home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / kermit11.tar.gz / kermit11.tar / k11pak.mac < prev    next >
Text File  |  1989-06-13  |  59KB  |  2,051 lines
  1.     .title    k11pak    packet driver for kermit-11
  2.     .ident    /8.0.01/
  3.     .enabl    gbl
  4.  
  5. ;    Brian Nelson    30-Nov-83  10:20:09
  6. ;    Last edit:    02-Jul-85  14:44:32
  7. ;
  8. ;    Change Software, Toledo, Ohio
  9. ;    University of Toledo, Toledo, Ohio
  10. ;
  11.  
  12.     .enabl    lc
  13.  
  14.  
  15.  
  16.  
  17. ;    define macros and things we want for KERMIT-11
  18. ;
  19. ;    K11MAC.MAC defines all macros and a number of symbols
  20.     .include    /IN:K11DEF.MAC/
  21.  
  22.  
  23.  
  24.  
  25.     .if ndf, K11INC
  26.     .ift
  27.     .include    /IN:K11MAC.MAC/
  28.     .endc
  29.  
  30.     .iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed
  31.     .include    /IN:K11DEF.MAC/
  32.  
  33.  
  34.  
  35.     maxpak    ==    94.        ; maximum packet size-maxsize(checksum)
  36.  
  37.     mx$try    ==    10        ; number of times to retry packet
  38.     myquote    ==    '#        ; quoting
  39.     mypad    ==    0        ; no padding
  40.     mypchar    ==    0        ; thus no pad character
  41.     myeol    ==    cr        ; end-of-line
  42.     mytime    ==    12        ; time me out after this
  43.     myqbin    ==    '&        ; 8 bit quoting
  44.     defchk    ==    '1
  45.     mychkt    ==    defchk        ; normal checksumming
  46.     myrept    ==    176        ; tilde for repeat things
  47.     mycapa    ==    capa.a+capa.l    ; /42/ Attributes + long packets
  48.     maxtim    ==    60        ; maximum timeout
  49.     mintim    ==    2        ; minimum timeout
  50.     badchk    ==    377        ; psuedo packet type for checksum
  51.     timout    ==    'T&137        ; psuedo packet type for timeout
  52.     defdly    ==    6        ; delay for SENDING to start up
  53.  
  54.  
  55.  
  56.     .sbttl    notes on RMS-11
  57.  
  58. ;    RSTS and RSX note:
  59. ;
  60. ;     Note that we really  don't need distinct luns for input, output
  61. ;    and  directory lookup as we would normally  never have more than
  62. ;    one of them active at any given time.  The space used to do this
  63. ;    only adds  about 1 KW of  size to the task  so I am not going to
  64. ;    worry about it.  There could  always come a time  when the above
  65. ;    assumption will not hold.  Most of KERMIT-11 is  sharable anyway
  66. ;    due to the linking to RMSRES. The code, all being in PSECT $CODE
  67. ;    can always be task built with the /MU switch to  make more of it
  68. ;    sharable (RSTS and RSX11M Plus only).
  69. ;     The one thing to note is that LUN.LO must ALWAYS be reserved as
  70. ;    logging  and debugging to disk can  be running concurrently with
  71. ;    anything else. Also, when the TAKE command is put in another lun
  72. ;    will be required for it.
  73.  
  74.  
  75.     lun.kb    ==    0        ; assume if channel 0 --> terminal
  76.     lun.in    ==    1        ; channel for input files
  77.     lun.ou    ==    2        ; channel for output files
  78.     lun.lo    ==    3        ; channel for packet and file logging
  79.     lun.tr    ==    3        ; same as lun.log
  80.     lun.ta    ==    4        ; for the TAKE command
  81.     lun.tt    ==    5        ; for RSX, the normal TI: channel
  82.     lun.sr    ==    6        ; channel for $search for RMSv2.0
  83.     lun.ti    ==    7        ; channel number for connected terminal
  84.     lun.xk    ==    7        ; Ditto, for clarity
  85.     lun.co    ==    10        ; used as is lin.ti for remote connect
  86.     lun.as    ==    11        ; used to attach to remote link device
  87.                     ; to fake a device assignment
  88.  
  89.     .psect    $pdata
  90.  
  91. null:    .byte    0,0            ; a null packet to send
  92.  
  93.     .psect    $code
  94.  
  95.  
  96.     .sbttl    KERMIT packet format
  97.  
  98. ;                 PACKET FORMAT
  99. ;
  100. ;The  KERMIT  protocol is built around exchange of packets of the following for-
  101. ;mat:
  102. ;
  103. ;    +------+-----------+-----------+------+------------+-------+
  104. ;    ] MARK ] char(LEN) ] char(SEQ) ] TYPE ]    DATA    ] CHECK ]
  105. ;    +------+-----------+-----------+------+------------+-------+
  106. ;
  107. ;where all fields consist of ASCII characters.  The fields are:
  108. ;
  109. ;MARK   The synchronization character that marks the beginning of  the  packet.
  110. ;    This should normally be CTRL-A, but may be redefined.
  111. ;
  112. ;LEN    The  number  of  ASCII  characters  within  the packet that follow this
  113. ;    field, in other words the packet length minus two.  Since  this  number
  114. ;    is  transformed  to  a single character via the char() function, packet
  115. ;    character counts of 0 to 94 (decimal) are permitted, and  96  (decimal)
  116. ;    is  the  maximum total packet length.  The length does not include end-
  117. ;    of-line or padding characters, which are outside  the  packet  and  are
  118. ;    strictly  for  the benefit of the operating system, but it does include
  119. ;    the block check characters.
  120. ;
  121. ;SEQ    The packet sequence number, modulo 64, ranging from 0 to 63.   Sequence
  122. ;    numbers "wrap around" to 0 after each group of 64 packets.
  123. ;
  124. ;
  125. ;TYPE   The  packet type, a single ASCII character.  The following packet types
  126. ;    are required:
  127. ;
  128. ;     D   Data packet
  129. ;     Y   Acknowledge (ACK)
  130. ;     N   Negative acknowledge (NAK)
  131. ;     S   Send initiate (exchange parameters)
  132. ;     B   Break transmission (EOT)
  133. ;     F   File header
  134. ;     Z   End of file (EOF)
  135. ;     E   Error
  136. ;
  137. ;
  138. ;DATA   The "contents" of the packet, if any contents are required in the given
  139. ;    type of packet, interpreted according to  the  packet  type.    Control
  140. ;    characters  are  preceded  by a special prefix character, normally "#",
  141. ;    and "uncontrollified" via ctl().  A prefixed sequence may not be broken
  142. ;    across packets.  Logical records in printable files are delimited  with
  143. ;    CRLFs,  suitably prefixed (e.g. "#M#J").  Any prefix characters are in-
  144. ;    cluded in the count.  Optional encoding for  8-bit  data  and  repeated
  145. ;    characters is described later.
  146. ;
  147. ;
  148. ;CHECK   A block check on the characters in the packet between, but not includ-
  149. ;    ing, the mark and the block check itself.  The check for each packet is
  150. ;    computed  by  both hosts, and must agree if a packet is to be accepted.
  151. ;    A single-character arithmetic checksum is the normal and required block
  152. ;    check.    Only  six  bits of the arithmetic sum are included.  In order
  153. ;    that all the bits of each data character contribute to  this  quantity,
  154. ;    bits  6  and  7  of the final value are added to the quantity formed by
  155. ;    bits 0-5.  Thus if s is the arithmetic sum  of  the  ASCII  characters,
  156. ;    then
  157. ;
  158. ;        check = char((s + ((s AND 192)/64)) AND 63)
  159. ;
  160. ;    This  is  the  default  block check, and all Kermits must be capable of
  161. ;    performing it.  Other optional block check types are described later.
  162. ;    The block check is based on the ASCII values of the characters  in  the
  163. ;    packet.    Non-ASCII  systems must translate to ASCII before performing
  164. ;    the block check calculation.
  165. ;
  166. ;
  167. ;
  168. ;    13-Oct-84  14:01:32  BDN    moved SENDSW and RECSW out
  169.  
  170.  
  171.     .sbttl    GETCR0    decide where to get the next character from
  172.  
  173. ;    06-Nov-85  11:22:14  BDN    Added Edit 38
  174. ;
  175. ;    Passed:    r0    LUN
  176. ;    Return:    r0    Error code (generally 0 or ER$EOF)
  177. ;        r1    Character just read
  178. ;
  179. ;
  180. ;    GETCR0  is  the lowest level entry point called in Kermit to
  181. ;    obtain the next character for a  SEND  function  (even  GETC
  182. ;    calls  it),  where that it may be a normal file transfer, or
  183. ;    a SERVER extended response. The main idea in altering it  is
  184. ;    so  that  a  server  dispatch  routine  can  change  the the
  185. ;    default (get from a  file)  to,  say,  get  from  an  .ASCIZ
  186. ;    string   in   memory   or  switch  to  some  other  kind  of
  187. ;    GET_NEXT_CHARACTER routine. This requires that  the  service
  188. ;    routine  insert  its  GET_NEXT_CHAR routine address into the
  189. ;    global 'GETCROUTINE' and also to reset it to 'FGETCR0'  when
  190. ;    the  action  is  complete.  Currenty, REMOTE HELP and REMOTE
  191. ;    DIR use this facility. 
  192.  
  193.  
  194. getcr0::tst    getcroutine        ; /38/is there any routine address set
  195.     bne    10$            ; /38/yes
  196.     call    fgetcr0            ; /38/no, default to file reading
  197.     br    100$            ; /38/exit
  198. 10$:    call    @getcroutine        ; /38/call currently defined routine
  199. 100$:    return
  200.  
  201.  
  202. tgetcr::tst    tgetaddr        ; /38/Have we ever been inited ?
  203.     beq    90$            ; /38/no, return ER$EOF
  204.     movb    @tgetaddr,r1        ; /38/yes, get next character please
  205.     beq    90$            ; /38/nothing is left to do
  206.     inc    tgetaddr        ; /38/text_address++
  207.     clr    r0            ; /38/return(no_errors)
  208.     br    100$            ; /38/exit
  209. 90$:    mov    #ER$EOF    ,r0        ; /38/return(end_of_file)
  210.     mov    #fgetcr0,getcroutine    ; /38/reset to file reading please
  211. 100$:    return                ; /38/exit
  212.  
  213.     global    <getcroutine,fgetcr0,tgetcr0,tgetaddr,ER$EOF>
  214.  
  215.  
  216.     .sbttl    spack    send packet
  217.  
  218.  
  219. ;    S P A C K $
  220. ;
  221. ;    spack$(%val type,%val num,%val len, %loc data)
  222. ;
  223. ;    input:    @r5    type of packet
  224. ;        2(r5)    packet number
  225. ;        4(r5)    length of the packet
  226. ;        6(r5)    location of the data to send
  227. ;    output:    r0    error status
  228.  
  229.     $ALLSIZ    =    <MAXLNG+<MAXLNG/10>>&177776
  230.  
  231. spack$::save    <r1,r2,r3,r4>        ; Save registers that we may use
  232.     call    spakwa
  233.     call    spakin
  234.     sub    #$ALLSIZ,sp        ; /42/ Allocate a LONG buffer
  235.     mov    sp    ,r4        ; Point to the buffer
  236.     clr    -(sp)            ; Count the total length
  237.     tst    prexon            ; /53/ Should we prefix all packets
  238.     beq    5$            ; /53/ with an XON? If eq, NO
  239.     movb    #'Q&37    ,(r4)+        ; /53/ Yes, insert one
  240.     inc    @sp            ; /53/ Write_length++
  241. 5$:    setpar    sensop    ,(r4)+        ; Start all packets with control A 
  242.     mov    r4    ,r2        ; Get address for checksum compute
  243.     inc    @sp            ; Packetlength := succ(packetlength)
  244.     mov    4(r5)    ,r0        ; The length of the packet
  245.     cmp    r0    ,#MAXPAK    ; Packet too large ?
  246.     blos    15$            ; No
  247.     bitb    #CAPA.L,conpar+p.capas    ; /43/ Check to see if both sides
  248.     beq    10$            ; /43/ REALLY understand long packets
  249.     bitb    #CAPA.L,senpar+p.capas    ; /43/ We would normally but it is
  250.     beq    10$            ; /43/ possible to SET NOLONG
  251.     tst    senlng            ; /42/ Receiver said it can do long
  252.     beq    10$            ; /42/ packets? If eq, then no
  253.                     ; /42/ Otherwise, build ext header.
  254.     mov    r2    ,-(sp)        ; /42/ Save this
  255.     mov    #40    ,-(sp)        ; /42/ Accumulate header checksum
  256.     setpar    #40    ,(r4)+        ; /42/ Length is a space, of course.
  257.     tochar    2(r5)    ,r1        ; /42/ Packet sequence please
  258.     add    r1    ,(sp)        ; /42/ Add into header checksum now.
  259.     setpar    r1    ,(r4)+        ; /42/ Insert it
  260.     movb    (r5)    ,r1        ; /42/ The packet type is next.
  261.     bicb    #40    ,r1        ; /42/ Insure always upper case.
  262.     add    r1    ,(sp)        ; /42/ Add in the checksum
  263.     setpar    r1    ,(r4)+        ; /42/ And insert that also
  264.     mov    r0    ,r3        ; /42/ Insert the total packet size
  265.     clr    r2            ; /42/ First byte is size/95.
  266.     add    chksiz    ,r3        ; /42/ Must include checksum size.
  267.     div    #95.    ,r2        ; /42/ Second byte is size mod 95
  268.     tochar    r2    ,r2        ; /42/ Convert to character rep
  269.     tochar    r3    ,r3        ; /42/ Convert to character rep
  270.     setpar    r2    ,(r4)+        ; /42/ Insert high bits into packet
  271.     add    r2    ,(sp)        ; /42/ Add into checksum
  272.     setpar    r3    ,(r4)+        ; /42/ Insert low bits into packet
  273.     add    r3    ,(sp)        ; /42/ Add into checksum
  274.     mov    (sp)+    ,r0        ; /42/ Pop the checksum please
  275.     mov    r0    ,r2        ; /42/ Save it
  276.     bic    #^C300    ,r2        ; /42/ Compute it as in:
  277.     ash    #-6    ,r2        ; /42/ Chk=char((s+((s&0300)/0100))&77)
  278.     add    r0    ,r2        ; /42/ ...
  279.     bic    #^C77    ,r2        ; /42/ Got it now
  280.     tochar    r2    ,r2        ; /42/ Convert checksum to character
  281.     setpar    r2    ,(r4)+        ; /42/ and insert into packet.
  282.     mov    (sp)+    ,r2        ; /42/ Where to start checksum for rest
  283.     mov    #7    ,(sp)        ; /42/ We now have seven characters.
  284.     br    20$            ; /42/ Add off we go
  285.  
  286. 10$:    mov    #MAXPAK-3,r0        ; Yes, reset packet size please
  287. 15$:    add    #2    ,r0        ; + two for number and type
  288.     add    chksiz    ,r0        ; + the length of the checksum please
  289.     clr    r1            ; Accumulated checksum
  290.     tochar    r0    ,r1        ; Start the checksum out right
  291.     setpar    r1    ,(r4)+        ; And stuff length into the packet
  292.     inc    @sp            ; Packetlength := succ(packetlength)
  293.     tochar    2(r5)    ,r0        ; Convert the packet number now
  294.     setpar    r0    ,(r4)+        ; And stuff it into the packet
  295.     inc    @sp            ; Packetlength := succ(packetlength)
  296.     movb    @r5    ,r0        ; Get the packet type now
  297.     bicb    #40    ,r0        ; Insure UPPER CASE packet type
  298.     setpar    r0    ,(r4)+        ; Insert the packet type into buffer
  299.     inc    @sp            ; Packetlength := succ(packetlength)
  300.  
  301. 20$:    mov    4(r5)    ,r1        ; Get the data length
  302.     beq    40$            ; Nothing to do
  303.     mov    6(r5)    ,r3        ; Address of the data to send
  304.  
  305. 30$:    clr    r0            ; Get the next character
  306.     bisb    (r3)+    ,r0        ; Next char
  307.     setpar    r0    ,(r4)+        ; Now move the data byte into the buffer
  308.     inc    @sp            ; Packetlength := succ(packetlength)
  309.     sob    r1    ,30$        ; Next please
  310.  
  311. 40$:    clrb    @r4            ; Set .asciz for call to checks
  312.     mov    r2    ,-(sp)        ; Starting address for checksum field
  313.     call    checks            ; Simple
  314.     mov    (sp)+    ,r2        ; Get the computed checksum now
  315.     call    spakck            ; Stuff checksum into buffer now
  316.     add    r0    ,@sp        ; And the length of the checksum
  317.     setpar    conpar+p.eol,(r4)+    ; End of line needed ?
  318.     inc    @sp            ; Packetlength := succ(packetlength)
  319.     mov    (sp)+    ,r1        ; Packet length
  320.     mov    sp    ,r4        ; Address(buffer)
  321.     calls    pakwri    ,<r4,r1,#lun.ti>; And dump the buffer out now
  322.     call    spakfi            ; Handle ibm stuff if possible
  323.  
  324.     add    #$ALLSIZ,sp        ; Pop the buffer
  325.     unsave    <r4,r3,r2,r1>        ; Pop registers that we used
  326.     return
  327.     
  328.     GLOBAL    <CHKSIZ,CONPAR,DEBUG,SENSOP,RECSOP,SENLNG>
  329.     GLOBAL    <PREXON>                    ; /53/
  330.  
  331.  
  332.     .sbttl    spack routines
  333.     .enabl    lsb
  334.  
  335.  
  336. spakin::bit    #log$pa    ,trace        ; tracing today ?
  337.     beq    5$            ; no
  338.     calls    dskdmp    ,<#200$,4(r5),@r5,2(r5),6(r5)>
  339.  
  340. 5$:    tst    pauset            ; wait a moment ?
  341.     beq    6$            ; no
  342.     calls    suspend    ,<pauset>    ; yes
  343. 6$:    mov    #conpar+p.padc,r2    ; address of the pad character ?
  344.     clr    r1
  345.     bisb    conpar+p.npad,r1    ; send some pad characters ?
  346.     tst    r1
  347.     beq    20$            ; no padding
  348. 10$:    calls    pakwri    ,<r2,#1,#lun.ti>; send some padding
  349.     sob    r1    ,10$        ; next please
  350.  
  351. 20$:    movb    @r5    ,r1        ; the packet type next
  352.     cmpb    r1    ,#'A&137    ; a legitimate packet type ?
  353.     blo    30$            ; no
  354.     cmpb    r1    ,#'Z&137    ; must be in the range A..Z
  355.     bhi    30$            ; no good
  356.      sub    #100    ,r1        ; convert into range 1..26
  357.      asl    r1            ; and count the packet type
  358.      asl    r1            ; /43/ 32 bits
  359.      add    #1    ,pcnt.s+2(r1)    ; /43/ 32 bits, paccnt(type)++
  360.      adc    pcnt.s+0(r1)        ; /43/ 32 bits, the high part
  361.      add    #1    ,pcnt.s+2    ; /43/ 32 bits now
  362.      adc    pcnt.s+0        ; /43/ The high order part
  363. 30$:    return
  364.  
  365.  
  366.     .save
  367.     .psect    $PDATA    ,D
  368. 200$:    .asciz    /SPACK - /
  369.     .even
  370.     .restore
  371.     .dsabl    lsb
  372.  
  373.  
  374.  
  375.  
  376. spakck:    clr    r0            ; checksum.len := 0
  377.     cmpb    chktyp    ,#defchk    ; if checklength > 6 bits
  378.     blos    20$            ;  then begin
  379.     cmpb    chktyp    ,#'3        ;   if checktype = CRC16
  380.     bne    10$            ;    then begin
  381.      mov    r2    ,r1        ;     checkchar1:=tochar(check[12..15])
  382.      ash    #-14    ,r1        ;     shift over 12 bits
  383.      bic    #^C17    ,r1        ;     mask off the high 12  bits
  384.      tochar    r1    ,@r4
  385.      setpar    @r4    ,(r4)+
  386.      inc    r0            ;     packetlength := succ(packetlength)
  387.                     ;    end
  388. 10$:     mov    r2    ,r1        ;   checkchar1 := tochar(check[6..11])
  389.      ash    #-6    ,r1        ;   shift over 6 bits
  390.      bic    #^C77    ,r1        ;   mask off the higher order bits
  391.      tochar    r1    ,@r4
  392.      setpar    @r4    ,(r4)+
  393.      inc    r0            ;   packetlength := succ(packetlength)
  394.      bic    #^C77    ,r2        ;   now drop the high bits from checks
  395. 20$:
  396.     tochar    r2    ,@r4
  397.     tst    ranerr            ; insert random checksum errors?
  398.     beq    40$            ; no, please don't
  399.     mov    r0    ,-(sp)        ;+ test mode
  400.     call    irand            ;+ test mode
  401.     tst    r0            ;+ test mode
  402.     bne    30$            ;+ test mode
  403.     incb    @r4            ;+ test mode
  404. 30$:    mov    (sp)+    ,r0        ;+ test mode
  405. 40$:    setpar    @r4    ,(r4)+
  406.     inc    r0            ; packetlength := succ(packetlength)
  407.     return
  408.  
  409.     global    <chktyp    ,pauset    ,pcnt.s    ,ranerr>
  410.  
  411.  
  412.  
  413.     .sbttl    try to handle half duplex handshake garbage ala IBM (barf)
  414.  
  415.  
  416. spakfi:    save    <r2>            ; don't do this forever please
  417.     call    200$            ; dump raw i/o first please
  418.     unsave    <r2>
  419.     return
  420.  
  421.  
  422. 200$:    bit    #log$io    ,trace        ; dumping all i/o out ?
  423.     beq    230$            ; no
  424.     save    <r0,r1,r2,r4>        ; save these please
  425.     mov    r1    ,r2        ; anything to do ?
  426.     beq    220$            ; no
  427. 210$:    clr    r0            ; yes, dump ch by ch please
  428.     bisb    (r4)+    ,r0        ; get the next ch to dump
  429.     mov    #lun.lo    ,r1        ; the lun to write to
  430.     call    putcr0            ; simple
  431.     sob    r2    ,210$        ; next please
  432. 220$:    unsave    <r4,r2,r1,r0>        ; pop and exit
  433. 230$:    return                ; bye
  434.  
  435.     global    <handch>
  436.  
  437.     .enabl    lsb
  438.  
  439. spakwa:    save    <r2>
  440.     tstb    handch            ; any paritcular handshake char today?
  441.     beq    100$            ; no, just exit please
  442.     scan    @r5    ,#200$
  443.     tst    r0
  444.     bne    100$
  445.     mov    #200    ,r2        ; a limit on looping please
  446. 10$:    calls    binrea    ,<#lun.ti,#4>    ; wait for XON, max 4 seconds please
  447.     tst    r0            ; did the read timeout. if so, exit.
  448.     bne    90$            ; exit and try to xon the link
  449.     bicb    #200    ,r1        ; insure no parity is set
  450.     cmpb    r1    ,handch        ; is this the handshake character
  451.     beq    100$            ; no, try again please
  452.     sob    r2    ,10$        ; not forever, please
  453.     br    100$            ; bye
  454.  
  455. 90$:    save    <r0>            ; save error flags
  456.     calls    ttxon    ,<#ttname,#lun.ti>; get the line turned on again please
  457.     unsave    <r0>            ; pop error
  458.  
  459. 100$:    unsave    <r2>            ; pop loop index
  460.     return
  461.  
  462.     .save
  463.     .psect    $PDATA    ,D
  464. 200$:    .byte    msg$snd
  465.     .byte    msg$ser
  466.     .byte    msg$rcv
  467.     .byte    msg$command
  468.     .byte    msg$generic
  469.     .byte    0
  470.     .even
  471.     .restore
  472.     .dsabl    lsb
  473.  
  474.     global    <ttname>
  475.  
  476.  
  477.     .sbttl    rpack$    read incoming packet
  478.  
  479.  
  480. ;    R P A C K $
  481. ;
  482. ;    rpack$(%loc data)
  483. ;
  484. ;    input:    @r5    buffer address
  485. ;        2(r5)    data structure of 3 words to contain the
  486. ;            returned length, number and type
  487. ;
  488. ;    output:    r0    error code if < 0, packet type if > 0
  489. ;            255 for checksum error
  490. ;
  491.     o$len    =    0        ; offset for retruned packet length
  492.     o$num    =    2        ; offset for returned packet number
  493.     o$type    =    4        ; offset for returned packet type
  494. ;
  495. ;                word    2    packet type
  496. ;                word    1    packet number
  497. ;    as in:    2(r5)    ------>    word    0    packet length
  498. ;
  499. ;
  500. ;
  501. ;    local data offsets from r4 (allocated on the stack
  502. ;
  503.     .done    =    0        ; if <> 0 then we have the packet
  504.     .type    =    2        ; current type of packet
  505.     .ccheck    =    4        ; computed checksum
  506.     .rcheck    =    6        ; received checksum
  507.     .len    =    10        ; received pakcet length
  508.     .timeo    =    12        ; current timeout
  509.     .num    =    14        ; packet number, received
  510.     .size    =    16        ; current size of data portion
  511.     .paksi    =    20        ; for loop control for data portion
  512.     .cbuff    =    22        ; /42/ Mark checksum buffer address
  513.     .hdtype    =    24        ; /42/
  514.     .lsize    =    26        ; total size of local data
  515.  
  516.  
  517. ;    internal register usage:
  518. ;
  519. ;    r0    error return
  520. ;    r1    current character just read from remote
  521. ;    r3    pointer to temp buffer containing the packet less the SOH
  522. ;        and the checksum,  used for computing checksum after  the
  523. ;        packet has been read.
  524. ;    r4    pointer to local r/w data
  525. ;    r5    pointer to argument list
  526.  
  527.     
  528.  
  529.  
  530.  
  531.     .sbttl    rpack continued
  532.  
  533.     .iif ndf,$ALLSIZ, $ALLSIZ = <MAXLNG+<MAXLNG/10>>&177776
  534.  
  535. rpack$::save    <r1,r2,r3,r4>
  536.     clr    recbit            ; /43/ Clear bit sum out
  537.     sub    #.lsize    ,sp        ; allocate space for local data
  538.     mov    sp    ,r4        ; and point to it please
  539.     sub    #$ALLSIZ,sp        ; /42/ Allocate huge buffer
  540.  
  541.     clr    .num(r4)        ; /41/ No fubar numbers on SOH tmo
  542.     clr    .size(r4)        ; /41/ No fubar sizes on SOH timeout
  543.     call    waitsoh            ; wait for a packet to start
  544.     tst    r0            ; did it work or did we timeout
  545.     beq    5$            ; yes
  546.     jmp    95$            ; we must have timed out then
  547.  
  548.  
  549. 5$:    mov    sp    ,r3        ; the packet less SOH and checksum
  550.     mov    sp    ,.cbuff(r4)    ; /42/ Save start address
  551.     clr    .hdtype(r4)        ; /42/
  552.     call    rpakin            ; initialize things
  553.  
  554. 10$:    tst    .done(r4)        ; while ( !done ) {
  555.     bne    90$            ; 
  556.                     ;
  557.     call    rpakrd            ; Read the next character from
  558.     bcs    95$            ; packet reader's buffer
  559.     bisb    r1    ,recbit        ; /43/ So we can determine parity set
  560.     bic    #^C177    ,r1        ; Insure parity is cleared out
  561.     cmpb    r1    ,recsop        ; If the character is senders SOH
  562.     beq    80$            ; then we have to restart this else
  563.     movb    r1    ,(r3)+        ; *checkpacket++ = ch ;
  564.     unchar    r1    ,r0        ; Get the length packet next please
  565.     mov    r0    ,.hdtype(r4)    ; /42/ Save header type
  566.     cmp    r0    ,#2        ; /42/ If the length is 0,1 or 2 then
  567.     ble    15$            ; /42/ an extended header instead
  568.  
  569. 14$:    sub    #2    ,r0        ; This is NOT an extended header so we
  570.     sub    chksiz    ,r0        ; will check to see if the packet can
  571.     bge    15$            ; hold at least SEQ+TYPE+CHECK
  572.     clr    r0            ; /44/
  573. ;-     add    chksiz    ,r0        ; Can't, thus we somehow lost the check
  574. ;-     dec    r0            ; sum type, so punt and reset it to a
  575. ;-     movb    #defchk    ,chktyp        ; type one checksum
  576. ;-     mov    #1    ,chksiz        ; Fix the Checksum length also
  577. 15$:    mov    r0    ,.len(r4)    ; Stuff the packet length
  578.  
  579.     call    rpakrd            ; As before, ask for the next character
  580.     bcs    95$            ; and take an error exit if need be
  581.     bisb    r1    ,recbit        ; /43/ So we can determine parity set
  582.     bic    #^C177    ,r1        ; Insure parity is cleared out
  583.     cmpb    r1    ,recsop        ; If this is the sender's START_OF_PAK
  584.     beq    80$            ; then it's time to restart the loop.
  585.     movb    r1    ,(r3)+        ; Insert the sequence number into the
  586.     unchar    r1    ,.num(r4)    ; checksum packet and save the SEQ
  587.  
  588.     call    rpakrd            ; Read the TYPE field next, exiting
  589.     bcs    95$            ; on a read error, of course.
  590.     bisb    r1    ,recbit        ; /43/ So we can determine parity set
  591.     bic    #^C177    ,r1        ; Insure parity is cleared out
  592.     cmpb    r1    ,recsop        ; As always, if we find the sender's
  593.     beq    80$            ; START_OF_PACKET, the restart.
  594.     movb    r1    ,(r3)+        ; Save the TYPE field into the checksum
  595.     mov    r1    ,.type(r4)    ; and also into the field for return.
  596.  
  597.     tst    .hdtype(r4)        ; /42/ NOW check for extended header.
  598.     bne    19$            ; /42/ Not extended header.
  599.     call    rdexhd            ; /42/ ReaD EXtended HeaDer
  600.     tst    r0            ; /42/ Did this work ok ?
  601.     bgt    80$            ; /42/ No, got a RESYNCH
  602.     bmi    96$            ; /42/ No, got a timeout or checksum
  603.     
  604.  
  605. 19$:    mov    .len(r4),.paksi(r4)    ;   loop for the data, if any
  606.     mov    @r5    ,r2        ;   point to the buffer now
  607.  
  608. 20$:    tst    .paksi(r4)        ;   for i := 1 to len do
  609.     beq    30$            ;    begin
  610.     call    rpakrd            ;     read(input,ch)
  611.     bcs    95$            ;     exit if error
  612.     clrpar    r1            ;     ch := ch and chr(177B)
  613.     cmpb    r1    ,recsop        ;     if ch = SOH then resynch
  614.     beq    80$            ;
  615.     cmp    .size(r4),#MAXLNG    ;     if currentsize < MAXPAKSIZE
  616.     bhis    25$            ;       then 
  617.     movb    r1    ,(r2)+        ;         data[i]  := ch
  618.     movb    r1    ,(r3)+        ;         checkpacket++ := ch
  619.                     ;    end
  620. 25$:    inc    .size(r4)        ;     currentsize:=succ(currentsize)
  621.     dec    .paksi(r4)        ;    nchar_left := nchar_left - 1
  622.     br    20$            ;    end
  623.  
  624. 30$:    clrb    @r2            ;   data[len] := NULL
  625.     clrb    @r3            ;   checkpacket++ := null
  626.     mov    sp    ,r3        ;   reset base address of checkpacket
  627.     call    rpakck            ;   read the checksum now
  628.     bcs    95$            ;   exit on line error (like timeout)
  629.     mov    sp    ,.done(r4)    ; flag that we are done
  630.     br    10$            ; check to see if we are done
  631.  
  632. 80$:    br    5$            ; synch error, restart the packet
  633.  
  634.  
  635. 90$:    call    rpakfi            ; finish checksum and return the
  636.     br    100$
  637.  
  638. 95$:    mov    2(r5)    ,r1        ; timeout error, flag no packet
  639.     clr    r0            ; nonfatal error for timout
  640.     mov    #timout    ,o$type(r1)    ; return as psuedo packet type
  641.     mov    #timout    ,.type(r4)    ; return as psuedo packet type
  642. 96$:    call    rpakst            ; do stats and disk dumping now
  643.  
  644. 100$:    add    #.lsize+$ALLSIZ,sp    ; /42/ Pop local buffers
  645.     unsave    <r4,r3,r2,r1>
  646.     return
  647.  
  648.     global    <chktyp>
  649.  
  650.  
  651.  
  652.     .sbttl    Read extended header type 0 for long packets
  653.  
  654. ;    Added edit /42/ 08-Jan-86  16:32:59 Brian Nelson
  655.  
  656. rdexhd:    mov    r5    ,-(sp)        ; /42/ Need an ODD register for MUL
  657.     mov    r2    ,-(sp)        ; /42/ Save R2 please
  658.     call    rpakrd            ; /42/ Extended header, read the LENX1
  659.     bcs    90$            ; /42/ field, exiting on read errors.
  660.     bic    #^C177    ,r1        ; /42/ Insure parity is cleared out
  661.     cmpb    r1    ,recsop        ; /42/ Exit if we find the SENDERS
  662.     beq    80$            ; /42/ START_OF_HEADER please
  663.     movb    r1    ,(r3)+        ; /42/ Save into Checksum buffer
  664.     unchar    r1    ,r5        ; /42/ Get the high order of length
  665.     mul    #95.    ,r5        ; /42/ Shift over please
  666.     call    rpakrd            ; /42/ Extended header, read the LENX2
  667.     bcs    90$            ; /42/ field, exiting on read errors.
  668.     bic    #^C177    ,r1        ; /42/ Insure parity is cleared out
  669.     cmpb    r1    ,recsop        ; /42/ Exit if we find the SENDERS
  670.     beq    80$            ; /42/ START_OF_HEADER please
  671.     movb    r1    ,(r3)+        ; /42/ Save into Checksum buffer
  672.     unchar    r1    ,r1        ; /42/ Get the next one
  673.     add    r1    ,r5        ; /42/ Now we have the EXTENDED length
  674.     sub    chksiz    ,r5        ; /42/ Drop it by checksum size
  675.     mov    r5    ,.len(r4)    ; /42/ Save it here, of course
  676.  
  677.     mov    .cbuff(r4),r5        ; /42/ Now, at LAST, get the extended
  678.     mov    #5    ,r1        ; /42/ header CHECKSUM data
  679.     clr    -(sp)            ; /42/ Accum in stack
  680. 10$:    clr    r0            ; /42/ Use the normal SAFE way to add
  681.     bisb    (r5)+    ,r0        ; /42/ bytes even though we know for
  682.     add    r0    ,(sp)        ; /42/ that no sign extends will happen
  683.     sob    r1    ,10$        ; /42/ Next please
  684.     mov    (sp)+    ,r0        ; /42/ Pop the checksum please
  685.     mov    r0    ,r2        ; /42/ Save it
  686.     bic    #^C300    ,r2        ; /42/ Compute it as in:
  687.     ash    #-6    ,r2        ; /42/ Chk=char((s+((s&0300)/0100))&77)
  688.     add    r0    ,r2        ; /42/ ...
  689.     bic    #^C77    ,r2        ; /42/ Got it now
  690.  
  691.     call    rpakrd            ; /42/ Extended header, read the HCHECK
  692.     bcs    90$            ; /42/ field, exiting on read errors.
  693.     bic    #^C177    ,r1        ; /42/ Insure parity is cleared out
  694.     cmpb    r1    ,recsop        ; /42/ Exit if we find the SENDERS
  695.     beq    80$            ; /42/ START_OF_HEADER please
  696.     movb    r1    ,(r3)+        ; /42/ Save into Checksum buffer
  697.     unchar    r1    ,r1        ; /42/ Convert to actual checksum now
  698.     cmpb    r1    ,r2        ; /42/ Do the CHECKSUMS match ?
  699.     bne    85$            ; /42/ No, exit with such set please
  700.     clr    r0            ; /42/ It worked, exit normally
  701.     br    100$            ; /42/ bye...
  702.     
  703. 80$:    mov    #1    ,r0        ; /42/ Resynch time
  704.     br    100$            ; /42/ Exit
  705.  
  706. 85$:    mov    #badchk    ,r0        ; /42/ Header Checksum error
  707.     br    95$            ; /42/ Stuff the error
  708. 90$:    mov    #timout    ,r0        ; /42/ Return timeout error
  709. 95$:    mov    2(sp)    ,r5        ; /42/ Return timeout error
  710.     mov    2(r5)    ,r1        ; /42/ Get address of result block
  711.     clr    o$len(r1)        ; /42/ Clear this also
  712.     mov    r0    ,o$type(r1)    ; /42/ Return the error
  713.     mov    r0    ,.type(r4)    ; /42/ Here also please
  714.     mov    #-1    ,r0        ; /42/ Fatal error
  715. 100$:    mov    (sp)+    ,r2        ; /42/ Pop r2 and
  716.     mov    (sp)+    ,r5        ; /42/ Restore R5
  717.     return
  718.  
  719.  
  720.  
  721.     .sbttl    subroutines for RPACK only
  722.     .enabl    lsb
  723.  
  724. rpakrd:    calls    binrea    ,<#lun.ti,.timeo(r4)>; read(input,ch)
  725.     tst    r0            ; did it work
  726.     bne    110$            ; no
  727.     call    rawio            ; perhaps raw i/o logging
  728.     bit    #log$rp    ,trace        ; dump to a local terminal ?
  729.     beq    20$            ; no
  730.     cmpb    r1    ,recsop        ; start of a packet ?
  731.     beq    10$            ; yes
  732.     movb    r1    ,-(sp)        ; yes, stuff the ch onto the stack
  733.     mov    sp    ,r1        ; point to it
  734.     print    r1    ,#1        ; dump it
  735.     clr    r1            ; restore what we read and exit
  736.     bisb    (sp)+    ,r1        ; restore it and exit
  737.     br    20$            ; bye
  738. 10$:    print    #200$            ; start of a packet
  739. 20$:    clr    r0            ; no errors
  740.     clc                ; it worked
  741.     return                ; bye
  742.  
  743. 110$:    save    <r0>            ; save the error code
  744.     calls    ttxon    ,<#ttname,#lun.ti>; get the line turned on again please
  745.     unsave    <r0>            ; restore the error code
  746.     sec                ; flag the error
  747.     return                ; bye
  748.  
  749.     .save
  750.     .psect    $PDATA    ,D
  751. 200$:    .asciz    <cr><lf>/<SOH>/
  752.     .even
  753.     .restore
  754.     .dsabl    lsb
  755.  
  756.  
  757.  
  758. rpakin:    clr    .done(r4)        ; done := false
  759.     clr    .type(r4)        ; packettype := 0
  760.     clr    .ccheck(r4)        ; checksum := 0
  761.     clr    .rcheck(r4)        ; received_checksum := 0
  762.     clr    .len(r4)        ; current length := 0
  763.     clr    .num(r4)        ; packet_number  := 0
  764.     clr    .timeo(r4)        ; timeout := 0
  765.     clr    .size(r4)        ; current size of data part of packet
  766.     clr    .paksi(r4)        ; loop control for data of packet
  767.     mov    @r5    ,r0        ; initialize the buffer to null
  768.     mov    #40    ,r1
  769. 10$:    clrb    (r0)+            ; simple
  770.     clrb    (r0)+            ; simple
  771.     sob    r1    ,10$
  772.     mov    2(r5)    ,r0        ; return parameters
  773.     clr    (r0)+            ; packet.length := 0
  774.     clr    (r0)+            ; packet.number := 0
  775.     clr    (r0)+            ; packet.type   := 0
  776.     call    settmo
  777.     mov    r0    ,.timeo(r4)
  778.     return
  779.  
  780.  
  781. settmo:    mov    sertim    ,r0        ; if waiting for server command
  782.     bne    20$            ;  then use that timeout
  783.     clr    r0            ;
  784.     bisb    conpar+p.time,r0    ; get the remotes timeout
  785.     bne    10$            ; ok
  786.     mov    #mytime    ,r0        ; no good, setup a timeout
  787. 10$:    cmpb    r0,setrec+p.time    ; use SET TIMEOUT value if >
  788.     bhis    20$            ; no, use the timeout as in
  789.     clr    r0            ; ok, use the value the user said
  790.     bisb    setrec+p.time,r0    ; in the SET TIMEOUT command
  791.     bne    20$            ; must be > 0 by now
  792.     mov    #mytime    ,r0        ; no ??
  793. 20$:    return
  794.  
  795.     global    <conpar    ,setrec    ,sertim>
  796.  
  797.  
  798.     .sbttl    finish up rpack
  799.  
  800.  
  801. rpakfi:    mov    r3    ,-(sp)        ; compute correct checksum type
  802.     call    checks            ; simple
  803.     mov    (sp)+    ,.ccheck(r4)    ; and stuff it in please
  804.     cmpb    .ccheck(r4),.rcheck(r4)    ; compare computed checksum with the
  805.     beq    100$            ; actual checksum
  806.     mov    #badchk    ,.type(r4)    ; flag checksum error
  807.  
  808. 100$:    mov    2(r5)    ,r1        ; where to return some things
  809.     mov    .len(r4),o$len(r1)    ; return the packet length
  810.     mov    .type(r4),o$type(r1)    ; and the packet type
  811.     mov    .num(r4),o$num(r1)    ; and at last, the packet number
  812.     call    rpakst            ; do stats and logging now
  813.     call    rpaklo            ; possibly log checksum errors?
  814.     return
  815.  
  816.     .enabl    lsb
  817.  
  818. rpakst:    cmpb    .type(r4),#'A&137    ; count the packet types for stats
  819.     blo    110$            ; bad packet type
  820.     cmpb    .type(r4),#'Z&137    ; must in the range A..Z
  821.     bhi    110$            ; definiately a bad packet
  822.      movb    .type(r4),r1        ; packet is ok, add it to the stats
  823.      sub    #100    ,r1        ; convert to 1..26
  824.      asl    r1            ; to word offsets
  825.      asl    r1            ; /43/ Double word offsets
  826.      add    #1    ,pcnt.r+2(r1)    ; /43/ 32 bit addition today
  827.      adc    pcnt.r+0(r1)        ; /43/ The high order part of it
  828.      add    #1    ,pcnt.r+2    ; /43/ Add it in here also
  829.      adc    pcnt.r+0        ; /43/ High order part
  830.  
  831. 110$:    bit    #log$pa    ,trace        ; tracing today ?
  832.     beq    120$            ; no
  833.     calls    dskdmp    ,<#200$,.len(r4),.type(r4),.num(r4),@r5>
  834.  
  835. 120$:    return
  836.  
  837.     .save
  838.     .psect    $PDATA    ,D
  839. 200$:    .asciz    /RPACK - /
  840.     .even
  841.     .restore
  842.     .dsabl    lsb
  843.     .enabl    lsb
  844.  
  845. rpaklo:    save    <r0>
  846.     cmp    .rcheck(r4),.ccheck(r4)    ; checksums match ?
  847.     beq    100$            ; yes, do nothing then
  848.     bit    #log$io    ,trace        ; not if in raw i/o mode
  849.     bne    100$            ; forget it
  850.     sub    #60    ,sp        ; dump bad checksums out to disk
  851.     mov    sp    ,r1        ; point to the buffer
  852.     copyz    #200$    ,r1        ; a header
  853.     strlen    r1            ; length so far
  854.     add    r0    ,r1        ; point to the end of it
  855.     deccvt    .rcheck(r4),r1        ; convert to decimal
  856.     add    #6    ,r1        ; move along please
  857.     deccvt    .ccheck(r4),r1        ; the calculated checksum
  858.     add    #6    ,r1        ; make it .asciz
  859.     clrb    @r1            ; simple
  860.     mov    sp    ,r1        ; point back to the buffer
  861.     strlen    r1            ; get the length
  862.     calls    putrec    ,<r1,r0,#lun.lo>; dump buffer to disk
  863.     add    #60    ,sp        ; pop buffer and exit
  864. 100$:    unsave    <r0>            ; pop r0 and exit
  865.     return
  866.  
  867.     .save
  868.     .psect    $PDATA    ,D
  869. 200$:    .asciz    /?Bad Checksum: rcv,calc are /
  870.     .even
  871.     .restore
  872.     .dsabl    lsb
  873.  
  874.     global    <pcnt.r    ,sertim    ,trace>
  875.  
  876.  
  877.  
  878.  
  879.     .sbttl    read and convert the checksum for RPACK
  880.  
  881.  
  882. rpakck:    save    <r3>            ;   use r3 for accumulating check
  883.     clr    r3            ;   assume zero for now
  884.     call    rpakrd            ;   read(input,ch)
  885.     bcs    110$            ;   exit if error
  886.     bisb    r1    ,recbit        ;   recbit |= ch ;
  887.     bic    #^c177    ,r1        ;   ch := ch and 177B
  888.     unchar    r1    ,r3        ;   received_check := ch
  889.     cmpb    chktyp    ,#defchk    ;   if len(checksum) > 8bits
  890.     blos    10$            ;    then begin
  891.      ash    #6    ,r3        ;     check := check * 64
  892.      call    rpakrd            ;     read(input,ch)
  893.      bcs    110$            ;     exit if error
  894.      bic    #^c177    ,r1        ;     ch := ch and 177B
  895.      unchar    r1    ,r1        ;     ch := unchar(ch)
  896.      bisb    r1    ,r3        ;     rcheck := rcheck + ch
  897.      cmpb    chktyp    ,#'3        ;     if checktype = CRC16
  898.      bne    10$            ;      then
  899.      ash    #6    ,r3        ;       begin
  900.      call    rpakrd            ;        check := check * 64
  901.      bcs    110$            ;     check := check + ch
  902.      bic    #^c177    ,r1        ;        ch := ch and 177B
  903.      unchar    r1    ,r1        ;
  904.      bisb    r1    ,r3        ;      end ;
  905. 10$:    clc
  906.     br    120$
  907.  
  908. 110$:    sec
  909. 120$:    mov    r3    ,.rcheck(r4)    ;    return the checksum
  910.     unsave    <r3>
  911.     return
  912.     
  913.  
  914.  
  915.  
  916.     .sbttl    parity routines
  917.  
  918. ;    C L R P A R
  919. ;
  920. ;    input:    2(sp)    the character to clear parity for
  921. ;    output:    2(sp)    the result
  922. ;
  923. ;    caller by CLRPAR macro
  924. ;
  925. ;    If parity is set to anything but NONE then always
  926. ;    clear the parity out else clear it if and only if
  927. ;    filetype is not image mode.
  928.  
  929.  
  930. clrpar::tstb    parity            ; handle nothing please (no parity)
  931.     beq    10$            ; yes
  932.     cmpb    parity    ,#par$no    ; set parity none used ?
  933.     bne    20$            ; no, must be some other type
  934. 10$:    tst    image            ; no parity, image mode today ?
  935.     bne    100$            ; yes, leave things alone please
  936. 20$:    bic    #^C177    ,2(sp)        ; no, clear bits 7-15 please
  937. 100$:    return                ; bye
  938.  
  939.  
  940.     global    <parity>
  941.     
  942.  
  943.  
  944.  
  945.     .sbttl    compute proper checksum please
  946.  
  947. ;    C H E C K S
  948. ;
  949. ;    input:    2(sp)    address of .asciz string to compute checksum for
  950. ;    output:    @sp    the computed checksum
  951.  
  952.  
  953.  
  954. checks::save    <r0,r1,r2,r3>        ; save registers we may use
  955.     mov    12(sp)    ,r2        ; point to the string to do it for
  956.     clr    12(sp)            ; assume a zero checksum ?
  957.  
  958.     cmpb    chktyp    ,#'3        ; CRC-CCITT type today ?
  959.     bne    5$            ; no
  960.     strlen    r2            ; yes, get the .asciz string length
  961.     calls    crcclc    ,<r2,r0>    ; compute the CRC16-CCITT
  962.     mov    r0    ,r2        ; stuff the result into r2 for later
  963.     br    90$            ; and exit
  964.  
  965. 5$:    clr    r1            ; init the checksum accumulator
  966. 10$:    clr    r3            ; get the next ch please
  967.     bisb    (r2)+    ,r3        ; got the next ch now
  968.     beq    20$            ; hit the end of the string
  969.     cmpb    parity    ,#par$no    ; did the packet contain parity?
  970.     beq    15$            ; no, leave bit 7 alone
  971.     bic    #^C177    ,r3        ; yes, please clear bit seven
  972. 15$:    bic    #170000    ,r1        ; /42/ Insure long packet not overflow
  973.     add    r3    ,r1        ; check := check + ch
  974.     br    10$
  975.  
  976. 20$:    mov    r1    ,r2        ; checksum := (((checksum and 300B)/64)
  977.     cmpb    chktyp    ,#'2        ; 12 bit sum type checksum ?
  978.     beq    30$            ; yes, just exit
  979.     bic    #^C300    ,r2        ;              +checksum) and 77B)
  980.     ash    #-6    ,r2        ;
  981.     add    r1    ,r2        ;
  982.     bic    #^C77    ,r2
  983.     br    90$
  984.  
  985. 30$:    bic    #170000    ,r2        ; type 2 checksum
  986.  
  987. 90$:    mov    r2    ,12(sp)        ; return the checksum
  988.     
  989.  
  990. 100$:    unsave    <r3,r2,r1,r0>        ; exit
  991.     return
  992.  
  993.  
  994.     
  995.  
  996.  
  997.  
  998.     .sbttl    crc calculation
  999.  
  1000. ;    This  routine will calculate the CRC for a string, using the
  1001. ;    CRC-CCIT polynomial. 
  1002. ;
  1003. ;    The string should be the fields of the  packet  between  but
  1004. ;    not  including  the  <mark>  and  the  block check, which is
  1005. ;    treated as a string of bits with the low order  bit  of  the
  1006. ;    first  character  first  and  the high order bit of the last
  1007. ;    character last --  this  is  how  the  bits  arrive  on  the
  1008. ;    transmission   line.  The  bit  string  is  divided  by  the
  1009. ;    polynomial 
  1010. ;
  1011. ;    x^16+x^12+x^5+1
  1012. ;
  1013. ;    The initial value of  the  CRC  is  0.  The  result  is  the
  1014. ;    remainder   of   this   division,   used   as-is  (i.e.  not
  1015. ;    complemented). 
  1016. ;
  1017. ;    From  20KERMIT.MAC, rewritten  for  PDP11  by  Brian  Nelson
  1018. ;    13-Jan-84 08:50:43 
  1019. ;
  1020. ;    input:    @r5    string address
  1021. ;        2(r5)    string length
  1022. ;    output:    r0    crc
  1023.  
  1024.  
  1025. crcclc::save    <r1,r2,r3,r4,r5>    ; save registers please
  1026.     clr    r0            ; initialize the CRC to zero
  1027.     mov    @r5    ,r3        ; get the string address now
  1028.     mov    2(r5)    ,r4        ; get the string length
  1029.     beq    100$            ; oops, nothing to do then
  1030.  
  1031. 10$:    clr    r1            ; get the next character please
  1032.     bisb    (r3)+    ,r1        ; please avoid pdp11 sign extend
  1033.     cmpb    parity    ,#par$no    ; did the packet have parity?
  1034.     beq    20$            ; no, leave bit seven alone
  1035.     bic    #^C177    ,r1        ; yes, clear bit seven please
  1036. 20$:    ixor    r0    ,r1        ; add in with the current CRC
  1037.     mov    r1    ,r2        ; get the high four bits
  1038.     ash    #-4    ,r2        ; and move them over to 3..0
  1039.     bic    #^C17    ,r2        ; drop any bits left over
  1040.     bic    #^C17    ,r1        ; and the low four bits
  1041.     asl    r1            ; times 2 for word addressing
  1042.     asl    r2            ; times 2 for word addressing
  1043.     mov    crctb2(r1),r1        ; get low portion of CRC factor
  1044.     ixor    crctab(r2),r1        ; simple (limited modes for XOR)
  1045.     swab    r0            ; shift off a byte from previous crc
  1046.     bic    #^C377    ,r0        ; clear new high byte
  1047.     ixor    r1    ,r0        ; add in the new value
  1048.     sob    r4    ,10$        ; next please
  1049.  
  1050. 100$:    unsave    <r5,r4,r3,r2,r1>    ; pop saved r1-r5
  1051.     return
  1052.  
  1053.  
  1054. ; Data tables for CRC-CCITT generation
  1055.  
  1056.     .save
  1057.     .psect    $PDATA    ,D
  1058.  
  1059. crctab:    .word    0
  1060.     .word    10201
  1061.     .word    20402
  1062.     .word    30603
  1063.     .word    41004
  1064.     .word    51205
  1065.     .word    61406
  1066.     .word    71607
  1067.     .word    102010
  1068.     .word    112211
  1069.     .word    122412
  1070.     .word    132613
  1071.     .word    143014
  1072.     .word    153215
  1073.     .word    163416
  1074.     .word    173617
  1075.  
  1076. crctb2:    .word    0
  1077.     .word    10611
  1078.     .word    21422
  1079.     .word    31233
  1080.     .word    43044
  1081.     .word    53655
  1082.     .word    62466
  1083.     .word    72277
  1084.     .word    106110
  1085.     .word    116701
  1086.     .word    127532
  1087.     .word    137323
  1088.     .word    145154
  1089.     .word    155745
  1090.     .word    164576
  1091.     .word    174367
  1092.  
  1093.     .restore
  1094.  
  1095.  
  1096.  
  1097.  
  1098.  
  1099.     .sbttl    clear stats out
  1100.  
  1101. ;    C L R S T A
  1102. ;
  1103. ;    clear out the packet counts by packet type from the last
  1104. ;    transaction and add them into the total running count by
  1105. ;    packet type.
  1106.  
  1107. clrsta::save    <r0,r1,r2>        ; save the registers we use
  1108.     mov    #pcnt.r    ,r1        ; packets received
  1109.     mov    totp.r    ,r2        ; running count so far
  1110.     mov    #34    ,r0        ; number of works to add/clear
  1111. 10$:    add    2(r1)    ,2(r2)        ; /43/ Add in the totals
  1112.     adc    (r2)            ; /43/ The carryover also
  1113.     add    (r1)    ,(r2)+        ; /43/ The HIGH order of it
  1114.     tst    (r2)+            ; /43/ Get to the next one
  1115.     clr    (r1)+            ; /43/ Clear of old stuff out
  1116.     clr    (r1)+            ; /43/ Clear of old stuff out
  1117.     sob    r0    ,10$        ; /43/ Next please
  1118.     mov    #pcnt.s    ,r1        ; now for the packets sent
  1119.     mov    totp.s    ,r2        ; where to add them in
  1120.     mov    #34    ,r0        ; number of words to do
  1121. 20$:    add    2(r1)    ,2(r2)        ; /43/ Add in the totals
  1122.     adc    (r2)            ; /43/ The carryover also
  1123.     add    (r1)    ,(r2)+        ; /43/ The HIGH order of it
  1124.     tst    (r2)+            ; /43/ Get to the next one
  1125.     clr    (r1)+            ; /43/ Clear of old stuff out
  1126.     clr    (r1)+            ; /43/ Clear of old stuff out
  1127.     sob    r0    ,20$        ; /43/ Next please
  1128.     clr    pcnt.n            ; naks count
  1129.     clr    pcnt.n+2        ; /43/ rest of it
  1130.     clr    pcnt.t            ; /44/ Timeouts
  1131.     clr    pcnt.t+2        ; /44/ Timeouts
  1132.     clr    filein+0        ; /43/ File data stats
  1133.     clr    filein+2        ; /43/ File data stats
  1134.     clr    fileout+0        ; /43/ File data stats
  1135.     clr    fileout+2        ; /43/ File data stats
  1136.     clr    charin+0        ; /43/ Physical link stats
  1137.     clr    charin+2        ; /43/ Physical link stats
  1138.     clr    charout+0        ; /43/ Physical link stats
  1139.     clr    charout+2        ; /43/ Physical link stats
  1140.     unsave    <r2,r1,r0>        ; pop the registers we used
  1141.     return                ; and exit
  1142.  
  1143.  
  1144. incsta::call    seconds            ; /43/ Get current seconds since
  1145.     mov    #times+4,r2        ; /43/ midnight, moving old times
  1146.     mov    r0    ,(r2)+        ; /43/ Insert NEW times first
  1147.     mov    r1    ,(r2)        ; /43/ then subtact off the old
  1148.     sub    times+2    ,(r2)        ; /43/ times from it
  1149.     sbc    -(r2)            ; /43/ ditto for the carry
  1150.     sub    times    ,(r2)        ; /43/ Incremental is in times+4
  1151.     mov    r1    ,-(r2)        ; /43/ and times+6, new time is in
  1152.     mov    r0    ,-(r2)        ; /43/ times+0 and time+2
  1153.     return                ; /43/ Exit
  1154.  
  1155.     
  1156.     global    <pcnt.n    ,pcnt.r    ,pcnt.s    ,totp.r    ,totp.s>
  1157.     global    <charin,charout,filein,fileout,seconds,times>    ; /43/
  1158.     global    <pcnt.t>                    ; /44/
  1159.  
  1160.  
  1161.     .sbttl    waitsoh    wait for a packet start (ascii 1, SOH)
  1162.  
  1163.  
  1164. ;    W A I T S O H
  1165. ;
  1166. ;    input:    nothing
  1167. ;    output:    r0    error code
  1168. ;        r1    the SOH or NULL if we timed out
  1169. ;
  1170. ;
  1171. ;    As of edit 2.41 (25-Dec-85  13:26:26) from Steve Heflin we will
  1172. ;    exit Kermit-11 if we find that the first thing we find is a CTL
  1173. ;    Z (\032). This is desired in case the user accidentilly put the
  1174. ;    Kermit-11 into server without setting a line.
  1175. ;    On edit /44/, wait for TWO control z's in a row to exit.
  1176.  
  1177. waitsoh:clr    r1            ; Start with nothing
  1178.     clr    -(sp)            ; /56/ Hold virgin copy of data
  1179.     mov    #2    ,-(sp)        ; /44/ Counter for control Z's
  1180. 10$:    cmpb    r1    ,recsop        ; wait for a packet header please
  1181.     beq    40$            ; ok, exit
  1182.     call    settmo            ; get proper timeout set up
  1183.     calls    binrea    ,<#lun.ti,r0>    ; read with timeout
  1184.     mov    r1    ,2(sp)        ; /56/ Save it
  1185.     bic    #^C177    ,r1        ; /44/ Never want parity here
  1186.     tst    r0            ; did the read work ?
  1187.     bne    30$            ; oops, just exit then
  1188.     cmpb    r1    ,#'Z&37        ; /41/ Control Z returned ?
  1189.     bne    15$            ; /41/ No
  1190.     dec    (sp)            ; /44/ Should we REALLY exit now?
  1191.     bne    20$            ; /44/ No, in case we got some NOISE
  1192.     call    clostt            ; /41/ Yes, drop terminal and exit
  1193.     jmp    exit            ; /41/ Bye now
  1194. 15$:    mov    #2    ,(sp)        ; /44/ Need TWO ^Z's in a row to exit
  1195. 20$:    call    rawio            ; all is not well, perhaps dump packets
  1196.     br    10$            ; loop back for finding a PACKET start
  1197. 30$:    clr    r1            ; Timeout, return( NULL )
  1198.     br    100$            ; /56/
  1199. 40$:    bitb    #200    ,2(sp)        ; /56/ Parity perhaps?
  1200.     beq    100$            ; /56/ No
  1201.     cmpb    parity    ,#PAR$NONE    ; /56/ 8bit channel?
  1202.     bne    100$            ; /56/ No
  1203.     inc    incpar            ; /56/ Yes, also want message only once
  1204. 100$:    cmp    (sp)+    ,(sp)+        ; /56/ Pop control Z counter
  1205.     return                ; exit
  1206.  
  1207.  
  1208.     global    <conpar    ,sertim    ,clostt    ,exit>
  1209.     GLOBAL    <incpar>
  1210.  
  1211.  
  1212. rawio:    bit    #log$io    ,trace        ; dumping all i/o today?
  1213.     beq    100$            ; no
  1214.     save    <r0,r1>            ; yes, save these please
  1215.     clr    r0
  1216.     bisb    r1    ,r0        ; and setup call to putcr0
  1217.     mov    #lun.lo    ,r1        ; the unit to write to
  1218.     call    putcr0            ; simple
  1219.     unsave    <r1,r0>            ; pop these now
  1220. 100$:    return
  1221.  
  1222.  
  1223.     .sbttl    initialize repeat count for sending
  1224.  
  1225.  
  1226. inirepeat::
  1227.     save    <r0,r1>
  1228.     clr    dorpt            ; assume not doing repeat things
  1229.     tst    setrpt            ; user disable repeat count processing?
  1230.     beq    100$            ; yes
  1231.     cmpb    #myrept    ,#40        ; am I doing it ?
  1232.     beq    100$            ; no, just exit then
  1233.     clr    rptcount        ; size of repeat if zero
  1234.     clr    rptlast            ; no last character please (a null)
  1235.     mov    #-1    ,rptinit    ; need to prime the pump please
  1236.     movb    conpar+p.rept,r0    ; check for doing so
  1237.     beq    100$            ; no
  1238.     cmpb    r0    ,#40        ; a space also ?
  1239.     beq    100$            ; yes
  1240.     cmpb    r0    ,senpar+p.rept    ; same ?
  1241.     bne    100$            ; no
  1242.     movb    r0    ,rptquo        ; yes, save it
  1243.     mov    #-1    ,dorpt        ; and we are indeed doing this
  1244. 100$:    clc
  1245.     unsave    <r1,r0>
  1246.     return
  1247.  
  1248.     global    <dorpt,rptcount,rptlast,rptquo,rptsave,rptinit,setrpt>
  1249.     
  1250.  
  1251.  
  1252.  
  1253.     .sbttl    BUFFIL    buffer from the file that is being sent
  1254.  
  1255.  
  1256. ;    B U F F I L
  1257. ;
  1258. ;    input:    @r5    buffer address
  1259. ;    output:    r0    rms sts error code
  1260. ;        r1    length of the string
  1261.  
  1262. buffil::save    <r2,r3,r4,r5>        ; save all registers we may use
  1263.     mov    @r5    ,r4        ; point to the destination address
  1264.     clr    r3            ; use as a length counter
  1265.     clr    r5            ;
  1266.     bitb    #CAPA.L,conpar+p.capas    ; /42/ Check to see if both sides
  1267.     beq    4$            ; /42/ REALLY understand long packets
  1268.     bitb    #CAPA.L,senpar+p.capas    ; /42/ We would normally but it is
  1269.     beq    4$            ; /42/ possible to SET NOLONG
  1270.     mov    senlng    ,r5        ; /42/ Does receiver understand
  1271.     bne    5$            ; /42/ long packets today?
  1272. 4$:    bisb    conpar+p.spsiz,r5    ; get the recievers maximum size
  1273. 5$:    sub    #14    ,r5        ; being overcautious today ?
  1274.  
  1275. 10$:    tst    dorpt            ; are we doing repeat counts
  1276.     beq    50$            ; no
  1277.  
  1278. 15$:    call    gnc            ;   getnext character ;
  1279.     bcs    30$            ;   if ( error ) then break ;
  1280.     tst    rptinit            ;   if ( firsttime )
  1281.     beq    20$            ;     then
  1282.     clr    rptinit            ;    rptinit = 0 ;
  1283.     clr    rptcount        ;    rptcount = 0 ;
  1284.     movb    r1    ,rptlast    ;    rptlast = ch ;
  1285. 20$:    cmpb    r1    ,rptlast    ;   if ( ch == rptlast )
  1286.     bne    30$            ;     then
  1287.     cmp    rptcount,#94.        ;
  1288.     bge    30$
  1289.     inc    rptcount        ;    rptcount++ ;
  1290.     br    15$            ;     else break ;
  1291.  
  1292. 30$:    mov    r1    ,rptsave    ; save the failed character please
  1293.     tst    rptcount        ; this may be EOF on first character
  1294.     beq    90$            ; if so, we simply do nothing at all
  1295.  
  1296.     cmp    rptcount,#2        ; please don't bother with ONE char.
  1297.     bgt    40$            ; don't waste the overhead for two
  1298. 35$:    clr    r1            ; avoid sign extension please
  1299.     bisb    rptlast    ,r1        ; get the character to write
  1300.     call    200$            ; and stuff it into the buffer
  1301.     dec    rptcount        ; more to insert ?
  1302.     bne    35$            ; yes
  1303.     br    45$            ; no, exit
  1304.  
  1305. 40$:    movb    rptquo    ,(r4)+        ; insert the repeat count quote
  1306.     inc    r3            ; count it in the packet size
  1307.     tochar    rptcount,(r4)+        ; convert the repeat count to a char
  1308.     inc    r3            ; and count in the packet size
  1309.     clr    r1            ;
  1310.     bisb    rptlast    ,r1        ; and insert the repeated character
  1311.     call    200$            ; insert it into the buffer
  1312. 45$:    movb    rptsave    ,rptlast    ; make the failing character the one
  1313.     clr    rptcount        ; in case of EOF, set this please
  1314.     tst    r0            ; was this the end of file ?
  1315.     bne    90$            ; yes, we had better leave then
  1316.     inc    rptcount        ; no, initialize the count please
  1317.     br    70$            ; and check for overflow in the buffer
  1318.  
  1319. 50$:    call    gnc            ; getnextchar ;
  1320.     bcs    90$            ; if ( eof ) then break ;
  1321.     call    200$            ; get the character stuff w/o repeats
  1322.  
  1323. 70$:    cmp    r3    ,r5        ; room for the data ?
  1324.     blo    10$            ; end
  1325.  
  1326. 90$:    mov    r3    ,r1        ; return the length please
  1327.     beq    100$            ; nothing there
  1328.     clr    r0            ; say read was successful
  1329. 100$:    unsave    <r5,r4,r3,r2>        ; and exit
  1330.     return
  1331.  
  1332.  
  1333.     .sbttl    actually quote and stuff the character in for BUFFIL
  1334.  
  1335.  
  1336. 200$:    tst    do8bit            ;   exit if status <> success;
  1337.     beq    210$            ;   if        need_8_bit_prefix
  1338.     tstb    r1            ;      and bit_test(ch,200B)
  1339.     bpl    210$            ;     then begin
  1340.      movb    ebquot    ,(r4)+        ;      buffer[i] := eight_bit_quote
  1341.      inc    r3            ;      i := succ(i)
  1342.      bicb    #200    ,r1        ;      ch := bit_clear(ch,200b)
  1343. 210$:    clr    r2            ;     end ;
  1344.     bisb    r1    ,r2        ;   ch0_7 := ch
  1345.     bic    #^C177    ,r2        ;   ch0_7 := ch0_7 and 177B
  1346.  
  1347.     cmpb    r2    ,#SPACE        ;   if ch0_7 < space
  1348.     blo    220$            ;     or
  1349.     cmpb    r2    ,#DEL        ;       ch0_7 = del
  1350.     beq    220$            ;     or
  1351.     cmpb    r2    ,senpar+p.qctl    ;       ch0_7 = quote
  1352.     beq    220$            ;     or
  1353.     tst    do8bit            ;      ( need_8_bit_prefix )
  1354.     beq    215$            ;       and ( ch0_7 == binaryquote )
  1355.     cmpb    r2    ,ebquot        ;
  1356.     beq    220$            ;     or
  1357. 215$:    tst    dorpt            ;      ( doing_repeatcompression )
  1358.     beq    230$            ;       and ( ch0_7 == repeatquote )
  1359.     cmpb    r2    ,rptquo        ;
  1360.     bne    230$            ;    then
  1361.                     ;       begin
  1362. 220$:    movb    senpar+p.qctl,(r4)+    ;     buffer[i] := quote
  1363.     inc    r3            ;     length := succ(length)
  1364.     cmpb    r2    ,#37        ;    if ( ch0_7 < SPACE )
  1365.     blos    225$            ;      or
  1366.     cmpb    r2    ,#del        ;    ( ch0_7 == DEL )
  1367.     bne    230$            ;      then
  1368. 225$:    ctl    r1    ,r1        ;      ch := ctl(ch)
  1369.     ctl    r2    ,r2        ;      ch0_7 := ctl(ch0_7)
  1370. 230$:    tst    image            ;   if image_mode
  1371.     beq    240$            ;    then
  1372.     movb    r1    ,(r4)+        ;     buffer[i] := ch
  1373.     br    250$            ;    else
  1374. 240$:    movb    r2    ,(r4)+        ;     buffer[i] := ch0_7
  1375. 250$:    inc    r3            ;   length := succ( length )
  1376.     return
  1377.  
  1378.  
  1379.  
  1380. gnc:    mov    #lun.in    ,r0
  1381.     add    #1    ,fileout+2    ; /43/ Stats on file data
  1382.     adc    fileout+0        ; /43/ 32 bits
  1383.     call    getcr0
  1384.     tst    r0
  1385.     beq    100$
  1386.     sec
  1387.     return
  1388. 100$:    clc
  1389.     return
  1390.  
  1391.  
  1392.     global    <getcr0    ,image    ,conpar>
  1393.  
  1394.  
  1395.  
  1396.  
  1397.     .sbttl    bufpak    buffil but get data from a buffer
  1398.  
  1399.  
  1400. ;    input:    @r5    source buffer, .asciz
  1401. ;    output:    2(r5)    destination buffer
  1402. ;        r0    zero (ie, no errors are possible)
  1403. ;        r1    string length
  1404. ;
  1405. ;    No 8 bit prefixing  and no repeat counts will be done.
  1406. ;    This routine is used for encoding string to be sent as
  1407. ;    generic commands to a server.
  1408.  
  1409.  
  1410. bufpak::save    <r2,r3,r4,r5>        ; save all registers we may use
  1411.     mov    2(r5)    ,r4        ; point to the destination address
  1412.     mov    @r5    ,r5        ; the source string
  1413.     clr    r3            ; use as a length counter
  1414.  
  1415. 10$:    clr    r1            ; ch := buffer[i]
  1416.     bisb    (r5)+    ,r1        ; avoid PDP-11 sign extension
  1417.     beq    90$            ;   
  1418.     clr    r2            ;
  1419.     bisb    r1    ,r2        ;   ch0_7 := ch '
  1420.     bic    #^C177    ,r2        ;   ch0_7 := ch0_7 and 177B
  1421.     cmpb    r2    ,#space        ;   if ch0_7 < space
  1422.     blo    20$            ;    or
  1423.     cmpb    r2    ,#del        ;      ch0_7 = del
  1424.     beq    20$            ;    or
  1425.     cmpb    r2    ,senpar+p.qctl    ;      ch0_7 = quote
  1426.     bne    40$            ;     then
  1427.                     ;      begin
  1428. 20$:    movb    senpar+p.qctl,(r4)+    ;    buffer[i] := quote
  1429.     inc    r3            ;    length := succ(length)
  1430.     cmpb    r2    ,senpar+p.qctl    ;    if ch0_7 <> quote
  1431.     beq    30$            ;     then begin
  1432.     ctl    r1    ,r1        ;      ch := ctl(ch)
  1433.     ctl    r2    ,r2        ;      ch0_7 := ctl(ch0_7) end
  1434. 30$:                    ;      end
  1435. 40$:    tst    image            ;   if image_mode
  1436.     beq    50$            ;    then
  1437.     movb    r1    ,(r4)+        ;     buffer[i] := ch
  1438.     br    60$            ;    else
  1439. 50$:    movb    r2    ,(r4)+        ;     buffer[i] := ch0_7
  1440. 60$:    inc    r3            ;   length := succ( length )
  1441.  
  1442. 70$:    clr    -(sp)
  1443.     bisb    conpar+p.spsiz,@sp    ;  exit if length > spsize-8
  1444.     bne    80$            ;  if spsiz = 0
  1445.      mov    #maxpak    ,@sp        ;   then maxsize := #maxpak
  1446. 80$:    sub    #10    ,@sp        ;
  1447.     cmp    r3    ,(sp)+        ;
  1448.     blo    10$            ; end
  1449.  
  1450.  
  1451. 90$:    mov    r3    ,r1        ; return the length please
  1452.     clr    r0            ; say read was successful
  1453.     unsave    <r5,r4,r3,r2>        ; and exit
  1454.     return
  1455.  
  1456.  
  1457.  
  1458.  
  1459.  
  1460.     .sbttl    bufemp    dump a buffer out to disk
  1461.  
  1462. ;    B U F E M P
  1463. ;
  1464. ;    bufemp(%loc buffer,%val len)
  1465. ;
  1466. ;    input:    @r5    buffer address
  1467. ;        2(r5)    length
  1468. ;    output:    r0    error
  1469.  
  1470.  
  1471. bufemp::save    <r1,r2,r3,r4>        ; save temps as usual
  1472.     mov    @r5    ,r2        ; input record address
  1473.     mov    2(r5)    ,r3        ; string length
  1474.     clr    r0            ; insure no error for a null packet
  1475.  
  1476. 10$:    tst    r3            ; anything left in the record?
  1477.     ble    100$            ; no
  1478. 20$:    clr    r0            ; get the next character
  1479.     bisb    (r2)+    ,r0        ; into a convienient place
  1480.     dec    r3            ; chcount-- ;
  1481.  
  1482.     mov    #1    ,r4        ; repeat_count = 1 ;
  1483.     tst    dorpt            ; are we doing repeat count stuff?
  1484.     beq    30$            ; no
  1485.     cmpb    r0    ,rptquo        ; yes, is this the aggreed upon prefix?
  1486.     bne    30$            ; no
  1487.     dec    r3            ; chcount--
  1488.     clr    r4            ; yes, get the next character then
  1489.     bisb    (r2)+    ,r4        ; and decode it into a number
  1490.     bic    #^C177    ,r4        ; insure no parity bits are hanging
  1491.     unchar    r4    ,r4        ; simple to do
  1492.     clr    r0            ; now prime CH with the next character
  1493.     bisb    (r2)+    ,r0        ; so we can check for other types of
  1494.     dec    r3            ; quoting to be done.
  1495.     tst    r4            ; insure the count is legitimate
  1496.     bgt    30$            ; it's ok
  1497.     mov    #1    ,r4        ; it's fubar, fix it
  1498.  
  1499. 30$:    clr    set8bit            ; assume we don't have to set bit 7
  1500.     tst    do8bit            ; must we do 8 bit unprefixing?
  1501.     beq    60$            ; no
  1502.     cmpb    r0    ,ebquot        ; yes, is this the 8 bit prefix?
  1503.     bne    60$            ; no
  1504.     mov    sp    ,set8bit    ; yes, send a flag to set the bit
  1505.     clr    r0            ; and get the next character
  1506.     bisb    (r2)+    ,r0        ; without sign extension
  1507.     dec    r3            ; one less character left in buffer
  1508.  
  1509. 60$:    cmpb    r0    ,conpar+p.qctl    ; is this a quoted character?
  1510.     bne    70$            ; no
  1511.     clr    r0            ; yes, get the next character
  1512.     bisb    (r2)+    ,r0        ; must be one you know
  1513.     dec    r3            ; chcount := pred(chcount)
  1514.     clr    r1            ; must avoid sign extension here
  1515.     bisb    r0    ,r1        ; check low 7 bits against quote
  1516.     bic    #^C177    ,r1        ; drop 7..15
  1517.     cmpb    r1    ,conpar+p.qctl    ; if ch <> myquote
  1518.     beq    70$            ;  then
  1519.     cmpb    r1    ,#77        ;   if   ( ch & 177 ) >= ctl(DEL)
  1520.     blo    70$            ;    and ( ch & 177 ) <= ctl(del)+40
  1521.     cmpb    r1    ,#137        ;    then
  1522.     bhi    70$            ;      ch = ctl(ch) ;
  1523.     ctl    r0    ,r0        ;
  1524.  
  1525. 70$:    tst    set8bit            ; do we need to set the high bit?
  1526.     beq    74$            ; no
  1527.     bisb    #200    ,r0        ; yes, set the bit on please
  1528. 74$:    mov    r0    ,-(sp)        ; and save the character to write
  1529. 75$:    mov    #lun.ou    ,r1        ; channel_number := lun.out
  1530.     tst    outopn            ; is there really something open?
  1531.     bne    80$            ; yes, put the data to it
  1532.     clr    r1            ; no, direct the output to a terminal
  1533. 80$:    mov    @sp    ,r0        ; restore the character to write out
  1534.     call    putcr0            ; and do it
  1535.     add    #1    ,filein+2    ; /43/ Stats
  1536.     adc    filein+0        ; /43/ 32 bits worth
  1537.     sob    r4    ,75$        ; duplicate the character if need be.
  1538.     tst    (sp)+            ; pop the stack where we saved CH
  1539.     br    10$            ; next character please
  1540.  
  1541. 100$:    unsave    <r4,r3,r2,r1>
  1542.     return
  1543.  
  1544.     global    <do8bit    ,ebquot    ,putcr0    ,outopn    ,senpar    ,set8bit>
  1545.     global    <dorpt    ,rptquo    >
  1546.  
  1547.  
  1548.  
  1549.     .sbttl    bufunpack    like bufemp, but return data to a buffer
  1550.  
  1551.  
  1552. ;    input:    @r5    source buffer, .asciz
  1553. ;    output:    2(r5)    destination buffer
  1554. ;        r0    zero (ie, no errors are possible)
  1555. ;        r1    string length
  1556. ;
  1557. ;    No 8 bit prefixing  and no repeat counts will be done.
  1558. ;    This routine is used for decoding strings received for
  1559. ;    generic commands to the server.
  1560.  
  1561.  
  1562.  
  1563. bufunp::save    <r2,r3,r4,r5>        ; save temps as usual
  1564.     mov    @r5    ,r2        ; input record address
  1565.     clr    r3            ; length := 0
  1566.     mov    2(r5)    ,r4        ; resultant string
  1567.                     ;
  1568. 10$:    clr    r0            ; get the next character
  1569.     bisb    (r2)+    ,r0        ; into a convienient place
  1570.     beq    100$            ; All done
  1571.     bic    #^C177    ,r0        ; /53/ Always seven bit data
  1572.     mov    #1    ,r5        ; /53/ Assume character not repeated
  1573.     tst    dorpt            ; /53/ Repeat processing off?
  1574.     beq    20$            ; /53/ Yes, ignore.
  1575.     cmpb    r0    ,rptquo        ; /53/ Is this a repeated char?
  1576.     bne    20$            ; /53/ No, normal processing
  1577.     bisb    (r2)+    ,r5        ; /53/ Yes, get the repeat count
  1578.     bic    #^C177    ,r5        ; /53/ Always seven bit data
  1579.     unchar    r5    ,r5        ; /53/ Get the value
  1580.     tst    r5            ; /53/ Good data
  1581.     bgt    15$            ; /53/ Yes
  1582.     mov    #1    ,r5        ; /53/ No, fix it
  1583. 15$:    clr    r0            ; /53/ Avoid sign extension
  1584.     bisb    (r2)+    ,r0        ; /53/ Now get the real data
  1585.     bic    #^C177    ,r0        ; /53/ Always seven bit data
  1586. 20$:    cmpb    r0    ,senpar+p.qctl    ; is this a quoted character?
  1587.     bne    30$            ; no
  1588.     clr    r0            ; yes, get the next character
  1589.     bisb    (r2)+    ,r0        ; must be one you know
  1590.     clr    r1            ; must avoid sign extension here
  1591.     bisb    r0    ,r1        ; check low 7 bits against quote
  1592.     bic    #^C177    ,r1        ; drop 7..15
  1593.     cmpb    r1    ,senpar+p.qctl    ; if ch <> myquote
  1594.     beq    30$            ;  then
  1595.     ctl    r0    ,r0        ;   ch := ctl(ch);
  1596.  
  1597. 30$:    movb    r0    ,(r4)+        ; copy the byte over now
  1598.     inc    r3            ; length := succ(length)
  1599.     sob    r5    ,30$        ; /53/ Perhaps data was repeated
  1600.     br    10$            ; next character please
  1601.  
  1602. 100$:    clrb    @r4            ; make the string .asciz
  1603.     mov    r3    ,r1        ; return the length
  1604.     clr    r0            ; fake no errors please
  1605.     unsave    <r5,r4,r3,r2>        ; pop registers and exit
  1606.     return
  1607.  
  1608.  
  1609.     global    <spar    ,rpar    ,fixchk>
  1610.  
  1611.  
  1612.     .sbttl    printm    print message if not remote
  1613.  
  1614. ;    P R I N T M
  1615. ;
  1616. ;    input:    @r5    arg count
  1617. ;        2(r5)    text for message #1
  1618. ;        4(r5)    and so on
  1619.  
  1620.     .enabl    lsb
  1621.  
  1622.  
  1623. printm::save    <r0,r1,r5>        ; save registers we will use
  1624.     mov    (r5)+    ,r1        ; get the message count
  1625.     beq    100$            ; nothing to do
  1626.     tst    inserv            ; skip if a server
  1627.     bne    100$            ; bye
  1628.     tst    remote            ; skip if we are the remote
  1629.     bne    100$            ; yep
  1630.     message
  1631.     message    <Kermit: >        ; a header
  1632. 10$:    mov    (r5)+    ,r0
  1633.     .print    r0            ; now loop thru printing the stuff
  1634.     sob    r1    ,10$        ; next please
  1635.     message                ; a <cr><lf>
  1636.     clr    logini            ; may need a logging header
  1637. 100$:    unsave    <r5,r1,r0>        ; pop temps
  1638.     return                ; and exit
  1639.  
  1640.     global    <logini,remote>
  1641.  
  1642.     .dsabl    lsb
  1643.  
  1644.  
  1645.  
  1646.  
  1647.  
  1648.     .sbttl    error message printing
  1649.  
  1650. ;    E R R O R
  1651. ;
  1652. ;    error(%val msgcount,%loc msg1, %loc msg2,....)
  1653. ;
  1654. ;    Error sends the message text if we are remote else
  1655. ;    it prints it out as in the baseline KERMIT.C
  1656.  
  1657.     erbfsiz    =    84.
  1658.  
  1659. error::    save    <r1,r2,r3,r4,r5>
  1660.     tst    remote            ; if not remote then printm(...)
  1661.     bne    10$            ; we are the remote. send errors
  1662.     call    printm            ; simple
  1663.     br    100$            ; bye
  1664.  
  1665. 10$:    mov    (r5)+    ,r1        ; message count
  1666.     beq    100$            ; nothing to do ?
  1667.  
  1668.     sub    #erbfsiz+2,sp        ; remote, allocate a text buffer
  1669.     mov    sp    ,r4        ; and point to it please
  1670.     movb    #'%    ,(r4)+        ; /35/ insert dec style 'warning'
  1671.     mov    #erbfsiz-1,r2        ; length so far
  1672.     mov    #prompt    ,r0        ; /32/ insert prompt into error text
  1673. 20$:    movb    (r0)+    ,(r4)+        ; /32/ copy the prompt text over
  1674.     beq    25$            ; /32/ all done, found a null (asciz)
  1675.     dec    r2            ; /32/ one less place to store text
  1676.     br    20$            ; /32/ next prompt character please
  1677. 25$:    dec    r4            ; /32/ backup to the null we copied.
  1678.     cmpb    -1(r4)    ,#'>        ; /35/ get rid of the trailing '>'
  1679.     bne    26$            ; /35/ no
  1680.     movb    #'-    ,-1(r4)        ; /35/ change it to form 'Kermit-11-'
  1681. 26$:    movb    #40    ,(r4)+        ; /32/ insert a space into buffer
  1682.     dec    r2            ; /32/ one less available
  1683.     tst    r2            ; /32/ did we possibly run out of room?
  1684.     bgt    30$            ; /32/ no
  1685.     mov    sp    ,r4        ; /32/ yes, forget about the prompt.
  1686.     mov    #erbfsiz,r2        ; /32/ yes, also reset the space avail
  1687.  
  1688. 30$:    mov    (r5)+    ,r3        ; get the next message please
  1689. 40$:    movb    (r3)+    ,@r4        ; now copy it to the buffer until
  1690.     beq    50$            ; we get an ascii null (chr(0))
  1691.     cmpb    @r4    ,#'$        ; apparently CPM systems don't like
  1692.     bne    45$            ; dollar symbols ?
  1693.     movb    #'_    ,@r4        ; so stuff a '_' in instead
  1694. 45$:    inc    r4
  1695.     sob    r2    ,40$        ; no, go until we get one or run
  1696.     br    60$            ; out of space to put it
  1697. 50$:    movb    #40    ,(r4)+        ; insert a space in there
  1698.     dec    r2            ; insure sufficient space
  1699.     beq    60$            ; no
  1700.     sob    r1    ,30$        ; and get the next message
  1701.  
  1702. 60$:    clrb    @r4            ; inaure .asciz
  1703.     mov    sp    ,r4        ; all done, send the ERROR packet
  1704.     strlen    r4            ; get the length
  1705.     spack    #'E,paknum,r0,r4    ; and send it
  1706.     add    #erbfsiz+2,sp        ; deallocate the text buffer
  1707.  
  1708. 100$:    unsave    <r5,r4,r3,r2,r1>    ; and exit
  1709.     return
  1710.  
  1711.     global    <paknum    ,prompt    ,remote>
  1712.  
  1713.     .sbttl    print received error packet out
  1714.  
  1715. ;    P R E R R P
  1716. ;
  1717. ;    prerrp(%loc msg)
  1718. ;
  1719. ;    input:    @r5    address of .asciz string to print
  1720.  
  1721.     .enabl    lsb
  1722.  
  1723.  
  1724. prerrp::.print    #200$
  1725.     .print    @r5
  1726.     .newli
  1727.     clr    logini
  1728.     return
  1729.  
  1730.     .save
  1731.     .psect    $PDATA    ,D
  1732.     .enabl    lc
  1733. 200$:    .asciz    /Aborting with error from remote./<CR><LF>
  1734.     .even
  1735.     .restore
  1736.     .dsabl    lsb
  1737.  
  1738.     global    <logini>
  1739.  
  1740.  
  1741.  
  1742.     .sbttl    send/print several common types of errors
  1743.  
  1744. ;    M$TYPE(%val(type),%loc(packet))    unknown packet type recieved
  1745. ;    M$RETRY                retry abort
  1746. ;    M$SYNCH                out of synch
  1747. ;
  1748. ;    18-Oct-84  17:34:37 BDN        debugging for PRO/RT11 Kermit
  1749.  
  1750.  
  1751. m$type::save    <r0>            ; save temps that we will use
  1752.     clr    -(sp)            ; a buffer for the packet type
  1753.     movb    @r5    ,@sp        ; the packet type
  1754.     mov    sp    ,r0        ; point back to the buffer
  1755.     calls    error    ,<#4,#e$type,r0,#e$hd,2(r5)>
  1756.     tst    (sp)+            ; pop local buffer
  1757.     unsave    <r0>            ; pop temp and exit
  1758.     return
  1759.  
  1760.  
  1761.  
  1762. m$retr::save    <r0>            ; save r0 please
  1763.     bitb    #200    ,recbit        ; /44/ Perhaps parity was going ?
  1764.     beq    10$            ; /44/ No
  1765.     cmpb    parity    ,#PAR$NO    ; /44/ Yes, do we know about parity
  1766.     bne    10$            ; /44/ Yes we do, normal abort
  1767.     calls    error    ,<#1,#e$par>    ; /44/ No parity, ctl fields have
  1768.     br    100$            ; /44/ Exit
  1769. 10$:    calls    error    ,<#1,#e$retr>    ; send/print the error message
  1770. 100$:    unsave    <r0>            ; pop and exit
  1771.     return                ; bye
  1772.  
  1773.  
  1774. m$sync::save    <r0>            ; save r0 please
  1775.     calls    error    ,<#1,#e$synch>    ; send/print the error message
  1776.     unsave    <r0>            ; pop and exit
  1777.     return                ; bye
  1778.  
  1779.  
  1780.     .save
  1781.     .psect    $pdata
  1782. e$hd:    .asciz    / pak: /
  1783. e$type:    .asciz    /Fubar pak type: /
  1784. e$retr:    .asciz    /Retry limit reached/
  1785. e$synch:.asciz    /Hopelessly out of synch with sending Kermit/
  1786. e$par:    .asciz    /Retry limit reached, parity is possibly being introduced/
  1787.     .even
  1788.     .restore
  1789.  
  1790.  
  1791.  
  1792.  
  1793.     .sbttl    get next file to send
  1794.  
  1795.  
  1796. ;    G E T N X T
  1797. ;
  1798. ;    input:    srcnam    possibly wildcarded filename
  1799. ;        index    flag if eq 0 then this is the first time thru
  1800. ;    output:    filnam    next file to do
  1801. ;        r0    <> 0 then abort
  1802. ;    
  1803. ;    RSTS and RSX11M/M+
  1804. ;
  1805. ;     Lookup uses the RMS version 2 $SEARCH macro to do the directory
  1806. ;    operation.  For RT11 we will simply  NOP  the $SEARCH since RT11
  1807. ;    does  not support directory lookup operations in the EXEC.  Thus
  1808. ;    the error codes ER$NMF (no more files) and ER$FNF are referenced
  1809. ;    directly here.
  1810.     
  1811.  
  1812.  
  1813. getnxt::save    <r1>
  1814.     calls    lookup    ,<#3,#srcnam,#index,#filnam>
  1815.     tst    r0            ; did it work ?
  1816.     beq    100$            ; yes
  1817.     cmp    r0    ,#ER$NMF    ; no more files matching name ?
  1818.     beq    20$            ; yes, we are all done then
  1819.     cmp    r0    ,#ER$FNF    ; how about file not found ?
  1820.     bne    30$            ; no, print the error message out
  1821. 20$:    tst    index            ; sent any files yet ?
  1822.     bne    100$            ; yes, that's ok then
  1823.     mov    #ER$FNF    ,r0        ; no, convert ER$NMF to ER$FNF
  1824.  
  1825. 30$:    mov    r0    ,-(sp)        ; save r0 please
  1826.     calls    syserr    ,<r0,#errtxt>    ; not so good. Get the error text
  1827.     mov    #filnam    ,r1        ; assume the filename parse worked
  1828.     calls    fparse    ,<#srcnam,#filnam>; quite possibly it may not have
  1829.     tst    r0            ; so decide whether to send the
  1830.     beq    40$            ; origonal name or the expanded
  1831.     mov    #srcnam    ,r1        ; filename in the error packet.
  1832. 40$:    calls    error    ,<#2,#errtxt,r1>; and send/print it out
  1833.     mov    (sp)+    ,r0        ; pop saved error code from lookup
  1834.  
  1835. 100$:    unsave    <r1>
  1836.     return
  1837.  
  1838.     global    <er$fnf    ,er$nmf    ,errtxt    ,filnam    ,index    ,srcnam>
  1839.  
  1840.  
  1841.     .sbttl    xor and scanch
  1842.  
  1843.  
  1844. l$xor::    save    <r0>
  1845.     mov    4(sp)    ,r0
  1846.     ixor    #100    ,r0
  1847.     mov    r0    ,4(sp)
  1848.     unsave    <r0>
  1849.     return
  1850.     
  1851.  
  1852.  
  1853. ;    S C A N C H 
  1854. ;
  1855. ;    input:    4(sp)    the string address
  1856. ;        2(sp)    the character to look for
  1857. ;    output:    r0    position of ch in string
  1858.  
  1859.  
  1860. scanch::save    <r2>            ; save temps
  1861.     mov    6(sp)    ,r2        ; get address of the string
  1862.     clr    r0            ; initial found position
  1863. 10$:    tstb    @r2            ; end of the string yet ?
  1864.     beq    90$            ; yes
  1865.     inc    r0            ; no, pos := succ(pos)
  1866.     cmpb    4(sp)    ,(r2)+        ; does the ch match the next one?
  1867.     bne    10$            ; no, try again
  1868.     br    100$            ; yes, exit loop
  1869. 90$:    clr    r0            ; failure, return postion = 0
  1870. 100$:    unsave    <r2>            ; pop r2
  1871.     mov    @sp    ,4(sp)        ; move return address up
  1872.     cmp    (sp)+    ,(sp)+        ; pop stack
  1873.     return                ; and exit
  1874.  
  1875.  
  1876. ;    random things for testing
  1877.  
  1878.  
  1879. irand::    tst    testc
  1880.     bne    10$
  1881.     mov    #1234.    ,testc
  1882. 10$:    mov    testc    ,r0
  1883.     mov    r1    ,-(sp)
  1884.     mov    r0    ,r1
  1885.     ash    #-4    ,r1
  1886.     bic    #170000    ,r1
  1887.     xor    r1    ,r0
  1888.     ash    #13    ,r1
  1889.     bic    #100000    ,r1
  1890.     xor    r1    ,r0
  1891.     bic    #100000    ,r0
  1892.     mov    r0    ,testc
  1893.     ash    #-13    ,r0
  1894.     mov    (sp)+    ,r1
  1895.     return
  1896.  
  1897.     global    <testc>
  1898.  
  1899.  
  1900.  
  1901.  
  1902.  
  1903.     .sbttl    compute parity for an outgoing 8 bit link
  1904.  
  1905.  
  1906. ;    This  is  software  parity generation as some DEC interfaces
  1907. ;    and some DEC executives don't know how  to  compute  parity.
  1908. ;    There  are  two  methods given here for ODD and EVEN genera-
  1909. ;    tion. One is from Frank da Cruz's 20KERMIT.MAC and  does  it
  1910. ;    by  computing  it.  The other method is from the pascal RT11
  1911. ;    Kermit (by Phil Murton) and does a table lookup  to  compute
  1912. ;    the  parity. For the sake of speed and the fact that some RT
  1913. ;    systems lack certain instructions  we  will  use  the  later
  1914. ;    method at a slight cost in space. 
  1915.  
  1916.     parlok    =    1        ; use table lookup method
  1917.  
  1918.  
  1919.  
  1920.     .assume    par$od    eq 1        ; set parity odd
  1921.     .assume    par$ev    eq 2        ; set parity even
  1922.     .assume    par$ma    eq 3        ; set parity mark
  1923.     .assume    par$sp    eq 4        ; set parity space
  1924.     .assume    par$no    eq 5        ; set parity none
  1925.  
  1926.  
  1927.     .psect    $pdata
  1928. pardsp:    .word    none.p,    odd.p,    even.p    ,mark.p    ,spac.p    ,none.p    
  1929.     .psect    $code
  1930.  
  1931.  
  1932.  
  1933. dopari::save    <r0,r1,r2,r3>        ; save things we will use
  1934.     mov    parity    ,r3        ; get the current parity setting
  1935.     asl    r3            ; times 2
  1936.     mov    12(sp)    ,r1        ; get the character to do it to
  1937.     jsr    pc    ,@pardsp(r3)    ; and dispatch as desired
  1938.     mov    r1    ,12(sp)        ; return the character please
  1939.     unsave    <r3,r2,r1,r0>        ; pop and exit
  1940.     return
  1941.  
  1942.  
  1943. none.p:    return                ; do nothing
  1944.  
  1945. mark.p:    bisb    #200    ,r1        ; mark means we are always high
  1946.     return                ; on bit seven
  1947.  
  1948. spac.p:    bicb    #200    ,r1        ; space means we are always low
  1949.     return                ; on bit seven
  1950.  
  1951.  
  1952.  
  1953.  
  1954.     .sbttl    odd/even parity generation
  1955.  
  1956.     .if eq    ,parlok            ; what kind of parity generation
  1957.     .ift                ; to use
  1958.  
  1959.  
  1960. even.p:    bic    #^c177    ,r1        ; insure no high bits are set
  1961.     mov    r1    ,r2        ; copy
  1962.     call    par            ; and do it
  1963.     return
  1964.  
  1965. odd.p:    bic    #^c177    ,r1        ; insure only bits 0..6
  1966.     mov    r1    ,r2        ; copy it
  1967.     bisb    #200    ,r2        ; and set bit seven
  1968.     call    par            ; do it
  1969.     return                ; bye
  1970.  
  1971. par:    mov    #200    ,r3        ; xor instruction is strange
  1972.     ash    #-4    ,r2        ; move the high four bits down
  1973.     bic    #^C17    ,r2        ; clear bit 7's right propagation
  1974.     ixor    r1    ,r2        ; fold source character into one
  1975.     bic    #^C17    ,r2        ; insure we have only 4 bits today
  1976.     mov    r2    ,r3        ; now check if bits 2 and 3 are
  1977.     asr    r3            ; /2
  1978.     asr    r3            ; /2
  1979.     cmpb    r3    ,#3        ; both high or both low
  1980.     beq    10$            ; both high
  1981.     tstb    r3            ; both low ?
  1982.     bne    20$            ; no, don't set any parity then
  1983. 10$:    ixor    #200    ,r1        ; yes, toggle parity now
  1984. 20$:    bic    #^C3    ,r2        ; ok, now see if the low 2 bits are
  1985.     cmpb    r2    ,#3        ; both either on or off
  1986.     beq    30$            ; both are on, set parity
  1987.     tstb    r2            ; perhaps only one bit is on?
  1988.     bne    40$            ; yep
  1989. 30$:    ixor    #200    ,r1        ; toggle the bit then
  1990. 40$:
  1991.     return                ; bye
  1992.  
  1993.     .endc                ; if eq, parlok
  1994.  
  1995.  
  1996.  
  1997.  
  1998.  
  1999.     .sbttl    odd/even parity generation via lookup
  2000.  
  2001.     .if ne    ,parlok            ; use this method ?
  2002.     .ift                ; yes
  2003.  
  2004.  
  2005. odd.p:    bic    #^c177    ,r1
  2006.     tstb    partab(r1)
  2007.     bne    100$
  2008.     bisb    #200    ,r1
  2009. 100$:    return
  2010.  
  2011. even.p:    bic    #^c177    ,r1
  2012.     tstb    partab(r1)
  2013.     beq    100$
  2014.     bisb    #200    ,r1
  2015. 100$:    return
  2016.  
  2017.  
  2018. ;    Table of parity setting for ascii 0-177
  2019. ;    From Phil Murton's RTLINE.PAS
  2020.  
  2021.     .save
  2022.     .psect    $PDATA    ,D
  2023.  
  2024. partab:    .byte    0,1,1,0,1,0,0,1        ; first 8 ascii characters
  2025.     .byte    1,0,0,1,0,1,1,0
  2026.     .byte    1,0,0,1,0,1,1,0
  2027.     .byte    0,1,1,0,1,0,0,1
  2028.     .byte    1,0,0,1,0,1,1,0
  2029.     .byte    0,1,1,0,1,0,0,1
  2030.     .byte    0,1,1,0,1,0,0,1
  2031.     .byte    1,0,0,1,0,1,1,0
  2032.     .byte    1,0,0,1,0,1,1,0
  2033.     .byte    0,1,1,0,1,0,0,1
  2034.     .byte    0,1,1,0,1,0,0,1
  2035.     .byte    1,0,0,1,0,1,1,0
  2036.     .byte    0,1,1,0,1,0,0,1
  2037.     .byte    1,0,0,1,0,1,1,0
  2038.     .byte    1,0,0,1,0,1,1,0
  2039.     .byte    0,1,1,0,1,0,0,1        ; last eight ascii characters (to 177)
  2040.  
  2041.     .restore
  2042.  
  2043.     .endc                ; if ne, parlok
  2044.  
  2045.  
  2046.  
  2047.  
  2048.  
  2049.  
  2050.     .end
  2051.