home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / decpro300 / proscr.mac < prev    next >
Text File  |  2020-01-01  |  26KB  |  913 lines
  1.     .TITLE     KERSCR
  2.     .SBTTL    S Hecht/D Stevens/R McQueen/N Bush
  3. ;
  4. ; PRO/Kermit screen routines 
  5. ;
  6.  
  7. ; Version number
  8.  
  9.     .IDENT    /1.0.05/
  10.  
  11. ; Directives
  12.  
  13.     .ENABLE    LC            ; Allow lower case ascii strings
  14.     .NLIST    BEX
  15.     .LIBRARY /KERMLB/        ; Kermit macro library
  16.  
  17.     .SBTTL    Revision History
  18.  
  19. ;++
  20. ; 1.0.00    By: D Stevens, S Hecht, R McQueen    On: 13-June-1983
  21. ;        Start this program.
  22. ;
  23. ; 1.0.01    By: N Bush            On: 15-Feb-84
  24. ;        Fix (hopefully) screen painting so that server will
  25. ;        get the screen painted when it starts up.
  26. ;
  27. ; 1.0.02    By: Robert C. McQueen        On: 3-March-1984
  28. ;        Fix problems with server mode not painting the screen.
  29. ;
  30. ; 1.0.03    By: David Stevens        On 7-March-1984
  31. ;        Set flag in ASTCHK routine for use by KERXFR-generic
  32. ;        commands I/O handling.
  33. ;
  34. ; 1.0.04    By: Robert C. McQueen        On: 13-March-1984
  35. ;        Redo the inter task communication processing
  36. ;
  37. ; 1.0.05    By: David Stevens        On: 19-March-1984
  38. ;        Check flag in XFR.STATUS to be set by Generic commands,
  39. ;        so that Screen painting is ignored.
  40. ;--
  41.  
  42.     .SBTTL    External routines used and macros
  43. ;
  44. ; External routines used
  45. ;
  46.     .MCALL    SREX$C            ; Specify Requested Exit AST
  47.     .MCALL    ASTX$S            ; Exit AST routine
  48.     .MCALL    ALUN$C            ; Assign Logical Unit Number
  49.     .MCALL    QIO$C
  50.     .MCALL    QIOW$
  51.     .MCALL    QIOW$S
  52.     .MCALL    DIR$
  53.     .MCALL    MRKT$S            ; Mark time
  54.     .MCALL    GTIM$S            ; Get time
  55.     .MCALL    DECL$S            ; Declare significant event
  56.     .MCALL    SETF$S            ; Set event flag
  57.     .MCALL    WTSE$            ; Wait for single event flag
  58.     .MCALL    WTSE$S            ; Wait for single event flag
  59.     .MCALL    CLEF$S            ; Clear event flag
  60.     .MCALL    RDEF$S            ; Read event flag
  61.  
  62.     .SBTTL    Definitions
  63. ;
  64. ; Definitions
  65. ;
  66.     .MCALL    KERDEF
  67.     KERDEF                ; Get the definitions from the library
  68.  
  69.     .MCALL    CHRDEF            ; Get the character definitions
  70.     CHRDEF                ; Expand them
  71.  
  72.     .MCALL    MSG            ; Text message macro
  73.     .MCALL    BLSRTN            ; Allow use of BLISS macros from
  74.     .MCALL    BLSCAL            ;   library
  75.     .MCALL    PJMP            ; Call and return
  76.  
  77.     .SBTTL    Data Section
  78.  
  79.     .PSECT    $OWN$,  D  
  80.  
  81. NUMRTY:    .BLKW    1            ; Number of retries to display
  82. ABORT::    .BLKW    1            ; Flag that we must abort receive/send
  83. DTOT:    .blkw    2            ; Locations to hold calculations of
  84. DMORE:    .blkw    2            ;   time in milliseconds
  85. XFRDIR:    .BLKW                ; Transfer direction
  86. SCRPTD:    .BLKB    1            ; Flag whether screen is painted
  87. LSTXFR:    .BLKB    1            ; Subtype argument from last S$IXFR call
  88. KEYQIO:    .BLKB    1            ; Flag whether a QIO is pending
  89. BRKBUF:    .BLKB    5            ; Buffer for reading key
  90.     .EVEN                ; Ensure even addresses again
  91. KEYGMC:    .BLKB    2            ; Data for get multiple characteristics
  92.  
  93.  
  94.     .SBTTL    Data Section
  95.  
  96.     .PSECT    $PLIT$,  RO ,  D  
  97.  
  98. SCRLON:    .ASCIZ    <.CHCSI>/16;24r/    ; Set scrolling to lines 16 - 24
  99. SCRLOF:    .ASCIZ    <.CHCSI>/0;24r/        ; Set scrolloing to full screen
  100.  
  101.     .SBTTL    Transfer status text
  102.  
  103. ; Header
  104.  
  105.     MSG    XFR,<PRO/Kermit     File transfer status>
  106.  
  107. ; Information
  108.  
  109. M$XFRI:    .ASCII    <.CHCSI>/3;10HPacket number:      0      (dec)/
  110.     .ASCII    <.CHCSI>/5;10HNumber of Retries:  0      (dec)/
  111.     .ASCII    <.CHCSI>/11;6HPress INTERRUPT to skip a file,/
  112.     .ASCII          /  CANCEL to skip rest of transfer,/
  113.     .ASCII    <.CHCSI>/12;6HMAIN SCREEN or EXIT to return to Kermit/
  114.     .ASCII            / before transfer completes,/
  115.     .ASCII    <.CHCSI>/13;6HF5 to retry, ADDNL OPTIONS to turn debugging on/
  116.     .ASCIZ            / or off/
  117. XFRI$L=.-M$XFRI
  118.  
  119. M$SERV:    .ASCIZ    <.CHCSI>/7;10HServer idle     /
  120. M$GENE:    .ASCIZ    <.CHCSI>/7;10HGeneric command /
  121. M$RFIL:    .ASCIZ    <.CHCSI>/7;10HReceiving file: /
  122. M$SFIL:    .ASCIZ    <.CHCSI>/7;10HSending file:   /;27
  123. M$PKPS:    .ASCIZ    <.CHCSI>/3;30H      /<.CHCSI>/3;30H/
  124. M$NKPS:    .ASCIZ    <.CHCSI>/5;30H      /<.CHCSI>/5;30H/
  125.  
  126. M$CFLN:    .ASCII    <.CHCSI>/7;26H                                      /
  127.     .ASCIZ    <.CHCSI>/7;26H/
  128.  
  129. M$SCUR:    .ASCIZ    <.CHESC>/7/
  130. M$RCUR:    .ASCIZ    <.CHESC>/8/
  131. M$PSCR:    .ASCIZ    <.CHCSI>/20;H/
  132.  
  133. M$SUCC::
  134.     .ASCIZ    /File transfer completed successfully/
  135. SUCC$L==.-M$SUCC
  136. M$ABOR::
  137.     .ASCIZ    <.CHBEL>/File transfer aborted/
  138. ABOR$L==.-M$ABOR
  139.  
  140.     .EVEN
  141.  
  142.     .SBTTL    LIST macro definition
  143.  
  144. .MACRO    LIST    NAME,MCRNAM
  145. C$'NAME:
  146.     .MACRO    L    CODE,ADDR
  147.     .WORD    CODE
  148.     .ENDM
  149.         MCRNAM            ; Generate codes
  150. L$'NAME=<.-C$'NAME>/2
  151. E$'NAME=.
  152.     .MACRO    L    CODE,ADDR
  153.     .WORD    ADDR
  154.     .ENDM
  155.         MCRNAM            ; Generate addresses
  156. .ENDM
  157.  
  158. ;++
  159. ;The following are tables for the XFR.STATUS routine
  160. ;--
  161. .MACRO    MIXFR                ; XFR.STATUS I-type table
  162.     L    'S,M$SFIL
  163.     L    'R,M$RFIL
  164.     L    'G,M$GENE
  165. .ENDM
  166.  
  167. LIST IXFR,MIXFR                ; Generate table
  168.  
  169. .MACRO    MFXFR                ; XFR.STATUS F-type table
  170.     L    'C,M$CXFR
  171.     L    'X,M$XXFR
  172.     L    'Z,M$ZXFR
  173.     L    'D,M$DXFR
  174.     L    'A,M$AXFR
  175. .ENDM
  176.  
  177. LIST FXFR,MFXFR                ; Generate table
  178.  
  179. M$FXFR:    .ASCII    <.CHCSI>/9;10HFile:                                               /
  180.     .ASCIZ    <.CHCSI>/9;16H/
  181. M$CXFR:    .ASCIZ    / transfer completed/
  182. M$XXFR:    .ASCIZ    / aborted by user/
  183. M$ZXFR:    .ASCIZ    / Group aborted by user/
  184. M$DXFR:    .ASCIZ    / aborted but saved/
  185. M$AXFR:    .ASCIZ    / aborted due to protocol error/
  186.     .EVEN
  187.  
  188.     .SBTTL    Command dispatch tables for KERFIL task
  189.  
  190. ;++
  191. ; The following macro defines the various routines to call if we have
  192. ; received information from the command scanner.
  193. ;--
  194.  
  195. .MACRO    TCMDS
  196.     L    $TKGEN,X$GEN
  197.     L    $TKXIT,X$EXIT
  198.     L    $TKRCV,X$RECV
  199.     L    $TKSND,X$SEND
  200.     L    $TKSRV,X$SERV
  201. .ENDM
  202.  
  203. LIST    CMDS, TCMDS
  204.  
  205.  
  206.     .SBTTL    Start of KERSCR program section
  207.  
  208. ;++
  209. ; This is the main loop for the file transfer task.  It will wait until
  210. ; an event occurs for it.
  211. ;--
  212.  
  213.     .PSECT    $CODE$,  RO 
  214.  
  215. FOZZIE:    BIS    #TRUE,RUN        ; Flag running
  216.     SREX$C    EXIAST,,$CODE$        ; Specify EXIT ast routine
  217.     DIR$    #ASSIGN,IOERR        ; Do the assign terminal LUN routine
  218.                     ;   located at assign.
  219.     ALUN$C    XKLUN,XK,0,$CODE$    ; Assign XK LUN
  220.     JSR    PC,INILIB        ; Initialize the library routines
  221.     BLSCAL    MSG.INIT        ; Do the initialization of KERMSG
  222.     BLSCAL    TT.INIT            ; Set up the terminal routines
  223.     JSR    PC,XFRINI        ; Initialize the XFR module
  224.     MOV    #N$FIL,R0        ; Claim I'm KERFIL
  225.     MOV    #N$KER,R1        ; And I talk to KERMIT
  226.     JSR    PC,IT$INI        ; Initialize intertask
  227.     MOV    #INTRPT,R0        ; Get the routine
  228.     JSR    PC,IT$PAS        ; Post as AST routine to call
  229.  
  230. ;
  231. ; Now enter the MAIN KERFIL loop.
  232. ;
  233.  
  234. LOOP:    CLR    ABORT            ; Nothing is aborted currently
  235.     CLEF$S    #CONEFN            ; Clear this EFN (used to abort KERFIL)
  236.     BIC    #TRUE,RUN        ; Flag not running any more
  237.     MOV    #FALSE,NOSCRN        ; Allow type out again
  238.     WTSE$S    #ITCEFN            ; Wait until we get the EFN
  239.     CLEF$S    #ITCEFN            ; Clear the event flag
  240.     JSR    PC,IT$RDA        ; Receive the data sent to me
  241.     BCC    LOOP            ; Failed to get data, loop
  242. ;
  243. ; Now to find the function and dispatch to the correct routine
  244. ;
  245.     MOV    #C$CMDS,R1        ; Get the table address
  246.     MOV    #L$CMDS,R2        ; Get the length into R2
  247.  
  248. 10$:    CMP    R0,(R1)+        ; Is this the entry?
  249.     BEQ    20$            ; Yes, handle it
  250.     SOB    R2,10$            ; Loop for all items in the table
  251. ;
  252. ; If we didn't find the entry, send back the NAK
  253. ;
  254.     MOV    #$TKNAK,R0        ; Get the function to send
  255.     JSR    PC,IT$SDA        ; Send the data
  256. ;
  257. 15$:    JSR    PC,NOTIFY        ; Notify KERFIL we are done
  258.     BR    LOOP            ; Go back to sleep until needed again
  259. ;
  260. ; Here if we found the function to process
  261. ;
  262. 20$:    BIS    #TRUE,RUN        ; Flag I'm now running
  263.     MOV    R1,-(SP)        ; Save the offset
  264.     MOV    #$TKOK,R0        ; Send back the OK
  265.     JSR    PC,IT$SDA        ; Send the information
  266.     MOV    (SP)+,R0        ; Get the address of the table entry
  267.     BCC    15$            ; Failed, so skip this attempt
  268. ;
  269. ; Now call the routine to do the function
  270. ;
  271.     ADD    #<L$CMDS*2>-2,R0    ; Point to the address
  272.     MOV    (R0),R0            ; Get the address to call
  273.     JSR    PC,@R0            ; Call the routine
  274.  
  275.     JSR    PC,NOTIFY        ; Notify KERMIT we are done
  276.     BR    LOOP            ; Go back to sleep until needed again
  277. ;
  278. ; Here if Kermit requested us to exit.  Tell it ok and do so
  279. ;
  280. X$EXIT:    PJMP    EXIT            ; And shut down
  281.  
  282.     .SBTTL    EXIT AST routine
  283.  
  284. ;+
  285. ; This routine is called when the task is aborted or attempts
  286. ; to exit.
  287. ;
  288. ; Usage:
  289. ;    Called by AST level
  290. ;--
  291.  
  292.     .PSECT    $CODE$, RO,I
  293.  
  294. EXIAST:    BIC    #TRUE,RUN        ; We aren't running any more
  295.     ADD    (SP),SP            ; Adjust the stack
  296.     ASTX$S                ; Return to the caller
  297.  
  298.     .SBTTL    Notify routine - Tell KERMIT we are finished
  299.  
  300. ;++
  301. ; This routine will notify the KERMIT task that it should start processing
  302. ; commands.  It doesn't necessarly mean that KERFIL is finished the transfer
  303. ; just that we aren't playing with the screen any more.
  304. ;
  305. ; Usage:
  306. ;    JSR    PC,NOTIFY
  307. ;    (Return)
  308. ;
  309. ;--
  310.  
  311.     .PSECT    $CODE$, RO, I
  312.  
  313. NOTIFY:    MOV    R0,-(SP)        ; Save this incase needed
  314.     MOV    #$TKOK,R0        ; Get the information to send
  315.     JSR    PC,IT$SDA        ; Send the data to the other end
  316.     MOV    (SP)+,R0        ; Restore the register
  317.     RTS    PC            ; Return to the caller
  318.  
  319.     .SBTTL    Interrupt routine
  320.  
  321. ;++
  322. ; This routine is called when we receive a message when we are currently
  323. ; running.  This routine will check to see what to do with the interrupt.
  324. ;
  325. ; Usage:
  326. ;    JSR    PC,INTRPT
  327. ;
  328. ;--
  329.  
  330.     .PSECT    $CODE$, RO, I
  331.  
  332. INTRPT:    BIT    #TRUE,RUN        ; Are we running?
  333.     BEQ    99$            ; No, must be at loop level ignore this
  334. ;
  335. ; Here if we have gotten an interrupt for the inter-task communication and
  336. ; we are currently running.  We must now repaint the screen and cause the
  337. ; keyboard to be enabled.
  338. ;
  339.     JSR    PC,IT$RDA        ; Get the data KERMIT sent
  340.     CMP    R0,#$TKPAI        ; Paint the screen?
  341.     BEQ    10$            ; Branch if so
  342.     CMP    R0,#$TKABT        ; Forced abort?
  343.     BEQ    10$            ; Yes, send an OK back
  344.     MOV    #$TKNAK,R0        ; No, send a NAK back
  345.     JSR    PC,IT$SDA        ; Send the data
  346.     BR    99$            ; Return to the caller
  347. ;
  348. ; Here to send the ACK back to the caller
  349. ;
  350. 10$:    MOV    R0,-(SP)        ; Save the item on the stack
  351.     MOV    #$TKOK,R0        ; Get the ACK function
  352.     JSR    PC,IT$SDA        ; Send the data
  353.     MOV    (SP)+,R0        ; Get the item back from the stack
  354.     CMP    R0,#$TKABT        ; Is this the forced abort?
  355.     BEQ    20$            ; Yes, handle it
  356.     JSR    PC,X$PAINT        ; Repaint the screen
  357.     RTS    PC            ; Return to the caller
  358. ;
  359. ; Here to handle the forced abort by the user.
  360. ;
  361. 20$:    MOV    #TRUE,ABORT        ; Flag we must abort this
  362.     SETF$S    #CONEFN            ; Set the EFN to kick the XK
  363. ;
  364. ; Now return to the caller
  365. ;
  366. 99$:    RTS    PC            ; Just return for now
  367.  
  368.     .SBTTL    Cause screen to be repainted
  369.  
  370. ;++
  371. ; This routine will cause the screen to be repainted and the keys to be
  372. ; enabled.  This routine will be called from the interrupt routine and
  373. ; should only do something if KERFIL is running.
  374. ;
  375. ; Usage:
  376. ;    JSR    PC,X$PAINT
  377. ;    (Return)
  378. ;
  379. ;--
  380.  
  381.     .PSECT    $CODE$, RO, I
  382.  
  383. X$PAINT:CLRB    SCRPTD            ; Claim the screen is not painted
  384.     CLR    NOSCRN            ; Allow screen output again
  385.     MOV    LSTXFR,R1        ; Get the last type of thing we did
  386.     JSR    PC,S$IXFR        ; Paint the screen
  387.     RTS    PC            ; Return to the caller
  388.  
  389.     .SBTTL    Transfer status -- Initialization
  390.  
  391. ;++
  392. ; This routine will paint the initialize screen for the file transfer.
  393. ; It will return to the caller after the screen has been initilized.
  394. ;
  395. ; Usage:
  396. ;    R0/ XFR.STATUS type value ("I")
  397. ;    R1/ XFR.STATUS subtype value
  398. ;    JSR    PC,S$IXFR        ; Initilize the screen
  399. ;                    ;  display for transfers
  400. ;    (Return)
  401. ;
  402. ;--
  403.  
  404.     .PSECT    $CODE$,  RO 
  405.  
  406. S$IXFR:    BIT    #TRUE,NOSCRN        ;[01] Screen update suppressed?
  407.     BNE    99$            ;[01] Yes, no sense doing anything
  408.     MOV    #L$IXFR,R3        ; Get the length of the table
  409.     MOV    #C$IXFR,R2        ; Get the address of the codes that
  410. 5$:    CMP    R1,(R2)+        ;   could be passes, check the next one
  411.     BEQ    6$            ; If we have a match then branch
  412.     SOB    R3,5$            ; Loop for all commands
  413.     RTS    PC            ; Just return if unknown call
  414.  
  415. 6$:    ADD    #<L$IXFR*2>-2,R2    ; Point to other table
  416.     MOVB    R1,LSTXFR        ; Save last call argument
  417.     TSTB    SCRPTD            ; Check to see if screen painted
  418.     BNE    7$            ; If painted then skip
  419.     BLSCAL    PAINT,<#M$XFR,#XFR$L,#15.> ; Call the screen painter
  420.     BLSCAL    TT.TEXT,#M$XFRI        ; Output the information part
  421. 7$:    BLSCAL    TT.TEXT,@R2,+        ; Call the routine to output direction
  422.     BLSCAL    TT.TEXT,#M$CFLN,+    ; Clear the file name area
  423.     CMPB    R1,#'G            ; Check for GENERIC
  424.     BEQ    10$            ; If generic then don't ouput file name
  425.     MOV    #FILE.NAME,R0        ; Point at the file name
  426.     ADD    FILE.SIZE,R0        ; Point to the end
  427.     CLRB    (R0)+            ; Clear the end of it
  428.     BLSCAL    TT.TEXT,#FILE.NAME,+    ; Output the file name
  429. 10$:    BLSCAL    TT.TEXT,#SCRLON,+    ; Turn on the scrolling region
  430.     BLSCAL    TT.TEXT,#M$PSCR,+    ; Position to the scrolling region
  431.     BLSCAL    TT.TEXT,#CUROFF,+    ; Turn the cursor off
  432.     BLSCAL    TT.OUTPUT,,-        ; Force it out on the scree
  433.     CMPB    #'R,R1            ; Are we receiving?
  434.     BNE    15$            ; No, then branch
  435.     CLR    XFRDIR            ; Yes, clear XFRDIR for other routines
  436. 15$:    CLR    NUMRTY            ; No NUMRTY yet
  437.     MOVB    #-1,SCRPTD        ; Screen is now painted
  438. 99$:    RTS    PC            ; Return to the caller
  439.  
  440.     .SBTTL    Transfer status -- File name writer
  441.  
  442. ;++
  443. ; This routine will write the file name that we are processing over the file
  444. ; name that was displayed on the screen.  To do this it will first erase
  445. ; the file name that is on the screen and then paint the new file specification
  446. ;
  447. ; Usage:
  448. ;    JSR    PC,S$WFLN
  449. ;    (Return)
  450. ;
  451. ;--
  452.  
  453.     .PSECT    $CODE$,  RO 
  454.  
  455.     .GLOBL    S$WFLN
  456.  
  457. S$WFLN:    BLSCAL    TT.TEXT,#M$SCUR,+    ; Save current position
  458.     BLSCAL    TT.TEXT,#M$CFLN,+    ; Position and clear file name
  459.     MOV    #FILE.NAME,R0        ; Point at the file name
  460.     ADD    FILE.SIZE,R0        ; Point to the end
  461.     CLRB    (R0)+            ; Clear the end of it
  462.     BLSCAL    TT.TEXT,#FILE.NAME,+    ; Output the file name
  463.     BLSCAL    TT.TEXT,#M$RCUR,+    ; Position back to scrolling region
  464.     BLSCAL    TT.OUTPUT,,-        ; Finish it off
  465.     RTS    PC            ; Return to the caller
  466.  
  467.     .SBTTL    Transfer status -- Per packet - XFR.STATUS
  468.  
  469. ;++
  470. ; This routine is called with the information about how the transfer
  471. ; of information is progressing.  It will call with two arguments.
  472. ; One determines if we are sending or receiving and the other is
  473. ; if we just processed an ACK/NAK.
  474. ;
  475. ; Usage:
  476. ;
  477. ; Bliss:
  478. ;
  479. ;
  480. ;    XFR_STATUS (Type, Subtype);
  481. ;
  482. ;        Type: "S" - Send, "R" - Receive
  483. ;            Subtype: "P" - Packet
  484. ;                 "N" - NAK
  485. ;                 "T" - timeout
  486. ;        For type = "I" (initiate), "T" (terminate):
  487. ;            Subtype: "S" - a file send
  488. ;                 "R" - a file receive
  489. ;                 "G" - a generic command
  490. ;                 "I" - for "T" only, returning to server idle
  491. ;        For type = "F" (file operation):
  492. ;            Subtype: "S" - open for sending
  493. ;                 "R" - open for receiving
  494. ;                 "C" - closing file OK
  495. ;                 "X" - aborting file by user request
  496. ;                 "Z" - aborting group by user request
  497. ;                 "D" - aborting file, but saving due to disposition
  498. ;                 "A" - aborting file due to protocol error
  499. ;--
  500.  
  501.     .PSECT    $CODE$,  RO 
  502. BLSRTN    XFR.STATUS,4,<TYPE,SUBTYPE>
  503.     TST    GENFLG            ;[05] Is the generic command flag on ?
  504.     BNE    199$            ;[05] Yes, branch.
  505.     MOV    TYPE(SP),R0        ; Get main type
  506.     MOV    SUBTYPE(SP),R1        ; And subtype
  507.     CMPB    #'I,R0            ; Initiate command?
  508.     BNE    20$            ; No, then branch
  509.     PJMP    S$IXFR            ; Call initiate routine
  510. 20$:    BIT    #TRUE,NOSCRN        ; No desire for screen stuff?
  511.     BNE    23$            ; If not, don't bother painting
  512.     TSTB    KEYQIO            ; We have the screen, is the QIO up?
  513.     BNE    21$            ; If so, leave it
  514.     JSR    PC,INIKEY        ; If not, queue it up again
  515.  
  516. 21$:    TSTB    SCRPTD            ; Screen current?
  517.     BNE    23$            ; If so check for other commands
  518.  
  519.     MOVB    LSTXFR,R1        ; Else get the last S$IXFR arg
  520.     BNE    22$            ; Branch if something there
  521.     MOV    #'G,R1            ; Assume generic
  522.  
  523. 22$:    MOV    NUMRTY,-(SP)        ; Save number of retries
  524.     JSR    PC,S$IXFR        ; Do the initial painting
  525.     MOV    (SP)+,NUMRTY        ; Restore number of retries
  526.     MOV    TYPE(SP),R0        ; Get the arguments back
  527.     MOV    SUBTYPE(SP),R1        ;  .  .  .
  528.  
  529. 23$:    CMPB    #'T,R0            ; Check for terminate command
  530.     BNE    30$            ; No, then branch
  531.     CMPB    #'I,R1            ; Check for return to IDLE SERVER
  532.     BNE    25$            ; No, then branch
  533.     BLSCAL    TT.TEXT,#M$SCUR,+    ; Save current position, etc.
  534.     BLSCAL    TT.TEXT,#M$SERV,+    ; Ouput the idle server message
  535.     BLSCAL    TT.TEXT,#M$CFLN,+    ; Clear the file name area
  536.     BLSCAL    TT.TEXT,#M$RCUR,+    ; Restore position, etc.
  537.     BLSCAL    TT.OUTPUT,,-        ; Force it
  538. 25$:    RTS    PC            ; Return to sender
  539. ;
  540. ; Here if not an initiate or terminal call
  541. ;
  542. 30$:    CMPB    #'S,R0            ; Check for Send type
  543.     BEQ    35$            ; If yes then branch
  544.     CMPB    #'R,R0            ; Check for Receive type
  545.     BNE    40$            ; If no then branch
  546.  
  547. 35$:    CMP    #'N,R1            ; NAK packet?
  548.     BEQ    100$            ; Yes, go handle it
  549.     CMP    #'T,R1            ; No, timeout?
  550.     BNE    120$            ; No, must have been good packet
  551. ;
  552. ; Here if we timed out.  If we are sending a file this will cause a
  553. ;retry, so count it.  If we are receiving a file, this will cause a
  554. ;NAK to be sent, which will cause the retry count to be upped.
  555. ;
  556.     TST    XFRDIR            ; Check direction of transfer
  557.     BNE    100$            ; If sending, handle like NAK
  558.     RTS    PC            ; Otherwise ignore it
  559.  
  560. ; Here if we are either sending or receiving a NAK or have timed out
  561. ;while sending.  Bump our retry counter and display it
  562.  
  563. 100$:    MOV    #M$NKPS,R2        ; Get the NAK position msg
  564.     INC    NUMRTY            ; Count it
  565.     MOV    NUMRTY,R3        ; And get the count
  566.     BR    140$            ; Display new count
  567.  
  568. ; Here if we are processing a packet.  Determine if we sent the packet or
  569. ; if the packet was received.
  570.  
  571. 120$:    MOV    #M$PKPS,R2        ; Get the packet position msg
  572.     CMP    #'S,R0            ; Sending?
  573.     BEQ    130$            ; Yes, process it this way
  574.  
  575. ; Here if the packet was sent
  576.  
  577.     TST    XFRDIR            ; Sending?
  578.     BNE    199$            ; No, return
  579.     MOV    SMSG.COUNT,R3        ; Yes, get the send packet count
  580.     BR    140$            ; Join common code
  581.  
  582. ; Here to handle the receive packet processing
  583.  
  584. 130$:    TST    XFRDIR            ; Receiving?
  585.     BEQ    199$            ; No, return
  586.     MOV    RMSG.COUNT,R3        ; Get the receive packet count
  587.  
  588. ; Here to display the information on the screen.
  589.  
  590. 140$:    BLSCAL    TT.TEXT,#M$SCUR,+    ; Save current position
  591.     BLSCAL    TT.TEXT,R2,+        ; Clear the area
  592.     BLSCAL    TT.NUMBER,R3,+        ; Output the number
  593.     BLSCAL    TT.TEXT,#M$RCUR,+    ; Back to the scrolling region
  594.     BLSCAL    TT.OUTPUT,,-        ; Output the text
  595.  
  596. ; Here to just return to the caller
  597.  
  598. 199$:    RTS    PC            ; Return
  599.  
  600. ; Here if not initiate, terminate or message call
  601.  
  602. 40$:    CMPB    #'F,R0            ; Check for file command
  603.     BNE    50$            ; No, then branch
  604.     CMPB    #'S,R1            ; Check for send subcode
  605.     BEQ    41$            ; Yes, then branch
  606.     CMPB    #'R,R1            ; Check for receive subcode
  607.     BNE    43$            ; No, then branch
  608. 41$:    PJMP    S$WFLN            ; Output the new file name
  609.  
  610. ; Here so must be closing the file for some reason
  611.  
  612. 43$:    MOV    #L$FXFR,R2        ; Get the length of the table
  613.     MOV    #C$FXFR,R3        ; Get the address of the codes that
  614.  
  615. 44$:    CMP    R1,(R3)+        ;   could be passes, check the next one
  616.     BEQ    45$            ; If we have a match then branch
  617.     SOB    R2,44$            ; Loop for all commands
  618.     RTS    PC            ; Not found, just return
  619.  
  620. 45$:    ADD    #<L$FXFR*2>-2,R3    ; Point to other table
  621.     BLSCAL    TT.TEXT,#M$SCUR,+    ; Save current position
  622.     BLSCAL    TT.TEXT,#M$FXFR,+    ; Position to correct line
  623.     BLSCAL    TT.TEXT,#FILE.NAME,+    ; Dump the file name
  624.     BLSCAL    TT.TEXT,(R3),+        ; Output the text
  625.     BLSCAL    TT.TEXT,#M$RCUR,+    ; Restore current position
  626.     BLSCAL    TT.OUTPUT,,-        ; Force the text out
  627. 50$:    RTS    PC            ; Return to sender
  628.  
  629.  
  630.     .SBTTL    Transfer status -- Reset screen
  631.  
  632. ;++
  633. ; This routine will reset the screen after having displayed the transfer
  634. ; status information.  It will clear the screen and the scrolling region.
  635. ; It will then return to the caller
  636. ;
  637. ; Usage:
  638. ;    JSR    PC,S$RXFR
  639. ;    (Return)
  640. ;
  641. ;--
  642.  
  643.     .PSECT    $CODE$,  RO 
  644.  
  645.     .GLOBL    S$RXFR            ; Global routine
  646.  
  647. S$RXFR:    BLSCAL    TT.TEXT,#SCRLOF,+    ; Turn off the scrolling region
  648.                     ;  (Note: S$CLEAR forces text out)
  649.     BLSCAL    TT.TEXT,#CURON,-    ; Turn the cursor back on
  650.     JSR    PC,S$CLEAR        ; Clear the screen and home cursor
  651.     CLRB    SCRPTD            ; Screen no longer painted
  652.     RTS    PC            ; Return to the caller
  653.  
  654.     .SBTTL    Bliss interface -- SY_TIME
  655.  
  656. ; This routine will return a millisecond count in R0
  657. ;
  658. ;    INPUT:    None
  659. ;
  660. ;    OUTPUT:    R0 contains the count
  661. ;
  662. ;    REGISTERS destroyed:    NONE
  663. ;
  664. ; NOTE:    local foo [2];
  665. ;    sy_time(foo);
  666.  
  667.     .PSECT    $CODE$,  RO 
  668.  
  669. SY.TIME::
  670.     MOV    2(SP),TMPADR        ; Get the buffer address and save it
  671.     JSR    R1,$SAVE5        ; Save some registers
  672.     mov    #dtot,R1        ; Get the address of the total
  673.     mov    R1,-(sp)        ; Push address for the addition
  674.     mov    #dmore,-(sp)        ;   routine onto the stack
  675.     mov    R1,-(sp)        ;
  676.     clr    (R1)+            ; Clear the total of the time
  677.     clr    (R1)            ;   in milliseconds
  678.     gtim$s    #timloc            ; Get the current time
  679.  
  680.     mov    #g.tict,R1
  681.     mov    timloc(R1),R3        ; Get the number of ticks
  682.     mov    #1000.,R4        ; Convert to number of milliticks
  683.     mul    R4,R3            ;
  684.     clr    R2            ; Clear the high word
  685.     mov    #64.,R5            ; Set division by 64.
  686.     div    R5,R2            ; Divide to get number of milliseconds
  687.     mov    #dmore,R0
  688.     mov    R2,(R0)+        ; Save the result in DMORE, DMORE+2
  689.     clr    (R0)
  690.     jsr    pc,sy.dadd        ; Add to the total
  691.  
  692.     mov    #g.tisc,R1        ; Get the offset for seconds
  693.     mov    timloc(R1),R3        ; Get the number of seconds
  694.     mul    R4,R3            ; Convert to milliseconds
  695.     mov    R3,dmore        ; Save for the add routine
  696.     jsr    pc,sy.dadd        ; Add to the current total
  697.  
  698.     mov    #g.timi,R1        ; Get the offset for minutes
  699.     mov    timloc(R1),R3        ; Get the number of minutes
  700.     mov    #1000.*60.,R4        ; Move the factor to R4 to
  701.     mul    R4,R2            ;   convert to milliseconds
  702.     mov    #dmore,R0        ; get the storage address
  703.     mov    R2,(R0)+        ; Save the low order word
  704.     mov    R3,(R0)            ; Save the high order word
  705.     jsr    pc,sy.dadd        ; Add to current total
  706.  
  707.     cmp    (sp)+,(sp)+        ; Pull the extra addresses off the
  708.     tst    (sp)+            ;   stack
  709.     mov    #tmpadr,R0        ; Get the address to save the answer in
  710.     mov    #dtot,R1        ; Get the place where it is
  711.     mov    (R1)+,(R0)+        ; Move the answer to the correct place
  712.     mov    (R1),(R0)
  713.     mov    #knormal,R0        ; Set no error
  714.     rts    pc            ; Return to sender
  715.  
  716.     .SBTTL    SY.DADD - Subroutine to add two long words
  717.  
  718. ; This routine will add two numbers that are each two words long
  719. ;
  720. ;    INPUT:    The addresses of the numbers on the stack
  721. ;
  722. ;        Stack:    Address of one number
  723. ;            Address of other number
  724. ;            Address to store the result in
  725. ;
  726. ;    OUTPUT:    The numbers are added and stored in the specified location
  727. ;        R0 is set to knormal (no error)
  728. ;
  729. ;    REGISTERS destroyed:    NONE
  730. ;
  731. ;    SY_DADD(A,B,C) ==> A = B + C    (R2 + R1 = R3)
  732.  
  733.     .PSECT    $CODE$,  RO 
  734.  
  735.     BLSRTN    SY.DADD,4,<ANUM,BNUM,CNUM>
  736.     MOV    CNUM(SP),R1        ; Get the address of C
  737.     MOV    BNUM(SP),R2        ; Get the address of B
  738.     MOV    ANUM(SP),R3        ; GET the address of A
  739.     mov    (R2)+,R4        ; Add least significant words
  740.     add    (R1)+,R4        ;
  741.     mov    R4,(R3)+        ; Save result
  742.     mov    (R2),R4            ; Get most significant word
  743.     adc    R4            ; Add carry from last add(if any)
  744.     add    (R1),R4            ; Add on other word
  745.     mov    R4,(R3)            ; Save result
  746.     rts    pc            ; Return to sender
  747.  
  748.     .SBTTL    Bliss interface -- SY.DSUB - DP subtraction
  749.  
  750. ; This routine will subtract two numbers that are each two words long
  751. ;
  752. ;    INPUT:    The addresses of the numbers on the stack
  753. ;
  754. ;        Stack:    Address of the number to subtract
  755. ;            Address of the number to subtract from
  756. ;            Address to store the result in
  757. ;
  758. ;    OUTPUT:    The difference of the numbers is stored in
  759. ;            the specified location
  760. ;        R0 is set to knormal (no error)
  761. ;
  762. ;    REGISTERS destroyed:    NONE
  763. ;
  764. ;    SY_DSUB(A,B,C) ==> A = B - C    (R2 - R1 = R3)
  765.  
  766.     .PSECT    $CODE$,  RO 
  767.  
  768.     BLSRTN    SY.DSUB,4,<ANUM,BNUM,CNUM>
  769.     MOV    CNUM(SP),R1        ; Get the address of C
  770.     MOV    BNUM(SP),R2        ; Get the address of B
  771.     MOV    ANUM(SP),R3        ; GET the address of A
  772.  
  773.     MOV    (R2)+,R4        ; Subtract least significant words
  774.     SUB    (R1)+,R4        ;
  775.     MOV    R4,(R3)+        ; Save result
  776.     MOV    (R2),R4            ; Get most significant word
  777.     SBC    R4            ; Subtract carry from last sub(if any)
  778.     SUB    (R1),R4            ; Subtract off other word
  779.     MOV    R4,(R3)            ; Save result
  780.  
  781.     MOV    #KNORMAL,R0        ; Set no error
  782.     RTS    PC            ; Return to sender
  783.  
  784.     .SBTTL    Bliss interface -- SY.DISMISS - Wait some amount of time
  785.  
  786. ; This routine will wait the specified amount of time
  787. ;
  788. ;    INPUT:    The amount of time in seconds to wait must
  789. ;            be on the stack under the return address
  790. ;
  791. ;    OUTPUT:    NONE - Time is wasted
  792. ;        Nothing is changed in this routine
  793. ;
  794. ;    REGISTERS destroyed:    NONE
  795. ;
  796.  
  797.     .PSECT    $CODE$,  RO 
  798.  
  799.     BLSRTN    SY.DISMISS,0,DSMTIM
  800.     MOV    DSMTIM(SP),R0        ; Get the amount of time to dismiss
  801.     CLEF$S    #GENEFN            ; Clear the flag
  802.     MRKT$S    #GENEFN,R0,#2.        ; Macro to wait R0 seconds.  This 
  803.                     ;   uses the general EFN.
  804.     WTSE$S    #GENEFN            ; Wait for time to expire
  805.     MOV    #KNORMAL,R0        ; Set no error
  806.     RTS    PC            ; Return to sender
  807.  
  808.     .SBTTL    Keyboard routines for transfer active
  809.  
  810. ;
  811. ; These routines will handle the keyboard during an active transfer.
  812. ;This allows the transfer to be interrupted, or modified based on input
  813. ;from the user.
  814. ;
  815. ; Usage:
  816. ;    JSR    PC,INIKEY        ; Set up initial QIO
  817. ;
  818. ;    JSR    PC,KILKEY        ; Kill any pending QIO
  819. ;
  820.  
  821.     .PSECT    $CODE$,  RO 
  822.  
  823. INIKEY::MOVB    #-1,KEYQIO        ; Flag it is up
  824.     QIO$C    IO.RAL!TF.RNE,TERLUN,TTREFN,,IOSTAT,ASTCHK,<BRKBUF,1.>,$CODE$
  825.     RTS    PC            ; And return
  826.  
  827. KILKEY::TSTB    KEYQIO            ; Anything queued up?
  828.     BEQ    RETRN            ; If not, nothing to kill
  829.     QIO$C    IO.KIL,TERLUN,TTREFN,,,,,$CODE$ ; Kill the pending QIO
  830. RETRN:    RTS    PC            ; And return
  831.  
  832. ; AST routine to handle actual key input
  833.  
  834. ASTCHK::
  835.     JSR    PC,DOAST        ; Do the AST processing
  836.     TST    (SP)+            ; Pull one item off stack for AST
  837.     ASTX$S                ; End ast.
  838.  
  839. DOAST:    JSR    R1,$SAVE5        ; Save some registers
  840.     TSTB    IOSTAT            ; Any errors?
  841.     BPL    10$            ; If not, just continue
  842.     CLRB    KEYQIO            ; No QIO pending now
  843.     RTS    PC            ; Just return
  844.  
  845. 10$:    CMPB    BRKBUFF,#.CHESC        ; Did we get an ESCAPE?
  846.     BNE    110$            ; No so its just junk
  847.     MOVB    #TC.TBF,KEYGMC        ; Store code for get character count
  848.     QIOW$S    #SF.GMC,#TERLUN,#TTREFN,,#IOSTAT,,<#KEYGMC,#2.>
  849.     MOVB    KEYGMC+1,R0        ; Find out how many keys are there
  850.     BEQ    110$            ; If none then just an escape
  851.     CMP    R0,#4            ; Make sure there are no more than
  852.     BLT    12$            ;  four chars. that we read
  853.     MOV    #4,R0            ; Set equal to four since really more
  854. 12$:    QIOW$S    #IO.RAL!TF.RNE,#TERLUN,#TTREFN,,#IOSTAT,,<#BRKBUFF,R0>
  855.     MOV    #BRKBUFF,R1        ; Point at start of buffer
  856.     CMPB    (R1)+,#'[        ; Is the next an open bracket ?
  857.     BNE    110$            ; No, branch.
  858.     CMPB    (R1)+,#'2        ; Is the next byte a 2 ?
  859.     BNE    30$            ; No branch.
  860.  
  861.     CMPB    (R1),#'6        ; Additional options key?
  862.     BEQ    40$            ; Yes, handle it
  863.  
  864.     CMPB    (R1),#'0        ; Is the next byte a 0 (MAIN SCREEN) ?
  865.     BEQ    20$            ; Yes, branch.
  866.     CMPB    (R1),#'1        ; Or was it a 1 (EXIT key) ?
  867.     BNE    110$            ; No, branch.
  868.  
  869. ; If we get a main screen or exit key, give up the terminal and return
  870. ;it to KERMIT.  Keep the transfer in progress
  871.  
  872. 20$:    CLRB    KEYQIO            ; No QIO pending
  873.     MOV    #TRUE,NOSCRN        ; Stop screen update
  874.     CLRB    SCRPTD            ; Screen not painted anymore
  875.     JSR    PC,NOTIFY        ; Notify KERMIT it can process commands
  876.     RTS    PC            ; Return to the caller
  877.  
  878. 30$:    CMPB    -1(R1),#'1        ; Or was that byte a 1 (INTERUPT) ?
  879.     BNE    110$            ; No branch.
  880.     CMPB    (R1),#'7        ; Is the next byte a 7 ?
  881.     BNE    100$            ; No, branch.
  882.     MOV    #TRUE,ABT.CUR.FILE    ; Set up abort current file flag.
  883.     BR    999$            ; Queue up read again
  884.  
  885. ; Here for additional options key.  Just complement the debug flag
  886.  
  887. 40$:    COM    DEBUG.FLAG        ; Do it
  888.     BR    999$            ; Queue up the read again
  889.  
  890. ; Here for F5 and CANCEL keys
  891.  
  892. 100$:    CMPB    (R1),#'5        ; Was it F5?
  893.     BEQ    105$            ; Yes, handle it
  894.  
  895.     CMPB    (R1),#'9        ; Or was it a 9 (CANCEL) ?
  896.     BNE    110$
  897.     MOV    #TRUE,ABT.ALL.FILE
  898.     BR    999$            ; Queue up the read again
  899.  
  900. ; Here for an F5.  Force a timeout so we will NAK.  We do this by setting
  901. ; the GENEFN event flag, which XK would be waiting for.
  902.  
  903. 105$:    SETF$S    #GENEFN            ; Time to try again
  904.     BR    999$            ; Queue up read again
  905.  
  906. 110$:    BLSCAL    TT.CHAR,#.CHBEL        ; Output the message
  907.     BLSCAL    TT.OUTPUT        ; Output any remaining characters
  908. 999$:    PJMP    INIKEY            ; Requeue the input
  909.  
  910.     .SBTTL    End of KERSCR
  911.  
  912.     .END    FOZZIE            ; That's all folks! (Ribbit)
  913.