Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/source/tecprs.mac
There are 3 other files named tecprs.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1970, 1971, 1972, Digital Equipment Corp., Maynard, Mass.
; Additions and revisions to produce version 200
; Copyright (c) 1979 Stevens Institute of Technology, Hoboken, New Jersey
; 07030.
; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
; TECO Project
; Computer Center
; Stevens Institute of Technology
; Castle Point Station
; Hoboken, New Jersey 07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.
; Search needed universals
SEARCH JOBDAT ; Get the job data definitions
SEARCH TECUNV ; TECO universal file
; Generate the prologue
TECVER==200 ; Major version number
TECMIN==1 ; Minor version number
TECEDT==1172 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(PRS,<TECO Command parser>) ; Generate the TITLE and other stuff
IFN FTDEBUG,<OPDEF CONTIN[JRSTF @.JBOPC]>
SUBTTL Table of Contents
;+
;.pag.lit
; Table of Contents for TECPRS - Command parsing
;
;
; Section Page
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. REENTER from the monitor . . . . . . . . . . . . . . . 4
; 5. P$INIT - Parser initialization . . . . . . . . . . . . 5
; 6. Command character fetching
; 6.1. SKRCH - Conditionally read a character. . . . 6
; 6.2. RCH - Read a character. . . . . . . . . . . . 7
; 6.3. RCHSVD - Fetch a saved character. . . . . . . 8
; 6.4. REEAT . . . . . . . . . . . . . . . . . . . . 8
; 7. Command string scanner . . . . . . . . . . . . . . . . 9
; 8. Command processing . . . . . . . . . . . . . . . . . . 10
; 9. C$INIT - Per command initialization. . . . . . . . . . 11
; 10. CLNXS - Clean up the XS stack. . . . . . . . . . . . . 12
; 11. Command input
; 11.1. P$INPT. . . . . . . . . . . . . . . . . . . . 13
; 11.2. Standard
; 11.2.1. First character dispatch . . . . . . 14
; 11.2.2. Main loop. . . . . . . . . . . . . . 15
; 11.2.3. Special characters . . . . . . . . . 15
; 11.2.4. Control G. . . . . . . . . . . . . . 16
; 11.2.5. Control R. . . . . . . . . . . . . . 17
; 11.2.6. Escape . . . . . . . . . . . . . . . 17
; 11.2.7. Control U. . . . . . . . . . . . . . 18
; 11.2.8. Utility routines
; 11.2.8.1. C$BLIN. . . . . . . . . . . 19
; 11.2.8.2. BACKUP. . . . . . . . . . . 20
; 11.3. Video
; 11.3.1. C$VID. . . . . . . . . . . . . . . . 21
; 12. Immediate commands
; 12.1. I$1LT - Do +1LT . . . . . . . . . . . . . . . 22
; 12.2. I$N1LT - Do a -LT . . . . . . . . . . . . . . 23
; 12.3. I$0LT - Do a 0LT. . . . . . . . . . . . . . . 24
; 12.4. I$QREG - Store last command in Q register . . 25
; 12.5. I$1L - Do a 1L command. . . . . . . . . . . . 26
; 12.6. I$N1L - Do a -1L command. . . . . . . . . . . 26
; 12.7. I$0L - Do a 0L command. . . . . . . . . . . . 26
; 12.8. I$1C - Do old video 1C. . . . . . . . . . . . 26
; 12.9. I$1R - Do old video 1R. . . . . . . . . . . . 26
; 12.10. I$FFD - Do a refresh (form feed command). . . 26
; 13. Command buffer
; 13.1. CB$INI - Initialization . . . . . . . . . . . 27
; 13.2. CB$MOV - Move a string into the command buffer 28
; 13.3. CB$STO - Store a character into the command buffer 29
; 14. Rubout processing
; 14.1. Old style . . . . . . . . . . . . . . . . . . 30
; 14.2. Video . . . . . . . . . . . . . . . . . . . . 31
; 14.3. BACCR . . . . . . . . . . . . . . . . . . . . 32
; 14.4. BACBAK - Back over a backspace. . . . . . . . 32
; 14.5. BACNON - Backup no characters . . . . . . . . 32
; 14.6. BACTAB - Back over a tab. . . . . . . . . . . 33
; 14.7. BACREW - Retype the line after wrap around. . 34
; 14.8. HORPOS. . . . . . . . . . . . . . . . . . . . 35
; 14.9. BACONE & BACTWO . . . . . . . . . . . . . . . 36
; 14.10. CHRLEN. . . . . . . . . . . . . . . . . . . . 37
; 15. C$XCT - Execute a command in the command buffer. . . . 38
; 16. Command execution
; 16.1. Argument processing
; 16.1.1. ARGARG . . . . . . . . . . . . . . . 41
; 16.1.2. ARGNON . . . . . . . . . . . . . . . 41
; 16.1.3. ARGMK1 . . . . . . . . . . . . . . . 41
; 16.1.4. ARGD12 . . . . . . . . . . . . . . . 41
; 16.1.5. ARGMY1 . . . . . . . . . . . . . . . 42
; 16.1.6. ARGMY2 . . . . . . . . . . . . . . . 42
; 16.1.7. ARGM12 . . . . . . . . . . . . . . . 43
; 16.1.8. ARGMH1 . . . . . . . . . . . . . . . 43
; 16.1.9. ARGMH2 . . . . . . . . . . . . . . . 43
; 16.2. Value returning
; 16.2.1. VALNON . . . . . . . . . . . . . . . 44
; 16.2.2. VALRT1 . . . . . . . . . . . . . . . 44
; 16.2.3. VALRT2 . . . . . . . . . . . . . . . 45
; 16.2.4. VALPAS . . . . . . . . . . . . . . . 45
; 16.3. Subroutines
; 16.3.1. RETZER . . . . . . . . . . . . . . . 46
; 16.3.2. RTONES . . . . . . . . . . . . . . . 46
; 16.3.3. VALRET . . . . . . . . . . . . . . . 46
; 16.3.4. OPENP. . . . . . . . . . . . . . . . 47
; 16.3.5. CLOSEP . . . . . . . . . . . . . . . 48
; 16.4. Argument processing
; 16.4.1. CAND - And operator. . . . . . . . . 49
; 16.4.2. COR - OR operator. . . . . . . . . . 49
; 16.4.3. PLUS - '+' operator. . . . . . . . . 50
; 16.4.4. MINUS - '-' operator . . . . . . . . 50
; 16.4.5. SLASH - '/' operator . . . . . . . . 51
; 16.4.6. TIMES - '*' operator . . . . . . . . 51
; 16.4.7. ^O (Octal input) . . . . . . . . . . 52
; 16.5. Subroutines
; 16.5.1. CDNUM. . . . . . . . . . . . . . . . 53
; 16.5.2. STOP . . . . . . . . . . . . . . . . 54
; 16.5.3. COMMA - Argument delimiter . . . . . 55
; 16.5.4. ALTMOD - Commad delimiter. . . . . . 56
; 17. Low segment for TECPRS . . . . . . . . . . . . . . . . 58
; 18. End of TECPRS. . . . . . . . . . . . . . . . . . . . . 59
;.end lit.pag
;-
SUBTTL Revision History
COMMENT |
1000 Start of this version
1012 By: Nick Bush On: 6-August-1980
Fix the fast search algorithm. Under certain circumstances, it was looking
one character too far in the buffer. If this character happened to match,
it could claim that the string was found when in fact it did not exist
in the buffer. This would also end up with PT set at Z+1 leading to
all sorts of problems (including PTD stopcodes in video mode).
Also make REE (reenter) save all of the Tx ac's before calling lower
level routines which use them. There are numerous places where not
doing this can cause random errors.
Modules: TECPRS,TECSRH
1014 By: Nick Bush On: 11-August-1980
1) Don't do the AUTO-BUFFER command if we had a error on the last command.
This avoids losing info for the error messages.
2) Make an EB/ER/EX sequence end up renaming the correct files, not
trying to rename the ER'ed file to the EB'ed file.BAK, ...
3) Make TEC file=file work the way it is supposed to.
Modules: TECPRS,TECFIL,TECECM,TECINI
1020 By: Robert McQueen On: 13-August-1980
REENTER at the wrong time cause an ill mem ref. One of the times was when
you typed ^C to the --More-- processing.
Modules: TECPRS
1042 By: Robert McQueen On: 3-September-1980
Don't reinitialize the symbol table management until C$XCT, otherwise
symbols we are typing out in error messages go away.
Modules: TECPRS
1052 By: Nick Bush On: 12-November-1980
Make sure RCHSVD gets cleared when we start command execution.
Also make :M(FOOBAR) work correctly.
Modules: TECPRS,TECCMD
1053 By: Robert McQueen On: 12-November-1980
RCHSVD should have been LASTCH, otherwise you get an ill mem ref.
Modules: TECPRS
1062 By: Nick Bush On: 18-December-1980
Add n^D command to go down one screen line staying in the same column.
Also add ^D as an immediate command to do a 1^D and ^U to do a -1^D.
Modules: TECPRS,TECTBL,TECMVM
1077 By: Nick Bush On: 6-Febuary-1981
1) Add routine do delete all tags for a given text buffer, and have it
called anytime the buffer becomes editable, or is destroyed.
2) Reset CUREDT to point at TXTBUF anytime the q-register which it points
at becomes disassociated with it.
Modules: TECUNV,TECPRS,TECCMD,TECECM,TECSYM
Start of Version 200A(1126)
1127 By: Nick Bush@SIT, Robert C. McQueen@SIT On: 15-October-1981
Add the following new features:
- String arguments. {...} is a string argument.
- Make I take them, = and == return them.
- Implement the FC command to define immediate command tables
- Implement the E? command to return various items.
- Start doing some work so that TECO will work on TOPS-20
- Start doing some work so that TECO some day may run in a section
besides zero.
Modules: TECUNV,TECERR,TECPRS,TECCMD,TECSRH,TECMEM,TECUUO,TECECM,TECMVM,TECCOM,TECINI
1132 By: Nick Bush On: 10-December-1981
1) Add Q-register data types for the sake of FC(Q-reg)SAVE$ and
FC(Q-reg)RESTORE$ commands.
2) Fix FC(q-reg)REPLACE$ to correctly replace the ALWAYS and OTHER options.
Modules: TECUNV,TECCMD,TECECM,TECMEM,TECPRS,TECMVM
1137 By: Nick Bush On: 1-January-1982
Fix clean up of Q-register stack. It had not been taught about Q-reg
data types.
Modules: TECPRS
1144 By: Nick Bush On: 4-January-1982
Fix commands which take an optional numeric argument to work correctly
within expressions. (I.e., 100+%1).
Modules: TECPRS
1145 By: Nick Bush On: 8-Febuary-1982
Re-write command input routines to implement FI command. As part of this
allow user to set prompt by storing the prompt text for normal commands in
the Q-register 'COMMAND-PROMPT'.
Modules: TECUNV,TECPRS,TECCIN,TECFCM,TECVID,TECUPD
1151 By: Nick Bush On: 24-March-1982
Add Q-register 'EXIT-BUFFER' to be executed whenever TECO is exiting.
Also remove the string to set VT-100's to smooth scroll on exit. This
can now be done by putting the correct macro in 'EXIT-BUFFER'.
Modules: TECUNV,TECECM,TECPRS,TECTBL,TECDEC
1160 By: Nick Bush On: 10-May-1982
Don't save XCTING while executing the exit Q-regs. REENTER was broken
if that was done.
Modules: TECPRS
1161 By: Nick Bush On: 13-May-1982
Add new code to support peek-ahead for immediate (FC table) commands and
for a new form of the control-T command.
Add the new form of the control-T command to allow macros to peek at
input, and to make use of timed input. Also add the Q-register
TERMINAL-INPUT-BUFFER to hold the text being peeked at, with the side
effect of allowing macros to store text into the Q-register, and have
it be treated as input typed on the terminal.
Also change the space command to just pass through the arguments unless
EO is set to 4 or less.
Modules: TECUNV,TECVID,TECUPD,TECMVM,TECPRS,TECTRM,TECCMD,TECTBL
1170 By: Nick Bush On: 22-June-1982
Save XCTING (flag whether execting commands) over execution of EXIT-COMMAND.
If this is not done, then the EX command will not work when something is
in EXIT-COMMAND.
Modules: TECPRS
1171 By: Nick Bush On: 29-June-1982
Fix * and ? from screwing up after an error when a long prompt is being used.
Modules: TECUNV,TECPRS,TECUUO
1172 By: Nick Bush On: 4-August-1982
Fix log file processing (old input mode) to correctly skip the
prompt in the buffer.
Modules: TECPRS
|
SUBTTL REENTER from the monitor
;+
;.HL1 REE
; This routine handles the monitor REENTER command. It will immediately
;stop any typeout, and reset the terminal. If we are in a long command
;which can be aborted (normally a type out command) or are waiting for
;command type-in, we will reprompt immediately for the next command.
;Otherwise, we will continue the current command. If a second ^C REENTER
;command is done before the command completes, it will immediately abort,
;regardless of the consequences (can leave things confused at times).
;If the command completes first, the main command loop will notice that
;a REENTER occured, and will abort before getting another command.
;-
$CODE ; This is code
REE: PORTAL .+1 ; Entry point from where ever
CLRBFO ; Stop typeout
IFN FTDEBUG,<
;** Temp for debugging
TXZ F,F.FCON ; Turn of immediate command processing
> ; End of IFN FTDEBUG
PUSH P,T1 ; Save a few registers
PUSH P,T2 ; . .
PUSH P,T3 ; Save T3
PUSH P,T4 ; And T4
MOVEI T1,TTYFDB ; Get the file access block
PUSHJ P,F$RSET ; Reset the terminal
JFCL ; Could not happen
MOVX T1,$IOWRI ; Get the function
MOVEI T2,TTYFDB ; Get the terminal FDB
PUSHJ P,F$OPEN ; Open it
JFCL ; Can not happen
SKIPN ECHOFF ; Echo supposed to be off?
JRST REE.2 ; No, skip this
SETZM ECHOFF ; Yes, clear the flag
PUSHJ P,T$CECH ; And make sure echo goes off
REE.2: SETZM IMGFLG ; Flag not in image mode any more
JMPNS REE.1 ; Screen mode?
SETOM MESFLG ; Flag we need to do a complete refresh
PUSHJ P,SC$ERS ; Clear the lines, so everything will refresh
REE.1: POP P,T4 ; Restore the ac's
POP P,T3 ; . . .
POP P,T2 ; Restore T2
POP P,T1 ; And T1
SKIPGE XCTXQR ; reenter during exit routine shouldn't stop things
AOSN XCTING ; Command in progress ?
JRSTF @.JBOPC ; Continue
JRST COMND ; Go to the start of command processing
SUBTTL P$INIT - Parser initialization
;+
;.HL1 P$INIT
; This routine will do the parser initialization. It will clear the low segment
;and return to the caller.
;.literal
;
; Usage:
; PUSHJ P,P$INIT
; (Return)
;.end literal
;-
P$INIT: STORE T1,P$ZBEG,P$ZEND,0 ; Clear the low segment
; Now set up QTAB with the correct Q-register name info
MOVSI P1,-200 ; Get the number of characters to check
MOVX T2,CF.QRG ; And the flag to check
MOVX T3,CF.LC ; Also get lower case flag
PINI.1: TDNN T3,CHRFLG(P1) ; Lower case?
TDNN T2,CHRFLG(P1) ; No, is this a valid Q-register name?
JRST PINI.2 ; Not a Q-reg name (or lower case)
LOAD. T1,CDTQRI,+CHRFLG(P1) ; Get the index
IMULX T1,$QRLEN ; Convert to the offset
HRRZM P1,$QRQRN+QTAB(T1) ; Store the name
PINI.2: AOBJN P1,PINI.1 ; Loop for all possible names
; Now do the predefined long names
MOVE P1,[XWD -QNMLEN,QNMTBL] ; Get the pointer
PINI.3: MOVE T3,(P1) ; Get the address of the info
DMOVE T1,2(T3) ; Get the Q-reg address and flags
MOVE T3,(T3) ; And the byte pointer to the name
IORM T2,$QRFLG(T1) ; Turn on the right flags
MOVEM T3,$QRQRN(T1) ; And store the name pointer
AOBJN P1,PINI.3 ; Loop for all of the names
PJRST CCIINI ; Set up the control-C intercept and return
SUBTTL Command character fetching -- SKRCH - Conditionally read a character
;+
;.HL2 SKRCH
;This routine will determine if there are any more characters
;at this level to fetch. If there are it will return the character.
;.literal
;
; Usage:
; PUSHJ P,SKRCH
; (Error return -- No more characters)
; (Normal return -- Character in CH)
;-
SKRCH: PUSHJ P,RCHSVD ; Get the saved character (if any)
JRST .POPJ1 ; Have one, return now
$SAVE <T1,T2> ; Save T1
LOAD. T2,TPTADR,+XCTBUF ; Get the address of the execution buffer
LOAD. T1,BLKPT,(T2) ; Get the address of PT
CFMG. ,BLKEND,(T2),T1 ; At the end ?
POPJ P, ; Yes
AOS (P) ; No, give good return
PJRST RCH.0 ; No - Get the next character
SUBTTL Command character fetching -- RCH - Read a character
;+
;.HL2 RCH
;This routine will input a character from the execution buffer.
;.literal
;
; Usage:
; PUSHJ P,RCH
; (Return -- Character in CH)
;-
RCH: PUSHJ P,RCHSVD ; Get the saved character (if any)
POPJ P, ; Return happy
$SAVE <T1,T2> ; Save T1 and T2
RCH.2: LOAD. T2,TPTADR,+XCTBUF ; Get the buffer address
; Special entry point from SKRCH
RCH.0: INCR. T1,BLKPT,(T2) ; Increment PT
CFMGE. ,BLKEND,(T2),T1 ; At the end of the buffer
JRST RCH.1 ; Yes - Pop up to a higher level
ILDB CH,.BKPTR(T2) ; Get the character
PUSHJ P,ALTEO ; Convert any altmodes
TXNE F,F.TRAC ; Tracing ?
TXNE S,S.NTRC ; But is it being suppressed ?
POPJ P, ; No tracing or being suppressed
PJRST T$OCHR ; Trace mode - Type the character
; Here to pop to an upper level
RCH.1: DECR. ,BLKPT,(T2) ; Backup the pointer in case this becomes a text buffer
SKIPGE XCTXQR ; Doing one of the exit routines?
JRST RCH.3 ; No, skip these checks
LOAD. T1,TPTADR,+$QRTPT+XITQRG ; Get the address of the exit QRG
CAMN T1,T2 ; Is this it?
JRST [MOVEI CH,.CHESC ; Yes, return an escape
POPJ P,] ; . . .
LOAD. T1,TPTADR,+$QRTPT+CTCQRG ; Get the address of the control-C Q-reg
CAMN T1,T2 ; Is this the one?
JRST [MOVEI CH,.CHESC ; Yes, return an escape
POPJ P,] ; . . .
RCH.3: SOSGE EQM ; Decrement the macro count
SETZM EQM ; Don't allow it to go negative
; or people will screw up
LOAD. T2,XSBTYP,(XS) ; Get the type
CAXE T2,$XEMAC ; Is it a macro?
ERROR E.IAB
MOVEI T1,XCTBUF ; Get the address of the buffer
PUSHJ P,M$RELB ; Release it
LOAD. T1,TPTADR,+$XSBUF(XS) ; Get the address
MOVEI T2,XCTBUF ; Get the address of the buffer
PUSHJ P,M$USEB ; Insert it
MOVEI T1,$XSBUF(XS) ; Get the pointer
PUSHJ P,M$RELB ; And release this reference
LOAD. T1,XSBERA,(XS) ; Get the error position
MOVEM T1,ERRPT ; Restore the error point
LOAD. T1,XSBFLG,(XS) ; Get the flags
$ADJSP XS,-$XSMLN ; Remove the items from the stack
TXNN T1,F.COLN ; Colon flag on then ?
JRST RCH.2 ; Try again
TXOE F,F.ARG ; Was there already an argument?
JRST RCH.2 ; Yes, don't kill it
TXO F,F.ACLN ; Flag now have an argument from a colon
SETOB A1,ARG$1 ; Zero argument
JRST RCH.2 ; And continue
SUBTTL Command character fetching -- RCHSVD - Fetch a saved character
;+
;.hl1 RCHSVD
; This routine will get the saved character, if there is one.
;.b
;.literal
; Usage:
; PUSHJ P,RCHSVD
; (Have saved char in CH)
; (No saved character)
;
;.end literal
;-
RCHSVD: SETZ CH, ; Clear the character
EXCH CH,LASTCH ; Get the saved character
JUMPE CH,.POPJ1 ; If none, give the skip return
POPJ P, ; Else just return the character
SUBTTL Command character fetching -- REEAT
;+
;.hl1 REEAT
; This routine will save a character so it will be the next character
;fetched from the RCH routines.
;.b
;.literal
; Usage:
; MOVEI CH,character
; PUSHJ P,REEAT
; (return here)
;
;.end literal
;-
REEAT: SKIPE LASTCH ; Have a character already?
STOPCD R2C,<REEAT called for second character>
MOVEM CH,LASTCH ; Save the character
POPJ P, ; And return
SUBTTL Command string scanner
;+
;.HL1 SKAN
; This routine will scan the command string for a given character.
;It will return with the pointers set up for the character following
;the given character. It will not return the character if it is
;inside of a string argument (unless EO <= EO21) or if it is inside
;of a string starting with the other given character.
;.b.lit
; Usage:
; MOVEI T2,Character.to.find
; MOVEI T3,Character.starting.ignored.strings
; PUSHJ P,SKAN
; (End of command)
; (Found character)
;
;.end literal
;-
SKAN: MOVE T1,[XWD REEAT,SKRCH] ; Get the default routines
SKANST: TXO S,S.NTRC ; Flag no tracing
HLRZM T1,SKNREA ; Save the address of the re-eat routine
HRRZM T1,SKNRCH ; Save the address of the get-a-char routine
MOVE T1,[IFIW CHRTBL(CH)] ; Set up the table pointers
MOVEM T1,SKNTBL ; . . .
MOVE T1,[IFIW CHRFLG(CH)] ; Also to the flag table
MOVEM T1,SKNFLG ; . . .
SETZ T4, ; Clear the depth counter
SKAN.0: PUSHJ P,@SKNRCH ; Get a character
POPJ P, ; Give the not found return
CAIN CH,(T2) ; Character we are looking for?
SOJL T4,SKAN.E ; Yes, go check if done
CAIN CH,(T3) ; Is this the start of a string to ignore?
AOJ T4, ; Yes, count it
CHKEO EO21,SKAN.0 ; If old style, don't bother checking for strings
SKAN.2: LOAD T1,@SKNFLG,CF.ECA ; Check if extended command table
JMPF T1,SKAN.3 ; If so must fix table pointers
LOAD. T1,CDTCMD,+@SKNTBL ; Get the pointer address
MOVE T1,(T1) ; And get the pointer
HLRM T1,SKNFLG ; Store in the flag pointer
HRRM T1,SKNTBL ; And the table pointer
PUSHJ P,@SKNRCH ; Get the next character
POPJ P, ; Couldn't
JRST SKAN.2 ; And go try again
SKAN.3: LOAD. T1,CDTPST,+@SKNFLG ; Get the post command argument type
PUSH P,@SKNFLG ; Save the flags
PUSHJ P,@SKNARG(T1) ; Go handle the arg
PJRST .T1PJ ; Return if we hit end of command
POP P,T1 ; Get back the flags
TXNN T1,CF.RST ; Restore the tables?
JRST SKAN.0 ; Go get the next character
TXNN T1,CF.AT ; Don't clear @ flag on?
TXZ F,F.SLSL ; No, clear the flag
MOVEI T1,CHRTBL ; Get the main table address
HRRM T1,SKNTBL ; Save it
MOVEI T1,CHRFLG ; Get the flag table address
HRRM T1,SKNFLG ; Save it
JRST SKAN.0 ; And loop for the next character
; Here when we have found the character
SKAN.E: TXZ S,S.NTRC ; Flag we are no scanning anymore
PJRST .POPJ1 ; And return
TABDEF SKNARG,.CP
TABENT NON,<IFIW!.POPJ1> ; No argument
TABENT QRG,<IFIW!SKNQRG> ; Q-register name
TABENT CHR,<IFIW!@SKNRCH> ; Single character
TABENT ALT,<IFIW!SKNALT> ; Simple altmode terminated string
TABENT DEL,<IFIW!SKNDEL> ; Simple string terminated by same character
TABENT INS,<IFIW!SKNINS> ; Insert string
TABENT SRH,<IFIW!SKNSRH> ; Search string
TABENT SIN,<IFIW!SKNSIN> ; Search string then insert string
TABENT AT, <IFIW!SKNAT> ; "@" command prefix
TABENT PW, <IFIW!SKNPW> ; Possible PW command
TABENT SAG,<IFIW!SKNSAG> ; String argument (terminated by })
TABEND
; Here to scan off a Q-register name. Possibilities are a single
;character, or a string enclosed in parens.
SKNQRG: PUSHJ P,@SKNRCH ; Get a character
POPJ P, ; Couldn't
CAIE CH,"(" ; Open paren?
PJRST .POPJ1 ; No, all done
MOVEI CH,")" ; Yes, get the delimeter
PJRST SKNDEL ; And go look for it
; Here to scan off a simple string terminated by an altmode
SKNALT: MOVX CH,.CHESC ; Get te delimeter
FALL SKNDEL ; And join common routine
; Here to scan off a string terminated by the character in CH
SKNDEL: $SAVE <P1> ; Save P1
MOVE P1,CH ; And save the delimeter character
SKND.0: PUSHJ P,@SKNRCH ; Get a character
POPJ P, ; Couldn't
CAIE CH,(P1) ; Correct character?
JRST SKND.0 ; No, get the next
PJRST .POPJ1 ; Yes, give the skip return
; Here to check for possible "PW" command
SKNPW: PUSHJ P,@SKNRCH ; Get the next character
POPJ P, ; Couldn't
AOS (P) ; Give skip return
CAIE CH,"W" ; Is it a W
CAIN CH,"w" ; or a lower case w?
POPJ P, ; Yes, return
PJRST @SKNREA ; No, go back up a character
; Here to scan over an insert string
SKNINS: $SAVE <P1> ; Save P1
TXZN F,F.SLSL ; See an "@" first?
JRST SKNI.0 ; No, skip this
PUSHJ P,@SKNRCH ; Yes, get the delimeter character
POPJ P, ; Couldn't
SKIPA P1,CH ; Get the character into P1
SKNI.0: MOVX P1,.CHESC ; Not delimeted mode, use an escape
SKNI.1: PUSHJ P,@SKNRCH ; Get the next character
POPJ P, ; Couldn't
CAIN CH,(P1) ; Is this the end?
PJRST .POPJ1 ; Yes, return
CAIE CH,$CHQOT ; Quoting character?
JRST SKNI.1 ; No, try next character
PUSHJ P,@SKNRCH ; Yes, get the next character
POPJ P, ; Couldn't
JRST SKNI.1 ; And ignore it
; Here to scan over a search string
SKNSRH: $SAVE <P1> ; Save P1
SKNS.0: TXZN F,F.SLSL ; Delimteded mode?
JRST SKNS.2 ; No, use an escape
PUSHJ P,@SKNRCH ; Get the delimeter
POPJ P, ; Couldn't
SKIPA P1,CH ; Get the character
SKNS.2: MOVX P1,.CHESC ; Get the default teminator
SKNS.1: PUSHJ P,@SKNRCH ; Get a character
POPJ P, ; Couldn't
CAIN CH,(P1) ; Is this it?
PJRST .POPJ1 ; Yes, all done
CAIE CH,$CHQOT ; Default quoting character?
CAIN CH,.CHCNQ ; Or control-Q?
JRST .+2 ; Yes, skip
JRST SKNS.1 ; No, go get the next character
PUSHJ P,@SKNRCH ; Yes, get the next character
POPJ P, ; None left
JRST SKNS.1 ; And ignore it
; Here to scan over a search string followed by an insert string
SKNSIN: $SAVE <P1> ; Save P1
PUSHJ P,SKNS.0 ; scan over the search string
POPJ P, ; Ran out of string
PJRST SKNI.1 ; And go do the insert string
; Here to handle a "@"
SKNAT: TXO F,F.SLSL ; Flag the character
PJRST .POPJ1 ; And give the good return
; Here to scan over a string argument.
SKNSAG: $SAVE <P1> ; Save P1
MOVX P1,"}" ; Get the delimeter
PJRST SKNI.1 ; And search for it
SUBTTL Command processing
;+
;.HL1 COMND
;This is the main command loop for TECO. It will first call the per command
;initialization routine. After everthing is initialized it will input the
;command. It will then execute the command if it was not an immediate command.
;-
COMND: MOVE P,PDLSAV ; Reset the stack incase of a reenter
PUSHJ P,C$INIT ; Do the per command initialization
; Now check if we should perform an automatic command.
SOSG AUTCTR ; Decrement the count
SKIPG T1,AUTCNT+$QRVAL ; Get the value from the count register
JRST COMN.1 ; Don't need to do this yet
MOVE T2,CMDSTA ; Get the state
CAXE T2,$CSNRM ; Only do this if there was no problem
JRST COMN.1 ; Otherwise wait till next time
AOJ T1, ; Add one more so we can come through here again
MOVEM T1,AUTCTR ; Reset the counter
SKIPN AUTBUF+$QRTPT+$TPADR ; Any text to execute?
JRST COMN.1 ; No, skip this
MOVEI T1,XCTBUF ; Get the pointer to the current execution buffer
SKIPE (T1) ; Anything here?
PUSHJ P,M$RELB ; Release it
MOVX T1,^D16 ; Get the length of the command
PUSHJ P,M$GTXT ; And get a buffer
MOVEI T2,XCTBUF ; Get the pointer
PUSHJ P,M$USEB ; And set up the use
DMOVE T1,[TXTPTR(<M(AUTO-BUFFER)>)] ; Get the command to perform
LOAD. T3,TPTADR,+XCTBUF ; Get the address
SETZ T4, ; And flag this is stationary text
PUSHJ P,M$INSS ; Insert the string
LOAD. T1,TPTADR,+XCTBUF ; Get the address back
ZERO. ,BLKPT,(T1) ; And clear the pointer
TXZ F,F.CCLR ; Clear out the flags
TXZ S,S.CCLR ; . . .
PUSHJ P,C$XCTI ; And go execute the command
JRST COMND ; Go reset the world an start again
COMN.1: PUSHJ P,P$INPT ; Go get a command
JRST COMND ; Go try again
PUSHJ P,C$XCT ; Execute the command
JRST COMND ; Execute the next command
SUBTTL C$INIT - Per command initialization
;+
;.HL1 C$INIT
;This routine will do the per command initialization for TECO.
;.literal
;
; Usage:
; PUSHJ P,C$INIT ; Do the initialization
; (Return)
;.end literal
;-
C$INIT: PUSHJ P,T$CINI ; Do the per command initialization
XMOVEI T1,QRNTPT ; Check if anything left from Q-register scanning
SKIPE (T1) ; . . .
PUSHJ P,M$RELB ; Yes, release it
SETZM QRNTPT ; And clear it out
SETZM EQM ; Clear the macro level count
PUSHJ P,CLRAG1 ; Get rid of the string arguments
PUSHJ P,CLRAG2 ; If any
MOVX T1,<MOVE A1,ARG$1> ; Get the instruction to store
MOVEM T1,X.INS ; Store the instruction
MOVX T1,<IFIW CHRTBL(CH)> ; Get the normal dispatch
MOVEM T1,CMDTBL ; Store it
MOVX T1,<IFIW CHRFLG(CH)> ; Get the normal flags
MOVEM T1,CMDFLG ; Store it
PUSHJ P,CLNXS ; Clean up the XS stack
MOVE XS,[IOWD D.XPDL,XSPDL] ; Set up the execution stack
PUSH XS,[EXP $XENOP] ; Stack in case something screws up
MOVE T1,[MOVE A1,ARG$1] ; Get the instruction
MOVEM T1,X.INS ; Store the instruction
MOVE P1,QRGSTK ; Get the address of the stack
C$IN.0:
IFN FTXADR,CAMG P1,[EXP PFL] ; Before start of stack?
IFE FTXADR,CAIG P1,PFL ; Before start of stack?
JRST [MOVEM P1,QRGSTK ; Yes, reset the pointer
POPJ P,] ; And return
MOVEI T1,-1(P1) ; Yes, get the pointer address
MOVE T2,(P1) ; Get the datatype
CAXE T2,$DTFCT ; Command table?
CAXN T2,$DTTXT ; Text?
PUSHJ P,M$RELB ; Yes, release it
SOJ P1, ; Count the item
SOJA P1,C$IN.0 ; Loop
SUBTTL CLNXS - Clean up the XS stack
;+
;.HL1 CLNXS
;This routine will clean up the XS stack of any the junk on it.
;.literal
;
; Usage:
; PUSHJ P,CLNXS
; (Return)
;
;.end literal
;-
CLNXS: LOAD. T1,XSBTYP,(XS) ; Get the type
XCT CLNTBL(T1) ; Do correct function
JRST CLNXS ; And try the next block
; Here to clean up a macro entry
CLNX.M: XMOVEI T1,$XSBUF(XS) ; Get the address to release
SKIPE $TPADR(T1) ; Anything to release?
PUSHJ P,M$RELB ; Release the block
ADJSP XS,-$XSMLN ; Remove the entry
POPJ P, ; And return
; Here to clean up after memory management
CLNX.C: XMOVEI T1,$XSBUF(XS) ; Get the address of the BLK
SKIPE $TPADR(T1) ; Anything to release?
PUSHJ P,M$RELB ; Release the pointer
ADJSP XS,-$XSCLN ; Remove the data
POPJ P, ; And return
; Dispatch table for block types
TABDEF CLN,$XE
TABENT NOP,<POPJ P,> ; Return for no-op
TABENT PAR,<ADJSP XS,-$XSPLN> ; Parens just need items removed
TABENT LOP,<ADJSP XS,-$XSLLN> ; Loops just need items removed
TABENT MAC,<PUSHJ P,CLNX.M> ; Macros need special handling
TABENT IQG,<ADJSP XS,-$XSQLN> ; Just remove the item
TABENT MEM,<PUSHJ P,CLNX.C> ; Clean up the memory managements pointer
TABEND ; End of table
SUBTTL C$SCMD - Save the last command
;+
;.hl1 C$SCMD
;This routine will save the last command that was input. This outine
;is called when a new command will be input or on an error on the
;the command.
;.literal
;
; Usage:
; PUSHJ P,C$SCMD
; (Return)
;
; On return:
; Commad saved in LSTCMD
;
;.end literal
;-
C$SCMD: $SAVE <P1> ; Save some ac's
XMOVEI T1,LSTCMD ; Get the address of the last command pointer
SKIPE $TPADR(T1) ; Anything there?
PUSHJ P,M$RELB ; Yes, release it first
LOAD. T1,TPTADR,+CMDBUF ; No, get the command buffer
MOVEI T2,LSTCMD ; And the pointer address
PUSHJ P,M$USEB ; Use the buffer
ZERO. ,BLKPT,(T1) ; Clear the pointer
MOVE T2,CPMLEN ; Delete the first character
SETZ T3, ; . . .
LOAD. P1,BLKOED,(T1) ; Get the old end
PUSHJ P,M$SRNK ; . . .
MOVEI T1,CMDBUF ; Release the old use
PUSHJ P,M$RELB ; . . .
MOVX T1,D.CMDS ; Get a new buffer
PUSHJ P,M$GTXT ; Get it
STOR. P1,BLKOED,(T1) ; Store the old end
MOVE T2,CPMLEN ; Get the prompt length
STOR. T2,BLKFST,(T1) ; Save the first mod
STOR. P1,BLKLST,(T1) ; And the last mod
MOVEI T2,CMDBUF ; And store the pointer
PJRST M$USEB ; and return
SUBTTL Command input -- P$INPT
;+
;.HL1 P$INPT
;This routine will input a command from the terminal.
;.literal
;
; Usage:
; PUSHJ P,P$INPT
; (Immediate command -- Already executed)
; (Normal command -- Needs to be executed)
;-
P$INPT: SKIPN LSTCMD ; Have the last command yet?
PUSHJ P,C$SCMD ; Save the last command
LOAD. T1,TPTADR,+$QRTPT+CMDBUF ; Get the command buffer address
SETZ T3, ; Delete from the start of the buffer
LOAD. T2,BLKEND,(T1) ; All of it
ZERO. ,BLKPT,(T1) ; Clear the pointer
SKIPE T2 ; Anything to delete?
PUSHJ P,M$SRNK ; Shrink the buffer
LOAD. T1,QRGDTP,+CPMQRG ; Get the data type of the prompt
CAXE T1,$DTNUM ; A value?
JRST P$IN.2 ; No, go handle it
LOAD. CH,QRGVAL,+CPMQRG ; Get the prompt character
PUSHJ P,CB$STO ; Store the character in the buffer
JRST P$IN.4 ; Continue on
P$IN.2: XMOVEI T4,$QRTPT+CPMQRG ; Get the address of the pointer
LOAD. T3,TPTADR,+$QRTPT+CMDBUF ; And where to put it
LOAD. T1,TPTADR,(T4) ; Get the address where the prompt is
LOAD. T2,BLKEND,(T1) ; Get the length
ADDX T1,<POINT 7,.BKTLN> ; Set up the byte pointer
PUSHJ P,M$INSS ; Insert the string
P$IN.4: XMOVEI T1,CMDBUF ; Get the pointer to the command buffer
LOAD. T3,TPTADR,+$QRTPT(T1) ; Get the buffer address
LOAD. T2,BLKEND,(T3) ; And get the length of the prompt
STOR. T2,BLKPT,(T3) ; Store as the pointer
MOVEM T2,CPMLEN ; Save the length
PUSHJ P,C$CINI ; Initialize the command input routines
PUSHJ P,C$PRMT ; Prompt the user
SKIPE ISOFLG ; We doing image outstrs?
PUSHJ P,SC$FLS ; Yes, Flush the output buffer
PUSHJ P,C$IMMD ; Try for immediate commands
POPJ P, ; Got one, give the correct return
PUSHJ P,T$SECH ; Make the terminal echo again
TXNN F,F.FCON ; Is the immediate command processing turned on?
PUSHJ P,I$CIMG ; No, clear image mode also
TXZ F,F.ECHO ; And clear echoing for the first character
PUSHJ P,@TY.IBY ; Get the first byte of the command
MOVE T1,CHRFLG(CH) ; Get the flags
TXNN T1,CF.1ST ; Is the first character special
JRST PINP.1 ; Go reset the the state
MOVE T1,CMDSTA ; Get the command state
SKPNS ; Screen mode?
SKIPA T1,OVDTBL(T1) ; Yes - use the old video mode table
MOVE T1,FSTTBL(T1) ; No - Get the correct dispatch
PUSHJ P,NDISPT ; Dispatch to the correct routine
PINP.1: PUSHJ P,CB$INI ; Initialize the command buffer
PJRST C$INPT ; Go input the command
SUBTTL Command input -- Standard -- First character dispatch
; Standard command first character dispatch
ERRDSP: XWD ERRSLH,"/" ; Slash after an error
ER1DSP: XWD ERRQUE,"?" ; Question mark after an error
IMDDSP: XWD I$1LT, .CHLFD ; Line feed -- do +1LT
XWD I$N1LT,.CHCNH ; Backspace -- Do -1LT
XWD I$0LT, ";" ; Semicolon -- Do 0LT
XWD I$QREG,"*" ; Asterisk -- Save last command in Q register
XWD 0,0 ; End of dispatch
TABDEF FST,$CS,00
TABENT NRM,<EXP IMDDSP> ; Normal dispatch
TABENT QUE,<EXP ER1DSP> ; Just ? allowed after an error
TABENT QS1,<EXP ERRDSP> ; / or ? allowed
TABENT QS2,<EXP ERRDSP> ; / or ? allowed
TABEND
; Old video mode first character command dispatch table
OVDERR: XWD ERRSLH,"/" ; Slash after an error
OVDER1: XWD ERRQUE,"?" ; Question mark after an error
OVDIMD: XWD I$FFD, .CHFFD ; Form feed - Do a refresh
XWD I$1L, .CHLFD ; Line feed - Do +1L
XWD I$N1L, .CHCNH ; Backspace - Do -1L
XWD I$0L, ";" ; Semicolon - Do 0L
XWD I$QREG,"*" ; Asterisk - Save last command in Q register
XWD I$1C, " " ; Space - Do 1C
XWD I$1R, .CHCNB ; Control B - Do 1R
XWD I$1CD, .CHCND ; Control-D, do a control-D
XWD I$N1CD, .CHCNU ; Control-U, do a -1^D
XWD I$1V, .CHCNV ; Control-V, do a :1V
XWD I$1FW, .CHCNW ; Control-W, do a 1FW command
XWD 0,0 ; End of list
TABDEF OVD,$CS,0
TABENT NRM,<EXP OVDIMD> ; Normal dispatch
TABENT QUE,<EXP OVDER1> ; Just ? allowed after an error
TABENT QS1,<EXP OVDERR> ; / or ? allowed
TABENT QS2,<EXP OVDERR> ; / or ? allowed
TABEND
SUBTTL Immediate command processing -- C$IMMD
;+
;.hl1 C$IMMD
; This routine will do the immediate command processing using the
;command table set up by an FC command.
;.lit
;
; Usage:
; PUSHJ P,C$IMMD
; (immediate command already executed)
; (No immediate command)
;
;.end lit
;-
C$IMMD: TXNN F,F.FCON ; Immediate commands turned on?
PJRST .POPJ1 ; No, give skip return
MOVEM P,CMDSVP ; Save the current stack pointer in case of errors
MOVEM P,SAVEP ; Also here
XMOVEI T1,T$PEKW ; Peek ahead and wait if not there yet
XMOVEI T2,T$REDN ; Routine to read a number of characters
PUSHJ P,I$PRSC ; Try parsing an immediate command
POPJ P, ; Got one, say we did it
PJRST .POPJ1 ; And give no immediate command return
SUBTTL Immediate commands -- I$1LT - Do +1LT
;+
;.HL1 Immediate commands
;The following group of routines will process all the immediate commands.
;There are two different sets, one for screen mode ad the other for old TECO
;mode.
;.HL2 I$1LT
;This routine will do a +1LT. It is called if the first character of the
;command is a line feed.
;-
I$1LT: TXO S,S.OLOG ; Suppress log file output
TXNE CRT,CR$NCR ; No free CR's?
JRST I$1LT0 ; None allowed, just type out where we are
MOVX CH,.CHCRT ; Output a carriage return (Back to column 0)
PUSHJ P,T$OCHR ; Output it
TXNN CRT,CR$DLF ; Have a delete line feed function ?
JRST I$1LT0 ; No - Continue
PUSHJ P,C$HPOS ; Get the horizontal position
CAILE T2,1 ; Only a single character?
JRST [TXNN CRT,CR$CTU ; No, have a control-U function?
JRST I$1LT0 ; No, give up
XCT $CRDLF(CRT) ; Yes, delete the line feed
XCT $CRCTU(CRT) ; And kill the line
JRST I$1LT0] ; And continue on
XCT $CRDLF(CRT) ; Delete the line feed
MOVE T1,$CRDBS(CRT) ; Do a destructive backspace
PUSHJ P,SC$MES
I$1LT0: PUSHJ P,CB$INI ; Initialize the command buffer
DMOVE T1,[TXTPTR(:+1LT)] ; Get the command string
AOS (P) ; Give the skip return
PJRST CB$MOV ; Move this into the command buffer
SUBTTL Immediate commands -- I$N1LT - Do a -LT
;+
;.HL2 I$N1LT
;This routine will be called if the first character of the line is a backspace.
;This outine will store the command string -1LT into the command buffer and
;then return to the upper level routine.
;-
I$N1LT: DMOVE P1,[TXTPTR(:-1LT)] ; Get the command string
PJSP P3,I$LT ; Flag and continue below
SUBTTL Immediate commands -- I$0LT - Do a 0LT
;+
;.HL2 I$0LT
;This routine will do a 0LT command if the first character of a command is
;a semicolon.
;-
I$0LT: DMOVE P1,[TXTPTR(:0LT)] ; Get the command string
SETZ P3, ; Clear this flag
I$LT: TXNE CRT,CR$TTY ; Is this a TTY ?
JRST [PUSHJ P,.TCRLF ; Yes, output a CRLF
JRST I$LT.3] ; And continue processing
TXNN CRT,CR$CTU ; Have a control U function ?
JRST I$LT.1 ; No, continue below
XCT $CRCTU(CRT) ; Clear the line
JRST I$LT.3 ; Continue below
I$LT.1: PUSHJ P,C$HPOS ; Determine the horizontal position we are at
CAILE T2,1 ; Zero or one character?
JRST [PUSHJ P,.TCRLF ; No, can't really delete it
JRST I$LT.3] ; Continue on
JUMPN P3,I$LT.2 ; If this is -1LT then do it differently
MOVE T1,$CRBCK(CRT) ; Get the destructive backspace
PUSHJ P,SC$MES ; Output it
PUSHJ P,C$ERS2## ; Erase the two characters
JRST I$LT.3 ; Continue
I$LT.2: PUSHJ P,C$ERS1## ; Back up one character
I$LT.3: PUSHJ P,CB$INI ; Init the command buffer
DMOVE T1,P1 ; Copy the items
AOS (P) ; Give the skip return
PJRST CB$MOV ; Install them in the command buffer
SUBTTL Immediate commands -- I$QREG - Store last command in Q register
;+
;.HL2 I$QREG
;This command will store the previous command into the Q register that is
;specified.
;-
I$QREG: MOVEM P,CMDSVP ; Save P
MOVEM P,SAVEP ; Here also, for error processing
SKPNS ; Skip if not screen mode
PUSHJ P,V$ECHO ; Echo the *
MOVEI T1,XCTBUF ; Get the buffer address
SKIPE (T1) ; Anything here?
PUSHJ P,M$RELB ; Yes, release it
MOVEI T1,5 ; Start with 5 chars
PUSHJ P,M$GTXT ; . . .
ZERO. ,BLKPT,(T1) ; Clear the pointer
MOVEI T2,XCTBUF ; Get the pointer
PUSHJ P,M$USEB ; And set the use
SETZB T1,LASQCH ; No default
MOVEI T2,I$QCHR ; Get the input routine
MOVEI T3,I$QREA ; Get the "re-eat" routine
MOVEI T4,XCTBUF ; Remember where the name is
PUSHJ P,REDQRG ; Try reading the name
JRST [PUSHJ P,I$QCHR ; Get the single character
JFCL ; Ignore the error return
PUSHJ P,QREGV2 ; Convert to address
JRST .+1] ; Continue on
MOVE P1,T1 ; Copy the index to a safer place
MOVE T1,$QRFLG(P1) ; Get the flags
CAME P1,CUREDT ; Current buffer?
TXNE T1,QR$WRT ; Allowed to write at all?
ERROR E.DOQ ; No, punt
LOAD. T1,QRGDTP,(P1) ; Get the datatype
MOVX T2,$DTTXT ; And get the new one
XCT RQRGTB(T1) ; Change types
I$QR.0: LOAD. T1,TPTADR,+LSTCMD ; Get the command buffer address
XMOVEI T2,$QRTPT(P1) ; Set up to set the address
PUSHJ P,M$USEB ; in the use chain
JMPS .POPJ ; All done
PJRST .TCRLF ; All done with command
; Get a character routine
I$QCHR: SETZ CH, ; Clear CH
EXCH CH,LASQCH ; Get the saved char if any
JUMPN CH,.POPJ1 ; Return if we had one
$SAVE <T1,T2,T3,T4> ; Else save some ac's
PUSHJ P,@TY.IBY ; Input a byte
MOVEI T1,XCTBUF ; Get the address of the pointer
AOS (P) ; Give skip return when done
PJRST M$ACHR ; Append the character on
; Reeat a character
I$QREA: MOVEM CH,LASQCH ; Save the character
POPJ P, ; And return
SUBTTL Immediate commands -- I$1L - Do a 1L command
;+
;.HL1 I$1L
;This routine will do an old video mode 1L.
;-
I$1L: DMOVE P1,[TXTPTR(:+1L)] ; Get the string
JRST OVDCMD ; Process it
SUBTTL Immediate commands -- I$N1L - Do a -1L command
;+
;.HL1 I$N1L
;This routine will do an old video mode -1L command.
;-
I$N1L: DMOVE P1,[TXTPTR(:-1L)] ; Get the string
PJRST OVDCMD ; Process it
SUBTTL Immediate commands -- I$0L - Do a 0L command
;+
;.HL1 I$0L
;This routine will do an old video mode 0L command.
;-
I$0L: DMOVE P1,[TXTPTR(:0L)] ; Get the string
PJRST OVDCMD ; Process it
SUBTTL Immediate commands -- I$1C - Do old video 1C
;+
;.HL2 I$1C
;This routine will do an old video 1C command.
;-
I$1C: DMOVE P1,[TXTPTR(:1C)] ; Get the command string
PJRST OVDCMD ; Process it
SUBTTL Immediate commands -- I$CD - Do a control-D
;+
;.hl2 I$1CD
; This routine will cause a 1^D command to be executed.
;-
I$1CD: DMOVE P1,[TXTPTR(:1)] ; Get the string
PJRST OVDCMD ; And go stuff it in
SUBTTL Immediate commands -- I$N1CD - Do a -1^D
;+
;.hl2 I$N1CD
; This routine will cause a -1^D command to be executed.
;-
I$N1CD: DMOVE P1,[TXTPTR(:-1)] ; get the string
PJRST OVDCMD ; And go do it
SUBTTL Immediate commands -- I$1FW - do a 1FW
;+
;.HL2 I$1FW
; This routine will cause a 1FW command to be executed for an ^W
;immediate command.
;-
I$1FW: DMOVE P1,[TXTPTR(:1FW)] ; Get the command
PJRST OVDCMD ; And go do it
SUBTTL Immediate commands -- I$1V - Do a :1V
;+
;.hl2 I$1V
; This routine will cause a :1V command to be executed for the ^V
;immediate command.
;-
I$1V: DMOVE P1,[TXTPTR(:1V)] ; Get the command
PJRST OVDCMD ; And go do it
SUBTTL Immediate commands -- I$1R - Do old video 1R
;+
;.HL2 I$1R
;This routine will do an old video 1R command
;-
I$1R: DMOVE P1,[TXTPTR(:1R)] ; Get the command string
OVDCMD: PUSHJ P,CB$INI ; Initialize the command buffer
DMOVE T1,P1 ; Copy the string
AOS (P) ; Give a skip return
PJRST CB$MOV ; Move the string into the command buffer
SUBTTL Immediate commands -- I$FFD - Do a refresh (form feed command)
;+
;.hl2 I$FFD
; This routine will refresh the screen
;-
I$FFD: PJRST SC$REF ; Go refresh the screen
SUBTTL Command buffer -- CB$INI - Initialization
;+
;.Hl1 CB$INI
;This routine will initialize the command buffer store a character
;routine. It will just copy data from various locations and store
;it.
;.literal
;
; Usage:
; PUSHJ P,CB$INI ; Initialize command buffer
; (Return) ; Return here always
;.end literal
;-
CB$INI: LOAD. T1,TPTADR,+CMDBUF ; Get the address of the text buffer
LOAD. T3,BLKPT,(T1) ; Get the pointer
LOAD. T2,BLKEND,(T1) ; And the end
SUB T2,T3 ; And delete to the end
PUSHJ P,M$SRNK ; Shrink the buffer
MOVEI T1,LSTCMD ; And release the last command now
SKIPE (T1) ; If nothing to release don't bother
PUSHJ P,M$RELB ; . . .
POPJ P, ; Return to the caller
SUBTTL Command buffer -- CB$MOV - Move a string into the command buffer
;+
;.HL1 CB$MOVE
;This routine will move a string into the command buffer. It expects that
;the caller has initialized the command buffer already.
;.literal
;
; Usage:
; MOVEI T1,Address.of.text
; PUSHJ P,CB$MOV ; Move the text into the command buffer
; (Return)
;.end literal
;-
CB$MOV: SETZ T4, ; Flag not from a text buffer
LOAD. T3,TPTADR,+CMDBUF ; Get the address of the command buffer
PUSHJ P,M$INSS ; Insert the string
LOAD. T2,TPTADR,+CMDBUF ; Get the address again
STOR. T1,BLKPT,(T2) ; Store the new pointer
POPJ P, ; Return to the caller
SUBTTL Command buffer -- CB$STO - Store a character into the command buffer
;+
;.hl1 CB$STO
;This routine will store a character into the command buffer. It assumes that
;the pointer is at the end of the buffer.
;
; Usage:
;
; MOVE CH,Character
; PUSHJ P,CB$STO ; Store the character
; (Return)
;
; Note: Will use T1, T2 and T3
;.end literal
;-
CB$STO: MOVEI T1,CMDBUF ; Get where to put this
PJRST M$ACHR ; Store the character
SUBTTL C$XCT - Execute a command in the command buffer
;+
;.HL1 C$XCT
;This routine is called to execute a command.
;.literal
;
; Usage:
; PUSHJ P,C$XCT
; (Error return)
; (Return)
;.end literal
;-
C$XCT: PUSHJ P,S$CINI ; Do per command symbols stuff
MOVX T1,$CSNRM ; Get the normal state
MOVEM T1,CMDSTA ; Save it
TXZ S,S.SLOG ; Don't suppress log file now
MOVEM P,CMDSVP ; Save the stack pointer in case of error
TXNN S,S.LIN ; Type in going to log file ?
JRST XCT.1 ; No - Continue on
LOAD. P1,TPTADR,+CMDBUF ; Get the address of the text buffer
LOAD. P2,BLKEND,(P1) ; Get the character count
SUB P2,CPMLEN ; Account for the prompt
MOVE T1,CPMLEN ; Get the length of the prompt
IDIVI T1,5 ; Make word and byte index
TDO T1,BTAB-1(T2) ; Make the byte pointer
ADD P1,T1 ; . . .
ADDX P1,.BKTLN-1 ; . . .
XCT.0: ILDB CH,P1 ; Get a character to output
PUSHJ P,LOGCHR ; Output the character
SOJG P2,XCT.0 ; Loop outputing all the characters
MOVEI CH,.CHCRT ; Get a carriage return
PUSHJ P,LOGCHR ; Write it
MOVEI CH,.CHLFD ; And a line feed
PUSHJ P,LOGCHR ; And write that also
; Here to set up for the command execution
XCT.1: SETZM ARG$OP ; Clear the operand
SETZB A1,ARG$1 ; And the argument
SETZM LASTCH ; Clear the saved character
MOVEI T1,XCTBUF ; Get the last one to release
SKIPE (T1) ; If nothing there do nothing
PUSHJ P,M$RELB ; Release the block
LOAD. T1,TPTADR,+CMDBUF ; Get the command buffer address
MOVE T2,CPMLEN ; Start at the begining
PUSHJ P,SETINC ; Set up the pointers
STOPCD ZLC,<Zero length command - No terminating altmodes>
MOVEI T2,XCTBUF ; Place to store it
PUSHJ P,M$USEB ; Put it in the queue
TXZ F,F.CCLR ; Clear some flags
TXZ S,S.CCLR ; . . .
; Entry point for automatic command execution
C$XCTI: MOVEM P,CMDSVP ; Save the stack pointer
MOVE T1,[POINT 7,CMDSTR] ; Set up for storing command
MOVEM T1,CMDSPT ; Save the pointer
SETZM CMDSTR ; And clear the word
SETOM XCTING ; Flag that we are executing
XCT.2: TXZ F,F.GOCL ; Clear the F flags
TXZ S,S.CCLR ; Clear some flags
SKIPN XCTING ; Someone want us to stop?
POPJ P, ; Give an error return (XS needs clean up)
TXNN F,F.ARG!F.ARG2!F.COLN!F.SLSL!F.MCCM ; Any args yet?
PUSHJ P,U$CINI ; No, go set up the error stuff
PUSHJ P,RCH ; Get the character
IDPB CH,CMDSPT ; Store the character
LOAD T1,@CMDFLG,CF.ECA ; Check if extended command table address
JMPT T1,XCT.7 ; Yes, go handle it
LOAD. T2,CDTAG1,+@CMDFLG ; Get the argument types
PUSH P,@CMDFLG ; Save this information
PUSHJ P,@ARGTBL(T2) ; Process the arguments and dispatch
JRST XCT.4 ; Error, go handle it
POP P,P1 ; Get the flags
XCT.5: TXNN P1,CF.RST ; Restore the normal command table ?
JRST XCT.3 ; No - Continue
TXZ F,F.MCCM ; Not in middle of multi-char command anymore
MOVEI T1,CHRTBL ; Get the command table
HRRM T1,CMDTBL ; Store it
MOVEI T1,CHRFLG ; Get the flags
HRRM T1,CMDFLG ; Store it
XCT.3: TXZE F,F.DONE ; Finished ?
JRST [SETZM XCTING ; Clear the executing flag
POPJ P,] ; Give a good return to the caller
TXNE F,F.MCCM ; In middle of multi char command
JRST XCT.2 ; Yes, don't reset pointer
MOVE T1,[POINT 7,CMDSTR] ; No, get the byte pointer
MOVEM T1,CMDSPT ; Save it
SETZM CMDSTR ; And clear the string
JRST XCT.2 ; Continue processing
XCT.4: TXZ F,F.ARG2!F.OP!F.ARG ; Clear these flags
MOVE T1,[MOVE A1,ARG$1] ; Get the normal argument fetch instruction back
MOVEM T1,X.INS ; Save it
PUSHJ P,CLRAG1 ; Clear out the first argument
PUSHJ P,CLRAG2 ; And the second
POP P,P1 ; Restore the flags
SETZB A1,ARG$1 ; Clear the arg
TXNN P1,CF.CLN ; need to clear the colon ?
TXZN F,F.COLN ; Have a colon?
JRST XCT.5 ; Continue, no colon
SETOB A1,ARG$1 ; Yes, flag this was successful
TXO F,F.ARG!F.ACLN ; Flag we have an argument again
JRST XCT.5 ; And go handle the rest
; Here to change command tables. The table entry has the address
; of a word with the address of the flag table in the left half
; and the address of the dispatch table in the right half.
XCT.7: LOAD. T1,CDTCMD,+@CMDTBL ; Get the pointer address
HLRZ T2,(T1) ; Get the flag table address
HRRM T2,CMDFLG ; Store it
HRRZ T1,(T1) ; Get the dispatch table address
HRRM T1,CMDTBL ; Save it also
TXO F,F.MCCM ; Flag in multi character command
JRST XCT.2 ; And loop back for next character
; The following is the argument processing dispatch table
TABDEF ARG,$CA
TABENT ARG,<EXP ARGARG> ; This is part of an argument
TABENT MBN,<EXP ARGMBN> ; Must have one numeric
TABENT MBS,<EXP ARGMBS> ; Must have one string
TABENT DF1,<EXP ARGDF1> ; Defaults to single argument of one
TABENT NON,<EXP ARGNON> ; Takes no arguments
TABENT OPN,<EXP ARGOPN> ; Optional numeric argument
TABENT OPS,<EXP ARGOPS> ; Optional string argument
TABENT OSN,<EXP ARGOSN> ; Optional numeric or string argument
TABENT MNS,<IFIW!ARGMNS> ; Must be numeric or string
TABEND
; Table of routines for processing the second argument
TABDEF AG2,$CA
TABENT ARG,<EXP AG2ARG> ; This is part of an argument
TABENT MBN,<EXP AG2MBN> ; Must have one numeric
TABENT MBS,<EXP AG2MBS> ; Must have one string
TABENT DF1,<EXP AG2DF1> ; Defaults to single argument of one
TABENT NON,<EXP AG2NON> ; Takes no arguments
TABENT OPN,<EXP AG2OPN> ; Optional numeric argument
TABENT OPS,<EXP AG2OPS> ; Optional string argument
TABENT OSN,<EXP AG2OSN> ; Optional numeric or string argument
TABENT MNS,<IFIW!AG2MNS> ; Must be numeric or string
TABEND
SUBTTL Command execution -- Argument processing -- ARGARG
; This routine is called before the character that is part of an argument.
;There is no need to do the second argument checks.
ARGARG: MOVEM P,SAVEP ; Save the stack
TXNE F,F.STR1 ; Do we have a string?
ERROR E.ARG ; Yes, complain
LOAD. T1,CDTCMD,+@CMDTBL ; Get the character dispatch
PJRST (T1) ; Call the routine
SUBTTL Command execution -- Argument processing -- ARGNON
; This routine is called before the commands that require no arguments.
;There is no need for the second argument checks, since no command takes
;only the second arg.
ARGNON: MOVEM P,SAVEP ; Save the stack
TXNN F,F.OP ; Have an operation pending?
TXNN F,F.ARG ; Are there arguments
JRST ARGDSP ; Skip
TXNE F,F.ACLN ; Is the argument from a colon'ed command?
JRST ARGN.0 ; Yes, it is okay
CHKEO EO124,ARGN.0 ; Forget the error if old version
ERROR E.NAA ; ++ No arguments allowed
ARGN.0: TXZ F,F.ARG!F.ACLN!F.OP ; Yes, clear the arg
MOVE T1,[MOVE A1,ARG$1] ; And reset the instruction
MOVEM T1,X.INS ; Store it
ARGDSP: LOAD. T1,CDTCMD,+@CMDTBL ; Get the character dispatch
PJRST (T1) ; Call the routine
SUBTTL Command execution -- Argument processing -- ARGMBN
; This routine is called for commands which require an argument, but don't
;care what type.
ARGMNS: MOVEM P,SAVEP ; Save P
TXNN F,F.ARG ; Have an argument
ERROR E.MFA ; No, punt it
JRST AG1DSP ; Dispatch for the second arg
SUBTTL Command execution -- Argument processing -- ARGMBN
; This routine is called for commands which require a first argument
;that is numeric.
ARGMBN: MOVEM P,SAVEP ; Save the stack pointer
TXNE F,F.STR1 ; First argument a string?
ERROR E.FNS ; String argument not allowed
TXNN F,F.ARG ; Have an argument?
ERROR E.MFA ; No, missing first argument
AG1DSP: MOVE A1,ARG$OP ; Get the operand
XCT X.INS ; And do the instruction
MOVE T1,[MOVE A1,ARG$1] ; Get the initial instruction
TXNE F,F.ARG ; Was there an argument?
MOVEM T1,X.INS ; Yes, save the basic instruction
LOAD. T1,CDTAG2,+@CMDFLG ; Get the second arg type
PJRST @AG2TBL(T1) ; And dispatch
SUBTTL Command execution -- Argument processing -- ARGMBS
; This routine is called for command whose first argument must
;be a string.
ARGMBS: MOVEM P,SAVEP ; Save the stack pointer
TXNN F,F.ARG ; Have an argument?
ERROR E.MFA ; No, punt
TXNN F,F.STR1 ; Yes, is it a string
ERROR E.FMS ; No, first argument not a string
PJRST AG1DSP ; Dispatch on the second arg type
SUBTTL Command execution -- Argument processing -- ARGDF1
; This routine is called for a command which defaults to a one for
;its first argument if no arguments are given.
ARGDF1: MOVEM P,SAVEP ; Save the stack pointer in case of error
TXOE F,F.ARG ; Have a first argument?
TXNE F,F.OP ; Without an operation pending?
MOVEI A1,1 ; Yes, default it to a one
MOVEM A1,ARG$1 ; Save it
TXNE F,F.STR1 ; It wasn't a string, was it?
ERROR E.FNS ; Yes, punt it
JRST AG1DSP ; And dispatch
SUBTTL Command execution -- Argument processing -- ARGOPN
; This routine is called for a command that may take an optional
;numeric argument.
ARGOPN: MOVEM P,SAVEP ; Save the stack
TXNE F,F.OP ; Have an operator pending?
TXZ F,F.ARG ; Yes, flag no argument
TXNE F,F.STR1 ; Is the argument a string?
ERROR E.FNS ; Yes, not allowed
PJRST AG1DSP ; Call the routine
SUBTTL Command execution -- Argument processing -- ARGOPS
; This routine is called for commands which take an optional string
;argument.
ARGOPS: MOVEM P,SAVEP ; Save the stack
TXNE F,F.ARG ; Argument exist?
TXNE F,F.STR1 ; Yes, is it a string?
PJRST AG1DSP ; And go dispatch to the routine
ERROR E.FMS ; No, punt it
SUBTTL Command execution -- Argument processing -- ARGOSN
; This routine is called for a command which takes any type of
;first argument (or no first argument).
ARGOSN: MOVEM P,SAVEP ; Save the stack pointer
TXNE F,F.OP ; Operator pending?
TXZ F,F.ARG ; Yes, then flag no argument
PJRST AG1DSP ; And dispatch
SUBTTL Command execution -- Argument processing -- AG2ARG
; This routine is called for a character which is part of an argument.
;It should never actually be called, and will therefore stopcode.
AG2ARG: STOPCD SAA,<Second argument is an argument?>
SUBTTL Command execution -- Argument processing -- AG2NON
; This routine is called for the second argument of commands which
;do not take a second argument.
AG2NON: CHKEO EO124,ARGDSP ; Just dispatch if old version
TXNN F,F.OP ; Have an operation pending?
TXNN F,F.ARG2 ; No, have a second argument?
JRST ARGDSP ; No second argument, go dispatch
ERROR E.SAN ; No second arg allowed
SUBTTL Command execution -- Argument processing -- AG2MBN
; Here if the second argument must be numeric
AG2MBN: TXNN F,F.STR2 ; Is the arg a string?
PJRST ARGDSP ; No, dispatch
AG2MNS: TXNN F,F.ARG2 ; Have the arg at all?
ERROR E.MSA ; No, punt
ERROR E.SMN ; Yes, complain
SUBTTL Command execution -- Argument processing -- AG2MBS
; Here if the second argument must be a string.
AG2MBS: TXNN F,F.ARG2 ; Have two args?
ERROR E.MSA ; No, punt
TXNE F,F.STR2 ; Is second argument a string?
PJRST ARGDSP ; Yes, all is fine
ERROR E.SMS ; Second argument not a string
SUBTTL Command execution -- Argument processing -- AG2DF1
; Here if the second argument should default to one. This should
;not occur.
AG2DF1: STOPCD SD1,<Second arg defaults to one>
SUBTTL Command execution -- Argument processing -- AG2OPN
; Here when the second argument is an optional numeric
AG2OPN: TXNE F,F.ARG2 ; Have a second argument?
TXNN F,F.STR2 ; Yes, is it a string?
PJRST ARGDSP ; No, all is fine
ERROR E.SMN ; Yes, complain
SUBTTL Command execution -- Argument processing -- AG2OPS
; Here if the second argument is an optional string
AG2OPS: TXNE F,F.ARG2 ; Is it there at all?
TXNE F,F.STR2 ; Yes, is it a string?
PJRST ARGDSP ; Either no arg or a string, all is fine
ERROR E.SMS ; No, punt it
SUBTTL Command execution -- Argument processing -- AG2OSN
; Here for commands which have an optional second argument which can
;be anything.
AG2OSN: PJRST ARGDSP ; Just dispatch to the command
SUBTTL Command execution -- Subroutines -- RETZER
SUBTTL Command execution -- Subroutines -- RTONES
SUBTTL Command execution -- Subroutines -- VALRET
;+
;.HL2 RETZER, RTONES, and VALRET
;This routines will return zero, minus one, or the value in T1 to the calling routine.
;-
VALRT2: MOVEM A1,ARG$1 ; Save the arg in the correct place
PUSHJ P,CLRAG1 ; Clear out the first arg
PUSHJ P,CLRAG2 ; And the second
TXO F,F.ARG!F.ARG2 ; Flag we have two arguments
PJRST .POPJ1 ; And return
RETZER: TDZA A1,A1 ; Clear the value to return
RTONES: SETO A1, ; Return minus one
VALRET: MOVEM A1,ARG$1 ; Save the argument
PUSHJ P,CLRAG1 ; Remove any first string arg
TXOE F,F.ARG ; Flag we have an argument
JRST [TXNE F,F.OP ; Operation pending?
JRST .+1 ; Yes, continue on
TXZ F,F.ARG2 ; No, clear second arg
AOS (P) ; Give value returned return
PJRST CLRAG2] ; And clear out the string if any
TXZN F,F.OP ; Have an operation pending?
PJRST .POPJ1 ; No, just return
MOVE A1,ARG$OP ; Get the operand
XCT X.INS ; Yes, do the op
MOVEM A1,ARG$1 ; Store the value
MOVE T1,[MOVE A1,ARG$1] ; And reset the instruction
MOVEM T1,X.INS ; Store it
SETZM ARG$OP ; Clear the operator
PASRET: PJRST .POPJ1 ; Return the value
SUBTTL Command execution -- Subroutines -- STRRET
;+
;.HL2 STRRET
; This routine is used to return a string as the argument. It will set
;up the proper flags and locations for the string.
;.LIT
;
; Usage:
; LOAD. A1,TPTADR,+xxxx ; Get the address of the text buffer
; MOVX T1,.TRUE/.FALSE ; .TRUE if nothing points to text
; ; .FALSE if something does
; PJRST STRRET ; Return the string
;
;.end lit
;-
STRRET: PUSH P,T1 ; Save the flag
PUSHJ P,CLRAG1 ; Clear out the first argument
POP P,CPYAG1 ; Restore the flag so we know if we should copy
MOVE T1,A1 ; Get the address of the text
MOVEI T2,SARG$1 ; And of the pointer
PUSHJ P,M$USEB ; Set up the pointer
AOS (P) ; Set up the skip return
TXON F,F.STR1!F.ARG ; Flag we have the argument
POPJ P, ; None there now, all done
TXZ F,F.ARG2 ; Flag no second argument
PJRST CLRAG2 ; And clear it out if necessary
SUBTTL Command execution -- Subroutines -- CLRAG1 & CLRAG2
;+
;.hl2 CLRAG1 and CLRAG2
; These routines are called to clean up any previous string arguments.
;They will return the previous text and clear the string argument flags.
;-
CLRAG1: MOVEI T1,SARG$1 ; Get the pointer to the first argument
SKIPE SARG$1 ; Is it there?
PUSHJ P,M$RELB ; Yes, release it now
SETZM SARG$1 ; No string argument now
TXZ F,F.STR1 ; . . .
POPJ P, ; And return
CLRAG2: MOVEI T1,SARG$2 ; Get the pointer to the first argument
SKIPE SARG$2 ; Is it there?
PUSHJ P,M$RELB ; Yes, release it now
SETZM SARG$2 ; No string argument now
TXZ F,F.STR2 ; . . .
POPJ P, ; And return
SUBTTL Command execution -- Subroutines -- OPENP
;+
;.HL2 OPENP
;Here to process the open parenthesis. Store the items on the execution stack
;and return to the calling routine.
;-
OPENP: $ADJSP XS,$XSPLN ; Make room on the stack
MOVX T1,F.OP!F.COLN!F.ARG2 ; Get the flags
AND T1,F ; copied from F
STOR. T1,XSBFLG,(XS) ; Store the flags
TXZ F,F.OP!F.COLN ; No operation pending now
MOVE T1,ARG$OP ; Save the current argument on the stack
STOR. T1,XSBARG,(XS) ; Store the arg
MOVE T1,X.INS ; Save the current operator
STOR. T1,XSBOPR,(XS) ; . . .
MOVX T1,$XEPAR ; Get the block type
STOR. T1,XSBTYP,(XS) ; Store the type
MOVX T1,<MOVE A1,ARG$1> ; Get the new instruction
MOVEM T1,X.INS ; Store the instruction
POPJ P, ; And return
SUBTTL Command execution -- Subroutines -- CLOSEP
;+
;.HL2 CLOSEP
;Here to process the close parenthesis. Restore the items from the execution
;stack. Check to see if there is a problem with ( ... < .... )...> nesting.
;-
CLOSEP: LOAD. T1,XSBTYP,(XS) ; Last thing on the stack a left paren ?
CAXE T1,$XEPAR ; Last thing a paren?
JRST CLOSE1 ; No, go check which it was
LOAD. T1,XSBOPR,(XS) ; Get the operation
MOVEM T1,X.INS ; Restore the instruction to execute
LOAD. T1,XSBARG,(XS) ; Get the arg
MOVEM T1,ARG$OP ; Restore the argument
LOAD. T1,XSBFLG,(XS) ; Get the flags
TDO F,T1 ; And turn them on
$ADJSP XS,-$XSPLN ; Remove the item
PJRST VALRET ; Return the value
CLOSE1: CAXN T1,$XELOP ; Was last thing a loop?
ERROR E.PAR ; (...<....)...> type command
CLOSE2: ERROR E.MLP ; ++ Missing left paren
SUBTTL Command execution -- Argument processing -- CAND - And operator
;+
;.HL2 CAND
;Here to store the AND operator to be executed later.
;-
CAND: MOVX T1,<AND A1,> ; Get the new instruction
PJRST C$SINS ; Store the instruction
SUBTTL Command execution -- Argument processing -- COR - OR operator
;+
;.HL2 COR
;Here to store the OR operator to be executed later.
;-
COR: MOVX T1,<OR A1,> ; Get the new instruction
FALL C$SINS ; Fall into the routine
C$SINS: HRRI T1,ARG$1 ; Get the rest of the address
C$SI.0: MOVEM T1,X.INS ; Store the instruction
MOVE T1,ARG$1 ; Get the current arg
TXOE F,F.OP ; Flag we have an operation pending
PJRST PASRET ; Already had an operation pending
MOVEM T1,ARG$OP ; And save it for the operation
SETZB A1,ARG$1 ; Clear the arg
PJRST PASRET ; Give a good return
SUBTTL Command execution -- Argument processing -- PLUS - '+' operator
;+
;.HL2 PLUS
;Here to store the plus operator to be executed later.
;-
SPCCMD: CHKEO EO200,PLUS ; Old versions make this act like a plus
JRST PASRET ; New ones just ignore it
PLUS: TXNN F,F.ARG ; Have an arg yet?
JRST PASRET ; No, don't really need to do anything
MOVX T1,<ADD A1,> ; Get the instruction
PJRST C$SINS ; Store the instruction
SUBTTL Command execution -- Argument processing -- MINUS - '-' operator
;+
;.HL2 MINUS
;Here to store the subtraction operator to be executed later.
;-
MINUS: MOVX T1,<SUB A1,> ; Get the instruction
PJRST C$SINS ; Store the instruction and return
SUBTTL Command execution -- Argument processing -- SLASH - '/' operator
;+
;.HL2 SLASH
;Here to store the division operator to be executed later.
;-
SLASH: MOVE T1,[PUSHJ P,SLAS.0] ; Get the instruction
MOVEM T1,X.INS ; Store the instruction
PJRST C$SI.0 ; Give a good return
; Here to do the operation. Make sure we don't smash A2
SLAS.0: PUSH P,A2 ; Save A2
IDIV A1,ARG$1 ; Do the division
POP P,A2 ; And restore A2
POPJ P, ; And return
SUBTTL Command execution -- Argument processing -- TIMES - '*' operator
;+
;.HL2 TIMES
;Here to store the multiplication operator to be executed later.
;-
TIMES: MOVX T1,<IMUL A1,> ; Get the new instruction
PJRST C$SINS ; Store it
SUBTTL Command execution -- Argument processing -- ^O (Octal input)
;+
;.HL2 OCTIN
;This routine will processing the control O command for the arguments. This
;routine will set the radix to octal.
;-
OCTIN: PUSHJ P,RCH ; Get the next character
MOVE T1,CHRFLG(CH) ; Get the flags
TXNN T1,CF.NUM ; Valid number ?
ERROR E.DIG ; ++ Expecting a digit
SETZ A1, ; Clear the place to accumulate the number
OCTI.0: LSH A1,3 ; Multiply by 8
ADDI A1,-"0"(CH) ; And add in this digit
PUSHJ P,RCH ; Get the next character
MOVE T1,CHRFLG(CH) ; Check if a digit
TXNE T1,CF.NUM ; Is it?
JRST [CAIGE CH,"8" ; Valid octal digit?
JRST OCTI.0 ; Yes, go handle it
ERROR E.OCT] ; No, punt it
PUSHJ P,REEAT ; Eat the last character back
PJRST VALRET ; And go return the value
SUBTTL Command execution -- Subroutines -- CDNUM
;+
;.HL2 CDNUM
;This routine will accumulate the a numeric string.
;-
CDNUM: SETZ A1, ; Clear the accumulated number
CDNM.0: IMULI A1,^D10 ; Mul by the radix
ADDI A1,-"0"(CH) ; Add in the next digit
PUSHJ P,RCH ; Get the next character
MOVE T1,CHRFLG(CH) ; Get the flags
TXNE T1,CF.NUM ; Is this a numeric ?
JRST CDNM.0 ; Loop for the next digit
PUSHJ P,REEAT ; Reeat the last character
JRST VALRET ; Return the value
SUBTTL Command execution -- Subroutines -- STOP
;+
;.HL2 STOP
;Here to exit to the monitor
;-
STOP: PUSHJ P,DOXITQ ; Do the user's exit routine
JMPNS .+2 ; Screen mode?
PUSHJ P,SC$FIN ; Yes, fix up terminal
MONRT. ; Exit to the operating system
JMPS SC$ERS ; If screen mode, go clear the screen
POPJ P, ; Allow continues
SUBTTL Command execution -- Subroutines -- COMMA - Argument delimiter
;+
;.HL2 COMMA
;Here to processing an argument delimiter. This will move the argument into the
;other argument register.
;-
COMMA: PUSHJ P,CLRAG2 ; Clear the second arg
MOVE A2,A1 ; Copy the argument over
TXZE F,F.ARG ; Have at least the argument ?
TXOE F,F.ARG2 ; Already have a second argument ?
ERROR E.ARG ; Yes, Problems with arguments
SETZM ARG$1 ; Clear the argument for the operations
TXZN F,F.STR1 ; First argument a string?
JRST PASRET ; Return to the caller
LOAD. T1,TPTADR,+SARG$1 ; Get the address of the string
MOVEI T2,SARG$2 ; And get the second pointer
PUSHJ P,M$USEB ; Set up the pointer
MOVE T1,CPYAG1 ; Get the flag for the arg
MOVEM T1,CPYAG2 ; Save it
PUSHJ P,CLRAG1 ; Clear out the first arg
TXO F,F.STR2 ; And flag the second arg is a string
PJRST PASRET ; Give value returned return
SUBTTL Command execution -- Subroutines -- ALTMOD - Commad delimiter
;+
;.HL2 ALTMOD
;Here to process a command delimiter. This routine will peek at the next character
;to see if the command is terminated.
;-
ALTMOD: LOAD. P1,TPTADR,+XCTBUF ; Get the address of the text buffer
LOAD. T1,BLKPT,(P1) ; Get the character address of PT
CFMN. ,BLKEND,(P1),T1 ; At the end of the command ?
JRST ALTM.0 ; Yes - Check if in a macro
LOAD. T1,BLKPTR,(P1) ; Get the byte pointer for the next character
ILDB T1,T1 ; Get the next character
CAXE T1,.CHESC ; Is this the double altmode ?
POPJ P, ; Return to the caller
JRST ALTM.1 ; And go join common routine to kill one altmode
; Here to check if at the end of a command or macro
ALTM.0: SKIPE EQM ; In a macro ?
POPJ P, ; Return to the caller
ALTM.1: TXO F,F.DONE ; No - Finished
LOAD. T1,TPTADR,+CMDBUF ; Get the command buffer address
LOAD. T2,TPTADR,+XCTBUF ; And what we are executing
CAME T1,T2 ; Same?
POPJ P, ; No, just return
DECR. T2,BLKEND,(T1) ; Yes, decrement the number of characters to get rid of the second altmode
INCR. T2,BLKFRE,(T1) ; And bump the number free
POPJ P, ; And return
; ^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER.
UAR: PUSHJ P,SKRCH ; GET NEXT COMMAND CHARACTER.
ERROR E.MEU
TRZ CH,140 ; CHANGE IT TO CONTROL CHARACTER
PUSHJ P,REEAT ; Stuff the character back
JRST PASRET ; And pass thru the values
SUBTTL Command processing -- Subroutines -- STRARG
;+
;.hl2 STRARG
; This routine will handle the immediate form of a string argument.
;It is called when a "{" is seen in the command.
;-
STRARG: MOVX CH,"}" ; Get the terminator character
PUSHJ P,INSE.0 ; And determine the length of the string
MOVE P2,T1 ; Get the length of the string
PUSHJ P,GETSTR ; Get the string block
MOVE T1,P2 ; Get the length back
MOVEI T2,SARG$1 ; And the pointer
MOVX CH,"}" ; Terminate on the close bracket
PUSHJ P,INSE.I ; Insert the text
PJRST PASRET ; Pass back the argument
SUBTTL Command processing -- Subroutines -- CV2NUM
;+
;.hl2 CV2NUM
; This routine will convert a string argument to a numeric argument.
;.lit
;
; Usage:
; T1/ Address of text block
; PUSHJ P,CV2NUM
; (return, A1=numeric value)
;
;.end lit
;-
CV2NUM: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Get the address of the buffer
SETZ A1, ; Clear the accumulated result
SETZ T1, ; Start at the first character
BLDBPT (T1,(P1)) ; Set up the byte pointer
LOAD. T2,BLKEND,(P1) ; Get the number of characters there are here
CV2N.1: SOJL T2,.POPJ ; Return the value if nothing left
ILDB T3,T1 ; Get a character
CAXL T3,"0" ; Is it numeric?
CAXLE T3,"9" ; . . .
JRST CV2N.1 ; Not a digit, get next character
CV2N.2: SOJL T2,.POPJ ; Return if nothing left
ILDB T3,T1 ; Get the next character
CAXL T3,"0" ; Numeric?
CAXLE T3,"9" ; . . .
POPJ P, ; No, return what we have
IMULX A1,^D10 ; Yes, bump the current number
ADDI A1,-"0"(T3) ; And add in this character
JRST CV2N.2 ; And try again
SUBTTL Command processing -- Subroutines -- GETSTR
;+
;.hl2 GETSTR
; This routine will get a text buffer for a string argument. It is called
;to allocate the buffer for commands which wish to generate a string argument
;to return. It will set up the argument pointers for the argument.
;.lit
;
; Usage:
; MOVE T1,Estimated size of argument
; PUSHJ P,GETSTR
; (return, T1=address of buffer, SARG$1 also pointing at it)
;
;.end lit
;-
GETSTR: PUSH P,T1 ; Save T1
PUSHJ P,CLRAG1 ; Clear out the arg if already one there
TXON F,F.ARG!F.STR1 ; Flag we have the argument
JRST GETST1 ; None before, get the block
TXZ F,F.ARG2 ; Clear the second argument
PUSHJ P,CLRAG2 ; For real
GETST1: STORE T1,CPYAG1,,.TRUE ; Flag arg does not need copying
POP P,T1 ; Get back the length
PUSHJ P,M$GTXT ; Get the text block
MOVEI T2,SARG$1 ; And the address of the pointer
PUSHJ P,M$USEB ; Set up the pointer
POPJ P, ; And return
SUBTTL Control-C intercept -- Initialization
;+
;.HL1 CCIINI
; This routine will initialize the control-C intercept. The control-C
;intercept is used to execute a Q-register when TECO is control-C'ed. This
;allows the users macro to do whatever it likes to reset the terminal.
;-
CCIINI: SETOM XCTXQR ; Flag not doing the exit Q-regs
TOPS10,<
SETZM .JBINT ; Assume no interrupt needed
MOVE T1,[XWD CCILEN,CCIXIT] ; Get the routine to use
MOVEM T1,CCIBLK+.ERNPC ; Save it
SETZM CCIBLK+.EROPC ; Clear the old PC
SETZM CCIBLK+.ERCCL ; And the reason
MOVX T1,ER.MSG+ER.ICC ; Get the type of interrupts we want
MOVEM T1,CCIBLK+.ERCLS ; Save it
MOVEI T1,CCIBLK ; Yes, get the address of the block
MOVEM T1,.JBINT ; Save in .JBINT
> ; End of TOPS10
POPJ P, ; And return
SUBTTL Control-C intercept -- Intercept processing
;+
;.HL1 CCIXIT
; This routine will handle the control-C intercept. It will save what is
;necessary, reset the terminal (if required), and call the user's macro
;to do on exit (if defined).
;-
TOPS10,<
; Here on a control-C interrupt. We must output the finish string to cause
;the terminal to be put in a reasonable state.
CCIXIT: DMOVEM T1,CCISV1 ; Save T1/T2
MOVEM T3,CCISV3 ; Save T3
HRRZ T1,CCIBLK+.EROPC ; Get the old PC
HLRZ T2,.JBDDT ; Get the end of DDT address
HRRZ T3,.JBDDT ; And the start
CAMG T1,T2 ; After the end of DDT?
CAMGE T1,T3 ; Or before the start?
JRST CCIX.1 ; No, go take us down gracefully
MOVE T3,CCIBLK+.EROPC ; Get the address we came from
EXCH T3,CCISV3 ; Restore T3 and save return address
SETZM CCIBLK+.EROPC ; Allow more interrupts
DMOVE T1,CCISV1 ; Get T1/T2 back
MONRT. ; Exit to the monitor
JRSTF @CCISV3 ; Go back to DDT
CCIX.1: PUSH P,CCIBLK+.EROPC ; Save the old PC
DMOVE T1,CCISV1 ; Get the ac's set back up
MOVE T3,CCISV3 ; . . .
$SAVE <T1,T2,T3,T4,CH> ; Save some ac's
SETZM CCIBLK+.EROPC ; Clear out the PC
SKPNS ; Screen mode on?
XCT $CRFIN(CRT) ; Yes, do the finish function
PUSH P,XCTING ; Save the value of the flag
SETOM XCTING ; And flag reenter should do the JRSTF
PUSHJ P,SC$FLS ; Go flush the tty buffer
PUSHJ P,DOCTCQ ; Perform the user's exit macro
MONRT. ; Go to the monitor
SKIPL XCTING ; Did we get REENTERed?
AOS (P) ; Yes, pass on the flag
POP P,XCTING ; Restore the flag
SKPNS ; Screen mode turned on?
SKIPN $CRINT(CRT) ; Have an initialization routine
JRST .+2 ; Don't need initialization
XCT $CRINT(CRT) ; Yes, do it
SKIPGE XCTING ; Are we currently doing something?
POPJ P, ; Yes, continue doing it
JRST COMND ; And go try all over again
> ; End of TOPS10
SUBTTL DOXITQ - Perform user's exit macro
;+
;.HL1 DOXITQ
; This routine will perform the user's exit macro from the Q-register
;EXIT-BUFFER. It will save the entire state of the command processor
;first.
;-
DOXITQ: AOSE XCTXQR ; Doing one of these Q-regs already?
POPJ P, ; No, nothing to do
SKIPN $TPADR+$QRTPT+XITQRG ; Have some text in the buffer?
JRST [SETOM XCTXQR ; Flag not in exit Q-reg
POPJ P,] ; And return
$SAVE <XCTING> ; Save the state of the executing flag
XMOVEI T1,XITQRG ; Get the address of the Q-register to do
JRST DOXI.1 ; Join common routine
DOCTCQ: AOSE XCTXQR ; Doing one of these already?
POPJ P, ; No, give skip return
SKIPN $TPADR+$QRTPT+CTCQRG ; Have something to do?
JRST [SETOM XCTXQR ; Flag not in exit Q-reg
POPJ P,] ; And return
AOS (P) ; Give skip return when done
XMOVEI T1,CTCQRG ; Get the Q-register to do
DOXI.1: $SAVE <P1,P2,P3,P4,A1,A2,ARG$1,ARG$OP,X.INS,CMDSTA,EQM,LASTCH,CMDSTR,CMDSPT,CMDTBL,CMDFLG,SKNTBL,SKNFLG,SKNRCH,SKNREA,CPYAG1,CPYAG2,SAVEP,CMDSVP,ITERCT,LOPADR,ANGLVL,STAINS,INSRCH,INSREE,OLDREE,OLDINR,CTGLVL,CTGBUF>
MOVE P1,T1 ; Get the address of the QRG to do
PUSH XS,[EXP $XENOP] ; Put the limit word on the stack
ALCXSB (MEM,CLN) ; Allocate a block on the XS stack
SETZM $XSBUF+$TPADR(XS) ; Flag nothing there
LOAD. T1,TPTADR,+SARG$1 ; Get the first string arg
XMOVEI T2,$XSBUF(XS) ; Get the address of the pointer
TXNE F,F.STR1 ; Is there one?
PUSHJ P,M$USEB ; Yes, set up the pointer
ALCXSB (MEM,CLN) ; Set up a second pointer
SETZM $XSBUF+$TPADR(XS) ; Flag nothing there
XMOVEI T2,$XSBUF(XS) ; Get the address of the pointer
LOAD. T1,TPTADR,+SARG$2 ; Get the second arg
TXNE F,F.STR2 ; Is it there?
PUSHJ P,M$USEB ; Yes, save it
ALCXSB (MEM,CLN) ; One more pointer
XMOVEI T2,$XSBUF(XS) ; Get the address of the pointer
LOAD. T1,TPTADR,+XCTBUF ; Get the current buffer
IFN FTDEBUG,SETZM $TPADR(T2) ; Clear the word if debugging
PUSHJ P,M$USEB ; Set up the pointer
XMOVEI T1,XCTBUF ; Get the address of the pointer
PUSHJ P,M$RELB ; And release it
MOVE T1,F ; Get the current F flags
ANDX T1,F.GOCL!F.CCLR ; Keep only the ones we will clear
PUSH P,F ; Save them
MOVE T1,S ; Get the current S flags
ANDX T1,S.CCLR ; Keep the ones we need
PUSH P,T1 ; Save them
PUSH XS,[EXP $XENOP] ; Flag the stack limit to clean up when done
MOVX T1,$CSNRM ; Reset the command state to normal
MOVEM T1,CMDSTA ; . . .
PUSHJ P,CLRAG1 ; Clear out the first argument
PUSHJ P,CLRAG2 ; And the second
MOVX T1,<MOVE A1,ARG$1> ; Get the instruction to store
MOVEM T1,X.INS ; Store the instruction
MOVX T1,<IFIW CHRTBL(CH)> ; Get the normal dispatch
MOVEM T1,CMDTBL ; Store it
MOVX T1,<IFIW CHRFLG(CH)> ; Get the normal flags
MOVEM T1,CMDFLG ; Store it
MOVE T1,[MOVE A1,ARG$1] ; Get the instruction
MOVEM T1,X.INS ; Store the instruction
TXZ F,F.CCLR!F.GOCL ; Clear the flags
TXZ S,S.CCLR ; Here also
LOAD. T1,TPTADR,+$QRTPT(P1) ; Get the address of what to execute
XMOVEI T2,XCTBUF ; And what needs to point at it
PUSHJ P,M$USEB ; Set it up
SETZM EQM ; Flag not in a macro
SETZB T2,LASTCH ; Start from start of buffer
PUSHJ P,SETINC ; Set it up
JRST .+2 ; If nothing to do, just return
PUSHJ P,C$XCTI ; Execute the command
PUSHJ P,CLNXS ; Clean up the XS stack
PUSHJ P,CLRAG1 ; Make sure arguments are cleared
PUSHJ P,CLRAG2 ; . . .
POP P,T1 ; Get back the S flags
IOR S,T1 ; Turn them on
POP P,T1 ; Get the F flags back
IOR F,T1 ; And do them also
POP XS,(XS) ; Remove the stack limit
XMOVEI T1,XCTBUF ; Kill the pointer to the command
PUSHJ P,M$RELB ; . . .
LOAD. T1,TPTADR,+$XSBUF(XS) ; Get the saved address
XMOVEI T2,XCTBUF ; And reset it
PUSHJ P,M$USEB ; . . .
LOAD. T1,TPTADR,+$XSBUF-$XSCLN(XS) ; Get the 2nd string arg (maybe)
XMOVEI T2,SARG$2 ; And the pointer
SKIPE T1 ; Anything to point at?
PUSHJ P,M$USEB ; Yes, set it up
LOAD. T1,TPTADR,+$XSBUF-$XSCLN-$XSCLN(XS) ; Get the first string arg
XMOVEI T2,SARG$1 ; And what should point at it
SKIPE T1 ; Have one?
PUSHJ P,M$USEB ; Yes, set up the pointer
PUSHJ P,CLNXS ; Clean up the pointers from the stack
POP XS,(XS) ; Remove the limit
SETOM XCTXQR ; Flag we are not doing either Q-reg now
POPJ P, ; And return, restoring the rest of the world
SUBTTL Low segment for TECPRS
; The following is the low segment for TECPRS
$IMPURE ; Impure data section
LOWVER(PRS,4) ; Low segment version number
P$ZBEG:!
XSPDL: BLOCK D.XPDL ; Execution stack
XCTBUF: BLOCK 1 ; Text buffer being executed
LSTCMD: BLOCK 1 ; Pointer to the last command
CMDSTA: BLOCK 1 ; Command state
XCTING: BLOCK 1 ; Flag we are executing a command
EQM: BLOCK 1 ; Macro level and flag we are executing a macro
LASTCH: BLOCK 1 ; Saved character for RCH routines
CMDSTR: BLOCK 1 ; Word for saving command string for error type-out
CMDSPT: BLOCK 1 ; Byte pointer into CMDSTR
CMDTBL: BLOCK 1 ; Current command table inuse
CMDFLG: BLOCK 1 ; Current command flags inuse
CPMLEN: BLOCK 1 ; Length of prompt in command buffer
; Automatic command execution storage
AUTBUF: BLOCK $QRLEN ; Buffer for text of command
AUTCNT: BLOCK $QRLEN ; Buffer for count between executions
AUTCTR: BLOCK 1 ; Location to count in
; Table pointers for SKAN
SKNTBL: BLOCK 1 ; Pointer to command dispatch table
SKNFLG: BLOCK 1 ; Pointer to command flags table
SKNRCH: BLOCK 1 ; Address of get-a-char routine for SKAN
SKNREA: BLOCK 1 ; Address of re-eat a char routine for SKAN
; Expression evaluation
X.INS: BLOCK 1 ; Instruction to execute
ARG$1: BLOCK 1 ; Saved value
ARG$OP: BLOCK 1 ; Saved operand
SARG$1: BLOCK .TPLEN ; Text pointer for first string argument
SARG$2: BLOCK .TPLEN ; Text pointer for second string argument
CPYAG1: BLOCK 1 ; .TRUE if SARG$x is only pointer to arg x
CPYAG2: BLOCK 1 ; .FALSE otherwise
; For immediate command processing
IMMTPT: BLOCK $TPLEN ; TPT to saved characters
IMMSVC: BLOCK 1 ; Save address of typeout routine
; Misc
ETVAL: BLOCK 1 ; ET value
LASQCH: BLOCK 1 ; Saved character from "*" immediate command
; Saved locations for error recovery
SAVEP: BLOCK 1 ; Location the stack is saved in before command
; execution.
CMDSVP: BLOCK 1 ; Stack pointer from before entire command
SAVCMD: BLOCK 1 ; Character address in current buffer
; Of start of command
; Locations for control-C trapping
TOPS10,<
CCIBLK: BLOCK .ERCCL+1 ; .JBINT type intercept block
CCILEN==.-CCIBLK
CCISV1: BLOCK 2 ; Room to save T1/T2
CCISV3: BLOCK 1 ; And T3
> ; End of TOPS10
XCTXQR: BLOCK 1 ; Flag whether we are executing either exit Q-reg
XITQRG: BLOCK $QRLEN ; Q-register to call on exit
CTCQRG: BLOCK $QRLEN ; Q-register to handle ^C
P$ZEND==.-1 ; End of the parser low segment
SUBTTL End of TECPRS
END ; End of TECPRS