.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. ; ; 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 .include /IN:K11MAC.MAC/ .psect $pdata watt: .word sn.sys ,sn.typ ,sn.fab ,sn.pr0 ,sn.pr1 ,sn.len ,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 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 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 .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.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: 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 100$ ; /49/ No, exit inc at$len ; /49/ Yes, len++ 100$: 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: clr r0 return 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 strlen r5 ; packet size ok cmp r0 ,#fabsiz ; well.... blo 100$ ; too small, ignore the fab data call ispdp ; are we compatible today? tst r0 ; no if eq beq 100$ ; no, ignore the system dep attr's 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 10$: 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 ,10$ ; 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 .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$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 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 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$: unsave ; output file and exit return 200$: .byte 40,0 .end