.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, ; 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 #-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 #-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, 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 #-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, 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, 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,,$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)