Columbia Kermit/kermit.zip/pub/rt11/krtini.mac

Text File | 2020-01-01 | 31KB | 877 lines

    .title    KRTINI    Initialization and rarely used routines
    .ident    "V03.63"

; /63/    27-Sep-97  Billy Youdelman  V03.63

; /62/    27-Jul-93  Billy Youdelman  V03.62
;
;    dump FILLOG, as PRINTM now does this
;    provide for logfile errors
;    add current_block_pointer/size_of file to ^A stats display
;
;    check packet length in dskdmp, don't trap to 4 writing past end
;    of buffer due to line noise and/or modems retraining
;
;    major cleanup and maintenance update

; /BBS/     1-Dec-91  Billy Youdelman  V03.61
;
;    prompt set to KRT
;
;    call to an .INI file now tries INI, KRT then DK and finally
;    SY.  take file echo is disabled if krt.ini is found, then
;    enabled when the init file is closed (in readcmd, in krtcmd)
;    name of init file (if found) is displayed while reading same..
;
;    recdsp table fixed to call recvt1 (instead of senvt1 .. ) for
;    terminals >VT100
;
;    added warning message when 8-bit quoting is first forced on and
;    init stuff in fixchk so the need for 8-bit quoting is tested on
;    each xfr, thus one need not exit/restart Kermit to turn it off
;
;    packet length display in log files now accommodates four digit
;    numbers, as the max. packet is now 1024. bytes
;
;    kill normal packet stats display when logging to TT
;    reset parity found while set NONE warning before each transaction
;    fixed warning messages for unsupported/disabled long packets
;    dkname used to home, here it's init'd to physical DK at start-up

;    03-Jul-84  09:34:32  Brian Nelson
;
;    Copyright 1984 Change Software, Inc.
;
;    Remove Kermit init code and routines like SPAR and RPAR that
;    are only called once per file transfer.  Placed into overlay
;    with KRTATR.  This was done to reduce the task size a bit.


    .include "IN:KRTMAC.MAC"
    .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MAC failed>

    .mcall    .GTIM            ; /62/


    .macro    $chkb    val ,reg ,?a    ; used to check received parameters
    tstb    @reg            ; to be sure something is there
    bne    a            ; if no default supplied
    movb    val    ,@reg        ; stuff one in
a:    inc    reg            ; next time, do next one
    .endm    $chkb


    .sbttl    Misc defaults        ; /63/ moved these here from KRTPAK

    DEFDLY    =      6.        ; secs delay before SENDing a file
    IN$TRY    =      5.        ; /BBS/ number of times to retry init
    MX$TRY    =     16.        ; number of times to retry packet
    MYCHKT    =     '1        ; normal checksumming
    MYEOL    =     cr        ; end-of-line
    MYQUOTE    =     '#        ; control char quoting prefix char
    MYPAD    =      0        ; no padding
    MYPCHAR    =      0        ; thus no pad character
    MYQBIN    =     '&        ; 8-bit quoting prefix char
    MYREPT    =     tilde        ; tilde for repeat quoting
    MYRTMO    =     10.        ; /62/ RECEIVE default time-out
    MYSTMO    =     13.        ; /62/ SEND default time-out


    .sbttl    Local data        ; /63/ consolidated here..

    .psect    $pdata
ini.00:    .word    ini.01    ,ini.02    ,ini.03    ,ini.04    ,0 ; /63/ init file name list
ini.01:    .asciz    "INI:KRT.INI"        ; /BBS/ try this logical first
ini.02:    .asciz    "KRT:KRT.INI"        ; /BBS/ then this one, etc..
ini.03:    .asciz    "DK:KRT.INI"
ini.04:    .asciz    "SY:KRT.INI"
ini.05:    .asciz    "Paknum"        ; /BBS/ PAK and LEN flipped
ini.06:    .asciz    "Type"
ini.07:    .asciz    "Length"
ini.08:    .asciz    "    "            ; /62/ four blanks to indent
ini.09:    .asciz    " Bytes "
ini.10:    .asciz    ", open file: "        ; /62/
ini.11:    .asciz    "sent"            ; /62/
ini.12:    .asciz    "rec'd"            ; /62/
ini.13:    .asciz    ", cur/max blk: "    ; /62/
ini.14:    .asciz    "Reading "        ; /BBS/ display this while waiting..
ini.15:    .asciz    " .."            ; /BBS/ ..for the file to load
prefix:    .asciz    "The other Kermit "
cando:    .asciz    "supports long packets, which are disabled locally"
lmsg:    .asciz    "doesn't support or has disabled long packets"
warn8m:    .asciz    "Eight-bit quoting forced on"

$delim:    .asciz    "/"            ; /63/ display format stuff
$sendh:    .ascii    <cr><esc>"[2K"
    .asciz    "Packets sent:            Naks:            Time-outs: "
$rech:    .ascii    <cr><esc>"[2K"
    .asciz    "Packets received:            Naks:            Time-outs: "
$pos0:    .asciz    <cr><esc>"[15C"        ; /BBS/ cursor to column 15.
$pos1:    .asciz    <cr><esc>"[19C"        ; /BBS/ col 19.
npos:    .asciz    <cr><esc>"[36C"        ; /BBS/ col 36.
npox:    .asciz    <cr><esc>"[32C"        ; /BBS/ col 32.
dpos:    .asciz    <cr><esc>"[58C"        ; /BBS/ col 58.
dpox:    .asciz    <cr><esc>"[54C"        ; /BBS/ col 54.
    .even


    .psect    $code
    .sbttl    Initialize ourselves    ; /62/ rearranged for clarity..

kerini::mov    #rwdata    ,r0        ; first of all, clear all read/write
    mov    #rwsize/2,r1        ; data out please
10$:    clr    (r0)+            ; for i := 1 to rwdata_size
    sob    r1    ,10$        ;  do data[i] := 0

    mov    sp    ,doauto        ; default to checking file attributes
    mov    #<at.all!at.on>    ,doattr    ; /63/ and doing all file attributes
    mov    sp    ,setrpt        ; assume we will do repeat counts
    mov    sp    ,dolong        ; /62/ we want long packets if doable
    mov    #myrtmo    ,rectim        ; /62/ default receive time-out
    mov    #mystmo    ,sentim        ; /62/ default send time-out
    call    rparini            ; other Kermit's default sinit params
    call    sparini            ; initialize my sinit parameters

    mov    #1    ,blip        ; assume logging all packets to TT
    call    xinit            ; /42/ moved call forward, init memory

    mov    #soh    ,recsop        ; assume ^A please, for receive SOH
    mov    #soh    ,sensop        ; ditto for sending..
    mov    #defchk    ,chktyp        ; set the default checksum type
    mov    #1    ,chksiz        ; and its size (length in bytes)
    mov    #defchk    ,setchkt    ; /62/ init the SET BLO type too..
    mov    #in$try    ,initry        ; /BBS/ init packet retry limit
    mov    #mx$try    ,maxtry        ; all other packets retry limit
    mov    sp    ,dowild        ; /63/ default to implicit wildcards
    mov    sp    ,incfile    ; /BBS/ discard incomplete files
    mov    #60.    ,serwait    ; /41/ SET SERVER [NO]WAIT default
    mov    #defdly    ,sendly        ; init the delay for send command

    mov    #ctlflgs,r0        ; /63/ ctrl char processing list top
    mov    #<1.+32.+1.+32.>,r1    ; /63/ list is this many bytes long
20$:    incb    (r0)+            ; /63/ init each one as must quote
    sob    r1    ,20$        ; /63/

    mov    sp    ,infomsg    ; /BBS/ default to verbosity
    mov    sp    ,qu.ini        ; /BBS/ save copy of infomsg for reset
    mov    sp    ,rtvol        ; /BBS/ assume volume header checks
    mov    #con$esc,conesc        ; /62/ default CONNECT escape char

    clrb    ininam            ; /62/ no init file found yet
    mov    #ini.00    ,r3        ; try to open an init file somewhere
30$:    tst    @r3            ; any more to try?
    beq    40$            ; no
    calls    open    ,<(r3)+,#lun.ta,#text> ; ya, see if it's there
    tst    r0            ; did the open work?
    bne    30$            ; no, just ignore it
    mov    #lun.ta    ,cmdlun        ; yes, setup for reading from init
    mov    sp    ,sy.ini        ; flag an init file is now open
    clr    infomsg            ; /BBS/ don't echo init file
    strcpy    #indnam    ,-(r3)        ; /62/ stash a copy of file name
    strcpy    #ininam    ,(r3)        ; /62/ and another for show file
    wrtall    #ini.14            ; /63/ "Reading "
    wrtall    (r3)            ; /BBS/ name of init file
    wrtall    #ini.15            ; /63/ tag with " .."
    call    l$nolf            ; /BBS/ just a CR unless TT is NOSCOPE
40$:    return


    .sbttl    Setup defaults for our SINIT parameters

; NOTE:    the SENPAR and CONPAR buffers are zeroed at the top of KERINI thus
;    unused bytes here and for RPARINI are assumed to be already cleared

sparini:mov    #senpar    ,r1        ; where to put them
    movb    #maxpak    ,(r1)+        ; maximum packet size
    mov    #maxpak    ,senlen        ; /62/ init SET SEND PAC limit
    movb    #mystmo    ,(r1)+        ; /62/ send time-out default
    movb    #mypad    ,(r1)+        ; how much padding
    movb    #mypchar,(r1)+        ; whatever I use for padding
    movb    #myeol    ,(r1)+        ; EOL char (not used by this program)
    movb    #myquote,(r1)+        ; ctrl (<40) char quoting prefix char
    movb    #'Y&137    ,(r1)+        ; do 8-bit quoting if need be..
    movb    #mychkt    ,(r1)+        ; /BBS/ checksum type

    movb    #space    ,(r1)        ; assume no repeat processing
    tst    setrpt            ; really do repeat encoding?
    beq    10$            ; no
    movb    #myrept    ,(r1)        ; ya, use this char to prefix it

10$:    mov    #11    ,sparsz        ; /62/ spar packet size up to now..
    mov    doattr    ,r0        ; /62/ if both attributes and
    bis    dolong    ,r0        ; /62/ long-packets are not enabled
    beq    30$            ; /62/ then this is all that's needed
    add    #4    ,sparsz        ; /62/ more to come, make room for it

    inc    r1            ; /62/ bump pointer to capas byte
    tst    doattr            ; /42/ are attributes enabled?
    beq    20$            ; /62/ no
    bisb    #capa.a    ,(r1)        ; /62/ ya, let the other Kermit know

20$:    tst    dolong            ; /42/ long packets enabled?
    beq    30$            ; /62/ no, done
    bisb    #capa.l    ,(r1)+        ; /62/ set long packets support bit
    inc    r1            ; /62/ no window size to send over
    mov    #maxlng    ,r3        ; /62/ use long-packet max length
    clr    r2            ; /42/ break the size
    div    #95.    ,r2        ; /42/ into two bytes
    movb    r2    ,(r1)+        ; /42/ p.mxl1 = buffer_size / 95.
    movb    r3    ,(r1)        ; /62/ p.mxl2 = buffer_size mod 95.
    mov    #maxlng    ,senlen        ; /62/ make SET SEND PAC the max too..
30$:    return


    .sbttl    Setup defaults for other Kermit's SINIT parameters

rparini:mov    #conpar    ,r1        ; where to put them
    movb    #maxpak    ,(r1)+        ;  0 maximum packet size
    movb    #myrtmo    ,(r1)+        ;  1 /62/ default to receive time-out
    movb    #mypad    ,(r1)+        ;  2 how much padding
    movb    #mypchar,(r1)+        ;  3 pad char
    movb    #myeol    ,(r1)+        ;  4 EOL char (not used by this pgm)
    movb    #myquote,(r1)+        ;  5 control (<40) char quoting char
    movb    #'Y&137    ,(r1)+        ;  6 do 8-bit quoting if asked
    movb    #mychkt    ,(r1)+        ;  7 checksum type
    movb    #space    ,(r1)        ; 10 assume no repeat count processing
    return


    .sbttl    Read other Kermit's SINIT parameters

;    input:     (r5)    = address of packet
;        2(r5)    = packet length
;    output:    CONPAR[0..20] list of parameters

rpar::    save    <r0,r1,r2,r3,r4>
    mov    #conpar    ,r2        ; /62/ pointer to conpar buffer
    mov    #20    ,r0        ; /62/ its length
10$:    clrb    (r2)+            ; /62/ clear out any old data
    sob    r0    ,10$        ; /62/ next please
    mov    @r5    ,r1        ; incoming packet address
    mov    2(r5)    ,r0        ; and its length
    mov    #conpar    ,r2        ; save other Kermit's params here
    clr    r3            ; /42/ init long-packet length reg
    movb    #'N&137    ,p.qbin(r2)    ; /58/ assume worst for 8-bit quoting

    unchar    (r1)+    ,(r2)+        ; conpar.spsiz
    dec    r0            ; if no more data
    beq    20$            ; exit
    unchar    (r1)+    ,(r2)+        ; conpar.time
    dec    r0
    beq    20$
    unchar    (r1)+    ,(r2)+        ; conpar.npad
    dec    r0
    beq    20$
    ctl    (r1)+    ,(r2)+        ; conpar.padc
    dec    r0
    beq    20$
    unchar    (r1)+    ,(r2)+        ; conpar.eol
    dec    r0
    beq    20$
    movb    (r1)+    ,(r2)+        ; conpar.qctl
    dec    r0
    beq    20$
    movb    (r1)+    ,(r2)+        ; conpar.qbin
    dec    r0
    beq    20$
    movb    (r1)+    ,(r2)+        ; conpar.chkt
    dec    r0
    beq    20$
    movb    (r1)+    ,(r2)+        ; conpar.rept
    dec    r0
    beq    20$
    unchar    (r1)+    ,(r2)+        ; /62/ conpar.capas
    dec    r0
    beq    20$
    unchar    (r1)+    ,(r2)        ; /62/ conpar.winds
    movb    (r2)+    ,senwin        ; /62/ save a copy here
    dec    r0
    beq    20$
    unchar    (r1)+    ,r3        ; /42/ conpar.mxl1 (hi word)
    bicb    #200    ,r3        ; /42/ ensure high bit off
    movb    r3    ,(r2)+        ; /62/ copy to the conpar vector
    mul    #95.    ,r3        ; /42/ and save it
    dec    r0            ; /42/ get the next part please
    beq    20$            ; /42/ nothing is left
    unchar    (r1)+    ,r4        ; /42/ conpar.mxl2 (lo word)
    bicb    #200    ,r4        ; /42/ ensure high bit off
    movb    r4    ,(r2)+        ; /62/ copy to the conpar vector
    add    r4    ,r3        ; /42/ add into long-packet length
20$:    clrb    (r2)            ; /62/ null terminate the conpar data

    mov    #conpar    ,r2        ; now clear parity please
    mov    #15    ,r0        ; 13. of 'em to do
30$:    bicb    #200    ,(r2)+        ; simple
    sob    r0    ,30$        ; next one

    mov    #conpar    ,r0        ; /37/ be defensive about the other
    $chkb    #maxpak    ,r0        ; /37/ guy's parameters please..
    inc    r0            ; /62/ allow time-out of zero value
    $chkb    #mypad    ,r0
    $chkb    #mypchar,r0
    $chkb    #myeol    ,r0
    $chkb    #myquote,r0
    $chkb    #'Y    ,r0
    $chkb    #defchk    ,r0        ; /62/ always default to type 1
    $chkb    #space    ,r0

    mov    #senpar    ,r0        ; /43/ check to see if we need to
    mov    #conpar    ,r1        ; override any of the sinit stuff

    movb    p.npad(r0),r2        ; /57/ check for SET SEND PADDING
    beq    40$            ; /62/ not set, use rec'd values
    movb    r2    ,p.npad(r1)    ; /57/ set, use that value along
    movb    p.padc(r0),p.padc(r1)    ; /62/ with the local pad char

40$:    movb    p.chkt(r1),senpar+p.chkt ; setup for type of checksum used

    mov    snd8bit    ,do8bit        ; in case spar decided WE need 8-bit
    clr    snd8bit            ; prefixing to send a file over, but
    cmpb    p.qbin(r1),#'Y&137    ; can the other end handle it?
    bne    50$            ; maybe.. go find out
    movb    #myqbin    ,ebquot        ; yes, use the default "&" prefix and
    br    70$            ; do8bit as possibly set per the above
50$:    cmpb    p.qbin(r1),#'N&137    ; other end require 8-bit quoting?
    bne    60$            ; yes, using its own prefix char
    clr    do8bit            ; no, it doesn't want it
    br    70$
60$:    mov    sp    ,do8bit        ; set flag for doing 8-bit prefixing
    movb    p.qbin(r1),ebquot    ; set the quote character please
    call    warn8            ; /BBS/ warn 8-bit prefixing forced on

70$:    clr    senlng            ; /42/ clear write long buffer size
    tst    dolong            ; /42/ really want long-packets today?
    bne    80$            ; /42/ yes
    bitb    #capa.l    ,p.capas(r1)    ; /BBS/ no, but can other end do them?
    beq    120$            ; /BBS/ no
    tst    msgtim            ; /BBS/ ya, is this a new transaction?
    bne    120$            ; /62/ no, continue..
    calls    printm    ,<#2,#prefix,#cando> ; /BBS/ ya, say it is possible..
    br    110$            ; /62/ go set msg given flag, continue

80$:    bitb    #capa.l    ,p.capas(r1)    ; /42/ can other end do long packets?
    beq    100$            ; /42/ no
    mov    r3    ,senlng        ; /42/ yes, load its passed pak length
    bne    90$            ; /42/ something was there
    mov    #maxpak    ,senlng        ; /BBS/ not there, use normal packets
90$:    cmp    senlng    ,#maxlng    ; /42/ is this bigger than our buffer?
    ble    120$            ; /42/ no
    mov    #maxlng    ,senlng        ; /42/ yes, please fix it then
    br    120$            ; /43/ and continue

100$:    cmp    reclng    ,#maxpak    ; /BBS/ is SET REC PAC > 94. here?
    ble    120$            ; /BBS/ no
    tst    msgtim            ; /43/ ya, say long-packets possible
    bne    120$            ; /43/ but please, NOT for every file
    calls    printm    ,<#2,#prefix,#lmsg> ; /BBS/ print a warning message
110$:    mov    sp    ,msgtim        ; /43/ flag we printed a warning
120$:    unsave    <r4,r3,r2,r1,r0>
    return

warn8:    tst    warn8done        ; /BBS/ done this yet?
    bne    10$            ; /BBS/ ya
    calls    printm    ,<#1,#warn8msg>    ; /BBS/ warn 8-bit prefixing forced
    mov    sp    ,warn8done    ; /BBS/ flag warning has been given
10$:    return


    .sbttl    Fill a buffer with my initialization parameters

;    input:    (r5)    = address of buffer to fill

spar::    save    <r0,r1,r2>
    mov    @r5    ,r2        ; point to the destination
    mov    #senpar    ,r1        ; and our local parameters

    tochar    (r1)+    ,(r2)+        ; senpar.spsiz
    tochar    (r1)+    ,(r2)+        ; senpar.time
    tochar    (r1)+    ,(r2)+        ; senpar.npad
    ctl    (r1)+    ,(r2)+        ; senpar.padc
    movb    (r1)    ,conpar+p.eol    ; /62/ in case SET and SENDing first..
    tochar    (r1)+    ,(r2)+        ; senpar.eol
    movb    (r1)+    ,(r2)+        ; senpar.qctl

    clr    snd8bit            ; assume we don't need 8-bit quoting
    movb    #'Y&137    ,(r1)        ; /62/ but "if we must, ok"
    movb    conpar+p.qbin,r0    ; get other Kermit's quote character
    cmpb    r0    ,#'N&137    ; can it do 8-bit quoting?
    bne    10$            ; possibly..
    clr    do8bit            ; no, don't ever try to do it, but
    br    30$            ; stuff the "Y" in our params anyway
10$:    cmpb    r0    ,#'Y&137    ; does the other end require quoting?
    bne    20$            ; yes, set the mode up then
    tst    parity            ; /BBS/ no, but do we need to do it?
    beq    30$            ; no, don't waste the overhead
    movb    #myqbin    ,r0        ; yes, force this to the other side
20$:    mov    sp    ,snd8bit    ; flag so rpar knows what's up here
    mov    sp    ,do8bit        ; force 8-bit prefixing then
    movb    r0    ,ebquot        ; and set ours to the same please
    movb    r0    ,(r1)        ; /62/ update senpar data
    call    warn8            ; /BBS/ warn 8-bit prefixing forced

30$:    movb    (r1)+    ,(r2)+        ; senpar.qbin
    movb    (r1)+    ,(r2)+        ; senpar.chkt
    movb    (r1)+    ,(r2)+        ; senpar.rept

    mov    #11    ,sparsz        ; /62/ spar packet size up to now..
    mov    doattr    ,r0        ; /62/ if both attributes and
    bis    dolong    ,r0        ; /62/ long-packets are not enabled
    beq    60$            ; /62/ then this is all that's needed
    add    #4    ,sparsz        ; /62/ more to come, make room for it

    clrb    (r1)            ; /62/ init capas byte
    tst    dolong            ; /42/ do long packets?
    beq    40$            ; /42/ no
    bisb    #capa.l    ,@r1        ; /42/ ya
40$:    tst    doattr            ; /42/ do attributes?
    beq    50$            ; /62/ no
    bisb    #capa.a    ,@r1        ; /62/ ya

50$:    tochar    (r1)+    ,(r2)+        ; senpar.capas
    tochar    (r1)+    ,(r2)+        ; /42/ senpar.capas+1 (window_size)
    tochar    (r1)+    ,(r2)+        ; /42/ senpar.capas+2 (maxlen1)
    tochar    (r1)+    ,(r2)+        ; /42/ senpar.capas+3 (maxlen2)

60$:    clrb    (r2)            ; /62/ end, null terminate
    unsave    <r2,r1,r0>
    return


    .sbttl    Restore set checksum type and init a few things

fixchk::movb    setchkt    ,senpar+p.chkt    ; /62/ put SET BLO value back
    clr    do8bit            ; /BBS/ reset the 8-bit quoting flag
    clr    warn8done        ; /BBS/ allow warn message again
    clr    msgtim            ; /BBS/ and long packet messages
    movb    #'Y&137    ,conpar+p.qbin    ; /BBS/ preset normal 8-bit quote bit
    clr    incpar            ; /BBS/ reset parity warning counter
    return


    .sbttl    Dump a debug packet to disk

;    D S K D M P
;
;    input:      (r5)    = function name (RPACK or SPACK)
;         2(r5)    = packet number    ; /BBS/ number and length flipped
;         4(r5)    = packet type
;         6(r5)    = packet length
;        10(r5)    = packet buffer address

dskdmp::save                ; /42/ save r0-r5
    sub    #64    ,sp        ; /BBS/ allocate a formatting buffer
    mov    sp    ,r1        ; point to it
    mov    #64    ,r0        ; number of bytes in the buffer
10$:    movb    #space    ,(r1)+        ; /BBS/ fill it with blanks
    sob    r0    ,10$        ; one byte at a time
    mov    sp    ,r1        ; point back to the buffer
    mov    (r5)+    ,r0        ; point to the routine name
    call    160$            ; and copy it
    dec    r1            ; /BBS/ format display
    mov    #ini.05    ,r0        ; /BBS/ and a label, "PAK"
    call    160$            ; copy it
    inc    r1            ; /BBS/ a space
    mov    (r5)+    ,r0        ; /BBS/ deccvt uses r5, so use r0 here
    deccvt    r0    ,r1    ,#2    ; /BBS/ convert to decimal
    add    #6    ,r1        ; /BBS/ and skip to next position
    mov    #ini.06    ,r0        ; another label, "TYP"
    call    160$            ; simple
    inc    r1            ; /BBS/ a space
    movb    (r5)+    ,(r1)        ; get the packet type
    inc    r5            ; /62/ finish bumping r5 to next arg..
    cmpb    (r1)    ,#badchk    ; /62/ checksum error?
    bne    20$            ; /62/ no
    movb    #'*    ,(r1)        ; /62/ yes, flag it please
    br    40$            ; /62/ and continue
20$:    cmpb    (r1)    ,#'A&137    ; /62/ smaller than an "A" ?
    blt    30$            ; /62/ ya..
    cmpb    (r1)    ,#'Z&137    ; /62/ bigger than a "Z" ?
    ble    40$            ; /62/ nope
30$:    movb    #'?    ,(r1)        ; /62/ indicate type is in la-la land
40$:    add    #5    ,r1        ; /62/ skip to next entry in line
    mov    #ini.07    ,r0        ; and a label, "LEN"
    call    160$            ; copy it
    inc    r1            ; /BBS/ a space
    mov    (r5)+    ,r2        ; /BBS/ save a copy of packet length
    deccvt    r2    ,r1    ,#4    ; /BBS/ and convert to decimal
    add    #4    ,r1        ; now point to the end
    clrb    @r1            ; make it .asciz
    mov    sp    ,r1        ; point back to the start
    bit    #log$pa    ,trace        ; /BBS/ maybe only doing TT now?
    beq    100$            ; /BBS/ ya..
    strlen    r1            ; /BBS/ don't write extra blanks!
    calls    putrec    ,<r1,r0,#lun.lo> ; and put out to disk now
    tst    r0            ; /62/ did it work?
    beq    50$            ; /62/ ya
    call    logerr            ; /62/ no, handle the error
    br    100$            ; /62/ that's it for this part..
50$:    mov    @r5    ,r3        ; /BBS/ get address of packet buffer
    cmp    r2    ,#$allsiz-2    ; /62/ is this length for real?
    ble    60$            ; /62/ should be..  else truncate to
    mov    #$allsiz-2,r2        ; /62/ avoid trap to 4 past buff end!!
60$:    mov    r2    ,r4        ; /42/ save the length please
70$:    mov    r4    ,r0        ; /42/ assume a reasonable size
    ble    100$            ; /BBS/ don't write null lines..
    cmp    r0    ,#72.        ; /42/ will the leftovers fit?
    ble    80$            ; /42/ yes
    mov    #72.    ,r0        ; /42/ no
80$:    call    170$            ; /62/ indent 4 columns
    calls    putrec    ,<r3,r0,#lun.lo> ; /42/ dump a (partial) bufferful
    tst    r0            ; /62/ did it work?
    beq    90$            ; /62/ ya
    call    logerr            ; /62/ no, handle the error
    br    100$            ; /62/ that's it for this part..
90$:    add    #72.    ,r3        ; /42/ move up to next partial
    sub    #72.    ,r4        ; /42/ and try again
    br    70$            ; /42/ next please

100$:    bit    #log$de    ,trace        ; /62/ should we also dump to TT?
    beq    150$            ; no
    wrtall    r1            ; yes, dump the length and type
    .newline            ; and a CR/LF
    tst    r2            ; anything in the packet?
    beq    150$            ; no
    clr    r1            ; /BBS/ init a counter for newlines
    mov    @r5    ,r3        ; /BBS/ get address of packet buffer
110$:    tst    tsxsav            ; /BBS/ running under TSX?
    beq    120$            ; /BBS/ nope
    cmpb    @r3    ,m.tsxr        ; /62/ ya, is this TSLICH?
    beq    140$            ; /BBS/ ya, don't type it to TT
120$:    tst    r1            ; /62/ at the top of a line (col.1)?
    bne    130$            ; /62/ nope
    wrtall    #ini.08            ; /62/ ya, indent 4 columns..
130$:    movb    (r3)+    ,r0        ; /BBS/ get a byte
    call    writ1char        ; /BBS/ send it to TT
    inc    r1            ; /BBS/ increment the byte counter
    cmp    r1    ,#72.        ; /BBS/ done 72. chars yet?
    ble    140$            ; /BBS/ nope
    .newline            ; /BBS/ ya, do a <cr><lf>
    clr    r1            ; /BBS/ and reset the byte counter
140$:    sob    r2    ,110$        ; /BBS/ continue
    tst    r1            ; /BBS/ need a newline?
    beq    150$            ; /BBS/ nope
    .newline            ; /BBS/ ya
150$:    add    #64    ,sp        ; /BBS/ pop the local buffer
    unsave                ; /42/ unsave r5-r0
    return

160$:    movb    (r0)+    ,(r1)+        ; copy .asciz string to buffer
    bne    160$            ; done yet?
    dec    r1            ; /BBS/ back up to null
    movb    #space    ,(r1)+        ; /BBS/ stuff a space where null was
    return

170$:    save    <r2,r1,r0>        ; /62/ added, dump 4 blanks to logfile
    mov    #4    ,r2        ; loop 4 times
    mov    #lun.lo    ,r1        ; write to this channel
180$:    mov    #space    ,r0        ; space is the char to write
    call    putcr0            ; do it
    sob    r2    ,180$        ; until done
    unsave    <r0,r1,r2>
    return


    .sbttl    Init stats registers    ; /62/ now includes clrsta

inista::call    dcdtst            ; /63/ check DCD, report any change
    mov    #pcnt.r    ,r1        ; packets received
    mov    totp.r    ,r2        ; running count so far
    mov    #34    ,r0        ; number of words to add/clear
10$:    add    2(r1)    ,2(r2)        ; /43/ add in the totals
    adc    (r2)            ; /43/ the carryover also
    add    (r1)    ,(r2)+        ; /43/ the high order of it
    tst    (r2)+            ; /43/ get to the next one
    clr    (r1)+            ; /43/ clear old stuff out
    clr    (r1)+            ; /43/
    sob    r0    ,10$        ; /43/ next please
    mov    #pcnt.s    ,r1        ; now for the packets sent
    mov    totp.s    ,r2        ; where to add them in
    mov    #34    ,r0        ; number of words to do
20$:    add    2(r1)    ,2(r2)        ; /43/ add in the totals
    adc    (r2)            ; /43/ the carryover also
    add    (r1)    ,(r2)+        ; /43/ the high order of it
    tst    (r2)+            ; /43/ get to the next one
    clr    (r1)+            ; /43/ clear old stuff out
    clr    (r1)+            ; /43/
    sob    r0    ,20$        ; /43/ next please
    clr    pcnt.n            ; NAKs count
    clr    pcnt.n+2        ; /43/ rest of it
    clr    pcnt.t            ; /44/ time-outs
    clr    pcnt.t+2        ; /44/
    clr    filein+0        ; /43/ file data stats
    clr    filein+2        ; /43/
    clr    fileout+0        ; /43/
    clr    fileout+2        ; /43/
    clr    charin+0        ; /43/ physical link stats
    clr    charin+2        ; /43/
    clr    charout+0        ; /43/
    clr    charout+2        ; /43/
    clr    rdrate+0        ; /BBS/ read rate, # chars hi word
    clr    rdrate+2        ; /BBS/ # chars lo word
    clr    rdrate+4        ; /BBS/ # of reads
    clr    nakrec            ; /BBS/ anti-resonating NAK register
    .gtim    #rtwork    ,#pkrate    ; /62/ start of init packet xmission
    mov    #-1    ,pkrate+4    ; /62/ flag this is first time through
    mov    #-1    ,pcnt.n+2    ; init so next bump makes it zero
    clr    pcnt.n+0        ; /43/ clear high order bits
    mov    #-1    ,pcnt.t+2    ; /44/ init time-out counter
    clr    pcnt.t+0        ; /44/ 32. bits here too
    .br    incsta            ; /63/


    .sbttl    Increment stats

incsta::cmp    -(sp)    ,-(sp)        ; allocate two word buffer
    mov    sp    ,r3        ; and point to the small buffer
    .gtim    #rtwork    ,r3        ; get ticks past midnite
    mov    (r3)+    ,r0        ; load time hi word and
    mov    (r3)    ,r1        ; low word for double precision divide
    cmp    (sp)+    ,(sp)+        ; pop the tiny buffer
    mov    #40    ,r3        ; set iteration count in r3 (32. bits)
    mov    clkflg    ,-(sp)        ; put divisor on the stack
    clr    r2            ; set the remainder to zero
10$:    asl    r1            ; shift the entire dividend
    rol    r0            ; ...
    rol    r2            ; ... to left and into remainder
    cmp    r2    ,(sp)        ; is remainder greater than divisor
    blo    20$            ; no, skip to iteration control
    sub    (sp)    ,r2        ; yes, subtract divisor out please
    inc    r1            ; increment the quotient
20$:    dec    r3            ; repeat please
    bgt    10$            ; not done    r0=hiword secs>midnite
    tst    (sp)+            ; pop divisor    r1=loword secs>midnite
    mov    #times+4,r2        ; /43/ midnight, moving old times
    mov    r0    ,(r2)+        ; /43/ insert new times first
    mov    r1    ,(r2)        ; /43/ then subtract off the old
    sub    times+2    ,(r2)        ; /43/ times from it
    sbc    -(r2)            ; /43/ ditto for the carry
    sub    times+0    ,(r2)        ; /43/ incremental is in times+4..>>
    bge    30$            ; /BBS/ didn't cross midnight
    mov    #times+6,r2        ; /BBS/ did cross, add 24 hours to fix
    add    #20864.    ,(r2)        ; /BBS/ low word of # secs in 24 hours
    adc    -(r2)            ; /BBS/ add carry to 32-bit hi word
    add    #1.    ,(r2)        ; /BBS/ hi word of # secs in 24 hours
30$:    mov    r1    ,times+2    ; /43/ <<..and times+6, new time is in
    mov    r0    ,times+0    ; /43/ times+0 and times+2
    return                ; /43/


    .sbttl    Initialize repeat count for sending packets

inirep::save    <r0>
    clr    dorpt            ; assume not doing repeat things
    tst    setrpt            ; repeat count processing disabled?
    beq    10$            ; yes
    cmpb    #myrept    ,#space        ; am I doing it?
    beq    10$            ; no, just exit then
    clr    rptcount        ; size of repeat if zero
    clr    rptlast            ; no last character please (a null)
    mov    #-1    ,rptinit    ; need to prime the pump please
    movb    conpar+p.rept,r0    ; check for doing so
    beq    10$            ; no
    cmpb    r0    ,#space        ; a space also?
    beq    10$            ; yes
    cmpb    r0    ,senpar+p.rept    ; same?
    bne    10$            ; no
    movb    r0    ,rptquo        ; yes, save it and
    mov    sp    ,dorpt        ; /62/ we are indeed doing this
10$:    unsave    <r0>
    return


    .sbttl    Decide what to do about displaying packet counts

dolog:    call    dcdtst            ; /62/ check DCD, report any change
    tst    blip            ; display at every "blip" # of counts
    beq    10$            ; do not do this at all
    tst    infomsg            ; /51/ if SET TT QUIET
    beq    10$            ; /51/ don't do this
    tst    remote            ; a server?
    bne    10$            ; could be
    tst    xmode            ; extended reply?  also clears carry..
    bne    10$            ; yes
    bit    #log$de    ,trace        ; /62/ debugging to TT?
    bne    10$            ; /BBS/ ya, stop headers + etc..
    bit    #log$rp    ,trace        ; /BBS/ this also writes to TT
    beq    20$            ; /BBS/ except when equal to zero
10$:    sec                ; flag to skip stats display
20$:    return                ; /63/ or carry cleared by above tests


    .sbttl    Display received packets stats

reclog::save    <r1>
    call    dolog            ; decide what to do
    bcs    10$            ; do nothing
    mov    pcnt.r+2,r1        ; check for modulo on screen updates
    clr    r0            ; setup for the divide
    div    blip    ,r0        ; do it
    tst    r1            ; any remainder left over?
    bne    10$            ; yes, simply exit
    mov    vttype    ,r0        ; no, dispatch to the correct routine
    asl    r0            ; it's word indexing
    jsr    pc    ,@recdsp(r0)    ; dispatch
10$:    unsave    <r1>
    return

    .save
    .psect    $pdata
recdsp:    .word    rectty    ,rectty    ,recvt1    ,recvt1    ,recvt1
    .restore

rectty:    mov    #pcnt.r    ,r1        ; /43/ pass address in r1
    call    numout            ; write the number to the terminal
    wrtall    #$delim            ; a "/" delimiter
    mov    #pcnt.s+<4*<<'N&137>-100>>,r1 ; /43/ 32. bits this time
    cmp    2(r1)    ,pcnt.n+2    ; /43/ unlikely that the NAK
    beq    10$            ; /43/ count would ever be > 65535.
    mov    2(r1)    ,pcnt.n+2    ; /43/ use low order 16 bits
10$:    call    numout            ; /BBS/ always refresh display
    call    l$nolf            ; just a CR, unless TT is NOSCOPE
    mov    sp    ,logini        ; /BBS/ flag this line has been used
    return

recvt1:    tst    logini            ; need the header?
    bne    20$            ; no
    tst    pcnt.r+2        ; /62/ ya, but sent any packets yet?
    bne    10$            ; /62/ ya
    tst    pcnt.r+0        ; /62/ check hi word just in case
    beq    50$            ; /62/ nothing to do yet
10$:    wrtall    #$rech            ; /62/ initial header please
    mov    #-1    ,pcnt.n+2    ; /62/ force redisplay of NAKs
    mov    #-1    ,pcnt.t+2    ; /62/ and time-outs
    mov    sp    ,logini        ; /62/ flag it has been done
20$:    wrtall    #$pos1            ; position the cursor
    mov    #pcnt.r    ,r1        ; /43/ received packet count
    call    numout            ; dump it
    mov    #pcnt.s+<4*<<'N&137>-100>>,r1 ; /43/ get the sent NAK count
    cmp    2(r1)    ,pcnt.n+2    ; /43/ really need to update NAKs?
    beq    30$            ; no
    mov    2(r1)    ,pcnt.n+2    ; /43/ stuff low order 16 bits
    wrtall    #npos            ; /62/ put cursor where NAK count goes
    call    numout            ; print the NAK count
30$:    ; /BBS/ dotmo moved here
    mov    #pcnt.r+<4*<<'T&137>-100>>,r1 ; /44/ get time-out count
    cmp    2(r1)    ,pcnt.t+2    ; /44/ has time-out count changed?
    beq    40$            ; /44/ no, just exit
    mov    2(r1)    ,pcnt.t+2    ; /44/ yes, update counter
    wrtall    #dpos            ; /44/ position cursor
    call    numout            ; /44/ dump the number to TT please
40$:    call    l$nolf
50$:    return


    .sbttl    Display sent packets stats

senlog::save    <r1>
    call    dolog            ; decide what to do
    bcs    10$            ; don't do anything
    mov    pcnt.s+2,r1        ; check for modulo on screen updates
    clr    r0            ; setup for the divide
    div    blip    ,r0        ; do it
    tst    r1            ; any remainder left over?
    bne    10$            ; yes, simply exit
    mov    vttype    ,r0        ; recover terminal type
    asl    r0            ; word indexing here
    jsr    pc    ,@sendsp(r0)    ; dispatch based on terminal type
10$:    unsave    <r1>
    return

    .save
    .psect    $pdata
sendsp:    .word    sentty    ,sentty    ,senvt1    ,senvt1    ,senvt1
    .restore

sentty:    mov    #pcnt.s    ,r1        ; /43/ 32. bits now
    call    numout            ; write the number to the terminal
    wrtall    #$delim            ; a "/" delimiter
    mov    #pcnt.r+<4*<<'N&137>-100>>,r1 ; get the sent NAK count
    cmp    2(r1)    ,pcnt.n+2    ; any change in count?
    beq    10$            ; no
    mov    2(r1)    ,pcnt.n+2    ; ya, update it
10$:    call    numout            ; /BBS/ always refresh display
    call    l$nolf            ; just a CR, unless TT is NOSCOPE
    mov    sp    ,logini        ; /BBS/ flag this line has been used
    return

senvt1:    tst    logini            ; need the header?
    bne    20$            ; no
    tst    pcnt.r+2        ; /62/ ya, but sent any packets yet?
    bne    10$            ; /62/ ya
    tst    pcnt.r+0        ; /62/ check hi word just in case
    beq    50$            ; /62/ nothing to do yet
10$:    wrtall    #$sendh            ; /62/ ya, dump it to TT
    mov    #-1    ,pcnt.n+2    ; /62/ force redisplay of NAKs
    mov    #-1    ,pcnt.t+2    ; /62/ and time-outs
    mov    sp    ,logini        ; /62/ flag header now exists
20$:    wrtall    #$pos0            ; /BBS/ position the cursor
    mov    #pcnt.s    ,r1        ; /43/ 32. bits now
    call    numout            ; write number on terminal
    mov    #pcnt.r+<4*<<'N&137>-100>>,r1 ; get the sent NAK count
    cmp    2(r1)    ,pcnt.n+2    ; any change in count?
    beq    30$            ; no
    mov    2(r1)    ,pcnt.n+2    ; ya, update it
    wrtall    #npox            ; /62/ for shortened send logging
    call    numout            ; write number on terminal
30$:    ; /BBS/ dotmo moved here
    mov    #pcnt.r+<4*<<'T&137>-100>>,r1 ; /44/ get time-out count
    cmp    2(r1)    ,pcnt.t+2    ; /44/ has time-out count changed?
    beq    40$            ; /44/ no, just exit
    mov    2(r1)    ,pcnt.t+2    ; /44/ yes, update counter
    wrtall    #dpox            ; /BBS/ position cursor for send
    call    numout            ; /44/ dump the number to TT please
40$:    call    l$nolf            ; just a CR, unless TT is NOSCOPE
50$:    return


    .sbttl    Display packet stats via ^A    ; 9-Dec-86 07:46:02

; /56/    This is similar to the VMS Kermit's ^A status line, which is just like
; that in FTP.  Under KRT as it currently is however, the only time this test
; can be done is just after receiving a data packet, and there may be some lag
; until that occurs, especially when using long packets over a slow link.

cs$in::    mov    #ini.12    ,r0        ; pass to common code
    mov    #filein    ,r1        ; address of data to print
    mov    #lun.ou    ,-(sp)        ; /62/ save for blocks display
    br    cs.com            ; /63/

cs$out::mov    #ini.11    ,r0        ; pass to common code
    mov    #fileout,r1        ; address of data to print
    mov    #lun.in    ,-(sp)        ; /62/ save for blocks display
cs.com:    call    l$nolf            ; /62/ ensure stats are in the clear
    call    numout            ; dump char count @r1
    wrtall    #ini.09            ; /62/ some text
    wrtall    r0            ; send or receive?
    wrtall    #ini.10            ; /62/ some more text
    wrtall    #filnam            ; name of the file
    wrtall    #ini.13            ; /62/ "curblk/maxblk"
    mov    (sp)+    ,r1        ; /62/ recover file's lun
    asl    r1            ; /62/ word indexing here..
    mov    blknum(r1),r0        ; /62/ current block number
    call    L10266            ; /62/ display it
    mov    #'/    ,r0        ; /62/ a slash
    call    writ1char        ; /62/ display it
    mov    sizof(r1),r0        ; /62/ this is how big file is
    call    L10266            ; /62/ display it
    .newline            ; /62/ done
    clr    logini            ; retype the display header
    return


    .sbttl    Display a 32-bit number    ; /43/

numout:    save    <r0,r1,r2>
    sub    #20    ,sp        ; allocate a buffer please
    mov    sp    ,r0        ; point to buffer for $cddmg
    clr    r2            ; kill leading zero and spaces
    call    $cddmg            ; convert to ascii
    clrb    @r0            ; make it .asciz
    mov    sp    ,r0        ; reset pointer
    wrtall    r0            ; dump the string
    add    #20    ,sp
    unsave    <r2,r1,r0>
    return

    .end