.title KRTATR Process attribute packets .ident "V04.64" ; /E64/ 10-May-96 John Santos ; ; Conditionalize for RSTS/E. ; Restore RSTS/E attibutes handling from K11ATR.MAC ; Send two words of file size in sn.len & sn.xle ; Send our system type as RSTS/E ; Restore attribute 54 (RSTS/RSX protection code) ; handle creation date (cdt) attribute ; split up internal packet type (sn.inf) so that it can be sent in ; multiple packets. ; Send multiple attribute packets because they are too big. ; /63/ 23-Dec-94 Billy Youdelman ; /62/ 27-Jul-93 Billy Youdelman V03.62 ; ; add 25% to rec'd length for text files from non RT-11/TSX systems ; /BBS/ 1-Dec-91 Billy Youdelman V03.61 ; ; modified rx.cdt,sn.cdt to do the "#" date/time attribute ; hosed unused stuff, added rx.pro,sn.pro for protected file attribute ; ; added support for date/time/prot file attributes ; patched open, close and I/O data table to support it.. ; ; modified w$attr to send all attributes in a single packet ; rx.xle result in at$len no longer overwritten by rx.len ; added send exact file length in bytes ; call binary files "BINARY" not "IMAGE" so MS-Kermit is happy ; Copyright 1984 Change Software, Inc. ; ; 18-Apr-84 11:20:59 Brian Nelson ; 24-Mar-86 12:00:56 BDN Major revision which has some rather ; unpleasant compatibility problems with ; older Kermit-11's. ; 12-Sep-86 10:37:04 BDN Convert for I/D space ; This module is intended to be placed into an overlay ; which MUST be the "ERROR" cotree as the server, which ; is overlaid in the "UTILTY" cotree can indirectly ; call the module through the packet control routines. ; The receiving Kermit should ALWAYS get the SYSTEM and ; EXECUTIVE type attribute packet first so it can decide ; if it should use the data being sent. .include "IN:KRTMAC.MAC" .iif ndf KRTINC .error <; .include for IN:KRTMAC.MAC failed> .if df RT11 ; /E64/ .mcall .DATE ,.GTIM ; /BBS/ .endc ;RT11 ; /E64/ .psect $rwdata ,rw,d,lcl,rel,con atrctx::.word 0 ; /E64/ send attrs context (index) .if df RSTS ; /E64/ atrsnt::.word 0 ; /E64/ attributes actually sent atrsiz: .word 0 ; /E64/ approx size of current packet .endc ;RSTS ; /E64/ curatr: .blkb 200 ; current attribute scratch buffer day.x: .word 0 ; /BBS/ integer file create day day.y: .byte 0 ,0 ,0 ,0 ; /BBS/ ascii file create day mon.x: .word 0 ; /BBS/ integer file create month mon.y: .byte 0 ,0 ,0 ,0 ; /BBS/ ascii file create month sizbuf: .byte 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ; /BBS/ sn.xle ascii size xblock: .word 0 ,0 ; /BBS/ buffer for sn.xle, .gtim yr.x: .word 0 ; /BBS/ integer file create year yr.y: .byte 0 ,0 ,0 ,0 ,0 ,0 ; /BBS/ ascii file create year .psect $code .sbttl Send all attributes in a single packet ; /BBS/ modified to.. ; W $ A T T R ; ; input: (r5) = file lun ; 2(r5) = output packet buffer address ; output: r1 > 0 is packet length, 0 = receiver can't do attributes w$attr::save clr r1 ; preset in case other system bitb #capa.a ,conpar+p.capas ; can't handle attributes beq 40$ ; it can't bit #at.on ,doattr ; /63/ are attributes enabled? beq 40$ ; /63/ no mov 2(r5) ,r4 ; point to the packet .if df RT11 ; /E64/ clr atrctx ; init index .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ clrb @r4 ; /E64/ init packet in case it's empty clr atrsiz ; /E64/ no attrs yet in this packet mov atrsnt ,atrctx ; /E64/ here's where we start .endc ;RSTS ; /E64/ 10$: mov atrctx ,r0 ; dispatch on what to send next asl r0 ; word indexing tst watt(r0) ; all done? beq 30$ ; yes, finish up bit at.tx(r0),doattr ; /62/ is this attribute enabled? beq 20$ ; /62/ no .if df RSTS ; /E64/ add at.ln(r0),atrsiz ; /E64/ room for next attribute? cmp atrsiz ,#94. ; /E64/ (max allowed is 94 bytes) bhi 30$ ; /E64/ no, so out of here .endc ;RSTS ; /E64/ jsr pc ,@watt(r0) ; do it .if df RSTS ; /E64/ strlen 2(r5) ; /E64/ get length so far mov r0 ,atrsiz ; /E64/ and save it .endc ;RSTS ; /E64/ 20$: inc atrctx ; index to next subroutine br 10$ ; loop back for it 30$: strlen 2(r5) ; get the length and return it mov r0 ,r1 ; and say that this packet is for real 40$: clr r0 ; no error possible unsave return .save .psect $pdata .if df RT11 ; /E64/ watt: .word sn.sys ,sn.typ ,sn.pro ,sn.len ,sn.inf ,sn.cdt ,sn.xle at.rx: .word 0 ; /62/ also terminates watt at.tx: .word at.sys ,at.typ ,at.pro ,at.len ,at.inf ,at.cdt ,at.xle .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ watt: .word sn.sys ,sn.typ ,sn.pro ,sn.len ,sn.in1 ,sn.inf ,sn.cdt .word sn.xle at.rx: .word 0 ; /62/ also terminates watt at.tx: .word at.sys ,at.typ ,at.pro ,at.len ,at.inf ,at.inf ,at.cdt .word at.xle at.ln: .word 4 ,3 ,8. ,9. ,79. ,31. ,16. .word 12. .endc ;RSTS ; /E64/ .restore .sbttl Send system type sn.sys: movb #'. ,(r4)+ ; the system id attribute movb #42 ,(r4)+ ; /49/ length of what follows movb #'D&137 ,(r4)+ ; return the vendor code (DEC) .if df RT11 ; /E64/ movb #'B&137 ,(r4)+ ; /BBS/ it's RT-11 for sure here .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ movb #'A&137 ,(r4)+ ; /E64/ it's RSTS/E for sure here .endc ;RSTS ; /E64/ br sn.end ; /63/ go make it .asciz .sbttl Send generic file type sn.typ: movb #42 ,(r4)+ ; file type attribute movb #41 ,(r4)+ ; /49/ length of what follows movb #'A&137 ,r0 ; /BBS/ assume ascii cmpb image ,#binary ; is it binary or 8-bit text? blt 10$ ; /63/ no movb #'B&137 ,r0 ; /BBS/ yes, indicate it is.. 10$: movb r0 ,(r4)+ ; /BBS/ put file type in packet br sn.end ; /63/ go make it .asciz .sbttl Send file protection ; /BBS/ fixed for RT-11 .if df RT11 ; /E64/ sn.pro: ; bit_0 = read ; bit_1 = write ; protection codes from "Kermit, A bit_2 = execute ; File Transfer Protocol," 1987, for bit_3 = append ; the "-" (octal 55) attribute bit_4 = delete ; bit_5 = directory movb #55 ,(r4)+ ; public file protection movb #41 ,(r4)+ ; length of what follows mov (r5) ,r0 ; get lun asl r0 ; word indexing tst prot.a(r0) ; is it protected? bne 10$ ; ya mov #<1!2!4!10!20!40>,r0 ; no, set bits 0 thru 5 br 20$ ; continue 10$: mov #<1!4!40>,r0 ; protected, set bits 0,2,5 only 20$: add #40 ,r0 ; tochar r0 movb r0 ,(r4)+ ; put it into packet sn.end: clrb @r4 ; .asciz return .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ sn.pro: calls getpro ,<(r5)> ; /E64/ Get protection for file call tof11 ; /59/ Yes, convert movb #54 ,(r4)+ ; /59/ Sending internal protection movb #40+6 ,(r4)+ ; /59/ Field is six characters calls l$otoa , ; /59/ Convert to octal add #6 ,r4 ; /59/ Always leave pointing to end sn.end: clrb @r4 ; .asciz return .endc ;RSTS ; /E64/ .sbttl Send file length ; /BBS/ sn.len: mov (r5) ,r1 ; lun open to the file asl r1 ; word indexing .if df RT11 ; /E64/ mov sizof(r1),r1 ; get file size inc r1 ; accommodate rounding to asr r1 ; 1024. byte blocks, not 512. bne 10$ ; /BBS/ something is left of size.. inc r1 ; /BBS/ no, make it at least one block 10$: movb #41 ,(r4)+ ; attribute type (file size) movb #45 ,(r4)+ ; length of the number deccvt r1 ,r4 ,#5 ; convert to ascii mov #5 ,r0 ; for 5 chars 20$: cmpb @r4 ,#space ; if a space, then make it a "0" bne 30$ ; not a space movb #'0 ,@r4 ; it was a space 30$: inc r4 ; next sob r0 ,20$ ; please .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ ; /E64/ this code isn't really RSTS/E specific. It is ; /E64/ large file (>65535. blocks) specific. mov sizofh(r1),r0 ; /E64/ high word of size mov sizof(r1),r2 ; /E64/ low word of size add #1 ,r2 ; /E64/ round up adc r0 ; /E64/ carry to high word asr r0 ; /E64/ divide by 2 to convert to ror r2 ; /E64/ 1024. byte blocks mov #xblock+2,r1 ; /E64/ address of 32-bit number mov r2 ,(r1) ; /E64/ store low word mov r0 ,-(r1) ; /E64/ and high word ; /E64/ sorry, this is ludicrously ; /E64/ optimized for no good reason, ; /E64/ but I couldn't resist! ; /E64/ R1 now points to xblock clr r2 ; suppress leading zeros in output mov #sizbuf ,r0 ; address of out buff for ascii call $cddmg ; convert 32-bit integer to ascii clrb @r0 ; null terminate the string cmpb #'* ,sizbuf ; did $cddmg overflow? beq 40$ ; ya, bail out.. strlen #sizbuf ; get its length mov r0 ,r1 ; /E64/ save length movb #41 ,(r4)+ ; attribute type (file size) add #40 ,r0 ; tochar the string length movb r0 ,(r4)+ ; stuff into the attribute string mov #sizbuf ,r0 ; get pointer to the length string 20$: movb (r0)+ ,(r4)+ ; then copy ascii'd length into attr$ sob r1 ,20$ ; /E64/ next... .endc ;RSTS ; /E64/ 40$: br sn.end ; /63/ go make it .asciz .sbttl Send system specific info ; /52/ added /BBS/ cleaned up ; send a copy of the ifab over ; ; The routine 'GETATR' takes the directory (or file header) information ; regarding the file format from the IFAB allocated to the FAB for the ; file currently being sent. This data is converted to octal strings and ; then sent over as an ATTRIBUTE packet with a type of '0', which is the ; type reserved for system specific data. ; The receiver KERMIT should ALWAYS get the SYSTEM and EXECUTIVE type ; attribute packet first so it can decide whether or not it wants to use ; the data being sent. ; ; For instance, the file A.A would have a packet sent over as in below ; ; Name .Typ Size Prot Access Date Time Clu RTS Pos ;A .A 1 < 60> 01-May-84 01-May-84 10:17 AM 4 ...RSX 3493 ; RF:VAR=132 FO:SEQ USED:1:98 RECSI:46 CC:IMP ; ; ; ;SPACK - Length 78 Type A Paknum 3 ;0001002 000056 000000 000001 000000 000001 000142 000000 000204 000000 000000 .if df RSTS ; /E64/ sn.in1: calls getatr ,<(r5),#at$fab> ; get the ifab stuff now movb #'0 ,(r4)+ ; return sys type attr code movb #<13*7>+40,(r4)+ ; Length of data to follow. mov #at$fab ,r2 ; where we store such things mov #13 ,r0 ; number of words to send 20$: calls l$otoa , ; do it add #6 ,r4 ; skip over it movb #40 ,(r4)+ ; sob r0 ,20$ ; next 30$: br sn.end ; go make it .asciz .endc ;RSTS ; /E64/ ; Send internal file type ; sn.inf: movb #'0 ,(r4)+ ; DEC-specific file type movb #42 ,(r4)+ ; length of data to follow movb #42 ,(r4)+ ; sending extended file type mov image ,r0 ; use this to index to it movb sn$inf(r0),(r4)+ ; /63/ insert it ; Send creation date and time in RMS format ; .if df RSTS ; /E64/ movb #'0 ,(r4)+ ; System dependent data following movb #41+<6*4>,(r4)+ ; Amount of data to follow movb #43 ,(r4)+ ; Date of creation, 64bit format CALLS getcdt ,<(r5)> ; Get address of data mov r0 ,r2 ; Successful (ie, not RT11) mov #4 ,r3 ; Number of words 40$: CALLS l$otoa , ; Do it add #6 ,r4 ; Move over sob r3 ,40$ ; Next please .endc ;RSTS ; /E64/ br sn.end ; /63/ go make it .asciz .save .psect $pdata sn$inf: .byte 'A&137 ,'I&137 ,'N&137 .even .restore .sbttl Get file creation date/time ; /BBS/ added this.. sn.cdt: save ; pointer to current position in buff mov (r5) ,r4 ; channel asl r4 ; word offsets .if df RT11 ; /E64/ mov date.a(r4),r0 ; recover current file's date mov #curatr ,r1 ; the result address mov r0 ,r3 ; copy the date to extract bic #^c<37> ,r3 ; the year add #1972. ,r3 ; plus the bias please mov r0 ,r2 ; copy the date bic #^c<140000>,r2 ; extend max year w/two hi bits swab r2 ; two hi bits now are bits 7,6 asr r2 ; shift to bits 6,5 (true value) add r2 ,r3 ; add to total years call i4toa ; do all 4 digits of year mov r0 ,r3 ; copy to extract months swab r3 ; get the month to bits 7..2 asr r3 ; now bits 6..1 asr r3 ; now bits 5..0 bic #^c<37> ,r3 ; hose everything else call i2toa ; write ascii to out buff mov r0 ,r3 ; copy to extract day of month ash #3 ,r3 ; /62/ shift left 3 places swab r3 ; then swap bytes to get bic #^c<37> ,r3 ; the date call i2toa ; write ascii to out buff tst tsxsav ; only do file time under TSX beq 10$ ; it's not TSX movb #space ,(r1)+ ; a space delimiter between date,time mov time.a(r4),r3 ; recover current file's time clr r2 ; clear hi word for upcoming divide div #20. ,r2 ; get # of 3-sec units since midnight mov r3 ,-(sp) ; put on stack asl r3 ; 2x secs add r3 ,(sp) ; plus 1x = 3x = number_of_seconds mov r2 ,r3 ; get rest of time clr r2 ; set up for next divide div #60. ,r2 ; get number of minutes mov r3 ,-(sp) ; and save on stack mov r2 ,r3 ; this is the number of hours call i2toa ; write ascii to out buff movb #': ,(r1)+ ; a colon into the buffer mov (sp)+ ,r3 ; recover minutes call i2toa ; write ascii to out buff movb #': ,(r1)+ ; a colon into the buffer mov (sp)+ ,r3 ; recover secs call i2toa ; write ascii to out buff 10$: clrb @r1 ; .asciz .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ calls cantim ,<#curatr,date.a(r4),time.a(r4)> ; /E64/ convert date & time to ascii .endc ;RSTS ; /E64/ unsave ; recover packet buffer pointer mov #curatr ,r1 ; pointer to string just built strlen r1 ; get length of string add #40 ,r0 ; encode length (tochar..) movb #'# ,(r4)+ ; file create time/date data movb r0 ,(r4)+ ; put length into packet buffer 20$: movb (r1)+ ,(r4)+ ; then copy data into it bne 20$ ; until null dec r4 ; bump pointer back to the null return .sbttl Send file length in bytes ; /BBS/ all new sn.xle: mov (r5) ,r3 ; file open on this chan asl r3 ; word indexing .if df RT11 ; /E64/ clr r2 ; double precision, init high word .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ mov sizofh(r3),r2 ; /E64/ high word of size .endc ;RSTS ; /E64/ mov sizof(r3),r3 ; size in the accumulator low word bne 10$ ; something is there .if df RSTS ; /E64/ tst r2 ; /E64/ both words zero? bne 10$ ; /E64/ nope .endc ;RSTS ; /E64/ inc r3 ; make it at least one block 10$: mov #512. ,r0 ; setup call to $dmul, size*512. call $dmul ; double precision multiply mov r0 ,xblock ; save hi word mov r1 ,xblock+2 ; save low word clr r2 ; suppress leading zeros in output mov #xblock ,r1 ; address of 32-bit number mov #sizbuf ,r0 ; address of out buff for ascii call $cddmg ; convert 32-bit integer to ascii clrb @r0 ; null terminate the string cmpb #'* ,sizbuf ; did $cddmg overflow? beq 30$ ; ya, bail out.. strlen #sizbuf ; get its length movb #61 ,(r4)+ ; attribute type (exact size in bytes) add #40 ,r0 ; tochar the string length movb r0 ,(r4)+ ; stuff into the attribute string mov #sizbuf ,r0 ; get pointer to the length string 20$: movb (r0)+ ,(r4)+ ; then copy ascii'd length into attr$ bne 20$ ; until hitting the null terminator 30$: return .sbttl Received attribute packet processing ; R $ A T T R ; ; input: (r5) = packet buffer address ; output: r0 = if <>, error code r$attr::save ; /BBS/ cleaned this up a bit.. bit #at.on ,doattr ; /63/ attribute processing enabled? beq 70$ ; /62/ nope mov @r5 ,r5 ; /49/ get packet data address 10$: movb (r5)+ ,r0 ; /49/ attribute type code beq 60$ ; /49/ nothing there.. movb (r5)+ ,r1 ; /49/ get length field next beq 60$ ; /49/ nothing there.. cmpb r0 ,#'. ; /49/ if this is an OLD Kermit-11 bne 20$ ; /49/ with the invalid system type cmpb r1 ,#'D&137 ; /49/ format then we have to fix it bne 20$ ; /49/ it is not.. dec r5 ; /49/ it is, we'd been forgetting to mov #42 ,r1 ; /49/ include the length field 20$: sub #40 ,r1 ; /49/ convert length to integer ble 60$ ; /BBS/ nothing there mov #curatr ,r2 ; /49/ copy current attribute argument 30$: movb (r5)+ ,(r2)+ ; /49/ over to a save area now sob r1 ,30$ ; /49/ next please clrb (r2)+ ; /49/ ensure .asciz please mov r5 ,-(sp) ; /49/ make sure the r5 context saved scan r0 ,#attrty ; look for the attribute packet type? asl r0 ; simple to do bit at.rx(r0),doattr ; /62/ is this attribute enabled? bne 40$ ; /62/ ya clr r0 ; /62/ no, check for br 50$ ; /62/ more attributes 40$: jsr pc ,@attrds(r0) ; process the attribute packet now 50$: mov (sp)+ ,r5 ; /49/ restore the r5 context now tst r0 ; success? beq 10$ ; yes br 80$ ; no, exit with error in r0 60$: .if df RT11 ; /E64/ call ispdp ; /62/ if other end is RT-11 or TSX.. cmp r0 ,#4 ; /62/ well? beq 70$ ; /62/ it is, so file sizes are exact cmp image ,#binary ; /62/ then if file type isn't binary beq 70$ ; /62/ it is, image size is always ok mov at$len ,r0 ; /62/ otherwise save the passed size beq 80$ ; /62/ nothing was there, r0 is clear asr r0 ; /62/ divide by two asr r0 ; /62/ now it's by four, 25% of total inc r0 ; /62/ bump one more block to be sure add r0 ,at$len ; /62/ now bump requested space by 25% bcc 70$ ; /62/ result didn't overflow mov #65497. ,at$len ; /62/ it did, try the max possible.. .endc ;RT11 ; /E64/ 70$: clr r0 ; packet format error or end of data 80$: unsave return .save .psect $pdata .if df RT11 ; /E64/ attrty: .byte 56 ,42 ,55 ,41 ,60 ,43 ,61 .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ attrty: .byte 56 ,42 ,54 ,41 ,60 ,43 ,61 ; /E64/ .endc ;RSTS ; /E64/ .byte 0 .even attrds: .word rx.$$ ; /62/ must conform to at.rx .word rx.sys ,rx.typ ,rx.pro ,rx.len ,rx.inf ,rx.cdt ,rx.xle .restore .sbttl Null attribute handler rx.$$: clr r0 ; /49/ ignore unknown attribute types return .sbttl Process received length specified in 1024. byte blocks rx.len: tst at$len ; /BBS/ size from rx.xle already here? bne 40$ ; /BBS/ ya, use it instead of this .if df RSTS ; /E64/ tst at$len+2 ; /E64/ check high word, too bne 40$ ; /E64/ ya, use it instead of this .endc ;RSTS ; /E64/ mov #curatr ,r2 ; /49/ where we saved attributes .if df RSTS ; /E64/ clr r0 ; /E64/ high word of result .endc ;RSTS ; /E64/ clr r1 ; init the accumulator 10$: tstb @r2 ; EOL? beq 30$ ; yep cmpb @r2 ,#space ; ignore leading spaces please beq 20$ ; yes, a space clr -(sp) ; avoid sxt bisb @r2 ,@sp ; get the next digit please sub #'0 ,@sp ; and convert to decimal .if df RT11 ; /E64/ mul #12 ,r1 ; shift accum over 10. .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ mov r2 ,-(sp) ; /E64/ save pointer mov r0 ,r2 ; /E64/ high word of multiplicand mov r1 ,r3 ; /E64/ low word mov #12 ,r0 ; /E64/ shift accum over 10. call $dmul ; /E64/ multiply it mov (sp)+ ,r2 ; /E64/ restore pointer .endc ;RSTS ; /E64/ add (sp)+ ,r1 ; add in the current digit .if df RSTS ; /E64/ adc r0 ; /E64/ carry from add .endc ;RSTS ; /E64/ 20$: inc r2 ; next ch please br 10$ ; /49/ Next please 30$: asl r1 ; convert 1024. blocks to 512. blocks mov r1 ,at$len ; save it please .if df RSTS ; /E64/ rol r0 ; /E64/ high word of size mov r0 ,at$len+2 ; /E64/ save it please .endc ;RSTS ; /E64/ 40$: clr r0 ; success return .sbttl Received file type rx.typ: tst doauto ; /BBS/ auto file type enabled? bne 10$ ; /BBS/ ya mov $image ,image ; /BBS/ no, use what's SET br 30$ 10$: cmpb curatr ,#'B&137 ; binary? beq 20$ ; yes cmpb curatr ,#'I&137 ; image? bne 30$ ; no 20$: mov #binary ,image ; flag for image mode 30$: clr r0 ; success return .sbttl Put create date/time where close can get them later ; /BBS/ rx.cdt: clr -(sp) ; init 2 digit year flag scan #space ,#curatr ; find the space between date and time tst r0 ; get it? bne 10$ ; ya.. strlen #curatr ; no time is there cmp r0 ,#7 ; 2 or 4 digit year? bgt 20$ ; it's 4 br 30$ ; it's 2 10$: cmp r0 ,#10 ; 2 or 4 digit year? blt 30$ ; 2 digits 20$: mov sp ,(sp) ; 4 digits, set flag 30$: mov #curatr ,r1 ; pointer to date/time packet data mov #yr.y ,r0 ; extract the ascii year here call mov2b ; copy two bytes tst (sp)+ ; two or four digit year string? beq 40$ ; just two call mov2b ; copy two bytes 40$: mov #mon.y ,r0 ; extract the ascii month here call mov2b ; copy two bytes mov #day.y ,r0 ; extract the ascii day here call mov2b ; copy two bytes save ; save pointer to time string mov #yr.y ,r3 ; recover ascii year call gnum ; make it an integer mov r1 ,yr.x ; and save it here mov #mon.y ,r3 ; recover ascii month call gnum ; make it an integer mov r1 ,mon.x ; and save it here mov #day.y ,r3 ; recover ascii day call gnum ; make it an integer mov r1 ,day.x ; and save it here .if df RT11 ; /E64/ ; 2_bits ,4_bits ,5_bits ,5_bits mov mon.x ,r1 ; recover month ash #5 ,r1 ; partial shift towards final location add day.x ,r1 ; recover days ash #5 ,r1 ; shift days/months to final positions .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ mov mon.x ,r0 ; /E64/ get month asl r0 ; /E64/ *2 for indexing mov monday-2(r0),r0 ; /E64/ days in the month add day.x ,r0 ; /E64/ day of year (mod leap year!) .endc ;RSTS ; /E64/ mov yr.x ,-(sp) ; recover year cmp (sp) ,#100. ; is it two digits only? bge 60$ ; no .if df RT11 ; /E64/ cmp (sp) ,#71. ; ya but ambiguity impossible 'til '72 ble 50$ ; it has to be 21st century ; if two-digit year extend to four-digits based on the current century .gtim #rtwork ,#xblock ; ensure clock rollover.. .date ; ya, which century is it now? mov r0 ,r3 ; copy the date bic #^c<37> ,r3 ; the year add #1972. ,r3 ; plus the bias bic #^c<140000>,r0 ; extend max year w/two hi bits swab r0 ; two hi bits now are bits 7,6 asr r0 ; shift to bits 6,5 (true value) add r0 ,r3 ; now it's the total years cmp r3 ,#1999. ; well? bgt 50$ ; it's 2000 A.D. or above .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ cmp (sp) ,#69. ; /E64/ before '70? ble 50$ ; /E64/ yes, it has to be 21st century .endc ;RSTS ; /E64/ add #1900. ,(sp) ; not 2000 A.D. yet .. br 60$ ; and continue 50$: add #2000. ,(sp) ; default to current century .if df RT11 ; /E64/ 60$: sub #1972. ,(sp) ; RT-11 dates begin at 1972.. bge 70$ ; an ok date for RT-11 clr r1 ; a bad date, so hose it br 80$ ; and continue.. 70$: mov (sp) ,r0 ; copy to.. bic #^c<100!40>,r0 ; ..extract bits 6,5 asl r0 ; shift them to bits 7,6 swab r0 ; now they are the two hi bits bic #^c<37> ,(sp) ; hose possible hi bits in here add (sp) ,r1 ; and add it into the date word bis r0 ,r1 ; then insert year extension bits .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ 60$: bit #3,(sp) ; /E64/ is it a multiple of 4 ; /E64/ (i.e. leapyear? -- All RSTS/E dates fall between 1970 and ; /E64/ 2035, so this simplified rule works! bne 65$ ; /E64/ no cmp mon.x,#3 ; /E64/ yes, March or later? blo 65$ ; /E64/ no inc r0 ; /E64/ yes, so allow for Feb 29. 65$: sub #1970. ,(sp) ; /E64/ RSTS/E dates begin at 1970.. bge 70$ ; an ok date for RSTS clr r1 ; a bad date, so hose it br 80$ ; and continue.. 70$: mov (sp) ,r1 ; /E64/ copy to.. mul #1000. ,r1 ; /E64/ year * 1000 add r0 ,r1 ; /E64/ + day .endc ;RSTS ; /E64/ 80$: tst (sp)+ ; pop buffer mov #lun.ou ,r0 ; assume it's the output file asl r0 ; word indexing mov r1 ,date.a(r0) ; save date for use when closing file unsave ; recover pointer to time string tstb (r1)+ ; bump past space delimiter beq 100$ ; no time supplied mov r1 ,r3 ; now do time.. copy pointer call gnum ; convert hours to integer .if df RT11 ; /E64/ mul #<60.*20.>,r1 ; and to 3-sec intervals .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ mul #<60.> ,r1 ; /E64/ and to minutes .endc ;RSTS ; /E64/ mov r1 ,-(sp) ; save them inc r3 ; bump past colon call gnum ; convert mins to integer .if df RT11 ; /E64/ mul #20. ,r1 ; and to 3-sec intervals mov r1 ,-(sp) ; save them clr r1 ; preset in case no seconds supplied cmpb (r3)+ ,#': ; if not a colon, there's no secs bne 90$ ; done call gnum ; convert secs to integer clr r0 ; prep for divide div #3 ,r0 ; and to 3-sec intervals 90$: add (sp)+ ,r0 ; add in minutes data add (sp)+ ,r0 ; add in hours data .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ ; /E64/ RSTS times have no seconds add (sp)+ ,r1 ; /E64/ add in hours data mov #1440. ,r0 ; /E64/ Make minutes to midnight sub r1 ,r0 ; /E64/ (1440 minutes in a day) .endc ;RSTS ; /E64/ mov #lun.ou ,r1 ; assume it's the output file asl r1 ; word indexing mov r0 ,time.a(r1) ; save time for use when closing file 100$: clr r0 ; success return mov2b: movb (r1)+ ,(r0)+ ; move two bytes movb (r1)+ ,(r0)+ clrb (r0) ; null terminate return gnum: clr r1 ; the answer ; return the next number 110$: movb (r3)+ ,r0 ; next char sub #'9+1 ,r0 ; convert ascii byte add #9.+1 ,r0 ; to an integer bcc 120$ ; not a number mul #10. ,r1 ; bump accumulator by 10s add r0 ,r1 ; add in result from this pass br 110$ ; then try the next byte 120$: tstb -(r3) ; park on first non-numeric byte return .if df RSTS ; /E64/ .save .psect $pdata ; table of number of before the 1st of each month monday: .word 0 ,31. ,59. ,90. ,120. ,151. .word 181. ,212. ,243. ,273. ,304. ,334. .restore .endc ;RSTS ; /E64/ .sbttl Put file protection code where close can get it later ; /BBS/ .if df RT11 ; /E64/ rx.pro: mov #lun.ou ,r1 ; assume output file asl r1 ; word indexing bicb #<1!4!40!100!200>,curatr ; hose bits 0,2,5 and unused bits 6,7 beq 10$ clr prot.a(r1) ; it's read-write br 20$ 10$: mov sp ,prot.a(r1) ; it's read-only 20$: clr r0 ; success return .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ rx.pro: call ispdp ; /59/ Is this another Kermit-11 tst r0 ; /59/ sending us protection in beq 100$ ; /59/ internal (Files11) format? calls octval ,<#curatr> ; /59/ Convert from octal string. mov r1 ,r0 ; /59/ We are running on a RSTS call torsts ; /59/ system, convert it. mov r1 ,at$pro ; /E64/ Save the protection. 100$: clr r0 ; /59/ Success return ; /59/ And exit .endc ;RSTS ; /E64/ .sbttl Received system type rx.sys: movb curatr ,at$sys ; save major vendor type movb curatr+1,at$sys+1 ; save the operating system type clr r0 ; success return .sbttl Receive system specific info fabsiz = 7*13 ; need at least this many rx.inf: call ispdp ; are we tst r0 ; compatible today? beq 10$ ; no, ignore the system dep attr's .if df RSTS ; /E64/ mov #curatr ,r5 ; /E64/ current attribute data strlen r5 ; packet size ok cmp r0 ,#fabsiz ; well.... bge 40$ ; Ok, must be a IFAB cmpb (r5) ,#43 ; /54/ Date info? bne 100$ ; /54/ No inc r0 ; /54/ Yes, process 4 octal words mov sp ,at$cdt ; /54/ Flag we have been here mov #4 ,-(sp) ; /54/ Number of words mov #at$klu ,r2 ; /54/ Destination 20$: clr r1 ; /54/ Accumulator mov #6 ,r3 ; /54/ Number of itmes 30$: movb (r0)+ ,r4 ; /54/ The next character sub #'0 ,r4 ; /54/ Convert to a number asl r1 ; /54/ Multiply by 8 asl r1 ; /54/ ... asl r1 ; /54/ ...... add r4 ,r1 ; /54/ Put in current result sob r3 ,30$ ; /54/ Next please mov r1 ,(r2)+ ; /54/ Copy the word dec (sp) ; /54/ More to do bne 20$ ; /54/ Yep tst (sp)+ ; /54/ All done br 10$ ; /54/ Exit 40$: mov #at$fab ,r4 ; copy the packet over now mov #-1 ,(r4)+ ; flag that the attributes are for real mov #13 ,r2 ; number of words to convert back 50$: clrb 6(r5) ; insure .asciz now calls octval , ; simple tst r0 ; successfull? bne 90$ ; no, clear flag and exit mov r1 ,(r4)+ ; and save the value now add #7 ,r5 ; point to the next octal number sob r2 ,50$ ; next please mov sp ,at$val ; it's ok to use the attributes br 10$ ; bye 90$: clr at$fab ; error exit (conversion error) ; message ,cr; /49/ br 10$ ; /E64/ 100$: ; .endc ;RSTS ; /E64/ mov #curatr ,r0 ; /BBS/ current attribute data cmpb (r0)+ ,#42 ; /53/ file type subfunction? bne 10$ ; /53/ no, ignore for now tst doauto ; /BBS/ auto file type enabled? beq 10$ ; /BBS/ no, ignore this stuff.. scan (r0) ,#rx$in0 ; /63/ get IFAB file attributes data asl r0 ; /53/ word addressing mov rx$in1(r0),image ; /63/ set it 10$: clr r0 return .save .psect $pdata rx$in0: .byte 'A&137 ,'B&137 ,'I&137 ,'N&137 ; /63/ add "B" type .byte 0 .even rx$in1: .word TEXT ; if not in this list call it text .word TEXT ,BINARY ,BINARY ,DECNAT .restore .sbttl Exact file size in bytes (type "1") rx.xle: mov #curatr ,r5 ; /49/ point to attribute save area clr r3 ; /49/ init the accumulator (low word) clr r2 ; /49/ double precision (high word) 10$: tstb @r5 ; /49/ EOL? beq 30$ ; /49/ yep cmpb @r5 ,#space ; /49/ ignore leading spaces please beq 20$ ; /49/ yes, a space mov #12 ,r0 ; /49/ setup for call to $dmul call $dmul ; /49/ do it please mov r0 ,r2 ; /49/ restore accumulator values now mov r1 ,r3 ; /49/ ditto... clr -(sp) ; /49/ get the next digit please bisb @r5 ,@sp ; /BBS/ convert to decimal sub #'0 ,@sp ; /49/ got it add (sp)+ ,r3 ; /49/ add in the current digit adc r2 ; /49/ add carry bit in also please 20$: inc r5 ; /49/ next ch please br 10$ ; /49/ next please .if df RT11 ; /E64/ 30$: div #1000 ,r2 ; /BBS/ convert to 512 byte blocks now mov r2 ,at$len ; /49/ save it please tst r3 ; /BBS/ was there a remainder? beq 40$ ; /49/ no, exit inc at$len ; /49/ yes, len++ .endc ;RT11 ; /E64/ .if df RSTS ; /E64/ 30$: add #777 ,r3 ; /E64/ round up to block boundary adc r2 ; /E64/ propagate carry ashc #-9. ,r2 ; /E64/ shift leaving 32-bit result mov r2 ,at$len+2 ; /E64/ save it please mov r3 ,at$len ; /E64/ save it please .endc ;RSTS ; /E64/ 40$: clr r0 ; success return .sbttl Determine if other system is a PDP-11 ; I S P D P ; ; output: r0 = 5 other system running POS ; 4 RT-11 or TSX+ ; 3 RSTS ; 2 IAS ; 1 RSX ; 0 it's something else.. PD$RSX = '8 PD$IAS = '9 PD$RSTS = 'A&137 PD$RT = 'B&137 ; includes TSX PD$POS = 'C&137 ispdp: clr r0 ; presume failure cmpb at$sys ,#'D&137 ; a DEC system? bne 10$ ; no, exit scan ,#pdplst ; ya, determine operating system type 10$: return .save .psect $pdata pdplst: .byte pd$rsx ,pd$ias ,pd$rsts,pd$rt ,pd$pos ,0 .even .restore .sbttl Clear attributes clratr::clr at$len ; clear the file length .if df RSTS ; /E64/ clr at$len+2 ; /E64/ clear the file length - high clr at$pro ; /E64/ .endc ;RSTS ; /E64/ clr at$sys ; clear the system type .if df RSTS ; /E64/ clr at$fab clr atrctx clr at$klu+0 clr at$klu+2 clr at$klu+4 clr at$klu+6 clr at$cdt .endc ;RSTS ; /E64/ return .sbttl finish up the update of rms file attributes to output ; A T R F I N ; ; If the file was sent in image mode, and we have been sent ; valid attributes (basically, the sender's IFAB), then call ; PUTATR to place these attributes into our output file's ; IFAB so they will get updated. ; ; ; Note: 11-Jul-84 17:12:49 BDN, edit /19/ ; ; Note that for RSTS/E, we have an unusual problem in that if ; the sender sent a stream ascii file (most likely a file with ; NO attributes) over and the sender said it's binary, then ; RMS-11 sends GARBAGE for the VFC header size. When this data ; is wriiten into the output file's IFAB, RMS11 finds invalid ; data in the IFAB and writes attributes to disk with the last ; block field (F$HEOF and F$LEOF) equal to ZERO. Such a file ; would thus be unreadable to PIP, RMS and other programs that ; look at the file attributes. The fix is one of two things. ; One, we can clear the invalid VFC size and fudge the record ; size and maximum record size to something usable (like 512), ; or we can simply ignore the senders attributes and let the ; file stand as a FIXED, NO CC, recordsize 512 file. Rather ; than to try to fix the attributes, we will simple ignore the ; attributes if the sender said that the file is stream ascii ; with a garbage VFC. Since the attributes are only used if ; the transfer was in image mode, this will not affect normal ; files, only files like DMS-500 files that have no attributes ; but must be sent in image mode. ; Of course, the sending Kermit-11 can always be given the SET ; ATT OFF and SET FIL BIN and the receiving Kermit-11 be given ; the SET FIL BIN and the issue will never arise. ; ; The mods are noted with /19/ after the statement. .if df RSTS ; /E64/ atrfin::save ; just in case please tst @r5 ; lun zero ? beq 100$ ; yep tst at$val ; valid attributes to write ? beq 100$ ; no tst at$cdt ; Ever set the creation date/time? beq 10$ ; No calls putcdt ,<@r5,#at$klu> ; Yes, update it 10$: cmpb image ,#binary ; did we get this as a binary file? bne 100$ ; no mov #at$fab ,r1 ; yes tst (r1)+ ; valid data present ? beq 100$ ; no cmp @r1 ,#2000 ; /19/ stream ascii ? bne 30$ ; /19/ no cmp 16(r1) ,#177400 ; /19/ garbage for the vfc header size? beq 90$ ; /19/ yes, forget about the attributes 30$: calls putatr ,<@r5,r1> ; /19/ update the ifab for the file 90$: clr at$fab ; no longer valid please clr at$val ; no longer valid please 100$: clr at$cdt unsave ; output file and exit return .endc ;RSTS ; /E64/ .sbttl Map RSTS protection codes to Files-11 codes and back ; /59/ 9-OCT-1987 08:11 BDN ; ; Use the files11 format for transfering protection code ; between two kermit-11's, thus it will work even for RSX ; to RSTS transfer. .if df RSTS ; /E64/ .Save .Psect $Pdata ,d dflt.f: .word ^B1100110000000000 ; Default to no world, group rsts.p: .word 1*20 ; If 0 set, no owner read .word 2*20 ; If 1 set, no owner write .word 1*400 ; If 2 set, no group read .word 2*400 ; If 3 set, no group write .word 1*10000 ; If 4 set, no world read .word 2*10000 ; If 5 set, no world write .Restore torsts: mov #77 ,r1 ; Start with no access clr r2 ; Current bit to set mov #6 ,r3 ; Six times please clr r4 ; Indexing into bit table mov #1 ,r2 ; Start with bit one 10$: bit rsts.p(r4),r0 ; Check for F11 bit set bne 20$ ; Set, implies access bic r2 ,r1 ; So clear it here 20$: asl r2 ; Shift it tst (r4)+ ; Next bit pattern sob r3 ,10$ ; Loopback return ; Exit tof11: mov dflt.f ,r1 ; Default Files-11 bitmask clr r2 ; Start with bit zero of RSTS mov #6 ,r3 ; Loop six times 10$: bit #1 ,r0 ; Check for bit being set in RSTS beq 20$ ; code. Not set, leave alone bis rsts.p(r2),r1 ; Set, so set the Files-11 prot 20$: tst (r2)+ ; Next asr r0 ; Get the next bit moved over sob r3 ,10$ ; And loop back mov r1 ,r0 ; Return in r0 return ; Exit .endc ;RSTS ; /E64/ .sbttl 32-bit multiply from RSX SYSLIB.OLB $DMUL: MOV R0 ,-(SP) CLR R0 CLR R1 10$: TST (SP) BEQ 30$ ROR (SP) BCC 20$ ADD R3 ,R1 ADC R0 ADD R2 ,R0 20$: ASL R3 ROL R2 BR 10$ 30$: TST (SP)+ RETURN .end