.TITLE VTLSUB - VTL Subroutines. .IDENT /1.8/ .ENABL LC ;+ ; ; Free software BY ; Project Software & Development, Inc. ; ; This software is furnished for free and may be used and copied as ; desired. This software or any other copies thereof may be provided or ; otherwise made available to any other person. No title to and ; ownership of the software is hereby transferred or allowed. ; ; The information in this software is subject to change without notice ; and should not be construed as a commitment by PROJECT SOFTWARE ; AND DEVELOPMENT, INC. ; ; PROJECT SOFTWARE assumes no responsibility for the use or reliability ; of this software on any equipment whatsoever. ; ; Project Software & Development, Inc. ; 14 Story St. ; Cambridge, Ma. 02138 ; 617-661-1444 ; ; ; Title: VTLSUB.MAC ; Author: Robin Miller ; Date: July 20, 1983 ; ; Description: ; ; This module contains various subroutines for the VTL program. ; ;- .ENABL AMA .NLIST BEX .MCALL ASTX$S, CMKT$S, DIR$, MRKT$S, QIOW$, TTSYM$ .MCALL CSI$, FCSBT$, NBOFF$ ; STRICT = 0 ; Define for strict parsing syntax. ;+ ; ; Modification History: ; ; February 21, 1985 by Robin Miller. Edit (08), Version 1.8 ; Check for CTRL/C being typed when searching or the first file ; to prevent error messages from aborted functions. ; ; February 13, 1985 by Robin Miller. Edit (07), Version 1.7 ; Don't enable escape sequences for our terminal. Instead, we ; will clear this attribute to ensure the escape sequences are ; passed to us. The read with escape sequences don't work with ; an IO.RTT function on an RSX-11M/M+ system and they don't work ; through DECNET to a VAX/VMS system. ; ; February 13, 1985 by Robin Miller. Edit (06), Version 1.6 ; Use MOVB when picking up the typeahead buffer count. The ; MOV word instruction was causing an odd address trap. ; ; October 29, 1984 by Robin Miller. Edit (05), Version 1.5 ; Fix problem with edit (01). When terminal type is other than ; VT100, set AVO option in SWMASK word instead of STATUS word. ; ; June 7, 1984 by Robin Miller. Edit (03), Version 1.4 ; Call routine VMSPRS to parse multiple file specifications when ; running on VMS to allow "file,file1,...,filen" syntax. ; ; June 7, 1984 by Robin Miller. Edit (02), Version 1.3 ; On VMS, if there are no VMS wildcard characters in the filespec, ; use the normal RSX open routines because they are faster. ; ( Removed this edit ... didn't seem that much faster. ) ; ; June 6, 1984 by Robin Miller. Version 1.2 ; Add routines STIMER, DOWORK, and CTIMER to display working message ; for routines which take awhile to complete. ; ; May 23, 1984 by Robin Miller. Edit (01), Version 1.1 ; Presume terminal has AVO option if other than VT100 terminal. ; ;- ; Bit and offset definitions: CSI$ ; Define the CSI offsets. FCSBT$ DEF$L ; Define the FCS bits locally. NBOFF$ DEF$L ; Define the FNB offsets locally. TTSYM$ ; Define the terminal symbols. NB.SFL = NB.SD1!NB.SD2!NB.SNM!NB.STP!NB.SVR ; All wildcard bits. ; Local equates: DLYTIM = 2 ; The number of seconds to delay SECNDS = 2 ; Time unit for seconds. ; Local messages: WAITM: .ASCIZ "Press any key to continue: " CTRCM: .ASCIZ "Aborted by CTRL/C" .EVEN ; QIOW's to get and set the terminal characteristics. GETCHA: QIOW$ SF.GMC,TOLUN,TOEFN,,TIOSB,, ; Get term. char. SETCHA: QIOW$ SF.SMC,TOLUN,TOEFN,,TIOSB,, ; Set term. char. CLRTAH: QIOW$ SF.SMC,TOLUN,TOEFN,,TIOSB,, ; Clear typeahead. GETTAH: QIOW$ SF.GMC,TOLUN,TOEFN,,TIOSB,, ; Get typehead. ; Local storage: TTYBUF: .BYTE TC.TTP ; Get the terminal type. TTYPE:: .BYTE T.V100 ; Default to a VT100. TTYSIZ = .-TTYBUF ; Size of status table. SETBUF: .BYTE TC.ESQ,0 ; Enable escape sequences. (07) SETSIZ = .-SETBUF TAHBUF::.BYTE TC.TBF,1 ; Clear/get typeahead buffer count. TAHSIZ = .-TAHBUF .SBTTL ADDBEL - Add a bell to a buffer. ;+ ; ; ADDBEL - Add a bell to a buffer. ; ; This routine is called to a BELL character to a buffer. The bell is ; not added to the buffer if suppressing of the bell has been requested. ; ; Inputs: ; R0 = The buffer address. ; ; Outputs: ; R0 = The updated buffer address. ; ; All other registers are preserved. ; ;- ADDBEL::BIT #B.BELL,SWMASK ; Is ringing of bell suppressed ? BEQ 10$ ; If EQ, yes. MOVB #BELL,(R0)+ ; Nope, append the bell. CLRB (R0) ; And terminate with a null. 10$: RETURN .SBTTL ADJSEC - Adjust the section size. ;+ ; ; ADJSEC - Adjust the section size. ; ; This routine is used to adjust the section size after the number of ; lines to be displayed has been changed. The formula used to calculate ; the section size is: ; ; (max_lines - ((max_lines) / 5) + 1)) = section_size. ; i.e.: ; (20 - ((20 / 5) + 1)) = 15 ; (10 - ((10 / 5) + 1)) = 7 ; (05 - ((05 / 5) + 1)) = 3 ; ; Implicit inputs: ; O.USIZ = The user specified section size (overrides adjustment). ; ; Outputs: ; All registers are preserved. ; ;- ADJSEC::CALL $SAVAL ; Save all registers. MOV IENTRY,R5 ; Copy the file entry address. MOV O.USIZ(R5),R2 ; User specified section size ? BNE 10$ ; If NE, yes (use it). CALL CALMAX ; Calculate the maximum lines. MOV R1,R2 ; Save the maximum lines. CLR R0 ; Prepare for the divide. DIV #5,R0 ; Do the 32 bit division: ; R0 = the quotient. ; R1 = the remainder. INC R0 ; Adjust the size by one. SUB R0,R2 ; Calculate the section size. 10$: MOV R2,O.SSIZ(R5) ; Save the new section size. RETURN .SBTTL CHCTRC - Check for CTRL/C being typed. ;+ ; ; CHCTRC - Check for CTRL/C being typed. ; ; This routine is used to check for CTRL/C being typed to abort a function. ; If CTRL/C has been typed, the current cursor position is saved and then ; restored after displaying the abort message. This is done since the ; CTRL/C detection has been deferred until after returning from the table ; parser. At that time, the cursor should be positioned in preparation for ; the next line to be displayed. ; ; Implicit inputs: ; STATUS = CTRL/C typed flag (B.CTRC = bit 15). ; ; Outputs: ; C bit clear/set = CTRL/C not typed / CTRL/C typed. ; ; All registers are preserved. ; ;- CHCTRC::JSR R2,$SAVVR ; Save R0 - R2. TST STATUS ; Was CTRL/C typed to abort ? BPL 100$ ; If PL, no (C bit cleared). MOV #FMTBUF,R0 ; Set address of output buffer. CALL SAVEC ; Save the current cursor position. CALL SETMSG ; Setup to write to message line. MOV #CTRCM,R1 ; Set address of CTRL/C message. CALL MOVEC ; Append it to the output buffer. CALL RESTC ; Restore the cursor position. CALL TYPMSG ; Now display the message. BIC #B.CTRC,STATUS ; Reset the CTRL/C typed flag. SEC ; Show CTRL/C was typed. 100$: RETURN .SBTTL CTTYPE - Check the terminal type. ;+ ; ; CTTYPE - Check the terminal type. ; ; This routine is used to ensure the terminal being used is a VT100 ; family terminal. If it is not, an appropriate error message is ; displayed and we exit from the program. ; ; Inputs: ; None. ; ; Outputs: ; C bit clear/set = success/failure. ; ; All registers are preserved. ; ;- .ENABL LSB CTTYPE::CALL $SAVAL ; Save all registers. DIR$ #GETCHA ; Get the terminal type. CALL CHKERR ; Check for any errors. BCS 30$ ; If CS, we've had an error. ; Ensure the terminal is of the VT100 family. CMPB TTYPE,#T.V100 ; Are we running on a VT100 ? BEQ 10$ ; If EQ, yes (continue ...). ; Range of VT100 terminals is T.V101 (24) through T.V132 (31). CMPB TTYPE,#T.V101 ; Is this possible VT100 family ? BLO 20$ ; If LO, no CMPB TTYPE,#T.V132 ; Really a VT100 family terminal ? BHI 20$ ; If HI, no BIS #B.AVO,SWMASK ; Presume we have the AVO option. (05) 10$: CALL ANSI ; Put the VT100 in ANSI mode. CALL SETNAR ; Set the screen to narrow mode. BIC #B.STUP,SWMASK ; Show no longer in startup code. DIR$ #SETCHA ; Disable software escape sequences.(07) CALL CHKERR ; Check for any errors. BR 30$ ; And return with C bit clear/set. 20$: ERRMSG NVT100,<%VTL-F-NVT100, not a VT100 family terminal.> SEC ; Show the terminal check failed. 30$: RETURN .DSABL LSB .SBTTL CTYPAH - Clear the typeahead buffer. ;+ ; ; CTYPAH - Clear the typeahead buffer. ; ; Inputs: ; None. ; ; Outputs: ; All registers are preserved. ; ;- CTYPAH::DIR$ #CLRTAH ; Clear the typehead buffer. CALL CHKERR ; Check/report any errors. RETURN .SBTTL GTYPAH - Get the typeahead buffer count. ;+ ; ; GTYPAH - Get the typeahead buffer count. ; ; Inputs: ; None. ; ; Outputs: ; C bit clear/set = typeahead count / no count. ; ; R1 = The typeahead buffer count. ; ;- GTYPAH::DIR$ #GETTAH ; Get the typeahead buffer count. CALL CHKERR ; Check/report any errors. BCS 10$ ; If CS, we had an error. MOVB TAHBUF+1,R1 ; Else, copy typeahead count. (06) BNE 10$ ; If NE, there was a count. (06) SEC ; Show there was nothing. (06) 10$: RETURN .SBTTL DISESC - Disable escape sequences. ;+ ; ; DISESC - Disable escape sequences. ; ; This routine is called when we exit to disable the escape sequences. ; If this is not done, programs such as EDT will not work with the keypad. ; ; Inputs: ; None. ; ; Outputs: ; All registers are preserved. ; ;- DISESC:: ;*** CLRB SETBUF+1 ; Clear to disable escape seq. (07) ;*** DIR$ #SETCHA ; Now do it. (07) ;*** CALL CHKERR ; Check/report any errors. (07) RETURN .SBTTL DOOPEN - Do the initial file open. ;+ ; ; DOOPEN - Do the initial file open. ; ; This routine is called to do the command line parsing and opening of ; the first input file. ; ; Inputs: ; R0 = The input buffer address. ; R1 = The buffer byte count. ; ; Outputs: ; C bit clear/set = success/failure. ; ; All registers are preserved. ; ;- DOOPEN::CALL $SAVAL ; Save all registers. MOV IENTRY,R5 ; Copy the file entry address. MOV O.FPTR(R5),INPTR ; Copy address of the input buffer. BIC #^C,STATUS ; Initialize status bits. ; Parse the command line using the table parser. MOV #START,R5 ; Set the starting state address. CALL DOPARS ; Now parse the command line. BCS 90$ ; If CS, we had an error parsing. ; The command line has been successfully parsed. BIT #B.CMNT,STATUS ; Did we encounter a comment line ? BNE 90$ ; If NE, yes (return failure). BIT #B.IFIL,STATUS ; Was an input file specified ? BEQ 90$ ; If EQ, no (return failure). ; Open the first input file. 10$: MOV IENTRY,R5 ; Set active file entry address. MOV O.FDB(R5),R0 ; Copy the FDB address. MOV O.FPTR(R5),R1 ; Copy address of the input buffer. .IFNDF RSX11M TST VAXFLG ; Are we running on VAX/VMS ? BEQ 20$ ; If EQ, no (use normal open). ;*** BIS #S.RSX,(R5) ; Presume no VMS wildcards. (02) ;*** CALL VMSWLD ; Wildcards in the file spec ? (02) ;*** BCS 20$ ; If CS, no (use RSX parsing). (02) ;*** BIC #S.RSX,(R5) ; Show using VMS wildcards. (02) CALL VMSPRS ; Parse multiple file names. (03) CLR O.CONT(R5) ; Clear the context longword CLR O.CONT+2(R5) ; for VMS wildcard lookup. CALL DOVMS ; Do the VMS wildcard lookup. BCC 15$ ; If CC, open expanded file name. BIT #B.NATV,SWMASK ; Was the native mode routine found ? BEQ 20$ ; If EQ, no (use the normal open). BR 30$ ; Yes, report the error message. 15$: MOV O.FNAM(R5),R1 ; Set address of expanded file name. .ENDC ;IFNDF RSX11M 20$: CALL OPENR ; Try to open the input file. BCC 100$ ; If CC, success. 30$: TST STATUS ; Was CTRL/C typed to abort ? (08) BMI 90$ ; If MI, yes (inhibit error). (08) CALL OPERR ; Report error/get the next file. BCC 100$ ; If CC, success. 90$: SEC ; Show failure to open file. 100$: RETURN .SBTTL DOPARS - Parse the command line. ;+ ; ; DOPARS - Parse the command line. ; ; Use .TPARS to parse the command line. ; ; Inputs to DOPARS: ; R0 = The buffer address. ; R1 = The buffer byte count. ; R5 = The starting state address. ; ; Inputs to .TPARS: ; R1 = Bit 0 in the low byte controls processing of blanks/tabs: ; if 0, ignore blanks, if 1 then pass blanks and tabs. ; The high byte contains the number of characters that ; keywords are alloewed to be abbreviated (0 = exact). ; R2 = The keyword table address. ; R3 = The input string byte count. ; R4 = The input buffer address. ; R5 = The starting state address. ; ; Outputs from .TPARS: ; C bit clear/set = success/failure. ; ; R3 = Zero on success or ; remaining byte count on syntax error. ; R4 = End of input string or ; updated buffer address on syntax error. ; ; All other registers from .TPARS are preserved. ; ;- DOPARS::CALL $SAVAL ; Save all registers. MOV R0,R4 ; Copy the buffer address. MOV R1,R3 ; Copy the buffer byte count. MOV #<<400*1>+0>,R1 ; Ignore blanks, match 1 character. MOV #KEYWRD,R2 ; Address of the keyword table. CALL .TPARS ; Now parse the command line. .IF NDF STRICT BCC 100$ ; If CC, success. .IFF BCS 10$ ; If CS, we had an error. BIT #B.CMNT,STATUS ; Was a comment line encountered ? BNE 100$ ; If NE, yes (don't report error). ; Don't flag error if spaces and/or tabs at end of command line. CALL SKIP ; Skip any tabs and/or spaces. TST R3 ; Any unprocessed characters ? BEQ 100$ ; If EQ, no (this is success). .ENDC ;STRICT 10$: CALL WRTSYN ; Write the syntax error. 100$: RETURN .IF DF STRICT .SBTTL SKIP - Skip tabs and/or spaces. ;+ ; ; SKIP - Skip tabs and/or spaces. ; ; Inputs: ; R3 = The byte count. ; R4 = The buffer address. ; ; Outputs: ; R3 & R4 are adjusted past any tabs and/or spaces. ; ; All other registers are preserved. ; ;- SKIP: TST R3 ; Any byte count left ? BEQ 100$ ; If EQ, no. CMPB (R4),#SPACE ; Is this a space ? BEQ 10$ ; If EQ, yes. CMPB (R4),#HT ; Is this a horizontal tab ? BNE 100$ ; If NE, no. 10$: INC R4 ; Adjust the buffer address. SOB R3,SKIP ; And loop on the byte count. 100$: RETURN .ENDC ;STRICT .SBTTL DOWAIT - Wait before continuing. ;+ ; ; DOWAIT - Wait before continuing. ; PRSPEC - Do special prompting of the user. ; PRUSER - Entry point to always prompt the user. ; PRWAIT - Entry point to always prompt or delay. ; ; These routines are called when we want to wait for the user to respond ; before continuing. If the user has disabled the wait (prompt) feature, ; we delay several seconds to give them time to read the error message. ; ; Actually, we don't wait unless input is from a command file, wildcards are ; active, or multiple files was specified. ; ; Inputs: ; None. ; ; Outputs: ; All registers are preserved. ; ; Implicit outputs: ; TMPBUF = The character typed to continue. ; B.EXIT is set in STATUS if the response is "E". ; B.NEXT is set in STATUS if the response is "N". ; ;- .ENABL LSB DOWAIT::CALL $SAVAL ; Save all registers. MOV IENTRY,R5 ; Copy the file entry address. MOV O.FNB(R5),R4 ; Copy the FNB address. BIT #B.2FIL,STATUS ; Are we displaying two files ? BNE 10$ ; If NE, yes (prompt the user). .IFNDF RSX11M ; VAX/VMS specific code. CALL VMSWLD ; Check for VAX/VMS wildcards. BCC 10$ ; If CC, there is a wildcard. .ENDC ;.IFNDF RSX11M MOV #GCLBLK,R0 ; Set address of the control block. BITB #FD.TTY,F.RCTL(R0) ; Is input from the terminal ? BEQ 10$ ; If EQ, no (presume command file). BIT #NB.SFL,N.STAT(R4) ; Are there any wildcards active ? BNE 10$ ; If NE, yes. MOV O.CSI(R5),R4 ; Copy the CSI bock address. BITB #CS.MOR,C.STAT(R4) ; Were multiple files specified ? BNE 10$ ; If NE, yes. RETURN ; No, don't bother waiting. ; ; This routine is used when set temporarily to narrow screen when ; listing files in wide mode with no advanced video option. ; PRSPEC::MOV STATUS,-(SP) ; Save the current status word. BIC #B.132,STATUS ; Disable wide screen mode. CALL PRUSER ; Prompt the user for response. BIS (SP)+,STATUS ; Restore previous status word. RETURN ; Wait several seconds before we continue. PRWAIT::CALL $SAVAL ; Save all registers. 10$: BIT #B.WAIT,SWMASK ; Should we prompt or delay ? BNE 20$ ; If NE, we should prompt. MOV #DLYTIM,R0 ; Set number of seconds to delay. MOV #SECNDS,R1 ; Set the time unit for seconds. CALL DELAY ; Now, delay for awhile. BR 100$ ; And continue ... ; Prompt the user before we continue. PRUSER::CALL $SAVAL ; Save all registers. 20$: MOV #FMTBUF,R0 ; Set address of output buffer. CALL CPYPRL ; Position to the prompt line. CALL BOLD ; Add the BOLD video attribute. MOV #WAITM,R1 ; Set the wait message address. CALL MOVEC ; Append it to the output buffer. CALL ATTOFF ; Turn off the video attributes. CALL VTYPE ; Now write it to the terminal. MOV #TMPBUF,R0 ; Set the input buffer address. MOV #1,R1 ; Set the character count to read. CALL GETCMD ; Now, wait until the user responds. ; If the user responds with "E", presume end of listing. CMPB (R0),#'E ; Does the user want to exit ? BNE 90$ ; If NE, no (check for next). BIS #B.EXIT,STATUS ; Yes, show we are exiting. BR 100$ ; And continue ... ; If the user responds with "N", presume display next file. 90$: CMPB (R0),#'N ; Does user want the next file ? BNE 100$ ; If NE, no (continue ...) BIS #B.NEXT,STATUS ; Yes, presume display next file. 100$: RETURN .DSABL LSB .SBTTL STIMER - Start the timer. ;+ ; ; STIMER - Start the timer. ; ; This routine is called to start a timer which when it expires will enter ; an AST routine to display the working message at the screen. ; ; Inputs: ; None. ; ; Outputs: ; All registers are preserved. ; ;- STIMER::JSR R2,$SAVVR ; Save R0 - R2. BIC #B.CTIM,SWMASK ; Clear the timer aborted flag. MRKT$S ,#2,#SECNDS,#DOWORK ; Start working message timer. CALL CHKDIR ; Check/display any errors. RETURN .SBTTL CTIMER - Cancel the timer. ;+ ; ; CTIMER - Cancel the timer. ; ; This routine is called to disable a previously enabled timer. ; ; Inputs: ; None. ; ; Outputs: ; All registers are perserved. ; ;- CTIMER::BIS #B.CTIM,SWMASK ; Show timer has been aborted. CMKT$S ; Cancel all outstanding timers. RETURN .SBTTL DOWORK - Display the working message. ;+ ; ; DOWORK - Display the working message. ; ; This routine is entered after the timer expires to display the working ; message at the screen. ; ; Inputs: ; None. ; ; Outputs: ; All registers are preserved. ; ;- DOWORK::CALL WRTWRK ; Call routine to write message. BIT #B.CTIM,SWMASK ; Has the timer been aborted ? BNE 10$ ; If EQ, yes (don't start again). CALL STIMER ; Start the timer again. 10$: TST (SP)+ ; Clear event flag from stack. ASTX$S ; Exit from the AST routine. .END