.title k11pak packet driver for kermit-11 .ident /8.0.01/ .dsabl gbl ; Brian Nelson 30-Nov-83 10:20:09 ; ; Change Software, Toledo, Ohio ; University of Toledo, Toledo, Ohio ; ; last edit: 04-Jan-84 08:35:48 .enabl lc ; define macros and things we want for KERMIT-11 ; ; K11MAC.MAC defines all macros and a number of symbols ; K11DEF.MAC defines all the packet types .include /IN:K11MAC.MAC/ .iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed .include /IN:K11DEF.MAC/ maxpak == 94. ; maximum packet size-maxsize(checksum) mx$try == 10 ; number of times to retry packet myquote == '# ; quoting mypad == 0 ; no padding mypchar == 0 ; thus no pad character myeol == cr ; end-of-line mytime == 12 ; time me out after this myqbin == '& ; 8 bit quoting defchk == '1 mychkt == defchk ; normal checksumming myrept == 40 ; no repeat counts mycapa == capa.a ; i can receive attributes maxtim == 60 ; maximum timeout mintim == 2 ; minimum timeout badchk == 377 ; psuedo packet type for checksum timout == 'T&137 ; psuedo packet type for timeout defdly == 6 ; delay for SENDING to start up STA.ABO = 'A&137 ; state is 'abort' STA.ATR = 'H&137 ; state is 'send attributes' STA.BRK = 'B&137 ; state is 'break link' STA.COM = 'C&137 ; state is 'transaction complete' STA.DAT = 'D&137 ; state is 'data' STA.EOF = 'Z&137 ; state is 'end of file/reply' STA.FIL = 'F&137 ; state is 'filename header' STA.INI = 'I&137 ; state is 'init' STA.RIN = 'R&137 ; state is 'receive init' STA.SIN = 'S&137 ; state is 'send init' STA.TYP = 'X&137 ; state is 'extended reply' .sbttl notes on RMS-11 ; RSTS and RSX note: ; ; Note that we really don't need distinct luns for input, output ; and directory lookup as we would normally never have more than ; one of them active at any given time. The space used to do this ; only adds about 1 KW of size to the task so I am not going to ; worry about it. There could always come a time when the above ; assumption will not hold. Most of KERMIT-11 is sharable anyway ; due to the linking to RMSRES. The code, all being in PSECT $CODE ; can always be task built with the /MU switch to make more of it ; sharable (RSTS and RSX11M Plus only). ; The one thing to note is that LUN.LO must ALWAYS be reserved as ; logging and debugging to disk can be running concurrently with ; anything else. Also, when the TAKE command is put in another lun ; will be required for it. lun.kb == 0 ; assume if channel 0 --> terminal lun.in == 1 ; channel for input files lun.ou == 2 ; channel for output files lun.lo == 3 ; channel for packet and file logging lun.tr == 3 ; same as lun.log lun.ta == 4 ; for the TAKE command lun.tt == 5 ; for RSX, the normal TI: channel lun.sr == 6 ; channel for $search for RMSv2.0 lun.ti == 7 ; channel number for connected terminal lun.co == 10 ; used as is lin.ti for remote connect lun.as == 11 ; used to attach to remote link device ; to fake a device assignment .psect $pdata null: .byte 0,0 ; a null packet to send .psect $code .sbttl KERMIT packet format ; PACKET FORMAT ; ;The KERMIT protocol is built around exchange of packets of the following for- ;mat: ; ; +------+-----------+-----------+------+------------+-------+ ; ] MARK ] char(LEN) ] char(SEQ) ] TYPE ] DATA ] CHECK ] ; +------+-----------+-----------+------+------------+-------+ ; ;where all fields consist of ASCII characters. The fields are: ; ;MARK The synchronization character that marks the beginning of the packet. ; This should normally be CTRL-A, but may be redefined. ; ;LEN The number of ASCII characters within the packet that follow this ; field, in other words the packet length minus two. Since this number ; is transformed to a single character via the char() function, packet ; character counts of 0 to 94 (decimal) are permitted, and 96 (decimal) ; is the maximum total packet length. The length does not include end- ; of-line or padding characters, which are outside the packet and are ; strictly for the benefit of the operating system, but it does include ; the block check characters. ; ;SEQ The packet sequence number, modulo 64, ranging from 0 to 63. Sequence ; numbers "wrap around" to 0 after each group of 64 packets. ; ; ;TYPE The packet type, a single ASCII character. The following packet types ; are required: ; ; D Data packet ; Y Acknowledge (ACK) ; N Negative acknowledge (NAK) ; S Send initiate (exchange parameters) ; B Break transmission (EOT) ; F File header ; Z End of file (EOF) ; E Error ; ; ;DATA The "contents" of the packet, if any contents are required in the given ; type of packet, interpreted according to the packet type. Control ; characters are preceded by a special prefix character, normally "#", ; and "uncontrollified" via ctl(). A prefixed sequence may not be broken ; across packets. Logical records in printable files are delimited with ; CRLFs, suitably prefixed (e.g. "#M#J"). Any prefix characters are in- ; cluded in the count. Optional encoding for 8-bit data and repeated ; characters is described later. ; ; ;CHECK A block check on the characters in the packet between, but not includ- ; ing, the mark and the block check itself. The check for each packet is ; computed by both hosts, and must agree if a packet is to be accepted. ; A single-character arithmetic checksum is the normal and required block ; check. Only six bits of the arithmetic sum are included. In order ; that all the bits of each data character contribute to this quantity, ; bits 6 and 7 of the final value are added to the quantity formed by ; bits 0-5. Thus if s is the arithmetic sum of the ASCII characters, ; then ; ; check = char((s + ((s AND 192)/64)) AND 63) ; ; This is the default block check, and all Kermits must be capable of ; performing it. Other optional block check types are described later. ; The block check is based on the ASCII values of the characters in the ; packet. Non-ASCII systems must translate to ASCII before performing ; the block check calculation. .sbttl send processing .enabl lsb sen.sw:: sendsw::movb @r5 ,state ; do a SINIT first thing please movb #defchk ,chktyp ; setup the default checksum type mov #1 ,chksiz ; the dize of the checksum mov $image ,image ; insure correct default for mode clr paknum ; packetnumber := 0 clr numtry ; retry_count := 0 clr oldtry ; oldretry_count := 0 add pcnt.s+0,sencnt ; save sent packet count call clrsta ; clear the stats out now cmpb conpar+p.chkt,#'1 ; did the other system want crc checks? bne 1$ ; yep cmpb senpar+p.chkt,#'1 ; simple block checks today beq 5$ ; yes, assume caller's state is ok 1$: movb #STA.SIN,state ; no, must force a SINIT exchange. 5$: call senhdr 10$: call sendeb scan state,#200$ ; now dispatch based on current asl r0 ; state jsr pc ,@210$(r0) ; and do it again movb r1 ,state ; set a new state bcc 10$ ; ok movb #defchk ,chktyp ; reset the checksum type mov #1 ,chksiz ; the size of the checksum save ; insure files are closed tst inopn ; file open from a failure ? beq 110$ ; no calls close ,<#lun.in> ; insure that it's closed 110$: unsave ; pop exit status code please return ; bye 200$: .byte STA.ABO ,STA.BRK,STA.COM,STA.DAT,STA.FIL,STA.SIN,STA.EOF .byte STA.ATR .byte 0 .even 210$: .word send.$ .word send.a ,send.b ,send.c ,send.d ,send.f ,send.s ,send.z .word send.h .dsabl lsb global global global .sbttl STATE routines for SENDSW send.a: send.$: mov #-1 ,r0 movb #STA.ABO,r1 ; return ("ABORT") sec ; unknown state, abort return send.b: call sbreak ; send a break to the other system clc ; and continue return send.c: clr r0 ; Complete sec ; exit return send.d: call sdata ; send data now clc ; assume all is well return ; bye send.f: call sfile ; send a file header clc ; assume it went well return send.h: call sattr clc return send.s: call sinit ; initialize clc return send.z: call seof ; end of file clc return sendeb: bit #log$st ,trace ; debugging for SENDSW beq 30$ ; if trace is on then dump the sub #50 ,sp ; current state to the disk file mov sp ,r1 ; allocate a small buffer mov #200$ ,r2 ; point to a header 10$: movb (r2)+ ,(r1)+ ; copy a header please bne 10$ ; until we find a null dec r1 ; all done movb state ,(r1)+ ; copy the current state over movb #40 ,(r1)+ ; sub sp ,r1 ; get the record length mov sp ,r0 ; and point back to the record calls putrec ,; dump it add #50 ,sp ; and deallocate the buffer 30$: tst debug ; terminal debugging on ? beq 40$ ; no .print #200$ ; yes, dump current state to ti: .print #state ,#1 ; .newli ; and a crlf 40$: call senlog ; packet stats 100$: return 200$: .asciz /Sendsw - state is / .even global .sbttl sattr send attribute data for the current file sattr: inc numtry ; abort if we have been trying too much cmp numtry ,maxtry ; well ? blos 10$ ; no, keep it up movb #STA.ABO,r1 ; yes, return("ABORT") br 100$ ; exit 10$: tst sendat ; really do this ? beq 90$ ; no calls w$attr ,<#filnam,#lun.in,#packet> ; get the next attr packet tst r0 ; any errors along the way ? bne 90$ ; yes tst r1 ; anything to send over ? beq 90$ ; no spack #'A,paknum,r1,#packet ; send the next record out please rpack r2,r3,#recpkt ; get the reply please scan r1,#200$ ; and take action on the reply asl r0 ; dispatch based on the packet type jsr pc ,@210$(r0) ; simple br 100$ ; bye 90$: calls buffil ,<#packet> ; get the first buffer of data please mov r1 ,size ; and save it movb #STA.DAT,r1 ; switch to data state if no more attr 100$: return ; bye 200$: .byte 'E&137 ,'N&137 ,'Y&137 ,timout ,badchk ,0 .even 210$: .word satr.$ .word satr.e ,satr.n ,satr.y ,satr$$ ,satr$$ .sbttl handle the response to the packet sent by SATTR satr.$: movb #STA.ABO,r1 ; unrecognized packet type return satr$$: movb state ,r1 ; timeout, stay in current state return ; and exit satr.e: calls prerrp ,<#recpkt> ; print out received error packet movb #STA.ABO,r1 ; abort return ; and exit satr.n: dec r3 ; a NAK, see if it's for the last bge 10$ ; packet mov #63. ,r3 ; --paknum<0 ? 63:paknum 10$: cmp r3 ,paknum ; same one ? beq 20$ ; yes movb state ,r1 ; no, continue on as before then return ; bye 20$: call satr.y ; same packet, goto ACK code return satr.y: cmp r3 ,paknum ; insure ACK is for correct packet beq 10$ ; yes movb state ,r1 ; no, continue in current state return 10$: clr numtry ; retrycount := 0 incm64 paknum ; paknum := (paknum+1) mod 64 movb #STA.ATR,r1 ; not eof, stay in ATTRIBUTE state return ; return("ATTRIBUTE") global .sbttl sbreak send a break sbreak: inc numtry ; ABORT if retry count is too high cmp numtry ,maxtry ; well ? blos 10$ ; ok movb #STA.ABO,r1 ; no, abort the sending of this br 100$ 10$: spack #'B,paknum,#0,#packet ; send a break packet rpack r2,r3,#recpkt ; read the response scan r1,#200$ ; and dispatch based on it asl r0 ; offset times two jsr pc ,@210$(r0) ; simple 100$: clc return 200$: .byte 'E&137 ,'N&137 ,'Y&137 ,timout ,badchk ,0 .even 210$: .word sbrk.$ .word sbrk.e ,sbrk.n ,sbrk.y ,sbrk$$ ,sbrk$$ global .sbttl sbreak routines sbrk.$: movb #STA.ABO,r1 ; default or timeout error return ; bye sbrk$$: movb state ,r1 ; receive failure (timeout) return ; remain in current state sbrk.e: calls prerrp ,<#recpkt> movb #STA.ABO,r1 return sbrk.n: dec r3 ; for a NAK see if it was for bge 10$ ; the last one mod 64 mov #63. ,r3 ; underflowed, reset to 63 10$: cmpb r3 ,paknum ; is it the last one ? beq 20$ ; yes movb state ,r1 ; no, simply stay in current mode return 20$: call sbrk.y return sbrk.y: cmp r3 ,paknum ; ACK, insure ack is for the beq 10$ ; current packet movb state ,r1 ; wrong packet, ignore it return 10$: clr numtry ; ack for this packet. incm64 paknum ; paknum := (paknum+1) mod 64 movb #'C&137 ,r1 ; return ("COMPLETE") return global .sbttl sendinit sinfo:: save ; save ALL registers please clr numtry ; send info packets before any clr paknum ; extended server response please movb #'I&137 ,-(sp) ; packet type 'i' call .sinit ; do it unsave ; restore ALL registers now return ; bye sinit:: movb #'S&137 ,-(sp) ; normal sinit operation for sending call .sinit ; files return ; bye .sinit: mov chktyp ,-(sp) ; save checksum type (not needed) mov chksiz ,-(sp) ; save checksum type (not needed) movb #defchk ,chktyp ; force type one please mov #1 ,chksiz ; length of it inc numtry ; abort if we have been trying too much cmp numtry ,maxtry ; well ? blos 10$ ; no, keep it up movb #STA.ABO,r1 ; yes, return("ABORT") br 100$ 10$: calls spar ,<#packet> ; get our send parameters calls cantyp ,<#ttname,#lun.ti>; flush pending input please movb 6(sp) ,r5 ; packet type to do today spack r5,paknum,sparsz,#packet ; sent our init info now rpack r2,r3,#recpkt ; and get the other's response scan r1,#200$ ; and dispatch to the correct asl r0 ; routine now jsr pc ,@210$(r0) ; simple 100$: mov (sp)+ ,chksiz ; restore cehcksum stuff mov (sp)+ ,chktyp ; restore cehcksum stuff mov (sp)+ ,@sp ; pop passed packet type now return 200$: .byte 'E&137 ,'N&137 ,'Y&137 ,timout ,badchk ,0 .even 210$: .word sini.$ .word sini.e ,sini.n ,sini.y ,sini$$ ,sini$$ global global .sbttl routines for SINIT sini.$: movb #STA.ABO,r1 ; default case, unrecognized TYPE return sini$$: movb state ,r1 ; error on the packet, try again return sini.e: cmpb r5 ,#'I&137 ; if called from sinfo, ignore errors beq 100$ ; calls prerrp ,<#recpkt> ; error state, print it and abort movb #STA.ABO,r1 ; return ("ABORT") 100$: return sini.n: cmpb r5 ,#'I&137 ; server NAK for I (sinfo) packet? bne 10$ ; no cmp numtry ,#2 ; gotten at least one NAK for 'I'? blo 10$ ; no, try again please incm64 paknum ; yes, simply ignore it and move clr numtry ; to file state movb #STA.FIL,r1 ; not all servers may know about it return 10$: movb state ,r1 ; NAK, continue as before return sini.y: cmp r3 ,paknum ; got an ACK for SINIT beq 10$ ; and the ack is for correct packet movb state ,r1 ; wrong ACK, ignore it please return 10$: calls rpar ,<#recpkt,r2> ; load the other's parameters now tstb conpar+p.eol ; insure legitimate EOL character bne 20$ ; yes movb #cr ,conpar+p.eol ; no, stuff a carriage return in 20$: tstb conpar+p.qctl ; vaild quoting character present? bne 30$ ; yes movb #myquot ,conpar+p.qctl ; no, stuff the default in please 30$: clr numtry ; number_of_trys := 0 incm64 paknum ; packetnumber := packetnumber+1 mod 64 movb #STA.FIL,r1 ; return("FILE") return global .sbttl sfile .enabl lsb sfile: movb conpar+p.chkt,chktyp ; switch to new checksum type movb chktyp ,chksiz ; compute the checksum size also sub #'0 ,chksiz ; simple mov $image ,image ; insure correct default for mode mov #filnam ,r3 ; and point to it please clr skipfl ; the user skip the rest of a file call clratr ; insure attribute stuff is cleared sub #100 ,sp ; and a converted filename buffer mov sp ,r4 ; and point to it please inc numtry ; abort if we have been trying too much cmp numtry ,maxtry ; well ? blos 10$ ; no, keep it up movb #STA.ABO,r1 ; yes, return("ABORT") jmp 100$ ; exit 10$: tst inopn ; open files hanging around ? beq 20$ ; no calls close ,<#lun.in> ; yes, clean up please clr inopn ; it's closed now 20$: tst doauto ; see if we should check for binary beq 25$ ; no, don't do it please calls binfil ,<#filnam,#lun.in>; should we force binary mode ? tst r0 ; if gt, then yes ble 25$ ; no mov #binary ,image ; yes, force binary file operations 25$: calls open ,<#filnam,#lun.in,image>; open the file for input tst r0 ; did it work ? beq 30$ ; yes calls syserr , ; no calls error ,<#2,#errtxt,#filnam>; say so please movb #STA.ABO,r1 ; return("ABORT") br 100$ ; exit 30$: mov sp ,inopn ; file is open tst xmode ; is this a server X-tended reply? bne 45$ ; yes, send a simple X packet calls fillog ,<#1,#filnam> ; log this to disk calls namcvt ,<#filnam,r4> ; convert name to simple name tst remote ; are we local here ? bne 40$ ; no, don't print this out calls printm ,<#4,#300$,#filnam,#310$,r4> 40$: strlen r4 ; and get the filename length spack #'F,paknum,r0,r4 ; set the filename packet over br 50$ ; ok 45$: spack #'X,paknum ; server extended reply here, send X 50$: rpack r2,r3,#recpkt ; get the response to the filename scan r1,#200$ ; and dispatch on the response asl r0 ; times 2 jsr pc ,@210$(r0) ; and call the appropiate response 100$: add #100 ,sp return 200$: .byte 'E&137 ,'N&137 ,'Y&137 ,timout ,badchk ,0 .even 210$: .word sfil.$ .word sfil.e ,sfil.n ,sfil.y ,sfil$$ ,sfil$$ 300$: .asciz /Sending file / 310$: .asciz / as file / .even .dsabl lsb global global .sbttl routines for SFILE sfil.$: movb #STA.ABO,r1 ; unknown response, return("ABORT") return sfil$$: movb state ,r1 ; timeout or checksum error return ; remain in current F state sfil.e: calls prerrp ,<#recpkt> ; error, abort aftering getting movb #STA.ABO,r1 ; the error packet printed. return sfil.n: dec r3 ; a NAK, see if it's for the last bge 10$ ; packet mov #63. ,r3 ; --paknum<0 ? 63:paknum 10$: cmp r3 ,paknum ; same one ? beq 20$ ; yes movb state ,r1 ; no, continue on as before then return ; bye 20$: call sfil.y ; same packet, goto ACK code return sfil.y: cmp r3 ,paknum ; same packet number being ACKED? beq 10$ ; yes movb state ,r1 ; no, continue in current state return 10$: clr numtry ; number_of_tries := 0 incm64 paknum ; packnumber := packnumber+1 mod 64 movb #STA.ATR,r1 ; return("ATTRIBUTE") return global .sbttl sdata send file data to other system sdata: inc numtry ; abort if we have been trying too much cmp numtry ,maxtry ; well ? blos 10$ ; no, keep it up movb #STA.ABO,r1 ; yes, return("ABORT") br 100$ ; exit 10$: spack #'D,paknum,size,#packet ; send the next record out please rpack r2,r3,#recpkt ; get the reply please scan r1,#200$ ; and take action on the reply asl r0 ; dispatch based on the packet type jsr pc ,@210$(r0) ; simple 100$: return ; bye 200$: .byte 'E&137 ,'N&137 ,'Y&137 ,timout ,badchk ,0 .even 210$: .word sdat.$ .word sdat.e ,sdat.n ,sdat.y ,sdat$$ ,sdat$$ .sbttl handle the response to the packet sent by SDATA sdat.$: movb #STA.ABO,r1 ; unrecognized packet type return sdat$$: movb state ,r1 ; timeout, stay in current state return ; and exit sdat.e: calls prerrp ,<#recpkt> ; print out received error packet return sdat.n: dec r3 ; a NAK, see if it's for the last bge 10$ ; packet mov #63. ,r3 ; --paknum<0 ? 63:paknum 10$: cmp r3 ,paknum ; same one ? beq 20$ ; yes movb state ,r1 ; no, continue on as before then return ; bye 20$: call sdat.y ; same packet, goto ACK code return sdat.y: cmp r3 ,paknum ; insure ACK is for correct packet beq 10$ ; yes movb state ,r1 ; no, continue in current state return 10$: clr numtry ; retrycount := 0 incm64 paknum ; paknum := (paknum+1) mod 64 cmpb recpkt ,#'X&137 ; did the ack contain a X for skipfile beq 20$ ; yes, fake EOF then cmpb recpkt ,#'Z&137 ; did the ack contain a Z for skip all bne 30$ ; files ? no mov #-1 ,index ; flag a fake no more files 20$: movb #STA.EOF,r1 ; and fake EOF for either X or Z ack return 30$: calls buffil ,<#packet> ; get the next buffer of data to send mov r1 ,size ; and save the size please bne 40$ ; something was there movb #STA.EOF,r1 ; EOF, set state to EOF state return ; return("EOF") 40$: movb #'D&137 ,r1 ; not eof, stay in DATA state return ; return("DATA") global seof: inc numtry ; abort if we have been trying too much cmp numtry ,maxtry ; well ? blos 10$ ; no, keep it up movb #STA.ABO,r1 ; yes, return("ABORT") br 100$ ; exit 10$: tst skipfl ; skipping the rest of a file ? beq 20$ ; no spack #'Z,paknum,#1,#220$ ; yes, send D in data field br 30$ 20$: spack #'Z,paknum,#0,#null ; send an EOF packet out now 30$: rpack r2,r3,#recpkt ; get the reply please scan r1,#200$ ; and take action on the reply asl r0 ; dispatch based on the packet type jsr pc ,@210$(r0) ; simple 100$: return ; bye 200$: .byte 'E&137 ,'N&137 ,'Y&137 ,timout ,badchk ,0 .even 210$: .word seof.$ .word seof.e ,seof.n ,seof.y ,seof$$ ,seof$$ 220$: .byte 'D&137 ,0 .sbttl handle the response to the packet sent by seof seof.$: movb #STA.ABO,r1 ; unrecognized packet type return seof$$: movb state ,r1 ; timeout, stay in current state return ; and exit seof.e: calls prerrp ,<#recpkt> ; print out received error packet return seof.n: dec r3 ; a NAK, see if it's for the last bge 10$ ; packet mov #63. ,r3 ; --paknum<0 ? 63:paknum 10$: cmp r3 ,paknum ; same one ? beq 20$ ; yes movb state ,r1 ; no, continue on as before then return ; bye 20$: call seof.y ; last packet, handle the kac return seof.y: cmp r3 ,paknum ; correct packet number beq 10$ ; yes movb state ,r1 ; no, return the last state return 10$: clr numtry ; clear the retry count incm64 paknum ; paknum := (paknum+1) mod 64 calls close ,<#lun.in> ; close the input file clr inopn ; input file is now closed cmp index ,#-1 ; force a break here from user beq 20$ ; yes call getnxt ; get the next input file ? tst r0 ; did it work ? bne 20$ ; no tst xmode bne 20$ movb #STA.FIL,r1 ; yes, set new state to "FILE" return 20$: movb #STA.BRK,r1 ; return("BREAK") return .sbttl recsw state table controller for receiving files recsw:: clr paknum ; packet_number := 0 rec.sw::movb @r5 ,state ; assume RECEIVE-INIT for starters clr cccnt ; control_c_count := 0 mov $image ,image ; insure correct default for mode movb #defchk ,chktyp ; reset checksum type to default mov #1 ,chksiz ; the size of the checksum clr numtry ; number_trys := 0 clr oldtry ; add pcnt.r+0,reccnt ; save rec packet count call clrsta ; clear the stats out now clr outopn ; say nothing is open now tst remote ; local or remote bne 5$ ; remote call ttrini ; perhaps special init for local tt: 5$: call rechdr 10$: call recdeb ; perhaps debugging should be done scan state ,#200$ ; case state of asl r0 ; dispatch to correct routine jsr pc ,@210$(r0) bcc 10$ 100$: movb #defchk ,chktyp ; reset type of checksum to 1 mov #1 ,chksiz ; the size of the checksum save ; insure files are closed tst remote ; remote or local bne 105$ ; remote call ttrfin ; local, perhaps clean up console 105$: tst outopn ; file open from a failure ? beq 110$ ; no calls close ,<#lun.ou> ; insure that it's closed clr outopn 110$: unsave ; pop exit status code please return 200$: .byte 'R&137 ,'F&137 ,'D&137 ,'C&137 ,'A&137 ,0 .even 210$: .word recs.$ .word recs.r ,recs.f ,recs.d ,recs.c ,recs.a recs.$: clc ; Unknown state return ; back to caller recs.r: call rinit ; receive-init movb r1 ,state ; set state and exit clc ; saying there is more to come return ; bye recs.f: call rfile ; receive-file movb r1 ,state clc return recs.d: call rdata ; receive-data movb r1 ,state clc return recs.c: clr r0 ; complete sec return recs.a: mov sp ,r0 ; abort sec return global .sbttl debugging and logging for receive recdeb: save sub #50 ,sp mov sp ,r1 ; allocate a small buffer mov #200$ ,r2 ; point to a header 10$: movb (r2)+ ,(r1)+ ; copy a header please bne 10$ ; until we find a null dec r1 ; all done movb state ,(r1)+ ; copy the current state over movb #40 ,(r1)+ ; sub sp ,r1 ; get the record length mov sp ,r0 ; and point back to the record bit #log$st ,trace ; debugging for RECSW beq 30$ ; if trace is on then dump the calls putrec ,; dump it 30$: tst debug ; terminal debugging on ? beq 40$ ; no print r0 ,r1 .newli ; and a crlf 40$: tst remote ; running locally ? bne 100$ ; no tst xmode ; simply printing text to ti: ? bne 100$ ; yes, skip the packet stats then call reclog 100$: add #50 ,sp unsave return 200$: .asciz /Recsw - state is / .even global .sbttl rinit receive initialization ; R I N I T ; ; input: nothing .enabl lsb rinit: save ; get registers we use saved inc numtry ; check for retry count cmp numtry ,maxtry ; been here too often ? blos 10$ ; no movb #STA.ABO,r1 ; yes, return ABORT state br 100$ 10$: rpack r2,r3,#packet ; get the next packet please scan r1,#200$ ; look for the packet type asl r0 ; and dispatch to it jsr pc ,@210$(r0) ; simple 100$: unsave return 200$: .byte 'S&137 ,'E&137 ,timout ,badchk ,0 .even 210$: .word rini.$ .word rini.S ,rini.E ,rini$$ ,rini$$ .dsabl lsb rini.$: movb #STA.ABO,r1 return rini$$: spack #'N,paknum,#0,#null ; error, send a NAK movb state ,r1 ; and exit return rini.e: calls prerrp ,<#packet> movb #STA.ABO,r1 return rini.s: calls rpar ,<#packet,r2> ; SEND-INIT calls spar ,<#packet> ; get other sides init and fill with spack #'Y,paknum,sparsz,#packet; ours mov numtry ,oldtry clr numtry incm64 paknum ; paknum := (paknum+1) mod 64 movb #STA.FIL,r1 ; state := FILE-RECEIVE return .sbttl rfile receive file header rfile: save ; get registers we use saved call clratr ; insure attribute stuff is cleared movb conpar+p.chkt,chktyp ; time to use new checksum ? movb chktyp ,chksiz ; compute the checksum size also sub #'0 ,chksiz ; simple mov $image ,image ; insure correct default for mode inc numtry ; check for retry count cmp numtry ,maxtry ; been here too often ? blos 5$ ; no movb #STA.ABO,r1 ; yes, return ABORT state br 100$ 5$: tst xgottn ; already get the x packet ? beq 10$ ; no movb #'X&137 ,r1 ; yes, fake that we already got it br 20$ 10$: rpack r2,r3,#packet ; get the next packet please 20$: scan r1,#200$ ; look for the packet type asl r0 ; and dispatch to it jsr pc ,@210$(r0) ; simple 100$: unsave return 200$: .byte 'S&137 ,'Z&137 ,'F&137 ,'B&137 ,'E&137 ,'X&137 .byte timout ,badchk ,0 .even 210$: .word rfil.$ .word rfil.s ,rfil.z ,rfil.f ,rfil.b ,rfil.e ,rfil.x .word rfil$$ ,rfil$$ .sbttl more rfile rfil.$: movb #STA.ABO,r1 ; default, unknown packet type return ; bye rfil$$: spack #'N,paknum,#0,#null ; timeout or checksum error, send movb state ,r1 ; NAK and continue in current state return rfil.b: cmp r3 ,paknum ; Break XMIT (EOT) beq 10$ ; insure BREAK is for current packet movb #STA.ABO,r1 ; no, return 'ABORT" return 10$: spack #'Y,paknum,#0,#null ; ACK the BREAK movb #'C&137 ,r1 ; and return state as 'COMPLETE' return rfil.e: calls prerrp ,<#packet> ; error packet, print it out movb #STA.ABO,r1 ; return 'ABORT' return rfil.s: inc oldtry ; SEND-INIT, must have lost ours cmp oldtry ,maxtry ; tried this too many times ? blos 10$ ; no movb #STA.ABO,r1 ; yes, return 'ABORT' return 10$: mov paknum ,r1 ; see if thispacket=(paknum+63) mod 64 add #77 ,r1 ; ie, check if this data packet was the clr r0 ; one sent the last time. if so, we div #100 ,r0 ; must reack that packet and remain clr r0 ; in the current state. cmp r3 ,r1 ; bne 20$ ; no calls spar ,<#packet> ; resend our SEND-INIT stuff spack #'Y,r3,sparsz,#packet ; reack this then clr numtry ; clear out retry counter movb state ,r1 ; and return current state return 20$: movb #STA.ABO,r1 ; otherwise return ABORT since we must return ; be way out of synch then. rfil.z: inc oldtry ; END-OF-FILE ? cmp oldtry ,maxtry ; tried this too many times ? blos 10$ ; no movb #STA.ABO,r1 ; yes, return 'ABORT' return 10$: mov paknum ,r1 ; see if thispacket=(paknum+63) mod 64 add #77 ,r1 ; ie, check if this data packet was the clr r0 ; one sent the last time. if so, we div #100 ,r0 ; must reack that packet and remain clr r0 ; in the current state. cmp r3 ,r1 ; bne 20$ ; not the last one after all spack #'Y,r3,#0,#null ; reack this then clr numtry ; clear out retry counter movb state ,r1 ; and return current state return 20$: movb #STA.ABO,r1 ; otherwise return ABORT since we must return ; be way out of synch then. .sbttl more rfile subroutines ; Move the actual file create to RDATA so we can create ; the output file after all attribute packets have come. ; Thus, when we get the first DATA packet is when we go ; and create the file. ; ; 18-Apr-84 10:24:45 Brian Nelson rfil.f: cmp r3 ,paknum ; FILE name beq 10$ ; insure correct packet numer movb #STA.ABO,r1 ; no, return 'ABORT' return ; bye 10$: calls fparse ,<#packet,#filnam>; parse and fill in defaults tst outopn ; output already open as if from beq 20$ ; a NAK or something calls close ,<#lun.ou> ; yes, close it please clr outopn ; it's closed 20$: spack #'Y,paknum ; please ack the fileheader packet mov numtry ,oldtry ; update number of retrys clr numtry ; and init the current retry count incm64 paknum ; paknum := (paknum+1) mod 64 movb #'D&137 ,r1 ; return 'DATA' return rfil.x: cmp r3 ,paknum ; X header name beq 10$ ; insure correct packet numer movb #STA.ABO,r1 ; no, return 'ABORT' return ; bye 10$: spack #'Y,paknum,#0,#null ; ACK the filename clr outlun ; not a real file to output to clr outopn ; nothing is open for output mov sp ,xmode ; flag this also please mov numtry ,oldtry ; update number of retrys clr numtry ; and init the current retry count incm64 paknum ; paknum := (paknum+1) mod 64 movb #'D&137 ,r1 ; return 'DATA' return global global .sbttl rdata receive data from pc ; R D A T A ; ; input: nothing ; output: global paknum packet number ; oldtry retry count ; packet packet just received ; numtry ; r1 returned state rdata: save clr r0 ; error := 0 inc numtry ; abort of retry count is too large cmp numtry ,maxtry ; been here too many times ? blos 10$ ; no movb #STA.ABO,r1 ; yes, return state(abort) br 100$ ; bye 10$: rpack r2,r3,#packet ; get the next imcoming packet scan r1 ,#200$ ; look for the packet type and dispatch asl r0 ; to the correct routine. ie, a crude jsr pc ,@210$(r0) ; case statement 100$: unsave return 200$: .byte 'A&137 ,'D&137 ,'E&137 ,'F&137 ,'Z&137 ,'X&137 .byte timout ,badchk ,0 .even 210$: .word rdat.$ .word rdat.a ,rdat.d ,rdat.e ,rdat.f ,rdat.z ,rdat.x .word rdat$$ ,rdat$$ global .sbttl rdata packet handlers rdat.$: movb #STA.ABO,r1 ; case default: return ABORT return rdat.d: tst xmode ; do we need to create the file bne 10$ ; no tst outopn ; did we already open the file up? bne 10$ ; yes, please don't try again then. calls create ,<#filnam,#lun.ou,image>; now create it tst r0 ; did the file create work ? beq 5$ ; yes mov #lun.ou ,outlun ; set a real LUN for output calls syserr , ; no, get the system error text calls error ,<#3,#230$,#errtxt,#filnam> movb #STA.ABO,r1 ; return 'ABORT' return 5$: calls fillog ,<#0,#filnam> ; log to disk perhaps ? calls printm ,<#2,#240$,#filnam> mov sp ,outopn ; flag output as being open mov #lun.ou ,outlun ; set a real LUN for output 10$: cmp r3 ,paknum ; case "D" beq 40$ ; Correct packet number ? inc oldtry ; no, see if retry limit expired cmp oldtry ,maxtry ; if so, return ABORT blos 20$ ; no movb #STA.ABO,r1 ; yes, return 'ABORT' return ; bye 20$: mov paknum ,r1 ; see if thispacket=(paknum+63) mod 64 add #77 ,r1 ; ie, check if this data packet was the clr r0 ; one sent the last time. if so, we div #100 ,r0 ; must reack that packet and remain clr r0 ; in the current state. cmp r3 ,r1 ; insure r0 is not affected bne 30$ ; not the last packet spack #'Y,r3,#6,#packet ; reack this then clr numtry ; clear out retry counter movb state ,r1 ; and return current state return 30$: movb #STA.ABO,r1 ; otherwise return ABORT since we must return ; be way out of synch then. 40$: calls bufemp ,<#packet,r2> ; correct packet, get the data out mov r0 ,-(sp) ; save error code from BUFEMP tst remote ; are we a local kermit today ? bne 50$ ; no, just ack normally tst cccnt ; we are local. check for control bne 45$ ; c abort for this file please call chkabo ; check for abort via ^X and ^Z cmpb r0 ,#'Z&37 ; did the user type a control Z? beq 45$ ; yes cmpb r0 ,#'X&37 ; no, what about a control X then? bne 50$ ; no spack #'Y,paknum,#1,#220$ ; ^X typed, send an X in the data br 60$ 45$: spack #'Y,paknum,#1,#210$ ; yes, send an ACK with "Z" data br 60$ ; 50$: spack #'Y,paknum,#0,#null ; ack it 60$: mov numtry ,oldtry ; oldtry_count:= numtry clr numtry ; numtry := 0 incm64 paknum ; increment packet number mod 64 mov (sp)+ ,r0 ; check error from BUFEMP beq 70$ ; ok calls syserr , ; it failed, send error packet calls error ,<#2,#200$,#errtxt> movb #STA.ABO,r1 ; and return ABORT return 70$: movb #'D&137 ,r1 ; switch to data state return ; bye global 200$: .asciz /Remote KERMIT error: / 210$: .byte 'Z&137,0 220$: .byte 'X&137,0 230$: .asciz /Create failed - / 240$: .asciz /Created file - / .even .sbttl rdata subroutines, continued ; 'F', got a FILE HEADER rdat.x: ; 'X', also handle EXTENED REPLY rdat.f: inc oldtry ; no, see if retry limit expired cmp oldtry ,maxtry ; if so, return ABORT blos 10$ ; no movb #STA.ABO,r1 ; yes, return 'ABORT' return ; bye 10$: mov paknum ,r1 ; see if thispacket=(paknum+63) mod 64 add #77 ,r1 ; ie, check if this data packet was the clr r0 ; one sent the last time. if so, we div #100 ,r0 ; must reack that packet and remain clr r0 ; in the current state. cmp r3 ,r1 ; bne 20$ ; not the last packet spack #'Y,r3,#0,#null ; reack this then clr numtry ; clear out retry counter movb state ,r1 ; and return current state return 20$: movb #STA.ABO,r1 ; else return ABORT return rdat.e: calls prerrp ,<#packet> ; flag error, print it movb #STA.ABO,r1 ; return ABORT return rdat.z: cmp paknum ,r3 ; END OF FILE. If not correct packet beq 10$ ; the return 'ABORT' movb #STA.ABO,r1 return 10$: mov #lun.ou ,r2 ; assume that we close a disk file tst outopn ; real output or to the terminal bne 20$ ; it's a for real disk file today clr r2 ; no, it's the console terminal 20$: calls close , ; do the close now call clratr ; attributes no longer valid clr outopn ; flag it spack #'Y,r3,#0,#null ; acknowledge the eof packet incm64 paknum ; paknum := (paknum+1) mod 64 movb #STA.FIL,r1 ; back to receive file state clr xgottn ; don't have an X packet anymore return rdat$$: spack #'N,paknum,#0,#null ; timed out or checksum error movb state ,r1 ; NAK it and return current state return global .sbttl receive data attribute packets rdat.a: cmp r3 ,paknum ; case "A" beq 40$ ; Correct packet number ? inc oldtry ; no, see if retry limit expired cmp oldtry ,maxtry ; if so, return ABORT blos 20$ ; no movb #STA.ABO,r1 ; yes, return 'ABORT' return ; bye 20$: mov paknum ,r1 ; see if thispacket=(paknum+63) mod 64 add #77 ,r1 ; ie, check if this data packet was the clr r0 ; one sent the last time. if so, we div #100 ,r0 ; must reack that packet and remain clr r0 ; in the current state. cmp r3 ,r1 ; insure r0 is not affected bne 30$ ; not the last packet spack #'Y,r3 ; reack this then clr numtry ; clear out retry counter movb state ,r1 ; and return current state return 30$: movb #STA.ABO,r1 ; otherwise return ABORT since we must return ; be way out of synch then. 40$: calls r$attr ,<#packet> ; simple tst r0 ; was this successful ? bne 50$ ; no spack #'Y,paknum mov numtry ,oldtry ; oldtry_count:= numtry clr numtry ; numtry := 0 incm64 paknum ; increment packet number mod 64 movb state ,r1 ; retain current state br 100$ ; all done 50$: movb #STA.ABO,r1 ; new state br 100$ ; bye 100$: return ; exti 200$: .asciz /Attribute packet error - / .even .sbttl spack send packet ; S P A C K $ ; ; spack$(%val type,%val num,%val len, %loc data) ; ; input: @r5 type of packet ; 2(r5) packet number ; 4(r5) length of the packet ; 6(r5) location of the data to send ; output: r0 error status spack$: save ; save registers that we may use call spakwa call spakin sub #200 ,sp ; allocate a buffer mov sp ,r4 ; point to the buffer clr -(sp) ; count the total length setpar #SOH ,(r4)+ ; start all packets with control A mov r4 ,r2 ; get address for checksum compute inc @sp ; packetlength := succ(packetlength) mov 4(r5) ,r0 ; the length of the packet cmp r0 ,#maxpak ; packet too large ? blos 25$ ; no mov #maxpak ,r0 ; yes, reset packet size please 25$: add #2 ,r0 ; + two for number and type add chksiz ,r0 ; + the length of the checksum please clr r1 ; accumulated checksum tochar r0 ,r1 ; start the checksum out right setpar r1 ,(r4)+ ; and stuff length into the packet inc @sp ; packetlength := succ(packetlength) tochar 2(r5) ,r0 ; convert the packet number now setpar r0 ,(r4)+ ; and stuff it into the packet inc @sp ; packetlength := succ(packetlength) movb @r5 ,r0 ; get the packet type now bicb #40 ,r0 ; insure UPPER CASE packet type setpar r0 ,(r4)+ ; insert the packet type into buffer inc @sp ; packetlength := succ(packetlength) mov 4(r5) ,r1 ; get the data length beq 40$ ; nothing to do mov 6(r5) ,r3 ; address of the data to send cmp r1 ,#maxpak ; too much data ? blos 30$ ; no mov #maxpak ,r1 ; yes, fix it please 30$: clr r0 ; get the next character bisb (r3)+ ,r0 ; next char setpar r0 ,(r4)+ ; now move the data byte into the buffer inc @sp ; packetlength := succ(packetlength) sob r1 ,30$ ; next please 40$: clrb @r4 ; set .asciz for call to checks mov r2 ,-(sp) ; starting address for checksum field call checks ; simple mov (sp)+ ,r2 ; get the computed checksum now call spakck ; stuff checksum into buffer now add r0 ,@sp ; and the length of the checksum movb conpar+p.eol,(r4)+ ; end of line needed ? inc @sp ; packetlength := succ(packetlength) mov (sp)+ ,r1 ; packet length mov sp ,r4 ; address(buffer) calls binwri ,; and dump the buffer out now call spakfi ; handle ibm stuff if possible 100$: add #200 ,sp ; pop the buffer unsave ; pop registers that we used return global .sbttl spack routines spakin::bit #log$pa ,trace ; tracing today ? beq 5$ ; no calls dskdmp ,<#200$,4(r5),@r5,2(r5),6(r5)> 5$: tst pauset ; wait a moment ? beq 6$ ; no calls suspend , ; yes 6$: mov #conpar+p.padc,r2 ; address of the pad character ? clr r1 bisb conpar+p.npad,r1 ; send some pad characters ? tst r1 beq 20$ ; no padding 10$: calls binwri ,; send some padding sob r1 ,10$ ; next please 20$: movb @r5 ,r1 ; the packet type next cmpb r1 ,#'A&137 ; a legitimate packet type ? blo 30$ ; no cmpb r1 ,#'Z&137 ; must be in the range A..Z bhi 30$ ; no good sub #100 ,r1 ; convert into range 1..26 asl r1 ; and count the packet type inc pcnt.s(r1) ; pakcount(type):=pakcount(type)+1 inc pcnt.s+0 30$: return 200$: .asciz /SPACK - / .even spakck: clr r0 ; checksum.len := 0 cmpb chktyp ,#defchk ; if checklength > 6 bits blos 20$ ; then begin cmpb chktyp ,#'3 ; if checktype = CRC16 bne 10$ ; then begin mov r2 ,r1 ; checkchar1:=tochar(check[12..15]) ash #-14 ,r1 ; shift over 12 bits bic #^C17 ,r1 ; mask off the high 12 bits tochar r1 ,@r4 setpar @r4 ,(r4)+ inc r0 ; packetlength := succ(packetlength) ; end 10$: mov r2 ,r1 ; checkchar1 := tochar(check[6..11]) ash #-6 ,r1 ; shift over 6 bits bic #^C77 ,r1 ; mask off the higher order bits tochar r1 ,@r4 setpar @r4 ,(r4)+ inc r0 ; packetlength := succ(packetlength) bic #^C77 ,r2 ; now drop the high bits from checks 20$: tochar r2 ,@r4 tst ranerr ; insert random checksum errors? beq 40$ ; no, please don't mov r0 ,-(sp) ;+ test mode call irand ;+ test mode tst r0 ;+ test mode bne 30$ ;+ test mode incb @r4 ;+ test mode 30$: mov (sp)+ ,r0 ;+ test mode 40$: setpar @r4 ,(r4)+ inc r0 ; packetlength := succ(packetlength) return global .sbttl try to handle half duplex handshake garbage ala IBM (barf) spakfi: save ; don't do this forever please call 200$ ; dump raw i/o first please unsave return 200$: bit #log$io ,trace ; dumping all i/o out ? beq 230$ ; no save ; save these please mov r1 ,r2 ; anything to do ? beq 220$ ; no 210$: clr r0 ; yes, dump ch by ch please bisb (r4)+ ,r0 ; get the next ch to dump mov #lun.lo ,r1 ; the lun to write to call putcr0 ; simple sob r2 ,210$ ; next please 220$: unsave ; pop and exit 230$: return ; bye global spakwa: save tstb handch ; any paritcular handshake char today? beq 100$ ; no, just exit please scan @r5 ,#200$ tst r0 bne 100$ mov #200 ,r2 ; a limit on looping please 10$: calls binrea ,<#lun.ti,#4> ; wait for XON, max 4 seconds please tst r0 ; did the read timeout. if so, exit. bne 90$ ; exit and try to xon the link bicb #200 ,r1 ; insure no parity is set cmpb r1 ,handch ; is this the handshake character beq 100$ ; no, try again please sob r2 ,10$ ; not forever, please br 100$ ; bye 90$: save ; save error flags calls ttxon ,<#ttname,#lun.ti>; get the line turned on again please unsave ; pop error 100$: unsave ; pop loop index return 200$: .byte msg$snd .byte msg$ser .byte msg$rcv .byte msg$command .byte msg$generic .byte 0 .even .sbttl rpack$ read incoming packet ; R P A C K $ ; ; rpack$(%loc data) ; ; input: @r5 buffer address ; 2(r5) data structure of 3 words to contain the ; returned length, number and type ; ; output: r0 error code if < 0, packet type if > 0 ; 255 for checksum error ; o$len = 0 ; offset for retruned packet length o$num = 2 ; offset for returned packet number o$type = 4 ; offset for returned packet type ; ; word 2 packet type ; word 1 packet number ; as in: 2(r5) ------> word 0 packet length ; ; ; ; local data offsets from r4 (allocated on the stack ; .done = 0 ; if <> 0 then we have the packet .type = 2 ; current type of packet .ccheck = 4 ; computed checksum .rcheck = 6 ; received checksum .len = 10 ; received pakcet length .timeo = 12 ; current timeout .num = 14 ; packet number, received .size = 16 ; current size of data portion .paksi = 20 ; for loop control for data portion .lsize = 22 ; total size of local data ; internal register usage: ; ; r0 error return ; r1 current character just read from remote ; r3 pointer to temp buffer containing the packet less the SOH ; and the checksum, used for computing checksum after the ; packet has been read. ; r4 pointer to local r/w data ; r5 pointer to argument list .sbttl rpack continued rpack$: save sub #.lsize ,sp ; allocate space for local data mov sp ,r4 ; and point to it please sub #200 ,sp ; allocate temp buffer for storing mov sp ,r3 ; the packet less SOH and checksum call rpakin call waitsoh ; wait for a packet to start tst r0 ; did it work or did we timeout beq 10$ ; yes jmp 95$ ; we must have timed out then 10$: tst .done(r4) ; while not done do bne 90$ ; begin call rpakrd ; read(input,ch); bcs 95$ ; exit if error; clrpar r1 ; ch := ch and chr(177B); cmpb r1 ,#SOH ; if ch = SOH then resynch beq 80$ ; movb r1 ,(r3)+ ; checkpacket++ := ch unchar r1 ,r0 ; len := unchar(ch)-2-checksum_size sub #2 ,r0 ; sub chksiz ,r0 ; bge 15$ ; if datalength < 0 add chksiz ,r0 ; then dec r0 ; len := len + checksum_size - 1 movb #defchk ,chktyp ; checksum_type := default_type mov #1 ,chksiz ; checksum_len := 1 15$: mov r0 ,.len(r4) ; call rpakrd ; read(input,ch) bcs 95$ ; exit if error clrpar r1 ; ch := ch and chr(177B) cmpb r1 ,#SOH ; if ch = SOH then resynch beq 80$ ; movb r1 ,(r3)+ ; checkpacket++ := ch unchar r1 ,.num(r4) call rpakrd ; read(input,ch) bcs 95$ ; exit if error clrpar r1 ; ch := ch and chr(177B) cmpb r1 ,#SOH ; if ch = SOH then resynch beq 80$ ; movb r1 ,(r3)+ ; checkpacket++ := ch mov r1 ,.type(r4) ; packet_type := ch mov .len(r4),.paksi(r4) ; loop for the data, if any mov @r5 ,r2 ; point to the buffer now 20$: tst .paksi(r4) ; for i := 1 to len do beq 30$ ; begin call rpakrd ; read(input,ch) bcs 95$ ; exit if error clrpar r1 ; ch := ch and chr(177B) cmpb r1 ,#SOH ; if ch = SOH then resynch beq 80$ ; cmp .size(r4),#maxpak ; if currentsize < MAXPAKSIZE bhis 25$ ; then movb r1 ,(r2)+ ; data[i] := ch movb r1 ,(r3)+ ; checkpacket++ := ch ; end 25$: inc .size(r4) ; currentsize:=succ(currentsize) dec .paksi(r4) ; nchar_left := nchar_left - 1 br 20$ ; end 30$: clrb @r2 ; data[len] := NULL clrb @r3 ; checkpacket++ := null mov sp ,r3 ; reset base address of checkpacket call rpakck ; read the checksum now bcs 95$ ; exit on line error (like timeout) mov sp ,.done(r4) 80$: br 10$ 90$: call rpakfi ; finish checksum and return the br 100$ 95$: mov 2(r5) ,r1 ; timeout error, flag no packet clr r0 ; nonfatal error for timout mov #timout ,o$type(r1) ; return as psuedo packet type mov #timout ,.type(r4) ; return as psuedo packet type call rpakst ; do stats and disk dumping now 100$: add #.lsize+200,sp ; pop local data + local buffer unsave return global .sbttl subroutines for RPACK only rpakrd: calls binrea ,<#lun.ti,.timeo(r4)>; read(input,ch) tst r0 ; did it work bne 110$ ; no call rawio ; perhaps raw i/o logging bit #log$rp ,trace ; dump to a local terminal ? beq 20$ ; no cmpb r1 ,#SOH ; start of a packet ? beq 10$ ; yes movb r1 ,-(sp) ; yes, stuff the ch onto the stack mov sp ,r1 ; point to it print r1 ,#1 ; dump it clr r1 ; restore what we read and exit bisb (sp)+ ,r1 ; restore it and exit br 20$ ; bye 10$: print #200$ ; start of a packet 20$: clr r0 ; no errors clc ; it worked return ; bye 110$: save ; save the error code calls ttxon ,<#ttname,#lun.ti>; get the line turned on again please unsave ; restore the error code sec ; flag the error return ; bye 200$: .asciz // .even rpakin: clr .done(r4) ; done := false clr .type(r4) ; packettype := 0 clr .ccheck(r4) ; checksum := 0 clr .rcheck(r4) ; received_checksum := 0 clr .len(r4) ; current length := 0 clr .num(r4) ; packet_number := 0 clr .timeo(r4) ; timeout := 0 clr .size(r4) ; current size of data part of packet clr .paksi(r4) ; loop control for data of packet mov @r5 ,r0 ; initialize the buffer to null mov #40 ,r1 10$: clrb (r0)+ ; simple clrb (r0)+ ; simple sob r1 ,10$ mov 2(r5) ,r0 ; return parameters clr (r0)+ ; packet.length := 0 clr (r0)+ ; packet.number := 0 clr (r0)+ ; packet.type := 0 call settmo mov r0 ,.timeo(r4) return settmo: mov sertim ,r0 ; if waiting for server command bne 20$ ; then use that timeout clr r0 ; bisb conpar+p.time,r0 ; get the remotes timeout bne 10$ ; ok mov #mytime ,r0 ; no good, setup a timeout 10$: cmpb r0,setrec+p.time ; use SET TIMEOUT value if > bhis 20$ ; no, use the timeout as in clr r0 ; ok, use the value the user said bisb setrec+p.time,r0 ; in the SET TIMEOUT command bne 20$ ; must be > 0 by now mov #mytime ,r0 ; no ?? 20$: return global .sbttl finish up rpack rpakfi: mov r3 ,-(sp) ; compute correct checksum type call checks ; simple mov (sp)+ ,.ccheck(r4) ; and stuff it in please cmpb .ccheck(r4),.rcheck(r4) ; compare computed checksum with the beq 100$ ; actual checksum mov #badchk ,.type(r4) ; flag checksum error 100$: mov 2(r5) ,r1 ; where to return some things mov .len(r4),o$len(r1) ; return the packet length mov .type(r4),o$type(r1) ; and the packet type mov .num(r4),o$num(r1) ; and at last, the packet number call rpakst ; do stats and logging now call rpaklo ; possibly log checksum errors? return rpakst: cmpb .type(r4),#'A&137 ; count the packet types for stats blo 110$ ; bad packet type cmpb .type(r4),#'Z&137 ; must in the range A..Z bhi 110$ ; definiately a bad packet movb .type(r4),r1 ; packet is ok, add it to the stats sub #100 ,r1 ; convert to 1..26 asl r1 ; to word offsets inc pcnt.r(r1) ; simple inc pcnt.r+0 110$: bit #log$pa ,trace ; tracing today ? beq 120$ ; no calls dskdmp ,<#200$,.len(r4),.type(r4),.num(r4),@r5> 120$: return 200$: .asciz /RPACK - / .even rpaklo: save cmp .rcheck(r4),.ccheck(r4) ; checksums match ? beq 100$ ; yes, do nothing then bit #log$io ,trace ; not if in raw i/o mode bne 100$ ; forget it sub #60 ,sp ; dump bad checksums out to disk mov sp ,r1 ; point to the buffer copyz #200$ ,r1 ; a header strlen r1 ; length so far add r0 ,r1 ; point to the end of it deccvt .rcheck(r4),r1 ; convert to decimal add #6 ,r1 ; move along please deccvt .ccheck(r4),r1 ; the calculated checksum add #6 ,r1 ; make it .asciz clrb @r1 ; simple mov sp ,r1 ; point back to the buffer strlen r1 ; get the length calls putrec ,; dump buffer to disk add #60 ,sp ; pop buffer and exit 100$: unsave ; pop r0 and exit return 200$: .asciz /?Bad Checksum: rcv,calc are / .even global .sbttl read and convert the checksum for RPACK rpakck: save ; use r3 for accumulating check clr r3 ; assume zero for now call rpakrd ; read(input,ch) bcs 110$ ; exit if error bic #^c177 ,r1 ; ch := ch and 177B unchar r1 ,r3 ; received_check := ch cmpb chktyp ,#defchk ; if len(checksum) > 8bits blos 10$ ; then begin ash #6 ,r3 ; check := check * 64 call rpakrd ; read(input,ch) bcs 110$ ; exit if error bic #^c177 ,r1 ; ch := ch and 177B unchar r1 ,r1 ; ch := unchar(ch) bisb r1 ,r3 ; rcheck := rcheck + ch cmpb chktyp ,#'3 ; if checktype = CRC16 bne 10$ ; then ash #6 ,r3 ; begin call rpakrd ; check := check * 64 bcs 110$ ; check := check + ch bic #^c177 ,r1 ; ch := ch and 177B unchar r1 ,r1 ; bisb r1 ,r3 ; end ; 10$: clc br 120$ 110$: sec 120$: mov r3 ,.rcheck(r4) ; return the checksum unsave return .sbttl parity routines ; C L R P A R ; ; input: 2(sp) the character to clear parity for ; output: 2(sp) the result ; ; caller by CLRPAR macro ; ; If parity is set to anything but NONE then always ; clear the parity out else clear it if and only if ; filetype is not image mode. clrpar::tstb parity ; handle nothing please (no parity) beq 10$ ; yes cmpb parity ,#par$no ; set parity none used ? bne 20$ ; no, must be some other type 10$: tst image ; no parity, image mode today ? bne 100$ ; yes, leave things alone please 20$: bic #^C177 ,2(sp) ; no, clear bits 7-15 please 100$: return ; bye global .sbttl compute proper checksum please ; C H E C K S ; ; input: 2(sp) address of .asciz string to compute checksum for ; output: @sp the computed checksum checks::save ; save registers we may use mov 12(sp) ,r2 ; point to the string to do it for clr 12(sp) ; assume a zero checksum ? cmpb chktyp ,#'3 ; CRC-CCITT type today ? bne 5$ ; no strlen r2 ; yes, get the .asciz string length calls crcclc , ; compute the CRC16-CCITT mov r0 ,r2 ; stuff the result into r2 for later br 90$ ; and exit 5$: clr r1 ; init the checksum accumulator 10$: clr r3 ; get the next ch please bisb (r2)+ ,r3 ; got the next ch now beq 20$ ; hit the end of the string cmpb parity ,#par$no ; did the packet contain parity? beq 15$ ; no, leave bit 7 alone bic #^C177 ,r3 ; yes, please clear bit seven 15$: add r3 ,r1 ; check := check + ch br 10$ 20$: mov r1 ,r2 ; checksum := (((checksum and 300B)/64) cmpb chktyp ,#'2 ; 12 bit sum type checksum ? beq 30$ ; yes, just exit bic #^C300 ,r2 ; +checksum) and 77B) ash #-6 ,r2 ; add r1 ,r2 ; bic #^C77 ,r2 br 90$ 30$: bic #170000 ,r2 ; type 2 checksum 90$: mov r2 ,12(sp) ; return the checksum 100$: unsave ; exit return .sbttl crc calculation ; This routine will calculate the CRC for a string, using the ; CRC-CCIT polynomial. ; ; The string should be the fields of the packet between but ; not including the and the block check, which is ; treated as a string of bits with the low order bit of the ; first character first and the high order bit of the last ; character last -- this is how the bits arrive on the ; transmission line. The bit string is divided by the ; polynomial ; ; x^16+x^12+x^5+1 ; ; The initial value of the CRC is 0. The result is the ; remainder of this division, used as-is (i.e. not ; complemented). ; ; From 20KERMIT.MAC, rewritten for PDP11 by Brian Nelson ; 13-Jan-84 08:50:43 ; ; input: @r5 string address ; 2(r5) string length ; output: r0 crc crcclc::save ; save registers please clr r0 ; initialize the CRC to zero mov @r5 ,r3 ; get the string address now mov 2(r5) ,r4 ; get the string length beq 100$ ; oops, nothing to do then 10$: clr r1 ; get the next character please bisb (r3)+ ,r1 ; please avoid pdp11 sign extend cmpb parity ,#par$no ; did the packet have parity? beq 20$ ; no, leave bit seven alone bic #^C177 ,r1 ; yes, clear bit seven please 20$: ixor r0 ,r1 ; add in with the current CRC mov r1 ,r2 ; get the high four bits ash #-4 ,r2 ; and move them over to 3..0 bic #^C17 ,r2 ; drop any bits left over bic #^C17 ,r1 ; and the low four bits asl r1 ; times 2 for word addressing asl r2 ; times 2 for word addressing mov crctb2(r1),r1 ; get low portion of CRC factor ixor crctab(r2),r1 ; simple (limited modes for XOR) swab r0 ; shift off a byte from previous crc bic #^C377 ,r0 ; clear new high byte ixor r1 ,r0 ; add in the new value sob r4 ,10$ ; next please 100$: unsave ; pop saved r1-r5 return ; Data tables for CRC-CCITT generation crctab: .word 0 .word 10201 .word 20402 .word 30603 .word 41004 .word 51205 .word 61406 .word 71607 .word 102010 .word 112211 .word 122412 .word 132613 .word 143014 .word 153215 .word 163416 .word 173617 crctb2: .word 0 .word 10611 .word 21422 .word 31233 .word 43044 .word 53655 .word 62466 .word 72277 .word 106110 .word 116701 .word 127532 .word 137323 .word 145154 .word 155745 .word 164576 .word 174367 .sbttl clear stats out ; C L R S T A ; ; clear out the packet counts by packet type from the last ; transaction and add them into the total running count by ; packet type. clrsta: save ; save the registers we use mov #pcnt.r ,r1 ; packets received mov #totp.r ,r2 ; running count so far mov #34 ,r0 ; number of works to add/clear 10$: add @r1 ,(r2)+ ; add in the current totals clr (r1)+ ; and clear out the totals sob r0 ,10$ ; next please mov #pcnt.s ,r1 ; now for the packets sent mov #totp.s ,r2 ; where to add them in mov #34 ,r0 ; number of words to do 20$: add @r1 ,(r2)+ ; sum in the total sent count clr (r1)+ ; and clear them out sob r0 ,20$ ; next please unsave ; pop the registers we used return ; and exit global .sbttl waitsoh wait for a packet start (ascii 1, SOH) ; W A I T S O H ; ; input: nothing ; output: r0 error code ; r1 the SOH or NULL if we timed out waitsoh:clr r1 ; 10$: cmpb r1 ,#soh ; wait for a packet header please beq 100$ ; ok, exit call settmo ; get proper timeout set up calls binrea ,<#lun.ti,r0> ; read with timeout clrpar r1 tst r0 ; did the read work ? bne 20$ ; oops, just exit then call rawio br 10$ 20$: clr r1 100$: return global rawio: bit #log$io ,trace ; dumping all i/o today? beq 100$ ; no save ; yes, save these please clr r0 bisb r1 ,r0 ; and setup call to putcr0 mov #lun.lo ,r1 ; the unit to write to call putcr0 ; simple unsave ; pop these now 100$: return .sbttl BUFFIL buffer from the file that is being sent ; B U F F I L ; ; input: @r5 buffer address ; output: r0 rms sts error code ; r1 length of the string buffil: save ; save all registers we may use mov @r5 ,r4 ; point to the destination address clr r3 ; use as a length counter 10$: mov #lun.in ,r0 ; while error = 0 do call getcr0 ; begin tst r0 ; ch := infile@; bne 90$ ; get(infile); tst do8bit ; exit if status <> success; beq 15$ ; if need_8_bit_prefix tstb r1 ; and bit_test(ch,200B) bpl 15$ ; then begin movb ebquot ,(r4)+ ; buffer[i] := eight_bit_quote inc r3 ; i := succ(i) bicb #200 ,r1 ; ch := bit_clear(ch,200b) 15$: clr r2 ; end ; bisb r1 ,r2 ; ch0_7 := ch bic #^C177 ,r2 ; ch0_7 := ch0_7 and 177B cmpb r2 ,#space ; if ch0_7 < space blo 20$ ; or cmpb r2 ,#del ; ch0_7 = del beq 20$ ; or cmpb r2 ,senpar+p.qctl ; ch0_7 = quote beq 20$ ; or tst do8bit ; ( need_8_bit_prefix beq 40$ ; and (ch0_7=sendpar.qbinary) ) cmpb r2 ,ebquot ; bne 40$ ; then ; begin 20$: movb senpar+p.qctl,(r4)+ ; buffer[i] := quote inc r3 ; length := succ(length) cmpb r2 ,senpar+p.qctl ; if ch0_7 <> quote beq 30$ ; then begin ctl r1 ,r1 ; ch := ctl(ch) ctl r2 ,r2 ; ch0_7 := ctl(ch0_7) end 30$: ; end 40$: tst image ; if image_mode beq 50$ ; then movb r1 ,(r4)+ ; buffer[i] := ch br 60$ ; else 50$: movb r2 ,(r4)+ ; buffer[i] := ch0_7 60$: inc r3 ; length := succ( length ) 70$: clr -(sp) bisb conpar+p.spsiz,@sp ; exit if length > spsize-8 sub #12 ,@sp ; cmp r3 ,(sp)+ ; blo 10$ ; end 90$: mov r3 ,r1 ; return the length please beq 100$ ; nothing there clr r0 ; say read was successful 100$: unsave ; and exit return global .sbttl bufpak buffil but get data from a buffer ; input: @r5 source buffer, .asciz ; output: 2(r5) destination buffer ; r0 zero (ie, no errors are possible) ; r1 string length ; ; No 8 bit prefixing and no repeat counts will be done. ; This routine is used for encoding string to be sent as ; generic commands to a server. bufpak::save ; save all registers we may use mov 2(r5) ,r4 ; point to the destination address mov @r5 ,r5 ; the source string clr r3 ; use as a length counter 10$: clr r1 ; ch := buffer[i] bisb (r5)+ ,r1 ; avoid PDP-11 sign extension beq 90$ ; clr r2 ; bisb r1 ,r2 ; ch0_7 := ch ' bic #^C177 ,r2 ; ch0_7 := ch0_7 and 177B cmpb r2 ,#space ; if ch0_7 < space blo 20$ ; or cmpb r2 ,#del ; ch0_7 = del beq 20$ ; or cmpb r2 ,senpar+p.qctl ; ch0_7 = quote bne 40$ ; then ; begin 20$: movb senpar+p.qctl,(r4)+ ; buffer[i] := quote inc r3 ; length := succ(length) cmpb r2 ,senpar+p.qctl ; if ch0_7 <> quote beq 30$ ; then begin ctl r1 ,r1 ; ch := ctl(ch) ctl r2 ,r2 ; ch0_7 := ctl(ch0_7) end 30$: ; end 40$: tst image ; if image_mode beq 50$ ; then movb r1 ,(r4)+ ; buffer[i] := ch br 60$ ; else 50$: movb r2 ,(r4)+ ; buffer[i] := ch0_7 60$: inc r3 ; length := succ( length ) 70$: clr -(sp) bisb conpar+p.spsiz,@sp ; exit if length > spsize-8 bne 80$ ; if spsiz = 0 mov #maxpak ,@sp ; then maxsize := #maxpak 80$: sub #10 ,@sp ; cmp r3 ,(sp)+ ; blo 10$ ; end 90$: mov r3 ,r1 ; return the length please clr r0 ; say read was successful unsave ; and exit return .sbttl bufemp dump a buffer out to disk ; B U F E M P ; ; bufemp(%loc buffer,%val len) ; ; input: @r5 buffer address ; 2(r5) length ; output: r0 error bufemp: save ; save temps as usual mov @r5 ,r2 ; input record address mov 2(r5) ,r3 ; string length clr r0 ; insure no error for a null packet 10$: tst r3 ; anything left in the record? beq 100$ ; no 20$: clr r0 ; get the next character bisb (r2)+ ,r0 ; into a convienient place dec r3 ; chcount := pred(chcount) clr set8bit ; assume we don't have to set bit 7 tst do8bit ; must we do 8 bit unprefixing? beq 60$ ; no cmpb r0 ,ebquot ; yes, is this the 8 bit prefix? bne 60$ ; no mov sp ,set8bit ; yes, send a flag to set the bit clr r0 ; and get the next character bisb (r2)+ ,r0 ; without sign extension dec r3 ; one less character left in buffer 60$: cmpb r0 ,conpar+p.qctl ; is this a quoted character? bne 70$ ; no clr r0 ; yes, get the next character bisb (r2)+ ,r0 ; must be one you know dec r3 ; chcount := pred(chcount) clr r1 ; must avoid sign extension here bisb r0 ,r1 ; check low 7 bits against quote bic #^C177 ,r1 ; drop 7..15 cmpb r1 ,conpar+p.qctl ; if ch <> myquote beq 70$ ; then cmpb r1 ,#77 ; and ch ge '?' blo 70$ ; then ctl r0 ,r0 ; ch := ctl(ch); 70$: tst set8bit ; do we need to set the high bit? beq 75$ ; no bisb #200 ,r0 ; yes, set the bit on please 75$: mov #lun.ou ,r1 ; channel_number := lun.out tst outopn ; is there really something open? bne 80$ ; yes, put the data to it clr r1 ; no, direct the output to a terminal 80$: call putcr0 ; and do it br 10$ ; next character please 100$: unsave return global .sbttl bufunpack like bufemp, but return data to a buffer ; input: @r5 source buffer, .asciz ; output: 2(r5) destination buffer ; r0 zero (ie, no errors are possible) ; r1 string length ; ; No 8 bit prefixing and no repeat counts will be done. ; This routine is used for decoding strings received for ; generic commands to the server. bufunp::save ; save temps as usual mov @r5 ,r2 ; input record address clr r3 ; length := 0 mov 2(r5) ,r4 ; resultant string 10$: clr r0 ; get the next character bisb (r2)+ ,r0 ; into a convienient place beq 100$ cmpb r0 ,senpar+p.qctl ; is this a quoted character? bne 30$ ; no clr r0 ; yes, get the next character bisb (r2)+ ,r0 ; must be one you know clr r1 ; must avoid sign extension here bisb r0 ,r1 ; check low 7 bits against quote bic #^C177 ,r1 ; drop 7..15 cmpb r1 ,senpar+p.qctl ; if ch <> myquote beq 30$ ; then ctl r0 ,r0 ; ch := ctl(ch); 30$: movb r0 ,(r4)+ ; copy the byte over now inc r3 ; length := succ(length) br 10$ ; next character please 100$: clrb @r4 ; make the string .asciz mov r3 ,r1 ; return the length clr r0 ; fake no errors please unsave ; pop registers and exit return global .sbttl printm print message if not remote ; P R I N T M ; ; input: @r5 arg count ; 2(r5) text for message #1 ; 4(r5) and so on .enabl lsb printm: save ; save registers we will use mov (r5)+ ,r1 ; get the message count beq 100$ ; nothing to do tst remote ; skip if we are the remote bne 100$ ; yep message message ; a header 10$: mov (r5)+ ,r0 .print r0 ; now loop thru printing the stuff sob r1 ,10$ ; next please message ; a clr logini ; may need a logging header 100$: unsave ; pop temps return ; and exit global .dsabl lsb .sbttl error message printing ; E R R O R ; ; error(%val msgcount,%loc msg1, %loc msg2,....) ; ; Error sends the message text if we are remote else ; it prints it out as in the baseline KERMIT.C erbfsiz = 100. error:: save tst remote ; if not remote then printm(...) bne 10$ ; we are the remote. send errors call printm ; simple br 100$ ; bye 10$: mov (r5)+ ,r1 ; message count beq 100$ ; nothing to do ? sub #erbfsiz+2,sp ; remote, allocate a text buffer mov sp ,r4 ; and point to it please mov #erbfsiz,r2 ; length so far 30$: mov (r5)+ ,r3 ; get the next message please 40$: movb (r3)+ ,@r4 ; now copy it to the buffer until beq 50$ ; we get an ascii null (chr(0)) cmpb @r4 ,#'$ ; apparently CPM systems don't like bne 45$ ; dollar symbols ? movb #'_ ,@r4 ; so stuff a '_' in instead 45$: inc r4 sob r2 ,40$ ; no, go until we get one or run br 60$ ; out of space to put it 50$: movb #40 ,(r4)+ ; insert a space in there dec r2 ; insure sufficient space beq 60$ ; no sob r1 ,30$ ; and get the next message 60$: clrb @r4 ; inaure .asciz mov sp ,r4 ; all done, send the ERROR packet strlen r4 ; get the length spack #'E,paknum,r0,r4 ; and send it add #erbfsiz+2,sp ; deallocate the text buffer 100$: unsave ; and exit return global .sbttl print received error packet out ; P R E R R P ; ; prerrp(%loc msg) ; ; input: @r5 address of .asciz string to print prerrp::.print #200$ .print @r5 .newli clr logini return .enabl lc 200$: .asciz /Aborting with error from remote / .even global .sbttl get next file to send ; G E T N X T ; ; input: srcnam possibly wildcarded filename ; index flag if eq 0 then this is the first time thru ; output: filnam next file to do ; r0 <> 0 then abort ; ; RSTS and RSX11M/M+ ; ; Lookup uses the RMS version 2 $SEARCH macro to do the directory ; operation. For RT11 we will simply NOP the $SEARCH since RT11 ; does not support directory lookup operations in the EXEC. Thus ; the error codes ER$NMF (no more files) and ER$FNF are referenced ; directly here. getnxt::save calls lookup ,<#3,#srcnam,#index,#filnam> tst r0 ; did it work ? beq 100$ ; yes cmp r0 ,#ER$NMF ; no more files matching name ? beq 20$ ; yes, we are all done then cmp r0 ,#ER$FNF ; how about file not found ? bne 30$ ; no, print the error message out 20$: tst index ; sent any files yet ? bne 100$ ; yes, that's ok then mov #ER$FNF ,r0 ; no, convert ER$NMF to ER$FNF 30$: mov r0 ,-(sp) ; save r0 please calls syserr , ; not so good. Get the error text mov #filnam ,r1 ; assume the filename parse worked calls fparse ,<#srcnam,#filnam>; quite possibly it may not have tst r0 ; so decide whether to send the beq 40$ ; origonal name or the expanded mov #srcnam ,r1 ; filename in the error packet. 40$: calls error ,<#2,#errtxt,r1>; and send/print it out mov (sp)+ ,r0 ; pop saved error code from lookup 100$: unsave return global .sbttl xor and scanch l$xor:: save mov 4(sp) ,r0 ixor #100 ,r0 mov r0 ,4(sp) unsave return ; S C A N C H ; ; input: 4(sp) the string address ; 2(sp) the character to look for ; output: r0 position of ch in string scanch::save ; save temps mov 6(sp) ,r2 ; get address of the string clr r0 ; initial found position 10$: tstb @r2 ; end of the string yet ? beq 90$ ; yes inc r0 ; no, pos := succ(pos) cmpb 4(sp) ,(r2)+ ; does the ch match the next one? bne 10$ ; no, try again br 100$ ; yes, exit loop 90$: clr r0 ; failure, return postion = 0 100$: unsave ; pop r2 mov @sp ,4(sp) ; move return address up cmp (sp)+ ,(sp)+ ; pop stack return ; and exit ; random things for testing irand:: tst testc bne 10$ mov #1234. ,testc 10$: mov testc ,r0 mov r1 ,-(sp) mov r0 ,r1 ash #-4 ,r1 bic #170000 ,r1 xor r1 ,r0 ash #13 ,r1 bic #100000 ,r1 xor r1 ,r0 bic #100000 ,r0 mov r0 ,testc ash #-13 ,r0 mov (sp)+ ,r1 return global .sbttl compute parity for an outgoing 8 bit link ; This is software parity generation as some DEC interfaces ; and some DEC executives don't know how to compute parity. ; There are two methods given here for ODD and EVEN genera- ; tion. One is from Frank da Cruz's 20KERMIT.MAC and does it ; by computing it. The other method is from the pascal RT11 ; Kermit (by Phil Murton) and does a table lookup to compute ; the parity. For the sake of speed and the fact that some RT ; systems lack certain instructions we will use the later ; method at a slight cost in space. parlok = 1 ; use table lookup method .assume par$od eq 1 ; set parity odd .assume par$ev eq 2 ; set parity even .assume par$ma eq 3 ; set parity mark .assume par$sp eq 4 ; set parity space .assume par$no eq 5 ; set parity none .psect $pdata pardsp: .word none.p, odd.p, even.p ,mark.p ,spac.p ,none.p .psect $code dopari::save ; save things we will use mov parity ,r3 ; get the current parity setting asl r3 ; times 2 mov 12(sp) ,r1 ; get the character to do it to jsr pc ,@pardsp(r3) ; and dispatch as desired mov r1 ,12(sp) ; return the character please unsave ; pop and exit return none.p: return ; do nothing mark.p: bisb #200 ,r1 ; mark means we are always high return ; on bit seven spac.p: bicb #200 ,r1 ; space means we are always low return ; on bit seven .sbttl odd/even parity generation .if eq ,parlok ; what kind of parity generation .ift ; to use even.p: bic #^c177 ,r1 ; insure no high bits are set mov r1 ,r2 ; copy call par ; and do it return odd.p: bic #^c177 ,r1 ; insure only bits 0..6 mov r1 ,r2 ; copy it bisb #200 ,r2 ; and set bit seven call par ; do it return ; bye par: mov #200 ,r3 ; xor instruction is strange ash #-4 ,r2 ; move the high four bits down bic #^C17 ,r2 ; clear bit 7's right propagation ixor r1 ,r2 ; fold source character into one bic #^C17 ,r2 ; insure we have only 4 bits today mov r2 ,r3 ; now check if bits 2 and 3 are asr r3 ; /2 asr r3 ; /2 cmpb r3 ,#3 ; both high or both low beq 10$ ; both high tstb r3 ; both low ? bne 20$ ; no, don't set any parity then 10$: ixor #200 ,r1 ; yes, toggle parity now 20$: bic #^C3 ,r2 ; ok, now see if the low 2 bits are cmpb r2 ,#3 ; both either on or off beq 30$ ; both are on, set parity tstb r2 ; perhaps only one bit is on? bne 40$ ; yep 30$: ixor #200 ,r1 ; toggle the bit then 40$: return ; bye .endc ; if eq, parlok .sbttl odd/even parity generation via lookup .if ne ,parlok ; use this method ? .ift ; yes odd.p: bic #^c177 ,r1 tstb partab(r1) bne 100$ bisb #200 ,r1 100$: return even.p: bic #^c177 ,r1 tstb partab(r1) beq 100$ bisb #200 ,r1 100$: return ; Table of parity setting for ascii 0-177 ; From Phil Murton's RTLINE.PAS partab: .byte 0,1,1,0,1,0,0,1 ; first 8 ascii characters .byte 1,0,0,1,0,1,1,0 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 .byte 0,1,1,0,1,0,0,1 .byte 1,0,0,1,0,1,1,0 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 .byte 0,1,1,0,1,0,0,1 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 .byte 1,0,0,1,0,1,1,0 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 ; last eight ascii characters (to 177) .endc ; if ne, parlok .end