.title k11atr process attribute packets .ident /1.0.02/ .enabl gbl ; 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 running ; ; Copyright (C) 1984 Change Software, Inc. ; ; ; Process attribute packets for RSTS/E and RSX11M/M+ ; ; This module is intended to be placed into an overlay ; which MUST be the 'ERROR' cotree as the server, which ; is overlayed in the 'UTILTY' cotree can indirectly ; call the module through the packet control routines. ; This module will also be rather RMS11 dependent. ; ; ; Get the Kermi-11 common macro definition INCLUDE file .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .psect $pdata watt: .word sn.sys ,sn.typ ,sn.fab ,sn.pr0 ,sn.pr1 ,sn.len ,sn.fty ;- .word sn.cdt .word 0 attrty: .byte 41 ,42 ,43 ,44 ,45 ,46 ,47 .byte 50 ,51 ,52 ,53 ,54 ,55 ,56 .byte 57 ,60 ,61 .byte 0 .even attrds: .word at.$$ .word at.len ,at.typ ,at.cre ,at.id ,at.bil ,at.area,at.pas .word at.bsiz ,at.acc ,at.enc ,at.dis ,at.pr0 ,at.pr1 ,at.sys .word at.for ,at.fab ,at.xle badpak: .asciz /Unknown attribute packet type / incomp: .ascii /?K11-ATR Protocol bugfix detected. Use/ .asciz /SET NOATT and see K11.BWR, K11INS.DOC./ .even .psect tempda ,rw,d,lcl,rel,con curatr: .blkb 200 .psect $code .sbttl return the next attribute packet to send ; W $ A T T R ; ; input: @r5 filename address ; 2(r5) lun it's using ; 4(r5) output packet address ; ; output: r0 rms error code, else zero ; r1 > 0 the packet length, also come back for more later ; r1 = 0 no more packets or else receiver can't handle them w$attr::save ; save registers that we may use here bitb #capa.a ,conpar+p.capas ; the other system handle 'A' packets? beq 90$ ; no, exit with 'eof' 10$: mov 4(r5) ,r4 ; point to the packet mov atrctx ,r0 ; now dispatch on what to send next asl r0 ; simple to do tst watt(r0) ; all done ? beq 90$ ; yes, just exit then jsr pc ,@watt(r0) ; and do it inc atrctx ; next time, do the next one in the list tst r0 ; was it possible to do this attr? bne 10$ ; no, try the next one then strlen 4(r5) ; get the length and return it mov r0 ,r1 ; and say that this packet is for real clr r0 ; exit without error br 100$ ; bye 90$: clr r0 ; all done, no more attributes to clr r1 ; send over clr atrctx ; init for the next file we send 100$: unsave ; pop these and exit return ; bye .sbttl dispatch routines for sending 'a' packets .enabl lsb sn.sys: call getsys ; get the system type first scan r0 ,#200$ ; find out what we are tst r0 ; did it work ? beq 110$ ; no movb #'. ,(r4)+ ; sys id attr packet movb #42 ,(r4)+ ; /49/ Length of whats to follow movb #'D&137 ,(r4)+ ; return the vendor code (DEC) movb 210$(r0),(r4)+ ; and the system type clrb @r4 ; .asciz clr r0 ; say it worked return ; bye 110$: mov sp ,r0 ; it failed return .save .psect $PDATA ,D 200$: .byte sy$11m ,sy$ias ,sy$rsts,sy$mpl ,sy$rt ,sy$pos ,0 210$: .byte 0 .byte '8 ,'9 ,'A&137 ,'8 ,'B&137 ,'C&137 ,0 .even .restore .dsabl lsb .sbttl 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 sn.fab: calls getatr ,<2(r5),#at$fab>; get the ifab stuff now tst r0 ; but did it work? bmi 100$ ; no, it crapped out movb #'0 ,(r4)+ ; return sys type attr code movb #<13*7>+40,(r4)+ ; Length of data to follow. mov r4 ,r0 ; fill it with spaces first mov #13*7 ,r1 ; simple 5$: movb #40 ,(r0)+ ; sob r1 ,5$ ; next mov #at$fab ,r2 ; where we store such things mov #13 ,r0 ; number of words to send 10$: calls l$otoa , ; do it add #7 ,r4 ; skip over it sob r0 ,10$ ; next clr r0 ; say that it worked clrb @r4 ; .asciz 100$: return .sbttl send file type (ascii,binary), protection and size ; SN.FTY added /52/ .enabl lsb sn.fty: movb #'0 ,(r4)+ ; Attribute type (SYS type) movb #42 ,(r4)+ ; Length of data to follow. movb #42 ,(r4)+ ; Sending extended filetype mov image ,r0 ; Index into it movb 200$(r0),(r4)+ ; Insert it clrb @r4 ; .Asciz clr r0 ; Success return ; Exit .ASSUME TEXT EQ 0 .ASSUME BINARY EQ 1 .ASSUME DECNAT EQ 2 .save ; Save, start a DATA psect .psect $pdata ,d 200$: .byte 'A&137 ,'I&137 ,'N&137 ,'A&137 .even .restore ; Pop old psect .dsabl lsb ; And drop local symbol block sn.cdt: 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 ,<2(r5)> ; Get address of data mov r0 ,r2 ; Successful (ie, not RT11) beq 90$ ; No mov #4 ,r3 ; Number of words 10$: CALLS l$otoa , ; Do it add #6 ,r4 ; Move over sob r3 ,10$ ; Next please clrb @r4 ; .ASCIZ clr r0 ; Success br 100$ ; Exit 90$: mov #-1 ,r0 ; Failure 100$: return ; Exit sn.typ: movb #42 ,(r4)+ ; attribute type movb #41 ,(r4)+ ; /49/ Length of what follows movb #'A&137 ,@r4 ; assume ascii cmpb image ,#binary ; already decided that it's binary? bne 10$ ; no movb #'I&137 ,@r4 ; yes, say it's image mode today 10$: clrb 1(r4) ; insure .asciz clr r0 ; flag success and exit return ; bye sn.pr0: call getsys ; /59/ Get system type mov r0 ,-(sp) ; /59/ Save it calls getpro ,<2(r5)> ; /59/ Get protection for file cmpb (sp)+ ,#4 ; /59/ If RSTS, we want to convert bne 10$ ; /59/ to files11 format. call tof11 ; /59/ Yes, convert 10$: 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 clrb @r4 ; /59/ And make it .asciz clr r0 ; /59/ Success return ; /59/ Exit sn.pr1: mov #-1 ,r0 return sn.len: calls getsiz ,<2(r5)> ; get the size of the file please tst r0 ; did this work ? bne 100$ ; no inc r1 ; try to accomodate rounding asr r1 ; in 1024 blocks, not 512 bic #100000 ,r1 ; insure no sign bits now movb #41 ,(r4)+ ; attribute type (file size) movb #45 ,(r4)+ ; length of the number deccvt r1,r4,#5 ; convert to ascii mov #5 ,r0 ; convert leading spaces to '0' 10$: cmpb @r4 ,#40 ; if a space, then make it a '0' bne 20$ ; no movb #'0 ,@r4 ; yes, stuff a space in 20$: inc r4 ; next please sob r0 ,10$ ; next please clrb @r4 ; insure .asciz clr r0 ; to be safe 100$: return ; bye .sbttl dispatch on the type of attribute packet received .psect $code ; R $ A T T R ; ; input: @r5 the packet address ; output: r0 error code, zero for success r$attr::save ; just to be safe mov @r5 ,r5 ; /49/ Get packet data address 10$: movb (r5)+ ,r0 ; /49/ Attribute type code beq 90$ ; /49/ Nothing there ??? movb (r5)+ ,r1 ; /49/ Get length field next beq 90$ ; /49/ Nothing there ? cmpb r0 ,#'. ; /49/ If this is an OLD kermit-11 bne 20$ ; /49/ with the invalid packet fmt cmpb r1 ,#'D&137 ; /49/ then we will have to make a bne 20$ ; /49/ note of it and try to fix it mov sp ,oldatt ; /49/ up. 20$: call 200$ ; /49/ Perhaps fix packets from old K11 sub #40 ,r1 ; /49/ Convert length to integer bmi 90$ ; /49/ Again, nothing was there mov #curatr ,r2 ; /49/ Copy current attribute argument 40$: movb (r5)+ ,(r2)+ ; /49/ over to a save area now. sob r1 ,40$ ; /49/ Next please clrb (r2)+ ; /49/ Insure .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 jsr pc ,@attrds(r0) ; process the attribute packet now mov (sp)+ ,r5 ; /49/ Restore the R5 context now. tst r0 ; Success beq 10$ ; Yes br 100$ ; No, exit 90$: clr r0 ; Packet format error or end of data 100$: unsave ; bye return ; exit 200$: mov r0 ,-(sp) ; /49/ Fix bad attribute data up (?) cmpb r0 ,#41 ; /49/ The old (and incorrect) K11's beq 220$ ; /49/ did the filesize format ok tst oldatt ; /49/ Is this a fubarred old Kermit-11 beq 220$ ; /49/ No dec r5 ; /49/ Yes, we had been forgetting to strlen r5 ; /49/ include the length field before mov r0 ,r1 ; /49/ the actual attribute data. add #40 ,r1 ; /49/ Convert to char format. 220$: mov (sp)+ ,r0 ; /49/ So backup one char and reset the return ; /49/ Length. at.$$: clr r0 ; /49/ Ignore unknown attribute types return ; /49/ Exit ;- calls error ,<#1,#badpak> ; send error back to abort things ;- mov #-1 ,r0 ; return 'abort' ;- return .sbttl process specific attribute types ; File size in 1024 byte chunks (512 would have been better) at.len: save ; save temps please clr at$len ; assume zero mov #curatr ,r2 ; /49/ Where we saved attributes clr r1 ; init the accumulator 10$: tstb @r2 ; eol ? beq 30$ ; yep cmpb @r2 ,#40 ; ignore leading spaces please beq 20$ ; yes, a space clr -(sp) ; get the next digit please movb @r2 ,@sp ; and convert to decimal sub #'0 ,@sp ; got it mul #12 ,r1 ; shift accum over 10 add (sp)+ ,r1 ; add in the current digit 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 100$: unsave ; pop temps and exit clr r0 return ; Exact size in bytes (type '1') at.xlen:save ; /49/ Save temps please asl r1 ; /49/ Convert 1024 blocks to 512 blocks clr at$len ; /49/ Assume zero mov #curatr ,r5 ; /49/ Point to attribute save area clr r3 ; /49/ Init the accumulator clr r2 ; /49/ Double precision please 10$: tstb @r5 ; /49/ Eol ? beq 30$ ; /49/ Yep cmpb @r5 ,#40 ; /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 movb @r5 ,@sp ; /49/ And 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 30$: mov r2 ,r1 ; /49/ Setup for call to $DDIV now mov r3 ,r2 ; /49/ Ditto.... mov #1000 ,r0 ; /49/ Convert to 512 byte blocks now call $ddiv ; /49/ Simple mov r2 ,at$len ; /49/ Save it please tst r0 ; /49/ Was there a remainder ? beq 40$ ; /49/ No, exit inc at$len ; /49/ Yes, len++ 40$: call getsys ; /61/ See if RT11, since a UNIX system cmpb r0 ,#SY$RT ; /61/ will send the wrong size, ie, RT bne 100$ ; /61/ needs CrLf rather than Lf at eol mov at$len ,r1 ; /61/ So we will add a small fudge ash #-5 ,r1 ; /61/ factor in (len += len/32) bic #174000 ,r1 ; /61/ ... add r1 ,at$len ; /61/ Tacky, but effective I guess 100$: mov at$len ,at$xlen ; /61/ Save unsave ; /49/ Pop temps and exit clr r0 return global <$ddiv ,$dmul> global .sbttl more attribute receive options at.typ: cmpb curatr ,#'B&137 ; 'binary' ? beq 10$ ; yes cmpb curatr ,#'I&137 ; 'image' ? bne 100$ ; no 10$: mov #binary ,image ; flag for image mode then mov #binary ,at$typ ; save it here also 100$: clr r0 return at.cre: clr r0 return at.id: clr r0 return at.bil: clr r0 return at.area:clr r0 return at.pas: clr r0 return at.bsiz:clr r0 return at.acc: clr r0 return at.enc: clr r0 return at.dis: movb curatr ,at$dis clr r0 return at.pr0: call ispdp ; /59/ Is this another Kermit-11 tst r0 ; /59/ sending us protection in beq 100$ ; /59/ internal (Files11) format? call getsys ; /59/ If it's RSTS, convert from mov r0 ,r2 ; /59/ F11 format to RSTS format. calls octval ,<#curatr> ; /59/ Convert from octal string. cmpb r2 ,#4 ; /59/ Is it RSTS ? bne 10$ ; /59/ No, can use as is mov r1 ,r0 ; /59/ We are running on a RSTS call torsts ; /59/ system, convert it. 10$: mov r1 ,at$pr0 ; /59/ Save the protection. 100$: clr r0 ; /59/ Success return ; /59/ And exit at.pr1: clr r0 return at.sys: movb curatr ,at$sys ; major vendor type movb curatr+1,at$sys+1 ; save the system type clr r0 ; no errors return ; exit at.for: clr r0 return .sbttl recieve the ifab data for file attributes from another 11 .enabl lsb fabsiz = 7*13 ; need at least this many at.fab: mov #curatr ,r5 ; /49/ Save area for current attr's call ispdp ; are we compatible today? tst r0 ; no if eq beq 100$ ; no, ignore the system dep attr's strlen r5 ; packet size ok cmp r0 ,#fabsiz ; well.... bge 40$ ; Ok, must be a IFAB mov r5 ,r3 ; /53/ Not an IFAB, perhaps other sys cmpb (r3) ,#43 ; /54/ Date info? bne 30$ ; /54/ No inc r3 ; /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 10$: clr r1 ; /54/ Accumulator mov #6 ,r0 ; /54/ Number of itmes 20$: movb (r3)+ ,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 r0 ,20$ ; /54/ Next please mov r1 ,(r2)+ ; /54/ Copy the word dec (sp) ; /54/ More to do bne 10$ ; /54/ Yep tst (sp)+ ; /54/ All done br 100$ ; /54/ Exit ; 30$: cmpb (r3)+ ,#42 ; /53/ File type subfunction? bne 100$ ; /53/ No, ignore for now movb (r3)+ ,r0 ; /53/ Get the file type SCAN r0 ,#200$ ; /53/ Look for it asl r0 ; /53/ Word addressing mov 210$(r0),image ; /53/ Set it mov 210$(r0),at$typ ; /53/ Here also. br 100$ ; /53/ Exit 40$: mov #at$fab ,r4 ; copy the packet over now mov r5 ,r3 ; and the source please mov #-1 ,(r4)+ ; flag that the attributes are for real mov #13 ,r2 ; number of words to convert back 50$: clrb 6(r3) ; 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 ,r3 ; point to the next octal number sob r2 ,50$ ; next please mov sp ,at$val ; it's ok to use the attributes br 100$ ; bye 90$: clr at$fab ; error exit (conversion error) message ,cr; /49/ 100$: clr r0 ; always flag success and exit return .save .psect $pdata ,d 200$: .byte 'A ,'I ,'N ,0 210$: .word TEXT .word TEXT ,BINARY ,DECNAT ,0 .even .restore .dsabl lsb .sbttl utility routines pd$rsx = '8 pd$ias = '9 pd$rsts = 'A&137 pd$rt = 'B&137 pd$pos = 'C&137 ; I S P D P ; ; input: nothing ; output: r0 <> 0 if the other system is a KERMIT-11 system ; errors: none .psect $pdata pdplst: .byte pd$rsx ,pd$ias ,pd$rsts,pd$rt ,pd$pos ,0 .even .psect $code ispdp:: clr r0 ; presume failure cmpb at$sys ,#'D&137 ; a DEC system ? bne 100$ ; no, exit scan ,#pdplst 100$: return clratr::clr at$len clr at$xlen clr at$typ clr at$cre clr at$id clr at$bil clr at$area clr at$pas clr at$bsiz clr at$acc clr at$enc clr at$dis clr at$pr0 clr at$pr1 clr at$sys clr at$for clr at$fab clr atrctx clr at$klu+0 clr at$klu+2 clr at$klu+4 clr at$klu+6 clr at$cdt return .sbttl finish up the update of rms file attributes to output ; A T R F I N ; ; If the file was send 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 moed, 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. 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 at$typ ,#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$typ ; /19/ no longer valid please clr at$fab ; no longer valid please clr at$val ; no longer valid please 100$: clr at$cdt unsave ; output file and exit return .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. .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 .sbttl 32 bit arithmetic modules 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 $DDIV: MOV R3,-(SP) MOV #40,R3 MOV R0,-(SP) CLR R0 10$: ASL R2 ROL R1 ROL R0 CMP R0,(SP) BCS 20$ SUB (SP),R0 INC R2 20$: DEC R3 BGT 10$ TST (SP)+ MOV (SP)+,R3 RETURN .end