owing 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. ; ; ; ; 13-Oct-84 14:01:32 BDN moved SENDSW and RECSW out .sbttl GETCR0 decide where to get the next character from ; 06-Nov-85 11:22:14 BDN Added Edit 38 ; ; Passed: r0 LUN ; Return: r0 Error code (generally 0 or ER$EOF) ; r1 Character just read ; ; ; GETCR0 is the lowest level entry point called in Kermit to ; obtain the next character for a SEND function (even GETC ; calls it), where that it may be a normal file transfer, or ; a SERVER extended response. The main idea in altering it is ; so that a server dispatch routine can change the the ; default (get from a file) to, say, get from an .ASCIZ ; string in memory or switch to some other kind of ; GET_NEXT_CHARACTER routine. This requires that the service ; routine insert its GET_NEXT_CHAR routine address into the ; global 'GETCROUTINE' and also to reset it to 'FGETCR0' when ; the action is complete. Currenty, REMOTE HELP and REMOTE ; DIR use this facility. getcr0::tst getcroutine ; /38/is there any routine address set bne 10$ ; /38/yes call fgetcr0 ; /38/no, default to file reading br 100$ ; /38/exit 10$: call @getcroutine ; /38/call currently defined routine 100$: return tgetcr::tst tgetaddr ; /38/Have we ever been inited ? beq 90$ ; /38/no, return ER$EOF movb @tgetaddr,r1 ; /38/yes, get next character please beq 90$ ; /38/nothing is left to do inc tgetaddr ; /38/text_address++ clr r0 ; /38/return(no_errors) br 100$ ; /38/exit 90$: mov #ER$EOF ,r0 ; /38/return(end_of_file) mov #fgetcr0,getcroutine ; /38/reset to file reading please 100$: return ; /38/exit global .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 $ALLSIZ = >&177776 spack$::save ; Save registers that we may use call spakwa call spakin sub #$ALLSIZ,sp ; /42/ Allocate a LONG buffer mov sp ,r4 ; Point to the buffer clr -(sp) ; Count the total length tst prexon ; K11PAKMAC[.050032]K11PAK.MAC[.050032]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ᄇ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf#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 pakwri ,; 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 asl r1 ; /43/ 32 bits add #1 ,pcnt.s+2(r1) ; /43/ 32 bits, paccnt(type)++ adc pcnt.s+0(r1) ; /43/ 32 bits, the high part add #1 ,pcnt.s+2 ; /43/ 32 bits now adc pcnt.s+0 ; /43/ The high order part 30$: return .save .psect $PDATA ,D 200$: .asciz /SPACK - / .even .restore .dsabl lsb 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 .enabl lsb 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 .save .psect $PDATA ,D 200$: .byte msg$snd .byte msg$ser .byte msg$rcv .byte msg$command .byte msg$generic .byte 0 .even .restore .dsabl lsb global .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 typeK11PAKMAC[.050032]K11PAK.MAC[.050032]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ᄇ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf cmpb r1 ,recsop ; if ch = SOH then resynch beq 80$ ; cmp .size(r4),#MAXLNG ; 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) ; flag that we are done br 10$ ; check to see if we are done 80$: br 5$ ; synch error, restart the packet 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 96$: call rpakst ; do stats and disk dumping now 100$: add #.lsize+$ALLSIZ,sp ; /42/ Pop local buffers unsave return global .sbttl Read extended header type 0 for long packets ; Added edit /42/ 08-Jan-86 16:32:59 Brian Nelson rdexhd: mov r5 ,-(sp) ; /42/ Need an ODD register for MUL mov r2 ,-(sp) ; /42/ Save R2 please call rpakrd ; /42/ Extended header, read the LENX1 bcs 90$ ; /42/ field, exiting on read errors. bic #^C177 ,r1 ; /42/ Insure parity is cleared out cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS beq 80$ ; /42/ START_OF_HEADER please movb r1 ,(r3)+ ; /42/ Save into Checksum buffer unchar r1 ,r5 ; /42/ Get the high order of length mul #95. ,r5 ; /42/ Shift over please call rpakrd ; /42/ Extended header, read the LENX2 bcs 90$ ; /42/ field, exiting on read errors. bic #^C177 ,r1 ; /42/ Insure parity is cleared out cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS beq 80$ ; /42/ START_OF_HEADER please movb r1 ,(r3)+ ; /42/ Save into Checksum buffer unchar r1 ,r1 ; /42/ Get the next one add r1 ,r5 ; /42/ Now we have the EXTENDED length sub chksiz ,r5 ; /42/ Drop it by checksum size mov r5 ,.len(r4) ; /42/ Save it here, of course mov .cbuff(r4),r5 ; /42/ Now, at LAST, get the extended mov #5 ,r1 ; /42/ header CHECKSUM data clr -(sp) ; /42/ Accum in stack 10$: clr r0 ; /42/ Use the normal SAFE way to add bisb (r5)+ ,r0 ; /42/ bytes even though we know for add r0 ,(sp) ; /42/ that no sign extends will happen sob r1 ,10$ ; /42/ Next please mov (sp)+ ,r0 ; /42/ Pop the checksum please mov r0 ,r2 ; /42/ Save it bic #^C300 ,r2 ; /42/ Compute it as in: ash #-6 ,r2 ; /42/ Chk=char((s+((s&0300)/0100))&77) add r0 ,r2 ; /42/ ... bic #^C77 ,r2 ; /42/ Got it now call rpakrd ; /42/ Extended header, read the HCHECK bcs 90$ ; /42/ field, exiting on read errors. bic #^C177 ,r1 ; /42/ Insure parity is cleared out cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS beq 80$ ; /42/ START_OF_HEADER please movb r1 ,(r3)+ ; /42/ Save into Checksum buffer unchar r1 ,r1 ; /42/ Convert to actual checksum now cmpb r1 ,r2 ; /42/ Do the CHECKSUMS match ? bne 85$ ; /42/ No, exit with such set please clr r0 ; /42/ It worked, exit normally br 100$ ; /42/ bye... 80$: mov #1 ,r0 ; /42/ Resynch time br 100$ ; /42/ Exit 85$: mov #badchk ,r0 ; /42/ Header Checksum error br 95$ ; /42/ Stuff the error 90$: mov #timout ,r0 ; /42/ Return timeout error 95$: mov 2(sp) ,r5 ; /42/ Return timeout error mov 2(r5) ,r1 ; /42/ Get address of result block clr o$len(r1) ; /42/ Clear this also mov r0 ,o$type(r1) ; /42/ Return the error mov r0 ,.type(r4) ; /42/ Here also please mov #-1 ,r0 ; /42/ Fatal error 100$: mov (sp)+ ,r2 ; /42/ Pop r2 and mov (sp)+ ,r5 ; /42/ Restore R5 return .sbttl subroutines for RPACK only .enabl lsb rpakrd: calls binrea ,<#lun.ti,.timeo(r4)>; read(input,ch) tst r0 ; did it work bne 110$ K11PAKMAC[.050032]K11PAK.MAC[.050032]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ᄇ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddfp ; pop buffer and exit 100$: unsave ; pop r0 and exit return .save .psect $PDATA ,D 200$: .asciz /?Bad Checksum: rcv,calc are / .even .restore .dsabl lsb 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 bisb r1 ,recbit ; recbit |= ch ; 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$: bic #170000 ,r1 ; /42/ Insure long packet not overflow 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 ; ; inputK11PAKMAC[.050032]K11PAK.MAC[.050032]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ᄇ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddftimed out ; ; ; As of edit 2.41 (25-Dec-85 13:26:26) from Steve Heflin we will ; exit Kermit-11 if we find that the first thing we find is a CTL ; Z (\032). This is desired in case the user accidentilly put the ; Kermit-11 into server without setting a line. ; On edit /44/, wait for TWO control z's in a row to exit. waitsoh:clr r1 ; mov #2 ,-(sp) ; /44/ Counter for control Z's 10$: cmpb r1 ,recsop ; 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 bic #^C177 ,r1 ; /44/ Never want parity here tst r0 ; did the read work ? bne 30$ ; oops, just exit then cmpb r1 ,#'Z&37 ; /41/ Control Z returned ? bne 15$ ; /41/ No dec (sp) ; /44/ Should we REALLY exit now? bne 20$ ; /44/ No, in case we got some NOISE call clostt ; /41/ Yes, drop terminal and exit jmp exit ; /41/ Bye now 15$: mov #2 ,(sp) ; /44/ Need TWO ^Z's in a row to exit 20$: call rawio ; all is not well, perhaps dump packets br 10$ ; loop back for finding a PACKET start 30$: clr r1 ; Timeout, return( NULL ) 100$: tst (sp)+ ; /44/ Pop control Z counter return ; exit 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 initialize repeat count for sending inirepeat:: save clr dorpt ; assume not doing repeat things tst setrpt ; user disable repeat count processing? beq 100$ ; yes cmpb #myrept ,#40 ; am I doing it ? beq 100$ ; no, just exit then clr rptcount ; size of repeat if zero clr rptlast ; no last character please (a null) mov #-1 ,rptinit ; need to prime the pump please movb conpar+p.rept,r0 ; check for doing so beq 100$ ; no cmpb r0 ,#40 ; a space also ? beq 100$ ; yes cmpb r0 ,senpar+p.rept ; same ? bne 100$ ; no movb r0 ,rptquo ; yes, save it mov #-1 ,dorpt ; and we are indeed doing this 100$: clc unsave return global .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 clr r5 ; bitb #CAPA.L,conpar+p.capas ; /42/ Check to see if both sides beq 4$ ; /42/ REALLY understand long packets bitb #CAPA.L,senpar+p.capas ; /42/ We would normally but it is beq 4$ ; /42/ possible to SET NOLONG mov senlng ,r5 ; /42/ Does receiver understand bne 5$ ; /42/ long packets today? 4$: bisb conpar+p.spsiz,r5 ; get the recievers maximum size 5$: sub #14 ,r5 ; being overcautious today ? 10$: tst dorpt ; are we doing repeat counts beq 50$ ; no 15$: call gnc ; getnext character ; bcs 30$ ; if ( error ) then break ; tst rptinit ; if ( firsttime ) beq 20$ ; then clr rptinit ; rptinit = 0 ; clr rptcount ; rptcount = 0 ; movb r1 ,rptlast ; rptlast = ch ; 20$: cmpb r1 ,rptlast ; if ( ch == rptlast ) bne 30$ ; then cmp rptcount,#94. ; bge 30$ inc rptcount ; rptcount++ ; br 15$ ; else break ; 30$: mov r1 ,rptsave ; save the failed character please tst rptcount ; this may be EOF on first character beq 90$ ; if so, we simply do nothing at all cmp rptcount,#2 ; please don't bother with ONE char. bgt 40$ ; don't waste the overhead for two 35$: clr r1 ; avoid sign extension please bisb rptlast ,r1 ; get the character to write call 200$ ; and stuff it into the buffer dec rptcount ; more to insert ? bne 35$ ; yes br 45$ ; no, exit 40$: movb rptquo ,(r4)+ ; insert the repeat count quote inc r3 ; count it K11PAKMAC[.050032]K11PAK.MAC[.050032]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ᄇ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf ,@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? ble 100$ ; no 20$: clr r0 ; get the next character bisb (r2)+ ,r0 ; into a convienient place dec r3 ; chcount-- ; mov #1 ,r4 ; repeat_count = 1 ; tst dorpt ; are we doing repeat count stuff? beq 30$ ; no cmpb r0 ,rptquo ; yes, is this the aggreed upon prefix? bne 30$ ; no dec r3 ; chcount-- clr r4 ; yes, get the next character then bisb (r2)+ ,r4 ; and decode it into a number bic #^C177 ,r4 ; insure no parity bits are hanging unchar r4 ,r4 ; simple to do clr r0 ; now prime CH with the next character bisb (r2)+ ,r0 ; so we can check for other types of dec r3 ; quoting to be done. tst r4 ; insure the count is legitimate bgt 30$ ; it's ok mov #1 ,r4 ; it's fubar, fix it 30$: 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 ; if ( ch & 177 ) >= ctl(DEL) blo 70$ ; and ( ch & 177 ) <= ctl(del)+40 cmpb r1 ,#137 ; then bhi 70$ ; ch = ctl(ch) ; ctl r0 ,r0 ; 70$: tst set8bit ; do we need to set the high bit? beq 74$ ; no bisb #200 ,r0 ; yes, set the bit on please 74$: mov r0 ,-(sp) ; and save the character to write 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$: mov @sp ,r0 ; restore the character to write out call putcr0 ; and do it add #1 ,filein+2 ; /43/ Stats adc filein+0 ; /43/ 32 bits worth sob r4 ,75$ ; duplicate the character if need be. tst (sp)+ ; pop the stack where we saved CH br 10$ ; next character please 100$: unsave return global 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$ ; All done bic #^C177 ,r0 ; /53/ Always seven bit data mov #1 ,r5 ; /53/ Assume character not repeated tst dorpt ; /53/ Repeat processing off? beq 20$ ; /53/ Yes, ignore. cmpb r0 ,rptquo ; /53/ Is this a repeated char? bne 20$ ; /53/ No, normal processing bisb (r2)+ ,r5 ; /53/ Yes, get the repeat count bic #^C177 ,r5 ; /53/ Always seven bit data unchar r5 ,r5 ; /53/ Get the K11PAKMAC[.050032]K11PAK.MAC[.050032]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ᄇ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddfreturn .save .psect $PDATA ,D .enabl lc 200$: .asciz /Aborting with error from remote./ .even .restore .dsabl lsb global .sbttl send/print several common types of errors ; M$TYPE(%val(type),%loc(packet)) unknown packet type recieved ; M$RETRY retry abort ; M$SYNCH out of synch ; ; 18-Oct-84 17:34:37 BDN debugging for PRO/RT11 Kermit m$type::save ; save temps that we will use clr -(sp) ; a buffer for the packet type movb @r5 ,@sp ; the packet type mov sp ,r0 ; point back to the buffer calls error ,<#4,#e$type,r0,#e$hd,2(r5)> tst (sp)+ ; pop local buffer unsave ; pop temp and exit return m$retr::save ; save r0 please bitb #200 ,recbit ; /44/ Perhaps parity was going ? beq 10$ ; /44/ No cmpb parity ,#PAR$NO ; /44/ Yes, do we know about parity bne 10$ ; /44/ Yes we do, normal abort calls error ,<#1,#e$par> ; /44/ No parity, ctl fields have br 100$ ; /44/ Exit 10$: calls error ,<#1,#e$retr> ; send/print the error message 100$: unsave ; pop and exit return ; bye m$sync::save ; save r0 please calls error ,<#1,#e$synch> ; send/print the error message unsave ; pop and exit return ; bye .save .psect $pdata e$hd: .asciz / pak: / e$type: .asciz /Fubar pak type: / e$retr: .asciz /Retry limit reached/ e$synch:.asciz /Hopelessly out of synch with sending Kermit/ e$par: .asciz /Retry limit reached, parity is possibly being introduced/ .even .restore .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 ,rK11PAKMAC[.050032]K11PAK.MAC[.050032]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ᄇ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf0 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 .save .psect $PDATA ,D 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) .restore .endc ; if ne, parlok .end