Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/source/tececm.mac
There are 5 other files named tececm.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==1164 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(ECM,<TECO E command processing>) ; Generate the TITLE and other stuff
SUBTTL Table of Contents
;+
;.pag.lit
; Table of Contents for TECECM - E command processing
;
;
; Section Page
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. Misc symbol definitions. . . . . . . . . . . . . . . . 4
; 5. E Commands
; 5.1. Initialization. . . . . . . . . . . . . . . . 5
; 5.2. E. - Switch editing buffers . . . . . . . . . 6
; 5.3. E<(Q-reg) - Type input file name into buffer. 7
; 5.4. E>(Q-reg) - Type output file name into buffer 8
; 5.5. EL
; 5.5.1. LOGCHR . . . . . . . . . . . . . . . 9
; 5.5.2. MAKLOG . . . . . . . . . . . . . . . 10
; 5.6. EE - Write out a save file. . . . . . . . . . 12
; 5.7. EE - Restart code . . . . . . . . . . . . . . 14
; 5.8. EE
; 5.8.1. RST - Restart routine. . . . . . . . 15
; 5.9. EC - Perform a garbege collection . . . . . . 16
; 5.10. EI and EP - Read into a Q-register. . . . . . 17
; 5.11. EQ - Write out Q-register . . . . . . . . . . 20
; 5.12. EG - Exit closing all files & run COMPIL. . . 21
; 5.13. EX
; 5.13.1. Exit closing all files . . . . . . . 22
; 5.13.2. Common routines
; 5.13.2.1. FINI.0. . . . . . . . . . . 23
; 5.13.2.2. CLSFIL. . . . . . . . . . . 24
; 5.13.2.3. FIN.EB. . . . . . . . . . . 25
; 5.14. ED (Run a program on exit). . . . . . . . . . 26
; 5.15. ET - Set type out mode. . . . . . . . . . . . 29
; 5.16. EO. . . . . . . . . . . . . . . . . . . . . . 30
; 5.17. EU command. . . . . . . . . . . . . . . . . . 31
; 5.18. ES. . . . . . . . . . . . . . . . . . . . . . 32
; 5.19. EH - Change error message level . . . . . . . 33
; 5.20. EK - Kill off the output file . . . . . . . . 34
; 5.21. EN - rename the input file. . . . . . . . . . 35
; 5.22. ER - Read a file. . . . . . . . . . . . . . . 36
; 5.23. EB - Edit and backup command. . . . . . . . . 37
; 5.24. EW - Write a file . . . . . . . . . . . . . . 39
; 5.25. EA - Append to a file . . . . . . . . . . . . 39
; 5.26. EZ and EF . . . . . . . . . . . . . . . . . . 41
; 5.27. EM - MTAPE UUO's. . . . . . . . . . . . . . . 43
; 5.28. Subroutines
; 5.28.1. E$DFLT . . . . . . . . . . . . . . . 44
; 6. Low segment. . . . . . . . . . . . . . . . . . . . . . 45
; 7. End of TECECM. . . . . . . . . . . . . . . . . . . . . 46
;.end lit.pag
;-
SUBTTL Revision History
COMMENT |
1000 Start of this version
1006 By: Nick Bush On: 28-July-1980
1. EE files get "Not a save file" from monitor. The byte size specified in
TECUNV was getting expanded as 36 octal, not decimal.
2. EW was using the wrong address for calling F$RSET when there already was
an output file. Make it use the FDB address, not the text buffer address.
Modules: TECUNV,TECECM
1014 By: Nick Bush On: 11-August-1980
1) Don't do the AUTO-BUFFER command if we had a error on the last command.
This avoids losing info for the error messages.
2) Make an EB/ER/EX sequence end up renaming the correct files, not
trying to rename the ER'ed file to the EB'ed file.BAK, ...
3) Make TEC file=file work the way it is supposed to.
Modules: TECPRS,TECFIL,TECECM,TECINI
1016 By: Robert McQueen On: 12-August-1980
- Log files do not work for /NOOUTPUT and /NOINPUT
- Make :E< and :E> work.
Modules: TECECM
1017 By: Robert McQueen On: 12-August-1980
- The ENQ'd path was wrong sometimes, test backwards.
- ^Z command caused files to be renamed for EB'd files.
Modules: TECTRM,TECECM
1030 By: Robert McQueen On: 21-August-1980
- Clean up defaulting routines
- Prevent EB files from always seeming to be /INPLACE.
Modules: TECFIL,TECECM
1061 By: Nick Bush On: 18-December-1980
1) Finish and debug Tektronix 4025 support.
2) Add FW command.
3) Add capability of logging screen update info in log file.
Modules: TECUNV,TECTEK,TECSRH,TECTBL,TECECM,TECVID,TECERR
1071 By: Nick Bush On: 10-January-1981
Add F$RBUF and F$WBUF routines to improve I/O performance.
Also add /MODE:DUMP for all file commands.
Modules: TECUNV,TECFIL,TECCMD,TECECM
1074 By: Nick Bush On: 23-January-1981
Make TECONC ask for an initial command string for TECINI. This can be
any set of TECO commands terminated by two altmodes.
Also make TECECM do a physical-only GETSEG during an EE file restart if
the original run-from info was gotten from the GETTAB's.
Modules: TECINI,TECONC,TECECM
1076 By: Nick Bush On: 30-January-1981
Add a default mode to be mode type 0. This will allow /MODE:ASCII
to really be such with LSA files. Also make /MODE: properly default
from ER/EW to EB and vice versa.
Modules: TECUNV,TECCMD,TECFIL,TECECM
1077 By: Nick Bush On: 6-Febuary-1981
1) Add routine do delete all tags for a given text buffer, and have it
called anytime the buffer becomes editable, or is destroyed.
2) Reset CUREDT to point at TXTBUF anytime the q-register which it points
at becomes disassociated with it.
Modules: TECUNV,TECPRS,TECCMD,TECECM,TECSYM
1100 By: Robert McQueen On: 8-Febuary-1981
- Issue a ?TECNFO error message if there are no files for output on an EX
command or anything else that runs through FINI.0.
- Cause the ?TECNFO error message from the above to only print one. U$WW??
should not save TY.OBY on the stack, but use the ^X feature of $STRING.
Modules: TECECM,TECUUO
1106 By: Nick Bush On: 13-May-1981
Improve screen updating for times when the new screen has portions which
are identical with the old. This will also fix most cases of wrapped
around lines on the top of the section of the screen.
Also fix some random /MODE:DUMP bugs.
Modules: TECUNV,TECVID,TECCMD,TECECM,TECUUO,TECMEM
1125 By: Robert McQueen On: 29-September-1981
- Make symbol table entries movable blocks.
- Use the new linked list processing.
- Initial work to make TECSYM run in non-zero section.
Modules: TECUNV,TECECM,TECSYM,TECMEM
Start of Version 200A(1126)
1127 By: Nick Bush@SIT, Robert C. McQueen@SIT On: 15-October-1981
Add the following new features:
- String arguments. {...} is a string argument.
- Make I take them, = and == return them.
- Implement the FC command to define immediate command tables
- Implement the E? command to return various items.
- Start doing some work so that TECO will work on TOPS-20
- Start doing some work so that TECO some day may run in a section
besides zero.
Modules: TECUNV,TECERR,TECPRS,TECCMD,TECSRH,TECMEM,TECUUO,TECECM,TECMVM,TECCOM,TECINI
1132 By: Nick Bush On: 10-December-1981
1) Add Q-register data types for the sake of FC(Q-reg)SAVE$ and
FC(Q-reg)RESTORE$ commands.
2) Fix FC(q-reg)REPLACE$ to correctly replace the ALWAYS and OTHER options.
Modules: TECUNV,TECCMD,TECECM,TECMEM,TECPRS,TECMVM
1135 By: Nick Bush On: 21-December-1981
Add /YANK and /NOYANK switches to ER and EB commands. These will
cause an EY command to be done along with the ER/EB command.
The switch will have a single default for both ER and EB.
Modules: TECECM
1140 By: Nick Bush On: 1-January-1982
Fix E?TERMINAL-TYPE$ to not put a CRLF after the terminal name.
Modules: TECECM
1141 By: Nick Bush On: 1-January-1982
Fix EW/EA command to correctly turn off the "output open" flag when
reseting the previous file.
Modules: TECECM
1142 By: Nick Bush On: 3-January-1982
Fix SETWIN to properly copy the VIN block when it had to be expanded
and moved. It was not copying the last word of the old block.
Modules: TECECM
1147 By: Nick Bush On: 17-March-1982
Fix control-C code to correctly restore T1-3 before saving them on the stack.
This got broken when the check for DDT was put in.
Modules: TECECM
1151 By: Nick Bush On: 24-March-1982
Add Q-register 'EXIT-BUFFER' to be executed whenever TECO is exiting.
Also remove the string to set VT-100's to smooth scroll on exit. This
can now be done by putting the correct macro in 'EXIT-BUFFER'.
Modules: TECUNV,TECECM,TECPRS,TECTBL,TECDEC
1162 By: Nick Bush On: 14-May-1982
Add a new flag for Q-regs to indicate that the Q-reg may not become the
current editing buffer with the E. command. This keeps TERMINAL-INPUT-BUFFER
from causing problems
Modules: TECUNV,TECECM,TECCMD
1164 By: Nick Bush On: 29-May-1982
Last edit broke redefining the screen without intervening update.
In SETWIN, always call SC$CLS, whether the Q-reg claims to be displayed
or not.
Modules: TECECM
|
SUBTTL Misc symbol definitions
; The following symbols are not defined in UUOSYM. These are the GETSEG
; and RUN arguments
TOPS10<
$RNDEV==0 ; Offset to the device name
$RNNAM==1 ; Offset to the name
$RNEXT==2 ; Offset to the extension
$RNPPN==4 ; Offset to the PPN
$RNCOR==5 ; Offset to the core argument (Right half)
>; End of TOPS10
SUBTTL E Commands -- Initialization
;+
;.HL1 E$INIT
;Here to initialize the E command processing.
;-
$CODE ; In the CODE PSECT
; First define the permanent default file specs.
PDF$EW:
PDF$ER:
;PDF$EB:
$BUILD FDB,.FDLEN ; Initialize the macro
$SET DEV,<SIXBIT |DSK|> ; Default device name
$EOB ; End of the block
PDF$EL: $BUILD FDB,.FDLEN ; Prime the macro
TOPS10<
$SET DEV,<SIXBIT |DSK|> ; Default the device name
$SET NAM,<SIXBIT |TECO|> ; Default the name
$SET EXT,'LOG' ; Default the extension
>; End of TOPS10
TOPS20<
$SET FIL,<ASCIZ |DSK:TECO.LOG|>
>; End of TOPS20
$SET FLG,FD.HEX ; And the flags
$EOB ; End the block
PDF$EQ: $BUILD FDB,.FDLEN ; Prime the macro
$SET NAM,<SIXBIT |TECO|> ; Default the name
$SET EXT,'TEC' ; Default the extension
$SET FLG,FD.HEX ; And the flags
$EOB ; End the block
PDF$EE: $BUILD FDB,.FDLEN ; Prime the macro
TOPS10<
$SET DEV,<SIXBIT |DSK|> ; Default the device name
$SET NAM,<SIXBIT |TECO|> ; Default the name
$SET EXT,'SAV' ; Default the extension
>; End of TOPS10 conditional
TOPS20<
$SET FIL,<ASCIZ |DSK:TECO.EXE|>
>; End of TOPS20
$SET FLG,FD.HEX ; And the flags
$EOB ; End the block
E$INIT: STORE T1,E$ZBEG,E$ZEND,0 ; Clear the data
STORE T1,E$OBEG,E$OEND,-1 ; And initialize the default switches
MOVE T1,[XWD RUNCOD,ED$COD] ; Get set to move the code
BLT T1,ED$COD+RUNLEN-1 ; Move all the RUN UUO code
DEFINE ..DFT(NAME),<IRP <NAME>,<
MOVE T1,[XWD PDF$'NAME,DEF$'NAME] ;; Get the BLT pointer
BLT T1,DEF$'NAME+.FDLEN-1 ;; And copy the block
>> ; End of ..DFT(NAME)
; Now set up the defaults
..DFT(<EW,EL,ER,EE,EQ>)
; Set up the default switch tables
STORE T1,ER$DFS,ER$DFS+<ER$END-ER$BEG>,-1 ; All defaults in ER
; Set up the EO instruction table.
MOVX A1,EOVAL ; Get the value
PJRST OLD.0 ; And go set it
SUBTTL E Commands -- E. - Switch editing buffers
;+
;.HL1 SWTBUF
; This routine will cause the editing buffer to be changed to the given
;Q-register. The editing buffer initially the "." Q-register.
;.literal
;
; Command format:
;
; E.(Q-register)
;
; Q-register - This is the new editing buffer.
;.end literal
;-
SWTBUF: SETZ T1, ; Clear the default Q-register
PUSHJ P,SCNQRG ; Scan off the Q-reg names
ERROR E.IQN ; ++ Invalid Q-reg name
MOVE T2,$QRFLG(T1) ; Get the flags
TXNE T2,QR$WRT ; Allowed to write into this?
ERROR E.DOQ ; No, display only
TXNE T2,QR$TXT!QR$EDT ; Allowed to have text in this?
ERROR E.VOQ ; No, value only
MOVE P1,T1 ; Copy the index
MOVEI T1,TXTBUF+$QRTPT ; Get the address of the TPT
SKIPE $TPADR(T1) ; If not text then skip this
PUSHJ P,M$RELB ; Release the block
LOAD. T1,QRGDTP,(P1) ; Get the Q-register data type
CAXN T1,$DTTXT ; Is there text in it?
JRST SWTB.0 ; Yes, leave it alone
MOVX T2,$DTTXT ; Get the new type
XCT RQRGTB(T1) ; And change types
MOVX T1,D.TXTS ; Get the default text size
PUSHJ P,M$GTXT ; Allocate a text buffer
MOVEI T2,$QRTPT(P1) ; Get the address
PUSHJ P,M$USEB ; Store it
; Now release the current text buffer
SWTB.0: MOVEM P1,CUREDT ; Save the QRG address we are currently editing
LOAD. T1,TPTADR,+$QRTPT(P1) ; Get the buffer address
PUSHJ P,S$TAGC ; Clean up any tags laying around
LOAD. T1,TPTADR,+$QRTPT(P1) ; Get the address of the block
MOVEI T2,TXTBUF+$QRTPT ; And the new text buffer
PJRST M$USEB ; Set it as the new text buffer
SUBTTL E Commands -- E$ - Set window items.
;+
;.HL1 E$
;This command will set which q-registers are typed on the screen for the
;screen editing. It will require two arguments.
;.literal
;
; Command format:
;
; m,nE$(q-register)
;
; m - Starting line number.
; n - Ending line number.
; q-register - Item to be displayed.
;
;.end literal
;-
SETWIN: SETZ T1, ; No default
PUSHJ P,SCNQRG ; Scan the q-register name
ERROR E.IQN ; Illegal Q-register name
LOAD T2,$QRFLG(T1),QR$DIS ; Can we display this one ?
JMPT T2,[ERROR E.VOQ] ; No, Value only Q-register
PUSHJ P,QTXTEI ; Have any text in the Q-register ?
; Does not return if not
MOVE P1,T2 ; Copy the address to a safe place
SKIPN $CRXYP(CRT) ; Have a terminal which supports this?
ERROR E.NSM ; No, punt
CAMLE A1,A2 ; Are they in the correct order
EXCH A1,A2 ; No - Put them in the correct order
JUMPLE A1,ERRLOR ; This one valid?
JUMPLE A2,ERRLOR ; How about this one
CAMG A1,$CRLIN(CRT) ; Within range ?
CAMLE A2,$CRLIN(CRT) ; . . .
ERRLOR: ERROR E.LOR ; ++ Line number out of range
SOJ A1, ; Decrement to internal form
; Now we must update the VIN block to include this QRG, remove any conflicting
;QRG, and update the max screen length seen so far.
SKIPE VINADR+$TPADR ; Already have the block?
JRST SETW.1 ; Yes, must go do all the checks
MOVE T1,A2 ; Get the last line number
ADDX T1,$VIQRG-.BKLEN ; Get the correct length needed
MOVX T2,.BTMOV ; And the block type
PUSHJ P,M$ZBLK ; Get a block
SUBX T1,.BKLEN ; Point to the start of the block
XMOVEI T2,VINADR ; Get the address of the pointer
PUSHJ P,M$USEB ; Set it up
MOVE P2,T1 ; Get a copy
STOR. A2,VINNLN,(P2) ; Store the number of lines
JRST SETW.3 ; And go setup the QRG
; Here if we already have a VIN block. Check to see if we are conflicting
;with any of the entries.
;First check to see if this QRG is already displayed.
SETW.1: LOAD. P2,TPTADR,+VINADR ; Get the address of the VIN block
MOVE T1,P1 ; Get the address of the QRG
PUSHJ P,SC$CLS ; Clear out that section of video info
; See if we need to expand the block
SETW.2: LOAD. T2,VINNLN,(P2) ; Get the number of lines in the block
CAML T2,A2 ; Enough?
JRST SETW.3 ; Yes, skip the expansion
SUBM A2,T2 ; Get the amount we need to add
MOVE T1,P2 ; Get the address of the block
PUSHJ P,M$APPD ; And expand the block
JRST .+2 ; Need to copy the data
JRST SETW.3 ; Nothing to copy
MOVE P2,T3 ; Here also
XMOVEI T2,$VINLN(T1) ; Get the old address
XMOVEI T3,$VINLN(T3) ; And the new
LOAD. T1,VINNLN,(T1) ; And the old size
AOJ T1, ; Plus one word for the number of lines
PUSHJ P,M$MCOR ; Move the data
; Now set up the correct lines with the QRG address. If there already is
;something displayed there, remove the display attributes.
SETW.3: LOAD. P2,TPTADR,+VINADR ; Get the address of the info
CFMGE. ,VINNLN,(P2),A2 ; This a new max?
STOR. A2,VINNLN,(P2) ; Yes, save it
MOVE P3,A1 ; Get the first line number
ADD P3,P2 ; And point to the VIN info
SUB A2,A1 ; Get the number of lines
MOVE P4,A2 ; Get a copy
SETW.4: LOAD. T1,VINQRG,(P3) ; Get the QRG address
JUMPE T1,SETW.5 ; If nothing was displayed here, try the next
PUSHJ P,SC$CLS ; Clear out this QRG display info
SETW.5: STOR. P1,VINQRG,(P3) ; Store the info
AOJ P3, ; Advance to the next line
SOJG P4,SETW.4 ; And go do it
BITON T1,QR$VLU!QR$FCT,$QRFLG(P1) ; Flag this is displayed
POPJ P, ; And return
SUBTTL E Commands -- EV processing -- General command
;+
;.HL1 EV command
; The EV command is handled by the VIDEO routine. This routine will set
;various terminal parameters, return information or set the terminal type
;for the user. This command has the format of one of the following:
;.literal
;
; arg1,arg2EV$ - Set parameter arg2 to have the value arg1
; EVterminal$ - Set the terminal type to be 'terminal'
; EVparameter$ - Return a value of a parameter
; argEVparameter$ - Set the parameter to be ARG
;.end literal
;-
VIDEO: MOVEI T1,[ERROR E.UTK] ; Get the error name
PUSHJ P,F$SETI ; Set the input routine
PUSHJ P,F$SXBT ; Input a sixbit token
TXNE F,F.ARG ; An argument seen ?
JRST VIDCHG ; Yes - Other type of processing
MOVE T2,CRTPTR ; Set up for the matching routine
PUSHJ P,LOKNAM ; Look for this in the table
JRST [JUMPE T2,VIDE.0 ; If unknown see if parameter
ERROR E.ABT] ; Not - Ambig
MOVEI T2,-CRTTAB(T2) ; Calculate the offset
MOVE CRT,CRTDSP(T2) ; Get the first parameter
MOVEM CRT,CRTTYP ; Store the flags
; Check if there is an initialization string and if we are in video mode.
;If so, do the initialization now.
JMPNS .POPJ ; If not screen mode, just return
PJRST INTCRT ; Initialize the terminal
; Here if it was not a terminal type to set. Try for a parameter
VIDE.0: MOVE T2,PARPTR ; Get the pointer to the parameter table
PUSHJ P,LOKNAM ; Lookup the value
JRST [SKIPE T2 ; Unkown ?
ERROR E.ABV ; Ambiguous parameter
ERROR E.UTP] ; Unknown video parameter
MOVEI T1,-VPRMTB(T2) ; Get the offset into the table
SKIPE VPRMVAL(T1) ; Have something to do??
XCT VPRMVAL(T1) ; Yes, do it
SKIPE T1,VPRMOFS(T1) ; Get the offset into the CRT block
MOVE T1,CRTFNC(T1) ; And get the value
PJRST VALRET ; Go return the value
CRTPTR: XWD -NUMCRT,CRTTAB ; Pointer to the table of CRT names
PARPTR: XWD -VPRMLN,VPRMTB ; Pointer to the table of video parameters
SUBTTL E Commands -- EV processing -- Parameter setting
; Here if the EV command had numerical arguments
VIDCHG: JUMPN T1,VIDPRM ; Try for a keyword
SUBI A1,1 ; Correct the offset (So symbols work)
TXZE F,F.ARG2 ; Only one argument ?
ERROR E.ROP ; ++ Read only parameter
SKIPL A1 ; Check the range
CAILE A1,$CRMAX ; . . .
ERROR E.VOR ; ++ Value out of range
MOVE A1,CRTTYP(A1) ; Get the value
JRST VALRET ; Return the value
SUBTTL E Commands -- EV processing -- Parameter keywords
;VIDPRM - Routine to handle VIDEO terminals parameters.
;This routine will dispatch to the correct routine to handle the video
;parameters.
VIDPRM: MOVE T2,[XWD -VPRMLN,VPRMTB] ; Get the table offset
PUSHJ P,LOKNAM ; Lookup in the table
JRST [SKIPE T2 ; Unknown ?
ERROR E.ABV ; ++ Ambigous video parameter
ERROR E.UVP] ; ++ Unknown video parameter
MOVEI T2,-VPRMTB(T2) ; Get the offset
SKIPE VPRMRT(T2) ; Have a routine??
JRST @VPRMRT(T2) ; Dispatch to the routine
ERROR E.ROP ; Read-only video parameter
SUBTTL E Commands -- EV processing -- Keyword table
DEFINE VIDPR.,<
VPRM FAST,,,VPFAST
VPRM LINE,,,RTLINE
VPRM MODE,,,RTMODE
VPRM NODE,,,RTNODE
VPRM OFF,,,VPOFF
VPRM ON,,,VPON
VPRM REFRESH,,,VPREFRESH
VPRM SCREEN,VPSCREEN,,RTSCREEN
VPRM SCROLL,VPSCRL,,RTSCRL
VPRM SLOW,,,VPSLOW
VPRM TRMOP,RTTRMP
VPRM UPDATE,VPUP.0,,VPUPDATE
VPRM WINDOW,VPWINDOW,,RTWINDOW
>; End of the VIDPR. definition
DEFINE VPRM(A,B,C,D),<EXP SIXBIT |A| >
VPRMTB: VIDPR.
VPRMLN==.-VPRMTB
DEFINE VPRM(A,B,C,D),<EXP B>
VPRMRT: VIDPR.
DEFINE VPRM(A,B,C,D),<EXP C>
VPRMOFS:
VIDPR. ; Generate the offsets
DEFINE VPRM(A,B,C,D),<IFNB <D>,<JRST D ;> 0>
VPRMVAL:
VIDPR. ; Generate the instructions
SUBTTL E Commands -- EV processing -- SCROLL parameter
; This parameter is used to determine whether the command section of the screen
;should be scrolled or not.
VPSCRL: TXZ S,S.SCRL ; Assume no scrolling
JUMPE A1,.POPJ ; If zero, don't scroll
TXO S,S.SCRL ; Otherwise flag we should scroll if possible
POPJ P, ; And return
RTSCRL: TXNE S,S.SCRL ; Check the flag
PJRST RTONES ; Return -1
PJRST RETZER ; Return 0
SUBTTL E Commands -- EV processing -- ON command
; This command will turn on OLD video mode.
VPON: SKIPN $CRXYP(CRT) ; Can we do this?
POPJ P, ; No, just return
TXOE S,S.SCRN ; Flag we are in complete video mode now
POPJ P, ; Already were, skip this
SETZM OUTFLG ; Clear the flag to avoid an unnecessary --cont--
PUSHJ P,INTCRT ; Initialize the terminal
PUSHJ P,T$SRTN ; And set up the typein/out routines
SKIPE T1,$CRERS(CRT) ; Have a way to erase the screen?
PUSHJ P,SC$STR ; Yes, do it
SETZM CURPOS+$OFSX ; Remember where we are
SETZM CURPOS+$OFSY ; . . .
POPJ P, ; And return
INTCRT: SKIPE $CRINT(CRT) ; Need to do this?
XCT $CRINT(CRT) ; Initialize the terminal
POPJ P, ; And return
SUBTTL E Commands -- EV processing -- OFF command
; Here to clear video mode
VPOFF: TXZN S,S.SCRN ; Clear the flags
POPJ P, ; Return
PUSHJ P,SC$ERS ; Erase the whole screen
XCT $CRFIN(CRT) ; Cause the terminal to be put in reasonable state
PUSHJ P,SC$RVD ; Return the video info
PUSHJ P,T$SRTN ; Set the typein routines
PJRST .TCRLF ; And type a CRLF
SUBTTL E Commands -- EV processing -- MODE command
;+
;.hl2 RTMODE
; This command will return the state of the video mode flags.
;It returns values as follows: 0 for video processing turned off
;(version 124A terminal I/O), -1 for video processing turned on in
;version 125 mode, 1 for video processing turned on in IMMEDIATE
;(MAGIC) mode.
;-
RTMODE: JMPNS RETZER ; Return a zero if not on at all
MOVX A1,-1 ; No, get the correct value
PJRST VALRET ; And return it
SUBTTL E Commands -- EV processing -- WINDOW command
SUBTTL E Commands -- EV processing -- SCREEN command
;+
;.HL2 RTWINDOW
;Return the widow size of the window.
;-
RTWINDOW:
RTSCREEN:
SKIPN T1,SCRNLN ; Have the screen set up yet?
SKIPE T1,CRTLEN ; Have the length set by the user yet?
JRST RTWI.1 ; Yes, go return it
SKIPN T1,TRMLEN ; No, get the length from the TRMOP
MOVE T1,$CRLIN(CRT) ; Wasn't one, get the default
RTWI.1: SKIPN A1,SCRWID ; Get the width of the screen
SKIPE A1,CRTWID ; Isn't one yet, get that set by user
JRST .+2 ; We have the width
MOVE A1,TRMWID ; Otherwise use width from TRMOP.
HRL A1,T1 ; Set up the values
AOJA A1,VALRET ; And return the value
; Here for EVSCREEN and EVWINDOW commands which had arguments
; A1 will contain the new width, and A2 the new length (if given)
VPWINDOW:
VPSCREEN:
JUMPL A1,[MOVE A1,$CRWID(CRT) ; Negative value means use default
JRST VPWI.1] ; . . .
SOJGE A1,.+2 ; Convert to internal width
SETZ A1, ; Zero or one means use default
VPWI.1: ANDX A1,777 ; Keep it reasonable
MOVEM A1,CRTWID ; Save the width
TXNN F,F.ARG2 ; Second argument given?
POPJ P, ; No, just return now
JUMPGE A2,.+2 ; Want default value?
MOVE A2,$CRLIN(CRT) ; Yes, get it
ANDX A2,777 ; Keep the length reasonable
MOVEM A2,CRTLEN ; Save the value
POPJ P, ; And return
SUBTTL E Commands -- EV processing -- Refresh command
VPREFRESH:
SC$REF: PUSHJ P,SC$ERS ; Erase the screen
POPJ P, ; Return
SUBTTL E Commands -- EV processing -- Update command
;.hl2 VPUPDATE
; This routine is called when a EVUPDATE$ command is given. It will
;cause the screen to be updated.
;-
VPUP.0: $SAVE <NOTYIA> ; Save the type-ahead flag
MOVEM A1,NOTYIA ; Save the new value
VPUPDATE:
MOVX T1,.TRUE ; SC$UPD should use new user info if any
JRST SC$UPD ; Call the update routine
SUBTTL E Commands -- EV processing -- NODE command
;+
;.HL1 EVNODE
; This command will return the value of the node number to which the
;controlling terminal is attached.
;-
RTNODE: MOVE A1,TRMUDX ; Get our UDX
GTNTN. A1, ; Get the node number
JRST RETZER ; Not a network system
HLRZ A1,A1 ; Get the node number for our terminal
JRST VALRET ; And return it
SUBTTL E Commands -- EV processing -- LINE command
;+
;.HL1 EVLINE
; This command returns the line number on the node on which the terminal
;controlling this job is connected.
;-
RTLINE: MOVE A1,TRMUDX ; Get the teminal UDX
MOVE T1,A1 ; Get a copy
SUBX T1,.UXTRM ; And convert to line number
GTNTN. A1, ; Get the node and line on node
MOVE A1,T1 ; Not a network system, return the line number
; from TRMNO.
HRRZ A1,A1 ; Clear the node number
JRST VALRET ; And return the value
SUBTTL E Commands -- EV processing -- TRMOP command
;+
;.HL1 EVTRMOP
; This command will perform a TRMOP. for the users terminal. A1 will
;contain the TRMOP. function, and A2 will contain the argument (if any).
;It will return the value from the TRMOP. if it returns one.
;-
RTTRMP: MOVE T2,A1 ; Get the function code
MOVE T3,TRMUDX ; And the UDX
MOVE T4,A2 ; Get the argument (maybe)
MOVX T1,<XWD 3,T2> ; Get the pointer
CAXL A1,^O1000 ; Legal function?
TRMOP. T1, ; Yes, do it
ERROR E.ITT ; Illegal function
MOVE A1,T1 ; Get the return value
CAXE T1,<XWD 3,T2> ; Did we get our arg pointer back?
PJRST VALRET ; No, return the value
POPJ P, ; Yes, no value
SUBTTL E Commands -- EV processing -- FAST command
;+
;.HL1 EVFAST
;This command will set a flag telling TECO to override the smart video
;updating. It comes in handy on fast terminals and slow systems.
;.Literal
; Command usage:
; EVFAST$
;
;.End literal
;-
VPFAST: SETOM FSTFLG ;Set the fast flag
POPJ P, ;Return
SUBTTL E Commands -- EV processing -- SLOW command
;+
;.HL1 EVSLOW
;This comand is the opposite of the EVFAST command. It tells TECO
;to use smart updating. It comes in handy on slow terminal and fast systems
;.Literal
; Command usage:
; EVSLOW$
;
;.End literal
;-
VPSLOW: SETZM FSTFLG ;Clear the fast flag
POPJ P, ;Return
SUBTTL E Commands -- E<(Q-reg) - Type input file name into buffer
;+
;.HL1 E<
;This command will type the input file specification into the current editing
;buffer.
;.literal
; Command usage:
; E<(Q-register)$
;
;.end literal
;-
E$LANG: SETZ T1, ; No default
PUSHJ P,SCNQRG ; Scan for the Q-register name
ERROR E.IQN ; Missing Q-register name
PUSHJ P,QTXTEI ; Have any text in the Q-register ?
PUSHJ P,GETFDI ; Get the FD assoicated with the input file
ERROR E.NFI ; No file for input
; Here for the typing of the FD into the current editing buffer. Set up
; a $STRING to type the information into the buffer and return
LANG.0: MOVE P1,T1 ; Copy the information to a safer place
MOVEI T1,TXTBUF+$QRTPT ; Get the current editing buffer
MOVEI T2,[$STRING(<^F/P1/^N>)] ; Get the string to type
PJRST .INSRT ; Insert it into the buffer
SUBTTL E Commands -- E>(Q-reg) - Type output file name into buffer
;+
;.HL1 E>(Q-reg)
;This command will cause the output file specification associated with
;the named Q-register to be typed into the current editing buffer.
;.literal
; Command Usage:
;
; E>(Q-register-name)$
;
;.end literal
;-
E$RANG: SETZ T1, ; No default name
PUSHJ P,SCNQRG ; Scan for the Q-register name
ERROR E.IQN ; Failed, Issue an error message
PUSHJ P,QTXTEI ; Have any text in the Q-register ?
PUSHJ P,GETFDO ; Get the output FD block
ERROR E.NFO ; No file for output
PJRST LANG.0 ; Join the common type out routine
SUBTTL E commands -- EJ - Set pointer for other than current buffer
;+
;.HL1 EJCMD (EJ command)
; This command will perform a "J" command for a Q-reg other than the current
;editing buffer.
;Command format:
;.b.c;nEJ(Q-register name)
;-
EJCMD: SETZ T1, ; Clear T1
PUSHJ P,SCNQRG ; Scan off the Q-register name
ERROR E.IQN ; Illegal Q-register name
PUSHJ P,QTXTEI ; Have any text in the Q-register ?
PJRST JMP1 ; And go set it
SUBTTL E Commands -- EL -- LOGCHR
;+
;.hl1 EL command
;.hl2 LOGCHR
; This routine is called to write the current character into the log
;file.
;.b.literal
; Usage:
; MOVEI CH,Character
; PUSHJ P,LOGCHR
; (return always)
;
;.end literal
;-
LOGCHR: TXNN S,S.SLOG ; Suppressing the log file?
LOGC.0: SKIPN FDB$EL ; Have a log file?
POPJ P, ; No, return
$SAVE <T1,T2,T3,T4,LASFDB> ; Save the Tx ac's
MOVE T1,FDB$EL ; Get the fdb address
PUSHJ P,F$WRIT ; And write the character
PJRST F$ERR ; Give up
SKIPE T1,L$COUNT ; Want checkpoints at all?
SOSLE L$CNTR ; Yes, want one now?
POPJ P, ; No, return
MOVEM T1,L$CNTR ; Reset the counter
MOVE T1,FDB$EL ; Yes, get the FDB address again
PUSHJ P,F$CHKP ; Checkpoint it
POPJ P, ; All done
SUBTTL E Commands -- EL -- MAKLOG
;+
;.hl2 MAKLOG
; This routine will handle the EL command. If no argument is given
;this will start the log file. If an argument is given it will change
;whether input or output or both are written to the log file. If the
;argument is negative it will close the log file.
;-
MAKLOG: TXNE F,F.ARG ; Argument given?
JRST CHANGL ; Yes, go change what we are doing
SKIPN T1,FDB$EL ; Have a log file already?
JRST MAKL.1 ; No, skip this
PUSHJ P,F$CLOS ; Yes, close the file
PJRST F$ERR ; Go give up
SETZ T1, ; Clear T1
EXCH T1,FDB$EL ; Get the address back
JRST MAKL.2 ; And skip getting an FDB
MAKL.1: MOVX T1,.FDLEN ; Get the length
MOVX T2,.BTFDB ; Get the block type
PUSHJ P,M$GBLK ; Get the block
MAKL.2: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Get the FDB address
STORE T2,SL$BEG,SL$END,-1 ; Clear the switches
MOVEI T2,LOGSWT ; Get the switch pointer
PUSHJ P,F$PARS ; Parse the file spec
PJRST F$ERR ; Give an error message
MOVEI T3,PDF$EL ; Get the permanent default address
MOVEI T2,DEF$EL ; Get the default FDB
MOVE T1,P1 ; And the FDB address
PUSHJ P,F$DFLT ; And default it
TXO S,S.LIN!S.LOUT ; Flag input and output logged
SKIPL LS$NOI ; /NOINPUT given?
TXZ S,S.LIN ; Flag he wants input
SKIPL LS$NOO ; . . .
TXZ S,S.LOUT ; Flag he wants output
SKIPL LS$VID ; Want video info?
TXO S,S.LVID ; Yes, flag that
SKIPL LS$IIN ; Image type in wanted?
TXO S,S.LIIN ; Yes, flag that
MOVE T2,P1 ; Get the FDB address
SKIPGE T1,LS$CHK ; Get the frequency of checkpoints
SETZ T1, ; 0 and -1 mean never
MOVEM T1,L$COUN ; Save for reseting the counter
MOVEM T1,L$CNTR ; And save in the counter
MOVX T1,$IOWRI ; Get the code
SKIPL LS$APP ; Or should it be append
MOVX T1,$IOAPP ; Yes, get the right code
PUSHJ P,F$OPEN ; And open the file
JRST MAKL.5 ; Skip
MOVEM P1,FDB$EL ; Save the FDB address
POPJ P, ; And return
MAKL.5: SETZM FDB$EL ; Clear the pointer
TXZ S,S.LIN!S.LOUT ; And flag no logging
PJRST F$ERR ; And go give the error
DEFINE SWT$EL,<
SW APPEND,LS$APP,,1,
SW CHECKP,LS$CHK,.IDECW,^D640,
SW IMGINP,LS$IIN,,1,
SW NOINPUT,LS$NOI,,1,
SW NOOUTPUT,LS$NOO,,1,
SW VIDEO,LS$VID,,1,
> ; End of SWT$EL definition
DOSWTCH(LOG,SWT$EL) ; Generate the switch tables
LOGSWT: SWTPTR(LOG) ; Generate the pointers to the switch table
; Here when :nEL is given. Reset the /NOINPUT or /NOOUTPUT flags
; Argument bits:
AB$OUT==1 ; Output wanted
AB$INP==2 ; Input wanted
AB$VID==4 ; Video wanted
AB$IIN==10 ; Image input wanted
CHANGL: PUSHJ P,SKRCH ; Get the next character
ERROR E.NAL ; Must have the altmode
CAXE CH,.CHESC ; Is it one?
ERROR E.NAL ; No, complain
SKIPE T1,FDB$EL ; Do we have one?
SKPOPN 0(T1) ; Yes, is it open?
ERROR E.NLF ; No log file open
TXNE A1,AB$INP ; Want input?
TXO S,S.LIN ; Yes, flag he wants input
TXNE A1,AB$OUT ; Want output?
TXO S,S.LOUT ; Flag he wants output
TXNE A1,AB$VID ; Want video logged?
TXO S,S.LVID ; Yes, flag it
TXNE A1,AB$IIN ; Want image of input?
TXO S,S.LIIN ; Yes, flag that
JUMPGE A1,.POPJ ; If the arg is negative close the file
TXZ S,S.LIN!S.LOUT!S.LVID ; Flag no more logging
PUSHJ P,F$CLOS ; Close the file
PJRST F$ERR ; Couldn't?
MOVE T1,FDB$EL ; Get the FDB
SETZM FDB$EL ; Clear the pointer
PJRST M$RBLK ; And return the FDB
SUBTTL E Commands -- EE -- Write out a save file
;+
;.hl1 EECMD
; The EE command causes TECO to write out its low segment into a save
;file which is set up so that when the save file is run it will
;GETSEG TECO's high segment and continue execution with the command
;after the EE command.
;-
EECMD: MOVEM 17,EEACS+17 ; Save 17 for restart
MOVEI 17,EEACS ; And set up to save the world
BLT 17,EEACS+16 ; Save the rest
MOVE 17,EEACS+17 ; And restore 17
MOVX T1,.FDLEN ; Get the length
MOVX T2,.BTFDB ; And the block type
PUSHJ P,M$GBLK ; Get the FDB
MOVE P1,T1 ; Save in safe place
SETZ T2, ; No switches
PUSHJ P,F$PARS ; Parse the file spec
PJRST F$ERR ; Couldn't
MOVE T1,P1 ; Get the FDB address
MOVEI T2,DEF$EE ; Get the default block
MOVEI T3,PDF$EE ; Get the perm defaults
PUSHJ P,F$DFLT ; And default it
STORI. $FMBIN,T1,FDBMOD,(P1) ; store the mode
MOVX T1,$IOWRI ; Get the functin
MOVE T2,P1 ; And the FDB address
PUSHJ P,F$OPEN ; And open the file
PJRST F$ERR ; Couldn't, give an error
MOVE T1,[XWD GETBLK,STARTL] ; Move the restart code into the
BLT T1,STARTL+STR.LN-1 ; low segment
$SAVE <.JBSA,.JBCOR,FDB$EL> ; Save the locs we must change
SETZM FDB$EL ; Clear the log file pointer
MOVEI T1,STARTL ; And set up the new start address
HRL T1,.JBFF ; And first free
MOVEM T1,.JBSA ; Save it
HRR T1,.JBREL ; Get the end of core address
MOVEM T1,.JBCOR ; And store it
MOVEI P2,.JBHRL+1 ; Start after HRL
EECM.3: SKIPE (P2) ; Word zero?
JRST EECM.4 ; No, first non-zero word
CAMGE P2,FSTBLK ; Into free core yet?
AOJA P2,EECM.3 ; No, bump to the next word
EECM.4: MOVE P3,P2 ; Get the address of first non-zero word
EECM.B: SKIPN (P2) ; Is this word zero?
JRST EECM.5 ; Yes, end of non-zero block
CAMGE P2,FSTBLK ; Hit allocated section yet?
AOJA P2,EECM.B ; No, try next word
MOVE P4,P3 ; Get the address
SETZ P3, ; Clear the junk address
JRST EECM.7 ; And go handle free core
EECM.5: SUBM P3,P2 ; Get the different
JUMPE P2,[MOVE P2,FSTBLK ; If nothing to write, go handle
JRST EECM.A] ; Go handle allocated core
MOVSI P2,(P2) ; Get the count into the left half
HRRI P2,-1(P3) ; And make the IOWD
MOVE CH,P2 ; First write the IOWD
MOVE T1,P1 ; Get the address of the FDB
PUSHJ P,F$WRIT ; And write the word
PJRST F$ERR ; Give up
EECM.6: MOVE CH,1(P2) ; Get the next word
MOVE T1,P1 ; Reset the FDB address
PUSHJ P,F$WRIT ; Write the word
PJRST F$ERR ; Give up
AOBJN P2,EECM.6 ; Loop for all the words
AOJ P2, ; Point to the next word to check
CAMGE P2,FSTBLK ; Are we into allocated core?
JRST EECM.3 ; No, go look for next non-zero word
IFN FTDEBUG,<
CAME P2,FSTBLK ; Is this the right value?
STOPCD NFB,<EE loop stopped after FSTBLK>
> ; End of IFN FTDEBUG
EECM.A: SETZB P3,P4 ; Flag we haven't seen anything yet
EECM.7: LOAD. T1,BLKTYP,(P2) ; Get the block type
PUSHJ P,@EETBL(T1) ; Do the correct thing for this block type
LOAD. T1,BLKSIZ,(P2) ; Get the size of this block
MOVX T2,BF.LST ; Make sure not last on page
TDNN T2,.BKFLG(P2) ; . . .
JRST EECM.8 ; It isn't
LOAD. T2,BLKNXT,(P2) ; Get the pointer to the next page
JUMPE T2,EECM.9 ; If no more we are done
PG2ADR T2 ; And convert to an address
SKIPA P2,T2 ; Get the address
EECM.8: ADD P2,T1 ; Point to the next block
JRST EECM.7 ; And loop
EECM.9: ADD P2,T1 ; Point to the end
SKIPE P3 ; End a junk block?
PUSHJ P,ENDJNK ; Yes, end the block
SKIPE P4 ; Any non-zero block to end?
PUSHJ P,ENDBLK ; Yes, end it
MOVE CH,[JRST STARTL] ; Get the start instruction
MOVE T1,P1 ; And the FDB address
PUSHJ P,F$WRIT ; Write it
PJRST F$ERR ; Give up
MOVE T1,P1 ; Get the address
PUSHJ P,F$CLOS ; And close the file
PJRST F$ERR ; Couldn't
MOVE T1,P1 ; Get the address again
PJRST M$RBLK ; And return it
TABDEF EE,.BT,EETXT ; Generate the dispatch table
TABENT JNK,EEJNK ; Do different things for junk
TABENT FDB,EEJNK ; and FDB's
TABENT BUF,EEJNK ; And buffers
TABEND
; Here for a block which is neither junk or an FDB
EETXT: SKIPE P3 ; Have a previous junk block?
PUSHJ P,ENDJNK ; Yes, end it
LOAD. T1,BLKSIZ,(P2) ; Get the size of this block
MOVN T1,T1 ; And make an loop counter
MOVSI T1,(T1) ; . . .
HRRI T1,(P2) ; . . .
EETX.2: SKIPN (T1) ; Zero word?
JRST EETX.4 ; Yes, go handle it
JUMPN P4,EETX.3 ; First non-zero word?
MOVEI P4,(T1) ; Yes, get the address
EETX.3: AOBJN T1,EETX.2 ; Loop through the block
POPJ P, ; Return
EETX.4: JUMPE P4,EETX.3 ; If not first zero word, just loop
PUSH P,P2 ; Save P2
MOVEI P2,(T1) ; Get the address of the word
PUSHJ P,ENDBLK ; No, end the current block
POP P,P2 ; Restore P2
AOBJN T1,EETX.2 ; And loop
POPJ P, ; Return since we are done
ENDBLK: $SAVE <T1,P2> ; Save P2
SUBM P4,P2 ; And get the number to read
HRLI P4,(P2) ; Make the IOWD
SOJ P4, ; . . .
MOVE CH,P4 ; And write
MOVE T1,P1 ; it into the file
PUSHJ P,F$WRIT ; . . .
PJRST F$ERR ; And give the error
ENDB.1: MOVE CH,1(P4) ; Get the word
MOVE T1,P1 ; And reset the FDB
PUSHJ P,F$WRIT ; Write out the word
PJRST F$ERR ; Give the error
AOBJN P4,ENDB.1 ; Loop for the whole block
SETZ P4, ; In a zero block now
POPJ P, ; Return
; Here for an FDB or a junk block
EEJNK: JUMPN P4,EEJN.1 ; In a good section already?
JUMPN P3,.POPJ ; Already in a junk section?
MOVE P3,P2 ; No, remember where this one is
POPJ P, ; And return
EEJN.1: $SAVE <P2> ; Save P2
AOJ P2, ; And bump it
PJRST ENDBLK ; And end the current block
; Here to end a junk section. P2 contains address after the section, P3
;the address of the start of the section.
ENDJNK: CAIN P3,-1(P2) ; Was this right before this block?
JRST [MOVE P4,P3 ; Yes, get the address for later
SETZ P3, ; Flag no junk
POPJ P,] ; And return
MOVEI CH,-1(P3) ; Get the address for the IOWD
HRLI CH,-1 ; And the count
MOVE T1,P1 ; Get the FDB address
PUSHJ P,F$WRIT ; And write the IOWD
PJRST F$ERR ; Couldn't
MOVE CH,P2 ; Get the end address
SUBI CH,(P3) ; And get the length
IFN <ALIGN.(BK.SIZ)>,LSH CH,<ALIGN.(BK.SIZ)> ; Put in correct place
STORI. .BTJNK,T1,BLKTYP,+CH ; Store the block type
CAML P2,.JBFF ; Is this the last block?
TXO CH,BF.LST ; Yes, flag it
MOVE T1,P1 ; Get the FDB address
PUSHJ P,F$WRIT ; And write the word
PJRST F$ERR ; Couldn't
SETZ P3, ; Not in a junk section anymore
POPJ P, ; Return
SUBTTL E Commands -- EE - Restart code
GETBLK: TDZA 1,1 ; Remember not CCL entry
SETO 1, ; Flag CCL
MOVEM T1,CCLSW ; Flag whether CCL entry or not
MOVE 2+$RNDEV,RUNDEV ; Get the device
MOVE 2+$RNNAM,RUNNAM ; And the name
MOVEI 2+$RNPPN,RUNPTH ; And the path block address
SETZB 2+$RNEXT,2+$RNCOR ; clear the rest
MOVEI 0,2 ; Get the address of the GETSEG block
SETZ 1, ; Assume non-physical
SKIPE PHYSON ; Should we do physical only GETSEG?
TRO 1,UU.PHY ; Yes, flag it
GETSEG 0,(1) ; Get back our original segment
HALT
MOVEI P1,%TECOV ; Get the normal low segment version
MOVEI P2,%TECTV ; And the terminal dependent section
HRRZ T1,.JBREL ; Get the end of the low seg
TXNN T1,1B18 ; Over 128k??
MOVEI T1,400000-1 ; No, use 400000 as default
HRLI T2,-2 ; Get it from monitor
HRRI T2,.GTUPM ; If we can
GETTAB T2, ; . . .
HRLI T2,1(T1) ; Can't, use our default
HLRZ T2,T2 ; Get the offset
ANDI T2,777000 ; Clear low order bits
JRST .JBHDA(T2) ; And go restart
STR.LN==.-GETBLK
SUBTTL E Commands -- EE -- RST - Restart routine
;+
;.HL1 RST
; This routine is called from the low segment after TECO's high
;segment has been GETSEG'ed from an EE'ed file. It is entered
;with P1= %TECOV and P2=%TECTV from the copy which wrote the EE'ed file, and
;T2= the base address of the high segment.
;-
RST: CAIN P1,%TECOV ; Check if this is the correct version of the low segment
CAIE P2,%TECTV ; Terminal low segment version the same?
JRST .+2 ; One or the other wrong, give the error
JRST RST1 ; Yes, all is okay
OUTSTR [ASCIZ .?TECWVT Wrong version of TECO GETSEG'd
.]
MONRT. ; Exit to the monitor
JRST .-1 ; Can't really continue
RST1: MOVE T1,.JBHSA(T2) ; Get the starting address
MOVEM T1,.JBSA ; Reset it
MOVE T1,.JBHCR(T2) ; Get the copy of .JBCOR
MOVEM T1,.JBCOR ; Reset it
MOVE T1,.JBH41(T2) ; And get the error instruction
MOVEM T1,.JB41 ; Save it
MOVE T1,.JBHRN(T2) ; Get the values to fix .JBHRL and .JBREN
HLLM T1,.JBHRL ; Fix .JBHRL
HRRZM T1,.JBREN ; And .JBREN
MOVSI 17,EEACS ; Set up to restore the registers
BLT 17,17 ; Do it
; Now to fix up any text blocks (or FDB's) so we don't think we have any
;open files.
MOVE T1,FSTBLK ; Get the first block
RST.2: CFXE. T2,BLKTYP,(T1),.BTTXT ; Text block?
JRST RST.3 ; No, go check if an FDB
BITOFF T2,TF.OPO!TF.OPI,.BKTFL(T1) ; Yes, clear the open file flags
JRST RST.4 ; And try the next
RST.3: CFXE. T2,BLKTYP,(T1),.BTFDB ; Is this an FDB?
JRST RST.4 ; No, try the next block
STORI. .BTJNK,T2,BLKTYP,(T1) ; Yes, make it junk
RST.4: MOVX T2,BF.LST ; Last block?
TDNE T2,.BKFLG(T1) ; . . .
JRST RST.5 ; Yes, go check page field
LOAD. T2,BLKSIZ,(T1) ; No, get the size
ADD T1,T2 ; And advance to the next block
JRST RST.2 ; Loop
RST.5: LOAD. T1,BLKNXT,(T1) ; Get the next block page number
PG2ADR T1 ; Convert to address
JUMPN T1,RST.2 ; And loop if any address
PUSHJ P,M$GC ; Do a garbage collection to clean up
; Now re-initialize some things
PUSHJ P,U$INIT ; Do the UUO initialization
PUSHJ P,T$INIT ; Reintialize the terminal
PUSHJ P,I$JOB ; Do the job initialization
PUSHJ P,I$INIT ; Reinitialize the immediate mode stuff
POPJ P, ; And return
SUBTTL E Commands -- EC - Perform a garbege collection
;+
;.HL1 ECCMD
;This routine will force a garbage collection to occur, so that TECO
;may shrink in size.
;-
ECCMD: TXNE F,F.ARG ; Have an arg?
JUMPG A1,ECCM.9 ; Yes, if positive expand
MOVE P1,.JBREL ; Get our current size
TXO F,F.ECMD ; Flag this is for an EC command
PUSHJ P,S$QRGC ; Collect all zero valued Q-registers
LOAD. T1,TPTADR,+$QRTPT+ERRQRG ; Get the last error message QRG
JUMPE T1,ECCM.7 ; Anything there?
LOAD. T2,BLKEND,(T1) ; Get the number of chars in the buffer
SETZ T3, ; Delete from the first character
PUSHJ P,M$SRNK ; Shrink the buffer
ECCM.7: LOAD. T1,TPTADR,+$QRTPT+QTAB+QRGIDX(?) ; Get the address of the last error command
JUMPE T1,ECCM.8 ; Anythin here?
LOAD. T2,BLKEND,(T1) ; And the size
SETZ T3, ; Delete from first char
PUSHJ P,M$SRNK ; Shrink the buffer
ECCM.8: PUSHJ P,M$GC ; Collect the garbage
TXZ F,F.ECMD ; Turn off the EC command flag
MOVE T1,FSTBLK ; Get the first block
MOVX T2,BF.LST ; And get the flag to check
SETZ T4, ; Flag no previous block
ECCM.1: TDNE T2,.BKFLG(T1) ; Is this the last block?
JRST ECCM.2 ; Yes, go handle it
LOAD. T3,BLKSIZ,(T1) ; No, get the size
MOVE T4,T1 ; Remember the previous block
ADD T1,T3 ; And point to he next block
JRST ECCM.1 ; Loop
ECCM.2: LOAD. T2,BLKNXT,(T1) ; Get the next page number
JUMPE T2,ECCM.3 ; If done go check if we need this block
MOVE T1,T2 ; Otherwise get the page number
PG2ADR T1 ; And convert to an address
SETZ T4, ; Remember the previous
JRST ECCM.1 ; Try again
ECCM.3: CFXE. T2,BLKTYP,(T1),.BTJNK ; Is this block junk?
POPJ P, ; No, can't shrink
MOVEI T2,-1(T1) ; Yes, get the address minus one
SKIPN .JBDDT ; Don't shrink if DDT is loaded.
CORE T2, ; And try to shrink
JFCL ; Shouldn't happen
IFN FTDEBUG,<
SKIPN T4 ; Have a previous block?
STOPCD (NPB,<No previous block - no free core in use>)
> ; End of IFN FTDEBUG
BITON T3,BF.LST,.BKFLG(T4) ; Make the previous block the last
MOVEM T1,.JBFF ; Save the new first free
MOVE T1,.JBREL ; Get the current end
CAML T1,P1 ; Did we really shrink?
POPJ P, ; No, return
AOJ T1, ; Bump the number
ADR2PG T1 ; Convert to a page number
MOVE P1,T1 ; Get the number
MOVEI T1,[$STRING(<[^D/P1/P core]>)] ; Get the string to type
TXNE F,F.ARG ; Have an arg?
JUMPL A1,.POPJ ; Yes, if negative don't type
PJRST T$TYPE ; Type it
ECCM.9: PG2ADR A1, ; Convert to a word number
MOVE T1,A1 ; Get it
CAMG T1,.JBREL ; Will it really expand?
POPJ P, ; No, just return
CORE T1, ; Try to expand
JFCL ; Ignore the error
POPJ P, ; And return
SUBTTL E Commands -- EI and EP - Read into a Q-register
;+
;.hl1 EI and EP commands
; These commands cause an entire file to be read into a Q-register.
;EP just reads the file, EI will cause the Q-register to be executed
;after it is read (effectively doing an M command on the Q-reg after
;reading the file).
;-
EICMD: TXOA S,S.DOIT ; Flag to execute after file is read
EPCMD: TXZ S,S.DOIT ; Flag no execution
MOVX T1,"*" ; Get the default Q-register
PUSHJ P,SCNQRG ; Scan off the Q-register name
JFCL ; Shouldn't happen
MOVE T2,$QRFLG(T1) ; Get the flags
CAME T1,CUREDT ; Current buffer?
TXNE T2,QR$WRT ; Allowed to write into this?
ERROR E.DOQ ; No, display only
TXNE T2,QR$TXT ; Allowed to have text in this?
ERROR E.VOQ ; No, value only
MOVE P1,T1 ; Save the index
MOVX T1,.FDLEN ; Get the descriptor block
MOVX T2,.BTFDB ; And the block type
PUSHJ P,M$GBLK ; Get the block
MOVE P2,T1 ; Remember where it is
SETZ T2, ; No switches
PUSHJ P,F$PARS ; Parse the spec
PJRST F$ERR ; Couldn't
MOVEI T2,DEF$EQ ; Get the default block address
MOVE T1,P2 ; Get the FDB address back
MOVEI T3,PDF$EQ ; Get the permanent defaults
PUSHJ P,F$DFLT ; And default it
;Here to LOOKUP file for EI and EP.
;If no directory or device has been specified, then look for the
;file as follows:
; [-]
; [,,TEC]/SCAN
; TED:
MOVX T1,FD.PTH ; Check if PPN or path given
CFXN. ,FDBDEV,(P2),0 ; Device given?
TDNE T1,.FDFLG(P2) ; Or PPN or path?
TDZA P3,P3 ; Yes, no random searches
MOVX P3,3 ; No, start with sequence 3
EPILOP: JRST @EPITBL(P3) ; Do the right thing for this pass
EPITBL: EXP EPIDFT ; Default's from block
EXP EPITED ; TED:
EXP EPISFD ; DSK:[,,TEC]/SCAN
EXP EPIDSK ; DSK:[-]
; Here for DSK:[,,TEC]/SCAN
EPISFD: MOVE T1,MYPPN ; Get out PPN
STOR. T1,FDBPPN,(P2) ; Store it
STORI. <SIXBIT |TEC|>,T1,FDBSFD,(P2) ; Store the SFD name
BITON T1,FD.SCN!FD.PTH,.FDFLG(P2) ; And flag /SCAN
FALL EPIDSK ; And join common disk code
; Here to look on DSK:[-]
EPIDSK: STORI. <SIXBIT |DSK|>,T1,FDBDEV,(P2) ; Store the device name
PJRST EPIDFT ; Go join common open routine
; Here to look on TED:
EPITED: STORI. <SIXBIT |TED|>,T1,FDBDEV,(P2) ; Store the device name
ZERO. ,FDBPPN,(P2) ; Clear the path
ZERO. ,FDBSFD,(P2) ; . . .
FALL EPIDFT ; Join common routine
; Here to open the file
EPIDFT: MOVX T1,<SIXBIT |DSK|> ; Get the default name
CFXN. ,FDBDEV,(P2),0 ; Have a device?
STOR. T1,FDBDEV,(P2) ; No, use DSK
MOVX T1,$IOREA ; Get the function
MOVE T2,P2 ; And the FDB
PUSHJ P,F$OPEN ; Open the file
JRST .+2 ; Couldn't, check if more to try
JRST EPIRED ; Go it, go read the file
SOJG P3,[MOVE T1,P2 ; Get the FDB address
PUSHJ P,F$RSET ; Clear the channel
JRST EPILOP] ; Loop if anything left
PJRST F$ERR ; No, give up
; Here after file has been opened.
EPIRED: MOVX T1,D.EPIS ; Get the default size
PUSHJ P,M$GTXT ; Get the text buffer
MOVEI T2,EPIQRG ; Get the pointer address
PUSHJ P,M$USEB ; And set it up
STOR. P2,BLKFDI,(T1) ; Store as input file
BITON T2,TF.OPI,.BKTFL(T1) ; And flag it
MOVEI T1,EPIQRG ; Get the TPT address
MOVX T2,.INFIN ; read the entire file
MOVX T3,.INFIN ; . . .
MOVX T4,.INFIN ; . . .
PUSHJ P,F$RBUF ; Read the data
LOAD. T1,TPTADR,+EPIQRG ; get the buffer address
BITOFF T2,TF.OPI,.BKTFL(T1) ; No input file now
ZERO. ,BLKFDI,(T1) ; . . .
; Here after file has been read in. Store the Q-register pointer and
;execute the Q-register if this was an EI command
EPIR.E: LOAD. T1,QRGDTP,(P1) ; Get the data type
MOVX T2,$DTTXT ; And the new data type
XCT RQRGTB(T1) ; And release the old data
EPIR.4: LOAD. T1,TPTADR,+EPIQRG ; Get the buffer address
MOVEI T2,$QRTPT(P1) ; And the pointer address
PUSHJ P,M$USEB ; Add the user
MOVEI T1,EPIQRG ; Get the old pointer
PUSHJ P,M$RELB ; And remove it
MOVE T1,P2 ; Get the FDB address
PUSHJ P,F$CLOS ; Close the file
PJRST F$ERR ; Give up
MOVE T1,P2 ; Get it again
PUSHJ P,M$RBLK ; And return it
MOVE T2,P1 ; Get the Q-register index
TXNE S,S.DOIT ; EI command?
PJRST MAC.0 ; Yes, go execute the Q-register
POPJ P, ; No, return
SUBTTL E Commands -- EQ - Write out Q-register
; This command will write out the contents of the given Q-register
; to the file spec given. The command format is EQ(q)file.ext$,
; where q is the Q-register name. If the (q) is missing it will
; use Q-register *.
EQCMD: MOVX T1,"*" ; Get the default
PUSHJ P,SCNQRG ; And try for a Q-register name
JFCL ; Couldn't?
LOAD T2,$QRFLG(T1),QR$WRT ; Get the flag
JMPT T2,[ERROR E.DOQ] ; Display only Q-register
MOVE P1,T1 ; Get the index
PUSHJ P,QTXTEI ; And try for text
MOVX T1,.FDLEN ; Get an FDB
MOVX T2,.BTFDB ; . . .
PUSHJ P,M$GBLK ; Get it
MOVE P2,T1 ; Save in a safer place
SETZ T2, ; No switches
PUSHJ P,F$PARS ; Parse the spec
PJRST F$ERR ; Couldn't
MOVX T3,<SIXBIT |DSK|> ; Get the device
CFXN. T4,FDBDEV,+DEF$EQ,0 ; Is this zero ?
STOR. T3,FDBDEV,+DEF$EQ ; Yes - Store a device
MOVEI T2,DEF$EQ ; Get the default block
MOVE T1,P2 ; Get the other FDB address
MOVEI T3,PDF$EQ ; get the permanent defaults
PUSHJ P,F$DFLT ; And default it
MOVX T1,$IOWRI ; Want to write the file
MOVE T2,P2 ; . . .
PUSHJ P,F$OPEN ; Open up the file
PJRST F$ERR ; Couldn't
MOVE T1,P1 ; Get the index back
PUSHJ P,QTXTEI ; And get the block address
MOVE P1,T1 ; . . .
MOVX T2,.TRUE ; Set up to write entire file
MOVX T3,.FALSE ; . . .
MOVE T4,P2 ; Get the FDB address
SETZ A2, ; Start at first character
LOAD. A1,BLKEND,(T1) ; And write to the end
PUSHJ P,F$WBUF ; Write out the buffer
MOVE T1,P2 ; Get the FDB address
PUSHJ P,F$CLOS ; And close the file
PJRST F$ERR ; Couldn't?
MOVE T1,P2 ; Get the FDB address again
PJRST M$RBLK ; And return the buffer
SUBTTL E Commands -- EG - Exit closing all files & run COMPIL
;+
;.HL1 EG command
; This command will cause TECO to exit copying all input files to output
;files and all files will then be closed. It will then cause COMPIL to be run
;from SYS:
;-
EGCMD: TXO F,F.RUN ; Flag we are running a program
MOVX T1,<SIXBIT /SYS/> ; Get the default device to run from
MOVEM T1,ED$BLK+$RNDEV ; Store the device name
MOVX T1,<SIXBIT /COMPIL/> ; Get the program name
MOVEM T1,ED$BLK+$RNNAM ; Store the name
SETZM ED$BLK+$RNEXT ; Clear the extension
SETZM ED$BLK+$RNCOR ; Clear the core argument
MOVEI T1,1 ; Get the run offset
HRLM T1,ED$COD+RNOARG ; Store the run offset
FALL (FINISH) ; Fall into the EX code
SUBTTL E Commands -- EX -- Exit closing all files
;+
;.hl1 EX command
; This command will cause TECO to exit copying all input files to output
;files and all files closed.
;.hl1 ^Z command
; This command will cause TECO to exit and close all open files. It will
;not copy input to output, nor will it write out the current buffers.
;-
FINISH: TDZA P1,P1 ; Flag we want everything copied
DECDMP: SETO P1, ; Flag no writing
PUSHJ P,DOXITQ ; Do the user's exit routine
JMPNS .+2 ; Screen mode?
PUSHJ P,SC$FIN ; Set up for exiting
TXZ S,S.SCRN ; And flag not screen mode anymore
PUSHJ P,T$SRTN ; Set up the correct type out routines
MOVEI T1,TTYFDB ; Get the terminal FDB
PUSHJ P,F$RSET ; Reset the channel
MOVE T1,P1 ; Get the flag
PUSHJ P,FINI.0 ; Call common routine
JRST CONT ; He re-entered, don't exit
TXNE F,F.RUN ; Have something to run?
JRST ED$COD ; Yes, go do it
MONRT. ; And exit
CONT: SETZM XCTING ; Flag not executing
PJRST @.JBREN ; And fake a re-enter to re-open the world
SUBTTL E Commands -- EX -- Common routines -- FINI.0
;+
;.hl1 FINI.0
; This routine will do the work of the EX, EG, and ^Z commands. It will
;search through free core finding all the text buffers and closing there
;associated files. It will also close the LOG file.
;-
FINI.0: MOVE P4,T1 ; Get the flag into a safer place
MOVE P1,FSTBLK ; And the start of the allocated core
SETO P2, ; Flag no input files seen yet
FINI.1: CFXE. T1,BLKTYP,(P1),.BTTXT ; Is this a text block?
JRST FINI.5 ; No, try the next
MOVE T1,P1 ; Get the block address
MOVE T2,P4 ; And get the flag
SETZ T3, ; Flag we want re-enters to work
PUSHJ P,CLSFIL ; Go close the files
POPJ P, ; User typed reenter
JUMPL T1,FINI.5 ; If no input file, continue on
JUMPGE P2,.+2 ; Any input files yet?
SETZ P2, ; No, clear for first one
ADD P2,T1 ; And count whether this one had an output file
; Here when all files are closed.
FINI.5: LOAD. T1,BLKSIZ,(P1) ; Get the size of the block
MOVX T2,BF.LST ; Get the bit to check
TDNN T2,.BKFLG(P1) ; Is this the last block on the page?
JRST FINI.6 ; No, go advance to next one
LOAD. P1,BLKNXT,(P1) ; Yes, get the next page
PG2ADR P1 ; Convert to page number
JUMPE P1,FINI.8 ; Done?
JRST FINI.1 ; Go try this block
FINI.6: ADD P1,T1 ; Point to the next block
JRST FINI.1 ; And loop for this block
FINI.8: JUMPN P4,FINI.9 ; Don't give an error message if no writing
JUMPN P2,FINI.9 ; Any output files?
MOVX T1,$IOWRI ; Get the function
MOVEI T2,TTYFDB ; Get the terminal FDB
PUSHJ P,F$OPEN ; Open it
JFCL ; Can not happen
JMPNS [ERROR E.NFO] ; Screen mode?
SETOM MESFLG ; Flag we need to do a complete refresh
PUSHJ P,SC$ERS ; Clear the lines, so everything will refresh
ERROR E.NFO ; No, No file for output error
FINI.9: SKIPN T1,FDB$EL ; Have a log file?
PJRST .POPJ1 ; No, give the good return
PUSHJ P,F$CLOS ; Yes, close the file
PJRST F$ERR ; Couldn't
MOVE T1,FDB$EL ; Get the address again
SETZM FDB$EL ; No more log file
PUSHJ P,M$RBLK ; And return the block
PJRST .POPJ1 ; And give the good return
SUBTTL E Commands -- EX -- Common routines -- CLSFIL
;+
;.hl1 CLSFIL
; This routine will close any files associated with a text buffer.
;.b.literal
; Usage:
; MOVE T1,Text.buffer.address
; MOVEI T2,(0 for EX type close, -1 for ^Z type close)
; PUSHJ P,CLSFIL
; (user typed re-enter)
; (done)
;
;.end literal
;-
CLSFIL: $SAVE <P1,P2,P3,P4> ; Save the Px ac's
MOVE P1,T1 ; Get the text buffer address
MOVE P4,T3 ; And get the flag
HRLI P4,(T2) ; Also get the other flag
PUSHJ P,GETFDI ; And get the input FDB
SETZ T1, ; Isn't any, flag it
MOVE P3,T1 ; Copy into correct place
MOVE T1,P1 ; Get the text buffer address again
PUSHJ P,GETFDO ; And get the output address
SETZ T1, ; Isn't one
MOVE P2,T1 ; Copy the address
JUMPE P2,CLSF.1 ; If no output file, nothing to copy into
JUMPL P4,CLSF.0 ; Need to copy stuff first?
MOVE T1,P1 ; Get the buffer address
SETZ T2, ; And flag re-enter should abort
HRRE T3,P4 ; Get the re-enter flag
PUSHJ P,F$COPY ; Copy the file data
JRST CLSF.4 ; Typed re-enter, go handle it
CLSF.0: JUMPE P2,CLSF.1 ; Have an output file to close?
JUMPL P4,CLSF.2 ; If control Z then don't finish EB files
MOVX T1,FD.EB ; Check if file is EB'ed
TDNE T1,.FDFLG(P2) ; . . .
JRST CLSF.5 ; Yes, handle special
CLSF.2: MOVE T1,P2 ; Yes, get the address
PUSHJ P,F$CLOS ; And close the file
PJRST F$ERR ; Couldn't
MOVE T1,P2 ; Get the FDB address again
PUSHJ P,M$RBLK ; And return it
CLSF.1: JUMPE P3,CLSF.3 ; Have an input file to close?
MOVE T1,P3 ; Yes, get the address
PUSHJ P,F$CLOS ; And close it
PJRST F$ERR ; Couldn't, go complain
MOVE T1,P3 ; Get the address again
PUSHJ P,M$RBLK ; And return the block
JRST CLSF.3 ; Go turn off the bits
CLSF.4: LOAD. T1,TPTADR,+TXTBUF ; Check if we have the current text buffer
CAIE T1,(P1) ; No, skip this
POPJ P, ; Return
PJRST YANK ; Pull in a new buffer and return
CLSF.5: PUSHJ P,FIN.EB ; Finish up the EB'ed file
; All done, flag we don't have any open files
CLSF.3: BITOFF T1,TF.OPO!TF.OPI,.BKTFL(P1) ; Flag no files open
MOVX T1,-1 ; get a -1
JUMPE P3,.POPJ1 ; If no input file, just return the -1
SETZ T1, ; Get a zero
JUMPE P2,.POPJ1 ; If no output file, return 0
AOJA T1,.POPJ1 ; And return
SUBTTL E Commands -- EX -- Common routines -- FIN.EB
;+
;.hl1 FIN.EB
; This routine will close the files from an EB command. It assumes that
;all data has already been written into the output file.
;.b.literal
; Usage:
; MOVE P1,Text.buffer.address
; MOVE P2,Output.FDB.address
; MOVE P3,Input.FDB.address
;
;.end literal
;-
FIN.EB: $SAVE <P1,P2,P3,P4> ; Save P1-P4
$SAVE <A1> ; Save A1
LOAD. P4,BLKTMP,(P1) ; Get the FDB address for the .BAK file
LOAD. A1,FDBEXT,(P4) ; Save the extension
BITOFF T1,TF.OPO,.BKTFL(P1) ; Flag no more input or output files
MOVE T1,P2 ; First close the output file
PUSHJ P,F$CLOS ; . . .
PJRST F$ERR ; Couldn't?
BITOFF T1,TF.OPI,.BKTFL(P1) ; Flag no more input or output files
MOVE T1,P3 ; Close the input file
PUSHJ P,F$CLOS ; . . .
PJRST F$ERR ; Couldn't
STORI. <'BAK'>,T1,FDBEXT,(P4) ; Store the extension
MOVX T1,$IODEL ; Delete the back file first
MOVE T2,P4 ; If there is one
PUSHJ P,F$OPEN ; Do it
JRST [CAXE T1,ERFNF% ; File not found?
PJRST F$ERR ; No, give up
JRST .+1] ; Yes, all is okay
MOVEI T1,(P3) ; Get the address of the FDB
HRLI T1,(P4) ; Get the other address
BLT T1,.FDLEN-1(P3) ; Move the data
STOR. A1,FDBEXT,(P3) ; And store the extension
MOVE T1,P3 ; Set up to rename the input file
MOVE T2,P4 ; . . .
PUSHJ P,F$RENM ; Do it
PJRST F$ERR ; Couldn't
MOVE T1,P2 ; Now rename the output file to the correct thing
MOVE T2,P3 ; . . .
PUSHJ P,F$RENM ; Do it
PJRST F$ERR ; Couldn't
MOVE T1,P2 ; Get output FDB
PUSHJ P,M$RBLK ; And return it
MOVE T1,P3 ; Get the input FDB
PUSHJ P,M$RBLK ; And return it
MOVE T1,P4 ; Get the other
PUSHJ P,M$RBLK ; And return it also
POPJ P, ; And return
SUBTTL E Commands -- ED (Run a program on exit)
;+
;.HL1 ED
; The routine EDCMD will process the ED TECO command. This routine will call
;the file specification parser to determine the file to run. It will then move
;the information into the data segment so that the EX or EG commands will know
;what to run.
; The valid switches for this command are: /RUNOFFSET:n and /CORE:n. These
;switches specifiy different arguments for the RUN UUO.
;-
EDCMD: SKIPE T1,ED$FDB ; Have an FDB (an error occured last time out)
JRST [SETZM ED$FDB ; Yes - Clear the old pointer
JRST EDCM.2] ; And continue processing
MOVX T1,.FDLEN ; Get the length of an FDB
MOVX T2,.BTGEN ; Core section to get it from
PUSHJ P,M$GBLK ; Allocate the block
EDCM.2: MOVE P1,T1 ; Copy the address to a safer place
MOVEI T2,EDPTR ; Get the pointer to the ED switches
STORE T3,ED$BEG,ED$END,-1 ; Clear the switch area
PUSHJ P,F$PARS ; Parse the file input
JRST EDCM.E ; Process the error
LOAD. T1,FDBDEV,(P1) ; Get the device specified
SKIPN T1 ; Device specified ?
MOVX T1,<SIXBIT |SYS|> ; No, Assume from SYS:
MOVEM T1,ED$BLK+$RNDEV ; Store it in the block
LOAD. T1,FDBNAM,(P1) ; Get the program name
MOVEM T1,ED$BLK+$RNNAM ; Store it in the block
LOADS. T1,FDBEXT,(P1) ; Get the extension
MOVEM T1,ED$BLK+$RNEXT ; Store the extension
CFXN. ,FDBPPN,(P1),0 ; Is this zero ?
JRST EDCM.0 ; Yes - Skip this section
; Now setup the path to run the program from
LOAD. T1,FDBPPN,(P1) ; Get the PPN
MOVEM T1,ED$PTH+.PTPPN ; Store it in the path block
MOVEI T1,ED$PTH ; Get the address of the path block
MOVEM T1,ED$BLK+$RNPPN ; Store the pinter to the path block
MOVX T2,<<-.PTMAX-.PTSFD>,,.PTSFD> ; Get the AOBJN pointer
MOVEI T3,.FDSFD(P1) ; Get the address of the SFDs
EDCM.1: MOVE T1,(T3) ; Get an SFD
MOVEM T1,ED$PTH(T2) ; Store it in the path block
ADDI T3,1 ; Increment the pointer
AOBJN T2,EDCM.1 ; Loop for all items
SKIPA ; Enter the common code again
EDCM.0: SETZM ED$BLK+$RNPPN ; Clear the PPN
SKIPGE T1,LS$COR ; Have a core argument ?
SETZ T1, ; No - Assume zero
MOVEM T1,ED$BLK+$RNCOR ; Store it in the RUN block
SKIPGE T1,LS$RUN ; Have a run offset ?
SETZ T1, ; No - Assume zero
HRLM T1,ED$COD+RNOARG ; Store it in the code
TXO F,F.RUN ; Flag something to run on an exit
MOVE T1,P1 ; Copy the FDB address back again
PJRST M$RBLK ; Return the block
; Here on an error parsing the file specification.
EDCM.E: MOVEM P1,ED$FDB ; Store the FDB for later
PJRST F$ERR ; Issue the error message
; The following are the valid switches on the ED command
DEFINE ED$SW,<
SW CORE,LS$COR,F$CORE,,SW.VRQ ;;/CORE:n
SW RUNOFFSET,LS$RUN,.IOCTW,,SW.VRQ ;;/RUNOFFSET:n
> ; End of ED$SW macro definition
DOSWTCH (ED,ED$SW) ; Generate the switch block
EDPTR: SWTPTR (ED) ; Generate the pointer to the switch block
; The following is the code that is moved into the low segment to
; do the RUN UUO.
RUNCOD:!PHASE 0 ; Make this phased
MOVSI T1,1 ; Get rid of the high segment
CORE T1, ; . . .
JFCL ; Don't care
MOVE T1,RNOARG+ED$COD ; Get the argument
RUN T1, ; Do the RUN UUO
HALT ; Can not continue
RNOARG:!EXP ED$BLK ; Address of the run block
RUNLEN:!DEPHASE ; Back to normal
SUBTTL E Commands -- ET - Set type out mode
;ET COMMAND
; 0 = Normal typeout
; 1 = Literal typeout
; 2 = Image typeout (IONEOU)
TYOCTL: TXNE F,F.ARG ; Have an arg?
JRST TYOCT1 ; Yes, go set new value
SKIPE A1,ETVAL ; Get ET value
CHKEO EODEC,RTONES ; If EO > 2 and non-zero, return -1
PJRST VALRET ; Return the value
TYOCT1: CHKEO EODEC,TYOCT3 ; Jump if old style ET
SKIPL A1 ; Check range
CAILE A1,2 ; ...
ERROR E.ETA ; Illegal value
TYOCT2: MOVEM A1,ETVAL ; Store value
POPJ P, ; And return
TYOCT3: JUMPE A1,TYOCT2 ; Old ET can be only 0 or 1
MOVEI A1,1 ; Non zero means 1
JRST TYOCT2 ; Go store and return
SUBTTl E Commands -- EO
;+
;.HL1 OLDMOD
;This routine will do the processing for the EO command.
;-
OLDMOD: TXNE F,F.ARG ; Have an arg?
JRST OLD1 ; Yes, go set value of EOFLAG
MOVE A1,EOFLAG ; No, return the current value
PJRST VALRET
OLD1: CAIG A1,0 ; Greater than zero?
MOVEI A1,EOVAL ; No, use standard value
CAILE A1,EOVAL ; Is value within range?
ERROR E.EOA ; No, give the error
MOVEM A1,EOFLAG ; Yes, set the value
; Now set up the instruction table for the CHKEO tables.
OLD.0: MOVSI T1,-<EOVAL> ; Get the loop pointer
MOVX T2,<JFCL> ; And get the no-op to use for things to avoid
OLD.2: CAIN A1,1(T1) ; Get to the correct one yet?
MOVX T2,<TRNA> ; Yes, make it a skip instruction
MOVEM T2,EOXCTS(T1) ; Save the instruction
AOBJN T1,OLD.2 ; And loop for all the entries.
POPJ P, ; And return
EOMAX: EXP EOVAL ; Max EO level for error message
SUBTTL E Commands -- EU command
;+
;.HL1 TYCASE
;This routine will execute the EU command.
;-
TYCASE: TXNE F,F.ARG ; Have an arg?
JRST TYCAS1 ; Yes, go handle it
MOVE A1,TYCASF ; No, return the current value
PJRST VALRET ; Return it
TYCAS1: MOVEM A1,TYCASF ; Set the flag
CHKEO EO124,.POPJ ; Just return if old
CAXL A1,-1 ; Check if argument is valid
CAXLE A1,1 ; Only -1, 0, and 1 are okay
ERROR E.EUO ; EU value out of range
POPJ P, ; Value is okay
POPJ P, ; And return
SUBTTL E Commands -- ES
AUTOTY: TXNE F,F.ARG ; Arg given?
JRST AUTOT1 ; Yes, go set type out char
MOVE A1,AUTOF ; No, get the current auto type out character
PJRST VALRET ; And return it
AUTOT1: MOVEI T1,.CHLFD ; Get the default character
CAIL A1,1 ; Is the character legal?
CAILE A1,37 ; . . .
MOVE T1,A1 ; Yes, use what he gave
MOVEM T1,AUTOF ; Set the new value
POPJ P, ; And return
SUBTTL E Commands -- EH - Change error message level
ERRSET: TXNE F,F.ARG ;ARG SEEN?
JRST ERRSE1 ;YES, RESET INDICATOR
HLLZ T1,ERRLEN ;NO, RETURN CURRENT VALUE OF FLAG
MOVSI T2,-3 ;NUMBER OF POSSIBILITIES
ERRS.0: TDNE T1,JWTABL(T2) ;BIT ON?
MOVEI A1,1(T2)
AOBJN T2,ERRS.0 ;NO, LOOP
JRST VALRET
JWTABL: XWD JW.WPR_-22,JW.WPR_-22
XWD JW.WFL_-22,<JW.WPR!JW.WFL>_-22
XWD JW.WCN_-22,<JW.WPR!JW.WFL!JW.WCN>_-22
ERRSE1: CAILE A1,3 ;3 IS HIEST
MOVEI A1,3 ;FORCE IT DOWN IF GREATER
MOVE T1,PRMERR ;ASSUME DEFAULT
SKIPLE A1 ;OK ASSUMPTION?
HRLZ T1,JWTABL-1(A1) ;NO
MOVEM T1,ERRLEN ;2 BECOMES 0 = MEDIUM
POPJ P, ; Return
SUBTTL E Commands -- EK - Kill off the output file
EKILL: LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address
PUSHJ P,GETFDO ; Get the output FDB address
POPJ P, ; Isn't one, just return
MOVE P1,T1 ; Save a copy
PUSHJ P,F$RSET ; Close the file
LOAD. T1,TPTADR,+TXTBUF ; Get the buffer address back again
BITOFF T2,TF.OPO,.BKTFL(T1) ; Flag file is not open anymore
PUSHJ P,GETFDI ; Have an input file?
JRST EKIL.1 ; No, skip this
BITOFF T2,FD.EB,.FDFLG(T1) ; Yes, flag it is not EB'ed any more
TXNE T2,FD.ENQ ; File ENQ'ed?
PUSHJ P,F$DEQ ; Yes, remove the lock
EKIL.1: MOVE T1,P1 ; Get the address back
PJRST M$RBLK ; And return it
SUBTTL E Commands -- EN - rename the input file
;+
;.HL1 ENCMD
;This routine will execute the EN command. This command causes a file
;to be renamed.
;-
ENCMD: MOVX T1,.FDLEN ; Get the size of an FDB
MOVX T2,.BTFDB ; And the block type
PUSHJ P,M$GBLK ; Get a block
MOVE P1,T1 ; Get the address
SETZ T2, ; No switches
PUSHJ P,F$PARS ; Parse the file spec
PJRST F$ERR ; Couldn't
LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address
MOVEM P1,LASFDB ; Save the FDB address in case of error
PUSHJ P,GETFDI ; Get the input file name
ERROR E.ENE ; EN error
MOVE P2,T1 ; Get the address
MOVX T1,FD.EB ; Check if the file is EB'ed
TDNE T1,.FDFLG(P2) ; Check if EB'ed?
ERROR E.ENE ; Can't rename EB'ed file
DMOVE T1,P1 ; Copy the FDBs
PUSH P,.FDNAM(P1) ; Save the file name
PUSHJ P,E$DFLT ; Cause any defaulting
POP P,.FDNAM(P1) ; And reset the file name
MOVE T1,P2 ; Get the input FDB
PUSHJ P,F$CLOS ; And close the file
PJRST F$ERR ; Couldn't
LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address again
BITOFF T2,TF.OPI,.BKTFL(T1) ; Clear the input flag
MOVE T1,P2 ; Get the addresses again
MOVE T2,P1 ; . . .
PUSHJ P,F$RENM ; Rename the file
PJRST F$ERR ; Couldn't
MOVE T1,P1 ; Get the old input FDB
PUSHJ P,M$RBLK ; Return it
MOVE T1,P2 ; Get the other FDB
PJRST M$RBLK ; And return it
SUBTTL E Commands -- ER - Read a file
;+
;.hl1 ER command
; This command is used to open a file for input. It will associate the
;file with the current text buffer.
;-
OPNRD: LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address
PUSHJ P,GETFDI ; Have an input file already?
JRST OPNR.1 ; No, no worries
MOVE P1,T1 ; Save a copy
LOAD. T3,TPTADR,+TXTBUF ; Get the buffer address
BITOFF T2,TF.OPI,.BKTFL(T3) ; Clear the open input flag
PUSHJ P,F$CLOS ; Close off the old input file
PJRST F$ERR ; Couldn't, punt
JRST OPNR.2 ; Already have an FDB, no need for a new one
OPNR.1: MOVX T1,.FDLEN ; Get the length
MOVX T2,.BTFDB ; And the block type
PUSHJ P,M$ZBLK ; get the block
MOVE P1,T1 ; Get the address
OPNR.2: SETOM ER$BEG ; Clear the only switch
; STORE T1,ER$BEG,ER$END,-1 ; Clear the switch block
MOVE T1,P1 ; Get the FDB address
MOVEI T2,ERSWT ; And the pointer to the switch block
PUSHJ P,F$PARS ; Parse the block
PJRST F$ERR ; Give up
; Default the ER switches
MOVE T4,.FDFLG(P1) ; Get the flags from the FDB
TXNE T4,FD.DEF ; /DEFAULT given?
SETOM DFTYNK ; Yes, default the /YANK value
TXNE T4,FD.NDF ; /NODEFAULT given?
JRST OPNR.N ; Yes, skip this
MOVE T1,LS$YNK ; Get the switch value
CAXN T1,-1 ; Default?
MOVE T1,DFTYNK ; Get the default
MOVEM T1,LS$YNK ; Set the switch value
MOVEM T1,DFTYNK ; And save as default
OPNR.N: XMOVEI T1,ER$BEG ; Get the start of the ER switches
XMOVEI T2,ER$DFS ; And the default ER switches
MOVEI T3,ER$END-ER$BEG+1 ; And the length of the table
PUSHJ P,E$DFSW ; Default the switch values
; Now do the random defaulting
OPNR.0: MOVEI T1,DEF$ER ; Get the default block
MOVEI T2,DEF$EW ; Use the EW block forst
PUSHJ P,E$DFLT ; Do the defaulting
; Do the defaulting for the file specification now
MOVEI T3,PDF$ER ; Get the perm defaults
MOVEI T2,DEF$ER ; Get the default block
MOVE T1,P1 ; Get the FDB address
PUSHJ P,F$DFLT ; And default the block
MOVX T1,$IOREA ; Set up to read the file
MOVE T2,P1 ; . . .
PUSHJ P,F$OPEN ; And open it up
PJRST F$ERR ; Give up
LOAD. T1,TPTADR,+TXTBUF ; Get the buffer address again
STOR. P1,BLKFDI,(T1) ; Store the FDB address
BITON T2,TF.OPI,.BKTFL(T1) ; Flag we have a file
SKIPLE LS$YNK ; User want /YANK?
PJRST YANK ; Yes, go do it
POPJ P, ; Return happy
DEFINE ER$SW,<
SW NOYANK,LS$YNK,,0,
SW SUPLSN,SR$SLS,,1,
SW YANK,LS$YNK,,1,
> ; End of ER$SW macro
DOSWTCH(ER,ER$SW)
ERSWT: SWTPTR(ER)
SUBTTL E Commands -- EB - Edit and backup command
;+
;.HL1 EB command
; This command will cause the file to be edited and a backup of the orginal
;file to be created when the editing is finished. This command will take
;both input and output modes. The following are a list of the allowed switches.
;.literal
;
; Switches:
; /GENLSN Same as /OMODE:LSA
; /IMODE:mode Sets the input mode to the specified mode
; /INPLACE Edit the file in the path it was found in
; /MODE:mode Sets the input and output mode
; /OMODE:mode Sets the output mode
; /READONLY Set the file as only being read
; /SUPLSN Sets the output mode to /OMODE:ASCII
;.end literal
;-
DEFINE EB$SW,<
SW GENLSN,SWTOMD,,$FMLSA,
SW IMODE,SWTIMD,F$KEY,MODPTR,SW.VRQ!SW.KEY
SW INPLACE,LS$INP,,0,
SW MODE,SWTIMD,F$KEY,MODPTR,SW.VRQ!SW.KEY
SW NOYANK,LS$YNK,,0,
SW OMODE,SWTOMD,F$KEY,MODPTR,SW.VRQ!SW.KEY
SW READONLY,LS$RED,,0,
SW SUPLSN,SWTOMD,,$FMASC,
SW YANK,LS$YNK,,1,
> ; End of EB$SW macro definition
DOSWTCH(EB,EB$SW) ; Generate the EB switches
EBPTR: SWTPTR(EB) ; Generate the switch pointer
DEFINE FK(A,B,C),<EXP SIXBIT /'B'/>
MODKEY: FM$KEY ; Generate the key words
MOD.L==.-MODKEY ; Generate the length
MODPTR==:<-MOD.L,,MODKEY> ; Generate a symbol
; Main routine
EBCMD: MOVX T1,.FDLEN ; Get the length of an FDB
MOVX T2,.BTFDB ; From the FDB area
PUSHJ P,M$GBLK ; Allocate the block
MOVE P1,T1 ; Move to a safer place
SETOM SWTIMD ; Set the external values
SETOM SWTOMD ; . . .
SETOM LS$INP ; Set the local switch
SETOM LS$RED ; . . .
SETOM LS$YNK ; . . .
MOVEI T2,EBPTR ; Get the EB switch pointer
PUSHJ P,F$PARS ; Parse the file specification
JRST F$ERR ; Failed
LOAD. T1,FDBFLG,(P1) ; Get the flags
TXNE T1,FD.DEF ; /DEFAULT?
JRST [SETOM DFTOMD ; Forget the defaults
SETOM DFTIMD ; . . .
SETOM DFTYNK ; Clear default /YANK value
JRST .+1] ; Continue on
TXNE T1,FD.NDF ; /NODEFAULT given?
JRST EBCM.D ; Yes, skip defaulting
MOVE T1,SWTIMD ; Get the /IMODE argument
CAXN T1,-1 ; Any given?
MOVE T1,DFTIMD ; No, get the default
MOVEM T1,SWTIMD ; Save as current /MODE
MOVEM T1,DFTIMD ; And as new default
MOVE T1,SWTOMD ; Get the output mode
CAXN T1,-1 ; Any given?
MOVE T1,DFTOMD ; No, get the default
MOVEM T1,SWTOMD ; Save as current /OMODE
MOVEM T1,DFTOMD ; And as new default
MOVE T1,LS$YNK ; Get the /YANK switch
CAXN T1,-1 ; Any given?
MOVE T1,DFTYNK ; No, use default
MOVEM T1,LS$YNK ; Save it back
MOVEM T1,DFTYNK ; . . .
EBCM.D: SKIPL T1,SWTIMD ; Get the /IMODE value
STOR. T1,FDBMOD,(P1) ; There was one, store it
SKIPGE LS$INP ; Was /INPLACE specified ?
JRST EBCM.0 ; No - Skip this
BITON T1,FD.INP,.FDFLG(P1) ; Yes - Light the flag
; Now do the random defaulting
EBCM.0:
; MOVEI T1,DEF$EB ; Place to store the defaults
; MOVEI T2,DEF$ER ; From the ER
; PUSHJ P,E$DFLT ; Do it
MOVEI T1,DEF$ER ; Place to store the defaults
MOVEI T2,DEF$EW ; From the EW
PUSHJ P,E$DFLT ; Do it
; Now to the per file specification defaulting
MOVE T1,P1 ; Get the FDB address
MOVEI T2,DEF$ER ; Get the default block
MOVEI T3,PDF$ER ; Get the perm defaults address
PUSHJ P,F$DFLT ; And default the FDB
SKIPL LS$RED ; Read only?
JRST EBCM.9 ; Yes, just do an ER command
LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address
PUSHJ P,GETFDI ; Get the input FDB address
JRST EBCM.3 ; None, try output
MOVX T2,FD.EB ; Check if this is an EB'ed file
TDNN T2,.FDFLG(T1) ; . . .
JRST EBCM.5 ; Okay, just close the file
MOVE T1,P1 ; Get the FDB address of the new file
PUSHJ P,M$RBLK ; And return it
ERROR E.EBO ; EB still open
EBCM.5: PUSH P,T1 ; Save the address
PUSHJ P,F$CLOS ; Close the input file
PJRST F$ERR ; Couldn't
POP P,T1 ; Get the FDB address back
PUSHJ P,M$RBLK ; And return it
EBCM.3: LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address
BITOFF T2,TF.OPO!TF.OPI,.BKTFL(T1) ; Clear the open file flags
PUSHJ P,GETFDO ; And try for an output file
JRST EBCM.4 ; None, skip this
PUSH P,T1 ; Save the address
PUSHJ P,F$CLOS ; Close the file
PJRST F$ERR ; Couldn't
POP P,T1 ; Get the FDB address back
PUSHJ P,M$RBLK ; And return it
EBCM.4: MOVE T1,P1 ; Get the pointer to the FDB again
PUSHJ P,F$EB ; Make this file be in EB mode
JRST F$ERR ; Failed
LOAD. T3,TPTADR,+TXTBUF ; Get the address of the text block
STOR. T1,BLKFDO,(T3) ; Store the address of the temp file
STOR. T2,BLKTMP,(T3) ; Store the output FDB
STOR. P1,BLKFDI,(T3) ; Store the input FDB
BITON T1,TF.OPO!TF.OPI,.BKTFL(T3) ; Flag the file is open
SKIPLE LS$YNK ; /YANK given?
PJRST YANK ; Yes, go do it
POPJ P, ; Return to the caller
EBCM.9: SETOM SR$SLS ; Flag no /SUPLSN
MOVE T1,SWTOMD ; Get the output mode
CAXN T1,$FMASC ; Did we get the switch?
SETZM SR$SLS ; Yes, flag it
JRST OPNR.0 ; And go open for reading
SUBTTL E Commands -- EW - Write a file
SUBTTL E Commands -- EA - Append to a file
;+
;.hl1 EA and EW command
; This routine will open an output file. EA opens the file for appending
;EW will supersede the file. The file will be associated with the current
;buffer.
;-
OPNWRA: SKIPA P2,[EXP $IOAPP] ; Get the append function
OPNWR: MOVX P2,$IOWRS ; Get the write function
LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address
PUSHJ P,GETFDO ; And get the output FDB
JRST OPNW.1 ; Don't have one, don't need to close it
MOVE P1,T1 ; Copy the address
LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer
BITOFF T2,TF.OPO,.BKTFL(T1) ; Clear the file open flag
MOVE T1,P1 ; Get the FDB address back
PUSHJ P,F$RSET ; And delete the output we were making
JRST OPNW.2 ; Skip getting a new FDB
OPNW.1: MOVX T1,.FDLEN ; Get the length
MOVX T2,.BTFDB ; And the block type
PUSHJ P,M$GBLK ; Get the FDB
MOVE P1,T1 ; Into the correct place
OPNW.2:
; STORE T1,EW$BEG,EW$END,-1 ; Clear the switches
SETOM EW$BEG ; Clear the switch
MOVE T1,P1 ; Get the block address back
MOVEI T2,EWSWT ; And get the EW switches
PUSHJ P,F$PARS ; Parse the file spec
PJRST F$ERR ; Go give the error message
; Now do the random defaulting
MOVEI T1,DEF$EW ; Get the place to store into
MOVEI T2,DEF$ER ; From
PUSHJ P,E$DFLT ; Default this block
; Now default the file specification just input
MOVE T1,P1 ; Get the FDB address
MOVEI T2,DEF$EW ; Get the default block
MOVEI T3,PDF$EW ; Get the perm default block
PUSHJ P,F$DFLT ; Default the block
OPNW.0: MOVE T1,P2 ; Get the function (either write or append)
MOVE T2,P1 ; And the FDB address
PUSHJ P,F$OPEN ; Open the file
PJRST F$ERR ; Couldn't
MOVEI T1,(P1) ; Get the FDB address
PUSHJ P,F$ENQ ; ENQ. this file
JRST OPNW.4 ; Couldn't forget the whole thing
LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address back
STOR. P1,BLKFDO,(T1) ; Store the FDB address
BITON T2,TF.OPO,.BKTFL(T1) ; And flag it is there
POPJ P, ; Return
OPNW.4: HRRZM P1,LASFDB ; Store the FDB address
ERROR E.FAE ; And give the error
DEFINE EW$SW,<
SW GENLSN,SW$GLS,,1,
> ; End of EW$Sw
DOSWTCH(EW,EW$SW)
EWSWT: SWTPTR(EW)
SUBTTL E Commands -- EZ and EF
;EZ SELECTS THE OUTPUT DEVICE, ISSUES A REWIND COMMAND TO IT,
; ISSUES A COMMAND TO ZERO ITS DIRECTORY, AND OPENS THE FILE
; SPECIFIED (IF ANY).
ZERDIR: MOVX T1,.FDLEN ; Get the length of an FDB
MOVX T2,.BTFDB ; And the block type
PUSHJ P,M$GBLK ; Get the FDB
MOVE P1,T1 ; Get the address
STORE T2,EW$BEG,EW$END,-1 ; Clear the switch block
MOVEI T2,EWSWT ; Get the Ew switches
PUSHJ P,F$PARS ; And parse the file spec
PJRST F$ERR ; Couldn't
MOVE T1,P1 ; Get the FDB address
MOVEI T2,DEF$EW ; Get the default block
MOVEI T3,PDF$EW ; Get the default block address
PUSHJ P,F$DFLT ; And default the block
LOAD. T1,FDBDEV,(P1) ; Get the device name
IONDX. T1, ; Get the device index
JRST ZERD.1 ; Couldn't, just go try to open the file
UTPCLR T1, ; Clear the directory for the device
ZERD.1: MOVX P2,$IOWRI ; Get the F$OPEN function
PJRST OPNW.0 ; Go open the file for output
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
; SELECTING A NEW OUTPUT FILE.
CLOSEF: LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address
MOVE P1,T1 ; And get a copy
PUSHJ P,GETFDO ; Get the output FDB
POPJ P, ; None, just return
MOVE P2,T1 ; Get a copy
MOVE T1,P1 ; Get the buffer address back
PUSHJ P,GETFDI ; And try for an input FDB
JRST CLOS.1 ; None, can't be an EB'ed file
MOVE P3,T1 ; Save the address
MOVX T1,FD.EB ; Check if EB'ed
TDNN T1,.FDFLG(P2) ; . . .
JRST CLOS.1 ; No, just close the output file
PUSHJ P,FIN.EB ; Finish up
BITOFF T1,TF.OPO!TF.OPI,.BKTFL(P1) ; Flag no files open at all
POPJ P, ; And return
CLOS.1: MOVE T1,P2 ; Not EB'ed, just close the output
PUSHJ P,F$CLOS ; Close the file
PJRST F$ERR ; Something went wrong
BITOFF T1,TF.OPO,.BKTFL(P1) ; Clear the output open flag
MOVE T1,P2 ; Get the address
PJRST M$RBLK ; And return the core
SUBTTL E Commands -- EM - MTAPE UUO's
TP.MTP==777B8 ; MTAPE code
TP.ARG==777B17 ; Argument for TAPOP.
TP.TOP==777777 ; Function for TAPOP.
EMTAPE: LOAD. T1,TPTADR,+TXTBUF ; Get the text buffer address
PUSHJ P,GETFDI ; Get the input FDB address
ERROR E.NFI ; No file for input
MOVE P1,T1 ; Get the address
LOAD. T1,FDBCHN,(P1) ; Get the channel number
DEVCHR T1, ; And get the bits
TXNN T1,DV.MTA!DV.DTA ; Only do this for magtape or DECtape
POPJ P, ; No-op otherwise
JUMPGE A1,.+2 ; Valid MTAPE?
ERROR E.EMA ; No, punt it
MOVE T2,[XWD -MTPLEN,MTPTBL] ; Get the table pointer
CHKEO EO124,EMTA.1 ; If EO level before 200 use MTAPE args
JRST EMTA.3 ; Go handle TAPOP. arg
EMTA.1: LOAD T1,(T2),TP.MTP ; Get the MTAPE code
CAIE A1,(T1) ; Correct one?
JRST EMTA.2 ; Yes, go get it
LOAD A1,(T2),TP.TOP ; Convert the code to the TAPOP. equivalent
LOAD A2,(T2),TP.ARG ; And get the argument
CAXE A2,TP.ARG_-<ALIGN.(TP.ARG)> ; No argument?
TXO F,F.ARG2 ; No, flag we have a second arg
JRST EMTA.3 ; And go do it
EMTA.2: AOBJN T2,EMTA.1 ; Loop through the entire table
; Here to do the requested TAPOP. See if it requires or returns a value
EMTA.3: CAXGE A1,2000 ; Set function?
JRST EMTA.4 ; No, go read a value
TXNN F,F.ARG2 ; Have the second arg?
SETZ A2, ; No, assume zero
MOVE P2,[XWD 3,T2] ; Get the block pointer
MOVE T4,A2 ; Get the argument to set
JRST EMTA.5 ; Go do the TAPOP.
EMTA.4: MOVE P2,[XWD 2,T2] ; Get the pointer
EMTA.5: LOAD. T3,FDBCHN,(P1) ; get the channel
MOVE T2,A1 ; Get the funcion
TAPOP. P2, ; And do it
ERROR E.TPF ; Couldn't, TAPOP. failed
CAXL A1,1000 ; Read function?
CAXL A1,2000 ; . . .
POPJ P, ; No, just return
MOVE A1,P2 ; Yes, get the value
PJRST VALRET ; And return
MTPTBL: INSVL.(<MTWAT.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFWAT,TP.TOP)>
INSVL.(<MTREW.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFREW,TP.TOP)>
INSVL.(<MTEOF.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFDSE,TP.TOP)>
INSVL.(<MTSKR.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFFSB,TP.TOP)>
INSVL.(<MTBSR.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFBSB,TP.TOP)>
INSVL.(<MTEOT.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFSLE,TP.TOP)>
INSVL.(<MTUNL.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFUNL,TP.TOP)>
INSVL.(<MTBLK.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFWLG,TP.TOP)>
INSVL.(<MTSKF.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFFSF,TP.TOP)>
INSVL.(<MTBSF.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFBSF,TP.TOP)>
INSVL.(<MTDEC.>,TP.MTP)!<INSVL.(.TFMDD,TP.ARG)>!<INSVL.(.TFMOD,TP.TOP)>
INSVL.(<MTIND.>,TP.MTP)!<INSVL.(.TFM8B,TP.ARG)>!<INSVL.(.TFMOD,TP.TOP)>
INSVL.(<MTLTH.>,TP.MTP)!<INSVL.(-1,TP.ARG)>!<INSVL.(.TFLTH,TP.TOP)>
MTPLEN==.-MTPTBL
SUBTTL E Commands -- E? command
;+
;.hl1 EQUEST
; This routine will handle the E? command. This command is used to obtain
;information about various things.
;.b
;Command format:
;.lit
; E?(Q-REG-NAME)KEYWORD$
; - or -
; E?KEYWORD$
;
;.end lit
;-
; Definition of keyword table entry
INTSTR EQU,EQ,$,$SRLEN ; Generate $EQxxx
WORD RTN ; Routine address to call
WORD FLG ; Flags
INTFLG EQ
FLAG NMA ; Numeric argument allowed
ENDSTR ; End the structure
EQUEST: SETZ T1, ; Flag no default name
PUSHJ P,SCNQRG ; Scan off a Q-register name
SETZ T1, ; None, remember that
MOVE P1,T1 ; Save the QRG address
MOVEI T1,XCTBUF ; Get the address of the TPT
MOVEI T2,SKRCH ; And the routine
PUSHJ P,SCNKEY ; Get the keyword
ERROR E.UTK ; Not finished
MOVE T1,[XWD -EQULEN,EQUTBL] ; Get the table pointer
PUSHJ P,FNDKWD ; And look for the keyword
ERROR E.IKW ; Illegal keyword
MOVE T2,$EQFLG(T1) ; Get the flags
TXNE F,F.ARG ; Is there an argument?
TXNE T2,EQ$NMA ; Yes, is it allowed?
PJRST @$EQRTN(T1) ; Dispatch to the correct routine
ERROR E.NAA ; No, no argument allowed
; Table of keywords for E?
DEFINE EQUNAM,<
STR <CURRENT-TEXT-BUFFER>,<EQUCTB,>
;STR <DISPLAY-BOUNDS>,<EQUDBN,>
STR <DISPLAY-LINES>,<EQUDLN,>
STR <INPUT-FILE>,<EQUIFL,>
STR <LEAVE-BLANK-LINE>,<EQULBL,EQ$NMA>
STR <LAST-SEARCH-STRING-LENGTH>,<EQULSL>
STR <OUTPUT-FILE>,<EQUOFL,>
STR <Q-DIRECTORY>,<EQUQDR,>
STR <REVERSE-SEARCH-FLAG>,<EQURVS,EQ$NMA>
STR <SCREEN-ADDRESS>,<EQUSCA,EQ$NMA>
STR <TERMINAL-TYPE>,<EQUTTY,>
> ; End of EQUNAM
DEFINE STRSUB(RTN,FLAGS<0>),<EXP <IFIW RTN>,<FLAGS>>
SYN EQUNAM,STRTBL
DOSTR(EQU)
SUBTTL E Commands -- E? command -- CURRENT-TEXT-BUFFER
;+
;.hl2 CURRENT-TEXT-BUFFER
; This routine will return the name of the Q-register that is currently being
;edited.
;-
EQUCTB: JUMPN P1,[ERROR E.QNN] ; Can't have a Q-reg for this command
MOVEI T1,1 ; Get a character
PUSHJ P,GETSTR ; long buffer
MOVEI T1,SARG$1 ; Get the text buffer pointer
MOVEI T2,[$STRING(<^G/CUREDT/^N>)] ; Get the string
PUSHJ P,.INSRT ; Insert it
PJRST PASRET ; And return
SUBTTL E Commands -- E? command -- INPUT-FILE
;+
;.HL2 INPUT-FILE
; This routine will handle theE?(q-reg)INPUT-FILE$ command. This will return
;a string argument which is the file specification for the current input file
;for the Q-reg.
;-
EQUIFL: JUMPE P1,[ERROR E.QNR] ; If no Q-reg given, complain
MOVE T1,P1 ; Get the Q-reg address
PUSHJ P,QTXTEI ; And set up for reading text
PUSHJ P,GETFDI ; Get the input file
PJRST EQUNUL ; Return the null string
JRST EQUF.0 ; Join common routine
SUBTTL E Commands -- E? command -- OUTPUT-FILE
;+
;.HL2 OUTPUT-FILE
; This routine will handle the E?(q-reg)OUTPUT-FILE$ command. It will
;return a string which is the file specification of the output file for
;the given Q-register.
;-
EQUOFL: JUMPE P1,[ERROR E.QNR] ; If no Q-reg given, complain
MOVE T1,P1 ; Get the Q-reg address
PUSHJ P,QTXTEI ; And set up for reading text
PUSHJ P,GETFDO ; Yes, get the FD address
PJRST EQUNUL ; None, return the null string
EQUF.0: MOVE P1,T1 ; Get the FDB address
MOVEI T1,^D20 ; Probably about 20 characters
PUSHJ P,GETSTR ; Get the string
MOVEI T1,SARG$1 ; Get the address of the TPT
MOVEI T2,[$STRING(<^F/P1/^N>)] ; Get the address of the string
PUSHJ P,.INSRT ; Insert the text
PJRST PASRET ; And return
; Here to return the null string for Q-regs which don't have a file open.
EQUNUL: SETZ T1, ; Get 0 characters
PUSHJ P,GETSTR ; . . .
PJRST PASRET ; And return the null
SUBTTL E Commands -- E? command -- DISPLAY-LINES
;+
;.hl2 DISPLAY-LINES
; This routine will handle the E?(q-reg)DISPLAY-LINES$ command. It will
;return two arguments as taken by an E$ command.
;If the Q-register name is not given, it will use the current editing
;buffer.
;-
EQUDLN: MOVX T1,QR$VID ; Get the flag to check
JUMPN P1,EDLN.1 ; If we have the Q-reg name, just go do it
MOVE P1,CUREDT ; Otherwise use the current editing buffer
TDNN T1,$QRFLG(P1) ; Is this displayed?
XMOVEI P1,TXTBUF ; No, assume he wants TEXT-BUFFER
EDLN.1: LOAD. A1,QRGOFS,(P1) ; Get the offset to the first line
LOAD. A2,QRGNLN,(P1) ; And the number of lines
ADD A2,A1 ; Get the last line number
AOJ A1, ; And the first
TDNN T1,$QRFLG(P1) ; Is it really displayed?
SETZB A1,A2 ; No, return zeros
PJRST VALRT2 ; Return the values
SUBTTL E Commands -- E? command -- LEAVE-BLANK-LINE
;+
;.hl2 LEAVE-BLANK-LINE
; This routine will return or set the value of the display blank line flag
;for a Q-register.
;-
EQULBL: JUMPE P1,[ERROR E.QNR] ; If no Q-reg given, complain
MOVX T1,QR$DLC ; Get the flag to check
TXNE F,F.ARG ; Argument given?
JRST ELBL.1 ; Yes, go set the flag
TDNN T1,$QRFLG(P1) ; Check if it is set
PJRST RETZER ; No, return a zero
PJRST RTONES ; Yes, return -1
ELBL.1: CAIN P1,CMDBUF ; Can't change command buffer flgas
POPJ P, ; Just pretend we allowed it
ANDCAM T1,$QRFLG(P1) ; Turn off the flag
JUMPE A1,.POPJ ; And return if that is the desired setting
IORM T1,$QRFLG(P1) ; Otherwise turn it on
POPJ P, ; And return
SUBTTL E Commands -- E? command -- Q-DIRECTORY
;+
;.hl2 Q-DIRECTORY
; This routine will handle the E?Q-DIRECTORY$ command. This will return
;a string argument which is a list of the currently active Q-register names
;and some information about each.
;-
EQUQDR: MOVEI T1,^D50 ; Assume 50 characters for a start
PUSHJ P,GETSTR ; Get a text buffer for the string argument return
SKIPN T1,P1 ; Have a specific Q-reg?
JRST EQDR.0 ; Go do the complete listing
MOVEI T2,[$STRING(<^G/LASQRG/^N>)] ; Get the $STRING for the name
PUSHJ P,EQDR.S ; List this QRG
PJRST PASRET ; And return
; First loop through the single character names, checking for Q-registers
;with either text or a non-zero value.
;
EQDR.0: MOVSI P1,-<"Z"> ; Get the count for all possible characters (upper case)
EQDR.1: MOVX T1,CF.QRG ; See if a valid Q-reg name
TDNN T1,CHRFLG(P1) ; . . .
JRST EQDR.2 ; No, try the next
LOAD. T1,CDTQRI,+CHRFLG(P1) ; Get the Q-reg index
IMULX T1,$QRLEN ; Make the offset
ADDI T1,QTAB ; Plus the base address
MOVEI T2,[$STRING(<^7/CH/^N>)] ; Get the name type out string
MOVEI CH,(P1) ; Get the character name
LOAD. T3,QRGDTP,(T1) ; Get the data type
CAXN T3,$DTNUM ; Numeric value?
SKIPE $QRVAL(T1) ; Yes, non-zero?
PUSHJ P,EQDR.S ; List the info for this QRG
EQDR.2: AOBJN P1,EQDR.1 ; Loop for all of the permanent Q-registers
; Now do the special purpose long names
MOVE P1,[XWD -QNMLEN,QNMTBL] ; Get the pointer to the table
EQDR.3: MOVE CH,(P1) ; Get the address of the data
MOVE T1,2(CH) ; Get the QRG address
MOVEI T2,[$STRING(<^B/(CH)/^N>)] ; Get the string to type the name
PUSHJ P,EQDR.S ; Do it
AOBJN P1,EQDR.3 ; And do the rest of the special Q-regs
; Now go down the chain of the defined Q-registers.
LOAD. P1,LNKNXT,+QRGLNK ; Have any Q-registers defined?
PJUMPE P1,PASRET ; No, all done
EQDR.4: LOAD. T1,SYMQRG,(P1) ; Get the address of the QRG block
MOVE A1,T1 ; Get a safer copy
MOVEI T2,[$STRING(<^G/A1/^N>)] ; Get the string pointer to type out the name
PUSHJ P,EQDR.S ; Stuff the text
LOAD. P1,LNKNXT,+$SYLNK(P1) ; Get the address of the next Q-register
JUMPN P1,EQDR.4 ; Have one?
PJRST PASRET ; All done, return
; Subroutine to list the information for a Q-register.
; Usage:
; T1/ QRG block address
; T2/ Address of $STRING to list the name
; PUSHJ P,EQDR.S
EQDR.S: $SAVE <P1,P2,P3,P4> ; Save some ac's
DMOVE P1,T1 ; Get the arguments
LOAD. T1,QRGDTP,(P1) ; Get the data type
CAXE T1,$DTTXT ; Is this text?
JRST EQDS.1 ; No, just a number
LOAD. T1,TPTADR,+$QRTPT(P1) ; Yes, get the address of the buffer
LOAD. T3,BLKPT,(T1) ; Get the position
LOAD. T4,BLKEND,(T1) ; And the length
XMOVEI P3,[$STRING(<Text .=^D/T3/, Z=^D/T4/^N>)] ; Get the type out string
JRST EQDS.2 ; Go write the text
EQDS.1: CAXE T1,$DTNUM ; Numeric value?
SKIPA P3,[[$STRING(<FC table>)]] ; No, must be an FC table
XMOVEI P3,[$STRING(<Value=^D/$QRVAL(P1)/^N>)] ; For numerics, just print the value
EQDS.2: XMOVEI T1,SARG$1 ; Get the pointer to where to put the text
XMOVEI T2,[$STRING(<(^S/(P2)/): ^S/(P3)/>)] ; Get the text
PUSHJ P,.INSRT ; Insert the text
LOAD. T3,QRGOFS,(P1) ; Get the offset to where this is displayed
LOAD. T4,QRGNLN,(P1) ; Get the number of lines
ADD T4,T3 ; Get the final line
AOJ T3, ; And make them external line numbers
MOVE T1,$QRFLG(P1) ; Get the flags
TXNN T1,QR$VID ; Is this displayed?
SKIPA T2,[[$STRING(<^N^M^J>)]] ; No, just do the CRLF
MOVEI T2,[$STRING(<, Displayed:^D/T3/:^D/T4/^N^M^J>)]
MOVEI T1,SARG$1 ; Get the pointer to the buffer
PJRST .INSRT ; And insert the text
SUBTTL E Commands -- E? command -- SCREEN-ADDRESS
;+
;.HL2 SCREEN-ADDRESS
; This will return the screen coordinates of the given position. If no
;Q-register is given it will assume the current editing buffer, and if
;no numeric argument is given it will assume the current pointer position
;for the given Q-register. It will return two arguments, the first being
;the X position, and the second the Y position. If the given position is
;not displayed, it will return zeros for both arguments.
;-
EQUSCA: MOVX T1,QR$VID ; See if current buffer is displayed
JUMPN P1,ESCA.1 ; If a Q-reg was given skip this
MOVE P1,CUREDT ; . . .
TDNN T1,$QRFLG(P1) ; Is it?
XMOVEI P1,TXTBUF ; No, try text-buffer
ESCA.1: TDNN T1,$QRFLG(P1) ; Is it displayed?
JRST [SETZB A1,A2 ; No, clear the return args
PJRST VALRT2] ; And return both args
LOAD. T1,TPTADR,+$QRTPT(P1) ; Get the address of the buffer
TXNN F,F.ARG ; Did we have an argument?
LOAD. A1,BLKPT,(T1) ; No, use current position
MOVE T1,A1 ; Get the position
MOVE T2,P1 ; And the QRG
PUSHJ P,FNDCHP ; Find where the character is
SETOB T1,T2 ; Make so we return zeros
AOS A2,T1 ; Get the X position
AOS A1,T2 ; And the Y position
PJRST VALRT2 ; Return the args
SUBTTL E Commands -- E? command -- TERMINAL-TYPE
;+
;.HL2 TERMINAL-TYPE
;This will return a string argument that is the name of the current terminal
;type that the user is connected to.
;-
EQUTTY: JUMPN P1,[ERROR E.QNN] ; Can't have a Q-reg for this command
MOVEI T1,1 ; Get a character
PUSHJ P,GETSTR ; long buffer
MOVEI T1,SARG$1 ; Get the text buffer pointer
TOPS10<
MOVEI T2,[$STRING(^W/TRMTYP/^N)] ; Get the string to use
>; End of TOPS10
TOPS20<
MOVE T3,TRMTYP ; Get the terminal type
MOVEI T2,[$STRING(^T/@TRMNAM(T3)/^N)] ; Get the string to use
>
PUSHJ P,.INSRT ; Insert the text
PJRST PASRET ; And return
SUBTTL E Commands -- E? command -- LAST-SEARCH-STRING-LENGTH
;+
;.HL2 LAST-SEARCH-STRING-LENGTH
; This routine will return the length of the last search string that
;was found.
;-
EQULSL: JUMPN P1,[ERROR E.QNN] ; Q-reg not allowed
MOVE A1,SRHLEN ; Get the last string length found
PJRST VALRET ; And return it
SUBTTL E Commands -- E? command -- REVERSE-SEARCH-FLAG
;+
;.hl2 REVERSE-SEARCH-FLAG
; This routine will set or clear the reverse search flag, or return the
;value of the flag. If the reverse search flag is set, then reverse
;searches will leave the pointer immediately before the first character
;in the occurance of the search string that was found. If the flag
;is clear, then the reverse search will leave the pointer after the
;last character of the occurance of the search string.
;-
EQURVS: JUMPN P1,[ERROR E.QNN] ; Complain if Q-reg name given
TXNE F,F.ARG ; Argument given?
JRST ERVS.1 ; Yes, go set or clear the flag
TXNE S,S.RVRS ; No, is the flag set?
PJRST RTONES ; Yes, return -1
PJRST RETZER ; No, return 0
ERVS.1: TXZ S,S.RVRS ; Assume clearing the flag
JUMPE A1,.POPJ ; If value is zero, leave it clear
TXO S,S.RVRS ; Otherwise set it
POPJ P, ; And return
SUBTTL E Commands -- Subroutines -- E$DFLT
;+
;.HL2 E$DFLT
;This is a special defaulting routine for ER/EW and EB processing.
;.literal
;
; Usage:
; MOVEI T1,To FDB
; MOVEI T2,From FDB
; PUSHJ P,E$DFLT
; (Return)
;.end literal
;-
DEFINE DEFFDB(FIELD,BIT,%1)<
IFNB <BIT>,<
MOVX T1,FD.'BIT ;; Get the bit to check
TDNE T1,.FDFLG(P1) ;; Check if field was given
JRST %1 ;; Given, leave it alone
TDNE T1,.FDFLG(P2) ;; Do we need it on?
IORM T1,.FDFLG(P1) ;; Yes, flag it
>;; End of IFNB <BIT>
LOAD. T1,FDB'FIELD,(P2) ;; Get the default
IFB <BIT>,<CFXN. T2,FDB'FIELD,(P1),0 ;; Check if given>
STOR. T1,FDB'FIELD,(P1) ;; Store the value
IFNB <BIT>,<%1:!>
> ; End of DEFFDB definition
DEFINE CPYFDB(FIELD)<
LOAD. T1,FDB'FIELD,(P2) ;; Load the field
STOR. T1,FDB'FIELD,(P1) ;; Store it into the other field
>; End of CPYFDB
E$DFLT: $SAVE <P1,P2> ; Save P1 and P2
DMOVE P1,T1 ; Copy the arguments
MOVX T1,FD.NDF ; Check if /NODEFAULT
TDNE T1,.FDFLG(P1) ; given
POPJ P, ; Yes, don't do any defaulting
DEFFDB NOD ; Default the node name
DEFFDB NAM ; Default the name
DEFFDB EXT,HEX ; Default the extension
DEFFDB PRO,HPR ; Default the protection
DEFFDB VER ; Default the version
DEFFDB MOD ; Default the mode
MOVX T1,FD.PTH ; Get the path bit
TDNE T1,.FDFLG(P1) ; Was the field specified ?
POPJ P, ; No, just return to the caller
TDNE T1,.FDFLG(P2) ; Over here ?
IORM T1,.FDFLG(P1) ; Light it over here too
CPYFDB PPN ; Default the PPN
CPYFDB SFD ; Default the path
CPYFDB SF2 ; . . .
CPYFDB SF3 ; . . .
CPYFDB SF4 ; . . .
CPYFDB SF5 ; . . .
POPJ P, ; Return to the caller
SUBTTL E Commands -- Subroutines -- E$DFSW
;+
;.HL1 E$DFSW
; This routine is called to default any switch values which have not
;been specified. It will go through the tables and copy the value from
;one to the other.
;.lit
;
; Usage:
; T1/ Address of user specified switches
; T2/ Address of default switch block
; T3/ Length of switch block
; T4/ Flags from FDB
; PUSHJ P,E$DFSW
; (return)
;
;.end lit
;-
E$DFSW: TXNN T4,FD.DEF ; Reset of defaults wanted?
JRST DFSW.0 ; No, skip it
PUSH P,T1 ; Save T1
IFE FTXADR,<
HRLI T1,(T2) ; Set up the BLT pointer
HRRI T1,1(T2) ; To clear out the switches
SETOM (T2) ; . . .
ADD T2,T3 ; Get the final address +1
CAIE T3,1 ; Only one word?
BLT T1,-1(T2) ; No, clear the block
SUB T2,T3 ; Get the base address back
> ; End of IFE FTXADR
IFN FTXADR,<PRINTX ? Clear default switch block in E$DFSW>
POP P,T1 ; Restore T1
DFSW.0: TXNE T4,FD.NDF ; No defaults wanted?
POPJ P, ; No, just return now
DFSW.2: MOVE T4,(T1) ; Get the user switch value?
CAXN T4,-1 ; Want default?
MOVE T4,(T2) ; Yes, get the value
MOVEM T4,(T1) ; Reset the value
MOVEM T4,(T2) ; And save as default
AOJ T1, ; Bump the pointers
AOJ T2, ; . . .
SOJG T3,DFSW.2 ; And loop for all switches
POPJ P, ; All done
SUBTTL Low segment
$IMPURE ; Impure data area
LOWVER(ECM,4) ; Low segment version number
E$ZBEG:!
DEF$EW: BLOCK .FDLEN ; Pointer to the default EW
DEF$EL: BLOCK .FDLEN ; Pointer to the default EL
DEF$ER: BLOCK .FDLEN ; Pointer to the default ER specification
;DEF$EB: BLOCK .FDLEN ; Pointer to the default EB specification
DEF$EQ: BLOCK .FDLEN ; Pointer to the default EI/EQ/EP spec
DEF$EE: BLOCK .FDLEN ; Pointer to default EE spec
; EB command storage
E$OBEG:! ; Start of area to be set to -1
DFTIMD: BLOCK 1 ; Default /IMODE
DFTOMD: BLOCK 1 ; Default /OMODE
DFTYNK: BLOCK 1 ; Default /YANK
E$OEND==.-1
LS$INP: BLOCK 1 ; Inplace switch
LS$RED: BLOCK 1 ; /READONLY switch
LS$YNK: BLOCK 1 ; /YANK switch
; EL command storage
FDB$EL: BLOCK 1 ; Pointer to the currently open log file
L$COUN: BLOCK 1 ; Number of characters to output between checkpoints
L$CNTR: BLOCK 1 ; Running counter
DEFINE SW(NAME,LOC,ROUTINE,VALUE,FLAGS),<LOC: BLOCK 1>
SL$BEG:!
SWT$EL ; Generate the storage for the switches
SL$END==.-1
; Storage for ER command
ER$BEG:!
SR$SLS: BLOCK 1 ; /SUPLSN switch
SR$YNK: BLOCK 1 ; /YANK or /NOYANK switch
ER$END==.-1
ER$DFS: BLOCK ER$END-ER$BEG+1 ; Space for defaults
; Storage for EW command
EW$BEG:!
DEFINE SW(NAME,LOC,ROUTINE,VALUE,FLAGS)<LOC: BLOCK 1>
EW$SW
EW$END==.-1
; Storage for EI/EP commands
EPIQRG: BLOCK 1 ; Pointer to text buffer for EI/EP command
E$ZEND==.-1
; Storage for EE command
RUNDEV: BLOCK 1 ; Device we were orignally run from
RUNNAM: BLOCK 1 ; Name we were originally run with
RUNPTH: BLOCK .PTMAX ; Path block for GETSEG
EEACS: BLOCK 20 ; Ac's saved for restart
; Storage for ED command
ED$FDB: BLOCK 1 ; FDB for the ED command
ED$PTH: BLOCK .PTMAX ; Path specification for the RUN
ED$BLK: BLOCK 6 ; RUN argument block
ED$COD: BLOCK RUNLEN ; RUN code
ED$BEG:! ; Beginning of the switch area for ED
ED$SW ; Expand the switch area
ED$END==.-1 ; End of the switch area
; For E. command
CUREDT: BLOCK 1 ; Current QRG being edited
;Flag to be used with EVFAST/EVSLOW commands.
FSTFLG: BLOCK 1 ; Just a flag (defaulted to slow mode)
STARTL: BLOCK STR.LN ; Block for low segment restart code for EE command
; Table for EO level skip instructions. These are executed by the CHKEO
;macro. If the instruction skips, the EO is less than or equal to the
;index used.
EOXCTS: BLOCK EOVAL ; Allocate enough room.
SUBTTL End of TECECM
END ; End of TECECM