Columbia Kermit/kermit.zip/archives/mskermit.tar.gz/mskermit.tar/mscp98.asm

Assembly Source File | 1991-04-18 | 58KB | 1,743 lines

    NAME    msscom
; File MSSCOM.ASM
    include mssdef.h
;       Copyright (C) 1982,1991, Trustees of Columbia University in the
;       City of New York.  Permission is granted to any individual or
;       institution to use, copy, or redistribute this software as long as
;       it is not sold for profit and this copyright notice is retained.
; Edit history:
; 2 March 1991 version 3.10
; Last edit 23 Jan 1991

    public    spack, rpack, sleep, spause, bufclr, pakptr, bufrel
    public    makebuf, getbuf, pakdup, chkwind, firstfree, windused
    public    rpacket, windlow, chkparflg

stat_suc equ    0        ; success
stat_tmo equ    1        ; timeout
stat_chk equ    2        ; checksum mismatch
stat_ptl equ    4        ; packet too long
stat_int equ    8        ; user interrupt
stat_eol equ    10h        ; eol char seen
stat_bad equ    80h        ; packet is bad (premature EOL)

data    segment    public 'data'
    extrn    flags:byte, trans:byte, fsta:word, ssta:word, fmtdsp:byte
    extrn    pktnum:byte, portval:word, denyflg:word

parmsk    db    0ffh        ; parity mask (0FFH for 8bit data path) [umd]
badpflag db    0        ; flag to say have shown bad parity message
spmes    db    'Spack: $'
rpmes     db    'Rpack: $'
crlf    db      cr,lf,'$'
msgstl    db    'Internal Error: send packet is too long',0,'$'
msgtmo    db    '<Timeout>',cr,lf,'$'
msgbad    db    '<Crunched packet>',cr,lf,'$'
msgecho    db    '<Echo of sent packet>',cr,lf,'$'
msgbadsnd db    cr,lf,'<Error sending packet bytes>',cr,lf,'$'
msgbadpare db    'Unexpected Parity from host! Changing Parity to EVEN'
    db    cr,lf,0
msgbadparo db    'Unexpected Parity from host! Changing Parity to ODD'
    db    cr,lf,0
msgbadparm db    'Unexpected Parity from host! Changing Parity to MARK'
    db    cr,lf,0
tmp    db    0
spause    db    0        ; # millisec to wait before sending pkt
timeval    db    0        ; active receive timeout value, seconds
prvtyp  db      0        ; Type of last packet sent
chkparflg db    0        ; non-zero to check parity on received pkts
prevchar db    0        ; previous char from comms line (for ^C exit)
lentyp    db    0        ; packet length type, 3, 0, 1
debflg    db    0        ; debug display, send/receive flag
timeit    db    0        ; arm timeout counter
flowon    db    0        ; xon or null, flow-on value
                ; sliding windows data structures
windlow    db    0        ; lower border of window
windused db    0        ; number of window slots in use
prolog  db    10 dup (0)    ; prolog: SOH, LEN, SEQ, TYPE, xlen,...,null
epilog    db    30 dup (0)    ; epilog: checksum, eol, handshake + null term
rbuf    db    128 dup (0)    ; static packet buffer for replies
    even
bufnum    dw    0        ; number of buffers available now
buflist dw    maxwind dup (0) ; pointers to packet structures in pktlist
bufuse    dw    maxwind dup (0) ; in-use flag (0 = not in use)
pktlist    pktinfo maxwind dup (<>) ; pktinfo structured members (private)
bufbuf    db    maxpack+((3*maxwind)/2) dup (0) ; Data buffer for packets
rpacket    pktinfo <offset rbuf,0,length rbuf,0,0> ; reply pktinfo
    even
rtemp    dw    0        ; address of pktinfo structure for rpack
stemp    dw    0        ; address of pktinfo structure for spack
linecnt    dw    0        ; debug line width counter
pktptr  dw    0        ; position in receive packet
chksum    dw    0        ; running checksum (two char)
chrcnt    dw    0        ; number of bytes in data field of a packet
spkcnt    dw    0        ; number of bytes sent in this packet
rpkcnt    dw    0        ; number of bytes received in this packet
status    dw    0        ; status of packet receiver (0 = ok)
deblen    dw    0        ; length of current debug buffer
fairflg    dw    0        ; fairness flag, for console/port reads
time     dw    2 dup (0)    ; Sleep, when we should timeout
rptim    db    4 dup (0)    ; read packet timeout slots
sixzero    dw    60        ; for div operation in rec packet timeouts
ninefive dw    95        ; for mult/div with long packets
temp    dw    0
data    ends

code    segment    public 'code'
    extrn    prtchr:near, outchr:near, isdev:near
    extrn    sppos:near, ermsg:near, clearl:near, rppos:near
    extrn    pktcpt:near, strlen:near, pcwait:near

    assume     cs:code, ds:data, es:nothing
prtchr1    proc    far        ; near-far interface routines for code1 seg
    call    prtchr
    ret
prtchr1    endp
outchr1    proc    far
    call    outchr
    ret
outchr1    endp
isdev1    proc    far
    call    isdev
    ret
isdev1    endp
rppos1    proc    far
    call    rppos
    ret
rppos1    endp
sppos1    proc    far
    call    sppos
    ret
sppos1    endp
ermsg1    proc    far
    call    ermsg
    ret
ermsg1    endp
clearl1    proc    far
    call    clearl
    ret
clearl1    endp
pktcpt1    proc    far
    call    pktcpt
    ret
pktcpt1    endp
strlen1    proc    far
    call    strlen
    ret
strlen1    endp
pcwait1    proc    far
    call    pcwait
    ret
pcwait1    endp
code    ends

code1    segment    public    'code'
    assume     cs:code1, ds:data, es:nothing

; Send_Packet
; This routine assembles a packet from the arguments given and sends it
; to the host.
;
; Expects the following:
;    SI = pointer to pktinfo structure, as
;    [SI].PKTYPE - Packet type letter
;    [SI].SEQNUM - Packet sequence number
;    [SI].DATLEN - Number of data characters
;    [SI].DATADR - Address of data field for packet
; Returns: carry clear if success, carry set if failure.
; Packet construction areas:
;     Prolog (8 bytes)            Data     null  Epilog
;+----------------------------------------+---------------+---------------+
;| SOH,LEN,SEQ,TYPE,Xlen(2-3),Xlen chksum | packet's data | chksum,EOL,HS |
;+----------------------------------------+---------------+---------------+
; where Xlen is 2 byte (Long) or 3 byte (Extra Long) count of bytes to follow.
;
SPACK    PROC    FAR
    mov    stemp,si    ; save pkt pointer
    mov    ah,[si].pktype
    mov    prvtyp,ah    ; remember packet type
    mov    spkcnt,0    ; number of bytes sent in this packet
    add    fsta.pspkt,1    ; statistics, count a packet being sent
    adc    fsta.pspkt+2,0    ;  ripple carry
    add    ssta.pspkt,1    ; statistics, count a packet being sent
    adc    ssta.pspkt+2,0    ;  ripple carry
    mov    al,spause    ; wait spause milliseconds before sending pkt
    or    al,al        ; zero?
    jz    spac1        ; z = yes
    xor    ah,ah
    call    pcwait1        ;   to let other side get ready
spac1:    mov    cl,trans.spad    ; get the number of padding chars
    xor    ch,ch
    jcxz    spac4        ; z = none
    xor    al,al
    xchg    al,trans.sdbl    ; doubling char, stash and clear it
    push    ax
    mov    ah,trans.spadch    ; get padding char
spac2:    call    spkout        ; send padding char
    jnc    spac3        ; nc = success
    ret            ; failed
spac3:    loop    spac2
    pop    ax        ; recover doubling char
    xchg    trans.sdbl,al

spac4:    mov    bx,offset prolog ; start with these guys
    mov    pktptr,bx
    call    snddeb        ; do debug display (while it's still our turn)
    mov    bx,offset prolog ; start with these guys
    mov    pktptr,bx
    push    es
    push    ds
    pop    es
    cld
    mov    cx,length prolog
    mov    di,offset prolog
    xor    al,al
    rep    stosb
    mov    cx,length epilog
    mov    di,offset epilog
    rep    stosb
    pop    es
    mov    al,trans.ssoh    ; get the start of header char
    mov    prolog,al    ; put SOH in the packet
    mov    si,stemp    ; address of send pktinfo
    mov    al,[si].seqnum    ; SEQ
    add    al,20h        ; ascii bias
    mov    prolog+2,al    ; store SEQ in packet
    xor    ah,ah
    mov    chksum,ax    ; start checksum
    mov    al,prvtyp    ; TYPE
    mov    prolog+3,al    ; store TYPE
    add    chksum,ax    ; add to checksum
;
; packet length type is directly governed here by length of header plus data
; field, [si].datlen, plus chksum: regular <= 94, long <= 9024, else X long.
;
    mov    ax,[si].datlen    ; DATA length
    add    ax,2        ; add SEQ, TYPE lengths
    add    al,trans.chklen    ; add checksum length at the end
    adc    ah,0        ; propagate carry, yields overall new length
    cmp    ax,[si].datsize    ; too big?
    jle    spac14        ; le = ok
    push    dx        ; tell user an internal error has occurred
    mov    dx,offset msgstl ; packet is too long
    call    ermsg1        ; display message on error line
    call    captdol        ; put into packet log
    pop    dx
    stc
    ret            ; return bad

spac14:    mov    lentyp,3    ; assume regular packet
    cmp    ax,94        ; longer than a regular?
    ja    spac15        ; a = use Long
    add    al,20h        ; convert length to ascii
    mov    prolog+1,al    ; store LEN
    xor    ah,ah
    add    chksum,ax    ; add LEN to checksum
    mov    bx,offset prolog+4 ; look at data field
    jmp    spac19        ; do regular

                ; use Long packets (type 0)
spac15:    sub    ax,2        ; deduct SEQ and TYPE from above = data+chksum
    mov    lentyp,0    ; assume type 0 packet
    cmp    ax,(95*95-1)    ; longest type 0 Long packet (9024)
    jbe    spac16        ; be = type 0
    mov    lentyp,1    ; type 1 packet, Extra Long
spac16:    mov    cl,lentyp    ; add new LEN field to checksum
    add    cl,20h        ; ascii bias, tochar()
    xor    ch,ch
    add    chksum,cx    ; add to running checksum
    mov    prolog+1,cl    ; put LEN into packet
    mov    bx,offset prolog+4
    mov    cx,1        ; a counter
    xor    dx,dx        ; high order numerator of length
spac17:    div    ninefive    ; divide ax by 95. quo = ax, rem = dx
    push    dx        ; push remainder
    inc    cx        ; count push depth
    cmp    ax,95        ; quotient >= 95?
    jae    spac17        ; ae = yes, recurse
    push    ax        ; push for pop below
spac18:    pop    ax        ; get a digit
    add    al,20h        ; apply tochar()
    mov    [bx],al        ; store in data field
    add    chksum,ax    ; accumulate checksum for header
    inc    bx        ; point to next data field byte
    mov    byte ptr[bx],0    ; insert terminator
    loop    spac18        ; get the rest
                ;
    mov    ax,chksum    ; current checksum
    shl    ax,1        ; put two highest bits of al into ah
    shl    ax,1
    and    ah,3        ; want just those two bits
    shr    al,1        ; put al back in place
    shr    al,1
    add    al,ah        ; add two high bits to earlier checksum
    and    al,03fh        ; chop to lower 6 bits (mod 64)
    add    al,20h        ; apply tochar()
    mov    [bx],al        ; store that in length's header checksum
    inc    bx
    mov    byte ptr [bx],0 ; terminator to prolog field
    xor    ah,ah
    add    chksum,ax    ; add that byte to running checksum
                ; end of inserting Long pkt info

spac19:    mov    cx,bx        ; where we stopped+1
    mov    bx,offset prolog ; place where prolog section starts
    sub    cx,bx
    jcxz    spac22        ; nothing
spac20:    mov    ah,[bx]        ; prolog part
    or    ah,ah        ; at the end?
    jz    spac22        ; z = yes
    inc    bx
    call    spkout        ; send byte to serial port
    jnc    spac21        ; nc = good send
    jmp    spac28        ; bad send
spac21:    loop    spac20        ; do all prolog parts
spac22:    mov    pktptr,offset prolog ; starting point for deblin, end = [bx-1]
    call    deblin        ; show debug info for prolog
    mov    si,stemp    ; address of pktinfo
    mov    bx,[si].datadr    ; select from given data buffer
    mov    pktptr,bx    ; start here with next deblin
    mov    dx,[si].datlen    ; get the number of data bytes in packet
spac23:    or    dx,dx        ; any data chars remaining?
    jle    spac25        ; le = no, finish up
    mov    al,[bx]        ; get a data char
    inc    bx        ; point to next char [umd]
spac24:    xor    ah,ah
    add    chksum,ax    ; add the char to the checksum [umd]
    and    chksum,0fffh    ; keep only low order 12 bits
    mov    ah,al        ; put char in ah where spkout wants it
    dec    dx        ; say sending one character
    call    spkout        ; send it
    jnc    spac23        ; nc = success, get more data chars
    jmp    spac28        ; bad send

spac25:    mov    byte ptr [bx],0    ; terminator of data field
    call    deblin        ; show debug display of data field
    mov    bx,offset epilog ; area for epilog
    mov    pktptr,bx    ; where to start last of debug display
    mov    cx,chksum
    cmp    trans.chklen,2    ; what kind of checksum are we using?
    je    spac27        ; e = 2 characters
    jg    spac26        ; g = 3 characters
    mov    ah,cl        ; 1 char: get the character total
    mov    ch,cl        ; save here too (need 'cl' for shift)
    and    ah,0C0H        ; turn off all but the two high order bits
    mov    cl,6
    shr    ah,cl        ; shift them into the low order position
    mov    cl,ch
    add    ah,cl        ; add it to the old bits
    and    ah,3FH        ; turn off the two high order bits.  (MOD 64)
    add    ah,' '        ; add a space so the number is printable
    mov    [bx],ah        ; put in the packet
    inc    bx        ; point to next char
    call    spkout        ; send it
    jnc    spac30        ; add EOL char
    jmp    spac28        ; bad send
spac26: mov    byte ptr[bx],0    ; null, to determine end of buffer
    push    bx        ; don't lose our place
    mov    bx,offset prolog+1 ; first checksummed char, skip SOH
    xor    dx,dx        ; initial CRC value is 0
    call    crcclc        ; calculate the CRC of prolog part, to cx
    mov    si,stemp    ; address of pktinfo
    mov    bx,[si].datadr    ; address of data
    push    bx        ; save address
    add    bx,[si].datlen    ; byte beyond data
    mov    byte ptr [bx],0    ; null terminator for CRC
    pop    bx        ; recover address of data
    mov    dx,cx        ; first part of CRC returned in cx
    call    crcclc        ; do CRC of data, using current CRC in dx
    pop    bx        ; recover place to store more debug info
    push    cx        ; save the crc
    mov    ax,cx        ; manipulate it here
    and    ax,0F000H    ; get 4 highest bits
    mov    cl,4
    shr    ah,cl        ; shift over 4 bits
    add    ah,' '        ; make printable
    mov    [bx],ah        ; add to buffer
    inc    bx
    pop    cx        ; get back checksum value
    call    spkout        ; send it
    jnc    spac27
    jmp    short spac28    ; bad send
spac27:    push    cx        ; save it for now
    and    cx,0FC0H    ; get bits 6-11
    mov    ax,cx
    mov    cl,6
    shr    ax,cl        ; shift them bits over
    add    al,' '        ; make printable
    mov    [bx],al        ; add to buffer
    inc    bx
    mov    ah,al
    call    spkout        ; send it
    pop    cx        ; get back the original
    jc    spac28        ; c = bad send
    and    cx,003FH    ; get bits 0-5
    add    cl,' '        ; make printable
    mov    [bx],cl        ; add to buffer
    inc    bx
    mov    ah,cl
    call    spkout        ; send it
    jnc    spac30
spac28:    call    deblin        ; show debug info so far before exiting
    mov    dx,offset msgbadsnd ; say sending error in log
    call    captdol
    mov    si,stemp    ; restore pkt pointer
    stc            ; carry set for failure
    RET            ; bad send, do ret to caller of spack

spac30:    mov    ah,trans.seol    ; get the EOL the other host wants
    mov    [bx],ah        ; put eol
    inc    bx
    call    deblin        ; do debug display (while it's still our turn)
    test    flags.debug,logpkt ; In debug mode?
    jnz    spac31        ; nz = yes
    test    flags.capflg,logpkt ; log packets?
    jz    spac32        ; z = no
spac31:    cmp    linecnt,0    ; anything on current line?
    je    spac32        ; e = no
    mov    dx,offset crlf    ; finish line with cr/lf
    call    captdol        ;  to log file
spac32:    mov    ah,trans.seol    ; recover EOL
    call    spkout        ; send it
    jnc    spac33
    stc            ; bad send
    ret            ; return in error state

spac33:    mov    ax,spkcnt    ; number of bytes sent in this packet
    add    fsta.psbyte,ax    ; file total bytes sent
    adc    fsta.psbyte+2,0    ; propagate carry to high word
    add    ssta.psbyte,ax    ; for session
    adc    ssta.psbyte+2,0
    call    chkcon        ; check console for user interrupts
    mov    si,stemp    ; restore pkt pointer
    clc            ; carry clear for success
    ret            ; return successfully
SPACK    ENDP

spkout:    cmp    ah,trans.sdbl    ; double this char?
    jne    spkou1        ; ne = no
    call    spkou1        ; do it once here and again via fall through
    jnc    spkou1        ;  but again only if no failure
    ret            ; return failure
spkou1:    push    ax        ; send char in ah out the serial port
    push    bx        ; return carry clear if success
    push    cx
    push    dx
    mov    tmp,1        ; retry counter
spkour:    call    outchr1        ; serial port transmitter procedure
    jc    spkoux        ; c = bad send, retry
    inc    spkcnt        ; count number of bytes sent in this packet
    pop    dx
    pop    cx
    pop    bx
    pop    ax
    clc            ; carry    clear for good send
    ret
spkoux:    cmp    tmp,5        ; done 5 attempts on this char?
    jge    spkoux1        ; ge = yes, fail the sending
    inc    tmp
    push    ax
    mov    ax,10        ; wait 10 milliseconds
    call    pcwait1
    pop    ax
    jmp    short spkour    ; retry
spkoux1:pop    dx        ; failed to send char
    pop    cx
    pop    bx
    pop    ax
    stc            ; set carry for bad send
    ret

; Calculate the CRC of the null-terminated string whose address is in BX.
; Returns the CRC in CX.  Destroys BX and AX.
; The CRC is based on the SDLC polynomial: x**16 + x**12 + x**5 + 1.
; By Edgar Butt  28 Oct 1987 [ebb].
; Enter with initial CRC in DX (normally 0).
crcclc: push    dx
    mov    cl,4            ; load shift count
crc0:   mov    ah,[bx]            ; get the next char of the string
        or    ah,ah            ; if null, then we're done
        jz    crc1            ; z = null, stop
        inc    bx
        xor    dl,ah            ; XOR input with lo order byte of CRC
        mov    ah,dl            ; copy it
        shl    ah,cl            ; shift copy
        xor    ah,dl            ; XOR to get quotient byte in ah
        mov    dl,dh            ; high byte of CRC becomes low byte
        mov    dh,ah            ; initialize high byte with quotient
        xor    al,al
        shr    ax,cl            ; shift quotient byte
        xor    dl,ah            ; XOR (part of) it with CRC
        shr    ax,1            ; shift it again
        xor    dx,ax            ; XOR it again to finish up
        jmp    short crc0
crc1:   mov    cx,dx            ; return CRC in CX
        pop    dx
        ret

; Receive_Packet
; This routine waits for a packet arrive from the host. Two Control-C's in a
; row from the comms line will cause a Control-C interruption exit.
; Returns
;    SI = pointer to pktinfo structure, as
;    [SI].SEQNUM - Packet sequence number
;    [SI].DATLEN - Number of data characters
;    [SI].DATADR - Address of data field for packet
; Returns AH -  packet type (letter code)
; Returns: carry clear if success, carry set if failure.
; Packet construction areas:
;     Prolog (8 bytes+2 nulls)    null    Data    null  Epilog   null
;+----------------------------------------+---------------+---------------+
;| SOH,LEN,SEQ,TYPE,Xlen(2-3),Xlen chksum | packet's data | chksum,EOL,HS |
;+----------------------------------------+---------------+---------------+
; where Xlen is 2 byte (Long) or 3 byte (Extra Long) count of bytes to follow.

RPACK    PROC    FAR
    mov    rtemp,si        ; save pkt structure address
    xor    ax,ax            ; get a zero
    mov    debflg,al        ; say debugging display not setup
    mov    fairflg,ax        ; set fairness flag
    mov    badpflag,al        ; bad parity flag, clear it
    mov    prevchar,al        ; clear previous recv'd char area
    mov    [si].pktype,'T'        ; assume 'T' type packet (timeout)
    mov    bx,[si].datadr        ; caller's data buffer
    mov    pktptr,bx        ; debug buffer pointer for new stuff
    mov    [si].datlen,ax        ; init to empty buffer
    mov    cx,[si].datsize        ; length of that buffer, for debugger
    mov    deblen,cx
    mov    word ptr [bx],ax    ; clear storage areas (asciiz)
    mov    word ptr prolog,ax
    mov    word ptr epilog,ax
    mov    cl,trans.stime        ; time to wait for start of packet
    mov    timeval,cl        ; local timer value, seconds
    mov    status,stat_suc        ; assume success
    mov    rpkcnt,ax        ; number of bytes rcvd in packet
    push    bx
    mov    parmsk,0ffh        ; parity mask, assume 8 bit data
    mov    bx,portval
    mov    ax,[bx].flowc        ; flow control
    mov    flowon,al        ; xon or null
    xor    ax,ax
    cmp    [bx].parflg,parnon    ; parity is none?
    pop    bx
    je    rpack0a            ; e = none
    mov    parmsk,7fh        ; else strip parity (8th) bit
    jmp    rpack0a

                    ; get here with unexpected char
rpack0:    test    status,stat_tmo        ; timeout get us here?
    jnz    rpack0f            ; nz = yes, no new char to record
    xor    ah,ah
    mov    [bx],ax            ; store 8 bit char in buffer
    inc    bx            ; advance buffer pointer
rpack0f:push    ax            ; save around this work
    cmp    debflg,0        ; started debugging display yet?
    jne    rpack0d            ; ne = yes
    call    rcvdeb            ; setup receive debug display
rpack0d:call    deblin            ; debug, show chars received thus far
    mov    bx,rtemp        ; pktinfo address
    mov    [bx].datlen,0        ; say no data yet
    mov    [bx].seqnum,0ffh    ; illegal value
    mov    [bx].pktype,0        ; illegal value
    mov    ax,[bx].datsize     ; length of that buffer, for debugger
    mov    deblen,ax
    mov    bx,[bx].datadr        ; data field address, reuse for prolog
    mov    pktptr,bx        ; debug buffer pointer for new stuff
    xor    ax,ax
    mov    word ptr [bx],ax     ; clear the data field
    mov    word ptr prolog,ax    ; clear prolog field
    mov    word ptr epilog,ax    ; clear epilog field
    mov    rpkcnt,ax        ; count of chars
    pop    ax            ; recover unexpected char
    test    status,stat_int        ; interrupted?
    jz    rpack0e            ; z = no
    jmp    rpack60            ; yes, exit now
rpack0e:mov    status,stat_suc        ; assume success
    and    al,7fh            ; strip high bit
    cmp    al,trans.rsoh        ; was unexpected char the SOH?
    je    rpack1            ; e = yes, get LEN char

rpack0a:call    inchr            ; get a character. SOH
    jnc    rpack0b            ; nc = got one
                ; c=failure (eol, timeout, user intervention)
    test    status,stat_eol        ; hit eol from prev packet?
    jnz    rpack0            ; nz = yes, restart
    jmp    rpack60            ; timeout or user intervention

rpack0b:mov    ah,al            ; copy the char
    and    ah,7fh            ; strip any parity bit, regardless
    cmp    ah,trans.rsoh        ; start of header char?
    je    rpack0c            ; e = yes, SOH
    jmp    rpack0            ; ne = no, go until it is
rpack0c:xor    ah,ah            ; clear the terminator byte
    mov    [bx],ax            ; store 8 bit char in buffer
    inc    bx            ; advance buffer pointer
rpack1:    mov    timeval,1        ; reduce local timer value to 1 second
    call    inchr            ; get a character. LEN
    jc    rpack1a            ; failure
    mov    [bx],al            ; store LEN in buffer
    and    al,7fh            ; strip any parity bit
    cmp    al,trans.rsoh        ; start of header char?
    jne    rpack1b            ; ne = no
rpack1a:jmp    rpack0            ; yes, start over (common jmp point)
rpack1b:inc    bx
    mov    chksum,ax        ; start the checksum
    sub    al,20h            ; unchar(LEN) to binary
    jnc    rpack1e            ; nc = legal (printable)
    mov    status,stat_ptl        ; set bad length status
    jmp    rpack40            ; and quit
rpack1e:mov    si,rtemp
    mov    [si].datlen,ax        ; save the data count (byte)
    call    inchr            ; get a character. SEQ
    jc    rpack1a            ; c = failure
    mov    [bx],al            ; store SEQ in buffer
    inc    bx
    and    al,7fh            ; strip any parity bit
    cmp    al,trans.rsoh        ; SOH?
    je    rpack1a            ; e = yes, then go start over
    add    chksum,ax
    sub    al,' '            ; get the real packet number
    jnc    rpack1f            ; nc = no overflow
    mov    status,stat_ptl        ; say bad status
    jmp    rpack40            ; and exit now
rpack1f:mov    si,rtemp
    mov    [si].seqnum,al        ; save the packet number. SEQ
    call    inchr            ; get a character. TYPE
    jc    rpack1a            ; c = failure
    mov    [bx],al            ; store TYPE in buffer
    inc    bx
    and    al,7fh            ; strip any parity bit
    cmp    al,trans.rsoh        ; SOH?
    je    rpack1a            ; e = yes, then go start over
    mov    [si].pktype,al        ; save the message type
    add    chksum,ax        ; add it to the checksum
    call    parchk            ; check parity on protocol characters
    call    getlen        ; get complicated data length (reg, lp, elp)
                ; into [si].datlen and kind into byte lentyp. carry set if error
    jnc    rpack1c            ; nc = packet is ok so far
    jmp    rpack40            ; failure
rpack1c:
; Start of change.
; Now determine block check type for this packet.  Here we violate the layered
; nature of the protocol by inspecting the packet type in order to detect when
; the two sides get out of sync.  Two heuristics allow us to resync here:
;   a. I and S packets always has a type 1 checksum.
;   b. A NAK never contains data, so its block check type is seqnum1.
    mov    si,rtemp        ; pktinfo address
    mov    ax,[si].datlen        ; length of packet information
    mov    cl,[si].pktype        ; packet type byte itself
    cmp    cl,'S'            ; "S" packet?
    jne    rpk0            ; ne = no
    mov    trans.chklen,1        ; S packets use one byte checksums
    jmp    short rpk3
rpk0:    cmp    cl,'I'            ; I packets are like S packets
    jne    rpk1
    mov    trans.chklen,1        ; I packets use one byte checksums
    jmp    short rpk3
rpk1:    cmp    cl,'N'            ; NAK?
    jne    rpk3            ; ne = no
    cmp    ax,1            ; NAK, get length of data + chklen
    jb    rpk1a            ; b = impossible length
    cmp    ax,3            ; longest NAK (3 char checksum)
    jbe    rpk2            ; be = possible
rpk1a:    or    status,stat_ptl        ; status = bad length
    jmp    rpack40            ; return on impossible length
rpk2:    mov    trans.chklen,al        ; remainder must be checksum type for NAK
rpk3:    sub    al,trans.chklen        ; minus checksum length, for all pkts
    sbb    ah,0            ; propagate borrow
    mov    [si].datlen,ax        ; store apparent length of data field
; End of change.
; now, for long packets we start the real data (after the extended byte
; count 3 or 4 bytes) at offset data and thus the checksumming starts
; such packets a few bytes earlier.
    push    si
    push    di
    mov    si,rtemp        ; pktinfo address
    mov    si,[si].datadr        ; data field address
    mov    di,offset prolog    ; where to store
    mov    cx,4            ; number of bytes to move, reg pkts
    cmp    lentyp,0        ; long packets?
    jne    rpk5            ; ne = no
    mov    cx,7            ; seven bytes mark...type, xl,xl,xlchk
    jmp    short rpk7
rpk5:    cmp    lentyp,1        ; extra long packets?
    jne    rpk7            ; ne = no
    mov    cx,8            ; extra long packets
rpk7:    push    es            ; save es
    push    ds
    pop    es            ; set es to data segment
    cld                ; move forward
    rep    movsb            ; move the protocol header, cx times
    mov    byte ptr [di],0     ; null terminator
    pop    es
    pop    di
    pop    si

    mov    si,rtemp
    push    si
    mov    si,[si].datadr
    mov    word ptr [si],0        ; clear data field for debugging
    pop    si
    mov    dx,[si].datlen        ; length of data field, excl LP header
    mov    chrcnt,dx
    cmp    dx,[si].datsize        ; material longer than data buffer?
    ja    rpk8b            ; a = yes, give up
    mov    dx,trans.rlong        ; longest packet we should receive
    sub    dl,trans.chklen        ; minus checksum length
    sbb    dh,0            ; propagate borrow
    cmp    dx,chrcnt        ; is data too long?
    jae    rpk8c            ; ae = not too big
    or    status,stat_ptl        ; failure status, packet too long
rpk8b:    jmp    rpack40            ; too big, quit now
rpk8c:    mov    bx,[si].datadr        ; point to the data buffer
    mov    pktptr,bx        ; start of buffer for debugging
    mov    dx,[si].datsize     ; length of that buffer, for debugger
    mov    deblen,dx        ; keep here
    mov    word ptr [bx],0        ; clear start of that buffer
                    ; get DATA field characters
rpack2:    cmp    chrcnt,0        ; any chars expected?
    jle    rpack3            ; le = no, go do checksum
    call    inchr            ; get a character into al. DATA
    jc    rpak2c            ; c = Control-C, timeout, eol
    mov    [bx],ax            ; put char into buffer, with null
    inc    bx            ; point to next free slot
    cmp    al,trans.rsoh        ; start of header char?
    jne    rpak2b            ; ne = no
    jmp    rpack7            ; yes, then go start over
rpak2b:    add    chksum,ax        ; inchr clears AH
    dec    chrcnt            ; one less char expected
    jmp    short rpack2        ; get another data character
rpak2c:    jmp    rpack40            ; Control-C, timeout, EOL

rpack3:    mov    byte ptr[bx],0        ; terminate data field
    and    chksum,0fffh    ; keep only lower 12 bits of current checksum
    call    inchr            ; start Checksum bytes
    jc    rpack3b            ; failed
    mov    ah,al
    and    ah,7fh            ; strip high bit
    cmp    ah,trans.rsoh        ; start of header char?
    jne    rpack3a            ; ne = no
    jmp    rpack7            ; yes, then go start over
rpack3a:mov    bx,offset epilog    ; record debugging in epilog buffer
    mov    pktptr,bx        ; start of that buffer, for debug
    mov    deblen,length epilog    ; length of that buffer
    xor    ah,ah
    mov    [bx],ax            ; store checksum
    inc    bx            ; point at next slot
    sub    al,' '            ; unchar() back to binary
    mov    cx,chksum        ; current checksum
    cmp    trans.chklen,2        ; which checksum length is in use?
    je    rpack5            ; e = Two character checksum
    jg    rpack4            ; g = Three char CRC, else one char
    shl    cx,1            ; put two highest digits of al into ah
    shl    cx,1
    and    ch,3            ; want just those two bits
    shr    cl,1            ; put al back in place
    shr    cl,1
    add    cl,ch            ;add two high bits to earlier checksum
    and    cl,03fh            ; chop to lower 6 bits (mod 64)
    cmp    cl,al        ; computed vs received checksum byte (binary)
    je    rpack3b            ; e = equal, so finish up
    or    status,stat_chk        ; say checksum failure
rpack3b:jmp    rpack40

rpack7:    jmp    rpack0            ; for the jump out of range

rpack4:    mov    tmp,al            ; save value from packet here
    push    bx            ; three character CRC
    mov    cx,[bx-1]        ; save checksum char and next
    mov    temp,cx
    mov    bx,offset prolog+1    ; where data for CRC is, skipping SOH
    xor    dx,dx            ; initial CRC is zero
    call    crcclc            ; calculate the CRC and put into CX
    mov    bx,rtemp
    mov    bx,[bx].datadr        ; data field address
    mov    dx,cx            ; previous CRC
    call    crcclc            ; final CRC is in CX
    pop    bx
    mov    ax,temp
    mov    [bx-1],ax        ; restore char pair from above
    mov    ah,ch            ; cx = 16 bit binary CRC of rcv'd data
    and    ah,0f0h            ; manipulate it here
    shr    ah,1
    shr    ah,1            ; get 4 highest bits
    shr    ah,1
    shr    ah,1            ; shift right 4 bits
    cmp    ah,tmp            ; is what we got == calculated?
    je    rpack4a            ; e = yes
    or    status,stat_chk        ; checksum failure
rpack4a:call    inchr            ; get next character of checksum
    jc    rpack40            ; c = failed
    mov    [bx],ax            ; put into buffer for debug
    inc    bx
    and    al,7fh            ; strip high bit
    cmp    al,trans.rsoh        ; SOH?
    je    rpack7            ; e = yes
    sub    al,' '            ; get back real value
rpack5:    mov    tmp,al            ; save here for now
    push    cx            ; two character checksum
    and    cx,0FC0H        ; get bits 6-11
    mov    ax,cx
    mov    cl,6
    shr    ax,cl            ; shift bits
    pop    cx            ; get back the original
    cmp    al,tmp            ; equal?
    je    rpack5a            ; e = yes
    or    status,stat_chk        ; checksum failure
rpack5a:call    inchr            ; get last character of checksum
    jc    rpack40            ; c = failed
    mov    [bx],ax            ; put into buffer for debug
    inc    bx
    and    al,7fh            ; strip high bit
    cmp    al,trans.rsoh        ; SOH?
    je    rpack7            ; e = yes
    sub    al,' '            ; get back real value
    and    cx,003FH        ; get bits 0-5
    cmp    al,cl            ; do the last chars match?
    je    rpack40            ; e = yes
    or    status,stat_chk        ; say checksum failure

rpack40:mov    byte ptr [bx],0        ; terminate current buffer
    test    status,stat_tmo        ; timeout?
    jz    rpack41            ; z = no
    jmp    rpack60            ; nz = yes
rpack41:test    status,stat_eol        ; premature eol?
    jz    rpack42            ; z = no
    or    status,stat_bad        ; say bad packet overall
    mov    bx,offset epilog     ; start debugging with epilog buffer
    mov    pktptr,bx
    mov    deblen,length epilog    ; length of that buffer
    mov    [bx],ax            ; put it into buffer for debug
    inc    bx
    jmp    short rpack45        ; now try for handshake

rpack42:push    bx
    sub    bx,pktptr    ; next char slot - starting address, debugging
    cmp    bx,deblen        ; at length of active debug buffer?
    pop    bx
    jb    rpack43            ; b = no
    call    rdebug            ; yes, dump what we have
    mov    bx,offset epilog    ; and start again with epilog buffer
    mov    pktptr,bx
    mov    deblen,length epilog    ; length of that buffer
rpack43:call    inchr            ; get eol char
    jnc    rpack43a        ; nc = got regular character
    test    status,stat_int        ; interrupted?
    jnz    rpack60            ; nz = yes
    test    status,stat_tmo        ; timeout?
    jnz    rpack43b        ; nz = yes, no char
rpack43a:mov    [bx],ax            ; put into buffer for debug
    inc    bx
rpack43b:and    status,not stat_tmo    ; ignore timeouts on EOL character
    test    status,stat_eol        ; eol char?
    jnz    rpack44            ; nz = yes, got the EOL char
    and    al,7fh            ; strip high bit
    cmp    al,trans.rsoh        ; soh already?
    jne    rpack44            ; ne = no
    jmp    rpack0            ; yes, do debug display and start over

rpack44:and    status,not stat_eol     ; desired eol is not an error
rpack45:push    bx            ; test for line turn char
    mov    bx,portval        ;   if doing handshaking
    mov    ah,[bx].hands        ; get desired handshake char
    cmp    [bx].hndflg,0        ; doing half duplex handshaking?
    pop    bx
    je    rpack60            ; e = no
    mov    tmp,ah            ; keep it here
    call    inchr            ; get handshake char
    jnc    rpack45a        ; nc = regular character
    test    status,stat_eol        ; EOL char?
    jnz    rpack45a        ; nz = yes
    jmp    short rpack48        ; timeout or user intervention
rpack45a:and    status,not stat_eol    ; ignore unexpected eol status here
    mov    si,rtemp
    mov    cx,[si].datsize        ; length of receive buffer
    add    cx,[si].datadr        ; starting address of the buffer
    cmp    bx,cx            ; filled buffer yet?
    jae    rpack46            ; ae = yes
    mov    [bx],ax            ; put into buffer for debug
    inc    bx
rpack46:and    al,7fh            ; strip high bit
    cmp    al,trans.rsoh        ; soh already?
    jne    rpack47            ; ne = no
    jmp    rpack0            ; yes, do debug display and start over
rpack47:cmp    al,tmp            ; compare received char with handshake
    jne    rpack45        ; ne = not handshake, try again til timeout
rpack48:and    status,not stat_tmo    ; ignore timeouts on handshake char

                    ; Perform logging and debugging now
rpack60:call    rdebug            ; helper procedure
    call    chkcon            ; check console for user interrupt
    test    status,stat_tmo        ; did a timeout get us here?
    jz    rpack61            ; z = no
    mov    si,rtemp
    mov    [si].pktype,'T'        ; yes, say 'T' type packet (timeout)
    test    flags.capflg,logpkt     ; log packets?
    jz    rpack61            ; z = no
    mov    dx,offset msgtmo     ; say timeout in log
    call    captdol
rpack61:test    status,not stat_tmo    ; crunched packet?
    jz    rpack62            ; z = no
    test    flags.capflg,logpkt     ; log packets?
    jz    rpack62            ; z = no
    mov    dx,offset msgbad     ; say crunched pkt in log
    call    captdol

rpack62:mov    ax,rpkcnt        ; number of bytes received in packet
    add    fsta.prbyte,ax        ; file total received bytes
    adc    fsta.prbyte+2,0        ; propagate carry to high word
    add    ssta.prbyte,ax        ; session total received bytes
    adc    ssta.prbyte+2,0        ; propagate carry to high word
    add    fsta.prpkt,1        ; file received packet
    adc    fsta.prpkt+2,0        ;  ripple carry
    add    ssta.prpkt,1        ; session received packet
    adc    ssta.prpkt+2,0
    mov    si,rtemp        ; restore pkt pointer
    mov    ah,[si].pktype        ; return packet type in ah
        cmp    ah,prvtyp        ; packet type same as last sent?
    jne    rpack64            ; ne = no
    test    flags.capflg,logpkt     ; log packets?
    jz    rpack63            ; z = no
    mov    dx,offset msgecho     ; say echo in log
    call    captdol
rpack63:test    status,stat_int        ; interrupted?
    jnz    rpack64            ; nz = yes, exit now
    jmp    rpack            ; discard echoed packet and read again

rpack64:cmp    status,stat_suc        ; successful so far?
    jne    rpack65            ; ne = no
    cmp    chkparflg,0        ; do parity checking?
    je    rpack64a        ; e = no
    mov    chkparflg,0        ; do only once
    test    badpflag,80h        ; get parity error flagging bit
    jz    rpack64a        ; z = no parity error
    mov    bx,portval
    mov    cl,badpflag        ; get new parity plus flagging bit
    and    cl,7fh            ; strip flagging bit
    mov    [bx].parflg,cl        ; force new parity
rpack64a:clc                ; carry clear for success
    ret
rpack65:stc                ; carry set for failure
    ret                ; failure exit
RPACK    ENDP

rdebug    proc    near
    cmp    debflg,0        ; setup debug display yet?
    jne    rdebu1            ; ne = yes
    call    rcvdeb            ; setup display
rdebu1:    test    flags.debug,logpkt    ; in debug mode?
    jnz    rdebu2            ; nz = yes
    test    flags.capflg,logpkt    ; log packets?
    jz    rdebu5            ; z = no
rdebu2:    mov    dx,offset prolog    ; do prolog section
    mov    pktptr,dx
    mov    bx,dx
    call    strlen1            ; get length of prolog section
    jcxz    rdebu3            ; z = empty, try next section
    add    bx,cx            ; point off end
    call    deblin            ; do debug display
    mov    prolog,0        ; clear prolog field
rdebu3:    mov    bx,rtemp        ; do data section
    mov    bx,[bx].datadr
    mov    dx,bx
    mov    pktptr,bx
    call    strlen1            ; get length of data section
    jcxz    rdebu4            ; z = empty, try next section
    add    bx,cx            ; point off end
    call    deblin            ; do debug display
rdebu4:    mov    bx,offset epilog    ; do epilog section
    mov    pktptr,bx
    mov    dx,bx
    call    strlen1            ; get length of epilog section
    jcxz    rdebu5            ; z = empty
    add    bx,cx            ; point off end
    call    deblin            ; do debug display
    mov    epilog,0        ; clear epilog field
rdebu5:    test    flags.debug,logpkt    ; In debug mode?
    jnz    rdebu6            ; nz = yes
    test    flags.capflg,logpkt    ; log packets?
    jz    rdebu7            ; z = no
rdebu6:    cmp    linecnt,0        ; anything on current line?
    je    rdebu7            ; e = no
    mov    dx,offset crlf        ; finish line with cr/lf
    call    captdol            ;  to log file
rdebu7:    ret
rdebug    endp

; Check Console (keyboard). Return carry setif "action" chars: cr for forced
; timeout, Control-E for force out Error packet, Control-C for quit work now.
; Return carry clear on Control-X and Control-Z as these are acted upon by
; higher layers. Consume and ignore anything else.
chkcon:    call    isdev1        ; is stdin a device and not a disk file?
    jnc    chkco5        ; nc = no, a disk file so do not read here
    mov    dl,0ffh
    mov    ah,dconio        ; read console
    int    dos
    jz    chkco5            ; z = nothing there
    and    al,1fh            ; make char a control code
    cmp    al,CR            ; carriage return?
    je    chkco3            ; e = yes, simulate timeout
    cmp    al,'C'-40h        ; Control-C?
    je    chkco1            ; e = yes
    cmp    al,'E'-40h        ; Control-E?
    je    chkco1            ; e = yes
    cmp    al,'X'-40h        ; Control-X?
    je    chkco4            ; e = yes
    cmp    al,'Z'-40h        ; Control-Z?
    je    chkco4        ; record it, take no immmediate action here
    cmp    al,'Q'-40h        ; Control-Q?
    je    chkco6            ; e = yes
    or    al,al            ; scan code being returned?
    jnz    chkco5            ; nz = no, ignore ascii char
    mov    ah,dconio        ; read and discard second byte
    mov    dl,0ffh
    int    dos
    jmp    short chkco5        ; else unknown, ignore
chkco1:    or    al,40h            ; make Control-C-E printable
    mov    flags.cxzflg,al        ; remember what we saw
chkco2:    or    status,stat_int        ; interrupted
    stc
    ret                ; act now
chkco3:    or    status,stat_tmo        ; CR simulates timeout
    stc
    ret                ; act now
chkco4:    or    al,40h            ; make control-X-Z printable
    mov    flags.cxzflg,al        ; put into flags
    clc                ; do not act on them here
    ret
chkco5:    cmp    flags.cxzflg,'C'    ; control-C intercepted elsewhere?
    je    chkco2            ; e = yes
    clc                ; else say no immediate action needed
    ret
chkco6:    xchg    ah,al            ; put Control-Q in AH for transmission
    call    spkout            ; send it now
    jmp    short chkco5

getlen    proc    near        ; compute packet length for short & long types
                ; returns length in [si].datlen and
                ; length type (0, 1, 3) in local byte lentyp
                ; returns length of  data + checksum
    mov     si,rtemp
    mov    ax,[si].datlen    ; get LEN byte value
    and    ax,7fh        ; clear unused high byte and parity bit

    cmp    al,3        ; regular packet has 3 or larger here
    jb    getln1        ; b = long packet
    sub    [si].datlen,2    ; minus SEQ and TYPE = DATA + CHKSUM
    mov    lentyp,3    ; store assumed length type (3 = regular)
    clc            ; clear carry for success
    ret

getln1:    push    cx        ; counter for number of length bytes
    mov    lentyp,0    ; store assumed length type 0 (long)
    mov    cx,2        ; two base-95 digits
    or    al,al        ; is this a type 0 (long packet)?
    jz    getln2        ; z = yes, go find & check length data
    mov    lentyp,1    ; store length type (1 = extra long)
    inc    cx        ; three base 95 digits
    cmp    al,1        ; is this a type 1 (extra long packet)?
    je    getln2        ; e = yes, go find & check length data
    pop    cx
    or    status,stat_ptl    ; say packet too long (an unknown len code)
    stc            ; set carry bit to say error
    ret
getln2:                ; chk header chksum and recover binary length
    push    dx        ; save working reg
    xor    ax,ax        ; clear length accumulator, low part
    mov    [si].datlen,ax    ; clear final length too
getln3:    xor    dx,dx        ; ditto, high part
    mov    ax,[si].datlen    ; length to date
    mul    ninefive    ; multiply accumulation (in ax) by 95
    mov    [si].datlen,ax    ; save results
    push    cx
    call    inchr        ; read another serial port char into al
    pop    cx
    jc    getln4        ; c = failure
    xor    ah,ah
    mov    [bx],al        ; store in buffer
    inc    bx
    add    chksum,ax
    sub    al,20h        ; subtract space, apply unchar()
    mov    si,rtemp
    add    [si].datlen,ax    ; add to overall length count
    loop    getln3        ; cx preset earlier for type 0 or type 1
    mov    dx,chksum    ; get running checksum
    shl    dx,1        ; get two high order bits into dh
    shl    dx,1
    and    dh,3        ; want just these two bits
    shr    dl,1        ; put low order part back
    shr    dl,1
    add    dl,dh        ; add low order byte to two high order bits
    and    dl,03fh        ; chop to lower 6 bits (mod 64)
    add    dl,20h        ; apply tochar()
    push    dx
    call    inchr        ; read another serial port char
    pop    dx
    jc    getln4        ; c = failure
    xor    ah,ah
    mov    [bx],al        ; store in buf for debug
    inc    bx
    add    chksum,ax
    cmp    dl,al        ; our vs their checksum, same?
    je    getln5        ; e = checksums match, success
getln4:    or    status,stat_chk    ; checksum failure
    pop    dx        ; unsave regs (preserves flags)
    pop    cx
    stc            ; else return carry set for error
    ret
getln5:    pop    dx        ; unsave regs (preserves flags)
    pop    cx
    clc            ; clear carry (say success)
    ret
getlen    endp

; Get char from serial port into al, with timeout and console check.
; Return carry set if timeout or console char or EOL seen,
; return carry clear and char in AL for other characters.
; Sets status of stat_eol if EOL seen.
; Fairflg allows occassional reads from console before looking at serial port.
inchr    proc    near
    mov    timeit,0    ; reset timeout flag (do each char separately)
    push    bx        ; save a reg
    cmp    fairflg,maxpack/4 ; look at console first every now and then
    jbe    inchr1        ; be = not console's turn yet
    mov    fairflg,0    ; reset fairness flag for next time
    call    chkcon        ; check console
    jnc    inchr1        ; nc = nothing to interrupt us
    pop    bx        ; clean stack
    ret            ; return failure for interruption

inchr1:    call    prtchr1        ; read a serial port character
    jc    inchr2        ; c = nothing there
    pop    bx        ; here with char in al from port
    mov    ah,al        ; copy char to temp place AH
    and    ah,7fh        ; strip parity bit from work copy
    and    al,parmsk    ; apply 7/8 bit parity mask
    or    ah,ah        ; null char?
    jz    inchr        ; ignore the null, read another char
    cmp    ah,del        ; ascii del byte?
    je    inchr        ; e = yes, ignore it too
    inc    rpkcnt        ; count received byte
    cmp    al,trans.rign    ; char in al to be ignored?
    je    inchr        ; e = yes, do so
    cmp    ah,'C'-40h    ; Control-C from comms line?
    jne    inchr6        ; ne = no
    cmp    ah,prevchar    ; was previous char also Control-C?
    jne    inchr6        ; ne = no
    cmp    ah,trans.rsoh    ; could this also be an SOH?
    je    inchr6        ; e = yes, do not exit
    cmp    ah,trans.reol    ; could this also be an EOL?
    je    inchr6        ; e = yes
    test    denyflg,finflg    ; is FIN enabled?
    jnz    inchr6        ; nz = no, ignore server exit cmd
    mov    flags.cxzflg,'C'; set Control-C flag
    or    status,stat_int+stat_eol ; say interrupted and End of Line
    mov    al,ah        ; use non-parity version
    xor    ah,ah        ; always return with high byte clear
    stc            ; exit failure
    ret
inchr6:    mov    prevchar,ah    ; remember current as previous char
    cmp    ah,trans.reol    ; eol char we want?
    je    inchr7        ; e = yes, ret with carry set
    xor    ah,ah        ; always return with high byte clear
    clc            ; char is in al
    ret
inchr7:    or    status,stat_eol    ; set status appropriately
    mov    al,ah        ; use non-parity version
    xor    ah,ah        ; always return with high byte clear
    stc            ; set carry to say eol seen
    ret            ; and return qualified failure

inchr2:    call    chkcon        ; check console
    jnc    inchr2a        ; nc = nothing to interrupt us
    pop    bx        ; clean stack
    ret            ; return failure for interruption

inchr2a:cmp    flags.timflg,0    ; are timeouts turned off?
    je    inchr1        ; e = yes, just check for more input
    cmp    trans.stime,0    ; doing time outs?
    jne    inchr2b        ; ne = yes
    jmp    inchr1        ; go check for more input
inchr2b:push    cx        ; save regs
    push    dx        ; Stolen from Script code
    cmp    timeit,0    ; have we gotten time of day for first fail?
    jne    inchr4        ; ne = yes, just compare times
    mov    ah,gettim    ; get DOS time of day
    int    dos        ; ch = hh, cl = mm, dh = ss, dl = 0.01 sec
    xchg    ch,cl        ; get ordering of low byte = hours, etc
    mov    word ptr rptim,cx ; hours and minutes
    xchg    dh,dl
    mov    word ptr rptim+2,dx ; seconds and fraction
    mov    bl,timeval    ; our desired timeout interval (seconds)
    xor    bh,bh        ; one byte's worth
    mov    temp,bx        ; work area
    mov    bx,2           ; start with seconds field
inchr3: mov    ax,temp        ; desired timeout interval, working copy
    add    al,rptim[bx]    ; add current tod digit interval
    adc    ah,0
    xor    dx,dx        ; clear high order part thereof
    div    sixzero        ; compute number of minutes or hours
    mov    temp,ax        ; quotient, for next time around
    mov    rptim[bx],dl    ; put normalized remainder in timeout tod
    dec    bx        ; look at next higher order time field
    or    bx,bx        ; done all time fields?
    jge    inchr3        ; ge = no
    cmp    rptim[0],24    ; normalize hours
    jl    inchr3a        ; l = not 24 hours or greater
    sub    rptim[0],24    ; discard part over 24 hours
inchr3a:mov    timeit,1    ; say have tod of timeout

inchr4:    mov    ah,gettim    ; compare present tod versus timeout tod
    int    dos        ; get the time of day
    sub    ch,rptim    ; hours difference, ch = (now - timeout)
    je    inchr4b        ; e = same, check mmss.s
    jl    inchr4d        ; l = we are early
    cmp    ch,12        ; hours difference, large or small?
    jge    inchr4d        ; ge = we are early
    jl    inchr4c        ; l = we are late, say timeout
inchr4b:cmp    cl,rptim+1    ; minutes, hours match
    jb    inchr4d        ; b = we are early
    ja    inchr4c        ; a = we are late
    cmp    dh,rptim+2    ; seconds, hours and minutes match
    jb    inchr4d        ; b = we are early
    ja    inchr4c        ; a = we are late
    cmp    dl,rptim+3    ; hundredths of seconds, hhmmss match
    jbe    inchr4d        ; be = we are early
inchr4c:or    status,stat_tmo    ; say timeout
;    cmp    flowon,0    ; using xon/xoff flow control?
;    je    inchr4e        ; e = no
;    mov    ah,flowon    ; send host an xon in case it's stuck
;    call    outchr1        ;   with a stray xoff not from us
inchr4e:pop    dx
    pop    cx
    pop    bx
    stc            ; set carry bit
    ret            ; failure
inchr4d:pop    dx
    pop    cx
    jmp    inchr1        ; not timed out yet
inchr    endp


; sleep for the # of seconds in al
; Preserve all regs. Added console input forced timeout 21 March 1987 [jrd]
sleep    proc    far
    push    ax
    push    cx
    push    dx
    push    ax        ; save argument
    mov    ah,gettim    ; DOS tod (ch=hh, cl=mm, dh=ss, dl=.s)
    int    dos        ; get current time
    pop    ax        ; restore desired # of seconds
    add    dh,al        ; add # of seconds
sleep1:    cmp    dh,60        ; too big for seconds?
    jb    sleep2        ; no, keep going
    sub    dh,60        ; yes, subtract a minute's overflow
    inc    cl        ; and add one to minutes field
    cmp    cl,60        ; did minutes overflow?
    jb    sleep1        ; no, check seconds again
    sub    cl,60        ; else take away an hour's overflow
    inc    ch        ; add it back in hours field
    jmp    short sleep1    ; and keep checking
sleep2:    mov    time,cx        ; store desired ending time,  hh,mm
    mov    time+2,dx    ; ss, .s
sleep3:    call    chkcon        ; check console for user timeout override
    jc    short sleep5    ; c = have override
    mov    ah,gettim    ; get time
    int    dos        ; from dos
    sub    ch,byte ptr time+1 ; hours difference, ch = (now - timeout)
    je    sleep4        ; e = hours match, check mmss.s
    jl    sleep3        ; l = we are early
    cmp    ch,12        ; hours difference, large or small?
    jge    sleep3        ; ge = we are early
    jl    sleep5        ; l = we are late, exit now
sleep4:    cmp    cl,byte ptr time ; check minutes, hours match
    jb    sleep3        ; b = we are early
    ja    sleep5        ; a = over limit, time to exit
    cmp    dx,time+2    ; check seconds and fraction, hhmm match
    jb    sleep3        ; b = we are early
sleep5:    pop    dx
    pop    cx
    pop    ax
    ret
sleep    endp
                ; Packet Debug display routines
rcvdeb:    test    flags.debug,logpkt ; In debug mode?
    jnz    rcvde1        ; nz = yes
    test    flags.capflg,logpkt ; log packets?
    jnz    rcvde1        ; nz = yes
    ret            ; no
rcvde1:    mov    debflg,'R'    ; say receiving
    jmp    short deb1

snddeb:    test    flags.debug,logpkt ; In debug mode?
    jnz    sndde1        ; nz = yes
    test    flags.capflg,logpkt ; log packets?
    jnz    sndde1        ; yes
    ret            ; no
sndde1:    mov    debflg,'S'    ; say sending

deb1:    push    ax        ; Debug. Packet display
    push    bx
    push    cx        ; save some regs
    push    dx
    push    di
    test    flags.debug,logpkt    ; is debug active (vs just logging)?
    jz    deb1d        ; z = no, just logging
    cmp    fmtdsp,0    ; non-formatted display?
    je    deb1d        ; e = yes, skip extra line clearing
    cmp    debflg,'R'    ; receiving?
    je    deb1a        ; e = yes
    call    sppos1        ; spack: cursor position
    jmp    short deb1b
deb1a:    call    rppos1        ; rpack: cursor position
deb1b:    call    clearl1        ; clear the line
        mov    dx,offset crlf
        mov    ah,prstr    ; display
        int    dos
        call    clearl1        ; clear debug line and line beneath
    cmp    debflg,'R'    ; receiving?
    je    deb1c        ; e = yes
    call    sppos1        ; reposition cursor for spack:
    jmp    short deb1d
deb1c:    call    rppos1        ; reposition cursor for rpack:
deb1d:    mov    dx,offset spmes    ; spack: message
    cmp    debflg,'R'
    jne    deb2        ; ne = sending
    mov    dx,offset rpmes    ; rpack: message
deb2:    call    captdol        ; record dollar terminated string in Log file
    mov    linecnt,7    ; number of columns used so far
    pop    di
    pop    dx
    pop    cx
    pop    bx
    pop    ax
    ret

; Display/log packet chars processed so far.
; Displays chars from pktptr to bx-1, both are pointers.
; Enter with bx = offset of next new char. All registers preserved
deblin:    test    flags.debug,logpkt ; In debug mode?
    jnz    debln0        ; nz = yes
    test    flags.capflg,logpkt ; log packets?
    jnz    debln0        ; nz = yes
    ret            ; else    nothing to do
debln0:    push    cx
    push    dx
    push    di
    mov    di,pktptr    ; starting place for debug analysis
    mov    cx,bx        ; place for next new char
    sub    cx,di        ; minus where we start = number chars to do
    or    cx,cx
    jle    debln5        ; le = nothing to do
debln2:
    push    cx        ; save loop counter
    cmp    linecnt,70
         jb    debln3        ; b = not yet, get next data char
    mov    dx,offset crlf    ; break line with cr/lf
    call    captdol        ; and in log file
    mov    linecnt,0    ; setup for next line
debln3:    mov    dl,[di]        ; get char
    test    dl,80h        ; high bit set?
    jz    debln3b        ; z = no
    push    dx        ; save char in dl
    mov    dl,7eh        ; show tilde char for high bit set
    call    captchr        ; record in Log file
    inc    linecnt        ; count displayed column
    cmp    linecnt,70    ; exhausted line count yet?
    jb    debln3a        ; b = not yet
    mov    dx,offset crlf    ; break line with cr/lf
    call    captdol        ; and in log file
    mov    linecnt,0    ; setup for next line
debln3a:pop    dx
    and    dl,7fh        ; get lower seven bits here
debln3b:cmp    dl,' '        ; control char?
    jae    debln4        ; ae = no
    add    dl,40h        ; uncontrollify the char
    push    dx        ; save char in dl
    mov    dl,5eh        ; show caret before control code
    call    captchr        ; record in Log file
    inc    linecnt        ; count displayed column
    cmp    linecnt,70    ; exhausted line count yet?
    jb    debln3c        ; b = not yet
    mov    dx,offset crlf    ; break line with cr/lf
    call    captdol        ; and in log file
    mov    linecnt,0    ; setup for next line
debln3c:pop    dx        ; recover char in dl

debln4:    call    captchr        ; record char in dl in the log file
    inc    di        ; done with this char, point to next
    inc    linecnt        ; one more column used on screen
    pop    cx        ; recover loop counter
    loop    debln2        ; get next data char
debln5:    pop    di
    pop    dx
    pop    cx
    ret


captdol    proc    near        ; write dollar sign terminated string in dx
                ; to the capture file (Log file).
    push    ax        ; save regs
    push    si
    mov    si,dx        ; point to start of string
    cld
captdo1:lodsb            ; get a byte into al
    cmp    al,'$'        ; at the end yet?
    je    captdo3        ; e = yes
    or    al,al        ; asciiz?
    jz    captdo3        ; z = yes, this is also the end
    mov    dl,al
    test    flags.debug,logpkt ; debug display active?
    jz    captdo2        ; z = no
    mov    ah,conout
    int    dos        ; display char in dl
captdo2:test    flags.capflg,logpkt ; logging active?
    jz    captdo1        ; z = no
    mov    al,dl        ; where pktcpt wants it
    call    pktcpt1        ; record the char, pktcpt is in msster.asm
    jmp    short captdo1    ; repeat until dollar sign is encountered
captdo3:pop    si
    pop    ax
    ret
captdol    endp

captchr    proc    near        ; record char in dl into the Log file
    push    ax
    test    flags.debug,logpkt ; debug display active?
    jz    captch1        ; z = no
    mov    ah,conout
    int    dos        ; display char in dl
captch1:test    flags.capflg,logpkt ; logging active?
    jz    captch2        ; z = no
    mov    al,dl        ; where pktcpt wants it
    call    pktcpt1        ; record the char, pktcpt is in msster.asm
captch2:pop    ax
    ret
captchr    endp

parchk    proc    near            ; check parity of pkt prolog chars
    cmp    chkparflg,0        ; ok to check parity?
    jne    parchk0            ; ne = yes
    ret
parchk0:push    ax
    push    bx
    push    cx
    push    dx
    mov    bx,pktptr        ; where packet prolog is stored now
    mov    ax,[bx]            ; first two prolog chars
    or    ax,[bx+2]        ; next two
    test    ax,8080h        ; parity bit set?
    jz    parchk7            ; z = no
    mov    parmsk,7fh        ; set parity mask for 7 bits
    cmp    badpflag,0        ; said bad parity once this packet?
    jne    parchk7            ; ne = yes
    mov    cx,4            ; do all four protocol characters
    xor    dx,dx            ; dl=even parity cntr, dh=odd parity
parchk1:mov    al,[bx]            ; get a char
    inc    bx            ; point to next char
    or    al,al            ; sense parity
    jpo    parchk2            ; po = odd parity
    inc    dl            ; count even parity
    jmp    short parchk3
parchk2:inc    dh            ; count odd parity
parchk3:loop    parchk1            ; do all four chars
    cmp    dl,4            ; got four even parity chars?
    jne    parchk4            ; ne = no
    mov    badpflag,parevn+80h    ; say even parity and flagging bit
    mov    dx,offset msgbadpare    ; say using even parity
    jmp    short parchk6
parchk4:cmp    dh,4            ; got four odd parity chars?
    jne    parchk5            ; ne = no
    mov    badpflag,parodd+80h    ; say odd parity and flagging bit
    mov    dx,offset msgbadparo    ; say using odd parity
    jmp    short parchk6
parchk5:mov    badpflag,parmrk+80h    ; say mark parity and flagging bit
    mov    dx,offset msgbadparm    ; say using mark parity
parchk6:call    ermsg1
    call    captdol            ; write in log file too
parchk7:pop    dx
    pop    cx
    pop    bx
    pop    ax
    ret
parchk    endp

; General packet buffer structure manipulation routines. The packet buffers
; consist of a arrays of words, bufuse and buflist, an array of pktinfo
; structure packet descriptors, and a subdivided main buffer named "bufbuf".
; Each pktinfo member describes a packet by holding the address (offset within
; segment data) of the data field of a packet (datadr), the length of that
; field in bytes (datsize), the number of bytes currently occupying that field
; (datlen), the packet sequence number, an ack-done flag byte, and the number
; of retries of the packet.
; The data field is a portion of main buffer "bufbuf" with space for an extra
; null terminator byte required by the packet routines rpack and spack. It
; is sectioned into trans.windo buffers by procedure makebuf.
; Bufuse is an array holding an in-use flag for each pktinfo member; 0 means
; the member is free, otherwise a caller has allocated the member via getbuf.
; Buflist holds the address (offset in segment data) of each pktinfo member,
; for rapid list searching.
;
; Packet structures are constructed and initialized by procedure makebuf.
; Other procedures below access the members in various ways. Details of
; buffer construction should remain local to these routines.
; Generally, SI is used to point to a pktinfo member and AL holds a packet
; sequence number (0 - 63 binary). BX and CX are used for some status reports.
;
;  bufuse    buflist            pktlist (group of pktinfo members)
;  -------    -------        -------------------------------------------
; 0 for unused              | datadr,datlen,datsize,seqnum,ackdone,numtry |
;            pointers to ->+ datadr,datlen,datsize,seqnum,ackdone,numtry |
; 1 for used              | datadr,datlen,datsize,seqnum,ackdone,numtry |
;                        etc
;
; Construct new buffers, cleared, by subdividing main buffer "bufbuf"
; according to the number of windows (variable trans.windo). Makes these
; buffers available to getbuf and other manipulation routines. All regs
; are preserved.
makebuf    proc    far
    push    ax
    push    bx
    push    cx
    push    dx
    push    si
    mov    ax,maxpack        ; size of main packet buffer (bufbuf)
    mov    cl,trans.windo        ; number of window slots
    xor    ch,ch
    cmp    cx,1            ; 0 or 1 window slots = initial slot
    jae    makebu1            ; a = more than one, compute
    inc    cx
    jmp    short makebu2        ; save a division by one
makebu1:xor    dx,dx
    div    cx            ; size of windowed buffer to ax
makebu2:mov    dx,ax            ; keep buffer size in dx
    mov    bufnum,cx        ; number of buffers
    mov    ax,offset bufbuf    ; where buffers start
    mov    si,offset pktlist    ; where pktinfo group starts
    xor    bx,bx            ; index (words)
makebu3:mov    bufuse[bx],0        ; say buffer slot is not used yet
    mov    buflist[bx],si        ; pointer to pktinfo member
    mov    [si].datadr,ax        ; address of data field
    mov    [si].datsize,dx        ; data buffer size
    mov    [si].numtry,0        ; clear number tries for this buffer
    mov    [si].ackdone,0        ; not acked yet
    mov    [si].seqnum,0        ; a dummy sequence number
    add    si,size pktinfo        ; next pktinfo member
    add    ax,dx            ; pointer to next buffer
    inc    ax            ; leave space for null pointer
    add    bx,2            ; next buflist slot
    loop    makebu3            ; make another structure member
    mov    windused,0        ; no slots used yet
    pop    si
    pop    dx
    pop    cx
    pop    bx
    pop    ax
    ret
makebuf    endp

; Allocate a buffer. Return carry clear and SI pointing at fresh pktinfo
; structure, or if failure return carry set and all regs preserved.
getbuf    proc    far
    push    ax
    push    cx
    push    si
    xor    si,si            ; index
    mov    cx,bufnum        ; number of buffers
    jcxz    getbuf2            ; 0 means none, error
getbuf1:cmp    bufuse[si],0        ; is this slot in use?
    je    getbuf3            ; e = no, grab it
    add    si,2            ; try next slot
    loop    getbuf1            ; fall through on no free buffers
getbuf2:pop    si            ; get here if all are in use
    pop    cx
    pop    ax
    stc                ; return failure, si preserved
    ret

getbuf3:mov    bufuse[si],1        ; mark buffer as being in use
    inc    windused        ; one more slot in use
    mov    si,buflist[si]        ; address of pktinfo member
    mov    al,pktnum        ; next sequence number to be used
    mov    [si].seqnum,al        ; use it as sequence number
    mov    [si].datlen,0        ; no data in packet
    mov    [si].numtry,0        ; clear number tries for this buffer
    mov    [si].ackdone,0        ; not acked yet
    pop    cx            ; discard originally saved si
    pop    cx
    pop    ax
    clc                ; return success, buffer ptr in si
    ret
getbuf    endp

; Release all buffers (just marks them as free).

bufclr    proc    far
    push    ax
    push    cx
    push    di
    push    es
    push    ds
    pop    es
    mov    cx,maxwind        ; max number of buffers
    xor    ax,ax
    mov    di,offset bufuse    ; buffer in-use list
    cld
    rep    stosw            ; store zeros to clear the buffers
    mov    windused,0        ; number now used (none)
    pop    es
    pop    di
    pop    cx
    pop    ax
    ret
bufclr    endp

; Release buffer whose pktinfo pointer is in SI.
; Return carry clear if success, or carry set if failure.
bufrel    proc    far
    push    bx
    push    cx
    mov    cx,bufnum        ; number of buffers
    xor    bx,bx
bufrel1:cmp    buflist[bx],si        ; compare addresses, match?
    je    bufrel2            ; e = yes, found it
    add    bx,2
    loop    bufrel1
    pop    cx
    pop    bx
    stc                ; no such buffer
    ret
bufrel2:mov    bufuse[bx],0        ; say buffer is no longer in use
    dec    windused        ; one less used buffer
    pop    cx
    pop    bx
    clc
    ret
bufrel    endp

; Returns in BX the "packet pointer" for the buffer with the same seqnum as
; provided in AL. Returns carry set if no match found. Modifies BX.
pakptr    proc    far
    push    cx
    push    di
    mov    cx,bufnum        ; number of buffers
    xor    di,di            ; buffer index for tests
pakptr1:cmp    bufuse[di],0        ; is buffer vacant?
    je    pakptr2            ; e = yes, ignore
    mov    bx,buflist[di]        ; bx = address of pktinfo member
    cmp    al,[bx].seqnum        ; is this the desired sequence number?
    je    pakptr3            ; e = yes
pakptr2:add    di,2            ; next buffer index
    loop    pakptr1            ; do next test
    xor    bx,bx            ; say no pointer
    stc                ; set carry for failure
    pop    di
    pop    cx
    ret
pakptr3:clc                ; success, BX has buffer pointer
    pop    di
    pop    cx
    ret
pakptr    endp

; Returns in AH count of packets with a given sequence number supplied in AL
; and returns in BX the packet pointer of the last matching entry.
; Used to detect duplicated packets.
pakdup    proc    far
    push    cx
    push    dx
    push    di
    mov    cx,bufnum        ; number of buffers
    xor    di,di            ; buffer index for tests
    xor    ah,ah            ; number of pkts with seqnum in al
    mov    dx,-1            ; a bad pointer
pakdup1:cmp    bufuse[di],0        ; is buffer vacant?
    je    pakdup2            ; e = yes, ignore
    mov    bx,buflist[di]        ; bx = address of pktinfo member
    cmp    al,[bx].seqnum        ; is this the desired sequence number?
    jne    pakdup2            ; ne = no
    mov    dx,bx            ; yes, remember last pointer
    inc    ah            ; count a found packet
pakdup2:add    di,2            ; next buffer index
    loop    pakdup1            ; do next test
    mov    bx,dx            ; return last matching member's ptr
    pop    di
    pop    dx
    pop    cx
    or    ah,ah            ; any found?
    jz    pakdup3            ; z = no
    clc                ; return success
    ret
pakdup3:stc                ; return failure
    ret
pakdup    endp

; Find sequence number of first free window slot and return it in AL,
; Return carry set and al = windlow if window is full (no free slots).
firstfree proc    far
    mov    al,windlow        ; start looking at windlow
    mov    ah,al
    add    ah,trans.windo
    and    ah,3fh            ; ah = 1+top window seq number, mod 64
firstf1:push    bx
    call    pakptr            ; buffer in use for seqnum in AL?
    pop    bx
    jc    firstf2            ; c = no, seq number in not in use
    inc    al            ; next sequence number
    and    al,3fh            ; modulo 64
    cmp    al,ah            ; done all yet?
    jne    firstf1            ; ne = no, do more
    mov    al,windlow        ; a safety measure
    stc                ; carry set to say no free slots
    ret
firstf2:clc                ; success, al has first free seqnum
    ret
firstfree endp

; Check sequence number for lying in the current or previous window or
; outside either window.
; Enter with sequence number of received packet in [si].seqnum.
; Returns:
;    carry clear and cx =  0 if [si].seqnum is within the current window,
;    carry set   and cx = -1 if [si].seqnum is inside previous window,
;    carry set   and cx = +1 if [si].seqnum is outside any window.
chkwind    proc    far
    mov    ch,[si].seqnum        ; current packet sequence number
    mov    cl,trans.windo        ; number of window slots
    sub    ch,windlow        ; ch = distance from windlow
    jc    chkwin1            ; c = negative result
    cmp    ch,cl            ; span greater than # window slots?
    jb    chkwinz            ; b = no, in current window
    sub    ch,64            ; distance measured the other way
    neg    ch
    cmp    ch,cl            ; more than window size?
    ja    chkwinp            ; a = yes, outside any window
    jmp    short chkwinm        ; else in previous window

                    ; sequence number less than windlow
chkwin1:neg    ch            ; distance, positive, cl >= ch
    cmp    ch,cl            ; more than window size?
    ja    chkwin2            ; a = yes, maybe this window
    jmp    short chkwinm        ; no, in previous window

chkwin2:sub    ch,64            ; distance measured the other way
    neg    ch
    cmp    ch,cl            ; greater than window size?
    jb    chkwinz            ; b = no, in current window
                    ; else outside any window

chkwinp:mov    cx,1            ; outside any window
    stc                ; carry set for outside current window
    ret
chkwinz:xor    cx,cx            ; inside current window
    clc                ; carry clear, inside current window
    ret
chkwinm:mov    cx,-1            ; in previous window
    stc                ; carry set for outside current window
    ret
chkwind    endp

code1    ends
    end