home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / test / pdp11 / krtpak.mac < prev    next >
Text File  |  1996-10-17  |  50KB  |  1,446 lines
  1.     .title    KRTPAK    Packet driver
  2.     .ident    "V04.64"
  3.  
  4. ; /E64/    28-Apr-96  John Santos
  5. ;
  6. ;    Conditionalize for RSTS/E support, restore BUFUNP, PRERRP used by
  7. ;    RSTS/E.  Use pakwri instead of binwri for transmitting packets.
  8. ;    Use wrtall instead of .print
  9.  
  10. ; /63/    14-Feb-96  Billy Youdelman
  11. ;
  12. ;    make .TOGO = 16, fixing a (harmless) typo (was 26)..
  13. ;    dump ^A = restart a packet for SET CONTROL UNPREFIX 1 operation
  14. ;    BUFFIL back to root (KRTPAK), for speed and room now available
  15. ;    ERROR: now sends error packet when link is open and xfr in progress
  16. ;    modify BUFFIL to do BUFPAK too, for repeated char encoding
  17.  
  18. ; /62/    27-Jul-93  Billy Youdelman
  19. ;
  20. ;    move erbfsiz to KRTMAC
  21. ;    patch PRINTM to also write to a logfile, when same is in use
  22. ;    add logfile error handler and provide for logfile errors
  23. ;    write error messages to logfile
  24. ;    include file spec in getnxt error messages
  25. ;    add individual packet exchange duration timer, for debugging
  26. ;    make BUFFIL limit test max-0 (was max-4), allows bigger packets
  27. ;    don't log bogus data for timout
  28. ;    make ERROR send an error packet, use PRINTM elsewhere
  29. ;    don't modify SET time-out value
  30. ;    add/enforce SET SEND PACKET-LEN limit
  31. ;    move bufpak to KRTSER, no one else uses it
  32. ;    move buffil to KRTSEN, ditto..
  33. ;    move bufemp to KRTREC
  34. ;    add passed buffer length to rpack$
  35.  
  36. ; /BBS/     1-Dec-91  Billy Youdelman  V03.61
  37. ;
  38. ;    added lun.ld == 12 for TSX logical disk support
  39. ;    added lun.at == 5 for file attributes support
  40. ;    prefixing error messages with the prompt string moved to KRTERR
  41. ;    waitsoh - ^Z abort changed to ^C abort, thus not killing the pgm
  42. ;
  43. ;    spack$ packet length test fixed to determine the true length of
  44. ;    a packet near or equal to 94 bytes when long packets are used.
  45. ;    it was possible to generate a "normal" packet with an out-of-
  46. ;    range LENGTH character (using all eight bits) when reaching the
  47. ;    the EOF produced a last packet in a long packet series close to
  48. ;    94 bytes, as the routine filling the packet data input buffer
  49. ;    is still looking for enough to make a long packet, with no
  50. ;    consideration for the added SEQ and TYP bytes nor the checksum
  51. ;    size (up to three more bytes with CRC block checking)..
  52. ;
  53. ;    rpakst patched to hose link device whenever the "T" (time-out)
  54. ;    packet count is incremented, or when a NAK xxx NAK series
  55. ;    (indicating resonating packets) occurs.  this is very helpful
  56. ;    when telephone line noise crashes/hangs the handler..
  57. ;
  58. ;    space padding between elements of an error message moved from
  59. ;    error: to the err msgs themselves as printm doesn't do it, and
  60. ;    it's too confusing otherwise..
  61. ;
  62. ;    patched to compensate for crossing midnight, as long as
  63. ;    there's less than 24 hours between calls to it, thus 32-bit
  64. ;    time data from incsta are thought to be sufficient here
  65. ;    note: the display routine in krtsho limits max to 18.2 hours..
  66. ;
  67. ;    patched bufemp to not output the lead-in char to TT under TSX
  68. ;
  69. ;    moved RPACK debug stuff to rawio: as when it was in rpakrd: it
  70. ;    missed the SOH, which is handled by waitsoh: (both call rawio)..
  71. ;    also cleaned up display at the EOL and added display of TIMOUTs
  72. ;
  73. ;    fixed non-init'd repeat count reg bug in bufunpack
  74.  
  75. ;    Brian Nelson    30-Nov-83  10:20:09
  76. ;    13-Oct-84  14:01:32  BDN    moved SENDSW and RECSW out
  77. ;
  78. ;    Change Software, Toledo, Ohio
  79. ;    University of Toledo, Toledo, Ohio
  80.  
  81.  
  82. ;                 PACKET FORMAT
  83. ;
  84. ; The KERMIT protocol is built around exchange of packets of this format:
  85. ;
  86. ;    +------+-----------+-----------+------+- ~ ---- ~ -+-------+-----+
  87. ;    | MARK | char(LEN) | char(SEQ) | TYPE |    DATA    | CHECK | EOL |
  88. ;    +------+-----------+-----------+------+- ~ ---- ~ -+-------+-----+
  89. ;
  90. ; where all fields consist of ASCII characters.  The fields are:
  91. ;
  92. ; MARK  The synchronization character that marks the beginning of the packet.
  93. ;      This is normally ^A, but may be redefined.
  94. ;
  95. ; LEN  The  number  of  ASCII  characters  within  the packet that follow this
  96. ;      field, in other words the packet length minus two.  Since  this  number
  97. ;      is  transformed  to  a single character via the char() function, packet
  98. ;      character  counts  of  0. to 94. are permitted, and  96. is the maximum
  99. ;      total packet length.  The length doesn't include end-of-line or padding
  100. ;      characters, which are outside  the  packet  and  are  strictly  for the
  101. ;      benefit of the operating system,  but  it  does include the block check
  102. ;      characters.
  103. ;
  104. ; SEQ  The packet sequence number modulo 64., ranging from 0. to 63.  Sequence
  105. ;      numbers "wrap around" to 0. after each group of 64. packets.
  106. ;
  107. ; TYPE  The packet type, a single ASCII character.  The following packet types
  108. ;       are used in the Kermit protocol -
  109. ;
  110. ;  A = Attributes                     K = Kermit (remote) command
  111. ;  B = Break transmission (EOT)       N = Negative acknowledgment (NAK)
  112. ;  C = Host (remote) command          R = Receive file init
  113. ;  D = Data packet                    S = Send file init
  114. ;  E = Error                          T = Time out (internal)
  115. ;  F = File header (name)             X = Extended reply
  116. ;  G = Generic (remote) command       Y = Acknowledgment (ACK)
  117. ;  I = Server init                    Z = End of file (EOF)
  118. ;
  119. ; DATA  The contents of the packet,  if any contents are required in the given
  120. ;      type of packet, interpreted according to  the  packet  type.    Control
  121. ;      characters  are  preceded  by a special prefix character, normally "#",
  122. ;      and "uncontrollified" via ctl().  A prefixed sequence may not be broken
  123. ;      across packets.  Logical records in printable files are delimited  with
  124. ;      CR/LFs, suitably prefixed (e.g. "#M#J").  Any prefix characters are in-
  125. ;      cluded in the count.  Optional encoding for  8-bit  data  and  repeated
  126. ;      characters is also available.
  127. ;
  128. ; CHECK  A block check on characters in the packet between,  but not including
  129. ;      ing, the mark and the block check itself.  The check for each packet is
  130. ;      computed by both hosts,  and  must agree if a packet is to be accepted.
  131. ;      A single-character arithmetic checksum is the normal and required block
  132. ;      check.   Only  six  bits  of the arithmetic sum are included.  In order
  133. ;      that all the bits of each data character contribute to  this  quantity,
  134. ;      bits  6  and  7  of the final value are added to the quantity formed by
  135. ;      bits 0-5.  Thus if s is the arithmetic sum  of  the  ASCII  characters,
  136. ;      then
  137. ;
  138. ;        check = char((s + ((s & 192.)/64.)) & 63.)
  139. ;
  140. ;      This  is  the  default  block check, and all Kermits must be capable of
  141. ;      performing it.  Other optional block check types are also defined.  The
  142. ;      block check  is  based  on  the  ASCII  values of the characters in the
  143. ;      packet.    Non-ASCII  systems must translate to ASCII before performing
  144. ;      the block check calculation.
  145. ;
  146. ; EOL  The End Of Line character, normally a carriage return, marks the end of
  147. ;      the packet.  This particular implementation (Kermit-11) uses the packet
  148. ;      length and ignores the EOL char other than displaying it when debugging
  149. ;      to the terminal.
  150.  
  151.  
  152.     .include "IN:KRTMAC.MAC"
  153.     .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MAC failed>
  154.     .include "IN:KRTDEF.MAC"
  155.     .iif ndf  MSG$DA  .error    <; .include for IN:KRTDEF.MAC failed>
  156.  
  157. .if df    RT11                ; /E64/
  158.     .mcall    .CLOSE    ,.GTIM    ,.PURGE    ; /62/
  159. .endc    ;RT11                ; /E64/
  160.                     ; /E64/ neither .GTIM nor .PURGE are
  161.                     ; /E64/ actually used in this module
  162.  
  163.  
  164.     .sbttl    Misc defaults
  165.  
  166.     BADCHK    ==    377        ; pseudo packet type for bad checksum
  167.     DEFCHK    ==     '1        ; default block-check-type
  168.     TIMOUT    ==   'T&137        ; pseudo packet type for time-out
  169.  
  170.  
  171.     .sbttl    Local and global read-only data
  172.  
  173.     .psect    $pdata    ; /62/ MUST be non-swapping, in root (SJ) or APR1 (XM)
  174. aspace::.byte    40 ,0    ; /62/ consolidated all this here..
  175. null::    .byte     0 ,0
  176. e$pari:    .asciz    ", parity is possibly being introduced"
  177. e$retr:    .asciz    "Retry limit reached"
  178. e$sync:    .asciz    "Packet serial numbers are out of sync"
  179. pak.01:    .asciz    "Kermit: "
  180. pak.02:    .asciz    "<<< RPACK - "
  181. pak.03:    .asciz    "<TIMOUT>"
  182. pak.04:    .asciz    "BAD Checksum: RCV,CALC = "
  183. pak.05:    .asciz    "<SOH>"
  184. pak.06:    .ascii    "<EOL>"
  185. pak.07:    .asciz    <cr><lf>
  186. pak.08:    .asciz    ">>> SPACK - "
  187. .if df    RSTS                ; /E64/
  188. pak.09:    .asciz    "Aborting with error from remote."<CR><LF>
  189. .endc    ;RSTS                ; /E64/
  190.     .even
  191.  
  192.  
  193.     .psect    $code
  194.     .sbttl    Read incoming packet
  195.  
  196. ;    R P A C K $
  197. ;
  198. ;    input:      (r5)    = packet buffer address
  199. ;         4(r5)    = packet buffer length
  200. ;    output:     2(r5)    = 3 word data structure returns length, number, type
  201.  
  202.     O$LEN    =  0        ; offset for returned packet length
  203.     O$SEQ    =  2        ; packet number
  204.     O$TYP    =  4        ; packet type
  205.  
  206.     ; /62/    local data allocated on the stack, offsets from r4
  207.     .TYP    =  0        ; packet type
  208.     .CCHECK    =  2        ; computed checksum
  209.     .RCHECK    =  4        ; received checksum
  210.     .LEN    =  6        ; received packet length
  211.     .TIMEO    = 10        ; read time-out
  212.     .SEQ    = 12        ; received packet number
  213.     .SIZE    = 14        ; current size of data portion
  214.     .TOGO    = 16        ; /63/ loop count control for data portion
  215.     .HDTYPE    = 20        ; /62/ header type
  216.     .CBUFF    = 22        ; /62/ checksum buffer address
  217.     .LSIZE    = 24        ; total size of the above local data
  218.  
  219. ;    internal register usage:
  220. ;    r0    = scratch register
  221. ;    r1    = current character just read from remote
  222. ;    r2    = pointer to packet buffer
  223. ;    r3    = pointer to temp buffer on the stack containing the packet
  224. ;          less the SOH and the checksum, for computing checksum after
  225. ;          the packet has been read
  226. ;    r4    = pointer to local data on stack, as defined above
  227. ;    r5    = pointer to argument list
  228.  
  229. rpack$::call    dcdtst            ; /62/ check DCD, report any change..
  230.     save    <r1,r2,r3,r4>
  231.     clr    recbit            ; /43/ clear bit sum out
  232.     sub    #.lsize    ,sp        ; allocate space for local data
  233.     mov    sp    ,r4        ; and point to it please
  234.     sub    #$allsiz,sp        ; /42/ allocate a HUGE buffer
  235.     call    waitsoh            ; wait for a packet to start
  236.     tst    r0            ; did it work or did we time out?
  237.     beq    10$            ; yes it worked
  238.     jmp    100$            ; we must have timed out then
  239.  
  240. 10$:    mov    sp    ,r3        ; the packet less SOH and checksum
  241.     mov    sp    ,.cbuff(r4)    ; /42/ save start address
  242.     call    rpakin            ; initialize things
  243.     call    rpakrd            ; read the next character from
  244.     bcs    100$            ; packet reader's buffer
  245.     bisb    r1    ,recbit        ; /43/ so we can determine parity set
  246.     bic    #^c<177>,r1        ; ensure parity is cleared out
  247.     movb    r1    ,(r3)+        ; *checkpacket++ = ch
  248.     unchar    r1    ,r0        ; get the length packet next please
  249.     mov    r0    ,.hdtype(r4)    ; /42/ save header type
  250.     cmp    r0    ,#2        ; /42/ if the length is 0,1 or 2 then
  251.     ble    20$            ; /42/ an extended header instead
  252.     sub    #2    ,r0        ; this is NOT an extended header so we
  253.     sub    chksiz    ,r0        ; will check to see if the packet can
  254.     bge    20$            ; hold at least SEQ+TYPE+CHECK
  255.     clr    r0            ; /44/ couldn't, "fix" bad length
  256. 20$:    mov    r0    ,.len(r4)    ; stuff the packet length
  257.  
  258.     call    rpakrd            ; as before, ask for the next char
  259.     bcs    100$            ; and take an error exit if need be
  260.     bisb    r1    ,recbit        ; /43/ so we can determine parity set
  261.     bic    #^c<177>,r1        ; ensure parity is cleared out
  262.     movb    r1    ,(r3)+        ; insert the sequence number into the
  263.     unchar    r1    ,.seq(r4)    ; checksum packet and save the SEQ
  264.  
  265.     call    rpakrd            ; read the TYPE field next, exiting
  266.     bcs    100$            ; on a read error, of course
  267.     bisb    r1    ,recbit        ; /43/ so we can determine parity set
  268.     bic    #^c<177>,r1        ; ensure parity is cleared out
  269.     movb    r1    ,(r3)+        ; save TYPE field into the checksum
  270.     mov    r1    ,.typ(r4)    ; and also into the field for return
  271.  
  272.     tst    .hdtype(r4)        ; /42/ NOW check for extended header
  273.     bne    30$            ; /42/ not extended header
  274.     call    rdexhd            ; /42/ ReaD EXtended HeaDer
  275.     tst    r0            ; /42/ did this work ok?
  276.     bne    110$            ; /63/ no, time-out or checksum error
  277.  
  278. 30$:    mov    .len(r4),.togo(r4)    ; loop for the data, if any
  279.     cmp    .togo(r4),4(r5)        ; /62/ ensure we don't overwrite buff
  280.     blos    40$            ; /62/ received length is ok
  281.     mov    4(r5)    ,.togo(r4)    ; /62/ bad length, do max possible..
  282. 40$:    mov    @r5    ,r2        ; point to the buffer now
  283.  
  284. 50$:    tst    .togo(r4)        ;   for i := 1 to len do
  285.     beq    90$            ;    begin
  286.     call    rpakrd            ;     read(input,ch)
  287.     bcs    100$            ;     exit if error
  288.     tst    parity            ; /62/ parity set to none?
  289.     bne    60$            ; /62/ no, must be some other type
  290.     tst    image            ; /62/ no parity, image mode today?
  291.     bne    70$            ; /62/ yes, leave things alone please
  292. 60$:    bic    #^c<177>,r1        ; /62/ ch := ch and chr(177b)
  293. 70$:    cmp    .size(r4),#maxlng    ;     if currentsize < maxpaksize
  294.     bhis    80$            ;       then
  295.     movb    r1    ,(r2)+        ;         data[i]  := ch
  296.     movb    r1    ,(r3)+        ;         checkpacket++ := ch
  297.                     ;    end
  298. 80$:    inc    .size(r4)        ;     currentsize:=succ(currentsize)
  299.     dec    .togo(r4)        ;    nchar_left := nchar_left-1
  300.     br    50$            ;    end
  301.  
  302. 90$:    clrb    @r2            ;   data[len] := null
  303.     clrb    @r3            ;   checkpacket++ := null
  304.     mov    sp    ,r3        ;   reset base address of checkpacket
  305.     call    rpakck            ;   read the checksum now
  306.     bcs    100$            ;   exit on error or time-out
  307.     call    rpakfi            ; /62/ finish the checksum
  308.     br    120$
  309.  
  310. 100$:    mov    2(r5)    ,r1        ; time-out error, flag no packet
  311.     mov    #timout    ,o$typ(r1)    ; return as pseudo packet type
  312.     mov    #timout    ,.typ(r4)    ; ditto for rpakst
  313.     clr    o$len(r1)        ; /62/ time-out has no length
  314.     clr    .len(r4)        ; /62/ don't log bogus data either
  315.     clr    .seq(r4)        ; /62/ time-out has no packet number
  316. 110$:    call    rpakst            ; do stats and disk dumping now
  317.  
  318. 120$:    add    #.lsize+$allsiz,sp    ; /42/ pop local buffers
  319.     unsave    <r4,r3,r2,r1>
  320.     return
  321.  
  322.  
  323.     .sbttl    RPACK$ wait for a start of packet char (SOH)
  324.  
  325. ;    W A I T S O H
  326. ;
  327. ;    output:      r0    = if <>, error code
  328. ;          r1    = the SOH or a null if we timed out
  329.  
  330. ; /BBS/    ^Z exit changed to ^C abort (requires two successive ^Cs)
  331.  
  332. waitsoh:clr    r1            ; start with nothing
  333.     clr    -(sp)            ; /56/ hold virgin copy of data
  334.     mov    #2    ,-(sp)        ; /BBS/ counter for ^C's
  335. 10$:    cmpb    r1    ,recsop        ; wait for a packet header please
  336.     beq    60$            ; got one, exit
  337.     mov    sertim    ,r0        ; /62/ if waiting for server command
  338.     bne    20$            ; /62/ then use that time-out
  339.     movb    senpar+p.time,r0    ; /62/ else use "normal" time-out
  340. 20$:    calls    binrea    ,<r0>        ; read with time-out
  341.     tst    r0            ; did the read work?
  342.     bne    50$            ; oops, just exit then
  343.     mov    r1    ,2(sp)        ; /56/ save it
  344.     bic    #^c<177>,r1        ; /44/ never want parity here
  345.     cmpb    r1    ,#'C&37        ; /BBS/ ^C returned?
  346.     bne    30$            ; /41/ no
  347.     dec    (sp)            ; /44/ should we really exit now?
  348.     bne    40$            ; /44/ no, in case we got some noise
  349. .if df    RSTS                ; /E64/
  350.         call    clostt                  ; /41/ Yes, drop terminal and exit
  351.         jmp     exit                    ; /41/ Bye now
  352. .endc    ;RSTS                ; /E64/
  353. .if df    RT11                ; /E64/
  354.     mov    cc$max    ,cccnt        ; /BBS/ force abort thru cptln routine
  355.     mov    sp    ,ccflag        ; /BBS/ else .spcps will bomb..
  356.     mov    #er$nin    ,r0        ; /BBS/ a fake time-out until
  357.     br    50$            ; /BBS/ the ccast hits (15. ticks max)
  358. .endc    ;RT11                ; /E64/
  359. 30$:    mov    #2    ,(sp)        ; /BBS/ need TWO ^C's in a row to exit
  360. 40$:    call    rawio            ; all's not well, perhaps dump packets
  361.     br    10$            ; loop back for finding a packet start
  362. 50$:    clr    r1            ; time-out, return a null
  363.     br    70$            ; /56/
  364. 60$:    tstb    2(sp)            ; /62/ parity perhaps?
  365.     bpl    70$            ; /62/ no
  366.     tst    parity            ; /BBS/ 8-bit channel?
  367.     bne    70$            ; /56/ no
  368.     tst    incpar            ; /62/ warning already done?
  369.     bne    70$            ; /62/ ya, avoid rollover to zero..
  370.     inc    incpar            ; /56/ ya, also want message only once
  371. 70$:    cmp    (sp)+    ,(sp)+        ; /BBS/ pop ^C counter, data buffer
  372.     return
  373.  
  374.  
  375.     .sbttl    RPACK$ initialization
  376.  
  377. rpakin:    mov    r4    ,r0        ; /62/ copy local buffer pointer
  378.     mov    #11    ,r1        ; /62/ need to clear this many words
  379. 10$:    clr    (r0)+            ; /62/ do it
  380.     sob    r1    ,10$        ; /62/ one word at a time
  381.     bisb    senpar+p.time,.timeo(r4) ; /62/ time-out := SET TIME-OUT value
  382.     mov    2(r5)    ,r0
  383.     clr    (r0)+            ; packet.length := 0
  384.     clr    (r0)+            ; packet.number := 0
  385.     clr    (r0)+            ; packet.type   := 0
  386.     return
  387.  
  388.  
  389.     .sbttl    RPACK$ read with time-out
  390.  
  391. rpakrd:    calls    binrea    ,<.timeo(r4)>    ; read input char
  392.     tst    r0            ; did it work?
  393.     bne    10$            ; no
  394.     call    rawio            ; perhaps raw I/O logging
  395.     clr    r0            ; no errors, also clears carry
  396.     return
  397. 10$:    sec                ; flag the time-out
  398.     return
  399.  
  400.  
  401.     .sbttl    RPACK$ extended header type 0 for long packets
  402.  
  403. rdexhd:    mov    r2    ,-(sp)        ; /42/ added 08-Jan-86 Brian Nelson
  404.     mov    r5    ,-(sp)        ; need an odd register for mul
  405.     call    rpakrd            ; extended header, read the lenx1
  406.     bcs    20$            ; field, exiting on read errors
  407.     bic    #^c<177>,r1        ; ensure parity is cleared out
  408.     movb    r1    ,(r3)+        ; save into checksum buffer
  409.     unchar    r1    ,r5        ; get the high order of length
  410.     mul    #95.    ,r5        ; shift over please
  411.     call    rpakrd            ; extended header, read the lenx2
  412.     bcs    20$            ; field, exiting on read errors
  413.     bic    #^c<177>,r1        ; ensure parity is cleared out
  414.     movb    r1    ,(r3)+        ; save into checksum buffer
  415.     unchar    r1    ,r1        ; get the next one
  416.     add    r1    ,r5        ; now we have the extended length
  417.     sub    chksiz    ,r5        ; drop it by checksum size
  418.     mov    r5    ,.len(r4)    ; save it here, of course
  419.  
  420.     mov    .cbuff(r4),r5        ; now, at last, get the extended
  421.     mov    #5    ,r1        ; header checksum data
  422.     clr    -(sp)            ; accumulate in stack
  423. 10$:    clr    r0            ; use the normal safe way to add
  424.     bisb    (r5)+    ,r0        ; bytes even though we know that
  425.     add    r0    ,(sp)        ; no sign extends will happen
  426.     sob    r1    ,10$        ; next please
  427.     mov    (sp)+    ,r0        ; pop the checksum please
  428.     mov    r0    ,r2        ; save it
  429.     bic    #^c<300>,r2        ; compute it as in:
  430.     ash    #-6    ,r2        ; chk=char((s+((s&0300)/0100))&77)
  431.     add    r0    ,r2
  432.     bic    #^c<77>    ,r2        ; got it now
  433.  
  434.     call    rpakrd            ; extended header - read the hcheck
  435.     bcs    20$            ; field, exiting on read errors
  436.     clr    r0            ; /63/ preset no error
  437.     bic    #^c<177>,r1        ; ensure parity is cleared out
  438.     movb    r1    ,(r3)+        ; save into checksum buffer
  439.     unchar    r1    ,r1        ; convert to actual checksum now
  440.     cmpb    r1    ,r2        ; do the checksums match?
  441.     beq    40$            ; /63/ yes
  442.     mov    #badchk    ,r0        ; header checksum error
  443.     br    30$            ; stuff the error
  444. 20$:    mov    #timout    ,r0        ; return time-out error
  445.     clr    .len(r4)        ; /62/ don't log bogus data on timout
  446. 30$:    mov    2(sp)    ,r5        ; /BBS/ restore r5 to as entering
  447.     mov    2(r5)    ,r1        ; get address of result block
  448.     clr    o$len(r1)        ; clear packet length
  449.     mov    r0    ,o$typ(r1)    ; return the error
  450.     mov    r0    ,.typ(r4)    ; here also please
  451.     mov    #-1    ,r0        ; fatal error
  452. 40$:    mov    (sp)+    ,r5
  453.     mov    (sp)+    ,r2
  454.     return
  455.  
  456.  
  457.     .sbttl    RPACK$ get and convert the checksum
  458.  
  459. rpakck:    save    <r3>            ; use r3 for accumulating check
  460.     clr    r3            ; assume zero for now
  461.     call    rpakrd            ; read(input,ch)
  462.     bcs    20$            ; exit if timed out
  463.     bisb    r1    ,recbit        ; recbit |= ch
  464.     bic    #^c<177>,r1        ; ch := ch and 177b
  465.     unchar    r1    ,r3        ; received_check := ch
  466.     cmpb    chktyp    ,#defchk    ; if len(checksum) > 8 bits
  467.     blos    10$            ;  then begin
  468.      ash    #6    ,r3        ;   check := check * 64
  469.      call    rpakrd            ;   read(input,ch)
  470.      bcs    20$            ;   exit if timed out
  471.      bic    #^c<177>,r1        ;   ch := ch and 177b
  472.      unchar    r1    ,r1        ;   ch := unchar(ch)
  473.      bisb    r1    ,r3        ;   rcheck := rcheck + ch
  474.      cmpb    chktyp    ,#'3        ;   if checktype = crc16
  475.      bne    10$            ;    then
  476.      ash    #6    ,r3        ;     begin
  477.      call    rpakrd            ;      check := check * 64
  478.      bcs    20$            ;      check := check + ch
  479.      bic    #^c<177>,r1        ;      ch := ch and 177b
  480.      unchar    r1    ,r1
  481.      bisb    r1    ,r3        ;      end
  482. 10$:    clc
  483. 20$:    mov    r3    ,.rcheck(r4)    ; return the checksum
  484.     unsave    <r3>
  485.     return
  486.  
  487.  
  488.     .sbttl    RPACK$ end of packet housekeeping
  489.  
  490. rpakfi:    mov    r3    ,-(sp)        ; compute correct checksum type
  491.     call    checks            ; simple
  492.     mov    (sp)+    ,.ccheck(r4)    ; and stuff it in please
  493.     cmpb    .ccheck(r4),.rcheck(r4)    ; compare computed, actual checksums
  494.     beq    10$            ; they are the same
  495.     mov    #badchk    ,.typ(r4)    ; they're different, flag the error
  496. 10$:    mov    2(r5)    ,r1        ; where to return some things
  497.     mov    .len(r4),(r1)+        ; /62/ O$LEN packet length
  498.     mov    .seq(r4),(r1)+        ; /62/ O$SEQ packet number
  499.     mov    .typ(r4),(r1)        ; /62/ O$TYP packet type
  500.     call    rpakst            ; do stats and logging now
  501.     jmp    rpaklo            ; /62/ possibly log checksum errors?
  502.  
  503.  
  504.     .sbttl    RPACK$ statistics, logging, resonating packets fix
  505.  
  506. rpakst:    cmpb    .typ(r4),#'A&137    ; count the packet types for stats
  507.     blo    40$            ; bad packet type
  508.     cmpb    .typ(r4),#'Z&137    ; must in the range A..Z
  509.     bhi    40$            ; definitely a bad packet
  510.  
  511.     ; /BBS/ check for resonating packets or hung driver
  512.     asr    nakrec            ; shift prior tests down the line
  513.     cmpb    .typ(r4),#'N&137    ; a NAK?
  514.     bne    10$            ; nope..
  515.     bis    #4    ,nakrec        ; ya, mark shift reg at 1st position
  516. 10$:    cmp    nakrec    ,#4+1        ; looking for NAK xxx NAK series as
  517.     bge    20$            ; when resonating, go clear it
  518.     cmpb    .typ(r4),#timout    ; timed out?
  519.     bne    30$            ; nope..
  520. 20$:    call    hose            ; ya, try harder to make it go
  521.     clr    nakrec            ; start over after hose
  522.     bit    #log$rp    ,trace        ; /BBS/ RPACK to TT?
  523.     beq    30$            ; /BBS/ no
  524.     wrtall    #pak.03            ; /62/ ya, display time out
  525.  
  526. 30$:     movb    .typ(r4),r1        ; packet is ok, add it to the stats
  527.      sub    #100    ,r1        ; convert to 1..26
  528.      asl    r1            ; to word offsets
  529.      asl    r1            ; /43/ double word offsets
  530.      add    #1    ,pcnt.r+2(r1)    ; /43/ 32-bit addition today
  531.      adc    pcnt.r+0(r1)        ; /43/ the high order part of it
  532.      add    #1    ,pcnt.r+2    ; /43/ add it in here also
  533.      adc    pcnt.r+0        ; /43/ high order part
  534.  
  535. 40$:    bit    #log$rp    ,trace        ; /BBS/ RPACK to TT?
  536.     beq    50$            ; /BBS/ no
  537.     .newline            ; /BBS/ ya, format display
  538. 50$:    bit    #log$pa    ,trace        ; tracing today?
  539.     bne    60$            ; /BBS/ ya
  540.     bit    #log$de    ,trace        ; /62/ TT debugging?
  541.     beq    70$            ; /BBS/ no
  542. 60$:    calls    dskdmp    ,<#pak.02,.seq(r4),.typ(r4),.len(r4),@r5> ; /62/
  543. 70$:    return
  544.  
  545.  
  546.     .sbttl    RPACK$ packet logging
  547.  
  548. rpaklo:    cmp    .rcheck(r4),.ccheck(r4)    ; checksums match?
  549.     beq    40$            ; /62/ yes, do nothing then
  550.     save    <r0,r1>            ; /62/
  551.     mov    trace    ,r0        ; /62/ copy of debug status word
  552.     bic    #^c<log$pa!log$de>,r0    ; /62/ need to do this?
  553.     beq    30$            ; /62/ nope
  554.     sub    #100.    ,sp        ; /63/ ya, make buffer for err message
  555.     mov    sp    ,r1        ; point to the buffer
  556.     strcpy    r1    ,#pak.04    ; /62/ a header
  557.     strlen    r1            ; length so far
  558.     add    r0    ,r1        ; point to the end of it
  559.     deccvt    .rcheck(r4),r1        ; convert to decimal
  560.     add    #6    ,r1        ; move along please
  561.     movb    #comma    ,(r1)+        ; /62/ insert delimiter
  562.     deccvt    .ccheck(r4),r1        ; the calculated checksum
  563.     add    #6    ,r1        ; make it .asciz
  564.     clrb    @r1            ; simple
  565.     mov    sp    ,r1        ; point back to the buffer
  566.     bit    #log$pa    ,trace        ; /62/ is packet debugging on?
  567.     beq    10$            ; /62/ no
  568.     strlen    r1            ; ya, get the length
  569.     calls    putrec    ,<r1,r0,#lun.lo> ; dump buffer to disk
  570.     tst    r0            ; /62/ did it work?
  571.     beq    10$            ; /62/ ya
  572.     call    logerr            ; /62/ no, handle the error
  573. 10$:    tst    remote            ; /62/ running locally?
  574.     bne    20$            ; /62/ no
  575.     bit    #log$de    ,trace        ; /62/ ya, is terminal debugging on?
  576.     beq    20$            ; /62/ no
  577.     wrtall    r1            ; /62/ ya, print it
  578.     .newline            ; /62/
  579. 20$:    add    #100.    ,sp        ; /63/ pop buffer
  580. 30$:    unsave    <r1,r0>            ; /62/
  581. 40$:    return
  582.  
  583.  
  584.     .sbttl    RPACK$ raw I/O logging, chars to RPACK debug display
  585.  
  586. rawio:    save    <r0,r1>
  587.     bit    #log$io    ,trace        ; dumping all I/O today?
  588.     beq    20$            ; /BBS/ no
  589.     save    <r1>
  590.     clr    r0            ; avoid sxt
  591.     bisb    r1    ,r0        ; and setup call to putcr0
  592.     mov    #lun.lo    ,r1        ; write to this channel
  593.     call    putcr0            ; simple
  594.     tst    r0            ; /62/ did it work?
  595.     beq    10$            ; /62/ ya
  596.     call    logerr            ; /62/ no, handle the error
  597. 10$:    unsave    <r1>            ; /62/
  598.  
  599. 20$:    bit    #log$rp    ,trace        ; /BBS/ dump to a local terminal?
  600.     beq    60$            ; no
  601.     cmpb    r1    ,recsop        ; start of a packet?
  602.     beq    50$            ; yes
  603.     cmpb    r1    ,conpar+p.eol    ; /BBS/ no, is this the end of line?
  604.     bne    30$            ; /BBS/ no
  605.     wrtall    #pak.06            ; /62/ yes, finish up the display
  606.     br    60$
  607.  
  608. 30$:
  609. .if df    RT11                ; /E64/
  610.     tst    tsxsav            ; /BBS/ running under TSX?
  611.     beq    40$            ; /BBS/ nope
  612.     cmpb    r1    ,m.tsxr        ; /62/ ya, is this the TSLICH?
  613.     beq    60$            ; /BBS/ ya, don't type it to TT
  614. .endc    ;RT11                ; /E64/
  615. 40$:    movb    r1    ,r0        ; /BBS/ get a byte
  616.     call    writ1char        ; /BBS/ send it to TT
  617.     br    60$
  618.  
  619. 50$:    wrtall    #pak.05            ; /62/ start of a packet
  620. 60$:    unsave    <r1,r0>
  621.     return
  622.  
  623.  
  624.     .sbttl    Send a packet
  625.  
  626. ;    S P A C K $
  627. ;
  628. ;    input:      (r5)    = type of packet
  629. ;         2(r5)    = packet number
  630. ;         4(r5)    = length of the data to send
  631. ;         6(r5)    = location of the data to send
  632. ;    output:       r0    = error status
  633.  
  634. spack$::save    <r1,r2,r3,r4>
  635.     call    dcdtst            ; /62/ check DCD, report any change..
  636.     tstb    handch            ; /62/ any particular handshake today?
  637.     beq    10$            ; no
  638.     call    spakwa            ; ya, do handshaking
  639. 10$:    call    spakin            ; logging, padding, packet type stats
  640.     sub    #$allsiz,sp        ; /42/ allocate a LONG buffer
  641.     mov    sp    ,r4        ; point to the buffer
  642.     clr    -(sp)            ; count the total length
  643.     tst    prexon            ; /53/ prefix all packets with an XON?
  644.     beq    20$            ; /53/ no
  645.     movb    #xon    ,(r4)+        ; /53/ yes, insert one
  646.     inc    @sp            ; /53/ write_length++
  647. 20$:    setpar    sensop    ,(r4)+        ; start all packets with the SOH
  648.     mov    r4    ,r2        ; get address for checksum compute
  649.     inc    @sp            ; packetlength := succ(packetlength)
  650.     mov    4(r5)    ,r0        ; the length of the packet
  651.     mov    #maxpak    ,r1        ; /BBS/ preset for compare
  652.     cmp    senlng    ,r1        ; /BBS/ long packets this time?
  653.     blos    30$            ; /BBS/ nope..
  654.     sub    chksiz    ,r1        ; /BBS/ ya, be sure checksum will fit
  655.     sub    #2    ,r1        ; /BBS/ SEQ + TYP have to fit too..
  656. 30$:    cmp    r0    ,r1        ; /BBS/ packet too large?
  657.     blos    50$            ; no
  658.     tst    senlng            ; /42/ receiver said it can do long
  659.     beq    40$            ; /42/ packets?  if eq, no
  660.                     ; /42/ otherwise build extended header
  661.     mov    r2    ,-(sp)        ; /42/ save address of start of packet
  662.     mov    #space    ,-(sp)        ; /42/ accumulate header checksum
  663.     setpar    #space    ,(r4)+        ; /42/ length is a space, of course
  664.     tochar    2(r5)    ,r1        ; /42/ packet sequence please
  665.     add    r1    ,(sp)        ; /42/ add into header checksum now
  666.     setpar    r1    ,(r4)+        ; /42/ insert it
  667.     movb    (r5)    ,r1        ; /42/ the packet type is next
  668.     bicb    #40    ,r1        ; /42/ ensure always upper case
  669.     add    r1    ,(sp)        ; /42/ add in the checksum
  670.     setpar    r1    ,(r4)+        ; /42/ and insert that also
  671.     mov    r0    ,r3        ; /42/ insert the total packet size
  672.     clr    r2            ; /42/ first byte is size/95
  673.     add    chksiz    ,r3        ; /42/ must include checksum size
  674.     div    #95.    ,r2        ; /42/ second byte is size mod 95
  675.     tochar    r2    ,r2        ; /42/ convert to character rep
  676.     tochar    r3    ,r3        ; /42/ convert to character rep
  677.     setpar    r2    ,(r4)+        ; /42/ insert high bits into packet
  678.     add    r2    ,(sp)        ; /42/ add into checksum
  679.     setpar    r3    ,(r4)+        ; /42/ insert low bits into packet
  680.     add    r3    ,(sp)        ; /42/ add into checksum
  681.     mov    (sp)+    ,r0        ; /42/ pop the checksum please
  682.     mov    r0    ,r2        ; /42/ save it
  683.     bic    #^c<300>,r2        ; /42/ compute it as in:
  684.     ash    #-6    ,r2        ; /42/ checksum=
  685.     add    r0    ,r2        ; /42/ char((s+((s&300)/100))&77)
  686.     bic    #^c<77>    ,r2        ; /42/ got it now
  687.     tochar    r2    ,r2        ; /42/ convert checksum to character
  688.     setpar    r2    ,(r4)+        ; /42/ and insert into packet
  689.     mov    (sp)+    ,r2        ; /42/ start checksum for rest here
  690.     add    #7    ,(sp)        ; /BBS/ add, in case of prexon, above
  691.     br    60$            ; /42/ add off we go
  692.  
  693. 40$:    mov    #maxpak-3,r0        ; yes, reset packet size please
  694. 50$:    add    #2    ,r0        ; + two for number and type
  695.     add    chksiz    ,r0        ; + the length of the checksum please
  696.     clr    r1            ; accumulated checksum
  697.     tochar    r0    ,r1        ; start the checksum out right
  698.     setpar    r1    ,(r4)+        ; and stuff length into the packet
  699.     inc    @sp            ; packetlength := succ(packetlength)
  700.     tochar    2(r5)    ,r0        ; convert the packet number now
  701.     setpar    r0    ,(r4)+        ; and stuff it into the packet
  702.     inc    @sp            ; packetlength := succ(packetlength)
  703.     movb    @r5    ,r0        ; get the packet type now
  704.     bicb    #40    ,r0        ; ensure UPPER CASE packet type
  705.     setpar    r0    ,(r4)+        ; insert the packet type into buffer
  706.     inc    @sp            ; packetlength := succ(packetlength)
  707.  
  708. 60$:    mov    4(r5)    ,r1        ; get the data length
  709.     beq    80$            ; nothing to do
  710.     mov    6(r5)    ,r3        ; address of the data to send
  711.  
  712. 70$:    clr    r0            ; get the next character
  713.     bisb    (r3)+    ,r0        ; next char
  714.     setpar    r0    ,(r4)+        ; now move the data byte into the buff
  715.     inc    @sp            ; packetlength := succ(packetlength)
  716.     sob    r1    ,70$        ; next please
  717.  
  718. 80$:    clrb    @r4            ; set .asciz for call to checks
  719.     mov    r2    ,-(sp)        ; starting address for checksum field
  720.     call    checks            ; simple
  721.     mov    (sp)+    ,r2        ; get the computed checksum now
  722.     call    spakck            ; stuff checksum into buffer now
  723.     add    r0    ,@sp        ; and the length of the checksum
  724.     setpar    conpar+p.eol,(r4)+    ; end of line
  725.     inc    @sp            ; packetlength := succ(packetlength)
  726.     mov    (sp)+    ,r1        ; packet length
  727.     mov    sp    ,r4        ; address(buffer)
  728. .if df    RT11                ; /E64/
  729.     calls    binwri    ,<r4,r1>    ; and dump the buffer out now
  730. .endc    ;RT11                ; /E64/
  731. .if df    RSTS                ; /E64/
  732.     calls    pakwri    ,<r4,r1>    ; and dump the buffer out now
  733. .endc    ;RSTS                ; /E64/
  734.     call    spakfi            ; log to disk
  735.     add    #$allsiz,sp        ; pop the buffer
  736.     unsave    <r4,r3,r2,r1>
  737.     return
  738.  
  739.  
  740.     .sbttl    SPACK$ handshaking
  741.  
  742. spakwa:    scan    @r5    ,#han.no    ; if packet type is in this list..
  743.     tst    r0
  744.     bne    30$            ; ..then skip the handshaking stuff
  745.     save    <r2>
  746.     mov    4(r5)    ,r2        ; /62/ limit looping to packet length
  747.     add    #14    ,r2        ; /62/ plus header, trailer, etc..
  748.     movb    senpar+p.time,r0    ; /62/ use "normal" time-out
  749. 10$:    calls    binrea    ,<r0>        ; /62/ wait for handshake char
  750.     tst    r0            ; did the read time out?
  751.     bne    20$            ; /62/ if so, exit
  752.     bicb    #200    ,r1        ; ensure no parity is set
  753.     cmpb    r1    ,handch        ; is this the handshake character?
  754.     beq    20$            ; /62/ ya
  755.     sob    r2    ,10$        ; no, try again but not forever please
  756. 20$:    unsave    <r2>
  757. 30$:    return
  758.  
  759.     .save                ; these packet types must NOT
  760.     .psect    $pdata            ; be processed with handshaking
  761. han.no:    .byte    msg$snd    ,msg$ser ,msg$rcv ,msg$command ,msg$generic
  762.     .byte    0
  763.     .even
  764.     .restore
  765.  
  766.  
  767.     .sbttl    SPACK$ logging, padding, packet type stats
  768.  
  769. spakin:    bit    #log$pa    ,trace        ; packet debugging today?
  770.     bne    10$            ; /BBS/ ya
  771.     bit    #log$de    ,trace        ; /62/ no, maybe TT debugging?
  772.     beq    20$            ; /BBS/ no
  773. 10$:    calls    dskdmp    ,<#pak.08,2(r5),@r5,4(r5),6(r5)> ; /62/ ya
  774.  
  775. 20$:    tst    pauset            ; wait a moment?
  776.     beq    30$            ; no
  777.     calls    suspend    ,<pauset>    ; yes
  778. 30$:    clr    r1            ; avoid sign extension
  779.     bisb    conpar+p.npad,r1    ; send some pad characters?
  780.     beq    50$            ; no padding
  781.     mov    #conpar+p.padc,r2    ; /62/ address of the pad character
  782. .if df    RT11                ; /E64/
  783. 40$:    calls    binwri    ,<r2,#1>    ; send some padding
  784. .endc    ;RT11                ; /E64/
  785. .if df    RSTS                ; /E64/
  786. 40$:    calls    pakwri    ,<r2,#1>    ; send some padding
  787. .endc    ;RSTS                ; /E64/
  788.     sob    r1    ,40$        ; next please
  789.  
  790. 50$:    movb    @r5    ,r1        ; the packet type next
  791.     cmpb    r1    ,#'A&137    ; a legitimate packet type?
  792.     blo    60$            ; no
  793.     cmpb    r1    ,#'Z&137    ; must be in the range A..Z
  794.     bhi    60$            ; no good
  795.      sub    #100    ,r1        ; convert into range 1..26
  796.      asl    r1            ; and count the packet type
  797.      asl    r1            ; /43/ 32. bits
  798.      add    #1    ,pcnt.s+2(r1)    ; /43/ 32. bits, pakcnt(type)++
  799.      adc    pcnt.s+0(r1)        ; /43/ 32. bits, the high part
  800.      add    #1    ,pcnt.s+2    ; /43/ 32. bits now
  801.      adc    pcnt.s+0        ; /43/ the high order part
  802. 60$:    return
  803.  
  804.  
  805.     .sbttl    SPACK$ compute checksum
  806.  
  807. spakck:    clr    r0        ; checksum.len := 0
  808.     cmpb    chktyp    ,#defchk ; if checklength > 6 bits
  809.     blos    20$        ;  then begin
  810.     cmpb    chktyp    ,#'3    ;   if checktype = crc16
  811.     bne    10$        ;    then begin
  812.     mov    r2    ,r1    ;     checkchar1:=tochar(check[12..15])
  813.      ash    #-14    ,r1    ;     shift over 12 bits
  814.      bic    #^c<17>    ,r1    ;     mask off the high 12  bits
  815.      tochar    r1    ,@r4
  816.      setpar    @r4    ,(r4)+
  817.      inc    r0        ;     packetlength := succ(packetlength)
  818.                 ;    end
  819. 10$:     mov    r2    ,r1    ;   checkchar1 := tochar(check[6..11])
  820.      ash    #-6    ,r1    ;   shift over 6 bits
  821.      bic    #^c<77>    ,r1    ;   mask off the higher order bits
  822.      tochar    r1    ,@r4
  823.      setpar    @r4    ,(r4)+
  824.      inc    r0        ;   packetlength := succ(packetlength)
  825.      bic    #^c<77>    ,r2    ;   now drop the high bits from checks
  826.  
  827. 20$:    tochar    r2    ,@r4    ; convert char
  828.     tst    ranerr        ; insert random checksum errors?
  829.     beq    40$        ; no, please don't
  830.     mov    r0    ,-(sp)    ;+ test mode  irand uses r0
  831.     call    irand        ;+ test mode  get a random number
  832.     tst    r0        ;+ test mode  is it zero?
  833.     bne    30$        ;+ test mode  no, leave things alone
  834.     incb    @r4        ;+ test mode  ya, create an error
  835. 30$:    mov    (sp)+    ,r0    ;+ test mode  restore r0
  836. 40$:    setpar    @r4    ,(r4)+    ; set parity, if in use..
  837.     inc    r0        ; packetlength := succ(packetlength)
  838.     return
  839.  
  840.  
  841.     .sbttl    SPACK$ pseudo random number generator for testing
  842.  
  843. irand:    tst    seed            ; has a seed been set?
  844.     bne    10$            ; ya, use that value
  845.     mov    #1234.    ,seed        ; no, use this default seed
  846. 10$:    mov    seed    ,r0        ; make a copy of it
  847.     mov    r1    ,-(sp)        ; preserve r1
  848.     mov    r0    ,r1        ; copy of seed number to
  849.     ash    #-4    ,r1        ; multiply it * 16. and
  850.     bic    #170000    ,r1        ; clear its bits 15. - 12. then
  851.     xor    r1    ,r0        ; toggle whatever's left in orig seed
  852.     ash    #13    ,r1        ; dump bits 11. thru 0.
  853.     bic    #100000    ,r1        ; ensure what's left is a positive num
  854.     xor    r1    ,r0        ; again, toggle the orig seed with it
  855.     bic    #100000    ,r0        ; make sure result remains positive
  856.     mov    r0    ,seed        ; save it for the next time around..
  857.     ash    #-13    ,r0        ; shift so only 4 hi bits are output
  858.     mov    (sp)+    ,r1        ; restore r1
  859.     return
  860.  
  861.  
  862.     .sbttl    SPACK$ log to disk
  863.  
  864. spakfi:    bit    #log$io    ,trace        ; dumping all I/O out?
  865.     beq    40$            ; no
  866.     save    <r0,r1,r2,r4>
  867.     mov    r1    ,r2        ; anything to do?
  868.     beq    30$            ; no
  869. 10$:    clr    r0            ; yes, avoid sign extension
  870.     bisb    (r4)+    ,r0        ; get the next ch to dump
  871.     mov    #lun.lo    ,r1        ; the lun to write to
  872.     call    putcr0            ; simple
  873.     tst    r0            ; /62/ did it work?
  874.     beq    20$            ; /62/ ya
  875.     call    logerr            ; /62/ no, handle the error
  876.     br    30$            ; /62/ then bail out
  877. 20$:    sob    r2    ,10$        ; next please
  878. 30$:    unsave    <r4,r2,r1,r0>
  879. 40$:    return
  880.  
  881.  
  882.     .sbttl    Compute checksum
  883.  
  884. ;    C H E C K S
  885. ;
  886. ;    input:      (sp)    = address of .asciz string to checksum
  887. ;    output:      (sp)    = the computed checksum
  888.  
  889. checks:    save    <r0,r1,r2,r3>
  890.     mov    10+2(sp),r2        ; pointer to the string to check
  891.     cmpb    chktyp    ,#'3        ; CRC-CCITT type today?
  892.     bne    10$            ; no
  893.     strlen    r2            ; yes, get the .asciz string length
  894.     calls    crcclc    ,<r2,r0>    ; compute the crc16
  895.     mov    r0    ,r2        ; stuff the result into r2 for later
  896.     br    60$            ; and exit
  897.  
  898. 10$:    clr    r1            ; init the checksum accumulator
  899. 20$:    clr    r3            ; get the next ch please
  900.     bisb    (r2)+    ,r3        ; got the next ch now
  901.     beq    40$            ; hit the end of the string
  902.     tst    parity            ; /BBS/ did the packet contain parity?
  903.     beq    30$            ; no, leave bit 7 alone
  904.     bic    #^c<177>,r3        ; yes, please clear bit seven
  905. 30$:    bic    #170000    ,r1        ; /42/ ensure long packet not overflow
  906.     add    r3    ,r1        ; check := check + ch
  907.     br    20$
  908.  
  909. 40$:    mov    r1    ,r2        ; checksum := ((checksum and 300B)/64)
  910.     cmpb    chktyp    ,#'2        ; 12 bit sum type checksum?
  911.     beq    50$            ; yes, just exit
  912.     bic    #^c<300>,r2        ; ((..+checksum) and 77b)
  913.     ash    #-6    ,r2
  914.     add    r1    ,r2
  915.     bic    #^c<77>    ,r2
  916.     br    60$
  917.  
  918. 50$:    bic    #170000    ,r2        ; type 2 checksum
  919. 60$:    mov    r2    ,10+2(sp)    ; return the checksum
  920.     unsave    <r3,r2,r1,r0>
  921.     return
  922.  
  923.  
  924.     .sbttl    CRC calculation
  925.  
  926. ;    This routine will calculate the CRC for a string using the
  927. ;    CRC-CCIT polynomial.
  928. ;
  929. ;    The string should be the fields of the packet between  but
  930. ;    not including the  <mark>  and  the  block check, which is
  931. ;    treated as a string of bits with the low order bit of  the
  932. ;    first  character  first and the high order bit of the last
  933. ;    character last --  this  is  how  the  bits  arrive on the
  934. ;    transmission  line.  The  bit  string  is  divided by  the
  935. ;    polynomial
  936. ;
  937. ;    x^16+x^12+x^5+1
  938. ;
  939. ;    The initial value of the  CRC  is  0.  The  result  is the
  940. ;    remainder  of  this   division,   used   as-is  (i.e.  not
  941. ;    complemented).
  942. ;
  943. ;    From 20KERMIT.MAC, rewritten for  PDP-11  by  Brian Nelson
  944. ;    13-Jan-84 08:50:43
  945. ;
  946. ;    input:      (r5)    = string address
  947. ;         2(r5)    = string length
  948. ;    output:       r0    = CRC
  949.  
  950. crcclc:    save    <r1,r2,r3,r4,r5>
  951.     clr    r0            ; initialize the CRC to zero
  952.     mov    @r5    ,r3        ; get the string address now
  953.     mov    2(r5)    ,r4        ; get the string length
  954.     beq    30$            ; oops, nothing to do then
  955.  
  956. 10$:    clr    r1            ; get the next character please
  957.     bisb    (r3)+    ,r1        ; please avoid PDP-11 sign extend
  958.     tst    parity            ; /BBS/ did the packet have parity?
  959.     beq    20$            ; no, leave bit seven alone
  960.     bic    #^c<177>,r1        ; yes, clear bit seven please
  961. 20$:    ixor    r0    ,r1        ; add in with the current CRC
  962.     mov    r1    ,r2        ; get the high four bits
  963.     ash    #-4    ,r2        ; and move them over to 3..0
  964.     bic    #^c<17>    ,r2        ; drop any bits left over
  965.     bic    #^c<17>    ,r1        ; and the low four bits
  966.     asl    r1            ; times 2 for
  967.     asl    r2            ; word addressing
  968.     mov    crctb2(r1),r1        ; get low portion of CRC factor
  969.     ixor    crctab(r2),r1        ; ixor avoids hardware xor mode limits
  970.     swab    r0            ; shift off a byte from previous CRC
  971.     bic    #^c<377>,r0        ; clear new high byte
  972.     ixor    r1    ,r0        ; add in the new value
  973.     sob    r4    ,10$        ; next please
  974.  
  975. 30$:    unsave    <r5,r4,r3,r2,r1>
  976.     return
  977.  
  978.     .save
  979.     .psect    $pdata
  980. crctab:    .word         0 ,010201 ,020402 ,030603 ,041004 ,051205 ,061406 ,071607
  981.     .word    102010 ,112211 ,122412 ,132613 ,143014 ,153215 ,163416 ,173617
  982. crctb2:    .word         0 ,010611 ,021422 ,031233 ,043044 ,053655 ,062466 ,072277
  983.     .word    106110 ,116701 ,127532 ,137323 ,145154 ,155745 ,164576 ,174367
  984.     .restore
  985.  
  986.  
  987.     .sbttl    Buffer file being sent    ; /63/ moved back here for speed..
  988.  
  989. ;    B U F F I L              /63/ patched to include BUFPAK
  990. ;
  991. ;    input:     (r5)    = #0 for file or null terminated source buffer address
  992. ;        2(25)    = destination buffer, will be null terminated
  993. ;    output:      r0    = if <>, RMS error code
  994. ;          r1    = returned string length, excluding null terminator
  995. ;
  996. ;    Control and 8-bit char prefixing and repeat count encoding done here.
  997.  
  998. buffil::save    <r2,r3,r4>        ; /63/
  999.     mov    2(r5)    ,r4        ; destination buffer address
  1000.     mov     (r5)    ,r5        ; /63/ source buff addr or 0 if a file
  1001.     clr    r3            ; init a string length counter
  1002.     mov    senlng    ,r2        ; /63/ long_packets on?   or clears r2
  1003.     bne    10$            ; /62/ ya..  to avoid sxt on next inst
  1004.     bisb    conpar+p.spsiz,r2    ; /63/ get receiver's max size
  1005. 10$:    cmp    r2    ,senlen        ; /63/ rec'd packet_len > SET SEN PAC?
  1006.     ble    20$            ; /62/ no
  1007.     mov    senlen    ,r2        ; /63/ ya, let SET SEN PAC prevail
  1008. 20$:    sub    #10    ,r2        ; /63/ allow for rpt quoting, etc, etc
  1009.  
  1010. 30$:    tst    dorpt            ; are we doing repeat counts?
  1011.     beq    100$            ; no
  1012.  
  1013. 40$:    call    gnc            ; get next character
  1014.     bcs    60$            ; hit the end of the file
  1015.     tst    rptinit            ; if first time through this loop
  1016.     beq    50$            ; then
  1017.     clr    rptinit            ; flag we've been here now
  1018.     clr    rptcount        ; init the repeatt count
  1019.     movb    r1    ,rptlast    ; save copy of char in rptlast buffer
  1020. 50$:    cmpb    r1    ,rptlast    ; if the current char = rptlast char
  1021.     bne    60$            ; then
  1022.     cmp    rptcount,#maxpak    ; reached the mex repeat count yet?
  1023.     bge    60$            ; ya..
  1024.     inc    rptcount        ; no, bump the repeat count
  1025.     br    40$            ; and loop
  1026.  
  1027. 60$:    mov    r1    ,rptsave    ; save the failed character please
  1028.     tst    rptcount        ; this may be EOF on first character
  1029.     beq    120$            ; if so, we simply do nothing at all
  1030.     cmp    rptcount,#2        ; please don't bother with ONE char
  1031.     bgt    80$            ; don't waste the overhead for two
  1032. 70$:    clr    r1            ; avoid sign extension please
  1033.     bisb    rptlast    ,r1        ; get the character to write
  1034.     call    140$            ; and stuff it into the buffer
  1035.     dec    rptcount        ; more to insert?
  1036.     bne    70$            ; yes
  1037.     br    90$            ; no, exit
  1038.  
  1039. 80$:    movb    rptquo    ,(r4)+        ; insert the repeat count quote
  1040.     inc    r3            ; count it in the packet size
  1041.     tochar    rptcount,(r4)+        ; convert the repeat count to a char
  1042.     inc    r3            ; and count in the packet size
  1043.     clr    r1            ; avoid sxt
  1044.     bisb    rptlast    ,r1        ; recover the repeated character
  1045.     call    140$            ; and insert it into the buffer
  1046. 90$:    movb    rptsave    ,rptlast    ; make the failing character the one
  1047.     clr    rptcount        ; in case of EOF, set this please
  1048.     tst    r0            ; was this the end of file?
  1049.     bne    120$            ; yes, we had better leave then
  1050.     inc    rptcount        ; no, initialize the count please
  1051.     br    110$            ; and check for overflow in the buffer
  1052.  
  1053. 100$:    call    gnc            ; get next char
  1054.     bcs    120$            ; if (EOF) then break
  1055.     call    140$            ; stuff the character w/o repeats
  1056. 110$:    cmp    r3    ,r2        ; /63/ room for more data?
  1057.     blo    30$            ; ya
  1058.  
  1059. 120$:    mov    r3    ,r1        ; return the length please
  1060.     beq    130$            ; nothing there
  1061.     clr    r0            ; say read was successful
  1062. 130$:    clrb    (r4)            ; /63/ null term for non-file usage
  1063.     unsave    <r4,r3,r2>        ; /63/ is harmless for file packets
  1064.     return
  1065.  
  1066.  
  1067.     .sbttl    Actually quote and stuff the char for BUFFIL
  1068.  
  1069. 140$:    save    <r0,r2>            ; /63/ save regs used by caller
  1070.     tst    do8bit            ; if doing 8-bit prefixing
  1071.     beq    150$            ; and
  1072.     tstb    r1            ; bit_test(ch,200) is true
  1073.     bpl    150$            ; then
  1074.     movb    ebquot    ,(r4)+        ; buffer[i] := eight_bit_quote
  1075.     inc    r3            ; i := succ(i)
  1076.     bicb    #200    ,r1        ; ch := bit_clear(ch,200)
  1077. 150$:    mov    r1    ,r2        ; /63/ ch0_7 := ch
  1078.     bic    #^c<177>,r2        ; ch0_6 := ch0_7 and 177
  1079.     cmpb    r2    ,senpar+p.qctl    ; if ch0_6 = quote (ignoring hi bit)
  1080.     beq    190$            ; /63/ then quote it
  1081.     tst    do8bit            ; if doing 8-bit prefixing
  1082.     beq    160$            ; and
  1083.     cmpb    r2    ,ebquot        ; if ch0_6 == binary_quote
  1084.     beq    190$            ; /63/ then quote it
  1085. 160$:    tst    dorpt            ; if doing repeat compression
  1086.     beq    170$            ; /63/ and
  1087.     cmpb    r2    ,rptquo        ; if ch0_6 == repeat_quote
  1088.     beq    190$            ; /63/ then quote it
  1089. 170$:    mov    r1    ,r0        ; /63/ copy to map char into ctlflgs
  1090.     incb    r0            ; /63/ wrap 377 to 0, others ch=ch+1
  1091.     cmp    r0    ,#41        ; /63/ was char 37..0,377 (now 40..0)?
  1092.     blo    180$            ; /63/ yes, check for quoting enabled
  1093.     sub    #137    ,r0        ; /63/ no, bump 240..200 to 101..41
  1094.     cmp    r0    ,#41        ; /63/ if now < 41 then it's
  1095.     blo    200$            ; /63/ not a control char
  1096.     cmp    r0    ,#101        ; /63/ if now > 101 then it's
  1097.     bhi    200$            ; /63/ not a control char
  1098. 180$:    tstb    ctlflgs(r0)        ; /63/ quote this control char?
  1099.     beq    200$            ; /63/ no, pass it as it is..
  1100.     ctl    r1    ,r1        ; /63/ ch0_7 := ctl(ch0_7)
  1101.     ctl    r2    ,r2        ; /63/ ch0_6 := ctl(ch0_6)
  1102. 190$:    movb    senpar+p.qctl,(r4)+    ; /63/ buffer[i] := quote
  1103.     inc    r3            ; /63/ length := succ(length)
  1104. 200$:    tst    image            ; if image_mode
  1105.     beq    210$            ; then
  1106.     movb    r1    ,(r4)+        ; buffer[i] := ch0_7
  1107.     br    220$            ; else
  1108. 210$:    movb    r2    ,(r4)+        ; buffer[i] := ch0_6
  1109. 220$:    inc    r3            ; length := succ(length)
  1110.     unsave    <r2,r0>            ; /63/ restore caller's registers
  1111.     return
  1112.  
  1113.  
  1114.     .sbttl    Get the next char
  1115.  
  1116. gnc:    tst    r5            ; /63/ where is the next char?
  1117.     beq    10$            ; /63/ get it from a file
  1118.     clr    r0            ; /63/ preset to return success
  1119.     clr    r1            ; /63/ avoid sxt
  1120.     bisb    (r5)+    ,r1        ; /63/ get next char from input buff
  1121.     bne    30$            ; /63/ go add it to stats
  1122.     mov    #er$eof    ,r0        ; /63/ hit a null, flag end of data
  1123.     br    20$            ; /63/ and exit
  1124.  
  1125. 10$:    mov    #lun.in    ,r0        ; copy of file channel number
  1126.     call    getcr0            ; get next char
  1127.     tst    r0            ; did it work?
  1128.     beq    30$            ; ya
  1129. 20$:    sec                ; no, flag an error
  1130.     return
  1131.  
  1132. 30$:    add    #1    ,fileout+2    ; /62/ stats on file data
  1133.     adc    fileout+0        ; /43/ 32. bits
  1134.     clc                ; success  clc here just in case..!
  1135.     return
  1136.  
  1137.  
  1138.     .sbttl    Error message handler
  1139.  
  1140. ;    E R R O R
  1141. ;
  1142. ;    input:      (r5)    = arg count
  1143. ;         2(r5)    = text for message #1
  1144. ;         4(r5)    = and so on, total length not to exceed erbfsiz
  1145.  
  1146. error::    save    <r1,r2,r3,r4,r5>
  1147.     tst    remote            ; if not remote then printm(..)
  1148.     bne    10$            ; we are the remote, send errors
  1149.     call    printm            ; simple
  1150.     tst    linksts            ; /63/ was link running?
  1151.     beq    70$            ; /63/ nope..
  1152.     tst    inprogress        ; /63/ packet exchange in progress?
  1153.     beq    70$            ; /63/ nope..  else send error packet
  1154.  
  1155. 10$:    mov    (r5)+    ,r1        ; message count
  1156.     beq    70$            ; nothing to do
  1157.  
  1158.     sub    #erbfsiz+2,sp        ; remote, allocate a text buffer
  1159.     mov    sp    ,r4        ; and point to it please
  1160.     mov    #erbfsiz,r2        ; /BBS/ init erbfsiz byte counter
  1161.  
  1162. 20$:    mov    (r5)+    ,r3        ; get the next message please
  1163. 30$:    movb    (r3)+    ,@r4        ; now copy it to the buffer until
  1164.     beq    40$            ; we get a null
  1165.     inc    r4            ; bump buffer pointer to next pos
  1166.     sob    r2    ,30$        ; or until we run
  1167.     br    50$            ; out of space to put it
  1168. 40$:    dec    r2            ; ensure sufficient space
  1169.     beq    50$            ; don't overwrite stack!!
  1170.     sob    r1    ,20$        ; and get the next message
  1171. 50$:    clrb    @r4            ; ensure .asciz
  1172.  
  1173.     mov    sp    ,r4        ; all done, send the error packet
  1174.     strlen    r4            ; get the length
  1175.     spack    #msg$error,paknum,r0,r4    ; and send it
  1176.     bit    #log$pa    ,trace        ; /62/ logging packets?
  1177.     beq    60$            ; /62/ nope
  1178.     strlen    r4            ; /62/ ya, get length of it all
  1179.     calls    putrec    ,<r4,r0,#lun.lo> ; /62/ and dump buffer to disk
  1180.     tst    r0            ; /62/ did it work?
  1181.     beq    60$            ; /62/ ya
  1182.     call    logerr            ; /62/ no, go say why not
  1183. 60$:    add    #erbfsiz+2,sp        ; /62/ deallocate the text buffer
  1184. 70$:    unsave    <r5,r4,r3,r2,r1>
  1185.     return
  1186.  
  1187.  
  1188.     .sbttl    Like bufemp, but return data to a buffer
  1189.  
  1190. ;    input:      (r5)    = source buffer, .asciz
  1191. ;    output:     2(r5)    = destination buffer
  1192. ;           r0    = zero (no errors are possible)
  1193. ;           r1    = string length
  1194. ;
  1195. ;    No 8-bit prefixing will be done.  This routine
  1196. ;    used for decoding strings received for generic
  1197. ;    commands to the server.
  1198.  
  1199. .if df    RSTS                ; /E64/
  1200. bufunp::save    <r2,r3,r4,r5>
  1201.     mov    @r5    ,r2        ; input record address
  1202.     clr    r3            ; length := 0
  1203.     mov    2(r5)    ,r4        ; resultant string
  1204.  
  1205. 10$:    clr    r0            ; get the next character
  1206.     bisb    (r2)+    ,r0        ; into a convenient place
  1207.     beq    100$            ; all done
  1208.     bic    #^c177    ,r0        ; /53/ always seven bit data
  1209.     mov    #1    ,r5        ; /53/ assume character not repeated
  1210.     tst    dorpt            ; /53/ repeat processing off?
  1211.     beq    20$            ; /53/ yes, ignore
  1212.     cmpb    r0    ,rptquo        ; /53/ is this a repeated char?
  1213.     bne    20$            ; /53/ no, normal processing
  1214.     clr    r5            ; /BBS/ init to copy repeat count!
  1215.     bisb    (r2)+    ,r5        ; /53/ yes, get the repeat count
  1216.     bic    #^c177    ,r5        ; /53/ always seven bit data
  1217.     unchar    r5    ,r5        ; /53/ get the value
  1218.     tst    r5            ; /53/ good data
  1219.     bgt    15$            ; /53/ yes
  1220.     mov    #1    ,r5        ; /53/ no, fix it
  1221. 15$:    clr    r0            ; /53/ avoid sign extension
  1222.     bisb    (r2)+    ,r0        ; /53/ now get the real data
  1223.     bic    #^c177    ,r0        ; /53/ always seven bit data
  1224. 20$:    cmpb    r0    ,senpar+p.qctl    ; is this a quoted character?
  1225.     bne    30$            ; no
  1226.     clr    r0            ; yes, get the next character
  1227.     bisb    (r2)+    ,r0        ; must be one you know
  1228.     clr    r1            ; must avoid sign extension here
  1229.     bisb    r0    ,r1        ; check low 7 bits against quote
  1230.     bic    #^c177    ,r1        ; drop 7..15
  1231.     cmpb    r1    ,senpar+p.qctl    ; if ch <> myquote
  1232.     beq    30$            ;  then
  1233.     ctl    r0    ,r0        ;   ch := ctl(ch)
  1234.  
  1235. 30$:    movb    r0    ,(r4)+        ; copy the byte over now
  1236.     inc    r3            ; length := succ(length)
  1237.     sob    r5    ,30$        ; /53/ perhaps data was repeated
  1238.     br    10$            ; next character please
  1239.  
  1240. 100$:    clrb    @r4            ; make the string .asciz
  1241.     mov    r3    ,r1        ; return the length
  1242.     clr    r0            ; fake no errors please
  1243.     unsave    <r5,r4,r3,r2>
  1244.     return
  1245. .endc    ;RSTS                ; /E64/
  1246.  
  1247.  
  1248.     .sbttl    Print message if not remote, and copy to logfile
  1249.  
  1250. ;    P R I N T M            ; /62/ major revision
  1251. ;
  1252. ;    input:      (r5)    = arg count
  1253. ;         2(r5)    = text for message #1
  1254. ;         4(r5)    = and so on, total length not to exceed erbfsiz
  1255.  
  1256. printm::save                ; save r0 - r5, inclusive
  1257.     mov    (r5)+    ,r1        ; get the message count
  1258.     beq    100$            ; nothing to do
  1259.  
  1260.     sub    #erbfsiz+2,sp        ; allocate a local text buffer
  1261.     mov    sp    ,r4        ; and a pointer to it
  1262.     mov    #erbfsiz,r2        ; init byte overflow counter
  1263.  
  1264.     cmpb    @(r5)    ,#'?        ; is this an error message?
  1265.     beq    10$            ; ya, skip "Kermit:" prefix
  1266.     cmpb    @(r5)    ,#'%        ; /62/ is this an error message?
  1267.     beq    10$            ; /62/ ya, skip "Kermit:" prefix
  1268.     scan    #':    ,@r5        ; look for a colon indicating a
  1269.     tst    r0            ; prefix string ala "Xyz: "
  1270.     bne    10$            ; found one, don't do 2 headers
  1271.     mov    #pak.01    ,r3        ; stuff in "Kermit: " prefix
  1272.     inc    r1            ; by adding it to the arg count
  1273.     br    20$            ; and jumping in here..
  1274.  
  1275. 10$:    mov    (r5)+    ,r3        ; get the next message please
  1276. .if df    RT11                ; /E64/
  1277.     tst    tsxsav            ; TSX?
  1278.     beq    20$            ; no
  1279.     cmpb    (r3)    ,m.tsxr        ; is it the TSX lead-in char?
  1280.     bne    20$            ; no
  1281.     inc    r3            ; ya, skip past it and
  1282.     br    30$            ; don't type this to TT
  1283. .endc    ;RT11                ; /E64/
  1284. 20$:    movb    (r3)+    ,@r4        ; now copy it to the buffer until
  1285.     beq    40$            ; we get an ascii null
  1286. 30$:    inc    r4            ; bump buffer pointer to next position
  1287.     sob    r2    ,20$        ; or until we run
  1288.     br    50$            ; out of space to put it
  1289. 40$:    dec    r2            ; ensure sufficient space
  1290.     beq    50$            ; don't overwrite stack!!
  1291.     sob    r1    ,10$        ; and get the next message
  1292.  
  1293. 50$:    clrb    (r4)            ; ensure .asciz
  1294.     mov    sp    ,r4        ; all done, restore pointer
  1295.  
  1296.     tst    inserv            ; skip TT stuff if a server
  1297.     bne    80$            ; go check for disk logging
  1298.     tst    remote            ; skip if we are the remote
  1299.     bne    80$            ; go check for disk logging
  1300.     tst    xmode            ; if amidst an extended reply
  1301.     bne    60$            ; do a newline for sure..
  1302.     tst    logini            ; need a .newline if this is set
  1303.     beq    70$            ; no, this line is clean
  1304. 60$:    .newline
  1305. 70$:    wrtall    r4            ; dump local buffer to terminal
  1306.     .newline
  1307.     clr    logini            ; may need a logging header
  1308.  
  1309. 80$:    bit    #log$pa    ,trace        ; logging packets?
  1310.     beq    90$            ; nope
  1311.     strlen    r4            ; ya, get length of it all
  1312.     calls    putrec    ,<r4,r0,#lun.lo> ; and dump buffer to disk
  1313.     tst    r0            ; did it work?
  1314.     beq    90$            ; ya
  1315.     call    logerr            ; no, go say why not
  1316. 90$:    add    #erbfsiz+2,sp        ; pop local buffer
  1317. 100$:    unsave
  1318.     return
  1319.  
  1320.  
  1321.     .sbttl    print received error packet out
  1322.  
  1323. ;    P R E R R P
  1324. ;
  1325. ;    prerrp(%loc msg)
  1326. ;
  1327. ;    input:    @r5    address of .asciz string to print
  1328.  
  1329. .if df    RSTS                ; /E64/
  1330. prerrp::wrtall    #pak.09
  1331.     wrtall    @r5
  1332.     .newline
  1333.     clr    logini
  1334.     return
  1335. .endc    ;RSTS                ; /E64/
  1336.  
  1337.  
  1338.     .sbttl    Logfile error handler    ; /62/ all new
  1339.  
  1340. logerr::calls    syserr    ,<r0,#errtxt>    ; enter with r0=whatever_the_error_was
  1341. .if df    RT11                ; /E64/
  1342.     .close    #lun.lo            ; save what did make it to logfile..
  1343. .endc    ;RT11                ; /E64/
  1344. .if df    RSTS                ; /E64/
  1345.     calls    close    ,<#lun.lo>    ; close it
  1346. .endc    ;RSTS                ; /E64/
  1347.     bic    #<log$op!log$al!log$io>,trace ; kill all disk-based debugging
  1348.     mov    #er$lwe    ,r0        ; this is some logfile write error..
  1349.     calls    syserr    ,<r0,#spare1>    ; generate an error message saying so
  1350.     strcat    #spare1    ,#pak.07    ; /62/ now insert a <cr><lf> after it
  1351.     strcat    #spare1    ,#errtxt    ; then include the reported error too
  1352.     tst    inserv            ; skip TT stuff
  1353.     bne    30$            ; if a server
  1354.     tst    remote            ; skip if we
  1355.     bne    30$            ; are the remote
  1356. 10$:    tst    logini            ; need a .newline if this is set
  1357.     beq    20$            ; no, this line is clean
  1358.     .newline
  1359. 20$:    wrtall    #spare1            ; dump local buffer to terminal
  1360.     .newline
  1361.     clr    logini            ; may need a packet cnt logging header
  1362.     return
  1363.  
  1364. 30$:    tst    linksts            ; got a path for an error packet?
  1365.     beq    10$            ; nope, dump it to TT regardless then
  1366.     strlen    #spare1            ; ya, get the length of and
  1367.     spack    #msg$error,paknum,r0,#spare1 ; then send the error message
  1368.     movb    #sta.abo,state        ; /62/ and force the trasnfer to abort
  1369.     return
  1370.  
  1371.  
  1372.     .sbttl    Process retry and sync errors
  1373.  
  1374. m$retr::save    <r0>            ; retry abort
  1375.     bitb    #200    ,recbit        ; /44/ perhaps parity was going?
  1376.     beq    10$            ; /44/ no
  1377.     tst    parity            ; /BBS/ do we know about parity?
  1378.     bne    10$            ; /44/ yes we do, normal abort
  1379.     calls    error    ,<#2,#e$retr,#e$pari> ; /62/ no, mention it now!
  1380.     br    20$            ; /44/ exit
  1381. 10$:    calls    error    ,<#1,#e$retr>    ; send/print the error message
  1382. 20$:    unsave    <r0>
  1383.     return
  1384.  
  1385. m$sync::save    <r0>            ; out of sync
  1386.     calls    error    ,<#1,#e$sync>    ; send/print the error message
  1387.     unsave    <r0>
  1388.     return
  1389.  
  1390.  
  1391.     .sbttl    Compute parity for an outgoing 8-bit link
  1392.  
  1393. ;    This is software parity generation as it allows Kermit to control
  1394. ;    it even on interfaces which don't support it (by setting them for
  1395. ;    8 data bits and no parity).  It was derived from the Pascal RT-11
  1396. ;    Kermit by Phil Murton, and does a table lookup to compute parity.
  1397. ;    For the sake of speed and because some RT-11 systems lack certain
  1398. ;    instructions this method is used at a slight cost in space.
  1399.  
  1400. dopari::save    <r0,r1>            ; /BBS/    somewhat cleaned up..
  1401.     mov    parity    ,r0        ; get the current parity setting
  1402.     beq    10$            ; nothing to do
  1403.     asl    r0            ; word indexing to addresses
  1404.     mov    6(sp)    ,r1        ; get the character to do it to
  1405.     jsr    pc    ,@pardsp(r0)    ; and dispatch as desired
  1406.     mov    r1    ,6(sp)        ; return the character please
  1407. 10$:    unsave    <r1,r0>
  1408.     return
  1409.  
  1410.     .save
  1411.     .psect    $pdata
  1412. pardsp:    .word    0  ,odd.p  ,even.p  ,mark.p  ,spac.p
  1413.     .restore
  1414.  
  1415. mark.p:    bisb    #200    ,r1        ; mark means we are always HIGH
  1416.     return                ; on bit seven
  1417.  
  1418. spac.p:    bicb    #200    ,r1        ; space means we are always LOW
  1419.     return                ; on bit seven
  1420.  
  1421. odd.p:    bic    #^c<177>,r1        ; hose any previous parity
  1422.     tstb    partab(r1)        ; if char's entry in table is <>
  1423.     bne    10$            ; leave parity bit clear
  1424.     bisb    #200    ,r1        ; else set parity bit
  1425. 10$:    return
  1426.  
  1427. even.p:    bic    #^c<177>,r1        ; hose any previous parity
  1428.     tstb    partab(r1)        ; if char's entry in table is 0
  1429.     beq    10$            ; leave parity bit clear
  1430.     bisb    #200    ,r1        ; else set parity bit
  1431. 10$:    return
  1432.  
  1433.     .save
  1434.     .psect    $pdata
  1435. partab:    .byte    0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0  ; first 16 ascii characters
  1436.     .byte    1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1
  1437.     .byte    1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1
  1438.     .byte    0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0
  1439.     .byte    1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1
  1440.     .byte    0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0
  1441.     .byte    0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0
  1442.     .byte    1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1  ; last 16 characters (to 177)
  1443.     .restore
  1444.  
  1445.     .end
  1446.