.title k11atr process attribute packets .ident /1.0.01/ ; 18-Apr-84 11:20:59 Brian Nelson ; ; 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 ,0 attrty: .byte 41 ,42 ,43 ,44 ,45 ,46 ,47 .byte 50 ,51 ,52 ,53 ,54 ,55 ,56 .byte 57 ,60 .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 badpak: .asciz /Unknown attribute packet type / .even .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 #'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 ,0 210$: .byte 0 .byte '8 ,'9 ,'A&137 ,'8 ,'B&137 .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 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 sn.typ: movb #42 ,(r4)+ ; attribute type 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 .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 movb @r5 ,r0 scan r0 ,#attrty ; look for the attribute packet type? asl r0 ; simple to do jsr pc ,@attrds(r0) ; process the attribute packet now unsave ; bye return ; exit at.$$: calls error ,<#1,#badpak> ; send error back to abort things mov #-1 ,r0 ; return 'abort' return at.len: clr r0 return at.typ: cmpb 1(r5) ,#'B&137 ; 'binary' ? beq 10$ ; yes cmpb 1(r5) ,#'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 1(r5) ,at$dis clr r0 return at.pr0: clr r0 return at.pr1: clr r0 return at.sys: movb 1(r5) ,at$sys ; major vendor type movb 2(r5) ,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 fabsiz = 7*13 ; need at least this many at.fab: strlen r5 ; packet size ok dec r0 ; less the attribute type ('system') 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 inc r3 ; skip the attribute type header 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) 100$: clr r0 ; always flag success and exit return .sbttl utility routines pd$rsx = '8 pd$ias = '9 pd$rsts = 'A&137 pd$rt = 'B&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 ,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 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 calls putatr ,<@r5,r1> ; yes, update the ifab for the clr at$typ ; 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 .end