home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pdp11 / k11sen.mac < prev    next >
Text File  |  2020-01-01  |  22KB  |  832 lines
  1.     .title    k11sen    send processing
  2.     .ident    /T2.23/
  3.  
  4.  
  5.     .if ndf, K11INC
  6.     .ift
  7.     .include    /IN:K11MAC.MAC/
  8.     .include    /IN:K11DEF.MAC/
  9.     .endc
  10.  
  11.     .psect
  12.     .enabl    gbl
  13.  
  14. ;    13-Oct-84  14:04:37  Brian Nelson
  15. ;
  16. ;    Creation: moved from K11PAK.MAC
  17. ;
  18. ;
  19. ;    Copyright (C) 1983 1984   Change Software, Inc.
  20. ;    
  21. ;    
  22. ;    This software is furnished under a license and may
  23. ;    be  used  and  copied  only in accordance with the
  24. ;    terms of such license and with  the  inclusion  of
  25. ;    the  above copyright notice.  This software or any
  26. ;    other copies thereof may not be provided or other-
  27. ;    wise made available to any other person.  No title
  28. ;    to and ownership of the software is hereby  trans-
  29. ;    ferred.
  30. ;    
  31. ;    The information in this  software  is  subject  to
  32. ;    change  without notice and should not be construed
  33. ;    as a commitment by the author.
  34. ;
  35. ;
  36.  
  37.     .save
  38.     .psect    recpkt    ,rw,d,lcl,rel,con
  39. recpkt:    .blkb    130            ; /51/ We will never get a long
  40.     .restore            ; /51/ packet in reply to data.
  41.  
  42.  
  43.     .sbttl    send processing
  44.  
  45.     .enabl    lsb
  46.     .psect    $CODE    ,I
  47.     .enabl    lsb
  48.  
  49. sen.sw::
  50. sendsw::movb    @r5    ,state        ; do a SINIT first thing please
  51.     movb    #defchk    ,chktyp        ; setup the default checksum type
  52.     mov    #1    ,chksiz        ; the dize of the checksum
  53.     mov    $image    ,image        ; insure correct default for mode
  54.     clr    paknum            ; packetnumber := 0
  55.     clr    numtry            ; retry_count := 0
  56.     clr    oldtry            ; oldretry_count := 0
  57.     clr    datauk            ; /43/ Abort synch status
  58.     add    pcnt.s+2,sencnt+2    ; /43/ save sent packet count
  59.     adc    sencnt+0        ; /43/ 32 bit sums please
  60.     add    pcnt.s+0,sencnt+0    ; /43/ 32 bit high part also
  61.     call    clrsta            ; clear the stats out now
  62.     cmpb    conpar+p.chkt,#'1    ; did the other system want crc checks?
  63.     bne    1$            ; yep
  64.     cmpb    senpar+p.chkt,#'1    ; simple block checks today
  65.     beq    5$            ; yes, assume caller's state is ok
  66. 1$:    movb    #STA.SIN,state        ; no, must force a SINIT exchange.
  67. 5$:    tst    remote            ; local kermit today?
  68.     bne    6$            ; no
  69.     call    ttrini            ; yes, init for console aborts then
  70. 6$:    call    senhdr            ; packet count header initialization
  71.     clr    dpnumber        ; /43/ Clear DATA packet count
  72.     call    incsta            ; /43/ Get timer stats set up
  73.  
  74. 10$:    call    sendeb
  75.     tst    remote            ; /43/ If remote, don't
  76.     bne    20$            ; /43/ Ok
  77.     tst    cccnt            ; /36/ control C abort
  78.     beq    20$            ; /36/ no
  79.     movb    #STA.CCABO,state    ; /36/ fake abort
  80. 20$:    scan    state,#200$        ; now dispatch based on current
  81.     asl    r0            ; state
  82.     jsr    pc    ,@210$(r0)    ; and do it again
  83.     movb    r1    ,state        ; set a new state
  84.     bcc    10$            ; ok
  85.  
  86.  
  87. 100$:    movb    #defchk    ,chktyp        ; reset the checksum type
  88.     mov    #1    ,chksiz        ; the size of the checksum
  89.     save    <r0>            ; insure files are closed
  90.     tst    remote            ; do we need to drop console aborts?
  91.     bne    105$            ; no
  92.     call    ttrfin            ; yes, drop them
  93. 105$:    tst    inopn            ; file open from a failure ?
  94.     beq    110$            ; no
  95.     calls    close    ,<#lun.in>    ; insure that it's closed
  96. 110$:    call    incsta            ; /43/ Get timer stats set up
  97.     unsave    <r0>            ; pop exit status code please
  98.     return                ; bye
  99.  
  100.  
  101.     .save
  102.     .psect    $PDATA    ,D
  103. 200$:    .byte    STA.ABO    ,STA.BRK,STA.COM,STA.DAT,STA.FIL,STA.SIN,STA.EOF
  104.     .byte    STA.ATR    ,STA.CCA
  105.     .byte    0
  106.     .even
  107. 210$:    .word    send.$
  108.     .word    send.a    ,send.b    ,send.c    ,send.d    ,send.f    ,send.s    ,send.z
  109.     .word    send.h    ,ccabort
  110.     .restore
  111.     .dsabl    lsb
  112.  
  113.     global    <chksiz    ,chktyp    ,inopn    ,lun.in    ,state    ,sencnt>
  114.     global    <image    ,$image    ,dpnumb>            ; /43/
  115.  
  116.     global    <senhdr,senlog,rechdr,reclog>
  117.  
  118.  
  119.     .sbttl    STATE routines for SENDSW
  120.  
  121. ccabort:spack    #MSG$ERROR,paknum    ; /36/ break up a deadlock perhaps
  122. send.a:
  123. send.$:    mov    #-1    ,r0
  124.     movb    #STA.ABO,r1        ; return ("ABORT")
  125.     sec                ; unknown state, abort
  126.     return
  127.  
  128. send.b:    call    sbreak            ; send a break to the other system
  129.     clc                ; and continue
  130.     return
  131.  
  132. send.c:    clr    r0            ; Complete
  133.     sec                ; exit
  134.     return
  135.  
  136. send.d:    call    sdata            ; send data now
  137.     clc                ; assume all is well
  138.     return                ; bye
  139.  
  140. send.f:    call    sfile            ; send a file header
  141.     clc                ; assume it went well
  142.     return
  143.  
  144. send.h:    call    sattr
  145.     clc
  146.     return
  147.  
  148. send.s:    call    sinit            ; initialize
  149.     clc
  150.     return
  151.  
  152. send.z:    call    seof            ; end of file
  153.     clc
  154.     return
  155.  
  156.  
  157.     .enabl    lsb
  158.  
  159. sendeb:    bit    #log$st    ,trace        ; debugging for SENDSW
  160.     beq    30$            ; if trace is on then dump the
  161.     sub    #50    ,sp        ; current state to the disk file
  162.     mov    sp    ,r1        ; allocate a small buffer
  163.     mov    #200$    ,r2        ; point to a header
  164. 10$:    movb    (r2)+    ,(r1)+        ; copy a header please
  165.     bne    10$            ; until we find a null
  166.     dec    r1            ; all done
  167.     movb    state    ,(r1)+        ; copy the current state over
  168.     movb    #40    ,(r1)+        ;
  169.     sub    sp    ,r1        ; get the record length
  170.     mov    sp    ,r0        ; and point back to the record
  171.     calls    putrec    ,<r0,r1,#lun.lo>; dump it
  172.     add    #50    ,sp        ; and deallocate the buffer
  173. 30$:    tst    debug            ; terminal debugging on ?
  174.     beq    40$            ; no
  175.     .print    #200$            ; yes, dump current state to ti:
  176.     .print    #state    ,#1        ;
  177.     .newli                ; and a crlf
  178. 40$:    call    senlog            ; packet stats
  179. 100$:    return
  180.  
  181.     .save
  182.     .psect    $PDATA    ,D
  183. 200$:    .asciz    /Sendsw - state is /
  184.     .even
  185.     .restore
  186.     .dsabl    lsb
  187.  
  188.     global    <image    ,state    ,trace>
  189.  
  190.     .sbttl    sattr    send attribute data for the current file
  191.     .enabl    lsb
  192.  
  193. sattr:    inc    numtry            ; abort if we have been trying too much
  194.     cmp    numtry    ,maxtry        ; well ?
  195.     blos    10$            ; no, keep it up
  196.      movb    #STA.ABO,r1        ; yes, return("ABORT")
  197.      call    m$retry            ; flag the error type please
  198.      br    100$            ; exit
  199.  
  200.  
  201. 10$:    tst    sendat            ; really do this ?
  202.     beq    90$            ; no
  203.     mov    atrctx    ,r5        ; save ctx in case of timeout or nak
  204.     calls    w$attr    ,<#filnam,#lun.in,#packet> ; get the next attr packet
  205.     tst    r0            ; any errors along the way ?
  206.     bne    90$            ; yes
  207.     tst    r1            ; anything to send over ?
  208.     beq    90$            ; no
  209.     spack    #MSG$ATR,paknum,r1,#packet ; send the next record out please
  210.     rpack    r2,r3,#recpkt        ; get the reply please
  211.     scan    r1,#200$        ; and take action on the reply
  212.     asl    r0            ; dispatch based on the packet type
  213.     jsr    pc    ,@210$(r0)    ; simple
  214.     br    100$            ; bye
  215. 90$:    calls    buffil    ,<#packet>    ; get the first buffer of data please
  216.     mov    r1    ,size        ; and save it
  217.     movb    #STA.DAT,r1        ; switch to data state if no more attr
  218. 100$:    return                ; bye
  219.  
  220.     .save
  221.     .psect    $PDATA    ,D
  222. 200$:    .byte    MSG$ERROR,MSG$NAK,MSG$ACK,TIMOUT,BADCHK,0
  223.     .even
  224. 210$:    .word    satr.$
  225.     .word    satr.e    ,satr.n    ,satr.y    ,satr$$    ,satr$$
  226.     .restore
  227.     .dsabl    lsb
  228.  
  229.  
  230.  
  231.     .sbttl    handle the response to the packet sent by SATTR
  232.  
  233. satr.$:    movb    #STA.ABO,r1        ; unrecognized packet type
  234.     return
  235.  
  236.  
  237. satr$$:    movb    state    ,r1        ; timeout, stay in current state
  238.     mov    r5    ,atrctx        ; we want the same packet next time
  239.     return                ; and exit
  240.  
  241.  
  242. satr.e:    calls    prerrp    ,<#recpkt>    ; print out received error packet
  243.     movb    #STA.ABO,r1        ; abort
  244.     return                ; and exit
  245.  
  246.  
  247. satr.n:    dec    r3            ; a NAK, see if it's for the last
  248.     bge    10$            ; packet
  249.     mov    #63.    ,r3        ; --paknum<0 ? 63:paknum
  250. 10$:    cmp    r3    ,paknum        ; same one ?
  251.     beq    20$            ; yes
  252.      movb    state    ,r1        ; no, continue on as before then
  253.      mov    r5    ,atrctx        ; also restore context please
  254.      return                ; bye
  255. 20$:    call    satr.y            ; same packet, goto ACK code
  256.     return
  257.  
  258.  
  259. satr.y:    cmp    r3    ,paknum        ; insure ACK is for correct packet
  260.     beq    10$            ; yes
  261.      movb    state    ,r1        ; no, continue in current state
  262.      return
  263.  
  264. 10$:    clr    numtry            ; retrycount := 0
  265.     incm64    paknum            ; paknum := (paknum+1) mod 64
  266.     movb    #STA.ATR,r1        ; not eof, stay in ATTRIBUTE state
  267.     return                ; return("ATTRIBUTE")
  268.  
  269.     global    <atrctx,numtry    ,paknum    ,packet    ,sendat    ,size    ,state>
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.     .sbttl    sbreak    send a break
  278.     .enabl    lsb
  279.  
  280. sbreak:    inc    numtry            ; ABORT if retry count is too high
  281.     cmp    numtry    ,maxtry        ; well ?
  282.     blos    10$            ; ok
  283.      movb    #STA.ABO,r1        ; no, abort the sending of this
  284.      call    m$retry            ; flag the error type please
  285.      br    100$
  286.  
  287. 10$:    spack    #MSG$BREAK,paknum,#0,#packet ; send a break packet
  288.     rpack    r2,r3,#recpkt        ; read the response
  289.     scan    r1,#200$        ; and dispatch based on it
  290.     asl    r0            ; offset times two
  291.     jsr    pc    ,@210$(r0)    ; simple
  292.  
  293. 100$:    clc
  294.     return
  295.  
  296.  
  297.  
  298.     .save
  299.     .psect    $PDATA    ,D
  300. 200$:    .byte    MSG$ERROR,MSG$NAK,MSG$ACK,TIMOUT,BADCHK,0
  301.     .even
  302. 210$:    .word    sbrk.$
  303.     .word    sbrk.e    ,sbrk.n    ,sbrk.y    ,sbrk$$    ,sbrk$$
  304.     .restore
  305.     .dsabl    lsb
  306.  
  307.     global    <maxtry    ,state>
  308.  
  309.  
  310.  
  311.     .sbttl    sbreak routines
  312.  
  313. sbrk.$:    movb    #STA.ABO,r1        ; default or timeout error
  314.     return                ; bye
  315.  
  316.  
  317. sbrk$$:    movb    state    ,r1        ; receive failure (timeout)
  318.     return                ; remain in current state
  319.  
  320.  
  321. sbrk.e:    calls    prerrp    ,<#recpkt>
  322.     movb    #STA.ABO,r1
  323.     return
  324.  
  325.  
  326. sbrk.n:    dec    r3            ; for a NAK see if it was for
  327.     bge    10$            ; the last one mod 64
  328.     mov    #63.    ,r3        ; underflowed, reset to 63
  329. 10$:    cmpb    r3    ,paknum        ; is it the last one ?
  330.     beq    20$            ; yes
  331.     movb    state    ,r1        ; no, simply stay in current mode
  332.     return
  333.  
  334. 20$:    call    sbrk.y
  335.     return
  336.  
  337.  
  338. sbrk.y:    cmp    r3    ,paknum        ; ACK, insure ack is for the
  339.     beq    10$            ; current packet
  340.     movb    state    ,r1        ; wrong packet, ignore it
  341.     return
  342. 10$:    clr    numtry            ; ack for this packet.
  343.     incm64    paknum            ; paknum := (paknum+1) mod 64
  344.     movb    #STA.COM,r1        ; return ("COMPLETE")
  345.     return
  346.  
  347.  
  348.     global    <numtry    ,paknum    ,packet    ,state>
  349.  
  350.  
  351.     .sbttl    sendinit
  352.     .enabl    lsb
  353.  
  354. sinfo::    save                ; save ALL registers please
  355.     clr    numtry            ; send info packets before any 
  356.     clr    paknum            ; extended server response please
  357.     movb    #MSG$SER,-(sp)        ; packet type 'i'
  358.     call    .sinit            ; do it
  359.     unsave                ; restore ALL registers now
  360.     return                ; bye
  361.  
  362. sinit::    movb    #MSG$SND,-(sp)        ; normal sinit operation for sending
  363.     call    .sinit            ; files
  364.     return                ; bye
  365.  
  366.  
  367.  
  368. .sinit:
  369.     mov    chktyp    ,-(sp)        ; save checksum type (not needed)
  370.     mov    chksiz    ,-(sp)        ; save checksum type (not needed)
  371.     movb    #defchk    ,chktyp        ; force type one please
  372.     mov    #1    ,chksiz        ; length of it
  373.     inc    numtry            ; abort if we have been trying too much
  374.     cmp    numtry    ,maxtry        ; well ?
  375.     blos    10$            ; no, keep it up
  376.      movb    #STA.ABO,r1        ; yes, return("ABORT")
  377.      call    m$retry            ; flag the error type please
  378.      br    100$
  379.  
  380. 10$:    calls    spar    ,<#packet>    ; get our send parameters
  381.     calls    cantyp    ,<#ttname,#lun.ti>; flush pending input please
  382.     movb    6(sp)    ,r5        ; packet type to do today
  383.     spack    r5,paknum,sparsz,#packet ; sent our init info now
  384.     rpack    r2,r3,#recpkt        ; and get the other's response
  385.     scan    r1,#200$        ; and dispatch to the correct
  386.     asl    r0            ; routine now
  387.     jsr    pc    ,@210$(r0)    ; simple
  388. 100$:    mov    (sp)+    ,chksiz        ; restore cehcksum stuff
  389.     mov    (sp)+    ,chktyp        ; restore cehcksum stuff
  390.     mov    (sp)+    ,@sp        ; pop passed packet type now
  391.     return
  392.  
  393.  
  394.     .save
  395.     .psect    $PDATA    ,D
  396. 200$:    .byte    MSG$ERROR,MSG$NAK,MSG$ACK,TIMOUT,BADCHK,0
  397.     .even
  398. 210$:    .word    sini.$
  399.     .word    sini.e    ,sini.n    ,sini.y    ,sini$$    ,sini$$
  400.     .restore
  401.     .dsabl    lsb
  402.  
  403.     global    <lun.ti    ,packet    ,paknum    ,sparsz    ,ttname>
  404.     global    <maxtry    ,numtry>
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.     .sbttl    routines for SINIT
  412.  
  413.  
  414. sini.$:    movb    #STA.ABO,r1        ; default case, unrecognized TYPE
  415.     return
  416.  
  417.  
  418. sini$$:    movb    state    ,r1        ; error on the packet, try again
  419.     return
  420.  
  421.  
  422. sini.e:    cmpb    r5    ,#MSG$SER    ; if called from sinfo, ignore errors
  423.     beq    100$            ;
  424.     calls    prerrp    ,<#recpkt>    ; error state, print it and abort
  425.     movb    #STA.ABO,r1        ; return ("ABORT")
  426. 100$:    return
  427.  
  428.  
  429. sini.n:    cmpb    r5    ,#MSG$SER    ; server NAK for I (sinfo) packet?
  430.     bne    10$            ; no
  431.     cmp    numtry    ,#2        ; gotten at least one NAK for 'I'?
  432.     blo    10$            ; no, try again please
  433.     incm64    paknum            ; yes, simply ignore it and move
  434.     clr    numtry            ; to file state
  435.     movb    #STA.FIL,r1        ; not all servers may know about it
  436.     return
  437. 10$:    movb    state    ,r1        ; NAK, continue as before
  438.     return
  439.  
  440.  
  441. sini.y:    cmp    r3    ,paknum        ; got an ACK for SINIT
  442.     beq    10$            ; and the ack is for correct packet
  443.      movb    state    ,r1        ; wrong ACK, ignore it please
  444.      return
  445.  
  446. 10$:    calls    rpar    ,<#recpkt,r2>    ; load the other's parameters now
  447.     tstb    conpar+p.eol        ; insure legitimate EOL character
  448.     bne    20$            ; yes
  449.     movb    #cr    ,conpar+p.eol    ; no, stuff a carriage return in
  450. 20$:    tstb    conpar+p.qctl        ; vaild quoting character present?
  451.     bne    30$            ; yes
  452.     movb    #myquot    ,conpar+p.qctl    ; no, stuff the default in please
  453. 30$:    clr    numtry            ; number_of_trys := 0
  454.     incm64    paknum            ; packetnumber := packetnumber+1 mod 64
  455.     call    inirepeat        ; initialize repeat processing
  456.     movb    #STA.FIL,r1        ; return("FILE")
  457.     return
  458.  
  459.     global    <conpar    ,numtry    ,paknum>
  460.     
  461.  
  462.     .sbttl    sfile
  463.     .enabl    lsb
  464.  
  465. sfile:    movb    conpar+p.chkt,chktyp    ; switch to new checksum type
  466.     movb    chktyp    ,chksiz        ; compute the checksum size also
  467.     sub    #'0    ,chksiz        ; simple
  468.     mov    $image    ,image        ; insure correct default for mode
  469.     mov    #filnam    ,r3        ; and point to it please
  470.     clr    skipfl            ; the user skip the rest of a file
  471.     call    clratr            ; insure attribute stuff is cleared
  472.     call    inirepeat        ; must reset pointers for repeat counts
  473.     sub    #100    ,sp        ; and a converted filename buffer
  474.     mov    sp    ,r4        ; and point to it please
  475.     inc    numtry            ; abort if we have been trying too much
  476.     cmp    numtry    ,maxtry        ; well ?
  477.     blos    10$            ; no, keep it up
  478.      movb    #STA.ABO,r1        ; yes, return("ABORT")
  479.      call    m$retry            ; flag the error type please
  480.      jmp    100$            ; exit
  481.  
  482. 10$:    tst    inopn            ; open files hanging around ?
  483.     beq    20$            ; no    
  484.     calls    close    ,<#lun.in>    ; yes, clean up please
  485.     clr    inopn            ; it's closed now
  486. 20$:    tstb    filnam            ; /38/ a REAL file today?
  487.     bne    21$            ; /38/ no, must be extended server reply
  488.     jmp    45$
  489. 21$:    tst    doauto            ; see if we should check for binary
  490.     beq    25$            ; no, don't do it please
  491.     tst    image            ; /56/
  492.     bne    25$            ; /56/
  493.     calls    binfil    ,<#filnam,#lun.in>; should we force binary mode ?
  494.     tst    r0            ; if gt, then yes
  495.     ble    25$            ; no
  496.     mov    #binary    ,image        ; yes, force binary file operations
  497. 25$:    calls    open    ,<#filnam,#lun.in,image>; open the file for input
  498.     tst    r0            ; did it work ?
  499.     beq    30$            ; yes
  500.     calls    syserr    ,<r0,#errtxt>    ; no
  501.     calls    error    ,<#2,#errtxt,#filnam>; say so please
  502.     movb    #STA.ABO,r1        ; return("ABORT")
  503.     br    100$            ; exit
  504.  
  505. 30$:    mov    sp    ,inopn        ; file is open
  506.     tst    xmode            ; is this a server X-tended reply?
  507.     bne    45$            ; yes, send a simple X packet
  508.     calls    fillog    ,<#1,#filnam>    ; log this to disk
  509.     calls    namcvt    ,<#filnam,r4>    ; convert name to simple name
  510.     tstb    asname            ; /36/ check for alternate name ?
  511.     beq    35$            ; /36/ no
  512.     mov    #asname    ,r4        ; /36/ yes, point to that name
  513. 35$:    tst    remote            ; are we local here ?
  514.     bne    40$            ; no, don't print this out
  515.     calls    printm    ,<#4,#300$,#filnam,#310$,r4>
  516.  
  517. 40$:    strlen    r4            ; and get the filename length
  518.     spack    #MSG$FILE,paknum,r0,r4    ; set the filename packet over
  519.     clrb    asname            ; /36/ insure one shot only
  520.     br    50$            ; ok
  521.  
  522. 45$:    spack    #MSG$TEXT,paknum    ; server extended reply here, send X
  523.  
  524. 50$:    rpack    r2,r3,#recpkt        ; get the response to the filename
  525.     scan    r1,#200$        ; and dispatch on the response
  526.     asl    r0            ; times 2
  527.     jsr    pc    ,@210$(r0)    ; and call the appropiate response
  528.  
  529. 100$:    add    #100    ,sp
  530.     return
  531.  
  532.     .save
  533.     .psect    $PDATA    ,D
  534. 200$:    .byte    MSG$ERROR,MSG$NAK,MSG$ACK,TIMOUT,BADCHK,0
  535.     .even
  536. 210$:    .word    sfil.$
  537.     .word    sfil.e    ,sfil.n    ,sfil.y    ,sfil$$    ,sfil$$
  538.  
  539. 300$:    .asciz    /Sending file /
  540. 310$:    .asciz    / as file /
  541.     .even
  542.     .restore
  543.     .dsabl    lsb
  544.  
  545.     global    <doauto    ,errtxt    ,filnam    ,index    ,inopn    ,paknum>
  546.     global    <skipfl    ,clratr    ,asname>
  547.  
  548.  
  549.  
  550.     .sbttl    routines for SFILE
  551.  
  552.  
  553. sfil.$:    movb    #STA.ABO,r1        ; unknown response, return("ABORT")
  554.     return
  555.  
  556.  
  557. sfil$$:    movb    state    ,r1        ; timeout or checksum error
  558.     return                ; remain in current F state
  559.  
  560.  
  561. sfil.e:    calls    prerrp    ,<#recpkt>    ; error, abort aftering getting
  562.     movb    #STA.ABO,r1        ; the error packet printed.
  563.     return
  564.  
  565.  
  566. sfil.n:    dec    r3            ; a NAK, see if it's for the last
  567.     bge    10$            ; packet
  568.     mov    #63.    ,r3        ; --paknum<0 ? 63:paknum
  569. 10$:    cmp    r3    ,paknum        ; same one ?
  570.     beq    20$            ; yes
  571.      movb    state    ,r1        ; no, continue on as before then
  572.      return                ; bye
  573. 20$:    call    sfil.y            ; same packet, goto ACK code
  574.     return
  575.  
  576.  
  577. sfil.y:    cmp    r3    ,paknum        ; same packet number being ACKED?
  578.     beq    10$            ; yes
  579.      movb    state    ,r1        ; no, continue in current state
  580.      return
  581.  
  582. 10$:    clr    numtry            ; number_of_tries := 0
  583.     incm64    paknum            ; packnumber := packnumber+1 mod 64
  584.     movb    #STA.ATR,r1        ; return("ATTRIBUTE")
  585.     tst    xmode            ; /38/ return((xmode) ?STA.DAT:STA.ATR)
  586.     beq    20$            ; /38/ attributes next
  587.     calls    buffil    ,<#packet>    ; /38/ get the first buffer of data
  588.     mov    r1    ,size        ; /38/ and save it
  589.     movb    #STA.DAT,r1        ; /38/ extended reply, no attributes
  590. 20$:    return
  591.  
  592.     global    <size>
  593.  
  594.  
  595.     .sbttl    sdata    send file data to other system
  596.     .enabl    lsb
  597.  
  598. sdata:    inc    numtry            ; abort if we have been trying too much
  599.     movb    paknum    ,datauk        ; /43/
  600.     cmp    numtry    ,maxtry        ; well ?
  601.     blos    10$            ; no, keep it up
  602.      movb    #STA.ABO,r1        ; yes, return("ABORT")
  603.      call    m$retry            ; flag the error type please
  604.      br    100$            ; exit
  605.  
  606. 10$:    spack    #MSG$DATA,paknum,size,#packet ; send the next record out please
  607.     rpack    r2,r3,#recpkt        ; get the reply please
  608.     scan    r1,#200$        ; and take action on the reply
  609.     asl    r0            ; dispatch based on the packet type
  610.     jsr    pc    ,@210$(r0)    ; simple
  611. 100$:    return                ; bye
  612.  
  613.  
  614.     .save
  615.     .psect    $PDATA    ,D
  616. 200$:    .byte    MSG$ERROR,MSG$NAK,MSG$ACK,TIMOUT,BADCHK,0
  617.     .even
  618. 210$:    .word    sdat.$
  619.     .word    sdat.e    ,sdat.n    ,sdat.y    ,sdat$$    ,sdat$$
  620.     .restore
  621.     .dsabl    lsb
  622.  
  623.     global    <datauk>        ; /43/
  624.  
  625.  
  626.     .sbttl    handle the response to the packet sent by SDATA
  627.     .enabl    lsb
  628.  
  629. ;    Unknown or packet type not valid in current state
  630.  
  631. sdat.$:    cmpb    datauk+1,#2        ; /43/ Been here too often ?
  632.     blo    100$            ; /43/ No, simply NAK it
  633.     cmpb    datauk    ,paknum        ; /43/ But for the SAME packet
  634.     bne    100$            ; /43/ No, just NAK it
  635.     incb    datauk+1        ; /43/ Bump the counter please
  636.     strlen    #200$            ; /43/ Yes, send error packet
  637.     spack    #MSG$ERROR,paknum,r0,#200$ ; /43/ ...
  638.     movb    #STA.ABO,r1        ; /43/ Exit please
  639.     return
  640. 100$:    spack    #MSG$NAK,paknum        ; /43/ No, just simple NAK
  641.     movb    state    ,r1        ; /43/ Continue...
  642.     return                ; /43/ Exit
  643.  
  644.     .save
  645.     .psect    $PDATA    ,D
  646. 200$:    .asciz    /Expecting ACK, packet type not valid in current SDATA state/
  647.     .even
  648.     .restore
  649.     .dsabl    lsb
  650.  
  651.  
  652. sdat$$:                    ; /43/ Timeout
  653. sizfix:    tst    dpnumber        ; /43/ First DATA packet?
  654.     bne    100$            ; /43/ No
  655.     cmp    senlng    ,#maxpak    ; /43/ Long packet got TOO small ?
  656.     blos    100$            ; /43/ No
  657.     asr    senlng            ; /43/ Yes, reduce packet size
  658.     tst    infomsg            ; /43/ Really inform the user?
  659.     beq    100$            ; /43/ No
  660.     calls    printm    ,<#1,#adpmsg>    ; /43/ Inform the user
  661. 100$:    movb    state    ,r1        ; /43/ Keep current state
  662.     return                ; and exit
  663.  
  664.     global    <dpnumber,infomsg,senlng,state>    ; /43/
  665.  
  666.     .save
  667.     .psect    $pdata
  668. adpmsg:    .ascii    /LONG Packet size reduced, first data packet failed/
  669.     .byte    cr,lf,0
  670.     .even
  671.     .restore
  672.  
  673.  
  674. sdat.e:    calls    prerrp    ,<#recpkt>    ; print out received error packet
  675.     return
  676.  
  677.  
  678. sdat.n:    clr    datauk            ; /43/
  679.     dec    r3            ; a NAK, see if it's for the last
  680.     bge    10$            ; packet
  681.     mov    #63.    ,r3        ; --paknum<0 ? 63:paknum
  682. 10$:    cmp    r3    ,paknum        ; same one ?
  683.     bne    sizfix            ; /43/ No, must be for current packet
  684.     call    sdat.y            ; same packet, goto ACK code
  685.     return
  686.  
  687.  
  688. sdat.y:    clr    datauk            ; /43/
  689.     cmp    r3    ,paknum        ; insure ACK is for correct packet
  690.     beq    10$            ; yes
  691.      movb    state    ,r1        ; no, continue in current state
  692.      return
  693.  
  694. 10$:    add    #1    ,dpnumber    ; /43/ datapacket_number++
  695.     bcc    15$            ; /43/ 
  696.     mov    #1    ,dpnumber    ; /43/ Avoid overflow
  697. 15$:    clr    numtry            ; retry_counter = 0
  698.     incm64    paknum            ; paknum = paknum mod 64
  699.     tst    remote            ; is this a remote system?
  700.     bne    40$            ; yes, forget about checking
  701.     tst    cccnt            ; any control C's pending?
  702.     bne    30$            ; yes, always send an error packet
  703.     call    chkabo            ; now check for control X,Z or E
  704.     cmpb    r0    ,#'A&37        ; /56/ Control A stats?
  705.     bne    16$            ; /56/ No
  706.     call    cs$out            ; /56/ Yes, dump char counts
  707.     br    40$            ; /56/ And finish up
  708. 16$:    cmpb    r0    ,#ABT$ERROR&37    ; /56/ control E then send error packet
  709.     beq    30$            ; yes
  710.     cmpb    r0    ,#ABT$CUR&37    ; control X then abort current file
  711.     beq    20$            ; yes
  712.     cmpb    r0    ,#ABT$ALL&37    ; control Z then abort file group?
  713.     bne    40$            ; nothing
  714.     mov    #-1    ,index        ; flag that we are all done
  715. 20$:    mov    #STA.EOF,r1        ; force new state to EOF
  716.     mov    sp    ,skipfl        ; get SEOF to set discard in EOF
  717.     return                ; and exit
  718. 30$:    spack    #MSG$ERROR,paknum    ; send an error packet
  719.     clr    cccnt            ; /36/ clear control C flag
  720.     mov    #STA.ABO,r1        ; force state to ABORT
  721.     return                ; and exit
  722.  
  723.  
  724. 40$:    cmpb    recpkt    ,#ABT$CUR    ; did the ack contain a X for skipfile
  725.     beq    80$            ; yes, fake EOF then
  726.     cmpb    recpkt    ,#ABT$ALL    ; did the ack contain a Z for skip all
  727.     bne    90$            ; files ? no
  728.      mov    #-1    ,index        ; flag a fake no more files
  729. 80$:     movb    #STA.EOF,r1        ; and fake EOF for either X or Z ack
  730.      return
  731.  
  732. 90$:    add    size    ,charout+2    ; /43/ Keep track of counts
  733.     adc    charout+0        ; /43/ 32 bits please
  734.     calls    buffil    ,<#packet>    ; get the next buffer of data to send
  735.     mov    r1    ,size        ; and save the size please
  736.     bne    100$            ; something was there
  737.      movb    #STA.EOF,r1        ; EOF, set state to EOF state
  738.      return                ; return("EOF")
  739. 100$:    movb    #STA.DAT,r1        ; not eof, stay in DATA state
  740.     return                ; return("DATA")
  741.  
  742.     global    <chkabo    ,numtry    ,paknum    ,packet    ,size    ,state>
  743.  
  744.     .sbttl    SEOF    Send file eof packet
  745.     .enabl    lsb
  746.  
  747. seof:    inc    numtry            ; abort if we have been trying too much
  748.     cmp    numtry    ,maxtry        ; well ?
  749.     blos    10$            ; no, keep it up
  750.      movb    #STA.ABO,r1        ; yes, return("ABORT")
  751.      call    m$retry            ; flag the error type please
  752.      br    100$            ; exit
  753.  
  754. 10$:    tst    skipfl            ; skipping the rest of a file ?
  755.     beq    20$            ; no
  756.     spack    #MSG$EOF,paknum,#1,#220$; yes, send D in data field
  757.     br    30$
  758. 20$:    spack    #MSG$EOF,paknum        ; send an EOF packet out now
  759. 30$:    rpack    r2,r3,#recpkt        ; get the reply please
  760.     scan    r1,#200$        ; and take action on the reply
  761.     asl    r0            ; dispatch based on the packet type
  762.     jsr    pc    ,@210$(r0)    ; simple
  763. 100$:    clr    skipfl            ; clear skip the file flag
  764.     return                ; bye
  765.  
  766.     .save
  767.     .psect    $PDATA    ,D
  768. 200$:    .byte    MSG$ERROR,MSG$NAK,MSG$ACK,TIMOUT,BADCHK,0
  769.     .even
  770. 210$:    .word    seof.$
  771.     .word    seof.e    ,seof.n    ,seof.y    ,seof$$    ,seof$$
  772.  
  773. 220$:    .byte    'D&137    ,0
  774.     .even
  775.     .restore
  776.     .dsabl    lsb
  777.  
  778.  
  779.  
  780.     .sbttl    handle the response to the packet sent by seof
  781.  
  782. seof.$:    movb    #STA.ABO,r1        ; unrecognized packet type
  783.     return
  784.  
  785.  
  786. seof$$:    movb    state    ,r1        ; timeout, stay in current state
  787.     return                ; and exit
  788.  
  789.  
  790. seof.e:    calls    prerrp    ,<#recpkt>    ; print out received error packet
  791.     return
  792.  
  793.  
  794. seof.n:    dec    r3            ; a NAK, see if it's for the last
  795.     bge    10$            ; packet
  796.     mov    #63.    ,r3        ; --paknum<0 ? 63:paknum
  797. 10$:    cmp    r3    ,paknum        ; same one ?
  798.     beq    20$            ; yes
  799.      movb    state    ,r1        ; no, continue on as before then
  800.      return                ; bye
  801. 20$:    call    seof.y            ; last packet, handle the kac
  802.     return
  803.  
  804.  
  805. seof.y:    cmp    r3    ,paknum        ; correct packet number
  806.     beq    10$            ; yes
  807.      movb    state    ,r1        ; no, return the last state
  808.      return
  809.  
  810. 10$:    clr    numtry            ; clear the retry count
  811.     incm64    paknum            ; paknum := (paknum+1) mod 64
  812.     calls    close    ,<#lun.in>    ; close the input file
  813.     clr    inopn            ; input file is now closed
  814.     cmp    index    ,#-1        ; force a break here from user
  815.     beq    20$            ; yes
  816.     clr    r0            ; /38/ no errors
  817.     tst    xmode            ; /38/ extended response?
  818.     bne    20$            ; /38/ finish up the transaction
  819.     call    getnxt            ; get the next input file ?
  820.     tst    r0            ; did it work ?
  821.     bne    20$            ; no
  822.     movb    #STA.FIL,r1        ; yes, set new state to "FILE"
  823.     return
  824. 20$:    movb    #STA.BRK,r1        ; return("BREAK")
  825.     return
  826.  
  827.  
  828.  
  829.  
  830.  
  831.     .end
  832.