Trailing-Edge
-
PDP-10 Archives
-
decuslib20-10
-
decus/20-185/vaxmit.mar
There are no other files named vaxmit.mar in the archive.
.title Vaxmit, computer to computer transfer protocol
.page
.subtitle WCC edit history
;[W1] Modify the file name translation from 20 to Vax routine.
; [JGD 2-Oct-84]
;
;[W2] Modified where the file name size of incomming files is gotten.
; [JGD 15-Oct-84]
;
;[W3] Reset the packet to start at packet + 0. Removing junk at the start
; of what is collected. [JGD 15-Oct-84]
;
;[W4] Fix the file name and extension length. A max of 8 characters for a
; file name are allowed. A max of 3 characters for a file extension
; are allowed. [JGD 19-Oct-84]
;
;[W5] Modify to use the network directory structure and add logging
; capabilities.
;
.page
.subtitle program initialization
;version information
Vmajor == 1 ;Major version
Vminor == 0 ;Minor version
Vedit == 1 ;Edit number
Vcust == 5 ;WCC edit code
;*
;*
;*
;* Written by Doug Bigelow on 2-Jul-84 in Macro 20
;* Translated into Vax 11 by Joseph Deck on 6-Jul-84
;*
;* Library required: None
;*
;* Description: This program runs on a Vax 750 to automatically
;* handle file transfers between a DEC 20 / VAX 750 systems.
;* It reads files from <KLA> and sends them across a TTY
;* line, and puts the incomming files into <TO>.
;*
;* Protocol Explaination: There are six possible types of packets:
;* A Ack a packet (standard good response to a good packet)
;* B Nak a packet (standard good response to a bad packet)
;* C Cancel a packet (no appropiate response received)
;* D Data packet (requires an A, B, or C back)
;* E EOF packet (requires an A, B, or C back)
;* F File init packet (requires an A, B, or C back)
;*
;* The proper packet format is:
;* [SOP] [CODE] [COUNT] [D1] [D2] .. [Dn] [CHK] [EOP]
;* Where
;* SOP == the start of the packet (ascii ctrl A)
;* CODE == the type of packet A through F
;* COUNT == the number of the packet 0 through maxpxt-n
;* D1..Dn == pieces of data
;* CHK == seven bit chksum
;* EOP == end of packet (ascii ctrl B)
;*
;* The count and the chksum are constrained to be seven bits, from
;* 0 to 177. To avoid problems with ascii codes 0 to 37, these values
;* are translated to the values 240 to 277. The count is added to the
;* chksum before this translation takes place, and the chksum includes
;* all bytes after the SOP.
;*
;* In data packets values 0 to 2 and 200 to 202 are are quoted with a
;* quote byte ("\") before the byte and an octal 40 is added to the
;* byte itself. A sequence "\\" gives "\".
;*
;*
.page
;Symbols and storage
$namdef ;Define the name block
$ttdef ;Define terminal character
$prvdef ;Define the privilege bits
$jpidef ;Define job/process information
$iodef ;Define the output information
$rmsdef ;Define the rms fields
.library /Macrolib/ ;[W5] Library required
true == 0
false == 1
siz7 == false
siz8 == true
logging == true ;[W5]
.psect data,noexe,wrt,rd,pic,usr,con,noshr,rel,lcl
outfab: $fab fop = nam,-
nam = innam,- ;pointer to the name block
fna = inbox,- ;where to store the incoming file
fns = infs,- ;the size of the dir
fac = <put>- ;write enabled
mrs = blksiz,- ;maximum record size
rat = cr,- ;use crlf
rfm = var,- ;fixed length records
fop = sup ;superceed existing files
outrab: $rab fab = outfab,- ;output file info
bkt = 0,- ;use the nbp
rbf = recb ;record buffer
outnam: $nam rsa = rstr1,- ;result buffer address
rss = nam$c_maxrss,- ;result buffer size
esa = estr1,- ;expanded buffer address
ess = nam$c_maxrss ;expanded buffer size
infab: $fab fop = nam,-
nam = outnam,- ;pointer to the name block
fna = outbox,- ;parse the wild card dir
fns = outfs,- ;the size of the wild card dir
fac = <get,bio>,- ;read access,block i/o
mrs = blksiz,- ;maximum record size
rat = cr,- ;use crlf
rfm = var ;variable length records
inrab: $rab bkt = 0,- ;start at the begining of file
fab = infab,- ;input file info
ubf = buffer,- ;input buffer address
usz = blksiz ;buffer size = maxpkt size
innam: $nam rsa = rstr2,- ;result buffer address
rss = nam$c_maxrss,- ;result buffer size
esa = estr2,- ;expanded buffer address
ess = nam$c_maxrss ;expanded buffer size
.if equal logging ;[W5]
logfab: $fab fop = cif,- ;[W5] open if there else create
fna = logbox,- ;[W5] the file name
fns = logfs,- ;[W5] the size of the file name
fac = put,- ;[W5] read access
mrs = blksiz,- ;[W5] maximum record size
rat = cr,- ;[W5] use crlf
shr = <get,put,upd>,- ;[W5] share the file
rfm = var ;[W5] variable length records
lograb: $rab rop = <eof,nlk,rrl>,- ;[W5] start at the end of the file
fab = logfab,- ;[W5] log file info
rbf = logbuf,- ;[W5] log buffer address
usz = blksiz ;[W5] buffer size = maxpkt size
logbox: .ascii /DUA0:<SYS0.GCS>KLAMIT.LOG/ ;[W5] klamit log file
logfs =.-logbox ;[W5]
.endc ;[W5]
outbox: .ascii /DUA0:<SYS0.GCS.TO.WESLYN.KLA>*.*.*/ ;[W5] parse the outbox
outfs =.-outbox
inbox: .ascii /DUA0:<SYS0.GCS.TO>/ ;[W5] store incoming files
infs =.-inbox
mail20: .ascii /MAIL20.MAI/ ;mail from the 20
mail =.-mail20
ether: .ascii /ETHERNET.MAI/
mether =.-ether
mailvax:.ascii /[--QUEUED-MAIL--].NEW-SPECIAL/
vmail =.-mailvax
estr1: .blkb nam$c_maxrss ;expanded string buffer
rstr1: .blkb nam$c_maxrss ;result string buffer
estr2: .blkb nam$c_maxrss ;expanded string buffer
rstr2: .blkb nam$c_maxrss ;result string buffer
recsz == 1 ;maximum size of a record
delay == ^d90 ;90 seconds for incomming sof
dsend == ^d60 ;60 seconds detween outgoing eof
dwait == ^d20 ;20 seconds for a data wait
maxpkt == ^d100 ;Maximum packet size
blksiz == ^d512 ;size of a disk block
maxsnd == maxpkt/2-6 ;Maximum send size
maxnak == ^d12 ;Maximum naks before aborting
cr == ^d13 ;cr to terminate line
lf == ^d10 ;lf to terminate line
ctrlv == ^d22 ;control V
bit7 == ^d7 ;send seven bit bytes
bit8 == ^d8 ;send eight bit bytes
period: .ascii /./ ;period
quote == ^a"\" ;Quote character
bell == ^d7 ;Bell
.if equal siz7
bsiz == bit7
.print ;Byte size is set to seven bits.
.endc
.if equal siz8
bsiz == bit8
.print ;Byte size is set to eight bits.
.endc
.if equal logging ;[W5]
.print ;Logging is turned on.
.endc ;[W5]
.if not_equal logging ;[W5]
.print ;Logging is turned off.
.endc ;[W5]
fnam: .blkb 50
fsiz: .blkl 1
recb: .blkb ^d514 ;output record buffer
bbuff: .blkb 2 ;overflow buffer
buffer: .blkb ^d514 ;input buffer = 1 disk page
bufadd: .blkl 1 ;storage for the buffer address
recadd: .blkl 1 ;storage for the buffer address
logbuf: .blkb ^d512 ;[W5]
oddev: .blkb 1 ;odd even flag
pktnum: .blkb 1 ;storage for the packet number
linsiz: .blkw 1 ;storage for the char in a line
chksum: .blkb 1 ;Storage for the checksum
numack: .blkb 1 ;storage for logging acks
numnak: .blkb 1 ;storage for logging naks
nakcnt: .blkb 1 ;storage for the nak counter
f.ieof: .blkb 1 ;storage for the eof flag
sop == 1 ;start of packet
eop == 2 ;end of packet
ack == 1 ;Begin "A" offset
nak == 2 ;nak the packet
can == 3 ;Cancel or abort transaction
dat == 4 ;Data packet
eof == 5 ;End of file
sof == 6 ;Start of file
maxerr == ^d6 ;[W5] maximum level of errors
level1 == ^d1 ;[W5] error level 1
level2 == ^d2 ;[W5] error level 2
level3 == ^d3 ;[W5] error level 3
level4 == ^d4 ;[W5] error level 4
level5 == ^d5 ;[W5] error level 5
level6 == ^d6 ;[W5] error level 6
text: .word 12 ;[W5] text descriptor
.byte dsc$k_dtype_t ;[W5]
.byte dsc$k_class_s ;[W5]
.address txtout ;[W5]
txtout: .blkb 12 ;[W5]
binlen: .word 0 ;[W5]
binary: .word 4 ;[W5] Binary descriptor
.byte dsc$k_dtype_l ;[W5]
.byte dsc$k_class_s ;[W5]
.address binin ;[W5]
binin: .blkb 4 ;[W5]
timsys: .blkq 1 ;[W5] system time
time: .long 23 ;[W5] descriptor for time
.address timbuf ;[W5]
timbuf: .blkb 23 ;[W5]
items: .word 12 ;Item list for $getjpi
.word jpi$_curpriv ;Get the current priv's
.address prcinf ;Store the returned values here
.address prcsiz ;Store the returned buffer size
.long 0 ;End of item list
prcinf: .blkb 12 ;Storage for the returned items
prcsiz: .blkl 1 ;Storage for the buffer size
code: .blkb 1 ;code for the packet number
prvmsk: .long <0> ;Mask of privileges
.long <1@prv$v_oper>
eopmsk: .long <0> ;Mask of the eop for qio read
.long <4>
cty: .ascid /_opa0:/ ;[W5] Name of the tty to use
cchan: .blkw 1 ;[W5] Storage for port channel
port: .ascid /_tta4:/ ;Name of the tty to use
pbuf: .blkb 2 ;Port buffer
pchan: .blkw 1 ;Storage for the port channel
piosb: .blkw 1 ;Storage for the port status
piolen: .blkw 1 ;PIOSB is a quadword containing
.blkl 1 ;31 count 16,15 status 0
;62 device dependent info 32
pdesc: .blkl 1 ;tty char buffer (class,type,width)
pdesc1: .blkl 1 ; characteristics, length
odesc: .blkl 1 ;save the original desc
ndesc:.long<1@tt$v_eightbit>!<1@tt$v_noecho>!<1@tt$v_notypeahd>!<1@tt$v_passall>
packet: .blkw maxpkt + 1 ;Storage for the packet read in
outpkt: .blkw maxpkt + 1 ;storage for the packet to write
resp1: .ascid /Insufficient privileges to run vaxmit./
login: .ascic /Logging started on: / ;[W5]
msg1: .ascic /Receiving file / ;[W5]
msg2: .ascic /Finished file at / ;[W5]
msg3: .ascic /Sending file / ;[W5]
msg4: .ascic / at / ;[W5]
msg5: .ascic / with / ;[W5]
msg6: .ascic / acks and / ;[W5]
msg7: .ascic /naks/ ;[W5]
msg8: .ascic /.../ ;[W5]
emsg1: .ascic /Unable to create file klamit.log/ ;[W5]
emsg2: .ascic /Error writting to file klamit.log/ ;[W5]
emsg3: .ascic /Unable to close file klamit.log/ ;[W5]
emsg4: .ascic ?Can't open the I/O port.? ;[W5]
emsg5: .ascic /Received data packet without init/ ;[W5]
emsg6: .ascic /Received EOF packet without init/ ;[W5]
emsg7: .ascic /Received inadaquately sized data packet/ ;[W5]
emsg8: .ascic /Unable to open incomming file/ ;[W5]
emsg9: .ascic /Received incorrect packet/ ;[W5]
emsg10: .ascic /Skipped an incomming packet before EOF received/ ;[W5]
emsg11: .ascic /Unable to close incomming file/ ;[W5]
emsg12: .ascic /Sent or received too many naks/ ;[W5]
emsg13: .ascic /Received a CAN while expecting data packet/ ;[W5]
emsg14: .ascic /Received a SOF while expecting data packet/ ;[W5]
emsg15: .ascic /Received CAN after sending SOF packet/ ;[W5]
emsg16: .ascic /Received data after sending SOF packet/;[W5]
emsg17: .ascic /Received EOF after sending SOF packet/ ;[W5]
emsg18: .ascic /Received SOF after sending SOF packet/ ;[W5]
emsg19: .ascic /Received CAN after sending data packet/;[W5]
emsg20: .ascic /Received data after sending data packet/;[W5]
emsg21: .ascic /Received EOF after sending data packet/ ;[W5]
emsg22: .ascic /Received SOF after sending data packet/ ;[W5]
.page
.subtitle main body
.psect code,exe,nowrt
.entry vaxmit,^m<>
gpriv: $getjpi_s itmlst=items ;Get this process's privs
bbs prvmsk,prcinf,priv ;Check for the priv
pushal resp1 ;Say that we dont have the priv
calls #1,g^lib$put_output ;Send the text to the TTY
jmp exit ;And exit the program
priv: ;We have the privileges now get the TTY to be used for transfer
$assign_s devnam=port,chan=pchan ;Assign TTY for vaxmit transfer
check_rms severity=#level2,ermsg=emsg4 ;exit on error
$qiow_s chan=pchan,- ;Get the tty characteristics
func=#io$_sensemode,-
p1=pdesc ;description of the character
check_rms severity=#level2,ermsg=emsg4 ;exit on error
movl pdesc1,odesc ;save the old description
bisl2 ndesc,pdesc1 ;and it with the old
$qiow_s chan=pchan,- ;Modify the terminal for the
func=#io$_setmode,- ;programs duration
p1=pdesc ;description of the character
check_rms severity=#level2,ermsg=emsg4 ;exit on error
.if equal logging
logini: $create fab=logfab ;[W5] create/open the log file
blbc r0,10$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
10$: $connect rab=lograb ;[W5] connect so we can do i/o
blbc r0,20$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
20$: moval login,r1 ;[W5] get the address of login
movzbw (r1)+,r2 ;[W5] get the size of login
movw r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),logbuf ;[W5] write the init message
addw2 time,lograb+rab$w_rsz ;[W5] add time size to record
$gettim_s timsys ;[W5] get time in system format
$asctim_s timbuf = time,- ;[W5] then convert it to ascii
timadr = timsys ;[W5]
movc3 time,timbuf,(r3) ;[W5] tack it on to the string
$put rab=lograb ;[W5] init this session
blbc r0,30$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
30$: clrw lograb+rab$w_rsz ;[W5] send a blank line
$put rab=lograb ;[W5] init this session
blbc r0,40$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
40$: $close fab = logfab ;[W5] close the file
99$:
.endc ;[W5]
Main: bsbw getpkt ;Wait for incomming packet
bsbw chkfil ;Check for incomming files
jmp main ;Repeat forever
.page
.subtitle Getpkt - Check for incomming packets
;First level of processing -- wait for incomming characters for up to five
;minutes before returning.
getpkt: movzbl #delay,r1 ;wait for incomming
bsbw inpack ;input a packet
jmp @l^disp1(r7) ;dispatch to proper routine
disp1: .address r ;invalid packet
.address p.can ;ack packet
.address p.can ;nak packet
.address r ;cancel (abort transfer)
.address diser1 ;data packet
.address diser2 ;end of packet
.address p.sof ;start of file
r: rsb ;dummy routine just return
.page
.subtitle Inpack - routine to check and validate incomming packets
;We check type, contents, and checksum before returning a valid packet code.
;Packets are returned in "packet", code in r7, count in r8.
;Registers used internally are:
; R7 contains the packet code.
; R8 contains the packet size.
; R9 is used internally for checksum.
; R10 is used as a byte pointer.
; R11 is used as temp storage and testing.
; R12 is used as temp storage for the packet code.
inpack: clrb r7 ;Clear the packet code
clrb r9 ;and also the checksum
$qiow_s chan=pchan,- ;Read a packet from the port
iosb=piosb,- ;Save the status and count
func=#io$_readvblk!io$m_timed,- ;Read function,purge line and time
p1=packet,- ;Store what is read at packet
p2=#maxpkt,- ;Read up to the maximum size
p3=r1,- ;Timeout after waiting
p4=#eopmsk ;End read if eop
;ignore errors
10$: movzwl piolen,r8 ;Put the packet size in r8
;analyze the line read in
tstw piolen ;Did we read any characters?
bneq 20$ ;If yes continue processing
clrl r7 ;If no, Zero the jump register
rsb ;and return
20$: moval packet,r5 ;get the address of packet
addb2 piolen,r5 ;get the packet length
movb #eop,r5 ;Put an eop at end of packet
moval packet,r10 ;Get the packet start into r10
moval packet,r1 ;[W3] reset the packet to start
;Find a sop character
inpk.a: movb (r10)+,r11 ;get a character
cmpb r11,#eop ;end of packet?
bneq 10$ ;Yes, quit
clrl r7 ;If no, Zero the jump register
rsb
10$: cmpb r11,#sop ;Start of packet?
bneq inpk.a ;Nope, keep looking
movb r11,(r1)+ ;[W3] start packet at packet
;Here we have a packet start. Get the code character
movb (r10)+,r11 ;get a character
movb r11,r9 ;copy into the checksum
subb2 #^d64,r11 ;make it into an offset
tstb r11 ;return if too low
bgtr 20$ ;return
clrl r7 ;If no, Zero the jump register
rsb
20$: movb r11,r12 ;save the packet code for later
cmpb r11,#sof ;or if too high
bleq 30$ ;return
clrl r7 ;If no, Zero the jump register
rsb
30$: movb r11,(r1)+ ;[W3] store the code
;Get the count of the remaining characters.
movb (r10)+,r11 ;get count of remaining chars
cmpb #^d160,r11 ;remove the offset added
bgtru 60$ ;so that nulls could
subb2 #^d160,r11 ;be transfered
60$: tstb r11 ;check for too small a packet
bgtr 70$ ;too small return
clrl r7 ;If no, Zero the jump register
rsb
70$: cmpb r11,#maxpkt ;check for too large
bleq 80$ ;too large return
clrl r7 ;If no, Zero the jump register
rsb
80$: movb r11,r8 ;save the count in r8 for later
addb2 r11,r9 ;add into the checksum (r9)
movb r11,(r1)+ ;[W3] store the char count
;Loop checksumming the data.
inpk.b: decb r11 ;bump the packet count down
tstb r11 ;is that all of the data
blss inpk.c ;if so, check the checksum
movb (r10)+,r2 ;get a data character
addb2 r2,r9 ;add it in to the checksum
movb r2,(r1)+ ;[W3] store the characters
jmp inpk.b ;and loop
;Now check the checksum.
inpk.c: mcomb #^d127,r1 ;complement the parity
bicb2 r1,r9 ;reduce to seven bits
cmpb #^d32,r9 ;is it printable
bleq 10$ ;so that nulls could
addb2 #^d160,r9 ;not printable make it
10$: movb (r10)+,r11 ;get the checksum
cmpb r11,r9 ;do they match
beql 20$ ;no reject packet, return
clrl r7 ;If no, Zero the jump register
rsb
20$: movb r11,(r1)+ ;[W3] store the chksum
;Finally, the EOP character should follow.
movb (r10)+,r11 ;get the last character
cmpb r11,#eop ;is it an eop
beql 30$ ;no, so reject the packet
clrl r7 ;If no, Zero the jump register
rsb
30$: movb r11,(r1)+ ;[W3] finally the eop
movzbl r12,r7 ;return the packet code (r7)
mulb2 #4,r7 ;each address uses 4 bytes
rsb ;and return success
.page
.subtitle Ack, Nak, and Can routines.
;Register 1 is used as temp storage.
;Register 7 is used for the packet code.
;Register 8 is used for the character count
p.ack: incb numack ;increment the ack count
movb #^a/A/,r7 ;packet code
p.all: movb #1,r8 ;specify the char count
jsb pinit ;initialize the packet
movb code,(r10)+ ;flag the code
addb2 code,chksum ;add the code to checksum
movb chksum,r11 ;get the checksum
mcomb #^d127,r2 ;complement to make it seven bit
bicb2 r2,r11 ;set the bits
cmpb #^d32,r11 ;is it printable
blequ 10$ ;if not add in an offset
addb2 #^d160,r11 ;not printable make it so
10$: movb r11,(r10)+ ;store it in the string
movb #eop,(r10)+ ;store the eop in the string
jsb outsnd ;send the packet
rsb ;and return
;Nak routine -- called as a response to anything you don't understand
p.nak: incb numnak ;[W5] increment the nak counter
movb #^a/B/,r7 ;nak packet code
jmp p.all ;send the packet
;Cancel routine -- Called to send an abort packet across the line.
p.can1: $close fab=infab ;error close the file and
jmp p.can ;cancel and goto main
p.can2: $close fab=outfab ;error close the file and
;cancel and goto main
p.can: movb #^a/C/,r7 ;Can packet code
jsb p.all ;send the packet
rsb
.page
.subtitle Packet control routines.
;Pinit routine -- prepare an outgoing packet.
;Leaves Register 10 set up as a byte pointer.
pinit: moval outpkt,r10 ;point to the packet area
movb #sop,(r10)+ ;insert a start of packet
movb r7,(r10)+ ;insert the packet code
movb r7,chksum ;start the checksum
addb2 r8,chksum ;add the data count
movb r8,r1 ;get the character count
cmpb #^d32,r1 ;is it printable
bleq 10$ ;if not make it so
addb2 #^d160,r1 ;make it printable
10$: movb r1,(r10)+ ;insert it into the packet
rsb ;done, return
;Outsnd routine -- send the packet.
outsnd: movb outpkt+2,r8 ;get the size of the packet into
cmpb #^d160,r8 ;remove the offset added
bgtru 10$ ;so that nulls could
subb2 #^d160,r8 ;be transfered
10$: addb2 #5,r8 ;add the coding info
moval outpkt,r10 ;Set up a pointer to outpkt
20$: movb (r10)+,pbuf ;move a character into a buffer
$qiow_s chan=pchan,- ;Write a packet to the port
iosb=piosb,- ;Save the status and count
func=#io$_writelblk!io$m_noformat,- ;Write function
p1=pbuf,- ;Send the character
p2=#1 ;Write one character
;ignore errors
decb r8 ;bump the counter down
tstb r8 ;Is that the whole packet?
bneq 20$ ;If not get another character
rsb ;If no return
.page
.subtitle File receiving routine
;This routine is called for a start of file packet. Open the file with
;the proper name and then wait for a data packet.
p.sof: movc3 #infs,inbox,fnam ;put the files in inbox
movb #infs,fsiz ;add the dir name size
movzbl packet+2,r8 ;[W2] get the packet size
cmpb #^d160,r8 ;has the offset been added
bgtru 1$ ;if not skip
subb2 #^d160,r8 ;subbtract the offset
1$: decl r8 ;[W2] minus the byte size
;[W4] move clrb r10 down
moval packet+4,r7 ;[W2] get address of the name
matchc #^d1,period,r8,(r7) ;check for a file extension
tstb r0 ;[W2] did we find an extension?
beql 5$ ;[W2] if not set extension to 0
clrb r2 ;[W2] no extension found
5$: movzbl r2,r7 ;get the extension size
movl r3,r9 ;save the exten address
subl3 r7,r8,r6 ;total size - ext size = nam sz
decl r6 ;without the period
20$: moval packet+4,r1 ;[W2] get address of the name
moval fnam+infs,r2 ;get the address where to put
cmpb #ctrlv,(r1) ;[W2] ctrl V means its 20 mail
beql m20 ;use mail20.mai as name else...
tstl r6 ;[W2] do we have a file name?
beql 35$ ;[W2] if not just add the ext
clrb r10 ;[W4] use r10 for size counter
30$: movb (r1)+,r3 ;get a character
bsbw insert ;insert it if printable
cmpb #^d8,r10 ;[W2] max of 8 ch in name
beql 35$ ;[W2] if at max skip rest
sobgtr r6,30$ ;get the next character
35$: addb2 r10,fsiz ;[W4] add the name size
movb period,(r2)+ ;insert the period
addb2 #1,fsiz ;[W4] one for the period
tstl r7 ;do we have an ext
beql noext ;if not skip
clrb r10 ;[W4] use r10 for size counter
40$: movb (r9)+,r3 ;get an ext char if any
bsbw insert ;insert it if printable
cmpb #^d3,r10 ;[W2] [W4] hit max of 3 ch ext?
beql noext ;[W2] if at max skip rest
sobgtr r7,40$ ;get the next char
noext: addb2 r10,fsiz ;add the ext size
jmp gotname ;and continue
m20: movc3 #mail,mail20,fnam+infs ;this is mail from the 20
addb2 #mail,fsiz ;so convert it to mail.20.mai
gotname:
moval fnam,outfab+fab$l_fna ;deposit the file name
movb fsiz,outfab+fab$b_fns ;deposit the file name size
.if equal logging
log.1: $create fab=logfab ;[W5] create/open the log file
blbc r0,10$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
10$: $connect rab=lograb ;[W5] connect so we can do i/o
blbc r0,20$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
20$: moval msg1,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
movw r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),logbuf ;[W5] write the init message
addb2 fsiz,lograb+rab$w_rsz ;[W5] size of filename
movzbw fsiz,r1
movc3 r1,fnam,(r3) ;[W5] tack on the filename
moval msg4,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
addw2 time,lograb+rab$w_rsz ;[W5] add time size to record
$gettim_s timsys ;[W5] get time in system format
$asctim_s timbuf = time,- ;[W5] then convert it to ascii
timadr = timsys ;[W5]
movc3 time,timbuf,(r3) ;[W5] tack it on to the string
moval msg8,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
$put rab=lograb ;[W5] write the message
blbc r0,30$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
30$: $close fab = logfab ;[W5] close the file
99$:
loge.1:
.endc ;[W5]
$create fab=outfab ;create a file using rms
check_rms severity=#level5,ermsg=emsg8 ;exit on error
$connect rab=outrab ;connect so i/o can be done
check_rms severity=#level5,ermsg=emsg8 ;exit on error
moval recb,recadd ;reset the output buffer point
clrw outrab+rab$w_rsz ;reset the data counter
clrb numack ;reset the ack's
clrb numnak ;and nak's
movb #^a/F/,code ;flag a sof
bsbw p.ack ;send a response
clrb pktnum ;reset the packet number
jmp datpak ;and get the first packet
;;**;; [W1] Rewrite the entire insert routine.
insert: cmpb #^d48,r3 ;[W1] is it below a zero
bgtr 10$ ;[W1] if so its not printable
cmpb #^d57,r3 ;[W1] is it 9 or less
bgeq 5$ ;[W1] if 9 or less printable
cmpb #^d65,r3 ;[W1] is it below an A
bgtr 10$ ;[W1] if so its not printable
cmpb #^d90,r3 ;[W1] is it a Z or less
bgeq 5$ ;[W1] if so its printable
cmpb #^d97,r3 ;[W1] is it below an a
bgtr 10$ ;[W1] if so its not printable
cmpb #^d122,r3 ;[W1] is it above a z
blss 10$ ;[W1] if so its not printable
5$: movb r3,(r2)+ ;[W1] insert the character
incb r10 ;[W1] up the name count
10$: rsb ;[W1] and return
.page
.subtitle Incoming data packet handling
datpak: movb #maxnak,nakcnt ;reset the max nak counter
datp.a: decb nakcnt ;nak bump the counter
tstb nakcnt ;have we gotten to maxnak?
bneq 10$ ;if not skip
jmp nakout ;yes so abort the file
10$: movzbl #dwait,r1 ;wait for the packet
bsbw inpack ;no so get another packet
jmp @L^disp2(r7) ;dispatch on the answer
disp2: .address datp.e ;illegal send a nak
.address datp.e ;send a nak
.address datp.e ;send a nak
.address diser3 ;received a can from 20
.address datp.b ;data packet
.address datp.d ;end of file packet
.address diser4 ;received a sof expecting data
;Good response, process the incoming data
datp.b: movb packet+3,r1 ;pick up the packet number
movb r1,code ;store it as the ack/nak code
cmpb #^d160,r1 ;has the offset been added
bgtru 10$ ;if not skip
subb2 #^d160,r1 ;subbtract the offset
10$: movb pktnum,r2 ;get the expected packet number
cmpb r1,r2 ;is it what we got?
bgequ 20$ ;if not just ack it
jmp datpc1 ;packet is obsolete ack it
20$: bgtru 30$ ;is it too large this time?
jmp dtp.b1 ;no process the packet
30$: tstb r2 ;catch the packet wrap around
bnequ 40$ ;if zero start cnt again else cancel
jmp datpc1 ;start count again
40$: jmp p.can2 ;cancel this exchange
;Right packet number output the contents
;Register 2 is used for temp storage and data manipulation
;Register 8 holds the character count
;Register 10 is used for temp storage and data manipulation
;Register 11 is used for a packet pointer
dtp.b1: decb r8 ;get the packet count
movl recadd,r9 ;set up the output buffer point
moval packet+4,r10 ;set up the pointer to the data
incb pktnum ;bump the packet count
movb pktnum,r2 ;move the count into r2
mcomb #^d127,r11 ;convert the packet count 7 bit
bicb2 r11,r2
movb r2,pktnum ;and save it
datp.c: decb r8 ;bump the counter down
tstb r8 ;and see if its the end of data
bgeq 10$ ;skip if its not the end
jmp datpc2 ;it is the end of the data
10$: movb (r10)+,r11 ;it was not the end, get a byte
cmpb r11,#quote ;is it a quote character
bneq 20$ ;if not skip
movb (r10)+,r11 ;it was so convert the next ch
subb2 #^d32,r11 ;into a printable character
decb r8 ;and bump the char count down
20$: cmpb #cr,r11 ;is this an line cr
beql datp.c ;get the next character if so
cmpb #lf,r11 ;is it a line ?
beql 30$ ;output the line
movb r11,(r9)+ ;put the character into buffer
incw outrab+rab$w_rsz ;bump up the data counter
cmpw #blksiz,outrab+rab$w_rsz ;is it at a max
beqlu 30$ ;yes output it
incb f.ieof ;set the output flag
jmp datp.c ;and loop
30$:
$put rab=outrab ;write a byte to the file
;ignore errors
clrb f.ieof ;reset the output flag
clrw outrab+rab$w_rsz ;reset the data counter
moval recb,r9 ;reset the output buffer point
jmp datp.c ;it is the end of the data
;Here to ack and get the next
datpc1: incb numnak ;bump the nak count
jmp datpak ;and get the next
datpc2: movl r9,recadd ;save the output address
bsbw p.ack ;ack it
jmp datpak ;and get the next
;end of file and error handling
datp.d: movb packet+3,r11 ;pick up the packet number
movb r11,code ;store it as the ack/nak code
cmpb #^d160,r11 ;has the offset been added
bgtru 10$ ;if not skip
subb2 #^d160,r11 ;subbtract the offset
10$: movb pktnum,r2 ;get the expected packet number
cmpb r11,r2 ;is it what we got?
beql 20$ ;if so skip
clrb r0 ;force error
check_rms severity=#level5,ermsg=emsg10 ;exit on error
jmp p.can2 ;no match abort the file
20$: tstb f.ieof ;did we send the last line?
beql 30$ ;skip if we did
$put rab=outrab ;write a byte to the file using rms
30$: $close fab=outfab ;close the file using rms
check_rms severity=#level5,ermsg=emsg11 ;exit on error
.if equal logging
log.2: $create fab=logfab ;[W5] create/open the log file
blbc r0,10$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
10$: $connect rab=lograb ;[W5] connect so we can do i/o
blbc r0,20$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
20$: moval msg8,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
movw r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),logbuf ;[W5] write the init message
moval msg2,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
addw2 time,lograb+rab$w_rsz ;[W5] add time size to record
$gettim_s timsys ;[W5] get time in system format
$asctim_s timbuf = time,- ;[W5] then convert it to ascii
timadr = timsys ;[W5]
movc3 time,timbuf,(r3) ;[W5] tack it on to the string
moval msg5,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
movb #1,binary ;[W5] size of numack
movb numack,binin ;[W5] the number of acks
pushaw binlen ;[W5] length to output
pushaw text ;[W5] push desc on the stack
pushaw binary ;[W5] push source on the stack
calls #3,g^lib$cvt_dx_dx ;[W5] convert binary to text
addw2 #4,lograb+rab$w_rsz ;[W5] size of record
movc3 #4,txtout,(r3) ;[W5] add the message
moval msg6,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
movb #1,binary ;[W5] size of numack
movb numnak,binin ;[W5] the number of naks
pushaw binlen ;[W5] length to output
pushaw text ;[W5] push desc on the stack
pushaw binary ;[W5] push source on the stack
calls #3,g^lib$cvt_dx_dx ;[W5] convert binary to text
addw2 #4,lograb+rab$w_rsz ;[W5] size of record
movc3 #4,txtout,(r3) ;[W5] add the message
moval msg7,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
$put rab=lograb ;[W5] write the message
blbc r0,30$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
30$: clrw lograb+rab$w_rsz ;[W5] send a blank line
$put rab=lograb ;[W5] init this session
blbc r0,40$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
40$: $close fab = logfab ;[W5] close the file
99$:
loge.2:
.endc ;[W5]
bsbw p.ack ;ack the packet
rsb ;and return form getpkt
;Nak handling
datp.e: bsbw p.nak ;nak it
jmp datp.a ;and try again
;Too many naks
nakout: clrb r0 ;force an error
check_rms severity=#level5,ermsg=emsg12 ;log error
jmp p.can2 ;cancel file transaction
.page
.subtitle Chkfil - Send outgoing files
;Loop looking for files in <KLA> and sending them over the line.
;If the line is inactive, wait here forever, periodically sending S F
;packets, until the other line activates.
chkfil: $parse fab = infab ;parse the input file spec
blbs r0,chk.1 ;if no more return to main
rsb ;return
chk.1: jmp nxtjfn ;get a jfn see if file exists
;here on each file
opnfil: movb #^a/F/,r7 ;send a file init
clrb r8 ;zero the packet count
bsbw pinit ;init a packet
clrw inrab+rab$w_rsz ;get ready to read
clrw linsiz ;clear the line size
clrb numack ;clear the acks
clrb numnak ;and naks
$open fab=infab ;now open the file
blbs r0,opn.1 ;if no more return to main
rsb ;return
opn.1: $connect rab=inrab ;connect so we can do i/o
blbs r0,opn.2 ;if no more return to main
rsb ;return
opn.2:
.if equal logging
log.3: $create fab=logfab ;[W5] create/open the log file
blbc r0,10$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
10$: $connect rab=lograb ;[W5] connect so we can do i/o
blbc r0,20$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
20$: moval msg3,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
movw r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),logbuf ;[W5] write the init message
subb3 #5,infab+fab$b_fns,r1
movzbw r1,r1
addb2 r1,lograb+rab$w_rsz ;[W5] size of filename
movl infab+fab$l_fna,r2
movc3 r1,(r2),(r3) ;[W5] tack on the filename
addb2 fsiz,lograb+rab$w_rsz ;[W5] size of filename
movzbw fsiz,r1
movc3 r1,fnam,(r3) ;[W5] tack on the filename
moval msg4,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
addw2 time,lograb+rab$w_rsz ;[W5] add time size to record
$gettim_s timsys ;[W5] get time in system format
$asctim_s timbuf = time,- ;[W5] then convert it to ascii
timadr = timsys ;[W5]
movc3 time,timbuf,(r3) ;[W5] tack it on to the string
moval msg8,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
$put rab=lograb ;[W5] write the message
blbc r0,30$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
30$: $close fab = logfab ;[W5] close the file
99$:
loge.3:
.endc ;[W5]
cmpc3 #mether,ether,fnam ;is this mail for the 20
bneq 10$ ;if not use the name provided
movw #vmail,r6 ;it was so use mm name format
moval mailvax,r9 ;and filename size
jmp 20$ ;and continue
10$: movzbw fsiz,r6 ;get the filename size
moval fnam,r9 ;point to the file name
20$: moval outpkt+4,r10 ;point to outpacket
;this is where the filename starts
;Loop coping and checksumming the file
chkf.a: movb (r9)+,r11 ;get a character
tstw r6 ;any more characters?
bneq 10$ ;if not we have the name
jmp chkf.b ;we have it
10$: addb2 r11,chksum ;add the char to the checksum
movb r11,(r10)+ ;and insert into the pointer
incb r8 ;increment the packet count
decw r6 ;bump the name counter down
jmp chkf.a ;and loop until we have the name
;done with name.
chkf.b: incb r8 ;increment for the file size
movb chksum,r9 ;get the checksum
addb2 r8,r9 ;add in the data count
addb2 #bsiz,r9 ;add in the size field
mcomb #^d127,r1 ;make the data seven bits
bicb2 r1,r9
cmpb #^d32,r9 ;is the chksum printable
bleq 20$ ;if not make it so, else leave
addb2 #^d160,r9 ;make it printable
20$: movb r9,(r10)+ ;insert chksum into outpacket
movb #eop,(r10)+ ;insert an eop into outpacket
movb r8,outpkt+2 ;insert the char count
movb #bsiz,outpkt+3 ;and the byte size into outpack
movb #-1,pktnum ;start the packet number at -1
clrb f.ieof ;set the eof flag to not eof
;Check response, keep trying forever
filsnd: bsbw outsnd ;send it off
movzbl #dsend,r1 ;wait for a reply
bsbw inpack ;get a reply
jmp @L^disp3(r7) ;dispatch to the reply
disp3: .address filsnd ;garbage try again
.address rspchk ;ack success
.address filsnd ;naked try again
.address diser5 ;recieved a can after sending sof
.address diser6 ;cancel received data after send sof
.address diser7 ;cancel rec eof after sending sof
.address diser8 ;cancel rec sof after sending sof
;Check response to see if it is right
rspchk: movb packet+3,r10 ;get a data item
cmpb r10,#^a/F/ ;is it a file init
bgeq 10$ ;if it is proceed else ask again
jmp filsnd ;it wasn't, so ask again
10$: jmp sndpak ;it was proceed
.page
.subtitle Sndpak - Loop sending data packets
;The file init has been ackknowledged, send the data
sndpak: incb pktnum ;bump up the packet number
mcomb #^d127,r1 ;and make sure it is printable
bicb r1,pktnum
sndpk1: tstw inrab+rab$w_rsz ;see if we have or need data
beql snd.a ;if so read
jmp snd.b4 ;skip reading this time
snd.a: $read rab=inrab ;read a block from the file
blbs r0,10$ ;have we hit the eof?
cmpl r0,#rms$_eof ;if yes set an eof flag
bneq 5$ ;if not a real error abort xfer
movb #-1,f.ieof ;yes set the flag and continue
tstw inrab+rab$w_rsz ;if eof and data continue
bneq 10$ ;if eof + no data send eof pkt
jmp sndp.g ;go send an eof
5$: $close fab=infab ;error close the file and
rsb ;abort transfer
10$: moval bbuff,bufadd ;no store the address of buffer
;We have the text -- process it removing the line size adding cr lf
snd.b: movw inrab+rab$w_rsz,r6 ;loop counter for the data
moval buffer,r9 ;point to the line count
moval bbuff,r10 ;to avoid the crlf problem
tstw linsiz ;check the line size
beql snd.b1 ;didn't end at eol on last read
movzwl linsiz,r5 ;get the last line count
addw2 #2,inrab+rab$w_rsz ;add two for the extra crlf
jmp snd.b2 ;and start with the data
snd.b1: subw2 #2,r6 ;bump down for the line cnt
movzwl (r9)+,r5 ;get the line count
tstw r5 ;is this a blank line?
bneq 10$ ;if yes go add a crlf
clrb oddev ;clear the byte its even
jmp snd.b3 ;and go add the crlf
10$: clrq r3 ;not clear the quad word
movl r5,r3 ;get the count into quad word
clrl r1 ;clear the remainder
clrl r8 ;clear the quotient
movl #2,r8 ;get the divisor
ediv r8,r3,r8,r1 ;does the line have an even or
tstw r1 ;odd number of characters
bneq 20$ ;branch if odd
clrb oddev ;clear the byte its even
jmp snd.b2 ;and continue
20$: incb oddev ;set the byte its odd
snd.b2: tstw r6 ;processed the last line?
beql snd.b35 ;yes send the data, else contin
10$: movb (r9)+,(r10)+ ;else get and store the data
decw r6 ;and bump the inrab count down
sobgtr r5,snd.b2 ;check the line count
snd.b3: movb #cr,(r10)+ ;hit the eol so add a crlf
movb #lf,(r10)+ ;to finish the line
tstw r6 ;is this the end out the data
beql snd.b35 ;if the last data item send it
tstb oddev ;if the last line was even skip
beql 20$ ;else trash the null at the eol
decw inrab+rab$w_rsz ;and bump the inrab count down
decw r6 ;and dont use in final count
beql snd.b35 ;if the last item send it
movb (r9)+,r11 ;trash the null
20$: jmp snd.b1 ;get the next line count
;Ibuff has the correct data now build outpkt
snd.b35:movw r5,linsiz ;save the line size count
tstw r5 ;if r5 is zero we sent the crlf
beql snd.b4 ;so continue else we did not
subw2 #2,inrab+rab$w_rsz ;the crlf so bump for the
;missing crlf
snd.b4: movb #^a/D/,r7 ;get the data packet code
clrb r8 ;zero the packet count
bsbw pinit ;initialize the packet
cmpw #maxsnd,inrab+rab$w_rsz ;is there enough for a maxpkt?
bgtr 5$ ;if so send a maxpkt
movzbl #maxsnd,r6 ;send a maxpkt
subw2 #maxsnd,inrab+rab$w_rsz ;reduce the count for next read
jmp 8$ ;and continue
5$: movzwl inrab+rab$w_rsz,r6 ;no so use what is left
clrw inrab+rab$w_rsz ;zero count (read next time)
8$: movb pktnum,r2 ;get the packet number
cmpb #^d32,r2 ;is the char printable
bleq 10$ ;if so leave it alone else make it so
addb2 #^d160,r2 ;its not printable make it
10$: movb r2,code ;save to check the ack code later
addb2 r2,chksum ;add to the checksum
movb r2,(r10)+ ;insert it into outpacket
movl bufadd,r9 ;use buffer +
;Data loop
sndp.c: movb (r9)+,r11 ;get the char read in
cmpb #quote,r11 ;is it a quote char?
beqlu 20$ ;if it is skip
cmpb #eop,r11 ;is it larger than an eop?
bgequ 20$ ;if it is continue else goto sndpc1
jmp sndpc1 ;it was not a quote or eop
20$: addb2 #quote,chksum ;add a quote into the checksum
movb #quote,(r10)+ ;put a quote char into the packet
addb2 #^d32,r11 ;add the offset
incb r8 ;increment the char count
sndpc1: movb r11,(r10)+ ;store the character
incb r8 ;bump up the char count
addb2 r11,chksum ;add it to the checksum
sobgtr r6,sndp.c ;have we gotten to maxpkt?
movl r9,bufadd ;save the pointer to buffer
;Now do the checksum
sndpc2: incb r8 ;bump up the char count
addb2 r8,chksum ;add the count to the chksum
cmpb #^d32,r8 ;is the char printable
bleq 10$ ;if so leave it alone else make it so
addb2 #^d160,r8 ;make it printable
10$: movb r8,outpkt+2 ;store cnt in outpkt
mcomb #^d127,r1 ;make the count seven bit
bicb r1,chksum
cmpb #^d32,chksum ;is the char printable
bleq 20$ ;if so leave it, else add offset
addb2 #^d160,chksum ;add the offset
20$: movb chksum,(r10)+ ;store the chksum in outpkt
movb #eop,(r10)+ ;end the packet with an eop
;Send the packet
sndp.d: movb #maxnak,nakcnt ;get the max number of naks allowed
jmp snd.e1 ;and try sending the packet
sndp.e: incb numnak ;increment the number of naks
decb nakcnt ;decmrement the nakcnt
bgtr snd.e1 ;and try sending again, if not over allowed naks
jmp nakout ;too many naks abort
snd.e1: bsbw outsnd ;send the packet
movzbl #dwait,r1 ;wait for a reply
bsbw inpack ;get the response
jmp @L^disp4(r7) ;dispatch on the answer
disp4: .address sndp.e ;illegal retry
.address sndp.f ;ack, do the next unless eof
.address sndp.e ;nak, try again
.address diser9 ;received can after sending data
.address p.can1 ;rec data after sending data
.address p.can1 ;rec eof after sending data
.address p.can1 ;rec sof after sending data
rsb: $close fab=infab ;error close the file and
rsb ;goto main
;Here when deciding whether we are done or not.
sndp.f: movb packet+3,r1 ;get the packet code
cmpb r1,code ;if the codes match continue
beql 10$ ;if they don't goto sndp.e
jmp sndp.e ;they didnt match
10$: incb numack ;bump the ack counter
tstw inrab+rab$w_rsz ;do we have more data to send
bneq 15$ ;if so send it, else check eof
tstb f.ieof ;is it the eof?
blss 20$ ;if negative data done send eof
bgtr 30$ ;if positive eof sent close file
15$: jmp sndpak ;if zero send more data
;Send an eof packet
20$: incb pktnum ;increment the packet number
mcomb #^d127,r1 ;and make sure it is printable
bicb r1,pktnum
jmp sndp.g ;send an eof packet
;Now close and delete the file
30$: $close fab=infab ;close the file using rms
$erase fab=infab ;and delete the file
.if equal logging
log.4: $create fab=logfab ;[W5] create/open the log file
blbc r0,10$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
10$: $connect rab=lograb ;[W5] connect so we can do i/o
blbc r0,20$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
20$: moval msg8,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
movw r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),logbuf ;[W5] write the init message
moval msg2,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
addw2 time,lograb+rab$w_rsz ;[W5] add time size to record
$gettim_s timsys ;[W5] get time in system format
$asctim_s timbuf = time,- ;[W5] then convert it to ascii
timadr = timsys ;[W5]
movc3 time,timbuf,(r3) ;[W5] tack it on to the string
moval msg5,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
movb #1,binary ;[W5] size of numack
movb numack,binin ;[W5] the number of acks
pushaw binlen ;[W5] length to output
pushaw text ;[W5] push desc on the stack
pushaw binary ;[W5] push source on the stack
calls #3,g^lib$cvt_dx_dx ;[W5] convert binary to text
addw2 #4,lograb+rab$w_rsz ;[W5] size of record
movc3 #4,txtout,(r3) ;[W5] add the message
moval msg6,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
movb #1,binary ;[W5] size of numack
movb numnak,binin ;[W5] the number of naks
pushaw binlen ;[W5] length to output
pushaw text ;[W5] push desc on the stack
pushaw binary ;[W5] push source on the stack
calls #3,g^lib$cvt_dx_dx ;[W5] convert binary to text
addw2 #4,lograb+rab$w_rsz ;[W5] size of record
movc3 #4,txtout,(r3) ;[W5] add the message
moval msg7,r1 ;[W5] get the address of msg
movzbw (r1)+,r2 ;[W5] get the size of msg
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r1),(r3) ;[W5] add the message
$put rab=lograb ;[W5] write the message
blbc r0,30$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
30$: clrw lograb+rab$w_rsz ;[W5] send a blank line
$put rab=lograb ;[W5] init this session
blbc r0,40$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
40$: $close fab = logfab ;[W5] close the file
99$:
loge.4:
.endc ;[W5]
jmp nxtjfn ;get the next file
;Here when the file is done.
sndp.g: movb #^a/E/,r7 ;signal eof
movb #1,r8 ;one data item
bsbw pinit ;init packet
movb pktnum,r1 ;get the packet number
mcomb #^d127,r2 ;complement to make it seven bit
bicb2 r2,r1 ;set the bits
cmpb #^d32,r1 ;is it printable
bleq 10$ ;if not add in an offset
addb2 #^d160,r1 ;not printable make it so
10$: movb r1,code ;store it in the code
addb2 r1,chksum ;add it to the checksum
movb r1,(r10)+ ;store the code
movb chksum,r1
mcomb #^d127,r2 ;complement to make it seven bit
bicb2 r2,r1 ;set the bits
cmpb #^d32,r1 ;is it printable
bleq 20$ ;if not add in an offset
addb2 #^d160,r1 ;not printable make it so
20$: movb r1,(r10)+ ;store the checksum
movb #eop,(r10)+ ;finish with an eop
movb #1,f.ieof ;set the eof flag
jmp sndp.d
;nxtjfn -- get the next file in the wildcard group
nxtjfn: $search fab = infab ;Find a file
blbs r0,nxt.1 ;if no more return to main
rsb ;return
nxt.1: clrb fsiz ;start with no size
movzbw outnam+nam$b_name,fsiz ;get the filename length
movl outnam+nam$l_name,r5 ;get the filename
movc3 fsiz,(r5),fnam ;store the filename
movzbl outnam+nam$b_type,r6 ;get the filetype length
movl outnam+nam$l_type,r5 ;get the file type
moval fnam,r2
addw2 fsiz,r2
movc3 r6,(r5),(r2) ;store the filename
addb2 r6,fsiz ;add the file type length
jmp opnfil ;process this file
.page
.subtitle Error Handling
;Error routines.
;
; Explaination: This routine is a proceedural call. Two variables
;are passed to this proceedure, an error sererity level, and the address
;of an error message.
;
; Error severity level:
; 1 severe (crash program and send message to cty)
; 2 (crash/restart up to maxcrash times then send cty msg)
; 3 (attempt to recover error if can't goto level 2)
; 4 moderate (send message to cty)
; 5 (log error)
; 6 informational (continue)
;
; Error message:
; The error message is written to the server.log file or the cty
; depending on the severty of the error.
;
error:: caseb r6,#1,#maxerr ;from one to maxerr
5$: .word 10$-5$ ;severity level 1
.word 15$-5$ ;severity level 2
.word 20$-5$ ;severity level 3
.word 25$-5$ ;severity level 4
.word 30$-5$ ;severity level 5
.word 35$-5$ ;severity level 6
10$: bsbw ctymsg ;send message to cty
jmp exit ;and crash
15$: jmp 10$ ;not yet implemented
20$: jmp 15$ ;not yet implemented
25$: bsbw ctymsg ;send message to cty
rsb ;and continue on
30$: bsbw logmsg ;log the error
rsb ;and continue on
35$: rsb ;and continue on
;Here to log a message
logmsg: ;[W5]
.if equal logging
log.5: $create fab=logfab ;[W5] create/open the log file
blbc r0,10$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
10$: $connect rab=lograb ;[W5] connect so we can do i/o
blbc r0,20$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
20$: movzbw (r7)+,r2 ;[W5] get the size of message
addw2 r2,lograb+rab$w_rsz ;[W5] size of record
movc3 r2,(r7),logbuf ;[W5] write the message
$put rab=lograb ;[W5] write the message
blbc r0,30$ ;[W5] jmp on error
jmp 99$ ;[W5] don't log
30$: $close fab = logfab ;[W5] close the file
99$:
loge.5:
.endc ;[W5]
rsb ;[W5] and return
;Here to send a message to the CTY.
ctymsg: $assign_s devnam=cty,- ;[W5] Assign CTY
chan=cchan ;[W5]
blbs r0,10$ ;[W5] Check for a success
jmp exit ;[W5] Not success, exit
10$: movzbw (r7)+,r8 ;[W5] size of the message
moval logbuf,r1 ;[W5] get a buffer
movb #cr,(r1)+ ;[W5] a carriage ret
movb #lf,(r1)+ ;[W5] a line feed
movb #bell,(r1)+ ;[W5] a bell
movc3 r8,(r7),(r1) ;[W5] the message
addw2 #3,r8 ;[W5]
$qiow_s chan=pchan,- ;[W5] Write a packet to the cty
func=#io$_writelblk,- ;[W5] Write function
p1=logbuf,- ;[W5] address of the message
p2=r8 ;[W5] size of the message
rsb
;The following are dispatch errors. Not "true" errors and therefore
;are handled separately.
diser1: moval emsg5,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can ;send a CAN
diser2: moval emsg6,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can ;send a CAN
diser3: moval emsg13,r7 ;get the error message
bsbw logmsg ;send it
rsb ;return to main loop
diser4: moval emsg14,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can2 ;send a CAN/close output file
diser5: moval emsg15,r7 ;get the error message
bsbw logmsg ;send it
rsb ;return to main loop
diser6: moval emsg16,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can1 ;send a CAN/close input file
diser7: moval emsg17,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can1 ;send a CAN/close input file
diser8: moval emsg18,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can1 ;send a CAN/close input file
diser9: moval emsg19,r7 ;get the error message
bsbw logmsg ;send it
rsb ;return to main loop
diser10:moval emsg20,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can1 ;send a CAN/close input file
diser11:moval emsg21,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can1 ;send a CAN/close input file
diser12:moval emsg22,r7 ;get the error message
bsbw logmsg ;send it
jmp p.can1 ;send a CAN/close input file
;Here on a fatal error.
exit: $exit_s r0 ;End this program
.end vaxmit