home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
test
/
pdp11
/
krtatr.mac
< prev
next >
Wrap
Text File
|
2020-01-01
|
35KB
|
1,094 lines
.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 <r2,r3,r4>
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 <r4,r3,r2>
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 ,<r4,r0> ; /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 ,<r4,(r2)+> ; 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 ,<r4,(r2)+> ; 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 <r4> ; 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 <r4> ; 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 <r1,r2,r5> ; /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 <r5,r2,r1>
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 <r1> ; 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<year_ext> ,4_bits<mon> ,5_bits<day> ,5_bits<year-1972>
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 <r1> ; 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 ,<r5> ; 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 <Fab attribute error>,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 <at$sys+1>,#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 <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 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 <r3,r2,r1> ; 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