minnie.tuhs.org

home *** CD-ROM | disk | FTP | other *** search

/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Tools / Serial / kserve.mac < prev next >

Wrap

Text File | 1998-03-16 | 56.7 KB | 2,493 lines

.title KSERVE .enabl lc ;++ ; ; Kermit console server. ; ; Allows KERMIT communication with a microcomputer ; connected in place of the CTY (TT:). ; ; By John Wilson. ; ; 23-Oct-88 Created. ; 04-Dec-90 Added directory command. ; 10-Dec-90 Receive (from us) command. ; 24-Jan-92 Generate attribute packets. ; ;-- .mcall .close,.dstat,.exit,.fetch,.print .mcall .purge,.releas,.ttinr,.ttyout,.wait ; eis$$= 1 ;NZ => processor has EIS rt11$$= 1 ;NZ => OS is RT-11 ; soh= 1 ;SOH character is ^A binlin= 0 ;NZ => we have an 8-bit line ;Z => 7-bit line, will need QBIN escape ; bufsiz= 4000 ;buffer size, in bytes ; .enter= emt+375 .lookup=emt+375 .rctrlo=emt+355 .read= emt+375 .readw= emt+375 .write= emt+375 ; .asect .= 44 .word 50000 ;set LC, noecho bits in JSW .psect ; attr= 10 ;CAPAS bit for attribute packets ; lf= 12 cr= 15 ; start: ; gentlemen, start your engines! mov #<^RDK >,defdev ;initial default device clrb binfil ;not binary files ; init packet parameters movb #cr,eol ;init eol clrb npad ;no pads movb #77.,maxl ;MAXL=80. (-header/checksum) loop: clrb seq ;always packet 0 in command wait mov #1,lchk ;check type is 1 until SEND-INIT mov #chk1,checka call getpac ;get a packet bcc 10$ ;handle it call nak ;NAK it br loop ;loop 10$: movb r1,seq ;accept whatever they think we're at mov #cmds,r2 ;pt at table mov #ncmds,r3 ;# entries 20$: cmp r0,(r2)+ ;is this it? beq 30$ ;yes tst (r2)+ ;no, skip addr sob r3,20$ ;loop movb r0,pnsc ;save char mov #pns,r0 ;pt at string call err ;send error br loop ;loop 30$: call @(r2)+ ;go br loop ;loop ; cmds: .word 'G,genric ;GENERIC .word 'I,init ;INITIALIZE .word 'K,kcmd ;KERMIT command .word 'R,send ;RECEIVE-INIT .word 'S,receiv ;SEND-INIT ncmds= <.-cmds>/4 .sbttl generic commands ;+ ; ; Generic commands (actual command in data field). ; ;- genric: ; unpack data field mov #buf1,bufptr ;set up ptr mov #80.,bufctr ;let's be reasonable jsr r1,iunpk ;unpack .word secrts ;don't flush bcs 10$ ;error mov #buf1,r5 ;init ptr mov bufptr,r4 ;calc length sub r5,r4 beq 20$ ;0, who cares movb (r5)+,r0 ;get command byte dec r4 ;count it mov #gcmds,r2 ;pt at list mov #ngcmds,r3 ;number of entries 10$: cmp r0,(r2)+ ;is this it? beq 30$ ;yes tst (r2)+ ;skip address sob r3,10$ ;loop movb r0,cnsc ;save char mov #cns,r0 ;pt at string jmp err ;send error, return 20$: ; null packet jmp ack ;just ack it, ignore, return 30$: jmp @(r2)+ ;dispatch ; gcmds: .word 'C,cwd .word 'D,direct .word 'F,finish .word 'L,logout .word 'U,usage ngcmds= <.-gcmds>/4 ;+ ; ; Change working directory. ; ; For RT-11 V4.0 this will just mean set default device, ; since I don't know anything about the subdisks in V5. ; ;- cwd: tst r4 ;any data field? beq 20$ ;no mov #buf1,bufptr ;set up ptr mov #80.,bufctr ;good length jsr r1,iunpk ;unpack .word secrts ;don't flush bcs 40$ ;error ; parse it mov #buf1,r5 ;ptr movb (r5)+,r4 ;get 2nd length byte sub #40,r4 ;unchar() beq 20$ ;length byte is 0, skip add r5,r4 ;skip to end clrb (r4) ;.asciz call rad50 ;parse tst r0 ;end? beq 10$ ;yes cmp r0,#': ;must be colon bne 40$ ;no tstb (r5) ;followed by end? bne 40$ ;no 10$: ; see if it's a valid dev name mov r1,fbuf ;save dev name .dstat #dstat,#fbuf ;see if it's OK bcs 40$ ;nope mov fbuf,defdev ;it's the new default br 30$ ;skip 20$: mov #<^RDK >,defdev ;set it back to DK: 30$: ; echo back the name mov #ddev,r5 ;pt at string mov #ddev1,r4 ;pt at dev name mov defdev,r1 ;get name call r50nbl ;convert it movb #':,(r4)+ ;colon movb #cr,(r4)+ ;crlf movb #lf,(r4)+ sub r5,r4 call ldatn ;make data field call ldatf ;fix r4, r5 jmp ack1 ;ack, return 40$: mov #bdn,r0 ;bad device name jmp err ;+ ; ; Directory listing. ; ;- direct: movb #1,dirall ;assume we're showing everything clrb dirnon ;actually show it mov defdev,wlddev ;default device tst r4 ;filespec given? beq 40$ ;no ; unpack data field mov #buf1,bufptr ;set up ptr mov #80.,bufctr ;let's be reasonable jsr r1,iunpk ;unpack .word secrts ;don't flush bcs 10$ ;error ; parse it mov #buf1,r5 ;ptr movb (r5)+,r4 ;get 2nd length byte sub #40,r4 ;unchar() beq 40$ ;length byte is 0, skip add r5,r4 ;skip to end clrb (r4) ;.asciz, r4 is NZ for PWILD call pwild ;parse wildcard bcc 30$ ;skip if OK 10$: ; invalid mov #bfs,r0 ;bad file spec jmp err ;send error packet, return 20$: rts pc 30$: clrb dirall ;we're matching some wildcard 40$: ; do the SEND-INIT thing call iparms ;init parms call sparms ;prepare ours mov #'S,r0 ;SEND-INIT call makpac ;make a packet call sndack ;send it, get ACK bcs 20$ ;punt call rparms ;get their parms call fparms ;finish up ; send a blank text header mov #'X,r0 ;type call sndsmp ;send it bcs 20$ ;error ; set up for dir read call dirini ;init dir read bcs 120$ ;err, punt mov #txbuf+3,-(sp) ;init LDAT parms movb maxl,r0 mov r0,-(sp) 50$: ; process next segment call dirseg ;get next seg bcs 110$ ;err or end 60$: ; display next file mov #buf2,r4 ;output line buf mov (r5)+,r1 ;convert first word beq 50$ ;end of seg, get next call r50 mov (r5)+,r1 ;2nd word call r50 movb #'.,(r4)+ ;point mov (r5)+,r1 ;extension call r50 mov #10,r3 ;column counter add r3,r4 ;skip past end of field mov (r5)+,r1 ;get length of file mov #10.,r2 ;radix 70$: clr r0 ;0-extend div r2,r0 ;divide bis #'0,r1 ;convert remainder movb r1,-(r4) ;save dec r3 ;count it mov r0,r1 ;copy bne 70$ ;loop if there's more 80$: movb #' ,-(r4) ;pad with blanks sob r3,80$ ;loop add #10,r4 ;skip to end of field mov (r5)+,r3 ;get date beq 100$ ;meaningless, never mind movb #' ,(r4)+ ;2 more blanks movb #' ,(r4)+ mov r3,r1 ;copy date ash #-5,r1 ;right 5 bic #^C37,r1 ;isolate low 5 call dec2 ;day as 2-dig decimal mov r3,r1 ;save swab r3 ;put month in low byte bic #^C74,r3 ;isolate month*4 add #months-4,r3 ;index to -Month- mov #5,r0 ;count 90$: movb (r3)+,(r4)+ ;copy a byte sob r0,90$ ;loop bic #^C37,r1 ;isolate year add #72.,r1 ;what's so special about 1972? cmp r1,#100. ;they should have just kept blo .+6 ;the last 2 digs of year (7 bits) sub #100.,r1 ;handle 2000+ AD (ha!) call dec2 ;convert 100$: movb #cr,(r4)+ ;crlf movb #lf,(r4)+ ; send this line to the toy computer mov (sp)+,r2 ;restore LDAT parms mov (sp)+,r1 mov r5,-(sp) ;save dir ptr mov #buf2,r5 ;begn of line sub r5,r4 ;length call sdat ;send data mov (sp)+,r5 ;[restore r5] bcs 220$ ;punt mov r1,-(sp) ;save mov r2,-(sp) br 60$ ;loop 110$: ; end or error beq 130$ ;end, skip add #4,sp ;flush stack 120$: mov #ioerr,r0 ;pt at msg jmp err ;bitch, return 130$: ; end of listing call dirsum ;get dir summary ; send summary to the toy computer mov (sp)+,r2 ;restore LDAT parms mov (sp)+,r1 call sdat ;send data bcs 210$ ;punt mov #txbuf+3,r5 ;pt at buf mov r1,r4 ;copy end sub r5,r4 ;find it beq 200$ ;none mov #'D,r0 ;packet type call makpac ;make it call sndack ;send, get ACK bcs 210$ ;punt 200$: mov #'Z,r0 ;end of file call sndsmp bcs 210$ ;punt mov #'B,r0 ;break call sndsmp ;(don't worry about errors) 210$: rts pc 220$: ; retry limit reached, punt .close #0 ;close dir rts pc ; .enabl lsb 10$: ; flush output buffer mov r5,-(sp) ;save buf posn mov r4,-(sp) mov #txbuf+3,r5 ;pt at buf mov r1,r4 ;copy end sub r5,r4 ;find it mov #'D,r0 ;packet type call makpac ;make a packet call sndack ;send it, get ACK bcs 20$ ;failed, skip mov (sp)+,r4 ;restore mov (sp)+,r5 mov #txbuf+3,r1 ;reinit movb maxl,r2 sdat: call ldat ;continue loading bcs 10$ ;full again, loop 20$: rts pc .dsabl lsb ; dec2: ; number in r1 to convert 2-digit decimal clr r0 ;0-extend div #10.,r0 ;divide bis #'0,r0 ;convert high dig movb r0,(r4)+ bis #'0,r1 ;convert low dig movb r1,(r4)+ rts pc ; decv: ; convert variable-width decimal no. in r1 cmp r1,#10. ;do we need to recurse? blo 10$ ;no clr r0 ;0-extend div #10.,r0 ;divide mov r1,-(sp) ;save remainder mov r0,r1 ;copy quotient call decv ;recurse mov (sp)+,r1 ;restore remainder 10$: bis #'0,r1 ;convert movb r1,(r4)+ ;save rts pc ;+ ; ; Convert a radix-50 word to a 3-character ASCII string. ; ; r1 word ; r4 buffer ptr ; ;- r50: clr r0 ;0-extend div #50,r0 ;divide mov r1,r2 ;save remainder mov r0,r1 ;copy clr r0 ;0-extend div #50,r0 ;divide movb r50t(r0),(r4)+ ;first char movb r50t(r1),(r4)+ ;second movb r50t(r2),(r4)+ ;third rts pc ;+ ; ; Finish/logout. ; ; ACK and kill the server. ; ;- finish: logout: call ack ;ACK it .exit ;bye ;+ ; ; Disk usage. ; ;- usage: mov defdev,wlddev ;copy dev name movb #1,dirall ;look at all files movb #1,dirnon ;but don't bother making a list call dirini ;init dir I/O bcs 20$ ;err 10$: call dirseg ;scan next segment bcc 10$ ;loop until all done bne 20$ ;err call dirsum ;make dir summary ; send to toy computer call ldatn ;load data field call ldatf ;fix for ACK1 jmp ack1 ;ACK, return 20$: ; I/O error mov #ioerr,r0 ;point jmp err ;bitch, return ;+ ; ; Make a summary of a directory scan. ; ; On return: ; r5 ptr to line (#buf2) ; r4 length ; ;- dirsum: mov #buf2,r4 ;pt at buf2 ; display # of files mov files,r1 ;print # files call decv mov #tfile,r0 ;string 10$: movb (r0)+,(r4)+ ;copy bne 10$ dec r4 dec files ;files=1? beq 20$ ;yes movb #'s,(r4)+ ;s 20$: ; display # of blks used movb #',,(r4)+ ;, movb #' ,(r4)+ mov used,r1 ;print # blks in use call decv mov #tblk,r0 ;string 30$: movb (r0)+,(r4)+ ;copy bne 30$ dec r4 dec used ;used=1? beq 40$ ;yes movb #'s,(r4)+ ;s 40$: movb (r0)+,(r4)+ ;copy " in use" bne 40$ dec r4 tstb dirall ;showing frees too? beq 60$ ;no ; display # of free blks movb #',,(r4)+ ;, movb #' ,(r4)+ mov free,r1 ;print # free blks call decv mov #tfree,r0 ;string 50$: movb (r0)+,(r4)+ ;copy bne 50$ dec r4 60$: movb #cr,(r4)+ ;crlf movb #lf,(r4)+ mov #buf2,r5 ;begn of line sub r5,r4 ;length rts pc ; .sbttl initialize parameters ;+ ; ; Takes parms as usual, responds with ours. ; ;- init: call iparms ;init parm negotiation call rparms ;process the ones we got call sparms ;set up the ones to send call ack1 ;send them jmp fparms ;finish up, return .sbttl kermit command ;+ ; ; Handle what would normally be keyboard commands. ; ;- kcmd: mov #buf1,bufptr ;set up ptr mov #132.,bufctr ;good length clrb buf1 ;start with nothing tst r4 ;is that all there is? beq 10$ ;yep jsr r1,iunpk ;unpack .word secrts ;don't flush bcs 20$ ;error clrb @bufptr ;zap end 10$: mov #buf1,r5 ;ptr mov #cmdtab,r4 ;pt at table call parskw ;look up keyword bcs what ;error jmp ack ;null, just ACK 20$: mov #toolng,r0 ;pt at msg jmp err ;punt, return ;+ ; ; Echo back the keyword we didn't understand. ; ;- what: bcc 20$ ;keyword was just missing mov #buf1,r5 ;pt at buf mov r5,r4 ;copy 10$: movb (r3)+,(r4)+ ;copy keyword sob r2,10$ movb #'?,(r4)+ ;huh? movb #'?,(r4)+ movb #cr,(r4)+ ;eol movb #lf,(r4)+ sub r5,r4 ;find length call ldatn ;make a packet call ldatf ;get length mov #'E,r0 ;packet type call makpac ;make packet jmp putpac ;send it 20$: mov #mkw,r0 ;missing keyword jmp err ; cmdtab: .asciz <2>/SET/<0> .word set ; .asciz <2>/SHOW/ ; .word show .word 0 ;+ ; ; Set stuff. ; ;- set: mov #settab,r4 ;pt at table call parskw ;parse a keyword br what ;complain ; settab: .asciz <1>/FILE/ .word setfil .word 0 ;+ ; ; Set file. ; ;- setfil: mov #stftab,r4 ;pt at table call parskw ;parse a keyword br what ;complain ; stftab: .asciz <1>/TYPE/ .word stftyp .word 0 ;+ ; ; Set file type. ; ;- stftyp: mov #ftptab,r4 ;pt at table call parskw ;parse a keyword br what ;complain ; ftptab: .asciz <1>/BINARY/ .word setbin .asciz <1>/TEXT/ .word settxt .word 0 ;+ ; ; Set file type binary. ; ;- setbin: movb #377,binfil ;yep jsr r5,reply ;reply .asciz /Binary mode set. All bytes will be transferred./<cr><lf> .even ;+ ; ; Set file type text. ; ;- settxt: clrb binfil ;yep jsr r5,reply ;reply .asciz /Text mode set. Trailing nulls will be stripped./<cr><lf> .even ;+ ; ; Send a reply. ; ; Called through r5 with in-line .asciz string. ; ;- reply: tst (sp)+ ;lose old r5 mov r5,r4 ;copy 10$: tstb (r4)+ ;count bne 10$ dec r4 ;back up sub r5,r4 ;find length call ldatn ;build data field call ldatf ;set up r4, r5 jmp ack1 ;send reply, return ;+ ; ; Parse a keyword and dispatch on it. ; ; r5 ptr to current posn in .asciz string ; r4 ptr to dispatch table ; ; If the keyword is OK, we flush the return addr and ; jump to the routine. Otherwise we return C=1. ; We return C=0 if there was nothing left on the line. ; ;- parskw: movb (r5)+,r0 ;get next char beq 100$ ;eol cmp r0,#<' > ;blank or cc? blos parskw ;yes, ignore 10$: dec r5 ;back up mov r5,r3 ;copy 20$: movb (r5)+,r0 ;get next char beq 30$ ;eol cmp r0,#<' > ;blank or cc? blos 30$ ;yes cmp r0,#'a ;lower case? blo 20$ ;no cmp r0,#'z bhi 20$ bic #40,r0 ;convert movb r0,-1(r5) br 20$ 30$: dec r5 ;back up mov r5,r2 ;copy sub r3,r2 ;find length 40$: ; search dispatch table for string movb (r4)+,r0 ;get min length to match beq 90$ ;end of list cmpb r2,r0 ;long enough to match? blo 80$ ;no, skip mov r3,r1 ;copy addr mov r2,r0 ;and len 50$: cmpb (r1)+,(r4)+ ;same? bne 70$ ;no sob r0,50$ ;loop 60$: tstb (r4)+ ;skip to end of string bne 60$ ;loop inc r4 ;round to even bic #1,r4 tst (sp)+ ;toss return addr jmp @(r4)+ ;dispatch 70$: dec r4 ;might have been end of string 80$: tstb (r4)+ ;skip to end bne 80$ ;loop add #3,r4 ;+2, round to even bic #1,r4 br 40$ ;loop 90$: sec ;invalid rts pc 100$: clc ;eol rts pc .sbttl receive a file ;+ ; ; Receive a file from the toy computer. ; ;- receiv: call iparms ;init parm negotiation call rparms ;process theirs call sparms ;prepare ours call ack1 ;send them call fparms ;finish up 10$: ; start next file call getpac ;get a packet bcc 20$ ;got it ;;;;; heuristic: ; if we just ACKed with our parameters, and changed CHKT to ; something other than '1, see if this packet would seem good ; if it were a SEND-INIT with CHKT=1. if so, re-ACK with CHKT=1. ;;; we'll have to make sure GETPAC actually read a whole ;;; packet and that the checksum was the only problem. call nak ;nope br 10$ ;loop 20$: cmpb r1,seq ;current packet? bne 30$ ;no, must be previous cmp r0,#'F ;FILE-HEADER? beq 50$ ;yes cmp r0,#'B ;BREAK? bne 40$ ;no, skip jmp ack ;ACK it and return to loop 30$: call reack ;re-ACK br 10$ ;try again 40$: ; protocol violation movb r0,pvlc ;save char mov #pvl,r0 ;pt at string jmp err ;error packet 50$: ; starting a new file mov #buf1,bufptr ;set up for unpacking mov #bufsiz-1,bufctr ;allow for ^@ at end jsr r1,iunpk ;unpack .word secrts ;don't flush clrb @bufptr ;mark end mov #buf1,r5 ;pt at filename call file ;parse filename, get handler bcc 60$ ;skip mov #bfs,r0 ;bad filespec jmp err ;bitch, return 60$: ; set up for file output mov #buf2,wca ;set core addr mov #bufsiz/2,wwc ;word count clr wblk ;init blk # mov #buf1,cbuf ;current buf mov #buf1,bufptr ;pointer mov #bufsiz,bufctr ;and free count ; return the file name we're using mov #buf2,r4 ;output line buf mov #fbuf,r5 mov (r5)+,r1 ;dev: call r50nbl movb #':,(r4)+ mov (r5)+,r1 ;filename call r50nbl mov (r5)+,r1 call r50nbl movb #'.,(r4)+ ;. mov (r5)+,r1 ;ext call r50nbl mov #buf2,r5 ;pt sub r5,r4 ;find length call ldatn ;encode call ldatf ;fix for ACK1 call ack1 ;ACK, give filename 70$: ; slurp attribute packet(s) call getpac ;get a packet bcs 80$ cmpb r1,seq ;is this curr pkt? bne 90$ ;no, must be previous cmp r0,#'A ;attribute packet? bne 100$ ;no ; handle attributes ;;;;;;;;;;; call ack ;ACK br 70$ 80$: call nak ;NAK it br 70$ ;try again 90$: call reack ;re-ACK previous pkt br 70$ 100$: ; not 'A packet, open file mov r0,-(sp) ;save call ldev ;make sure we have the dev handler bcs 120$ ;shouldn't happen mov #earea,r0 ;point at it .enter ;open the file mov (sp)+,r0 ;[restore] bcs 110$ ;error clr -(sp) ;initial flags mov #1,-(sp) ;initial repeat count br 150$ ;groovy, go see if it was 'D or 'Z 110$: mov #ucf,r0 ;unable to create file br 130$ 120$: mov #bdn,r0 ;bad device name 130$: jmp err ;bitch, return 140$: ; read (another) data packet call getpac ;get a packet bcs 160$ ;bad, skip cmpb r1,seq ;is this curr pkt? bne 170$ ;no, must be previous 150$: cmp r0,#'D ;data? beq 180$ cmp r0,#'Z ;eof? beq 190$ mov r0,r1 ;save .purge #1 ;reset the file add #4,sp ;flush stack cmp r0,#'E ;error packet? beq .+6 jmp 40$ ;no, protocol violation rts pc ;gracefully punt 160$: ; bad checksum or timeout call nak ;nak it br 140$ ;more 170$: ; they resent the previous packet call reack ;re-ACK previous packet br 140$ ;more 180$: ; data packet mov r4,-(sp) ;save length & ptr mov r5,-(sp) call ack ;ACK the packet mov (sp)+,r5 ;restore mov (sp)+,r4 beq 140$ ;length=0, ignore mov (sp)+,r3 ;restore flags mov (sp)+,r2 jsr r1,unpack ;unpack packet .word wrbuf ;flush routine bcs 220$ ;flush error mov r2,-(sp) ;save flags mov r3,-(sp) br 140$ ;get next packet 190$: ; eof, flush buffer and close file tst r4 ;is there a data field in the Z packet? beq .+4 movb (r5),r4 ;get 1st char mov r4,-(sp) ;save call ack ;ACK the ^Z mov (sp)+,r4 ;restore mov #bufsiz,r0 ;find # bytes in buf sub bufctr,r0 beq 200$ ;none, skip inc r0 ;round up asr r0 ;/2=wc mov r0,wwc ;save clrb @bufptr ;zap odd byte, if any (at least 1 byte free) mov cbuf,wca ;core addr .wait #1 ;finish previous mov #warea,r0 ;EMT area .write ;write last buffer bcs 210$ ;error 200$: add #4,sp ;purge stack cmp r4,#'D ;delete the file? bne 230$ ;no ; Z/D, delete the file (user aborted or something) .purge #1 ;purge the file jmp 10$ ;start next 210$: ; error writing file add #4,sp ;flush stack 220$: .purge #1 ;purge the file mov #werr,r0 ;pt at string jmp err ;send, return 230$: ; keep the file .close #1 ;close the file ;;; now's the time to apply 'A packets and set the date etc. jmp 10$ ;start next ; wrbuf: ; flush buffer .wait #1 ;wait for previous transfer mov wca,r0 ;get previous buf addr mov cbuf,wca ;reset to current mov r0,cbuf ;prev is now current mov r0,bufptr ;set ptr mov #bufsiz,bufctr ;and counter mov #warea,r0 ;queue a write .write bcs 10$ ;just punt if C=1 add #bufsiz/1000,wblk ;update blk #, C=0 10$: rts pc ; secrts: ; dummy flush routine for IUNPK/UNPACK sec ;flush failed rts pc .sbttl send file(s) ;+ ; ; Send file(s) to the toy computer. ; ;- send: tst r4 ;filespec given? beq 20$ ;no ; unpack data field mov #buf1,bufptr ;set up ptr mov #80.,bufctr ;let's be reasonable jsr r1,iunpk ;unpack .word secrts ;don't flush bcs 10$ ;error ; parse it clrb @bufptr ;zap end mov #buf1,r5 ;pt at string clr r4 ;no weird defaults call pwild ;parse wildcard bcc 20$ ;skip if OK 10$: ; invalid mov #bfs,r0 ;bad file spec jmp err ;send error packet, return 20$: ; set up for dir lookup clrb dirall ;we aren't showing everything clrb dirnon ;but give me the filenames ;;; don't bother with any of this if it's a char device call dirini ;get psyched bcs 60$ ;error opening dev ; make sure at least 1 match exists 30$: call dirseg ;get next segment bcs 40$ ;error tst (r5) ;anything? beq 30$ ;no, try next seg br 80$ ;OK, skip 40$: bne 60$ ;I/O err ; file not found tstb wldflg ;were we in a wildcard search? beq 50$ ;no mov #nomtch,r0 ;no matches found br 70$ 50$: mov #fnf,r0 ;file not found br 70$ 60$: ; I/O error mov #ioerr,r0 70$: jmp err ;later 80$: ; do the SEND-INIT thing mov r5,-(sp) ;save file ptr call iparms ;init parms call sparms ;prepare ours mov #'S,r0 ;SEND-INIT call makpac ;make a packet call sndack ;send it, get ACK bcs 130$ ;punt call rparms ;get their parms call fparms ;finish up mov (sp)+,r5 ;recover r5 br 100$ ;go send first file 90$: ; handle next dir segment call dirseg ;get next bcc 100$ ;OK bne 60$ ;I/O error mov #'B,r0 ;break transmission jmp sndsmp ;tell them, return (ignore err) 100$: ; handle next file mov #fbuf+2,r3 ;.LOOKUP buf mov #buf2,r4 ;output line buf mov (r5)+,r1 ;convert first word beq 90$ ;end of seg, get next mov r1,(r3)+ ;save in fbuf call r50nbl mov (r5)+,r1 ;2nd word mov r1,(r3)+ call r50nbl movb #'.,(r4)+ ;point mov (r5)+,r1 ;extension mov r1,(r3) call r50nbl mov r5,-(sp) ;save r5 mov #buf2,r5 ;pt sub r5,r4 ;find length ; open the file mov #larea,r0 ;pt at area ;;; mov #wlddev,2(r0) ;;;;;;; open the whole device .lookup ;try to open file for input bcs 120$ ;guess not ; OK, send FILE-HEADER packet call ldatn ;go call ldatf ;fix mov #'F,r0 ;FILE-HEADER call makpac ;make packet call sndack ;send it bcs 130$ ;punt ; should we send file attributes? ;; br 110$ ;;; no attributes when sending whole device ;;; is it a char dev? ;;; b<yes> 110$ ;don't send attr pack bitb #attr,capas ;sending attribute packets? bne 140$ ;yes 110$: add #4,(sp) ;no, skip size and date br 160$ ;go send file 120$: ; .LOOKUP error mov #uof,r0 ;unable to open file tst (sp)+ ;flush r5 jmp err ;later 130$: ; retry limit reached, punt quietly tst (sp)+ ;lose dir tab ptr rts pc ;timed out 140$: ; send ATTRIBUTE packet mov (sp),r5 ;get ptr ; size in K mov #txbuf+3,r4 ;init ptr, skip size movb #'!,(r4)+ ;length inc r4 ;skip length of length mov (r5)+,r1 ;get file size add #1,r1 ;round up, C=0 (or 1 if 200000) ror r1 ;(blks+1)/2 = K bytes call decv ;convert (r4=txbuf+3+2) mov r4,r0 ;copy sub #txbuf+3+2-40,r0 ;find char(width of field) movb r0,txbuf+3+1 ;poke it back ; date of creation mov (r5)+,r3 ;get date beq 150$ ;no date, don't send any movb #'#,(r4)+ ;date [& time - RT doesn't save times] movb #8.+40,(r4)+ ;length=8. mov r3,r1 ;copy date bic #^C37,r1 ;isolate year mov r3,r0 ;copy again (include RT V5 32s bit) ash #-10.,r0 ;shift b15 to b5 bic #^C40,r0 ;isolate bis r0,r1 ;OR it in add #1972.,r1 ;origin is 1972 call decv ;convert it (will always be 4 digits) mov r3,r1 ;copy date again ash #-10.,r1 ;right 10. bic #^C17,r1 ;isolate month call dec2 ;convert mov r3,r1 ;copy yet again ash #-5,r1 ;right 5 bic #^C37,r1 ;isolate day call dec2 ;convert 150$: ; machine/OS movb #'.,(r4)+ ;machine/OS movb #2+40,(r4)+ ;length=2 movb #'D,(r4)+ ;DEC .iif ne rt11$$, movb #'B,(r4)+ ;PDP-11/RT-11 ; send it mov r5,(sp) ;update mov #txbuf+3,r5 ;pt at begn sub r5,r4 ;length mov #'A,r0 ;type call makpac ;build the packet call sndack ;send it bcs 130$ ;punt ; skip this file if they refused it tst r4 ;OK? beq 160$ ;yep cmpb (r5),#'Y ;OK? bne 260$ ;no, do next file 160$: ; read initial bufferload clr rblk ;start at begn mov #bufsiz/2,rwc ;initial wc mov #buf1,rca ;initial buf mov #buf2,cbuf ;next buf mov #rarea,r0 ;read begn of file .read ;do it bcc 170$ ;skip if OK tst r0 ;err=read from EOF? beq 250$ ;yes, null file, send ^Z ;;; br 230$ ;;;;;; don't care if whole dev br 230$ ;no, I/O error 170$: mov r0,rlen ;so we know what to expect mov #txbuf+3,r1 ;for LDAT movb maxl,r2 180$: ; swap buffers mov rlen,r4 ;get # words expected beq 240$ ;eof, skip asl r4 ;# bytes .wait #1 ;wait for next buffer to fill mov rca,r5 ;pt at this buf mov cbuf,rca ;old curr buf will be next buf mov r5,cbuf ;next buf is now curr buf add #bufsiz/1000,rblk ;update blk # mov #rarea,r0 ;start next buffer reading .read ;do it bcc 190$ ;OK tst r0 ;rd from eof? ;;;;; sending whole dev, don't care ;; clr r0 ;;;;;; bne 230$ ;no, I/O error ;;;; 190$: mov r0,rlen ;# words expected tstb binfil ;binary file? bne 210$ ;yes ; scan off trailing nulls mov r4,r3 ;copy length add r5,r3 ;pt past end of blk 200$: tstb -(r3) ;back 1 bne 210$ ;skip sob r4,200$ ;loop br 180$ ;all nulls, loop 210$: ; send next buffer call ldat ;convert bcc 180$ ;it fit, loop mov r4,-(sp) ;save input ptr mov r5,-(sp) call ldatf ;get addr, len mov #'D,r0 ;DATA packet call makpac ;build it call sndack ;send it, get ACK (C set) mov (sp)+,r5 ;[restore] mov (sp)+,r4 mov #txbuf+3,r1 ;[init for next packet] movb maxl,r2 bcc 210$ ;(C set by SNDACK) around for more 220$: ; too many retries .close #1 ;close file tst (sp)+ ;lose r5 rts pc 230$: ; read error .close #1 ;close tst (sp)+ ;lose r5 mov #rerr,r0 ;err msg jmp err 240$: ; end of file, flush last packet call ldatf ;get addr, len tst r4 ;anything? beq 250$ ;no mov #'D,r0 ;DATA packet call makpac ;build it call sndack ;send it, get ACK bcs 220$ ;oh well nice try 250$: ; send END-OF-FILE mov #'Z,r0 ;send END-OF-FILE call sndsmp bcs 220$ ;oh sure, NOW you wuss out 260$: .close #1 ;close the file mov (sp)+,r5 ;restore ptr jmp 100$ ;handle next file .sbttl file-related routines ;+ ; ; Partially parse a wildcard and prepare for wildcard search. ; ; R5 ptr to .asciz string. ; R4 NZ => default filename/ext to * if missing, ; Z => each is blank if missing, ; *but* if the filename.ext is blank (except possibly ; for a device) then we write nothing either way. ; ; Return WLDDEV and WILD set up, device loaded (name at FBUF). ; C=1 wildcard contained invalid characters or bad format ; (two extensions, wildcard in device name, whatever) ; ; WLDFLG (byte) is set to non-zero (actually the # of wildcard chars) ; if the filespec actually is a wildcard. If WLDFLG=0, then it's ; just a filename, parse it with FILE. ; ;- pwild: clr wlddev ;no device yet 10$: mov #wild,r1 ;point at buf clr r2 ;no .'s yet clr r3 ;no wildcard chars either 20$: ; get next char movb (r5)+,r0 ;get a char beq 110$ ;end, skip cmp r0,#<' > ;blank? beq 20$ ;ignore cmp r0,#': ;device name? beq 90$ ;yes cmp r0,#'? ;RSTS-style wildcard? beq 70$ ;change to % cmp r0,#'a ;lower case? blo 30$ ;no cmp r0,#'z ;hm? bhi 30$ ;no bic #40,r0 ;yes, convert br 40$ ;we know char is OK 30$: ; make sure char is OK cmp r0,#<' > ;blank? beq 20$ ;yes, ignore cmp r0,#'. ;. is OK, once beq 50$ cmp r0,#'% ;wildcards are OK beq 80$ cmp r0,#'* beq 80$ cmp r0,#'0 ;digits are OK blo 100$ cmp r0,#'9 blos 40$ cmp r0,#'A ;letters are OK blo 100$ cmp r0,#'Z bhi 100$ 40$: movb r0,(r1)+ ;save br 20$ ;loop 50$: ; . tst r2 ;is this the first .? bne 100$ ;no tst r4 ;should we use default filename? beq 60$ ;no cmp r1,#wild ;is there any need? bne 60$ ;no movb #'*,(r1)+ ;yes, save it 60$: inc r2 ;set "." flag br 40$ 70$: ; ? as wildcard (= %) movb #'%,r0 ;replace ? with % 80$: inc r3 ;wildcard br 40$ ;loop 90$: ; device name tst wlddev ;do we have one already? bne 100$ ;yes, error clrb (r1) ;mark end mov r5,-(sp) ;save ptr mov #wild,r5 ;pt at dev name call rad50 ;parse it mov (sp)+,r5 ;restore tst r0 ;stopped on nul? bne 100$ ;no, bad filename mov r1,wlddev ;save bne 10$ ;there was something mov defdev,wlddev ;set default anyway, don't allow ":DEV:" br 10$ ;get filename 100$: sec ;bad filename rts pc 110$: ; end of filespec tst wlddev ;did we ever get a device? bne 120$ ;yes mov defdev,wlddev ;no, use default 120$: ; make sure handler is loaded mov wlddev,fbuf ;copy call ldev ;load it bcs 140$ ;punt on err ; add ".*" to name if we're using default wildcards tst r4 ;should we add ".*" if no ext? beq 130$ ;no tst r2 ;was there an ext? bne 130$ ;yes cmp r1,#wild ;totally null name? beq 130$ ;yes, leave it alone movb #'.,(r1)+ ;.* movb #'*,(r1)+ 130$: movb r3,wldflg ;remember whether it's a wildcard clrb (r1) ;C=0, mark end 140$: rts pc ;+ ; ; Init for directory search. ; ; C=1 on directory open error. ; ;- dirini: clr free ;no free blks yet clr used ;no used blks either clr files ;and no files ; open disk non-file-structured to get dir mov #ludir,r0 ;open the device .lookup ;(non-file-structured) ; The directory should start at block 6, but SSM says that in case ; it's different the correct starting block no. should be read from ; the word at offset 724 in the home block (block 1). ; But, if the volume was initialized under RSTS/E by the FIT utility ; (like my SY:), this field is set to ASCII blanks. ; So, I'll hard code to block 6. Sorry. ; DIR.SAV 4.0 can read my SY: so it seems that it doesn't worry about ; home+724 either. mov #1,segnxt ;next seg will be #1 rts pc ;+ ; ; Process next segment of directory. ; ; On return: ; C=0 OK, MATLST contains 0-terminated list of files ; C=1 Z=1 no more dir segments (dir has been closed) ; C=1 Z=0 dir read error ; ; r5 pts to all the matches we found in this segment. ; There are up to 72. entries (the max possible # of file entries in a ; segment) of the following format: ; .rad50 /filnamext/ ; .word size, date ; ; If DIRALL (byte) .ne.0, all files are copied (no wildcard comparison is ; performed), and empty blocks are copied as ; ".EMPTY." with no date. ; ; If DIRNON (byte) .ne.0, no files are copied. This is used to compute disk ; usage without bothering to copy all the filenames all over the place. ; ;- dirseg: mov segnxt,r0 ;get segment to read beq 110$ ;none, skip call getseg ;get it bcs 100$ mov #matlst,-(sp) ;pt at match list 10$: ; process next directory entry mov (r5)+,r0 ;get status word bit #4000,r0 ;end of segment? bne 90$ bit #1000,r0 ;empty block? bne 80$ bit #2000,r0 ;permanent? beq 60$ ;no tstb dirnon ;showing nothing? bne 50$ tstb dirall ;showing everything? bne 20$ ; check this entry for wildcard match mov r5,-(sp) ;save mov #buf2,r4 ;pt at buf mov (r5)+,r1 ;convert filename call r50nbl mov (r5)+,r1 call r50nbl movb #'.,(r4)+ ;. mov (r5),r1 ;extension call r50nbl clrb (r4) mov #wild,r5 ;pt at pattern mov #buf2,r4 ;test string call match ;match? mov (sp)+,r5 ;[restore] bcs 70$ 20$: ; match, save this entry add 6(r5),used ;count as used inc files ;bump count 30$: mov (sp)+,r4 ;get ptr back mov (r5)+,(r4)+ ;copy filename mov (r5)+,(r4)+ mov (r5)+,(r4)+ ;extension mov (r5)+,(r4)+ ;length tst (r5)+ ;skip tentative file info mov (r5)+,(r4)+ ;get date mov r4,-(sp) ;save 40$: add extbyt,r5 ;skip extra bytes, if any br 10$ ;loop 50$: add 6(r5),used ;count the file's blocks inc files ;count it br 70$ ;skip 60$: add 6(r5),free ;count tentative files as free 70$: ; skip this entry add #14,r5 ;skip br 40$ 80$: ; < UNUSED > block add 6(r5),free ;update # free blks tstb dirall ;showing everything? beq 70$ ;no, skip this mov r5,r0 ;copy mov #<^R.EM>,(r0)+ ;.EMPTY. mov #<^RPTY>,(r0)+ clr (r0) clr 6(r0) ;zap date br 30$ ;go display 90$: ; end of segment mov #matlst,r5 ;pt at match list mov (sp)+,r4 ;restore ptr clr (r4) ;mark end, C=0 rts pc 100$: ; I/O error .close #0 ;close the dir clz ;Z=0 sec ;C=1 rts pc 110$: ; end of dir .close #0 ;close the dir +sec!sez ;C=1, Z=1 (no more segs) rts pc ;+ ; ; Get dir segment in r0. ; ;- getseg: asl r0 ;*2 add #4,r0 ;blks 6,7 are seg 1 mov r0,dirblk ;copy ptr mov #rddir,r0 ;get (next) segment .readw ;read bcs 10$ ;bugged mov buf1+6,extbyt ;no. of extra bytes (FIT uses for RSTS RTSNAM) clr free ;no frees yet (C=0) mov buf1+2,segnxt ;save link to next mov #buf1+12,r5 ;pt at begn of seg 10$: rts pc ;+ ; ; Check for a wildcard match. ; ; % matches exactly one character. ; * matches 0 or more characters. ; ; Wildcards may not span the ".". ; ; r5 .asciz /wildcard/ ; r4 .asciz /name to check/ ; ; C=0 if they matched, C=1 if not. ; ;- match: movb (r5)+,r0 ;get a char beq 20$ ;end of name cmp r0,#'% ;match one char? beq 30$ ;yes cmp r0,#'* ;match 0 or more chars? beq 40$ ;yes cmpb r0,(r4)+ ;same? beq match ;yes 10$: sec ;no rts pc 20$: tstb (r4) ;did both end at once? (C=0) bne 10$ ;no rts pc 30$: ; % match one character movb (r4)+,r0 ;get it beq 10$ ;end cmp r0,#'. ;don't skip to extension bne match br 10$ 40$: ; * match 0 or more characters mov r5,-(sp) ;save mov r4,-(sp) call match ;recurse bcc 50$ ;got it mov (sp)+,r4 ;restore mov (sp)+,r5 movb (r4)+,r0 ;skip a char beq 10$ ;lose cmp r0,#'. ;extension separator? beq 10$ ;yep, don't skip that br 40$ ;recurse 50$: add #4,sp ;flush stack (C=0) rts pc ;+ ; ; Convert a radix-50 word to a 0- to 3-character ASCII string. ; Stop at first blank (all chars to right should be blank too). ; ; r1 word ; r4 buffer ptr ; ;- r50nbl: clr r0 ;0-extend div #50,r0 ;divide mov r1,r2 ;save remainder mov r0,r1 ;copy clr r0 ;0-extend div #50,r0 ;divide movb r50tnb(r0),(r4)+ ;first char beq 10$ ;whoops movb r50tnb(r1),(r4)+ ;second beq 10$ movb r50tnb(r2),(r4)+ ;third beq 10$ rts pc 10$: dec r4 ;back up rts pc ;+ ; ; Parse a filename, save in FBUF. ; ; On entry: ; r5 source pointer ; ; C=1 if filename is bad. ; ;- file: mov #fbuf,r4 ;point at filename area mov defdev,(r4)+ ;set default device clr (r4)+ ;zap file & ext clr (r4)+ clr (r4) sub #4,r4 ;back up to filename ; file or device name first call rad50 ;get it cmp r0,#': ;device? bne 10$ ;no mov r1,-2(r4) ;set it call rad50 ;get filename 10$: mov r1,(r4)+ ;it must be the filename mov r2,(r4)+ cmp r0,#'. ;extension given? bne 20$ ;no call rad50 ;yes, eat it mov r1,(r4) ;save it 20$: ; r0 should be blank, tab or null here cmp r0,#<' > ;blank or ctrl char? bhi 30$ ;no, bugged clc ;OK rts pc 30$: sec ;error return rts pc ;+ ; ; Parse a radix-50 string. ; ; r5 source pointer ; ; On return: ; r0 char we stopped on ; r1 1st 3 chars of string ; r2 2nd 3 chars of string ; r5 points to char in r0 +1 ; ;- rad50: clr r1 ;init buf clr r2 call chr50 ;get a char bcs 20$ ;yow asl r0 ;lookup 1st char mov rad50a(r0),r1 ;get it call chr50 ;get 2nd bcs 20$ ;end of string asl r0 ;lookup 2nd add rad50b(r0),r1 call chr50 ;3rd bcs 20$ add r0,r1 call chr50 ;4th bcs 20$ asl r0 mov rad50a(r0),r2 call chr50 ;5th bcs 20$ asl r0 add rad50b(r0),r2 call chr50 ;6th bcs 20$ add r0,r2 10$: call chr50 ;skip anything left bcc 10$ 20$: rts pc ;+ ; ; Get a char and cvt to radix 50 in r0. ; ; C=1 if we failed, char in r0. ; ;- chr50: movb (r5)+,r0 ;get it cmp r0,#<' > ;blank? beq chr50 ;yes, ignore cmp r0,#'0 ;digit? blo 10$ cmp r0,#'9 blos 20$ cmp r0,#'A ;u.c. letter? blo 10$ cmp r0,#'Z blos 30$ cmp r0,#'a ;l.c. letter? blo 10$ cmp r0,#'z blos 40$ 10$: sec ;error return rts pc 20$: ; digit sub #'0-<^R 0>,r0 ;convert (C=0) rts pc 30$: ; upper case letter sub #'A-<^R A>,r0 ;convert (C=0) rts pc 40$: ; lower case letter sub #'a-<^R A>,r0 ;convert (C=0) rts pc ;+ ; ; Make sure the device at FBUF is loaded. ; ; C=1 if invalid dev. ; ;- ldev: .dstat #dstat,#fbuf ;see if handler is loaded bcs 20$ ;invalid tst dstat+4 ;is it loaded? bne 20$ ;yes (C=0 from TST) ; device is non-resident, load it in tst device ;is there a device already? beq 10$ ;no .releas #device ;yes, release it 10$: .fetch #devhnd,#fbuf ;no, load it (set C) mov fbuf,device ;save device name 20$: rts pc ; .sbttl packet-level routines .rem $ Packet format: +-----------------------------------+ | soh | len | seq | typ | dat | chk | +-----------------------------------+ soh = start-of-header character len = <length of seq through chk inclusive> +40 seq = <sequence number mod 100> +40 typ = type (ascii char) dat = data field (variable length, may be null) chk = 1, 2, or 3 byte checksum or CRC of len through dat inclusive $ ;+ ; ; Init SEND-INIT parms for negotiation. ; ;- iparms: .if ne binlin movb #'Y,mqbin ;QBIN is OK with me but not needed .iff movb #'&,mqbin ;QBIN not OK .endc clrb chkt ;CHKT not decided yet clrb mchkt ;I haven't voted either clrb rept ;no REPT char yet movb #'~,mrept ;I'd like to rts pc ;+ ; ; Finish SEND-INIT parms processing. ; ;- fparms: ; make the CHKT change actually happen movb chkt,r0 ;get check type mov r0,lchk ;save length asl r0 ;*2 mov checks-2(r0),checka ;look up routine to do checks ; fix MAXL to be max data field size movb maxl,r0 ;get MAXL sub #2,r0 ;don't count seq or typ sub lchk,r0 ;or checksum movb r0,maxl ;save rts pc ;+ ; ; Prepare our SEND-INIT parms. ; ; Returns with: ; r5 data field ; r4 length ; ;- sparms: tstb mchkt ;have they specified MCHKT? bne 10$ ;yes movb #'1,mchkt ;no, my default is 1 10$: mov #mparms,r5 ;ptr mov #nmprms,r4 ;length rts pc ;+ ; ; Process SEND-INIT parms received from them. ; ; On entry: ; r5 data field (with space for padding) ; r4 length ; ;- rparms: ; pad with blanks so we'll use defaults as appropriate mov #' ,r1 ;handy constant mov #nparms,r3 ;expected max length sub r4,r3 ;find # missing parms blos 20$ ;they must be a later version add r5,r4 ;pt at end 10$: movb r1,(r4)+ ;pad sob r3,10$ 20$: ; read the parms mov #maxl,r4 ;point at param table ; MAXL=80. movb (r5)+,r0 ;get MAXL sub r1,r0 ;unchar() bne .+6 ;specified mov #80.,r0 ;default movb r0,(r4)+ ; TIME=5 movb (r5)+,r0 ;get TIME sub r1,r0 ;unchar() bne .+6 ;given mov #5,r0 ;def movb r0,(r4)+ ; NPAD=0 movb (r5)+,r0 ;get NPAD sub r1,r0 ;unchar() movb r0,(r4)+ ; PADC=^@ movb (r5)+,r0 ;get char asl r1 ;*2=100 xor r1,r0 ;ctl() movb r0,(r4)+ ; EOL=cr movb (r5)+,r0 ;get char asr r1 ;/2=40 again sub r1,r0 ;unchar() bne .+6 ;given mov #cr,r0 ;default movb r0,(r4)+ ; QCTL=# movb (r5)+,r0 ;get char cmp r0,r1 ;given? (blank?) bne .+6 ;no movb #'#,r0 ;default movb r0,(r4)+ ; QBIN=N movb (r5)+,r0 ;get char .if ne binlin movb #'N,mqbin ;assume they don't want to QBIN .endc cmp r0,r1 ;defaulted? beq 30$ cmp r0,#'Y ;up to us? beq 30$ cmp r0,#'N ;they don't want to? beq 30$ ;(we're screwed if BINLIN=0) movb r0,mqbin ;they want to, remember what br 40$ ;skip 30$: ; our decision, tell them what we've already assumed .if ne binlin clr r0 ;zap QBIN .iff mov #'&,r0 ;we want to use & .endc 40$: movb r0,(r4)+ ; CHKT=1 or what they say if they went first movb (r5)+,r0 ;get it cmp r0,r1 ;default (=1)? beq 50$ ;yes sub #'1,r0 ;find value (0,1,2) cmp r0,#2 ;valid? blos 60$ ;yes 50$: clr r0 ;no 60$: inc r0 ;+1 (1,2,3) movb mchkt,r2 ;have we already voted? bne 70$ ;yes ; they're going first, so their vote wins movb r0,(r4)+ ;save add #'0,r0 ;convert back movb r0,mchkt ;we'll agree br 90$ 70$: ; we already decided, if they agree that's it, otherwise 1 sub #'0,r2 ;convert cmp r0,r2 ;do they agree? beq 80$ ;yes movb #'1,mchkt ;no, we'll use 1 mov #1,r0 80$: movb r0,(r4)+ 90$: ; REPT=none movb (r5)+,r0 ;get their char movb r0,mrept ;I'll agree if I haven't already cmp r0,r1 ;will we do it? bne .+4 ;yes clr r0 ;no movb r0,(r4)+ ; CAPAS=none movb (r5)+,r0 ;get theirs sub r1,r0 ;UNCHAR() movb r0,(r4)+ ;save bits rts pc ;+ ; ; Send error packet. ; ; r0 ptr to .asciz msg ; ;- err: incb seq ;seq +1 bicb #^C77,seq ;isolate low 6 mov r0,r5 ;copy mov r0,r4 ;twice 10$: tstb (r4)+ ;count bne 10$ dec r4 ;-1 sub r5,r4 ;length call ldatn ;load packet call ldatf ;fix for MAKPAC mov #'E,r0 ;type=ERROR call makpac ;make packet jmp putpac ;send it, return ;+ ; ; Send an ACK for the current packet. ; ;- ack: clr r4 ;no data mov #txbuf+3,r5 ;space for header stuff ack1: ; enter with data field at (r5), length in r4 mov #'Y,r0 ;type=ACK call makpac ;make a packet mov r5,ackdat ;save data mov r4,acklen incb seq ;bump seq bicb #^C77,seq ;mod 100 jmp putpac ;send it, return ;+ ; ; Resend ACK for previous packet. ; ;- reack: mov ackdat,r5 ;get ptr mov acklen,r4 ;and length jmp putpac ;send it ;+ ; ; Send a NAK for the current packet. ; ;- nak: mov #'N,r0 ;NAK clr r4 ;no data mov #txbuf+3,r5 ;space for header stuff call makpac ;make a packet jmp putpac ;send it, return ;+ ; ; Load data field. ; ; r5 data to load ; r4 length of data ; r2 length of buffer ; r1 buffer addr ; ; Each code is as follows: ; .byte '~,count+40 ;repeat count if rept.ne.0 ; .byte '& ;8th-bit-quote if b7=1 and qbin.ne.0 ; .byte '# ;ctrl-char-quote if needed ('# is my choice) ; .byte char ;char, with quoted bits trimmed ; ; Returns C=1 if output buf is full, in which case it's possible ; that not all of the data were transferred (r5, r4 updated). ; ; The LDATN entry sets up r1 and r2 to start a new packet. ; The LDATF entry converts r1, r2 returned from LDAT into r4, r5 ; needed by MAKPAC, assuming we were using TXBUF as the buffer. ; ;- ldatn: ; set up for new packet mov #txbuf+3,r1 ;usual initial values for r1, r2 movb maxl,r2 ;br ldat ; ldat: tst r4 ;nothing to do? beq 170$ ;C=0 from TST br 150$ ;jump into loop 10$: ; dry run to see if this char will fit in the packet ; (we worry about this only when we're within 5 chars of full) movb (r5),r0 ;get next char ; 1 char for the char itself mov #1,r3 ;length so far ; 2 chars for repeat prefix tstb rept ;do we do compression? beq 20$ cmp r4,#3 ;at least 3 chars left? blo 20$ cmpb r0,1(r5) ;next one the same? bne 20$ cmpb r0,2(r5) ;what about the one after? bne 20$ add #2,r3 ;yep, compression takes 2 chars 20$: ; 1 char for 8th bit quote tstb qbin ;do we quote 8th bit? beq 30$ tstb r0 ;8th bit set? bpl 30$ inc r3 ;yes, add 1 char 30$: ; 1 char for ctrl quote or flag quote bic #^C177,r0 ;trim to 7 cmp r0,#177 ;ctrl char? beq 40$ cmp r0,#40 blo 40$ cmpb r0,#'# ;flag? beq 40$ cmpb r0,qbin beq 40$ cmpb r0,rept bne 50$ 40$: inc r3 ;add 1 char 50$: cmp r2,r3 ;enough space? blo 170$ ;no, return C=1 60$: ; we're sure we have enough space, really do it movb (r5)+,r0 ;get the char tstb rept ;try to compress? beq 90$ cmp r4,#3 ;.GE.3 chars? blo 90$ cmpb r0,(r5) ;.GE.3 in a row the same? bne 90$ cmpb r0,1(r5) bne 90$ ; at least 3 in a row, do a repeat count add #2,r5 ;skip the next 2 sub #2,r4 ;eat them mov #3,r3 ;init count 70$: cmp r4,#1 ;anything left? (r4 is still +1 here) beq 80$ ;no cmpb r0,(r5) ;yes, is it the same? bne 80$ inc r5 ;yes, eat it dec r4 ;count it inc r3 ;rept count +1 cmp r3,#94. ;field full? blo 70$ ;no, loop 80$: movb rept,(r1)+ ;save flag add #40,r3 ;char(count) movb r3,(r1)+ sub #2,r2 ;count 90$: ; quote 8th bit tstb qbin ;binary quoting? beq 100$ tstb r0 ;does it need it? bpl 100$ movb qbin,(r1)+ ;yes dec r2 bic #^C177,r0 ;isolate low 7 100$: ; quote control chars mov r0,r3 ;copy bic #^C177,r3 ;trim cmpb r3,#177 ;DEL? beq 110$ cmpb r3,#40 ;ctrl char? bhis 120$ 110$: mov #100,r3 ;get 100 xor r3,r0 ;ctl(r0) br 130$ ;go quote 120$: ; see if it's a flag char ; we got #@ above so r3 can't be nul - OK to cmpb to QBIN & REPT cmpb r3,#'# ;qctl? beq 130$ cmpb r3,qbin ;qbin? beq 130$ cmpb r3,rept ;rept? bne 140$ 130$: movb #'#,(r1)+ ;qctl dec r2 140$: ; write the char itself movb r0,(r1)+ ;write it dec r2 dec r4 ;dec count beq 160$ ;done, skip 150$: cmp r2,#5 ;could we overrun? bhis 60$ ;no, don't worry br 10$ ;yes, be careful 160$: clc ;no flush needed yet 170$: rts pc ;(C set up) ; ldatf: ; convert r1, r2 from LDAT into r4, r5 for MAKPAC mov #txbuf+3,r5 ;point mov r1,r4 ;copy sub r5,r4 ;get length rts pc ;+ ; ; Unpack the data field of a text packet. ; ; Handles all escapes, and as long as r2 and r3 are preserved parsing may be ; preserved around packet boundaries, which means that escape sequences may be ; broken between packets. After not mentioning whether this can happen in the ; first few versions, the 6th edition of the Kermit spec says it can't, so we ; won't generate them but we'll receive them OK. ; ; On entry: ; r2 escape bits: 200 if & encountered, 100 if # encountered ; r3 repeat count, or -1 if next char is char(repeat count) ; r4 length of input packet buffer ; r5 input packet buffer ; ; BUFPTR contains the current output buffer addr ; BUFCTR contains the # of free bytes in the buf at bufptr ; ; Call is through r1: ; jsr r1,unpack ; .word flush ; ... returns here, C=1 if flush error ; ; FLUSH is the addr of a routine which is called when BUFCTR reaches 0. It ; should start the old buf flushing and set up BUFPTR,BUFCTR to point to a ; fresh buffer for subsequent data. R0 may be destroyed by the routine, all ; others must be preserved. If the routine returns C=1, UNPACK returns ; immediately with C=1. ; ; The initial values for r2 and r3 are 0 and 1, respectively ; (no escapes yet and no repeat so we'll write 1 byte). ; Call IUNPK instead to set these up. ; ;- iunpk: ; come here to init flags clr r2 ;no escapes mov #1,r3 ;repeat count = 1 unpack: ; come here with flags already initted tst r4 ;anything to unpack? beq 60$ ;no 10$: movb (r5)+,r0 ;get next char tst r3 ;expecting repeat count? bmi 90$ ;yes cmpb r0,rept ;repeat flag? beq 80$ cmpb r0,qbin ;8th-bit flag (if any)? beq 100$ cmpb r0,qctl ;ctrl flag? beq 110$ 20$: xor r0,r2 ;we've finished the char, flip bits 30$: ; save r2, r3 times movb r2,@bufptr ;put in buf inc bufptr ;bump ptr dec bufctr ;any space left? beq 70$ ;no, queue write 40$: sob r3,30$ ;loop clr r2 ;re-init flags inc r3 ;count=1 50$: sob r4,10$ ;loop 60$: tst (r1)+ ;skip flush addr, C=0 rts r1 70$: ; go flush buffer call @(r1) ;flush bcc 40$ ;loop if ok tst (r1)+ ;skip flush addr sec ;C=1 rts r1 80$: ; repeat flag bit #100,r2 ;quoted? bne 120$ ;yes mov #-1,r3 ;no, next char is count br 50$ ;get it 90$: ; repeat count sub #40,r0 ;unchar mov r0,r3 ;save br 50$ ;get next 100$: ; 8th bit flag bit #100,r2 ;quoted? bne 120$ ;yes bis #200,r2 ;no, set 8th bit br 50$ ;C4 110$: ; ctrl flag bit #100,r2 ;quoted? bne 120$ ;yes bis #100,r2 ;no, set ctrl bit br 50$ ;C4 120$: bic #100,r2 ;clear flag (quoted, not ctrl) br 20$ ;save char ;+ ; ; Send a simple packet and get an ACK for it. ; ; Enter with packet type in r0. ; ; Exit with things set up from SNDACK. ; ;- sndsmp: mov #txbuf+3,r5 ;ptr clr r4 ;no data call makpac ;make a packet ;br sndack ;send it, get ACK ;+ ; ; Send a packet and get an ACK for it. ; ; Enter with r4, r5 set up for PUTPAC. ; ; Return with C=1 = retry count exhausted, ; C=0 = things are OK (getpac regs), seq updated. ; ;- sndack: mov #10.,-(sp) ;retry count 10$: call putpac ;send mov r4,-(sp) ;save mov r5,-(sp) call getpac ;get a packet bcc 30$ ;got one 20$: mov (sp)+,r5 ;restore mov (sp)+,r4 dec (sp) ;give up yet? bne 10$ ;no tst (sp)+ ;yes, flush sec ;C=1 rts pc 30$: cmp r0,#'Y ;ACK? bne 40$ ;no cmpb r1,seq ;correct sequence #? beq 50$ ;yes, skip 40$: cmp r0,#'N ;NAK? bne 20$ ;no, keep trying inc r1 ;seq+1 bic #^C77,r1 ;mod 100' cmpb r1,seq ;NAK for next packet? bne 20$ ;no, keep trying clr r4 ;shouldn't be any data 50$: incb seq ;bump seq bicb #^C77,seq ;mod 100' add #6,sp ;purge stack, C=0 rts pc ;+ ; ; Make a packet. ; ; On entry: ; ; r0 packet type ; r4 length of dat ; r5 ptr to dat (must have 3 bytes free at each end) ; ; On return: ; ; r4 length of packet ; r5 ptr to packet ; ;- makpac: movb r0,-(r5) ;save typ movb seq,r0 ;get seq # add #40,r0 ;char(seq) movb r0,-(r5) ;save seq add #2,r4 ;count both mov r4,r0 ;copy add lchk,r0 ;add length of check mov r0,-(sp) ;save add #40,r0 ;take char(len) movb r0,-(r5) ;save len mov r5,r1 ;copy ptr inc r4 ;count length field add r4,r1 ;add length mov r5,-(sp) ;save call @checka ;compute check mov (sp)+,r5 ;restore mov (sp)+,r4 inc r4 ;count length rts pc ;+ ; ; Send a packet. ; ; On entry, ; ; r4 length of len through chk fields ; r5 ptr to len field ; ; Preserves r4 and r5. ; ;- putpac: .rctrlo ;might have received ^O in line noise movb npad,r1 ;get # pads to send beq 20$ ;none movb padc,r0 ;get char 10$: .ttyout ;write one sob r1,10$ ;loop 20$: .ttyout #soh ;write SOH mov r4,r2 ;copy mov r5,r3 30$: movb (r3)+,r0 ;get next char .ttyout ;write it sob r2,30$ ;loop movb eol,r0 ;write eol char .ttyout rts pc ;+ ; ; Receive a packet. ; ; On return: ; ; If successful, C=0 and ; ; r0 packet type ; r1 packet sequence number ; r4 length of data field ; r5 ptr to data field ; ; C=1 on timeout, bad checksum, or obviously invalid length. ; ;- getpac: jsr r5,gtmout ;get mark .word 50$ ;whoops cmp r0,#soh ;is this mark? bne getpac ;loop if not mov #rxbuf,r5 ;pt at buf mov r5,r4 ;copy jsr r5,gtmout ;get length .word 50$ ;whoops movb r0,(r4)+ ;save sub #40,r0 ;unchar(len) cmp r0,#136 ;valid? bhi 50$ ;nope, don't rape core mov lchk,r1 ;get length of check add #2,r1 ;+2 (seq, typ) cmp r0,r1 ;too small for null data field? blo 50$ ;yes, forget it mov r0,r1 ;copy length 10$: jsr r5,gtmout ;get a char .word 50$ ;whoops movb r0,(r4)+ ;save the char sob r1,10$ ;loop ; got the whole thing, check it sub r5,r4 ;find length sub lchk,r4 ;don't check the check mov r4,-(sp) ;save mov r5,-(sp) mov #chkbuf,r1 ;pt at buf call @checka ;check the packet mov r5,r2 ;copy check ptr mov (sp)+,r5 ;restore mov (sp)+,r4 sub r3,r1 ;back up 20$: cmpb (r1)+,(r2)+ ;right? bne 40$ ;no sob r3,20$ ;loop 30$: inc r5 ;skip LEN movb (r5)+,r1 ;get seq sub #40,r1 ;unchar bcs 50$ ;whoops bit #^C77,r1 ;must fit in 6 bits bne 50$ ;doesn't, error movb (r5)+,r0 ;get type sub #3,r4 ;update length (C=0) rts pc 40$: ; bad check -- if check type .NE. 1-char-checksum, see if the packet ; would have been valid if it were; this way we can recover from them ; losing our half of parms negotiation ;;; we may want to limit this check to cases when it could happen, otherwise ;;; we'll blindly accept bad packets 1/256th of the time mov lchk,r0 ;get check type cmp r0,#1 ;=1? beq 50$ ;yes, no point in being cute add r0,r4 ;fix length dec r4 ;to include everything but 1-char-checksum mov r4,-(sp) ;save mov r5,-(sp) mov #chkbuf,r1 ;pt at buf call chk1 ;call 1-char-checksum routine mov r5,r2 ;save mov (sp)+,r5 ;restore mov (sp)+,r4 cmpb (r1),(r2) ;match? beq 30$ ;yes, continue processing 50$: sec ;error return rts pc ; gtmout: ; get char with timeout .ttinr ;try to get a char bcs gtmout ;loop tst (r5)+ ;skip return rts r5 ;+ ; ; Check routines. ; ; On entry: ; ; r1 buffer to put check in ; r4 length of len through dat fields ; r5 len field of packet to check ; ; On return: ; ; r1 updated ; r3 length of check generated ; r5 end of region checked ; ;- chk1: ; 1-byte checksum ; chk = <<sum+<<sum/100>&3>>&77>+40 (sum is 8-bit sum of chars) clr r2 ;init sum 10$: movb (r5)+,r0 ;get a char add r0,r2 ;add it in sob r4,10$ ;loop mov r2,r0 ;copy rolb r2 ;left 3 rolb r2 rolb r2 bic #^C3,r2 ;isolate <7:6> add r2,r0 ;find total bic #^C77,r0 ;isolate <5:0> add #40,r0 ;char(chk) movb r0,(r1)+ ;save mov #1,r3 ;length rts pc ; chk2: ; 2-byte checksum ; chk1 = sum&77+40, chk2 = <sum_-6>&77+40 (sum is 12-bit sum of chars) clr r2 ;init sum 10$: clr r0 ;clear high bisb (r5)+,r0 ;get a char add r0,r2 ;add it in sob r4,10$ ;loop mov r0,r2 ;copy bic #^C77,r0 ;low 6 bits add #40,r0 ;char() movb r0,(r1)+ ;save asl r2 ;left 2 asl r2 swab r2 ;and right 8 = right 6 bic #^C77,r2 ;high 6 bits add #40,r2 ;char() movb r2,(r1)+ ;save mov #2,r3 ;length rts pc ; chk3: ; 3-byte CRC (requires EIS) ; algorithm stolen from MS-Kermit V2.24 ; (written by Columbia University) clr r2 ;init 10$: movb (r5)+,r0 ;get next .if ne eis$$ xor r2,r0 ;XOR low byte of old value .iff mov r2,r3 ;save bis r2,r0 ;find IOR com r2 ;find AND bic r2,r3 bic r3,r0 ;(r2!r0)&^C(r2&r0) .endc bic #^C377,r0 ;isolate asl r0 ;*2 mov crc(r0),r0 ;get bits clrb r2 ;running total right 8. swab r2 .if ne eis$$ xor r0,r2 ;find new value .iff mov r0,r3 ;save bis r0,r2 ;IOR com r0 ;AND bic r0,r3 bic r3,r2 ;XOR .endc sob r4,10$ ;yay .if ne eis$$ mov r2,r3 ;copy ash #-6,r2 ;right 6 mov r2,r0 ash #-6,r0 ;again .iff mov r2,r3 ;copy mov r2,r0 swab r0 ;right 12. (right 8., right 4) asr r0 asr r0 asr r0 asr r0 asl r2 ;right 6. (left 2, right 8.) asl r2 swab r2 .endc bic #^C17,r0 ;<15:12> bis #40,r0 ;char() movb r0,(r1)+ bic #^C77,r2 ;<11:6> add #40,r2 ;char() movb r2,(r1)+ bic #^C77,r3 ;<5:0> add #40,r3 ;char() movb r3,(r1)+ mov #3,r3 ;length rts pc ; crc: .word 1,2,3,4 ;this table will be 256. words ; .rem % xor dx,dx ;init crc mov bh,dl ;bh=0 kchk3a: lodsb ;get next byte xor al,dl ;XOR in old value mov dl,dh ;right 8 bits mov dh,al ;save low byte mov bl,al ;copy and bl,17 ;isolate low 4 shl bl,1 ;*2 mov ax,ds:crc1[bx] ;get low part mov bl,dh ;copy again shr bl,1 ;right-justify high nibble, *2 shr bl,1 shr bl,1 and bl,36 ;isolate xor ax,ds:crc2[bx] ;bitwise add get high part mov dh,ah ;copy high half xor dl,al ;bitwise add low half loop kchk3a ;loop mov bx,dx ;copy mov cl,6 ;bit count shr bx,cl ;right 6 mov ax,bx ;one more time shr ax,cl ;right 6 or al,40 ;take char(CRC<15:12>) mov [di],al ;save it inc di ;+1 and bl,77 ;isolate CRC<6:11> add bl,40 ;take char() mov [di],bl ;save inc di ;+1 and dl,77 ;isolate CRC<5:0> add dl,40 ;take char() mov [di],dl ;save inc di ;+1 mov cl,3 ;byte count=3 ret % .sbttl pure data ; rad50a: ; 1st char rad50 lookup table .rad50 " A B C D E F G " .rad50 "H I J K L M N O " .rad50 "P Q R S T U V W " .rad50 "X Y Z $ . 0 1 " .rad50 "2 3 4 5 6 7 8 9 " ; rad50b: ; 2nd char rad50 lookup table .rad50 " A B C D E F G " .rad50 " H I J K L M N O " .rad50 " P Q R S T U V W " .rad50 " X Y Z $ . 0 1 " .rad50 " 2 3 4 5 6 7 8 9 " ; checks: .word chk1,chk2,chk3 ; larea: .byte 1,1 ;.LOOKUP, channel = 1 .word fbuf ;filename .word -1 ;start at head posn on magtape ; ludir: .byte 0,1 ;.LOOKUP, channel = 0 .word wlddev ;ptr to device name .word 0 ;(only for MT:) ; r50t: .ascii " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789" r50tnb: .ascii <0>"ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789" ; months: .ascii "-Jan-Feb-Mar-Apr-May-Jun-Jul-Aug-Sep-Oct-Nov-Dec-" ; ; strings for dirsum tfile: .asciz " file" tblk: .asciz " block" .asciz " in use" ;must follow tblk tfree: .asciz " free" ; bfs: .asciz 'Bad file specification.' bdn: .asciz 'Bad device name.' nomtch: .asciz 'No matching files found.' fnf: .asciz 'File not found.' ucf: .asciz 'Unable to create file.' uof: .asciz 'Unable to open file.' werr: .asciz 'Error writing file.' rerr: .asciz 'Error reading file.' ioerr: .asciz 'I/O error.' toolng: .asciz 'Line too long.' mkw: .asciz 'Missing keyword.' ; .sbttl some of both ; .even ; earea: .byte 1,2 ;.ENTER, channel = 1 .word fbuf ;dblk elen: .word -1 ;length=max (or value if we know) .word -1 ;add file at EOT if magtape ; device: .word 0 ;currently loaded device handler, or 0 if none lchk: .word 1 ;length of checksum (bytes) checka: .word chk1 ;addr of routine to compute checksum ; warea: .byte 1,11 ;.WRITE, channel = 1 wblk: .word ;blk # wca: .word ;core address wwc: .word ;word count .word 1 ;no crtn ; rarea: .byte 1,10 ;.READ, channel = 1 rblk: .word ;blk # rca: .word ;core address rwc: .word ;word count .word 1 ;no crtn ; rddir: .byte 0,10 ;.READ, channel = 0 dirblk: .word ;blk # .word buf1 ;core addr .word 1000 ;word cnt (dir segments are 2 blks) .word 0 ;wait for completion ; wrdir: .byte 0,11 ;.WRITE, channel=0 wdrblk: .word ;blk # .word buf1 ;core addr .word 1000 ;word cnt (2 blocks) .word 0 ;wait for completion ; wlddev: .word ;dev name for dir search .word 0,0,0 ;no filename or ext ; .blkb 3 ;for len, seq, typ mparms: ; my parameters .byte 94.+40 ;MAXL (anything's OK with us) .byte 5+40 ;TIME (line speed should be only problem) .byte 0+40 ;NPAD (no pad chars) .byte '@ ;PADC (doesn't matter) .byte cr+40 ;EOL (doesn't matter) .byte '# ;QCTL (hard-coded - doesn't really matter) mqbin: .byte ;QBIN (only if one of us needs it) mchkt: .byte ;CHKT (whatever they want, or 1 byte) mrept: .byte ;REPT (repeat char) .byte attr+40 ;CAPAS (attr packets OK) nmprms= .-mparms .blkb 3 ;for check ; pns: .ascii 'Packet type "' pnsc: .byte .asciz '" not supported.' ; cns: .ascii 'Generic command "' cnsc: .byte .asciz '" not supported.' ; pvl: .ascii 'Packet type "' pvlc: .byte .asciz '" invalid at this point.' ; ddev: .ascii 'Default device is now ' ddev1: .blkb 3+1+2 ;<ddu>:<crlf> ; .sbttl pure storage ; .even defdev: .blkw ;default device name (.rad50) fbuf: .blkw 4 ;device, filename, extension dstat: .blkw 4 ;.DSTAT area ackdat: .blkw ;ptr to last ACK packet acklen: .blkw ;length of last ACK packet ; directory stuff: extbyt: .blkw ;extra bytes per dir entry files: .blkw ;no. of files in dir listing used: .blkw ;total no. blks in use free: .blkw ;total no. < UNUSED > blks segnxt: .blkw ;next segment in dir ; seq: .blkb 1 ;packet sequence # txbuf: .blkb 3+91.+3 ;tx packet buffer rxbuf: .blkb 91.+3 ;rx packet buffer chkbuf: .blkb 3 ;check buffer (for generated rx check) wild: .blkb 91.+1 ;wildcard buffer for GD and R wldflg: .blkb ;NZ => WILD contains at least 1 wildcard char dirall: .blkb ;NZ => show all dir entries (no wildcard check) dirnon: .blkb ;NZ => don't build dir entry table (usage check) binfil: .blkb ;NZ => don't trim NULs from ends of file blks ; maxl: .blkb ;maximum packet length (bytes) time: .blkb ;packet timeout (seconds) npad: .blkb ;no. of pad characters padc: .blkb ;pad character (if npad.ne.0) eol: .blkb ;eol char qctl: .blkb ;ctrl char quote qbin: .blkb ;8th bit quote chkt: .blkb ;check type rept: .blkb ;repeat char capas: .blkb ;extra capabilities nparms= .-maxl ; .even cbuf: .blkw ;current buffer in double-buffering rlen: .blkw ;number of words reading into next buffer bufptr: .blkw ;ptr into buffer bufctr: .blkw ;ctr in buffer ; matlst: .blkw 72.*5+1 ;wildcard match list, up to 72. entries + zero ; buf1: .blkb bufsiz ;buffers buf2: .blkb bufsiz ; devhnd= . ;device handlers go here .end start