home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
kermit11.tar.gz
/
kermit11.tar
/
k11atr.mac
< prev
next >
Wrap
Text File
|
1989-06-13
|
21KB
|
752 lines
.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/<CR><LF>
.asciz /SET NOATT and see K11.BWR, K11INS.DOC./<CR><LF>
.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 <r2,r3,r4> ; 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 <r4,r3,r2> ; 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 ,<r4,(r2)+> ; 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 ,<r4,(r2)+> ; 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 ,<r4,r0> ; /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 <r1,r2,r3,r4,r5> ; 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 <r5,r4,r3,r2,r1> ; 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 <r1,r2> ; 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 <r2,r1> ; pop temps and exit
clr r0
return
; Exact size in bytes (type '1')
at.xlen:save <r1,r2,r4,r4,r5> ; /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 <r5,r4,r3,r2,r1> ; /49/ Pop temps and exit
clr r0
return
global <$ddiv ,$dmul>
global <at.xlen>
.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 ,<r3> ; 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 <Fab attribute error>,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 <at$sys+1>,#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 <r1,r2,r3> ; 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 <r3,r2,r1> ; 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