Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/source/teccmd.mac
There are 3 other files named teccmd.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1980 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 the authors or their
; employers.
; Search needed universals
SEARCH TECUNV ; TECO universal file
; Generate the prologue
TECVER==200 ; Major version number
TECMIN==1 ; Minor version number
TECEDT==1162 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(CMD,<Command processing>) ; Generate the TITLE and other stuff
;+
;.no flag all
;.fig 15
;.c;TECCMD
;.title TECCMD - Command processor
;-
SUBTTL Table of Contents
;+
;.pag.lit
; Table of Contents for TECCMD - Command processing
;
;
; Section Page
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. Command modifiers
; 4.1. "@" - Delimited mode. . . . . . . . . . . . . 4
; 4.2. ":" . . . . . . . . . . . . . . . . . . . . . 4
; 5. Values
; 5.1. "^E" - Form feed flag . . . . . . . . . . . . 5
; 5.2. "^N" - EOF flag . . . . . . . . . . . . . . . 6
; 5.3. "H" - B,Z . . . . . . . . . . . . . . . . . . 7
; 5.4. "." - Position of the pointer . . . . . . . . 7
; 5.5. "Z" - Number of characters in the buffer. . . 7
; 6. Commands
; 6.1. Control-L - Type a form feed or refresh the screen 8
; 6.2. "=" and "==" - Type out a value . . . . . . . 9
; 6.3. "^T" - Input a character. . . . . . . . . . . 10
; 6.4. Extended ^T operations. . . . . . . . . . . . 11
; 6.5. "^H" - Return daytime in jiffies. . . . . . . 12
; 6.6. "^F" - Read the console switches. . . . . . . 12
; 6.7. "^^" - Return the value of the next character 13
; 6.8. "\" - Read a number from the buffer . . . . . 14
; 6.9. "A" - Append or return value of character . . 16
; 6.10. Q-register
; 6.10.1. "U" - Store numeric value. . . . . . 18
; 6.10.2. "Q" - Fetch numeric value. . . . . . 19
; 6.10.3. "%" - Increment the value. . . . . . 20
; 6.10.4. "X" - Insert text into Q-reg . . . . 21
; 6.10.5. "G". . . . . . . . . . . . . . . . . 22
; 6.10.6. "M" and "W". . . . . . . . . . . . . 23
; 6.10.7. "]" - Pop Q-register . . . . . . . . 24
; 6.10.8. "[" - Push a Q-reg . . . . . . . . . 25
; 6.10.9. Utility routines
; 6.10.9.1. QREGVI. . . . . . . . . . . 26
; 6.10.9.2. SCNQRG. . . . . . . . . . . 27
; 6.10.9.3. QTXTEI. . . . . . . . . . . 28
; 6.10.9.4. QTXTST. . . . . . . . . . . 29
; 6.11. "^U" - Set next block to read . . . . . . . . 30
; 6.12. "^G" - GETTAB or EXIT . . . . . . . . . . . . 31
; 6.13. "^V" and "^W" - Lower and upper case flags. . 32
; 6.14. "^X" - Set or clear exact match . . . . . . . 33
; 6.15. "Y" ("EY") - Render the buffer empty. . . . . 34
; 6.16. ^Y and ^P - quick page scan commands. . . . . 36
; 6.17. "I"
; 6.17.1. Insert . . . . . . . . . . . . . . . 37
; 6.17.2. Utilities
; 6.17.2.1. Casing routines . . . . . . 41
; 6.17.2.2. CKNCC . . . . . . . . . . . 42
; 6.17.3. "nI" . . . . . . . . . . . . . . . . 43
; 6.18. T . . . . . . . . . . . . . . . . . . . . . . 44
; 6.19. V . . . . . . . . . . . . . . . . . . . . . . 45
; 6.20. P . . . . . . . . . . . . . . . . . . . . . . 46
; 6.21. "J" - Move the pointer to absolute position . 47
; 6.22. "R" - Move pointer backwards. . . . . . . . . 47
; 6.23. "C" - Move the pointer forwards . . . . . . . 47
; 6.24. "L" - Move the pointer n lines. . . . . . . . 48
; 6.25. "K" - Delete some text. . . . . . . . . . . . 49
; 6.26. "D" - Delete a number of characters . . . . . 50
; 6.27. "<" - Open iteration. . . . . . . . . . . . . 51
; 6.28. ">" - End an iteration loop . . . . . . . . . 52
; 6.29. ";" - Exit iteration. . . . . . . . . . . . . 53
; 6.30. "!" - Define a tag. . . . . . . . . . . . . . 54
; 6.31. "O" - Go to the tag named.. . . . . . . . . . 55
; 6.32. "?" - Enter or leave trace mode . . . . . . . 56
; 6.33. "^A" - Type out the comment . . . . . . . . . 56
; 7. Conditional excution . . . . . . . . . . . . . . . . . 57
; 8. Utility routines
; 8.1. GETARG - Return string type args. . . . . . . 59
; 8.2. SETINC, GETINC, and PUTINC. . . . . . . . . . 60
; 8.3. BTAB - Byte pointer table . . . . . . . . . . 61
; 8.4. CKEOL - Check if CH contains an EOL . . . . . 62
; 8.5. GETFDI - Get the address of an FDB. . . . . . 63
; 8.6. GETFDO - Get the address of an FDB. . . . . . 64
; 8.7. WRTBUF - Write out the buffer . . . . . . . . 65
; 9. Low segment. . . . . . . . . . . . . . . . . . . . . . 66
; 10. End of TECCMD. . . . . . . . . . . . . . . . . . . . . 67
;.end lit.pag
;-
SUBTTL Revision History
COMMENT |
1000 Start of this version
1003 By: Robert McQueen On: 17-July-1980
The look ahead for the PW command caused random errors. The TXZ
should not be, since it will mange special characters.
Modules: TECCMD
1004 By: Robert McQueen On: 21-July-1980
The O command would cause ?ill mem ref if the tag was null. Give a better
error message for the O command.
Modules: TECUNV,TECCMD,TECERR
1021 By: Nick Bush On: 14-August-1980
Fix GETARG to not allow two argument commands to have values outside
of the range for the buffer.
Modules: TECCMD
1040 By: Robert McQueen On: 2-September-1980
I^Gq or S^Gq gave bad error messages if single character q-register
names were used. Move QREGV2 back one line, so the name is stored.
Modules: TECCMD
1041 By: Robert McQueen On: 2-September-1980
Make the O command give the correct tag all the time, if the tag can not
be found.
Modules: TECCMD
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
1055 By: Robert McQueen On: 18-November-1980
Add two new :^T commands to put the terminal into packed image mode and to
take it out again.
:-3^T - Put into packed image mode
:-4^T - Take it out of packed image mode
Modules: TECUNV,TECFIL,TECCMD,TECMVM
1063 By: Nick Bush On: 19-December-1980
Fix FW command to clear current ^D column so we will remember a new one.
Fix ] command to respect the settings of the QR$xxx flags and not
store text into a value only Q-reg or a value into a text only Q-reg.
Modules: TECCMD,TECSRH
1071 By: Nick Bush On: 10-January-1981
Add F$RBUF and F$WBUF routines to improve I/O performance.
Also add /MODE:DUMP for all file commands.
Modules: TECUNV,TECFIL,TECCMD,TECECM
1073 By: Nick Bush On: 22-January-1981
Fix ^P command. WRTBUF has to save A1 and A2.
Also make M and W illegal for the current text buffer. While there
are still methods of ending up executing the current text buffer,
this should catch most of them.
Modules: TECCMD,TECERR
1076 By: Nick Bush On: 30-January-1981
Add a default mode to be mode type 0. This will allow /MODE:ASCII
to really be such with LSA files. Also make /MODE: properly default
from ER/EW to EB and vice versa.
Modules: TECUNV,TECCMD,TECFIL,TECECM
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
1106 By: Nick Bush On: 13-May-1981
Improve screen updating for times when the new screen has portions which
are identical with the old. This will also fix most cases of wrapped
around lines on the top of the section of the screen.
Also fix some random /MODE:DUMP bugs.
Modules: TECUNV,TECVID,TECCMD,TECECM,TECUUO,TECMEM
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
1134 By: Nick Bush On: 21-December-1981
Make sure QR$PRD gets turned on for predefined Q-register names.
Modules: TECCMD
1143 By: Nick Bush On: 3-January-1982
Fix insert to correctly call M$INSS. It was calling it with the address
of the buffer where the text was located, not the address of the pointer
to the buffer.
Modules: TECCMD
1156 By: Robert C. McQueen On: 14-April-1982
- Fix bug in the last edit.
- Fix problem with screen updating if /MODE:ASCI and P command.
Modules: TECSRH,TECCMD
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
1162 By: Nick Bush On: 14-May-1982
Add a new flag for Q-regs to indicate that the Q-reg may not become the
current editing buffer with the E. command. This keeps TERMINAL-INPUT-BUFFER
from causing problems
Modules: TECUNV,TECECM,TECCMD
|
SUBTTL Command modifiers -- "@" - Delimited mode
;+
;.hl1 Command modifiers
; Some commands may be prefixed with a command modifer which causes it to
;do different things than normally.
;.hl2 Delimited text strings ("@")
; If a command is prefixed by a "@" it will use the first character
;after the command as the delimiter character for the end of its string
;argument, instead of an altmode (escape). This modifier only makes
;sense for commands which take string arguments (i.e. I, S, etc.).
;-
$CODE ; Put into code PSECT
ATSIGN: TXOA F,F.SLSL ; Flag we have seen an "@"
FALL COLON ; Fall into the colon modifier
SUBTTL Command modifiers -- ":"
;+
;.hl2 Colon modifier (":")
; The colon modifer is used for two things. On certain commands ("A", "^T")
;it just flags that the command should do a different function than without
;the colon. On any other it flags that an error should not print an error
;message, but should return either zero as the commands value.
;-
COLON: TXO F,F.COLN ; Set the flag
POPJ P, ; Return
SUBTTL Values -- "^E" - Form feed flag
;+
;.hl1 Values
;.hl2 Form feed (^E)
; This command will return the value -1 if the current buffer ended
;with a form feed, and return a zero otherwise.
;-
FFEED: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
MOVX T2,TF.FFD ; Get the flag to check
TDNN T2,.BKTFL(T1) ; See if buffer stopped because of form feed
JRST RETZER ; Yes, return a zero
JRST RTONES ; No, return minus one
SUBTTL Values -- "^N" - EOF flag
;+
;.hl2 End of file (^N command)
; This command returns the value -1 if the current file is at EOF, otherwise
;it will return a zero.
;-
EOF: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the address of the buffer
PUSHJ P,GETFDI ; Get the FDB address
JRST RETZER ; No file, return a zero
MOVX T2,FD.EOF ; Have a file, check
TDNN T2,.FDFLG(T1) ; if it is at eof
JRST RETZER ; Not at eof
JRST RTONES ; At eof return -1
SUBTTL Values -- "H" - B,Z
;+
;.hl2 H = B,Z
; This routine will return a pair of args, zero for the first and
;Z for the second.
;-
HOLE: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
LOAD. A1,BLKEND,(T1) ; Get the end address
SETZ A2, ; First arg is zero
JRST VALRT2 ; Return the values
SUBTTL Values -- "." - Position of the pointer
;+
;.hl2 Number of characters to the left of the pointer (.)
; This routine will return the position of the pointer.
;-
PNT: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
LOAD. A1,BLKPT,(T1) ; And get the pointer
JRST VALRET ; And return it
SUBTTL Values -- "Z" - Number of characters in the buffer
;+
;.hl2 Number of characters in the buffer (Z)
; This routine will return the number of characters in the buffer.
;-
END1: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
LOAD. A1,BLKEND,(T1) ; Get the end address (= number of chars)
JRST VALRET ; And return the value
SUBTTL Commands -- Control-L - Type a form feed or refresh the screen
;+
;.hl1 Commands
;.hl2 Type a form feed or refresh the screen
; This command will type a form feed if TECO is running in non-video
;mode. Otherwise this command will cause the screen to be refreshed.
;-
FFDCMD: JMPS SC$REF ; If screen mode just refresh the screen
MOVX CH,.CHFFD ; Otherwise type a form feed
PJRST T$OCHR ; Output it and return
SUBTTL Commands -- "=" and "==" - Type out a value
;+
;.hl2 Type out a value ("=" and "==")
; These commands type out values. A single equals will type out the value
;in decimal. A double equals sign will type it in octal.
;-
PRNT: PUSHJ P,SKRCH ; Get the next character
JRST PRNT.D ; Decimal print, no character to eat
CAIN CH,"=" ; Equals?
JRST PRNT.O ; Yes, print number in octal
PUSHJ P,REEAT ; Save the character for next
PRNT.D: SKIPA T1,[[$STRING(<^X/T$TCHR/^D/A1/^N>)]] ; Get the thing to type
PRNT.O: XMOVEI T1,[$STRING(<^X/T$TCHR/^O/A1/^N>)] ; Get what to type for octal
TXNN F,F.ARG2 ; Have a second arg?
JRST PRNT.1 ; No, go do default thing
JUMPE A2,PRNT.2 ; If 0,n no crlf
JUMPL A2,PRNT.1 ; If -x,n type a crlf
PUSH P,A2 ; Save A2
PUSHJ P,PRNT.2 ; Print the number
POP P,A1 ; Get back the character to type
ANDX A1,177 ; Keep only what matters
XMOVEI T1,[$STRING(<^7/A1/^N>)] ; Set to type the character
PJRST T$TYPE ; And go do it
PRNT.1: TDZA A2,A2 ; Clear the second arg
PRNT.2: SETO A2, ; Flag we don't want a crlf
TXNE F,F.STR1 ; First argument a string?
JRST PRNT.3 ; Yes, go handle it
PUSHJ P,T$TYPE ; Type the thing
JUMPE A2,.TCRLF ; If a crlf needed, go type it
POPJ P, ; Else just return
; Here if the argument is a string. Type out the entire string.
PRNT.3: LOAD. P1,TPTADR,+SARG$1 ; Get the buffer address
SETZ A2, ; Flag we want the entire buffer
LOAD. A1,BLKEND,(P1) ; . . .
SETZM XCTING ; Flag REENTER should punt immediately
PUSHJ P,TYPE.T ; Type the buffer
SETOM XCTING ; Really executing again
POPJ P, ; Return
SUBTTL Commands -- "^T" - Input a character
;+
;.hl2 Input a character ("^T")
; This routine will handle the "^T" command. If there is no colon
;it will simply input a character, returning the ascii value as
;its value. If the command is prefixed by a colon, it will do a TTCALL
;and return the value (if any) from the UUO.
;If it is not prefixed by a colon, it works as follows:
;.b
;n,m_^T
;.b
;Where n is the amount of time to wait, and m is the character to input.
;If the amount of time to wait (n) is positive, TECO will wait up to
;n milli-seconds for the type-in, and return -1 if the timer expires.
;If the amount of time to wait is negative, TECO will wait |n| milli-seconds,
;and return -1 if the character is not present. In this case TECO will
;wait the full time, even if the character is typed; when the time is
;positive, TECO will return as soon as the character is typed, or
;when the timer expires, whichever happens first.
;A value of 0 for the time will cause TECO to wait forever.
;The second argument (m) is used to indicate which character should
;be read. A value of 1 will read the very next character from the input
;stream. A value of i will read the next i characters from the input
;stream, and return the value of the i^&th\& character.
;If m is negative, the value of the character is returned, but the
;character is left in the input stream, so it can be read again either
;by TECO's normal input, or by another ^T command.
;A value of 0 for the character to read will return the number of characters
;currently in the input stream (characters actually read from the terminal).
;
;The default value for the time (n) is 0. The default value for
;the character to read (m) is 1.
;-
SPTYI: $SAVE <XCTING> ; Save the REENTER flag
TXZE F,F.COLN ; Colon modified type?
JRST EXTTTY ; Yes, go do a TTCALL or set value
TXNN F,F.ARG ; First argument there?
MOVEI A1,1 ; No, default to 1
TXNE F,F.ARG2 ; Have two arguments?
JUMPN A2,SPTY.S ; Yes, if we have a sleep time, go handle it
SPTY.0: JUMPG A1,SPTY.1 ; Want to read some characters?
JUMPL A1,SPTY.2 ; No, want to peek at some?
PUSH P,ICHINS ; Save the get-a-char instruction
MOVE T1,[PUSHJ P,T$ICHS] ; Get the instruction to use
MOVEM T1,ICHINS ; Save it
PUSHJ P,T$RBUF ; Read whatever is there
POP P,ICHINS ; Reset the instruction
SKIPN TTIBUF+$QRTPT+$TPADR ; Any text here?
PJRST RETZER ; No, return a zero
LOAD. T1,TPTADR,+$QRTPT+TTIBUF ; Get the address of the buffer
LOAD. A1,BLKEND,(T1) ; And get the number of characters in it
PJRST VALRET ; Return the value
; Here to read some text
SPTY.1: SETZM XCTING ; Flag that REENTER should just get a command
PUSHJ P,@TY.IBY ; Input a character (with all processing)
SOJG A1,.-1 ; Skip the characters we want to ignore
MOVE A1,CH ; Get the character typed
PJRST VALRET ; And return it
; Here to peek ahead some number of characters
SPTY.2: SETZM XCTING ; Flag REENTER should re-prompt
MOVM T1,A1 ; Get the character number we want
PUSHJ P,T$PEKW ; Get it
MOVE A1,CH ; Get the character
PJRST VALRET ; And return it
; Here for timed input
SPTY.S: SETZM XCTING ; While we are waiting, allow REENTER to work
$SAVE <ICHINS> ; Save current input instruction
MOVE T1,[PUSHJ P,T$ICHS] ; Get the instruction to use
MOVEM T1,ICHINS ; Save it
MOVE T1,A2 ; Get the time to wait
MOVM T2,A1 ; And the number of characters to wait for
PUSHJ P,T$WAIT ; Wait for the correct condition
PJRST RTONES ; Nothing there, return -1
JRST SPTY.0 ; Characters are there, go get the correct one
SUBTTL Commands -- Extended ^T operations
;+
;.hl2 Extended "^T" commands
; If the "^T" command is preceded by a colon, it will do a TTCALL.
;The value returned by the TTCALL will be returned as the value
;for the command. If the TTCALL is one which takes an argument (i.e. OUTCHR)
;the first argument is used for the value fo the TTCALL, otherwise the
;command takes only one argument (the TTCALL number).
;-
; Tables for extended ^T command.
; TABLE1 is the bit mask for which TTCALLs are legal.
; TABLE2 is the bit mask for which TTCALLs may skip.
; TABLE3 is the bit mask for which TTCALLs return values.
;
; Macro to help defining the masks
DEFINE TT(TTCALL),<<<TTCALL>&IW.REG>_-<ALIGN.(IW.REG)>>
BITMSK(TABLE1,,<<TT(INCHRW)>,<TT(OUTCHR)>,<TT(INCHRS)>,
<TT(INCHWL)>,<TT(INCHSL)>,<TT(GETLCH)>,<TT(SETLCH)>,
<TT(RESCAN)>,<TT(CLRBFI)>,<TT(CLRBFO)>,<TT(SKPINC)>,
<TT(SKPINL)>,<TT(IONEOU)>>)
BITMSK(TABLE2,,<<TT(INCHRS)>,<TT(INCHSL)>,<TT(SKPINC)>,<TT(SKPINL)>>)
BITMSK(TABLE3,,<<TT(INCHRW)>,<TT(INCHRS)>,<TT(INCHWL)>,
<TT(INCHSL)>,<TT(GETLCH)>,<TT(RESCAN)>>)
BITMSK(TABLE4,,<<TT(INCHRW)>,<TT(OUTCHR)>,<TT(INCHRS)>,
<TT(INCHWL)>,<TT(INCHSL)>,<TT(IONEOU)>>)
EXTTTY: MOVN T1,A1 ; Get the TTCALL number
JUMPG T1,SETECH ; Go do the extended terminal processing
MOVX T2,1B0 ; Get a bit
LSH T2,(T1) ; Shift to place in mask
TXNN T2,TABLE1 ; Check if valid TTCALL
ERROR E.ITT ; No, give the error (Illegal TTCALL)
TXNE T2,TABLE4 ; Need to do output first?
TXNN F,F.TYOF ; Need an output UUO?
JRST .+2 ; Skip
PUSHJ P,TTYOUT ; Do the output
CAXN A1,<TT(RESCAN)> ; Is it the rescan function?
JRST EXTT.1 ; Yes, go handle it
MOVX T1,<TTCALL 0,A2> ; Get the instruction
STOR A1,T1,IW.REG ; Store the index
SETZM XCTING ; Flag REENTER allowed while waiting
XCT T1 ; Do the TTCALL
JRST EXTT.2 ; Didn't skip, go see what to do
TXNN T2,TABLE3 ; Does the TTCALL return a value?
SETO A2, ; No value, return minus one
MOVE A1,A2 ; Get the value
PJRST VALRET ; And return the value
EXTT.2: TXNE T2,TABLE2 ; Should it have skipped?
PJRST RETZER ; No, return zero
TXNN T2,TABLE3 ; Does it return a value?
POPJ P, ; No, nothing to return
MOVE A1,A2 ; Yes, get the value
PJRST VALRET ; And return it
EXTT.1: MOVX T1,<RESCAN 1> ; Get the instruction for a rescan
TXZE F,F.ARG2 ; Two args means return the CCL flag value
MOVE T1,[SKIPE CCLSW] ; Test the CCL entry value
XCT T1 ; Do the instruction
PJRST RTONES ; We have a command, return -1
PJRST RETZER ; Nothing there, return 0
SETECH: CAXLE T1,SETELN ; Is it legal?
ERROR E.ITT ; No, punt it
PJRST @SETETB-1(T1) ; Set the echo correctly
SETETB: EXP T$CECH ; Clear echo
EXP T$SECH ; Set echo
EXP I$SIMG ; Set packed image mode
EXP I$CIMG ; Clear packed image mode
SETELN==.-SETETB
SUBTTL Commands -- "^H" - Return daytime in jiffies
;+
;.hl2 Return the daytime in jiffies ("^H")
; This routine will handle the "^H" command. It will return the value
;returned by the monitor from a TIMER UUO.
;-
GTIME: TIMER A1, ; Get the value
PJRST VALRET ; And return it
SUBTTL Commands -- "^F" - Read the console switches
;+
;.hl2 Read the console switches ("^F")
; This routine will return the value returned by the SWITCH UUO.
;-
LAT: TXZE F,F.ARG!F.ARG2 ; If there is an argument
JRST REDUDX ; Read the terminal universal device index
SWITCH A1, ; Read the switches
JRST VALRET ; Return the value
; Here for "n^F". Return the UDX for the terminal for job n.
REDUDX: TRMNO. A1, ; Get the UDX
PJRST RETZER ; Can't
PJRST VALRET ; Got it, return the value
SUBTTL Commands -- "^^" - Return the value of the next character
;+
;.hl2 Return the value of the next character ("^^")
; This routine will return the value of the next character in the command
;string. It will give an error if there are no more characters in the string.
;-
CNTRUP: PUSHJ P,SKRCH ; Get the next character
ERROR E.MUU ; None, give the error
MOVE A1,CH ; Get the character in the right place
JRST VALRET ; And return it
SUBTTL Commands -- "\" - Read a number from the buffer
;+
;.hl2 Read a number from the buffer ("\" and "\\")
; This routine will return the value of the number which follows the pointer.
;The single backslash command reads this number in decimal, the double
;backslash reads it in octal.
;-
BAKSL: PUSHJ P,SKRCH ; Get the next character
JRST BAKS.D ; None, assume decimal
CAIN CH,"\" ; Is it the second backslash?
JRST BAKS.O ; Yes, read in octal
BAKS.D: PUSHJ P,REEAT ; Only single slash, back up the character
SKIPA P1,[EXP ^D10] ; And get the radix
BAKS.O: MOVEI P1,^D8 ; Get the radix
TXZE F,F.ARG ; Have an arg?
JRST BAKS.1 ; yes, go handle the number insertion
SETZ A1, ; Clear the value to return
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the address
LOAD. T2,BLKPT,(T1) ; Get the pointer location
PUSHJ P,SETINC ; Set up for GETINC
JRST VALRET ; Return the zero
PUSHJ P,GETINC ; Get the first character
JRST BAKS.3 ; Go return the value
CAIN CH,"+" ; Is it a plus sign?
JRST BAKS.0 ; Ignore the plus
CAIE CH,"-" ; Is it a minus sign?
JRST BAKS.2 ; No sign
TXO F,F.ARG ; Flag we must negate the arg
BAKS.0: PUSHJ P,GETINC ; Get a character
JRST BAKS.3 ; None left, this is it
BAKS.2: CAIGE CH,"0"(P1) ; Is this a valid digit?
CAIGE CH,"0" ; . . .
JRST BAKS.4 ; Not a digit, go exit
IMULI A1,(P1) ; Bump what we already have
ADDI A1,-"0"(CH) ; And add the character
JRST BAKS.0 ; Go for next character
BAKS.4: DECR. ,BLKPT,(T1) ; Decrement the pointer
BAKS.3: TXZE F,F.ARG ; Did we see a minus sign?
MOVN A1,A1 ; Yes, make it negative
PJRST VALRET ; And return it
; Here if an argument was given. Convert the number to ascii
;and insert the text into the buffer.
BAKS.1: MOVE T1,A1 ; Get the number
SETZB P2,P3 ; And clear the digit count
JUMPGE T1,BAKS.5 ; If positive just continue
AOS P2,P3 ; Otherwise bump the flag
MOVM T1,T1 ; And make the number positive
BAKS.5: IDIVI T1,(P1) ; Get a digit off
PUSH P,T2 ; Stack the digit
AOJ P2, ; And count it
JUMPN T1,BAKS.5 ; And loop for all of the digits
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
MOVE T2,P2 ; Get the number of characters
LOAD. T3,BLKPT,(T1) ; And where to put them
PUSHJ P,M$XPND ; Make room for the characters
LOAD. T2,BLKPT,(T1) ; Insert after the pointer
PUSHJ P,SETINC ; . . .
STOPCD BXS,<Backslash command expansion of buffer failed>
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the address back again
LOAD. T2,BLKPT,(T1) ; Get the current position
MOVE T3,T2 ; And make the end of the modified section
ADD T3,P2 ; . . .
PUSHJ P,UPDBND ; Update the bounds
JUMPE P3,BAKS.6 ; If it wasn't negative just continue
MOVEI CH,"-" ; Otherwise put the sign first
PUSHJ P,PUTINC ; Write it
JFCL ; Couldn't?
SOJ P2, ; And count the character
BAKS.6: POP P,CH ; Get a character
ADDX CH,"0" ; Convert the digit to ASCII
PUSHJ P,PUTINC ; Stuff in the character
JFCL ; Ignore it
SOJG P2,BAKS.6 ; Loop for all the chars
POPJ P, ; And return when done
SUBTTL Commands -- "A" - Append or return value of character
;+
;.hl2 Return value of character in text buffer
; This routine will return the value of the specified character in the
;text buffer, unless no arguments are given, in which case it will append
;the next buffer to the current one. nA will return the nth character
;to the right of the pointer. 0A will return the character to the left
;of the pointer. -nA will return the n+1st character to the left of the pointer.
;If.+n-1 is not within the buffer 0 will be returned, unless
;two arguments are given, in which case the first argument will be
;returned as the value.
;-
ACMD: TXNE F,F.ARG ; No argument implies Append
TXNE F,F.COLN ; Or is there a colon?
JRST APPEND ; Yes, this is an append command
MOVE T1,A1 ; Get the number of chars
SETZB A1,CH ; And set up for returning zero
; Set up 0 for return value
CHKEO EODEC,ACMD2 ; If EO = 2, do old-style 1A
TXZE F,F.ARG2 ; Was there a 2nd arg?
MOVE A1,A2 ; Yes, use it instead
ACMD1: SOS T2,T1 ; Get arg-1
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the address of the buffer
LOAD. T3,BLKPT,(T1) ; Get the pointer
ADD T2,T3 ; And get the place we want to see
JUMPL T2,VALRET ; Just return value if negative
CFMG. ,BLKEND,(T1),T2 ; Is it after Z?
JRST VALRET ; Yes, return the value we have
IDIVI T2,5 ; Convert to a byte pointer
TDO T2,BTAB(T3) ; . . .
ADDI T2,.BKTLN(T1) ; And make it absolute
LDB A1,T2 ; Get the character
PJRST VALRET ; And go return it
ACMD2: MOVEI T1,1 ; IF EO < 3, make arg=1
JRST ACMD1 ;
; Here for an append command ("A" or ":nA")
;If no argument just call YANK to read in another buffer load of input.
;If the argument is given, read in the number of lines specified by the
;argument.
APPEND: TXNN F,F.COLN ; Colon seen?
MOVX A1,.INFIN ; No, use infinity
MOVE T2,A1 ; Get the number to read
JUMPG T2,YANK.0 ; And go read the data
XMOVEI T1,$QRTPT+TXTBUF ; Get the TPT address
MOVX T2,.INFIN ; Assume as many line feeds as necessary
MOVX T3,.INFIN ; And as many chars
MOVN T4,A1 ; Get the the number of form feeds to read
PJRST F$RBUF ; Read a buffer
SUBTTL Commands -- Q-register -- "U" - Store numeric value
;+
;.hl2 Q-register commands
;.hl3 Store numeric value into the Q-register ("U")
; This command will store the argument into the Q-register. If two arguments
;are given the first argument is returned as the value.
;-
USE: PUSHJ P,QREGVI ; Get the Q-register index into T1
USE.0: MOVE P1,T1 ; Get the address of the QRG
TXNE F,F.STR1 ; First argument a string?
JRST USE.1 ; Yes, go handle it
LOAD. T1,QRGDTP,(P1) ; Get the datatype
MOVX T2,$DTNUM ; New value is numeric
XCT RQRGTB(T1) ; And release the previous item
STOR. A1,QRGVAL,(P1) ; Store the argument into the Q-register
USE.R: TXZN F,F.ARG2 ; Is there another arg?
POPJ P, ; No, just return
MOVE A1,A2 ; Move the arg
TXNN F,F.STR2 ; Second arg a string?
PJRST VALRET ; And return
LOAD. A1,TPTADR,+SARG$2 ; Yes, get the address
MOVE T1,CPYAG2 ; And the flag
PJRST STRRET ; And return
; Here if the argument is a string. Replace the Q-register value
;with the string argument.
USE.1: MOVE T2,$QRFLG(T1) ; Get the flags
TXNE T2,QR$TXT ; Allowed to put text in here?
ERROR E.VOQ ; No, value only
LOAD. T1,QRGDTP,(P1) ; Get the old data type
MOVX T2,$DTTXT ; And the new
XCT RQRGTB(T1) ; Release the previous value
PUSHJ P,GETAG1 ; Get the address of the arg
XMOVEI T2,$QRTPT(P1) ; And the pointer
PUSHJ P,M$USEB ; Set up the pointer
JRST USE.R ; Return the other arg, if one
SUBTTL Commands -- Q-register -- "Q" - Fetch numeric value
;+
;.hl3 Fetch numeric value ("Q")
; This command will fetch the numeric value from a q-register.
;-
QREG: PUSHJ P,QTXTST ; Get the Q-register index and check if text
JRST [MOVE A1,T1 ; Get the value
PJRST VALRET] ; And return it
MOVE A1,T1 ; Get the buffer address
MOVX T1,.FALSE ; Flag there arg more pointers here
PJRST STRRET ; And return the string
SUBTTL Commands -- Q-register -- "%" - Increment the value
;+
;.hl3 Increment the value ("%")
; This command will increment the numeric value that is in the Q-register.
;It will return the new value of the Q-register.
;-
PCNT: PUSHJ P,QTXTST ; Get the Q-register index and check for text
JRST .+2 ; Skip
ERROR E.NNQ ; Non-numeric Q-register
LOAD T4,$QRFLG(T2),QR$VLU ; Get the flag
JMPT T4,[ERROR E.TOQ] ; Text only ?
TXNN F,F.ARG ; Have an arg?
MOVEI A1,1 ; No, use a one
ADDB A1,$QRVAL(T2) ; Bump the value
PJRST VALRET ; And return the new value
SUBTTL Commands -- Q-register -- "X" - Insert text into Q-reg
;+
;.hl3 Insert text ("X")
; This command will copy the specified text into the Q-register. If
;two args are given they are the character positions for the text
;to be copied. If only one arg is given it is the number of lines
;before (if negative) or after (if negative) to copy.
;-
XCMD: PUSHJ P,GETARG ; Set up A1/A2 with character indices
PUSHJ P,QREGVI ; Get the Q-register index
MOVE T2,$QRFLG(T1) ; Get the flags
TXNE T2,QR$TXT ; Allowed to put text in here?
ERROR E.VOQ ; No, value only
MOVE P1,T1 ; Into a safer place
LOAD. T1,QRGDTP,(P1) ; Get the previous data type
MOVX T2,$DTTXT ; And the new data type
XCT RQRGTB(T2) ; And return the previous value
MOVE T1,A1 ; Get the number of chars
SUB T1,A2 ; We need
PUSHJ P,M$GTXT ; Get the buffer
MOVE P2,T1 ; Get the address
XMOVEI T2,$QRTPT(P1) ; Set up to set the address
PUSHJ P,M$USEB ; And add the user
MOVE T1,A2 ; Set up where to move from
LOAD. T3,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
BLDBPT (T1,(T3)) ; Build the byte pinter
MOVE T2,A1 ; Set up the count
SUB T2,A2 ; . . .
MOVE T3,P2 ; And the buffer address
ZERO. ,BLKPT,(T3) ; Insert from start of buffer
ZERO. T4,BLKCOL,(T3) ; Clear the current column
XMOVEI T4,$QRTPT+TXTBUF ; Get the pointer to the source
PJRST M$INSS ; Do it
SUBTTL Commands -- Q-register -- "G"
;+
;.hl3 Fetch text from Q-register ("G")
; This command will insert the text from the given Q-register into
;the text buffer after the pointer. The pointer will be positioned after
;the the newly inserted text. The Q-register will not be modified.
;-
QGET: PUSHJ P,QTXTST ; Get the buffer address
ERROR E.NTQ ; Give the error (no text in Q-register)
XMOVEI T4,$QRTPT(T2) ; Get the address of the pointer
LOAD. P1,TPTADR,+T1 ; Get the buffer address
XMOVEI T1,.BKTLN(P1) ; Get the address of the text
TXO T1,<$POINT(7)> ; Get the byte pointer
LOAD. T2,BLKEND,(P1) ; Get the character count
LOAD. T3,TPTADR,+$QRTPT+TXTBUF ; And get the text buffer address
PUSH P,.BKPT(T3) ; Save the old PT
PUSHJ P,M$INSS ; Move the string
LOAD. T2,TPTADR,+$QRTPT+TXTBUF ; Get the address back
STOR. T1,BLKPT,(T2) ; Store the pointer back
ZERO. T3,BLKCOL,(T2) ; Clear the current column
MOVE T3,T1 ; Get the end of mod address
MOVE T1,T2 ; And the buffer address
POP P,T2 ; And get back the start of mod address
PJRST UPDBND ; And go update the bounds
SUBTTL Commands -- Q-register -- "M" and "W"
;+
;.hl3 Q-register execution ("M" and "W")
; These commands cause the Q-register to be executed as commands. From
;command level M and W work the same, however, when executed in a macro
;M is a subroutine call, and W is a GOTO.
;-
MJRST: SKIPE EQM ; Here for W command, at command level?
JRST QACCES ; Not at command level, do stack anything
MAC: PUSHJ P,QTXTST ; Get the buffer address and check for text
ERROR E.NTQ ; No text in Q-reg
; Here from EP processing in TECECM. At this point the Q-register has
; been read into core and is about to be executed.
MAC.0: MOVE P1,T2 ; Save the address of the QRG block
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer
CFMN. T2,TPTADR,+$QRTPT(P1),T1 ; Is this what we are currently editing?
ERROR E.XTI ; Yes, that is not allowed
$ADJSP XS,$XSMLN ; Allocate the space for the items
STOR. F,XSBFLG,(XS) ; Store the flags
TXZ F,F.COLN ; Clear the colon flag (:EI command)
MOVE T1,ERRPT ; Get the current error position
STOR. T1,XSBERA,(XS) ; Store it
XMOVEI T2,$XSBUF(XS) ; Get the address
LOAD. T1,TPTADR,+XCTBUF ; And the buffer address
IFN FTDEBUG,SETZM (T2) ; Clear the pointer if debugging
PUSHJ P,M$USEB ; And add the user
MOVX T1,$XEMAC ; Get the block type
STOR. T1,XSBTYP,(XS) ; Store it
AOS EQM ; Bump the level we are at
JRST MAC.2 ; And go store new stuff
QACCES: PUSHJ P,QTXTST ; See if text in buffer
ERROR E.NTQ ; No text in Q-register
MOVE P1,T2 ; Get the table index
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer
CFMN. T2,TPTADR,+$QRTPT(P1),T1 ; Is this what we are currently editing?
ERROR E.XTI ; Yes, that is not allowed
MAC.2: XMOVEI T1,XCTBUF ; Unlink the old buffer
PUSHJ P,M$RELB ; . . .
XMOVEI T2,XCTBUF ; And set up the new one
LOAD. T1,TPTADR,+$QRTPT(P1) ; And get the address of te new one
PUSHJ P,M$USEB ; Set up the new user
LOAD. T2,TPTADR,+XCTBUF ; Get the buffer address
XMOVEI T1,.BKTLN(T2) ; Get the address of the text
TXO T1,<$POINT(7)> ; And set up the byte pointer
STOR. T1,BLKPTR,(T2) ; Store the byte pointer
ZERO. ,BLKPT,(T2) ; Clear the value of PT
ZERO. T1,BLKCOL,(T2) ; Clear current column
PJRST PASRET ; Pass the values through to the macro
SUBTTL Commands -- Q-register -- "]" - Pop Q-register
;+
;.hl3 Pop Q-register ("]")
; This command will pop a Q-register off of the Q-register stack. Note
;that the Q-register stack is cleared at the start of each complete
;command string (every time TECO prompts).
;-
CLOSEB: PUSHJ P,QREGVI ; Get the index
MOVE P1,T1 ; Get the index into a safe place
MOVE P2,QRGSTK ; Get stack pointer
IFN FTXADR,CAMG P2,[EXP PFL] ; Anything on the stack?
IFE FTXADR,CAIG P2,PFL ; Anything on the stack?
ERROR E.PDQ ; No, give the error
LOAD. T1,QRGDTP,(P1) ; Get the data type
MOVE T2,(P2) ; Get the new data type
XCT RQRGTB(T1) ; Release the previous data
MOVE T1,(P2) ; Get the old data type
CAXE T1,$DTNUM ; Numeric value?
JRST CLSB.1 ; No, try again
MOVE T1,-1(P2) ; Remove the value
MOVEM T1,$QRVAL(P1) ; Save it
JRST CLSB.2 ; And remove the items from the stack
CLSB.1: XMOVEI T1,$QRTPT(P1) ; Get the pointer address
SKIPE (T1) ; Anything to free up?
PUSHJ P,M$RELB ; Yes, release this use of it
LOAD. T1,TPTADR,-1(P2) ; Get the buffer address
XMOVEI T2,$QRTPT(P1) ; And the pointer address
PUSHJ P,M$USEB ; Yes, remember the new use
XMOVEI T1,-1(P2) ; And release
PUSHJ P,M$RELB ; The old use
CLSB.2: SUBI P2,2 ; Remove the two items
MOVEM P2,QRGSTK ; And store the updated pointer
POPJ P, ; And return
SUBTTL Commands -- Q-register -- "[" - Push a Q-reg
;+
;.hl3 Push a Q-register ("[")
; This command will save the value of a Q-register on the stack.
;It saves both the numeric part and the text part of the Q-register.
;If this command is preceded by arguments it will push the Q-register
;and then act like a "U" command. Note that values stored on the stack
;are cleared every time we prompt, therefore the PUSH/POP sequence must
;be within the same command.
;-
OPENB: PUSHJ P,QREGVI
MOVE P1,T1 ; Get the value
MOVE P2,QRGSTK ; Get the current stack pointer for the Q-reg stack
IFN FTXADR,CAML P2,[EXP PFL+LPF] ; At the end of the stack?
IFE FTXADR,CAIL P2,PFL+LPF ; At the end?
ERROR E.PDQ ; Yes, can't stack any more items
ADDI P2,2 ; Make room for the value and the data type
SETZM -1(P2) ; Clear the text pointer word
LOAD. T1,QRGDTP,(P1) ; Get the data type of the Q-register
MOVEM T1,(P2) ; Save the data type
CAXN T1,$DTNUM ; Numeric value?
JRST OPEN.1 ; Yes, skip this
XMOVEI T2,-1(P2) ; Yes, get the address of the new pointer
LOAD. T1,TPTADR,+$QRTPT(P1) ; And the buffer address
PUSHJ P,M$USEB ; And add this user of the block
JRST OPEN.2 ; And go store the new pointer
OPEN.1: LOAD. T1,QRGVAL,(P1) ; Get the value
MOVEM T1,-1(P2) ; Save it
OPEN.2: MOVEM P2,QRGSTK ; Store the pointer back
TXNN F,F.ARG ; Have any args?
POPJ P, ; No, return
MOVE T1,P1 ; Get the index back
PJRST USE.0 ; And go handle the args
SUBTTL Commands -- Q-register -- Utility routines -- RQRGTB
;+
;.hl3 Utility routines
;.hl4 RQRGTB
; This set of routines is used to release the previous contents of a
;Q-register when a new item is to be stored into it.
;.lit
;
; Usage:
; P1/ QRG address
; T1/ QRGDTP (data type)
; T2/ New data type
; XCT RQRGTB(T1)
; (return here, value can now be stored)
;
;.end lit
;-
; Table of instructions to release the previous contents of the Q-reg.
TABDEF RQRG,$DT
TABENT TXT,<PUSHJ P,RQRGTX> ; For a text buffer
TABENT FCT,<PUSHJ P,RQRGFC> ; For an FC table
TABENT NUM,<PUSHJ P,RQRGNM> ; For a numeric value
TABEND
; Table of to check if new value is allowed.
TABDEF NQRG,$DT
TABENT TXT,<IFIW NQRGTX> ; For text
TABENT FCT,<IFIW NQRGFC> ; For an FC table
TABENT NUM,<IFIW NQRGNM> ; For a numeric value
TABEND
; Here for numeric values
RQRGNM: PUSHJ P,@NQRGTB(T2) ; Check if new value is allowed
STOR. T2,QRGDTP,(P1) ; Store the new type
ZERO. ,QRGPDB,(P1) ; And clear the previous buffer field
POPJ P, ; And return
; To check for the new numeric value
NQRGNM: LOAD T3,$QRFLG(P1),QR$VLU ; Get the flag
JMPF T3,.POPJ ; Just return if allowed
ERROR E.TOQ ; Text only Q-reg
; Here for text values
RQRGTX: PUSHJ P,@NQRGTB(T2) ; Check if new value is allowed
CAXN T2,$DTTXT ; New value also text?
JRST RQTX.1 ; Yes, don't bother with PDB field
PUSH P,T2 ; Save the new type
XMOVEI T1,$QRPDB(P1) ; Get the previous buffer field
SKIPE (T1) ; Anything there?
PUSHJ P,M$RELB ; Yes, release it
ZERO. ,QRGPDB,(P1) ; Clear out the previous buffer pointer field
POP P,T2 ; Restore the new type
RQTX.1: STOR. T2,QRGDTP,(P1) ; Store the new data type
XMOVEI T1,$QRTPT(P1) ; Get the TPT address
SKIPE (T1) ; Already zero?
PUSHJ P,M$RELB ; No, clear it
POPJ P, ; And return
; Here to check if text value is allowed
NQRGTX: LOAD T3,$QRFLG(P1),QR$TXT ; See if text allowed
JMPF T3,.POPJ ; Yes, just return
ERROR E.VOQ ; No, complain
; Here for an FC table
RQRGFC: PUSHJ P,@NQRGTB(T2) ; Check the new value
JRST RQTX.1 ; And go return the old FC table
; Here to check if FC table is allowed
NQRGFC: LOAD T3,$QRFLG(P1),QR$FCT ; Allowed to store this here?
JMPF T3,.POPJ ; No, don't allow this
ERROR E.TOQ ; Assume it is text only
POPJ P, ; For now allow all QRG's
SUBTTL Commands -- Q-register -- Utility routines -- QREGVI
;+
;.HL4 QREGVI
; This routine will return a Q register index. There is an alternate
;entry point at QREGV2, which expect the character in CH.
;.b.literal
; Usage:
; PUSHJ P,QREGVI
; (Return index in T1)
;
; or
;
; MOVEI CH,Character
; PUSHJ P,QREGV2
; (Return index in T1)
;.end literal
;-
QREGVI: SETZ T1, ; No default
PUSHJ P,SCNQRG ; Get the Q-register name
JRST QREG.0 ; Couldn't, must be old style
LOAD T2,$QRFLG(T1),QR$WRT ; See if we can read/write it
CAME T1,CUREDT ; Current editing buffer?
JMPF T2,.POPJ ; Yes, just return then
ERROR E.DOQ ; No, Display only Q-register
QREG.0: PUSHJ P,SKRCH ; Get the Q-register name from the command string
ERROR E.MIQ ; Missing Q-reg name
QREGV2: MOVE T1,CHRFLG(CH) ; Get the flags
TXNN T1,CF.QRG ; Valid Q-register name?
ERROR E.IQN ; No give up
LOAD. T1,CDTQRI,+T1 ; Get the Q-register index
IMULX T1,$QRLEN ; Make the offset
ADDI T1,QTAB ; And make it the base address
MOVEM T1,LASQRG ; Save the last Q-reg used
CAME T1,CUREDT ; Same as current editing buffer?
POPJ P, ; And return it
ERROR E.DOQ ; No, punt
SUBTTL Commands -- Q-register -- Utility routines -- SCNQRG
;+
;.HL4 SCNQRG
; This routine will scan off a Q-register name and return the index.
;The format of the Q-register name is "(Q-register name)".
;.b.literal
; Usage:
; MOVEI T1,"default Q-register name"
; PUSHJ P,SCNQRG
; (Failed)
; (good return, T1= QRG block)
;
;.end lit
;-
SCNQRG: XMOVEI T2,SKRCH ; Get the routine to call to get the chars
XMOVEI T3,REEAT ; Routine to re-eat characters
XMOVEI T4,XCTBUF ; Get the default pointer address
REDQRG: $SAVE <P1,P2,P3,S,F> ; Save P1 and P2
TXNE S,S.NTRC ; Tracing suppressed?
TXZ F,F.TRAC ; Yes, turn it off
SETZM LASQRG ; Clear the last Q-reg
DMOVE P1,T2 ; Save the routine address
MOVE P3,T4 ; Get the TPT address
PUSH P,T1 ; Save the default
XMOVEI T1,QRNTPT ; Get the TPT address
SKIPE (T1) ; Anything there?
PUSHJ P,M$RELB ; Yes, release it
SETZM QRNTPT ; Clear it out
POP P,T1 ; Get the default back
PUSHJ P,(P1) ; Get what should be a paren
ERROR E.IQN ; Give the error (Illegal Q-register name)
CAXE CH,"(" ; Is it an open paren?
JRST SCNQ.0 ; No, not a Q-register name
LOAD. T2,TPTADR,(P3) ; Get the text buffer address
LOAD. T3,BLKPTR,(T2) ; Get the byte pointer
LOAD. T4,BLKPT,(T2) ; Get the current pointer
TXO S,S.NTRC ; Turn off tracing for a moment
PUSHJ P,(P1) ; Get the Q-register name
ERROR E.IQN ; No good
MOVE T1,CH ; Get the character
PUSHJ P,(P1) ; And get the close paren
JRST [MOVE CH,T1 ; Reset the character
TXZ S,S.NTRC ; Turn tracing back on (maybe)
TXNE F,F.TRAC ; Are we tracing?
PUSHJ P,T$OCHR ; Yes, type the character
ERROR E.MRP] ; Missing right paren
TXZ S,S.NTRC ; Clear the trace suppression
CAXE T1,$CHQOT ; Quoting character?
CAXE CH,")" ; Is it really one?
JRST .+2 ; Not a short name
JRST SCNQ.1 ; It is, short old-style q-register
CHKEO EO200,SCNQ.2 ; If all chars allowed in Q-reg names, go get the name
; Here to scan off the long name. We will build it into a BLK doing
;the necessary conversions. The name will be converted to upper case only,
;and the ^Gi construct will be allowed.
;Note that it will not allow nesting of long Q-register names.
;The argument for the ^G must be a single character Q-reg name.
STOR. T3,BLKPTR,(T2) ; Reset the position so we scan from the
STOR. T4,BLKPT,(T2) ; start of the name.
MOVX T1,^D15 ; Get a reasonable size for a name
PUSHJ P,M$GTXT ; And get the text block
XMOVEI T2,QRNTPT ; Get the address of the pointer
PUSHJ P,M$USEB ; Set up the pointer
SETZM QRNQRG ; Flag not nested yet
PUSH P,S ; Save the secondary flags
TXZ S,S.NCCT!S.CTLV!S.CTLW!S.CTVV ; Flag no control-T seen yet
TXO S,S.CTWW ; Flag we really want upper case
SCNLQN: PUSHJ P,(P1) ; Get a character
ERROR E.MRP ; Nothing there?
CAXN CH,")" ; End of the name?
SKIPE QRNQRG ; Yes, in a nested Q-reg?
JRST .+2 ; Not end of name
JRST SLQN.E ; End of name
XMOVEI T1,SLQTB1 ; Get the table address
TXNE S,S.NCCT ; Control-T seen?
XMOVEI T1,SLQTB2 ; Yes, get the other table pointer
PUSHJ P,NDISPT ; Dispatch on the character
PUSHJ P,CASE.0 ; Do proper casing
PUSHJ P,CKNCC ; Check if legal control-character
XMOVEI T1,QRNTPT ; Get the address of the TPT
PUSHJ P,M$ACHR ; And add the character in
JRST SCNLQN ; Get the next character
; Dispatch tables
SLQTB1: XWD SLQN.G,.CHBEL ; ^G
XWD SLQN.V,.CHCNA ; ^A
XWD SLQN.W,.CHCNB ; ^B
XWD SLQN.V,.CHCNV ; ^V
XWD SLQN.W,.CHCNW ; ^W
SLQTB2: XWD SLQN.T,.CHCNT ; ^T
XWD SLQN.R,$CHQOT ; Quoting character
XWD 0,0 ; End of table
; Here on a control-T. Complement the flag
SLQN.T: TXC S,S.NCCT ; Change whether control chars are allowed
JRST SCNLQN ; And try again
; Here on a control-R. Take the next character literally
SLQN.R: PUSHJ P,(P1) ; Get a character
ERROR E.MRP ; Punt
XMOVEI T1,QRNTPT ; Get the TPT address
PUSHJ P,M$ACHR ; Append the character
JRST SCNLQN ; And get the next character
; Here on an ^W (^A)
SLQN.W: PUSHJ P,C.W ; Use common routine
JRST SCNLQN ; And get next character
; Here on an ^V (^B)
SLQN.V: PUSHJ P,C.V ; Play with the flags
JRST SCNLQN ; And try again
; Here on a ^G. The next character should be a single character Q-reg
;name.
SLQN.G: PUSHJ P,(P1) ; Get the next character
ERROR E.IQN ; None there, punt
PUSHJ P,QREGV2 ; Get the QRG address
PUSHJ P,QTXTEI ; And make sure it has text
PUSH P,P1 ; Save the get-a-char address
PUSH P,QRNQRG ; Save the nested address
MOVEM T2,QRNQRG ; Save the QRG address
SETZ T2, ; Set up to fetch the first character
PUSHJ P,SETINC ; . . .
JFCL ; First GETINC call will fail
XMOVEI P1,SLQN.H ; Get the routine to fetch characters
JRST SCNLQN ; And try again
; Routine to fetch characters from the Q-reg for ^Gi
SLQN.H: MOVE T1,QRNQRG ; Get the QRG address
LOAD. T1,TPTADR,+$QRTPT(T1) ; And get the BLK address
PUSHJ P,GETINC ; Get a character
JRST SLQN.I ; All done, get out
PJRST .POPJ1 ; Give the good return
SLQN.I: POP P,CH ; Get the return address
POP P,QRNQRG ; Get the previous QRG address
POP P,P1 ; And the previous routine
PUSH P,CH ; Stuff the return address back
PJRST (P1) ; And try again
; Here when we have found a close paren ")". If we are in a ^Gi at
;all, complain. If not, set things up for the common code to do the
;lookup. Also, check for the case of a single character name showing up here.
SLQN.E: TXZ S,S.NCCT!S.CTLV!S.CTVV!S.CTLW!S.CTWW ; Clear the control-T flag
POP P,T2 ; Restore T2
TXNE T2,S.CTLV ; Control V inforce?
TXO S,S.CTLV ; Yes, turn it back on
TXNE T2,S.CTLW ; Control W inforce?
TXO S,S.CTLW ; Yes, turn it back on
TXNE T2,S.CTWW ; ^W^W?
TXO S,S.CTWW ; Yes, turn that on too
TXNE T2,S.CTVV ; ^V^V?
TXO S,S.CTVV ; Yes, turn that on too
SKIPE QRNQRG ; At top level?
ERROR E.IQN ; No, punt
LOAD. T2,TPTADR,+QRNTPT ; Get the address of the text
XMOVEI T3,.BKTLN(T2) ; Get the address of the text
TXO T3,<$POINT(7)> ; And set up the byte pointer
LOAD. T4,BLKEND,(T2) ; Get the length
XMOVEI P3,QRNTPT ; And the address of the pointer
CAXE T4,1 ; Only a single character name?
JRST SCNQ.9 ; No, go do the lookup
ILDB CH,T3 ; Yes, get the character
XMOVEI T1,QRNTPT ; Get the TPT address
PUSHJ P,M$RELB ; Release the buffer
MOVE T1,CH ; Get the character
JRST SCNQ.3 ; And go check if valid Q-reg
; Here for original long names. All characters except ")" are allowed,
;and no conversion to upper case is done.
;Enters with T2/ BLK address, T3/ Byte pointer to start, T4/ PT to start
SCNQ.2: TXNN F,F.TRAC ; Tracing enabled?
JRST SCNQ.6 ; No, skip this
EXCH CH,T1 ; Yes, get the first character
PUSHJ P,T$OCHR ; Print it
EXCH CH,T1 ; Get the second character
PUSHJ P,T$OCHR ; and type it out
SCNQ.6: PUSHJ P,(P1) ; Get the next character
ERROR E.MRP ; ++ Missing right paren
CAXE CH,")" ; Is it the closing paren ?
JRST SCNQ.6 ; No, Try again
LOAD. T1,BLKPT,(T2) ; Get the current pointer
SUBM T1,T4 ; Compute the length of the name
SOS T4 ; Decrement by one more to account for the )
SCNQ.9: $SAVE <P4> ; Save a few registers
DMOVE P1,T3 ; Move the length and the byte pointer
MOVE T1,[XWD -QNMLEN,QNMTBL] ; Get the pointer to the table
DMOVE T2,P1 ; Copy the items
PUSHJ P,FNDSTR ; Find the string
JRST SCNQ.4 ; Failed - Process it via symbol table
DMOVE T1,2(T1) ; Get the address and the flags
MOVEM T1,LASQRG ; Save the address of the last Q-reg
IORM T2,$QRFLG(T1) ; Turn on the bits
JRST .POPJ1 ; Give a good return
; Here if we have to call the symbol table management for the Q-register
; name.
SCNQ.4: LOAD. T1,TPTADR,(P3) ; Get the text buffer address
LOAD. T2,BLKPT,(T1) ; Get the address of the current PT
SUBI T2,1(P2) ; Remove the length
CAIN P3,QRNTPT ; Is this a new type name?
AOJ T2, ; Yes, don't count the paren
MOVE T3,P2 ; Get the length of the symbol
PUSHJ P,S$QREG ; Call the symbol table management for it
JRST SCNQ.5 ; Already defined, return the QRG block
STKTPT (T1,STETPT) ; Set up the pointer to the symbol
MOVX T1,$QRLEN ; Get the length of a QRG block
MOVX T2,.BTGEN ; Allocate it from general storage
PUSHJ P,M$ZBLK ; Allocate a zero block
LOAD. P4,TPTADR,+STETPT ; Get the address of the block
STOR. T1,SYMQRG,(P4) ; Store the address of the QRG block
MOVEM T1,LASQRG ; Save the last QRG seen
EXCH P4,T1 ; Get the address of the STE
XMOVEI T2,$QRQRN(P4) ; And set up the pointer
PUSHJ P,M$USEB ; . . .
EXCH T1,P4 ; Switch things back
BITON T2,QR$LQR,$QRFLG(T1) ; Flag this is a user long name
SKIPE QRNTPT ; Have a TPT to return?
JRST SCNQ.8 ; Yes, go do it
PJRST .POPJ1 ; Return to the caller
; Here if the Q-register was defined before
SCNQ.5: LOAD. T1,SYMQRG,(T1) ; Get the QRG block address
MOVEM T1,LASQRG ; Save the Q-register name
SKIPN QRNTPT ; Have something to return?
PJRST .POPJ1 ; Return to the caller
SCNQ.8: PUSH P,T1 ; Yes, save T1
XMOVEI T1,QRNTPT ; Get the address
PUSHJ P,M$RELB ; Release the BLK
SETZM QRNTPT ; Flag nothing there now
POP P,T1 ; Restore T1
PJRST .POPJ1 ; And return
; Here the old style Q-register names
SCNQ.0: PUSHJ P,(P2) ; Call the routine to reeat the character
JUMPE T1,.POPJ ; If no Q-register name give up
JRST SCNQ.3 ; Go find the QRG block for this character
SCNQ.1: TXNN F,F.TRAC ; Tracing enabled?
JRST SCNQ.3 ; No, skip this
MOVE CH,T1 ; Get the character back
PUSHJ P,T$OCHR ; Print the trace character
MOVX CH,")" ; Get the close paren
PUSHJ P,T$OCHR ; And output it
SCNQ.3: MOVE CH,T1 ; Get the character
AOS (P) ; Give the good return
MOVE T1,CHRFLG(CH) ; Get the flags
TXNN T1,CF.QRG ; Valid Q-reg name?
ERROR E.IQN ; No, punt
LOAD. T1,CDTQRI,+T1 ; Get the index
IMULX T1,$QRLEN ; Get the offset
ADDI T1,QTAB ; Point to the QRG
MOVEM T1,LASQRG ; Save the last Q-reg name
POPJ P, ; And return
; Table of special Q-register names
SYN QRGNAM, STRTBL
DEFINE STRSUB (ADR,FLG),<
EXP ADR
EXP QR$PRD!FLG
>
DOSTR (QNM) ; Build the names
SUBTTL Commands -- Q-register -- Utility routines -- QTXTEI
;+
;.HL4 QTXTEI
; This routine will check to see if the specified Q-register contains text or
;a numeric value. If it contains a value it will give an error message (NTQ).
;Otherwise it will return the address of the text block.
;.literal
;
; Usage:
; PUSHJ P,QREGV2 ; (or QREGVI)
; PUSHJ P,QTXTEI
; (Return -- T1 contains the text block address)
;.end literal
;-
QTXTEI: MOVE T2,T1 ; Copy the index
LOAD. T1,QRGDTP,(T2) ; Get the data type
CAXE T1,$DTTXT ; Is it a text Q-reg?
ERROR E.NTQ ; No, no text here
LOAD. T1,TPTADR,+$QRTPT(T2) ; Is there any text ?
POPJ P, ; Yes - Just return
SUBTTL Commands -- Q-register -- Utility routines -- QTXTST
;+
;.hl4 QTXTST
; This routine will set up the Q-register index and return the value of the
;Q-register. If the Q-register contains text, the value will be the address
;of the text block, otherwise it will be the numeric value from the Q-reg.
;A skip return will be given if the Q-reg contains text.
;.b
;.literal
; Usage:
; PUSHJ P,QTXTST
; (Q-reg contains number, value in T1, index in T2)
; (Q-reg contains text, address in T1, index in T2)
;
;.end literal
;-
QTXTST: PUSHJ P,QREGVI ; Get the index into T1
MOVE T2,T1 ; Get the index
LOAD. T1,QRGDTP,(T2) ; Get the data type
CAXN T1,$DTFCT ; Is this an FC table?
ERROR E.NTQ ; Yes, punt
CAXE T1,$DTTXT ; Text?
JRST QTXT.1 ; No, must be numeric
LOAD. T1,TPTADR,+$QRTPT(T2) ; Get the address of the text
PJRST .POPJ1 ; And give the text return
QTXT.1: MOVE T1,$QRVAL(T2) ; Get the number
POPJ P, ; And return it
SUBTTL Commands -- "^U" - Set next block to read
;+
;.hl2 Set next block to read ("^U")
; This command will set the next block to be read from an input file.
;This command is only legal on a file which is open only for input
;(i.e., ER command or EB/READ command).
;-
IUSET: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the block address
PUSHJ P,GETFDI ; Get the FDB address
ERROR E.NFI ; No file for input
MOVE T2,.FDFLG(T1) ; Get the flags
TXNE T2,FD.OPN ; Is this open
TXNN T2,FD.IN ; Open for input?
ERROR E.NFI ; No file for input
TXNN T2,FD.TMP ; Is it a TMPCOR file?
TXNE T2,FD.EB ; Or open for EB?
USTERR: ERROR E.UST ; Yes, give the USETI illegal message
JUMPLE A1,USTERR ; Give the error if block is not positive
MOVE T2,A1 ; Get the arg
PUSHJ P,F$USET ; Set up the block
PJRST F$ERR ; Go handle the error
POPJ P, ; and return
SUBTTL Commands -- "^G" - GETTAB or EXIT
;+
;.hl2 GETTAB or EXIT ("^G")
; This command will return the value of the given GETTAB table entry.
;If no arguments arg given it will return the user's job number.
;If only one argument is given it will return the result of a PEEK
;on the address given as the argument (don't ask me why).
;If the EO level is set to EO21 or less, it will do the old function of
;exiting.
;-
BELDMP: CHKEO EO21,DECDMP ; Old exit command if EO level set back
TXNE F,F.ARG ; If no arg then return the job number
JRST BELD.1 ; Have an arg, go do the gettab
PJOB A1, ; Get our job number
PJRST VALRET ; And return it
BELD.1: TXZN F,F.ARG2 ; Give two args?
JRST BELD.2 ; No, he wants a PEEK
HRL A1,A2 ; Get the table index
GETTAB A1, ; Get the value
SETZ A1, ; Return a zero if not there
PJRST VALRET ; Go return it
BELD.2: PEEK A1, ; Get the value
PJRST VALRET ; And return it
SUBTTL Commands -- "^V" and "^W" - Lower and upper case flags
;+
;.hl2 Lower and upper case conversion ("^V" and "^W")
; These commands control whether case conversion should be done, and
;what should be converted to what. "^V" with no args will cause all
;upper case to be converted to lower case. "^W" with no args will
;cause lower case to be converted to upper case. If either is
;given the argument of zero, it will clear all case conversion.
;-
; "^V" command
LOWCAS: TXNE F,F.ARG ; Did we have an arg?
JUMPE A1,CLRCAS ; Yes, if it was 0 clear both flags
TXZ S,S.UCAS ; Otherwise clear lower to upper
TXO S,S.LCAS ; And set upper to lower
POPJ P, ; And return
; "^W" command
STDCAS: TXNE F,F.ARG ; Did we have an argument?
JUMPE A1,CLRCAS ; Yes, if it was 0 clear case conversion
TXZ S,S.LCAS ; Else clear upper to lower
TXO S,S.UCAS ; And set lower to upper
POPJ P, ; Return
; Here for both "0^V" and "0^W"
CLRCAS: TXZ S,S.LCAS+S.UCAS ; Clear all case converion
POPJ P, ; And return
SUBTTL Commands -- "^X" - Set or clear exact match
;+
;.hl2 Set or clear exact match flag (^X)
; This command is used to determine whether the case of a letter is
;to matter in a search. "0^X" will make upper and lower case considered
;the same during a search. "n^X" (n not 0) will make upper and
;lower case be considered different during searches. The command
;with no argument will return the value of the flag, 0 if casing
;is not considered, and -1 if casing is considered different.
;-
SETMCH: TXNE F,F.ARG ; Did we have an arg?
JRST SETM.1 ; Yes, set or clear the flag
TXNE F,F.PMAT ; No, is the flag on?
JRST RTONES ; Yes, return -1
JRST RETZER ; No, return 0
SETM.1: TXZ F,F.PMAT ; Assume arg is zero
JUMPE A1,.POPJ ; If zero just return
TXO F,F.PMAT ; Else set the flag
POPJ P, ; And return
SUBTTL Commands -- "Y" ("EY") - Render the buffer empty
;+
;.hl2 Yank in a new buffer ("Y" or "EY")
; This command will input a new text buffer without writing out
;the current buffer. This command must be typed as "EY" from
;command level, unless the EO level is set to EODEC or less. This
;is prevent an accidental "Y" command.
;This routine will first clear the current buffer. It will then read
;into the buffer until a form feed is read, the end of file
;is encountered, the buffer is within one third or 128 characters
;of being full, and a line feed is read, or the buffer is completely
;full.
;-
YANKER: CHKEO EODEC,YANK ; Y is OK if EO level is 2 or less
SKIPN EQM ; "Y" is illegal from TTY
ERROR E.UEY ; Give use "EY" message instead
YANK: LOAD. P1,TPTADR,+$QRTPT+TXTBUF ; Get the address of the text buffer
ZERO. ,BLKPT,(P1) ; And clear it
ZERO. T1,BLKCOL,(P1) ; Clear current column
LOAD. T1,BLKEND,(P1) ; Get the number in the buffer
ZERO. ,BLKEND,(P1) ; Of all characters
LOAD. T2,BLKFRE,(P1) ; Get the number free
ADD T1,T2 ; Compute the new number free
STOR. T1,BLKFRE,(P1) ; Store it
MOVX T2,.INFIN ; Get the number of line feeds
; Here to read more into the buffer. The buffer will be expanded and the characters
;read until one of the above conditions terminates the read.
YANK.0: PUSH P,T2 ; Save the number of lines to read
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
LOAD. T2,BLKEND,(T1) ; Get the current end
MOVX T3,.INFIN ; Last modified loc
PUSHJ P,UPDBND ; Update the bounds
XMOVEI T1,$QRTPT+TXTBUF ; Get the buffer address
POP P,T2 ; Get the number of line feeds back
MOVX T3,D.TXTS ; Get the amount to expand the buffer
MOVX T4,0 ; And the number of form feeds
PJRST F$RBUF ; Just read it in
SUBTTL Commands -- ^Y and ^P - quick page scan commands
;+
;.hl2 Quick page scan commands ("^Y" and "^P")
; These commands are used to scan ahead for a given page number in the
;file. When given with no argument they return the current page number
;in the file. Control-Y will cause the new page to be read discarding
;the current buffer and all data between that buffer and the given page.
;-
QYANK: TXO S,S.YANK ; Note control-Y command
QPAGE: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
PUSHJ P,GETFDI ; And get the FDB address
JRST [TXNE F,F.ARG ; No open file
ERROR E.NFI ; No file for input
PJRST RETZER] ; Just wanted page number, return 0
MOVE P1,T1 ; Get a safe copy of the FDB address
TXNE F,F.ARG ; Just return a value?
JRST QPAG.1 ; No, go read the page.
LOAD. A1,FDBFFC,(P1) ; Yes, get the page number
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address again
MOVX T2,TF.FFD ; Check if we had a form feed
TDNE T2,.BKTFL(T1) ; . . .
SOJ A1, ; Have a form feed at the end, don't count that one
PJRST VALRET ; And return it
; Here if the user gave an argument
QPAG.1: TXNE S,S.YANK ; Doing an^Y?
JRST QPAG.0 ; Yes, don't need output
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address again
PUSHJ P,GETFDO ; Get the output FDB
ERROR E.NFO ; No file for output
MOVE P2,T1 ; Save for later
QPAG.0: LOAD. T2,FDBFFC,(P1) ; Get the page number
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address back
MOVX T3,TF.FFD ; Form feed at end
TDNE T3,.BKTFL(T1) ; ?
SOJ T2, ; Real page number is minus one
CAMLE T2,A1 ; Past the right page?
ERROR E.IPA ; Yes, give up
CAMN T2,A1 ; At the correct page already?
POPJ P, ; Yes, just return
LOAD. T2,FDBFFC,(P1) ; Get the page number
JUMPN T2,QPAG.6 ; Is it zero?
INCR. T2,FDBFFC,(P1) ; Yes, bump it
QPAG.6: MOVX T2,FD.EOF ; Check for eof
TDNE T2,.FDFLG(P1) ; . . .
ERROR E.PTL ; At eof, page number is too large
TXO F,F.NSRH ; Flag no free form feeds
TXNN S,S.YANK ; Doing an ^Y?
PUSHJ P,WRTBUF ; No, write the buffer
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address again
MOVX T2,TF.FFD ; Get the form feed flag
TDNE T2,.BKTFL(T1) ; Page end with a from feed?
JRST QPAG.7 ; Go check if correct page yet
QPAG.2: MOVE T1,P1 ; Get the address again
PUSHJ P,F$READ ; Get a character
PJRST QPAG.4 ; Go check if EOF
TXNE S,S.YANK ; Need to write it?
JRST QPAG.3 ; No, skip it
MOVE T1,P2 ; Get the output FDB
PUSHJ P,F$WRIT ; Yes, write the character
PJRST F$ERR ; Give up
QPAG.3: CAXE CH,.CHFFD ; Form feed?
JRST QPAG.2 ; No, try again
QPAG.7: CFMGE. T1,FDBFFC,(P1),A1 ; Right page yet?
JRST QPAG.2 ; No, try again
PJRST YANK ; Yes, go read in the buffer and return
QPAG.4: CAXE T1,$FEEOF ; End of file?
PJRST F$ERR ; No, give up
ERROR E.PTL ; Yes, give the error message
SUBTTL Commands -- "I" -- Insert
;+
;.hl2 Insert ("I" or tab)
; This command will insert the text which follows it into the text buffer.
;The tab command will insert the text preceded by a tab. If the "I"
;command is preceded by an argument, the character with the value of the
;argument is inserted into the buffer. If the command is preceded by
;an atsign ("@") the end of the text will be signified by an occurance
;of the first character seen after the "I", otherwise the string is
;terminated by the first non-quoted altmode.
;The pointer is left after the newly inserted string.
;-
TAB: PUSHJ P,TAB2 ; Insert the tab
INSERT: TXNE F,F.ARG ; Is there an argument?
JRST INS1A ; Yes, go handle that form
MOVX CH,.CHESC ; Get the normal terminator
TXZN F,F.SLSL ; Is this an "@I" command?
JRST INSE.A ; No, altmode is terminator
PUSHJ P,SKRCH ; Get the terminator character
ERROR E.UIN ; Unterminated insert string
INSE.A: PUSHJ P,INSE.0 ; Do the first pass of the command
JUMPE T1,.POPJ ; Return if nothing to insert
MOVE CH,P1 ; Get the delimeter character
XMOVEI T2,TXTBUF+$QRTPT ; And the TPT address
PJRST INSE.I ; Go insert the string
; Subroutine to parse the input string and determine its length.
INSE.0: MOVEI P1,(CH) ; Get the terminator character
LOAD. T1,TPTADR,+XCTBUF ; Get the address of the command buffer
LOAD. T2,BLKPT,(T1) ; Get the pointer address
MOVEM T2,STAINS ; Save it for second pass
XMOVEI T1,SKRCH ; Get the address of the input routine
MOVEM T1,INSRCH ; Save it
XMOVEI T1,REEAT ; Routine to re-eat characters
MOVEM T1,INSREE ; Store the routine address
SETZB P2,CTGLVL ; Clear the count of characters to insert
TXO S,S.NRAD ; Flag null insert (will clear if it isn't)
TXZ S,S.NCCT ; Clear control-T flag
INSE.1: PUSHJ P,@INSRCH ; Get a character
ERROR E.UIN ; Ran out?
SKIPN CTGLVL ; in a Q-reg?
CAIE CH,(P1) ; No, is this the terminator?
JRST .+2 ; In q-reg, or not terminator
JRST INSE.3 ; Have the terminator
TXZ S,S.NRAD ; Flag not null insert string (for FS/FN)
CHKEO EO21,INSE.2 ; If old version commands, control chars are legal
XMOVEI T1,I1ATAB ; Get the old table address
CHKEO EO200,INS.2A ; Is this an old version?
XMOVEI T1,IN1TAB ; No, get the new one
INS.2A: TXNE S,S.NCCT ; ^T flag on?
XMOVEI T1,IN2TAB ; Yes, allow the control chars
PUSHJ P,DISP1 ; Get dispatch on the char
JRST INSE.8 ; Not a special char
JUMPE CH,INSE.1 ; Special char, don't count it
AOJA P2,INSE.1 ; Count if it returns character
INSE.8: TXNN S,S.NCCT ; Allowing control-chars?
PUSHJ P,CKNCC ; No, check if control char
INSE.2: AOJA P2,INSE.1 ; Character is okay, count it and loop
; Here at the end of the string
INSE.3: TXZ S,S.NCCT!S.CTLV!S.CTVV!S.CTLW!S.CTWW ; Clear the flags for second pass
MOVE T1,P2 ; Get the length
POPJ P, ; And return
; Dispatch table for first pass control characters
IN1TAB: XWD CLRCH,.CHCNA ; ^A
XWD CLRCH,.CHCNB ; ^B
I1ATAB: XWD CTRGI,.CHBEL ; ^G
XWD CLRCH,.CHCNV ; ^V
XWD CLRCH,.CHCNW ; ^W
XWD INSE.R,.CHCCF ; ^^
IN2TAB: XWD INSE.T,.CHCNT ; ^T
XWD INSE.R,$CHQOT ; Quoting character
XWD 0,0 ; End of list
; Here for control-R. Get next character with no checks
INSE.R: PUSHJ P,@INSRCH ; Get the next character
ERROR E.UIN ; Unterminated insert
POPJ P, ; and return
; Here for control-T command. Complement the no-control-commands flag
INSE.T: TXC S,S.NCCT ; Complement the flag
CLRCH: SETZ CH, ; Flag this was a special char
POPJ P, ; And return
; Here for control-G command. Set up the input routines to read
;from the Q-register.
CTRGI: SETZ T1, ; Clear the default
XMOVEI T2,@INSRCH ; Get the routine to use
XMOVEI T3,@INSREE ; Get the routine to re-eat
MOVE T4,CTGBUF ; Get the current TPT address
SKIPN CTGLVL ; Are we down a level already?
XMOVEI T4,XCTBUF ; Yes, get the normal pointer
PUSHJ P,REDQRG ; Get the Q-register name
JRST [PUSHJ P,@INSRCH ; Get a character
ERROR E.ICG ; Couldn't
PUSHJ P,QREGV2 ; Make sure it is a Q-reg name
JRST .+1] ; And continue on
MOVE T3,T1 ; Save the address
MOVE T1,CTGBUF ; Get the buffer address
$ADJSP XS,$XSQLN ; Make room for the data
STOR. T1,XSBQAD,(XS) ; Store the previous address
MOVX T1,$XEIQG ; Get the item type
STOR. T1,XSBTYP,(XS) ; Store it
AOS T2,CTGLVL ; Bump the level
CAIE T2,1 ; Is this the first Q-reg?
JRST CTRGI0 ; Skip if the first level
MOVE T1,INSRCH ; Get the routine address
MOVEM T1,OLDINR ; Yes, save the old routine
MOVE T1,INSREE ; Get the re-eat routine
MOVEM T1,OLDREE ; Store the old routine
CTRGI0: XMOVEI T1,INSRCG ; Get the routine to fetch from Q-reg
MOVEM T1,INSRCH ; And save it
XMOVEI T1,INSQRE ; Get the q-register re-eat routine
MOVEM T1,INSREE ; Store the routine address
LOAD. T1,TPTADR,+$QRTPT(T3) ; Get the buffer address
JUMPE T1,[ERROR E.NTQ] ; No text in Q-reg
MOVEM T3,CTGBUF ; Save the address
SETZ T2, ; Clear the pointer offset
PUSHJ P,SETINC ; Set up to get chars
JFCL ; Ignore the error, let first call to GETINC fail
PJRST CLRCH ; Clear the character
; Get a character routine from Q-registers
INSRCG: $SAVE <T1,T2> ; Save T1 and T2
MOVE T1,CTGBUF ; Get the buffer address
LOAD. T1,TPTADR,(T1) ; . . .
PUSHJ P,GETINC ; Get a character
JRST .+2 ; None left
JRST .POPJ1 ; Got one, return it
LOAD. T1,XSBQAD,(XS) ; Get the item off the stack
MOVEM T1,CTGBUF ; Save it
ADJSP XS,-$XSQLN ; Remove the items
SOS T1,CTGLVL ; And decrement the level
JUMPN T1,INSRCG ; If still in Q-reg, try again
MOVE T1,OLDINR ; Get the routine to call
MOVEM T1,INSRCH ; Save it
MOVE T1,OLDREE ; Get the old re-eat routine
MOVEM T1,INSREE ; Store it back
PJRST @INSRCH ; And go get a character
; Routine to re-eat a character in a q-register
INSQRE: $SAVE <T1,T2,T3,T4> ; Don't smash anything
MOVE T1,CTGBUF ; Get the buffer address
LOAD. T1,TPTADR,(T1) ; Get the address
LOAD. T2,BLKPT,(T1) ; Get pointer
SUBI T2,1 ; Decrement it
PUSHJ P,SETINC ; Back up the character
JFCL ; Don't care
POPJ P, ; Return
; Here from the search code to complete an FS or FN type search.
;
; Usage:
; MOVE T1,Length
; MOVEI T2,Address.of.TPT to buffer
; MOVE CH,Delimeter character
; PUSHJ P,INSE.I
; (Return)
INSE.I: MOVE P1,CH ; Reset the delimeter character
MOVE P2,T1 ; Get the number of characters to insert
MOVE P3,T2 ; Get the TPT address
; Here after first pass of string is done with count of chars in P2
INSE.7: LOAD. T1,TPTADR,+XCTBUF ; Get the buffer address
MOVE T2,STAINS ; Get the start PT
PUSHJ P,SETINC ; Set up the pointers
STOPCD (CBS,<Command buffer shrank>)
LOAD. T1,TPTADR,+$QRTPT(P3) ; Get the text buffer address
MOVE T2,P2 ; And te number of characters we need to insert
LOAD. T3,BLKPT,(T1) ; Get the pointer
PUSHJ P,M$XPND ; Expand the buffer
LOAD. T2,BLKPT,(T1) ; Set up for inserting the string
PUSHJ P,SETINC ; . . .
STOPCD BSD,<Buffer space disappeared> ; ?
LOAD. T1,TPTADR,+$QRTPT(P3) ; Get the text buffer address
LOAD. T2,BLKPT,(T1) ; and the place we will start the modification
MOVE T3,T2 ; Get the end
ADD T3,P2 ; Plus the amount we are inserting
AOJ T3, ; Plus one to point past end
PUSHJ P,UPDBND ; Update the bounds
XMOVEI T1,SKRCH ; Get the input routine again
MOVEM T1,INSRCH ; Store the routine
XMOVEI T1,REEAT ; Get the re-eat routine
MOVEM T1,INSREE ; Store the routine address
TXO S,S.NTRC ; Suppress tracing
INSE.4: PUSHJ P,@INSRCH ; Get a character
STOPCD (ISS,<Insert string shrank>)
SKIPN CTGLVL ; In a Q-reg?
CAIE CH,(P1) ; No, is this the terminator?
JRST .+2 ; Not the end, skip
JRST [TXZ S,S.NTRC ; Allow tracing again
POPJ P,] ; Return to the caller
CHKEO EO21,INSE.5 ; EO level allow control chars?
XMOVEI T1,I3ATAB ; Get the old table address to control commands
CHKEO EO200,INS.5A ; Is this an older version?
XMOVEI T1,IN3TAB ; No, use the newer table
INS.5A: TXNE S,S.NCCT ; Allow control commands?
XMOVEI T1,IN4TAB ; No, use other table
PUSHJ P,DISP1 ; Dispatch to correct routine
JRST .+2 ; Skip if not command
JUMPE CH,INSE.4 ; Just loop if a command char
PUSHJ P,CASE ; Fix the casing
INSE.5: LOAD. T1,TPTADR,+$QRTPT(P3) ; Get the buffer address back
PUSHJ P,PUTINC ; And store the character
STOPCD (TBS,<Text buffer shrank>)
JRST INSE.4 ; Loop for all chars
; Dispatch table for insert pass control-chars
IN3TAB: XWD C.V,.CHCNA ; ^A is same as ^V
XWD C.W,.CHCNB ; ^B is same as ^W
I3ATAB: XWD CTRGI,.CHBEL ; ^G
XWD C.V,.CHCNV ; ^V
XWD C.W,.CHCNW ; ^W
XWD INSSPC,.CHCCF ; ^^
IN4TAB: XWD INSE.T,.CHCNT ; ^T
XWD INSE.R,$CHQOT ; Quoting character
XWD 0,0 ; End of list
; Here on control-^. If next char is a special char with lower case
;equivalent convert it to it's lower case form.
INSSPC: PUSHJ P,@INSRCH ; Get the next character
JFCL ; Ignore the error
PJRST CVTSPC ; And go convert the character
SUBTTL Commands -- "I" -- Utilities -- Casing routines
; Here on a control-V. If it is the second one, convert the flags
;for locked lower case. If first, just remember it for the next character.
C.V: TXON S,S.CTLV ; Set the single control-v flag and check if on
PJRST CLRCH ; Clear out CH
TXZ S,S.CTLV+S.CTWW ; Clear single control-V and double control-W
TXO S,S.CTVV ; Set double control-V
PJRST CLRCH ; Clear out CH
; Here on a control-W. If second in a row lock upper case, else
;just handle as single char.
C.W: TXON S,S.CTLW ; Flag we had a single, have one before?
PJRST CLRCH ; Clear out CH
TXZ S,S.CTLW+S.CTVV ; Yes, lock upper case on
TXO S,S.CTWW ; Flag it
PJRST CLRCH ; Clear out CH
; Here to convert upper to lower or lower to upper according
;to flags.
CASE: CAIL CH,"A" ; Is this an upper case char?
CAILE CH,"Z" ; . . .
CAIL CH,"a" ; Or is it loser case?
CAILE CH,"z" ; . . .
JRST CASE3 ; Not a letter, skip this
TXNE S,S.LCAS ; Lower case prevailing?
TRO CH,"a"-"A" ; Yes, convert to lower
TXNE S,S.UCAS ; Or is it upper case prevailing?
TRZ CH,"a"-"A" ; Yes, convert to upper
CASE.1: TXNE S,S.CTVV ; lower case lock on?
TRO CH,"a"-"A" ; Yes, convert to lower case
TXNE S,S.CTWW ; Upper case lock on?
TRZ CH,"a"-"A" ; Yes, convert to upper
TXZE S,S.CTLV ; Single control-V?
TRO CH,"a"-"A" ; Yes, convert to lower
TXZE S,S.CTLW ; Single control-W?
TRZ CH,"a"-"A" ; Yes, convert to upper
CASE3: TXZ S,S.CTLV+S.CTLW ; Clear in case no conversion
POPJ P,
; Here to convert characters according to ^W/^V settings, without regard to
;the prevailing case mode flags
CASE.0: CAIL CH,"A" ; Is this a letter?
CAILE CH,"Z" ; At all?
CAIL CH,"a" ; Maybe lower case?
CAILE CH,"z" ; . . .
JRST CASE3 ; No, clear the flag out
JRST CASE.1 ; Yes, go do the necessary conversions
; Here to convert upper case range special chars to their
;lower case equivalent character.
CVTSPC: CAIL CH,"[" ; Is this in the range past the upper case letters?
CAILE CH,"_" ; . . .
CAIN CH,"@" ; Or is it the atsign?
TRO CH,"a"-"A" ; Yes, convert to lower case range
POPJ P, ; And return it
SUBTTL Commands -- "I" -- Utilities -- CKNCC
; Here to check if CH contains a legal character to be inserted
;without quoting. Characters less than control-H (.CNCNH) or between
;a carriage return (.CHCRT) and an escape (.CHESC) or between
;an escape and a space are illegal.
CKNCC: CAIGE CH," " ; If above a space it is legal
CAXG CH,.CHCRT ; Below a carriage return?
CAXGE CH,.CHCNH ; and above a backspace?
CAXN CH,.CHESC ; Or is it an escape?
POPJ P, ; Legal character
ERROR E.ICT ; Not a legal char, give the error
SUBTTL Commands -- "I" -- "nI"
;+
; If an I is preceded by an argument the character with that numeric
;value is inserted.
;-
INS1A: TXNN F,F.STR1 ; First argument a string?
JRST INS1B ; No, numeric value
LOAD. T4,TPTADR,+SARG$1 ; Get the address of the text buffer
LOAD. T1,TPTADR,$QRTPT+TXTBUF ; Get the address of the text buffer
LOAD. T2,BLKPT,(T1) ; Get the current position
LOAD. T3,BLKEND,(T4) ; Get the amount we are inserting
ADD T2,T3 ; And make the overall amount
PUSHJ P,UPDBND ; Update the bounds
SETZ T1, ; Clear the offset
BLDBPT (T1,(T4)) ; Build the byte pointer
LOAD. T2,BLKEND,(T4) ; Get the number of characters
LOAD. T3,TPTADR,+$QRTPT+TXTBUF ; Get the address of the text buffer
XMOVEI T4,SARG$1 ; Get the address of the pointer
PUSHJ P,M$INSS ; Insert the string
LOAD. T2,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address back
STOR. T1,BLKPT,(T2) ; And reset the position
POPJ P, ; And return
INS1B: CHKEO EO21,INS1X ; Don't need to worry about altmode after the I if old mode
PUSHJ P,SKRCH ; Get the character after the I
ERROR E.NAI ; No altmode after nI
CAXE CH,.CHESC ; Was it an altmode?
ERROR E.NAI ; No, complain
INS1X: MOVE CH,A1 ; Get the arg
FALL TAB2 ; And fall into single character insert routine
; Here to insert the one character from CH at the current pointer
TAB2: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
MOVEI T2,1 ; One character
LOAD. T3,BLKPT,(T1) ; At the pointer
PUSHJ P,M$XPND ; Expand the buffer one char
LOAD. T2,BLKPT,(T1) ; Get the pointer again
MOVE T3,T2 ; Get the address
AOJ T3, ; Plus one for the character we are inserting
PUSHJ P,UPDBND ; Update the bounds
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer back
LOAD. T2,BLKPT,(T1) ; And the pointer
PUSHJ P,SETINC ; Set up for storing the char
JFCL ; Can't happen I hope
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
PUSHJ P,PUTINC ; And store the character
JFCL ; Who cares
POPJ P, ; And return
SUBTTL Commands -- T
;+
;.hl2 Type out ("T")
; This command will type a portion of the text buffer on the terminal.
;If no arg is given it will type from the pointer to the end of the current
;line. If one argument is given it will type that number of lines. If the
;argument is zero it will type from the beginning of the line to the pointer,
;if it is negative, it will type from the pointer back argument number of lines.
;If two arguments arg given it will type from the character specified by
;the first argument to the character specified by the second.
;-
TYPE: SETZM XCTING ;SO ^C^C REE WORKS PROPERLY
PUSHJ P,TYPE.0 ; Call the common routine
SETOM XCTING ; Flag we should continue again
POPJ P, ; and return
; Enter here with args set up like command processing
TYPE.0: PUSHJ P,GETARG ; Get the arguments
; Enter here with A1/A2 set up as character positions within current text
;buffer
TYPE.1: $SAVE (<P1,P2>) ; Save P1/P2
LOAD. P1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
TYPE.T: CFMGE. T2,BLKEND,(P1),A1 ; Is the second arg too large?
LOAD. A1,BLKEND,(P1) ; Yes, get the end instead
MOVE T1,A2 ; Get the start address
BLDBPT (T1,(P1)) ; Make the byte pointer
STOR. T1,BLKPTR,(P1) ; Store the pointer
MOVE P2,A1 ; Set up the counter
SUB P2,A2 ; . . .
TYPE.2: JUMPE P2,[TXZE F,F.TYOF ; Need to output some yet?
PJRST TTYOUT ; Yes, go do it
POPJ P,] ; No, return
ILDB CH,.BKPTR(P1) ; Get a character
PUSHJ P,T$TCHR ; Type it
SOJA P2,TYPE.2 ; And loop for all the chars
SUBTTL Commands -- V
;+
;.hl2 Type around the pointer ("V")
; This command will effectively do a (1-n)T nT command sequence.
;-
VCMD: JMPS VV$CMD ; If video mode we do things different
TXNE F,F.ARG2 ; Two args given?
ERROR E.SAN ; Only one arg allowed
PUSH P,A1 ; Save the argument
MOVN A1,A1 ; Get the minus amount to type
ADDI A1,1 ; . . .
PUSHJ P,TYPE ; Type the lines above
POP P,A1 ; Restore arg
PJRST TYPE ; Type the lines below
SUBTTL Commands -- P
;+
;.hl2 Write out the buffer ("P")
; There are a number of different forms of the P command:
;.b.ls1
;.le;"P" - Output the current buffer and yank in a new one.
;.le;"nP" - Perform a "P" command n times.
;.le;"i,jP" - Output from posistions i-j.
;.le;"PW" - Output the current buffer appending a form feed to the end
;and leave the buffer unchanged.
;.els
;-
PUNCHA: TXNE F,F.ARG2 ; Two arguments?
JRST PUNC.2 ; Yes, go handle it
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
MOVE P1,A1 ; Get the number of times to loop
LOAD. A1,BLKEND,(T1) ; And get the ending thing to write
SETZ A2, ; Clear the first char to write
PUSHJ P,SKRCH ; Get the next character
JRST PUNC.0 ; None there, skip it
CAXE CH,"w" ; Lower case W ?
CAIN CH,"W" ; Is it a W?
JRST PUNC.1 ; Skip this
PUSHJ P,REEAT ; No, back up a character
PUNC.0: TXO F,F.NSRH ; Flag not a PW command
; The following is the entry point for searches to allow them to
; punch a buffer for N or FN searches
PUNSCH:
PUNC.1: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
PUSHJ P,WRTBUF ; Write the buffer
TXNN F,F.NSRH ; PW command?
JRST PUNC.3 ; Yes, go handle it
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
PUSHJ P,GETFDI ; Check if we have an input file
JRST PUNC.4 ; No, just go clear the buffer
PUSH P,P1 ; Save the count of the number of times
PUSHJ P,YANK ; No, yank in a new buffer
POP P,P1 ; Restore the count
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
CFXN. T2,BLKEND,(T1),0 ; Empty buffer?
JRST PUNC.3 ; Yes, go handle it
PUSHJ P,GETFDI ; No, get the FDB address
ERROR E.NFI ; No file for input
MOVX T2,FD.EOF ; Check if end of file
TDNN T2,.FDFLG(T1) ; . . .
PUNC.3: SOJG P1,PUNC.1 ; Otherwise loop for more
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
SETZ T2, ; Clear this
LOAD. T3,BLKEND,(T1) ; Get the end of the buffer
PJRST UPDBND ; Update the bounds
; Here for i,jP
PUNC.2: MOVEI P1,1 ; Assume one time
PJRST PUNC.1 ; And go use normal routine
PUNC.4: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
LOAD. T2,BLKEND,(T1) ; Get the end
ZERO. T3,BLKPT,(T1) ; Clear the pointer
ZERO. T3,BLKCOL,(T1) ; Clear the current column also
SETZ T3, ; Clear the whole thing
PUSHJ P,M$SRNK ; Shrink it
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address again
SETZB T2,T3 ; Clear the bounds
PJRST UPDBND ; And update the bounds
SUBTTL Commands -- "J" - Move the pointer to absolute position
;+
;.hl2 Absolute pointer movement ("J")
; This command will move the pointer to the right of the nth character
;in the buffer.
;-
JMP: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
JMP1: JUMPL A1,[ERROR E.POP] ; If negative, give error
CFMGE. T2,BLKEND,(T1),A1 ; Is the value within range?
ERROR E.POP ; No, complian
ZERO. T2,BLKCOL,(T1) ; Clear the column
STOR. A1,BLKPT,(T1) ; Store the new pointer
POPJ P, ; And return
SUBTTL Commands -- "R" - Move pointer backwards
;+
;.hl2 Move pointer backwards ("R")
; This command will move the pointer backwards n positions. Note that
;the argument may be negative.
;-
REVERS: MOVN A1,A1 ; Make the arg negative
FALL CHARAC ; And fall into C command
SUBTTL Commands -- "C" - Move the pointer forwards
;+
;.hl2 Move the pointer forwards ("C")
; This command will move the pointer forward n characters. Note that
;n may be negative.
;-
CHARAC: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
LOAD. T2,BLKPT,(T1) ; And get the pointer
ADD A1,T2 ; Make it point to the new place
PJRST JMP1 ; And go store it
SUBTTL Commands -- "L" - Move the pointer n lines
;+
;.hl2 Move the pointer n lines ("L")
; This command will move the pointer forward or backward a given number
;of lines (line feeds).
;If n is greater than zero move the pointer to the right (down)
;stopping after passing over n line feeds.
;If n is negative, move the pointer to the left (up), stopping
;after passing n+1 line feeds, then place the pointer to the right of
;the last line feed passed over.
;-
LINE: PUSHJ P,GETARG ; Convert the arg into character indices
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the buffer address
XOR A1,A2 ; And magicically convert the correct one
XORM A1,.BKPT(T1) ; This works because either A1 or A2 must be
; equal to PT. XORing them together and then
; with the old PT will give the correct new
; value for PT.
ZERO. T2,BLKCOL,(T1) ; Clear current column
POPJ P, ; Return
SUBTTL Commands -- "K" - Delete some text
;+
;.hl2 Delete text ("K")
; This command will delete a given number of lines of text, or
;a given range of characters.
;-
KILL: PUSHJ P,GETARG ; Convert the arg if necessary
CAMN A1,A2 ; Deleting something?
POPJ P, ; No, just return
LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
MOVE T2,A2 ; Get the start of the section
MOVE T3,A1 ; And the end
PUSHJ P,UPDBND ; Update the bounds
MOVE T2,A1 ; Get the end address
SUB T2,A2 ; And make it the number of characters
LOAD. T3,BLKPT,(T1) ; Get the pointer
CAMGE T3,A2 ; Deleting before the pointer?
JRST KILL.1 ; No, keep going
CAMGE T3,A1 ; All of the deletion before the pointer?
SKIPA T3,A2 ; No, use the start of section being deleted
SUB T3,T2 ; Yes, account for the chars being deleted
STOR. T3,BLKPT,(T1) ; Store the new pointer
ZERO. T4,BLKCOL,(T1) ; Clear the current column
KILL.1: MOVE T3,A2 ; Get the offset to start
PJRST M$SRNK ; And go shrink the buffer
SUBTTL Commands -- "D" - Delete a number of characters
;+
;.hl2 Delete a number of characters ("D")
; This command will delete a given number of characters starting from
;the pointer. Note that the argument may be negative.
;-
DELETE: LOAD. T1,TPTADR,+$QRTPT+TXTBUF ; Get the text buffer address
LOAD. T2,BLKPT,(T1) ; Get the current position
MOVE T3,T2 ; Get a copy
ADD T3,A1 ; Make the end (or start)
CAMLE T2,T3 ; Need to be reversed?
EXCH T2,T3 ; Yes, do it
PUSHJ P,UPDBND ; Update the bounds
LOAD. T3,BLKPT,(T1) ; Get the place to delete from
MOVM T2,A1 ; And the number to delete
JUMPGE A1,DELE.1 ; Positive number to delete?
ADD T3,A1 ; No, back up that many characters
JUMPGE T3,DELE.0 ; Moving pointer off page?
ERROR E.POP ; Yes, give the error
DELE.0: ZERO. T4,BLKCOL,(T1) ; Clear the current column
STOR. T3,BLKPT,(T1) ; No, store the new pointer
PJRST M$SRNK ; Go shrink the buffer
DELE.1: ADD A1,T3 ; Get the final pointer address
CFMGE. T4,BLKEND,(T1),A1 ; Is the last character off the page?
ERROR E.POP ; Yes, give the error
PJRST M$SRNK ; No, go shrink it
SUBTTL Commands -- "<" - Open iteration
;+
;.hl2 Open iteration ("<")
; This command is the start of a loop to be iterated. It will save
;the current iteration info on the stack and return.
;-
LSSTH: $ADJSP XS,$XSLLN ; Make room for the data
MOVE T1,ITERCT ; Save the iteration count
STOR. T1,XSBITC,(XS) ; Store it
MOVE T1,LOPADR ; And the loop address
STOR. T1,XSBLOP,(XS) ; Store the loop address
MOVX T1,$XELOP ; Get the block type
STOR. T1,XSBTYP,(XS) ; Store it
LOAD. T1,TPTADR,+XCTBUF ; Get the current buffer address
LOAD. T2,BLKPT,(T1) ; And get the pointer
MOVEM T2,LOPADR ; Save the address
AOS ANGLVL ; Remember the bracket level
TXNN F,F.ARG ; Have an argument?
POPJ P, ; No, return now
JUMPLE A1,INCMA1 ; Yes, if not positive, skip loop
MOVEM A1,ITERCT ; Otherwise save the count
POPJ P, ; And return
SUBTTL Commands -- ">" - End an iteration loop
;+
;.hl2 End of iteration (">")
; This command ends a loop. It will cause the command to go back to
;the matching bracket unless the iteration count hits zero.
;-
GRTH: LOAD. T1,XSBTYP,(XS) ; Get the type of the last block
CAXN T1,$XELOP ; Loop?
JRST GRTH2 ; Yes, go handle it
CAXN T1,$XEPAR ; Was last thing a paren?
ERROR E.MRP ; Missing a paren?
ERROR E.MLA ; No, missing a left angle
GRTH2: SOSN ITERCT ; Decrement the iteration count
JRST INCMA2 ; Yes, go handle it
MOVE T2,LOPADR ; Get the loop address
LOAD. T1,TPTADR,+XCTBUF ; Get the buffer address
PUSHJ P,SETINC ; And set the pointers
STOPCD CBD,<Command buffer disappeared>
TXNE F,F.TRAC ; Tracing?
PUSHJ P,.TCRLF ; Yes, type the crlf
POPJ P, ; And return
SUBTTL Commands -- ";" - Exit iteration
;+
;.hl2 Exit iteration ";"
; This command will cause an exit from the current iteration if
;the last search failed.
;-
SEMICL: LOAD. T1,XSBTYP,(XS) ; Get the block type
CAXE T1,$XELOP ; Are we in a loop?
ERROR E.SNI ; Semi-colon not in iteration
TXNN F,F.ARG ; Did we have an arg?
MOVE A1,SFINDF ; No, use last search switch
JUMPL A1,.POPJ ; If arg less than zero just return
INCMA1: MOVEI T2,">" ; Loop for the bracket
MOVEI T3,"<" ; Ignoring matched pairs
PUSHJ P,SKAN ; Find it
ERROR E.MRA ; Missing right angle brack
INCMA2: LOAD. T1,XSBLOP,(XS) ; Get the loop address
MOVEM T1,LOPADR ; Save it
LOAD. T1,XSBITC,(XS) ; get the iteration count
MOVEM T1,ITERCT ; Save it
$ADJSP XS,-$XSLLN ; And remove the entry from the stack
SOS ANGLVL ; Back up one level
POPJ P, ; And return
SUBTTL Commands -- "!" - Define a tag
;+
;.hl2 Define a tag ("!")
; This command will define a tag which is the string which is
;between two exclamation points.
;-
EXCLAM: PUSHJ P,EXCL.2 ; Call common routine
JRST EXCL.9 ; Check if multiply defined
LOAD. T3,TPTADR,+XCTBUF ; Get the buffer address back
LOAD. T2,BLKPT,(T3) ; Get the pointer
STOR. T2,SYMIDX,(T1) ; Store the index
PJRST PASRET ; Return
EXCL.9: JUMPE P3,PASRET ; If a !! label just retur
LOAD. T3,TPTADR,+XCTBUF ; Get the buffer address
LOAD. T2,BLKPT,(T3) ; And get the pointer
CFME. T3,SYMIDX,(T1),T2 ; Check if this is the correct place
ERROR E.MDT ; No, give the error
PJRST PASRET ; Return any values
; Common routine to scan off a tag and make an STE
EXCL.2: LOAD. P1,TPTADR,+XCTBUF ; Get the buffer address
LOAD. P2,BLKPT,(P1) ; And get the character index
SETZ P3, ; Clear the counter
EXCL.1: PUSHJ P,SKRCH ; Get a character
ERROR E.UTG ; Unterminated tag
CAIE CH,"!" ; End of the tag?
AOJA P3,EXCL.1 ; No, count the character
JUMPE P3,.POPJ ; Return if no characters in label
DMOVE T1,P1 ; Get the start of string info
MOVE T3,P3 ; Get the length
PUSHJ P,S$LABL ; Define the label
SOS -1(P) ; Don't give a skip return
MOVEM T1,LASLBL ; Store the last label
JRST .POPJ1 ; Give the good return
; Entry point for O command
EXCL.0: $SAVE <P1,P2,P3> ; Save some ac's
TXO S,S.NTRC ; Flag no tracing
PUSHJ P,EXCL.2 ; Define the label
JRST .+2 ; Skip
AOS (P) ; Pass on the skip return
JUMPE P3,.POPJ ; Just return if !!
TXZ S,S.NTRC ; Clear the trace inhibit
LOAD. P1,TPTADR,+XCTBUF ; Get the buffer address back
LOAD. T2,BLKPT,(P1) ; Get the pointer
STOR. T2,SYMIDX,(T1) ; Store the index
POPJ P, ; And return
SUBTTL Commands -- "O" - Go to the tag named.
;+
;.hl2 Go to the named tag ("O")
; This command will cause the command flow to be transferred to the
;tag given.
;-
OG: LOAD. P1,TPTADR,+XCTBUF ; Get the buffer address
LOAD. P2,BLKPT,(P1) ; And the pointer index
SETZ P3, ; Clear the counter
OG.1: PUSHJ P,SKRCH ; Get a character
ERROR E.UTG ; Unterminated tag
CAXE CH,.CHESC ; Is it an escape?
AOJA P3,OG.1 ; No, try again
JUMPE P3,[ERROR E.NTG] ; Null tags are illegal
DMOVE T1,P1 ; Yes, get the info
MOVE T3,P3 ; . . .
PUSHJ P,S$LABL ; And try to find the symbol
JRST OG.2 ; Found it
MOVE P1,T1 ; Get the address for later
LOAD. T1,TPTADR,+XCTBUF ; Get the buffer address
SETZ T2, ; And reset to the beginning
PUSHJ P,SETINC ; Set the pointer
JFCL ; Never happens
OG.4: MOVEI T2,"!" ; Search for next tag
MOVEI T3,-1 ; No matched string
PUSHJ P,SKAN ; Go find it
JRST OG.E ; Couldn't
PUSHJ P,EXCL.0 ; Define the label
JRST OG.3 ; Already defined, check it is the one we want
JRST OG.4 ; Not the one we want, try again
OG.3: CAIE T1,(P1) ; Right label?
JRST OG.4 ; Not the right one, try again
OG.2: LOAD. T2,SYMIDX,(T1) ; Get the index
LOAD. T1,TPTADR,+XCTBUF ; Get the buffer address
PUSHJ P,SETINC ; Set up the pointers
JFCL ; Ignore if at end, top level will give error
POPJ P, ; Return
; Here if we couldn't find the tag. Reset the command pointer in case the
;command is colon'ed
OG.E: MOVEM P1,LASLBL ; Store the address of the label STE
TXZ S,S.NTRC ; Clear the trace bit
LOAD. T1,TPTADR,+XCTBUF ; Get the buffer address back
MOVE T2,P2 ; Get the start of the symbol
ADD T2,P3 ; And point past the end
AOJ T2, ; Also bump past the altmode
PUSHJ P,SETINC ; Reset the pointer
JFCL ; Who cares
ERROR E.TAG ; And give the error
SUBTTL Commands -- "?" - Enter or leave trace mode
;+
;.hl2 Trace mode ("?")
; This command will complement trace mode.
;-
QUESTN: TXCE F,F.TRAC ; Complement the flag and check if on
PUSHJ P,.TCRLF ; Type a crlf if leaving
POPJ P, ; And return
SUBTTL Commands -- "^A" - Type out the comment
;+
;.hl2 Type out comment ("^A")
; This command will cause all text following the first control-A
;until the next to be typed on the terminal.
;-
CMNT: PUSHJ P,SKRCH ; Get a character
ERROR E.UCA ; Unterminated control-A command
CAXN CH,.CHCNA ; Is this a control-A?
JRST [TXZE F,F.TYOF ; Need to force typeout?
PJRST TTYOUT ; Yes, go do it
POPJ P,] ; No, return
TXNN F,F.TRAC ; Omit the double type-out
PUSHJ P,T$ACHR ; Type the character
JRST CMNT ; Loop for next character
SUBTTL Conditional excution
;+
;.hl1 Conditionals
; The value"x ... ' construct is for conditional execution of the
;commands between the "x and the single quote. The following are the
;possibilities for x:
;.b.ls1
;.le;n"G - Only if n is greater than zero.
;.le;n"L - Only if n is less than zero.
;.le;n"N - Only if n is not equal to zero.
;.le;n"E - Only if n is equal to zero.
;.le;n"F - Only if n is false (equal to zero).
;.le;n"U - Only if previous command was unsuccessful (returned 0).
;.le;n"T - Only if n is true (less than zero).
;.le;n"S - Only if previous command was successful (returned negative value).
;.le;n"C - Only if n is the value of an ASCII character allowable in
;symbols (letters, digits, period, dollar sign, or percent).
;.le;n"A - Only if n is the value of an ASCII alphabetic character.
;.le;n"D - Only if n is the value of an ASCII numeric character.
;.le;n"V - Only if n is the value of a lower case alphabetic character.
;.le;n"W - Only if n is the value of an upper case alphabetic character.
;.els
;-
; Here for the tests for the individual commands
DQ.V: TRZN A1,40 ; If this bit not on can't be lower case
JRST NOGO ; Not LC, go skip the rest
DQ.A: TRZ A1,40 ; Convert possible upper to lower
DQ.W: CAIL A1,"A" ; Check if a letter
CAILE A1,"Z" ; . . .
JRST NOGO ; Not a letter
POPJ P, ; It is a letter
DQ.D: CAIL A1,"0" ; Check if it is a digit
CAILE A1,"9" ; . . .
JRST NOGO ; Not a digit
POPJ P, ; digit, return okay
DQ.C: MOVE CH,A1 ; Get the character into the correct place
PUSHJ P,CKSYM ; Check if a symbol character
POPJ P, ; Good character, return
JRST NOGO ; No good
DQ.T:
DQ.S: JUMPL A1,.POPJ ; Okay if less than zero
JRST NOGO ; No good, go skip
; The following four commands check for various conditions. The
; conditions are:
;
; 1. Not equal
; 2. Equal
; 3. Less than
; 4. Greater than
;
; The following are the offsets to the execute tables.
INTNUM DQ
NUM EQU ; Equal to
NUM NEQ ; Not equal to
NUM LSS ; Less than
NUM GTR ; Greater than
ENDNUM
; The following are the entry points into the main routine for the
; four commands:
;
; DQ.E - Equal
; DQ.N - Not equal
; DQ.L - Less than
; DQ.G - Greater than
DQ.E: SKIPA P1,[EXP $DQEQU] ; Get the offset
DQ.N: MOVX P1,$DQNEQ ; Get the not equal
JRST DQSUB ; Join the main routine
DQ.G: SKIPA P1,[EXP $DQGTR] ; Get the offset
DQ.L: MOVX P1,$DQLSS ; . . .
; Here to enter the main routine to process the four commands
DQSUB: TXNE F,F.ARG2 ; Have two arguments?
JRST DQG.2 ; Yes, go check them out
TXNE F,F.STR1 ; No, first argument a string?
ERROR E.FNS ; Yes, punt it
XCT DQJTBL(P1) ; Execute the first option
JRST NOGO ; no good
TABDEF DQJ,$DQ
TABENT GTR,<JUMPG A1,.POPJ> ; "G - Greater than
TABENT LSS,<JUMPL A1,.POPJ> ; "L - Less than
TABENT EQU,<JUMPE A1,.POPJ> ; "E - Equal to
TABENT NEQ,<JUMPN A1,.POPJ> ; "N - Not equal to
TABEND
; Here if we have two arguments. We must check to see if both of these
; arguments are greater then
DQG.2: TXNE F,F.STR1!F.STR2 ; Both numeric?
JRST DQG.1 ; No, make sure both are string
XCT DQCTBL(P1) ; Do the comparison
PJRST NOGO ; No, skip it
POPJ P, ; Yes, all is fine
TABDEF DQC,$DQ
TABENT GTR,<CAMLE A1,A2> ; "G - Greater than
TABENT LSS,<CAMGE A1,A2> ; "L - Less than
TABENT EQU,<CAME A1,A2> ; "E - Equal to
TABENT NEQ,<CAMN A1,A2> ; "N - Not equal to
TABEND
; Here if both args are not numeric
DQG.1: TXC F,F.STR1!F.STR2 ; Make sure both are strings
TXCE F,F.STR1!F.STR2 ; Are they?
PJRST [TXNE F,F.STR1 ; No, first arg a string?
ERROR E.SMS ; Yes, so must second
ERROR E.SMN] ; No, second must be numeric also
PUSHJ P,CMPSAG ; Compare the arguments
XCT DQJTBL(P1) ; Do the jump
JRST NOGO ; Skip the text
DQ.F:
DQ.U: JUMPE A1,.POPJ ; If equal to zero all is fine
FALL NOGO ; And go skip the commands
NOGO: MOVEI T2,"'" ; Scan for the proper quote
MOVEI T3,"""" ; Ignore any "...' strings
PUSHJ P,SKAN ; Go do it
ERROR E.MAP ; Missing the single quote
PUSHJ P,SKRCH ; Get the next character
POPJ P, ; There aren't any
CAXE CH,"""" ; Is this a double quote?
PJRST REEAT ; No, back up over it
PUSHJ P,REEAT ; Yes, back up over it
PJRST RETZER ; And return a zero
SUBTTL CMPSAG - Compare two string arguments
;+
;.hl1 CMPSAG
; This routine will compare two string arguments and determine whether
;the first string is less than, equal to, or greater than the second
;string.
;.literal
;
; Usage:
; PUSHJ P,CMPSAG
; (return)
;
; On return:
; A1/ 0 if strings are equal
; A1/ -1 if second less than first
; A1/ +1 if second greater than first
;.end lit
;-
CMPSAG: $SAVE <P1,P2,P3,P4> ; Save some ac's
LOAD. P1,TPTADR,+SARG$2 ; Get the address of the first argument
LOAD. P2,BLKEND,(P1) ; Get the length of the string
ADDX P1,<POINT 7,.BKTLN> ; Point to the text
LOAD. P3,TPTADR,+SARG$1 ; Get the second argument
LOAD. P4,BLKEND,(P3) ; Get the length
ADDX P3,<POINT 7,.BKTLN> ; And make it point to the text also
TXNN F,F.PMAT ; Exact case match?
TDZA T4,T4 ; No, no flag to check
MOVX T4,CF.LC ; Yes, check the LC flag
CSAG.1: SOJL P2,CSAG.2 ; Done with first string?
SOJL P4,CSAG.3 ; No, done with second?
ILDB T1,P1 ; No, get a char from the first
ILDB T2,P3 ; And the second
TDNE T4,CHRFLG(T1) ; Is this lower case?
SUBX T1,"a"-"A" ; Yes, convert to upper if needed
TDNE T4,CHRFLG(T2) ; Other character lower case?
SUBX T2,"a"-"A" ; Yes, convert if necessary
CAIN T2,(T1) ; Same character?
JRST CSAG.1 ; Yes, keep checking
CSAG.4: CAIGE T2,(T1) ; Second less than first?
CSAG.6: SKIPA A1,[EXP 1] ; Get the number
CSAG.7: SETO A1, ; Yes, return that
POPJ P, ; . . .
; Here if the first string ran out of characters
CSAG.2: SOJL P4,CSAG.5 ; If the second did also, then strings are equal
ILDB T2,P3 ; Get the next character
CAILE T2," " ; Less than a space?
JRST CSAG.7 ; Return a one
CAIN T2," " ; Is this a space?
JRST CSAG.2 ; Yes, try again
MOVEI A1,1 ; Return a one
POPJ P, ; Return to the caller
; Here if the second string ran out of characters
CSAG.3: ILDB T1,P1 ; Get the character
CAIGE T1," " ; Less than a space?
PJRST CSAG.7 ; Yes, return greater
CAIE T1," " ; Is it a space?
JRST CSAG.6 ; Return greater than
SOJGE P2,CSAG.3 ; Yes, try next character
CSAG.5: SETZ T1, ; Return equals
POPJ P, ; . . .
SUBTTL SQUOTE - Handle single quotes
;+
;.hl1 SQUOTE
; This routine will handle the single quote. If the next item is
;a double quote, it will process it with a value of true. Otherwise
;it will just continue processing.
;-
SQUOTE: PUSHJ P,SKRCH ; Get the next character
POPJ P, ; End of buffer
CAXE CH,"""" ; Double quote?
PJRST REEAT ; No, back up over it
PUSHJ P,REEAT ; Back up over the quote
PJRST RTONES ; Return minus one
SUBTTL Utility routines -- GETARG - Return string type args
;+
;.hl1 Utility routines
;.hl2 GETARG
; This routine will take standard arguments and convert them to string
;indices. If the user gave two arguments, it will just return them.
;If the user gave only one argument (or none and TECPRS used a default),
;it will use it as a relative line index.
;It always returns A1 and A2 set up as character indices.
;.hl2 GETCMD
; This routine will work the same as GETARG except it will only allow
;a single argument in A1 and will work for the command buffer.
;.hl2 GETTXT
; This routine is a generallized GETARG or GETCMD routine. It will
;expect to be given the text buffer that is to be used for looking
;up the lines.
;.literal
;
; Usage:
; MOVE T1,TPT.address
; MOVE A1,Number.of.lines
; PUSHJ P,GETTXT
; (Return -- A1 and A2 set up)
;.end literal
;-
GETCMD: $SAVE <CH,P1> ; Save CH and P1
LOAD. P1,TPTADR,+CMDBUF ; Get the address of the command buffer
JRST GETA.A ; Enter by the alternate point
GETARG: $SAVE <CH,P1> ; Save CH and P1
LOAD. P1,TPTADR,+$QRTPT+TXTBUF ; Get the address of the text buffer
TXNE F,F.ARG2 ; Were there two arguments?
JRST GETA.6 ; Yes, go check if negative
GETA.A: JUMPLE A1,GETA.3 ; argument negative
LOAD. T2,BLKPT,(P1) ; And get the pointer
MOVE T1,P1 ; Get the buffer address
MOVE A2,T2 ; Set up the beginning address
PUSHJ P,SETINC ; Set up for GETINC
JRST [MOVE A1,A2 ; Get the end for both indices
POPJ P,] ; And return
MOVE T3,A1 ; Get the counter
GETA.1: MOVE T1,P1 ; Get the buffer address again
PUSHJ P,GETINC ; Get the next character
JRST GETA.2 ; None left, go set up A1
PUSHJ P,CKEOL ; Is it an end of line character
JRST GETA.1 ; No, try again
SOJG T3,GETA.1 ; Is it the correct end of line?
GETA.2: LOAD. A1,BLKPT,(P1) ; Get the pointer
STOR. A2,BLKPT,(P1) ; And reset it
POPJ P, ; And return
; Here if the single argument is negative
GETA.3: LOAD. T1,BLKPT,(P1) ; Get the pointer
SOSGE T4,T1 ; Minus one character
JRST GETA.5 ; If negative we don't have to look any further
IDIVI T1,5 ; Make into a byte pointer
TDO T1,BTAB(T2) ; . . .
ADDI T1,.BKTLN(P1) ; . . .
GETA.4: LDB CH,T1 ; Get the character
PUSHJ P,CKEOL ; Check if end of line
JRST GETA.7 ; Nope, back up the byte pointer and try again
AOJG A1,GETA.5 ; Yes, are we done?
GETA.7: $DBP (T1,T2) ; Decrement the byte pointer
SOJGE T4,GETA.4 ; And loop unless we hit the start of the buffer
GETA.5: AOS A2,T4 ; Get the start of the string
LOAD. A1,BLKPT,(P1) ; And the end
POPJ P, ; And return
; Here if two arguments were given. Check that the first is less than
;the second, and force them to be within the buffer bounds.
GETA.6: CAMLE A2,A1 ; Make sure first arg given is less than second
ERROR E.SAL ; No, second arg less than first
JUMPGE A2,.+2 ; First argument okay?
SETZ A2, ; No, assume zero
CFMGE. ,BLKEND,(P1),A1 ; Second arg within valid range?
LOAD. A1,BLKEND,(P1) ; No, get the value
CFMGE. ,BLKEND,(P1),A2 ; First arg within range?
LOAD. A2,BLKEND,(P1) ; No, assume end
POPJ P, ; And return
SUBTTL Utility routines -- GETAG1/GETAG2
;+
;.HL2 GETAG1 and GETAG2
; These routines are used to fetch the address of a string argument.
;The routines will copy the argument into a new buffer if necessary.
;.lit
;
; Usage:
; PUSHJ P,GETAG1(or GETAG2)
; (return, T1=text buffer address)
;
;.end lit
;-
GETAG2: LOAD. T1,TPTADR,+SARG$2 ; Get the buffer address
SKPF CPYAG2 ; Does it need to be copied?
POPJ P, ; And return
XMOVEI T1,SARG$2 ; Yes,get the address
JRST GETAG0 ; And go do it
GETAG1: LOAD. T1,TPTADR,+SARG$1 ; Get the argument buffer address
SKPF CPYAG1 ; Need to copy it?
POPJ P, ; No, return now
XMOVEI T1,SARG$1 ; Get the address
FALL GETAG0 ; And fall into the routine to copy it
; Routine to copy the argument into a new buffer.
GETAG0: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Get the pointer address
LOAD. T1,TPTADR,(P1) ; Get the address of the text
LOAD. T1,BLKEND,(T1) ; And get the size
JUMPN T1,.+2 ; Really have a length?
MOVEI T1,1 ; No, we really want at least one character
PUSHJ P,M$GTXT ; Get the text block
LOAD. T2,TPTADR,(P1) ; Get the address of the argument
LOAD. T3,BLKEND,(T2) ; Get the size
JUMPE T3,.POPJ ; Just return if null string
STOR. T3,BLKEND,(T1) ; Save it
LOAD. T4,BLKFRE,(T1) ; Get the amount free in new block
SUB T4,T3 ; Fix it up
STOR. T4,BLKFRE,(T1) ; And store it back
IDIVI T3,5 ; Get the amount of text to move
JUMPE T4,.+2 ; partial word also?
AOJ T3, ; Yes, count it
HRLI T4,.BKTLN(T2) ; Get the source address
HRRI T4,.BKTLN(T1) ; And destination
ADDI T3,(T4) ; Get the final word
BLT T4,-1(T3) ; And copy the argument
POPJ P, ; And return the address
SUBTTL Utility routines -- SETINC, GETINC, and PUTINC
;+
;.hl2 SETINC, GETINC, and PUTINC
; These routines are used to fetch or store characters in a text buffer.
;The caller must first call SETINC to set up the index for the first
;character to be fetched or stored.
;.b.literal
; Usage:
; MOVEI T1,Text.buffer.address
; MOVEI T2,Index.into.buffer
; PUSHJ P,SETINC
; (No characters after pointer)
; (Good return)
;
; MOVEI T1,Text.buffer.address
; PUSHJ P,GETINC
; (No characters left)
; (Character in CH)
;
;
; MOVEI T1,Text.buffer.address
; MOVEI CH,Character
; PUSHJ P,PUTINC
; (No room left)
; (Good return)
;
;.end literal
;
; Note that the BLKPT and BLKPTR fields of the text buffer are used
;by these routines.
;-
SETINC: STOR. T2,BLKPT,(T1) ; Store the index
BLDBPT (T2,(T1)) ; Build the byte pointer to it
STOR. T2,BLKPTR,(T1) ; . . .
LOAD. T2,BLKPT,(T1) ; Get the pointer back
CFML. ,BLKEND,(T1),T2 ; At end of buffer?
AOS (P) ; No, give the good return
ZERO. T3,BLKCOL,(T1) ; Flag we need a new column
POPJ P, ; return
GETINC: INCR. CH,BLKPT,(T1) ; Bump the pointer
CFMGE. ,BLKEND,(T1),CH ; Hit the end yet?
JRST [DECR. CH,BLKPT,(T1) ; Yes, back it up
POPJ P,] ; And return
ILDB CH,.BKPTR(T1) ; Otherwise get the character
PJRST .POPJ1 ; ANd give the good return
PUTINC: $SAVE <P1> ; Save P1
INCR. P1,BLKPT,(T1) ; Bump the pointer
CFMGE. ,BLKEND,(T1),P1 ; Hit the end?
JRST [DECR. P1,BLKPT,(T1) ; Yes, back up the pointer
POPJ P,] ; And return
IDPB CH,.BKPTR(T1) ; Otherwise store the character
PJRST .POPJ1 ; And return happy
SUBTTL Utility routines -- BTAB - Byte pointer table
; This table is used to convert a character index into a byte pointer
POINT 7, ; Initial byte pointer for ILDB/IDPB
BTAB:
REPEAT 5,<
POINT 7,,6+<<.-BTAB>*7> ; Generate the rest of the pointers
> ; End of REPEAT 5
SUBTTL Utility routines -- CKEOL - Check if CH contains an EOL
;+
;.hl2 CKEOL
; This routine will check if the character in CH is an end of line
;character. Which characters are considered to be end of line characters
;is dependant upon the EO level.
;.b.literal
; Usage:
; MOVEI CH,Character.to.check
; PUSHJ P,CKEOL
; (Character is not an end of line)
; (Character is an end of line)
;
;.end literal
;-
CKEOL: CAXN CH,.CHLFD ; Line feed?
JRST .POPJ1 ; Yes, give the good return
CHKEO EO21,.POPJ ; Any other EOL's allowed?
CAXE CH,.CHVTB ; Yes, is this one of them?
CAXN CH,.CHFFD ; . . .
AOS (P) ; Yes, give the skip return
POPJ P, ; Return
SUBTTL Utility routines -- GETFDI - Get the address of an FDB
;+
;.hl2 GETFDI
; This routine will get the address of an FDB from a text buffer.
;.b.literal
; Usage:
; MOVEI T1,Text.buffer.address
; PUSHJ P,GETFDI
; (No file associated with buffer)
; (T1= FDB address)
;
;.end literal
;-
GETFDI: MOVX T2,TF.OPI ; Check if buffer has a file
TDNN T2,.BKTFL(T1) ; . . .
POPJ P, ; No file for this buffer
LOAD. T1,BLKFDI,(T1) ; Get the address
PJRST .POPJ1 ; And return happy
SUBTTL Utility routines -- GETFDO - Get the address of an FDB
;+
;.hl2 GETFDO
; This routine will get the address of an FDB from a text buffer.
;.b.literal
; Usage:
; MOVEI T1,Text.buffer.address
; PUSHJ P,GETFDO
; (No file associated with buffer)
; (T1= FDB address)
;
;.end literal
;-
GETFDO: MOVX T2,TF.OPO ; Check if buffer has a file
TDNN T2,.BKTFL(T1) ; . . .
POPJ P, ; No file for this buffer
LOAD. T1,BLKFDO,(T1) ; Get the address
PJRST .POPJ1 ; And return happy
SUBTTL Utility routines -- WRTBUF - Write out the buffer
;+
;.hl2 WRTBUF
; This routine will write out a given portion of the buffer. If F.ARG2
;is on it will write out the portion specified by A1/A2 with no form feed.
;If F.ARG2 is off, it will write out the entire buffer and append a form
;feed unless F.NSRH is on.
;.b.literal
; Usage:
; MOVEI T1,Text.buffer.address
; PUSHJ P,WRTBUF
; (return here)
;
;.end literal
;-
WRTBUF: $SAVE (<P1,P2,P3,P4>) ; Save some room to work
$SAVE <A1,A2> ; Save the arg ac's also
MOVE P1,T1 ; Get the address
TXNN F,F.ARG2 ; Two args?
SETZ A2, ; No, make sure it is clear
TXNN F,F.ARG2 ; . . .
LOAD. A1,BLKEND,(P1) ; Get the ending address
MOVE T1,P1 ; Get the buffer address
PUSHJ P,GETFDO ; Get the output FDB address
ERROR E.NFO ; None
MOVE T4,T1 ; Get a copy
MOVE T1,P1 ; Get the buffer address back
LOAD T2,F,F.ARG2 ; Get the form feed flag
LOAD T3,F,F.NSRH ; And the forced form feed
PJRST F$WBUF ; Write out the data
SUBTTL Low segment
$IMPURE ; To the impure section
LOWVER(CMD,2) ; Low segment version number
; Storage for loops ("<...>")
ITERCT: BLOCK 1 ; Iteration count
LOPADR: BLOCK 1 ; Address in command buffer for start of current loop
ANGLVL: BLOCK 1 ; Current depth in angle brackets
; Storage for insert command
STAINS: BLOCK 1 ; Address in buffer of beginning of insert string
INSRCH: BLOCK 1 ; Address of routine to call to get a character
INSREE: BLOCK 1 ; Re-eat routine
OLDREE: BLOCK 1 ; Old re-eat routine
OLDINR: BLOCK 1 ; Address of level 0 input routine for INSERT
CTGLVL: BLOCK 1 ; Current nesting level of ^G's
CTGBUF: BLOCK 1 ; Address of current Q-register
EOFLAG: BLOCK 1 ; EO flag
AUTOF: BLOCK 1 ; Auto type out after search flag
QTAB: BLOCK <.QRMAX+1>*$QRLEN ; Q-registers
TXTBUF: BLOCK $QRLEN ; Address of the text buffer
; Items for scanning off Q-register names
QRNQRG: BLOCK 1 ; Address of nested QRG
QRNTPT: BLOCK $TPLEN ; Pointer to text buffer
; Last Q-register name
LASQRG: BLOCK 1 ; Last Q-register name
; Last Label STE address
LASLBL: BLOCK 1 ; Last label STE address
SUBTTL End of TECCMD
END ; End of TECCMD