home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
extra
/
proscr.mac
< prev
next >
Wrap
Text File
|
1988-08-16
|
26KB
|
913 lines
.TITLE KERSCR
.SBTTL S Hecht/D Stevens/R McQueen/N Bush
;
; PRO/Kermit screen routines
;
; Version number
.IDENT /1.0.05/
; Directives
.ENABLE LC ; Allow lower case ascii strings
.NLIST BEX
.LIBRARY /KERMLB/ ; Kermit macro library
.SBTTL Revision History
;++
; 1.0.00 By: D Stevens, S Hecht, R McQueen On: 13-June-1983
; Start this program.
;
; 1.0.01 By: N Bush On: 15-Feb-84
; Fix (hopefully) screen painting so that server will
; get the screen painted when it starts up.
;
; 1.0.02 By: Robert C. McQueen On: 3-March-1984
; Fix problems with server mode not painting the screen.
;
; 1.0.03 By: David Stevens On 7-March-1984
; Set flag in ASTCHK routine for use by KERXFR-generic
; commands I/O handling.
;
; 1.0.04 By: Robert C. McQueen On: 13-March-1984
; Redo the inter task communication processing
;
; 1.0.05 By: David Stevens On: 19-March-1984
; Check flag in XFR.STATUS to be set by Generic commands,
; so that Screen painting is ignored.
;--
.SBTTL External routines used and macros
;
; External routines used
;
.MCALL SREX$C ; Specify Requested Exit AST
.MCALL ASTX$S ; Exit AST routine
.MCALL ALUN$C ; Assign Logical Unit Number
.MCALL QIO$C
.MCALL QIOW$
.MCALL QIOW$S
.MCALL DIR$
.MCALL MRKT$S ; Mark time
.MCALL GTIM$S ; Get time
.MCALL DECL$S ; Declare significant event
.MCALL SETF$S ; Set event flag
.MCALL WTSE$ ; Wait for single event flag
.MCALL WTSE$S ; Wait for single event flag
.MCALL CLEF$S ; Clear event flag
.MCALL RDEF$S ; Read event flag
.SBTTL Definitions
;
; Definitions
;
.MCALL KERDEF
KERDEF ; Get the definitions from the library
.MCALL CHRDEF ; Get the character definitions
CHRDEF ; Expand them
.MCALL MSG ; Text message macro
.MCALL BLSRTN ; Allow use of BLISS macros from
.MCALL BLSCAL ; library
.MCALL PJMP ; Call and return
.SBTTL Data Section
.PSECT $OWN$, D
NUMRTY: .BLKW 1 ; Number of retries to display
ABORT:: .BLKW 1 ; Flag that we must abort receive/send
DTOT: .blkw 2 ; Locations to hold calculations of
DMORE: .blkw 2 ; time in milliseconds
XFRDIR: .BLKW ; Transfer direction
SCRPTD: .BLKB 1 ; Flag whether screen is painted
LSTXFR: .BLKB 1 ; Subtype argument from last S$IXFR call
KEYQIO: .BLKB 1 ; Flag whether a QIO is pending
BRKBUF: .BLKB 5 ; Buffer for reading key
.EVEN ; Ensure even addresses again
KEYGMC: .BLKB 2 ; Data for get multiple characteristics
.SBTTL Data Section
.PSECT $PLIT$, RO , D
SCRLON: .ASCIZ <.CHCSI>/16;24r/ ; Set scrolling to lines 16 - 24
SCRLOF: .ASCIZ <.CHCSI>/0;24r/ ; Set scrolloing to full screen
.SBTTL Transfer status text
; Header
MSG XFR,<PRO/Kermit File transfer status>
; Information
M$XFRI: .ASCII <.CHCSI>/3;10HPacket number: 0 (dec)/
.ASCII <.CHCSI>/5;10HNumber of Retries: 0 (dec)/
.ASCII <.CHCSI>/11;6HPress INTERRUPT to skip a file,/
.ASCII / CANCEL to skip rest of transfer,/
.ASCII <.CHCSI>/12;6HMAIN SCREEN or EXIT to return to Kermit/
.ASCII / before transfer completes,/
.ASCII <.CHCSI>/13;6HF5 to retry, ADDNL OPTIONS to turn debugging on/
.ASCIZ / or off/
XFRI$L=.-M$XFRI
M$SERV: .ASCIZ <.CHCSI>/7;10HServer idle /
M$GENE: .ASCIZ <.CHCSI>/7;10HGeneric command /
M$RFIL: .ASCIZ <.CHCSI>/7;10HReceiving file: /
M$SFIL: .ASCIZ <.CHCSI>/7;10HSending file: /;27
M$PKPS: .ASCIZ <.CHCSI>/3;30H /<.CHCSI>/3;30H/
M$NKPS: .ASCIZ <.CHCSI>/5;30H /<.CHCSI>/5;30H/
M$CFLN: .ASCII <.CHCSI>/7;26H /
.ASCIZ <.CHCSI>/7;26H/
M$SCUR: .ASCIZ <.CHESC>/7/
M$RCUR: .ASCIZ <.CHESC>/8/
M$PSCR: .ASCIZ <.CHCSI>/20;H/
M$SUCC::
.ASCIZ /File transfer completed successfully/
SUCC$L==.-M$SUCC
M$ABOR::
.ASCIZ <.CHBEL>/File transfer aborted/
ABOR$L==.-M$ABOR
.EVEN
.SBTTL LIST macro definition
.MACRO LIST NAME,MCRNAM
C$'NAME:
.MACRO L CODE,ADDR
.WORD CODE
.ENDM
MCRNAM ; Generate codes
L$'NAME=<.-C$'NAME>/2
E$'NAME=.
.MACRO L CODE,ADDR
.WORD ADDR
.ENDM
MCRNAM ; Generate addresses
.ENDM
;++
;The following are tables for the XFR.STATUS routine
;--
.MACRO MIXFR ; XFR.STATUS I-type table
L 'S,M$SFIL
L 'R,M$RFIL
L 'G,M$GENE
.ENDM
LIST IXFR,MIXFR ; Generate table
.MACRO MFXFR ; XFR.STATUS F-type table
L 'C,M$CXFR
L 'X,M$XXFR
L 'Z,M$ZXFR
L 'D,M$DXFR
L 'A,M$AXFR
.ENDM
LIST FXFR,MFXFR ; Generate table
M$FXFR: .ASCII <.CHCSI>/9;10HFile: /
.ASCIZ <.CHCSI>/9;16H/
M$CXFR: .ASCIZ / transfer completed/
M$XXFR: .ASCIZ / aborted by user/
M$ZXFR: .ASCIZ / Group aborted by user/
M$DXFR: .ASCIZ / aborted but saved/
M$AXFR: .ASCIZ / aborted due to protocol error/
.EVEN
.SBTTL Command dispatch tables for KERFIL task
;++
; The following macro defines the various routines to call if we have
; received information from the command scanner.
;--
.MACRO TCMDS
L $TKGEN,X$GEN
L $TKXIT,X$EXIT
L $TKRCV,X$RECV
L $TKSND,X$SEND
L $TKSRV,X$SERV
.ENDM
LIST CMDS, TCMDS
.SBTTL Start of KERSCR program section
;++
; This is the main loop for the file transfer task. It will wait until
; an event occurs for it.
;--
.PSECT $CODE$, RO
FOZZIE: BIS #TRUE,RUN ; Flag running
SREX$C EXIAST,,$CODE$ ; Specify EXIT ast routine
DIR$ #ASSIGN,IOERR ; Do the assign terminal LUN routine
; located at assign.
ALUN$C XKLUN,XK,0,$CODE$ ; Assign XK LUN
JSR PC,INILIB ; Initialize the library routines
BLSCAL MSG.INIT ; Do the initialization of KERMSG
BLSCAL TT.INIT ; Set up the terminal routines
JSR PC,XFRINI ; Initialize the XFR module
MOV #N$FIL,R0 ; Claim I'm KERFIL
MOV #N$KER,R1 ; And I talk to KERMIT
JSR PC,IT$INI ; Initialize intertask
MOV #INTRPT,R0 ; Get the routine
JSR PC,IT$PAS ; Post as AST routine to call
;
; Now enter the MAIN KERFIL loop.
;
LOOP: CLR ABORT ; Nothing is aborted currently
CLEF$S #CONEFN ; Clear this EFN (used to abort KERFIL)
BIC #TRUE,RUN ; Flag not running any more
MOV #FALSE,NOSCRN ; Allow type out again
WTSE$S #ITCEFN ; Wait until we get the EFN
CLEF$S #ITCEFN ; Clear the event flag
JSR PC,IT$RDA ; Receive the data sent to me
BCC LOOP ; Failed to get data, loop
;
; Now to find the function and dispatch to the correct routine
;
MOV #C$CMDS,R1 ; Get the table address
MOV #L$CMDS,R2 ; Get the length into R2
10$: CMP R0,(R1)+ ; Is this the entry?
BEQ 20$ ; Yes, handle it
SOB R2,10$ ; Loop for all items in the table
;
; If we didn't find the entry, send back the NAK
;
MOV #$TKNAK,R0 ; Get the function to send
JSR PC,IT$SDA ; Send the data
;
15$: JSR PC,NOTIFY ; Notify KERFIL we are done
BR LOOP ; Go back to sleep until needed again
;
; Here if we found the function to process
;
20$: BIS #TRUE,RUN ; Flag I'm now running
MOV R1,-(SP) ; Save the offset
MOV #$TKOK,R0 ; Send back the OK
JSR PC,IT$SDA ; Send the information
MOV (SP)+,R0 ; Get the address of the table entry
BCC 15$ ; Failed, so skip this attempt
;
; Now call the routine to do the function
;
ADD #<L$CMDS*2>-2,R0 ; Point to the address
MOV (R0),R0 ; Get the address to call
JSR PC,@R0 ; Call the routine
JSR PC,NOTIFY ; Notify KERMIT we are done
BR LOOP ; Go back to sleep until needed again
;
; Here if Kermit requested us to exit. Tell it ok and do so
;
X$EXIT: PJMP EXIT ; And shut down
.SBTTL EXIT AST routine
;+
; This routine is called when the task is aborted or attempts
; to exit.
;
; Usage:
; Called by AST level
;--
.PSECT $CODE$, RO,I
EXIAST: BIC #TRUE,RUN ; We aren't running any more
ADD (SP),SP ; Adjust the stack
ASTX$S ; Return to the caller
.SBTTL Notify routine - Tell KERMIT we are finished
;++
; This routine will notify the KERMIT task that it should start processing
; commands. It doesn't necessarly mean that KERFIL is finished the transfer
; just that we aren't playing with the screen any more.
;
; Usage:
; JSR PC,NOTIFY
; (Return)
;
;--
.PSECT $CODE$, RO, I
NOTIFY: MOV R0,-(SP) ; Save this incase needed
MOV #$TKOK,R0 ; Get the information to send
JSR PC,IT$SDA ; Send the data to the other end
MOV (SP)+,R0 ; Restore the register
RTS PC ; Return to the caller
.SBTTL Interrupt routine
;++
; This routine is called when we receive a message when we are currently
; running. This routine will check to see what to do with the interrupt.
;
; Usage:
; JSR PC,INTRPT
;
;--
.PSECT $CODE$, RO, I
INTRPT: BIT #TRUE,RUN ; Are we running?
BEQ 99$ ; No, must be at loop level ignore this
;
; Here if we have gotten an interrupt for the inter-task communication and
; we are currently running. We must now repaint the screen and cause the
; keyboard to be enabled.
;
JSR PC,IT$RDA ; Get the data KERMIT sent
CMP R0,#$TKPAI ; Paint the screen?
BEQ 10$ ; Branch if so
CMP R0,#$TKABT ; Forced abort?
BEQ 10$ ; Yes, send an OK back
MOV #$TKNAK,R0 ; No, send a NAK back
JSR PC,IT$SDA ; Send the data
BR 99$ ; Return to the caller
;
; Here to send the ACK back to the caller
;
10$: MOV R0,-(SP) ; Save the item on the stack
MOV #$TKOK,R0 ; Get the ACK function
JSR PC,IT$SDA ; Send the data
MOV (SP)+,R0 ; Get the item back from the stack
CMP R0,#$TKABT ; Is this the forced abort?
BEQ 20$ ; Yes, handle it
JSR PC,X$PAINT ; Repaint the screen
RTS PC ; Return to the caller
;
; Here to handle the forced abort by the user.
;
20$: MOV #TRUE,ABORT ; Flag we must abort this
SETF$S #CONEFN ; Set the EFN to kick the XK
;
; Now return to the caller
;
99$: RTS PC ; Just return for now
.SBTTL Cause screen to be repainted
;++
; This routine will cause the screen to be repainted and the keys to be
; enabled. This routine will be called from the interrupt routine and
; should only do something if KERFIL is running.
;
; Usage:
; JSR PC,X$PAINT
; (Return)
;
;--
.PSECT $CODE$, RO, I
X$PAINT:CLRB SCRPTD ; Claim the screen is not painted
CLR NOSCRN ; Allow screen output again
MOV LSTXFR,R1 ; Get the last type of thing we did
JSR PC,S$IXFR ; Paint the screen
RTS PC ; Return to the caller
.SBTTL Transfer status -- Initialization
;++
; This routine will paint the initialize screen for the file transfer.
; It will return to the caller after the screen has been initilized.
;
; Usage:
; R0/ XFR.STATUS type value ("I")
; R1/ XFR.STATUS subtype value
; JSR PC,S$IXFR ; Initilize the screen
; ; display for transfers
; (Return)
;
;--
.PSECT $CODE$, RO
S$IXFR: BIT #TRUE,NOSCRN ;[01] Screen update suppressed?
BNE 99$ ;[01] Yes, no sense doing anything
MOV #L$IXFR,R3 ; Get the length of the table
MOV #C$IXFR,R2 ; Get the address of the codes that
5$: CMP R1,(R2)+ ; could be passes, check the next one
BEQ 6$ ; If we have a match then branch
SOB R3,5$ ; Loop for all commands
RTS PC ; Just return if unknown call
6$: ADD #<L$IXFR*2>-2,R2 ; Point to other table
MOVB R1,LSTXFR ; Save last call argument
TSTB SCRPTD ; Check to see if screen painted
BNE 7$ ; If painted then skip
BLSCAL PAINT,<#M$XFR,#XFR$L,#15.> ; Call the screen painter
BLSCAL TT.TEXT,#M$XFRI ; Output the information part
7$: BLSCAL TT.TEXT,@R2,+ ; Call the routine to output direction
BLSCAL TT.TEXT,#M$CFLN,+ ; Clear the file name area
CMPB R1,#'G ; Check for GENERIC
BEQ 10$ ; If generic then don't ouput file name
MOV #FILE.NAME,R0 ; Point at the file name
ADD FILE.SIZE,R0 ; Point to the end
CLRB (R0)+ ; Clear the end of it
BLSCAL TT.TEXT,#FILE.NAME,+ ; Output the file name
10$: BLSCAL TT.TEXT,#SCRLON,+ ; Turn on the scrolling region
BLSCAL TT.TEXT,#M$PSCR,+ ; Position to the scrolling region
BLSCAL TT.TEXT,#CUROFF,+ ; Turn the cursor off
BLSCAL TT.OUTPUT,,- ; Force it out on the scree
CMPB #'R,R1 ; Are we receiving?
BNE 15$ ; No, then branch
CLR XFRDIR ; Yes, clear XFRDIR for other routines
15$: CLR NUMRTY ; No NUMRTY yet
MOVB #-1,SCRPTD ; Screen is now painted
99$: RTS PC ; Return to the caller
.SBTTL Transfer status -- File name writer
;++
; This routine will write the file name that we are processing over the file
; name that was displayed on the screen. To do this it will first erase
; the file name that is on the screen and then paint the new file specification
;
; Usage:
; JSR PC,S$WFLN
; (Return)
;
;--
.PSECT $CODE$, RO
.GLOBL S$WFLN
S$WFLN: BLSCAL TT.TEXT,#M$SCUR,+ ; Save current position
BLSCAL TT.TEXT,#M$CFLN,+ ; Position and clear file name
MOV #FILE.NAME,R0 ; Point at the file name
ADD FILE.SIZE,R0 ; Point to the end
CLRB (R0)+ ; Clear the end of it
BLSCAL TT.TEXT,#FILE.NAME,+ ; Output the file name
BLSCAL TT.TEXT,#M$RCUR,+ ; Position back to scrolling region
BLSCAL TT.OUTPUT,,- ; Finish it off
RTS PC ; Return to the caller
.SBTTL Transfer status -- Per packet - XFR.STATUS
;++
; This routine is called with the information about how the transfer
; of information is progressing. It will call with two arguments.
; One determines if we are sending or receiving and the other is
; if we just processed an ACK/NAK.
;
; Usage:
;
; Bliss:
;
;
; XFR_STATUS (Type, Subtype);
;
; Type: "S" - Send, "R" - Receive
; Subtype: "P" - Packet
; "N" - NAK
; "T" - timeout
; For type = "I" (initiate), "T" (terminate):
; Subtype: "S" - a file send
; "R" - a file receive
; "G" - a generic command
; "I" - for "T" only, returning to server idle
; For type = "F" (file operation):
; Subtype: "S" - open for sending
; "R" - open for receiving
; "C" - closing file OK
; "X" - aborting file by user request
; "Z" - aborting group by user request
; "D" - aborting file, but saving due to disposition
; "A" - aborting file due to protocol error
;--
.PSECT $CODE$, RO
BLSRTN XFR.STATUS,4,<TYPE,SUBTYPE>
TST GENFLG ;[05] Is the generic command flag on ?
BNE 199$ ;[05] Yes, branch.
MOV TYPE(SP),R0 ; Get main type
MOV SUBTYPE(SP),R1 ; And subtype
CMPB #'I,R0 ; Initiate command?
BNE 20$ ; No, then branch
PJMP S$IXFR ; Call initiate routine
20$: BIT #TRUE,NOSCRN ; No desire for screen stuff?
BNE 23$ ; If not, don't bother painting
TSTB KEYQIO ; We have the screen, is the QIO up?
BNE 21$ ; If so, leave it
JSR PC,INIKEY ; If not, queue it up again
21$: TSTB SCRPTD ; Screen current?
BNE 23$ ; If so check for other commands
MOVB LSTXFR,R1 ; Else get the last S$IXFR arg
BNE 22$ ; Branch if something there
MOV #'G,R1 ; Assume generic
22$: MOV NUMRTY,-(SP) ; Save number of retries
JSR PC,S$IXFR ; Do the initial painting
MOV (SP)+,NUMRTY ; Restore number of retries
MOV TYPE(SP),R0 ; Get the arguments back
MOV SUBTYPE(SP),R1 ; . . .
23$: CMPB #'T,R0 ; Check for terminate command
BNE 30$ ; No, then branch
CMPB #'I,R1 ; Check for return to IDLE SERVER
BNE 25$ ; No, then branch
BLSCAL TT.TEXT,#M$SCUR,+ ; Save current position, etc.
BLSCAL TT.TEXT,#M$SERV,+ ; Ouput the idle server message
BLSCAL TT.TEXT,#M$CFLN,+ ; Clear the file name area
BLSCAL TT.TEXT,#M$RCUR,+ ; Restore position, etc.
BLSCAL TT.OUTPUT,,- ; Force it
25$: RTS PC ; Return to sender
;
; Here if not an initiate or terminal call
;
30$: CMPB #'S,R0 ; Check for Send type
BEQ 35$ ; If yes then branch
CMPB #'R,R0 ; Check for Receive type
BNE 40$ ; If no then branch
35$: CMP #'N,R1 ; NAK packet?
BEQ 100$ ; Yes, go handle it
CMP #'T,R1 ; No, timeout?
BNE 120$ ; No, must have been good packet
;
; Here if we timed out. If we are sending a file this will cause a
;retry, so count it. If we are receiving a file, this will cause a
;NAK to be sent, which will cause the retry count to be upped.
;
TST XFRDIR ; Check direction of transfer
BNE 100$ ; If sending, handle like NAK
RTS PC ; Otherwise ignore it
; Here if we are either sending or receiving a NAK or have timed out
;while sending. Bump our retry counter and display it
100$: MOV #M$NKPS,R2 ; Get the NAK position msg
INC NUMRTY ; Count it
MOV NUMRTY,R3 ; And get the count
BR 140$ ; Display new count
; Here if we are processing a packet. Determine if we sent the packet or
; if the packet was received.
120$: MOV #M$PKPS,R2 ; Get the packet position msg
CMP #'S,R0 ; Sending?
BEQ 130$ ; Yes, process it this way
; Here if the packet was sent
TST XFRDIR ; Sending?
BNE 199$ ; No, return
MOV SMSG.COUNT,R3 ; Yes, get the send packet count
BR 140$ ; Join common code
; Here to handle the receive packet processing
130$: TST XFRDIR ; Receiving?
BEQ 199$ ; No, return
MOV RMSG.COUNT,R3 ; Get the receive packet count
; Here to display the information on the screen.
140$: BLSCAL TT.TEXT,#M$SCUR,+ ; Save current position
BLSCAL TT.TEXT,R2,+ ; Clear the area
BLSCAL TT.NUMBER,R3,+ ; Output the number
BLSCAL TT.TEXT,#M$RCUR,+ ; Back to the scrolling region
BLSCAL TT.OUTPUT,,- ; Output the text
; Here to just return to the caller
199$: RTS PC ; Return
; Here if not initiate, terminate or message call
40$: CMPB #'F,R0 ; Check for file command
BNE 50$ ; No, then branch
CMPB #'S,R1 ; Check for send subcode
BEQ 41$ ; Yes, then branch
CMPB #'R,R1 ; Check for receive subcode
BNE 43$ ; No, then branch
41$: PJMP S$WFLN ; Output the new file name
; Here so must be closing the file for some reason
43$: MOV #L$FXFR,R2 ; Get the length of the table
MOV #C$FXFR,R3 ; Get the address of the codes that
44$: CMP R1,(R3)+ ; could be passes, check the next one
BEQ 45$ ; If we have a match then branch
SOB R2,44$ ; Loop for all commands
RTS PC ; Not found, just return
45$: ADD #<L$FXFR*2>-2,R3 ; Point to other table
BLSCAL TT.TEXT,#M$SCUR,+ ; Save current position
BLSCAL TT.TEXT,#M$FXFR,+ ; Position to correct line
BLSCAL TT.TEXT,#FILE.NAME,+ ; Dump the file name
BLSCAL TT.TEXT,(R3),+ ; Output the text
BLSCAL TT.TEXT,#M$RCUR,+ ; Restore current position
BLSCAL TT.OUTPUT,,- ; Force the text out
50$: RTS PC ; Return to sender
.SBTTL Transfer status -- Reset screen
;++
; This routine will reset the screen after having displayed the transfer
; status information. It will clear the screen and the scrolling region.
; It will then return to the caller
;
; Usage:
; JSR PC,S$RXFR
; (Return)
;
;--
.PSECT $CODE$, RO
.GLOBL S$RXFR ; Global routine
S$RXFR: BLSCAL TT.TEXT,#SCRLOF,+ ; Turn off the scrolling region
; (Note: S$CLEAR forces text out)
BLSCAL TT.TEXT,#CURON,- ; Turn the cursor back on
JSR PC,S$CLEAR ; Clear the screen and home cursor
CLRB SCRPTD ; Screen no longer painted
RTS PC ; Return to the caller
.SBTTL Bliss interface -- SY_TIME
; This routine will return a millisecond count in R0
;
; INPUT: None
;
; OUTPUT: R0 contains the count
;
; REGISTERS destroyed: NONE
;
; NOTE: local foo [2];
; sy_time(foo);
.PSECT $CODE$, RO
SY.TIME::
MOV 2(SP),TMPADR ; Get the buffer address and save it
JSR R1,$SAVE5 ; Save some registers
mov #dtot,R1 ; Get the address of the total
mov R1,-(sp) ; Push address for the addition
mov #dmore,-(sp) ; routine onto the stack
mov R1,-(sp) ;
clr (R1)+ ; Clear the total of the time
clr (R1) ; in milliseconds
gtim$s #timloc ; Get the current time
mov #g.tict,R1
mov timloc(R1),R3 ; Get the number of ticks
mov #1000.,R4 ; Convert to number of milliticks
mul R4,R3 ;
clr R2 ; Clear the high word
mov #64.,R5 ; Set division by 64.
div R5,R2 ; Divide to get number of milliseconds
mov #dmore,R0
mov R2,(R0)+ ; Save the result in DMORE, DMORE+2
clr (R0)
jsr pc,sy.dadd ; Add to the total
mov #g.tisc,R1 ; Get the offset for seconds
mov timloc(R1),R3 ; Get the number of seconds
mul R4,R3 ; Convert to milliseconds
mov R3,dmore ; Save for the add routine
jsr pc,sy.dadd ; Add to the current total
mov #g.timi,R1 ; Get the offset for minutes
mov timloc(R1),R3 ; Get the number of minutes
mov #1000.*60.,R4 ; Move the factor to R4 to
mul R4,R2 ; convert to milliseconds
mov #dmore,R0 ; get the storage address
mov R2,(R0)+ ; Save the low order word
mov R3,(R0) ; Save the high order word
jsr pc,sy.dadd ; Add to current total
cmp (sp)+,(sp)+ ; Pull the extra addresses off the
tst (sp)+ ; stack
mov #tmpadr,R0 ; Get the address to save the answer in
mov #dtot,R1 ; Get the place where it is
mov (R1)+,(R0)+ ; Move the answer to the correct place
mov (R1),(R0)
mov #knormal,R0 ; Set no error
rts pc ; Return to sender
.SBTTL SY.DADD - Subroutine to add two long words
; This routine will add two numbers that are each two words long
;
; INPUT: The addresses of the numbers on the stack
;
; Stack: Address of one number
; Address of other number
; Address to store the result in
;
; OUTPUT: The numbers are added and stored in the specified location
; R0 is set to knormal (no error)
;
; REGISTERS destroyed: NONE
;
; SY_DADD(A,B,C) ==> A = B + C (R2 + R1 = R3)
.PSECT $CODE$, RO
BLSRTN SY.DADD,4,<ANUM,BNUM,CNUM>
MOV CNUM(SP),R1 ; Get the address of C
MOV BNUM(SP),R2 ; Get the address of B
MOV ANUM(SP),R3 ; GET the address of A
mov (R2)+,R4 ; Add least significant words
add (R1)+,R4 ;
mov R4,(R3)+ ; Save result
mov (R2),R4 ; Get most significant word
adc R4 ; Add carry from last add(if any)
add (R1),R4 ; Add on other word
mov R4,(R3) ; Save result
rts pc ; Return to sender
.SBTTL Bliss interface -- SY.DSUB - DP subtraction
; This routine will subtract two numbers that are each two words long
;
; INPUT: The addresses of the numbers on the stack
;
; Stack: Address of the number to subtract
; Address of the number to subtract from
; Address to store the result in
;
; OUTPUT: The difference of the numbers is stored in
; the specified location
; R0 is set to knormal (no error)
;
; REGISTERS destroyed: NONE
;
; SY_DSUB(A,B,C) ==> A = B - C (R2 - R1 = R3)
.PSECT $CODE$, RO
BLSRTN SY.DSUB,4,<ANUM,BNUM,CNUM>
MOV CNUM(SP),R1 ; Get the address of C
MOV BNUM(SP),R2 ; Get the address of B
MOV ANUM(SP),R3 ; GET the address of A
MOV (R2)+,R4 ; Subtract least significant words
SUB (R1)+,R4 ;
MOV R4,(R3)+ ; Save result
MOV (R2),R4 ; Get most significant word
SBC R4 ; Subtract carry from last sub(if any)
SUB (R1),R4 ; Subtract off other word
MOV R4,(R3) ; Save result
MOV #KNORMAL,R0 ; Set no error
RTS PC ; Return to sender
.SBTTL Bliss interface -- SY.DISMISS - Wait some amount of time
; This routine will wait the specified amount of time
;
; INPUT: The amount of time in seconds to wait must
; be on the stack under the return address
;
; OUTPUT: NONE - Time is wasted
; Nothing is changed in this routine
;
; REGISTERS destroyed: NONE
;
.PSECT $CODE$, RO
BLSRTN SY.DISMISS,0,DSMTIM
MOV DSMTIM(SP),R0 ; Get the amount of time to dismiss
CLEF$S #GENEFN ; Clear the flag
MRKT$S #GENEFN,R0,#2. ; Macro to wait R0 seconds. This
; uses the general EFN.
WTSE$S #GENEFN ; Wait for time to expire
MOV #KNORMAL,R0 ; Set no error
RTS PC ; Return to sender
.SBTTL Keyboard routines for transfer active
;
; These routines will handle the keyboard during an active transfer.
;This allows the transfer to be interrupted, or modified based on input
;from the user.
;
; Usage:
; JSR PC,INIKEY ; Set up initial QIO
;
; JSR PC,KILKEY ; Kill any pending QIO
;
.PSECT $CODE$, RO
INIKEY::MOVB #-1,KEYQIO ; Flag it is up
QIO$C IO.RAL!TF.RNE,TERLUN,TTREFN,,IOSTAT,ASTCHK,<BRKBUF,1.>,$CODE$
RTS PC ; And return
KILKEY::TSTB KEYQIO ; Anything queued up?
BEQ RETRN ; If not, nothing to kill
QIO$C IO.KIL,TERLUN,TTREFN,,,,,$CODE$ ; Kill the pending QIO
RETRN: RTS PC ; And return
; AST routine to handle actual key input
ASTCHK::
JSR PC,DOAST ; Do the AST processing
TST (SP)+ ; Pull one item off stack for AST
ASTX$S ; End ast.
DOAST: JSR R1,$SAVE5 ; Save some registers
TSTB IOSTAT ; Any errors?
BPL 10$ ; If not, just continue
CLRB KEYQIO ; No QIO pending now
RTS PC ; Just return
10$: CMPB BRKBUFF,#.CHESC ; Did we get an ESCAPE?
BNE 110$ ; No so its just junk
MOVB #TC.TBF,KEYGMC ; Store code for get character count
QIOW$S #SF.GMC,#TERLUN,#TTREFN,,#IOSTAT,,<#KEYGMC,#2.>
MOVB KEYGMC+1,R0 ; Find out how many keys are there
BEQ 110$ ; If none then just an escape
CMP R0,#4 ; Make sure there are no more than
BLT 12$ ; four chars. that we read
MOV #4,R0 ; Set equal to four since really more
12$: QIOW$S #IO.RAL!TF.RNE,#TERLUN,#TTREFN,,#IOSTAT,,<#BRKBUFF,R0>
MOV #BRKBUFF,R1 ; Point at start of buffer
CMPB (R1)+,#'[ ; Is the next an open bracket ?
BNE 110$ ; No, branch.
CMPB (R1)+,#'2 ; Is the next byte a 2 ?
BNE 30$ ; No branch.
CMPB (R1),#'6 ; Additional options key?
BEQ 40$ ; Yes, handle it
CMPB (R1),#'0 ; Is the next byte a 0 (MAIN SCREEN) ?
BEQ 20$ ; Yes, branch.
CMPB (R1),#'1 ; Or was it a 1 (EXIT key) ?
BNE 110$ ; No, branch.
; If we get a main screen or exit key, give up the terminal and return
;it to KERMIT. Keep the transfer in progress
20$: CLRB KEYQIO ; No QIO pending
MOV #TRUE,NOSCRN ; Stop screen update
CLRB SCRPTD ; Screen not painted anymore
JSR PC,NOTIFY ; Notify KERMIT it can process commands
RTS PC ; Return to the caller
30$: CMPB -1(R1),#'1 ; Or was that byte a 1 (INTERUPT) ?
BNE 110$ ; No branch.
CMPB (R1),#'7 ; Is the next byte a 7 ?
BNE 100$ ; No, branch.
MOV #TRUE,ABT.CUR.FILE ; Set up abort current file flag.
BR 999$ ; Queue up read again
; Here for additional options key. Just complement the debug flag
40$: COM DEBUG.FLAG ; Do it
BR 999$ ; Queue up the read again
; Here for F5 and CANCEL keys
100$: CMPB (R1),#'5 ; Was it F5?
BEQ 105$ ; Yes, handle it
CMPB (R1),#'9 ; Or was it a 9 (CANCEL) ?
BNE 110$
MOV #TRUE,ABT.ALL.FILE
BR 999$ ; Queue up the read again
; Here for an F5. Force a timeout so we will NAK. We do this by setting
; the GENEFN event flag, which XK would be waiting for.
105$: SETF$S #GENEFN ; Time to try again
BR 999$ ; Queue up read again
110$: BLSCAL TT.CHAR,#.CHBEL ; Output the message
BLSCAL TT.OUTPUT ; Output any remaining characters
999$: PJMP INIKEY ; Requeue the input
.SBTTL End of KERSCR
.END FOZZIE ; That's all folks! (Ribbit)