Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/newsrc/tecmvm.mac
There are 3 other files named tecmvm.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1980, 1981 Stevens Institute of Technology, Hoboken, New Jersey
; 07030.
; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
; TECO Project
; Computer Center
; Stevens Institute of Technology
; Castle Point Station
; Hoboken, New Jersey 07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.
; Search needed universals
SEARCH TECUNV ; TECO universal file
; Generate the prologue
TECVER==200 ; Major version number
TECMIN==1 ; Minor version number
TECEDT==1173 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(MVM,<Magic video mode>) ; Generate the TITLE and other stuff
SUBTTL Table of Contents
;+
;.pag.lit
; Table of Contents for Magic Video Mode routines
;
;
; Section Page
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. Initialization . . . . . . . . . . . . . . . . . . . . 4
; 5. Terminal processing
; 5.1. I$SIMG - Set image mode . . . . . . . . . . . 5
; 5.2. I$CIMG - Clear image mode . . . . . . . . . . 6
; 5.3. CLRBUF - Clear the output buffers . . . . . . 7
; 6. CDCMD - Control-D command. . . . . . . . . . . . . . . 8
; 7. I$FPOS - Find X position on line . . . . . . . . . . . 10
; 8. CHRWID - Determine width of character. . . . . . . . . 11
; 9. UPDBND - Update modification bounds. . . . . . . . . . 12
; 10. FC command
; 10.1. Introduction. . . . . . . . . . . . . . . . . 13
; 10.2. Macros. . . . . . . . . . . . . . . . . . . . 14
; 10.3. Command parser. . . . . . . . . . . . . . . . 16
; 10.4. Keyword
; 10.4.1. Push current command table . . . . . 17
; 10.4.2. Restore a saved command table. . . . 18
; 10.4.3. Delete command(s). . . . . . . . . . 19
; 10.4.4. Insert command(s). . . . . . . . . . 20
; 10.4.5. Replace command(s) . . . . . . . . . 21
; 10.4.6. Overlay a command table. . . . . . . 22
; 10.4.7. Remove a command table . . . . . . . 23
; 10.5. Parse routines
; 10.5.1. C-string . . . . . . . . . . . . . . 24
; 10.5.2. Right hand side. . . . . . . . . . . 25
; 10.5.3. Command types. . . . . . . . . . . . 26
; 10.5.3.1. Table . . . . . . . . . . . 27
; 10.5.4. Terms. . . . . . . . . . . . . . . . 28
; 10.5.4.1. Table . . . . . . . . . . . 29
; 10.5.4.2. NULL. . . . . . . . . . . . 30
; 10.5.4.3. DELETE. . . . . . . . . . . 31
; 10.5.4.4. DECIMAL . . . . . . . . . . 32
; 10.5.4.5. OCTAL . . . . . . . . . . . 33
; 10.5.4.6. ALPHABETIC. . . . . . . . . 34
; 10.5.4.7. ALPHANUMERIC. . . . . . . . 35
; 10.5.4.8. ANY . . . . . . . . . . . . 36
; 10.5.4.9. VALUE . . . . . . . . . . . 37
; 10.5.4.10. RANGE . . . . . . . . . . . 38
; 10.5.4.11. OTHER . . . . . . . . . . . 39
; 10.5.4.12. ALWAYS. . . . . . . . . . . 40
; 10.6. Subroutines
; 10.6.1. INSCST . . . . . . . . . . . . . . . 41
; 10.6.2. SETCTY . . . . . . . . . . . . . . . 42
; 10.6.3. DLCMST . . . . . . . . . . . . . . . 43
; 10.6.4. CLRCHM and SETCHM. . . . . . . . . . 44
; 10.6.5. ALCBYT - Allocate a byte index . . . 45
; 10.6.6. RETBYT - Deallocate a byte index . . 46
; 10.6.7. FCCHR - Input a character. . . . . . 47
; 11. Impure data. . . . . . . . . . . . . . . . . . . . . . 48
; 12. End of TECMVM. . . . . . . . . . . . . . . . . . . . . 49
;.end lit.pag
;-
SUBTTL Revision History
COMMENT |
1000 Start of this version
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
1062 By: Nick Bush On: 18-December-1980
Add n^D command to go down one screen line staying in the same column.
Also add ^D as an immediate command to do a 1^D and ^U to do a -1^D.
Modules: TECPRS,TECTBL,TECMVM
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
1130 By: Nick Bush@SIT On: 5-November-1981
Split TECVID into two files: TECVID and TECUPD.
Redo how command editing is do in video mode to make the ^W editing
character easier to implement.
Add a new format for the V command when in video mode to allow the
user more control over the position of text on the screen.
Modules: TECVID,TECUPD,TECMVM
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
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
1167 By: Nick Bush On: 22-June-1982
Fix UPDBND to handle being called with infinity as the upper bound.
This makes YANK flag the changes correctly all the time.
Modules: TECMVM
1173 By: Nick Bush On: 10-August-1982
When deleting text, fix up the OTHER and ALWAYS text pointers if
necessary.
Modules: TECMVM
|
SUBTTL Macro definitions
DEFINE PSHTPT(NAME,ADDRESS)<
DEFINE NAME<$XSBUF(XS)>
IFIDN <ADDRESS><T1><PUSH P,T1> ;; Save T1
ALCXSB (MEM,CLN) ;; Allocate the space
IFN FTDEBUG,<
SETZM $XSBUF+$TPADR(XS) ;; Clear the address
>;; End of IFN FTDEBUG
IFIDN <ADDRESS><T1><POP P,T1> ;; Restore it
IFDIF <ADDRESS><T1><LOAD T1,ADDRESS> ;; Get the item
XMOVEI T2,$XSBUF(XS) ;; Get the address
PUSHJ P,M$USEB ;; Link this in
>; End of PSHTPT macro definition
DEFINE POPTPT(REG)<
IFNB <REG><
LOAD. REG,TPTADR,+$XSBUF(XS) ;; Get the address into the register
IFIDN <T1><REG><PUSH P,T1> ;; Save the register if needed
>;; End of IFNB <REG>
XMOVEI T1,$XSBUF(XS) ;; Point to the pointer
PUSHJ P,M$RTPT ;; Release the pointer
IFNB <REG><
IFIDN <T1><REG><POP P,T1> ;; Restore the register
>;; End of IFNB <REG>
ADJSP XS,-$XSCLN ;; Unwind the stack
>; End of POPTPT
SUBTTL Initialization
$CODE ; Put in correct PSECT
;+
;.hl1 I$INIT
;This routine will initialize the immediate mode processing in TECO.
;.literal
;
; Usage:
; PUSHJ P,I$INIT
; (Return)
;
;.end literal
;-
I$INIT: SETZM IMGFLG ; Clear the image mode flag
POPJ P, ; Just return for now
SUBTTL Terminal processing -- I$SIMG - Set image mode
;+
;.hl1 I$SIMG
;This routine will set the terminal into image mode.
;.literal
;
; Usage:
; PUSHJ P,I$SIMG
; (Return)
;
;.end literal
;-
I$SIMG: SKIPE IMGFLG ; Do this only once
POPJ P, ; Already in image mode
$SAVE <T1,T2,T3,T4> ; Save a few registers
MOVX T2,^D8 ; Going to eight bit bytes
PUSHJ P,CLRBUF ; Clear the buffers out
LOAD. T2,FDBCHN,+TTYFDB ; Get the channel
LSH T2,<ALIGN.(FO.CHN)> ; Move it to the right place
MOVX T3,.FOGET ; Get the status
STOR T3,T2,FO.FNC ; Store the function
MOVE T3,[XWD 1,T2] ; Get the argument pointer
FILOP. T3, ; Do the FILOP.
POPJ P, ; Failed, so give up
TXZ T3,IO.MOD ; Clear the mode field
TXO T3,.IOPIM ; Turn on the new mode
MOVX T4,.FOSET ; Get the function
STOR T4,T2,FO.FNC ; Store it
MOVE T4,[XWD 2,T2] ; Get the function block
FILOP. T4, ; Set the new mode for the terminal
POPJ P, ; Failed, so give up
SETOM IMGFLG ; Flag now in image mode
MOVX T2,$FMPIM ; Get the packed image mode flag
STOR. T2,FDBMOD,+TTYFDB ; Store it
POPJ P, ; Return to the caller
SUBTTL Terminal processing -- I$CIMG - Clear image mode
;+
;.hl1 I$CIMG
;This routine will clear the image mode input. This routine is called
;before TECO exits to the operating system.
;.literal
;
; Usage:
; PUSHJ P,I$CIMG
; (Return)
;
;.end literal
;-
I$CIMG: SKIPN IMGFLG ; Already cleared?
POPJ P, ; Yes, just return
$SAVE <T1,T2,T3,T4> ; Save a few registers
MOVX T2,^D7 ; Going to seven bit bytes
PUSHJ P,CLRBUF ; Clear out the buffers
LOAD. T2,FDBCHN,+TTYFDB ; Get the channel
LSH T2,<ALIGN.(FO.CHN)> ; Move it to the right place
MOVX T3,.FOGET ; Get the status
STOR T3,T2,FO.FNC ; Store the function
MOVE T3,[XWD 1,T2] ; Get the argument pointer
FILOP. T3, ; Do the FILOP.
POPJ P, ; Failed, so give up
TXZ T3,IO.MOD ; Clear the mode field
TXO T3,.IOASC ; Turn on the new mode
MOVX T4,.FOSET ; Get the function
STOR T4,T2,FO.FNC ; Store it
MOVE T4,[XWD 2,T2] ; Get the function block
FILOP. T4, ; Set the new mode for the terminal
POPJ P, ; Failed, so give up
SETZM IMGFLG ; Flag now in image mode
MOVX T2,$FMTRM ; Get the terminal mode
STOR. T2,FDBMOD,+TTYFDB ; Store the mode
POPJ P, ; Return to the caller
SUBTTL Terminal processing -- CLRBUF - Clear the output buffers
;+
;.hl1 CLRBUF
;This routine will clear the terminal buffers and change the byte pointer
;to be the new byte pointer (8) or (7).
;.literal
;
; Usage:
; MOVEI T2,Byte.size
; PUSHJ P,CLRBUF
; (Return)
;
;.end literal
;-
CLRBUF: PUSH P,T2 ; Save the new byte size
LOAD. T2,FDBCHN,+TTYFDB ; Get the channel number
LSH T2,<ALIGN.(FO.CHN)> ; Align it
MOVX T3,.FOOUT ; Force the terminal buffers out
STOR T3,T2,FO.FNC ; Store the function
MOVE T3,[XWD 1,T2] ; Get the argument pointer
FILOP. T3, ; Output them
STOPCD CTB,<Can not output terminal buffers>
LOAD. T2,FDBPTR,+TTYFDB ; Get the byte pointer
POP P,T3 ; Restore the size
STOR T3,T2,BP.SFL ; Store the new size
STOR. T2,FDBPTR,+TTYFDB ; Store it back it
ZERO. ,FDBCTR,+TTYFDB ; Clear the count
MOVX T2,BF.VBR ; Get the bit
IORM T2,.FDBRH+TTYFDB ; Light it
POPJ P, ; Return to the caller
SUBTTL CDCMD - Control-D command
;+
;.hl1 CDCMD
; This routine will handle the control-D command. This command will
;move directly up or down a number of lines on the screen.
;-
CDCMD: SKIPN P1,A1 ; Get the number of lines to move
POPJ P, ; 0^D is silly
LOAD. P2,TPTADR,+TXTBUF ; Get the text buffer address
MOVE T1,P2 ; Get the TPT address
LOAD. T2,BLKPT,(P2) ; And the pointer
PUSHJ P,I$FPOS ; And find the X position
MOVE P3,T1 ; get the X position on the line
LOAD. T1,BLKCOL,(P2) ; get previous column pos
JUMPN T1,CDCM.A ; If we have one, go use it
AOJ P3, ; Increment to correct range
STOR. P3,BLKCOL,(P2) ; Otherwise use the one we just got
CDCM.A: LOAD. P3,BLKCOL,(P2) ; get the destination column
SOJ P3, ; Correct to normal range
MOVE T3,T2 ; Get the character address of the start of the line
DMOVE T1,P1 ; And the number to move and text address
PUSHJ P,I$FLIN ; Find the correct line boundary
MOVE T2,T1 ; Get the character address
MOVE T1,P2 ; And the text address
PUSHJ P,SETLIN ; Set it up
; Now we must move out the required number of character positions on this
;line and determine the character address.
SETZ P4, ; Clear the position on the line
CDCM.2: CAML P4,P3 ; Have we gotten there yet?
POPJ P, ; All done
MOVE T1,P2 ; Get the TPT address
PUSHJ P,GETINC ; Get a character
JRST CDCM.Z ; If there aren't any, put the pointer at Z
PUSHJ P,CKTRM ; Line terminator?
JRST .+2 ; No, get the width
JRST CDCM.3 ; Yes, this is as far as we can go
PUSHJ P,CHRWID ; get the current with
TXO P4,7 ; Tabs need to be rounded up
ADD P4,T1 ; Get the new position
JRST CDCM.2 ; And go for the next character
CDCM.3: DECR. ,BLKPT,(P2) ; Decrement the pointer to be at the correct character
POPJ P, ; All done, return
; Here if we run out of characters before getting where we wanted to be
CDCM.Z: LOAD. T1,BLKEND,(P2) ; Get the final char address
STOR. T1,BLKPT,(P2) ; And save it as the current
POPJ P, ; And return
SUBTTL I$FLIN - Find line boundary
;+
;.HL1 I$FLIN
; This routine is used to find a screen line boundary a given number of
;lines from the current position. This is used by both the ^D and V commands.
;.lit
;
; Usage:
; MOVE T1,Number.of.lines.to.move
; MOVE T2,TPT.address
; MOVE T3,Character.address.to.start.from
; PUSHJ P,I$FLIN
; (return here, T1=character address)
;
;.end lit
;-
I$FLIN: $SAVE <P1,P2,P3,P4> ; Save P1/P2/P3/P4
$SAVE <A1,A2> ; Save A1/A2 also
DMOVE P1,T1 ; Get the arguments
MOVE P3,T3 ; Get the initial address
LOAD. P4,BLKPT,(P2) ; Get the current position
MOVE T2,P3 ; The first char on line address is in T2
JUMPL P1,IFLN.B ; If negative, we need to go backwards
; Here to move down P1 lines. We will do this by calling RTNLIN the
;necessary number of times, then figuring out what the character
;address that corresponds to the current position is.
;
MOVE T1,P2 ; Get the TPT address
PUSHJ P,SETLIN ; Set up for skipping this line
IFLN.1: MOVE T1,P2 ; Get the TPT address back
PUSHJ P,RTNLIN ; And get this line
JRST IFLN.Z ; If it fails, just use Z
SOJG P1,IFLN.1 ; If more lines to skip, loop
SKIPA T1,.BKPT(P2) ; Get the current position
IFLN.Z: LOAD. T1,BLKEND,(P2) ; Use the max position
STOR. P4,BLKPT,(P2) ; Reset the old position
POPJ P, ; And return
; Here if we need to move backwards.
IFLN.B: SOJL T2,IFLN.0 ; Just return if we don't have anywhere to go
MOVE P3,T2 ; Remember the start of this line
STOR. T2,BLKPT,(P2) ; Store the current position
MOVE T1,P2 ; Get the TPT address
PUSHJ P,GETVID ; And find the start of the previous line
MOVE T1,P2 ; Get the TPT address
MOVE T2,A2 ; And the character address
PUSHJ P,SETLIN ; Set up where to start the line from
IFLN.C: MOVE T1,P2 ; Get the address of the TPT
PUSHJ P,RTNLIN ; Find the end of the line
STOPCD CDL,<CDCMD lost some text>
TXNE T4,LD$CRLF ; Line end with a CRLF?
ADDI T2,1 ; Yes, count the CRLF in the line
CAMGE T2,P3 ; Is this the end of the line?
JRST IFLN.C ; No, try again
MOVE T2,T1 ; Yes, get the start address
AOJL P1,IFLN.B ; And loop until we get to the line we want
SKIPA T1,T2 ; Get the address of the line
IFLN.0: SETZ T1, ; Return B if we hit the top
STOR. P4,BLKPT,(P2) ; Reset the pointer
POPJ P, ; And return
SUBTTL I$FPOS - Find X position on line
;+
;.hl1 I$FPOS
; This routine will determine the X position of a given character address.
;.b.lit
; Usage:
; MOVE T1,TPT.address
; MOVE T2,Character.address
; PUSHJ P,I$FPOS
; (return, T1=X pos, T2= char addr of first char on this line)
;
;.end lit
;-
I$FPOS: $SAVE <P1,P2,P3,P4> ; Save some room to work
$SAVE <A1,A2> ; Also save the args
PUSH P,.BKPT(T1) ; Save the current position
DMOVE P1,T1 ; Get the args
PUSHJ P,GETVID ; Get the initial char address
MOVE T1,P1 ; Get the TPT address
MOVE T2,A2 ; Get the starting address
PUSHJ P,SETLIN ; Set up for getting characters
IFPO.0: LOAD. P4,BLKPT,(P1) ; get the line start address
SETZ P3, ; And start the count at column 0
IFPO.1: CAML P3,SCRWID ; Are we at the end of a line?
JMPS IFPO.0 ; Yes, go handle the wrap around if screen mode
CFML. ,BLKPT,(P1),P2 ; Are we at the correct address yet?
JRST IFPO.D ; Yes, all done
MOVE T1,P1 ; Get the TPT address
PUSHJ P,GETINC ; get a character
JRST IFPO.D ; All done, return the address
PUSHJ P,CKTRM ; Is this an end of line?
JRST IFPO.2 ; No, get the width
CFMN. T1,BLKPT,(P1),P2 ; This should be exactly the right place
CAXE CH,.CHCRT ; Is the terminator a CR?
STOPCD UTF,<Unknown terminator found>
SETZ P3, ; Flag this is in column 0
IFPO.D: DMOVE T1,P3 ; get the X position and start address
POP P,.BKPT(P1) ; Restore the current position
POPJ P, ; And return
IFPO.2: PUSHJ P,CHRWID ; Get the character width
TXO P3,7 ; It must have been a tab
ADD P3,T1 ; Total the character width
JRST IFPO.1 ; And check if we are there yet
SUBTTL CHRWID - Determine width of character
;+
;.hl1 CHRWID
; This routine will return the width of a character.
;.b.lit
; Usage:
; MOVE CH,Character
; PUSHJ P,CHRWID
; (return here if a tab, instruction should be TXO AC,7)
; (return here if not a tab, with width in T1)
;
;.end lit
;-
CHRWID: MOVX T1,1 ; Assume only 1 position wide
CAXN CH,.CHTAB ; Is it a tab?
POPJ P, ; Yes, return now
AOS (P) ; Set up skip return
CAXN CH,.CHDEL ; Is this a delete
AOJA T1,.POPJ ; Yes, return 2
CAXE CH,.CHESC ; Is this an escape?
CAXL CH," " ; Or not a control character?
POPJ P, ; Yes, return 1
AOJ T1, ; Return 2
POPJ P, ; . . .
SUBTTL UPDBND - Update modification bounds
;+
;.hl1 UPDBND
; This routine will update the bounds of the modifications done to a text
;buffer.
;.b.lit
;Usage:
; MOVEI T1,Text.buffer.address
; MOVE T2,Start.of.modification
; MOVE T3,End.of.modification
; PUSHJ P,UPDBND
; (Return here)
;
;.end lit
;-
UPDBND: CAMN T2,T3 ; Anything actually changed?
POPJ P, ; No, just return
CFML. ,BLKFST,(T1),T2 ; Before current first?
STOR. T2,BLKFST,(T1) ; Yes, update it
CAXN T3,.INFIN ; Want mods thru end?
JRST [STOR. T3,BLKLST,(T1) ; Yes, flag that
POPJ P,] ; And return
SUB T3,.BKEND(T1) ; Get the offset from the current end
ADD T3,.BKOED(T1) ; And make this relative to the old end
CFMG. ,BLKLST,(T1),T3 ; After current last?
STOR. T3,BLKLST,(T1) ; Yes, update it
POPJ P, ; Return
SUBTTL V command - Control screen display
;+
;.hl1 V command
; When video mode is on, the V command performs a different function
;than when it is off. This routine handles the V command if EVON is
;in effect. If EVON is not in effect, the V command is handled in TECCMD.
;The video version of the V command can take the following forms:
;.lit
; nV ! Shift window down n lines !
; -nV ! Shift window up n lines !
; m,nV ! Cause line containing character position m to be !
; ! displayed on relative line n of the section !
; 0V ! Discontinue any special positioning !
;
;.end lit
;-
VV$CMD: MOVX T1,QR$VID ; Get the bit to check
XMOVEI P1,TXTBUF ; Assume we are displaying TEXT-BUFFER
TDNN T1,$QRFLG+TXTBUF ; Are we?
MOVE P1,CUREDT ; No, check current buffer
TDNN T1,$QRFLG(P1) ; Is the current things displayed somehow?
ERROR E.NSM ; No, punt
VVCM.0: LOAD. P2,TPTADR,+$QRTPT(P1) ; Get the buffer address
TXNE F,F.ARG2 ; Both arguments given?
JRST VVCM.2 ; Yes, skip the relative movement
JUMPN A1,VVCM.1 ; If not a 0V, go handle it
MOVX T1,QR$FIX ; Check if already fixed
TDNN T1,$QRFLG(P1) ; . . .
POPJ P, ; No, all is fine
BITON T1,QR$SHF,$QRFLG(P1) ; Yes, make it only last once
POPJ P, ; And return
; Here for a single argument V command with a non-zero argument.
;We must figure out what the first thing displayed for this section is,
;and determine what should be on that line.
VVCM.1: SETZ A2, ; Assume fixing from relative line 0
CFME. T1,TPTADR,+$QRPDB(P1),P2 ; Last buffer the same?
JRST VVCM.5 ; No, back up from current position
MOVX T1,QR$SHF ; Check if the screen is already shifted
TDNE T1,$QRFLG(P1) ; Is it?
JRST [LOAD. T1,QRGVAL,(P1) ; Yes, get the value
LOAD. A2,QRGFLN,(P1) ; And the line number
JRST VVCM.A] ; And check out the position
LOAD. T1,QRGOFS,(P1) ; Get the offset to the first line
MOVE T4,T1 ; Save the line number
IMULX T1,$LDLEN ; And determine the LDB address
ADD T1,SCRNAD ; . . .
VVCM.3: CFMN. T3,LDBQRG,(T1),P1 ; Correct Q-register?
JRST VVCM.4 ; Yes, go get the first address
SUBX T1,$LDLEN ; No, back up a line
SOJGE T4,VVCM.3 ; And try again
JRST VVCM.5 ; Go move back from the current position
; Here with T1 pointing at the first LDB for this line.
VVCM.4: MOVX T2,LD$ICA ; Check if the address is correct
TDNE T2,$LDFLG(T1) ; Addresses ok?
JRST VVCM.5 ; No, use PT
LOAD. T1,LDBBEG,(T1) ; Yes, get the start
JUMPL T1,VVCM.5 ; Yes, use PT
VVCM.A: CFMLE. ,BLKFST,(P2),T1 ; Before first modification?
JRST VVCM.6 ; Yes, use this position
CFMLE. ,BLKLST,(P2),T1 ; After last modification?
LOAD. T1,BLKLST,(P2) ; Yes, use that
SUB T1,.BKOED(P2) ; Fix up by old end
ADD T1,.BKEND(P2) ; . . .
JRST VVCM.6 ; Go use this one
; Here if we must just use the current position
VVCM.5: LOAD. T1,BLKPT,(P2) ; Get the current position
VVCM.6: MOVE T2,T1 ; Get the character address
MOVE T1,P2 ; And the block address
LOAD. P3,BLKPT,(P2) ; Save the position
STOR. T2,BLKPT,(P2) ; And start from what we have
PUSHJ P,I$FPOS ; Find the start of the line
STOR. P3,BLKPT,(P2) ; Reset the position
MOVE T1,A1 ; Get the number of lines to move
MOVE T3,T2 ; And the address to start from
MOVE T2,P2 ; And the buffer address
PUSHJ P,I$FLIN ; Find the position
MOVE A1,T1 ; Get the position
JRST VVCM.7 ; And go set it up
; Here for a two argument V command. Check the validity of the arguments.
VVCM.2: JUMPL A1,ERRPOP ; Negative position is no good
CFMGE. ,BLKEND,(P2),A1 ; Also must be before the end
ERRPOP: ERROR E.POP ; Punt
JUMPL A2,ERRLOR ; Punt if bad line number
LOAD. T1,QRGNLN,(P1) ; Make sure with range
CAML A2,T1 ; . . .
ERRLOR: ERROR E.LOR ; No, punt
MOVE T1,P2 ; Get the buffer address
MOVE T2,A1 ; And the character address
LOAD. P3,BLKPT,(P2) ; Save the position
STOR. T2,BLKPT,(P2) ; And start from what we have
PUSHJ P,I$FPOS ; Find the start of the line
STOR. P3,BLKPT,(P2) ; Reset the position
MOVE A1,T2 ; Get it back
VVCM.7: CFMLE. ,BLKFST,(P2),A1 ; Before first modification?
JRST VVCM.8 ; Yes, just store the value
SUB A1,.BKEND(P2) ; Fix up with respsect to the old end
ADD A1,.BKOED(P2) ; . . .
VVCM.8: STOR. A1,QRGVAL,(P1) ; Store the position into the value word
STOR. A2,QRGFLN,(P1) ; And the line offset
MOVX T1,QR$FIX ; Get the fixed flag
TXNN F,F.ARG2 ; Two arguments?
TXO T1,QR$SHF ; No, just shifting the screen once
IORM T1,$QRFLG(P1) ; Flag it
POPJ P, ; And return
SUBTTL FC command -- Introduction
;+
;.hl1 FC command
;.hl2 Command format
;The "FC" command is used to set the command table to be used for
;immediate commands. The format of this command is:
;.B.I10;FC(Q-REG-NAME)KEYWORD$
;.BR;where Q-REG-NAME contains a command table as described below.
;After this command is executed, every time TECO gets the first character
;for a command, it will check for possible immediate commands in the
;table. The commands can be character strings of any length.
; The KEYWORD must be one of the following:
;.LS1
;.LE;PUSH - Save current command table on stack and (optionally) define a new
;one. If a Q-register is given along with this keyword, the current
;command table will be saved on the stack, and the text in the Q-register
;will be used to define a complete new command table.
;If no Q-register is given, a copy of the current command table is saved
;on the stack, and the current command table remains the command table.
;.LE;POP - Restore command table from stack, throwing away current one.
;.LE;DELETE - Delete commands from the current command table.
;.le;INSERT - Insert commands into the current command table. Give an error
;if any commands are superceded or become illegal.
;.LE;REPLACE - Insert commands into the current command table. Supercede
;any identical commands and delete any commands necessary to make the commands
;legal.
;.LE;OVERLAY - Define new command table to be searched before the current one.
;.LE;REMOVE - Remove definition of current command table.
;.LE;SAVE - Save the current command table in the given Q-register.
;.LE;RESTORE - Restore a command table from the given Q-register.
;.ELS
;.hl2 Command table format
;The format of the text contained in the Q-register being used as a command
;table must be as follows:
;.B2
;.br;c-string : command-type {command}
;.BR;#######-#or#-
;.BR;c-string | c-string | ... : command-type {command-string}
;.b
;Where c-string is a set of c-terms separated by spaces, or by the "+"
;operator. The "+" operator indicates that the previous c-term may be repeated
;one or more times.
;A c-term is either a string of characters enclosed in double quotes
;or one of the following keywords:
;.LS1
;.le;NULL - Match the null character, octal value 0 (equivalent to "_^@").
;.le;DELETE - Match the delete character, octal value 177 (equivalent to "_^?")
;.le;DECIMAL - Match any valid decimal digit (equivalent to "0", "1", "2", "3",
;"4", "5", "6", "7", "8", "9").
;.le;OCTAL - Match any valid octal digit (0 - 7)
;.le;ALPHABETIC - Match any alphabetic character (upper or lower case).
;.le;ALPHANUMERIC - Match any alphabetic or digit.
;.le;ANY:(lll,mmm,nnn,...) - Match any of the characters whose octal value is
;listed.
;.le;VALUE:nnn - Match character with octal value nnn.
;.le;VALUE:(lll,mmm,nnn) - Match string consisting of characters with given
;octal values.
;.LE;RANGE:low:upp - Match all characters whose octal values are between
;low and upp (inclusive).
;.LE;OTHER - Match first character of string that does correspond to any other
;entry.
;.le;ALWAYS - Perform this command after the command for every string which
;matches.
;.ELS
;Command-type is one of the following keywords:
;.ls1
;.le;TECO - Command-string is to be executed as normal TECO commands.
;.le;BASE - Command-string is to be executed as a string of commands to
;be mapped through the lowest level immediate command table.
;.le;PREVIOUS - Command-string is to be executed as a string of commands to
;be mapped through the next lower level command table.
;.le;IMMEDIATE - Command-string is to be executed as a string of commands to
;be mapped through the current command table.
;.els
;If command-type is null, the command-string is assumed to be normal
;TECO commands, and will be treated as if the keyword TECO was given.
;
;The command-string will be called with the character string that caused
;it to be executed as the argument to it.
;-
SUBTTL FC command -- Macros
;+
;.hl2 FC macros
;The following macros and expansions define the various keywords that
;are used in the FC command.
;.ls
;.le;FCKEYM - Defines the keywords that are found after the Q-register
;in the command. Each of the keywords is defined by a FCKEY macro that
;defines the keyword and an abbreviation that is used to define the routine
;names that process it.
;.le;FCTERM - Defines the various c-term keywords. Each entry is an FCTRM
;macro which is a keyword followed by an abbreviation used to define labels.
;.le;FCCTYM - Defines the variuos command types. This macro contains the
;FCCTY macros. Each FCCTY macro contains a keyword and an abbreviation for
;the label to dispatch to.
;.els
;-
DEFINE FCKEYM,<
STR PUSH, <PSH,<OPT,TXT,FCT>> ;; PUSH - Save current command table
STR POP, <POP,NON> ;; POP - Restore a saved command table
STR DELETE, <DEL,<REQ,TXT>> ;; DELETE - Delete command from current table
STR INSERT, <INS,<REQ,TXT>> ;; INSERT - Insert commands into the current
;; table
STR REPLACE,<RPL,<REQ,TXT>> ;; REPLACE - Replace commands in the current
;; command table
STR OVERLAY,<OVL,<REQ,TXT>> ;; OVERLAY - Overlay a new command table on the
;; current table
STR REMOVE, <RMV,NON> ;; Remove the definition of the current command
;; table
STR OFF, <OFF,NON> ;; OFF - Turn off immediate command processing
STR ON, <ON,NON> ;; ON - Turn on immediate command processing
STR RESET, <RST,NON> ;; RESET - Remove all command tables
STR SAVE, <SVE,<REQ,TXT,FCT,VAL>> ;; SAVE - Save table in Q-register
STR RESTORE,<RTR,<REQ,FCT>> ;; RESTORE restore table from Q-register
;; Replaces current command table
>; End of FCKEYM macro definition
DEFINE FCTERM,<
STR NULL, NUL ;; NULL - Null character (octal 0)
STR DELETE, DEL ;; DELETE - Delete character (octal 177)
STR DECIMAL,DEC ;; DECIMAL - Decimal characters ("0" to "9")
STR DIGIT, DEC ;; DIGIT - Same as DECIMAL
STR OCTAL, OCT ;; OCTAL - Octal characters ("0" to "7")
STR ALPHABETIC,ALP ;; ALPHABETIC - Letters uc/lc a to z
STR ALPHANUMERIC,ALN ;; ALPHANUMERIC - Letters and digits
STR ANY, ANY ;; ANY - Any as in SNOBOL4
STR VALUE, VAL ;; VALUE - Character given as an octal value
STR RANGE, RNG ;; RANGE - Range of characters (octal values)
STR OTHER, OTH ;; OTHER - First character not given by anything else
STR ALWAYS, ALW ;; ALWAYS - Always execute the given string
>; End of FCTERM macro definition
DEFINE FCCTYM,<
STR TECO, TEC ;; TECO - Commands are executed as normal TECO
;; commands
STR BASE, BAS ;; BASE - Commands are executed as mapped via
;; the lowest level immediate command table
STR PREVIOUS,PRV ;; PREVIOUS - Commands are mapped via the
;; previous immediate command table
STR IMMEDIATE,IMD ;; IMMEDIATE - Commands are mapped via the
;; current immediate command table
>; End of FCCTYM macro definition
SUBTTL FC command -- Command parser
; The following is the command parser. This is the section that will parse
; the '(Q-register)Keyword' part of the FC command.
FCCMD: SETZM FCQRG ; Clear the Q-reg address
XMOVEI T1,FCTPT ; Get the address
SKIPE FCTPT ; Is this zero?
PUSHJ P,M$RELB ; No, release the old block
XMOVEI T1,IFCCHR ; Get the address of the get-a-char routine
MOVEM T1,RTN ; Save for input routines
SETZM TRMRTN ; Clear the term parser special routine
SETZM FCLCHR ; Clear the last character
SETZB T1,FCTPT ; Clear the TPT and default Q-reg
PUSHJ P,SCNQRG ; Scan for the Q-register
JRST FCCM.0 ; Failed, skip the following
MOVEM T1,FCQRG ; Save the Q-reg address
; Now to search for the keyword in the command table.
FCCM.0: XMOVEI T1,XCTBUF ; Get the buffer we are using
XMOVEI T2,SKRCH ; And the input routine
PUSHJ P,SCNKEY ; Scan off the keyword
ERROR E.UTK ; Give the illegal keyword
MOVE T1,[XWD -KEYLEN,KEYTBL] ; Point to the table
PUSHJ P,FNDKWD ; Find the keyword in the table
ERROR E.IKW ; Illegal FC keyword
MOVE T2,3(T1) ; Get the flags
TXNN T2,FF$REQ ; Q-register required?
JRST FCCM.2 ; No, check if any allowed
SKIPN T3,FCQRG ; Have a Q-register?
ERROR E.QNR ; No, Q-register name required
FCCM.3: LOAD. T4,QRGDTP,(T3) ; Get the data type of the Q-reg
CAXE T4,$DTTXT ; Text?
JRST FCCM.4 ; No, check other possibilities
TXNN T2,FF$TXT ; Yes, does it take it?
ERROR E.TXN ; No, text not allowed
PUSH P,T1 ; Save the keyword table address
LOAD. T1,TPTADR,+$QRTPT(T3) ; And get the address of the text
XMOVEI T2,FCTPT ; Get the address of the pointer
PUSHJ P,M$USEB ; Set it up
SETZ T2, ; And start from first character
PUSHJ P,SETINC ; . . .
JFCL ; Ignore the error return
POP P,T1 ; Get the table entry address back
JRST FCCM.C ; And go call the routine
; Here if the Q-reg does not contain text
FCCM.4: CAXE T4,$DTFCT ; Does it contain an FC table?
JRST FCCM.5 ; No, check if anything else allowed
TXNN T2,FF$FCT ; Yes, is it allowed?
ERROR E.FCN ; No, don't allow it
PJRST FCCM.C ; Go dispatch to the command
; Here if Q-reg does not contain either text or an FC table
FCCM.5: TXNN T2,FF$VAL ; Value allowed?
ERROR E.NTQ ; No, assume it wanted text
FCCM.C: PUSHJ P,@2(T1) ; Dispatch to the correct routine
JRST .POPJ1 ; Give a good return
; Here if the command does not require a Q-reg.
FCCM.2: SKIPN T3,FCQRG ; Have a Q-reg?
JRST FCCM.C ; No, just go dispatch
TXNE T2,FF$NON ; No Q-reg allowed?
ERROR E.QNN ; Give the error
JRST FCCM.3 ; Go set up the Q-reg
; The following is the keyword dispatch table for FC keywords
INTFLG FF ; Define flags found in the table
FLAG NON ; No Q-register is required
FLAG REQ ; Q-register is required
FLAG OPT ; Q-register is optional
FLAG TXT ; Q-register may contain text
FLAG FCT ; Q-register may contain an FC table
FLAG VAL ; Q-register may contain a value
DEFINE STRSUB(ARG,FLAG)<
EXP IFIW!FC$'ARG ;; Dispatch to the routine to call
..TMP==0
.XCREF ..TMP
IRP FLAG,<..TMP==..TMP!FF$'FLAG>
EXP ..TMP
SUPPRESS ..TMP
>; End of STRSUB macro definition
SYN FCKEYM, STRTBL ; Syn the macros
DOSTR (KEY) ; Define the keyword table
SUBTTL FC command -- Keyword -- Push current command table
;+
;.HL2 FC$PSH
;This routine will push the current command table on the 'stack'. It will
;then cause the command table specified by the Q-register to be command
;table by which all commands are mapped.
;-
FC$PSH: LOAD. T1,LNKNXT,+CURCTB ; Get the current CTB
JUMPE T1,FCPS.0 ; Anything to push?
MOVX T2,$CTCTB ; Get the offset
XMOVEI T3,STKCTB-$CTSTK ; Get the address to use
MOVX T4,$CTSTK ; Get the offset to the links
PUSHJ P,M$MLNK ; Move this block from one list
; to another
FCPS.0: SKIPN FCQRG ; Get the Q-reg address
JRST FCPS.1 ; Go make a copy of what we just stacked
PUSHJ P,CRECTB ; Create a new CTB
MOVX T2,$CTCTB ; Put onto CURCTB list
XMOVEI T3,CURCTB-$CTCTB ; Get the address of the list header
PUSHJ P,M$LINK ; Link it in
MOVE T1,FCQRG ; Get the Q-reg address
LOAD. T1,QRGDTP,(T1) ; Get the data type
CAXE T1,$DTTXT ; Text?
PJRST FC$RTR ; No, must be an FC table
PJRST FC$RPL ; And act like replace
FCPS.1: LOAD. T1,LNKNXT,+STKCTB ; Get the address of the one we just stacked
JUMPE T1,.POPJ ; If nothing was stacked, skip this
PUSHJ P,CPYCTB ; Make a copy
MOVX T2,$CTCTB ; Get the offset to the linked list data
XMOVEI T3,CURCTB-$CTCTB ; Get the list header
PJRST M$LINK ; And link it in
SUBTTL FC command -- Keyword -- Restore a saved command table
;+
;.hl2 FC$POP
;This routine will restore a saved command table. It will issue an error
;message if there was no save'd command table.
;-
FC$POP: LOAD. T1,LNKNXT,+CURCTB ; Get the address of the current CTB
JUMPE T1,FCPO.0 ; Jump if finished
MOVX T2,$CTCTB ; Get the offset
PUSHJ P,M$ULNK ; Unlink the block
JRST FC$POP ; Loop until all the CTBs are returned
FCPO.0: LOAD. T1,LNKNXT,+STKCTB ; Get the top item on the stack
JUMPE T1,FCPO.1 ; Finished, if zero
MOVX T2,$CTSTK ; Get the offset
XMOVEI T3,CURCTB-$CTCTB ; Point to the list header
MOVX T4,$CTCTB ; Get the new offset
PUSHJ P,M$MLNK ; Move this block to the other list
POPJ P, ; Return to the caller
FCPO.1: XMOVEI T1,BASTPT ; Get the address of the pointer
SKIPE $TPADR(T1) ; Have one?
PUSHJ P,M$RELB ; Yes, release it
POPJ P, ; And return
SUBTTL FC command -- Keyword -- Reset command table
;+
;.HL2 FC$RST
; This routine will reset the command tables by turning off FC processing,
;and returning all of the CTB's that are around.
;-
FC$RST: PUSHJ P,FC$POP ; Delete the current CTB and pop one
SKIPE CURCTB+$LKNXT ; Have one left?
JRST FC$RST ; Yes, try again
TXZ F,F.FCON ; Turn off the immediate processing
POPJ P, ; And return
SUBTTL FC command -- Keyword -- Save command table
;+
;.HL2 FC$SVE
; This routine will set up the Q-register to contain a pointer to the
;current FC table.
;-
FC$SVE: MOVE P1,FCQRG ; Get the Q-reg address
LOAD. T1,QRGDTP,(P1) ; Get the old data type
MOVX T2,$DTFCT ; Get the new data type
XCT RQRGTB(T1) ; And set it up
LOAD. T1,LNKNXT,+CURCTB ; Get the address of the current table
XMOVEI T2,$QRTPT(P1) ; Get the address of the pointer
PUSHJ P,M$USEB ; Set it up
POPJ P, ; And return
SUBTTL FC command -- Keyword -- Restore command table
;+
;.HL2 FC$RTR
; This routine will set up the command table in the Q-register to be
;the current one. The command table in the Q-reg must have been saved
;with the FCSAVE command previously.
;-
FC$RTR: MOVE T1,FCQRG ; Get the address of the Q-reg
LOAD. T1,TPTADR,+$QRTPT(T1) ; Get the address of the table
MOVX T2,$CTCTB ; Get the list offset again
XMOVEI T3,CURCTB-$CTCTB ; And what we should be linked in after
PUSHJ P,M$LINK ; Link this item in
JUMPE T1,.POPJ ; Anything there?
LOAD. T1,LNKNXT,+$CTCTB(T1) ; Get the previous current
MOVX T2,$CTCTB ; Get the offset
PUSHJ P,M$ULNK ; Unlink it
POPJ P, ; And return
SUBTTL FC command -- Keyword -- Delete command(s)
;+
;.hl2 FC$DEL
;This routine will cause commands to be deleted from the current command table.
;-
FC$DEL: CFXN. T1,LNKNXT,+CURCTB,0 ; Is there a currently define table?
ERROR E.DCD ; Doesn't exist
SETO P4, ; Flag we don't have to return the CTB
LOAD. T1,LNKNXT,+CURCTB ; Get a pointer to the current CTB
PUSHJ P,CPYCTB ; Copy the CTB
STKTPT (T1,DELCTB) ; Stack the address
XMOVEI T1,DELCTB ; Point to it
MOVEM T1,RPLTPT ; Store the address
; The following is the main loop to input a C-string from the command and
; delete it from the current command table. The command table is copied first
; to allow errors to not screw up the current command table.
FDEL.N: PUSHJ P,SIGFCH ; Get the first character from the buffer
JRST FDEL.E ; Finished
PUSHJ P,FCREAT ; Got a character, reeat it
FDEL.0: PUSHJ P,PRSCST ; Parse a C-string
ERROR E.BFC ; Bad FC command
MOVE P1,T2 ; Get the terminator
CAXE T1,$FTCHR ; Is this a character string?
JRST FDEL.A ; No, Check for OTHER and ALWAYS
LOAD. T3,TPTADR,+RPLCTB ; Get the address of the CTB
LOAD. T2,TPTADR,+$CTCMD(T3) ; Get the address of the first CND block
LOAD. T4,TPTADR,+CSTTPT ; Get the address of the string
LOAD. T3,BLKSIZ,(T4) ; Get the length of the string
LOAD. T4,BLKFRW,(T4) ; And the number of words free
SUB T3,T4 ; Get the actual amount used
SUBX T3,.BKMLN ; Minus the header
IDIVX T3,BRLEN$ ; Get the number of characters in the string
MOVX T1,.BKMLN ; Start with first character data
PUSHJ P,DELCST ; Delete the string
SETZ P4, ; Flag we have to return the CND. We
; shouldn't have any more characters
; at this point now.
MOVEI T1,CSTTPT ; Get the CST address again
PUSHJ P,M$RELB ; Return the block
CAXE P1,$FTCLN ; Colon terminator?
JRST FDEL.0 ; No, Go get the next C-string
PUSHJ P,SCNRHS ; Just scan the right hand side
ERROR E.BFC ; Bad FC command
JRST FDEL.N ; Go get the next item
; Here to handle the ALWAYS and OTHER options on the FC command.
FDEL.A: CAXE T1,$FTALW ; Is this an ALWAYS?
JRST FDEL.O ; No, Try for an OTHER
LOAD. T1,TPTADR,+DELCTB ; Get the CTB address
MOVX T2,CT$ALF ; Get the ALWAYS flag
TDNN T2,$CTFLG(T1) ; Is the flag on?
ERROR E.DUA ; ++ Attempt to delete an undefined ALWAYS
ANDCAM T2,$CTFLG(T1) ; Clear the ALWAYS flag
LOAD. T1,CTBALN,(T1) ; Get the arguments to delete this
LOAD. T2,CTBALW,(T1) ; . . .
PUSHJ P,DLCMST ; Go delete the string if possible
PUSHJ P,SCNRHS ; Just scan the right hand side
ERROR E.BFC ; Bad FC command
JRST FDEL.N ; Go get the next item
; Here to handle the OTHER option.
FDEL.O:
IFN FTDEBUG,<
CAXE T1,$FTOTH ; Is this an OTHER?
STOPCD (UFC,<Unknown FC keyword returned>)
>; End of IFN FTDEBUG
LOAD. T1,TPTADR,+DELCTB ; Get the address of the CTB
MOVX T2,CT$OTF ; Check to see if we have an OTHER
TDNN T2,$CTFLG(T1) ; Is there one?
ERROR E.DUO ; ++ Attmept to delete an undefined OTHER
LOAD. T3,CTBOLN,(T1) ; Get the arguments to delete the string
LOAD. T2,CTBOTH,(T1) ; . . .
PUSHJ P,DLCMST ; Delete the string
PUSHJ P,SCNRHS ; Just scan the right hand side
ERROR E.BFC ; Bad FC command
JRST FDEL.N ; Go get the next item
; Here to handle the end of the command
FDEL.E: LOAD. T1,LNKNXT,+CURCTB ; Get the address of the first block
MOVX T2,$CTCTB ; Get the list offset
PUSHJ P,M$ULNK ; Unlink this block
JUMPE P4,.POPJ ; Just return if nothing more.
LOAD. T1,TPTADR,+RPLCTB ; Get the address of the new CTB
MOVX T2,$CTCTB ; Get the list offset again
XMOVEI T3,CURCTB-$CTCTB ; And what we should be linked in after
PUSHJ P,M$LINK ; Link this item in
POPJ P, ; And return
SUBTTL FC command -- Keyword -- Insert command(s)
;+
;.hl2 FC$INS
;This routine will cause commands to be inserted into the current command
;table.
;-
FC$INS: SETOM FCINSF ; Flag this is an insert, not replace
PJRST FRPL.0 ; And join replace command
SUBTTL FC command -- Keyword -- Replace command(s)
;+
;.hl2 FC$RPL
;This routine will cause commands in the current command table to be replaced
;by the commands that are specified in the Q-register.
;-
FC$RPL: SETZM FCINSF ; Flag this is a replace, not an insert
; Common routine for INSERT and REPLACE.
FRPL.0: CFXN. T1,LNKNXT,+CURCTB,0 ; Have a CTB already?
JRST [PUSHJ P,CRECTB ; No, create one
JRST FRPL.6] ; And don't bother making a copy
LOAD. T1,LNKNXT,+CURCTB ; Get the address of the current CTB
PUSHJ P,CPYCTB ; And make a copy
FRPL.6: STKTPT (T1,RPLCTB) ; Set up the pointer
XMOVEI T1,RPLCTB ; Get the address of the TPT
MOVEM T1,RPLTPT ; Save it for lower level routines
; The main loop will get a c-string from the command an merge it into
;the current command table. Conflicting commands will be handled according
;to the sense of the insert/replace flag.
; For the character address of the command, we will use the first free
;character address in the current command storage block.
; After the entire set of c-strings for the command have been parsed and
;merged into the table, the command type will be parsed, and the command
;string copied into the command storage block.
FRPL.N: PUSHJ P,SIGFCH ; Get a real character from the buffer, if any
JRST FRPL.E ; None left, all done
PUSHJ P,FCREAT ; Got one, save it back for next call
FRPL.1: PUSHJ P,PRSCST ; Get a C-string
ERROR E.BFC ; Punt
MOVE P1,T2 ; Get the terminator
CAXE T1,$FTCHR ; Is this a character string?
JRST FRPL.2 ; No, go check for other alternatives
LOAD. T3,TPTADR,+RPLCTB ; Get the address of the CTB
LOAD. T2,TPTADR,+$CTCMD(T3) ; Get the address of the first CND block
LOAD. T4,TPTADR,+CSTTPT ; Get the address of the string
LOAD. T3,BLKSIZ,(T4) ; Get the length of the string
LOAD. T4,BLKFRW,(T4) ; And the number of words free
SUB T3,T4 ; Get the actual amount used
SUBX T3,.BKMLN ; Minus the header
IDIVX T3,BRLEN$ ; Get the number of characters in the string
MOVX T1,.BKMLN ; Start with first character data
PUSHJ P,INSCST ; Insert the string
ERROR E.BFC ; Punt
LOAD. T2,TPTADR,+RPLCTB ; Get the address of the CTB
XMOVEI T1,CSTTPT ; Get the address of the string
PUSHJ P,M$RELB ; And release it
CAXE P1,$FTCLN ; End of this set of strings?
JRST FRPL.1 ; No, try again
; Here when we reach the end of the c-string list. Now we must parse
;the command type and the command string, and insert the command string
;into the buffer.
LOAD. T1,TPTADR,+RPLCTB ; Get the address of the text
LOAD. T1,TPTADR,+$CTTPT(T1) ; . . .
PUSHJ P,PRSRHS ; Parse off the right hand side
ERROR E.BFC ; Punt
PUSHJ P,SETCTY ; Set the correct command type for all commands
; That are currently partially set
JRST FRPL.N ; Try another command
; Here if we have either an ALWAYS or OTHER keyword. Either replace
;the item or give an error, depending on whether this is an INSERT or
;REPLACE command.
FRPL.2: CAXE T1,$FTALW ; Always option?
JRST FRPL.4 ; No, must be other
LOAD. T3,TPTADR,+RPLCTB ; Get the address of the CTB
MOVX T2,CT$ALF ; Check if we already have an always
TDNN T2,$CTFLG(T3) ; Already there?
JRST FRPL.3 ; No, continue on
SKIPE FCINSF ; INSERT?
ERROR E.AAE ; Yes, punt (ALWAYS already exists)
ANDCAM T2,$CTFLG(T3) ; Flag tha it is not really there anymore
MOVE T1,T3 ; Get the address of the CTB
LOAD. T3,CTBALN,(T1) ; And get the length
LOAD. T2,CTBALW,(T1) ; And the address of the first character
PUSHJ P,DLCMST ; Delete the command string
FRPL.3: LOAD. T1,TPTADR,+RPLCTB ; Get the CTB address
LOAD. T1,TPTADR,+$CTTPT(T1) ; And get the address of the buffer
PUSHJ P,PRSRHS ; Parse the right hand side of the command
ERROR E.BFC ; Punt
LOAD. T4,TPTADR,+RPLCTB ; Get the CTB address
STOR. T1,CTBATY,(T4) ; Save the command type
STOR. T2,CTBALW,(T4) ; Store the address of the text
STOR. T3,CTBALN,(T4) ; And the length
BITON T1,CT$ALF,$CTFLG(T4) ; Save the flags
JRST FRPL.N ; Try again
; Here if we get the OTHER keyword.
FRPL.4:
IFN FTDEBUG,<
CAXE T1,$FTOTH ; Other keyword?
STOPCD UFK,<Unknown FC keyword returned>
> ; End of IFN FTDEBUG
LOAD. T3,TPTADR,+RPLCTB ; Get the address of the CTB
MOVX T2,CT$OTF ; Check if we already have an OTHER
TDNN T2,$CTFLG(T3) ; Already there?
JRST FRPL.5 ; No, continue on
SKIPE FCINSF ; INSERT?
ERROR E.OAE ; Yes, punt (OTHER already exists)
ANDCAM T2,$CTFLG(T3) ; Flag it isn't real anymore
MOVE T1,T3 ; Get the address of the CTB
LOAD. T3,CTBOLN,(T1) ; And get the length
LOAD. T2,CTBOTH,(T1) ; And the address of the first character
PUSHJ P,DLCMST ; Delete the command string
FRPL.5: LOAD. T1,TPTADR,+RPLCTB ; Get the CTB address
LOAD. T1,TPTADR,+$CTTPT(T1) ; And get the address of the buffer
PUSHJ P,PRSRHS ; Parse the right hand side of the command
ERROR E.BFC ; Punt
LOAD. T4,TPTADR,+RPLCTB ; Get the CTB address
STOR. T1,CTBOTY,(T4) ; Save the command type
STOR. T2,CTBOTH,(T4) ; Store the address of the text
STOR. T3,CTBOLN,(T4) ; And the length
BITON T1,CT$OTF,$CTFLG(T4) ; Save the flags
JRST FRPL.N ; Try again
; Here at the end of the buffer. We have gotten no errors, so we can
;now return the previous command table and replace it with the one we
;have just built.
FRPL.E: LOAD. T1,LNKNXT,+CURCTB ; Get the address of the first block
MOVX T2,$CTCTB ; Get the list offset
SKIPE T1 ; If nothing there, don't unlink it
PUSHJ P,M$ULNK ; Unlink the block
LOAD. T1,TPTADR,+RPLCTB ; Get the address of the new CTB
MOVX T2,$CTCTB ; Get the offset
XMOVEI T3,CURCTB-$CTCTB ; And what should point at it
PUSHJ P,M$LINK ; Link this in
LOAD. T1,LNKNXT,+CURCTB ; Get the address again
XMOVEI T2,BASTPT ; Get the address of the base TPT
SKIPN $TPADR(T2) ; Have one already?
PUSHJ P,M$USEB ; No, make this the base
POPJ P, ; And return
SUBTTL FC command -- Keyword -- Overlay a command table
;+
;.hl2 FC$OVL
;This routine will cause a new command table to be created that is
;searched before the current command table.
;-
FC$OVL: LOAD. T1,LNKNXT,+CURCTB ; Get the current CTB
JUMPE T1,FC$RPL ; If none, just act like replace
PUSHJ P,CPYCTB ; Otherwise, create a new one
MOVX T2,$CTCTB ; . . .
XMOVEI T3,CURCTB-$CTCTB ; And link it in first
PUSHJ P,M$LINK ; . . .
PJRST FC$RPL ; And then just act like a replace
SUBTTL FC command -- Keyword -- Remove a command table
;+
;.hl2 FC$RMV
;This routine will cause the current command table to be deleted. This
;requires that the user has used the OVERLAY feature at some previous
;point in time. This routine will restore any older command tables.
;-
FC$RMV: SKIPN CURCTB+$LKNXT ; Any CTB's exist at all?
ERROR E.RWO ; No, remove without overlay
LOAD. T1,LNKNXT,+CURCTB ; Get the addrss of the current table
MOVX T2,$CTCTB ; Get the linked list offst
PUSHJ P,M$ULNK ; Unlink the item
POPJ P, ; Return to the caller
SUBTTL FC command -- Keyword -- OFF and ON - Turn processing off or on
;+
;.HL2 FC$OFF and FC$ON
; These routines are used to set and clear the flag to indicate whether immediate
;command processing should be done.
;-
FC$OFF: TXZ F,F.FCON ; Flag no immediate command processing
POPJ P, ; And return
FC$ON: TXO F,F.FCON ; Flag we want immediate command processing
POPJ P, ; And return
SUBTTL FC command -- Parse routines -- C-string
;+
;.hl2 PRSCST
; This routine will parse a c-string from the Q-reg. It will return the
;string as a sequence of 4-word character masks in a movable block.
;.lit
;
; Usage:
; PUSHJ P,PRSCST
; (Some type of error occurred)
; (Good return, T1=$FTxxx of c-string, T2=$FTxxx of terminator)
;
;.end lit
;If this routine parses a c-string that contains characters, it
;will return $FTCHR in T1, if it was just an ALWAYS or OTHER keyword,
;it will return the correct $FTxxx for that keyword.
;-
PLSBIT==1 ; Bit that says a plus (+) was seen after this character
LOPBIT==2 ; Bit that says this state should generate a loop
; Only used by INSCST or DELCST
SPCOFF==BRLEN$-1 ; Offset to word with special bits
PRSCST: PUSHJ P,PRSTRM ; Try to parse off a term
POPJ P, ; Punt
CAXE T1,$FTALW ; Is it an always?
CAXN T1,$FTOTH ; Or other?
JRST PCST.A ; Yes, go make sure the next thing is a colon
CAXE T1,$FTCHR ; Is this a character?
POPJ P, ; No, punt
XMOVEI T1,CSTTPT ; Get the address of the pointer
SKIPE $TPADR(T1) ; Something there already?
PUSHJ P,M$RELB ; Yes, release it first
MOVX T1,.BKMLN-.BKLEN+BRLEN$ ; Get the size of the initial block
MOVX T2,.BTMOV ; Get the block type
PUSHJ P,M$ZBLK ; Get it
SUBX T1,.BKLEN ; Remove the normal header
XMOVEI T2,CSTTPT ; Get the address of the TPT
PUSHJ P,M$USEB ; Set up the pointer
XMOVEI T3,.BKMLN(T1) ; Get the address of the destination
XMOVEI T2,CHRMSK ; And the source
MOVX T1,BRLEN$ ; Copy 4 words
PUSHJ P,M$MCOR ; Move the data
; Loop for all characters in the string
PCST.1: PUSHJ P,PRSTRM ; Get a term
POPJ P, ; Error, punt
CAXE T1,$FTCHR ; Is this a character?
JRST PCST.2 ; No, check other items
PCST.0: LOAD. T1,TPTADR,+CSTTPT ; Get the address of the block
LOAD. T3,BLKSIZ,(T1) ; Get the current size
LOAD. T2,BLKFRW,(T1) ; And amount free
SUB T3,T2 ; Get the offset to the first free word
PUSH P,T3 ; Save the offset
MOVX T2,BRLEN$ ; Get the number of words we want
PUSHJ P,M$XMOV ; Expand the block
POP P,T3 ; Get back the offset to the first free
ADD T3,T1 ; Get the address of the first free word
IFE FTXADR,<
HRLI T3,CHRMSK ; Get the address of the bits
MOVEI T2,BRLEN$-1(T3) ; Get where to end the BLT
BLT T3,(T2) ; Copy the 4-word block
> ; End of IFE FTXADR
IFN FTXADR,<
MOVX T1,BRLEN$ ; Get the number of words to move
XMOVEI T2,CHRMSK ; And the address
EXTEND T1,[XBLT] ; Move the data
> ; End of IFN FTXADR
JRST PCST.1 ; Get the next term
; Here when we get something that is not a character
PCST.2: CAXE T1,$FTPLS ; Is it the plus operator?
JRST PCST.3 ; No, check others
MOVX T4,PLSBIT ; Yes, remember that
LOAD. T1,TPTADR,+CSTTPT ; Get the address of the block
LOAD. T2,BLKSIZ,(T1) ; Get the size
LOAD. T3,BLKFRW,(T1) ; And number free
SUB T2,T3 ; Get the address of the first free
ADD T2,T1 ; Point to the last block
IORM T4,-1(T2) ; Remember the operator
; An operator must be followed by another character, since the DFA building
;algorithm we use insists that the final character of the string by
;a specific single character. Also, the characters allowed in the position
;following a position with either operator may not contain any of the
;characters included in the position with the operator.
PUSHJ P,PRSTRM ; Get a term
POPJ P, ; Punt
CAXE T1,$FTCHR ; Is it a character?
POPJ P, ; No, no good
LOAD. T1,TPTADR,+CSTTPT ; Get the address of the block
LOAD. T2,BLKSIZ,(T1) ; And get the final address
LOAD. T3,BLKFRW,(T1) ; . . .
SUB T2,T3 ; Get the first free address
ADD T2,T1 ; . . .
MOVSI T3,-BRLEN$ ; Get the loop counter
PCST.4: MOVE T1,-BRLEN$(T2) ; Get the first word of the previous block
AND T1,CHRMSK(T3) ; Check for problems
JUMPN T1,.POPJ ; Punt if anything the same
AOJ T2, ; Bump the pointer
AOBJN T3,PCST.4 ; Loop for all of the words
JRST PCST.0 ; Go store the character
; Here the the term is not a character or a plus
PCST.3: MOVE T2,T1 ; Get a copy of the term type
MOVX T1,$FTCHR ; And say we had some characters
CAXE T2,$FTORB ; Was this an or-bar?
CAXN T2,$FTCLN ; Or colon?
AOS (P) ; Give the skip return
POPJ P, ; Return
; Here on an ALWAYS or OTHER keyword
PCST.A: PUSH P,T1 ; Save the type of keyword
PUSHJ P,PRSTRM ; Parse off the next item
JRST [POP P,(P) ; Remove the item from the stack
POPJ P,] ; And give the error return
MOVE T2,T1 ; Get the terminator type (we hope)
POP P,T1 ; And get the keyword type back
CAXN T2,$FTCLN ; Did it terminate on a colon?
AOS (P) ; Yes, give skip return
POPJ P, ; return
SUBTTL FC command -- Parse routines -- Right hand side
;+
;.HL2 PRSRHS
; THis routine will parse the right hand side of a command. This is
;the command type and actual command string.
;.lit
;
; Usage:
; T1/ Address of text buffer to append string to
; PUSHJ P,PRSRHS ; Parse from current position
; (error)
; (good return)
;
; On a good return:
; T1/ Command type
; T2/ Character address of command string in CTB text buffer
; T3/ Length of command string
;
;.end lit
;-
SCNRHS: $SAVE <P1,P2,P3,P4> ; Save P1 to P4
SETO P4, ; Flag we are just scanning
JRST PRHS.0 ; Enter the common code
PRSRHS: $SAVE <P1,P2,P3,P4> ; Save P1/P2/P3/P4
STKTPT (T1,RHSTPT) ; Set up the pointer to the buffer
SETZ P4, ; Flag we are parsing
PRHS.0: PUSHJ P,SIGFCH ; Get a sigificant character
POPJ P, ; Punt
CAXN CH,"{" ; Start of the command string?
JRST PRHS.1 ; Yes, use default command type
PUSHJ P,FCREAT ; No, back up the character
PUSHJ P,PRSCTY ; And parse off the command type
MOVE P1,T1 ; Get the type
PUSHJ P,SIGFCH ; Get the next significant character
POPJ P, ; Punt
CAXE CH,"{" ; Start of the command?
POPJ P, ; No, give up
SKIPA P1,P1 ; Yes, save the command type in a safe place
PRHS.1: MOVX P1,$CTTEC ; If no type given, assume TECO commands
JUMPL P4,PRHS.5 ; Skip this if we are just scanning
LOAD. T1,TPTADR,+RHSTPT ; Get the address of the buffer
LOAD. P2,BLKEND,(T1) ; And get the current end address. This is where
; the string will go
PRHS.5: SETZ P3, ; Clear the counter for the length
PRHS.2: PUSHJ P,FCCHR ; Get a character
POPJ P, ; Punt on errors
CAXN CH,"}" ; End of command?
JRST PRHS.4 ; Yes, go return the values
CAXE CH,$CHQOT ; Quoting character?
JRST PRHS.3 ; No, go store the character
PUSHJ P,FCCHR ; Yes, get the next character
POPJ P, ; Error
PRHS.3: XMOVEI T1,RHSTPT ; Get the address of the TPT
SKIPL P4 ; Skip this if we are just scanning
PUSHJ P,M$ACHR ; And add the character on
AOJA P3,PRHS.2 ; Count the character and try again
; Here on the end of the string
PRHS.4: DMOVE T1,P1 ; Get the command type and address
MOVE T3,P3 ; And the length
PJRST .POPJ1 ; And return
SUBTTL FC command -- Parse routines -- Command types
;+
;.hl2 PRSCTY
;This routine will parse a command type. It will return the address of the
;routine to called for the specified command type.
;.literal
;
; Usage:
; PUSHJ P,PRSCTY
; (Sucess return)
;
; On return:
; T1/ Command type
;
;.end literal
;-
PRSCTY: XMOVEI T1,FCTPT ; Point to the FC TPT address
XMOVEI T2,FCCHR ; Routine to input FC characters
MOVX T3," " ; Break on a keyword
PUSHJ P,SCNKWD ; Scan off the keyword
ERROR E.UNK ; Illegal command type
MOVE T1,CTYPTR ; Get the table address
PUSHJ P,FNDKWD ; Find the string in the table
ERROR E.IFC ; Failed
MOVE T1,2(T1) ; Get the item
POPJ P, ; Return the address
CTYPTR: XWD -CTYLEN,CTYTBL ; Pointer to command tyep table
SUBTTL FC command -- Parse routines -- Command types -- Table
; The following is the expansion of the command types macro, FCCTYM.
DEFINE STRSUB(ARG)<EXP $CT'ARG>
SYN FCCTYM, STRTBL ; Syn the macros
DOSTR (CTY) ; Expand the types
SUBTTL FC command -- Parse routines -- Terms
;+
;.hl2 PRSTRM
; This routine will parse a single term in the c-string. It will return
;the information for the term, or indicate an error.
;.lit
;
; Usage:
; PUSHJ P,PRSTRM
; (error return, bad item found)
; (good return, term type in T1, possibly bits for characters in CHRMSK)
;
;.end lit
;-
PRSTRM: SKIPE TRMRTN ; Have a routine to call for the next character?
PJRST @TRMRTN ; Yes, do it
PRST.0: PUSHJ P,SIGFCH ; Get a significant character
POPJ P, ; None left
; Here with the first character of the term
CAXN CH,"""" ; Is this a quote?
JRST PTRM.Q ; Yes, go handle the string
CAXN CH,"+" ; Is it the plus operator?
JRST PTRM.P ; Yes, go handle it
CAXN CH,"|" ; No, is it an or-bar?
JRST PTRM.O ; Yes, handle that
CAXN CH,":" ; Have a colon?
JRST PTRM.C ; Yes, go return the correct item
CAXL CH,"`" ; Lower case range?
SUBI CH,"a"-"A" ; Yes, convert to upper
CAXL CH,"A" ; Is this a legal keyword character?
CAXLE CH,"Z" ; . . .
POPJ P, ; No, punt
PUSHJ P,FCREAT ; Back up a character
XMOVEI T1,FCTPT ; Get the pointer
XMOVEI T2,FCCHR ; And the routine to get a character
SETO T3, ; Break on non-keyword character
PUSHJ P,SCNKWD ; Scan off the keyword
POPJ P, ; Punt
PUSHJ P,FCREAT ; Back up the delimeter character
MOVE T1,[XWD -PTRLEN,PTRTBL] ; Get the pointer to the table
PUSHJ P,FNDKWD ; Search for the keyword
POPJ P, ; No keyword
PJRST @2(T1) ; Call the routine
; Here on a double quote. This is the start of a quoted string,
;so set up the routine to fetch subsequent characters.
PTRM.Q: XMOVEI T1,PQST.1 ; Get the address of the routine to fetch chars
MOVEM T1,TRMRTN ; Save it
FALL PQST.1 ; And get the first character
; Routine to fetch a character from the string. It will handle quotes
;embedded in the string
PQST.1: PUSHJ P,CLRCHM ; Clear out the character mask
PUSHJ P,FCCHR ; Get a character
JRST PQST.3 ; End of string, clear out special routine
CAXE CH,"""" ; Is this a quote?
JRST PQST.2 ; No, go return the correct mask
PUSHJ P,FCCHR ; Yes, try again
JRST PQST.3 ; End of string, clear out special routine
CAXN CH,"""" ; Is this another quote?
JRST PQST.2 ; No, go return the correct mask
PUSHJ P,FCREAT ; No, back up the character and give end of string return
SETZM TRMRTN ; Clear out the special address
PJRST PRSTRM ; And try again
; Here at the end of the string. Clear out the special processing routine
PQST.3: SETZM TRMRTN ; Clear the address
POPJ P, ; And return
; Here if we have a valid character. Set the correct bit in the mask.
PQST.2: MOVE T1,CH ; Get the character
PUSHJ P,SETCHM ; And set the character
MOVX T1,$FTCHR ; Get the terminal type
PJRST .POPJ1 ; And return
; Here if the item is a plus. Just return the correct type
PTRM.C: SKIPA T1,[EXP $FTCLN] ; Return the colon type
PTRM.P: MOVX T1,$FTPLS ; Get the term type
PJRST .POPJ1 ; And return it
; Here if the item is an or-bar. Just return the type.
PTRM.O: MOVX T1,$FTORB ; Get the type
PJRST .POPJ1 ; And return it
SUBTTL FC command -- Parse routines -- Terms -- Table
; The following is the dispatch table for the various terms that
; are found in the commands.
DEFINE STRSUB(ARG)<EXP IFIW!FT$'ARG>
SYN FCTERM, STRTBL ; Syn for the table generator macro
DOSTR (PTR) ; Generate the table
SUBTTL FC command -- Parse routines -- Terms -- NULL
;+
;.HL2 FT$NUL
;-
FT$NUL: PUSHJ P,CLRCHM ; Clear the mask out
MOVX T1,.CHNUL ; Get the character
PUSHJ P,SETCHM ; Set the correct bit
MOVX T1,$FTCHR ; Get the term type (single character)
PJRST .POPJ1 ; And return
SUBTTL FC command -- Parse routines -- Terms -- DELETE
;+
;.HL2 FT$DEL
;-
FT$DEL: PUSHJ P,CLRCHM ; Clear the mask
MOVX T1,.CHDEL ; Get a delete
PUSHJ P,SETCHM ; Set the bit
MOVX T1,$FTCHR ; Get the term type
PJRST .POPJ1 ; And return
SUBTTL FC command -- Parse routines -- Terms -- DECIMAL
;+
;.HL2 FT$DEC
;-
; Macro to copy a predefined item to CHRMSK
DEFINE CPYM(NAM),<
MOVE T1,[XWD NAM,CHRMSK] ;; Get the pointer
BLT T1,CHRMSK+BRLEN$-1 ;; And copy the mask
> ; End of DEFINE CPYM
FT$DEC: CPYM(DECMSK) ; Copy the mask
MOVX T1,$FTCHR ; Get the term type (range)
PJRST .POPJ1 ; And return
BRINI$(DEC) ; Define the mask
BRKCH$(DEC,"0","9") ; For the digits
DECMSK: BRGEN$(DEC) ; Generate the mask
SUBTTL FC command -- Parse routines -- Terms -- OCTAL
;+
;.HL2 FT$OCT
;-
FT$OCT: CPYM(OCTMSK) ; Copy the mask
MOVX T1,$FTCHR ; Get the term type (range)
PJRST .POPJ1 ; Return
BRINI$(OCT)
BRKCH$(OCT,"0","7")
OCTMSK: BRGEN$(OCT)
SUBTTL FC command -- Parse routines -- Terms -- ALPHABETIC
;+
;.HL2 FT$ALP
;-
FT$ALP: CPYM(ALPBRK) ; Move the mask
MOVX T1,$FTCHR ; Get the term type
PJRST .POPJ1 ; And return
ALPBRK: BRGEN$(ALP) ; Generate the table of characters
SUBTTL FC command -- Parse routines -- Terms -- ALPHANUMERIC
;+
;.HL2 FT$ALN
;-
FT$ALN: CPYM(ALNBRK) ; Copy the mask
MOVX T1,$FTCHR ; Get the term type
PJRST .POPJ1 ; And return
BRINI$(ALN,ALP) ; Get the alphabetics
BRKCH$(ALN,"0","9") ; And add the numerics
ALNBRK: BRGEN$(ALN) ; Generate the table
SUBTTL FC command -- Parse routines -- Terms -- ANY
;+
;.HL2 FT$ANY
;Syntax resembles ANY:(char-char,char, . . . )
;-
FT$ANY: $SAVE <P1,P2> ; Free up a few registers
PUSHJ P,FCCHR ; Get the next character
POPJ P, ; None there, punt
CAXE CH,":" ; Is there a colon?
POPJ P, ; No, punt
PUSHJ P,FCCHR ; Get a character
POPJ P, ; No, give up
CAXE CH,"(" ; Open paren?
POPJ P, ; No, give an error
PUSHJ P,CLRCHM ; Clear the mask out
; Here to get each octal number or character and set the correct bit
FANY.1: PUSHJ P,PRSCHR ; Get the number/character
JUMPL T1,.POPJ ; Punt if negative
CAXLE T1,.CHDEL ; Legal?
POPJ P, ; No, too large
CAXN CH,"-" ; Is this the start of a range specification?
JRST FANY.3 ; Yes, go off to handle that case
PUSHJ P,SETCHM ; Set the bit for the character
FANY.2: CAXN CH,"," ; Is there more to come?
JRST FANY.1 ; Yes, go get it
CAXE CH,")" ; No, end of list?
POPJ P, ; No, punt
MOVX T1,$FTCHR ; Get the term type
PJRST .POPJ1 ; And give the good return
; Here to get the upper part of a range, and then set the bits
FANY.3: MOVE P1,T1 ; Save the lower bound
PUSHJ P,PRSCHR ; Get the upper bound
MOVE P2,T1 ; Save the upper bound
JUMPL P2,.POPJ ; Error if negative,
CAXLE P2,.CHDEL ; or too big?
POPJ P, ; Yes, error return
CAMGE P2,P1 ; Is upper bound less than lower?
EXCH P2,P1 ; Yes, then exchange them.
FANY.4: MOVE T1,P1 ; Fetch loop index value
PUSHJ P,SETCHM ; Set the character bit
CAMGE P1,P2 ; End of range?
AOJA P1,FANY.4 ; No, do next character
JRST FANY.2 ; Finished, rejoin common routine
SUBTTL FC command -- Parse routines -- Terms -- VALUE
;+
;.HL2 FT$VAL
;-
FT$VAL: PUSHJ P,CLRCHM ; Clear out the mask
PUSHJ P,FCCHR ; Get a character
POPJ P, ; Nothing there
CAXE CH,":" ; Have a colon?
POPJ P, ; No, punt
PUSHJ P,FCCHR ; Get the next character
POPJ P, ; Ran out?
CAXN CH,"(" ; Is this the start of a string?
JRST FVAL.1 ; Yes, go handle it
PUSHJ P,FCREAT ; No, back up the character
FVAL.0: PUSHJ P,.IOCTW ; Get the octal number
JUMPL T1,.POPJ ; Bad character?
CAXLE T1,.CHDEL ; . . .
POPJ P, ; Yes, punt
PUSHJ P,FCREAT ; Set the terminator as the next character
PUSHJ P,SETCHM ; Set the character
MOVX T1,$FTCHR ; Say this is a single character
PJRST .POPJ1 ; And return
; Here when we have an open paren. Set up to return subsequent characters
FVAL.1: XMOVEI T1,FVAL.2 ; Get the routine
MOVEM T1,TRMRTN ; Save as special routine
JRST FVAL.0 ; And return the first character
; Here on subsequent calls to PRSTRM
FVAL.2: PUSHJ P,CLRCHM ; Clear out the mask
PUSHJ P,FCCHR ; Get the next character
POPJ P, ; Punt if nothing left
CAXE CH,"," ; Is this a comma?
JRST FVAL.3 ; No, check for paren
PUSHJ P,FVAL.0 ; Set the correct characters
JRST [SETZM TRMRTN ; Clear the routine
POPJ P,] ; And return
PJRST .POPJ1 ; Give the good return
; Here if the character is not a comma
FVAL.3: SETZM TRMRTN ; Clear out special routine
CAXE CH,")" ; End of list?
POPJ P, ; No, give error return
PJRST PRSTRM ; Go try for another item
SUBTTL FC command -- Parse routines -- Terms -- RANGE
;+
;.HL2 FT$RNG
;-
FT$RNG: $SAVE <P1,P2> ; Save some room
PUSHJ P,CLRCHM ; Clear out the mask
PUSHJ P,FCCHR ; Get the next character
POPJ P, ; Punt if nothing left
CAXE CH,":" ; Better be a colon
POPJ P, ; Nope, give up
PUSHJ P,PRSCHR ; Get a number
CAXN CH,":" ; Terminate on a colon?
CAXLE T1,.CHDEL ; Is it ok?
POPJ P, ; No, punt
MOVE P1,T1 ; Get the character
PUSHJ P,PRSCHR ; Get the next character value
CAXG T1,.CHDEL ; Or too large?
CAML P1,T1 ; Or less than first?
POPJ P, ; Illegal character combination
PUSHJ P,FCREAT ; Back up the character
MOVE P2,T1 ; Get the second character
FRNG.1: MOVE T1,P1 ; Get the character
PUSHJ P,SETCHM ; Set the character bit
CAMGE P1,P2 ; End of range?
AOJA P1,FRNG.1 ; No, do next character
MOVX T1,$FTCHR ; Get the term type
PJRST .POPJ1 ; And give the good return
SUBTTL FC command -- Parse routines -- Terms -- OTHER
;+
;.HL2 FT$OTH
;-
FT$OTH: MOVX T1,$FTOTH ; Just get the type
PJRST .POPJ1 ; And return
SUBTTL FC command -- Parse routines -- Terms -- ALWAYS
;+
;.HL2 FT$ALW
;-
FT$ALW: MOVX T1,$FTALW ; Just get the type
PJRST .POPJ1 ; And return
SUBTTL FC command -- Subroutines -- CRECTB
;+
;.hl2 CRECTB
; This routine will create a CTB and cause CURCTB to point at it.
;This is used to create the initial CTB the first time the FC command
;is given, and to create a new one when necessary for the FCPUSH and
;FCOVERLAY commands.
CRECTB: MOVX T1,$CTLEN ; Get the size of the CTB
MOVX T2,.BTCTB ; And the block type
PUSHJ P,M$ZBLK ; Get a block
SUBX T1,.BKLEN ; Remove the header offset
PSHTPT (CRETPT,T1) ; Save the address
SETZ T1, ; Get a minimal text buffer
PUSHJ P,M$GTXT ; . . .
LOAD. T2,TPTADR,+CRETPT ; Get the address of the first one
XMOVEI T2,$CTTPT(T2) ; . . .
PUSHJ P,M$USEB ; And set up the pointer
MOVX T1,$CNLEN ; Get the minimum length CND
MOVX T2,.BTCND ; Get the block type
PUSHJ P,M$ZBLK ; Allocate it
SUBX T1,.BKLEN ; Remove the offset
MOVX T2,$CNINF ; Set up the END pointer
STOR. T2,CNDEND,(T1) ; Store this in the END pointer
MOVX T2,$CNCND ; Get the offset
LOAD. T3,TPTADR,+CRETPT ; Get the address the first
ADDX T3,$CTCND-$CNCND ; Offset it
PUSHJ P,M$LINK ; Link the block into the list
LOAD. T2,TPTADR,+CRETPT ; Get the address of the CTB again
XMOVEI T2,$CTCMD(T2) ; Point at the TPT to point to the CND
PUSHJ P,M$USEB ; Set up the pointer
POPTPT (T1) ; Restore the CTB address
POPJ P, ; And return
SUBTTL FC command -- Subroutines -- INSCST
;+
;.hl2 INSCST
; This routine will insert a C-string into a command node. It will
;do this by inserting a single character position into the given
;node, then recursively calling itself for each separate command node
;which need to have characters inserted.
;.lit
;
; Usage:
; T1/ Offset into block pointed at by CSTTPT for this character position
; T2/ Address of command node
; T3/ Number of character positions in command beyond this point
; RPLTPT/ Address of TPT that points at the CTB
; PUSHJ P,INSCST
; (error return)
; (good return)
;
;.end lit
;-
INSCST: $SAVE <P1,P2,P3,P4,CH> ; Save some ac's
MOVE P1,T1 ; Get the arguments
MOVE P2,T3 ; Get the number of positions left
STKTPT (T2,ICNTPT) ; Set up the pointer to the command node
; This routine will work by first inserting the string for all characters
;which already are defined in this CND. It will simply advance to the
;CND for that character position, and call itself recursively. If there is
;an execute for the character, it will either give the error return or delete
;the previous command, depending on the state of FCINSF.
; Finally, after all characters already in the table have been processed,
;it will generate a set of CND's to handle the rest of the characters, if
;any.
LOAD. T1,TPTADR,+CSTTPT ; Get the address of the string
ADD T1,P1 ; Point to the character position
MOVE P4,SPCOFF(T1) ; Get the special bits
SETZ CH, ; Start with first possible character
SETO P3, ; Flag no new CND yet
ICST.1: MOVE T1,P1 ; Get the overall offset
LOAD. T2,TPTADR,+CSTTPT ; Get the address of the characters
PUSHJ P,NXTCHR ; Get the next character
JRST ICST.2 ; Got the next character
PJRST .POPJ1 ; And give the good return
; Here when we have found a character.
ICST.2: MOVE T1,CH ; Get the character
IDIVX T1,$CNBPW ; Convert to word/byte offset
LOAD. T3,TPTADR,+ICNTPT ; Get the address of the CND
ADD T1,T3 ; Get the address of the word of bytes
ADDX T1,$CNBYT ; Point to the correct word
TDO T1,CNBTAB(T2) ; Get the byte pointer
LDB T2,T1 ; Get the byte
TXNN T2,CB$DEF ; Transition defined?
JRST ICST.7 ; No, go set up the correct transition/execute
TXNE T2,CB$TRN ; Is this an execute item?
JRST ICST.4 ; No, all is fine
; Here if the character has an execute function at this position.
;We must check for the insert/replace flag, and if necessary delete the
;previous CND's and do something about the character.
ICST.Z: SKIPE FCINSF ; Insert?
POPJ P, ; Yes, punt now
; Check for other users of the same TPT.
; T1 contains the byte pointer to the info for the current character
; T2 contains the info for the current character
PUSH P,T1 ; Save the byte pointer
LOAD. T1,TPTADR,+ICNTPT ; Get the address of the block
PUSHJ P,CHKOTH ; Check for other users of the same index
JRST ICST.6 ; No others
POP P,T1 ; Yes, get the byte pointer back
SETZ T2, ; Clear the info out
DPB T2,T1 ; . . .
JRST ICST.7 ; Go set up the new info
; Here if this character had the only use of the execute info. We can
;release the use of the info words
ICST.6: POP P,T1 ; Get the byte pointer back
SETZ T3, ; Clear the byte out
DPB T3,T1 ; . . .
TXNE T2,CB$XCT ; Was this an execute?
JRST ICST.X ; Yes, nothing to return except the index
ANDX T2,CB$IDX ; Keep only the index
PUSH P,T2 ; Save the index
LOAD. T3,TPTADR,+ICNTPT ; Get the address of the CND
IMULX T2,$CILEN ; Get the offset to the info
ADD T2,T3 ; . . .
LOAD. T1,TPTADR,+$CNINF+$CITRN(T2) ; Get the address of the CND
CAMN T1,T3 ; Pointing to myself?
PUSHJ P,RETCND ; No, Return the CND if necessary
MOVE T1,(P) ; Get the index back
IMULX T1,$CILEN ; Get the offset
LOAD. T2,TPTADR,+ICNTPT ; Get the address of the CND
ADD T1,T2 ; Get the address of the info
XMOVEI T1,$CNINF+$CITRN(T1) ; Get the address of the TPT
PUSHJ P,M$RELB ; Release the block
POP P,T2 ; Get the index back
JRST ICST.V ; Skip trying to return a string
ICST.X: MOVE T1,RPLTPT ; Get the address of the TPT to the CTB
LOAD. T1,TPTADR,(T1) ; And get the address of the CTB
ANDX T2,CB$IDX ; Keep only the index
PUSH P,T2 ; Save the index we are returning
IMULX T2,$CILEN ; And get the address of the info
LOAD. T3,TPTADR,+ICNTPT ; Get the address of the CND
ADD T2,T3 ; And get the offset
LOAD. T3,CINCLN,+$CNINF(T2) ; Get the length of the string
LOAD. T2,CINCAD,+$CNINF(T2) ; And the character address
CAXE T2,-1 ; Is it a minus one?
PUSHJ P,DLCMST ; No, delete the command string
POP P,T2 ; Get the index back
ICST.V: LOAD. T1,TPTADR,+ICNTPT ; Get the address of the CND
PUSHJ P,RETBYT ; Release the info words
; Here if the character is not currently valid in this node.
;If we already have CND's allocated for the rest of the command string,
;we will allocate them, and set up the correct pointer for this character.
ICST.7: JUMPGE P3,ICST.8 ; If we already have the CND's allocated,
; just go store the info
LOAD. T1,TPTADR,+ICNTPT ; Get the address
PUSHJ P,ALCBYT ; And get the address of a free entry
MOVE P3,T1 ; Get the index
CAIE P2,1 ; Last character sition?
JRST ICST.9 ; No, this is a transfer
TXO P3,CB$XCT ; Yes, this is an execute
MOVE T1,P3 ; Get the info
ANDX T1,CB$IDX ; Keep only the index
IMULX T1,$CILEN ; Get the offset to the info
LOAD. T2,TPTADR,+ICNTPT ; Get the address of the CND
ADD T1,T2 ; And make the address of the info words
ONES. ,CINCAD,+$CNINF(T1) ; Flag this needs to be filled in
ICST.8: MOVE T1,CH ; Get the character value
IDIVX T1,$CNBPW ; Get the word/byte offsets
LOAD. T3,TPTADR,+ICNTPT ; Get the CND address
ADD T1,T3 ; Point to the correct byte
ADDX T1,$CNBYT ; . . .
TDO T1,CNBTAB(T2) ; Make it a byte pointer
DPB P3,T1 ; Store the info
AOJA CH,ICST.1 ; And go for the next character
; Here if the character is not referenced in this state, and it should
;have a transition out of this CND.
ICST.9: TXO P3,CB$TRN ; Flag we need a transition
LOAD. T1,TPTADR,+ICNTPT ; Get the address of the CND
TXNE P4,LOPBIT ; This position need to loop to itself?
JRST ICST.S ; Yes, go handle it
MOVX T1,$CNLEN+$CILEN ; Get the length of a CND (with one info)
MOVX T2,.BTCND ; Get the block type
PUSHJ P,M$ZBLK ; Get a block
SUBX T1,.BKLEN ; Point to the first word
MOVX T2,$CNINF ; Get the offset for the END
STOR. T2,CNDEND,(T1) ; Store the information
LOAD. T2,BLKFRW,(T1) ; Get the number free words
ADDX T2,$CILEN ; Update it
STOR. T2,BLKFRW,(T1) ; Store it back
LOAD. T3,TPTADR,+ICNTPT ; Get the address of the CND
MOVX T2,$CNCND ; Get the LNK offset
PUSHJ P,M$LINK ; Link this one in
ICST.S: MOVE T2,P3 ; Get the offset
ANDX T2,CB$IDX ; Keep only the index
IMULX T2,$CILEN ; Get the offset to the info
LOAD. T3,TPTADR,+ICNTPT ; Get the address of the CND again
ADD T2,T3 ; And make the address of the info
ADDX T2,$CNINF+$CITRN ; . . .
IFN FTDEBUG,SETZM $TPADR(T2) ; Clear it out if debugging
PUSHJ P,M$USEB ; Set up the pointer
MOVE T2,CH ; Get the character value
IDIVX T2,$CNBPW ; Get the word/byte offsets
LOAD. T4,TPTADR,+ICNTPT ; Get the CND address
ADD T2,T4 ; Point to the correct byte
ADDX T2,$CNBYT ; . . .
TDO T2,CNBTAB(T3) ; Make it a byte pointer
DPB P3,T2 ; Store the info
TXNE P4,PLSBIT ; End with a "+"?
JRST ICST.P ; Yes, go handle it
MOVE T2,T1 ; Get the address of the CND
MOVE T1,P1 ; Get the character offset
ADDX T1,BRLEN$ ; And advance to the next character position
MOVE T3,P2 ; Get the number of character positions left
SOJ T3, ; We have one less
PUSHJ P,INSCST ; Insert whatever is left
POPJ P, ; Pass back the error
JRST ICST.8 ; Go set the info for this character
; Here if the character was followed by the "+" operator. We will set up
;the correct transfers for this character. First we must set up the
;transition from this state to a new one. Then we will call ourself
;recursively to create the loop in the new state, and generate the exits from
;the state.
ICST.P: LOAD. T3,TPTADR,+CSTTPT ; Get the address of the string
ADD T3,P1 ; Point to this position
MOVX T2,LOPBIT!PLSBIT ; Get the bits to fix
XORM T2,SPCOFF(T3) ; Complement the bits
MOVX T2,CN$PLS ; Get the plus flag
IORM T2,$CNFLG(T1) ; Flag that this is a special CND
MOVE T2,T1 ; Get the address of the new CND
MOVE T1,P1 ; And set up the arguments for ourself
MOVE T3,P2 ; Get the number of characters left
PUSHJ P,INSCST ; Insert this portion
POPJ P, ; Pass back the error
LOAD. T1,TPTADR,+CSTTPT ; Get the TPT address
ADD T1,P1 ; And get the address of this character
MOVEM P4,SPCOFF(T1) ; Reset it
JRST ICST.8 ; Go set up the infor for this character
; Here if we have a transition out of this state on this character.
;Check for other transitions to the same place on other characters and
;determine if we need to split the next CND to allow this.
ICST.4: CAIN P2,1 ; Last character position causes a replace
JRST ICST.Z ; Yes, must do a replace
; Search for another use of the same index (still in T2)
; Byte pointer to characters info is still in T1
MOVE T4,T1 ; Get the byte pointer
LOAD. T1,TPTADR,+ICNTPT ; Get the address of the CND
SUB T4,T1 ; Make the byte pointer relative
PUSH P,T4 ; Save it on the stack
PUSHJ P,CHKOTH ; Any other users of this index?
JRST ICST.W ; No, all is fine
; Here if we find another character with the same index as this one
;Now check if we are going to the loop state of a "+".
ANDX T2,CB$IDX ; Keep only the index
PUSH P,T2 ; Save the index
IMULX T2,$CILEN ; Get the offset
LOAD. T1,TPTADR,+ICNTPT ; Get the CND address
ADD T2,T1 ; And make the address of the info
LOAD. T2,TPTADR,+$CITRN+$CNINF(T2) ; Get the address of the next CND
MOVX T3,CN$PLS ; Check if a loop state for a plus
TDNE T3,$CNFLG(T2) ; . . .
JRST ICST.O ; Yes, go handle it
ICST.Q: LOAD. T1,TPTADR,+ICNTPT ; Get the CND address
PUSHJ P,ALCBYT ; And get a new byte
EXCH T1,(P) ; Get the old index back
LOAD. T2,TPTADR,+ICNTPT ; Get the address of the CND
ADDX T2,$CNINF ; Plus the offset
IMULX T1,$CILEN ; And point to the data
ADD T1,T2 ; . . .
LOAD. T2,TPTADR,+$CITRN(T1) ; Get the address of the next CND
MOVE T1,RPLTPT ; Get the address of the TPT to the CTB
LOAD. T1,TPTADR,(T1) ; And get the address of the CTB
PUSHJ P,DUPCND ; Create a duplicate of the CND tree
; Now link up the new blocks into the current CND list.
SKIPA T2,T1 ; Set up to look for end of the new blocks
ICST.L: MOVE T2,T3 ; Get the address of the block
LOAD. T3,LNKNXT,+$CNCND(T2) ; Get the next block address
JUMPN T3,ICST.L ; Keep looking for the end of the list
LOAD. T3,TPTADR,+ICNTPT ; Get the address of the current CND
LOAD. T4,LNKNXT,+$CNCND(T3) ; Get the old next pointer
STOR. T1,LNKNXT,+$CNCND(T3) ; And store it
STOR. T3,LNKPRV,+$CNCND(T1) ; Set up the previous pointer for this block
STOR. T4,LNKNXT,+$CNCND(T2) ; Store the next pointer into the last of the new blocks
JUMPE T4,.+2 ; Have something being pointed at?
STOR. T2,LNKPRV,+$CNCND(T4) ; Yes, store the back pointer
POP P,T2 ; Get the index back
POP P,T3 ; And the byte pointer
LOAD. T4,TPTADR,+ICNTPT ; Get the CND address back
ADD T3,T4 ; And make the byte pointer absolute again
TXO T2,CB$TRN ; Flag this position is a transition
DPB T2,T3 ; Store it in
ANDX T2,CB$IDX ; Keep only the index
IMULX T2,$CILEN ; Get the offset
LOAD. T3,TPTADR,+ICNTPT ; Get the address of the CND
ADDX T3,$CNINF+$CITRN ; Point to the info words
ADD T2,T3 ; And make the address of the info for this byte
IFN FTDEBUG,SETZM $TPADR(T2) ; Clear the pointer
PUSHJ P,M$USEB ; Set up the pointer
MOVE T2,T1 ; Get the address of the CND
MOVE T1,P1 ; Get the offset to the character
ADDX T1,BRLEN$ ; Advance to the next
MOVE T3,P2 ; Get the number of characters left
SOJ T3, ; Decrement the count
PUSHJ P,INSCST ; And insert the rest of the string
POPJ P, ; Punt if it got an error
AOJA CH,ICST.1 ; Go for the next character
; Here if the next CND is a loop state. Check if everything that is in
;the current character position goes to the loop state, and nothing else
ICST.O: TXNN P4,PLSBIT ; Only need to check if current character position is also a plus
JRST ICST.R ; Not a plus, must do a replace
PUSHJ P,ICSSUB ; Do the checks
JRST ICST.Q ; Everything is the same, go handle it
ICST.R: ADJSP P,-2 ; Remove the junk
SKIPE FCINSF ; Doing a replace?
POPJ P, ; No, give the error
MOVE T3,CH ; Get the character value
IDIVX T3,$CNBPW ; Convert to word/byte index
ADDX T3,$CNBYT ; Point to the bytes
ADD T3,T2 ; In the next CND
TDO T3,CNBTAB(T4) ; Set up the pointer
SETZ T4, ; And clear out the byte
DPB T4,T3 ; . . .
SUB T3,T2 ; Get the relative byte pointer again
ADD T3,T1 ; And point to the current CND
DPB T4,T3 ; Clear out the byte
JRST ICST.7 ; And insert the new item
; Here if this is the only use of this transfer item. Just call
;ourself for the next character position.
;We must also check if the next position is a plus, and handle it
;correctly if it is.
ICST.W: PUSH P,T2 ; Save the index
ANDX T2,CB$IDX ; Keep only the index
IMULX T2,$CILEN ; Get the info offset
LOAD. T1,TPTADR,+ICNTPT ; Get the current CND address
ADD T2,T1 ; Get the address of the info
LOAD. T2,TPTADR,+$CNINF+$CITRN(T2) ; Get the address of the next CND
MOVX T1,CN$PLS ; Check if next state is a loop
TDNE T1,$CNFLG(T2) ; Is it?
JRST ICST.J ; Yes, we must replace it
ICST.M: ADJSP P,-2 ; Remove the junk from the stack
MOVE T1,P1 ; Get the offset for this character position
ADDX T1,BRLEN$ ; Advance to the next
MOVE T3,P2 ; Get the number of characters left
SOJ T3, ; One less
PUSHJ P,INSCST ; Insert the rest of this string
POPJ P, ; Pass back errors
AOJA CH,ICST.1 ; And try the next character
; Here if this single character goes to a loop state. Make sure
;this position only consists of the single character.
ICST.J: PUSH P,CH ; Save CH
SETZ CH, ; Clear the character
MOVE T1,P1 ; Get the index
LOAD. T2,TPTADR,+CSTTPT ; And the string address
ICST.K: PUSHJ P,NXTCHR ; Get a character
JRST [CAMN CH,(P) ; Same character?
JRST ICST.K ; Yes, try again
POP P,CH ; Restore CH
JRST ICST.N] ; And go handle this case
POP P,CH ; Restore CH
TXNE P4,PLSBIT ; If this character also has a plus then we can just advance
JRST ICST.M ; Only the single character, go advance it
; Here if we cannot possibly use the next state. We must do a replace,
;so set up the ac's and go back to the replace routine.
ICST.N: POP P,T2 ; Get the info back
POP P,T1 ; And the byte pointer
JRST ICST.Z ; And go do the replace
; Subroutine to determine if the current character position will map
;one-to-one to all the transfers to the given next CND.
;Usage:
; T1/ CND address
; T2/ Next CND address
; P1/ Index for current character position
; PUSHJ P,ICSSUB
; (return, one-one mapping exists)
; (skip return, one-one mapping does not exist)
; On return, T1 and T2 are intact
;
ICSSUB: $SAVE <T1,T2,P2,P3,P4,CH> ; Save some ac's
MOVE P2,T2 ; Get the args
SETZB CH,P3 ; Set up to start with first character
XMOVEI P4,$CNBYT(P2) ; Set up a byte pointer to the info
TXO P4,<POINT 9,> ; . . .
ISUB.1: MOVE T1,P1 ; Get the index
LOAD. T2,TPTADR,+CSTTPT ; And the address of the string
PUSHJ P,NXTCHR ; Get the next character
JRST ISUB.3 ; Got one, go handle it
ISUB.2: CAXLE P3,177 ; Done yet?
POPJ P, ; Yes, everything matches up
ILDB T1,P4 ; No, get the next byte
TXNN T1,CB$TRN ; Is this a transfer?
AOJA P3,ISUB.2 ; No, try the next
ANDX T1,CB$IDX ; Yes, keep the index
IMULX T1,$CILEN ; And make the offset
LOAD. T2,TPTADR,+ICNTPT ; Get the CND address
ADD T1,T2 ; And make the correct address
CFXE. T2,TPTADR,+$CITRN+$CNINF(T1),P2 ; Is this the CND we are worried about?
AOJA P3,ISUB.2 ; No, try the next character
PJRST .POPJ1 ; Yes, punt
; Here when we have found a character in this position. Check all characters
;the previous character to here for the info, and make sure this character
;has it.
ISUB.3: CAML P3,CH ; Previous characters to check?
JRST ISUB.4 ; No, check this one
ILDB T1,P4 ; Yes, get the info
TXNN T1,CB$TRN ; Transfer?
AOJA P3,ISUB.3 ; No, try again
ANDX T1,CB$IDX ; Yes, keep the index
IMULX T1,$CILEN ; And make the offset
LOAD. T2,TPTADR,+ICNTPT ; Get the CND address
ADD T1,T2 ; And make the correct address
CFXE. T2,TPTADR,+$CITRN+$CNINF(T1),P2 ; Is this the CND we are worried about?
AOJA P3,ISUB.3 ; No, try the next character
PJRST .POPJ1 ; Yes, punt
ISUB.4: ILDB T1,P4 ; Get the next character info (for this char)
TXNN T1,CB$TRN ; Is it a transfer?
PJRST .POPJ1 ; No, punt
ANDX T1,CB$IDX ; Yes, keep the index
IMULX T1,$CILEN ; And make the offset
LOAD. T2,TPTADR,+ICNTPT ; Get the CND address
ADD T1,T2 ; And make the correct address
CFXE. T2,TPTADR,+$CITRN+$CNINF(T1),P2 ; Is this the CND we are worried about?
PJRST .POPJ1 ; No, punt
AOJ P3, ; Advance to the next character here
AOJA CH,ISUB.1 ; And here
SUBTTL FC command -- Subroutines -- DELCST
;+
;.HL2 DELCST
;This routine will delete a C-string from a command node. It will do this
;by first searching for the end of the C-string and then deleting the transfers
;from the bottom of the C-string up.
;.literal
;
; Usage:
; T1/ Offset into the block pointed at by CSTTPT for this character position
; T2/ Address of the command node
; T3/ Number of character positions in command beyond this point
; RPLTPT/ Address of TPT that points at this CTB
; PUSHJ P,DELCST
; (Return CND return)
; (Don't return block return)
;
; On a Return CND return:
; T1/ Address of the CND to return
;
; On a Don't return CND return:
; T1/ Address of the CND
;
;.end literal
;-
DELCST: $SAVE <P1,P2,P3,P4> ; Save a few registers
$SAVE <CH,A1> ; Save the current character
MOVE P1,T1 ; Copy the arguments
MOVE P2,T3 ; . . .
STKTPT (T2,DLCTPT) ; Stack the pointer to the command node
XMOVEI T1,DLCTPT ; Get the address
MOVEM T1,DLCADR ; Store the address
SETZ CH, ; Initialize the character searching
LOAD. T1,TPTADR,+CSTTPT ; Get the address again
ADD T1,P1 ; Point to the information
MOVE P4,SPCOFF(T1) ; Get the special bits
TXNE P4,PLSBIT ; Is this a plus?
JRST DLCS.P ; Yes, Go handle it
; The following is the main loop that will do all of the work in finding
; the C-string that is to be deleted.
DLCS.1: MOVE T1,P1 ; Get a copy of the offset
LOAD. T2,TPTADR,+CSTTPT ; Get the command node offset
PUSHJ P,NXTCHR ; Get the next character
JRST DLCS.2 ; Succeeded, now delete this item
; Here to exit from the the routine. This section will check to determine
; if the CND block can be returned to memory.
DLCS.E: LOAD. T1,TPTADR,+DLCTPT ; Get the address of the CND
SKIPN $CNBTS(T1) ; Should we return this block?
SKIPE $CNBTS+1(T1) ; . . .
JRST .POPJ1 ; No, Just return
SKIPN $CNBTS+2(T1) ; . . .
SKIPE $CNBTS+3(T1) ; . . .
JRST .POPJ1 ; No, Just return
POPJ P, ; Return this block
; At this point we have the next character position to delete.
DLCS.2: LOAD. T3,TPTADR,+DLCTPT ; Get the command node address again
PUSHJ P,DLCSUB ; Call the subroutine
TXNN P3,CB$XCT ; Is this an execute?
JRST DLCS.3 ; Yes, Go execute it
; Here if we have an execute transfer. This means that we should not
; have any of the special bits on and that are at character position one.
CAIE P2,1 ; Are we at last position?
ERROR E.DUS ; No, die
LOAD. T1,TPTADR,+DLCTPT ; Get the address again
MOVE T2,P3 ; Get the byte
PUSHJ P,CHKOTH ; Other users?
JRST DLCS.4 ; No other users, delete this entry
AOJA CH,DLCS.1 ; Loop for the next entry
; Here if we have no other users of the of the execute.
DLCS.4: LOAD. T4,TPTADR,+DLCTPT ; Get the CND address
ADD T4,A1 ; Add in the other
LOAD. T2,CINCAD,(T4) ; Get the character address
LOAD. T3,CINCLN,(T4) ; Get the character length
ZERO. ,CINCAD,(T4) ; Clear the words now
ZERO. ,CINCLN,(T4) ; . . .
MOVE T1,RPLTPT ; Get the address of the TPT
LOAD. T1,TPTADR,(T1) ; Get the CTB address
PUSHJ P,DLCMST ; Delete the string
LOAD. T1,TPTADR,+DLCTPT ; Get the address of the CND
MOVE T2,P3 ; get the byte index
ANDX T2,CB$IDX ; Just the index
PUSHJ P,RETBYT ; Return this byte
AOJA CH,DLCS.1 ; Go process the next character
; Here if we have a transition to another state, check to make sure we haven't
; run out of characters.
DLCS.3: CAIG P2,1 ; Have more characters?
ERROR E.DUS ; Bad
MOVE T3,P2 ; Get the number of characters
SUBI T3,1 ; Back it up one
MOVE T1,P1 ; Get the offset
ADDX T1,BRLEN$ ; Point to the next item
LOAD. T2,TPTADR,+DLCTPT ; Get the address
ADD T2,A1 ; Point to the information
LOAD. T2,TPTADR,+$CITRN(T2) ; Get the transition CND
PUSHJ P,DELCST ; Delete the next CST
PUSHJ P,DLCDEL ; Make this go away
LOAD. T1,TPTADR,+DLCTPT ; Get the address
ADDI T1,$CITRN(A1) ; Point to the information
PUSHJ P,M$RELB ; Release the block
AOJA CH,DLCS.1 ; Loop for the next character
; DLCDEL - This routine will make a CND node block be deallocated.
DLCDEL: MOVX T2,$CNCND ; Get the offset
PUSHJ P,M$ULNK ; Unlink it from the list
MOVE T1,RPLTPT ; Get the address of the TPT
LOAD. T1,TPTADR,(T1) ; get the address of the CTB
POPJ P, ; Return to the caller
; DLCSUB - Subroutine to get the byte from the BYT field.
;
; Usage:
; CH/ Character we are currently processing
; T3/ TPT that we are working on
; PUSHJ P,DLCSUB
; (Return)
;
; On return:
; A1/ Offset into the information area in CND
; T1/ Byte pointer
; P3/ Byte information
DLCSUB: MOVE T1,CH ; Copy the character
IDIVX T1,$CNBPW ; Convert this into a word/offset
ADD T1,T3 ; Compute of address
ADDX T1,$CNBYT ; Point to the byte information
TDO T1,CNBTAB(T2) ; Make a byte pointer
LDB P3,T1 ; Get the byte of information
TXNN P3,CB$DEF ; Is this byte defined?
ERROR E.DUS ; ++Attempt to delete undefined string
SETZ A1, ; Clear this
DPB A1,T1 ; Zero the byte
; Here if the item in the byte table is defined. Determine if we have an
; execute or a transition to another state.
MOVE A1,P3 ; Get a copy of the index
ANDX A1,CB$IDX ; Just the index
IMULX A1,$CILEN ; Compute the offset
ADDX A1,$CNINF ; . . .
POPJ P, ; Return to the caller
; Here to handle the plus operator.
DLCS.P: PUSHJ P,DLCPLS ; Call the worker subroutine
; Here at the end of this command node for the plus processing.
POPTPT (P4) ; Get the address of the next CND from
; the stack
MOVE T3,P2 ; Get the number of characters
SUBI T3,1 ; Back it up one
MOVE T1,P1 ; Get the offset
ADDX T1,BRLEN$ ; Point to the next item
MOVE T2,P4 ; Get the transition CND
PUSHJ P,DELCST ; Delete the next CST
PUSHJ P,DLCDEL ; Make this go away
JRST DLCS.E ; Exit via the normal exit
;DLCPLS
;This is a subroutine to do most of the work for removing the pointers in the
;loop for this node. This subroutine is used for plus and star since a major
;part of the DFA is the same for these two items.
DLCPLS: SETZ P4, ; Clear the first time flag
DLCS.R: MOVE T1,P1 ; Get a copy of the offset
LOAD. T2,TPTADR,+CSTTPT ; Get the command node offset
PUSHJ P,NXTCHR ; Get the next character
SKIPA ; Got the character, continue on
POPJ P, ; Finished, just return to the caller
MOVE T3,DLCADR ; Get the address of the CND
LOAD. T3,TPTADR,(T3) ; Get the address of the CND
PUSHJ P,DLCSUB ; Process the subroutine
TXNE P3,CB$XCT ; Is this an execute?
ERROR E.DUS ; Yes, error
MOVE T4,DLCADR ; Get the address
LOAD. T1,TPTADR,(T4) ; Of the TPT for the CND
ADD T1,A1 ; Point to the information
LOAD. T1,TPTADR,+$CITRN(T1) ; Get the address of the item
JUMPN P4,DLCS.O ; Have we done this already?
PSHTPT (SVDTPT,T1) ; No, save the TPT on the stack
SETO P4, ; Flag we have done this already
DLCS.O: MOVE T1,DLCADR ; Get the address of the TPT for the CND
LOAD. T1,TPTADR,(T1) ; Get the address of the CND
MOVE T2,P3 ; Get the byte
PUSHJ P,CHKOTH ; Other users?
SKIPA ; No, Continue processing
JRST DLCS.N ; Not yet, so skip this one
MOVE T1,DLCADR ; Get the address of the TPT again
LOAD. T1,TPTADR,(T1) ; Get the address of the CND
ADDI T1,$CITRN(A1) ; Point to the information
PUSHJ P,M$RELB ; Release this pointer
MOVE T1,DLCADR ; Get the address of the TPT for the CND
LOAD. T1,TPTADR,(T1) ; Get the CND address
MOVE T2,P3 ; Get the byte
ANDX T2,CB$IDX ; Just the index
PUSHJ P,RETBYT ; Return this byte
DLCS.N: LOAD. T3,TPTADR,+SVDTPT ; Get the item on the stack
PUSHJ P,DLCSUB ; Calculate the offset here too
LOAD. T2,TPTADR,+SVDTPT ; Get the CND address again
MOVE T1,A1 ; Get a copy
ADD T1,T2 ; Point to the information
LOAD. T1,TPTADR,+$CITRN(T1) ; Get the address
CAME T1,T2 ; This better point to inself
ERROR E.DUS ; Problem
MOVE T2,P3 ; Get the index
PUSHJ P,CHKOTH ; Other users?
SKIPA ; No, continue processing
AOJA CH,DLCS.R ; Yes, Advance to the next character
LOAD. T1,TPTADR,+SVDTPT ; Get the CND address again
ADDI T1,$CITRN(A1) ; Point to the byte
PUSHJ P,M$RELB ; Release this pointer too
LOAD. T1,TPTADR,+SVDTPT ; Get the address of the CND again
MOVE T2,P3 ; Get the information byte again
ANDX T2,CB$IDX ; Just the index
PUSHJ P,RETBYT ; Return this byte to the free pool
AOJA CH,DLCS.R ; Loop for the next character
SUBTTL FC command -- Subroutines -- SETCTY
;+
;.hl2 SETCTY
; This routine will set the command type and character string info for
;all commands which were just inserted using INSCST. It will do this
;by searching all of the command nodes for the CTB for execute entries
;with negative character addresses.
;.lit
;
; Usage:
; T1/ Command type
; T2/ Character address
; T3/ Length of command
; PUSHJ P,SETCTY
; (return)
;
;.end lit
;-
SETCTY: $SAVE <P1,P2,P3,P4> ; Save a few registers
DMOVE P1,T1 ; Copy the arguments over
MOVE P3,T3 ; . . .
; Get the address of the first CND, so that we can loop on each CND.
MOVE T1,RPLTPT ; Get the address of the TPT
LOAD. T1,TPTADR,(T1) ; Get the address of the CTB
LOAD. P4,LNKNXT,+$CTCND(T1) ; Get the address of the first CND
; Here to loop over the CND to determine if there are any items that need
; fixing in this CND
SCND.1: MOVEI T4,^D128 ; Get the total number of bytes
XMOVEI T3,$CNBYT(P4) ; Get the address of the byts
TXO T3,<POINT 9> ; Make this a byte pointer to it
SCND.2: ILDB T2,T3 ; Get this byte
TXNE T2,CB$DEF ; Is this defined?
TXNE T2,CB$TRN ; Is this an execute?
JRST SCND.3 ; No, Skip it
; Here if we know that we have an execution byte. The offset is the only
; thing that is left in T2 at this point, so now point to the information.
ANDX T2,CB$IDX ; Keep only the index
IMULX T2,$CILEN ; Mult by the length of each entry
ADD T2,P4 ; Point to the information
CFXE. T1,CINCAD,+$CNINF(T2),-1 ; Is this -1?
JRST SCND.3 ; No, Skip it
; Here if we have an item to update.
STOR. P1,CINCTY,+$CNINF(T2) ; Store command type
STOR. P2,CINCAD,+$CNINF(T2) ; Store the character address
STOR. P3,CINCLN,+$CNINF(T2) ; Store the character length
; Here to advance to the next information byte in the CND
SCND.3: SOJG T4,SCND.2 ; Loop for all of the bytes in the CND
; Here to advance to the next CND in this CTB.
LOAD. P4,LNKNXT,+$CNCND(P4) ; Get the address of the next CND
JUMPN P4,SCND.1 ; Have one, process the information
POPJ P, ; Return from the routine call
SUBTTL FC command -- Subroutines -- DLCMST
;+
;.hl2 DLCMST
; This routine will delete a command string from the CTB's text buffer.
;It will only delete the string if it is no longer in use.
;.lit
;
; Usage:
; T1/ CTB address
; T2/ Character address of string
; T3/ Length of string
; PUSHJ P,DLCMST
; (return)
;
;.end lit
; This routine will search the CND's to see if the string is still in use,
;and if not it will delete the string and fix up all the character addresses
;in the CND's to reflect the fact.
;-
DLCMST: $SAVE <P1,P2,P3,P4> ; Save a few registers
DMOVE P1,T1 ; Copy the arguments over
MOVE P3,T3 ; . . .
; Get the address of the first CND, so that we can loop on each CND.
LOAD. P4,LNKNXT,+$CTCND(P1) ; Get the address of the first CND
IFN FTDEBUG,<
SKIPN P4 ; Make sure we have a CND
STOPCD LAC,<Lost a CND> ; No, Lost it!
>; End of IFN FTDEBUG
; Here to loop over the CND to determine if there are any items that need
; fixing in this CND
DLCM.1: MOVEI T4,^D128 ; Get the total number of bytes
XMOVEI T3,$CNBYT(P4) ; Get the address of the byts
TXO T3,<POINT 9> ; Make this a byte pointer to it
DLCM.2: ILDB T2,T3 ; Get this byte
TXNE T2,CB$DEF ; Is this defined?
TXNE T2,CB$TRN ; Is this an execute?
JRST DLCM.3 ; No, Skip it
; Here if we know that we have an execution byte. The offset is the only
; thing that is left in T2 at this point, so now point to the information.
ANDX T2,CB$IDX ; Keep only the index
IMULX T2,$CILEN ; Mult by the length of each entry
ADD T2,P4 ; Point to the information
CFMN. T1,CINCAD,+$CNINF(T2),P2 ; Is this the one
POPJ P, ; Return there is another copy
; Here to advance to the next information byte in the CND
DLCM.3: SOJG T4,DLCM.2 ; Loop for all of the bytes in the CND
; Here to advance to the next CND in this CTB.
LOAD. P4,LNKNXT,+$CNCND(P4) ; Get the address of the next CND
JUMPN P4,DLCM.1 ; Have one, process the information
; Here if there are no more CNDs and the only reference to the text is going
; away. The only logical thing to do is to delete the text from the text
; block and fix up all the pointers to the text.
MOVE T2,P3 ; Get the number of characters
MOVE T3,P2 ; And the offset to the information
LOAD. T1,TPTADR,+$CTTPT(P1) ; Get the text buffer addrss
PUSHJ P,M$SRNK ; Shrink the text buffer
; Now fix up the items, so that we can modify the information
MOVN P3,P3 ; Make this minus, so we can just add
; First fix up the OTHER and ALWAYS options if necessary.
MOVX T1,CT$ALF ; Check for the ALWAYS option
TDNN T1,$CTFLG(P1) ; Is there one?
JRST DLCM.7 ; No, skip it
CFXN. T1,CTBALW,(P1),-1 ; Is this currently being processed?
JRST DLCM.7 ; Yes, skip it
CFML. ,CTBALW,(P1),P2 ; Need fixing?
ADDM P3,$CTALW(P1) ; Yes, do so
DLCM.7: MOVX T1,CT$OTF ; Other option?
TDNN T1,$CTFLG(P1) ; . . .
JRST DLCM.8 ; No, skip this
CFXN. T1,CTBOTH,(P1),-1 ; Currently being done?
JRST DLCM.8 ; Yes, skip it
CFML. ,CTBOTH,(P1),P2 ; Does it need fixing?
ADDM P3,$CTOTH(P1) ; Yes, fix it
; Get the address of the first CND, so that we can loop on each CND.
DLCM.8: LOAD. P4,LNKNXT,+$CTCND(P1) ; Get the address of the first CND
; Here to loop over the CND to determine if there are any items that need
; fixing in this CND
DLCM.4: MOVEI T4,^D128 ; Get the total number of bytes
XMOVEI T3,$CNBYT(P4) ; Get the address of the byts
TXO T3,<POINT 9> ; Make this a byte pointer to it
DLCM.5: ILDB T2,T3 ; Get this byte
TXNE T2,CB$DEF ; Is this defined?
TXNE T2,CB$TRN ; Is this an execute?
JRST DLCM.6 ; No, Skip it
PUSHJ P,DLCM.S ; Check to see if we already did this byte
JRST DLCM.6 ; Already processed
ANDX T2,CB$IDX ; Keep only the index
; Here if we know that we have an execution byte. The offset is the only
; thing that is left in T2 at this point, so now point to the information.
IMULX T2,$CILEN ; Mult by the length of each entry
ADD T2,P4 ; Point to the information
CFXN. T1,CINCAD,+$CNINF(T2),-1 ; Is this just being created?
JRST DLCM.6 ; Yes, skip it
CFML. ,CINCAD,+$CNINF(T2),P2 ; Is this the one
ADDM P3,$CICAD+$CNINF(T2) ; Update the new address
; Here to advance to the next information byte in the CND
DLCM.6: SOJG T4,DLCM.5 ; Loop for all of the bytes in the CND
LOAD. P4,LNKNXT,+$CNCND(P4) ; Advance to the next CND
JUMPN P4,DLCM.4 ; And go process it if there is one
POPJ P, ; Return to the caller
; Subroutine to check to determine if we have processed this byte of
; information already.
;
; Usage:
; T2/ Index
; T3/ Byte pointer to check against
; P4/ CND Address
; PUSHJ P,DLCM.S
; (Return - Used already)
; (Return - Not used)
DLCM.S: $SAVE <P1,P2,P3> ; Save a few registers
MOVEI P1,^D128 ; Get the max number of times to loop
XMOVEI P2,$CNBYT(P4) ; Point at the information
TXO P2,<POINT 9> ; Build the full byte pointer
DLCM.T: ILDB P3,P2 ; Get a byte of information
TXNE P3,CB$DEF ; Is this one defined?
TXNE P3,CB$TRN ; Is this an execute?
JRST DLCM.U ; No, Skip this also
CAMN P2,T3 ; Is this the same byte pointer
JRST .POPJ1 ; Yes, just return
CAIN P3,(T2) ; Is this the same byte of information?
POPJ P, ; Yes, already used, just return
DLCM.U: SOJG P1,DLCM.T ; Loop for all the bytes
STOPCD (ROB,<Ran out of bytes of information>)
SUBTTL FC command -- Subroutines -- CHKOTH - Check for an index
;+
;.HL2 CHKOTH
; This routine will check for another occurance of an information index
;in a given CND.
;.lit
;
; Usage:
; T1/ CND address
; T2/ Index to search for
; CH/ Character which is known to have this index
; PUSHJ P,CHKOTH
; (return, no other users of same index)
; (Other user return)
;
;.end lit
;-
CHKOTH: SETZ T3, ; Must start with a null
ADDX T1,$CNBYT ; Point to the bytes
TXO T1,<POINT 9> ; Make a 9-bit pointer
COTH.1: CAXL T3,^D128 ; Still in valid characters?
POPJ P, ; None left, give no other user return
ILDB T4,T1 ; Yes, get the next value
CAME T3,CH ; Same as current character?
CAME T4,T2 ; Same info?
AOJA T3,COTH.1 ; No, try next character
PJRST .POPJ1 ; Give other user return
SUBTTL FC command -- Subroutines -- NXTCHR - Get the next character
;+
;.hl1 NXTCHR
;This routine will get the next character from the four word bit mask words.
;.literal
;
; Usage:
;
; CH/ Last character
; T1/ overall offset
; T2/ Block address
; PUSHJ P,NXTCHR
; (Success return)
; (Failure return)
;
; On a failure return:
; - No more character
;
; On a true return:
; CH/ Character
;
;.end literal
;-
NXTCHR: CAIL CH,^D128 ; Within range?
JRST .POPJ1 ; No, Fail
$SAVE <P1,P2> ; Save a register
DMOVE P1,T1 ; Get the arguments
NXTC.1: MOVE T1,CH ; Get the character
IDIVX T1,BRBPW$ ; Get the word/bit offset
ADD T1,P1 ; Get the overall offset
ADD T1,P2 ; Get the address of the correct word
MOVN T2,T2 ; Get the amount to shift the bit
SKIPE T3,T2 ; If first character of word, we don't want any bits
MOVX T3,1B0 ; Get a bit
ASH T3,1(T2) ; Shift the bit over to just before this character
TXO T3,<MASK.(<^D36-BRBPW$>,^D35)> ; Clear out extra bits
ANDCA T3,(T1) ; Get the bits from this character on
JFFO T3,NXTC.2 ; Have any on in this word?
; Here if none left in this word. We will advance to the next word.
ADDX T2,BRBPW$ ; Get the number of characters we are skipping
ADD CH,T2 ; . . .
NXTC.3: CAIGE CH,^D128 ; Hit the end of the character set?
JRST NXTC.1 ; No, try again
JRST .POPJ1 ; Give a failure return to the caller
; Here if we have the character, just return
NXTC.2: ADD T2,T4 ; Get the offset from the current character
ADD CH,T2 ; And fix the character value
POPJ P, ; Just return
SUBTTL FC command -- Subroutines -- PRSCHR - Parse a single character
;+
;.hl2 PRSCHR
;This routine will parse a single character or octal equivalent. It will
;only allow a single quoted character or an octal number.
;.literal
;
; Usage:
; PUSHJ P,PRSCHR
; (return)
;
; On return:
; T1/ Value of the character
;
;.end literal
;-
PRSCHR: PUSHJ P,FCCHR ; Get a character
ERROR E.BFC ; Bad FC command
CAXE CH,"""" ; Is this a single character?
JRST PCHR.1 ; No, skip this then
PUSHJ P,FCCHR ; Get the next character
ERROR E.BFC ; Bad FC command
MOVE T1,CH ; Save the character in a safe place
CAXE CH,"""" ; Is this another quote?
JRST PCHR.2 ; No, must be the character
PUSHJ P,IFCCHR ; Get the next character
CAXE CH,"""" ; Correctly quoted?
ERROR E.BFC ; No, Bad command
PCHR.2: PUSHJ P,IFCCHR ; Get the last character
CAXE CH,"""" ; Better be
ERROR E.BFC ; No, very bad
PJRST IFCCHR ; Get the next character and return
; Here if we may have an octal number. Just re-eat the character and
; call the octal number input routine.
PCHR.1: CAIL CH,"0" ; Is this an octal number?
CAILE CH,"7" ; . . .
ERROR E.BFC ; No, bad
PUSHJ P,FCREAT ; Back up the character
PJRST .IOCTW ; Input the octal number
SUBTTL FC command -- Subroutines -- CLRCHM and SETCHM
;+
;.hl2 CLRCHM and SETCHM
; This routines will clear out the character mask and set bits for characters.
;-
CLRCHM: SETZM CHRMSK ; Clear out the break set
MOVE T1,[XWD CHRMSK,CHRMSK+1] ; . . .
BLT T1,CHRMSK+BRLEN$-1 ; . . .
POPJ P, ; Return
SETCHM: IDIVX T1,BRBPW$ ; Get the word offset
MOVN T2,T2 ; And amount to shift the bit
MOVX T3,1B0 ; Get the bit
LSH T3,(T2) ; Shift it
IORM T3,CHRMSK(T1) ; Flag that this character is here
POPJ P, ; And return
SUBTTL FC command -- Subroutines -- ALCBYT - Allocate a byte index
;+
;.hl2 ALCBYT
;This routine will allocate a byte index in the byte table of a CND.
;.LITERAL
;
; Usage:
; T1/ CND table address
; PUSHJ P,ALCBYT
; (Return)
;
; On return:
; T1/ Byte index
; - Bit table set to denote byte allocated
;
;.end lteral
;This routine will stopcode if the table is completely allocated.
;-
ALCBYT: $SAVE <P1> ; Save P1
MOVE P1,T1 ; And remember the address of the CND
SETZ T4, ; Clear the word counter
ADDX T1,$CNBTS ; Point to the bits word
ALCB.0: SETCM T2,(T1) ; Any bits set in this word?
JFFO T2,ALCB.1 ; Get the first bit that is one
ADDX T4,^D36 ; Account for the number if bits per wd
IFN FTDEBUG,<
CAIL T4,<3*^D36> ; Too far?
STOPCD BCT,<Byte count too big> ; Yes, complain
>; End of IFN FTDEBUG
AOJA T1,ALCB.0 ; Loop to the next word
; Here when we have found a bit that is off.
ALCB.1: MOVX T2,1B0 ; Get the item to shift
MOVN T3,T3 ; Get the amount to shift
LSH T2,(T3) ; Move it over
IORM T2,(T1) ; Set the bit so we know it is being
; used
MOVM T3,T3 ; Make the index positive again
ADD T3,T4 ; Get the bit number
MOVE T1,T3 ; Move into the right place
IMULX T3,$CILEN ; Determine the offset to the info
ADDX T3,$CNINF+$CILEN ; Plus the base offset
CFML. T2,CNDEND,(P1),T3 ; Do we have enough room?
POPJ P, ; Yes, all is well
LOAD. T2,CNDEND,(P1) ; No, get the amount we have
STOR. T3,CNDEND,(P1) ; Set up the new end
SUB T3,T2 ; And see how much more we need
PUSH P,T1 ; No, save the index
MOVE T1,P1 ; Get the address of the block
MOVE T2,T3 ; Get the amount to expand
PUSHJ P,M$APPD ; Append some space to the block
JRST ALCB.2 ; Block has to be moved, go handle it
POP P,T1 ; Get the index back
POPJ P, ; Return the byte number to the caller
; Here if the call to M$APPD gave the 'block moved' return.
ALCB.2: POP P,T4 ; Get the index back
$SAVE <P2,P3,P4> ; Save another register
PUSH P,T4 ; Save for returning later
LOAD. T4,CNDEND,(T1) ; Get the address of the end
STOR. T4,CNDEND,(T3) ; Store it
MOVE P1,T3 ; Copy the new CND address
MOVE P2,T1 ; Get a copy of the old CND address
MOVE T2,T1 ; Get the old address
ADDX T2,$CNBTS ; Get the size
ADDX T3,$CNBTS ; . . .
MOVE T1,T4 ; Copy the length
SUBX T1,$CNBTS ; Minus the header
PUSHJ P,M$MCOR ; Move the memory
MOVEI P3,^D128 ; Get the loop counter
XMOVEI P4,$CNBYT(P2) ; Get the byte information
TXO P4,<POINT 9> ; Build the byte pointer
ALCB.3: ILDB T3,P4 ; Get the byte information
TXNN T3,CB$DEF ; Is this defined?
JRST ALCB.4 ; No, Skip this
SETZ T1, ; Clear out the byte
DPB T1,P4 ; . . .
TXNN T3,CB$TRN ; Is this a transition?
JRST ALCB.4 ; Yes, This is an execute.
; Here to move the TPT pointers to the new information.
ANDX T3,CB$IDX ; Keep only the index
IMULX T3,$CILEN ; Compute the offset
ADDX T3,$CNINF ; Add in the offset to the data
MOVE T2,T3 ; Copy the offset
PUSH P,T3 ; Save the offset
ADD T3,P2 ; Add in the address of the old block
ADD T2,P1 ; Add this in for the address
LOAD. T1,TPTADR,+$CITRN(T3) ; Get the address
JUMPE T1,[POP P,(P) ; If we already did this, remove the item
JRST ALCB.4] ; And get the character
IFN FTDEBUG,<
SETZM $TPADR+$CITRN(T2) ; Clear this
>; End of IFN FTDEBUG
IFN $CITRN,<ADDX T2,$CITRN> ; Point to the information
PUSHJ P,M$USEB ; Make this block used
POP P,T1 ; Restore the offset
ADD T1,P2 ; Point to the old pointer
IFN $CITRN,<ADDX T1,$CITRN> ; Point to the information
PUSHJ P,M$RELB ; Release this pointer
ALCB.4: SOJG P3,ALCB.3 ; Loop back
MOVE T1,P2 ; Get the address of the old CND
LOAD. P2,LNKPRV,+$CNCND(P2) ; Get the previous block address
MOVX T2,$CNCND ; Get the offset
PUSHJ P,M$ULNK ; Unlink the block
MOVE T1,P1 ; Get the new block address
MOVX T2,$CNCND ; Get the offset
MOVE T3,P2 ; Get the previous block address
PUSHJ P,M$LINK ; Link the block in
PJRST .T1PJ ; Restore the index and return
SUBTTL FC command -- Subroutines -- RETBYT - Deallocate a byte index
;+
;.hl2 RETBYT
;This routine will deallocate a byte index in the byte table of a CND.
;.literal
;
; Usage:
; T1/ CND table ADdress
; T2/ Byte index
; PUSHJ P,RETBYT
; (Return)
;
; On return:
; - Bit table updated.
;
;.end literal
;This routine will stopcode if the byte is already deallocated.
;-
RETBYT: $SAVE <P1,P2> ; Save some ac's
DMOVE P1,T1 ; Get the args
IDIVX T2,^D36 ; Determine the bit and word
ADDI T1,$CNBTS(T2) ; Compute the offset to the right word
MOVX T2,1B0 ; Get the bit to move to form the mask
MOVN T3,T3 ; Negate it to get shift amount
LSH T2,(T3) ; Move it over
IFN FTDEBUG,<
TDNN T2,(T1) ; Bit already clear?
STOPCD BAZ,<Bit already zero> ; Yes, die
>; End of IFN FTDEBUG
ANDCAM T2,(T1) ; Set the bit on the word
MOVE T2,P2 ; Get the index
IMULX T2,$CILEN ; Get the offset in words
ADDX T2,$CNINF ; . . .
CFMLE. T3,CNDEND,(P1),T2 ; Is this the last info words being freed?
POPJ P, ; No, just return
IFN FTDEBUG,<
CFME. T3,CNDEND,(P1),T2 ; Better not be too large
STOPCD CEM,<CNDEND messed up>
> ; End of IFN FTDEBUG
SUBX T2,$CILEN ; We are freeing this many words
STOR. T2,CNDEND,(P1) ; Set the END correct
LOAD. T3,BLKFRW,(P1) ; Get the number of free words
ADDX T3,$CILEN ; Increase by the same amount
STOR. T3,BLKFRW,(P1) ; Store it back
POPJ P, ; Return to the caller
SUBTTL FC command -- Subroutines -- RETCND - Return a CND tree
;+
;.hl2 RETCND
; This routine is used to return a CND and all CND's which are subordinate
;to it. It will return the trees from the bottom up.
;.lit
;
; Usage:
; T1/ Address of CND to return
; PUSHJ P,RETCND
; (return here always)
;
; On return:
; - CNDs returned
;
;.end lit
;-
RETCND: $SAVE <P1,P2,P3> ; Save a few registers
STKTPT (T1,RTCTPT) ; Save the address of this TPT
MOVX T2,$CNCND ; Get the LNK offset
PUSHJ P,M$ULNK ; Unlink this block from the chain
LOAD. P1,TPTADR,+RTCTPT ; Get the address of the CND back again
ADDX P1,$CNBYT ; Point to the byte information
TXO P1,<POINT 9> ; Make this a byte pointer
MOVEI P2,^D128 ; Get the loop counter
RETC.0: ILDB T3,P1 ; Get the byte of information
TXNE T3,CB$DEF ; Is this defined?
TXNN T3,CB$TRN ; Is it a transition?
JRST RETC.1 ; Yes, Skip this too
; Here if we have a transfer to another block. Determine if this is the
; same as the block that we are processing.
ANDX T3,CB$IDX ; Keep only the index
IMULX T3,$CILEN ; Compute the offset
ADDX T3,$CNINF ; Point to the information
PUSH P,T3 ; Save a copy of this
LOAD. T2,TPTADR,+RTCTPT ; Get the address of this block
ADD T3,T2 ; Point to it
LOAD. T1,TPTADR,+$CITRN(T3) ; Is this the information?
JUMPE T1,[POP P,(P) ; Remove the information if we returned
; this TPT already (more than one
; pointer to this CND from itself).
JRST RETC.1] ; Advance to the next byte
CAMN T1,T2 ; Same block?
JRST RETC.2 ; No, Skip this
SUB P1,T2 ; Make this a relative address
PUSHJ P,RETCND ; Call me
LOAD. T2,TPTADR,+RTCTPT ; Get the address again
ADD P1,T2 ; Make the byte pointer absolute
RETC.2: POP P,T1 ; Restore this
ADD T1,T2 ; Point at the TPT to release
PUSHJ P,M$RELB ; Release the block
; Here to advance to the next item in the block
RETC.1: SOJG P2,RETC.0 ; Loop for all bytes
POPJ P, ; . . .
SUBTTL FC command -- Subroutines -- DUPCND - Duplicate a CND tree
;+
;.hl2 DUPCND
; This routine is used to make a duplicate of a CND and all subordinate
;CND's. It will copy the CND's starting from the bottom up.
;.lit
;
; Usage:
; T1/ Address of CTB this CND hangs off of
; T2/ Address of CND to copy
; PUSHJ P,DUPCND
; (return here)
;
; On return:
; T1/ New CND address
;
;.end lit
;-
DUPCND: PUSH P,T2 ; Save the CND address
PUSHJ P,CLRMRK ; Clear all the mark bits
POP P,T1 ; Get the address of the CND back
STKTPS(<<T1,DUPTPT>>)
PUSHJ P,DUCN.0 ; Mark the CND's which need copying
LOAD. T1,TPTADR,+DUPTPT ; Get the address of the CND again
PUSHJ P,M$CPCN ; And copy the graph
POPJ P, ; And return
DUCN.0: MOVX T2,CN$MRK ; Get the mark flag
TDNE T2,$CNFLG(T1) ; Is this one already marked?
POPJ P, ; Yes, all done with it
IORM T2,$CNFLG(T1) ; Flag that we have been here
$SAVE <P1,P2> ; Save some ac's
MOVE P2,T1 ; Get the address of the CND
; Now set up the loop to copy the information words
SETZ P1, ; Start at the first character
XMOVEI T1,$CNBYT(P2) ; Get the CND address
TXO T1,<POINT 9,> ; . . .
DUCN.1: CAXL P1,^D128 ; Done yet?
POPJ P, ; Yes, return now
ILDB T2,T1 ; Get the info for this character
TXNN T2,CB$DEF ; Defined?
AOJA P1,DUCN.1 ; No, try next character
PUSH P,T2 ; Save the info
ANDX T2,CB$IDX ; Save only the index
IMULX T2,$CILEN ; Get the offset
ADDX T2,$CNINF ; . . .
MOVE T3,P2 ; Get the CND address
ADD T3,T2 ; Make the address of the block
POP P,T2 ; Get the info back
TXNE T2,CB$TRN ; Transition?
JRST DUCN.2 ; No, go handle the transfer
AOJA P1,DUCN.1 ; Try the next character
; Here on a transfer function.
DUCN.2: LOAD. T1,TPTADR,+$CITRN(T3) ; Get the address of the old block
PUSHJ P,DUCN.0 ; Mark its sub-graph
; Now reset the byte pointer
MOVE T1,P1 ; Get the current character
IDIVX T1,$CNBPW ; Split into word and byte offset
ADDX T1,$CNBYT ; . . .
ADD T1,P2 ; Get the byte address
TDO T1,CNBTAB(T2) ; And make the byte pointer
AOJA P1,DUCN.1 ; Try the next character
SUBTTL FC command -- Subroutines -- CLRMRK - Clear all mark bits
;+
;.hl2 CLRMRK
; This routine will clear the mark bit for all CND's hanging off of a given
;CTB.
;.lit
;
; Usage:
; T1/ Address of CTB
; PUSHJ P,CLRMRK
; (return here always)
;
;.end lit
;-
CLRMRK: LOAD. T1,LNKNXT,+$CTCND(T1) ; Get the address of the first CND in the list
MOVX T2,CN$MRK ; Get the bit to clear
CMRK.1: ANDCAM T2,$CNFLG(T1) ; Turn off the bits
LOAD. T1,LNKNXT,+$CNCND(T1) ; Advance to the next CND
JUMPN T1,CMRK.1 ; And go process it if there is one
POPJ P, ; All done
SUBTTL FC command -- Subroutines -- FCCHR - Input a character
;+
;.hl2 FCCHR
;This routine will input a character from the Q-register that is being
;processed.
;-
IFCCHR: $SAVE <T1,T2> ; Save some room
PUSHJ P,FCCHR ; Get a character
SETO CH, ; Flag nothing left
POPJ P, ; And give non-skip return
FCCHR: SETZ CH, ; Clear the character
EXCH CH,FCLCHR ; And get the saved one if any
JUMPN CH,.POPJ1 ; Return if something there
LOAD. T1,TPTADR,+FCTPT ; Get the address of the buffer
PUSHJ P,GETINC ; Get the next character from the buffer
POPJ P, ; Pass along the failure
JRST .POPJ1 ; Give a good return
FCREAT:
IFN FTDEBUG,<
SKIPE FCLCHR ; Already have a character saved?
STOPCD FR2,<FCREAT called twice in a row>
> ; End of IFN FTDEBUG
MOVEM CH,FCLCHR ; Save the last character
POPJ P, ; And return
; Routine to get a significant character from the FC buffer. It will
;skip all spaces, tabs, and end of line characters.
SIGFCH: PUSHJ P,FCCHR ; Get a character
POPJ P, ; None left
CAXN CH,"!" ; Start of a comment?
JRST SFCH.1 ; Yes, go skip it
CAXE CH,.CHTAB ; Is it a tab?
CAXN CH," " ; Or a space?
JRST SIGFCH ; Yes, skip it
CAXE CH,.CHCRT ; Carriage return?
CAXN CH,.CHLFD ; Or line feed?
JRST SIGFCH ; Yes, skip them
CAXE CH,.CHVTB ; Vertical tab?
CAXN CH,.CHFFD ; Or form feed?
JRST SIGFCH ; Yes, try again
PJRST .POPJ1 ; Got a good character, all done
; Here to skip a comment
SFCH.1: PUSHJ P,FCCHR ; Get a character
POPJ P, ; Nothing left?
CAXE CH,"!" ; End of the comment?
JRST SFCH.1 ; No, try again
JRST SIGFCH ; Go try again
SUBTTL Immediate command processing -- I$PRSC
;+
;.hl1 I$PRSC
; This routine will parse an immediate command. It will fetch characters
;up to the point where it is determined that either the characters are a
;given command, or cannot possibly be a command.
;.lit
;
; Usage:
; T1/ Address of routine to fetch a character
; PUSHJ P,I$PRSC
; (Immediate command found and executed return)
; (No immediate command found return)
;
; On the no immediate command found return:
;
; T1/ Address of buffer containing text which was read, but
; is not an immediate command
;
;.end lit
;-
I$PRSC: LOAD. T3,LNKNXT,+CURCTB ; Get the CTB address
JUMPE T3,[SETZ T1, ; No, clear the pointer
PJRST .POPJ1] ; And give the no command return
JRST IPRS.0 ; Join common routine
; Here on a recursive call. Save some items that upper level is using.
IPRS.R: $SAVE <IPRSGC,IPRSGC+1> ; Save the character fetch routine
IPRS.0: DMOVEM T1,IPRSGC ; Save the get a character routine
$SAVE <P1> ; Save a word to count in
SETZ P1, ; Clear the counter
STKTPS (<<,IPRTPT>,<T3,IPRCTB>,<,CURCND>>) ; And allocate a pointer to the current CND
MOVEI T1,5 ; Get some space for some characters
PUSHJ P,M$GTXT ; Get a buffer
XMOVEI T2,IPRTPT ; Get the address of the pointer
PUSHJ P,M$USEB ; And set it up
LOAD. T1,TPTADR,+IPRCTB ; Get the address of the current CTB
LOAD. T1,TPTADR,+$CTCMD(T1) ; And get the address of the first CND
XMOVEI T2,CURCND ; Get the address of the pointer
PUSHJ P,M$USEB ; Set up the pointer
IPRS.1: AOS T1,P1 ; Get the character to get
PUSHJ P,@IPRSGC ; Get a character
XMOVEI T1,IPRTPT ; Get the address of the TPT
PUSHJ P,M$ACHR ; And append the character to the buffer
MOVE T1,CH ; Get a copy of the character
IDIVX T1,$CNBPW ; Get the change into word/byte index
TDO T1,CNBTAB(T2) ; Set up the byte pointer
LOAD. T4,TPTADR,+CURCND ; Get the address of the CND
ADD T1,T4 ; Make the pointer
ADDX T1,$CNBYT ; Point to the byte info
LDB T2,T1 ; Get the byte
TXNN T2,CB$DEF ; This character valid?
JRST IPRS.N ; No, go check overlaid tables, etc.
TXNN T2,CB$TRN ; Is this an execute or a transfer?
JRST IPRS.X ; Execute, go handle it
ANDX T2,CB$IDX ; Keep only the index
IMULX T2,$CILEN ; Get the offset to the info for this character
ADD T2,T4 ; Get the address
LOAD. T2,TPTADR,+$CNINF+$CITRN(T2) ; Get the next CND address
PUSH P,T2 ; Save it for a moment
XMOVEI T1,CURCND ; Get the current CND pointer
PUSHJ P,M$RELB ; Release it
POP P,T1 ; Get the next CND address back
XMOVEI T2,CURCND ; And the address of the pointer
PUSHJ P,M$USEB ; Set up the pointer again
JRST IPRS.1 ; And go get the next character
; Here if we have found a string that is valid in the table.
;Dispatch on the command type to determine what to do with the command
;string information.
IPRS.X: ANDX T2,CB$IDX ; Keep only the index
IMULX T2,$CILEN ; Get the offset
ADD T2,T4 ; And the address
LOAD. T1,CINCTY,+$CNINF(T2) ; Get the command type
LOAD. T3,CINCLN,+$CNINF(T2) ; And the length
LOAD. T2,CINCAD,+$CNINF(T2) ; And character address
IPRS.Q: LOAD. T4,TPTADR,+IPRTPT ; Get the address of the buffer
PUSH P,T1 ; Save T1
PUSH P,T2 ; And T2
PUSH P,T3 ; And T3
MOVE T1,T4 ; Get the address of the buffer
LOAD. T2,BLKEND,(T1) ; And the size
SUB T2,P1 ; Get the amount we need to delete
MOVE T3,P1 ; And where to delete it
JUMPE T2,.+2 ; Need to delete something?
PUSHJ P,M$SRNK ; Yes, do it
MOVE T1,P1 ; Get the amount to skip in the input stream
PUSHJ P,@IPRSGC+1 ; Skip them
POP P,T3 ; Restore the command arguments
POP P,T2 ; . . .
POP P,T1 ; . . .
PUSHJ P,@IPRTBL(T1) ; And go handle it
LOAD. T4,TPTADR,+IPRCTB ; Get the address of the CTB
MOVX T2,CT$ALF ; Check if an always was given
TDNN T2,$CTFLG(T4) ; . . .
POPJ P, ; No, all done
LOAD. T3,CTBALN,(T4) ; Get the length of the command
LOAD. T2,CTBALW,(T4) ; Get the character address
LOAD. T1,CTBATY,(T4) ; Get the command type
PJRST @IPRTBL(T1) ; Go handle the always string
TABDEF IPR,$CT,<IFIW IPRSTP> ; Generate the table
TABENT TEC,<IFIW IPRS.T> ; TECO commands
TABENT BAS,<IFIW IPRS.B> ; Base level commands
TABENT PRV,<IFIW IPRS.P> ; Previous level command
TABENT IMD,<IFIW IPRS.I> ; Current CTB
TABEND
IPRSTP: STOPCD IPR,<Command type not yet handled in I$PRSC>
; Here when the text is to be interpreted as normal TECO commands.
IPRS.T: $SAVE <P1,P2,CMDSVP> ; Save some ac's
DMOVE P1,T2 ; Get the command address and length
XMOVEI T1,LSTCMD ; Get the pointer to the previous command
SKIPE $TPADR(T1) ; Is there one?
PUSHJ P,M$RELB ; Yes, release it
XMOVEI T1,CURCND ; Get the CND poiner address
PUSHJ P,M$RELB ; Release it
LOAD. A1,TPTADR,+IPRTPT ; Get the address of the text
MOVX T1,.TRUE ; Flag that no copy need be done
PUSHJ P,STRRET ; Set up the return
JFCL ; Won't happen
XMOVEI T1,IPRTPT ; Get the address of our pointer
PUSHJ P,M$RELB ; And release it
LOAD. T1,TPTADR,+IPRCTB ; Get the CTB address
LOAD. T1,TPTADR,+$CTTPT(T1) ; Get the address of the text for this command
XMOVEI T2,IPRTPT ; Set up the pointer to it
PUSHJ P,M$USEB ; Set up the pointer
MOVE T1,P2 ; Get the length of the command
PUSHJ P,M$GTXT ; Get a buffer
XMOVEI T2,CURCND ; Get the address of the pointer
PUSHJ P,M$USEB ; Set it up
LOAD. T1,TPTADR,+IPRTPT ; Get the address of the source
MOVE T2,P1 ; Get the character address of the first character
IDIVX T2,5 ; Make up the sorce byte pointer
ADD T1,T2 ; . . .
ADDX T1,.BKTLN ; . . .
TDO T1,BTAB-1(T3) ; . . .
MOVE T2,P2 ; Get the length of the command
LOAD. T3,TPTADR,+CURCND ; Get the address where to put the text
XMOVEI T4,IPRTPT ; And the address of the TPT for the sorce
PUSHJ P,M$INSS ; Insert the string
LOAD. T3,TPTADR,+CURCND ; Get the address of the text
STOR. T1,BLKPT,(T3) ; Store the new pointer
DMOVE T1,[TXTPTR(<>)] ; Make sure it is terminated by two altmodes
SETZ T4, ; String can't move
PUSHJ P,M$INSS ; Add the altmodes
LOAD. P1,TPTADR,+CURCND ; Get the address of the buffer for later
SKIPN INICMD ; Are we comming from command parsing already?
JRST IPRT.1 ; No, don't need to stack the command
$ADJSP XS,$XSMLN ; Make room for the stack items
STOR. F,XSBFLG,(XS) ; Store the flags
TXZ F,F.COLN ; Flag no colon
MOVE T1,ERRPT ; Save the error position
STOR. T1,XSBERA,(XS) ; Store the error address
LOAD. T1,TPTADR,+XCTBUF ; Get the current buffer address
XMOVEI T2,$XSBUF(XS) ; And the buffer address
PUSHJ P,M$USEB ; Set up the pointer
STORI. $XEMAC,T1,XSBTYP,(XS) ; Store the block type
AOS EQM ; Bump the macro level
JRST IPRT.2 ; And go start the command
IPRT.1: TXZ F,F.CCLR ; Clear the flags out
TXZ S,S.CCLR ; Here also
TXO F,F.ARG!F.STR1 ; Flag there is one string argument
XMOVEI T1,XCTBUF ; Get the address of the old command
PUSHJ P,M$RELB ; Release it
IPRT.2: MOVE T1,P1 ; Get the new command buffer
XMOVEI T2,XCTBUF ; And the address of the pointer
PUSHJ P,M$USEB ; Set up the pointer
ZERO. ,BLKPT,(T1) ; Make sure we start from the top
PUSH XS,[EXP $XENOP] ; Store a no-op on the stack
MOVX T1,$CSNRM ; Since we have a command, reset state to normal
MOVEM T1,CMDSTA ; Save it
PUSHJ P,C$XCTI ; Call the routine
PUSHJ P,CLNXS ; Clear up the stack
POP XS,(XS) ; Remove the no-op from the stack
POPJ P, ; Return to the caller
; Here when the test is to be mapped by the base level command table.
;We will set up the arguments and call IPRS.R for the string that the
;user supplied.
IPRS.B: LOAD. T4,TPTADR,+BASTPT ; Get the address of the CTB to use for these commands
PJRST IPRS.A ; And go do them
; Here for PREVIOUS type commands
IPRS.P: LOAD. T4,TPTADR,+IPRCTB ; Get the address of the current CTB
LOAD. T4,LNKNXT,+$CTCTB(T4) ; Get the next CTB
JUMPE T4,[ERROR E.IIC] ; If no next, illegal command
PJRST IPRS.A ; Go process the commands
; Here if we are to map the text through the current table
IPRS.I: LOAD. T4,TPTADR,+IPRCTB ; Get the current CTB
FALL IPRS.A ; And go do it
; Here to do the commands from a given table
IPRS.A: $SAVE <P1,P2,P3,ITPTAD,ICMCTR> ; Save some ac's
DMOVE P1,T2 ; Get the character address and length
MOVE P3,T4 ; Get the CTB address for this string
XMOVEI T1,IPRTPT ; Get the address of the input string
PUSHJ P,M$RELB ; Release it
XMOVEI T1,CURCND ; Get pointer to the CND
PUSHJ P,M$RELB ; Release it
MOVE T1,P3 ; Make CURCND point at the lower level CTB
XMOVEI T2,CURCND ; . . .
PUSHJ P,M$USEB ; . . .
LOAD. T1,TPTADR,+IPRCTB ; Get the address of the CTB
LOAD. T1,TPTADR,+$CTTPT(T1) ; And get the address of the text
XMOVEI T2,IPRTPT ; Get the address of our pointer
MOVEM T2,ITPTAD ; Save the address of the TPT for getting chars
PUSHJ P,M$USEB ; Set it up
LOAD. T2,BLKPT,(T1) ; Get the current position
PUSH P,T2 ; Save it
MOVE T2,P1 ; Get the address of the first character
PUSHJ P,SETINC ; Set up to read the text
JFCL ; Let error processing catch it later
MOVEM P2,ICMCTR ; Save the counter
IPRS.C: XMOVEI T1,IPRGCH ; Get the get a character routine
XMOVEI T2,.POPJ ; Get routine to skip input
LOAD. T3,TPTADR,+CURCND ; And the CTB address
PUSHJ P,IPRS.R ; Parse the rest of the text
JRST .+2 ; All is fine
ERROR E.IIC ; Illegal immediate command table
SKIPLE ICMCTR ; Any characters left?
JRST IPRS.C ; Yes, try again
LOAD. T1,TPTADR,+IPRTPT ; Get the address of the buffer
POP P,.BKPT(T1) ; Restore the pointer
POPJ P, ; And return
; Get a char routine for IPRS.R
IPRGCH: $SAVE <T1,T2,T3,T4> ; Save some ac's
MOVE T1,ITPTAD ; Get the address of the TPT
LOAD. T1,TPTADR,(T1) ; And get the address of the text
SOSL ICMCTR ; Count down the character
PUSHJ P,GETINC ; Get a character
ERROR E.IIC ; Bad command
POPJ P, ; Return
; Here when the text is not a valid immediate command in the current
;table. Check for overlaid tables, and see if valid there. If not,
;check for the OTHER option of the current table.
IPRS.N: LOAD. T4,TPTADR,+IPRCTB ; Get the CTB address
MOVX T1,CT$OTF ; Check if we have an OTHER string
TDNN T1,$CTFLG(T4) ; Is there one?
JRST IPRS.O ; No, try overlaid tables
LOAD. T1,CTBOTY,(T4) ; Yes, get the command type
LOAD. T2,CTBOTH,(T4) ; And the address
LOAD. T3,CTBOLN,(T4) ; And length
MOVEI P1,1 ; Only eat one character
JRST IPRS.Q ; And go process it
IPRS.O: XMOVEI T1,IPRTPT ; Get the address of the pointer
PUSHJ P,M$RELB ; Remove the pointer
PJRST .POPJ1 ; And give the skip return
SUBTTL Tables -- CNBTAB
; The following is a nine bit byte pointer table.
POINT 9,0 ; Before first byte
CNBTAB: POINT 9,0,8 ; First byte
POINT 9,0,17 ; Second byte
POINT 9,0,26 ; Third byte
POINT 9,0,35 ; Fourth byte
SUBTTL Impure data
; The following is the data region for the MVM module
$IMPURE ; Start of the impure area
LOWVER (MVM,3) ; Version number
IMGFLG: BLOCK 1 ; Image mode flag
; FC data area
FCQRG: BLOCK 1 ; Address of QRG for Q-reg being processed
FCTPT: BLOCK 1 ; Pointer to the Q-register being processed
FCLCHR: BLOCK 1 ; Saved character
CSTTPT: BLOCK $TPLEN ; Address of current c-string
CURCTB: BLOCK $LKLEN ; Current command table
STKCTB: BLOCK $LKLEN ; Command table stack
BASTPT: BLOCK $TPLEN ; TPT to the base level command table.
; Items for REPLACE/INSERT/DELETE routines
DLCADR: BLOCK 1 ; Address of the TPT for DELCST
RPLTPT: BLOCK 1 ; Address of TPT of CTB being used for FCINSERT or FCREPLACE
TRMRTN: BLOCK 1 ; Special routine for PRSTRM
FCINSF: BLOCK 1 ; Flag whether insert or replace command
CHRMSK: BLOCK BRLEN$ ; Break set for current character
; For I$PRSC
IPRSGC: BLOCK 2 ; Address of get-a-character routine
INICMD: BLOCK 1 ; Non-zero if command is within command
ICMCTR: BLOCK 1 ; Counter of chars left in this command
ITPTAD: BLOCK 1 ; Address of TPT for IPRGCH
$ENDPS ; End of this PSECT
SUBTTL End of TECMVM
END ; End of TECMVM.MAC