Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50410/xtec.mac
There are 2 other files named xtec.mac in the archive. Click here to see a list.
; XTEC - A TEXT EDITOR FOR THE DECSYSTEM-10
SEARCH JOBDAT,MACTEN,UUOSYM ;[366] DEFINE SYSTEMY THINGS
SALL ; SUPPRESS MACRO EXPANSIONS
TWOSEGMENTS .JBHGH ; THIS IS A TWO SEGMENT PROGRAM
.DIRECTIVE .XTABM ; TENEXY MACRO'S
DEFINE $TITLE(VXTEC)<
IFN FTXTEC,TITLE. XTEC,VXTEC,A TEXT EDITOR FOR THE DECSYSTEM-10
IFN FTXTCERR,TITLE. XTCERR,VXTEC,ERROR SEGMENT FOR XTEC
>
;MAKE THE RIGHT TITLE
$TITLE 0(427) ; EDIT LEVEL 6-JAN-78
SUBTTL J KRUPANSKY/M CRISPIN/JWK/MRC @SIT 12-AUG-74
SUBTTL Introduction to XTEC
; XTEC IS AN EXPERIMENTAL TEXT EDITOR AND CORRECTOR FOR THE
; DECSYSTEM-10. IT IS VERY SIMILAR TO DIGITAL EQUIPMENT CORPORATION'S
; TECO, BUT WITH MANY MINOR EXTERNAL CHANGES AND MAJOR INTERNAL CHANGES.
;
; XTEC IS BASED ON DIGITAL EQUIPMENT CORPORATION'S TECO WHICH
; WAS WRITTEN BY RC CLEMENTS/PMH/CAM.
; MANY OF THE EXTERNAL CHANGES ARE BASED ON CHANGES MADE TO TECO
; AT STEVENS INSTITUTE OF TECHNOLOGY BY J POTOCHNAK AND G BROWN.
;
; XTEC.MAC WAS WRITTEN BY J KRUPANSKY/JWK, BEGINNING
; 12-AUG-74 AT THE COMPUTER CENTER OF STEVENS INSTITUTE OF TECHNOLOGY,
; HOBOKEN, NJ 07030.
;
; CODE FOR THE ^U, ^Y, EL, FD, <ARGS>M, AND <ARGS>EI COMMANDS, AS
; WELL AS THE /APPEND, /NOIN, /NONSTD, AND /NOOUT I/O SWITCHES
; WAS WRITTEN BY MARK CRISPIN AT THE CHEMISTRY AND CHEMICAL ENGINEERING
; DEPARTMENT OF STEVENS INSTITUTE OF TECHNOLOGY.
SUBTTL TABLE OF CONTENTS
; TABLE OF CONTENTS FOR EXPERIMENTAL TECO
;
;
; SECTION PAGE
; 1. Introduction to XTEC.................................. 1
; 2. TABLE OF CONTENTS..................................... 2
; 3. Revision History...................................... 3
; 4. Assembly Parameters................................... 4
; 5. ASSEMBLY INSTRUCTIONS................................. 5
; 6. AC Definitions........................................ 6
; 7. Macro Definitions..................................... 7
; 8. OPDEFs and Symbol Definitions......................... 8
; 9. Flag AC Bit Definitions............................... 11
; 10. Transfer Vector Table for Command Execution........... 12
; 11. Startup Initialization................................ 13
; 12. Compile&Execute XTEC Option Line from DSK:SWITCH.INI.. 16
; 13. COMPILE&EXECUTE DSK:XTEC.INI[,] if it exists.......... 18
; 14. CCL Setup............................................. 19
; 15. Command Input Processor............................... 21
; 16. Read a Command String into the Command Buffer......... 22
; 17. Subroutines for Reading a Command String.............. 24
; 18. Command String is Stored. Process it.................. 25
; 19. Command Decoder Dispatch Table........................ 26
; 20. COMPIL - Command Decoder and Compiler................. 27
; 21. Command Decoding and Compilation Routines............. 31
; 22. Command Decoding and Compilation Subroutines.......... 57
; 23. EXECUT - Execute a Command............................ 63
; 24. $CTM - TRACE MODE TYPE-OUT............................ 65
; 25. $EH AND $EHS.......................................... 66
; 26. $U AND $Q AND $INC.................................... 67
; 27. $PUSH AND $POP........................................ 68
; 28. $DEC AND $OCT AND $CNE AND $CNN AND $FFD.............. 69
; 29. $UP AND $LOW AND CLRCAS AND $CX AND $CXS.............. 70
; 30. $CNZ and $MES and $NA................................. 71
; 31. $CKC and $CHA and $CKD and $CKV and $CKW.............. 72
; 32. $SEMF and $SEMZ and $SEM and $STOP.................... 73
; 33. $R and $C and $J...................................... 74
; 34. $KL and $L and $D..................................... 75
; 35. $TAB and $I and $NI and $L............................ 76
; 36. $BS1 and $BS2......................................... 77
; 37. $TTC.................................................. 78
; 38. $S and $N............................................. 79
; 39. $BAR.................................................. 80
; 40. $BS and $FS........................................... 81
; 41. $TL and $T and $0TT................................... 82
; 42. $A and $P and $PW and $BP............................. 83
; 43. $Y and $CNP AND $CNY AND $CNU......................... 84
; 44. $XL................................................... 85
; 45. $G.................................................... 86
; 46. FAIRET and SUCRET..................................... 87
; 47. $M.................................................... 88
; 48. $EC and $ECS and $TTY................................. 89
; 49. $GTB and $PEK - GETTAB and PEEK....................... 91
; 50. $ER and $EW and $EF and $ED........................... 92
; 51. $EB................................................... 93
; 52. $EA................................................... 94
; 53. $EI................................................... 95
; 54. $EL AND $ELA.......................................... 96
; 55. $EN................................................... 97
; 56. $EP................................................... 98
; 57. $EM and $EZ........................................... 99
; 58. $EE................................................... 100
; 59. $EG and $EX and MONRET................................ 101
; 60. SSTPSC - Prescan a Search String...................... 102
; 61. SSTGSM - Generate a Search Matrix..................... 104
; 62. SERCH and BSERCH - Perform a Search................... 111
; 63. SEARCH - The Actual Search Routine.................... 112
; 64. Command Execution Subroutines......................... 116
; 65. SETFSP - Fill in Defaults for a File Spec............. 122
; 66. SETRAD - Set the Adr of Read-a-Char Routine........... 124
; 67. SETWAD - Set Adr of Punch-a-Char Routine.............. 125
; 68. PUNBUF - Punch part of Input File..................... 126
; 69. PUNCH - Punch part of Text Buffer..................... 127
; 70. ASCPCH - Punch an ASCII Character..................... 128
; 71. SIXPCH - Punch a SIXBIT ASCII Character............... 129
; 72. OCTPCH - Punch an Octal Digit......................... 130
; 73. LSNPCH - Punch a Char and Turn on Bit35 for LSNS...... 131
; 74. GENPCH - Punch a Char and Generate LSNS............... 133
; 75. BAKCLS - Finish "EB" that is in Progress.............. 135
; 76. YANK and APPEND....................................... 137
; 77. ASCAPD - Read an ASCII Char........................... 139
; 78. SUPARD - Read a Char and Suppress LSNS................ 140
; 79. OCTAPD - Read an Octal Digit.......................... 141
; 80. SIXAPD - Read a SIXBIT ASCII Char..................... 142
; 81. MACRO - Compile and Execute a Macro................... 143
; 82. OPENRD - Select a File for Input...................... 145
; 83. OPENWR - Select a File for Output..................... 146
; 84. FILERD - Read a File into a Text Buffer............... 147
; 85. TYPEL and TYPE - Type part of Text Buffer............. 149
; 86. FILOPN - Open a Device and Setup Buffers.............. 150
; 87. FILLKP, FILENT, AND FILRNM - File LOOKUP/ENTER/RENAM.. 152
; 88. ERMT - Error Message Typeout.......................... 155
; 89. ERRTXT - Text of All Error Messages................... 158
; 90. GXXXXX - Character Input Routines..................... 159
; 91. LOGPCH - PUNCH A CHARACTER TO LOG FILE................ 167
; 92. CMDGCH AND CMDBCH - Get char from command buffer...... 168
; 93. TXXXXX - OUTPUT ROUTINES.............................. 169
; 94. MISCELLANEOUS ROUTINES................................ 175
; 95. QSTOR - Store a value/text-buffer in a Q-register..... 179
; 96. QGET - Return a Q-register............................ 181
; 97. QFIND - Find a Q-register in QTAB..................... 182
; 98. MKROOM - Make room for an arbitrary # of chars in ma.. 183
; 99. ADDBLK - Add a block to the Linked-List............... 186
; 100. REFBLK - Add one to the Reference Count for A BLOCK .. 187
; 101. DELBLK - Un-Reference a Block in Linked-List.......... 188
; 102. FNDBLK - Find a Block (given its id) in the Linked-L.. 189
; 103. SAVE AC ROUTINES...................................... 190
; 104. REQM - REQUEST MEMORY (CORE ALLOCATION)............... 191
; 105. RELM - RELEASE MEMORY................................. 192
; 106. GARCOL - GARBAGE COLLECTION ROUTINE................... 193
; 107. FIXREF - RELOCATE THE REFERNECES TO A DYNAMIC BLOCK... 195
; 108. EXPAND - Expand a Block of Core....................... 196
; 109. COMPRS - Compress a Block of Core..................... 198
; 110. SETSTK - INITIALIZE A DYNAMIC STACK................... 199
; 111. ADDPDL - Add a PDL to PDLTAB.......................... 200
; 112. DELPDL - Remove a PDL from PDLTAB..................... 201
; 113. FNDPDL - Find a PDL in PDLTAB......................... 202
; 114. APRTRP - APR Trap handler (POV Recovery).............. 203
; 115. UUOTRP - LUUO Handler................................. 205
; 116. REENTR - Reenter Processing (after ^C^C.REENTER)...... 206
; 117. ERRHAN - Error Handler................................ 207
; 118. ERCTY - TYPE LAST FEW COMMANDS AFTER AN ERROR......... 210
; 119. SAVPCM - SAVE LAST COMMAND STRING IN A Q-REGISTER..... 211
; 120. Phased Pure Low Segment Code.......................... 212
; 121. Impure Low Segment Data............................... 213
SUBTTL Revision History
;[301] 22-FEB-75 /JK - ^C START NO LONGER GETS ILL. MEM. REF.
;[302] 22-FEB-75 /JK - CHANGE EJ CMD TO ^G (FOR GETTABS AND PEEKS)
;[303] 22-FEB-75 /JK - MAKE PW CMD WORK
;[304] 22-FEB-75 /JK - NO ILL UUO IF NO OUTPUT FILE
;[305] 22-FEB-75 /JK - OLD FORM OF = AND == ARE NOW COMPATIBLE
; WITH DEC TECO. N,M= (AND ==) MEAN:
; N.LT.0 - TYPE A CRLF AFTER NUMBER
; N.EQ.0 - TYPE NOTHING AFTER NUMBER
; N.GT.0 - TYPE CHAR WHOSE CODE IS N AFTER NUMBER
;[306] 22-FEB-75 /JK - N^F RETURNS TTY#+^O200000 OF JOB N
;[307] 22-FEB-75 /JK - FIX BUG ABOUT ^R IN INSERTS
;[310] 22-FEB-75 /JK - MAKE ":" AND "@" THROW AWAY PREV. ARGS
;[311] 22-FEB-75 /JK - CHECK VERSION IF EE FILE
;[312] 22-FEB-75 /JK - PREVENT MACROS FROM USING MUCH CORE
;[313] 5-APR-75 /JK - PREVENT ?IO TO UNAS... WHEN "CONTINUE" IS
; TYPED AFTER "EX$$"
;[314] 5-APR-75 /JK - MAKE BOUNDED SEARCHES WORK
;[315] 5-APR-75 /JK - PREVENT <LF><LF> IN SWITCH.INI FROM
; CAUSING INFINITE LOOP
;[316] 5-APR-75 /JK - ADD SOME MORE PORTALS
;[317] 5-APR-75 /JK - MAKE ^C^C.REENTER PRESERVE THINGS
;[320] 10-APR-75 /MC - MAKE [311] WORK PROPERLY
;[321] 10-APR-75 /MC - FIX ^P
;[322] 10-APR-75 /MC - PREVENT MISSING CCL FILE, XTCERR FROM HALTING
;[323] 10-APR-75 /JK(MC) - FIX CRLF IN TRACE MODE
;[324] 10-APR-75 /JK(MC) - FIX SPACE BEFORE COMMAND BUG
;[325] 11-APR-75 /MC - EXTEND [316], CLEAN UP [320] AND [322]
;[326] 11-APR-75 /MC - PREVENT ILLEGAL UUO IF RUN XTCERR
;[327] 12-APR-75 /MC - N^Y YANKS TO PAGE N, ^Y= SAME AS ^P=
;[330] 14-APR-75 /MC - EL FILESPEC MAKES A LOG FILE
;[331] 14-APR-75 /MC - FIX UP ERROR TEXT
;[332] 15-APR-75 /MC - FIX TWO ARGS CARRYING TOO FAR IN ^G, ^T
;[333] 15-APR-75 /MC - N^U USETI'S TO BLOCK N ON INPUT FILE
;[334] 15-APR-75 /MC - /NONSTD OPENS DECTAPE IN NON-STANDARD MODE
;[335] 21-APR-75 /MC - FIX ?IO TO UNAS... WHEN USING EE & LOG FILES
;[336] 26-APR-75 /MC - ^G W/O AN ARGUMENT DOES A PJOB
;[337] 26-APR-75 /MC - FIX UP ERROR MESSAGE ?XTCBAK
;[340] 29-APR-75 /MC - GET DEFAULT PATH BY PATH., NOT GETPPN
;[341] 29-APR-75 /MC - IGNORE .BAK FILE ON OTHERS IN SEARCH LIST
;[342] 30-APR-75 /MC - [-] DOES A PATH., NOT A SETZM
;[343] 10-MAY-75 /MC - FIX HASH AT BEGINNING OF IMMEDIATE LINE TRACE
;[344] 13-MAY-75 /MC - ARGUMENTS CAN BE PASSED TO MACROS BY M
;[345] 13-MAY-75 /MC - EXTEND [344] FOR EI
;[346] 20-MAY-75 /MC - PREVENT ARGUMENTED MACROS FROM GOBBLING CORE
;[347] 6-JUN-75 /MC - USE MACTEN & UUOSYM RATHER THAN C
;[350] 18-JUN-75 /MC - FIX SAVEGET LOCS GETTING CLOBBERED(ST)
;[351] 18-JUN-75 /MC - FIX NNNEDT.TMP NOT BEING READ
;[352] 18-JUN-75 /MC - FIX MACRO RESULT GOING TOO FAR
;[353] 18-JUN-75 /MC - FIX "REENTER" FLAG IN COMMAND STRING
;[354] 18-JUN-75 /MC - FIX DOUBLE PAGES IN BAD ^P ARG
;[355] 18-JUN-75 /MC - FIX EB ON ANOTHER PPN GOING WRONG PLACE
;[356] 18-JUN-75 /MC - FIX EL/APPEND WITH NO LOG FILE
;[357] 18-JUN-75 /MC - FIX .JBCOR POP'ED INTO .JBSA IN "EE"
;[360] 18-JUN-75 /MC - FIX /SIXBIT IN OUTPUT
;[361] 18-JUN-75 /MC - FIX /SUPLSN CAUSING ILL MEM REF
;[362] 18-JUN-75 /MC - FIX ?XTCSRH ERROR TEXT
;[363] 18-JUN-75 /MC - FIX MISSING PORTAL IN "REENTR"
;[364] 18-JUN-75 /MC - FIX ?XTCERR W/ LOWER CASE FLAGGING
;[365] 3-JUL-75 /MC - FIX EB ON OTHERS IN SEARCH LIST
;[366] 3-JUL-75 /MC - USE JOBDAT & MACTEN MORE FULLY
;[367] 3-JUL-75 /MC - PATCH UP CCL CODE
;[370] 3-JUL-75 /MC - MAKE QI= WORK ON ASCII Q-REG
;[371] 3-JUL-75 /MC - MAKE EI LOOK ON TED: IF SPEC NOT OKAY
;[372] 3-JUL-75 /MC - FIX PPN SPEC OVERDEFAULTING ON [,]
;[373] 3-JUL-75 /MC - FIX BUG WITH ^^ AND ^R/^Q IN SEARCHES
;[374] 7-JUL-75 /MC - MAKE [370] WORK
;[375] 7-JUL-75 /MC - MAKE "START" DO A RESTART
;[376] 7-JUL-75 /MC - FIX SPURIOUS %XTCSEF ON OTHERS IN SL
;[377] 7-JUL-75 /MC - ADD FD <-- FIND AND DESTROY(!)
;[400] 4-AUG-75 /MC - FIX ILL MEM REF IN CCL(HOPEFULLY LAST)
;[401] 4-AUG-75 /MC - MAKE ">" THROW AWAY VALUE(TECO COMPATABLE)
;[402] 4-AUG-75 /MC - FIX "0-" BEING = 0 (I.E. :D-LT)
;[403] 4-AUG-75 /MC - FIX "-S" ALWAYS SUCCESSFUL(!)
;[404] 4-AUG-75 /MC - FIX NO "%XTCSEF" ON [-]
;[405] 4-AUG-75 /MC - FIX "?" RETURNING FROM XTCERR TO XTEC
;[406] 4-AUG-75 /MC - IMPLEMENT "EO" PROPERLY
;[407] 6-SEP-75 /MC - USE TITLE., PRETTY UP SOME CODE
;[410] 6-SEP-75 /MC - FIX :8^T ALWAYS FAILING
;[411] 29-OCT-75 /MC - FIX EH= RETURNING WRONG VALUE
;[412] 29-OCT-75 /MC - FIX P AT END OF FILE NOT ZEROING "."
;[413] 29-OCT-75 /MC - FIX EW TO DIRECTORY DEVICE AFTER EW
; TO NON-DIRECTORY DEVICE TRYING TO
; USE PPN 1 GREATER THAN IT SHOULD
;[414] 29-OCT-75 /MC - FIX EW TO NUL: GETTING %XTCSEF
;[415] 29-OCT-75 /MC - FIX [,] MEANING NOTHING!
;[416] 29-OCT-75 /MC - ALLOW "/" FOR % MESSAGES
;[417] 2-DEC-75 /MC - CLEAN UP CODE
;[420] 2-DEC-75 /MC - ADD ILLEGAL MEM REF TRAPPING
;[421] 2-DEC-75 /MC - [415] DID NOT WORK, REMOVE IT AND FIX ORIGINAL PROBLEM
;[422] 3-DEC-75 /MC - MAKE ERROR SEGMENT USE AN INDEX
;[423] 15-DEC-75 /MC - MAKE JWK HAPPY BY REMOVING ALTMODE CONVERSION
;[424] 1-JAN-75 /MC - REMOVE [423] (I WAS RIGHT AFTER ALL)
;[425] 1-JAN-75 /MC - FIX SFD HANDLING
;[426] 5-JAN-75 /MC - FIX MISSING ERROR TEXTS
;[427] 8-JAN-75 /MC MAKE ^U WORK IMMEDIATELY
SUBTTL Assembly Parameters
SHOW. %%JOBDAT ; VERSION OF JOBDAT
SHOW. %%MACTEN ; VERSION OF MACTEN
SHOW. %%UUOSYM ; VERSION OF UUOSYM
NDS. C$PDLL, 100 ; CONTROL PDL LENGTH
NDS. C$NREF, 3 ; # REFERNECE WORDS FOR A DYNAMIC MEMORY BLOCK
NDS. C$PATL, ^D16 ; SIZE OF THE PATCHING SPACE
NDS. C$GSIZ, ^D500 ; HOW MUCH TO GROW BEFORE GARBAGE COLLECTING
NDS. C$CMDL, ^D100 ; # WORDS IN INITIAL COMMAND BUFFER
NDS. C$SFDL, 5 ; # NESTED SFDS ALLOWED IN FILESPECS
NDS. C$CODL, ^D100 ; # WORDS TO ADD TO COMMAND BUFFER FOR CODE
NDS. C$NPDL, ^D7 ; # PDLS THAT CAN BE OVERFLOW PROTECTED
NDS. C$TPDL, ^D30 ; SIZE OF APRTRP TEMP CONTROL PDL
NDS. C$LPDL, ^D16 ; SIZE OF TAG PDL
NDS. C$RPDL, ^D16 ; SIZE OF TAG REFERENCE PDL
NDS. C$QRLN, 3*^D10 ; 3 TIMES MIN # Q-REGISTERS
NDS. C$QPLN, 3*^D10 ; 3 TIMES MIN SIZE OF Q-REGISTER PDL
NDS. C$NBUF, 2 ; # BUFFERS FOR A DEVICE
NDS. C$TBLN, ^D1200 ; INITIAL #WORDS IN MAIN TEXT EDITING BUFFER
NDS. C$FILB, ^D10 ; N MEANS FILL BUFFER TILL (N-1)/N FULL
NDS. C$EUVL, 0 ; DEFAULT CASE FLAGGING FLAG VALUE
; -1=NONE
; 0=FLAG LOWER CASE
; +1=FLAG UPPER CASE
NDS. C$BUFL, ^D128 ; # WORDS IN A MONITOR BUFFER
NDS. C$BFHD, 3 ; # WORDS IN A BUFFER HEADER
NDS. C$SRHL, ^D80 ; # CHARS IN SEARCH TEXT
NDS. C$ERRS, 'XTCERR' ; NAME OF THE ERROR SEGMENT
NDS. C$3NAM, 'XTC' ; 3 LETTER ABBREVIATION OF OUR NAME
; USED FOR TEMP FILES,ETC.
NDS. C$TPRV, <177> ; PROTECTION CODE FOR TEMP FILES
NDS. C$CCNM, '[CCL] ' ; MACRO NAME OF THE CCL COMMAND
; SO WE CAN EXIT ON 'FNF'
NDS. C$EOVL, 0 ;[406] DEFAULT "EO" VALUE OF THIS VERSION
SUBTTL ASSEMBLY INSTRUCTIONS
COMMENT!
TO GENERATE A PRODUCTION VERSION:
.LOAD @XTEC
.SSAVE
.LOAD/COMP @XTCERR
.SSAVE
TO GENERATE A VERSION WITH DDT:
.DEBUG @XTEC
.SAVE
.DEBUG/COMP @XTCERR
.SAVE
!;; END OF COMMENT
SUBTTL AC Definitions
F== 0 ; FLAGS
T1== 1 ; TEMP
T2== T1+1 ; TEMP
T3== T2+1 ; TEMP
T4== T3+1 ; TEMP
T5== T4+1 ; TEMP
X== 6 ; SUPER TEMP (HARDLY EVER SAVED)
C== 7 ; CHARACTER
N== C+1 ; NAME OR NUMBER OR WORD
M== N+1 ; MASK OR NUMBER OR WORD
L== 16 ; ARG OR ARG POINTER
P== 17 ; CONTROL PDP
; ACS USED IN COMMAND COMPILATION
CP== 12 ; CODE GENERATION PDP
TAG== 13 ; TAG STACK
REF== 14 ; TAG REFERENCE STACK
; ACS USED IN COMMAND EXECUTION
PC== TAG ; PC (IE: JSP PC,$$XX)
ARG== REF ; ARGUMENT
VALUE== 15 ; VALUE RETURNED BY A COMMAND
SARG== L ; SECOND ARG
R== CP ; RELOCATION REGISTER TO START
; OF COMMAND BUFFER
SUBTTL Macro Definitions
; FOR - MACRO TO OPEN A CONDITIONAL IF ARG IS TRUE
;
; CALL: FOR FTXXXX,<
; CLOSED BY: >;; END OF FOR FTXXXX
DEFINE FOR (WHO)
<IFE WHO,XLIST
IFN WHO,<LIST
SALL>
IFN WHO,>
; NOTFOR - MACRO TO OPEN A CONDITIONAL IF ARG IS FALSE
;
; CALL IS: NOTFOR FTXXXX,<
; CLOSED BY: >;; END NOTFOR FTXXXX
DEFINE NOTFOR (WHO)
<IFN WHO,XLIST
IFE WHO,<LIST
SALL>
IFE WHO,>
; BIT - MACRO TO DEFINE SUCCESSIVE BIT POSITIONS
;
; BIT(VALUE) DEFINES THE INITAIL BIT POSITION (EG: BIT (1B0) )
; BIT() RETURNS NEXT BIT POSITION BEGINNING WITH INITIAL VALUE (EG: FOO=BIT)
DEFINE BIT (INIVAL)
<IFB <INIVAL>,<<1B<<BIT$$$==BIT$$$+1>-1>>>IFNB <INIVAL>,<BIT$$$==^L<INIVAL>>>
; INT - MACRO TO DEFINE SUCCESSIVE INTEGERS
;
; BIT(VALUE) DEFINES THE INITIAL INTEGER (EG: INT (0) )
; BIT() RETURNS NEXT INTEGER BEGINNING WITH INITIAL VALUE (EG: ONE= INT)
DEFINE INT (INIVAL)
<IFB <INIVAL>,<<<INT$$$==INT$$$+1>-1>>IFNB <INIVAL>,<INT$$$==INIVAL>>
; SKP - MACRO TO GENERATE A JRST OVER THE NEXT N INSTRUCTIONS
;
; SKP() IS EQUIVALENT TO "JRST .+2"
; SKP(N) IS EQUIVALENT TO "JRST .+1+N" AND SKIPS THE NEXT N INSTRUCTIONS
DEFINE SKP (N)
<IFB <N>,<JRST .+2>
IFNB <N>,<JRST .+1+N>>
; GEN - MACRO TO GENERATE A KEYWORD&DISPATCH TABLE
;
; GEN(XXX) GENERATES A TABLE AT ADR 'XXXTBL' WITH LENGTH 'XXXLTH'
; USER MUST DEFINE 'XXX' AS A MACRO:
; DEFINE XXX
;< PAIR NAME,ADR,BITS
; PAIR LASTNM,ADRN,BITS>
; TO GENERATE THE TABLE:
; GEN (XXX); AT ADR 'XXXTBL' WITH LENGTH 'XXXLTH'
DEFINE GEN (TAB)
<DEFINE PAIR (NAME,ADR,BITS)<<SIXBIT/NAME/>>
TAB'TBL:
XLIST
TAB;; ; GENERATE KEYWORDS
TAB'LTH==.-TAB'TBL
DEFINE PAIR (NAME,ADR,BITS)<EXP BITS+ADR>
TAB;; ; GENERATE DISPATCH TABLE
LIST
SALL
>
; STSTK - MACRO TO SETUP AN EXPANDABLE STACK
DEFINE STSTK (AC,LEN,REF)
<IFIDN <AC>,<P>,<MOVE P,[IOWD C$TPDL,TPDL]>
MOVE T1,[<REF,,LEN>]
MOVEI N,AC
PUSHJ P,SETSTK
>
SUBTTL OPDEFs and Symbol Definitions
; ERROR - A MACRO TO GENERATE AN ERROR CALL LUUO
LUUERR==1 ; LUUO OPCODE FOR 'ERROR'
DEFINE ERROR (CODE)
< BYTE (9)LUUERR(4)0(1)0(4)0(18)<E$'CODE==<''CODE''&777777>>>
; CERROR MACRO TO GENERATE ERROR CALL FOR POSSIBLE ":" COMMANDS
LUUCER==2 ; LUUO OPCODE FOR 'CERROR'
DEFINE CERROR (CODE)
< BYTE (9)LUUCER(4)0(1)0(4)0(18)<E$'CODE==<''CODE''&777777>>>
; CERR1 - MACRO FOR LUUO CALL SAME AS 'CERROR' BUT POPS TOP OF STACK
LUUCR1==3 ; LUUO OPCODE FOR 'CERR1'
DEFINE CERR1 (CODE)
< BYTE (9)LUUCR1(4)0(1)0(4)0(18)<E$'CODE==<''CODE''&777777>>>
; WARN - MACRO FOR LUUO TO TYPE A WARNING MESSAGE
LUUWRN==4 ; LUUO OPCODE FOR 'WARN'
DEFINE WARN (CODE)
< BYTE(9)LUUWRN(4)0(1)0(4)0(18)<W$CODE==<''CODE''&777777>>>
; CHKEO - MACRO TO JUMP IF A FEATURE IS DISABLED
LUUCEO==5 ; LUUO OPCODE FOR 'CHKEO'
DEFINE CHKEO(NUM,ADR)
< <LUUCEO>B8+<NUM>B12+<Z ADR>>
; I/O CHANNELS
INP== 1 ; INPUT CHANNEL
OUT== 2 ; OUTPUT CHANNEL
LOG== 3 ;[330] LOG CHANNEL
; MISCELLANEOUS SYMBOLS
.CHSPC==040 ; A SPACE CHAR
.CHLAB=="<" ; LEFT ANGLE BRACKET
.CHRAB==">" ; RIGHT ANGLE BRACKET
; SYMBOLS FOR Q-REGISTER ELEMENTS. INDEX BY ADR OF Q-REGISTER
Q$NAM== 0 ; SIXBIT NAME OF Q-REGISTER
Q$BIT== 1 ; MISCELLANEOUS BITS
QB$NUM==1B0 ; Q-REGISTER IS NUMERIC
QB$TXT==1B1 ; Q-REGISTER IS A TEXT BUFFER
QB$CMP==1B2 ; COMPILED CODE FOR TEXT
Q$VAL== 2 ; NUMERIC VALUE OF Q-REGISTER
Q$PTR== Q$VAL ; LINKED-LIST ID FOR TEXT BUFFER
; INDICES INTO A DYNAMIC MEMORY BLOCK (RELATIVE TO FIRST DATA WORD)
B$1PTR==-3 ; FIRST POINTER WORD
B$2PTR==-2 ; SECOND POINTER WORD
B$3PTR==-1 ; THIRD POINTER WORD
B$DATA==0 ; FIRST DATA WORD
; INDICES INTO A TEXT BUFFER (RELATIVE TO FIRST DATA WORD)
T$PBUF==B$1PTR ; POINTER TO PREVIOUS BUFFER
T$NBUF==B$2PTR ; POINTER TO NEXT BUFFER
T$1REF==B$2PTR ; POINTER TO A STATIC REFERENCE
T$ACRF==B$3PTR ; POINTERS TO TWO AC REFERENCES
T$CCNT==B$DATA ; CHARACTER COUNT FOR BUFFER
T$RCNT==T$CCNT+1 ; REFERENCE COUNT FOR BUFFER
T$BID== T$RCNT+1 ; BUFFER ID
T$DATA==T$BID+1 ; FIRST DATA WORD FOR TEXT BUFFER
; INDICES INTO A FILE SPEC BLOCK
INT(0) ; INDICES START WITH ZERO
FS$FLG==INT ; FLAGS FOR FILE SPEC
BIT(1B0) ; FLAG BITS START WITH ZERO
FB$DEV==BIT ; DEVICE NAME SEEN
FB$NAM==BIT ; FILE NAME SEEN
FB$EXT==BIT ; FILE EXTENSION SEEN
FB$PRV==BIT ; /PROTECT:<NNN> SEEN
FB$PRJ==BIT ; PROJECT NUMBER SEEN
FB$PRG==BIT ; PROGRAMMER NUMBER SEEN
FB$PTH==BIT ; SOME SORT OF PATH SEEN
FB$DDR==BIT ; DEFAULT DIRECTORY SEEN
FB$SFD==BIT ; SFDS SEEN
FB$EXE==BIT ; /EXECUTE
FB$LSN==BIT ; /LSN - DO LSN PROCESSING
FB$ASC==BIT ; /ASCII - DON'T DO LSN PROCESSING
FB$SIX==BIT ; /SIXBIT - PROCESS A SIXBIT FILE
FB$OCT==BIT ; /OCTAL - PROCESS A BINARY FILE
FB$GEN==BIT ; /GENLSN - GENERATE LSN'S ON OUTPUT
FB$SUP==BIT ; /SUPLSN - SUPPRESS LSN'S ON INPUT
FB$APP==BIT ;[330] /APPEND - APPEND TO LOG FILE
FB$NOO==BIT ;[330] /NOOUT - NO TYPEOUT IN LOG
FB$NOI==BIT ;[330] /NOIN - NO TYPEIN IN LOG
FB$NON==BIT ;[334] /NONSTD - NON STANDARD DECTAPE
FB$$IO==FB$LSN!FB$ASC!FB$SIX!FB$OCT!FB$GEN!FB$SUP!FB$PRV!FB$APP!FB$NOO!FB$NOI!FB$NON
; THE I/O SWITCH BITS
FS$DEV==INT ; SIXBIT DEVICE NAME
FS$NAM==INT ; SIXBIT FILE NAME
FS$EXT==INT ; SIXBIT FILE EXTENSION
FS$PRV==INT ; PROTECTION, ETC.
FS$PTH==INT ; PATH
FS$PPN==FS$PTH+2 ; PPN
FS$SFD==FS$PTH+3 ; FIRST SFD
FS$LTH==FS$SFD+C$SFDL ; LENGTH OF FILE SPEC BLOCK
; FAKE CHARACTERS FOR SEARCH MATRIX
$CHBEG==200 ; SIGNALS MATCH WITH BEGINNING OF BUFFER
$CHEND==201 ; SIGNALS MATCH WITH END OF BUFFER IF NO EOL AT END
$CHSPC==202 ; SIGNALS MATCH WITH MULTIPLE SPACES/TABS
SRHLN==$CHSPC+1 ; # WORDS IN SEARCH MATRIX
SUBTTL Flag AC Bit Definitions
BIT (1B0) ; PRIME THE BIT GENERATOR
F$CCL==BIT ; CCL ENTRY WAS MADE
F$GCN==BIT ; GARBAGE COLLECTION IS NEEDED
F$1RG==BIT ; AN ARGUMENT IS PRESENT (CDC)
F$2RG==BIT ; A SECOND ARG IS PRESENT (CDC)
F$TRC==BIT ; IN TRACE MODE
F$REF==BIT ; T3=ADRREF(NOT ID) FOR QSTOR ROUTINE
F$EOF==BIT ; END OF FILE REACHED
F$FFD==BIT ; FORM FEED AT END OF BUFFER
F$NTI==BIT ; GETCH ROUTINE IS NOT INPUTTING FROM USER'S TERMINAL
F$EOL==BIT ; END OF LINE CHAR SEEN
F$LSF==BIT ; LAST SEARCH FAILED
F$COL==BIT ; THIS IS A ":" COMMAND (TRAP ON ERRORS)
F$DTM==BIT ; DELIMITED TEXT MODE
F$DNC==BIT ; DOWNCASE ALL INPUT LETTERS
F$UPC==BIT ; UPCASE ALL INPUT LETTERS
F$CNT==BIT ; ONLY ^R AND ^T ARE SPECIAL IN TEXT STRINGS
F$CNV==BIT ; DOWNCASE THE NEXT CHAR IF IT IS A LETTER
F$CVV==BIT ; DOWNCASE LETTERS TILL END OF STR OR FURTHER NOTICE
F$CNW==BIT ; UPCASE NEXT CHAR IF A LETTER
F$CWW==BIT ; DOWNCASE LETTERS TILL END OF STR OR FURTHER NOTICE
F$CNX==BIT ; EXACT SEARCH MODE
F$EXM==BIT ; EXACT SEARCH MODE CAUSED BY ^W OR ^W
F$EMA==BIT ; EXACT SEARCH MODE CAUSED BY ^\
F$CNN==BIT ; PREVIOUS CHAR WAS ^N(SEARCH MATRIX GENERATION)
F$BPG==BIT ; FIRST CHAR MATCHED WITH BEGINNING OF PAGE
F$MSR==BIT ; DOING MINUS SEARCH
F$NOF==BIT ; TEMPORARILY SUPPRESS CASE FLAGGING
F$URD==BIT ; A FILE IS OPEN FOR READING
F$UWR==BIT ; A FILE IS OPEN FOR WRITING
F$UBK==BIT ; "EB" IN PROGRESS
F$EDC==BIT ; RUN A PROGRAM WHEN WE EXIT
F$CMP==BIT ; COMPILE TEXT BUFFER (USED BY "MACRO")
F$STB==BIT ; SUPPRESS NEXT CHAR IF A TAB (FOR LSNS)
F$LSN==BIT ; CURRENT INPUT FILE HAS LSNS
F$REE==BIT ;[317] STOP BEFORE EXECUTING NEXT CMD
F$LOG==BIT ;[330] LOG FILE IN USE
F$$RG==F$1RG!F$2RG!F$COL!F$DTM ; ARGUMENT FLAGS (CDC)
F$$TX==F$CNT!F$CNV!F$CVV!F$CNW!F$CWW!F$EXM!F$EMA!F$CNN ; TEXT MODE FLAGS
; FOR TEXT INSERTION
F$$IO==F$URD!F$UWR!F$UBK!F$LOG ; I/O FLAGS
SUBTTL Transfer Vector Table for Command Execution
DEFINE TV (CMD)<$$'CMD: IFNDEF $'CMD,<PORTAL BEGIN>
IFDEF $'CMD,<PORTAL $'CMD>>; GEN A TRANSFER VECTOR
; CMDTVT - MACRO TO DEFINE THE COMMAND TRANSFER VECTOR TABLE
; ***** THIS TABLE SHOULD BE GENERATED BEFORE ANYTHING THAT COULD
; POSSIBLY CHANGE (PREFERABLY AT START OF HISEG)
DEFINE CMDTVT<XLIST
TV (CTM) ; TYPE COMMAND IF IN TRACE MODE
TV (ER) ; SELECT FILE FOR INPUT
TV (EM) ; POSITION MAGNETIC TAPE
TV (EW) ; SELECT FILE FOR OUTPUT
TV (EZ) ; ZERO DIRECTORY AND SELECT FILE FOR OUTPUT
TV (EB) ; EDIT BACKUP
TV (ED) ; SETUP FILE TO BEW RUN ON EXIT
TV (EI) ; EXECUTE AN INDIRECT COMMAND FILE
TV (EP) ; READ A FILE INTO Q-REGISTER "*"
TV (EA) ; APPEND TO A FILE
TV (EE) ; SAVE STATE IN A RUNNABLE FILE
TV (EL) ;[330] MAKE A LOG FILE
TV (ELA) ;[330] ALTER LOG FILE PARAMERERS
TV (EN) ; RENAME CURRENT INPUT FILE
TV (EH) ; RETURN MESSAGE LENGTH
TV (EHS) ; SET MESSAGE LENGTH
TV (GTB) ; GETTAB MUUO (N,M^G)
TV (PEK) ; PEEK MUUO (N^G)
TV (Y) ; CLEAR BUFFER AND INPUT ONE PAGE
TV (CNY) ;[327] YANK IN SPECIFIED PAGE
TV (CNU) ;[333] USETI TO SPECIFIED BLOCK
TV (A) ; APPEND A PAGE
TV (J) ; MOVE POINTER TO ABSOLUTE POSITION
TV (C) ; ADVANCE POINTER N POSITIONS
TV (R) ; BACKUP POINTER N POSITIONS
; EQUIVALENT TO -NC
TV (L) ; MOVE TO A LINE RELATIVE TO "."
TV (T) ; TYPE TEXT FROM BUFFER BETWEEN TWO POINTS
TV (TL) ; TYPE N LINES FROM BUFFER
TV (0TT) ; TYPE CURRENT LINE IF LAST SEARCH SUCCEEDED
TV (DEC) ; TYPE THE DECIMAL INTEGER N
TV (OCT) ; TYPE THE OCTAL INTEGER N
TV (MES) ; TYPE A MESSAGE
TV (TTY) ;[306] RETURN TTY#+^O200000 OF JOB N
TV (FFD) ; TYPE A FORMFEED
TV (TTC) ; PERFORM ANY TTCALL
TV (D) ; DELETE CHARACTERS
TV (K) ; DELETE TEXT BETWEEN TWO POINTS
TV (KL) ; DELETE LINES OF TEXT
TV (I) ; INSERT TEXT
TV (NI) ; INSERT CHARACTER WITH THE ASCII VALUE N
TV (TAB) ; TAB INSERT (IE: INSERT <TAB> THEN TEXT
TV (BS1) ; INSERT THE ASCII REPRESENTATION OF DECIMAL N
TV (BS2) ; VALUE OF NUMBER TO RIGHT OF POINTER
TV (UP) ; TRANSLATE TO UPPER CASE
TV (CX) ; ^X - RETURN VALUE OF EXACT SEARCH MODE FLAG
TV (CXS) ; N^X - SET EXACT SEARCH MODE FLAG
TV (LOW) ; TRANSLATE TO LOWER CASE
TV (PW) ; OUTPUT THE CURRENT PAGE AND APPEND
; A FORMFEED TO IT
TV (P) ; OUTPUT CURRENT PAGE
TV (BP) ; OUTPUT PART OF CURRENT PAGE (WITHIN BOUNDS)
TV (CNP) ; POSITION TO A PAGE IN FILE
TV (EF) ; CLOSE THE OUTPUT FILE
TV (CNZ) ; CLOSE THE OUTPUT FILE AND EXIT
TV (EX) ; OUTPUT REMAINDER OF FILE AND EXIT
; EXIT TO THE MONITOR
TV (EG) ; "EX" AND DO LAST COMPILE-CLASS COMMAND
TV (S) ; SEARCH FOR A STRING ON CURRENT PAGE
TV (BS) ; BOUNDED SEARCH
TV (FS) ; CHANGE STR1 TO STR2 ON CURRENT PAGE
TV (N) ; SAME AS "S" BUT USE REST OF FILE
TV (BAR) ;SAME AS "N" BUT DON'T OUTPUT
TV (SEM) ; JUMP OUT OF CURRENT ITERATION
TV (SEMF) ; JUMP OUT OF CURRENT ITERATION IF LAST SEARCH FAILED
TV (SEMZ) ; JUMP OUT OF CURRENT ITERATION IF ARG IS ZERO
TV (CKC) ; CHECK IF ARG IS A SYMBOL CONSTITUENT
TV (CKA) ; CHECK IF ARG IS A LETTER
TV (CKD) ; CHECK IF ARG IS A DIGIT
TV (CKV) ; CHECK IF ARG IS A LOWER CASE LETTER
TV (CKW) ; CHECK IF ARG IS AN UPPER CASE LETTER
TV (U) ; STORE INTEGER IN Q-REGISTER
TV (Q) ; RETURN VALUE STORED IN Q-REGISTER
TV (INC) ; INCREMENT Q-REGISTER BY 1 AND RETURN VALUE
TV (X) ;EXTRACT TEXT FROM TEXT BUFFER
TV (XL) ; STORE LINES FROM BUFFER INTO Q-REGISTER
TV (G) ;GET TEXT FROM A Q-REGISTER
TV (M) ; EXECUTE THE TEXT IN A Q-REGISTER
; AS A COMMAND STRING
TV (PUSH) ; PUSH CONTENTS OF A Q-REGISTER ON QPDL
TV (POP) ; POP QPDL INTO A Q-REGISTER
TV (NA) ;VALUE OF CHAR FOLLOWING POINTER
; POINTER
TV (CNE) ; RETURN VALUE OF THE FORMFEED FLAG.
TV (CNN) ; RETURN VALUE OF THE END-OF-FILE FLAG
TV (STOP) ; <ALT><ALT> (IE: STOP EXECUTION)
TV (EC) ; RETURN LOWSEGMENT SIZE IN WORDS
TV (ECS) ; SET THE LOWSEGMENT SIZE
LIST
SALL>
;THESE INSTRUCTIONS MUST BE THE FIRST DATA WORDS IN HISEG
$EECON: XTCERR:
FOR FTXTEC, PORTAL $EECNT ;[325] CALL EE CONTINUE
FOR FTXTCERR, PORTAL ERMT ;[325] CALL ERROR ROUTINE
FOR FTXTEC!FTXTCERR,SALL ;[410] RESTORE LISTING
; GENERATE THE COMMAND TRANSFER VECTOR TABLE HERE
FOR FTXTEC,<
CMDTVT
SUBTTL Startup Initialization
XTEC: PORTAL .+2 ; ENTRY POINT FOR NORMAL ENTRY
PORTAL .+2 ; ENTRY POINT FOR CCL ENTRY
TDZA T1,T1 ; THIS IS THE NORMAL ENTRY POINT
MOVX T1,F$CCL ; THIS IS THE CCL ENTRY POINT
RESET ; "CLEAR THE WORLD"
; CLEAR IMPURE LOW SEGMENT DATA
STORE (T2,LOWBEG,LOWEND,0)
; INITIALIZE PURE LOW SEGMENT CODE
MOVE T2,[<HICODE,,LOCODE>] ; SETUP BLT POINTER
BLT T2,LOCEND ; BLT CODE TO LOWSEGMENT
; STORE INFORMATION ABOUT WHERE WE CAME FROM
MOVEM .SGNAM,GSGNAM ; STORE OUR NAME
MOVEM .SGNAM,SEGNAM ; (DITTO)
MOVEM .SGPPN,GSGPPN ; STORE OUR DIRECTORY
MOVEM .SGDEV,GSGDEV ; STORE OUR DEVICE
MOVEM .SGLOW,GSGLOW ; SAVE OUR LOW FILE EXTENSION
; INITIALIZE FLAGS
MOVE F,T1 ; T1 HAS CCL ENTRY FLAG
; RELEASE EXTRA CORE
$XTEC: MOVE X,.JBFF ;[375] FETCH FIRST FREE ADR
MOVEM X,HEAD ; DYNAMIC FREE CORE WILL START THERE
MOVEI T1,(X) ; SAVE THE ADR
CORE X, ; TELL MONITOR EXACTLY HOW MUCH CORE WE NEED
JFCL ; ? ? ?
SETZM (T1) ; FIRST FREE LOC MUST BE ZERO
; (FOR THE CORE MANAGEMENT ROUTINES)
; SETUP APR TRAP ADDRESS
MOVEI X,APRTRP ; FETCH ADR OF APR TRAP HANDLER
MOVEM X,.JBAPR ; AND STORE IN JOBDAT WHERE MONITOR CAN SEE IT
; ENABLE FOR APR POV & ILM TRAPS
MOVX X,AP.REN!AP.POV!AP.ILM ; ENABLE FOR PDL OV AND ILL MEM REF AGAIN AND AGAIN
APRENB X, ; TELL THE MONITOR TO ENABLE THE APR FOR US
; SETUP ADDRESS OF LUUO HANDLER
MOVE X,[PUSHJ P,UUOTRP] ; LUUOS WILL CAUSE PUSHJ TO UUOTRP
MOVEM X,.JB41 ; STORE INSTRUCTION IN JOBDAT
; SETUP ADDRESS OF REENTER HANDLER (FOR ^C^C.REENTER)
MOVEI X,REENTR ; FETCH ADR OF REENTER HANDLER
MOVEM X,.JBREN ; AND STORE IT IN JOBDAT WHERE MONITOR WILL SEE IT
MOVEI X,RESTRT ;[375] LOAD RESTART ADR
HRRM X,.JBSA ;[350] SO SAVEGET DOESN'T GET CLOBBERED
; SETUP TEMPORARY CONTROL PDP
MOVE P,[IOWD C$TPDL,TPDL] ;[301] SETUP TEMP PDP
; INITIALIZE THE MAIN TEXT EDITING BUFFER
MOVEI L,TXTBUF ; FETCH ADR OF REFERENCE TO IT
PUSHJ P,RELM ; RELEASE IT IF IT EXISTS
MOVE L,[<TXTBUF,,C$TBLN>] ; ARG FOR ALLOCATING TEXT BUFFER
PUSHJ P,REQM ; ALLOCATE THE TEXT BUFFER
MOVEI X,NOOF ;[304] FETCH ADR FOR NO OUTPUT FILE ERROR
MOVEM X,PCHADR ;[304] TO PREVENT ILL. UUOS
; INITIALIZE CASE FLAGGING TO C$EUVL
IFE C$EUVL+1,<SETOM EUVAL> ; -1=FLAG NONE
IFE C$EUVL,<SETZM EUVAL> ; 0=FLAG LOWER CASE
IFE C$EUVL-1,<MOVEI X,1 ; +1=FLAG UPPER CASE
MOVEM X,EUVAL> ; . . .
; INITIALIZE "LAST" FILE SPECIFICATIONS
MOVSI X,'DSK' ; DEFAULT DEVICE IS 'DSK'
MOVEM X,LERSPC+FS$DEV ; FOR "ER" FILE-SPEC
MOVEM X,LEWSPC+FS$DEV ; AND LAST "EW" FILE-SPEC
MOVEM X,LEBSPC+FS$DEV ; AND LAST "EB" FILE-SPEC
MOVEM X,LEISPC+FS$DEV ; AND LAST "EI" FILE-SPEC
MOVEM X,LEDSPC+FS$DEV ; AND LAST "ED" FILE-SPEC
MOVEM X,LEESPC+FS$DEV ; AND LAST "EE" FILE-SPEC
MOVEM X,LELSPC+FS$DEV ;[330] AND LAST "EL" FILE-SPEC
MOVE X,SEGNAM ;[330] DEFAULT LOG NAME IS MY NAME
MOVEM X,LELSPC+FS$NAM ;[330] . . .
MOVSI X,'LOG' ;[330] DEFAULT LOG EXTENSION IS 'LOG'
MOVEM X,LELSPC+FS$EXT ;[330] . . .
MOVSI X,'TEC' ; FETCH DEFAULT EXT. FOR "EI"
MOVEM X,LEISPC+FS$EXT ; AND SET DEFAULT FILE EXT. FOR "EI"
MOVSI X,'SAV' ; FETCH DEFAULT FILE EXT FOR SAVE FILE
MOVEM X,LEESPC+FS$EXT ; AND STORE FOR LATER
; INITIALIZE THE BYTE POINTER FOR MOVING LAST PARTIAL WORD IN 'MKROOM'
MOVE X,[POINT 0,-1(14),34] ; FETCH THE BYTE POINTER
MOVEM X,MKRMBP ; AND STORE FOR USE BY 'MKROOM'
; SETUP THE CONTROL PDL POINTER
STSTK (P,C$PDLL,PDL) ; SETUP THE CONTROL PDL POINTER
; SETUP Q-REGISTER TABLE (QTAB)
STSTK (QR,C$QRLN,QTAB)
; SETUP Q-REGISTER PUSHDOWN LIST (QPDL)
STSTK (QP,C$QPLN,QPDL)
MOVE X,QP ; FETCH THE PDP FOR QPDL
PUSH X,[<0>] ; AND PUSH 3 ZEROS TO MARK BEGINNING
PUSH X,[<0>] ; . . .
PUSH X,[<0>] ; . . .
MOVEM X,QP ; AND STORE THE UPDATED PDP
; SETUP OUR CCL JOB NUMBER (IE: '###XTC')
PUSHJ P,MAKCJN ; MAKE OUR CCL JOB NUMBER
; AND STORE IN "CCJNAM"
; FETCH MESSAGE LENGTH
GTMSG. (X) ; GETTAB MESSAGE LENGTH
MOVEM X,EHVAL ; AND STORE FOR LATER
; STARTUP INITIALIZATION COMPLETE.
SUBTTL Compile&Execute XTEC Option Line from DSK:SWITCH.INI[,]
; SEE IF DSK:SWITCH.INI[-] EXISTS
MOVE N,[Z INP,0] ; SETUP INPUT CHANNEL
MOVEM N,INPCHN ; . . .
MOVEI M,INIBH ; FETCH ADR OF INPUT BUFFER HEADER
MOVEI L,FILSPC ; FETCH ADR OF FILE-SPEC
SETZM FS$FLG(L) ; CLEAR FILE-SPEC FLAGS
MOVSI X,'DSK' ; DEVICE IS 'DSK'
MOVEM X,FS$DEV(L) ; . . .
MOVE X,['SWITCH'] ; NAME IS 'SWITCH'
MOVEM X,FS$NAM(L) ; . . .
MOVSI X,'INI' ; EXTENSION IS 'INI'
MOVEM X,FS$EXT(L) ; . . .
; GETPPN X, ; GET OUR PPN
; JFCL ; (IN CASE OF JACCT)
; MOVEM X,FS$PPN(L) ; AND USE AS PPN FOR FILE
SETZM FS$PPN(L) ;[340] USE DEFAULT PATH FOR PPN
SETZM FS$SFD(L) ; CLEAR SFDS
PUSHJ P,FILOPN ; OPEN DSK:
JRST NOSWI ; NO SWITCH.INI
PUSHJ P,FILLKP ; LOOKUP SWITCH.INI[-]
JRST NOSWI ; NO SWITCH.INI
MOVEI X,[TXO F,F$EOF ; ADR OF WHERE TO GO ON EOF
MOVEI C,.CHESC
POPJ P,]
MOVEM X,INPEOF ; STORE ADR OF EOF PROCESSOR
MOVEI X,[ERROR (IES)] ; FETCH ADR OF WHERE TO GO ON INPUT ERROR
MOVEM X,INPERR ; AND STORE FOR LATER
MOVEI X,INIBH ; FETCH ADR OF BUFFER HEADER
MOVEM X,INPBH ; AND STORE FOR LATER
TXO F,F$NTI ; NOT INPUTTING FROM USER'S TERMINAL
; TRY TO FIND THE XTEC LINE IN SWITCH.INI
INI1: PUSHJ P,GSIX ; PICKUP NAME FROM SWITCH.INI LINE
JUMPE N,INI2 ; NONE. IGNORE THIS LINE
XOR N,SEGNAM ; SEE IF IT IS THE XTEC LINE
JUMPE N,INI3 ; YES
INI2: PUSHJ P,GEOL ; NO, EAT THE LINE
TXZN F,F$EOF ; END OF FILE?
JRST INI1 ; NO, KEEP SEARCHING FOR XTEC LINE
JRST NOSWI ; YES, THEN THERE IS NO XTEC LINE
; COPY THE XTEC LINE TO COMMAND BUFFER AND EXECUTE IT
INI3: MOVEI L,CURCMD ; FETCH ADR OF THE COMMAND BUFFER
PUSHJ P,RELM ; FREE IT
MOVE L,[<CURCMD,,C$CMDL+T$DATA>] ; ALLOCATE NEW COMMAND BUFFER
PUSHJ P,REQM ; . . .
MOVE T3,[POINT 7,T$DATA(T5)] ; SETUP BYTE POINTER TO CMD BUFFER
MOVEI T4,C$CMDL*5-2 ; SETUP COUNT OF CHARS LEFT IN BUFFER
INI4: PUSHJ P,GCHR ; FETCH NEXT CHAR FROM SWITCH.INI
MOVE T5,CURCMD ; FETCH BASE ADR OF COMMAND BUFFER
SOJL T4,INI5 ; BUFFER IS FULL
AOS (T5) ; COUNT THE CHAR
IDPB C,T3 ; AND STORE IT IN THE BUFFER
TXZN F,F$EOL ; WHOLE LINE IN BUFFER?
JRST INI4 ; NO, FETCH ANOTHER CHAR
INI5: MOVEI C,.CHESC ; APPEND TWO ALTMODES TO LINE
IDPB C,T3 ; . . .
IDPB C,T3 ; . . .
AOS (T5) ; AND COUNT THEM
AOS (T5) ; . . .
; NOW COMPILE AND EXECUTE THE LINE
MOVEI L,CURCMD ; FETCH ADR OF COMMAND BUFFER
PUSHJ P,ADDBLK ; ADD THE BUFFER TO THE LINKED LIST
MOVEM N,CMDBID ; SAVE THE BUFFER ID
MOVE L,['[SINI]'] ; GIVE THE BUFFER A NAME
TXO F,F$CMP ; FLAG TO "FORCE COMPILATION"
PUSHJ P,MACRO ; AND COMPILE&EXECUTE THE BUFFER
MOVE N,CMDBID ; RESTORE THE BUFFER ID
PUSHJ P,DELBLK ; AND DELETE THE BUFFER
NOSWI:; JRST INISET ; DO XTEC.INI IF IT EXISTS
SUBTTL COMPILE&EXECUTE DSK:XTEC.INI[,] if it exists
INISET: MOVEI L,FILSPC ; FETCH ADR OF FILE-SPEC
SETZM FS$FLG(L) ; CLEAR THE FILE-SPEC FLAGS
MOVSI X,'DSK' ; DEVICE IS 'DSK'
MOVEM X,FS$DEV(L) ; . . .
MOVE X,SEGNAM ; NAME IS NAME OF THIS SEGMENT
MOVEM X,FS$NAM(L) ; . . .
MOVSI X,'INI' ; EXTENSION IS 'INI'
MOVEM X,FS$EXT(L) ; . . .
; GETPPN X, ; GET OUR PPN
; JFCL ; (IN CASE OF JACCT)
; MOVEM X,FS$PPN(L) ; USE AS FILE PPN
SETZM FS$PPN(L) ;[340] USE DEFAULT PATH FOR PPN
SETZM FS$SFD(L) ; CLEAR SFDS
SETZ N, ; USE CHANNEL ZERO
MOVEI M,INIBH ; FETCH ADR OF INPUT BUFFER HEADER
PUSHJ P,FILOPN ; AND TRY TO FIND FILE
JRST NOINI ; NOT THERE. NO XTEC.INI FILE
PUSHJ P,FILLKP ; TRY TO FIND FILE STILL
JRST NOINI ; NOT THERE. NO XTEC.INI FILE
RELEAS 0, ; RELEASE THE CHANNEL
PUSHJ P,FILERD ; AND READ THE FILE
MOVEM N,CMDBID ; SAVE THE BUFFER ID
MOVE L,['[XINI]'] ; GIVE THE COMMAND A NAME
TXO F,F$CMP ; FORCE COMPILATION
PUSHJ P,MACRO ; AND COMPILE&EXECUTE THE MACRO
MOVE N,CMDBID ; RESTORE THE BUFFER ID
PUSHJ P,DELBLK ; AND DELETE THE BLOCK
NOINI: RELEAS 0, ; RELEASE CHANNEL ZERO
; JRST CCLSET ; DO CCL SETUP IF NECESSARY
SUBTTL CCL Setup
CCLSET: TXNN F,F$CCL ; WAS CCL ENTRY MADE?
JRST NOCCL ; NO
; TRY TO READ TMPCOR CCL FILE
MOVE T1,[<.TCRDF,,[EXP 'EDT ',<IOWD 200,INPBF+3>]>]
; SETUP TMPCOR ARG BLOCK
TMPCOR T1, ; TRY TO READ TMPCOR CCL FILE
JRST CCLST1 ; CAN'T. TRY DSK:###EDT.TMP[-]
; SETUP BYTE POINTER FOR TMPCOR BUFFER
MOVE X,[POINT 7,INPBF+3,6] ; POINT TO 2ND CHAR OF BUFFER
; (TO IGNORE THE LINED "S")
MOVEM X,INPBH+1 ; STORE THE BP IN INPUT BUFFER HEADER
JRST CCLST2 ; AND FIND THE "TECO" COMMAND
; TRY TO READ DSK:###EDT.TMP
CCLST1: INIT INP,.IOASL ; INIT 'DSK'
('DSK') ; . . .
<0,,INPBH> ; . . .
CCLERR: ERROR (CCM) ; ** CCL COMMAND MISSING **
MOVE T1,CCJNAM ; AND LOOKUP ###EDT.TMP
HRRI T1,'EDT' ; . . .
MOVSI T2,'TMP' ; . . .
SETZB T3,T4 ; . . .
LOOKUP INP,T1 ;[351] . . .
ERROR (CCM) ;[322] BALK
MOVEI T1,INPBF ;[400] LOAD ADDR OF INPUT BUFFER
EXCH T1,.JBFF ;[400] SWAP TO FOOL MONITOR
INBUF INP,C$NBUF ;[400] SET UP 1 BUFFER AT INPBF
MOVEM T1,.JBFF ;[400] RESTORE .JBFF
INPUT INP, ; INPUT DISK BUFFER
IBP INPBH+1 ; AND SKIP OVER THE LINED "S"
SETZ T1, ;[367] ZERO FILENAME MEANS DELETE
RENAME INP,T1 ;[367] DELETE IT
JFCL ;[367] SORRY HUN
RELEAS INP, ;[367] FREE CHANNEL
; READ FILE SPEC OF FORM SFILE-SPEC<ALT> OR SFILE-SPEC<CR>
; (<ALT> MEANS DO "EW", <CR> MEANS DO "EB" AND "EY")
CCLST2: MOVEI L,CURCMD ; ALLOCATE COMMAND BUFFER
PUSHJ P,RELM ; . . .
MOVE L,[<CURCMD,,200>] ; . . .
PUSHJ P,REQM ; . . .
MOVE T3,CURCMD ; SETUP BYTE POINTER TO CMD BUFFER
ADD T3,[POINT 7,T$DATA,13] ; . . .
MOVE T5,T3 ; SAVE BP TO THE "B" OF "EB"
MOVSI X,("EB"B13) ; SETUP FOR AN "EB" COMMAND
MOVEM X,(T3) ; . . .
SETZ T4, ; CLEAR THE CHAR COUNT
; PUT THE FILE-SPEC IN THE COMMAND BUFFER
CCLST3: ILDB C,INPBH+1 ; FETCH CCL CHAR
JUMPE C,CCLERR ;[367] NULL IN CCL MEANS SOMETHING FUNNY
CAIE C,.CHALT ; IS CHAR AN OLD ALTMODE?
CAIN C,.CHAL2 ; (TRY ALL FLAVORS!)
MOVEI C,.CHESC ; YES, CONVERT TO NEW STYLE <ALT>
IDPB C,T3 ; AND PUT IN COMMAND BUFFER
CAIN C,.CHCRT ; IS IT A <CR>?
JRST CCLST4 ; YES, FILE-SPEC IS COMPLETE
CAIE C,.CHESC ; IS IT <ALT>?
AOJA T4,CCLST3 ; NO, COUNT AND TRY NEXT CHAR
; SFILE-SPEC$ - COMMAND TO CREATE A FILE
MOVEI C,"W" ; CHANGE "EB" TO "EW"
DPB C,T5 ; . . .
JRST CCLST5 ; AND FINISH UP
; SFILE-SPEC<CR> - COMMAND TO "TECO" A FILE-SPEC
CCLST4: MOVEI C,.CHESC ; ADD AN <ALT> TO COMMAND
DPB C,T3 ;[367] . . .
MOVEI C,"E" ; ADD "EY" TO READ IN FIRST PAGE
IDPB C,T3 ; . . .
MOVEI C,"Y" ; . . .
IDPB C,T3 ; . . .
MOVEI T4,3(T4) ; COUNT THE <ALT>EY
; APPEND <ALT><ALT> TO COMMAND AND EXECUTE IT
CCLST5: MOVEI C,.CHESC ; FETCH AN <ALT>
IDPB C,T3 ; APPEND <ALT> TO COMMAND
IDPB C,T3 ; AND ANOTHER FOR GOOD LUCK
MOVEI T4,3(T4) ; COUNT <ALT><ALT> PLUS TERM CHAR
MOVEM T4,@CURCMD ; STORE CHAR COUNT FOR BUFFER
MOVEI L,CURCMD ; FETCH ADR OF COMMAND BUFFER
PUSHJ P,ADDBLK ; ADD THE BUFFER TO THE LINKED LIST
MOVEM N,CMDBID ; SAVE THE BUFFER ID
MOVX L,C$CCNM ; GIVE THE CCL BUFFER A NAME
TXO F,F$CMP ; FLAG TO "FORCE COMPILATION"
PUSHJ P,MACRO ; AND COMPILE&EXECUTE THE BUFFER
MOVE N,CMDBID ; RESTORE THE BUFFER ID
PUSHJ P,DELBLK ; AND DELETE THE BUFFER
NOCCL: TXZ F,F$NTI ; INPUT FROM USER'S TERMINAL AGAIN
SETZM INPADR ; . . .
SETZM INPCHR ; . . .
; JRST BEGIN ; AND BEGIN NORMAL COMMAND PROCESSING
SUBTTL Command Input Processor
BEGIN:
; SETUP THE CONTROL PDL POINTER
STSTK (P,C$PDLL,PDL) ; SETUP CONTROL PDL
; OUTPUT "*" AS PROMPT
TXZ F,F$$RG ;[352] CLEAR ARG FLAGS
MOVEI C,"*" ; FETCH THE "*" PROMPT CHAR
SKIPN INPCHR ; ALREADY HAVE FIRST CHAR?
PUSHJ P,TCHR ; NO, TYPE PROMPT
; CHECK FOR THE "*" COMMAND (IE: SAVE LAST COMMAND IN A Q-REGISTER)
PUSHJ P,GETCH ; READ NEXT INPUT CHAR
CAIN C,"*" ; IS IT A "*"?
JRST SAVPCM ; YES, SAVE PREVIOUS COMMAND IN Q-REGISTER
MOVEM C,INPCHR ; NO, SAVE THE FIRST CHAR OF COMMAND STRING
; RELEASE THE PREVIOUS COMMAND BUFFER
BEGIN1: SKIPE N,PCMBID ; A PREVIOUS COMMAND?
PUSHJ P,DELBLK ; YES, DELETE ITS BUFFER
MOVE N,CMDBID ; NO, FETCH CURRENT BUFFER ID
MOVEM N,PCMBID ; AND SAVE AS BID FOR "PREVIOUS" COMMAND
; ALLOCATE A NEW COMMAND BUFFER
MOVE L,[<CURCMD,,C$CMDL+T$DATA>] ; ARG FOR ALLOCATING BLOCK
PUSHJ P,REQM ; ALLOCATE NEW COMMAND BUFFER
MOVEI L,CURCMD ; FETCH ADR OF REF TO BUFFER
PUSHJ P,ADDBLK ; AND ADD THE BLOCK TO THE LINKED LIST
MOVEM N,CMDBID ; AND SAVE ITS BUFFER ID
PUSHJ P,FNDBLK ; "CURCMD" WILL REFERENCE THE BUFFER
ERROR (XXX) ; CAN'T FIND BLOCK. SHOULDN'T OCCUR!
; SETUP CHAR COUNTS AND BYTE POINTER FOR COMMAND BUFFER
SETZ T5, ; ZAP THE CHAR COUNT
MOVEI T3,C$CMDL*5 ; # CHARS WE CAN PUT IN BUFFER
MOVE T4,[POINT 7,T$DATA(T5)] ; BYTE POINTER
TXO F,F$NOF ; SUPPRESS CASE FLAGGING
; NOW READ COMMAND STRING
SUBTTL Read a Command String into the Command Buffer
RDLOOP: PUSHJ P,GETCH ; FETCH NEXT INPUT CHAR
RDLP0: CAIN C,.CHDEL ; IS CHAR A RUBOUT?
JRST RDRUB ; YES
CAIN C,.CHBEL ; IS CHAR A BELL(^G)?
JRST RDBEL ; YES
CAIN C,.CHCNU ; IS CHAR A ^U?
JRST RDCNU ; YES
; STORE THE CHAR IN COMMAND BUFFER BEFORE CHECKING FOR <ALT> OR ^R
PUSHJ P,RDIDPB ; STORE THE CHAR IN COMMAND BUFFER
CAIN C,.CHESC ; IS CHAR AN ALTMODE?
JRST RDESC ; YES
CAIN C,.CHCNR ; IS CHAR A ^R?
JRST RDCNR ; YES
CAIN C,.CHCNH ; IS CHAR ^H?
PUSHJ P,TCCHR ; YES, WE MUST ECHO IT
JRST RDLOOP ; ORDINARY CHAR. GO BACK FOR ANOTHER
; STORE CHAR IN COMMAND BUFFER
RDLP1: PUSHJ P,RDIDPB ; JAM THE CHAR INTO THE COMMAND BUFFER
JRST RDLOOP ; AND GO BACK FOR FOR INPUT
; RDRUB - PROCESS A RUBOUT
RDRUB: PUSHJ P,RDLDB ; FETCH LAST CHAR IN COMMAND BUFFER
JRST RDEMP ; NOTHING LEFT TO DELETE
PUSHJ P,TCCHR ; ECHO THE RUBBED OUT CHAR
PUSHJ P,RDDLDB ; BACK UP A CHAR IN BUFFER
JFCL ; IGNORE ERROR
JRST RDLOOP ; GO BACK FOR MORE INPUT
; RDCNU - PROCESS ^U (KILL CURRENT LINE OF COMMAND BUFFER)
RDCNU: PUSHJ P,TCCHR ; ECHO THE ^U
PUSHJ P,TCRLF ; GO TO A NEW LINE
PUSHJ P,RDFLF ; FIND THE PREVIOUS LINEFEED CHAR
JRST RDEMP1 ; NOTHING LEFT
JRST RDLOOP ; FOUND LF. GO BACK FOR SOME MORE INPUT
; RDBEL - PROCESS ^G
RDBEL: PUSHJ P,TCCHR ; ECHO "^G"
PUSHJ P,GETCH ; PICK UP CHAR THAT FOLLOWS THE ^G
CAIN C,.CHSPC ; IS CHAR A SPACE?
JRST RDRTYP ; YES, RETYPE CURRENT LINE
CAIN C,.CHBEL ; IS CHAR ANOTHER ^G?
JRST RDKILL ; YES, KILL ENTIRE COMMAND
; ^G IS JUST ANOTHER TEXT CHAR. STORE IT IN COMMAND BUFFER
MOVEI T1,(C) ; STORE THE CHAR THAT FOLLOWS THE ^G
MOVEI C,.CHBEL ; FETCH A ^G
PUSHJ P,RDIDPB ; STORE THE ^G IN COMMAND BUFFER
MOVEI C,(T1) ; FETCH THE CHAR THAT FOLLOWS THE ^G
JRST RDLP0 ; AND SEE IF IT HAS SOME SPECIAL MEANING
; RDRTYP - ^G<SP> - RETYPE CURRENT LINE FROM COMMAND BUFFER
RDRTYP: MOVE T1,@CURCMD ; FETCH CURRENT CHAR COUNT FOR COMMAND BUFFER
PUSHJ P,TCRLF ; GO TO A NEW LINE
PUSHJ P,RDFLF ; FIND THE PREVIOUS LINE FEED
JFCL ; NONE. BEG OF BUFFER MEANS SAME THING
SUB T1,@CURCMD ; MAKE A LOOP COUNT FOR RETYPING LINE
JUMPE T1,RDLOOP ; DONE IF NOTHING TO RETYPE
RDRTY1: PUSHJ P,RDILDB ; FETCH NEXT CHAR ON LINE
PUSHJ P,TCCHR ; AND TYPE IT
SOJG T1,RDRTY1 ; LOOP FOR ALL CHARS ON LINE
JRST RDLOOP ; DONE. GO BACK FOR SOME MORE INPUT
; RDKILL - ^G^G - KILL ENTIRE COMMAND BUFFER
RDKILL: PUSHJ P,TCCHR ; ECHO THE SECOND ^G
RDEMP: PUSHJ P,TCRLF ; GO TO A NEW LINE
RDEMP1: MOVE X,CURCMD ; FETCH ADR OF BUFFER
HRRZS X,T$1REF(X) ; AND UNBIND FROM CURCMD
SETZM CURCMD ; UNBIND CURCMD FROM BUFFER
JRST BEGIN ; AND REISSUE THE PROMPT CHAR
; RDESC - SEE IF END OF COMMAND STRING
RDESC: PUSHJ P,GETCH ; FETCH NEXT INPUT CHAR
CAIE C,.CHESC ; ANOTHER ALTMODE?
JRST RDLP0 ; NO, SEE IF IT HAS ANY SPECIAL MEANING
PUSHJ P,RDIDPB ; YES, STORE IT IN BUFFER
JRST RDFIN ; AND WE'RE DONE READING COMMAND STRING
; RDCNR - ^R - QUOTE THE NEXT CHAR
RDCNR: PUSHJ P,GETCH ; FETCH NEXT INPUT CHAR
CAIE C,.CHDEL ; IS IT A RUBOUT?
CAIN C,.CHCNU ; OR A ^U?
JRST RDLP0 ; YES, CAN'T QUOTE RUBOUT OR ^U
JRST RDLP1 ; NO, STORE THE QUOTED CHAR IN COMMAND BUFFER
SUBTTL Subroutines for Reading a Command String
; RDIDPB - IDPB CHAR INTO THE COMMAND BUFFER
RDIDPB: SOJL T3,RDIDP1 ; JUMP IF NO MORE ROOM IN BUFFER
MOVE T5,CURCMD ; FETCH BASE ADR OF COMMAND BUFFER
IDPB C,T4 ; STORE THE CHAR IN IT
AOS @CURCMD ; COUNT THE CHARS IN COMMAND BUFFER
POPJ P, ; AND RETURN TO CALLER
; EXPAND THE COMMAND BUFFER
RDIDP1: MOVEI N,C$CMDL ; HOW MUCH TO EXPAND BY
MOVEI L,CURCMD ; ADR OF THE BUFFER REFERENCE
PUSHJ P,EXPAND ; EXPAND THE COMMAND BUFFER
MOVEI T3,C$CMDL*5 ; CAN PUT THIS MANY MORE CHARS IN BUFFER
JRST RDIDPB ; CONTINUE WHERE WE LEFT OFF
; RDDLDB - DLDB LAST CHAR FROM COMMAND BUFFER
RDDLDB: SKIPN @CURCMD ; ANYTHING LEFT IN COMMAND BUFFER?
POPJ P, ; NO, GIVE NON-SKIP RETURN
ADD T4,[<7B5>] ; BACK UP A BYTE
JUMPG T4,.+3 ; OK
HRRI T4,-1(T4) ; MUST BACK UP A WORD
HRLI T4,(POINT 7,(T5),34) ; TO LAST BYTE IN PREVIOUS WORD
SOS @CURCMD ; DECREMENT THE CHAR COUNT
MOVE T5,CURCMD ; FETCH BASE ADR OF COMMAND BUFFER
LDB C,T4 ; AND FETCH CHAR FROM BUFFER
JRST CPOPJ1 ; GIVE SKIP RETURN TO CALLER
; RDLDB - LDB CHAR FROM COMMAND BUFFER
RDLDB: SKIPN @CURCMD ; ANYTHING IN BUFFER?
POPJ P, ; NO, GIVE NON-SKIP RETURN TO CALLER
MOVE T5,CURCMD ; YES, FETCH BASE ADR OF COMMAND BUFFER
LDB C,T4 ; FETCH CHAR FROM BUFFER
JRST CPOPJ1 ; AND GIVE SKIP RETURN TO CALLER
; RDILDB - ILDB CHAR FROM COMMAND BUFFER
RDILDB: MOVE T5,CURCMD ; FETCH BASE ADR OF COMMAND BUFFER
ILDB C,T4 ; FETCH NEXT CHAR FROM IT
AOS @CURCMD ; COUNT THE CHAR
POPJ P, ; AND RETURN TO CALLER
; RDFLF - FIND PREVIOUS LINEFEED IN COMMAND BUFFER
RDFLF: PUSHJ P,RDLDB ; FETCH CURRENT CHAR FROM COMMAND BUFFER
POPJ P, ; NONE LEFT. GIVE CALLER NON-SKIP RETURN
CAIN C,.CHLFD ; IS CHAR A LINEFEED?
JRST CPOPJ1 ; YES, GIVE CSKIP RETURN TO CALLER
PUSHJ P,RDDLDB ; NO, BACK UP A CHAR
POPJ P, ; NONE LEFT, GIVE NON-SKIP RETURN TO CALLER
JRST RDFLF ; KEEP LOOKING FOR THE PREVIOUS LF
SUBTTL Command String is Stored. Process it.
RDFIN: PUSHJ P,TCRLF ; GO TO A NEW LINE
MOVE X,CURCMD ; FETCH ADR OF REF TO BUFFER
HRRZS T$1REF(X) ; AND UNBIND THE REF
SETZM CURCMD ; AND ZERO "CURCMD"
MOVE L,['[CCMD]'] ; MAKE A NAME FOR THE CMD BUFFER
MOVE N,CMDBID ; AND FETCH BUFFER ID FOR COMMAND BUFFER
TXO F,F$CMP ; FLAG THAT BUFFER MUST BE COMPILED
PUSHJ P,MACRO ; AND COMPILE&EXECUTE THE CMD BUFFER
JRST BEGIN ; GO BACK FOR ANOTHER COMMAND
SUBTTL Command Decoder Dispatch Table
DEFINE DSP(D1,C1,D2,C2)<<D1+C1,,D2+C2>>
D$JR== 0B20 ; SIMPLE JRST DISPATCH
D$EC== 1B20 ; EVALUATE PRECEDING ARG AND THEN PUSHJ
D$EJ== 2B20 ; EVALUATE PRECEDING ARG AND THEN JRST
D$$DSP==D$JR!D$EC!D$EJ ; ALL OF THE DISPATCH BITS
DSPTBL: DSP (D$JR,CDERR,D$JR,CDCNA) ; ^@ ^A
DSP (D$JR,CDERR,D$JR,CDCNC) ; ^B ^C
DSP (D$JR,CDERR,D$JR,CDCNE) ; ^D ^E
DSP (D$EJ,CDCNF,D$EJ,CDCNG) ; ^F ^G
DSP (D$JR,CDCNH,D$EJ,CDTAB) ; ^H TAB
DSP (D$JR,CDCIGN,D$JR,CDCIGN) ; LF VT
DSP (D$JR,CDCNL,D$JR,CDCIGN) ; FF CR
DSP (D$JR,CDCNN,D$JR,CDOCT) ; ^N ^O
DSP (D$EJ,CDCNP,D$JR,CDERR) ; ^P ^Q
DSP (D$JR,CDERR,D$JR,CDERR) ; ^R ^S
DSP (D$EJ,CDCNT,D$EJ,CDCNU) ; ^T ^U
DSP (D$EJ,CDCNV,D$EJ,CDCNW) ; ^V ^W
DSP (D$EJ,CDCNX,D$EJ,CDCNY) ; ^X ^Y
DSP (D$JR,CDCNZ,D$JR,CDALT) ; ^Z ^[
DSP (D$JR,CDERR,D$JR,CDERR) ; ^\ ^]
DSP (D$JR,CDCUA,D$JR,CDERR) ; ^^ ^_
DSP (D$EJ,CDADD,D$JR,CDEXC) ; SPACE !
DSP (D$EJ,CDQUO,D$EJ,CDOR) ; " #
DSP (D$JR,CDERR,D$JR,CDPCT) ; $ %
DSP (D$EJ,CDAND,D$JR,CDAPO) ; & '
DSP (D$JR,CDLPA,D$EJ,CDRPA) ; ( )
DSP (D$EJ,CDMUL,D$EJ,CDADD) ; * +
DSP (D$EJ,CDCOM,D$EJ,CDSUB) ; , -
DSP (D$JR,CDPT,D$EJ,CDDIV) ; . /
DSP (D$JR,CDDIG,D$JR,CDDIG) ; 0 1
DSP (D$JR,CDDIG,D$JR,CDDIG) ; 2 3
DSP (D$JR,CDDIG,D$JR,CDDIG) ; 4 5
DSP (D$JR,CDDIG,D$JR,CDDIG) ; 6 7
DSP (D$JR,CDDIG,D$JR,CDDIG) ; 8 9
DSP (D$JR,CDCOL,D$EJ,CDSEM) ; : ;
DSP (D$EJ,CDLAB,D$EJ,CDEQU) ; < =
DSP (D$JR,CDRAB,D$JR,CDQST) ; > ?
DSP (D$JR,CDATS,D$EJ,CDA) ; @ A
DSP (D$JR,CDB,D$EJ,CDC0) ; B C
DSP (D$EJ,CDD,D$EJ,CDE) ; D E
DSP (D$EJ,CDF,D$JR,CDG) ; F G
DSP (D$JR,CDH,D$EJ,CDI) ; H I
DSP (D$EJ,CDJ,D$EJ,CDK) ; J K
DSP (D$EJ,CDL,D$EJ,CDM) ; L M
DSP (D$EJ,CDN,D$JR,CDO) ; N O
DSP (D$EJ,CDP,D$JR,CDQ) ; P Q
DSP (D$EJ,CDR,D$EJ,CDS) ; R S
DSP (D$EJ,CDT,D$EJ,CDU) ; T U
DSP (D$JR,CDERR,D$JR,CDERR) ; V W
DSP (D$EJ,CDX,D$EJ,CDY) ; X Y
DSP (D$JR,CDZ,D$JR,CDLSB) ; Z [
DSP (D$EJ,CDBKSL,D$JR,CDRSB) ; \ ]
DSP (D$JR,CDUAR,D$EJ,CDBAR) ; ^ _
CDERR: ERROR (ILL) ; ILLEGAL COMMAND
; PDL FLAGS
P$BEG== 0 ; BEGINNING OF COMMAND STRING
P$PAR== 1 ; LEFT PARENTHESIS
P$ITR== 2 ; LEFT ANGLE BRACKET
P$CON== 3 ; " FOR CONDITIONAL
SUBTTL COMPIL - Command Decoder and Compiler
; CALL: MOVEI L,COMMAND.BUFFER
; PUSHJ P,COMPIL
; (RETURN)
;
; GENERATES CODE AT THE END OF THE COMMAND BUFFER
;
; T4 HOLDS RELATIVE ADDRESS OF LAST CALL TO $$CTM
;
; T5 HOLDS INSTRUCTION TO PERFORM ON TWO ARGUMENTS
;
; USEAS ACS X,T1-T5
COMPIL: MOVEM L,CMDBUF ; SAVE ADR OF REF TO COMMAND BUFFER
; SETUP CHAR COUNT AND BYTE POINTER FOR COMMAND BUFFER
HRRZ X,@(L) ; FETCH CHAR COUNT
MOVEM X,CMDCNT ; AND STORE FOR CMDGCH ROUTINE
MOVE X,[POINT 7,T$DATA(R)] ; FETCH BP
MOVEM X,CMDBP ; AND STORE FOT 'CMDGCH' ROUTINE
; SETUP FOR GENERATING CODE AT END OF COMMAND BUFFER
MOVEI N,C$CODL ; INITIAL SIZE OF CODE SPACE
PUSHJ P,EXPAND ; ADD TO EXISTING SIZE OF COMMAND BUFFER
HRRZ T1,@(L) ; FETCH CHAR COUNT FOR BUFFER
IDIVI T1,5 ; CONVERT TO WORDS
MOVEI CP,T$DATA(T1) ; CP HAS RELATIVE ADR OF WHERE CODE
; WILL START
MOVE N,[<C$CODL,,CP>] ; ADD CURCMD TO THE LIST OF OVERFLOW
PUSHJ P,ADDPDL ; . . .
HRLI CP,-C$CODL+1 ; MAKE CP INTO A PDL POINTER
MOVE T1,(L) ; FETCH ADR OF BUFFER
MOVEI X,CP ; FETCH ADR OF "CP"
MOVEM X,T$ACRF(T1) ; AND BIND "CP" TO BUFFER
ADD CP,T1 ; FIX UP AC CP
; INITIALIZE TAG AND TAG REFERENCE PDLS
STSTK (TAG,C$LPDL,TAGPDL) ; SETUP TAG PDL
STSTK (REF,C$RPDL,REFPDL) ; SETUP TAG REF PDL
PUSH REF,[<0>] ; PUSH TWO ZEROS ON TAG REF PDL
PUSH REF,[<0>] ; . . .
; INITIALIZE PDL FLAG FOR BEGINNING OF COMMAND STRING
PUSH P,[<P$BEG>] ; FLAG BEGINNING OF PDL
; INITIALIZE THE INSTRUCTION IN T5
MOVEI T5,VALUE ; SETUP THE Y FIELD OF INST.
; GEN CODE TO CLEAR THE ":" COMMAND FLAG
SKIPA X,.+1 ; FETCH CODE TO CLEAR THE ":" FLAG
TXZ F,F$COL ; (THIS WAY BECAUSE OF MACRO BUG)
PUSH CP,X ; GEN THE CODE
; KLUDGE FOR START OF TRACE MODE
MOVEI T4,T4 ; SO THAT 'GENCT1' WILL BE A NO-OP
SUB T4,@CMDBUF ;[343] (IE: WILL NOT GEN CODE)
; CHECK FOR MACRO CALL, OTHERWISE CLEAR ARGUMENT FLAGS
SKIPN MACFLG ;[344] A MACRO COMPILATION?
JRST CDCRET+2 ;[344] NO, CLEAR FLAGS AND START CD
SETZM MACFLG ;[344] CLEAR THE FLAG FOR LATER
JRST CDCRT1 ;[344] AND CONTINUE CD WITH FLAGS
; HERE FOLLOWS THE MAIN LOOP OF THE COMMAND DECODER AND COMPILER
CDCRET: TXZE F,F$COL ; A ":" SEEN SINCE LAST COMMAND?
JRST CDCVL1 ; YES
TXZ F,F$$RG ; CLEAR ARG FLAGS
CDCRT1: HRLI T5,(MOVE ARG,) ; SET INST. TO [MOVE ARG,VALUE]
CDCBOP: TXNN F,F$1RG ; AN ARG SEEN?
PUSH CP,[SETZ ARG,] ; NO, GEN CODE TO CLEAR ARG
CDCIGN: PUSHJ P,GENCT1 ; TRACE MODE WILL DUMP CMDS TO THIS POINT
PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
JRST CDCFN1 ; END OF COMMAND STRING
PUSHJ P,GENCTM ; NEXT TRACE DUMP WILL START HERE
; UPCASE CHAR
PUSHJ P,UPCASE ; UPCASE THE CHAR
; FETCH THE COMMAND DISPATCH ADDRESS
CDCCC: MOVEI T1,(C) ; FETCH COPY OF COMMAND CHAR
CAIE T1,"@"+40 ; A LEGAL CHAR?
CAILE T1,"Z"+40 ; . . . ?
SETZ T1, ; NO, ZERO WILL GIVE ERROR
ROT T1,-1 ; DIVIDE IT BY 2
MOVE T2,DSPTBL(T1) ; FETCH TWO POSSIBLE DISPATCH ADRS
JUMPL T1,.+2 ; RH OF T2 HAS RIGHT DSPADR
HLRZ T2,T2 ; LH OF T2 HAS RIGHT DSPADR
; SEE WHAT KIND OF DISPATCH IT IT
TXZN T2,D$$DSP ; NON-SIMPLE JRST?
JRST (T2) ; NO, DO A SIMPLE JRST DISPATCH
; MUST "EVAL" PRECEDING ARG BEFORE DISPATCHING
TXNN F,F$1RG ; AN ARG TO BE EVAL'D?
JRST [PUSH CP,[SETZ ARG,] ; NO, GEN CODE TO SET ARG:=0
JRST CDCC1] ; AND CONTINUE
PUSH CP,T5 ; NO, GEN CODE FOR THE EVALUATION OF ARG
; NOW WE MUST EITHER 'JRST' OR 'PUSHJ'
CDCC1: TXZ T2,D$EJ ; CLEAR 'JRST' BIT
TXZE T2,D$EC ; MUST WE 'PUSHJ'?
PUSH P,[<CDCRET>] ; YES, THEN STORE RETURN ADR
JRST (T2) ; DISPATCH TO SPECIFIC CMD DECODER
; HERE AFTER A ":" COMMAND HAS BEEN SEEN
CDCVL1: SKIPA X,.+1 ; FETCH CODE TO CLEAR ":" COMMAND FLAG
TXZ F,F$COL ; (THIS WAY BECAUSE OF MACRO BUG)
PUSH CP,X ; GEN INTO CODE
; JRST CDCVAL ; DON'T FORGET: COMMAND RETURNS A VALUE
; HERE WHEN A COMMAND RETURNS A VALUE
CDCVAL: TXO F,F$1RG ; FLAG THAT ARG SEEN
JRST CDCBOP ; AND CONTINUE SCAN
; END OF COMMAND STRING. GENERATE A "POPJ P,"
CDCFIN: PUSHJ P,GENCT1 ; FINISH LAST TRACE DUMP CALL
CDCFN1: TXZ F,F$REE ;[353] CLEAR "REENTER" FLAG
POP P,X ; CLEAR "BEGINNING OF PDL" FLAG
PUSH CP,[POPJ P,] ; GEN CALL TO "RETURN" ROUTINE
JUMPE X,CDCFN2 ; NORMAL, NOW FIXUP TAG REFERENCES
SUBI X,2 ; MANIPULATE PDL FLAGS
JUMPL X,[ERROR (MRP)] ; ** MISSING ")" **
JUMPE X,[ERROR (MRA)] ; ** MISSING RAB **
ERROR (MAP) ; ** MISSING "'" **
; PATCH ALL TAG REFERENCES NOW THAT WE KNOW WHERE ALL TAGS ARE
; MAK AOBJN POINTER TO TAG PDL
CDCFN2: MOVE T5,TAGPDL ; FETCH ADR OF TAG PDL
SUBI T5,(TAG) ; COMPUTE LENGTH OF TAG PDL
MOVSI T5,(T5) ; FORM AOBJN POINTER
HRR T5,TAGPDL ; . . .
; POP TAG REFERENCES ONE AT A TIME AND PATCH THE TAG ADDRESS
CDCFN3: POP REF,N ; POP LAST TAG REF LENGTH
POP REF,M ; POP LAST TAG REF CHAR ADDRESS
JUMPE M,CDCFN8 ; DONE. RELEASE TAG AND REF
HLRZ T1,M ; FETCH CHAR ADDRESS OF TAG REF
SOJ T1, ; 'CAUSE BP WILL BE INCREMENTED FIRST
PUSHJ P,CTOBP ; AND CONVERT TO A BYTE POINTER
ADD T1,@CMDBUF ; MAKE BP ABSOLUTE
MOVE T4,T1 ; AND SAVE BP FOR LATER
; FIND A TAG WITH SAME LENGTH AS TAG REFERENCE
MOVE T3,T5 ; FETCH AOBJN LOOP COUNTER
JUMPG T3,CDCFNE ; IF NO TAGS, ** TAG NOT FOUND **
CDCFN4: MOVE X,1(T3) ; FETCH LENGTH OF NEXT TAG
CAIN X,(N) ; SAME LENGTH AS REFERENCE?
JRST CDCFN6 ; YES, NOW CHECK FOR TAG MATCH
CDCFN5: AOBJN T3,CDCFN4 ; NO, TRY THE NEXT TAG
CDCFNE: ERROR (TAG) ; ** REFERENCE TO UNDEFINED TAG **
; GOT A TAG WITH SAME LENGTH. CHACK IF TEXT MATCHES
CDCFN6: HLRZ T1,(T3) ; FETCH CHAR ADR OF TAG
SOJ T1, ; 'CAUSE BP WILL BE INCREMENTED FIRST
PUSHJ P,CTOBP ; AND CONVERT IT TO A BP
ADD T1,@CMDBUF ; MAKE BP ABSOLUTE
MOVE T2,T4 ; COPY BP FOR REFERENCE
MOVEI 15,(N) ; COPY REFERENCE LENGTH FOR LOOP COUNT
JUMPE 15,CDCFN9 ; IF LEN=0, THEN MATCH SUCCEEDS
CDCFN7: ILDB X,T2 ; FETCH REF CHAR
ILDB C,T1 ; FETCH TAG CHAR
CAIE X,(C) ; STILL MATCH?
JRST CDCFN5 ; NO, TRY NEXT TAG
SOJG 15,CDCFN7 ; YES, LOOP FOR ALL CHARS OF TAG
; FOUND MATCH. PATCH UP THE REFERENCE
CDCFN9: ADD M,@CMDBUF ; COMPUTE ABSOLUTE ADR OF "JRST"
MOVE X,(T3) ; FETCH RELATIVE ADR OF TAG
HRRM X,(M) ; PATCH THE "JRST TAG(R)"
JRST CDCFN3 ; AND PROCESS THE NEXT TAG REFERENCE
; RELEASE TAG,REF, AND CP AS PDLS
CDCFN8: MOVEI N,TAG ; RELEASE TAG
PUSHJ P,DELPDL ; . . .
MOVEI L,TAGPDL ; DELETE THE TAGPDL
PUSHJ P,RELM ; . . .
MOVEI N,REF ; RELEASE REF
PUSHJ P,DELPDL ; . . .
MOVEI L,REFPDL ; RELEASE THE TAG REFERENCE PDL
PUSHJ P,RELM ; . . .
MOVEI N,CP ; RELEASE CP
PJRST DELPDL ; AND RETURN TO CALLER
SUBTTL Command Decoding and Compilation Routines
; CDUAR - "^" - TRANSLATE NEXT CHAR TO A CONTROL CHAR
CDUAR: PUSHJ P,CMDGCH ; FETCH THE NEXT CHAR
ERROR (MEU) ; ** MACRO ENDING WITH ^ **
TRZ C,140 ; TRANSLATE THE CHAR TO CONTROL RANGE
JRST CDCCC ; AND PROCESS THE CONTROL CHAR
; CDALT - ALTMODE
; - SINGLE ALTMODE WILL BE IGNORED
; - TWO ALTMODES GENERATE "JSP PC,$$STOP"
CDALT: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
JRST CDCFIN ; END OF COMMAND STRING
CAIE C,.CHESC ; A SECOND ALTMODE?
JRST [PUSHJ P,CMDBCH ; NO, BACKUP OVER THE CHAR
JRST CDCRET] ; AND CONTINUE CD
PUSH CP,[JSP PC,$$STOP] ; YES, GEN CALL TO "STOP"
JRST CDCRET ; AND CONTINUE CD
; CDCNA - ^A - GEN COMMAND TO TYPE A STRING ENCLOSED IN ^A'S
; IE: ^ATHIS IS A MESSAGE^A
;
; GEN: JSP PC,$$MES
; <CHAR ADDRESS IN BUFFER,,CHAR COUNT>
CDCNA: PUSH CP,[JSP PC,$$MES] ; GEN CALL TO TYPE MESSAGE
PUSHJ P,CURCHA ; FETCH CURRENT CHAR ADDRESS IN BUFFER
MOVSI T2,(T1) ; AND SAVE FOR LATER
MOVEI C,.CHCNA ; SCAN FOR NEXT ^A
PUSHJ P,FNDCH ; . . .
ERROR (UCA) ; ** UNTERMINATED ^A COMMAND **
HRRI T2,(N) ; FETCH CHAR COUNT FOR MESSAGE
PUSH CP,T2 ; STORE <CHAR ADR,,CHAR COUNT> IN CODE
JRST CDCRET ; AND CONTINUE CD
; CDCNC - ^C - COMMAND TO DO A MONRT.
CDCNC: PUSH CP,[EXIT 1,] ; GEN THE MONRT.
JRST CDCRET ; AND CONTINUE CD
; CDCNE - ^E - COMMAND TO RETURN THE VALUE OF THE FORMFEED FLAG
CDCNE: PUSH CP,[JSP PC,$$CNE] ; GEN CODE TO FETCH VALUE OF FF FLAG
JRST CDCVAL ; AND CONTINUE CD
; CDCNF - ^F RETURNS CONTENTS OF CONSOLE SWITCH REGISTER
; N^F RETURNS TTY#+^O200000 OF JOB N
CDCNF: MOVE X,[JSP PC,$$TTY] ;[306] ASSUME WE WANT TTY#
TXNN F,F$1RG ;[306] WANT TTY#?
MOVE X,[SWITCH VALUE,] ;[306] NO, WANT CONSOLE SWITCHES
PUSH CP,X ;[306] GEN CODE FOR WHATEVER
JRST CDCVAL ; AND CONTINUE SCAN
; CDCNG - N,M^G=GETTAB, N^G=PEEK
CDCNG: MOVE X,[JSP PC,$$GTB] ;[302] ASSUME GETTAB
TXZN F,F$2RG ;[332] 2 ARGS FOR GETTAB?
HRRI X,$$PEK ;[302] NO, ONE ARG FOR PEEK
TXNN F,F$1RG ;[336] WANT PJOB?
MOVE X,[PJOB VALUE,] ;[336] YES, NO GETTAB/PEEK
PUSH CP,X ;[302] GEN THE CALL TO WHATEVER
JRST CDCVAL ;[302] AND CONTINUE WITH SCAN
; CDCNH - ^H - COMMAND TO RETURN TIME OF DAY IN JIFFIES
CDCNH: PUSH CP,[TIMER VALUE,] ; GEN CODE TO FETCH TIME OF DAY IN JIFFIES
JRST CDCVAL ; AND CONTINUE CD
; CDCNL - ^L - COMMAND TO TYPE A FORMFEED
CDCNL: PUSH CP,[JSP PC,$$FFD] ; GEN CODE TO TYPE A FORMFEED
JRST CDCRET ; AND CONTINUE CD
; CDCNN - ^N - COMMAND TO RETURN THE VALUE OF THE END-OF-FILE FLAG
CDCNN: PUSH CP,[JSP PC,$$CNN] ; GEN CODE TO RETURN VALUE OF EOF FLAG
JRST CDCVAL ; AND CONTINUE CD
; CDCNP - ^P OR N^P - RETURN CURRENT PAGE # OR POSITION TO SPECIFIED PAGE
CDCNP: TXNE F,F$1RG ; AN ARG PRESENT?
JRST CDCNP1 ; YES, POSITION TO SPECIFIED PAGE
; ^P - RETURN THE # OF THE CURRENT PAGE
CDCNP2: PUSH CP,[MOVE VALUE,PAGCNT] ; GEN CODE TO RETURN PAGE #
JRST CDCVAL ; AND CONTINUE CD
; N^P - POSITION TO SPECIFIED PAGE
CDCNP1: PUSH CP,[JSP PC,$$CNP] ; GEN CODE TO CALL $$CNP
JRST CDCRET ; AND CONTINUE CD
; CDCNT - ^T - COMMAND TO RETURN VALUE OF INPUT CHAR
CDCNT: MOVE X,[INCHRW VALUE] ; FETCH DEFAULT ^T COMMAND
TXNE F,F$COL ; IS THIS A ":" ^T COMMAND?
MOVE X,[JSP PC,$$TTC] ; YES, FETCH GEN. PURPOSE TTCALL ROUTINE
TXZN F,F$2RG ;[410] TWO ARGS?
PUSH CP,[SETZ SARG,] ;[410] NO, INSURE SECOND ARG 0!
PUSH CP,X ; GEN CODE FOR WHATEVER TTCALL
; REMOVED BY [410] AS REDUNDANT
; TXZ F,F$2RG ;[332] DON'T PASS SECOND ARG BEYOND
JRST CDCVAL ; AND CONTINUE CD
; CDCNU - N^U - USETI TO DESIRED BLOCK ON INPUT FILE
CDCNU: PUSHJ P,ARGK ;[333] MAKE SURE IT HAS AN ARG
PUSH CP,[JSP PC,$$CNU] ;[333] GEN CALL TO $$CNU
JRST CDCRET ;[333] AND CONTINUE CD
; CDCNV - N^V OR ^V - DOWNCASE ALL TEXT
CDCNV: PUSHJ P,ARGK ; MAKE SURE IT HAS AN ARG
PUSH CP,[JSP PC,$$LOW] ; GEN CALL TO $$LOW
JRST CDCRET ; AND CONTINUE CD
; CDCNW - N^W OR ^W - UPCASE ALL TEXT
CDCNW: PUSHJ P,ARGK ; MAKE SURE IT HAS AN ARG
PUSH CP,[JSP PC,$$UP] ; GEN CALL TO $$UP
JRST CDCRET ; AND CONTINUE CD
; CDCNY - ^Y OR N^Y - RETURN CURRENT PAGE # OR YANK TO SPECIFIED PAGE
CDCNY: TXNN F,F$1RG ;[327] AN ARG PRESENT?
JRST CDCNP2 ;[327] YES, TREAT AS ^P
; N^Y - YANK TO SPECIFIED PAGE
PUSH CP,[JSP PC,$$CNY] ;[327] GEN CODE TO CALL $$CNY
JRST CDCRET ;[327] AND CONTINUE CD
; CDCNX - N^X OR ^X - SET OR RETURN EXACT SEARCH MODE FLAG
CDCNX: MOVE X,[JSP PC,$$CX] ; FETCH CALL TO $$CX
TXNE F,F$1RG ; IS IT A SET CMD?
HRRI X,$$CXS ; YES, FETCH ADR OF "SET" ROUTINE
PUSH CP,X ; GEN CALL TO WHATEVER
TXNE F,F$1RG ; WAS IT A "SET" CMD?
JRST CDCRET ; YES, CONTINUE CD
JRST CDCVAL ; NO, IT RETURNS A VALUE
; CDCNZ - ^Z - CLOSE OUTPUT FILE AND RETURN TO MONITOR COMMAND LEVEL
CDCNZ: PUSH CP,[JSP PC,$$CNZ] ; GEN CODE TO CALL $$Z
JRST CDCRET ; AND CONTINUE CD
; CDCUA - ^^X - VALUE OF THE ARBITRARY CHAR "X"
CDCUA: PUSHJ P,CMDGCH ; GET NEXT CHAR
ERROR (MUU) ; NONE LEFT. ** MACRO ENDING WITH ^^ **
HRLI C,(MOVEI VALUE,) ; FORM: MOVEI VALUE,"X"
PUSH CP,C ; AND GEN THE INST. INTO CODE
JRST CDCVAL ; AND CONTINUE CD
; CDQUO - " - BEGINNING OF A CONDITIONAL
;
; FORMAT OF A CONDITIONAL IS:
;
; N"X...COMMANDS...'
;
; WHERE N IS A NUMERIC ARGUMENT, X IS A LETTER, AND
; ...COMMANDS... IS ANY SEQUENCE OF COMMANDS (INCLUDING
; MORE CONDITIONALS. THE COMMANDS ARE EXECUTED IF N.X.0 IS TRUE.
;
; X IS:
;
; G EXECUTE COMMANDS IF N.GT.0
; L EXECUTE COMMANDS IF N.LT.0
; N EXECUTE COMMANDS IF N.NE.0
; E EXECUTE COMMANDS IF N.EQ.0
; F EXECUTE COMMANDS IF N.EQ.0 (FALSE OF FAILURE)
; U EXECUTE COMMANDS IF N.EQ.0 (UNSUCCESSFUL)
; T EXECUTE COMMANDS IF N.LT.0 (TRUE)
; S EXECUTE COMMANDS IF N.LT.0 (SUCCESS)
; C EXECUTE COMMANDS IF N IS VALUE OF AN ASCII LETTER,
; DIGIT, ".", "%", OR "$".
; A EXECUTE COMMANDS IF N IS VALUE OF AN ASCII LETTER
; D EXECUTE COMMANDS IF N IS VALUE OF AN ASCII DIGIT
; V EXECUTE COMMANDS IF N IS VALUE OF AN ASCII LOWER CASE LETTER
; W EXECUTE COMMANDS IF N IS VALUE OF AN ASCII UPPER CASE LETTER
CDQUO: TXNN F,F$1RG ; AN ARG PRESENT?
ERROR (NAQ) ; NO, ** NO ARG BEFORE " **
PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR ("X")
ERROR (MEQ) ; NONE LEFT. ** MACRO ENDING WITH " **
PUSHJ P,UPCASE ; UPCASE THE CHAR
MOVE T1,[IOWD CONLTH,CONTBL] ; AOBJN PTR TO "X" TABLE
PUSHJ P,DISPAT ; DISPATCH TO PROPER CONDITIONAL
ERROR (IQC) ; ** ILLEGAL " COMMAND **
DEFINE QC(CMDS)<IRPC CMDS,<<"CMDS",,CDQ'CMDS>>>
CONTBL: QC (GLNEFUTSCADVW)
CONLTH==.-CONTBL
; CDQG - N"G...' - EXECUTE COMMANDS IF N.GT.0
CDQG: PUSH CP,[JUMPLE ARG,0(R)] ; GEN CODE TO SKIP COMMANDS
JRST CDQCJ ; FINISH CONDITIONAL
; CDQT - N"T...' - EXECUTE COMMANDS IF N IS TRUE
CDQT:
; CDQS - N"S...' - EXECUTE COMMANDS IF N IS SUCCESSFUL
CDQS:
; CDQL - N"L...' - EXECUTE COMMANDS IF N.LT.0
CDQL: PUSH CP,[JUMPGE ARG,0(R)] ; GEN CODE TO SKIP COMMANDS
JRST CDQCJ ; FINISH CONDITIONAL
; CDQN - N"N...' - EXECUTE COMMANDS IF N.NE.0
CDQN: PUSH CP,[JUMPE ARG,0(R)] ; GEN CODE TO SKIP COMMANDS
JRST CDQCJ ; FINISH THE CONDITIONAL
; CDQF - N"F...' - EXECUTE COMMANDS IF N IS FALSE
CDQF:
; CDQU - N"U...' - EXECUTE COMMANDS IF N IS UNSUCCESSFUL
CDQU:
; CDQE - N"E...' - EXECUTE COMMANDS IF N.EQ.0
CDQE: PUSH CP,[JUMPN ARG,0(R)] ; GEN CODE TO SKIP COMMANDS
JRST CDQCJ ; FINISH THE CONDITIONAL
; CDQC - N"C...' - EXECUTE COMMANDS IF N IS A SYMBOL CONSTITUENT
CDQC: PUSH CP,[JSP PC,$$CKC] ; GEN CALL TO SEE IF A SYMBOL CONSTITUENT
JRST CDQJA ; FINISH CONDITIONAL
; CDQA - N"A...' - EXECUTE COMMANDS IF N IS A LETTER
CDQA: PUSH CP,[JSP PC,$$CKA] ; GEN CALL TO SEE IF A LETTER
JRST CDQJA ; FINISH CONDITIONAL
; CDQD - N"D...' - EXECUTE COMMANDS IF N IS A DIGIT
CDQD: PUSH CP,[JSP PC,$$CKD] ; GEN CALL TO SEE IF A DIGIT
JRST CDQJA ; FINISH CONDITIONAL
; CDQV - N"V...' - EXECUTE COMMANDS IF N IS A LOWER CASE LETTER
CDQV: PUSH CP,[JSP PC,$$CKV] ; GEN CALL TO SEE IF A LC LETTER
JRST CDQJA ; FINISH CONDITIONAL
; CDQW - N"W...' - EXECUTE COMMANDS IF N IS AN UPPER CASE LETTER
CDQW: PUSH CP,[JSP PC,$$CKW] ; GEN CALL TO SEE IF A UC LETTER
CDQJA: PUSH CP,[JRST 0(R)] ; GEN CODE TO SKIP COMMANDS
CDQCJ: MOVEI X,(R) ; REMEMBER WHERE CONDITIONAL BEGINS
SUB X,@CMDBUF ; . . .
PUSH P,X ; . . .
PUSH P,[<P$CON>] ; FLAG THAT A CONDITIONAL IS ON PDL
JRST CDCRET ; AND CONTINUE CD
; CDAPO - ' - FINISH WAHT " BEGAN (IE: END OF A CONDITIONAL)
CDAPO: POP P,X ; POP THE PDL FLAG
JUMPE X,CDAPO1 ; NOT IN A CONDITIONAL
SOJ X,
SOJL X,CDAPO2 ; ** MISSING ) **
JUMPE X,CDAPO3 ; ** CONFUSED USE OF CONDITIONALA **
POP P,X ; POP THE ADR OF START OF CONDITIONAL
ADD X,@CMDBUF ; MAKE IT AN ABSOLUTE ADR
MOVEI T1,1(CP) ; FETCH ADR OF END OF CONDITIONAL
SUB T1,@CMDBUF ; AND MAKE IT RELATIVE
HRRM T1,(X) ; FINISH THE SKIP OVER COMMANDS
; FOR WHEN CONDITIONAL COMMANDS
; ARE NOT EXECUTED
JRST CDCRET ; AND CONTINUE CD
CDAPO1: ERROR (MSC) ; ** MISSING START OF CONDITIONAL **
CDAPO2: ERROR (MRP) ; ** MISSING ) **
CDAPO3: ERROR (CON) ; ** CONFUSED USE OF CONDITIONALS **
; CDQST - ? - COMMAND TO COMPLEMENT TRACE MODE FLAG
CDQST: SKIPA X,.+1 ; A MACRO BUG FORCES US TO DO THIS
TXC F,F$TRC ; INST. TO COMPLEMENT THE TRACE FLAG
PUSH CP,X ; GEN CODE TO COMPLEMENT TRACE FLAG
JRST CDCRET ; AND CONTINUE CD
; CDCOM - , - DELIMITS FIRST AND SECOND ARGUMENTS
CDCOM: TXZE F,F$1RG ; ARG ALREADY SEEN?
TXOE F,F$2RG ; AND NOT BOTH ARGS?
ERROR (ARG) ; NO. ",ARG" AND "ARG,ARG,ARG" ILLEGAL
PUSH CP,[MOVE SARG,ARG] ; GEN CODE TO SAVE SECOND ARG
JRST CDCRT1 ; AND CONTINUE CD
; CDLPA - ( - PERFORM OPERATIONS INSIDE "()" FIRST
;
; GEN: PUSH P,ARG
; <EVAL INSIDE PARENS>
; MOVE VALUE,ARG
; POP P,ARG
CDLPA: PUSH CP,[PUSH P,ARG] ; GEN CODE TO SAVE ARG
PUSH P,T5 ; SAVE CURRENT OPERATION
PUSH P,[<P$PAR>] ; FLAG THAT A "(" IS ON PDL
JRST CDCRT1 ; AND CONTINUE CD
; CDRPA - ) - FINISH WHAT CDLPA STARTED
CDRPA: POP P,X ; POP PDL FLAG
JUMPE X,CDRPA2 ; ** CONFUSED USE OF () **
SOJG X,CDRPA1 ; ** MISSING LEFT PARENTHESIS **
PUSH CP,[MOVE VALUE,ARG] ; GEN CODE TO SAVE ARG
PUSH CP,[POP P,ARG] ; GEN CODE TO RESTORE OLD ARG
POP P,T5 ; RESTORE PREVIOUS OPERATION
JRST CDCVAL ; AND CONTINUE WITH CD
CDRPA1: ERROR (PAR) ; ** CONFUSED USE OF () **
CDRPA2: ERROR (MLP) ; ** MISSING ( **
; CDEXC - !TAG! - COMMAND TO DEFINE A TAG (IE: LABEL)
CDEXC: TXZ F,F$1RG!F$2RG ;[310] THROW AWAY PREV. CMDS
PUSHJ P,CURCHA ; FETCH CURRENT CHAR ADR IN BUFFER
MOVSI T1,(T1) ; . . .
HRRI T1,1(CP) ; FETCH CURRENT ADR IN CODE
SUB T1,@CMDBUF ; . . .
PUSH TAG,T1 ; STORE INFO ABOUT TAG DEFINITION
MOVEI C,"!" ; SCAN FOR CLOSING "!"
PUSHJ P,FNDCH ; . . .
ERROR (UTG) ; ** UNTERMINATED TAG **
PUSH TAG,N ; STORE LENGTH OF TAG
JRST CDCRET ; AND CONTINUE CD
; CDO - OTAG$ - COMMAND TO BRANCH TO A TAG
CDO: PUSH CP,[JRST 0(R)] ; GEN CODE TO BRANCH TO TAG
; NOTE THAT Y FIELD MUST BE FILLED
; IN WHEN THE TAG ADR IS KNOWN
PUSHJ P,CURCHA ; FETCH CURRENT CHAR ADR IN BUFFER
MOVSI T1,(T1) ; . . .
HRRI T1,(CP) ; FETCH CURRENT ADR ON CODE
SUB T1,@CMDBUF ; . . .
PUSH REF,T1 ; AND STORE INFO ABOUT THE TAG REFERENCE
MOVEI C,.CHESC ; SCAN TILL NEXT <ALT>
PUSHJ P,FNDCH ; . . .
ERROR (MEO) ; ** MACRO ENDING WITH O COMMAND **
PUSH REF,N ; STORE LENGTH OF TAG REFERENCE
JRST CDALT ; AND CONTINUE WITH SCAN
; CDLAB - LAB - AN ITERATION
;
; GEN: PUSH P,ARG
; MOVEI X,%FIN
; PUSH P,X
; %ST: SOSGE -1(P) ; OR "SOSA -2(P)" IF NO ARG
; JSP PC,$$SEM
; ...
; JRST %ST(R)
;%FIN: POP P,X
CDLAB: PUSH CP,[PUSH P,ARG] ; GEN CODE TO STORE REPEAT COUNT
PUSH CP,[MOVEI X,0] ; GEN CODE TO STORE %FIN ADR
PUSH CP,[PUSH P,X] ; . . .
MOVE X,[SOSGE -1(P)] ; FETCH THE CONDITIONAL INST.
TXNN F,F$1RG ; AN ARG PRESENT?
HRLI X,(SOSA 0(P)) ; NO, WILL LOOP FOREVER
PUSH CP,X ; GEN THE CONDITIONAL INST.
PUSH CP,[JSP PC,$$SEM] ; GEN THE "JUMP OUT OF LOOP"
; FOR WHEN REPEAT COUNT RUNS OUT
MOVEI X,-3(CP) ; SAVE THE ADR OF THE "MOVEI"
SUB X,@CMDBUF ; . . .
PUSH P,X ; SO THAT CDRAB CAN PATCH IT
PUSH P,[<P$ITR>] ; SET ITERATION PDL FLAG
JRST CDCRET ; AND CONTINUE CD
; CDRAB - RAB - FINISH WHAT CDLAB STARTED
CDRAB: POP P,X ; POP THE PDL FLAG
JUMPE X,[ERROR (MLA)] ; ** MISSING LAB **
SOJE X,[ERROR (MRP)] ; ** MISSING ) **
SOJG X,[ERROR (MAP)] ; ** MISSING ' **
POP P,X ; POP ADR OF "MOVEI"
MOVEI T1,2(X) ; COMPUTE ADR OF %ST(R)
HRLI T1,(JRST 0(R)) ; MAKE "JRST %ST(R)"
PUSH CP,T1 ; AND GEN IT INTO CODE
PUSH CP,[POP P,X] ; GEN CODE TO CLEAR TEMP REPEAT COUNT
MOVEI T1,(CP) ; COPY CURRENT ADR IN CODE
SUB T1,@CMDBUF ; MAKE IT RELATIVE
ADD X,@CMDBUF ; COMPUTE ABS. ADR. OF "MOVEI"
HRRM T1,(X) ; FINISH "MOVEI X,%FIN"
TXZ F,F$1RG!F$2RG ;[401] CLEAR ARGUMENTS
JRST CDCRT1 ; AND CONTINUE SCAN
; CDADD - + - GEN "ADD ARG,VALUE" FOR AN ADDITION
CDADD: HRLI T5,(ADD ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCBOP ; AND CONTINUE SCAN
; CDSUB - - - GEN "SUB ARG,VALUE" FOR A SUBTRACTION
CDSUB: HRLI T5,(SUB ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCBOP ; AND CONTINUE CD
; CDMUL - * - GEN "IMUL ARG,VALUE" FOR A MULTIPLICATION
CDMUL: HRLI T5,(IMUL ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCBOP ; AND CONTINUE SCAN
; CDDIV - / - GEN "IDIV ARG,VALUE" FOR A DIVISION
CDDIV: HRLI T5,(IDIV ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCBOP ; AND CONTINUE SCAN
; CDAND - & - GEN "AND ARG,VALUE" FOR LOGICAL "AND" OPERATION
CDAND: HRLI T5,(AND ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCBOP ; AND CONTINUE CD
; CDOR - # - GEN "OR ARG,VALUE" FOR LOGICAL "OR" OPERATION
CDOR: HRLI T5,(OR ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCBOP ; AND CONTINUE CD
; CDOCT - ^O - AN OCTAL NUMBER FOLLOWS
CDOCT: SETZ N,
CDOCT1: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
JRST CDDIG5 ; NO MORE
CAIG C,"7" ; AN OCTAL DIGIT?
CAIGE C,"0" ; . . . ?
JRST CDDIG4 ; NO, END OF NUMBER
LSH N,3 ; MAKE ROOM FOR THE OCTAL DIGIT
IORI N,-"0"(C) ; AND "OR" IN THE DIGIT
JRST CDOCT1 ; AND GO BACK FOR ANOTHER DIGIT
; CDDIG - A DIGIT - A DECIMAL INTEGER FOLLOWS
CDDIG: SETZ N, ; START WITH N:=0
JRST CDDIG3 ; AND JUMP INTO THE LOOP
CDDIG2: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
JRST CDDIG5 ; NO MORE
CDDIG3: CAIG C,"9" ; IS CHAR A DIGIT?
CAIGE C,"0" ; . . . ?
JRST CDDIG4 ; NO. END OF NUMBER
IMULI N,^D10 ; YES, MAKE ROOM FOR DIGIT
ADDI N,-"0"(C) ; AND ADD IN THE DIGIT
JRST CDDIG2 ; AND GO BACK FOR ANOTHER DIGIT
CDDIG4: PUSHJ P,CMDBCH ; REPEAT THE CHAR THAT'S NOT A DIGIT
; GEN: SKIPA VALUE,.+1(R)
; <NUMBER>
; OR
; MOVEI VALUE,<NUMBER>
CDDIG5: TLNN N,-1 ; WILL NUMBER FIT IN 18. BITS?
JRST CDDIG7 ; YES, GEN A "MOVEI"
MOVEI T1,2(CP) ; NO, FETCH ABSOLUTE ".+1"
SUB T1,@CMDBUF ; MAKE RELATIVE ".+1"
HRLI T1,(SKIPA VALUE,0(R)); FORM "SKIPA VALUE,.+1(R)"
PUSH CP,T1 ; STORE "SKIPA" IN CODE
CDDIG6: PUSH CP,N ; STORE <NUMBER> IN CODE
JRST CDCVAL ; AND CONTINUE CD
CDDIG7: HRLI N,(MOVEI VALUE,) ; FORM: MOVEI VALUE,<NUMBER>
JRST CDDIG6 ; AND CONTINUE
; CDEQU - TYPE A NUMERIC QUANTITY
;
; N= (OR N==) - TYPE NUMBER IN DECIMAL (OR OCTAL) FOLLOWED BY CRLF
; N,M= (OR :N,M==) - TYPE NUMBER FOLLOWED BY CRLF IF N.LT.0,
; BY NOTHING IF N.EQ.0, OR
; BY CHAR WHOSE CODE IS N IF N.GT.0
CDEQU: TXNN F,F$1RG!F$2RG ;[305] WAS THERE AN ARG?
ERROR (NAE) ; NO. ** NO ARG BEFORE "=" **
TXNN F,F$2RG ;[305] THE TWO ARG FORM??
PUSH CP,[SETO SARG,] ;[305] NO, GEN CODE TO FORCE CRLF AFTER NUMBER
PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
JRST CDEQU1 ; NONE LEFT. ASSUME "="
CAIE C,"=" ; A SECOND "="?
JRST CDEQU1 ; NO, IT'S "="
PUSH CP,[JSP PC,$$OCT] ; GEN CALL TO TYPE IN OCTAL
JRST CDCRET ; AND CONTINUE CD
CDEQU1: PUSHJ P,CMDBCH ; BACKUP OVER THE CHAR THAT'S NOT "="
PUSH CP,[JSP PC,$$DEC] ; GEN CALL TO TYPE IN DECIMAL
JRST CDCRET ; AND CONTINUE CD
; CDSEM - ; OR N; - JUMP OUT OF CURRENT ITERATION
; ; - IF LAST SEARCH FAILED
; N; - IF N.EQ.0
CDSEM: PUSHJ P,CHKITR ; CHECK IF WE'RE IN AN ITERATION
ERROR (SNI) ; NO, ** ; NOT IN ITERATION **
CDSEM2: TXNE F,F$1RG ; AN ARG PRESENT?
JRST CDSEM3 ; YES
PUSH CP,[JSP PC,$$SEMF] ; NO, EQN CODE IF POP OUT OF
; CUR. ITERATION IF LAST SEARCH FAILED
JRST CDCRET ; CONTINUE CD
CDSEM3: PUSH CP,[JSP PC,$$SEMZ] ; GEN CODE TO JUMP OUT OF
; CUR. ITERATION IF ARG.GE.0
JRST CDCRET ; CONTINUE CD
; CDCOL - : - NEXT COMMAND WILL RETURN 0 IF IT FAILS, -1 IF IT SUCCEEDS
CDCOL: SKIPA X,.+1 ; FETCH CODE TO SET ":" COMMAND FLAG
TXO F,F$COL ; (THIS WAY BECAUSE OF MACRO BUG)
PUSH CP,X ; GEN INTO CODE
TXOA F,F$COL ;[310] FLAG THAT ":" SEEN AND FALL
;[310] INTO THE COMMON CODE
; CDATS - @ - NEXT TEXT STRING IS IN DELIMITED TEXT MODE
; (EG: @I/TEXT/$ , @FS/STRING/NEWSTR/$)
CDATS: TXO F,F$DTM ; FLAG THAT WE ARE IN DELIMITED TEXT MODE
TXZ F,F$1RG!F$2RG ;[310] THROW AWAY PREV. ARGS
JRST CDCRT1 ; AND CONTINUE CD
; CDA - A OR NA - APPEND TO BUFFER OR RETURN VALUE OF CHAR
; TO RIGHT OF TEXT POINTER
CDA: TXNE F,F$1RG ; APPEND?
JRST CDNA ; NO, RETURN VALUE OF NEXT CHAR IN BUFFER
; A - APPEND TO TEXT BUFFER
PUSH CP,[JSP PC,$$A] ; GEN CALL TO $$A
JRST CDCRET ; AND CONTINUE CD
; NA - RETURN THE VALUE OF THE CHAR TO THE RIGHT OF THE TEXT POINTER
CDNA: PUSH CP,[JSP PC,$$NA] ; GEN CALL TO $$NA
JRST CDCVAL ; AND CONTINUE CD
; CDB - B - RETURN VALUE OF BEGINNING OF BUFFER; 0
CDB: PUSH CP,[SETZ VALUE,] ; GEN CODE TO RETURN 0
JRST CDCVAL ; AND CONTINUE CD
; CDPT - . - RETURN VALUE OF THE BUFFER POINTER
CDPT: PUSH CP,[MOVE VALUE,PTVAL] ; GEN CODE TO FETCH VALUE OF "."
JRST CDCVAL ; AND CONTINUE CD
; CDH - H - AN ABBREVIATION FOR "B,Z"
CDH: TXOE F,F$2RG ; "ARG,H"?
ERROR (ARG) ; YES. ** ILLEGAL ARG CONSTRUCTION **
PUSH CP,[SETZ SARG,] ; GEN CODE TO RETURN "B" IN SARG
; CDZ - Z - RETURN VALUE OF THE END OF TH BUFFER
CDZ: PUSH CP,[MOVE VALUE,@TXTBUF] ; GEN CODE TO RETURN VALUE OF Z
JRST CDCVAL ; AND CONTINUE CD
; CDTAB - <TAB>TEXT$ - INSERT A TAB CHAR AND TEXT INTO MAIN TEXT BUFFER
CDTAB: PUSH CP,[JSP PC,$$TAB] ; GEN CALL TO $$TAB
JRST CDIN1 ; AND SCAN INSERT TEXT
; CDI - NI$ OR ITEXT$ - INSERT CHARACTER OR TEXT INTO MAIN TEXT BUFFER
CDI: TXNE F,F$1RG ; IS AN ARG PRESENT?
JRST CDNI ; YES, IT'S "NI$"
; ITEXT$ OR @I/TEXT/$ - INSERT TEXT INTO BUFFER AT CURRENT POSITION
PUSH CP,[JSP PC,$$I] ; GEN CODE TO CALL $$I
CDIN1: PUSHJ P,CDCINS ; SCAN THE INSERTION ARGUMENT
JRST CDALT ; AND CONTINUE CD
; CNDI - NI$ - INSERT THE CHAR WHOSE ASCII CODE IS N
CDNI: PUSHJ P,CMDGCH ; YES, MAKE SURE FOLLOWING CHAR IS <ALT>
ERROR (NAI) ; NO. ** NO ALTMODE AFTER I **
CAIE C,.CHESC ; IS IT <ALT>?
ERROR (NAI) ; NO. SAME ERROR
PUSH CP,[JSP PC,$$NI] ; GEN CALL TO $$NI
JRST CDALT ; AND CONTINUE CD
; CDD - D OR ND - DELETE AN ARBITRARY # CHARACTERS FROM TEXT BUFFER
CDD: PUSHJ P,ARGK ; KLUGE ARG IF NECESSARY
PUSH CP,[JSP PC,$$D] ; GEN CALL TO $$D
JRST CDCRET ; AND CONTINUE CD
; CDC0 - C OR -C OR NC - MOVE THE BUFFER POINTER OVER N CHARS
CDC0: PUSHJ P,ARGK ; KLUDGE THE ARG IF THERE WASN'T ANY
PUSH CP,[JSP PC,$$C] ; GEN CODE TO CALL $$C
JRST CDCRET ; AND CONTINUE CD
; CDR - R OR -R OR NR - MOVE THE BUFFER POINTER BACKWARDS N CHARS
CDR: PUSHJ P,ARGK ; KLUDGE THE ARG IF THERE WASN'T ANY
PUSH CP,[JSP PC,$$R] ; GEN CODE TO CALL $$R
JRST CDCRET ; AND CONTINUE CD
; CDJ - J OR NJ - POSITION THE BUFFER POINTER TO A SPECIFIC POSITION
CDJ: PUSH CP,[JSP PC,$$J] ; GEN CODE TO CALL $$J
JRST CDCRET ; AND CONTINUE CD
; CDP - P OR NP OR N,MP OR PW OR NPW - PUNCH ALL OR PART OF CURRENT PAGE
; - P - PUNCH ALL OF CURRENT PAGE
; - NP - PUNCH CURRENT PAGE AND NEXT N-1 PAGES
; - N,MP - PUNCH CHARS N+1 THRU M AND LEAVE BUFFER INTACT
; - PW - PUNCH CURRENT PAGE AND APPEND FF CHAR AND LEAVE BUFFER INTACT
; - NPW - PERFORM "PW" N TIMES
CDP: TXNE F,F$2RG ; IS IT "N,MP"?
JRST CDP2 ; YES
PUSHJ P,ARGK ; NO, KLUDGE ARG IF NOT PRESENT
PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
SKP ;[303] NONE, MEANS NOT PW
CAIE C,"W" ; IS COMMAND "PW"?
JRST CDP1 ; NO
PUSH CP,[JSP PC,$$PW] ; YES. GEN CALL TO $$PW
JRST CDCRET ; AND CONTINUE CD
CDP1: PUSHJ P,CMDBCH ; NOT "W", BACK UP OVER THE CHAR
PUSH CP,[JSP PC,$$P] ; AND GEN CALL TO $$P FOR "P" OR "NP"
JRST CDCRET ; AND CONTINUE CD
CDP2: PUSH CP,[JSP PC,$$BP] ; GEN CALL TO $$BP FOR "N,MP"
JRST CDCRET ; AND CONTINUE CD
; CDY - Y OR NY - RENDER THE BUFFER EMPTY AND APPEND A BUFFER
CDY: SKIPN MACLVL ; IN A MACRO?
ERROR (UEY) ; NO, "Y" ILLEGAL EXCEPT IN MACROS
JRST CDEY ; YES, TREAT SAME AS "EY"
; CDF - FXXX - THE "F" COMMANDS
CDF: PUSHJ P,CMDGCH ; FETCH THE NEXT COMMAND CHARACTER
ERROR (MEF) ; NONE LEFT. ** MACRO ENDING WITH F **
PUSHJ P,UPCASE ; UPCASE THE CHAR
MOVE T1,[IOWD FLTH,FTBL+1] ; FETCH PTR TO DISPATCH TABLE
PUSHJ P,DISPAT ; AND DISPATCH ON THE CHAR
ERROR (IFC) ; ** ILLEGAL F COMMAND **
; DISPATCH TABLE FOR THE "F" COMMANDS
FTBL: <"S",,CDFS>
<"N",,CDFN>
<"D",,CDFD>
FLTH==.-FTBL
; CDFN - FNSTR1$STR2$ - FIND "STR1" (USING N-SEARCH) AND SUBSTITUTE "STR2"
CDFN: SKIPA T2,[JSP PC,$$N] ; FETCH CALL FOR N-SEARCH
; CDFS - FSSTR1$STR2$ - FIND "STR1" (USING S-SEARCH) AND SUBSTITUTE "STR2"
;
; GEN: JSP PC,$$S
; <CHAR.ADR,,TEXT.LENGTH>
; JSP PC,$$FS
; <CHAR.ADR,,CHAR.LENGTH>
CDFS: MOVE T2,[JSP PC,$$S] ; FETCH CALL FOR S-SEARCH
PUSHJ P,ARGK ; KLUDGE ARG IF NOT PRESENT
TXNE F,F$2RG ; IS IT A BOUNDED SEARCH?
HRRI T2,$$BS ; YES (SAME FOR FS,FN)
PUSHJ P,CHKITR ; IN AN ITERATION?
JRST CDFS1 ; NO, CONTINUE NORMALLY
SKIPA X,.+1 ; YES, WE MUST RETURN A VALUE
TXO F,F$COL ; (THIS WAY BECAUSE OF A MACRO BUG)
TXON F,F$COL ; ALREADY RETURNING A VALUE?
PUSH CP,X ; NO, GEN CODE TO SET FLAG
CDFS1: PUSH CP,T2 ; GEN THE SEARCH CALL
PUSH P,T4 ; SAVE AC T4
PUSHJ P,SSTPSC ; PRESCAN THE SEARCH ARG
PUSHJ P,SSTGSM ; GEN THE SEARCH MATRIX FOR SYNTAX CHECK
POP P,T4 ; RESTORE AC T4
PUSH CP,[JSP PC,$$FS] ; GEN THE CALL TO THE SUBSTITUTE ROUTINE
PUSHJ P,CDCINS ; SCAN THE INSERTION
JRST CDS2 ; GEN CODE FOR SEARCH AUTOTYPE
; CDFD - FDSTR$ - FIND "STR" (USING S-SEARCH) AND DESTROY ALL UP TO
; AND INCLUDING "STR"
;
; GEN: PUSH P,PTVAL
; JSP PC,$$S
; <CHAR.ADR,,TEXT.LENGTH>
; POP P,ARG
; SUB ARG,PTVAL
; JSP PC,$$D
CDFD: PUSH CP,[PUSH P,PTVAL] ;[377] GEN CODE TO SAVE VALUE OF "."
MOVE T2,[JSP PC,$$S] ;[377] FETCH CALL FOR S-SEARCH
PUSHJ P,ARGK ;[377] KLUDGE ARG IF NOT PRESENT
TXNE F,F$2RG ;[377] BOUNDED SEARCH?
HRRI T2,$$BS ;[377] YES
PUSHJ P,CHKITR ;[377] IN AN ITERATION?
JRST CDFD1 ;[377] NO, NORMAL FD
SKIPA X,.+1 ;[377] YES, MUST RETURN A VALUE
TXO F,F$COL ;[377] (BECAUSE OF A MACRO BUG)
TXON F,F$COL ;[377] ALREADY RETURNING A VALUE?
PUSH CP,X ;[377] GEN CODE TO SET FLAG
CDFD1: PUSH CP,T2 ;[377] GEN THE SEARCH CALL
PUSH P,T4 ;[377] SAVE AC T4
PUSHJ P,SSTPSC ;[377] PRESCAN SEARCH ARG
PUSHJ P,SSTGSM ;[377] GEN THE SEARCH MATRIX FOR SYNTAX CHECK
POP P,T4 ;[377] RESTORE AC T4
PUSH CP,[POP P,ARG] ;[377] GEN CODE TO GET OLD VALUE OF "."
PUSH CP,[SUB ARG,PTVAL] ;[377] GEN CODE TO COMPUTE DESTORY #
PUSH CP,[JSP PC,$$D] ;[377] GEN CODE TO DESTROY
JRST CDS2 ;[377] GEN CODE FOR SEARCH AUTOTYPE
; CDK - K OR NK OR N,MK - REMOVE LINES FROM TEXT BUFFER
CDK: PUSHJ P,ARGK ; KLUDGE ARG IF NONE PRESENT
MOVE X,[JSP PC,$$K] ; FETCH CALL TO $$K FOR N,MK
TXNN F,F$2RG ; IS IT "N,MK"?
HRRI X,$$KL ; NO, IT'S "NK"
PUSH CP,X ; GEN THE CALL TO $$K OR $$KL
JRST CDCRET ; AND CONTINUE CD
; CDL - L OR NL - MOVE TO ANOTHER LINE RELATIVE TO "."
CDL: PUSHJ P,ARGK ; IN CASE NO ARG PRESENT
TXNE F,F$2RG ; TWO ARGS PRESENT?
ERROR (TAL) ; YES. ** TWO ARGUMENTS FOR L **
PUSH CP,[JSP PC,$$L] ; GEN CALL TO $$L
JRST CDCRET ; AND CONTINUE CD
; CDS - STEXT$ - SEARCH THE TEXT BUFFER FOR AN OCCURRANCE OF "TEXT"
; NSTEXT$ - NTH OCCURRANCE
; N,MSTEXT$ - WITHIN BOUNDS
; -STEXT$ - BACKWARDS SEARCH
; -NSTEXT$ - NTH OCCURRANCE (SEARCHING BACKWARDS)
; M,NSTEXT$ - WITHIN BOUNDS N,M (SEARCHING BACKWARDS, M.GT.N)
CDS: PUSHJ P,ARGK ; IN CASE THERE IS NO ARG PRESENT
MOVE T2,[JSP PC,$$S] ; FETCH CODE TO CALL $$S
CDS0: TXNE F,F$2RG ; TWO ARGUMENTS PRESENT?
HRRI T2,$$BS ; YES, THEN IT'S A BOUNDED SEARCH
PUSHJ P,CHKITR ; IN AN ITERATION?
JRST CDS1 ; NO
; SEARCHES INSIDE ITERATIONS ARE THE SAME AS ":" SEARCHES
SKIPA X,.+1 ; FETCH INST. TO SET ":" FLAG
TXO F,F$COL ; (THIS WAY BECAUSE OF A MACRO BUG)
TXON F,F$COL ; ALREADY A ":" SEARCH ?
PUSH CP,X ; NO, GEN THE INST. TO SET ":" FLAG
CDS1: PUSH CP,T2 ; GEN THE CALL TO $$S OR $$BS
PUSH P,T4 ; SAVE AC L
PUSHJ P,SSTPSC ; PRESCAN THE SEARCH STRING
PUSHJ P,SSTGSM ; GENERATE DUMMY SEARCH MATRIX
; TO CHECK SYNTAX
POP P,T4 ; RESTORE AC L
CDS2: TXNE F,F$COL ; IS IT A ":" SEARCH?
JRST CDALT ; YES, DON'T AUTOTYPE AFTER SEARCH
PUSHJ P,CHKITR ; IN AN ITERATION?
SKP ; NO, GEN CALL TO $$0TT
JRST CDALT ; YES, DON'T GEN CALL TO $$0TT
PUSH CP,[JSP PC,$$0TT] ; GEN CALL TO SEARCH AUTOTYPE ROUTINE
JRST CDALT ; CONTINUE CD
; CDN - SAME AS THE S COMMAND EXCEPT SEARCH THRU WHOLE FILE
CDN: PUSHJ P,ARGK ; IN CASE NO ARG IS PRESENT
MOVE T2,[JSP PC,$$N] ; FETCH CALL TO $$N
JRST CDS0 ; AND SCAN REST OF "N" COMMAND
; CDBAR - SAME AS "N" SEARCH EXCEPT THAT NOTHING IS OUTPUT
CDBAR: PUSHJ P,ARGK ; IN CASE NO ARG IS PRESENT
MOVE T2,[JSP PC,$$BAR] ; FETCH CALL TO $$BAR
JRST CDS0 ; SCAN SEARCH ARG AND CONTINUE CD
; CDT - T OR NT OR N,MT - TYPE TEXT FROM BUFFER
CDT: PUSHJ P,ARGK ; IN CASE NO ARGS
MOVE X,[JSP PC,$$T] ; FETCH CALL TO $$T
TXNN F,F$2RG ; IS IT "N,MT"?
HRRI X,$$TL ; NO, IT'S "NT"
PUSH CP,X ; GEN THE CALL TO $$T OR $$TL
JRST CDCRET ; AND CONTINUE CD
; CDU - NUQ - STORE NUMERIC ARG IN Q-REGISTER
CDU: TXNN F,F$1RG ; AN ARG PRESENT?
ERROR (NAU) ; NO. ** NO ARG BEFORE U **
PUSH CP,[JSP PC,$$U] ; GEN CODE TO CALL ROUTINE
; WHICH STORES Q-REGISTER CONTENTS
PUSHJ P,MAKQNM ; GEN THE Q-REGISTER NAME INTO CODE
JRST CDCRET ; AND CONTINUE CD
; CDQ - QQ - RETURN VALUE OF A NUMERIC Q-REGISTER
CDQ: PUSH CP,[JSP PC,$$Q] ; GEN CALL TO RETURN CONTENTS OF Q-REGISTER
PUSHJ P,MAKQNM ; GEN THE Q-REGISTER NAME INTO CODE
JRST CDCVAL ; AND CONTINUE CD
; CDX - NXQ OR N,MXQ OR XQ - STORE TEXT FROM BUFFER INTO Q-REGISTER
CDX: PUSHJ P,ARGK ; KLUDGE THE ARG IF NOT PRESENT
MOVE X,[JSP PC,$$X] ; FETCH THE CALL TO $$X
TXNN F,F$2RG ; IS ARG A # OF LINES?
HRRI X,$$XL ; YES, FETCH CALL TO $$XL
PUSH CP,X ; GEN THE CALL TO $$X OR $$XL
PUSHJ P,MAKQNM ; GEN THE Q-REGISTER NAME
JRST CDCRET ; AND CONTINUE CD
; CDG - GQ - GET THE TEXT CONTAINED IN A Q-REGISTER AND INSERT INTO BUFFER
CDG: PUSH CP,[JSP PC,$$G] ; GEN CALL TO $$G
PUSHJ P,MAKQNM ; GEN THE Q-REGISTER NAME
JRST CDCRET ; AND CONTINUE CD
; CDCPCT - %Q - INCREMENT Q AND RETURN RESULTING VALUE
CDPCT: PUSH CP,[JSP PC,$$INC] ; GEN CALL TO $$INC
PUSHJ P,MAKQNM ; GEN Q-REGISTER NAME INTO CODE
JRST CDCVAL ; AND CONTINUE CD
; CDM - MQ - COMPILE AND EXECUTE THE TEXT IN Q-REGISTER Q
CDM: HLR X,F ;[344] COPY FLAGS
ANDI X,(F$$RG) ;[344] AND TO GET ONLY ARG FLAGS
;[344] I REALIZE THIS MEANS ARG FLAGS
;[344] CAN ONLY BE IN LEFT HALF, BUT
;[344] THEY ARE HERE, AND WE CAN'T TXO
;[344] AT RUN TIME!!!
JUMPE X,.+2 ;[344] SKIP NEXT INSTRUCTION IF NO ARGS
PUSH CP,[SETOM MACFLG] ;[344] SET THE MACRO FLAG AT EXECUTION
HRLI X,(TLO F,) ;[344] FINISH MAKING INSTRUCTION
PUSH CP,X ;[344] SAVE THE ARG FLAG SETTING THING
PUSH CP,[JSP PC,$$M] ; GEN CALL TO $$M
PUSHJ P,MAKQNM ; GEN THE Q-REGISTER NAME INTO CODE
JRST CDCVAL ; AND CONTINUE CD
; CDE - EX... - "E" FILE CONTROL AND FLAG COMMANDS
CDE: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
ERROR (MEE) ; NONE LEFT. ** MACRO ENDING WITH E **
PUSHJ P,UPCASE ; UPCASE THE CHAR
MOVE T1,[IOWD ECLTH,ECTBL+1] ; AOBJN PTR TO "E" CMD DISPATCH TABLE
PUSHJ P,DISPAT ; DISPATCH TO SPECIFIC "E" COMMAND
ERROR (IEC) ; ** ILLEGAL E COMMAND **
; DISPATCH TABLE FOR "E" COMMANDS
DEFINE EC(CMDS)<IRPC CMDS,<<"CMDS",,CDE'CMDS>>>
ECTBL:
EC (ABCDEFGHILMNOPRSTUWXYZ)
ECLTH==.-ECTBL
; CDEY - EY - NEW FORM OF THE "YANK" COMMAND
CDEY: PUSHJ P,ARGK ; ASSUME ARG OF "1" IF NONE GIVEN
PUSH CP,[JSP PC,$$Y] ; GEN CALL TO $$Y
JRST CDCRET ; AND CONTINUE CD
; CDEC - EC AND NEC - RETURN AND SET LOWSEGMENT SIZE
;
; GEN: JSP PC,$$EC ; (OR $$ECS TO SET LOWSEG SIZE)
; <RETURN>
CDEC: MOVE X,[JSP PC,$$EC] ; FETCH CALL TO $$EC
TXNE F,F$1RG ; IS IT "NEC"?
HRRI X,$$ECS ; YES, GEN CALL TO $$ECS
PUSH CP,X ; GEN THE CALL TO WHATEVER
TXNE F,F$1RG ; RETURN A VALUE?
JRST CDCRET ; NO, CONTINUE CD
JRST CDCVAL ; YES, CONTINUE CD
; CDEB - EBFILESPEC$ - SETUP FOR EDITTING A FILE
;
; GEN: JSP PC,$$EB
; <FILE.SPEC>
; (RETURN)
CDEB: PUSH CP,[JSP PC,$$EB] ; GEN CALL TO $$EB
CDEXX: PUSHJ P,CDFSPC ; GEN THE FILE SPEC
JRST CDALT ; AND CONTINUE CD
; CDER - ERFILESPEC$ - SETUP FOR READING A FILE
;
; GEN: JSP PC,$$ER
; <FILE.SPEC>
; (RETURN)
CDER: PUSH CP,[JSP PC,$$ER] ; GEN CALL TO $$ER
JRST CDEXX ; GEN FILE SPEC AND CONTINUE CD
; CDEW - EWFILESPEC$ - SETUP FOR WRITING TO A FILE
;
; GEN: JSP PC,$$EW
; <FILE.SPEC>
; (RETURN)
CDEW: PUSH CP,[JSP PC,$$EW] ; GEN CALL TO $$EW
JRST CDEXX ; GEN FILE SPEC AND CONTINUE CD
; CDEZ - EZFILESPEC$ - ZERO DIRECTORY AND SETUP FOR WRITING TO A FILE
;
; GEN: JSP PC,$$EZ
; <FILE.SPEC>
; (RETURN)
CDEZ: PUSH CP,[JSP PC,$$EZ] ; GEN CALL TO $$EZ
JRST CDEXX ; GEN FILE SPEC AND CONTINUE CD
; CDEF - EF - CLOSE OUTPUT FILE
;
; GEN: JSP PC,$$EF
; (RETURN)
CDEF: PUSH CP,[JSP PC,$$EF] ; GEN CALL TO $$EF
JRST CDCRET ; AND CONTINUE CD
; CDEX - EX - PUNCH REST OF INPUT FILE AND EXIT
;
; GEN: JSP PC,$$EX
; (RETURN) ; IF USER TYPES "CONTINUE" AFTER EXIT
CDEX: PUSH CP,[JSP PC,$$EX] ; GEN CALL TO $$EX
JRST CDCRET ; AND CONTINUE CD
; CDEG - EG - PUNCH REST OF INPUT FILE AND EXIT AND PERFORM LAST
; COMPILE-CLASS COMMAND
CDEG: PUSH CP,[JSP PC,$$EG] ; GEN CALL TO $$EG
JRST CDCRET ; AND CONTINUE CD
; CDEM - NEM - PERFORM MAGTAPE OP N
;
; GEN: JSP PC,$$EM
; (RETURN)
CDEM: PUSH CP,[JSP PC,$$EM] ; GEN CALL TO $$EM
JRST CDCRET ; AND CONTINUE CD
; CDED - EDFILE-SPEC$ - SETUP FILE TO BE RUN ON EXIT
CDED: PUSH CP,[JSP PC,$$ED] ; GEN CALL TO $$ED
JRST CDEXX ; SCAN FILE SPEC AND CONTINUE CD
; CDEI - EIFILE-SPEC$ - EDIT INDIRECT (EXECUTE AN INDIRECT COMMAND FILE)
CDEI: HLR X,F ;[345] COPY FLAGS
ANDI X,(F$$RG) ;[345] ISOLATE ARGUMENT FLAGS
JUMPE X,.+2 ;[345] SKIP NEXT IF NO ARG
PUSH CP,[SETOM MACFLG] ;[345] SET THE MACRO ARGUMENT FLAG
HRLI X,(TLO F,) ;[345] FINISH RESETTING FLAGS INST.
PUSH CP,X ;[345] SAVE FOR RUN TIME
PUSH CP,[JSP PC,$$EI] ; GEN CALL TO $$EI
JRST CDEXX ; SCAN FILE-SPEC AND CONTINUE CD
; CDEP - EPFILE-SPEC$ - READ A FILE INTO Q-REGISTER "*"
CDEP: PUSH CP,[JSP PC,$$EP] ; GEN CALL TO $$EP
JRST CDEXX ; SCAN FILE-SPEC AND CONTINUE CD
; CDEE - EEFILE-SPEC$ - SAVE STATE IN A FILE (A RUNNABLE FILE)
CDEE: PUSH CP,[JSP PC,$$EE] ; GEN CALL TO $$EE
JRST CDEXX ; SCAN FILE-SPEC AND CONTINUE CD
; CDEA - EAFILE-SPEC$ - SAME AS "EW" BUT APPEND TO EXISTING FILE
CDEA: PUSH CP,[JSP PC,$$EA] ; GEN CALL TO $$EA
JRST CDEXX ; SCAN FILE SPEC AND CONTINUE CD
; CDEN - ENFILE-SPEC$ - RENAME CURRENT INPUT FILE
CDEN: PUSH CP,[JSP PC,$$EN] ; GEN CALL TO $$EN
JRST CDEXX ; SCAN FILE-SPEC AND CONTINUE CD
; CDET - ET OR NET - RETURN OR SET SUBSTITUTION TYPEOUT FLAG
CDET: TXNE F,F$1RG ; IS AN ARG PRESENT?
JRST CDET1 ; YES
PUSH CP,[MOVE VALUE,ETVAL] ; NO, GEN CODE TO RETURN ET FLAG
JRST CDCVAL ; AND CONTINUE SCAN
CDET1: PUSH CP,[MOVEM ARG,ETVAL] ; GEN CODE TO SET ET FLAG
JRST CDCRET ; AND CONTINUE CD
; CDEO - EO OR NEO - RETURN OR SET EDIT OLD FLAG
CDEO: TXNE F,F$1RG ; IS AN ARG PRESENT?
JRST CDEO1 ; YES
PUSH CP,[MOVE VALUE,EOVAL] ; NO, GEN CODE TO RETURN EO FLAG
JRST CDCVAL ; AND CONTINUE CD
CDEO1: PUSH CP,[CAIL ARG,] ;[406] GEN CODE TO CHECK FOR .LT.0
PUSH CP,[CAILE ARG,C$EOVL] ;[406] GEN CODE TO CHECK FOR .LE.MAXIMUM
PUSH CP,[CERROR (EOA)] ;[406] "EO" ARGUMENT ERROR
PUSH CP,[MOVEM ARG,EOVAL] ; GEN CODE TO SET EO FLAG
JRST CDCRET ; AND CONTINUE CD
; CDEU - EU OR NEU - SET OR RETURN CASE FLAGING FLAG
CDEU: TXNE F,F$1RG ; IS AN ARG PRESENT?
JRST CDEU1 ; YES
PUSH CP,[MOVE VALUE,EUVAL] ; NO, GEN CODE TO RETURN EU FLAG
JRST CDCVAL ; AND CONTINUE CD
CDEU1: PUSH CP,[MOVEM ARG,EUVAL] ; GEN CODE TO SET EU FLAG
JRST CDCRET ; AND CONTINUE CD
; CDEH - EH OR NEH - RETURN OR SET ERROR MESSAGE LENGTH FLAG
CDEH: MOVE X,[JSP PC,$$EHS] ;[325] FETCH CALL TO EH SET ROUTINE
TXNN F,F$1RG ; "SET" COMMAND?
HRRI X,$$EH ; NO, FETCH ADR OF "RETURN" ROUTINE
PUSH CP,X ; AND GEN THE CALL TO WHATEVER
TXNE F,F$1RG ; "SET"?
JRST CDCRET ; YES, CONTINUE CD
JRST CDCVAL ; NO, CONTINUE CD
; CDES - ES OR NES - RETURN OR SET THE AUTOTYPEOUT AFTER SEARCH FLAG
CDES: TXNE F,F$1RG ; IS AN ARG PRESENT?
JRST CDES1 ; YES
PUSH CP,[MOVE VALUE,ESVAL] ; NO, GEN CODE TO RETURN ES FLAG
JRST CDCVAL ; AND CONTINUE CD
CDES1: PUSH CP,[MOVEM ARG,ESVAL] ; GEN CODE TO SET ES FLAG
JRST CDCRET ; AND CONTINUE CD
; CDEL - ELFILESPEC$ - SETUP FOR WRITING OR MODIFYING LOG FILE
;
; GEN: JSP PC,$$EL
; <FILE.SPEC>
; (RETURN)
CDEL: TXNE F,F$1RG ;[330] ARG PRESENT?
JRST CDEL1 ;[330] YES, TO MODIFY
PUSH CP,[JSP PC,$$EL] ;[330] GEN CALL TO $$EL
JRST CDEXX ;[330] GEN FILE SPEC AND CONTINUE CD
CDEL1: PUSH CP,[JSP PC,$$ELA] ;[330] GEN CALL TO $$ELA
JRST CDCRET ;[330] AND CONTINUE CD
; CDBKSL - \ OR N\ - RETURN VALUE OF NUMBER AFTER POINTER IN
; TEXT BUFFER OR INSERT ASCII REPRESENTATION OF N
CDBKSL: MOVE X,[JSP PC,$$BS1] ; FETCH THE CALL TO $$BS1
TXNN F,F$1RG ; IS IT "N\"?
HRRI X,$$BS2 ; NO, ITS "\"
PUSH CP,X ; GEN THE CALL TO $$BS1 OR $$BS2
TXNE F,F$1RG ; RETURN A VALUE?
JRST CDCRET ; NO. CONTINUE CD
JRST CDCVAL ; YES, CONTINUE CD
; CDLSB - [I - PUSH A Q-REGISTER ON THE Q-REGISTER PDL
CDLSB: PUSH CP,[JSP PC,$$PUSH] ; GEN CODE TO CALL $$PUSH
CDLSB1: PUSHJ P,MAKQNM ; GEN THE Q-REGISTER NAME INTO CODE
JRST CDCRET ; AND CONTINUE CD
; CDRSB - ]I - POP THE Q-REGISTER PDL INTO A Q-REGISTER
CDRSB: PUSH CP,[JSP PC,$$POP] ; GEN CODE TO CALL $$POP
JRST CDLSB1 ; FINISH CODE AND CONTINUE CD
SUBTTL Command Decoding and Compilation Subroutines
; GENCTM - GENERATE CALL TO "CHECK FOR TRACE MODE" ROUTINE
; IF IN TRACE MODE, THIS WILL CAUSE TEXT OF COMMAND TO BE TYPED.
;
; CALL: PUSHJ P,GENCTM
; (RETURN)
;
; GEN: JSP PC,$$CTM
; <CHAR POSITION IN BUFFER,,CHAR COUNT>
;
; NOTE: THE CHAR COUNT IS STORED AS ZERO AND THEN FILLED IN
; BY A CALL TO 'GENCT1' AFTER THE COMMAND HAS BEEN SCANNED.
; THE RELATIVE ADR OF THE ZERO WILL BE STORED IN AC CT.
;
; USES ACS X,T1,T4
GENCTM: PUSH CP,[JSP PC,$$CTM] ; GEN THE CALL TO "CHECK FOR TRACE MODE"
PUSHJ P,CURCHA ; FETCH CURRENT CHAR ADR IN BUFFER
MOVSI X,-1(T1) ; . . .
PUSH CP,X ; AND GEN INTO CODE
; NOTE THAT CHAR COUNT WILL BE FILLED
; IN BY 'GENCT1'
MOVEI T4,(CP) ; FETCH CURRENT POSITION IN CODE
SUB T4,@CMDBUF ; MAKE IT A RELATIVE ADR
HRL T4,CMDCNT ; ALSO STORE THE CURRENT CHAR COUNT
POPJ P, ; AND RETURN TO CALLER
; GENCT1 - STORE THE CHAR COUNT IN THE LAST CALL TO "CHECK TRACE MODE"
;
; CALL: PUSHJ P,GENCT1
; (RETURN)
;
; USES ACS X,T1,T4
GENCT1: ADD T4,@CMDBUF ; MAKE IT ABSOLUTE POINTER TO DUMMY BP
HLRZ X,T4 ; FETCH THE OLD CHAR COUNT
SUB X,CMDCNT ; SUBTRAT4 THE CURRENT CHAR COUNT
AOJ X, ; MAKE IT THE ACTUAL CHAR COUNT (NOT -1)
HRRM X,(T4) ; AND STORE THE LENGTH OF TRACE
; MESSAGE IN CALL TO $$CTM
POPJ P, ; AND RETURN TO CALLER
>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
; CURCHA - RETURN CURRENT CHARACTER ADDRESS IN BUFFER
;
; CALL: PUSHJ P,CURCHA
; (RETURN) ; WITH CHAR ADR IN AC T1
;
; USES AC T1
CURCHA: MOVE T1,@CMDBUF ; FETCH ADR OF COMMAND BUFFER
MOVE T1,(T1) ; FETCH # CHARS IN BUFFER
SUB T1,CMDCNT ; MINUS # LEFT IN BUFFER
MOVEI T1,5*T$DATA(T1) ; REMEMBER OVERHEAD WORDS BEFORE TEXT
POPJ P, ; AND RETURN TO CALLER
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
; MAKQNM -SCAN Q-REGISTER NAME AND GENERATE INTO CODE
;
; CALL: PUSHJ P,MAKQNM
; (RETURN)
;
; USES ACS C,N
MAKQNM: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
ERROR (MIQ) ; NONE LEFT. ** MISSING Q-REGISTER NAME **
CAIN C,"(" ; EXTENDED Q-REGISTER NAME?
JRST MAKQN3 ; YES, PICK UP 6-CHAR NAME
CAIN C,"*" ; NO, IS IT THE SPECIAL Q-REG "*"?
JRST MAKQN1 ; YES
PUSHJ P,CHKAN ; MAKE SURE CHAR IS A VALID Q-REGISTER NAME
ERROR (IQN) ; NO. ** ILLEGAL Q-REGISTER NAME **
MAKQN1: MOVSI N,'A'-"A"(C) ; YES, CONVERT TO SIXBIT
LSH N,^D12 ; AND LEFT JUSTIFY
MAKQN2: PUSH CP,N ; AND GEN INTO CODE
POPJ P, ; RETURN TO CALLER
; PICK UP A 6-CHAR LETTER/DIGIT Q-REGISTER NAME
MAKQN3: MOVEI X,[PUSHJ P,CMDGCH ; FETCH ADR OF GET-A-CHAR ROUTINE
ERROR (UQN) ; ** UNTERMINATED Q-REGISTER NAME **
POPJ P,] ; RETURN
MOVEM X,INPADR ; STORE ADR OF GET-A-CHAR ROUTINE
SETZM INPCHR ; CLEAR THE "LAST" CHAR
PUSHJ P,GSIX ; PICK UP THE 6-CHAR NAME
PUSHJ P,GCHR ; FETCH THE TERMINATOR CHAR
CAIE C,")" ; END WITH ")"?
ERROR (UQN) ; NO, ** UNTERMINATED Q-REGISTER NAME **
SETZM INPADR ; CLEAR THE ADR OF GET-A-CHAR ROUTINE
SETZM INPCHR ; ANS "LAST" CHAR
JRST MAKQN2 ; YES, FINISH UP
; FNDCH - FIND NEXT OCCURRANCE OF A CHARACTER IN COMMAND STRING
;
; CALL: MOVEI C,CHAR
; PUSHJ P,FNDCH
; (FAIL RETURN)
; (SUCCESS RETURN) ; WITH COUNT IN AC N OF CHARS SCANNED
;
; USES ACS C,T1
FNDCH: MOVEI T1,(C) ; SAVE THE CHAR TO BE SEARCHED FOR
SETZ N, ; CLEAR THE SCANNED CHAR COUNT
FNDCH1: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
POPJ P, ; NONE LEFT. GIVE FAIL RETURN TO CALLER
CAIE C,(T1) ; IS IT THE CHAR WE WANT?
AOJA N,FNDCH1 ; NO, COUNT IT AND CONTINUE SCAN
JRST CPOPJ1 ; YES, RETURN TO CALLER WITH SUCCESS RETURN
; UPCASE - UPCASE THE CHAR IN AC C IF IT IS A LOWER CASE LETTER
;
; CALL: MOVEI C,CHAR
; PUSHJ P,UPCASE
; (RETURN) ; WITH UPCASED CHAR IN AC C
;
; USES AC C
UPCASE: CAIG C,"Z"+40 ; IS CHAR LC?
CAIGE C,"A"+40 ; . . . ?
POPJ P, ; NO, JUST RETURN TO CALLER
TRZ C,40 ; YES, UPCASE THE CHAR
POPJ P, ; AND RETURN TO CALLER
; ARGK - IF NO ARG PRESENT GEN "-1" IF LAST OP WAS "SUB" OR "+1" IF NOT
;
; CALL: PUSHJ P,ARGK
; (RETURN) ; WITH CODE GENERATED TO KLUDGE ARG
;
; USES AC X
ARGK: TXNE F,F$1RG ; IS AN ARG PRESENT?
POPJ P, ; YES, NO SPECIAL KLUDGES
; NO ARG. GEN "-1" IF "-" SEEN OR "+1" IF "-" NOT SEEN
MOVE X,[MOVEI ARG,1] ; CODE FOR "+1"
TLNE T5,(4B8) ; WAS LAST OP "SUB"?
TLO X,(MOVNI) ; YES, GEN "MOVNI ARG,1"
PUSH CP,X ; STORE THE ARG KLUDGE CODE
HRLI T5,(MOVE ARG,) ;[402] SET POSSIBLE "SUB" TO "MOVE"
POPJ P, ; AND RETURN TO CALLER
; CHKNCC - GIVE ERROR IF CHARACTER IS A CONTROL CHAR
; (EXCEPT FOR THE COMMON OUTPUT CONTROL CHARACTERS)
;
; CALL: MOVEI C,CHAR
; PUSHJ P,CHKNCC
; (SUCCESS RETURN)
;
; 'ERROR (ICT)' IS GIVEN IF THE CHAR IS AN UN-COMMON CONTROL CHAR
;
; USES AC C
CHKNCC: CAIGE C,.CHSPC ; CHECK FOR CONTROL CHARS
CAIG C,.CHCRT ; . . .
CAIGE C,.CHCNH ; . . .
CAIN C,.CHESC ; . . .
POPJ P, ; NOT A CONTROL CHAR. GIVE SUCCESS RETURN TO CALLER
ERROR (ICT) ; YES, GIVE ERROR
; CHKITR - SKIP IF IN AN ITERATION
;
; CALL: PUSHJ P,CHKITR
; (NOT-IN-AN-ITERATION RETURN)
; (IN-AN-ITERATION RETURN)
;
; SMASHES ACS X,T1
CHKITR: MOVE T1,P ; COPY THE CONTROL PDP
; SEE IF AN ITERATION IS ON THE PDL (CONDITIONALS ALLOWED BEFORE IT)
CHKIT1: MOVE X,-1(T1) ; FETCH PDL FLAG
CAIN X,P$ITR ; IS IT AN ITERATION?
JRST CPOPJ1 ; YES, GIVE SUCCESS RETURN TO CALLER
SOJ T1, ; NO, GET READY TO BACKUP ON PDL
CAIN X,P$CON ; IS IT A CONDITIONAL?
SOJA T1,CHKIT1 ; YES, THEY'RE ALLOWED.KEEP LOOKING BACK
POPJ P, ; NO, GIVE FAIL RETURN TO CALLER
; CDCINS - SCAN AN INSERTION ARGUMENT
;
; CALL: PUSHJ P,CDCINS
; (RETURN)
;
; GEN: <CHAR.ADR,,CHAR.LENGTH>
;
; SMASHES ACS X,T1,T3,C
CDCINS: MOVEI T3,.CHESC ; FETCH THE DELIMITER CHAR
TXZN F,F$DTM ; ARE WE IN DELIMITED TEXT MODE?
JRST CDI1 ; NO
; FETCH THE DELIMITER CHAR FOR DELIMITED TEXT MODE
PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
ERROR (UIN) ; NONE LEFT. ** UNTERMINATED INSERT **
MOVEI T3,(C) ; SAVE THE TEXT DELIMITER
CDI1: PUSHJ P,CURCHA ; FETCH THE CHAR ADR OF TEXT
MOVSI T2,(T1) ; AND SAVE FOR LATER. ALSO, RH OF T2
; IS CHAR COUNT(NOT SPECIALS) FOR TEXT
TXZ F,F$CNT ; CLEAR THE ^T FLAG
; SCAN THE TEXT STRING TO COUNT CHARS AND CHECK VALID USE OF CONTROLS
CDI2: PUSHJ P,CMDGCH ; FETCH THE NEXT COMMAND CHAR
ERROR (UIN) ; NONE LEFT. ** UNTERMINATED INSERT **
CAIN C,(T3) ; IS IT THE DELIMITER CHAR?
JRST CDI4 ; YES. SCAN IS COMPLETE
; DO SPECIAL CHECKING IF THE CHAR IS A CONTROL CHAR
MOVE T1,[IOWD CDIC1L,CDIC1+1] ; AOBJN POINTER FOR DISPATCH
TXNE F,F$CNT ; ^T MODE? (IE: ^R AND ^T ARE ONLY SPECIALS)
MOVE T1,[IOWD CDIC2L,CDIC2+1] ; YES, USE SHORT DISPATCH
PUSHJ P,DISPAT ; DISPATCH ON THE SPECIAL CONTROL CHAR
TXNN F,F$CNT ; NOT A SPECIAL CONTROL. IN ^T MODE?
PUSHJ P,CHKNCC ; NO, MAKE SURE CHAR IS NOT A CONTROL
CDI3: AOJA T2,CDI2 ; COUNT THE TEXT CHAR AND GO BACK FOR MORE
; DONE WITH SCAN OF TEXT STRING. STORE SOME INFO ABOUT IT IN CODE
CDI4: PUSH CP,T2 ; GEN <CHARADR,,LENGTH> INTO CODE
POPJ P, ; AND RETURN TO CALLER
; DISPATCH TABLES FOR CONTROL CHARS IN INSERT TEXT STRINGS
CDIC1: <"V"-100,,CDI2>
<"W"-100,,CDI2>
<"^"-100,,CDI2>
CDIC2: <"T"-100,,CDICT>
<"R"-100,,CDICR>
CDIC2L==.-CDIC2
CDIC1L==.-CDIC1
; ^T - COMPLEMENT THE ^T MODE FLAG
CDICT: TXC F,F$CNT ; COMPLEMENT THE ^T FLAG
JRST CDI2 ; AND CONTINUE SCAN OF TEXT STRING
; ^R - TAKE THE NEXT CHAR AS TEXT
CDICR: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
ERROR (UIN) ; NONE LEFT. ** UNTERMINATED INSERT **
JRST CDI3 ; HIDE THE CHAR AND CONTINUE
; CDFSPC - SCAN A FILE SPEC AND GEN INTO CODE
;
; (SEE PARAMETER DEFINITIONS FOR STUCTURE OF A FILESPEC BLOCK)
CDFSPC: MOVEI X,CDFSP2 ; FETCH ADR OF ROUTINE THAT SCNS A CHAR
MOVEM X,INPADR ; AND STORE FOR 'GETCH' ROUTINE
SETZM INPCHR ; IN CASE A CHAR IS WAITING FROM BEFORE
STORE (X,FILSPC,FILSPC+FS$LTH-1,0) ; CLEAR THE FILE.SPEC
MOVEI L,FILSPC ; FETCH ADR OF FILE SPEC BLOCK
PUSH P,T4 ; SAVE AC T4
PUSHJ P,GFSPEC ; AND SCAN THE FILE SPEC
POP P,T4 ; RESTORE AC T4
CAIE C,.CHESC ; WAS DELIMITER AN ALTMODE?
ERROR (IFS) ; NO. ** ILLEGAL FILE SPEC **
; NOW GEN THE FILE SPEC INTO THE CODE
MOVE X,[IOWD FS$LTH,FILSPC+1] ; FETCH AOBJN PTR TO FILESPEC
CDFSP1: PUSH CP,(X) ; GEN A WORD OF THE FILESPEC
AOBJN X,CDFSP1 ; LOOP FOR ALL WORDS OF FILE SPEC
SETZM INPADR ; CLEAR ADR OF INPUT ROUTINE
POPJ P, ; AND RETURN TO CALLER
; ROUTINE TO SCAN A CHAR FOR FILE SPEC
; IGNORES: SPACE,TAB,<LF>,<VT>,<FF>,AND <CR>
CDFSP2: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
ERROR (UFS) ; NONE LEFT. ** UNTERMINATED FILE SPEC **
CAIE C,.CHSPC ; IS CHAR A SPACE?
CAIG C,.CHCRT ; OR TAB,<LF>,<VT>,<FF>, OR <CR> ?
CAIGE C,.CHTAB ; . . . ?
POPJ P, ; NO RETURN THE CHAR
JRST CDFSP2 ; YES, IGNORE THE CHAR
SUBTTL EXECUT - Execute a Command
; CALL: MOVEI L,ADRREF ; ADR OF REFERENCE TO COMMAND BUFFER
; PUSHJ P,EXECUT
; (RETURN)
;
; ADRREF: <BUFFER>
;
; BUFFER:
; --------------
; ! CHAR COUNT !
; !------------!
; ! REF. COUNT !
; !------------!
; ! BUFFER ID !
; !------------!
; ! !
; ! ASCII !
; ! !
; ! COMMAND !
; ! !
; !------------!
; ! !
; ! EXECUTABLE !
; ! !
; ! CODE !
; ! !
; --------------
;
; USES ALL ACS
EXECUT: MOVEM L,CMDBUF ; SAVE ADR OF REF TO COMMAND BUFFER
MOVE T1,@(L) ; FETCH # CHARS IN TEXT BUFFER
MOVEI T1,5*T$DATA(T1) ; ADD OVERHEAD WORDS FOR TEXT BUFFER
IDIVI T1,5 ; COMPUTE RELATIVE START ADR OF CODE
; FORMALIZE THE FACT THAT R AND CP REFERENCE THE BUFFER
MOVE R,(L) ; FETCH ADR OF COMMAND BUFFER
MOVE X,[<PC,,R>] ; FETCH ADRS OF AC REFS
MOVEM X,T$ACRF(R) ; AND BIND THE AC REFS TO BUFFER
; ENABLE FOR CASE FLAGGING (BASED ON EU FLAG)
TXZ F,F$NOF ; CLEAR THE "SUPPRESS CASE FLAGGING" FLAG
; CLEAR "LAST TEN COMMANDS" TABLE
STORE (X,TENIDX,TENIDX+^D10,0) ; CLEAR COMMAND TABLE
; BEGIN EXECUTION
ADDI T1,1(R) ; FIND BEGINNING OF CODE
PUSHJ P,(T1) ; BEGIN EXECUTION OF CODE
HRRZS T$1REF(R) ; UNBIND FIXED REF TO BUFFER
SETZM T$ACRF(R) ; UNBIND AC REFS FROM BUFFER
POPJ P, ; AND RETURN TO CALLER
SUBTTL $CTM - TRACE MODE TYPE-OUT
; $CTM - CHECK FOR TRACE MODE. IF ON, TYPE TEXT
;
; CALL: JSP PC,$$CTM
; <CHAR ADR IN BUFFER,,CHAR COUNT>
; (RETURN)
$CTM: TXZE F,F$REE ;[317] WANT TO STOP NOW?
JRST ERRREC ;[317] YES, STOP!
AOS T1,TENIDX ; INCREMENT AND FETCH INDEX INTO CMD TABLE
IDIVI T1,^D10 ; MAKE ID MODULO 10.
MOVEM T2,TENIDX ; STORE THE NEW INDEX
PUSHJ P,NXTWRD ; FETCH ARG
MOVEM N,TENCMD(T2) ; STORE CMD INFOR IN THE TABLE FOR THE
; "LAST TEN COMMANDS"
TXNN F,F$TRC ; IN TRACE MODE?
JRST (PC) ; NO, RETURN
PUSHJ P,TMSG ; YES, TYPE THE COMMAND
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $EH AND $EHS
; $EH - RETURN CURRENT MESSAGE LENGTH
;
; CALL: JSP PC,$$EH
; (RETURN) ; WITH VALUE IN AC VALUE
$EH: SETZ VALUE, ;[411] ASSUME ZERO
MOVE T1,EHVAL ; FETCH MESSAGE LENGTH
MOVSI X,-3 ; GET READY TO CONVERT TO A NUMBER
TDNE T1,JWTBL(X) ; BIT SET?
AOJ VALUE, ;[411] YES, INCREMENT MESSAGE LENGTH
AOBJN X,.-2 ; AND TRY FOR ALL POSSIBLE LENGTHS
JRST (PC) ; DONE, RETURN TO CALLER
; $EHS - SET THE MESSAGE LENGTH
;
; CALL: JSP PC,$$EHS ; WITH NEW LENGTH IN AC ARG
; (RETURN)
$EHS: CAILE ARG,3 ; ARG TOO LARGE?
MOVEI ARG,3 ; YES, USE LARGEST LEGAL
MOVX X,JW.WPR!JW.WFL ; FETCH DEFAULT LENGTH
JUMPLE ARG,.+2 ; SKIP IF ARG IS NEGATIVE
HRLZ X,JWTBL-1(ARG) ; FETCH LENGTH FROM TABLE
MOVEM X,EHVAL ; STORE THE NEW MESSAGE LENGTH
JRST (PC) ; AND RETURN TO CALLER
; JWTBL - TABLE FOR CONVERTING MESSAGE LENGTHS
JWTBL: <JW.WPR>_-^D18,,<JW.WPR>_-^D18
<JW.WFL>_-^D18,,<JW.WPR!JW.WFL>_-^D18
<JW.WCN>_-^D18,,<JW.WPR!JW.WFL!JW.WCN>_-^D18
SUBTTL $U AND $Q AND $INC
; $U - STORE ARG IN IN SPECIFIED Q-REGISTER
;
; CALL: JSP PC,$$U
; <Q-REGISTER NAME>
; (RETURN)
$U: PUSHJ P,NXTWRD ; FETCH Q-REGISTER NAME
MOVE T1,N ; INTO AC T1
MOVX T2,QB$NUM ; THIS IS A NUMERIC Q-REGISTER
MOVE T3,ARG ; FETCH THE NUMERIC ARG
PUSHJ P,QSTOR ; AND STORE THE VALUE IN Q-REGISTER
JRST (PC) ; AND RETURN TO CALLER
; $Q - RETURN THE NUMERIC VALUE OF SPECIFIED Q-REGISTER
;
; CALL: JSP PC,$$Q
; <Q-REGISTER NAME>
; (RETURN) ; WITH NUMERIC VALUE IN VALUE
$Q: PUSHJ P,NXTWRD ; FETCH THE Q-REGISTER NAME
MOVE T1,N ; INTO AC T1
PUSHJ P,QGET ; FETCH THE Q-REGISTER
JRST FAIRET ; DOESN'T EXIST. RETURN ZERO
TXNN T2,QB$NUM ; IS Q-REGISTER NUMERIC?
JRST $Q1 ;[370] SEE IF TO TYPE ASCII Q-REG
MOVE VALUE,T3 ; PUT NUMERIC VALUE IN AC VALUE
JRST (PC) ; AND RETURN TO CALLER
$Q1: MOVE X,4(PC) ;[374] FETCH NEXT INSTRUCTION
CAME X,[JSP PC,$$DEC] ;[370] QI= CONSTRUCTION?
CERROR (NNQ) ;[370] ** NON-NUMERIC Q-REG **
ADDI PC,5 ;[374] BUMP PC SO NOT TO CALL $DEC
MOVEI N,(T3) ;[370] FETCH TEXT BUFFER ID
MOVEI L,TMPRFG ;[370] TMPRFG WILL REFERENCE THE TEXT BUFFER
PUSHJ P,FNDBLK ;[370] FIND THE BLOCK WITH THE ID
ERROR (XXX) ;[370] EEK!!!!!!!
HRRZ T1,@TMPRFG ;[370] FETCH # OF CHARS
MOVE T3,[POINT 7,T$DATA] ;[370] LOAD BYTE POINTER TO Q-REG
ADD T3,TMPRFG ;[370] JUSTIFY IT TO Q-REG
$Q2: SOJL T1,$G2 ;[370] GO TO UNBIND ROUTINE IN $G WHEN DONE
ILDB C,T3 ;[370] GET A CHARACTER
PUSHJ P,TCCHR ;[370] TYPE THE CHARACTER
JRST $Q2 ;[370] TRY THE NEXT ONE
; $INC - ADD ONE TO A Q-REGISTER AND RETURN RESULTING VALUE
;
; CALL: JSP PC,$$INC
; (RETURN) ; WITH VALUE IN AC 'VALUE'
$INC: PUSHJ P,NXTWRD ; FETCH THE Q-REGISTER NAME
MOVE T1,N ; AND COPY INTO AC T1
SETZ T3, ; ZERO INCASE Q-REGISTER DOESN'T EXIST
PUSHJ P,QGET ; FEIND THE Q-REGISTER
MOVX T2,QB$NUM ; DOESN'T EXIST. SET DUMMY TYPE
TXNN T2,QB$NUM ; IS Q-REGISTER NUMERIC?
CERROR (NNQ) ; NO, ** NON-NUMERIC Q-REGISTER **
AOJ T3, ; YES, INCREMENT IT
MOVE VALUE,T3 ; SAVE ITS VALUE TO BE RETURNED
PUSHJ P,QSTOR ; AND SET THE NEW VALUE OF Q-REGISTER
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $PUSH AND $POP
; $PUSH - PUSH A Q-REGISTER ON THE Q-REGISTER PDL
;
; CALL: JSP PC,$$PUSH
; <Q-REGISTER NAME>
; (RETURN)
$PUSH: PUSHJ P,NXTWRD ; FETCH THE Q-REGISTER NAME
MOVE T1,N ; INTO AC T1
PUSHJ P,QGET ; FETCH THE Q-REGISTER
JRST [MOVX T2,QB$NUM ; DOESN'T EXIST. MAKE A DUMMY ONE.
SETZ T3, ; . . .
JRST .+1] ; AND PROCEED
MOVEI N,(T3) ; FETCH POSSIBLE TEXT BUFFER ID
TXNE T2,QB$TXT ; IS Q-REGISTER A TEXT BUFFER?
PUSHJ P,REFBLK ; YES, ADD ONE TO ITS REFERENCE COUNT
MOVE X,QP ; FETCH PQ PDL
AOBJN X,.+1 ; INCREMENT IT
EXCH X,QP ; AND STORE IT
PUSH X,T1 ; PUSH Q-REGISTER NAME
MOVE X,QP ; FETCH QPDL PDP
AOBJN X,.+1 ; INCREMENT Q PDL
EXCH X,QP ; AND STORE IT
PUSH X,T2 ; PUSH Q-REGISTER BITS
MOVE X,QP ; FETCH QPDL PDP
AOBJN X,.+1 ; INCREMENT IT
EXCH X,QP ; AND STORE IT
PUSH X,T3 ; PUSH Q-REGISTER VALUE/ID
JRST (PC) ; RETURN TO CALLER
; $POP - POP THE Q-REGISTER PDL INTO THE SPECIFIED Q-REGISTER
;
; CALL: JSP PC,$$POP
; <Q-REGISTER NAME>
; (RETURN)
$POP: PUSHJ P,NXTWRD ; FETCH THE Q-REGISTER NAME
MOVE T1,N ; INTO AC T1
MOVE X,QP ; FETCH Q PDL
POP X,T3 ; POP THE PUSHED VALUE
POP X,T2 ; POP THE PUSHED BITS
POP X,N ; POP THE PUSHED Q-REGISTER NAME
MOVEM X,QP ; AND STORE THE UPDATED QPDL PDP
JUMPE N,[CERROR (PES)] ; ** POPED EMPTY STACK **
TXZ F,F$REF ; T3 DOES NOT CONTAIN TEXT BUFFER REFERENCE
; (IE: IT CONTAINS VALUE/TEXT BUFFER ID)
PUSHJ P,QSTOR ; STORE THE POPPED Q IN SPECIFIED Q-REGISTER
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $DEC AND $OCT AND $CNE AND $CNN AND $FFD
; $DEC - TYPE ARG IN DECIMAL
;
; CALL: JSP PC,$$DEC
; (RETURN)
$DEC: MOVE N,ARG ; MOVE ARG INTO PROPER AC
PUSHJ P,TDEC ; AND TYPE IT IN DECIMAL
JRST $OCT1 ;[305] SEE IF MORE TO DO
; $OCT - TYPE ARG IN OCTAL
;
; CALL: JSP PC,$$OCT
; (RETURN)
$OCT: MOVE N,ARG ; MOVE ARG INTO ANOTHER AC
PUSHJ P,TOCT ; AND TYPE IT IN OCTAL
; SEE IF WE MUST SUFFIX NUMBER WITH ANYTHING
$OCT1: JUMPE SARG,(PC) ;[305] N.EQ.0 MEANS NOTHING TO SUFFIX. RETURN
JUMPG SARG,$OCT2 ;[305] N.GT.0 MEANS SUFFIX CHAR
; N.LT.0 MEANS SUFFIX CRLF TO OUTPUT
PUSHJ P,TCRLF ;[305] SUFFIX A CRLF
JRST (PC) ;[305] AND RETURN TO CALLER
; N.GT.0 MEANS SUFFIX CHAR WHOSE CODE IS N TO OUTPUT
$OCT2: MOVEI C,(SARG) ;[305] FETCH THE CHAR TO OUTPUT
PUSHJ P,TCHR ;[305] TYPE THE CHAR
JRST (PC) ;[305] AND RETURN TO CALLER
; $CNE - RETURN VALUE OF THE FORMFEED FLAG (0=OFF,-1=ON)
;
; CALL: JSP PC,$$CNE
; (RETURN) ; WITH RESULT IN AC VALUE
$CNE: SETZ VALUE, ; FORMFEED FLAG IS OFF
TXNE F,F$FFD ; BUT IS IT?
SETO VALUE, ; NO, IT'S ON
JRST (PC) ; RETURN TO CALLER
; $CNN - RETURN THE VALUE OF THE END-OF-FILE FLAG (0=OFF,-1=ON)
;
; CALL: JSP PC,$$CNN
; (RETURN) ; WITH RESULT IN AC VALUE
$CNN: SETZ VALUE, ; THE EOF FLAG IS OFF
TXNE F,F$EOF ; BUT IS IT?
SETO VALUE, ; NO, IT'S ON
JRST (PC) ; RETURN TO CALLER
; $FFD - TYPE A FORMFEED
;
; CALL: JSP PC,$$FFD
; (RETURN)
$FFD: MOVEI C,.CHFFD ; FETCH A FORMFEED CHAR
PUSHJ P,TCCHR ; TYPE IT
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $UP AND $LOW AND CLRCAS AND $CX AND $CXS
; $UP - SET THE "UPCASE ALL TEXT" FLAG (OR CLEAR IF ARG.EQ.0)
;
; CALL: JSP PC,$$UP
; (RETURN)
$UP: JUMPE ARG,CLRCAS ; IF ARG.EQ.0 CLEAR ALL CASE FLAGS
TXZ F,F$DNC ; IF ARG.NE.0 THEN CLEAR "DOWNCASE" FLAG
TXO F,F$UPC ; AND SET THE "UPCASE" FLAG
JRST (PC) ; AND RETURN TO CALLER
; $LOW - SET THE "DOWNCASE ALL TEXT" FLAG (OR CLEAR IF ARG.EQ.0)
;
; CALL: JSP PC,$$LOW
; (RETURN)
$LOW: JUMPE ARG,CLRCAS ; IF ARG.EQ.0, CLEAR ALL CASE FLAGS
TXZ F,F$UPC ; IF ARG.NE.0, CLEAR "UPCASE" FLAG
TXO F,F$DNC ; AND SET THE "DOWNCASE" FLAG
JRST (PC) ; AND RETURN TO CALLER
; CLRCAS - CLEAR "UPCASE" AND "DOWNCASE" FLAGS
CLRCAS: TXZ F,F$UPC!F$DNC ; CLEAR FLAGS
JRST (PC) ; AND RETURN TO CALLER
; $CX - RETURN THE VALUE OF THE "EXACT SEARCH MODE" FLAG
;
; CALL: JSP PC,$$CX
; (RETURN) ; WITH VALUE IN AC VALUE
; ; -1=EXACT SEARCH MODE
; ; 0=BOTH UPPER&LOWER MATCH
$CX: TXNE F,F$CNX ; IN "EXACT SEARCH MODE"?
JRST SUCRET ; YES, RETURN VALUE OF -1
JRST FAIRET ; NO, RETURN VALUE OF 0
; $CXS - SET THE "EXACT SEARCH MODE" FLAG
;
; CALL: JSP PC,$$CXS
; (RETURN)
$CXS: TXZ F,F$CNX ; CLEAR THE "EXACT SEARCH MODE" FLAG
JUMPE ARG,(PC) ; RETURN IF CALLER WANTS IT CLEARED
TXO F,F$CNX ; NO, HE WANTS IT SET
JRST (PC) ; NOW RETURN TO CALLER
SUBTTL $CNZ and $MES and $NA
; $CNZ - CLOSE OUTPUT FILE AND EXEIT TO MONITOR COMMAND LEVEL
;
; CALL: JSP PC,$$CNZ
; (RETURN) ; IF USER TYPES "CONTINUE"
$CNZ: JRST $EX1 ; DO "EF^C"
; $MES - TYPE A MESSAGE (UNLESS IN TRACE MODE)
;
; CALL: JSP PC,$$MES
; <CHAR ADR IN BUFFER,,CHAR COUNT>
; (RETURN)
$MES: PUSHJ P,NXTWRD ; FETCH THE ARG
TXNN F,F$TRC ; IN TRACE MODE?
PUSHJ P,TMSG ; NO, TYPE THE MESSAGE
JRST (PC) ; AND RETURN TO CALLER
; $NA - RETURN THE ASCII VALUE OF THE CHAR FOLLOWING TEXT POINTER
;
; CALL: JSP PC,$$NA
; (RETURN)
$NA: MOVE T1,PTVAL ; FETCH "."
MOVE VALUE,@TXTBUF ; SEE WHERE "." IS
SUB VALUE,T1 ; . . .
JUMPE VALUE,(PC) ; END OF BUFFER. RETURN ZERO
PUSHJ P,GET ; FETCH THE CHAR AFTER "."
MOVEI VALUE,(C) ; COPY THE VALUE
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $CKC and $CHA and $CKD and $CKV and $CKW
; $CKC - SKIP IF ARG IS ASCII CODE FOR A SYMBOL CONSTITUENT
; (IE: A-Z,0-9,%,.,$)
;
; CALL: JSP PC,$CKC
; (FAIL RETURN)
; (SUCCESS RETURN)
$CKC: MOVE C,ARG ; FETCH THE ARG CHARACTER
PUSHJ P,CHKAN ; IS IT CODE FOR A LETTER/DIGIT?
SKP ; NO, TRY AGAIN
JRST 1(PC) ; YES, GIVE SUCCESS RETURN
CAIE C,"%" ; IS CHAR "%"?
CAIN C,"." ; OR "."?
JRST 1(PC) ; YES, GIVE SUCCESS RETURN
CAIN C,"$" ; NO, IS IT "$"?
JRST 1(PC) ; YES, GIVE SUCCESS RETURN
JRST (PC) ; NO, GIVE FAIL RETURN
; $CKA - SKIP IF ARG IS ASCII CODE FOR A LETTER (UPPER OR LOWER)
;
; CALL: JSP PC,$CKA
; (FAIL RETURN)
; (SUCCESS RETURN)
$CKA: CAIG ARG,"Z"+40 ; IS ARG WAY OUT OF RANGE?
CAIGE ARG,"A" ; . . . ?
JRST (PC) ; YES. GIVE FAIL RETURN
CAIGE ARG,"A"+40 ; NO, IS CHAR A LETTER?
CAIG ARG,"Z" ; . . . ?
JRST 1(PC) ; YES, GIVE SUCCESS RETURN
JRST (PC) ; NO, GIVE FAIL RETURN
; $CKD - SKIP IF ARG IS ASCII CODE FOR A DIGIT
;
; CALL: JSP PC,$CKD
; (FAIL RETURN)
; (SUCCESS RETURN)
$CKD: CAIG ARG,"9" ; IS ARG CODE FOR DIGIT?
CAIGE ARG,"0" ; . . . ?
JRST (PC) ; NO, GIVE FAIL RETURN
JRST 1(PC) ; YES, GIVE SUCCESS RETURN
; $CKV - SKIP IF ARG IS ASCII CODE FOR A LOWER CASE LETTER
;
; CALL: JSP PC,$CKV
; (FAIL RETURN)
; (SUCCESS RETURN)
$CKV: CAIG ARG,"Z"+40 ; IS ARG CODE FOR A LOWER CASE LETTER?
CAIGE ARG,"A"+40 ; . . . ?
JRST (PC) ; NO, GIVE FAIL RETURN
JRST 1(PC) ; YES, GIVE SUCCESS RETURN
; $CKW - SKIP IF ARG IS ASCII CODE FOR AN UPPER CASE LETTER
;
; CALL: JSP PC,$$CKW
;
; CALL: JSP PC,$$CKW
; (FAIL RETURN)
; (SUCCESS RETURN)
$CKW: CAIG ARG,"Z" ; IS ARG CODE FOR AN UPPER CASE LETTER?
CAIGE ARG,"A" ; . . . ?
JRST (PC) ; NO, GIVE FAIL RETURN
JRST 1(PC) ; YES, GIVE SUCCESS RETURN
SUBTTL $SEMF and $SEMZ and $SEM and $STOP
; $SEMF - JUMP OUT OF CURRENT ITERATION IF LAST SEARCH FAILED (ELSE CONTINUE)
;
; CALL: JSP PC,$$SEMF
; (RETURN IF LAST SEARCH SUCCEEDED)
$SEMF: TXNN F,F$LSF ; DID LAST SEARCH FAIL?
JRST (PC) ; NO, RETURN TO CALLER
JRST $SEM ; YES, JUMP OF OF CURRENT ITERATION
; $SEMZ - JUMP OUT OF CURRENT ITERATION IF ARG.EQ.0 (ELSE CONTINUE)
;
; CALL: JSP PC,$$SEMZ
; (RETURN IF ARG.LT.0)
$SEMZ: JUMPN ARG,(PC) ; RETURN TO CALLER IF ARG NON-ZERO
; JRST $SEM ; ARG.EQ.0. JUMP OUT OF CURRENT ITERATION
; $SEM - JUMP OUT OF CURRENT ITERATION
;
; CALL: JSP PC,$$SEM
$SEM: POP P,X ; POP "OUT OF ITERATION" ADR
ADDI X,(R) ; MAKE IT AN ABSOLUTE ADR
JRST (X) ; AND POP OUT OF THE ITERATION
; $STOP - STOP MACRO EXECUTION
;
; CALL: JSP PC,$$STOP
;
; DOES A "POPJ P," TO RETURN TO WHOEVER INVOKED THIS MACRO/COMMAND
$STOP: JRST ERRREC ; SAME AS RECOVERING FROM AN ERROR
SUBTTL $R and $C and $J
; $R - MOVE THE BUFFER POINTER BACKWARDS N CHARS
;
; CALL: JSP PC,$$R
; (RETURN)
$R: MOVN ARG,ARG ; MAKE ARG FOR "R" INTO ARG FOR "C"
; $C - MOVE THE BUFFER POINTER AHEAD N CHARS
;
; CALL: JSP PC,$$C
; (RETURN)
$C: ADD ARG,PTVAL ; MAKE ARG FOR "C" INTO ARG FOR "J"
; $J - MOVE THE BUFFER POINTER TO A SPECIFIC POSITION
;
; CALL: JSP PC,$$J
; (RETURN)
$J: PUSHJ P,CHKARG ; CHECK THE ARG FOR VALIDITY
CERROR (POP) ; ** ATTEMPT TO MOVE POINTER OFF PAGE **
MOVEM ARG,PTVAL ; ARG IS OK. SET NEW "." VALUE
JRST SUCRET ; AND RETURN TO CALLER
SUBTTL $KL and $L and $D
; $KL - REMOVE LINES FROM TEXT BUFFER
;
; CALL: JSP PC,$$KL
; (RETURN)
$KL: PUSHJ P,EVL2RG ; CONVERT LINE ARG TO CHAR ADDRESSES
SKP ; AND FALL INTO $K
; $K - REMOVE TEXT BETWEEN TWO POINTS FROM THE TEXT BUFFER
;
; CALL: JSP PC,$$K
; (RETURN)
$K: PUSHJ P,CHK2RG ; MAKE SURE ARGS ARE IN BOUNDS OF BUFFER
MOVEM SARG,PTVAL ; ".":=N (OF N,M)
SUB ARG,SARG ; COMPUTE # CHARS TO BE DELETED
JUMPE ARG,(PC) ; RETURN TO CALLER IF NOTHING TO DELETE
; ELSE FALL INTO $D
; $D - DELETE SPECIFIED # CHARACTERS FROM MAIN TEXT BUFFER
;
; CALL: JSP PC,$$D
; (RETURN)
$D: MOVM T1,ARG ; SAVE ARG AS ARG FOR 'MKROOM'
ADD ARG,PTVAL ; TURN ARG INTO A BUFFER ADDRESS
PUSHJ P,CHKARG ; AND MAKE SURE IT'S BETWEEN B AND Z
CERROR (POP) ; ** ATTEMPT TO MOVE POINTER OFF PAGE **
CAMGE ARG,PTVAL ; DOING -ND?
MOVEM ARG,PTVAL ; YES, BACKUP THE POINTER
MOVN T1,T1 ; ARG TO MKROOM IS A NEGATIVE # TO DELETE
PUSHJ P,MKROOM ; DELETE THE CHARACTERS
JRST SUCRET ; AND RETURN TO CALLER
SUBTTL $TAB and $I and $NI and $L
; $TAB - INSERT <TAB> AND THEN TEXT STRING INTO TEXT BUFFER AT "."
;
; CALL: JSP PC,$$TAB
; <CHAR.ADR,,CHAR.LENGTH>
; (RETURN)
$TAB: MOVEI C,.CHTAB ; FETCH A <TAB> CHARACTER
PUSHJ P,INSCHR ; INSERT IT AT "."
; JRST $I ; NOW INSERT THE TEXT STRING
; $I - INSERT A TEXT STRING INTO THE TEXT BUFFER AT CURRENT POSITION
;
; CALL: JSP PC,$$I
; <CHAR ADR OF TEXT,# TEXT CHARS>
; (RETURN)
$I: PUSHJ P,NXTWRD ; FETCH <CHARADR,,#CHARS>
HLRZ T1,N ; FETCH THE CHARADR
SOJ T1, ; 'CAUSE BP WILL BE INCREMENTED BEFORE USE
PUSHJ P,CTOBP ; AND CONVERT IT TO A BYTE POINTER
IOR T1,[Z 0(R)] ; BYTE POINTER IS RELATIVE TO CODE
MOVE T3,T1 ; SAVE THE BYTE POINTER FOR LATER
MOVEI N,(N) ; FETCH THE CHAR COUNT
TXZ F,F$$TX ; CLEAR TEXT MODE FLAGS
; MAKE ROOM IN THE TEXT BUFFER FOR THE INSERT TEXT
MOVEI T1,(N) ; FETCH # CHARS TO BE INSERTED
PUSH P,T3 ; SAVE AC T3
PUSH P,N ; SAVE AC N
PUSHJ P,MKROOM ; MAKE ROOM FOR THE INSERT TEXT
POP P,N ; RESTORE AC N
POP P,T3 ; RESTORE AC T3
; INSERT THE TEXT INTO THE BUFFER A CHAR AT A TIME
$I0: JUMPE N,(PC) ; RETURN TO CALLER IF INSERTION IS NULL
$I1: ILDB C,T3 ; FETCH NEXT CHAR FROM TEXT STRING
; CHECK FOR SPECIAL CONTROL CHARACTERS
MOVE T1,[IOWD $IT1L,$IT1+1] ; POINTER TO CTL CHAR DISPATCH TABLE
TXNE F,F$CNT ; IN ^T MODE?
MOVE T1,[IOWD $IT2L,$IT2+1] ; YES, USE SHORT DISPATCH TABLE
PUSHJ P,DISPAT ; DISPATCH ON SPECIAL CONTROL CHARS
$I3: PUSHJ P,CASE ; DO ANY REQUIRED CASE CONVERSIONS ON CCHAR
$I4: MOVE T1,PTVAL ; FETCH ADR OF WHERE CHAR WILL GO
PUSHJ P,PUT ; INSERT THE CHAR IN THE TEXT BUFFER AT "."
AOS PTVAL ; ".":="."+1
SOJG N,$I1 ; LOOP FOR ALL CHARS IN TEXT STRING
JRST (PC) ; DONE. RETURN TO CALLER
; DISPATCH TABLES FOR SPECIAL CONTROL CHARS IN INSERT TEXT STRINGS
$IT1: <"V"-100,,$ITV>
<"W"-100,,$ITW>
<"^"-100,,$ITU>
$IT2: <"T"-100,,$ITT>
<"R"-100,,$ITR>
$IT2L==.-$IT2
$IT1L==.-$IT1
; ^V - DOWNCASE FOLLOWING LETTER
; ^V^V - DOWNCASE LETTERS UNTIL END OF STRING OR FURTHER NOTICE
$ITV: PUSHJ P,CNV ; SET THE DOWNCASE FLAGS
JRST $I1 ; AND PROCESS NEXT CHAR
; ^W - UPCASE FOLLOWING LETTER
; ^W^W - UPCASE LETTERS UNTIL END OF STRING OR FURTHER NOTICE
$ITW: PUSHJ P,CNW ; SET UPCASE FLAGS
JRST $I1 ; AND PROCESS NEXT CHAR
; ^^ - INSERT LC EQUIVALENT OF FOLLOWING CHAR (@,[,\,],_)
$ITU: ILDB C,T3 ; FETCH THE NEXT CHAR
PUSHJ P,CNUAR ; DOWNCASE IF @,[,\,],OR _
JRST $I4 ; AND COUNT CHAR AND PROCESS NEXT CHAR
; ^R - QUOTE THE NEXT CHAR (IE: TAKE AS TEXT)
$ITR: ILDB C,T3 ; FETCH THE NEXT CHAR
JRST $I3 ; DO CASE CONVERSIONS AND STORE IN BUFFER
; ^T - COMPLEMENT ^T MODE FLAG (IN ^T MODE ONLY ^T AND ^R ARE SPECIAL)
$ITT: TXC F,F$CNT ; COMPLEMENT THE ^T MODE FLAG
JRST $I1 ; AND PROCESS NEXT CHAR
; $NI - INSERT ASCII CHARACTER FOR CODE IN ARG IN TEXT BUFFER AT "."
;
; CALL: JSP PC,$$NI
; (RETURN)
$NI: MOVE C,ARG ; COPY ARG INTO AC C
PUSHJ P,INSCHR ; PUT CHAR INTO BUFFER AT "."
JRST (PC) ; AND RETURN TO CALLER
; $L - MOVE BUFFER POINTER AHEAD AN ARBITRARY NUMBER(-,0,+) OF LINES
;
; CALL: JSP PC,$$L
; (RETURN)
$L: PUSHJ P,EVL2RG ; CONVERT LINE ARG TO STRING ADDRESSES
MOVEM T4,PTVAL ; PTVAL:=ADR OF NTH LINE
JRST (PC) ; RETURN TO CALLER
SUBTTL $BS1 and $BS2
; $BS1 - N\ - INSERT ASCII REPRESENTATION OF N TO RIGHT OF "."
;
; CALL: JSP PC,$$BS1
; (RETURN)
$BS1: MOVEI X,[AOJA T1,CPOPJ] ; TO COUNT # DIGITS IN NUMBER
MOVEM X,OUTADR ; SAVE ADR OF "OUTPUT" A CHAR ROUTINE
SETZ T1, ; CLEAR THE COUNT OF CHARS IN NUMBER
MOVE N,ARG ; FETCH THE NUMBER
PUSHJ P,TDEC ; COMPUTE # DIGITS IN NUMBER
PUSHJ P,MKROOM ; MAKE ROOM FOR THE NUMBER
MOVEI X,[AOS T1,PTVAL ; TO PUT ASCII CHARS IN THE TEXT BUFFER
SOJA T1,PUT] ; . . .
MOVEM X,OUTADR ; SAVE ADR OF OUTPUT A CHAR ROUTINE
MOVE N,ARG ; FETCH THE NUMBER AGAIN
PUSHJ P,TDEC ; AND STORE THE ASCII REPRESENTATION
; IN THE TEXT BUFFER
SETZM OUTADR ; DO NORMAL OUTPUT NOW
JRST (PC) ; AND RETURN TO CALLER
; $BS2 - \ - RETURN THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS
; (POSSIBLY +/- SIGN) FOLLOWING ".". "." IS POSITIONED
; AFTER THE LAST DIGIT OR CHAR OF NUMBER
;
; CALL: JSP PC,$$BS2
; (RETURN) ; WITH VALUE IN AC VALUE
$BS2: SETZ VALUE, ; CLEAR THE VALUE
TXZ F,F$1RG ; USED TO REMEMBER THAT "-" SEEN
MOVE T4,PTVAL ; FETCH "."
CAML T4,@TXTBUF ; AT END OF BUFFER?
JRST $BS23 ; YES, RETURN ZERO
$BS20: PUSHJ P,GETINC ; NO. FETCH CHAR FROM BUFFER
CAIN C,"+" ; IS IT "+" SIGN?
JRST $BS20 ; YES, IGNORE "+"
CAIE C,"-" ; IS IT "-" SIGN?
JRST $BS22 ; NO
TXO F,F$1RG ; YES, FLAG THAT "-" SEEN
$BS21: CAML T4,@TXTBUF ; AT END OF BUFFER?
JRST $BS23 ; YES
PUSHJ P,GETINC ; NO, FETCH NEXT CHAR
$BS22: CAIG C,"9" ; IS IT A DIGIT?
CAIGE C,"0" ; . . . ?
SOJA T4,$BS24 ; NO
IMULI VALUE,^D10 ; YES, MAKE ROOM FOR THE DIGIT
ADDI VALUE,-"0"(C) ; AND ADD IN THE DIGIT
JRST $BS21 ; AND TRY FOR ANOTHER DIGIT
$BS23: MOVE T4,@TXTBUF ; FETCH Z
$BS24: TXNE F,F$1RG ; A "-" SIGN SEEN?
MOVN VALUE,VALUE ; YES, NEGATE THE NUMBER
MOVEM T4,PTVAL ; POSITION "." AFTER THE NUMBER
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $TTC
; $TTC - GENERAL PURPOSE TTCALL ROUTINE
;
; CALL: JSP PC,$$TTC ; WITH TTCALL # IN AC ARG
; (RETURN)
$TTC: MOVE VALUE,SARG ; SO THAT OUTCHR,SETLCH, AND IONEOU WILL WORK
MOVX T1,1B0 ; INIT POINTER INTO BIT MAP
MOVNI X,(ARG) ; MAKE RIGHT SHIFT COUNT FROM TTCALL #
LSH T1,(X) ; FORM POINTER INTO BIT MAP
CAIG ARG,^D16 ; IS TTCALL # IN RANGE?
TDNN T1,TTLMAP ; . . . ?
ERROR (ITT) ; NO, ** ILLEGAL TTCALL **
CAIN ARG,^D8 ; IS THE TTCALL "RESCAN"?
JRST $TTC2 ; YES, DO SPECIAL KLUDGE
LSH ARG,^D23 ; PUT TTCALL # IN AC FIELD
IOR ARG,[TTCALL 0,VALUE] ; AND FROM A TTCALL INSTRUCTION
XCT ARG ; EXECUTE IT
JRST $TTC1 ; IT DIDN'T SKIP
TDNN T1,TTSMAP ; HAVE A VALUE WHEN IT SKIPS?
SETO VALUE, ; YES, SET VALUE:=.TRUE.
JRST (PC) ; NO, HAS ITS OWN VALUE. RETURN TO CALLER
; TTCALL DIDN'T SKIP
$TTC1: TDNE T1,TTSMAP ; WAS TTCALL A "SKIP" TYPE?
JRST FAIRET ; YES, RETURN VALUE OF ZERO FOR NON-SKIP RETURN
JRST (PC) ; NO, HAS ITS OWN VALUE
; SPECIAL KLUDGE FOR RESCAN TTCALL
;
; IF AC SARG.EQ.0 DO A "RESCAN 1", ELSE TAKE ON VALUE ON CCL FLAG
$TTC2: MOVE X,[RESCAN 1] ; FETCH THE "RESCAN" INSTRUCTION
JUMPE SARG,.+2 ; WANT TO CHECK CCL FLAG?
MOVE X,[TXNE (F,F$CCL)] ; YES, FETCH PROPER INSTRUCTION
XCT X ; PERFORM THE INSTRUCTION (WHATEVER IT IS)
JRST SUCRET ; SUCCESS RETURN. VALUE:=.TRUE.
JRST FAIRET ; FAIL RETURN. VALUE:=.FALSE.
; BIT MAPS FOR TTCALLS
TTLMAP: <^B111011111111110000,,0> ; MAP OF LEGAL TTCALL #'S
TTSMAP: <^B001001000001100000,,0> ; MAP OF TTCALLS THAT SKIP
SUBTTL $S and $N
; $S - SEARCH FOR AN OCCURRANCE OF A STRING IN THE TEXT BUFFER
;
; CALL: JSP PC,$$S
; <CHAR.ADR,,<X>B18+TEXT.LENGTH>
; ; CHAR.ADR:=ADR OF SEARCH ARGUMENT
; ; X:=0 IF BOTH LC AND UC LETTERS MATCH
; ; X:=1 IF EXACT SEARCH MODE
; ; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
; (RETURN)
$S: JUMPGE ARG,$S1 ; IF FORWARD SEARCH, THEN DO IT NOW
$S0: MOVE T4,@TXTBUF ; REVERSE BOUNDS FOR MINUS SEARCH
SETZ T5, ; . . .
MOVM ARG,ARG ; AND MAKE REPEAT FACTOR POSITIVE
PUSHJ P,BSERCH ; PERFORM THE SEARCH
JRST $SF ; SEARCH FAILED
JRST (PC) ; SEARCH SUCCEEDED. RETURN TO CALLER
$S1: PUSHJ P,SERCH ; DO THE FORWARD SEARCH
$SF: CERROR (SRH) ; ** SEARCH FAILED **
JRST (PC) ; SEARCH SUCCEEDED. RETURN TO CALLER
; $N - NON-STOP SEARCH FOR A STRING
;
; CALL: JSP PC,$$N
; <CHAR.ADR,,<X>B18+TEXT.LENGTH>
; ; CHAR.ADR:=ADR OF SEARCH ARGUMENT
; ; X:=0 IF BOTH LC AND UC LETTERS MATCH
; ; X:=1 IF EXACT SEARCH MODE
; ; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
; (RETURN)
$N: JUMPL ARG,$S0 ; BACKWARDS SEARCH (ONLY IN CURRENT BUFFER)
$N1: PUSHJ P,SERCH ; SEARCH REST OF CURRENT BUFFER
SKP ; SEARCH FAILED
JRST (PC) ; SEARCH SUCCEEDED. RETURN TO CALLER
SETZ T4, ; GET READY TO PUNCH OUT ENTIRE BUFFER
MOVE T5,@TXTBUF ; . . .
PUSHJ P,PUNCH ; PUNCH OUT THE ENTIRE BUFFER
MOVEI C,.CHFFD ; GET READY IN CASE <FF> CHAR NEEDED
TXNE F,F$FFD ; NEED <FF> AT END OF BUFFER?
PUSHJ P,@PCHADR ; YES, PUNCH A <FF> CHAR
TXNE F,F$EOF ; AT END OF FILE?
JRST [PUSHJ P,YANK ; YES, YANK THE BUFFER CLEAR
CERROR (SRH)] ; AND GIVE SEARCH FAIL ERROR
PUSHJ P,YANK ; NO, YANK THE NEXT BUFFER
SOJA PC,$N1 ; BACKUP PC TO <CHAR.ADR,,CHAR.LENGTH>
; AND CONTINUE SEARCH IN NEXT PAGE
SUBTTL $BAR
; $BAR - NON-STOP SEARCH FOR A STRING (NO OUTPUT)
;
; CALL: JSP PC,$$BAR
; <CHAR.ADR,,<X>B18+TEXT.LENGTH>
; ; CHAR.ADR:=ADR OF SEARCH ARGUMENT
; ; X:=0 IF BOTH LC AND UC LETTERS MATCH
; ; X:=1 IF EXACT SEARCH MODE
; ; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
; (RETURN)
$BAR: JUMPL ARG,$S0 ; BACKWARDS SEARCH (ONLY IN CURRENT BUFFER)
$BAR1: PUSHJ P,SERCH ; SEARCH REST OF CURRENT BUFFER
SKP ; SEARCH FAILED
JRST (PC) ; SEARCH SUCCEEDED. RETURN TO CALLER
TXNE F,F$EOF ; SEARCH FAILED. AT END OF FILE?
JRST $SF ; YES, STOP SEARCHING
PUSHJ P,YANK ; READ NEXT BUFFER
SOJA PC,$BAR1 ; POINT PC TO SEARCH ARGUMENT
; AND TRY THE SEARCH AGAIN IN NEXT BUFFER
SUBTTL $BS and $FS
; $BS - SEARCH FOR AN OCCURRANCE OF A STRING WITHIN SPECIFIED BOUNDS
;
; CALL: JSP PC,$$S
; <CHAR.ADR,,<X>B18+TEXT.LENGTH>
; ; CHAR.ADR:=ADR OF SEARCH ARGUMENT
; ; X:=0 IF BOTH LC AND UC LETTERS MATCH
; ; X:=1 IF EXACT SEARCH MODE
; ; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
; (RETURN)
$BS: TXZ F,F$MSR ; CLEAR THE MINUS SEARCH FLAG
EXCH SARG,ARG ; EXCHANGE ARGS
CAMLE ARG,SARG ;[314] MINUS SEARCH?
TXOA F,F$MSR ; YES, FLAG IT
EXCH SARG,ARG ; NO, PUT THE ARGS BACK
PUSHJ P,CHK2RG ; CHECK THE ARGS FOR VALIDITY
MOVEM SARG,PTVAL ; ".":=LOWER BOUND
TXZE F,F$MSR ; MINUS SEARCH?
EXCH SARG,ARG ; YES, REVERSE THE ARGS
MOVE T4,SARG ; FETCH THE LOWER BOUND
MOVE T5,ARG ; FETCH THE UPPER BOUND
MOVEI ARG,1 ;[314] SEARCH FOR FIRST OCCURRANCE
PUSHJ P,BSERCH ; AND DO THE SEARCH
JRST $SF ; SEARCH FAILED
JRST (PC) ; SEARCH SUCCEEDED. RETURN TO CALLER
; $FS - SUBSTITUTE A STRING FOR THE LAST SEARCH STRING
;
; CALL: JSP PC,$$FS
; <CHAR.ADR,,CHAR.LENGTH>
; (RETURN)
$FS: PUSHJ P,NXTWRD ; FETCH <ADR,,LEN>
TXNE F,F$LSF ; DID LAST SEARCH FAIL?
JRST (PC) ; YES, DON'T INSERT TEXT STRING
MOVEI T1,(N) ; FETCH INSERTION LENGTH (IN CHARS)
MOVE X,PTVAL ; FETCH VALUE OF "."
SUB X,SRHLEN ; MINUS LENGTH OF LAST SEARCH MATCH
MOVEM X,PTVAL ; POSITION "." BEFORE LAST SEARCH ARG
SUB T1,SRHLEN ; MINUS LENGTH OF LAST SEARCH MATCH
PUSHJ P,MKROOM ; ADJUST BUFFER FOR INSERTION
HLRZ T1,-1(PC) ; FETCH CHAR.ADR
SOJ T1, ; 'CAUSE BP WILL BE INCREMENTED BEFORE USE
PUSHJ P,CTOBP ; CONVERT IT TO A BYTE POINTER
IOR T1,[Z 0(R)] ; BYTE POINTER IS RELATIVE TO CODE
MOVE T3,T1 ; SAVE THE BYTE POINTER FOR LATER
TXZ F,F$$TX ; CLEAR TEXT MODE FLAGS
HRRZ N,-1(PC) ; FETCH # CHARS TO BE INSERTED
JRST $I0 ; AND DO THE INSERT
SUBTTL $TL and $T and $0TT
; $TL - TYPE LINES FROM TEXT BUFFER
;
; CALL: JSP PC,$$TL
; (RETURN)
$TL: PUSHJ P,TYPEL ; CALL THE "TYPE LINES" ROUTINE
JRST (PC) ; AND RETURN TO CALLER
; $T - TYPE TEXT BETWEEN TWO POINTS FROM THE TEXT BUFFER
;
; CALL: JSP PC,$$T
; (RETURN)
$T: PUSHJ P,TYPE ; CALL THE "TYPE" ROUTINE
JRST (PC) ; AND RETURN TO CALLER
; $0TT - TYPE CURRENT LINE IF LAST SEARCH SUCCEEDED AND ES.NE.0
;
; CALL: JSP PC,$$0TT
; (RETURN)
$0TT: TXNN F,F$LSF ; DID LAST SEARCH FAIL?
SKIPN ESVAL ; AND SEARCH AUTOTYPE FLAG OFF?
JRST (PC) ; YES, SKIP THE SEARCH AUTOTYPE
SETZ ARG, ; TYPE UP TO CURRENT POSITION ON LINE (IE: "0T")
PUSHJ P,TYPEL ; . . .
MOVE C,ESVAL ; FETCH THE SEARCH TYPE CHAR
JUMPLE C,$0TT1 ; DON'T TYPE SEARCH MARKER
CAIGE C,.CHSPC ; IS SEARCH MARKER A CONTROL CHAR?
MOVEI C,.CHLFD ; YES, SUBSTITUTE A <LF>
PUSHJ P,TCHR ; TYPE THE SEARCH MARKER CHAR
$0TT1: MOVEI ARG,1 ; TYPE REST OF CURRENT LINE (IE: "T")
PUSHJ P,TYPEL ; . . .
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $A and $P and $PW and $BP
; $A - APPEND NEXT INPUT BUFFER ONTO CURRENT BUFFER
;
; CALL: JSP PC,$$A
; (RETURN)
$A: PUSHJ P,APPEND ; APPEND THE NEXT INPUT PAGE
JRST (PC) ; AND RETURN TO CALLER
; $P - PUNCH CURRENT PAGE AND YANK IN A NEW PAGE
;
; CALL: JSP PC,$$P
; (RETURN)
$P: SETZM PTVAL ;[412] INSURE "." IS CLEARED
PUSHJ P,PUNBUF ; PUNCH "ARG" BUFFERS
JRST (PC) ; AND RETURN TO CALLER
; $PW - PUNCH CURRENT PAGE AND ALWAYS APPEND A FORMFEED
; DOES NOT AFFECT THE PAGE IN ANY WAY
;
; CALL: JSP PC,$$PW
; (RETURN)
$PW: JUMPLE ARG,(PC) ; DO NOTHING IF ARG.LE.0
$PW1: SETZ T4, ; T4:=LOWER BOUND (IE: B)
MOVE T5,@TXTBUF ; T5:=UPPER BOUND (IE: Z)
PUSHJ P,PUNCH ; PUNCH OUT THE ENTIRE BUFFER
MOVEI C,.CHFFD ; FETCH A FORM.FEED CHAR
PUSHJ P,@PCHADR ; AND PUNCH IT
SOJG ARG,$PW1 ; KEEP PUNCHING UNTILL ARG RUNS OUT
JRST (PC) ; ARG RAN OUT. RETURN TO CALLER
; $BP - PUNCH PART OF CURRENT PAGE (BETWEEN TWO BOUNDS)
; DOES NOT AFFECT THE PAGE IN ANY WAY
;
; CALL: JSP PC,$$BP
; (RETURN)
$BP: PUSHJ P,CHK2RG ; CHECK ARGS FOR VALIDITY
MOVE T4,SARG ; T4:=LOWER BOUND
MOVE T5,ARG ; T5:=UPPER BOUND
PUSHJ P,PUNCH ; PUNCH PART OF THE BUFFER
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $Y and $CNP AND $CNY AND $CNU
; $Y - RENDER THE BUFFER AND YANK A NEW BUFFER
;
; CALL: JSP PC,$$Y
; (RETURN)
$Y: MOVE X,PCHFLG ; FETCH FLAGS FOR LAST "EB" OR "EW"
TXNE X,FB$EXE ; /EXECUTE?
JRST SUCRET ; YES, SKIP THE YANK
JUMPLE ARG,SUCRET ; DO NOTHING IF ARG.LE.0
$Y1: PUSHJ P,YANK ; YANK A BUFFER
SOJG ARG,$Y1 ; KEEP YANKING UNTIL ARG RUNS OUT
JRST SUCRET ; ARG RAN OUT. RETURN TO CALLER
; $CNP - PUNCH INPUT FILE TILL SPECIFIED PAGE IS IN BUFFER
;
; CALL: JSP PC,$$CNP ; WITH PAGE # IN "ARG"
; (RETURN)
$CNP: CAMGE ARG,PAGCNT ; ARG BEFORE CURRENT PAGE?
ERROR (PPC) ; YES, ** PAGE PREVIOUS TO CURRENT PAGE **
CAMN ARG,PAGCNT ;[320] CHECK IF ALREADY THERE
JRST (PC) ;[320] YES: RETURN NOW
SOJ ARG, ; ARG:=# FORMFEEDS TO SKIP OVER
$CNP1: CAMG ARG,PAGCNT ; SKIPPED OVER DESIRED # FORMFEEDS?
JRST $CNP2 ; YES, PUNCH THIS BUFFER AND YANK FIRST
SETZ T4, ; PUNCH CURRENT PAGE
MOVE T5,@TXTBUF ; . . .
PUSHJ P,PUNCH ; . . .
MOVEI C,.CHFFD ; FETCH A <FF> CHAR JUST IN CASE
TXNE F,F$FFD ; NEED A <FF>?
PUSHJ P,@PCHADR ; YES, PUNCH THE <FF> AT END OF PAGE
TXNE F,F$EOF ; AT END OF FILE?
JRST $CNP3 ;[354] PAGE NOT FOUND
PUSHJ P,YANK ; NO, READ NEXT PAGE
JRST $CNP1 ; AND SEE IF IT'S THE ONE WE WANT
$CNP2: MOVEI ARG,1 ; PUNCH CURRENT PAGE AND YANK NEXT
JRST $P ; . . .
$CNP3: SETZM PTVAL ;[354] ".":=B (DOES A "J")
SETZM @TXTBUF ;[354] Z:=B (DOES AN "HK")
ERROR (PNF) ;[354] GIVE ERROR MESSAGE
; $CNY - YANK INPUT FILE TILL SPECIFIED PAGE IS IN BUFFER
;
; CALL: JSP PC,$$CNY ; WITH PAGE # IN "ARG"
; (RETURN)
$CNY: CAMGE ARG,PAGCNT ;[327] ARG BEFORE CURRENT PAGE?
ERROR (PPC) ;[327] YES ** PAGE PREVIOUS TO CURRENT PAGE **
CAMN ARG,PAGCNT ;[327] SEE IF ALREADY THERE
JRST (PC) ;[327] YES: RETURN NOW
SOJ ARG, ;[327] ARG:=(PAGE DESIRED-1)
$CNY1: CAMG ARG,PAGCNT ;[327] AT LAST BEFORE?
JRST $CNY2 ;[327] YES: YANK IN LAST
TXNE F,F$EOF ;[327] AT END OF FILE?
ERROR (PNF) ;[327] YES, ** PAGE NOT FOUND **
PUSHJ P,YANK ;[327] YANK IN A PAGE
JRST $CNY1 ;[327] LOOP FOR ANOTHER PAGE
$CNY2: MOVEI ARG,1 ;[327] YANK ONE LAST TIME
JRST $Y1 ;[327] . . .
; $CNU - USETI TO DESIRED BLOCK ON INPUT FILE
;
; CALL: JSP PC,$$CNU ; WITH BLOCK # IN "ARG"
; (RETURN)
$CNU: TXNN F,F$URD ;[333] IS A FILE OPEN FOR INPUT?
CERROR (NFI) ;[333] NO, BALK
USETI INP,(ARG) ;[333] PICK DESIRED BLOCK
MOVEI X,INPBF ;[427] TO BE PLACED IN .JBFF
EXCH X,.JBFF ;[427] GET CURRENT .JBFF AND SAVE TEMP
INBUF INP,C$NBUF ;[427] REND BUFFERS AND MAKE NEW ONES
EXCH X,.JBFF ;[427] RESTORE .JBFF
INPUT INP, ;[427] INPUT A NEW BUFFER
JRST (PC) ;[333] ALL DONE
SUBTTL $XL
; $XL - EXTRACT LINES FROM THE TEXT BUFFER AND STORE IN A Q-REGISTER
;
; CALL: JSP PC,$$XL
; <Q.REGISTER.NAME>
; (RETURN)
$XL: PUSHJ P,EVL2RG ; CONVERT LINE ARG TO CHAR ARGS
SKP ; AND FALL INTO $X
; $X - EXTRACT CHARACTERS FROM THE TEXT BUFFER AND STORE IN A Q-REGISTER
;
; CALL: JSP PC,$$X
; <Q.REGISTER.NAME>
; (RETURN)
$X: PUSHJ P,CHK2RG ; MAKE SURE ARGS ARE OKAY
MOVE T1,ARG ; COMPUTE SIZE OF TEXT BUFFER NEEDED
SUB T1,SARG ; . . .
MOVE T5,T1 ; SAVE # CHARS
ADDI T1,4+T$DATA*5 ; PLUS OVERHEAD WORDS AT BEG OF BUFFER
IDIVI T1,5 ; COMPUTE SIZE IN WORDS
PUSH P,SARG ; SAVE AC SARG
MOVE L,T1 ; . . .
HRLI L,TMPREF ; TMPREF WILL REFERENCE THE TEXT BUFFER
SETZM TMPREF ; CLEAR TMPREF
PUSHJ P,REQM ; ALLOCATE THE TEXT BUFFER
POP P,SARG ; RESTORE AC SARG
MOVE T3,[POINT 7,T$DATA] ; FORM BYTE POINTER TO BUFFER
ADD T3,TMPREF ; . . .
ADDM T5,-T$DATA(T3) ; SAVE # CHARS TO BE PUT IN Q-REGISTER
MOVE T1,SARG ; FETCH START CHAR.ADR
ADDI T1,T$DATA*5 ; SKIP OVER OVERHEAD WORDS
IDIVI T1,5 ; CONVERT TO A BYTE POINTER
HLL T1,CBPTBL-1(T2) ; . . .
ADD T1,TXTBUF ; . . .
; TO BE STORED
$X1: SOJL T5,$X2 ; JUMPE WHEN FINISHED STORING
ILDB C,T1 ; FETCH NEXT CHAR FROM MAIN TEXT BUFFER
IDPB C,T3 ; AND STORE IN Q-REGISTER
JRST $X1 ; AND TRY NEXT CHAR
; STORE COMPLETE. BIND THE TEXT BUFFER TO THE Q-REGISTER NAME
$X2: PUSHJ P,NXTWRD ; FETCH THE Q-REGISTER NAME
MOVE T1,N ; AND COPY INTO AC T1
MOVX T2,QB$TXT ; FLAG Q-REGISTER AS A TEXT BUFFER
MOVEI T3,TMPREF ; FETCH ADR OF REFERENCE TO TEXT BUFFER
TXO F,F$REF ; FLAG THAT T3 HAS ADR OF REFERENCE
PUSHJ P,QSTOR ; BIND THE TEXT BUFFER TO THE Q-REGISTER NAME
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $G
; $G - GET THE TEXT CONTAINED IN A Q-REGISTER AND INSERT IN BUFFER
;
; CALL: JSP PC,$$G
; <Q.REGISTER.NAME>
; (RETURN)
$G: PUSHJ P,NXTWRD ; FETCH THE Q-REGISTER NAME
MOVE T1,N ; AND COPY INTO AC T1
PUSHJ P,QGET ; GET THE Q-REGISTER
CERROR (NTQ) ; ** NO TEXT IN Q-REGISTER **
TXNN T2,QB$TXT ; IS THERE TEXT IN THE Q-REGISTER?
CERROR (NTQ) ; ** NO TEXT IN Q-REGISTER **
MOVEI N,(T3) ; FETCH THE TEXT BUFFER ID FOR Q-REGISTER
MOVEI L,TMPRFG ; TMPRFG WILL REFERENCE THE TEXT BUFFER
PUSHJ P,FNDBLK ; FIND THE BLOCK WITH THE ID
ERROR (XXX) ; SHOULDN'T OCCUR. ** CAN'T FIND Q-REGISTER **
HRRZ T1,@TMPRFG ; FETCH THE # CHARS IN Q-REGISTER
PUSHJ P,MKROOM ; AND MAKE ROOM FOR THEM
MOVE T5,T1 ; T5:=# CHARS IN Q-REGISTER
MOVE T3,[POINT 7,T$DATA] ; FORM BYTE POINTER TO Q-REGISTER IN T3
ADD T3,TMPRFG ; . . .
MOVE T1,PTVAL ; FETCH VALUE OF "."
ADDI T1,T$DATA*5 ; SKIP OVER OVERHEAD WORDS
IDIVI T1,5 ; CONVERT TO A BYTE POINTER
HLL T1,CBPTBL-1(T2) ; . . .
ADD T1,TXTBUF ; . . .
ADDM T5,PTVAL ; SET NEW VALUE OF "."
; INSERT THE TEXT FROM THE Q-REGISTER INTO THE MAIN TEXT BUFFER
$G1: SOJL T5,$G2 ; JUMP IF DONE
ILDB C,T3 ; FETCH NEXT CHAR FROM Q-REGISTER
IDPB C,T1 ; AND INSERT INTO TEXT BUFFER
JRST $G1 ; AND TRY FOR NEXT CHAR
; INSERTION COMPLETE. UNBIND THE Q-REG. TEXT BUFFER FROM TMPRFG
$G2: MOVE X,TMPRFG ; FETCH THE ADR OF Q-REG. TEXT BUFFER
HRRZS B$2PTR(X) ; AND UNBIND FROM TMPRFG
JRST (PC) ; RETURN TO CALLER
SUBTTL FAIRET and SUCRET
; FAIRET - RETURN ZERO IF COMMAND FAILED
FAIRET: SETZ VALUE, ; SET VALUE:=0
JRST (PC) ; AND RETURN TO CALLER
; SUCRET - RETURN -1 IF COMMAND SUCCEEDED
SUCRET: SETO VALUE, ; SET VALUE:=-1
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $M
; $M - COMPILE AND EXECUTE THE TEXT OF A Q-REGISTER
;
; CALL: JSP PC,$$M
; <Q-REG-NAME>
; (RETURN)
$M: PUSHJ P,NXTWRD ; FETCH THE Q-REG-NAME
MOVE T1,N ; AND COPY INTO AC T1
PUSH P,T1 ;[312] SAVE Q-REG. NAME
PUSHJ P,QGET ; GET INFO ON THE Q-REGG
CERROR (NTQ) ; ** NO TEXT IN Q-REGISTER **
TXNN T2,QB$TXT ; IS THERE TEXT IN Q-REGISTER?
CERROR (NTQ) ; ** NO TEXT IN Q-REGISTER **
MOVE L,T1 ; PUT Q-REG-NAME IN AC L
MOVE N,T3 ; PUT BUFFER ID IN AC N
TXZ F,F$CMP ; CLEAR THE "COMPILE" FLAG
TXNN T2,QB$CMP ; NEED TO COMPILE THE Q-REGISTER?
TXO F,F$CMP ; YES, SET THE "COMPILE" FLAG
PUSHJ P,MACRO ; NOW COMPILE&EXECUTE THE MACRO
POP P,T1 ;[312] GET Q-REG. NAME
PUSHJ P,QFIND ;[312] FIND THE Q-REG.
ERROR (XXX) ;[312] WHAT???
MOVX X,QB$CMP ;[312] FETCH THE "COMPILED" BIT
IORM X,Q$BIT(T5) ;[312] AND SET FOR THIS Q-REG.
JRST SUCRET ; GIVE SUCCESS RETURN TO CALLER
SUBTTL $EC and $ECS and $TTY
; $EC - RETURN THE NUMBER OF WORDS IN THE LOWSEGMENT (IE: .JBFF-1)
;
; CALL: JSP PC,$$EC
; (RETURN) ; WITH SIZE IN AC 'VALUE'
$EC: PUSHJ P,GARCOL ; GARBAGE COLLECT FIRST
MOVE VALUE,.JBFF ; FETCH SIZE OF LOWSEG+1
SOJA VALUE,(PC) ; COMPUTE LOWSEG SIZE AND RETURN TO CALLER
; $ECS - SET THE LOWSEGMENT SIZE (.JBCOR AND .JBREL)
;
; CALL: JSP PC,$$ECS ; WITH # WORDS IN AC 'ARG'
; (RETURN)
; COMPRESS THE TEXT BUFFER TO MAX(C$TBLN,(C$FILB/(C$FILB-1)*Z+4)/5)
; THEN GARBAGE COLLECT
; AND THEN SET OUR LOWSEG SIZE
$ECS: MOVE T1,@TXTBUF ; FETCH Z
IMULI T1,C$FILB ; COMPUTE C$FILB*Z
IDIVI T1,C$FILB-1 ; COMPUTE C$FILB/(C$FILB-1)*Z
ADDI T1,4 ; COMPUTE C$FILB/(C$FILB-1)*Z+4
IDIVI T1,5 ; COMPUTE (C$FILB/(C$FILB-1)*Z+4)/5
CAIGE T1,C$TBLN ; COMPUTE MAX OF ^ AND C$TBLN (ASSUME ^)
MOVEI T1,C$TBLN ; C$TBLN IS THE MAX
MOVE X,TXTBUF ; FETCH ADR OF TEXT BUFFER
HLRZ N,B$1PTR(X) ; FETCH ADR OF END+1 OF TEXT BUFFER
SUBI N,T$DATA(X) ; COMPUTE # WORDS IN TEXT BUFFER
SUBI N,(T1) ; COMPUTE # WORDS TO COMPRESS OUT
MOVEI L,TXTBUF ; FETCH ADR OF TEXT BUFFER REF
PUSHJ P,COMPRS ; AND COMPRESS THE TEXT BUFFER TO MIN SIZE
PUSHJ P,GARCOL ; PERFORM A GARBAGE COLLECTION
; SET OUR CORE SIZE
MOVEI X,(ARG) ; FETCH REQUESTED CORE SIZE
CAMGE X,.JBFF ; NOT TOO SMALL?
JRST $ECS1 ; HOLD ON! PRESERVE EXISTING LOWSEG!
CORE X, ; ASK THE SYSTEM FOR THE CORE
JRST $ECS2 ; FAILED. GET AS MUCH AS WE CAN
; STORE INFO ABOUT OUR SIZE IN JOBDAT
$ECS1: MOVE X,.JBREL ; FETCH OUR NEW SIZE
HRLI X,(X) ; FORM <SIZE,,SIZE>
MOVEM X,.JBCOR ; AND STORE IN .JBCOR
HRLM X,.JBSA ; SET OUR SIZE IN CASE OF A RESET
JRST (PC) ; AND RETURN TO CALLER
; CORE MUUO FAILED. GET AS MUCH CORE AS WE CAN
$ECS2: LSH X,^D10 ; CONVERT # K TO WORDS
SOJ X, ; CONVERT TO A "HIGHEST ADDR"
HRRZ T1,.JBHRL ; FETCH SIZE OF HIGH SEGMENT
IORI T1,1777 ; AND CONVERT TO "HIGHEST ADDR"
SUBI X,(T1) ; COMPUTE MAX LOWSEG SIZE
CORE X, ; AND ASK THE SYSTEM FOR IT
JFCL ; (WHY SHOULD IT FAIL?)
JRST $ECS1 ; GOT IT. STORE INFO AND RETURN
; $TTY - RETURN TTY#+^O200000 FOR JOB N
;
; CALL: JSP PC,$$TTY
; (RETURN) ; WITH TTY#+^O200000 IN AC VALUE
$TTY: MOVE VALUE,ARG ;[306] FETCH THE ARG
TRMNO. VALUE, ;[306] ASK MONITOR FOR TTY#+^O200000
SETZ VALUE, ;[306] FAILED - RETURN ZERO
JRST (PC) ;[306] AND RETURN TO CALLER
SUBTTL $GTB and $PEK - GETTAB and PEEK
; $GTB - PERFORM A GETTAB MUUO FOR USER
;
; CALL: JSP PC,$$GTB
; (RETURN) ; WITH GETTAB RESULT IN AC 'VALUE'
$GTB: HRLI ARG,(SARG) ; FORM GETTAB MUUO ARGUMENT
GETTAB ARG, ; ASK MONITOR FOR INFORMATION
TDZA VALUE,VALUE ; FAILED, RETURN ZERO
MOVE VALUE,ARG ; PUT RESULT IN AC 'VALUE'
JRST (PC) ; AND RETURN TO CALLER
; $PEK - PERFORM A PEEK MUUO FOR USER
;
; CALL: JSP PC,$$PEK
; (RETURN) ; WITH RESULT IN AC 'VALUE'
$PEK: PEEK ARG, ; ASK MONITOR FOR THE INFORMATION
MOVE VALUE,ARG ; PUT RESULT IN AC 'VALUE'
JRST (PC) ; AND RETURN TO CALLER
SUBTTL $ER and $EW and $EF and $ED
; $ER - SETUP A FILE FOR INPUT
;
; CALL: JSP PC,$$ER
; <FILE.SPEC>
; (RETURN)
$ER: MOVE X,FS$FLG(PC) ; FETCH FILE-SPEC FLAGS
TXNE X,FB$EXE ; /EXECUTE?
JRST $EI ; YES DO AN "EI"
MOVEI L,LERSPC ; FETCH ADR OF "ER" FILE-SPEC
PUSHJ P,SETFSP ; FILL IN THE DEFAULTS
PUSHJ P,OPENRD ; AND OPEN THE FILE FOR READING
PUSHJ P,SETRAD ; SET THE ADR OF THE READ-A-CHAR ROUTINE
JRST SUCRET ; AND RETURN TO CALLER
; $EW - SETUP A FILE FOR OUTPUT
;
; CALL: JSP PC,$$EW
; <FILE.SPEC>
; (RETURN)
$EW: MOVE X,FS$FLG(PC) ; FETCH FILE-SPEC FLAGS
TXNE X,FB$EXE ; /EXECUTE?
JRST $EI ; YES, DO AN "EI" INSTEAD OF "EW"
TXNE F,F$UBK ; "EB" IN PROGRESS?
CERROR (EBO) ; YES, ** EW WHEN EB IN PROGRESS **
MOVEI L,LEWSPC ; FETCH ADR OF "EW" FILE-SPEC
PUSHJ P,SETFSP ; FILL IN THE DAFAULTS
PUSHJ P,OPENWR ; AND OPEN THE FILE FOR WRITING
PUSHJ P,SETWAD ; SET THE ADR OF THE WRITE-A-CHAR ROUTINE
JRST SUCRET ; AND RETURN TO CALLER
; $EF - CLOSE OUTPUT FILE
;
; CALL: JSP PC,$$EF
; (RETURN)
$EF: TXZE F,F$UBK ; "EB" IN PROGRESS?
PUSHJ P,BAKCLS ; YES, FINISH IT
RELEAS OUT, ; RELEASE THE OUTPUT CHANNEL
TXZ F,F$UWR ; NO LONGER WRITING TO A FILE
MOVEI X,NOOF ;[304] FETCH ADR FOR NO OUTPUT FILE
MOVEM X,PCHADR ;[304] TO PREVENT ILL. UUOS
JRST (PC) ; RETURN TO CALLER
; NOOF - COME HERE WHEN WE WANT TO PUNCH A CHAR BUT NO OUTPUT FILE
NOOF: ERROR (NFO) ;[304] ** NO OUTPUT FILE **
; $ED - SETUP FILE TO BE RUN ON EXIT
;
; CALL: JSP PC,$$ED
; <FILE.SPEC>
; (RETURN)
$ED: MOVEM ARG,RUNOFS ; STORE /RUNOFFSET:N
MOVEI L,LEDSPC ; FETCH ADR OF LAST "ED" FILE-SPEC
PUSHJ P,SETFSP ; AND FILL IN THE DEFAULTS
TXO F,F$EDC ; FLAG THAT WE MUST RUN A PROG. ON EXIT
JRST SUCRET ; AND RETURN TO CALLER
SUBTTL $EB
; $EB - SETUP A FILE FOR EDITING WITH BACKUP PROTECTION
;
; CALL: JSP PC,$$EB
; <FILE.SPEC>
; (RETURN)
$EB: MOVE X,FS$FLG(PC) ; FETCH FILE-SPEC FLAGS
TXNE X,FB$EXE ; /EXECUTE?
JRST $EI ; YES, DO AN "EI" INSTEAD OF "EB"
TXNE F,F$UBK ; "EB" ALREADY IN PROGRESS?
CERROR (EBO) ; YES, F;ERROR
; SETUP THE EB FILESPEC
MOVEI L,LEBSPC ; FETCH ADR OF THE EB FILESPEC
PUSHJ P,SETFSP ; AND FILL IT IN
; MAKE SURE DEVICE IS A IDSK OR DECTAPE (OR OTHER DIRECTORY DEVICE)
MOVE X,FS$DEV(L) ; FETCH THE DEVICE NAME
DEVCHR X, ; AND FIND ITS CHARACTERISTICS
TXNN X,DV.DIR ; IS IT A DIRECTORY DEVICE?
CERROR (EBD) ; NO, ** EB FOR DEVICE IS ILLEGAL **
; MAKE SURE FILNAME IS NOT ###XTC.TMP OR EXTENSION .BAK
MOVE T5,FS$NAM(L) ; FETCH THE FILE NAME
HLRZ T1,FS$EXT(L) ; FETCH THE FILE EXTENSION
CAMN T5,CCJNAM ; IS FILE NAME '###XTC'?
CAIE T1,'TMP' ; AND EXTENSION .TMP?
CAIN T1,'BAK' ; OR EXTENSION .BAK?
CERROR (EBF) ; YES, ** ILLEGAL EB FILENAME **
; SELECT THE FILE FOR READING
PUSHJ P,OPENRD ; SELECT FILE FOR INPUT
; IF PPN IS NOT OURS, JUST DO ER-EW SEQUENCE
PUSHJ P,GETPTH ;[342] FETCH MY PATH
MOVE T1,RBSPC+.RBPPN ; GET PPN OR ADDRESS THEREOF
JUMPE T1,$EB1 ; DEFAULT PPN IS ALWAYS MINE
TXNN T1,LH.ALF ; A PPN?
MOVE T1,2(T1) ; NO AN ADDRESS--GET THE PPN
CAME X,T1 ; SAME AS THAT OF FILE?
JRST $EB2 ; NO, JUST DO ER-EW SEQUENCE
; SETUP THE FILESPEC FOR THE TEMP FILE
$EB1: MOVE T1,[<LEBSPC,,FILSPC>] ; COPY INPUT SPEC FOR TEMP FILE
BLT T1,FILSPC+FS$LTH-1 ; . . .
; PUT TEMP FILE ON SAME FILE-STRUCTURE AS INPUT FILE
MOVE X,RBSPC+.RBDEV ; FETCH THE FS OF INPUT FILE
ANDCMI X,'__' ; MASK TO FIRST 4 CHARS
MOVEM X,FILSPC+FS$DEV ; AND USE AS DEVICE FOR TEMP FILE
; FILENAME FOR TEMP FILE IS ###XTC
MOVE X,CCJNAM ; FETCH CCL JOB NAME
MOVEM X,FILSPC+FS$NAM ; SET FILENAME FOR TEMP FILE TO ###XTC
; FILE EXTENSION FOR TEMP FILE IS 'TMP'
MOVSI X,'TMP' ; FETCH THE TEMP FILE EXTENSION
MOVEM X,FILSPC+FS$EXT ; AND STORE IT
; USE FILE PROTECTION OF INPUT FILE FOR OUTPUT FILE
; UNLESS PROTECTION WAS SPECIFIED IN FILESPEC
LDB X,[POINT 9,RBSPC+.RBPRV,8] ; FETCH PROT. OF INPUT FILE
MOVE T1,LEBSPC+FS$FLG ; FETCH FILE SPEC FLAGS
TXNN T1,FB$PRV ; /PROTECT:NNN SPECIFIED?
DPB X,[POINT 9,LEBSPC+FS$PRV,8] ; NO, SAVE PROT OF INPUT FILE
; MAKE SURE WE CAN RENAME INPUT FILE
CAIL X,<300> ; CAN WE RENAME THE FILES?
CERROR (EBP) ; NO, ** EB PROTECTED FILES **
DPB X,[POINT 9,LEBSPC+FS$PRV,8] ; SAVE PROTECTION FOR LATER
MOVEI X,C$TPRV ; FETCH THE PROT. FOR TEMP FILE
DPB X,[POINT 9,FILSPC+FS$PRV,8] ; SET PROT. FOR TEMP FILE
; OPEN THE TEMP FILE
MOVSI N,(<Z OUT,>) ; FETCH THE OUTPUT CHANNEL
MOVSI M,OUTBH ; FETCH ADR OF OUTPUT BUFFER HEADER
MOVEI L,FILSPC ; FETCH ADR OF FILE SPEC
PUSHJ P,FILOPN ; OPEN THE TEMP FILE
CERROR (ODV) ; ** OUTPUT OPEN FAILURE **
; SET THE ESTIMATED SIZE OF THE TEMP FILE TO THE SIZE OF INPUT FILE
MOVE M,RBSPC+.RBSIZ ; FETCH SIZE OF INPUT FILE
LSH M,-7 ; CONVERT TO BLOCKSIZE
AOJ M, ; AND ROUND UP
; ENTER THE TEMP FILE
PUSHJ P,FILENT ; ENTER THE TEMP FILE
CERROR (ENT) ; ** ENTER FAILURE **
IFN 0,<; DON'T USE THIS UNLESS DATE75 KLUDGE INSERTED!!!
; SAVE CREATION DATE
LDB X,[POINT 23,RBSPC+.RBPRV,35] ; FETCH CREATION INFO
DPB X,[POINT 27,LEBSPC+FS$PRV,35] ; AND SAVE FOR LATER>
; DONE WITH "EB" SETUP
TXO F,F$UBK!F$UWR!F$URD ; FLAG THAT "EB" IN PROGRESS
; AND THAT WE ARE READING AND WRITING
PUSHJ P,SETRAD ; SET ADR OF READ-A-CHAR ROUTINE
PUSHJ P,SETWAD ; SET ADR OF WRITE-A-CHAR ROUTINE
JRST (PC) ; AND RETURN TO CALLER
; FILE NOT IN OUR UFD. JUST DO ER-EW SEQUENCE
$EB2: MOVE X,[<LEBSPC,,LERSPC>] ; COPY EB SPEC TO ER SPEC
BLT X,LERSPC+FS$LTH-1 ; . . .
MOVE X,[<LEBSPC,,LEWSPC>] ; COPY EB SPEC TO EW SPEC
BLT X,LEWSPC+FS$LTH-1 ; . . .
MOVSI X,'DSK' ;[355] BACK TO DSK:
MOVEM X,LEWSPC+FS$DEV ;[355] . . .
PUSHJ P,GETPTH ;[355] GET MY PATH(NO, NOT THE TRAINS!(HA-HA!))
MOVEM X,LEWSPC+FS$PPN ;[355] POINT TO ME, NOT TO HIM(HER?)
; SELECT THE INPUT FILE FOR READING
MOVEI L,LERSPC ; FETCH ADR OF ER FILESPEC
PUSHJ P,OPENRD ; AND SELECT IT FOR READING
PUSHJ P,SETRAD ; SET THE ADR OF THE READ-A-CHAR ROUTINE
; SELECT THE OUTPUT FILE FOR WRITING
MOVEI L,LEWSPC ;[355] SELECT ADR OF EW FILESPEC
PUSHJ P,OPENWR ; SELECT OUTPUT FILE FOR READING
PUSHJ P,SETWAD ; AND SET ADR OF PUNCH-A-CHAR ROUTINE
; DONE. RETURN TO CALLER
JRST SUCRET ; GIVE SUCCESS RETURN TO CALLER
SUBTTL $EA
; $EA - SETUP FOR APPENDING TO A FILE (OUTPUT)
;
; CALL: JSP PC,$$EA
; <FILE.SPEC>
; (RETURN)
$EA: TXNE F,F$UBK ; "EB" IN PROGRESS?
CERROR (EBO) ; YES, ** EA WHEN EB IN PROGRESS **
MOVEI L,LEWSPC ; FETCH ADR OF LAST "EW" FILE SPEC
PUSHJ P,SETFSP ; AND FILL IN PARTS
TXZ F,F$UWR ; FLAG THAT NO FILE FOR OUTPUT
MOVSI N,(<Z OUT,>) ; SETUP OUTPUT CHANNEL
MOVSI M,OUTBH ; SETUP ADR OF OUTPUT BUFFER HEADER
PUSHJ P,FILOPN ; OPEN THE OUTPUT DEVICE
CERROR (ODV) ; ** OPEN FAILURE FOR OUTPUT DEVICE **
SETZ T5, ; CLEAR "NO USETI NEEDED" FLAG
PUSHJ P,FILLKP ; LOOKUP THE OUTPUT FILE
SETO T5, ; FLAG THAT USETI NOT NEEDED
PUSHJ P,FILENT ; ENTER THE OUTPUT FILE
CERROR (ENT) ; ** ENTER FAILURE **
JUMPN T5,.+2 ; IF LOOKUP FAILED, NO USETI NEEDED
USETI OUT,-1 ; POSITION TO END OF FILE FOR APPENDING
TXO F,F$UWR ; FLAG THAT A FILE IS NOW READY FOR OUTPUT
PUSHJ P,SETWAD ; SET THE ADR OF PUNCH-A-CHAR ROUTINE
JRST SUCRET ; AND GIVE SUCCESS RETURN TO CALLER
SUBTTL $EI
; $EI - EXECUTE AN INDIRECT FILE AS A COMMAND STRING
;
; CALL: JSP PC,$$EI
; <FILE.SPEC>
; (RETURN)
$EI: MOVEI L,LEISPC ; FETCH ADR OF "EI" FILE-SPEC
PUSHJ P,SETFSP ; AND FILL IN DEFAULTS
SETZ N, ;[371] USE CHANNEL 0
MOVEI M,INIBH ;[371] FETCH ADDR OF BUFFER HEADER
PUSHJ P,FILOPN ;[371] OPEN THE DEVICE
CERROR (IDV) ;[371] ** INPUT DEVICE OPEN FAILURE **
PUSHJ P,FILLKP ;[371] FIND THE FILE
PUSHJ P,$EI1 ;[371] COULDN'T, TRY IT ON TED:
PUSHJ P,FILERD ; AND READ THE FILE INTO A BUFFER
PUSH P,N ; SAVE THE BUFFER ID
MOVE L,['[EICM]'] ; GIVE THE COMMAND A NAME
TXO F,F$CMP ; FORCE COMPILATION
PUSHJ P,MACRO ; AND COMPILE&EXECUTE THE MACRO
POP P,N ; RESTORE THE BUFFER ID
PUSHJ P,DELBLK ; AND DELETE THE BUFFER
JRST SUCRET ; AND GIVE SUCCESS RETURN TO CALLER
$EI1: SETZM LEWSPC+FS$PPN ;[371] IGNORE PPN NOW
MOVSI X,'TED' ;[371] TRY THE TECO MACRO LIBRARY
MOVEM X,LEISPC+FS$DEV ;[371] SET IT FOR TRY
POPJ P, ;[371] RETURN TO TRY IT
SUBTTL $EL AND $ELA
; $EL - MAKE A LOG FILE
;
; CALL: JSP PC,$$EL
; <FILE.SPEC>
; (RETURN)
$EL: MOVEI L,LELSPC ;[330] FETCH ADR OF "EL" FILE-SPEC
PUSHJ P,SETFSP ;[330] AND FILL IN DEFAULTS
MOVSI N,(<Z LOG,0>) ;[330] FETCH THE LOG CHANNEL
MOVSI M,LOGBH ;[330] SETUP ADR OF LOG BUFFER HEADER
PUSHJ P,FILOPN ;[330] OPEN THE LOG DEVICE
CERROR (LDV) ;[330] ** OPEN FAILURE **
MOVE X,FS$FLG(L) ;[330] LOAD FLAGS
SETZ T5, ;[356] SAY USETI IS COOL
TXNE X,FB$APP ;[330] APPEND?
PUSHJ P,FILLKP ;[330] YES, ENTER UPDATE MODE
SETO T5, ;[330] EITHER NO APPEND OR NO FILE
SETZ M, ;[330] DON'T ESTIMATE ANY SIZE
PUSHJ P,FILENT ;[330] ENTER FILE
CERROR (LFE) ;[330] ** ENTER FAILURE **
MOVE X,FS$FLG(L) ;[330] GET LOG FLAGS
TXNN X,FB$NOO!FB$NOI ;[330] SEE IF ANY ON
TXO X,FB$NOO!FB$NOI ;[330] NO, TURN ALL ON
CAIE T5, ;[356] IS USETI COOL?
TXZ X,FB$APP ;[356] NO, THE NARCS GOT AHOLD OF IT
TXZE X,FB$APP ;[330] APPEND?
USETI LOG,-1 ;[330] YES, APPEND TO PREVIOUS FILE
MOVEM X,FS$FLG(L) ;[330] SAVE LOG FLAGS
TXO F,F$LOG ;[330] INDICATE LOG FILE TO WRITE TO
JRST SUCRET ;[330] SUCESSFUL RETURN
; $ELA - ALTER LOG FILE PARAMETERS
;
; CALL: JSP PC,$$ELA
; <FILE.SPEC>
; (RETURN)
$ELA: CAIL ARG, ;[330] CHECK ARG FOR VALIDITY(0.LE.ARG.LEL3)
CAILE ARG,3 ;[330] . . .
CERROR (ILS) ;[330] ** ILLEGAL EL SPECIFICATION **
TXNN F,F$LOG ;[330] SEE IF LOG FILE OPEN
CERROR (NLF) ;[330] ** NO LOG FILE OPEN **
MOVE X,LELSPC+FS$FLG ;[330] LOAD LOG FILE SPECS
TXZ X,FB$NOO!FB$NOI ;[330] ZERO FLAGS
TXNE ARG,1 ;[330] SEE IF ODD
TXO X,FB$NOI ;[330] YES, /NOIN AT LEAST
TXNE ARG,2 ;[330] SEE IF /NOOUT
TXO X,FB$NOO ;[330] YES
MOVEM X,LELSPC+FS$FLG ;[330] SAVE FLAG SPECS
JRST SUCRET ;[330] GIVE SUCCESS RETURN
SUBTTL $EN
; $EN - RENAME CURRENT INPUT FILE
;
; CALL: JSP PC,$$EN
; <FILE.SPEC>
; (RETURN)
$EN: STORE (X,FILSPC,FILSPC+FS$LTH-1,0) ; CLEAR 'FILSPC' AREA
MOVEI L,FILSPC ; FETCH ADR OF NULL FILE-SPEC
PUSHJ P,SETFSP ; AND FILL IN PARTS
TXNE F,F$UBK ; "EB" IN PROGRESS?
CERROR (EBO) ; YES, ** EB IN PROGRESS **
TXNN F,F$URD ; "ER" IN PROGRESS?
CERROR (ENO) ; NO, ** NO DEVICE OPEN FOR INPUT **
MOVE X,FILSPC+FS$FLG ; FETCH FILE-SPEC FLAGS
TXNE X,FB$DEV ; SPECIFY A DEVICE?
CERROR (END) ; YES, ** ILLEGAL DEVICE **
MOVE N,[Z INP,] ; FETCH THE INPUT CHANNEL
PUSHJ P,FILRNM ; AND PERFORM THE RENAME
JRST $ENREE ; RENAME FAILED
RELEAS INP, ; CLOSE THE FILE
TXZ F,F$URD ; AND CLEAR THE "ER" FLAG
JRST SUCRET ; AND GIVE SUCCESS RETURN TO CALLER
$ENREE: RELEAS INP, ; RELEAS THE INPUT CHANNEL
TXZ F,F$URD ; NO LONGER READING A FILE
TXNE F,F$COL ; IS THIS A ":" COMMAND?
JRST FAIRET ; YES, RETURN TO CALLER
CERROR (RNF) ; NO, ** RENAME FAILURE **
SUBTTL $EP
; $EP - READ A FILE INTO Q-REGISTER "*"
;
; CALL: JSP PC,$$EP
; <FILE.SPEC>
; (RETURN)
$EP: MOVEI L,LEISPC ; FETCH ADR OF LAST "EP"(IE: "EI") FILE SPEC
PUSHJ P,SETFSP ; AND FILL IN PARTS
PUSHJ P,FILERD ; READ THE FILE INTO A BUFFER
MOVSI T1,'* ' ; FETCH NAME OF Q-REGISTER "*"
MOVX T2,QB$TXT ; SET THE "TEXT" BIT
MOVE T3,N ; FETCH THE BUFFER ID
TXZ F,F$REF ; FLAG THAT T3 HAS A BUFFER ID
PUSHJ P,QSTOR ; AND STORE BUFFER IN Q-REGISTER
JRST SUCRET ; AND GIVE SUCCESS RETURN TO CALLER
SUBTTL $EM and $EZ
; $EM - PERFORM MAGTAPE OPERATIONS
;
; CALL: JSP PC,$$EM
; (RETURN)
$EM: TXNE F,F$UBK ; "EB" IN PROGRESS?
CERROR (EBO) ; YES, ** EB IN PROGRESS **
TXNN F,F$URD ; "ER" IN PROGRESS?
CERROR (EMD) ; NO, ** NO DEVICE SELECTED FOR EM **
CAIGE ARG,1 ; IS OPCODE LEGAL?
CERROR (EMA) ; NO, ** ILLEGAL MAGTAPE OP **
MTAPE INP,(ARG) ; YES, PERFORM THE MAGTAPE OPERATION
MOVEI L,LERSPC ; FETCH THE ADR OF LAST "ER" FILSPC
MOVE N,[Z INP,] ; FETCH THE I/O CHANNEL
MOVEI M,INPBH ; FETCH THE ADR OF THE INPUT BUFFER HEADER
PUSHJ P,FILOPN ; AND OPEN THE INPUT DEVICE AGAIN
CERROR (IEM) ; CAN'T, ** OPEN FAILURE FOR INPUT DEVICE **
JRST SUCRET ; DONE. RETURN TO CALLER
; $EZ - CLEAR DECTAPE DIRECTORY AND DO AN "EW" FOR FILE
;
; CALL: JSP PC,$$EZ
; <FILE.SPEC>
; (RETURN)
$EZ: TXNE F,F$UBK ; "EB" IN PROGRESS?
CERROR (EBO) ; YES, ** EB IN PROGRESS **
MOVEI L,LEWSPC ; FETCH ADR OF LAST "EW" FILE-SPEC
PUSHJ P,SETFSP ; AND FILL IN PARTS
MOVE N,[Z OUT,] ; FETCH OUTPUT CHANNEL
MOVSI M,OUTBH ; FETCH ADR OF OUTPUT BUFFER HEADER
PUSHJ P,FILOPN ; AND OPEN THE OUTPUT DEVICE
CERROR (ODV) ; CAN'T, ** OPEN FAILURE FOR OUTPUT DEVICE **
UTPCLR OUT, ; CLEAR THE DECTAPE DIRECTORY
MTREW. OUT, ; REWIND THE DECTAPE
PUSHJ P,OPENWR ; RE-OPEN AND ENTER THE FILE
JRST SUCRET ; AND GIVE SUCCESS RETURN TO CALLER
SUBTTL $EE
; $EE - WRITE OUT LOWSEG AS A ZERO-COMPRESSED SAVE FILE (RUNNABLE)
;
; CALL: JSP PC,$$EE
; <FILE-SPEC>
; (RETURN)
$EE: MOVEI L,LEESPC ; FETCH ADR OF FILE-SPEC
PUSHJ P,SETFSP ; AND FILL IN DEFAULTS
PUSH P,.JBSA ; SAVE .JBSA
PUSH P,.JBCOR ; SAVE .JBCOR
PUSH P,X ; MAKE SURE ENOUGH ROOM ON STACK
PUSH P,X ; . . .
PUSH P,X ; . . .
PUSH P,X ; . . .
POP P,X ; . . .
POP P,X ; . . .
POP P,X ; . . .
POP P,X ; . . .
; REDUCE SIZE BY FORCING A GARBAGE COLLECTION
PUSHJ P,GARCOL ; GARBAGE COLLECT
; STORE .JBFF IN .JBSA AND .JBCOR AND CHANGE START ADR TO 'RUNENT'
MOVEI X,RUNENT ; FETCH NEW START ADR
MOVEM X,.JBSA ; AND STORE IN .JBSA
MOVE X,.JBFF ; FETCH .JBFF
HRLM X,.JBSA ; AND STORE IN .JBSA
HRLI X,(X) ; PUT .JBFF IN BOTH HALVES OF .JBCOR
HLRZ T1,.JBCOR ; FETCH .JBCOR
CAIGE T1,(X) ; NEED TO SET .JBCOR?
MOVEM X,.JBCOR ; YES, SET .JBCOR
; SAVE FLAGS AND ACS FOR RESTORATION ON NEXT RUN
MOVE T1,F ; FETCH FLAGS
TXZ T1,F$$IO ; AND CLEAR I/O FLAGS
MOVEM T1,ACSAVE ; AND SAVE FOR NEXT RUN
PUSH P,.JBDDT ; STORE DDT START ADR
PUSH P,[<$EECON>] ; STORE ADR OF WHERE TO GO AFTER RUN&GETSEG
MOVE 1,[<2,,ACSAVE+2>] ; SETUP BLT POINTER
BLT 1,ACSAVE+17 ; AND SAVE ACS FOR NEXT RUN
; INIT DSK:FILE.SAV[,]
SETZ N, ; USE CHANNEL 0
MOVSI M,INIBH ; FETCH ADR OF INPUT BUFFER HEADER
PUSHJ P,FILOPN ; OPEN THE DEVICE ('DSK')
CERROR (ODV) ; ** OUTPUT DEVICE OPEN FAILURE **
PUSHJ P,FILENT ; ENTER THE FILE (FILE.SAV[,])
CERROR (ENT) ; ** ENTER ERROR **
SETSTS .IOIBN ; CHANGE TO IMAGE BINARY MODE
MOVEI X,(POINT 36,) ; FETCH PROPER BYTE SIZE
HRLM X,INIBH+1 ; AND SET IT IN BUFFER HEADER
; NOW WRITE OUT THE FILE IN ZERO-COMPRESSED FORMAT
MOVEI N,.JBPFI+1 ; WHEN TO START SAVING
$EE1: SKIPN (N) ; FIND A NON-ZERO?
JSP L,$EE5 ; NO, TRY NEXT WORD
CAML N,.JBFF ; YES, AT END OF CORE?
JRST $EE2 ; YES, DONE
; FOUND A NON-ZERO WORD. COUNT # CONSECUTIVE NON-ZERO AND WRITE OUT
MOVE M,N ; SAVE AC N
SKIPE (N) ; FIND A ZERO?
JSP L,$EE5 ; NO, KEEP LOOKING
SUBM M,N ; YES, COMPUTE # CONSECUTIVE
MOVS N,N ; AND FORM AN IOWD
HRRI N,-1(M) ; FORM: IOWD LEN,,ADR
PUSHJ P,$EE3 ; AND WRITE OUT THE IOWD
MOVE C,N ; SAVE CURRENT ADR
MOVE N,1(C) ; FETCH A NON-ZERO DATA WORD
PUSHJ P,$EE3 ; WRITE OUT A WORD OF DATA
AOBJN C,.-2 ; AND DO FOR ALL CONSECUTIVE NON-ZEROS
MOVEI N,1(C) ; COMPUTE ADR OF WHERE TO START
; SEARCH FOR NEXT NON-ZERO DATA
CAMGE N,.JBFF ; ARE WE DONE?
JRST $EE1 ; NO, KEEP GOING
; DONE. FINISH UP.
$EE2: MOVE N,[JRST RUNENT] ; FETCH INST. TO START PROGRAM
PUSHJ P,$EE3 ; AND WRITE TO
POP P,X ; CLEAN UP STACK
POP P,X ;[357] . . .
POP P,.JBCOR ; RESTORE .JBCOR
POP P,.JBSA ; AND RESTORE .JBSA
RELEAS 0, ; RELEAS CHANNEL 0
JRST (PC) ; AND RETURN TO CALLER
; OUTPUT ONE WORD TO FILE
$EE3: SOSGE INIBH+2 ; ANY ROOM LEFT IN BUFFER?
JRST $EE4 ; NO, OUTPUT THE BUFFER
IDPB N,INIBH+1 ; YES, STORE THE CHAR IN BUFFER
POPJ P, ; AND RETURN TO CALLER
; OUTPUT BUFFER TO FILE
$EE4: OUT 0, ; OUTPUT THE BUFFER
JRST $EE3 ; AND CONTINUE
GETSTS 0,IOSTS ; FAILED. GET STATUS OF CHANNEL
POP P,X ; CLEAN STACK
POP P,X ; . . .
POP P,.JBCOR ; RESTORE .JBCOR
POP P,.JBSA ; RESTORE .JBSA
ERROR (OUT) ; AND GIVE OUTPUT ERROR MESSAGE
; CHECK IF AC N.GE..JBFF ELSE RETURN .-2
$EE5: CAML N,.JBFF ; .GE..JBFF?
JRST (L) ; YES, JUST NORMAL RETURN
AOJA N,-2(L) ; NO, INCR. N AND RETURN .-2
; $EECON - COME HERE AFTER RUN&GETSEG IN AN "EE" SAVE FILE
$EECNT: RESET ;[320] CLEAR THE WORLD
POP P,X ; RESTORE THE DDT START ADR
SETDDT X, ; . . . (WHAT? YOU'VE NEVER USED 'SETDDT'???)
POP P,.JBCOR ; RESTORE .JBCOR
POP P,.JBSA ; RESTORE .JBSA
MOVE X,[PUSHJ P,UUOTRP] ;[325] RESTORE LUUO TRAP
MOVEM X,.JB41 ;[325] . . .
MOVX X,AP.REN!AP.POV!AP.ILM ; ENABLE APR FOR PDL OV AND ILL MEM REF
APRENB X, ; . . .
PUSHJ P,MAKCJN ; MAKE OUR CCL JOB NUMBER
MOVE X,.JBVER ;[325] FETCH LOWSEG VERSION #
CAME X,.JBHGH+.JBHVR ;[325] COMPARE WITH HISEG VERSION #
ERROR (VAI) ;[311] NO, VERSIONS ARE INCOMPATIBLE
JRST (PC) ; AND CONTINUE WITH WHATEVER WAS
; AFTER THE "EE" COMMAND
SUBTTL $EG and $EX and MONRET
; $EG - PERFORM "EX" AND DO PREVIOUS COMPILE-CLASS MONITOR COMMAND
;
; CALL: JSP PC,$$EG
; (CONTROL IS TRANSFERRED TO SYS:COMPIL)
$EG: MOVSI X,'SYS' ; FETCH SYSTEM DEVICE NAME
MOVEM X,LEDSPC+FS$DEV ; AND STORE IN RUN FILE-SPEC
MOVE X,['COMPIL'] ; FETCH COMPIL'S NAME
MOVEM X,LEDSPC+FS$NAM ; AND STORE IN FILE-SPEC
SETZM LEDSPC+FS$EXT ; CLEAR THE FILE EXTENSION
SETZM LEDSPC+FS$PPN ; AND THE PPN
MOVEI X,1 ; /RUNOFFSET:1
MOVEM X,RUNOFS ; . . .
TXO F,F$EDC ; FLAG THAT A PROGRAM IS TO BE RUN
; JRST $EX ; AND DO THE "EX"
; $EX - PUNCH REST OF INPUT FILE AND EXIT OR RUN A PROGRAM
;
; CALL: JSP PC,$$EX
; (RETURN IF USER TYPES .CONTINUE)
$EX: SKPINL ; PUT USER'S TERMINAL BACK IN .IOASL MODE
JFCL ; . . .
MOVSI ARG,1 ; PUNCH REST OF INPUT FILE
TXNE F,F$UWR ; ANY OUTPUT FILE?
PUSHJ P,PUNBUF ; YES, PUNCH THE REST OF THE INPUT FILE
$EX1: TXNE F,F$UBK ; AN "EB" IN PROGRESS?
PUSHJ P,BAKCLS ; YES, FINISH IT
RELEAS INP, ; RELEAS INPUT AND OUTPUT CHANNELS
RELEAS OUT, ; . . .
RELEAS LOG, ;[330] . . .
TXZ F,F$$IO ;[313] RESET I/O FLAGS
; JRST MONRET ; AND EXIT (OR RUN A PROGRAM)
; MONRET - EXIT TO MONITOR COMMAND LEVEL OR RUN A PROGRAM
MONRET: TXNN F,F$EDC ; RUN A PROGRAM?
JRST MONRT1 ; NO, JUST EXIT
; DO A RUN MUUO ON FILE SPECIFIED IN LAST "ED" COMMAND
MOVE T1,LEDSPC+FS$DEV ; FETCH THE DEVICE NAME
MOVE T2,LEDSPC+FS$NAM ; FETCH THE FILE NAME
MOVE T3,LEDSPC+FS$EXT ; FETCH THE FILE EXTENSION
SETZB T4,T5+1 ; ZERO UNUSED WORDS OF RUN BLOCK
MOVE T5,LEDSPC+FS$PPN ; FETCH THE PPN
MOVEI C,T1 ; SETUP ADR OF RUN BLOCK
HRL C,RUNOFS ; PLUS THE RUNOFFSET
RUN C, ; DO THE RUN MUUO
HALT .-1 ; LET MONITOR DO ERROR PROCESSING
; DO A MONRT. AND CONTINUE IF USER TYPES "CONTINUE"
MONRT1: MONRT. ; RETURN TO MONITOR COMMAND LEVEL
JRST (PC) ; RETURN TO CALLER IF USER TYPES COONTINUE
SUBTTL SSTPSC - Prescan a Search String
; SSTPSC - PRESCAN A SEARCH STRING
;
; GEN: <CHAR.ADR,,<X>B18+TEXT.LENGTH> ; X:=1 IF EXACT MODE
; ; X:=0 IF BOTH UC AND LC MATCH
;
; CALL: PUSHJ P,SSTPSC
; (RETURN)
;
; SMASHES ACS X,T1-T4,C
;
; T2 HOLDS DELIMITER CHAR
; T3 HOLDS <CHAR.ADR,,<X>B18>
; T4 HOLDS <TEXT LENGTH>
SSTPSC: SETZ T4, ; CLEAR THE TEXT LENGTH COUNT
MOVEI T2,.CHESC ; ASSUME ALTMODE IS DELIMITER
TXZN F,F$DTM ; IS STRING IN DELIMITED MODE?
JRST SSTPS1 ; NO, ALTMODE IS THE DELIMITER
PUSHJ P,CMDGCH ; YES, FETCH THE DELIMITER CHAR
ERROR (USR) ; NONE LEFT. ** UNTERMINATED SEARCH ARGUMENT **
MOVEI T2,(C) ; COPY THE DELIMITER CHAR
SSTPS1: PUSHJ P,CURCHA ; FETCH ADR OF SEARCH STRING IN COMMAND STRING
MOVSI T3,(T1) ; SAVE THE CHAR.ADR OF STRING
; SCAN THE COMMAND STRING UNTIL THE DELIMITER CHAR IS SEEN
SSTPS2: PUSHJ P,CMDGCH ; FETCH THE NEXT COMMAND CHAR
ERROR (USR) ; NONE LEFT. ** UNTERMINATED SEARCH ARGUMENT **
CAIN C,(T2) ; IS IT THE DLIMITER CHAR?
JRST SSTPS4 ; YES, SCAN IS COMPLETE
AOJ T4, ; INCREMENT THE TEXT LENGTH COUNT
CAIE C,.CHCNR ; IS IT ^R?
CAIN C,.CHCNQ ; OR ^Q?
JRST SSTPS3 ; YES
CAIN C,.CHCNT ; IS IT ^T?
TXCA F,F$CNT ; YES, SET THE "^R AND ^T ARE ONLY SPECIALS" FLAG
TXNE F,F$CNT ; ARE WE IN ^T MODE?
JRST SSTPS2 ; YES, ^R AND ^T ARE THE ONLY SPECIAL CONTROL CHARS
CAIE C,.CHCNV ; NO, ^V?
CAIN C,.CHCNW ; OR ^W?
TRO T3,1B18 ; YES, SET THE EXACT MODE FLAG
JRST SSTPS2 ; AND CONTINUE SCAN
; ^R AND ^Q - TAKE NEXT CHAR AS TEXT
SSTPS3: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
ERROR (USR) ; NONE LEFT. ** UNTERMINATED SEARCH ARGUMENT **
AOJA T4,SSTPS2 ; AND CONTINUE SCAN
; SCAN COMPLETE. GEN <CHAR.ADR,,<X>B18+TEXT.LENGTH>
SSTPS4: CAILE T4,C$SRHL ; TOO MANY CHARS?
ERROR (STC) ; YES, ** TOO MANY CHARS IN SEARCH STRING **
IOR T3,T4 ; FORM <CHAR.ADR,,<X>B18+TEXT.LENGTH>
PUSH CP,T3 ; AND GEN IT INTO CODE
POPJ P, ; AND RETURN TO CALLER
SUBTTL SSTGSM - Generate a Search Matrix
; SSTGSM - GENERATE SEARCH MATRIX FOR A SEARCH ARGUMENT
; - COPIES SEARCH STRING FROM COMMAND STRING TO 'SRHARG'
; - GENERATE SEARCH MATRIX INTO 'SRHTAB'
; - STORES LENGTH OF SEARCH ARGUMENT IN 'SRHCTR'
; - STORES BIT POINTER FOR SEARCH MATRIX IN 'SRHSMP'
;
; CALL: MOVE T3,[<CHAR.ADR,,<X>B18+TEXT.LENGTH>]
; ; X:=1 IF SEARCH IS TO BE MADE IN EXACT MODE
; ; X:=0 IF SEARCH IS TO MATCH BOTH LC AND UC
; PUSHJ P,SSTGSM
; (RETURN)
;
; IF 'TEXT.LENGTH' IS ZERO, PREVIOUS SEARCH ARGUMENT AND MATRIX ARE USED.
;
; ACS X,T1-T4,N,M ARE SMASHED
;
; T2 HOLDS BYTE POINTER TO SOURCE
; T3 HOLDS COUNT OF CHARS LEFT IN TEXT
; T4 HOLDS BYTE POINTER TO 'SRHARG'
; N HOLDS BIT POSITION FOR SEARCH MATRIX
; M HOLDS ^E NESTING LEVEL
SSTGSM: TXZ F,F$$TX ; CLEAR SOME FLAGS
HLRZ T1,T3 ; FETCH CHAR.ADR OF SEARCH STRING
SOJ T1, ; 'CAUSE BP WILL BE INCREMENTED BEFORE USE
PUSHJ P,CTOBP ; CONVERT CHAR.ADR-1 TO A BYTE POINTER
MOVE T2,T1 ; PUT THE BP IN AC T2
ADD T2,@CMDBUF ; MAKE IT AN ABSOLUTE ADR
TRZE T3,1B18 ; SEARCH IN EXACT MODE?
TXO F,F$EXM ; YES
MOVEI T3,(T3) ; COMPUTE TEXT.LENGTH COUNT
JUMPE T3,CPOPJ ; DONE IF SEARCH STRING IS NULL
STORE (X,SRHTAB,SRHTAB+SRHLN-1,0) ; CLEAR THE SEARCH MATRIX
MOVEM T3,SRHCTR ; STORE THE LENGTH OF THE SEARCH STRING
MOVE T4,[POINT 7,SRHARG] ; SETUP BP TO SRHARG
STORE (X,SRHARG,SRHARG+^D<80/5-1>,0) ; CLEAR SEARCH ARG
MOVSI N,(1B0) ; INIT THE SEARCH MATRIX BIT POINTER
SETZ M, ; CLEAR ^E[...] LEVEL COUNT
; SCAN SEARCH STRING AND SET UP SEARCH MATRIX
SSTGS1: ILDB C,T2 ; FETCH CHAR FROM SEARCH STRING
IDPB C,T4 ; AND STORE IN SRHARG
MOVE T1,[IOWD S2TL,S2T+1] ; SETUP PTR TO SPECIAL CTL CHAR TABLE
TXNE F,F$CNT ; IN ^T MODE?
MOVE T1,[IOWD S3TL,S3T+1] ; YES, USE SHORT DISPATCH TABLE
PUSHJ P,DISPAT ; DISPATCH ON SPECIAL CONTROL CHARS
TXNN F,F$CNT ; NOT SPECIAL. IN ^T MODE?
PUSHJ P,CHKNCC ; YES, CHECK FOR ILLEGAL CONTROL COMMANDS
SSTGS2: TXNE F,F$EMA ; ACCEPT EITHER LC OR UC?
JRST SSTGS8 ; YES
TXNN F,F$CNX ; EXACT SEARCH MODE?
TXNE F,F$EXM ; . . . ?
JRST SSTGS3 ; YES
; BOTH LC AND UC LETTERS MATCH
SSTGS8: CAIG C,"Z"+40 ; IS CHAR A LC LETTER?
CAIGE C,"A"+40 ; . . . ?
SKP ; NO
TRZ C,40 ; YES, UPCASE IT
CAIG C,"Z" ; IS CHAR UC LETTER?
CAIGE C,"A" ; . . . ?
JRST SSTGS3 ; NO
XORM N,SRHTAB+40(C) ; YES, SET THE LC ENTRY FOR LETTER ALSO
JRST SSTGS4 ; NOW SET THE UC ENTRY FOR LETTER
SSTGS3: PUSHJ P,CASE ; TAKE CARE OF CASE SETTING FOR CHAR
SSTGS4: XORM N,SRHTAB(C) ; SET SEARCH MATRIX ENTRY FOR CHAR
SSTGS5: SOJ T3, ; DECREMENT # CHARS LEFT IN SEARCH STRING
JUMPN M,CPOPJ ; RETURN IF GATHERING DATA FOR ^E[A,B,C]
TXZN F,F$CNN ; WAS PREVIOUS CHAR ^N?
JRST SSTGS6 ; NO
ANDCAM N,SRHTAB+$CHBEG ; CLEAR FAKE CHARACTERS
ANDCAM N,SRHTAB+$CHSPC ; . . .
ANDCAM N,SRHTAB+$CHEND ; . . .
SSTGS6: LSH N,-1 ; ADVANCE SEARCH MATRIX TO NEXT POSITION
SSTGS9: JUMPLE T3,SSTGS7 ; SCAN COMPLETE
JUMPN N,SSTGS1 ; KEEP SCANNING IF .LT.36. CHARS
ERROR (STL) ; NO. ** SEARCH STRING TOO LONG **
; SCAN COMPLETE. STORE BIT POINTER FOR SEARCH MATRIX
SSTGS7: MOVEM N,SRHSMP ; STORE SEARCH MATRIX POINTER
POPJ P, ; AND RETURN TO CALLER
; DISPATCH TABLES FOR SPECIAL CONTROL COMMANDS IN SEARCH STRINGS
; DURING SEARCH MATRIX
S2T: <.CHCNE,,SSGCNE>
<.CHCNX,,SSGCNX>
<.CHCNN,,SSGCNN>
<.CHCNS,,SSGCNS>
<.CHCNV,,SSGCNV>
<.CHCNW,,SSGCNW>
<.CHCBS,,SSGCBS>
<.CHCCF,,SSGCUP>
S3T: <.CHCNT,,SSGCNT>
<.CHCNQ,,SSGCNQ>
<.CHCNR,,SSGCNR>
S3TL==.-S3T
S2TL==.-S2T
; ^X - SET SEARCH MATRIX TO MATCH ANY ARBITRARY CHARACTER
SSGCNX: MOVE X,[<-SRHLN+4,,1>] ; TO SET ALL CHARS
; EXCEPT NULL AND FAKE CHARS
SSGSET: PUSHJ P,SSGSTB ; SET CHARACTER(S) IN SEARCH MATRIX
JRST SSTGS5 ; AND CONTINUE SCAN
; ^N - SET SEARCH MATRIX TO REVERSE SENSE OF SEARCH FOR THE
; ARBITRARY CHARACTER THAT FOLLOWS (MAY BE ^E,^N,ETC.)
SSGCNN: MOVE X,[<-SRHLN+4,,1>] ; SET SEARCH MATRIX FOR ALL CHARS (EXCEPT NULL)
PUSHJ P,SSGSTB ; . . .
TXO F,F$CNN ; FLAG THAT A ^N WAS SEEN
SOJG T3,SSTGS1 ; AND CONTINUE SCAN
ERROR (ICN) ; NO CHARS LEFT. ** ILLEGAL ^N COMMAND **
; ^S - SET SEARCH MATRIX TO MATCH NON-SYMBOL CONSTITUENTS
; (IE: NOT(A-Z,0-9,.,%,$)
SSGCNS: MOVE X,[<-SRHLN+3,,1>] ; SET SEARCH MATRIX FOR ALL CHARS
PUSHJ P,SSGSTB ; EXCEPT NULL AND FAKE CHARS EXCEPT BEGPAGE
XORM N,SRHTAB+"." ; DON'T ALLOW "."
XORM N,SRHTAB+"%" ; DON'T ALLOW "%"
XORM N,SRHTAB+"$" ; DON'T ALLOW "$"
MOVE X,[<-^D10,,"0">] ; DON'T ALLOW DIGITS
PUSHJ P,SSGSTB ; . . .
SSGEA: MOVE X,[<-^D26,,"A">] ; ENTRY POINT FOR ^EA
PUSHJ P,SSGSTB ; SET/CLEAR UC LETTERS
SSGEV: MOVE X,[<-^D26,,"A"+40>] ; ENTRY POINT FOR ^EV
JRST SSGSET ; SET/CLEAR UC LETTERS
; ^V - DOWNCASE FOLLOWING CHAR IF A LETTER
; ^V^V - DOWNCASE FOLLOWING LETTERS TILL END OF STRING OR FURTHER NOTICE
SSGCNV: PUSHJ P,CNV ; SET FLAGS FOR ^V
SOJA T3,SSTGS9 ; AND CONTINUE SCAN
; ^W - UPCASE THE FOLLOWING CHAR IF A LETTER
; ^W^W - UPCASE FOLLOWING LETTERS TILL END OF STRING OR FURTHER NOTICE
SSGCNW: PUSHJ P,CNW ; SET FLAGS FOR ^W
SOJA T3,SSTGS9 ; AND CONTINUE SCAN
; ^\ - COMPLEMENT FORCED EXACT SEARCH MODE
SSGCBS: TXC F,F$EMA ; COMPLEMENT THE FORCED EXACT SEARCH MODE FLAG
SOJA T3,SSTGS9 ; AND CONTINUE SCAN
; ^^ - DOWNCASE THE FOLLOWING CHAR IF @,[,\,],OR _
SSGCUP: ILDB C,T2 ; FETCH THE FOLLOWING CHAR
IDPB C,T4 ; AND STORE IN SRHARG
PUSHJ P,CNUAR ;DOWNCASE IT IF @,[,\,],_
SOJA T3,SSTGS2 ; AND CONTINUE SCAN
; ^T - COMPLEMENT THE ^T MODE. DISABLES ALL CONTROL COMMANDS EXCEPT ^R,^Q,^T
SSGCNT: TXC F,F$CNT ; COMPLEMENT ^T MODE FLAG
SOJA T3,SSTGS9 ; AND CONTINUE SCAN
; ^R - TAKE THE FOLLOWING CHAR AS TEXT
SSGCNR:
; ^Q - TAKE THE FOLLOWING CHAR AS TEXT
SSGCNQ: ILDB C,T2 ; FETCH THE FOLLOWING CHAR
IDPB C,T4 ; AND STORE IT IN SRHARG
SOJA T3,SSTGS2 ;[373] AND CONTINUE SCAN
; ^E COMMANDS
SSGCNE: ILDB C,T2 ; FETCH THE FOLLOWING CHAR
IDPB C,T4 ; AND STORE IT IN SRHARG
SOJLE T3,SSGCEE ; NONE LEFT. ** ^E COMMAND ERROR **
MOVE T1,[IOWD S4TL,S4T+1] ; FETCH PTR TO DISPATCH TABLE
PUSHJ P,DISPAT ; DISPATCH ON THE FOLLOWING CHAR
SSGCEE: ERROR (ICE) ; ** ILLEGAL ^E COMMAND **
; DISPATCH TABLE FOR ^E COMMANDS DURING SEARCH MATRIX GENERATION
S4T: <"A",,SSGEA>
<"V",,SSGEV>
<"W",,SSGEW>
<"D",,SSGED>
<"L",,SSGEL>
<"S",,SSGES>
<.CHLAB,,SSGEAB>
<"[",,SSGESB>
S4TL==.-S4T
; ^EW - SET SEARCH MATRIX FOR UPPER CASE LETTERS
SSGEW: SKIPA X,[<-^D26,,"A">] ; FETCH AOBJN PTR FOR UC LETTERS
; ^ED - SET SEARCH MATRIX FOR DIGITS
SSGED: MOVE X,[<-^D10,,"0">] ; FETCH AOBJN PTR FOR DIGITS
JRST SSGSET ; SET SEARCH MATRIX AND CONTINUE SCAN
; ^EL - SET SEARCH MATRIX TO MATCH END-OF-LINE DELIMITERS
SSGEL: MOVE X,[<-3,,.CHLFD>] ; FETCH AOBJN POINTER FOR <LF><VT><FF>
JRST SSGSET ; AND SET SEARCH MATRIX AND CONTINUE SCAN
; ^ES - SET SEARCH MATRIX TO MATCH ARBITRARY # SPACES AND/OR TABS
SSGES: XORM N,SRHTAB+.CHSPC ; SET THE SPACE ENTRY IN SEARCH MATRIX
XORM N,SRHTAB+.CHTAB ; SET THE TAB ENTRY
XORM N,SRHTAB+$CHSPC ; SET ENTRY FOR ARBITRARY #
JRST SSTGS5 ; AND CONTINUE SCAN
; ^E<NNN> - SET SEARCH MATRIX TO MATCH ASCII CHAR WHOSE OCTAL CODE IS NNN
SSGEAB: SETZ X, ; SET NUMBER:=0
SSGEA1: ILDB C,T2 ; FETCH NEXT CHAR
IDPB C,T4 ; AND STORE IN SRHARG
SOJL T3,SSGCEE ; ERROR IF NO CHARS LEFT
CAIN C,.CHRAB ; IS CHAR A RIGHT ANGLE BRACKET?
JRST SSGEA2 ; YES, DONE WITH NNN
CAIG C,"7" ; IS CHAR AN OCTAL DIGIT?
CAIGE C,"0" ; . . . ?
ERROR (ICE) ; NO. ** ILLEGAL ^E COMMAND **
LSH X,3 ; YES, MAKE ROOM FOR THE DIGIT
IORI X,-"0"(C) ; AND ADD IN THE DIGIT
JRST SSGEA1 ; AND TRY FOR ANOTHER DIGIT
SSGEA2: ANDI X,177 ; MAKE OCTAL CODE 7 BITS
XORM N,SRHTAB(X) ; AND SET ENTRY IN SEARCH MATRIX
JRST SSTGS5 ; AND CONTINUE SCAN
; ^E[A,B,C] - ACCEPT "A" XOR "B" XOR "C" FOR THIS CHAR POSITION
; A,B,C ARE ANY STRING ELEMENTS INCLUDING ^E COMMANDS
SSGESB: AOJ M, ; COUNT THE LEVELS OF ^E NESTING
SSGES1: PUSHJ P,SSTGS1 ; PROCESS FOLLOWING CHAR
ILDB C,T2 ; FETCH NEXT CHAR
IDPB C,T4 ; AND STORE IN SRHARG
SOJL T3,SSGCEE ; ERROR IF NONE LEFT
CAIN C,"," ; IS CHAR ","?
JRST SSGES1 ; YES, CONTINUE [A,B,...]
CAIE C,"]" ; NO IS CHAR TERMINATING "]"?
ERROR (ICE) ; NO. ** ILLEGAL ^E COMMAND **
SOJA M,SSTGS5 ; YES, DECR ^E NESTING COUNT AND CONTINUE SCAN
; SSGSTB - SET SEARCH MATRIX FOR MULTIPLE CHARACTERS IN SAME POSITION
;
; CALL: MOVE X,[<-LEN,,START.CHAR>]
; PUSHJ P,SSGSTB
; (RETURN)
;
; SMASHES AC X
SSGSTB: XORM N,SRHTAB(X) ; SET ONE CHAR POSITION
AOBJN X,SSGSTB ; LOOP FOR ALL CHARS IN RANGE
POPJ P, ; DONE. RETURN TO CALLER
SUBTTL SERCH and BSERCH - Perform a Search
; SERCH - PERFORM A SEARCH ON THE MAIN TEXT BUFFER FROM "." ON
;
; CALL: PUSHJ P,SERCH
; (FAIL RETURN)
; (SUCCESS RETURN)
;
; SMASHES ACS X,T1-T5,C,N,M
SERCH: MOVE T4,PTVAL ; LOWER BOUND:="."
MOVE T5,@TXTBUF ; UPPER BOUND:=Z
; BSERCH - PERFORM A SEARCH ON THE MAIN TEXT BUFFER WITHIN SPECIFIED BOUNDS
;
; CALL: MOVEI T4,LBOUND ; LOWER BOUND
; MOVEI T5,UBOUND ; UPPER BOUND
; PUSHJ P,BSERCH
; (FAIL RETURN)
; (SUCCESS RETURN)
BSERCH: PUSH P,T4 ; SAVE AC T4
PUSH P,T5 ; SAVE AC T5
PUSHJ P,NXTWRD ; FETCH <CHAR.ADR,,TEXT.LENGTH>
MOVE T3,N ; AND COPY INTO AC T3
PUSHJ P,SSTGSM ; GENERATE THE SEARCH MATRIX
POP P,T5 ; RESTORE AC T5
POP P,T4 ; RESTORE AC T4
PJRST SEARCH ; PERFORM THE SEARCH
SUBTTL SEARCH - The Actual Search Routine
; SEARCH - SEARCH THE MAIN TEXT BUFFER (WITHIN BOUNDS) FOR A STRING
;
; CALL: MOVEI ARG,N ; FIND THE NTH OCCURRANCE
; MOVEI T4,LBOUND ; LOWER BOUND CHAR.ADR
; MOVEI T5,UBOUND ; UPPER BOUND. CHAR.ADR
; PUSHJ P,SEARCH
; (FAIL RETURN) ; "." IS B
; (SUCCESS RETURN) ; "." IS AFTER END OF STRING
;
; IT IS ASSUMED THAT SEARCH ARG HAS BEEN COPIED TO 'SRHARG', ITS LENGTH
; STORED IN 'SRHCTR', AND THE SEARCH MATRIX IS IN 'SRHTAB'
;
; SMASHES ACS X,T1,T2,C,N,M
;
; N HOLDS STATIC CHAR.ADR POINTER
; T1 HOLDS STATIC BYTE POINTER
; T2 HOLDS DYNAMIC BYTE POINTER
; M HOLDS BUT POINTER FOR SEARCH MATRIX
SEARCH: SKIPN SRHCTR ; WAS THERE A PREVIOUS SEARCH ARGUMENT?
ERROR (SNA) ; NO. ** SEARCH WITH NO INITIAL ARGUMENT **
MOVE T3,SRHSMP ; FETCH THE BIT POINTER TO THE LAST
; POSITION IN THE SEARCH MATRIX
MOVE X,PTVAL ; FETCH "."
MOVEM X,ACSAVE ; AND SAVE FOR LETER CHECKING
TXZ F,F$MSR!F$CNT ; CLEAR SOME FLAGS
EXCH T4,T5 ; EXCHANGE BOUNDS
CAMGE T4,T5 ; IS THIS A MINUS SEARCH?
; (IE: BACKWARDS)
TXOA F,F$MSR ; YES, KEEP ARGS REVERSED AND SET FLAG
EXCH T4,T5 ; EXCHANGE BOUNDS BACK IF NOT MINUS SEARCH
; MAIN SEARCH LOOP
SEARC1: JUMPLE ARG,SEARCS ; SUCCESS IF WE'VE FOUND THE NTH OCCURRANCE
MOVE N,PTVAL ; COPY OF "."
MOVE T1,N ; COPY CURRENT CHAR.ADR
ADDI T1,5*T$DATA-1 ; T1:=CHAR.ADR-1 IN BUFFER
IDIVI T1,5 ; TURN CHAR.ADR INTO A BP
HLL T1,CBPTBL(T2) ; . . .
ADD T1,TXTBUF ; ADD IN THE BASE ADR OF TEXT BUFFER
MOVE T2,T1 ; COPY BP INTO AC T2
JUMPG N,SEARC2 ; JUMP IF NOT AT BEG OF BUFFER
; AT BEGINNING OF BUFFER. SEE IF IT MATCHES FIRST CHAR OF SEARCH
SKIPL SRHTAB+$CHBEG ; DOES BEG OF BUFFER MATCH?
JRST SEARC2 ; NO
MOVX M,1B1 ; YES, START SEARCH AT WITH SECOND CHAR
TXO F,F$BPG ; FLAG THAT BEG OF BUFFER MATCHES
JRST SEARC5 ; AND JUMP INTO THE SEARCH LOOP
; SEE IF SEARCH MATCHES BEGINNING AT CURRENT POSITION
SEARC2: CAML N,T4 ; WITHIN BOUNDS?
CAMLE N,T5 ; . . . ?
JRST SEARC5 ; NO
MOVX M,1B0 ; START WITH FIRST CHAR
MOVE T2,T1 ; DYNAMIC BP:=STATIC BP
JRST SEARC7 ; JUMP INTO THE SEARCH
; CHECK INDIVIDUAL CHARS
SEARC3: TDNE M,SRHTAB+$CHSPC ; MULTIPLE SPACES/TABS THIS POSITION?
JRST SERSPC ; YES
AOJ N, ; ADVANCE STATIC POINTER
SEARC4: LSH M,-1 ; ADVANCE SEARCH MATRIX POSITION
SEARC5: CAMN M,T3 ; END OF SEARCH MATRIX?
JRST SEARCS ; YES, FOUND A MATCH
SEARC7: ILDB C,T2 ; FETCH CHAR FROM TEXT BUFFER
TDNE M,SRHTAB(C) ; DOES CHAR MATCH SEARCH MATRIX?
JRST SEARC3 ; YES, TRY NEXT CHAR IN BUFFER
; SEARCH STRING DOES NOT MATCH. ADVANCE STATIC POINTER
TXZE F,F$BPG ; AT BEG OF BUFFER?
JRST SEARC2 ; YES, NOW TRY FIRST CHAR OF SEARCH STRING
TXNE F,F$MSR ; DOING A MINUS SEARCH?
JRST SEARC6 ; YES
AOS N,PTVAL ; ADVANCE THE STATIC CHAR.ADR POINTER
CAMLE N,T5 ; WITHIN BOUNDS?
JRST SRCHF1 ; NO
IBP T1 ; YES, INCREMENT THE STATIC BP
JRST SEARC2 ; AND TRY AGAIN
SEARC6: SOS N,PTVAL ; BACKUP THE STATIC CHAR.ADR POINTER
CAMGE N,T4 ; ABOVE LOWER BOUND?
JRST SRCHF1 ; NO, SEARCH FAILED
ADD T1,[<7B5>] ; YES, DECREMENT STATIC BP
JUMPGE T1,SEARC2 ; AND TRY AGAIN
HRLI T1,(POINT 7,,34) ; . . .
SOJA T1,SEARC2 ; . . .
; SERSPC - SKIP OVER SPACES AND TABS
SERSPC: AOJ N, ; ADVANCE TO NEXT CHAR IN BUFFER
CAML N,T4 ; PAST END OF SEARCH BOUNDS?
CAMLE N,T5 ; . . . ?
JRST SEARC4 ; YES, STOP SKIPPING SPACES/TABS
MOVE X,T2 ; SAVE CURRENT BP
ILDB C,T2 ; GET NEXT CHAR FROM BUFFER
CAIE C,.CHSPC ; IS IT A SPACE?
CAIN C,.CHTAB ; OR A TAB?
JRST SERSPC ; YES, SKIP IT
MOVE T2,X ; NO, RESTORE BP
JRST SEARC4 ; AND GO BACK FOR MORE OF SEARCH
; SEARCH FAILED
SRCHF1: MOVE X,ACSAVE ; FETCH ORIGINAL "."
MOVEM X,PTVAL ; AND RESTORE IT
TXO F,F$LSF ; "LAST SEARCH FAILED"
SETZ VALUE, ; VALUE:=0
POPJ P, ; GIVE FAIL RETURN TO CALLER
; SEARCH SUCCEEDED
SEARCS: CAMLE N,T4 ; SUCCEED WITHIN BOUNDS?
CAMLE N,T5 ; . . . ?
JRST SRCHF1 ; NO, FAILED
TXZ F,F$LSF ; "LAST SEARCH SUCCEEDED"
MOVE X,N ; SAVE CURRENT POINTER
MOVE T2,PTVAL ; SAVE OLD "."
TXNE F,F$MSR ; DO A MINUS SEARCH?
JRST SRCHS2 ; YES
; CHECK IF WE'RE SEARCHING FOR THE NTH OCCURRANCE (N.GT.1)
SRCHS1: MOVEM N,PTVAL ; POSITION "." AFTER SEARCH MATCH-1
SOJG ARG,SEARC1 ; KEEP GOING IF N.GT.1
MOVEM X,PTVAL ; POSITION "." AFTER SEARCH
SUB X,T2 ; COMPUTE THE LENGTH OF THE SEARCH MATCH
MOVEM X,SRHLEN ; AND STORE FOR LATER USE
SETO VALUE, ; SET VALUE TO "SUCCESS"
JRST CPOPJ1 ; AND RETURN TO CALLER
SRCHS2: CAMG N,ACSAVE ; MATCH AFTER "." FOR MINUS SEARCH?
SOSA N,PTVAL ; NO, SEARCH A SUCCESS. DECR "."
SOSA N,PTVAL ; YES, DECR "."
JRST SRCHS1 ; AND SEE IF WE HAVE TO SEARCH AGAIN
JRST SEARC1 ; AND TRY AGAIN
SUBTTL Command Execution Subroutines
; NXTWRD - RETURN WORD AT PC AND INCREMENT PC
;
; CALL: PUSHJ P,NXTWRD
; (RETURN) ; WITH WORD IN AC N
;
; USES ACS X,N. UPDATES PC
NXTWRD: MOVE N,(PC) ; FETCH WORD AT CURRENT PC
AOJA PC,CPOPJ ; INCREMENT PC AND RETURN
; CHKARG - MAKE SURE ARG IS BETWEEN "B" AND "Z"
;
; CALL: PUSHJ P,CHKARG ; WITH ARG IN AC 'ARG'
; (FAIL RETURN) ; ARG IS OUT OF BOUNDS
; (SUCCESS RETURN) ; ARG IS OKAY
CHKARG: JUMPL ARG,.+2 ; ERROR IF ARG IS .LT.0
CAMLE ARG,@TXTBUF ; IS ARG .LE.Z?
POPJ P, ; NO, GIVE FAIL RETURN
JRST CPOPJ1 ; YES, GIVE SUCCESS RETURN TO CALLER
; CHK2RG - MAKE SURE SARG,ARG ARE IN BUFFER AND ERROR IF ARG.LT.SARG
;
; CALL: PUSHJ P,CHK2RG
;
; MODIFIES ACS ARG,SARG
CHK2RG: CAMLE SARG,ARG ; ARE ARGS IN PROPER ORDER
ERROR (SAL) ; NO, ** SECOND ARG LESS THAN FIRST **
CAMLE SARG,@TXTBUF ; SARG.GT.Z?
MOVE SARG,@TXTBUF ; YES, USE Z AS SARG
JUMPGE SARG,.+2 ; SARG.GE.ZERO?
SETZ SARG, ; NO, USE B AS SARG
CAMLE ARG,@TXTBUF ; ARG.GT.Z?
MOVE ARG,@TXTBUF ; YES, USE Z AS SARG
JUMPGE ARG,.+2 ; ARG.GE.ZERO?
SETZ ARG, ; NO, USE B AS ARG
POPJ P, ; AND RETURN TO CALLER
; EVL2RG - CONVERT SINGLE LINE ARG TO CHARACTER ADRESSES ARGS
;
; CALL: PUSHJ P,EVL2RG
; (RETURN) ; WITH START ADR IN ARG AND END ADR IN SARG
;
; USES ACS T1,T2,T4. MODIFIES ARG,SARG
EVL2RG: MOVE T4,PTVAL ; FETCH CURRENT CHAR ADR
JUMPLE ARG,EVL2R3 ; JUMP IF ARG IS .LE.ZERO
; ARG.GT.ZERO. GO TO THE N-1ST END-OF-LINE
EVL2R1: CAMN T4,@TXTBUF ; AT END OF BUFFER YET?
JRST EVL2R2 ; YES. THAT'S AS FAR AS WE GO
PUSHJ P,GETINC ; FETCH CURRENT CHAR FROM BUFFER AND INCR T4
PUSHJ P,CHKEOL ; IS CHAR END OF LINE?
JRST EVL2R1 ; NO, KEEP GOING
SOJG ARG,EVL2R1 ; YES, KEEP GOING TILL NTH ONE
EVL2R2: MOVE ARG,T4 ; FIRST ARG IS WHERE NTH LINE FROM "." IS
MOVE SARG,PTVAL ; SECOND ARG IS "."
POPJ P, ; RETURN TO CALLER
; ARG.LE.ZERO. GO BACK N END-OF-LINES
EVL2R3: SOJ T4, ; START LOOKING AT "."-1
EVL2R4: MOVE T1,T4 ; FETCH CHAR ADR
MOVE T1,T4 ; FETCH CURRENT ADR
JUMPL T1,EVL2R5 ; STOP WHEN BEGINNING OF BUFFER HIT
PUSHJ P,GET ; FETCH CHAR FROM BUFFER
PUSHJ P,CHKEOL ; END OF LINE?
SOJA T4,EVL2R4 ; NO, BACK UP ANOTHER CHAR
AOJLE ARG,.-1 ; YES, KEEP GOING TILL THE NTH ONE
AOSA SARG,T4 ; SECOND ARG IS "." MINUS N LINES
EVL2R5: SETZB SARG,T4 ; IF BEG OF BUFFER HIT, SARG:=0
MOVE ARG,PTVAL ; FIRST ARG IS "."
POPJ P, ; RETURN TO CALLER
; CNV - SET ^V (DOWNCASE NEXT CHAR) FLAG OR LOCK ^V^V FLAG
;
; CALL: PUSHJ P,CNV
; (RETURN)
CNV: TXON F,F$CNV ; SET THE ^V FLAG
POPJ P, ; RETURN TO CALLER IF IT WAR CLEAR
TXZ F,F$CNV!F$CWW ; WAS SET. CLEAR AND SET ^V^V LOCK FLAG
TXO F,F$CVV ; SET ^V^V LOCK FLAG
POPJ P, ; AND RETURN TO CALLER
; CNW - SET ^W (UPCASE NEXT CHAR) FLAG OR LOCK ^W^W FLAG
;
; CALL: PUSHJ P,CNW
; (RETURN)
CNW: TXON F,F$CNW ; SET THE ^W FLAG
POPJ P, ; RETURN TO CALLER IF IT WAS CLEAR
TXZ F,F$CNW!F$CVV ; WAS SET. CLEAR IT
TXO F,F$CWW ; AND SET ^W^W LOCK FLAG
POPJ P, ; AND RETURN TO CALLER
; CNUAR - DOWNCASE CHAR IF IT IS @,[,\,],OR _
;
; CALL: PUSHJ P,CNUAR
; (RETURN)
CNUAR: CAIL C,"[" ; IS IT ONE OF @,[,\,],OR _ ?
CAILE C,"_" ; . . . ?
CAIN C,"@" ; . . . ?
TRO C,40 ; YES, DOWNCASE THE CHAR
POPJ P, ; AND RETURN TO CALLER
; CASE - PUT CHAR IN PROPER CASE (BASED ON FLAGS)
;
; CALL: MOVEI C,CHAR
; PUSHJ P,CASE
; (RETURN)
CASE: CAIL C,"A" ; IS CHAR A LETTER?
CAILE C,"Z" ; . . . ?
CAIL C,"A"+40 ; . . . ?
CAILE C,"Z"+40 ; . . . ?
JRST CASE1 ; NO, CLEAR TEMPORARY CASE FLAGS
; SET THE LETTER TO THE PROPER CASING
TXNE F,F$DNC!F$CNV!F$CVV ; DOWNCASE CHAR?
TRO C,40 ; YES
TXNE F,F$UPC!F$CNW!F$CWW ; UPCASE CHAR?
TRZ C,40 ; YES
; CLEAR TEMPORARY CASE FLAGS
CASE1: TXZ F,F$CNW!F$CNV ; CLEAR TEMP CAPE FLAGS
POPJ P, ; AND RETURN TO CALLER
; GETINC - GET CHAR FROM ADR SPECIFIED IN T4 AND INCREMENT T4
;
; CALL: MOVEI T4,CHAR.ADR
; PUSHJ P,GETINC
; (RETURN) ; WITH CHAR IN AC C AND T4 INCREMENTED
;
; MODIFIES AC T4, SMASHES AC C
GETINC: AOS T1,T4 ; GET ADR INTO T1,INCR T4
SOJA T1,GET ; DECR T1, CALL GET
; GET - FETCH CHAR AT SPECIFIED ADR FROM TEXT BUFFER
;
; CALL: MOVEI T1,CHAR.ADR
; PUSHJ P,GET
; (RETURN) ; WITH CHAR IN AC C
;
; SMASHES ACS T1,T2,C
GET: IDIVI T1,5 ; COMPUTE WORD ADR
ADD T1,TXTBUF ; . . .
MOVEI T1,T$DATA(T1) ; (OVERHEAD WORDS IN BEG OF BUFFER)
HLL T1,CBPTBL(T2) ; MAKE INTO A BYTE POINTER
LDB C,T1 ; AND FETCH CHAR AT SPECIFIED ADR
POPJ P, ; AND RETURN TO CALLER
; INSCHR - INSERT A CHARACTER INTO BUFFER AT "."
;
; CALL: MOVEI C,CHAR
; PUSHJ P,INSCHR
; (RETURN)
INSCHR: MOVEI T1,1 ; WILL MAKE ROOM FOR ONE CHAR
PUSHJ P,MKROOM ; . . .
AOS T1,PTVAL ; ".":="."+1
SOJA T1,PUT ; PUT CHAR AT "."-1
; PUT - PUT CHAR IN BUFFER AT SPECIFIED ADDRESS
;
; CALL: MOVEI T1,CHAR.ADR
; MOVEI C,CHAR
; PUSHJ P,PUT
; (RETURN)
;
; SMASHES ACS T1,T2
PUT: IDIVI T1,5 ; COMPUTE WORD ADDRESS
ADD T1,TXTBUF ; . . .
MOVEI T1,T$DATA(T1) ; (OVERHEAD WORDS AT BEG OF BUFFER)
HLL T1,CBPTBL(T2) ; MAKE INTO A BYTE POINTER
DPB C,T1 ; AND PUT CHAR IN BUFFER
POPJ P, ; RETURN TO CALLER
SUBTTL SETFSP - Fill in Defaults for a File Spec
; SETFSP - Store a File Spec in LFSPC
; USES WHAT IS ALREADY IN LFSPC AS DEFAULTS
;
; CALL: MOVEI PC,FILSPC
; PUSHJ P,SETFSP
; (RETURN)
;
; SMASHES ACS X,T1-T3
SETFSP: MOVE T1,FS$FLG(PC) ; FETCH FILE SPEC FLAGS
TXNE T1,FB$$IO ; ANY I/O SWITCHES?
MOVEM T1,FS$FLG(L) ; YES, USE THEM INSTEAD OF PREVIOUS SWITCHES
MOVE X,FS$DEV(PC) ; FETCH THE DEVICE NAME
TXNE T1,FB$DEV ; FILE SPEC HAVE A DEVICE?
MOVEM X,FS$DEV(L) ; YES, STORE IT
MOVE X,FS$NAM(PC) ; FETCH THE FILE NAME
TXNE T1,FB$NAM ; FILE SPEC HAVE A FILE NAME?
MOVEM X,FS$NAM(L) ; YES, STORE IT
MOVE X,FS$EXT(PC) ; FETCH FILE EXTENSION
TXNE T1,FB$EXT ; FILE SPEC HAVE AN EXTENTION?
MOVEM X,FS$EXT(L) ; YES, STORE IT
MOVE X,[%LDSTP] ; FETCH DEFAULT PROTECTION
GETTAB X, ; . . .
MOVX X,<055B8> ; (IN CASE GETTAB FAILS)
TXNE T1,FB$PRV ; /PROTECT:NNN SPECIFIED?
MOVE X,FS$PRV(PC) ; YES, FETCH THE PROTECTION CODE
MOVEM X,FS$PRV(L) ; AND STORE IT
TXNN T1,FB$DDR ; DEFAULT DIRECTORY SPECIFIED?
JRST SETFS1 ; NO
; SETZM FS$PPN(L) ; YES, SET DEFAULT DIRECTORY
PUSHJ P,GETPTH ;[342] FETCH MY PATH
MOVEM X,FS$PPN(L) ;[342] SET DEFAULT DIRECTORY
JRST SETFS3 ; AND RETURN TO CALLER
SETFS1: TXNN T1,FB$PTH ; PATH SPECIFIED?
JRST SETFS3 ; NO, RETURN TO CALLER
GETPPN X, ; YES, MAKE SURE PPN STORED
JFCL ; (IN CASE OF JACCT)
MOVEM X,FS$PPN(L) ;[421] INITIALIZE DEFAULT
MOVE X,FS$PPN(PC) ; FETCH PPN FROM FILE SPEC
TXNE T1,FB$PRJ ; PROJECT # SPECIFIED IN FILE SPEC?
HLLM X,FS$PPN(L) ; YES, STORE IT
TXNE T1,FB$PRG ; PROGRAMMER # SPECIFIED IN FILE SPEC?
HRRM X,FS$PPN(L) ; YES, STORE IT
IFN C$SFDL,<TXNN T1,FB$SFD ; SFDS IN FILE SPEC?
JRST SETFS3 ; NO, RETURN TO CALLER
MOVE T2,[IOWD C$SFDL,FS$SFD] ;[425] SETUP AOBJN LOOP COUNTER
ADDI T2,(PC) ; MAKE IT POINT TO FIRST SFD
MOVEI T3,FS$SFD(L) ; FETCH ADR OF WHERE TO STORE SFDS
SETFS2: SKIPE X,(T2) ; FETCH SFD FROM FILE SPEC (SKIP IF NONE)
MOVEM X,(T3) ; STORE THE SFD
MOVEI T3,1(T3) ; POINT TO NEXT SFD IN STORED FILE SPEC
AOBJN T2,SETFS2 ; AND LOOP FOR ALL SFDS
>;; END IFN C$SFDL
SETFS3: MOVEI PC,FS$LTH(PC) ; SKIP OVER THE FILE SPEC
POPJ P, ; AND RETURN TO CALLER
SUBTTL SETRAD - Set the Adr of Read-a-Char Routine
; SETRAD - SET ADR OF THE READ-A-CHAR ROUTINE
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,SETRAD
; (RETURN)
;
; SAMSHES ACS X,T1
SETRAD: MOVE T1,FS$FLG(L) ; FETCH FILE-SPEC FLAGS
MOVEM T1,APDFLG ; AND SAVE FOR LATER USE
TXZ F,F$LSN ; CLEAR THE "FILE IS LINE-SEQ." FLAG
TXNN T1,FB$SUP ; /SUPLSN?
TXNN T1,FB$ASC!FB$SIX!FB$OCT ; OR UNSPEC. ASCII?
JRST SETR1 ; YES, CHECK INPUT FILE FOR LSNS
MOVE X,[<ASCAPD,,7>] ; FETCH ADR OF ASCII ROUTINE AND BYTE SIZE
TXNE T1,FB$SIX ; /SIXBIT?
MOVE X,[<SIXAPD,,6>] ; ADR OF SIXBIT ROUTINE AND BYTE SIZE
TXNE T1,FB$OCT ; /OCTAL?
MOVE X,[<OCTAPD,,3>] ; ADR OF OCTAL ROUTINE AND BYTE SIZE
HLRZM X,APDADR ; SAVE ADR OF GET-A-CHAR ROUTINE
DPB X,[POINT 6,INPBH+1,11] ; SET BYTE SIZE IN BUFFER HEADER
POPJ P, ; AND RETURN TO CALLER
; CHECK INPUT FILE FOR LSN'S
SETR1: INPUT INP, ; INPUT THE FIRST BLOCK
MOVE T1,INPBH+1 ; FETCH ADR OF BUFFER
MOVE X,1(T1) ; FETCH FIRST WORD OF FILE
IOR X,2(T1) ; AND THE SECOND WORD ALSO
MOVEI T1,ASCAPD ; PROBABLY NORMAL ASCII
TRNN X,1B35 ; IS IT LINE-SEQUENCE-NUMBERED?
JRST SETR2 ; NO
MOVE T2,FS$FLG(L) ; YES. FETCH I/O SWITCH FLAGS
TXNN T2,FB$SUP ; /SUPLSN?
TXO F,F$LSN ; NO, REMEMBER THAT FILE HAS LINE-SEQ#S
TXNE T2,FB$SUP ; /SUPLSN?
MOVEI T1,SUPAPD ; YES, FETCH ADR OF LSN ROUTINE
SETR2: MOVEM T1,APDADR ; STORE ADR OF GET-A-CHAR ROUTINE
MOVEI X,7 ; FETCH ASCII BYTE SIZE
DPB X,[POINT 6,INPBH+1,11] ; AND STORE IN BUFFER HEADER
POPJ P, ; AND RETURN TO CALLER
SUBTTL SETWAD - Set Adr of Punch-a-Char Routine
; SETWAD - SET ADR OF WRITE-A-CHAR ROUTINE
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,SETWAD
; (RETURN)
;
; SMASHES ACS X,T1
SETWAD: MOVE T1,FS$FLG(L) ; FETCH FILE-SPEC FLAGS
MOVEM T1,PCHFLG ; AND SAVE FOR LATER
MOVE X,[<ASCPCH,,7>] ; FETCH ADR ASCII ROUTINE AND BYTE SIZE
TXNE F,F$LSN ; IS INPUT FILE LINE-NUMBERED?
HRLI X,LSNPCH ; YES, PASS NUMBERS TO OUTPUT
TXNE T1,FB$GEN ; /GENLSN?
HRLI X,GENPCH ; YES, FETCH ADR OF GENLSN ROUTINE
TXNE T1,FB$ASC ; /ASCII?
HRLI X,ASCPCH ; YES, FETCH ADR OF ASCII ROUTINE
TXNE T1,FB$SIX ; /SIXBIT?
MOVE X,[<SIXPCH,,6>] ; YES, FETCH ADR OF SIXBIT ROUTINE
TXNE T1,FB$OCT ; /OCTAL?
MOVE X,[<OCTPCH,,3>] ; YES, FETCH ADR OF OCTQL ROUTINE
HLRZM X,PCHADR ; AND SAVE ADR OF WHATEVER ROUTINE
DPB X,[POINT 6,OUTBH+1,11] ; SET BYTE SIZE IN BUFFER HEADER
MOVE X,["00000"B34] ; INIT THE LSN COUNTER
MOVEM X,LSNCTR ; . . .
SETZM LSNCT1 ; . . .
POPJ P, ; AND RETURN TO CALLER
SUBTTL PUNBUF - Punch part of Input File
; PUNBUF - PUNCH AN ARBITRARY # BUFFERS OF INPUT FILE
;
; CALL: MOVEI ARG,N ; # BUFFERS TO PUNCH (INCLUDING CURRENT)
; PUSHJ P,PUNBUF
; (RETURN)
;
; SMASHES ACS X,T1-T4
PUNBUF: JUMPLE ARG,CPOPJ ; DO NOTHING IF ARG.LE.0
PUNB1: SETZ T4, ; T4:=LOWER BOUND (IE: B)
MOVE T5,@TXTBUF ; T5:=UPPER BOUND (IE: Z)
PUSHJ P,PUNCH ; PUNCH OUT THE ENTIRE PAGE
MOVEI C,.CHFFD ; IN CASE FORM FEED NEEDED
TXNE F,F$FFD ; WAS FORM.FEED SEEN ON INPUT?
PUSHJ P,@PCHADR ; YES, PUNCH A FORM.FEED
SETZM @TXTBUF ; CLEAR CHAR COUNT FOR BUFFER
TXNN F,F$EOF ; END OF FILE?
TXNN F,F$URD ; OR NOT READING A FILE?
POPJ P, ; YES, RETURN TO CALLER NOW
PUSHJ P,YANK ; YANK A NEW BUFFER
SOJG ARG,PUNB1 ; KEEP PUNCHING PAGES TILL ARG RUNS OUT
POPJ P, ; ARG RAN OUT. RETURN TO CALLER
SUBTTL PUNCH - Punch part of Text Buffer
; PUNCH - PUNCH OUT PART OF TEXT BUFFER
;
; CALL: MOVEI T4,LBOUND ; LOWER BOUND CHAR.ADR
; MOVEI T5,UBOUND ; UPPER BOUND CHAR.ADR
; PUSHJ P,PUNCH
; (RETURN)
;
; SMASHES ACS T1,T2,T3. USES ACS T4,T5
PUNCH: TXO F,F$STB ; FLAG THAT WE'RE AT BEG OF BUFFER
SETZM LSNCT1 ; CLEAR BYTE COUNTER FOR LSNS
MOVE T3,T5 ; T3:=LOWER BOUND
SUB T3,T4 ; T3:=# CHARS TO PUNCH
JUMPE T3,CPOPJ ; NONE TO PUNCH. RETURN TO CALLER
TXNN F,F$UWR ; ANY FILE FOR OUTPUT?
ERROR (NFO) ; NO, ** NO FILE FOR OUTPUT **
MOVE T1,T4 ; FETCH LOWER BOUND
IDIVI T1,5 ; AND FORM A BYTE POINTER THAT WILL
HLL T1,CBPTBL-1(T2) ; BE INCREMENTED BEFORE USE
ADD T1,TXTBUF ; MAKE BP ABSOLUTE TO TEXT BUFFER
ADDI T1,T$DATA ; SKIP OVER OVERHEAD WORDS OF BUFFER
; MAIN PUNCH LOOP
PUNCH1: ILDB C,T1 ; FETCH NEXT CHAR FROM TEXT BUFFER
PUSHJ P,@PCHADR ; AND PUNCH IT OUT
SOJG T3,PUNCH1 ; AND TRY FOR ANOTHER CHAR
TXZ F,F$STB ; CLEAR TEMP FLAG TO MAKE "YANK" HAPPY
POPJ P, ; ALL DONE. RETURN TO CALLER
SUBTTL ASCPCH - Punch an ASCII Character
; ASCPCH - PUNCH AN ASCII CHAR
ASCPCH: SOSGE OUTBH+2 ; ROOM IN OUTPUT BUFFER?
JRST ASCP1 ; NO
IDPB C,OUTBH+1 ; YES, STORE CHAR IN OUTPUT BUFFER
POPJ P, ; AND RETURN TO CALLER
; ASK MONITOR FOR A NEW OUTPUT BUFFER
ASCP1: OUT OUT, ; ASK MONITOR FOR NEXT BUFFER
JRST ASCPCH ; AND CONTINUE
; OUTERR - OUTPUT ERROR OCCURRED
OUTERR: GETSTS OUT,IOSTS ; GET I/O STATUS FOR OUTPUT CHANNELL
ERROR (OUT) ; AND GIVE AN ERROR MESSAGE
SUBTTL SIXPCH - Punch a SIXBIT ASCII Character
; SIXPCH - PUNCH A SIXBIT CHARACTER AFTER CONVERTING FROM ASCII
SIXPCH: SOSGE OUTBH+2 ; ROOM IN OUTPUT BUFFER?
JRST SIXP1 ; NO
MOVEI X,'A'-"A"(C) ; CONVERT ASCII TO SIXBIT
IDPB X,OUTBH+1 ;[360] AND STORE IN OUTPUT BUFFER
POPJ P, ; AND RETURN TO CALLER
; ASK MONITOR FOR A NEW OUTPUT BUFFER
SIXP1: OUT OUT, ; ASK MONITOR FOR A NEW OUTPUT BUFFER
JRST SIXPCH ; GOT IT. CONTINUE
JRST OUTERR ; FAILED! (SOME RANDOM ERROR)
SUBTTL OCTPCH - Punch an Octal Digit
; OCTPCH - PUNCH AN OCTAL DIGIT AFTER CONVERTING FROM ASCII
OCTPCH: SOSGE OUTBH+2 ; ROOM IN OUTPUT BUFFER?
JRST OCTP1 ; NO
MOVEI C,-"0"(C) ; CONVERT CHAR TO OCTAL
IDPB C,OUTBH+1 ; AND STORE IN OUTPUT BUFFER
POPJ P, ; AND RETURN TO CALLER
; ASK MONITOR FOR A NEW OUTPUT BUFFER
OCTP1: OUT OUT, ; ASK MONITOR FOR A NEW OUTPUT BUFFER
JRST OCTPCH ; GOT IT. CONTINUE
JRST OUTERR ; FAILED! (SOME RANDOM ERROR)
SUBTTL LSNPCH - Punch a Char and Turn on Bit35 for LSNS
; LSNPCH - PUNCH A CHAR AND TURN ON BIT35 FOR LSNS
LSNPCH: TXZN F,F$STB ; AT BEGINNING OF BUFFER?
SKIPE LSNCT1 ; IN AN LSN?
JRST LSNP1 ; YES
PUSHJ P,CHKEOL ; NO, IS CHAR END-OF-LINE?
JRST ASCPCH ; NO, JUST PUNCH IT
MOVEI X,5 ; YES, SET THE LSN FLAG
MOVEM X,LSNCT1 ; . . .
MOVE X,["00000"B34] ; AND GET READY TO JUSTIFY LSN
MOVEM X,LSNCTR ; . . .
PJRST ASCPCH ; AND PUNCH TO <EOL> CHAR
; ADD LEADING ZEROS TO AN EXISTING LSN BEFORE PUNCHING IT
LSNP1: SOSGE LSNCT1 ; DONE WITH LSN?
JRST LSNP2 ; NO, HAVEN'T BEGUN IT YET
CAIG C,"9" ; IS CHAR A DIGIT?
CAIGE C,"0" ; . . . ?
JRST LSNP5 ; NO, PUNCH THE LSN NOW
MOVE X,LSNCTR ; NO, FETCH WHAT WE HAVE ALREADY
LSH X,7 ; SHIFT IT ONE CHAR
DPB C,[POINT 7,X,34] ; AND PUT NEXT DIGIT IN
MOVEM X,LSNCTR ; AND SAVE AGAIN
SKIPN LSNCT1 ; IS THE LSN DONE?
JRST LSNP4 ; YES
POPJ P, ; NO, RETURN TO CALLER
; INIT LSN COUNTER WHEN AT BEGINNING OF BUFFER
LSNP2: MOVEI X,5 ; INIT THE DIGIT COUNTER
MOVEM X,LSNCT1 ; . . .
MOVE X,["00000"B34] ; INIT THE LSN
MOVEM X,LSNCTR ; . . .
JRST LSNP1 ; AND PLACE FIRST DIGIT IN LSN
; NOW PUNCH THE LSN
LSNP4: SETZM LSNCT1 ; CLEAR THE DIGIT COUNTER
MOVE X,OUTBH+2 ; FETCH BYTE COUNT
SUBI X,5 ; ACCOUNT FOR LSN
JUMPG X,.+2 ; SKIP IF ROOM FOR LSN
OUTPUT OUT, ; MAKE ROOM FOR THE LSN
SKIPN OUTBH+2 ; WAS IT A DUMMY OUTPUT?
OUTPUT OUT, ; YES, DO A REAL OUTPUT
AOS X,OUTBH+1 ; POINT TO NEXT WORD
MOVE N,LSNCTR ; FETCH THE LSN
IORI N,1 ; TURN ON THE LSN BIT (BIT35)
MOVEM N,(X) ; AND PUNCH THE LSN
LDB N,[POINT 6,OUTBH+1,5] ; FETCH # BITS LEFT IN WORD
IDIVI N,7 ; CONVERT TO CHARACTERS
MOVEI N,5(N) ; ACCOUNT FOR 5 CHARS OF LSN
; PLUS NULLS TO PAD WORD
MOVNI N,(N) ; . . .
ADDM N,OUTBH+2 ; . . .
MOVEI X,(POINT 7,,34) ; FIX BYTE POINTER TO NEXT WORD
HRLM X,OUTBH+1 ; . . .
POPJ P, ; AND RETURN TO CALLER
; PUNCH LSN AND THE CHAR AFTER IT
LSNP5: PUSH P,C ; SAVE THE CHAR
PUSHJ P,LSNP4 ; PUNCH THE LSN
POP P,C ; RESTORE THE CHAR
PJRST ASCPCH ; AND PUNCH IT AND RETURN TO CALLER
SUBTTL GENPCH - Punch a Char and Generate LSNS
; GENPCH - PUNCH A CHAR GENERATING AN LSN FOR EACH LINE
GENPCH: SKIPN LSNCT1 ; NEED AN LSN?
JRST GENP1 ; YES
PUSHJ P,CHKEOL ; NO, IS THIS CHAR AN END-OF-LINE?
PJRST ASCPCH ; NO, JUST PUNCH IT AND RETURN
SETZM LSNCT1 ; YES, FLAG THAT WE NEED AN LSN SOON
PJRST ASCPCH ; AND PUNCH THE END-OF-LINE CHAR
; GENERATE AN LSN FOR CURRENT LINE
GENP1: PUSH P,C ; SAVE THE CURRENT OUTPUT CHAR
MOVE X,OUTBH+2 ; IS THERE ROOM FOR THE LSN IN BUFFER?
SUBI X,12 ; . . . ?
JUMPG X,.+2 ; SKIP IF ROOM
OUTPUT OUT, ; MAKE ROOM
; PAD OUT CURRENT WORD WITH NULLS
GENP2: LDB X,[POINT 6,OUTBH+1,5] ; FETCH CURRENT BYTE POSITION
CAIG X,1 ; AT END OF WORD?
JRST GENP3 ; YES, READY FOR LSN
IBP OUTBH+1 ; NO, PAD WITH ANOTHER NULL
SOS OUTBH+2 ; DECREMENT BYTE COUNT
JRST GENP2 ; AND TRY AGAIN
; GENERATE A NEW LSN (OLD+10) AND STORE IN OUTPUT BUFFER
GENP3: MOVE X,LSNCTR ; FETCH OLD LSN
; ***** FOLLOWING CODE WORKS BY MAGIC (FROM DEC TECO) *****
ADD X,[BYTE(7)106,106,106,107]
MOVE N,X
AND N,[BYTE(7)60,60,60,60]
LSH N,-3
MOVE T2,X
AND T2,[BYTE(7)160,160,160,160]
IOR N,T2
SUB X,N
ADD X,[BYTE(7)60,60,60,60]
; ***** END OF MAGIC CODE *****
MOVEM X,LSNCTR ; STORE NEW LSN FOR LATER USE
AOS OUTBH+1 ; POINT TO NEXT WORD OF OUTPUT BUFFER
IORI X,1B35 ; SET THE LSN BIT IN LSN
MOVEM X,@OUTBH+1 ; STORE THE LSN IN OUTPUT BUFFER
MOVNI X,5 ; ACCOUNT FOR THE 5 CHARS OF LSN
ADDM X,OUTBH+2 ; . . .
SETOM LSNCT1 ; FLAG THAT LSN IS DONE
MOVEI C,.CHTAB ; AND PUNCH A <TAB> AFTER THE LSN
PUSHJ P,ASCPCH ; . . .
POP P,C ; RESTORE THE LAST OUTPUT CHAR
PJRST ASCPCH ; AND RETURN TO CALLER
SUBTTL BAKCLS - Finish "EB" that is in Progress
; BAKCLS - FINISH "EB" THAT IS IN PROGRESS
;
; 1) DELETE .BAK FILE
; 2) RENAME ORIGINAL FILE TO .BAK
; 3) RENAME .TMP FILE TO ORIGINAL NAME
;
; CALL: PUSHJ P,BAKCLS
; (RETURN)
;
; SMASHES ACS X,T1-T2
BAKCLS:
; DELETE .BAK FILE
MOVE X,[<LEBSPC,,FILSPC>] ; FETCH BLT POINTER
BLT X,FILSPC+FS$LTH-1 ; COPY ORIGINAL FILE-SPEC
MOVSI X,'BAK' ; AND CHANGE FILE EXTENSION
MOVEM X,FILSPC+FS$EXT ; TO .BAK
MOVE N,[Z INP,] ; FETCH INPUT I/O CHANNEL
MOVEI M,INPBH ; FETCH ADR OF INPUT BUFFER HEADER
MOVEI L,FILSPC ; FETCH ADR OF BACKUP FILE SPEC
PUSHJ P,FILOPN ; AND OPEN THE INPUT DEVICE
ERROR (IRN) ; CAN'T. ** INPUT FAILURE FOR RENAME **
PUSHJ P,FILLKP ; LOOKUP THE .BAK FILE
JRST BAKCL2 ; NONE THERE (SAVES US THE TROUBLE OF DELETING IT)
PUSHJ P,GETPTH ;[342] GET MY DEFAULT PATH
MOVE T1,RBSPC+.RBPPN ;[342] GET PPN
TXNN T1,LH.ALF ;[342] AN ADDRESS?
MOVE T1,(T1) ;[342] YES, GET PPN
CAME X,T1 ;[342] COMPARE WITH LOOKUP'ED PPN
JRST BAKCL2 ;[341] IT'S ON LIB: PROBABLY
; SAVE PROTECTION OF ORIGINAL .BAK FILE FOR NEW .BAK FILE
LDB X,[POINT 9,RBSPC+.RBPRV,8] ; FETCH .BAK PROTECTION
DPB X,[POINT 9,FILSPC+FS$PRV,8] ; AND STORE FOR NEW .BAK FILE
SETZ T1, ; DELETE THE .BAK FILE
RENAME INP,T1 ; . . .
ERROR (BAK) ; CAN'T . ** CAN'T DELETE .BAK FILE **
; RENAME ORIGINAL FILE TO .BAK
BAKCL2: MOVSI N,(Z INP,) ; FETCH INPUT CHANNEL
MOVEI L,LEBSPC ; FETCH ADR OF ORIGINAL FILE-SPEC
PUSHJ P,FILLKP ; AND LOOK IT UP
ERROR (ILR) ; CAN'T. ** LOOKUP FAILURE FOR INPUT FILE **
; SEE IF ORIGINAL FILE IS PROTECTED <2??>
LDB X,[POINT 9,RBSPC+.RBPRV,8] ; FETCH ORIGINAL FILE PROT
CAIGE X,<200> ; PROTECTED <2??>?
JRST BAKCL3 ; NO, MAKES THINGS EASIER
; ORIGINAL FILE IS PROTECTED <2??>
; RENAME IT TO <1??> SO THAT WE CAN RENAME IT
XORI X,<300> ; CHANGE PROTECTION TO <1??>
PUSH P,LEBSPC+FS$PRV ; SAVE ORIGINAL PROTECTION
DPB X,[POINT 9,LEBSPC+FS$PRV,8] ; SET THE <1??> PROTECTION
PUSHJ P,FILRNM ; AND RENAME THE ORIGINAL FILE TO NEW PROT.
ERROR (IRB) ; CAN'T RENAME IT !?!
POP P,LEBSPC+FS$PRV ; RENAMED IT. RESTORE ORIGINAL PROTECTION
; NOW REANME THE ORIGINAL FILE TO .BAK
BAKCL3: MOVEI L,FILSPC ; FETCH ADR OF .BAK FILE-SPEC
; PROTECTION OF .BAK FILE WILL BE <0NM> (IF WAS PROTECTED <LNM>
; THIS IS SO THAT .BAK FILES CAN BE EASILY DELETED
MOVSI X,(<700>B8) ; CLEAR THE OWNER FIELD IN PROTECTION CODE
ANDCAM X,FILSPC+FS$PRV ; . . .
PUSHJ P,FILRNM ; AND RENAME ORIGINAL TO .BAK
ERROR (IRB) ; CAN'T. ** RENAME FAILURE FOR .BAK FILE **
; RENAME '###XTC.TMP' TO ORIGINAL FILE
MOVSI N,(Z OUT,) ; FETCH OUTPUT CHANNEL
MOVEI L,LEBSPC ; FETCH ADR OF ORIGINAL FILE-SPEC
PUSHJ P,FILRNM ; AND RENAME .TMP FILE TO ORIGINAL
ERROR (RNO) ; CAN'T. ERROR
; DONE WITH "EB"
TXZ F,F$URD!F$UWR!F$UBK ; CLEAR I/O FLAGS
POPJ P, ; AND RETURN TO CALLER
SUBTTL YANK and APPEND
; YANK - RENDER THE MAIN TEXT BUFFER EMPTY AND APPEND A NEW BUFFER
;
; CALL: PUSHJ P,YANK
; (RETURN)
YANK: SETZM PTVAL ; ".":=B
SETZM @TXTBUF ; Z:=B MAKES THE BUFFER EMPTY
; PJRST APPEND ; APPEND A NEW BUFFER AND RETURN TO CALLER
; APPEND - READ INPUT CHARACTERS UNTIL:
;
; 1) A FORM.FEED CHARACTER IS ENCOUNTERED, OR
; 2) END.OF.FILE IS ENCOUNTERED, OR
; 3) BUFFER IS WITHIN FI/C$FILB FULL AND A LINE.FEED
; CHARACTER IS ENCOUNTERED, OR
; 4) BUFFER IS WITHIN 128. CHARACTERS OF CAPACITY
;
; T1 HOLDS BYTE POINTER FOR STORING CHARS IN TEXT BUFFER
; T3 HOLDS # CHARS LEFT TILL BUFFER IS (C$FILB-1)/C$FILB FULL
; T4 HOLDS # CHARS LEFT TILL BUFFER IS WITHIN 128. CHARS OF FULL
; T5 HOLDS NEW Z (OLD PLUS #CHARS SEEN)
;
; SMASHES ACS X,T1-T5,C
APPEND: TXZ F,F$FFD ; CLEAR THE FORMFEED FLAG
TXNN F,F$URD ; IS A FILE OPEN FOR INPUT?
CERR1 (NFI) ; NO, ** NO FILE OPEN FOR INPUT **
; SETUP NEW Z
MOVE T5,@TXTBUF ; NEW Z:=OLD Z
; MAKE SURE THAT THERE IS ROOM FOR AT LEAST 3000. CHARACTERS IN BUFFER
MOVE T4,@TXTBUF ; FETCH Z
EXCH T4,PTVAL ; T4:=. , ".":=Z
MOVEI T1,^D3000 ; FETCH 3000.
ADD T1,PTVAL ; T1:=3000.+Z
SUB T1,T4 ; T1:=3000.+Z-"."
PUSHJ P,MKROOM ; MAKE ROOM FOR CHARS
MOVEM T4,PTVAL ; ".":="."
; COMPUTE # CHARS LEFT TILL BUFFER IS WITH 128. CHARS OF FULL
MOVE X,TXTBUF ; COMPUTE CAPACITY OF BUFFER
HLRZ T1,B$1PTR(X) ; . . .
SUBI T1,(X) ; . . .
IMULI T1,5 ; CONVERT WORDS TO CHARS
SUBI T1,^D128 ; MINUS 128. CHARS
IDIVI T1,^D12 ; MAKE SURE A MULTIPLE OF 12.
IMULI T1,^D12 ; . . .
MOVE T4,T1 ; AND PUT IN AC T4
SUB T4,T5 ; MINUS # CHARS ALREADY IN BUFFER
; COMPUTE # CHARS LEFT TILL BUFFER IS (C$FILB-1)/C$FILB FULL
MOVE T3,T4 ; FETCH # CHARS WE CAN PUT IN BUFFER
ADDI T3,^D128 ; COMPUTE BUFFER CAPACITY
MOVE T1,T3 ; T1:=BUFFER CAPACITY
IDIVI T1,C$FILB ; COMPUTE 1/C$FILB OF BUFFER CAPACITY
SUB T3,T1 ; COMPUTE # CHARS LEFT TILL BUFFER (C$FILB-1)/C$FILB FULL
; SETUP BYTE POINTER FOR STORING CHARS IN TEXT BUFFER
MOVE T1,T5 ; FETCH Z
ADDI T1,5*T$DATA ; TO SKIP OVER OVERHEAD WORDS OF BUFFER
IDIVI T1,5 ; AND FORM A BYTE POINTER THAT WILL
HLL T1,CBPTBL-1(T2) ; BE INCREMENTED BEFORE USE
ADD T1,TXTBUF ; MAKE BP ABSOLUTE
SETZ C, ; CLEAR THE CURRENT CHAR
; MAIN READ LOOP
APPND1: SOJGE T3,@APDADR ; NEXT CHAR IF LOTS OF ROOM
JUMPLE T4,APPND2 ; STOP IF WITHIN 128. CHARS OF FULL
CAIE C,.CHLFD ; WAS LAST CHAR A LINE.FEED?
JRST @APDADR ; NO, FETCH NEXT CHAR
; APPEND COMPLETE
APPND2: MOVEM T5,@TXTBUF ; STORE NEW VALUE OF "Z"
POPJ P, ; AND RETURN TO CALLER
; "IN" MUUO FAILED. SEE WHAT HAPPENED
APPND3: STATO INP,IO.EOF ; END OF FILE?
JRST APPND4 ; NO, SOME RANDOM I/O ERROR
TXO F,F$EOF ; YES, REMEMBER THAT
JRST APPND2 ; AND FINISH UP
; INPUT ERROR
APPND4: GETSTS INP,IOSTS ; FETCH STATUS OF INPUT CHANNEL
ERROR (INP) ; AND GIVE ERROR MESSAGE
SUBTTL ASCAPD - Read an ASCII Char
; ASCAPD - FETCH NEXT ASCII INPUT CHAR AND STORE IN TEXT BUFFER
ASCAPD: SOSGE INPBH+2 ; ANY MORE CHARS IN INPUT BUFFER?
JRST ASCA1 ; NO, FETCH NEW BUFFER FULL
ILDB C,INPBH+1 ; YES, FETCH NEXT CHAR
CAIN C,.CHFFD ;; IS IT A FORM-FEED?
JRST ASCA2 ; YES
JUMPE C,ASCAPD ; NO, STORE CHAR IN TEXT BUFFER
IDPB C,T1 ; STORE THE CHAR IN TEXT BUFFER
AOJ T5, ; Z:=Z+1
SOJA T4,APPND1 ; AND TRY FOR NEXT CHAR
; INPUT NEW BUFFER
ASCA1: IN INP, ; ASK MONITOR FOR NEXT BUFFER
JRST ASCAPD ; GOT IT. FETCH NEXT CHAR
JRST APPND3 ; FAILED. FIND OUT WHY
; FORM-FEED CHAR ENCOUNTERED. FLAG IT AND STOP THE APPEND
ASCA2: TXO F,F$FFD ; FLAG THAT A <FF> SEEN
AOS PAGCNT ; INCREMENT PAGE COUNTER
JRST APPND2 ; AND STOP THE APPEND
SUBTTL SUPARD - Read a Char and Suppress LSNS
; SUPAPD - IGNORE LSNS ON INPUT(/SUPLSN) AND STORE CHAR IN TEXT BUFFER
SUPAPD: SOSGE INPBH+2 ; ANY MORE CHARS IN INPUT BUFFER?
JRST SUPAP2 ; NO, FETCH NEXT BUFFER
ILDB C,INPBH+1 ; YES, FETCH NEXT CHAR
JUMPE C,SUPAPD ; IGNORING NULLS
CAIN C,.CHFFD ; IS CHAR A FORM-FEED?
JRST ASCA2 ; YES
MOVE X,@INPBH+1 ; FETCH CURRENT INPUT WORD
TRNN X,1B35 ; IS IT A LINE-SEQUENCE-NUMBER?
JRST SUPAP1 ; NO
; SUPPRESS LINE-SEQUENCE-NUMBERS AND THE FOLLOWING <TAB>
AOS INPBH+1 ;[361] IGNORE THE LSN BY MOVING TO NEXT WORD
MOVE X,INPBH+2 ; FETCH THE CHAR COUNT
SUBI X,5 ;[361] AND SUBTRACT 5 CHARS
MOVEM X,INPBH+2 ; . . .
JRST SUPAPD ; AND GO BACK FOR ANOTHER CHAR
; TAB EATEN BY MAGIC IN PREVIOUS ROUTINE. HOW?
; THE BYTE POINTER POINTS TO THE SECOND BYTE IN THE WORD WHEN IT
; HITS THIS ROUTINE. RATHER THAN RESET AND GOBBLE IT AGAIN, I
; LEAVE IT THAT WAY. BECAUSE OF THIS, THE FIRST CHARACTER AFTER THE
; LSN, WHICH IS OF NECESSITY A <TAB>, IS TOTALLY IGNORED!
; THIS MAGIC WAS PART OF [361].
; STORE CHAR IN TEXT BUFFER
SUPAP1: IDPB C,T1 ; STORE CHAR IN TEXT BUFFER
AOJ T5, ; Z:=Z+1
SOJA T4,APPND1 ; AND GO BACK FOR ANOTHER CHAR
; INPUT NEXT BUFFER FROM MONITOR
SUPAP2: IN INP, ; ASK MONITOR FOR NEXT INPUT BUFFER
JRST SUPAPD ; GOT IT
JRST APPND3 ; FAILED. FIND OUT WHY
SUBTTL OCTAPD - Read an Octal Digit
; OCTAPD - FETCH NEXT OCTAL INPUT DIGIT AND STORE CHAR IN TEXT BUFFER
OCTAPD: SOSGE INPBH+2 ; ANY MORE DIGITS IN INPUT BUFFER?
JRST OCTA1 ; NO, FETCH NEXT INPUT BUFFER
ILDB C,INPBH+1 ; YES, FETCH NEXT OCTAL DIGIT
MOVEI C,"0"(C) ; AND CONVERT TO ASCII CHAR
IDPB C,T1 ; AND STORE IN TEXT BUFFER
AOJ T5, ; Z:=Z+1
SOJA T4,APPND1 ; AND TRY FOR NEXT CHAR
; INPUT NEW BUFFER AND GET READY FOR OCTAL PROCESSING
OCTA1: IN INP, ; ASK MONITOR FOR A NEW BUFFER
JRST OCTAPD ; GOT IT. CONTINUE
JRST APPND3 ; FAILED. FIND OUT WHY
SUBTTL SIXAPD - Read a SIXBIT ASCII Char
; SIXAPD - FETCH NEXT SIXBIT INPUT CHAR AND PUT IN TEXT BUFFER
SIXAPD: SOSGE INPBH+2 ; ANY MORE CHARS IN INPUT BUFFER?
JRST SIXA1 ; NO, GET ANOTHER BUFFER
ILDB C,INPBH+1 ; YES, FETCH NEXT CHAR
MOVEI C,"A"-'A'(C) ; AND CONVERT SIXBIT TO ASCII
IDPB C,T1 ; STORE THE ASCII CHAR IN TEXT BUFFER
AOJ T5, ; Z:=Z+1
SOJA T4,APPND1 ; AND GO BACK FOR MORE
; FETCH A NEW INPUT BUFFER
SIXA1: IN INP, ; ASK MONITOR FOR NEXT INPUT BUFFER
JRST SIXAPD ; GOT IT. CONTINUE
JRST APPND3 ; FAILED. FIND OUT WHY
SUBTTL MACRO - Compile and Execute a Macro
; MACRO - COMPILE AND EXECUTE A TEXT BUFFER
;
; CALL: MOVE L,[SIXBIT/Q-REG-NAME/]
; MOVX N,BID
; TX? F,F$CMP ; ?=O TO COMPILE, ?=Z TO SUPPRESS COMPILE
; PUSHJ P,MACRO
; (RETURN)
MACRO:
; PUSH NAME,BID,REL.PC ON CONTROL PDL
PUSH P,MACNAM ; SAVE NAME OF CURRENT MACRO
PUSH P,MACBID ; SAVE BUFFER ID FOR CURRENT MACRO
MOVEM L,MACNAM ; STORE NEW MACRO NAME
MOVEM N,MACBID ; AND IT'S BUFFER ID
SUB PC,R ; COMPUTE RELATIVE PC
PUSH P,PC ; AND SAVE CURRENT RELATIVE PC
; CLEAR AC AND MACBUF REFERENCES TO CURRENT MACRO TEXT BUFFER
SKIPN MACLVL ; IN A MACRO NOW?
JRST MACRO1 ; NO, NO REFS TO CLEAR
MOVE X,MACBUF ; YES, FETCH BASE ADR OF BUFFER
HRRZS T$1REF(X) ; UNBIND MACBUF FROM BUFFER
SETZM T$ACRF(X) ; UNBIND ACS FROM BUFFER
; FIND THE BUFFER FOR MACRO BUFFER ID
MACRO1: MOVEI L,MACBUF ; FETCH ADR OF BUFFER REF
PUSHJ P,FNDBLK ; FIND THE BUFFER FOR BID
ERROR (XXX) ; CAN'T. ERROR
MOVE X,MACBUF ; FETCH ADR OF BUFFER
AOS T$RCNT(X) ; AND INCREMENT REFERENCE COUNT
; COMPILE BUFFER IF F$CMP IS ON
MOVEI L,MACBUF ; FETCH ADR OF REF TO BUFFER
TXNE F,F$CMP ; COMPILE TO BUFFER?
PUSHJ P,COMPIL ; YES
AOS MACLVL ; COUNT THE NESTING OF MACROS
; EXECUTE THE COMPILED BUFFER
MOVEI L,MACBUF ; FETCH ADR OF REF TO BUFFER
PUSHJ P,EXECUT ; AND EXECUTE THE BUFFER
; POP INFO ABOUT PREVIOUS MACRO OFF CONTROL PDL
POP P,PC ; RESTORE RELATIVE RETURN PC
POP P,N ; RESTORE BUFFER ID
POP P,MACNAM ; RESTORE NAME OF PREVIOUS MACRO
; RELEASE CURRENT BUFFER
EXCH N,MACBID ; STORE PREVIOUS MACRO BUFFER ID
; AND FETCH CURRENT ONE INTO AC N
PUSHJ P,DELBLK ; AND DELETE THE CURRENT MACRO REF
; RESTORE PREVIOUS MACRO
SOSN MACLVL ; DECREMENT THE MACRO NESTING COUNT
POPJ P, ; AND RETURN TO CALLER IF NO LONGER IN A MACRO
MOVE N,MACBID ; FETCH BUFFER ID FOR PREVIOUS MACRO
MOVEI L,MACBUF ; FETCH ADR OF BUFFER REFERENCE
PUSHJ P,FNDBLK ; AND FIND THE PREVIOUS MACRO BUFFER
ERROR (XXX) ; CAN'T. SHOULDN'T OCCUR!
MOVE R,MACBUF ; FETCH ADR OF BUFFER
ADDI PC,(R) ; MAKE PC ABSOLUTE
MOVE X,[<PC,,R>] ; FETCH AC REFERENCES
MOVEM X,T$ACRF(R) ; AND BIND AC REFS TO BUFFER
POPJ P, ; AND RETURN TO CALLER
SUBTTL OPENRD - Select a File for Input
; OPENRD - SELECT A FILE FOR INPUT
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,OPENRD
; (RETURN)
;
; SMASHES ACS N,M. USES AC L
OPENRD: SETZM PAGCNT ; CLEAR THE PAGE COUNTER
TXZ F,F$URD!F$EOF!F$FFD ; CLEAR SOME FLAGS
MOVSI N,(<Z INP,0>) ; CHANNEL FOR FILOPN
MOVEI M,INPBH ; INPUT BUFFER HEADER FOR FILOPN
PUSHJ P,FILOPN ; OPEN DEVICE FOR INPUT
CERR1 (IDV) ; INPUT DEVICE OPEN FAILURE
PUSHJ P,FILLKP ; LOOKUP THE FILE
CERR1 (FNF) ; FILE NOT FOUND
TXO F,F$URD ; NOW READING FROM A FILE
POPJ P, ; RETURN TO CALLER
SUBTTL OPENWR - Select a File for Output
; OPENWR - SELECT A FILE FOR OUTPUT
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,OPENWR
; (RETURN)
;
; SMASHES ACS M,N. USES AC L
OPENWR: TXZ F,F$UWR ; CLEAR SOME FLAGS
MOVSI N,(<Z OUT,0>) ; CHANNEL FOR FILOPN
MOVE M,[<OUTBH,,INIBH>] ; BUFFER HEADERS FOR OUTPUT CHANNEL
; (INIBH 'CAUSE WE LOOKUP A FILE)
PUSHJ P,FILOPN ; OPEN DEVICE FOR OUTPUT
CERR1 (ODV) ; OUTPUT DEVICE OPEN FAILURE
; SEE IF THE FILE ALREADY EXISTS (IE: ARE WE SUPERCEDING IT?)
SKIPN X,FS$PPN(L) ;[404] IS PPN [-] ?
PUSHJ P,GETPTH ;[404] YES, GET PATH(NO WANT 0!)
MOVEM X,FS$PPN(L) ;[404] SAVE UPDATED PPN SPEC
PUSH P,FS$PPN(L) ;[365] THE PPN WILL GET CLOBBERED BY OTHERS
PUSHJ P,FILLKP ; SEE IF THE FILE IS THERE
TDZA T5,T5 ; NO, FLAG THAT IT DOESN'T EXIST
MOVE T5,FS$PPN(L) ;[376] FILE IS THERE. FETCH ITS REAL PPN
POP P,FS$PPN(L) ;[365] THE ONE HE(SHE?) WANTED, NOT OTHERS
; DO THE REAL ENTER
MOVE X,FS$DEV(L) ; FETCH THE DEVICE NAME
DEVCHR X, ; AND GET ITS CHARACTERISTICS
TXNN X,DV.MTA ;[414] NUL: CAN BE MTA AND DIR.(!)
TXNN X,DV.DIR ; IS IT A DIRECTORY DEVICE?
SETZ T5, ;[413] NO, FLAG AS ZERO
CLOSE OUT, ; CLOSE THE OUTPUT CHANNEL
PUSHJ P,FILENT ; DO THE ENTER
CERR1 (ENT) ; ** ENTER UUO FAILURE **
; SEE IF WE ARE SUPERCEDING THE FILE
JUMPE T5,.+3 ;[376] NOT SUPERCEDING IF FLAG 0
CAMN T5,FS$PPN(L) ;[376] DOES FILE "REALLY" EXIST?
WARN (SEF) ; YES, GIVE MSG ABOUT SUPERCEDE
; DONE. FLAG THAT "EW" IN OPERATION AND RETURN TO CALLER
TXO F,F$UWR ; FLAG THAT "EW" IN OPERATION
POPJ P, ; AND RETURN TO CALLER
SUBTTL FILERD - Read a File into a Text Buffer
; FILERD - READ A FILE INTO A TEXT BUFFER
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,FILERD
; (RETURN) ; WITH BUFFER ID IN AC N
;
; SMASHES ACS X,T1-T5
FILERD: SETZ N, ; USE CHANNEL ZERO
MOVEI M,INIBH ; FETCH ADR OF BUFFER HEADER FOR INPUT
PUSHJ P,FILOPN ; AND OPEN THE INPUT DEVICE
CERR1 (IDV) ; ** INPUT DEVICE OPEN FAILURE **
PUSHJ P,FILLKP ; LOOKUP THE INPUT FILE
CERR1 (FNF) ; ** FILE NOT FOUND **
MOVE L,[<FRDREF,,C$CMDL>] ; FETCH ARG FOR 'MAKBUF'
PUSHJ P,MAKBUF ; AND MAKE A BUFFER FOR TEXT OF FILE
; READ THE FILE INTO THE BUFFER
FRD1: SOSGE INIBH+2 ; ANY MORE CHARS IN INPUT BUFFER?
JRST FRD2 ; NO
ILDB C,INIBH+1 ; YES, FETCH THE NEXT ONE
JUMPE C,FRD1 ; IGNORE NULLS
JRST FRD3 ;PROCESS THE CHAR
; INPUT NEXT INPUT BUFFER
FRD2: IN 0, ; INPUT NEXT BUFFER
JRST FRD1 ; AND FETCH A CHAR
STATZ 0,IO.EOF ; FAILED. END-OF-FILE?
JRST FRD5 ; YES, DONE READING FILE
GETSTS 0,IOSTS ; NO, FETCH I/O STATUS
ERROR (IER) ; AND GIVE AN INPUT ERROR MSG
; STORE THE CHAR IN THE TEXT BUFFER
FRD3: SOJL T5,FRD4 ; OUT OF ROOM. EXPAND THE TEXT BUFFER
MOVE T3,FRDREF ; ROOM LEFT. FETCH BASE ADR OF TEXT BUFFER
IDPB C,T4 ; AND STORE THE CHAR IN BUFFER
AOS T$CCNT(T3) ; AND INCREMENT THE CHAR COUNT
JRST FRD1 ; AND FETCH ANOTHER INPUT CHAR
; EXPAND THE TEXT BUFFER WHEN OUT OF ROOM
FRD4: PUSH P,C ; SAVE AC C
PUSH P,N ; SAVE AC N
MOVEI N,C$CMDL ; FETCH #WORDS TO ADD
MOVEI L,FRDREF ; FETCH ADR OF BUFFER REFERENCE
PUSHJ P,EXPAND ; AND EXPAND THE BUFFER
MOVEI T5,C$CMDL*5-2 ; AND RESET THE # CHARS THAT CAN FIT IN BUFFER
POP P,N ; RESTORE AC N
POP P,C ; RESTORE AC C
JRST FRD3 ; AND STORE LAST INPUT CHAR
; DONE READING FILE. CLEAN UP AND RETURN TO CALLER
FRD5: MOVE X,FRDREF ; FETCH BASE ADR OF BUFFER
HRRZS T$1REF(X) ; AND DELETE THE REF TO BUFFER
SETZM FRDREF ; AND CLEAR 'FRDREF'
POPJ P, ; AND RETURN TO CALLER
; MAKBUF - ALLOCATE A TEXT BUFFER AND SETUP CHAR COUNT AND BYTE POINTER
;
; CALL: MOVE L,[<REF,,LEN>]
; PUSHJ P,MAKBUF
; (RETURN)
;
; T4:=BYTE POINTER TO BUFFER (INDEXED BY T3)
; T5:=CHAR COUNT FOR BUFFER(# CHARS THAT'L FIT IN BUFFER)
MAKBUF: PUSH P,L ; SAVE AC L
HLRZ L,L ; FETCH 'REF'
PUSHJ P,RELM ; AND RELEASE ANY EXISTING BLOCK
POP P,L ; RESTORE AC L
HRRI L,T$DATA(L) ; DON'T FORGET BUFFER INFO WORDS!
PUSHJ P,REQM ; AND ALLOCATE THE BUFFER
PUSH P,L ; SAVE AC L
HLRZ L,L ; FETCH 'REF'
PUSHJ P,ADDBLK ; PUT BUFFER IN LINKED LIST
MOVE L,(P) ; FETCH AC L
HLRZ L,L ; FETCH 'REF'
PUSHJ P,FNDBLK ; AND BIND 'REF' TO BUFFER
ERROR (XXX) ; ? ? ?
POP P,L ; RESTORE AC L
IMULI L,5 ; COMPUTE # CHARS IN BUFFER
SUBI L,T$DATA*5+2 ; MINUS #CHARS TAKEN UP BY OVERHEAD
MOVEI T5,(L) ; AND PUT IN AC T4
MOVE T4,[POINT 7,T$DATA(T3)] ; FETCH BP TO BUFFER
POPJ P, ; AND RETURN TO CALLER
SUBTTL TYPEL and TYPE - Type part of Text Buffer
; TYPEL - TYPE LINES OF TEXT BUFFER
;
; CALL: MOVEI ARG,N ; "N" OF "NT" COMMAND
; PUSHJ P,TYPEL
; (RETURN)
;
; SMASHES ACS X,T1,T4
TYPEL: PUSHJ P,EVL2RG ; CHANGE LINE ARG TO CHAR ADDRESSES
SKP ; AND FALL INTO "TYPE"
; TYPE - TYPE TEXT FROM TEXT BUFFER (BETWEEN TWO CHAR ADDRESSES)
;
; CALL: MOVEI SARG,CHAR.ADR1 ; LOWER BOUND
; MOVEI ARG,CHAR.ADR2 ; UPPER BOUND
; PUSHJ P,TYPE
; (RETURN)
;
; SMASHES ACS X,T1-T4
TYPE: PUSHJ P,CHK2RG ; MAKE SURE ARGS ARE IN BOUNDS
MOVE T4,ARG ; COPY SECOND ARGUMENT (M OF N,M)
SUB T4,SARG ; COMPUTE # CHARS TO BE TYPED
JUMPE T4,CPOPJ ; NOTHING TO TYPE. JUST RETURN TO CALLER
$T1: MOVEI T1,(SARG) ; FETCH ADR OF NEXT CHAR
PUSHJ P,GET ; ANF FETCH CHAR FROM BUFFER
PUSHJ P,TCCHR ; AND TYPE IT
AOJ SARG, ; INCREMENT TO NEXT CHAR
SOJG T4,$T1 ; LOOP FOR ALL CHARS TO BE TYPED
POPJ P, ; DONE. RETURN TO CALLER
SUBTTL FILOPN - Open a Device and Setup Buffers
; CALL: MOVE N,[Z CH,0]
; MOVE M,[<OBUF,,IBUF>]
; MOVEI L,FILSPC
; PUSHJ P,FILOPN
; (OPEN FAILURE RETURN)
; (SUCCESS)
;
; 'CH' IS THE I/O CHANNEL TO BE USED
; 'OBUF' IS THE ADR OF THE OUTPUT BUFFER HEADER
; 'IBUF' IS THE ADR OF THE INPUT BUFFER HEADER
; 'FILSPC' IS THE ADR OF THE FILE SPECIFICATION
;
; USES ACS X,T1-T3
FILOPN: MOVEM L,LASSPC ; SAVE ADR OF FILSPC IN CASE OF ERROR
MOVEI T1,.IOASL ; INIT IN ASCII LINE MODE
MOVE T2,FS$DEV(L) ; FETCH THE SIXBIT DEVICE NAME
; MAKE SURE DEVICE IS NOT A TTY CONTROLLED BY A JOB
MOVE X,T2 ; FETCH DEVICE NAME
DEVCHR X, ; AND ITS CHARACTERISTICS
TXNN X,DV.TTY ; IS DEVICE A TTY?
JRST FILOP2 ; NO, OKAY
TXNE X,DV.AVL ; YES, IS IT AVAILABLE?
TXNE X,DV.TTA ; AND NOT CONTROLLED BY A JOB?
ERROR (TTY) ; NO, ERROR
FILOP2: MOVE T3,M ; FETCH THE ADRS OF THE BUFFER HEADERS
MOVE X,FS$FLG(L) ;[334] GET FLAGS
TXNE X,FB$NON ;[334] SEE IF DECTAPE NON STANDARD
TXO T1,IO.NSD ;[334] NON-STANDARD DECTAPE
MOVE X,[OPEN 0,T1] ; SETUP THE OPEN
IOR X,N ; FILL IN THE CHANNEL
XCT X ; DO THE OPEN
POPJ P, ; OFEN FAILURE
; DO INBUF/OUTBUF
TLNN M,-1 ; OUTPUT HEADER SPECIFIED?
JRST FILOP1 ; NO
; DO OUTBUF TO SETUP OUTPUT BUFFERS
HLRZ T1,M ; FETCH ADR OF OUTPUT BUFFER HEADER
MOVEI T1,3(T1) ; FETCH ADR OF OUTPUT BUFFERS
EXCH T1,.JBFF ; AND PUT WHERE MONITOR CAN SEE IT
MOVE X,[OUTBUF 0,C$NBUF] ; GET READY FOR OUTBUF
IOR X,N ; FILL IN THE CHANNEL
XCT X ; DO THE OUTBUF
MOVEM T1,.JBFF ; RESTORE .JBFF
FILOP1: TRNN M,-1 ; INPUT HEADER SPECIFIED?
JRST CPOPJ1 ; NO, GIVE SUCCESS RETURN
; DO INBUF TO SETUP INPUT BUFFERS
MOVEI T1,3(M) ; FETCH ADR OF WHERE BUFFERS WILL GO
EXCH T1,.JBFF ; AND PUT WHERE MONITOR WILL SEE IT
MOVE X,[INBUF 0,C$NBUF] ; GET READY FOR INBUF
IOR X,N ; FILL IN THE CHANNEL
XCT X ; DO THE INBUF
MOVEM T1,.JBFF ; RESTORE .JBFF
JRST CPOPJ1 ; AND RETURN TO CALLER
SUBTTL FILLKP, FILENT, AND FILRNM - File LOOKUP/ENTER/RENAME
; CALL: MOVE N,[Z CH,0]
; MOVEI M,<ESTSIZ> ; ESTIMATED SIZE OF OUTPUT FILE
; MOVEI L,FILSPC
; PUSHJ P,FILLKP ; OR "PUSHJ P,FILENT"
; ; OR "PUSHJ P,FILRNM"
; (LOOKUP/ENTER ERROR)
; (SUCCESS RETURN)
;
; 'CH' IS THE I/O CHANNEL TO BE USED
; 'FILSPC' IS THE ADR OF THE FILE SPECIFICATION
;
; USES ACS X,T1-T4
FILENT: SKIPA T1,[ENTER 0,RBSPC] ; SETUP THE ENTER OPCODE
FILLKP: MOVE T1,[LOOKUP 0,RBSPC] ; SETUP THE LOOKUP OPCODE
FILL1: MOVEM L,LASSPC ; SAVE ADR OF FILE SPEC
; CHECK IF DEVICE IS DISK. IF NOT, USE SHORT BLOCK
MOVE X,FS$DEV(L) ; FETCH THE DEVICE NAME
DEVCHR X, ; AND ITS CHARACTERISTICS
TXNN X,DV.DSK ; IS IT A DISK?
JRST FILL5 ; NO, USE SHORT BLOCK
; CLEAR EXTENDED LOOKUP/RENAME/ENTER ARG BLOCK
STORE (X,RBSPC,RBSPC+.RBSTS,0) ; CLEAR ARG BLOCK
; SET ARG COUNT
MOVEI X,.RBSTS ; FETCH COUNT OF ARGS/VALUES
MOVEM X,RBSPC+.RBCNT ; AND STORE IN ARG BLOCK
; SET PPN
SKIPE X,FS$PPN(L) ; ANY PPN GIVEN?
MOVEI X,FS$PTH(L) ; YES, FETCH ADR OF PATH SPEC
MOVEM X,RBSPC+.RBPPN ; AND STORE IN ARG BLOCK
; SET FILENAME
MOVE X,FS$NAM(L) ; FETCH FILENAME
MOVEM X,RBSPC+.RBNAM ; AND STORE IN ARG BLOCK
; SET FILE EXTENSION
MOVE X,FS$EXT(L) ; FETCH THE FILE EXTENSION
MOVEM X,RBSPC+.RBEXT ; AND STORE IN ARG BLOCK
; SET FILE PROTECTION
MOVE X,FS$PRV(L) ; FETCH THE FILE PROTECTION
MOVEM X,RBSPC+.RBPRV ; AND STORE IN ARGUMENT BLOCK
; SET ESTIMATED SIZE OF FILE
CAXLE M,^D500 ; INSURE VALUE IS WITHIN REASON
SETZ M, ; WELL, DON'T TRY TO MAKE IT HUGE!!
MOVEM M,RBSPC+.RBEST ; SET ESTIMATED SIZE OF FILE
; CHECK FOR A UFD
HLRZ X,FS$EXT(L) ; FETCH FILE EXTENSION
CAIN X,'UFD' ; IS IT A UFD?
JRST FILL3 ; YES, DO SPECIAL PROCESSING
; DO THE LOOKUP/RENAME/ENTER
FILL2: IOR T1,N ; MAKE THE LOOKUP/RENAME/ENTER INST.
XCT T1 ; AND EXECUTE IT
SKIPA X,RBSPC+.RBEXT ; FAILED. GET ERROR CODE AND SKIP
JRST CPOPJ1 ; SUCCEEDED. GIVE SUCCESS RETURN TO CALLER
FILL2A: HRRZM X,LREERR ; STORE THE ERROR CODE FOR LATER
POPJ P, ; AND GIVE FAIL RETURN TO CALLER
; FILE IS A UFD
; SET PPN TO [1,1]
FILL3: MOVE X,[<1,,1>] ; FETCH MFD PPN ([1,1])
MOVEM X,RBSPC+.RBPPN ; AND STORE IN ARG BLOCK
; SET FILE NAME TO PPN OF FILESPEC
MOVE X,FS$PPN(L) ; FETCH PPN OF FILE SPEC
MOVEM X,RBSPC+.RBNAM ; AND STORE IN ARG BLOCK
; SET THE "I AM A DIRECTORY BIT" IN .RBSTS WORD
MOVX X,RP.DIR ; FETCH THE "I AM A DIRECTORY" BIT
MOVEM X,RBSPC+.RBSTS ; AND STORE IN ARG BLOCK
JRST FILL2 ; AND DO THE LOOKUP/RENAME/ENTER
; FILRNM - FILE RENAME
FILRNM: MOVE T1,[RENAME 0,RBSPC] ; SETUP THE RENAME OPCODE
MOVEM L,LASSPC ; SAVE ADR OF FILE SPEC
; JRST FILL5 ; AND DO RENAME WITH SHORT ARG BLOCK
; FOR NON-DISK, USE SHORT ARG BLOCK
FILL5: MOVE X,T1 ; COPY THE LOOKUP/RENAME/ENTER INST.
MOVE T1,FS$NAM(L) ; FETCH THE FILE NAME
MOVE T2,FS$EXT(L) ; FETCH THE FILE EXTENSION
MOVE T3,FS$PRV(L) ; FETCH THE FILE PROTECTION
SKIPE T4,FS$PPN(L) ; ANY PATH?
MOVEI T4,FS$PTH(L) ; YES, FETCH ADR OF PATH SPEC
; FORM THE LOOKUP/RENAME/ENTER INSTRUCTION
IOR X,N ; FILL IN THE CHANNEL
HRRI X,T1 ; FILL IN ADR OF ARG BLOCK
XCT X ; PERFORM THE LOOKUP/RENAME/ENTER
JRST FILL2A ; FAILED
; SAVE SOME INFO IN EXTENDED ARG BLOCK
MOVEM T3,RBSPC+.RBPRV ; SAVE CREATION INFO
JRST CPOPJ1 ; SUCCEEDED. GIVE SUCCESS RETURN TO CALLER
>;; END FOR FTXTEC
FOR FTXTCERR,<
SUBTTL ERMT - Error Message Typeout
ERMT: MOVE X,.JBREN ; SAVE REENTER ADR FOR OTHER SEGMENT
MOVEM X,RENSAV ; AND SAVE FOR RETURN
MOVEM P,SADSAV ; SAVE THE CONTROL PDP
MOVEI X,[MOVE P,SADSAV ; SET NEW REENTER ADR
JRST ERMT3] ; . . .
MOVEM X,.JBREN ; . . .
; SEARCH FOR THE THREE LETTER ERROR CODE
HRLZ X,.JBUUO ;[422] GET ERROR CODE
; LOAD INDEX AOBJN POINTER
MOVSI N,-ERRLEN ;[422] LOAD LENGTH OF TABLE IN AOBJN FORMAT
; SEARCH FOR THE ERROR
ERMT1: HLLZ C,ERRTAB(N) ;[422] FETCH CODE IN TABLE
CAMN X,C ;[422] FOUND?
JRST ERMT2 ;[422] HOORAY! FOUND IT!!
AOBJN N,ERMT1 ;[422] CONTINUE SEARCHING
JRST ERMTE ;[422] OOPS! FORGOT TO PUT CODE IN TEXT!
; CODE WAS FOUND
ERMT2: MOVX T5,<POINT 7,> ;[422] MAKE T5 A BYTE POINTER TO ERRTAB
HRR T5,ERRTAB(N) ;[422] . . .
PUSHJ P,ERMTL ; TYPE THE LINE
; CHECK IF EXTENDED MESSAGE DESIRED
MOVE X,EHVAL ; FETCH MESSAGE LENGTH
TXNE X,JW.WCN ; WANT MESSAGE CONTINUATION?
JRST ERMT5 ; YES
SETO T4, ; CLEAR FLAG THAT WE TYPE ALL OF MSG
ERMT3: LDB T1,[POINT 9,.JBUUO,8] ; FETCH LUUO OPCODE
CAIN T1,LUUWRN ; A WARNING?
JRST ERMT34 ;[416] YES, NEVER DIE
MOVX X,C$CCNM ; FETCH THE CCL MACRO NAME
CAMN X,MACNAM ; EXECUTING THE CCL COMMAND?
EXIT 1, ; YES, EXIT FOR FATAL CCL ERROR
; (USER CAN TYPE "CONTINUE" FOR
; MORE INFORMATION)
; PEEK AT NEXT INPUT CHAR TO SEE IF USER WANTS CONTINUATION OF MSG
ERMT34: MOVEI C,"*" ; TYPE FAKE PROMPT CHAR.
PUSHJ P,TCHR ; . . .
PUSHJ P,GETCH ; AND PEEK AT FIRST CHAR
CAIN C,"/" ; WANT CONTINUATION OF MESSAGE?
AOJLE T4,ERMT5 ; YES, IF WE HAVEN'T TYPED IT YET
CAIN C,"?" ; WANT TO SEE LAST 10 COMMANDS?
JRST ERMT4 ; YES
MOVEM C,INPCHR ; NO, SAVE CHAR FOR LATER
JRST ERMTZ ; AND FINISH UP
; TYPE LAST 10 COMMANDS
ERMT4: PUSH P,T4 ;[405] SAVE MSG FLAG...
PUSHJ P,ERRCTY ; TYPE LAST 10 COMMANDS
POP P,T4 ;[405] BECAUSE "ERRCTY" CLOBBERS IT
JRST ERMT3 ; AND GO BACK FOR MORE
; GIVE EXTENDED MESSAGE
ERMT5: ILDB C,T5 ; FETCH NEXT CHAR FROM TEXT
CAIG C,.CHCNH ; IS CHAR ^@,...,^H?
JRST ERMT3 ; YES, THEN WE'RE DONE
PUSHJ P,TCHR ; NO, TYPE THE CHAR
PUSHJ P,ERMTL ; AND REST OF LINE
JUMPE C,ERMT3 ;[422] IF NULL, QUIT
JRST ERMT5 ; AND TRY FOR ANOTHER LINE
; DONE. RETURN TO CONTROL SEGMENT
ERMTZ: MOVE X,RENSAV ; RESTORE PREVIOUS REENTER ADR
MOVEM X,.JBREN ; . . .
MOVE P,SADSAV ; RESTORE PREVIOUS CONTROL PDP
MOVE X,SEGNAM ; FETCH NAME OF CONTROL SEGMENT
MOVEM X,GSGNAM ; AND STORE IN GETSEG BLOCK
PJRST GETSG ; AND DO THE GETSEG
; CAN'T FIND THE ERROR CODE IN TEXT
ERMTE: MOVEI N,[ASCIZ/ *** UNDEFINED ERROR CODE ***
/]
PUSHJ P,TSTR ; TYPE THE MESSAGE
JRST ERMTZ
; TYPE A LINE FROM ERROR MESSAGE TEXT
ERMTL: ILDB C,T5 ; FETCH NEXT CHAR OF TEXT
JUMPE C,CPOPJ ;[422] RETURN IF NULL
CAIN C,.CHCNN ; IS IT A CONTROL-N?
JRST ERMTLN ; YES, PROCESS IT
PUSHJ P,TCHR ; NO, TYPE THE CHAR
CAIN C,.CHLFD ; IS IT A <LF>?
POPJ P, ; YES, RETURN TO CALLER
JRST ERMTL ; NO, KEEP TYPING THE LINE
; ERMTLN - PROCESS CONTROL-N IN LINE OF TEXT
ERMTLN: ILDB X,T5 ; FETCH FIRST DIGIT ON ^NDD
MOVEI X,-"0"(X) ; CONVERT CHAR TO A DECIMAL DIGIT
IMULI X,^D10 ; MAKE ROOM FOR SECOND DIGIT
ILDB C,T5 ; FETCH SECOND DIGIT
ADDI X,-"0"(C) ; ADD IN THE SECOND DIGIT
ROT X,-1 ; DIVIDE BY TWO AND KEEP THE REMAINEDER
MOVE T1,CNNTBL(X) ; FETCH TWO ADDR DISPATCH ENTRY
JUMPL X,.+2 ; SKIP IF NUMBER IS ODD
HLRZ T1,T1 ; ODD, FETCH OTHER DISPATCH ADDR
PUSHJ P,(T1) ; AND DISPATCH
JRST ERMTL ; DONE. CONTINUE MESSAGE PROCESSING
; CNNTBL - DISPATCH TABLE FOR ^N ITEMS IN MESSAGES
CNNTBL:
<CNNCCH,,CNNOFL> ; 00 01
<CNNFIL,,CNNERC> ; 02 03
<CNNDEV,,CNNPTH> ; 04 05
<CNNARG,,CNNPRO> ; 06 07
<CNNEBF,,CNNIFL> ; 08 09
<CNNEBN,,CNNIOF> ; 10 11
<CNNTAG,,CNNSKP> ; 12 13
<CNNISK,,0> ; 14 15
<CNNEOV,,CNNSRH> ; 16 17
<CNNTSC,,CNNSWT> ; 18 19
; ^N00 - TYPE CURRENT COMMAND CHAR
CNNCCH: PUSHJ P,CMDBCH ; BACKUP 2 CHARS
PUSHJ P,CMDBCH ; . . .
PUSHJ P,CMDGCH ; GET PREVIOUS CHAR
JFCL ; (WHY???)
CAIN C,"^" ; IS THIS AN ^<CHAR> COMMAND?
PUSHJ P,TCHR ; YES, TYPE AN "^" FIRST
PUSHJ P,CMDGCH ; AND FETCH THE CURRENT CHAR
JFCL ; (SHOULDN'T OCCUR)
PJRST TSCHR ; TYPE THE CHAR AND RETURN TO CALLER
; ^N01 - TYPE OUTPUT FILE-NAME AND EXTENSION
CNNOFL: MOVEI L,LEBSPC ; FETCH ADR OF LAST OUTPUT FILE-SPEC
PJRST TFSPEC ; AND TYPE FILE-NAME AND RETURN
; ^N02 - TYPE FILE-NAME REFERENCES BY LAST UUO
CNNFIL: MOVE L,LASSPC ; FETCH ADR OF LAST FILE SPEC
PJRST TFSPEC ; AND TYPE THE FILE-NAME AND EXTENSION
; ^N03 - TYPE MONITOR ERROR CODE (L-E-R)
CNNERC: MOVE N,LREERR ; FETCH LAST LOOKUP/RENAME/ENTER CODE
PJRST TOCT ; AND TYPE IT IN OCTAL
; ^N04 - TYPE OUTPUT DEVICE NAME
CNNDEV: MOVEI L,LEBSPC ; FETCH ADDR OF LAST OUTPUT FILE-SPEC
TXNN F,F$UBK ; DOING "EB"?
MOVEI L,LEWSPC ; NO, DOING "EW"
PJRST TDEV ; AND TYPE THE DEVICE NAME
; ^N05 - TYPE LAST FILE-SPEC PATH
CNNPTH: MOVE L,LASSPC ; FETCH ADR OF LAST FILE-SPEC
PJRST TPATH ; AND TYPE PATH AND RETURN
; ^N06 - TYPE ARG VALUE
CNNARG: MOVE N,ARG ; FETCH THE ARG VALUE
PJRST TDEC ; TYPE IT AND RETURN
; ^N07 - TYPE LAST FILE PROTECTION
CNNPRO: MOVE N,LASSPC ; FETCH LAST FILE-SPEC
PJRST TPROT ; TYPE PROTECTION AND RETURN
; ^N08 - TYPE LAST "EB" FILE-NAME
CNNEBF: MOVE N,LEBSPC+FS$NAM ;[337] GET .BAK NAME
PJRST TSIX ;[337] TYPE FILE-NAME AND RETURN
; ^N09 - TYPE LAST INPUT FILE NAME
CNNIFL: MOVEI L,LEBSPC ; FETCH ADR OF LAST INPUT FILE-SPEC
PJRST TFSPEC ; TYPE FILE-NAME AND RETURN
; ^N10 - TYPE ORIGINAL "EB" FILE-NAME
CNNEBN: PJRST CNNOFL ;[237] TYPE ORIGINAL SPEC
; ^N11 - TYPE I/O STATUS FLAGS
CNNIOF: HRRZ N,IOSTS ; FETCH I/O STATUS FLAGS
PJRST TOCT ; AND TYPE IN OCTAL
; ^N12 - TYPR CURRENT TAG
CNNTAG: HLRZ T1,1(REF) ; FETCH CHAR.ADR OF CURRENT TAG
IDIVI T1,5 ; AND FORM A BYTE POINTER
HLL T1,CBPTBL-1(T2) ; . . .
ADD T1,@CMDBUF ; MAKE IT ABSOLUTE
MOVE T2,2(REF) ; FETCH CHAR COUNT FOR TAG
CNNTG1: JUMPE T2,CPOPJ ; RETURN IF DONE
ILDB C,T1 ; FETCH NEXT CHAR FROM TAG
PUSHJ P,TCCHR ; AND TYPE IT
SOJA T2,CNNTG1 ; AND TRY FOR ANOTHER CHAR
; ^N13 - SKIP TO ^ANN WHEN NN IS LRE ERROR CODE IN OCTAL
; (LRE="LOOKUP/RENAME/ENTER")
CNNSKP: LDB T2,[POINT 6,LREERR,35] ; FETCH LRE ERROR CODE
CNNSK1: ILDB C,T5 ; FETCH NEXT TEXT CHAR
CAIN C,.CHCNB ; ^B?
POPJ P, ; YES, PRINT DEFAULT MESSAGE
CAIE C,.CHCNA ; ^A?
JRST CNNSK1 ; NO, TRY AGAIN WITH NEXT CHAR
; FOUND ^A. SEE IF NN MATCHES
ILDB C,T5 ; FETCH FIRST OCTAL DIGIT
MOVEI T1,-"0"(C) ; CONVERT TO A NUMBER
LSH T1,3 ; MAKE ROOM FOR SECOND DIGIT
ILDB C,T5 ; FETCH THE SECOND DIGIT
IORI T1,-"0"(C) ; ADD IN THE SECOND DIGIT
CAIE T1,(T2) ; DOES NN MATCH?
JRST CNNSK1 ; NO, TRY AGAIN
POPJ P, ; YES, TYPE OUT THE LINE
; ^N14 -SKIP TO ^ANN WHERE NN IS OCTAL FOR BITS 18-21 OF I/O STATUS
CNNISK: LDB T2,[POINT 4,IOSTS,21] ; FETCH 4 RELEVANT STATUS BITS
JRST CNNSK1 ; AND FIND THE PROPER MESSAGE
; ^N16 - TYPE "EO" VALUE
CNNEOV: MOVEI N,C$EOVL ;[406] FETCH THE "EO" VALUE
PJRST TDEC ; TYPE IT AND RETURN
; ^N17 - TYPE SEARCH ARG
CNNSRH: MOVEI N,SRHARG ; FETCH ADR OF SEARCH ARG
PJRST TSSTR ; TYPE IT AND RETURN
; ^N18 - TYPE ...
CNNTSC: POPJ P, ; . . .
; ^N19 - TYPE SWITCH NAME
CNNSWT: MOVE N,SBNAME ; FETCH THE SWITCH NAME
PJRST TSIX ; TYPE IT AND RETURN
SUBTTL ERRTXT - Text of All Error Messages
CINFO. ; CLEAR THE INFO/REDEF MECHANISM
; MACRO TO DEFINE AN ERROR TEXT
DEFINE ERRGEN(PREFIX,TEXT)<
LSTOF.
E$$'PREFIX': ASCIZ\'TEXT'\
INFO. (REDEF.,<%EGEN ('PREFIX')>)
LSTON.
>
ERRGEN ARG,< Improper Arguments
The following argument combinations are illegal:
1) , (no argument before comma)
2) M,N, (where M and N are numeric terms)
3) H, (because H=B,Z is already two arguments)
4) ,H (H following other arguments)
>
ERRGEN ASN,< Ambiguous Switch Name: /19
The switch "/19" is not uniquely abbreviated, i.e. more than
one switch will match "/19". A longer, unique form of the
switch should be used.
>
ERRGEN BAK,< Cannot Delete Old Backup File
Failure in RENAME process at close of editing job initiated by an EB
command or a TECO command. There exists an old backup file 08.BAK
with a protection 07 such that it cannot be deleted. Hence the
input file 10 cannot be renamed to "08.BAK". The output file
is closed with the filename "01". The RENAME MUUO
error code is 03.
>
ERRGEN CCM,< CCL Command Missing
XTEC was run with a run-offset of one (1) and there was no file
'EDT' in TMPCOR or '###EDT.TMP' on the user's disk area.
>
ERRGEN CEF,< Core expansion failure
The current operation requires more memory storage than XTEC now has
and XTEC is unable to obtain more core from the monitor. This message
can occur as a result of any one of the following things:
1) Command buffer overflow while a long command string is being typed,
2) Q-register buffer overflow caused by an X or [ command.
3) Too many Q-registers in use (.gt.5000),
4) Too much nesting or recursion of the M command.
5) Editing buffer overflow caused by an insert command or
a read command or other causes.
>
ERRGEN CFP,< Can't Find Overflowed PDL
A PDL overflow trap occurred, but XTEC could not find the PDL
that caused the overflow. This is an internal error and should be
reported, along with a teletype printout showing what the user was
doing.
>
ERRGEN CON,< Confused use of conditionals
Conditionals, parenthesized arguments, and iterations must be properly
nested. The user probably used some construct like: N"E...(...' where
an iteration or parenthesized argument is begun in a conditional
but not terminated in the same conditional.
>
ERRGEN EBD,< EB with Device 04 is Illegal
The EB command and the TECO command may be specified only with
file structured devices (ie: disk and DECtape.)
>
ERRGEN EBF,< EB with Illegal File 02
The EB command and the TECO command may not be used with a file
having the filename extension ".BAK" or a file having the name
"NNNXTC.TMP" where NNN is the user's job number. The user must
either use an ER-EW sequence or rename the file.
>
ERRGEN EBO,< ER or EW Before Current EB Closed
An ER or EW command may not be given while an EB command is in
progress. Give an EF to close the files if you wish
to do an ER or EW.
>
ERRGEN EBP,< EB Illegal because of file 02 Protection
The file 02 cannot be edited with an EB command or a TECO command
because it has a protection 07 such that it cannot be renamed
at close time.
>
ERRGEN EMA,< EM with Illegal Argument
The argument N in an NEM command must be greater than zero.
>
ERRGEN EMD,< EM with no Input Device Open
EM commands apply only to the input device, and should be preceded
by an ER (or equivalent) command. To position a tape for output, that
unit should be temporarily opened for input while doing the EM commands.
>
ERRGEN END,< EN with a Device is Illegal
Since it is not possible to RENAME across devices. There must be
no device specified in an EN command. The device is specified
in the ER command which selected the file.
>
ERRGEN ENO,< EN REQUIRES AN OPEN INPUT FILE
EN commands apply to the file currently open for input. You must
execute an ER command to select the file to be RENAME'd or deleted
before executing an EN.
>
ERRGEN ENT,< 13
00Illegal Output Filename "02"
ENTER UUO failure 0. The filename "02" specified for the
output file cannot be used. the format is invalid.
01Output UFD for the file "02" not found
ENTER UUO failure 1. The file 02 specified
for output by an EE, EW, EA, EZ, OR MAKE command cannot be created
because there is no user file directory with the project-programmer
number 05 on device 04.
02Output Protection Failure
ENTER UUO failure 2. The file 02 specified
for output by an EE, EA, EZ, EB, MAKE, or TECO command cannot be
created either because it already exists and is write-protected against
the user, or because the UFD it is to be entered into is write-
protected against the user.
03Output File being Modified
ENTER UUO failure 3. The file 02 specified for output
by an EE, EW, EA, EZ, EB, or TECO command cannot be created
because it is currently being created or modified by another job.
06Output UFD or RIB Error
ENTER UUO failure 6. The output file 02 cannot be
created because a bad directory block was encountered by the
monitor while the ENTER was in progress. The user may try
repeating the EE, EW, EA, EB, or TECO COMMAND, BUT IF The ERROR
PERSISTS, IT IS IMPOSSIBLE TO PROCEED. Notify your system manager.
14No Room or Quota Exceeded on 04
ENTER UUO FAILURE 14. The output file 02 cannot be
created because there is no more free space on device 04 or
because the user's quota is already exceeded there.
15Write Lock on 04
ENTER UUO failure 15. The output file 02 cannot be
created because the output file structure is write-locked.
16Monitor Table Space Exhausted
ENTER UUO failure 16. The output file 02 cannot be
created because there is not enough table space left in the
monitor to allow the enter. The user may try repeating the
EE, EW, EA, EB, or TECO command, but if the error persists
he or she will have to wait till conditions improve.
23Output SFD Not Found
ENTER UUO failure 23. The output file 02 cannot be
created because the Sub-File-Directory on which it should be
entered cannot be found.
24Search List Empty
ENTER UUO failure 24. The output file 02 cannot be
created because the user's file structure search list is empty.
25Output SFD Nested Too Deeply
ENTER UUO failure 25. The output file 02 cannot be
created because the specified SFD path for the ENTER
is nested too deeply.
26No Create for Specified SFD Path
ENTER UUO failure 26. The output file 02 cannot be
created because the specified sfd path for the ENTER
is set for no creation.
ENTER FAILURE 03 on Output File 02
The attempted ENTER of the output file 02 has failed and
the monitor has returned an error code of 03. This error
is not expected to occur on an ENTER. Please report it to your
systems manager with the tty printout showing what you were doing.
>
ERRGEN EOA,< 06EO Argument Too Large
The argument 06 given with an EO command is larger than the
standard (maximum) setting of eo=16 for this version of XTEC.
This must be an older version of XTEC than the user thinks he
is using; the features corresponding to EO=06 do not exist.
>
ERRGEN FNF,< 13
00Input File 02 not Found
LOOKUP UUO failure 0. The file 02 specified for input by an
ER, EB, EI, EP, OR TECO command was not found on the
input device 04.
01Input UFD - not Found
LOOKUP UUO failure 1. The file 02 specified for input by
an ER, EB, EI, EP, OR TECO command cannot be found
because there is no User File Directory with project-programmer
number 05 on device 04.
02Input Protection Failure
LOOKUP UUO failure 2. The file 02 specified for input
by an ER, EB, EI, EP OR TECO command cannot be read
because it is read-protected 07 against the user.
06Input UFD or RIB Error
LOOKUP UUO failure 6. The input file 02 cannot be
read because a bad directory block was encountered by the
monitor while the LOOKUP was in progress. The user may try
repeating the ER, EB, EI, EP OR TECO command, but if the error
persists all is lost. Notify your system manager.
16Monitor Table Space Exhausted
LOOKUP UUO failure 16. The input file 02 cannot be
read because there is not enough table space left in the
monitor to allow the LOOKUP. The user may try repeating the
ER, EB, EI, EP, OR TECO command, but if the error persists
he or she will have to wait until conditions improve.
23Input SFD not Found
LOOKUP UUO failure 23. The input file 02 cannot be found
because the sub-file-directory on which it should be looked up
cannot be found.
24Search List Empty
LOOKUP UUO failure 24. The input file 02 cannot be
found because the user's file structure search list is empty.
25Input SFD Nested Too Deeply
LOOKUP UUO failure 25. The input file 02 cannot be found
because the specified SFD path for the LOOKUP is
nested too deeply.
Lookup Failure (03) on Input File 02
The attempted LOOKUP on the input file 02 has failed and
the monitor has returned an error code of 03. This error
is not expected to occur on a LOOKUP. Please give the
terminal prinout showing what you were doing to your system manager.
>
ERRGEN ICE,< Illegal ^E Command in Search Argument
A search argument contains a ^E command that is either not defined
or incomplete. The only valid ^E commands in search arguments are:
^EA, ^ED, ^EV, ^EW, ^EL, ^ES, ^E<NNN>, and ^E[A,B,C,...].
>
ERRGEN ICN,< Illegal ^N Command in Search Argument
When used in a search argument, the ^N command must be followed
by a character.
>
ERRGEN ICT,< Illegal Control Command 00 in Text Argument
IN ORDER TO BE ENTERED AS TEXT IN AN INSERT COMMAND OR SEARCH COMMAND,
ALL CONTROL CHARACTERS (^@ - ^H AND ^N - ^_) MUST BE PRECEDED
BY ^R, ^Q, OR ^T. Otherwise they are interpreted as
commands. The control character "18" is an undefined text argument
control command.
>
ERRGEN IDV,< Input Device 04 not Available
INITIALIZATION FAILURE. Unable to initialize the device 04
for input. Either the device is being used by someone else right
now, or else it does not exist in the system.
>
ERRGEN IEC,< Illegal Character 00 After E
The ONLY COMMANDS STARTING WITH The LETTER E ARE EA, EB, ED, EE, EF, EG,
EH, EI, EL, EM, EN, EO, EP, ER, ET, EU, EW, EY, and EZ.
WheN USED AS A COMMAND (IE: NOT IN A TEXT ARGUMENT) E MAY NOT
BE FOLLOWED BY ANY CHARACTER EXCEPT ONE OF TheSE.
>
ERRGEN IEM,< Re-Init Failure on Device 04 After EM
Unable to re-initialize the device 04 after executing an
EM command on it. If this error persists after retrying to
initialize the device with an ER command(or EW command
if output to the device is desired), consult your system manager.
>
errgen IER,< Input Error While Reading a File
While reading an initialization, EI, EP, etc. an i/o error
occurred.
>
ERRGEN IES,< Input Error While Reading SWITCH.INI
An I/O error occurred whilst reading SWITCH.INI.
>
ERRGEN IFC,< Illegal Character "00" After F
The only commands starting with the letter F are FD, FN, and FS.
When used as a command (other than EF or in a text argument)
F may not be followed by any character other than one of these.
>
ERRGEN IFS,< Illegal Character "00" in File Specification
File specifications must be of the form: DEV:FILE.TXT[PATH]
where DEV, FILE, and EXT are alphanumeric strings. No
characters other than these may appear between the EB, ED, EE, EI,
EN, EP, EW, or EZ command and the altmode terminator ($).
>
ERRGEN ILL,< Illegal Command: 00
The character "00" is not defined as a valid XTEC command.
>
ERRGEN ILM,< Illegal Memory Reference
XTEC made an illegal memory reference. This is an internal
error and should be reported, along with a teletype printout showing
what the user was doing. The value of the buffer pointer is set to
the beginning of the buffer; the buffer and file should(hopefully)
remain intact.
>
ERRGEN ILR,< Cannot LOOKUP Input File 09 to RENAME it
Failure in rename process at close of editing job initiated by
an EB command or a TECO command. Unable to do a LOOKUP on the
original input file 10 in order to RENAME it to
"08.BAK". The output file is closed with the name "01".
The LOOKUP UUO error code is 03.
>
ERRGEN ILS,< Illegal EL Specification
A numeric specification for the EL command must be greater
than or equal to 0, and less than or equal to 3.
>
ERRGEN INP,< Input Error 11 on File 09
A read error has occurred during input. The input file 09
has been released. The user may try again to read the file, but if
the error persists, the user will have to return to his or her backup file.
The input device error flags (status word right half with bits 22-35
masked out) are 11 (14
01BLOCK TOO LARGE).
02PARITY OR CheCKSUM ERROR).
03BLOCK TOO LARGE AND PARITY ERROR).
04DEVICE ERROR, DATA MISSED).
05BLOCK TOO LARGE AND DEVICE ERROR).
06PARITY ERROR AND DEVICE ERROR).
07BLOCK TOO LARGE, PARITY ERROR, AND DEVICE ERROR).
10IMPROPER MODE).
11BLOCK TOO LARGE AND IMPROPER MODE).
12PARITY ERROR AND IMPROPER MODE).
13BLOCK TOO LARGE, PARITY ERROR, AND IMPROPER MODE).
14DEVICE ERROR AND IMPROPER MODE).
15BLOCK TOO LARGE, DEVICE ERROR, AND IMPROPER MODE).
16PARITY ERROR, DEVICE ERROR, AND IMPROPER MODE).
17BLOCK TOO LARGE, PARITY ERROR, DEVICE ERROR,
AND IMPROPER MODE).
>
ERRGEN IPP,< Illegal Character "00" in PPN
A PPN IS OF The FORM [PJ,PG,SFD1,...,SFDN]
WheRE "PJ", "PG", AND ",SFD1,...,SFDN" ARE OPTIONAL.
"PJ" AND "PG" MUST BE OCTAL NUMBERS. AN SFD is an alphanumeric
or quoted string.
>
ERRGEN IPR,< Illegal Character 00 in /PROTECT Switch
The format of the /PROTECT switch is: /PROTECT:NNN
Where NNN is an octal number and may optionally be
enclosed in angle brackets (ie: /protect:<nnn>.)
>
ERRGEN IQC,< Illegal Character "00" after " Command
The ONLY VALID " COMMANDS ARE "G, "L, "N, "E, "C,
"A, "D, "V, "W, "T, "F, "S, and "U.
>
ERRGEN IQN,< Illegal Character "00" in Q-Register Name
A Q-REGISTER NAME MUST BE IN ONE OF three FORMATS:
1) I WheRE I IS A LETTER OR DIGIT, OR
2) (A) WheRE A IS AN ALPHANUMERIC OR QUOTED STRING,OR
3) *
>
ERRGEN IRB,< Cannot Rename Input File 09 to 08.BAK
Failure in rename process at close of editing job initiated by an
EB command or a TECO command. The attempt to rename the original
input file 10 to the backup filename "08.BAK"
has failed. The output file is closed with the name "01".
The RENAME UUO error code is 03.
>
errgen IRN,< Cannot Re-Init Device 04 for Rename Process
Failure in rename process at close of editing job initiated by
an EB command or a TECO command. Cannot reinitialize
the original input device 04 in order to rename the input file
01 to 08.BAK. The output file is closed with the
name 02.
>
ERRGEN ISW,< Illegal Character "00" in a Switch
AN ARGUMENT WAS EXPECTED AFTER The SWITCH "/19". A
COLON (:) WAS EXPECTED.
>
ERRGEN ITT,< Illegal TTCALL Type Value 06
The EXTENDED TTCALL command must take the form ":arg1,arg2^T"
where arg1 is the (optional) TTCALL argument and arg2 is the
TTCALL type in decimal. The second argument must be a
legitimate TTCALL type, With 0-13 legal except for 3(OUTSTR).
Type 8 (RESCAN) WILL DO A RESCAN unless there is an arg1, in
which case it tests for CCL mode.
>
ERRGEN IUU,< Illegal LUUO
A local uuo was encountered which is not legal. This error
should not occur. close your files and report this problem
to your system manager.
>
ERRGEN LDV,< Cannot Access Log Device
I can't get that device for a log file, dummy!
>
ERRGEN LFE,< Cannot ENTER Log File
I can't make the file, dummy!
>
ERRGEN MAP,< Missing '
Every conditional (opened with the " command) must be closed
with the ' command.
>
ERRGEN MCP,< Missing Control PDL
A pdl overflow was trapped and the control pdl was found to be
missing. This error should not occur. Close your files
and report the problem to your system manager.
>
ERRGEN MEE,< Macro Ending with E
A COMMAND MACRO BEING EXECUTED FROM A Q-REGISTER ENDS WITH The
CHARACTER "E". THIS IS AN INCOMPLETE COMMAND. E IS The INITIAL
CHARACTER OF AN ENTIRE SET OF COMMANDS. The OTheR CHARACTER OF
The COMMAND BEGUN BY E MUST BE IN The SAME MACRO WITH The E.
>
ERRGEN MEF,< Macro Ending with F
A command macro being executed from a Q-register ends with the
character "F". This is an incomplete command. F is the initial
character of an entire set of commands. The other character
of the command begun by F must be in the same macro with the F.
>
ERRGEN MEO,< Macro Ending with Unterminated O Command
The LAST COMMAND OF A COMMAND MACRO BEING EXECUTED FROM A
Q-REGISTER IS AN O COMMAND WITH NO ALTMODE TO MARK The END
OF The TAG-NAME ARGUMENT. The ARGUMENT FOR The O COMMAND MUST
BW COMPLETE WITHIN The Q-REGISTER.
>
ERRGEN MEQ,< Macro Ending with "
A COMMAND MACRO BEING EXECUTED FROM A Q-REGISTER ENDS WITH
The " CHARACTER. THIS IS AN INCOMPLETE COMMAND. The " COMMAND
MUST BE FOLLOWED BY ONE OF The CHARACTES G, L, N, E, C, A, D,
V, W, T, F, S, or U to indicate the condition under which the
following commands are to be executed. This character must be in
the Q-register with the ".
>
ERRGEN MEU,< Macro Ending with ^
A COMMAND MACRO BEING EXECUTED FROM A Q-REGISTER ENDS WITH
The ^ CHARACTER. THIS IS AN INCOMPLETE COMMAND. The ^ COMMAND
TAKES A SINGLE CHARACTER TEXT ARGUMENT THAT MUST BE IN The
Q-REGISTER WITH The ^.
>
ERRGEN MIQ,< Macro Ending with "00"
A COMMAND MACRO BEING EXECUTED FROM A Q-REGISTER ENDS WITH
The CHARACTER "00". THIS IS AN INCOMPLETE COMMAND. The 00
COMMAND TAKES A SINGLE CHARACTER TEXT ARGUMENT TO NAME The Q-REGISTER
TO WHICH IT APPLIES. THIS ARGUMENT MUST BE IN The SAME MACRO
AS The 00 COMMAND ITSELF.
>
ERRGEN MLA,< Missing Left Angle Bracket
TheRE IS A RIGHT ANGLE BRACKET NOT MATCheD MY A LEFT ANGLE BRACKET
SOMEWheRE TO ITS LEFT. (NOTE: AN ITERATION IN A MACRO STORED IN A
Q-REGISTER MUST BE COMPLETE WITHIN The Q-REGISTER.)
>
ERRGEN MLP,< Missing (
COMMAND STRING CONTAINS A RIGHT PARENTheSIS THAT IS
NOT MATCheD BY A CORRESPONDING LEFT PARENTheSIS.
>
ERRGEN MRA,< Missing Right Angle Bracket
AN ITERATION THAT WAS BEGUN WITH A left angle bracket MUST
BE TERMINATED BY A RIGHT ANGLE BRACKET. (NOTE: ITERATIONS
MUST BE COMPLETE WITHIN A SINGLE MACRO LEVEL.)
>
ERRGEN MRP,< Missing )
AN EXPRESSION WHICH WAS BEGUN WITH A LEFT PARENTheSIS MUST BE
TERMNATED WITH A RIGHT PARENTheSIS.
>
ERRGEN MSC,< Missing Start of Conditional
A ' command (end of conditional) was encountered. Every '
command must be matched by a preceding " (start of conditional)
command.
>
ERRGEN MUU,< Macro Ending with ^^
a command macro being executed from a q-register ends with
control-^ or ^^. This is an incomplete command. The ^^command takes
a single character text argument that must be in the Q-register
with the ^^.
>
ERRGEN NAE,< No Argument Before =
The command N= or N== causes that value N to be typed. The
= command must be preceded by either a specific numeric
argument or a command that returns a numeric value.
>
ERRGEN NAI,< No Altmode After I
Unless the EO value has been set to 1, the numeric insert
command NI must be immediately followed by altmode.
>
ERRGEN NAQ,< No Argument Before "
The " command must be preceded by a single numeric argument
on which the decision to execute the following commands
or skip to the matching ' is based.
>
ERRGEN NAU,< No Argument Before U
The command NUI stores the value N in Q-register I.
The U command must be preceded by either a specific numeric
argument or a command that returns a numeric value.
>
ERRGEN NFI,< No File for Input
Before issuing an input command (Y, ^Y, or A) it is necessary
to open an input file by use of an ER, EB, or TECO command.
>
ERRGEN NFO,< No File for Output
Before giving an output command (PW, P, ^P, N, EX, or EG) it is
necessary to open an output file by use of an EA, EB, EW, EZ, MAKE,
or TECO command.
>
ERRGEN NLF,< No Log File Open
A command of the form nEL was given, but there is no log file
open to have parameters modified.
>
ERRGEN NNQ,< Non-Numeric in Q-Register "19"
The Q-register "19" does not contain a number.
>
ERRGEN NSI,< Null Switch Name is Illegal
A switch name must consist of one or more alphanumeric characters.
>
ERRGEN NTQ,< No Text in Q-register "19"
The Q-register "19" does not contain text.
>
ERRGEN ODV,< Output Device 04 Not Available
Initialization failure. Unable to initialize the device 04
for output. Either the device is being used by someone else
right now, or it is write locked, or else it does not exist in
the system.
>
ERRGEN OUT,< Output Error 11. Output File 10 Closed
An error on the output device is fatal.
The output file is closed at the end of the last data that
was successfully output. It has the filename "01".
See the TECO Reference Manual section 4.4 for a recovery
technique. The output device flags (status word right half
with bits 22-35 masked out) are 11 (14
00End of Tape).
01Block Number Too Large, Device Full or Quota Exceeded).
02Parity or Checksum Error).
Block Number Too Large and Parity Error).
04Device Error, Data Missed).
05Block Number Too Large and Device Error).
06Oarity Error and Device Error).
07Block Number Too Large, Parity Error, and Device Error).
10Improper Mode or Device Write Locked).
11Block Number Too Large and Improper Mode).
12Parity Error and Improper mode).
13Block Number Too Large, Parity Error, and Improper Mode).
14Device Error and Improper Mode).
15Block Number Too Large, Device Error, and Improper Mode).
16Parity Error, Device Error, and Improper Mode).
17Block Number Too Large, Parity Error, Device Error,
and Improper Mode).
>
ERRGEN OWL,< OUTPUT ERROR writing LOG FILE
AN OUTPUT ERROR OCCURED, DUMMY!
>
ERRGEN PAR,< Confused Use of Parentheses
An iteration may not be contained within a parenthesized expression.
>
ERRGEN PES,< Attempt to Pop Empty Stack
A ] command (pop off q-register stack into a q-register) was
encountered when there was nothing on the q-register stack.
(Note: The Q-register stack is cleared after every double altmode.)
>
ERRGEN PNF,< Page Number 06 Not Found
An attempt to move to page 06 of the input file 02
was made with the ^P or ^Y command. that page does not exist in the
input file.
>
ERRGEN POP,< Attempt to move Pointer Off Page with C,R,J, OR D
The argument specified with a J, C, R, or D command must point to
a position within the current size of the buffer. (ie: between B
and Z inclusive.)
>
ERRGEN PPC,< Attempt to Move Previous to Current page with ^P or ^Y
The argument to a ^P or ^Y command is an absolute page number in the
file. it must be greater than or equal to the current page number.
>
ERRGEN PTS,< PDL Table Too Small
There are not enough ENTRIES in the pdl table. This error is not
expected to occur. Close your files and report the problem to your
system manager.
>
ERRGEN RNF,< 13
01UFD for 02 Not Found
RENAME UUO failure 1. The new filespec 01 specified
by an EN command cannot be used because there is no directory
05 on device 04.
02Protection Failure for 01
RENAME UUO faulure 2. the filespec 01 specified
by an EN command cannot be used because you are not privileged
to RENAME the input file.
03File Being Modified
RENAME UUO failure 3. The filespec 02 specified
by an EN command cannot be used because the input file is being
modified by someone.
04Rename Filename 02 already exists
RENAME UUO failure 4. The filespec 02 specified
by an EN command could not be used because there is already
a file by that name.
06UFD or RIB Error
RENAME UUO failure 6. The filespec 02 specified
by an EN command could not be used because a bad directory
block was encountered by the monitor. Notify your system manager.
22Cannot Delete a Non-Empty Directory
RENAME UUO failure 22. The filespec 02 specified
by an EN command could not be used because the input file was
a directory which was not empty, and therefore cannot be deleted.
23Output SFD Not Found
RENAME UUO failure 23. The output file 02 specified
by an EN command could not be used because the Sub-File-Directory
on which the file should be placed does not exist.
RENAME failure 03 for 02
The attempted Rename of the Input file has failed and
the monitor has returned an error code of 03. This error should
probably not happen on a RENAME. Please report
the problem to your systems manager.
>
ERRGEN RNO,< Cannot Rename Output File 01
Failure in rename process at close of EDITING job initiated by
an EB command or a TECO command. The attempt to rename the output
file 01 to the name "10" originally specified in the
EB or TECO command has failed. The original input file 10
as been renamed "08.BAK", BUT The OUTPUT FILE IS CLOSED WITH
The NAME "01". The RENAME UUO error code is 03.
>
ERRGEN SAL,< Second Argument Less Than First
In a two argument command, the first argument
must be less than or equal to the second.
>
ERRGEN SEF,< Superceding Existing File: 02
The output file 02 already exists on 04.
This message is warning the user that his or her existing file is
being overwritten.
>
ERRGEN SNA,< Initial Search With No Argument
A search command with null argument has been given, but there
was no preceding search command from which the argument could be
taken.
>
ERRGEN SNI,< ; Not in Iteration
The semicolon command may be used only in an iteration.
>
ERRGEN SRH,< Cannot Find "17"
A search command not preceded by a colon modifier and not
within an iteration has failed to find the specified character
string "17".
If an S, FS, FD, or any negative or bounded search fails, the pointer is
unchanged. After an n or _ search fails, the last page of the
input file has been read and, in the case of N, output, and the
buffer cleared.
>
ERRGEN STC,< Search String Too Long
The maximum length of a search string is 80 characters, including
all string control commands and their arguments.
>
ERRGEN STL,< Search String Too Long
The maximum length of a search string is 36 character positions,
not counting extra characters required to specify a single position.
>
ERRGEN TAG,< Missing Tag !12!
The tag !12! specified by an O command cannot be found.
This tag must be in the same macro level as the O command
referencing it.
>
ERRGEN TAL,< Two Arguments With L
The L command takes at most one numeric argument, namely, the
number of lines over which the buffer pointer is to be moved.
>
ERRGEN TSD,< Too Many Nested SFD'S
The number of Sub-File-Directories specified in
a path exceeds the number allowed by XTEC. IF DESIRED, The USER
MAY RE-ASSEMBLE XTEC WITH 'C$SFDL' EQUAL TO The DESIRED
NESTING LEVEL OF SFD'S.
>
ERRGEN TTY,< Illegal TTY I/O Device
A teletype may be specified as an input/output device in an
ER, EW, EZ, or MAKE command only if it is not being used
to control an attached job, the user's own terminal.
>
ERRGEN UAT,< Unenabled APR Trap
An APR trap occurred which was not enabled. This
error should not occur. Please report it to your systems manager.
>
ERRGEN UCA,< Unterminated ^A Command
A ^A message type-out command has been given,
but there is no corresponding ^A to mark the end
of the message. ^A commands must be complete within a
single macro level.
>
ERRGEN UEY,< Use "EY" Instead of "Y"
The Y command has been replaced by EY, because it is too easy
to accidentally destroy the EDITING buffer by typing "Y".
This applies only to a typed-in command string, and not to macros
executed by the M command, on the assumption that macros have been
dubugged.
>
ERRGEN UFS,< Macro Ending with Unterminated File Selection Command
The last command in a command macro being executed from a
Q-register is a file selection command (ER, EW, EB, ED, EL, EI, EN,
or EZ) with no altmode to mark the end of the file specification.
The file selection command must be complete within the Q-register.
>
ERRGEN UIN,< Unterminated Insert Command
An insert command (possibly an @ insert command) has been given
without terminating the text argument at the same macro level.
>
ERRGEN UQN,< Unterminated Q-Register Name (missing ) )
If a multi-character q-register name is specified, it must be
terminated by a right parenthesis. the format is:
<command>(<q-reg-name>)
>
ERRGEN USN,< Unknown Switch Name: /19
The switch "/19" is not defined with either input or output
file selection commands. The currently implemented switches are:
/PROTECT, /ASCII, /LSN, /NOIN, /NOOUT, /APPEND, /SIXBIT, /OCTAL,
/NONSTD, /GENLSN, and /SUPLSN.
>
ERRGEN USR,< Unterminated Search Command
A search command (possibly an @ search command) has been given
without terminating the text argument at the same macro level.
>
ERRGEN UTG,< Unterminated Tag
A command string tag has been indicated by a ! command,
but there is no corresponding ! to mark the end of the tag.
Tags must be complete within a single command level.
>
ERRGEN VAI,< VERSION INCOMPATIBILITY
The CURRENT VERSION OF XTEC.SHR IS INCOMPATIBLE WITH SAVE FILES
WRITTEN WITH The EE COMMAND WITH AN OLD VERSION OF XTEC. RE-SAVE
ANY EXISTING TECO MACROS TO RUN TheM.
>
ERRGEN XXX,< Should Not Occur.
Please report this problem to your systems manager as soon as
possible. sorry for the inconvenience. try to close your files
if possible.
>
; NOW, DEFINE THE INDEX TABLE
DEFINE %EGEN(CODE)<''CODE'',,E$$'CODE>
INFO. <DEFINE %TABLE>
ERRTAB: LSTOF.
%TABLE
LSTON.
ERRLEN==.-ERRTAB ; DEFINE LENGTH OF TABLE
>;; END FOR FTXTCERR
FOR FTXTEC,<
SUBTTL GXXXXX - Character Input Routines
; GFSPEC - SCAN A FILE SPECIFICATION AND STORE IN A FILE SPEC BLOCK
;
; SEE PARAMETER DEFINITIONS FOR FORMAT OF A FILE SPEC BLOCK
;
; CALL: MOVEI L,FILE.SPEC.BLOCK
; PUSHJ P,GFSPEC
; (RETURN)
;
; SMASHES ACS X,C,N,T2
GFSPEC: MOVX T4,FB$$IO ; FETCH IMAGE OF I/O FLAGS FOR FILE-SPEC
AND T4,FS$FLG(L) ; AND KEEP PREVIOUS I/O FLAGS
GFS0: PUSHJ P,GSIX ; PICK UP A SIXBIT NAME
JUMPE N,GFS1 ; NONE THERE
PUSHJ P,GCHR ; PICKUP CHAR AFTER SIXBIT NAME
CAIE C,":" ; IS NAME A DEVICE NAM?
JRST GFSNAM ; NO, IT'S A FILE NAME
; STORE DEVICE NAME
MOVEM N,FS$DEV(L) ; STORE THE DEVICE NAME IN SILE SPEC BLOCK
TXO T4,FB$DEV ; FLAG THAT DEVICE WAS SEEN
JRST GFS0 ; AND TRY FOR MORE OF FILE SPEC
; PICK UP NEXT CHAR
GFS1: PUSHJ P,GCHR ; PICKUP THE NEXT CHAR
; DISPATCH FOR SPECIAL FILESPEC DELIMITERS
GFS2: CAIN C,"." ; "."?
JRST GFSEXT ; YES, FILE EXTENSION FOLLOWS
CAIE C,.CHLAB ; LEFT ANGLE BRACKET?
CAIN C,"[" ; "["?
JRST GFSPTH ; YES, PATH FOLLOWS
CAIN C,"/" ; "/"?
JRST GFSSWI ; YES, SWITCH FOLLOWS
CAIE C,.CHSPC ; IS CHAR A BLANK?
CAIN C,.CHTAB ; OR A TAB?
JRST GFS1 ; YES, IGNORE IT
MOVEM T4,FS$FLG(L) ; NO. STORE FILE SPEC FLAGS
POPJ P, ; AND RETURN TO CALLER
; STORE FILE NAME
GFSNAM: MOVEM N,FS$NAM(L) ; STORE THE FILE NAME IN SPEC BLOCK
TXO T4,FB$NAM ; FLAG THAT A FILE NAME WAS SEEN
JRST GFS2 ; AND CHECK THE DELIMITER CHAR
; STORE FILE EXTENSION
GFSEXT: PUSHJ P,GSIX ; SCAN THE FILE EXTENSION
MOVEM N,FS$EXT(L) ; AND STORE IT IN THE SPEC BLOCK
TXO T4,FB$EXT ; FLAG THAT A FILE EXT WAS SEEN
JRST GFS1 ; AND GO BACK FOR MORE
; STORE PATH: [-], [PJ,PG],[PJ,PG,SFD1,...,SFDN] (PJ AND/OR PG MAY BE NULL)
GFSPTH: TXO T4,FB$PTH ; FLAG THAT SOME SORT OF PATH SEEN
PUSHJ P,GCHR ; FETCH NEXT COMMAND CHAR
CAIE C,"-" ; "-"?
JRST GFSP3 ; NO
SETZM FS$PPN(L) ; YES, DEFAULT DIRECTORY IS ZERO PPN
TXO T4,FB$DDR ; FLAG THAT DEFAULT DIRECTORY SEEN
PUSHJ P,GCHR ; FETCH NEXT CHAR
GFSP2: CAIE C,.CHRAB ; NORMAL PATH TERMINATION?
CAIN C,"]" ; . . . ?
JRST GFS0 ; YES,
MOVEM C,INPCHR ; NO, DON'T LOSE THE CHAR
JRST GFS0 ; AND GO BACK FOR MORE OF FILE SPEC
GFSP3: CAIG C,"7" ; IS CHAR AN OCTAL DIGIT?
CAIGE C,"0" ; . . . ?
JRST GFSP4 ; NO
MOVEM C,INPCHR ; YES, REPEAT THE DIGIT
PUSHJ P,GOCT ; AND SCAN THE OCTAL PROJECT NUMBER
HRLM N,FS$PPN(L) ; STORE THE PROJECT NUMBER
TXO T4,FB$PRJ ; FLAG THAT PROJECT NUMBER SEEN
PUSHJ P,GCHR ; AND FETCH NEXT CHAR
GFSP4: CAIE C,"," ; IS IT A COMMA?
ERROR (IPP) ; NO, ** ILLEGAL PPN **
PUSHJ P,GCHR ; YES, FETCH NEXT CHAR
CAIG C,"7" ; IS IT AN OCTAL DIGIT?
CAIGE C,"0" ; . . . ?
JRST GFSP5 ; NO
MOVEM C,INPCHR ; YES, REPEAT THE CHAR
PUSHJ P,GOCT ; AND SCAN THE PROGRAMMER NUMBER
HRRM N,FS$PPN(L) ; AND STORE THE PROGRAMMER NUMBER
TXO T4,FB$PRG ; FLAG THAT PROGRAMMER NUMBER WAS SEEN
PUSHJ P,GCHR ; FETCH THE NEXT CHAR
GFSP5: CAIE C,"," ; IS IT A ","?
JRST GFSP2 ; NO
; SFD'S
IFE C$SFDL,<ERROR (TSD)> ; SFD'S NOT ALLOWED
IFN C$SFDL,<
TXO T4,FB$SFD ; FLAG THAT SFDS SEEN
MOVE T3,[IOWD C$SFDL,FS$SFD] ; FETCH AOBJN POINTER FOR SFD'S
ADDI T3,(L) ; POINTS INTO FILE.SPEC BLOCK
GFSSFD: PUSHJ P,GSIX ; PICK UP AN SFD NAME
MOVEM N,(T3) ; AND STORE IN FILE SPEC BLOCK
PUSHJ P,GCHR ; FETCH THE DELIMITER
CAIE C,"," ; MORE SFD'S TO COME?
JRST GFSP2 ; NO
AOBJN T3,GFSSFD ; YES
ERROR (TSD) ; ** TOO MANY NESTED SFD'S **
>;; END IFN C$SFDL
; SWITCHES
GFSSWI: PUSHJ P,GSIX ; PICK UP THE SWITCH NAME
JUMPE N,[ERROR (NSI)] ; ** NULL SWITCH ILLEGAL **
PUSH P,L ; SAVE AC L
MOVE L,[IOWD SWILTH,SWITBL+1] ; FETCH PTR TO SWITCH TABLE
PUSHJ P,MATCH ; AND LOOKUP THE SWITCH NAME
ERROR (USN) ; ** UNKNOWN SWITCH NAME **
ERROR (ASN) ; ** AMBIGUOUS SWITCH NAME **
MOVE X,SWILTH(L) ; FETCH DISPATCH ADR
POP P,L ; RESTORE AC L
JRST (X) ; AND DISPATCH TO THE SWITCH HANDLER
DEFINE SWI
< PAIR PROTEC,SWPRO
PAIR EXECUT,SWEXE
PAIR LSN,SWLSN
PAIR ASCII,SWASC
PAIR SIXBIT,SWSIX
PAIR OCTAL,SWOCT
PAIR GENLSN,SWGEN
PAIR SUPLSN,SWSUP
PAIR APPEND,SWAPP ;;[330] /APPEND
PAIR NOOUT,SWNOO ;;[330] /NOOUT
PAIR NOIN,SWNOI ;;[330] /NOIN
PAIR NONSTD,SWNON ;;[334] /NONSTD
>
GEN (SWI) ; GENERATE THE SWITCH TABLE
; SWPRO - /PROTECT:<NNN> - FILE PROTECTION
SWPRO: PUSHJ P,GCHR ; MAKE SURE A COLON FOLLOWS
CAIE C,":" ; DOES ONE?
ERROR (ISW) ; NO, ** ILLEGAL SWITCH **
PUSHJ P,GCHR ; YES, FETCH NEXT CHAR
CAIN C,.CHLAB ; LEFT ANGLE BRACKET?
PUSHJ P,GCHR ; YES, IGNORE IT
CAIG C,"7" ; AN OCTAL DIGIT?
CAIGE C,"0" ; . . . ?
ERROR (IPR) ; NO, ** ILLEGAL PROTECTION **
MOVEM C,INPCHR ; YES, REPEAT THE DIGIT
PUSHJ P,GOCT ; AND PICK UP THE WHOLE OCTAL NUMBER
LSH N,^D27 ; PUT NUMBER IN FILE PROTECTION FIELD
MOVEM N,FS$PRV(L) ; AND STORE IN FILE SPEC
TXO T4,FB$PRV ; FLAG THAT /PROTECT:<NNN> SEEN
PUSHJ P,GCHR ; FETCH NEXT CHAR
CAIE C,.CHRAB ; IS IT RIGH-ANGLE-BRACKET?
MOVEM C,INPCHR ; NO, REPEAT THE CHAR
JRST GFS0 ; AND GO BACK FOR MORE OF FILE SPEC
; SWEXE - /EXECUTE - FORCES AN "EI" ON FILE
SWEXE: TXO T4,FB$EXE ; SET THE "/EXECUTE" FLAG
JRST GFS0 ; AND CONTINUE FILE-SPEC SCAN
; SWLSN - /LSN - KEEP LINE-SEQUENCE NUMBERS IF A FILE HAS THEM
SWLSN: TXO T4,FB$LSN ; SET /LSN
JRST GFS0 ; AND CONTINUE FILE-SPEC SCAN
; SWASC - /ASCII - DON'T CHECK FOR LINE-SEQUENCE-NUMBERS
SWASC: TXO T4,FB$ASC ; SET /ASCII
JRST GFS0 ; AND CONTINUE FILE-SPEC SCAN
; SWSIX - /SIXBIT - FILE IS IN SIXBIT FORMAT
SWSIX: TXO T4,FB$SIX ; SET /SIXBIT
JRST GFS0 ; AND CONTINUE FILE-SPEC SCAN
; SWOCT - /OCTAL - FILE IS A BINARY FILE
SWOCT: TXO T4,FB$OCT ; SET /OCTAL
JRST GFS0 ; AND CONTINUE FILE-SPEC SCAN
; SWGEN - /GENLSN - GENERATE LINE-SEQUENCE NUMBERS ON OUTPUT
SWGEN: TXO T4,FB$GEN ; SET /GENLSN
JRST GFS0 ; AND CONTINUE FILE-SPEC SCAN
; SWSUP - /SUPLSN - SUPPRESS LINE-SEQUENCE-NUMBERS ON INPUT
SWSUP: TXO T4,FB$SUP ; SET /SUPLSN
JRST GFS0 ; AND CONTINUE FILE-SPEC SCAN
; SWAPP - /APPEND - APPEND THIS LOG TO LOG FILE
SWAPP: TXO T4,FB$APP ;[330] SET /APPEND
JRST GFS0 ;[330] AND CONTINUE FILE-SPEC SCAN
; SWNOO - /NOOUT - DO NOT GENERATE OUTPUT
SWNOO: TXO T4,FB$NOO ;[330] SET /NOOUT
JRST GFS0 ;[330] AND CONTINUE FILE-SPEC SCAN
; SWNOI - /NOIN - DO NOT GENERATE INPUT
SWNOI: TXO T4,FB$NOI ;[330] SET /NOIN
JRST GFS0 ;[330] AND CONTINUE FILE-SPEC SCAN
; SWNON - /NONSTD - OPEN DECTAPE IN NON STANDARD MODE
SWNON: TXO T4,FB$NON ;[334] SET /NONSTD
JRST GFS0 ;[334] AND CONTINUE FILE-SPEC SCAN
; GSIX - GET A SIXBIT NAME
;
; CALL: PUSHJ P,GSIX
; (RETURN) ; WITH NAME IN AC N, MASK IN AC M
;
; USES ACS C,N,M,T1,T2,T3
GSIX: MOVE T1,[POINT 6,N] ; SETUP BP TO NAME
SETZB N,M ; CLEAR NAME AND MASK
MOVSI T2,'_ ' ; SETUP THE MASKING WORD
PUSHJ P,GCHR ; FETCH FIRST CHAR
CAIN C,"*" ; IS IT "*"?
JRST GSIX2 ; YES, HANDLE SPECIALLY
CAIE C,"""" ; A QUOTED SIXBIT NAME?
CAIN C,"'" ; . . . ?
JRST GSIX3 ; YES
SKP ; NO
GSIX1: PUSHJ P,GCHR ; FETCH NEXT CHAR
PUSHJ P,CHKAN ; IS IT A LETTER/DIGIT?
JRST RPOPJ ; NO, REPEAT IT AND RETURN TO CALLER
MOVEI C,'A'-"A"(C) ; YES, CONVERT THE CHAR TO SIXBIT
TRNN N,'_' ; ROOM FOR ANOTHER CHAR IN NAME?
IDPB C,T1 ; YES, STORE THE CHAR IN NAME
IOR M,T2 ; AND MASK THE CHAR
LSH T2,-6 ; SHIFT THE MASKING WORD
JRST GSIX1 ; AND TRY FOR ANOTHER CHAR
; '*' IS A SPECIAL NAME (IE: 'ALL')
GSIX2: SETZ M, ; CLEAR THE MASK
MOVSI N,'* ' ; SET NAME TO '* '
POPJ P, ; AND RETURN TO CALLER
; SCAN A QUOTED SIXBIT NAME
GSIX3: MOVEI T3,(C) ; SAVE THE DELIMITER CHAR
GSIX4: PUSHJ P,GCHR ; PICK UP THE NEXT CHAR
CAIE C,(T3) ; IS IT THE DELIMITER?
JRST GSIX5 ; NO
PUSHJ P,GCHR ; YES, PICK UP THE NEXT CHAR
CAIE C,(T3) ; TWO OCCURRANCES OF THE DELIMITER?
JRST RPOPJ ; NO, FINISH UP AND RETURN TO CALLER
GSIX5: MOVEI C,'A'-"A"(C) ; CONVERT CHAR TO SIXBIT
TRNN N,'_' ; ROOM IN NAME FOR CHAR?
IDPB C,T1 ; YES, STORE CHAR IN NAME
IOR M,T2 ; FILL IN MASK FOR CURRENT POSITION
LSH T2,-6 ; AND SHIFT IT TO NEXT POSITION
JRST GSIX4 ; AND TRY FOR ANOTHER CHAR
RPOPJ: MOVEM C,INPCHR ; STORE THE CHAR SO IT REPEATS NEXT TIME
POPJ P, ; AND RETURN TO CALLER
; GOCT - GET AN OCTAL NUMBER
;
; CALL: PUSHJ P,GOCT
; (RETURN) ; WITH OCTAL NUMBER IN AC N
;
; SMASHES ACS X,C,N
GOCT: SETZ N, ; CLEAR NUMBER
GOCT0: PUSHJ P,GETCH ; FETCH NEXT CHAR
CAIG C,"7" ; IS CHAR AN OCTAL DIGIT?
CAIGE C,"0" ; . . . ?
JRST RPOPJ ; NO, REPEAT THE CHAR AND RETURN TO CALLER
LSH N,3 ; MAKE ROOM FOR THE OCTAL DIGIT
IORI N,-"0"(C) ; AND ADD IN THE OCTAL DIGIT
JRST GOCT0 ; AND CONTINUE
; GEOL - EAT CHARS TILL END OF LINE SEEN
;
; CALL: PUSHJ P,GEOL
; (RETURN)
;
; USES AC C
GEOL: SETZM INPCHR ;[315] CLEAR SAVED CHAR
TXZE F,F$EOL ; END OF LINE YET?
POPJ P, ; YES, CLEAR AND RETURN TO CALLER
PUSHJ P,GCHR ; NO, FETCH NEXT CHAR
JRST GEOL ; AND SEE IF END OF LINE YET
; GCHR - GET NEXT CHAR AND CHECK IF END OF LINE
;
; CALL: PUSHJ P,GCHR
; (RETURN) ; WITH CHAR IN AC C
;
; USES AC C
GCHR: PUSHJ P,GETCH ; FETCH NEXT INPUT CHAR
CAIN C,.CHCNZ ; A CONTROL-Z?
TXO F,F$EOL ; YES, SET END OF LINE
CAIE C,.CHESC ; ALTMODE?
CAIG C,.CHFFD ; <LF>,<VT>,OR <FF>?
CAIGE C,.CHLFD ; . . . ?
POPJ P, ; NO, JUST RETURN TO CALLER
TXO F,F$EOL ; YES, SET EOL
POPJ P, ; AND RETURN TO CALLER
>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
; GETCH - GET NEXT INPUT CHARACTER FROM CURRENT INPUT SOURCE
;
; CALL: PUSHJ P,GETCH
; (RETURN) ; WITH CHAR IN AC C
;
; USES AC C
GETCH: SKIPN C,INPCHR ; REPEAT THE LAST CHAR?
JRST GETCH0 ; NO
SETZM INPCHR ; YES, CLEAR THE SAVED CHAR
POPJ P, ; AND RETURN TO CALLER WITH THE LAST CHAR
GETCH0: SKIPE C,INPADR ; ADR OF AN INPUT ROUTINE?
PJRST (C) ; YES, GO TO IT
TXNE F,F$NTI ; INPUT FROM USER'S TERMINAL?
JRST GETCH2 ; NO, FROM SOMEWHERE ELSE
; INPUT A CHAR FROM USER'S TERMINAL
INCHRW C ; INPUT A CHAR INTO AC C
; PUNCH CHAR TO LOG FILE IF I SAID SO
TXNN F,F$LOG ;[330] DID I SAY SO?
JRST NOLOGI ;[330] NO LOG INPUT
MOVE X,LELSPC+FS$FLG ;[330] GET LOG FLAGS
TXNE X,FB$NOO ;[330] AM I ALLOWED TO RECORD INPUT?
PUSHJ P,LOGPH1 ;[330] RECORD INPUT
; IF CHAR IS ^D, THEN ENTER DDT
NOLOGI: SKIPE .JBDDT ; DO WE HAVE DDT?
CAIE C,.CHCND ; AND IS CHAR A ^D?
POPJ P, ; NO, JUST RETURN WITH THE CHAR
MOVE C,.JBDDT ; FETCH DDT START ADR
PUSHJ P,(C) ; PUSHJ TO DDT
JRST GETCH ; BACK FROM DDT. INPUT ANOTHER CHAR
; INPUT A CHAR. NOT FROM USER'S TERMINAL
GETCH2: MOVE X,INPBH ; FETCH ADR OF INPUT BUFFER HEADER
GETCH3: SOSGE .BFCTR(X) ; ANY CHARS LEFT IN BUFFER?
JRST GETCH4 ; NO
ILDB C,.BFPTR(X) ; YES, FETCH NEXT ONE
JUMPE C,GETCH3 ; IGNORE NULLS
POPJ P, ; RETURN WITH CHAR
; FETCH NEW INPUT BUFFER
GETCH4: MOVSI X,(IN) ; SETUP THE IN OPCODE
IOR X,INPCHN ; "OR" IN THE CHANNEL
XCT X ; DO THE "IN"
JRST GETCH2 ; AND GET CHAR FROM BUFFER
MOVE X,[STATO 0,IO.EOF] ; FAILED. SEE WHAT HAPPENED
IOR X,INPCHN ; FILL IN THE CHANNEL
XCT X ; DO THE "STATO CH,IO.EOF"
JRST @INPERR ; SOME RANDOM INPUT ERROR
PUSHJ P,@INPEOF ; END OF FILE
POPJ P, ; RETURN TO CALLER AFTER EOF
SUBTTL LOGPCH - PUNCH A CHARACTER TO LOG FILE
; LOGPCH - PUNCH A CHARACTER TO LOG FILE
LOGPCH: SOSGE LOGBH+2 ;[330] ROOM IN LOG BUFFER?
JRST LOGP1 ;[330] NO
IDPB C,LOGBH+1 ;[330] YES, STORE CHARACTER IN LOG BUFFER
POPJ P, ;[330] AND RETURN TO CALLER
; ASK MONITOR FOR A NEW LOG BUFFER
LOGP1: OUT LOG, ;[330] OUTPUT TO LOG
JRST LOGPCH ;[330] AND CONTINUE
for ftxtec,ERROR (OWL) ;[330] ** OUTPUT ERROR WRITING LOG **
for ftxtcerr,<
outstr e$$owl ;[326] no endless loops
jrst logpch ;[326] continue
>;; end for ftxtcerr
for ftxtec!ftxtcerr,sall ; restore listing
; LOGPH1 - PUNCH AN INPUT CHARACTER TO LOG FILE
LOGPH1: TXNN X,FB$NOI ;[330] /NOOUT SET?
PJRST LOGPCH ;[330] YES, PUNCH LITERALLY
PUSH P,C ;[330] SAVE CHAR
CAIN C,.CHESC ;[330] ALTMODE?
MOVEI C,"$" ;[330] MAKE "$"
CAIG C,.CHCNH ;[330] .LE.^H ?
JRST LOGPH2 ;[330] YES, ^ FORM
CAIL C,.CHCNN ;[330] .LT.^N ?
CAILE C,.CHCUN ;[330] .LE.^_ ?
JRST LOGPH3 ;[330] NOT AN ^ CHAR
LOGPH2: IORI C,"@" ;[330] MAKE PRINTABLE ASCII
PUSH P,C ;[330] SAVE IT
MOVEI C,"^" ;[330] FETCH UPARROW
PUSHJ P,LOGPCH ;[330] PUNCH IT
POP P,C ;[330] GET CHAR BACK
LOGPH3: PUSHJ P,LOGPCH ;[330] PUNCH WHATEVER
POP P,C ;[330] GET WHAT IT WAS ORIGINALLY
POPJ P, ;[330] RETURN
SUBTTL CMDGCH AND CMDBCH - Get char from command buffer
; CMDGCH - FETCH NEXT CHAR FROM COMMAND BUFFER
;
; CALL: PUSHJ P,CMDGCH
; (FAIL RETURN) ; NO CHARS LEFT IN BUFFER
; (SUCCESS RETURN) ; CHAR IS IN AC C
;
; USES ACS C,X
CMDGCH: SOSGE CMDCNT ; ANY CHARS LEFT?
POPJ P, ; NO, GIVE FAIL RETURN
MOVE X,R ; SAVE AC R
MOVE R,@CMDBUF ; YES, FETCH BASE ADR OF COMMAND BUFFER
ILDB C,CMDBP ; AND FETCH NEXT CHAR FROM BUFFER
MOVE R,X ; RESTORE AC R
JUMPE C,CMDGCH ; IGNORING NULLS
JRST CPOPJ1 ; RETURN TO CALLER WITH CHAR IN AC C
; CMDBCH - BACK UP ONE CHAR FOR COMMAND BUFFER
;
; CALL: PUSHJ P,CMDBCH
; (RETURN)
;
; USES AC X
CMDBCH: AOS CMDCNT ; ADD ONE TO THE CHAR COUNT
MOVE X,CMDBP ; FETCH THE BP
ADD X,[<7>B5] ; BACKUP THE BP
JUMPG X,.+3 ; IT'S OK
HRRI X,-1(X) ; GO BACK A FULL WORD
HRLI X,(POINT 7,(CP),34) ; TO LAST BYTE IN PREVIOUS WORD
MOVEM X,CMDBP ; STORE THE UPDATED BP
POPJ P, ; AND RETURN TO CALLER
SUBTTL TXXXXX - OUTPUT ROUTINES
; TSIX - TYPE A SIXBIT WORD (NO TRAILING SPACES)
;
; CALL IS: PUSHJ P,TSIX ; WITH SIXBIT WORD IN AC N
; (RETURN)
;
; ACS C,N ARE SMASHED
TSIX: JUMPE N,CPOPJ ; RETURN IF ONLY BLANKS LEFT
SETZ C, ; CLEAR THE CHAR
LSHC C,6 ; GRAB NEXT CHAR (SIXBIT)
MOVEI C,"A"-'A'(C) ; CONVERT TO ASCII CHAR
PUSHJ P,TCHR ; TYPE THE CHAR
JRST TSIX ; AND LOOP BACK FOR NEXT CHAR
; TOCT AND TDEC - OUTPUT AN OCTAL/DECIMAL NUMBER WITH POSSIBEL "-" SIGN
;
; CALL IS: PUSHJ P,TOCT ; OR PUSHJ P,TDEC
; (ONLY RETURN)
; NUMBER SHOULD BE IN AC N
; ACS C,N, AND M ARE SMASHED
TOCT: SKIPA X,[^D8] ; FETCH OCTAL RADIX
TDEC: MOVEI X,^D10 ; FETCH DECIMAL RADIX
JUMPGE N,TDEC0 ; NO "-" SIGN NEEDED
MOVEI C,"-" ; "-" SIGN NEEDED
PUSHJ P,TCHR ; TYPE THE "-" SIGN
MOVM N,N ; AND TAKE ABSOLUTE VALUE OF NUMBER
TDEC0: IDIVI N,(X) ; EXTRACT A DIGIT INTO AC M
HRLM M,(P) ; SAVE THE DIGIT
JUMPE N,.+2 ; SKIP IF NO MORE DIGITS
PUSHJ P,TDEC0 ; MORE DIGITS, EXTRACT THEM
; POP DIGITS OFF STACK IN THE ORDER THEY ARE TO BE OUTPUT
HLRZ C,(P) ; POP DIGIT OFF STACK
MOVEI C,"0"(C) ; TURN DIGIT INTO A CHAR
PJRST TCHR ; OUTPUT THE DIGIT AND ALL THAT FOLLOW
; TMSG - TYPE PART THE THE COMMAND BUFFER
;
; CALL: MOVE N,[<CHAR.ADR,,CHAR.LEN>]
; PUSHJ P,TMSG
; (RETURN)
;
; SMASHES ACS N,T1,T2,X
TMSG: HLRZ T1,N ; FETCH CHAR.ADR
MOVEI T1,-1(T1) ; 'CAUSE BYTE POINTER WILL BE INCREMENTED BEFORE USE
PUSHJ P,CTOBP ; CONVERT CHAR.ADR TO BYTE POINTER
IORX T1,<Z (R)> ; EVERYTHING IS INDEXED BY R
MOVEI N,(N) ; KEEP ONLY THE CHAR COUNT
TMSG1: JUMPLE N,CPOPJ ; IF DONE, RETURN TO CALLER
ILDB C,T1 ; FETCH NEXT CHAR OF MESSAGE
PUSHJ P,TCCHR ; AND TYPE IT
SOJA N,TMSG1 ; AND TRY AGAIN
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTCERR,<
; TSCHR - TYPE AN ASCIZ STRING WITH SPECIAL CHARS (EG: <TAB>)
;
; CALL: MOVEI N,[ASCIZ/STR/
; PUSHJ P,TSSTR
; (RETURN)
;
; SMASHES AC C. AC N WILL POINT TO LAST WORD OF STRING
TSSTR: HRLI N,(POINT 7,) ; FORM BYTE POINTER TO ASCIZ STRING
TSSTR0: ILDB C,N ; FETCH NEXT CHAR OF STRING
JUMPE C,CPOPJ ; RETURN IF A NULL
PUSHJ P,TSCHR ; TYPE CHAR
JRST TSSTR0 ; AND TRY FOR ANOTHER CHAR
; TSCHR - TYPE A CHAR. IF SPECIAL, TYPE AS <XXX> (EG: <TAB>)
;
; CALL: MOVEI C,"CHAR"
; PUSHJ P,TSCHR
; (RETURN)
;
; SMASHES AC X,C,T1. USES AC N
TSCHR: MOVE T1,[IOWD SCHTL,SCHT+1] ; FETCH POINTER TO SPECIAL CHAR TABLE
TSCHR0: HRRZ X,(T1) ; FETCH A CHAR FROM SPECIAL CHAR TABLE
CAIN C,(X) ; SAME AS OUR CHAR?
JRST TSCHR1 ; YES
AOBJN T1,TSCHR0 ; NO, TRY ANOTHER CHAR IN TABLE
PJRST TCCHR ; NONE LEFT. TYPE AS A NORMAL CHAR
; TYPE A SPECIAL CHAR AS <XXX> (EG: .CHTAB AS <TAB>)
TSCHR1: PUSH P,T1 ; SAVE T1 FOR LATER
MOVEI C,.CHLAB ; TYPE A LEFT WIDGET
PUSHJ P,TCHR ; . . .
POP P,T1 ; RESTORE AC T1
PUSH P,N ; SAVE AC N
HLLZ N,(T1) ; FETCH "XXX" OF <XXX>
PUSHJ P,TSIX ; AND TYPE IT IN SIXBIT
POP P,N ; RESTORE AC N
MOVEI C,.CHRAB ; AND TYPE RIGHT WIDGET
PJRST TCHR ; . . . AND RETURN TO CALLER
; SCHT - SPECIAL CHARACTER TABLE
DEFINE SCH (NAME,CODE)<<<SIXBIT/NAME/>_-^D18,,CODE>>
SCHT:
SCH(TAB,.CHTAB)
SCH(LF,.CHLFD)
SCH(VT,.CHVTB)
SCH(FF,.CHFFD)
SCH(CR,.CHCRT)
SCH(ESC,.CHESC)
SCHTL==.-SCHT
; TFSPEC - TYPE A COMPLETE FILE-SPEC IN FORM: DEV:FILE.EXT[PATH]
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,TFSPEC
; (RETURN)
;
; SMASHES ACS X,C,N,M
TFSPEC: PUSHJ P,TDEV ; TYPE "DEV:"
PUSHJ P,TFILE ; TYPE "FILE.EXT"
PJRST TPATH ; TYPE "[PATH]"
; TDEV - TYPE A DEVICE NAME IN FORM: DEV:
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,TDEV
; (RETURN)
;
; SMASHES ACS C,N
TDEV: MOVE N,FS$DEV(L) ; FETCH THE DEVICE NAME
PUSHJ P,TSIX ; AND TYPE IT
MOVEI C,":" ; FETCHA ":"
PJRST TCHR ; AND TYPE IT
; TFILE - TYPE A FILE-NAME AND EXTENSION IN FORM: FILE.EXT
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,TFILE
; (RETURN)
;
; SMASHES ACS C,N
TFILE: MOVE N,FS$NAM(L) ; FETCH THE FILE-NAME
PUSHJ P,TSIX ; AND TYPE IT
MOVEI C,"." ; TYPE A "."
PUSHJ P,TCHR ; . . .
MOVE N,FS$EXT(L) ; FETCH THE EXTENSION
PJRST TSIX ; TYPE IT AND RETURN TO CALLER
; TPROT - TYPE FILE PROTECTION IN FORMAT: <NNN>
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,TPROT
; (RETURN)
;
; SMASHES ACS C,N,M
TPROT: MOVEI C,.CHLAB ; TYPE LEFT WIDGET
MOVE N,FS$PRV(L) ; FETCH FILE PROTECTION
MOVEI C,"0" ; FETCH A ZERO
CAIL N,^D100 ; A THREE DIGIT NUMBER?
PUSHJ P,TCHR ; NO, ADD A LEADING ZERO
CAIL N,^D10 ; A TWO DIGIT NUMBER?
PUSHJ P,TCHR ; NO, ADD ANOTHER LEADING ZERO
PUSHJ P,TDEC ; TYPE THE FILE-PROTECTION
MOVEI C,.CHRAB ; AND TYPE A RIGHT WIDGET
PJRST TCHR ; AND RETURN TO CALLER
; TPATH - TYPE A PATH IN FORM: [-] OR [N,N] OR [N,N,SFD,...]
;
; CALL: MOVEI L,FILSPC
; PUSHJ P,TPATH
; (RETURN)
;
; SMASHES ACS C,N,M
TPATH: MOVEI C,"[" ; TYPE LEADING DELIMITER
PUSHJ P,TCHR ; . . .
MOVE X,FS$FLG(L) ; FETCH FILE-SPEC FLAGS
TXNN X,FB$DDR ; DEFAULT DIRECTORY?
JRST TPATH2 ; NO
MOVEI C,"-" ; YES, TYPE AS [-]
PUSHJ P,TCHR ; . . .
TPATH1: MOVEI C,"]" ; TYPE CLOSING DELIMITER
PJRST TCHR ; AND RETURN TO CALLER
TPATH2: HLRZ N,FS$PPN(L) ; FETCH PROJECT NUMBER
JUMPE N,.+2 ; DON'T PRINT IF ZERO
PUSHJ P,TOCT ; TYPE PROJECT NUMBER IN OCTAL
MOVEI C,"," ; TYPE A ","
PUSHJ P,TCHR ; . . .
HRRZ N,FS$PPN(L) ; FETCH THE PROGRAMMER NUMBER
JUMPE N,.+2 ; DON'T PRINT IF ZERO
PUSHJ P,TOCT ; TYPE PROGRAMMER NUMBER IN OCTAL
JRST TPATH1 ; FINISH UP AND RETURN TO CALLER
>;; END FOR FTXTCERR
FOR FTXTEC!FTXTCERR,<
; TCCHR - OUTPUT A CHAR, ALTMODE AS "$", CONTROL CHARS AS "^"CHAR UNLESS ET.NE.0
; ^I,^J,^K,^L,^M OUTPUT AS THEMSELVES CASE FLAGGING UNLESS F$NOF
;
; CALL IS: PUSHJ P,TCCHR ; WITH CHAR IN AC C
; (ONLY RETURN)
;
; AC C IS SMASHED
TCCHR: SKIPE ETVAL ; ET.NE.0?
PJRST TCHR ; YES, NO SUBSTITUTIONS FOR NON-PRINTING CHARS
CAIE C,.CHESC ; AN ALTMODE?
JRST TCC0 ; NO
; OUTPUT AN ALTMODE AS "$"
MOVEI C,"$" ; FETCH A "$"
PJRST TCHR ; AND OUTPUT IT
TCC0: TXNE F,F$NOF ; SUPPRESS CASE FLAGGING?
JRST TCC3 ; YES
PUSH P,C ; NO. SAVE CHAR
CAIG C,"_" ; IS IT A UC LETTER?
CAIGE C,"A" ; . . . ?
JRST TCC2 ; NO
; FLAG UC LETTER IF EU:=+
SKIPG EUVAL ; FLAG UC LETTERS?
JRST TCC11 ; NO
TCC1: MOVEI C,"'" ; YES, FLAG WITH "'"
PUSHJ P,TCHR ; TYPE THE "'"
TCC11: POP P,C ; RESTORE THE ORIGINAL CHAR
JRST TCC3 ; TYPE IT AND RETURN TO CALLER
TCC2: CAIG C,"_"+40 ; IS CHAR AN UC LETTER?
CAIGE C,"A"+40 ; . . . ?
JRST TCC11 ; NO
SKIPN EUVAL ; YES, FLAG IT?
JRST TCC1 ; YES
JRST TCC11 ; DON'T FLAG IT
TCC3: CAIG C,.CHCNH ; ^@-^H?
JRST TCC4 ; YES, SPECIAL OUTPUT
CAIL C,.CHCNN ; ^N-^_?
CAILE C,.CHCUN ; . . . ?
PJRST TCHR ; NO, OUTPUT CHAR AS IS
; OUTPUT CHAR AS "^"CHAR (^@-^H,^N-^_)
TCC4: IORI C,"@" ; MAKE CHAR READABLE
PUSH P,C ; SAVE CHAR
MOVEI C,"^" ; FETCH THE "^" CHAR
PUSHJ P,TCHR ; OUTPUT "^"
POP P,C ; RESTORE READABLE FORM OF CHAR
PJRST TCHR ; AND OUTPUT IT
; TSTR - TYPE AN ASCIZ STRING
;
; CALL: MOVEI N,[ASCIZ/STRING/]
; PUSHJ P,TSTR
; (RETURN)
TSTR: HRLI N,(POINT 7,) ; FORM BYTE POINTER
TSTR0: ILDB C,N ; FETCH NEXT CHAR OF ASCIZ STRING
JUMPE C,CPOPJ ; AND RETURN IF NULL
PUSHJ P,TCCHR ; TYPE THE CHAR
JRST TSTR0 ; AND LOOP FOR ALL CHARS OF STRING
; TCRLF - OUTPUT A CRLF
;
; CALL IS: PUSHJ P,TCRLF ;
; (ONLY RETURN)
; ACS B AND C ARE SMASHED
TCRLF: MOVEI C,.CHCRT ; FETCH A CR CHAR
PUSHJ P,TCHR ; AND TYPE IT
MOVEI C,.CHLFD ; FETCH A <LF> CHAR
; PJRST TCHR ; AND TYPE IT AND RETURN
; TCHR - OUTPUT A SINGLE CHAR
;
; CALL IS: PUSHJ P,TCHR
; (ONLY RETURN)
; AC C SHOULD CONTAIN CHAR. AC C IS PRESERVED
TCHR: SKIPE OUTADR ; OUTPUT TO NON-TERMINAL?
PJRST @OUTADR ; YES, GO TO ROUTINE
; PUNCH CHAR TO LOG FILE IF I SAID SO
TXNN F,F$LOG ;[330] DID I SAY SO?
JRST NOLOGO ;[330] NO LOG OUTPUT FOR YOU
MOVE X,LELSPC+FS$FLG ;[330] GET LOG FLAGS
TXNE X,FB$NOI ;[330] RECORD OUTPUT?
PUSHJ P,LOGPCH ;[330] YES, PUNCH IT
; TYPE CHAR ON USER'S TERMINAL
NOLOGO: OUTCHR C ; TYPE THE CHAR
POPJ P, ; AND RETURN TO CALLER
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
SUBTTL MISCELLANEOUS ROUTINES
; CHKAN - SEE IF A CHAR IS ALPHA-NUMERIC (LETTER/DIGIT)
;
; CALL IS: PUSHJ P,CHKAN ; WITH CHAR IN AC C
; (NOT A-N)
; (CHAR IS A-N)
;
; AC C SHOULD CONTAIN THE CHAR TO BE CHECKED
CHKAN: CAIG C,"Z"+40 ; IS CHAR LOWER CASE?
CAIGE C,"A"+40 ; . . .
SKP ; NO
MOVEI C,-40(C) ; YES, UPCASE THE LETTER
CAIG C,"Z" ; IS CHAR A LETTER OR DIGIT?
CAIGE C,"0" ; . . . ?
POPJ P, ; NO, GIVE ERROR RETURN
CAIGE C,"A" ; IS IT ?
CAIG C,"9" ; . . . ?
JRST CPOPJ1 ; YES! GIVE SKIP RETURN
POPJ P, ; NO, GIVE ERROR RETURN
; CHKEOL - SKIP IF CHARACTER IN AC C IS AN END-OF-LINE CHARACTER (<LF>,<VT>,<FF>)
;
; CALL: MOVEI C,CHAR
; PUSHJ P,CHKEOL
; (FAIL RETURN)
; (SUCCESS RETURN)
;
; USES AC C
CHKEOL: CAIG C,.CHFFD ; IS CHAR <LF>,<VT>, OR <FF>?
CAIGE C,.CHLFD ; . . . ?
POPJ P, ; NO, GIVE FAIL RETURN TO CALLER
JRST CPOPJ1 ; YES, GIVE SUCCESS RETURN TO CALLER
; MAKCJN - MAKE OUR CCL JOB NUMBER (IE: '###XTC')
;
; CALL: PUSHJ P,MAKCJN
; (RETURN) ; WITH CCL JOB NUMBER IN "CCJNAM"
;
; SMASHES ACS X,T1-T3
MAKCJN: MOVSI T3,C$3NAM ; INITIALIZE TO ' XTC'
PJOB T1, ; FETCH OUR JOB NUMBER
MOVEI X,3 ; FETCH #DIGITS IN '###'
MAKCJ1: IDIVI T1,^D10 ; EXTRACT A DIGIT
MOVEI T2,'0'(T2) ; AND CONVERT TO A SIXBIT DIGIT
LSHC T2,-6 ; AND ADD TO THE CCL JOB NAME
SOJG X,MAKCJ1 ; AND DO SAME FOR NEXT DIGIT
MOVEM T3,CCJNAM ; STORE THE CCL JOB NUMBER (IE: '###XTC')
; IN "CCJNAM"
POPJ P, ; AND RETURN TO CALLER
; GETPTH - GET MY DEFAULT PATH FROM PATH.(SUPERIOR TO SETZM'ING)
;
; CALL: PUSHJ P,GETPTH
; (RETURN) ; WITH PATH IN X
;
; SMASHES AC X (VERY HARD TO COMPREHEND WHY). THE ROUTINE IS USED
; IN GETTING THE DEFAULT PATH, TO ENABLE PEOPLE WHO CHANGE THEIR PATH
; TO HAVE THE RIGHT THING DONE FOR THEM, INCLUDING READING THEIR UFD!
; THIS ROUTINE INITIALLY WAS PART OF $EB, AS MAIN-LINE CODE.
GETPTH: MOVEI X,PATHB ;[340] LOAD ADDR OF PATH BLOCK
SETOM PATHB+.PTFCN ;[340] PATHB_-1,,.PTFRD
PATH. X, ;[340] GET MY DEFAULT PATH
CAIA ;[340] SICK MONITOR, USE GETPPN
SKIPA X,PATHB+.PTPPN ;[340] GET PPN FROM PATH BLOCK
GETPPN X, ;[342] GET OUR PPN
JFCL ;[342] (JACCT SKIP)
MOVEM X,PATHB+.PTPPN ;[341] IN CASE OF SICK MONITOR FOR BAKCLS
POPJ P, ;[342] AND RETURN TO CALLER
; MATCH - SEE IF A WORD IS IN A TABLE
;
; IF TABLE ENTRY BEGINS WITH '*', THEN ANY ABBREVIATION WINS.
;
; CALL: MOVE N,[SIXBIT/NAME/]
; PUSHJ P,MATCH ; WITH WORD IN AC N, MASK IN AC M
; (NO FIND RETURN)
; (AMBIGUOUS WORD RETURN)
; (SUCCESS RETURN); AC L POINTS TO WORD IN TABLE
;
; ACS X,T1,T2,L ARE SMASHED
MATCH: MOVEM N,SBNAME ; STORE THE SIXBIT NAME
SETO T2, ; USED TO COUNT MATCHES
MAT0: MOVE X,(L) ; FETCH WORD FROM TABLE
TXNE X,3B1 ; IS FIRST CHAR '*' ?
JRST MAT2 ; NO, CHECK THE NORMAL WAY
LSH X,6 ; YES, SHIFT OUT THE '*'
XOR X,N ; SEE IF A MATCH OR ABBREV.
TXZ X,77 ; IGNORE LAST CHAR BECAUSE TABLE ENTRY
; DOESN'T HAVE IT
AND X,M ; DO THE MASKING
JUMPE X,CPOPJ2 ; WIN IF MATCH OR ANY ABBREV. !
JRST MAT1 ; LOSE IF NOT MATCH OR AN ABBREV.
MAT2: XOR X,N ; AN EXACT MATCH?
JUMPE X,CPOPJ2 ; YES, SUCCESS!
AND X,M ; NO, AN ABBREVIATION?
JUMPN X,MAT1 ; NO
AOJG T2,MAT1 ; YES, COUNT IT. FIRST ONE?
MOVEI T1,(L) ; YES, SAVE ADR OF WORD IN TABLE
MAT1: AOBJN L,MAT0 ; TRY NEXT WORD IN TABLE
MOVEI L,(T1) ; ALL DONE. GET ADR OF FIRST MATCH
JUMPL T2,CPOPJ ; THERE WEREN'T ANY MATCHES
JUMPE T2,CPOPJ2 ; SUCCESS, UNIQUE MATCH!
JRST CPOPJ1 ; AMBIGUOUS, MORE THAN ONE MATCH
; DISPAT - LOOKUP A HALFWORD AND DISPATCH IF MATCH
;
; CALL: MOVEI C,XWD ; THE HALFWORD TO BE SEARCHED FOR
; MOVE T1,[IOWD LTH,TAB]
; PUSHJ P,DISPAT
; (NOFIND RETURN)
; IF FOUND, DISPATCH TO ADDRESS IN LH OF TABLE ENTRY
;
; TAB:
; <XWD,,ADR>
; <XWD,,ADR>
; . . .
; LTH==.-TAB
;
; USES ACS X,L,C
DISPAT: HLRZ X,(T1) ; FETCH XWD FROM TABLE ENTRY
CAIN X,(C) ; THE ONE WE'RE LOOKING FOR?
JRST DISPA1 ; YES, DISPATCH
AOBJN T1,DISPAT ; NO, LOOP FOR ALL TABLE ENTRIES
POPJ P, ; NOFIND. GIVE NOFIND RETURN
; FOUND IT! DISPATCH
DISPA1: POP P,X ; IGNORE RETURN ADR TO CALLER
MOVE X,(T1) ; FETCH THE DISPATCH ADDRESS
JRST (X) ; AND DISPATCH
>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
; CTOBP - CONVERT A CHARACTER ADDRESS TO A BYTE POINTER
;
; CALL: MOVEI T1,CHARADR
; PUSHJ P,CTOBP
; (RETURN) ; WITH BP IN AC T1
;
; USES ACS T1,T2
CTOBP: IDIVI T1,5 ; CONVERT TO WORD ADR + EXTRA
HLL T1,CBPTBL(T2) ; CONVERT EXTRA TO BIT POSITION
POPJ P, ; AND RETURN TO CALLER
; CBPTBL - CONVERSION TABLE FROM CHAR NUMBER(0-5) TO BYTE POINTER
POINT 7,,
CBPTBL: POINT 7,,6
POINT 7,,13
POINT 7,,20
POINT 7,,27
POINT 7,,34
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
SUBTTL QSTOR - Store a value/text-buffer in a Q-register
; CALL: MOVE T1,[SIXBIT/NAME/]
; MOVX T2,QB$???
; MOVE T3,VALUE/ADRREF
; TX? F,F$REF ; ?=Z IF ADRREF IS REALLY A TEXT-BUFFER ID
; ; ?=O IF ADRREF IS ADR OF REFERENCE TO A TEXT BUFFER
; PUSHJ P,QSTOR
; (RETURN)
;
; PRESERVES ACS (EXCEPT X)
QSTOR: PUSH P,N ; SAVE AC N
PUSH P,L ; SAVE AC L
TXNE F,F$REF ; IS ADRREF A TEXT BUFFER ID?
TXNN T2,QB$TXT ; IS Q-REGISTER A TEXT BUFFER?
JRST QSTOR1 ; NO
; MUST ADD TEXT BUFFER TO THE LINKED LIST AND GET ITS ID
MOVEI L,(T3) ; FETCH THE ADR OF REFERENCE
PUSHJ P,ADDBLK ; ADD THE BLOCK TO THE LINKED-LIST
MOVEI T3,(N) ; AND RETURN THE TEXT-BUFFER ID
; NOW SEE IF THE Q-REGISTER ALREADY EXISTS
QSTOR1: PUSHJ P,QFIND ; SEE IF THE Q-REGISTER EXISTS
JRST QSTOR2 ; NO, CREATE A NEW Q-REGISTER
; STORE NEW VALUES IN EXISTING Q-REGISTER
MOVE X,Q$BIT(T5) ; SAVE OLD Q-BITS
MOVE N,Q$PTR(T5) ; SAVE OLD Q-VALUE/Q-ID
MOVEM T2,Q$BIT(T5) ; SET NEW Q-BITS
MOVEM T3,Q$VAL(T5) ; SET NEW Q-VALUE/Q-ID
TXNE X,QB$TXT ; WAS OLD Q-REGISTER A TEXT BUFFER?
PUSHJ P,DELBLK ; YES, DELETE IT
JRST QSTOR3 ; RESTORE ACS AND RETURN TO CALLER
; ADD A NEW Q-REGISTER TO QTAB
QSTOR2: MOVE X,QR ; FETCH QTAB PDP
AOBJN X,.+1 ; INCREMENT IT
EXCH X,QR ; AND STORE IT
PUSH X,T1 ; SET NEW Q-REGISTER NAME
MOVE X,QR ; FETCH QTAB PDP
AOBJN X,.+1 ; INCREMENT QTAB PDP
EXCH X,QR ; AND STORE IT
PUSH X,T2 ; SET NEW Q-REGISTER BITS
MOVE X,QR ; FETCH QTAB PDP
AOBJN X,.+1 ; INCREMENT QTAB PDP
EXCH X,QR ; AND STORE IT
PUSH X,T3 ; SET NEW Q-REGISTER VALUE/TEXT-BUFFER-ID
; RESTORE ACS AND RETURN TO CALLER
QSTOR3: POP P,L ; RESTORE AC L
POP P,N ; RESTORE AC N
POPJ P, ; AND RETURN TO CALLER
SUBTTL QGET - Return a Q-register
; CALL: MOVE T1,[SIXBIT/NAME/]
; PUSHJ P,QGET
; (RETURN) ; T1:= SIXBIT Q-REGISTER NAME
; ; T2:= BITS
; ; T3:= NUMERIC VALUE/TEXT-BUFFER-ID
;
; USES ACS T1-T3
QGET: MOVEM T1,SBNAME ; SAVE THE Q-REGISTER NAME
PUSHJ P,QFIND ; FIND THE SPECIFIED Q-REGISTER
POPJ P, ; IT DOESN'T EXIST
MOVE T2,Q$BIT(T5) ; FETCH BITS INTO AC T2
MOVE T3,Q$VAL(T5) ; FETCH VALUE/TEXT-BUFFER-ID INTO AC T3
JRST CPOPJ1 ; AND RETURN TO CALLER
SUBTTL QFIND - Find a Q-register in QTAB
; CALL: MOVE T1,[SIXBIT/NAME/]
; PUSHJ P,QFIND
; (FAIL RETURN)
; (SUCCESS RETURN)
;
; USES ACS T1,T5
QFIND:
; MAKE A AOBJN POINTER FOR SEARCHING THROUGH QTAB
MOVE T5,QTAB ; FETCH BASE ADR OF Q-REGISTER TABLE
MOVEI X,(T5) ; COPY OF SAME
SUB X,QR ; COMPUTE MINUS LENGTH OF Q-REGISTER TABLE
HRLI T5,(X) ; <-LEN,,ADR>
; SEARCH FOR THE SPECIFIED Q-REGISTER
QFIND1: CAMN T1,(T5) ; IS THIS THE ONE?
JRST CPOPJ1 ; YES, GIVE SUCCESS RETURN TO CALLER
ADD T5,[<2,,2>] ; NO, POINT TO NEXT Q-REGISTER
AOBJN T5,QFIND1 ; AND LOOP FOR ALL Q-REGISTERS
POPJ P, ; Q-REGISTER NOT FOUND. GIVE FAIL
; RETURN TO CALLER
SUBTTL MKROOM - Make room for an arbitrary # of chars in main text buffer
; call: movei t1,#chars
; pushj p,mkroom
; (return)
;
; uses acs 1-17 DOES NOT PRESERVE 1-5,N,M
mkroom: move x,txtbuf ; fetch reference to text buffer
hlrz t2,B$1PTR(x) ; fetch adr of end of buffer
subi t2,T$DATA-B$1PTR(X) ; compute size of text buffer in words
move t3,@txtbuf ; fetch # chars in text buffer
addi t3,4(t1) ; plus # chars requested
movei n,(t3) ; copy of same
IDIVI N,5 ; CONVERTED TO WORDS
subi n,(t2) ; needed size minus what we have
jumple n,mkrm1 ; we have enough space. just shift buffer
; add space to main text buffer
movei n,^d10(n) ; fetch # words we need (plus some extra)
push p,l ; save ac l
movei l,txtbuf ; fetch adr of reference to text bufer
pushj p,expand ; expand text buffer to required size
pop p,l ; restore ac l
; SAVE ACS
MKRM1: MOVE X,[<2,,ACSAVE+2>] ; SETUP BLT POINTER
BLT X,ACSAVE+17 ; STORE ACS 2-17
; see if part of buffer must be shifted
move x,ptval ; fetch buffer pointer
camn x,@txtbuf ; at end of buffer?
JRST MKRM3 ; yes, don't have to shift buffer contents
JUMPL T1,MKRM4 ; NO, HAVE TO SHIFT PART OF BUFFER BACKWARDS
; (IE: FOR THE "D" COMMAND)
; SHIFT FROM "." THROUGH "Z" UP C(T1) CHARACTERS
; GET READY FOR THE UPWARD MOVE
MOVEI 14,(T1) ; AC14:=REQ (REQUESTED # CHARS)
IDIVI 14,5 ; AC14:=Q(REQ/5) , AC15:=REM(REQ/5)
IMULI 15,7 ; AC15:=(REM(REQ/5))*7
MOVN 13,15 ; AC13:=-(REM(REQ/5))*7
MOVEI 15,-43(15) ; AC15:=(REM(REQ/5))*7-43
MOVE 11,PTVAL ; PT (CURRENT BUFFER POSITION)
IDIVI 11,5 ; AC11:=Q(PT/5) , AC12:=REM(PT/5)
ADD 11,TXTBUF ; MAKE AC11 AN ABSOULUTE ADR
MOVEI 11,T$DATA(11) ; . . .
MOVNI 16,-5(12) ; AC12:=-REM(PT/5)-5
IMULI 16,7 ; AC16:=-(REM(PT/5)-5)*7
DPB 16,[POINT 6,MKRMBP,11] ; SIZE OF LAST PARTIAL WORD
ADDI 14,1(11) ; AC14:=Q(REQ/5)+Q(PT/5)+1
MOVE 16,@TXTBUF ; FETCH CHAR ADR OF END OF BUFFER
IDIVI 16,5 ; AC16:=Q(Z/5)
MOVEI T4,T$DATA+1(16) ; COMPUTE # WORDS TO MOVE
ADD T4,TXTBUF ; . . .
SUB T4,11 ; T2:=Q(Z/5)+1-Q(PT/5)=# WORDS TO MOVE
; PUT SHIFT ROUTINE IN FAST ACS
HRLI 11,(MOVE T2,0(T4)) ; AC11:=MOVE T2,[Q(PT/5)](T4)
HRLOI 12,(ROT T2,0) ; AC12:=ROT T2,-1
HRLI 13,(ROTC T2,0) ; AC13:=ROTC T2,-(REM(REQ/5))*7
HRLI 14,(MOVEM T3,0(T4)); AC14:=MOVEM T4,[Q(PT/5)+Q(REQ/5)+1](T4)
HRLI 15,(ROTC 2,0) ; AC15:=ROTC T2,(REM(REQ/5))*7-43
MOVE 16,.+2 ; AC16:=SOJGE T4,11
MOVE 17,[JRST MKRM2] ; AC17:=JRST MKRM2
SOJGE T4,11 ; T2:=T2-1. DONE?
; SHIFT IS ALMOST FINISHED
MKRM2: PORTAL .+1 ;[316] BACK FROM FAST ACS
ROTC T2,43(13) ; STORE LAST PARTIAL WORD
DPB T2,MKRMBP ; . . .
; UPDATE THE # CHARS IN BUFFER
MKRM3: ADDM T1,@TXTBUF ; ADD # CHARS TO BUFFER COUNT
; RESTORE ACS AND RETURN TO CALLER
MOVE 17,[<ACSAVE+2,,2>] ; SETUP BLT POINTER
BLT 17,17 ; ANS RESTORE ACS
POPJ P, ; AND RETURN TO CALLER
; SHIFT FROM "."+ABS(T1) THROUGH "Z" DOWN ABS(T1) CHARACTERS
MKRM4: MOVE 14,PTVAL ; INITIALIZE PARTIAL WORD POINTER
IDIVI 14,5 ; AC14:=Q(PT/5) , AC15:=REM(PT/5)
ADD 14,TXTBUF ; MAKE AC14 AN ABSOLUTE ADR
ADDI 14,T$DATA ; . . .
MOVE T4,14 ; T4:=Q(PT/5)
HRRZM 14,MKRMB1 ; INITIALIZE BP FOR LAST PARTIAL MOVE
IMULI 15,7 ; AC15:=(REM(PT/5))*7
DPB 15,[POINT 6,MKRMB1,11] ; SIZE:=(REM(PT/5))*7
MOVNI 15,-44(15) ; AC15:=44-(REM(PT/5))*7
DPB 15,[POINT 6,MKRMB1,5] ; POSITION:=44-(REM(PT/5))*7
MOVE 11,@TXTBUF ; FETCH "Z"
IDIVI 11,5 ; AC11:=Q(Z/5) , AC12:=REM(Z/5)
MOVEI 11,T$DATA+1(11) ; AC11:=Q(Z/5)+1
ADD 11,TXTBUF ; MAKE AC11 AN ABSOLUTE ADR
MOVE 13,T1 ; AC13:=REQ (# CHARS TO ADD)
IDIVI 13,5 ; AC13:=Q(REQ/5)
ADDI 13,-1(11) ; AC13:=Q(Z/5)-Q(REQ/5)
MOVNI 12,(14) ; AC12:=(REM(REQ/5))
IMULI 12,7 ; AC12:=(REM(REQ/5))*7
MOVNI 15,-43(12) ; AC15:=43-(REM(REQ/5))*7
SUBI T4,1(13) ; T2:=Q(PT/5)+Q(REQ/5)+Q(REQ/5)-Q(Z/5)-1
; = # WORDS TO SHIFT
; NOW PUT THE BACKWARDS SHIFT ROUTINE IN THE FAST ACS
HRLI 11,(MOVE T3,(T4)) ; AC11:=MOVE T3,[Q(Z/5)+1](T4)
HRLI 12,(ROTC T2,0) ; AC12:=ROTC T2,(REM(REQ/5))*7
HRLI 13,(MOVEM T2,(T4)) ; AC13:=MOVEM T2,[Q(Z/5)-Q(REQ/5)](T4)
MOVE 14,[ADDM T2,@13] ; AC14:=ADDM T2,@13
HRLI 15,(ROTC T2,0) ; AC15:=ROTC T2,43-(REM(REQ/5))*7
MOVE 16,MKRM5 ; AC16:=AOJLE T2,11
MOVE 17,[JRST MKRM6] ; AC17:=JRST KMRM6
LDB T5,MKRMB1 ; FECTH THE LAST PARTIAL WORD
MOVE T2,@11 ; FETCH FIRST WORD
ROT T2,-1 ; T2:=Q(PT/5)+Q(REQ/5) RIGHT JUSTIFIED
MKRM5: AOJLE T4,11 ; T2:=T2+1. DONE?
; DOWNWARD SHIFT IS ALMOST DONE
MKRM6: PORTAL .+1 ;[316] BACK FROM FAST ACS
DPB T5,MKRMB1 ; STORE THE LAST PARTIAL WORD
JRST MKRM3 ; DONE. RESTORE ACS AND RETURN
SUBTTL ADDBLK - Add a block to the Linked-List
; CALL: MOVEI L,ADRREF
; PUSHJ P,ADDBLK
; (RETURN) ; ID IS RETURNED IN AC N
;
; ACS PRESERVED
ADDBLK: PUSHJ P,SAVE2 ; SAVE ACS
MOVE T1,(L) ; FETCH ADR OF BLOCK
SETZM (L) ; CLEAR THE REFERENCE
SKIPN T2,LNKLST+1 ; ANYTHING IN LINKED-LIST?
MOVEI T2,LNKLST ; NO
HRRM T2,B$1PTR(T1) ; LNKLST+1 REFERENCES 2ND WORD OF BLOCK
MOVEI X,B$1PTR(T1) ; FETCH ADR OF FIRST WORD
HRRM X,(T2) ; 2ND WORD OF LAST BLOCK REFERENCES
; FIRST WORD OF NEW BLOCK
MOVEI X,LNKLST+1 ; FETCH ADR OF LNKLST+1
HRRM X,B$2PTR(T1) ; 2ND WORD OF NEW BLOCK REFERENCES
; LNKLST+1
MOVEI X,B$2PTR(T1) ; FETCH ADR OF 2ND WORD OF NEW BLOCK
MOVEM X,LNKLST+1 ; LNKLST+1 REFERENCES 2ND WORD OF NEW BLOCK
; ASSIGN AN ID TO THIS NEW BLOCK
AOS N,LNKID ; GENERATE A NEW ID
; AND RETURN IT IN AC N
MOVEM N,T$BID(T1) ; STORE BID FOR BLOCK
; INITIALIZE THE REFERENCE COUNT FOR THIS BLOCK TO 1
MOVEI X,1 ; INIT REFERENCE COUNT TO 1
MOVEM X,T$RCNT(T1) ; AND STORE IT AS 4TH WORD OF NEW BLLOCK
POPJ P, ; AND RETURN TO CALLER
SUBTTL REFBLK - Add one to the Reference Count for A BLOCK IN LINKED-LIST
; CALL: MOVEI N,ID
; PUSHJ P,REFBLK
; (RETURN)
;
; USES ACS X,L
REFBLK: SETZ L, ; T1 WILL POINT TO BLOCK
PUSHJ P,FNDBLK ; FIND THE BLOCK WITH SPECIFIED ID
POPJ P, ; NONE. RETURN TO CALLER
AOS T$RCNT(T1) ; ADD ONE TO THE REFERENCE COUNT
POPJ P, ; AND RETURN TO CALLER
SUBTTL DELBLK - Un-Reference a Block in Linked-List
; CALL: MOVEI N,ID
; PUSHJ P,DELBLK
; (RETURN)
;
; ACS PRESERVED (EXCEPT X,L)
DELBLK: PUSHJ P,SAVE5 ; SAVE ACS T1-T5
SETZ L, ; T1 WILL POINT TO BLOCK
PUSHJ P,FNDBLK ; FIND THE BLOCK WITH THE SPECIFIED ID
POPJ P, ; DOESN'T EXIST. RETURN TO CALLER
SOSLE T$RCNT(T1) ; DECREMENT THE REFERENCE COUNT
POPJ P, ; OTHERS USING BLOCK. LEAVE IT IN LIST
; REMOVE THE BLOCK FROM THE LIST
HRRZ T2,T$PBUF(T1) ; FETCH POINTER TO PREVIOS BLOCK
HRRZ T3,T$NBUF(T1) ; FETCH POINTER TO NEXT BLOCK
HLLZS T$PBUF(T1) ; DELETE ALL REFERENCES TO BLOCK
HRLI T1,-C$NREF ; MAKE AOBJN POINTER TO DELETE REFS
DELBK0: SETZM T$1REF(T1) ; CLEAR 2 REFS
AOBJN T1,DELBK0 ; AND TRY NEXT 2 REFS
; PATCH THE LINKS AROUND THE BLOCK
DELBK1: HRRM T3,(T2) ; LAST POINTS TO NEXT
HRRM T2,(T3) ; NEXT POINTS TO LAST
GPOPJ: TXO F,F$GCN ; FLAG THAT A GARBAGE COLLECTION NEEDED
POPJ P, ; AND RETURN TO CALLER
POPJ P, ; AND RETURN TO CALLER
SUBTTL FNDBLK - Find a Block (given its id) in the Linked-List
; CALL: MOVEI N,ID
; MOVEI L,ADRREF ; WILL REFERENCE THE BLOCK WHEN FOUND
; ; OR "SETZ L," IF T1 IS TO POINT TO BLOCK
; PUSHJ P,FNDBLK
; (FAIL RETURN)
; (SUCCESS RETURN) ; ADRREF WILL REFERENCE THE BLOCK
; ; IF L=0, THEN T1 POINTS TO BLOCK
;
; SMASHES ACS X,T1,T2
FNDBLK: SKIPN T1,LNKLST ; ANYTHING IN LINKED LIST?
POPJ P, ; NO, GIVE FAIL RETURN TO CALLER
; FIND THE BLOCK GIVEN ITS ID
FNDBK1: CAIN T1,LNKLST+1 ; AT END OF LIST?
POPJ P, ; YES, GIVE UP AND GIVE FAIL RETURN TO CALLER
MOVE X,T$BID-B$1PTR(T1) ; FETCH ID OF THIS BLOCK
CAMN X,N ; IS THIS THE ID WE WANT?
JRST FNDBK2 ; YES
HRRZ T1,1(T1) ; NO, FETCH POINTER TO NEXT BLOCK IN LIST
JRST FNDBK1 ; AND TRY IT
; FOUND BLOCK WITH SPECIFIED ID. SET UP REFERENCE TO IT
FNDBK2: MOVEI T1,C$NREF(T1) ; FETCH ADR OF FIRST DATA WORD IN BLOCK
JUMPE L,CPOPJ1 ; RETURN IF T1 SHOULD POINT TO BLOCK
MOVEM T1,(L) ; STORE IT IN REFERENCE
HRLM L,B$2PTR(T1) ; BIND THE REFERENCE TO BLOCK
JRST CPOPJ1 ; AND GIVE SUCCESS RETURN TO CALLER
SUBTTL SAVE AC ROUTINES
SAVE2: POP P,X ; SAVE RETURN ADDRESS
PUSH P,T1 ; SAVE T1
PUSH P,T2 ; SAVE T2
PUSHJ P,(X) ; RETURN
SKP ; CPOPJ RETURN
AOS -2(P) ; CPOPJ1 RETURN
REST2: POP P,T2 ; RESTORE T2
POP P,T1 ; RESTORE T1
POPJ P, ; AND RETURN
SAVE5: POP P,X ; SAVE RETURN ADDRESS
PUSH P,T1 ; SAVE T1
PUSH P,T2 ; SAVE T2
PUSH P,T3 ; SAVE T3
PUSH P,T4 ; SAVE T4
PUSH P,T5 ; SAVE T5
PUSHJ P,(X) ; RETURN
SKP ; CPOPJ RETURN
AOS -5(P) ; CPOPJ1 RETURN
POP P,T5 ; RESTORE T5
POP P,T4 ; RESTORE T4
POP P,T3 ; RESTORE T3
JRST REST2 ; RESTORE T2,T1 AND RETURN
>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
SUBTTL CPOPJX - Various POPJ Returns
; CPOPJ: NON-SKIP RETURN
; CPOPJ1: SKIP RETURN
; CPOPJ2: DOUBLE-SKIP RETURN
CPOPJ2: AOS (P)
CPOPJ1: AOS (P)
CPOPJ: POPJ P, ; RETURN TO CALLER
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
SUBTTL REQM - REQUEST MEMORY (CORE ALLOCATION)
; REQM - CORE ALLOCATION ROUTINE
;
; CALL IS: MOVE L,[XWD ADRREF,LENGTH]
; PUSHJ P,REQM
; (RETURN)
;
; CALLER MUST ALSO SET UP 'ADRREF' (REQM WILL ADD THE ADR OF
; THE FIRST DATA WORD IN THE ALLOCATED BLOCK TO THE RH OF 'ADRREF')
;
; ACS PRESERVED
REQM0: TXNN F,F$GCN ; GARBAGE COLLECTION NEEDED ?
JRST REQM3 ; NO, SIZE OF BLOCK.GT.C$GSIZ
PUSHJ P,GARCOL ; PERFORM A GARBAGE COLLECTION
SKP ; ACS ALREADY SAVED
REQM: PUSHJ P,SAVE2 ; SAVE T1,T2
MOVE X,.JBFF ; FETCH ADR OF FIRST FREE LOCATION
MOVEI T1,(X) ; " IN T1
ADDI T1,C$NREF(L) ; ADD REQUESTED LENGTH PLUS OVERHEAD WORDS
MOVEI T2,(L) ; FETCH REQUESTED LENGTH
ADDB T2,GSIZE ; ACCUMULATE # WORDS ALLOCATED SINCE
; LAST GARBAGE COLLECTION
CAMG T1,.JBREL ; DO WE HAVE THE CORE?
JRST REQM1 ; YES
CAILE T2,C$GSIZ ; NO, TIME FOR A GARBAGE COLLECTION?
JRST REQM0 ; YES, PERFORM ONE
REQM3: MOVEI T2,(T1) ; NO, FETCH ADR OF HIGHEST LOC WE WANT
CORE T2, ; AND ASK MONITOR FOR THE CORE
JRST REQM2 ; NOT ENOUGH CORE!
REQM1: MOVEI T2,1(X) ; FETCH ADR OF START OF NEW BLOCK
HRLI T2,(X) ; SET UP A BLT POINTER ...
BLT T2,(T1) ; AND ZERO OUT THE NEW BLOCK
MOVEM T1,.JBFF ; SAVE POINTER TO FIRST FREE LOCATION
HRLM T1,(X) ; SETUP POINTER TO NEXT BLOCK
HLRM L,(X) ; SETUP POINTER TO FIRST REFERENCE
SETZM (T1) ; ZERO THE FIRST FREE LOCATION
HLRZ T1,L ; FETCH ADR OF REFERENCE
MOVEI X,C$NREF(X) ; FETCH ADR OF FIRST DATA WORD
ADD X,(T1) ; ADD ADR FIRST DATA TO RH OF REFERENCE
HRRM X,(T1) ; AND UPDATE THE REFERENCE
POPJ P, ; AND RETURN
REQM2: TXNE F,F$GCN ; IS A GARBAGE COLLECTION NEEDED?
JRST REQM0 ; YES, PERFORM ONE
ERROR (CEF) ; NO, GIVE AN ERROR :
; "CORE EXPANSION FAILURE"
SUBTTL RELM - RELEASE MEMORY
; RELM - RELEASE A BLOCK OF MEMORY
;
; CALL IS: MOVE L,[XWD OFFSET,ADRREF]
; PUSHJ P,RELM
; (RETURN)
;
; 'OFFSET' IS THE DIFFERENCE BETWEEN THE RH OF 'ADRREF' AND ADR OF FIRST DATA.
;
; ACS PRESERVED
RELM: SKIPN (L) ; IS REFERENCE BOUND TO ANY BLOCK?
POPJ P, ; NO, GIVE IMMEDIATE RETURN
TXO F,F$GCN ; GARBAGE COLLECTION NEEDED
HLRE X,L ; FETCH THE OFFSET
MOVN X,X ; NEGATE THE OFFSET
ADD X,(L) ; ADD THE REFERENCE
HLLZS B$1PTR(X) ; ZAP THE 1ST REFERENCE
HRLI X,-C$NREF+1 ; MAKE AOBJN POINTER FOR REST
RELM0: SETZM B$2PTR(X) ; CLEAR 2 REFS
AOBJN X,RELM0 ; AND TRY NEXT REFS
SETZM (L) ; ZERO THE REFERENCE
POPJ P, ; AND RETURN
SUBTTL GARCOL - GARBAGE COLLECTION ROUTINE
; GARCOL - GARBAGE COLLECTION ROUTINE
;
; CALL IS: PUSHJ P,GARCOL
; (RETURN)
;
; ACS PRESERVED
GARCOL: PUSHJ P,SAVE5 ; SAVE T1,T2,T3,T4,T5
PUSH P,L ; SAVE AC L
SETZ T3, ; ZERO THE RELOCATION FACTOR
MOVE T4,HEAD ; FETCH ADR OF FIRST BLOCK OF CORE
; LOOP FOR EVERY BLOCK OF CORE
GCLOOP: SKIPN X,(T4) ; END OF LIST?
JRST GCDONE ; YES, FINISH UP
HLRZ T5,(T4) ; FETCH ADR OF NEXT BLOCK
MOVE T1,1(T4) ; FETCH 2ND REFERENCE WORD (1ST IS IN Z)
JUMPN T1,GCMOVE ; MOVE BLOCK IF IT IS REFERENCED
TRNE X,-1 ; IS BLOCK REFERENCED?
JRST GCMOVE ;YES, MOVE IT
; THIS IS AN UNBOUND BLOCK
HLRZ X,X ; FETCH ADR OF NEXT BLOCK
SUBI X,(T4) ; COMPUTE LENGTH OF THIS BLOCK
ADDI T3,(X) ; ACCUMULATE THE RELOCATION FACTOR
; TRY NEXT BLOCK
GCNEXT: MOVEI T4,(T5) ; LOAD ADR OF NEXT BLOCK
JRST GCLOOP ; AND TRY NEXT BLOCK
; MOVE THIS BLOCK (IF RELOCATION IS NON-ZERO)
;
; FIRST FIX UP REFERENCES
GCMOVE: JSP L,FIXREF ; RELOCATE THE REFERENCES
; NOW RELOCATE THE BLOCK
GCM3: MOVEI T2,(T4) ; FETCH ADR OF BLOCK
SUBI T2,(T3) ; ADR WHERE BLOCK WILL GO
HRLI T2,(T4) ; ADR WHERE IT IS NOW
HLRZ T1,(T4) ; ADR OF END OF BLOCK+1
SUBI T1,(T3) ; END OF WHERE IT WILL GO
MOVEI X,(T2) ; SAVE ADR OF NEW POSITION OF BLOCK
BLT T2,-1(T1) ; MOVE THE BLOCK
HRLM T1,(X) ; STORE POINTER TO NEXT BLOCK
JRST GCNEXT ; NOW TRY THE NEXT BLOCK
; FINISH UP AFTER THE GARBAGE COLLECTION
GCDONE: MOVNI T1,(T3) ; FETCH NEGATIVE RELOCATION FACTOR
ADDB T1,.JBFF ; UPDATE POINTER TO FIRST FREE
SETZM (T1) ; ZERO THE FIRST FREE LOC
HLRZ X,.JBCOR ; FETCH MIN CORE SIZE
CAIGE T1,(X) ; BELOW MINIMUM SIZE?
MOVEI T1,(X) ; YES, USE MINIMUM SIZE
CORE T1, ; RELEASE UNNEEDED CORE
JFCL ; ? ? ?
SETZM GSIZE ; CLEAR "# WORDS ALLOCATED SINCE LAST
; GARBAGE COLLECTION"
TXZ F,F$GCN ; SET "GARBAGE COLLECTION NOT NEEDED"
POP P,L ; RESTORE AC L
POPJ P, ; AND RETURN
SUBTTL FIXREF - RELOCATE THE REFERNECES TO A DYNAMIC BLOCK
; CALL: MOVEI T4,BLOCK
; MOVEI T3,RELOC.CONSTANT
; JSP L,FIXREF
; (RETURN)
;
; SMASHES ACS X,T1,T2. USES AC T4
FIXREF: JUMPE T3,(L) ; RETURN IF RELOC.CONSTANT=ZERO
HRLI T4,-C$NREF ; MAKE AOBJN POINTER FOR LOOPING
JRST FIXRF2 ; AND JUMP INTO LOOP FOR FIRST REF
FIXRF1: HLRZ T1,(T4) ; FETCH ADR OF LH REF
JUMPE T1,FIXRF2 ; NONE. TRY RH
HRRZ X,(T1) ; FETCH THE CONTENTS OF REF
SUBI X,(T3) ; RELOCATE IT
HRRM X,(T1) ; AND RESTORE IT
FIXRF2: HRRZ T1,(T4) ; FETCH ADR OF RH REF
JUMPE T1,FIXRF3 ; NONE. TRY NEXT WORD
HRRZ X,(T1) ; FETCH CONTENTS OF REF
SUBI X,(T3) ; RELOCATE IT
HRRM X,(T1) ; AND RESTORE IT
FIXRF3: AOBJN T4,FIXRF1 ; LOOP FOR ALL REFERENCE WORDS
; RESTORE AC T4 TO ITS FORMAER VALUE
SUBI T4,C$NREF ; RESTORE VALUE OF AC T4
JRST (L) ; DONE. RETURN TO CALLER
SUBTTL EXPAND - Expand a Block of Core
; CALL: MOVEI N,ADDLEN
; MOVE L,[<OFFSET,,ADRREF>]
; PUSHJ P,EXPAND
; (RETURN)
;
; 'ADDLEN' IS THE # WORDS TO ADD AT END OF BLOCK
; 'OFFSET' IS THE DIFFERENCE BETWEEN THE RH OF 'ADRREF' AND ADDRESS
; OF FIRST DATA WORD IN BLOCK.
; 'ADRREF' IS THE ADDRESS OF THE REFERENCE TO BLOCK.
;
; USES AC X. ALL OTHER ACS PRESERVED.
EXPAND: PUSHJ P,SAVE5 ; SAVE T1-T5
; SEE IF BLOCK TO BE EXPANDED IS LAST IN CORE
HLRZ T1,L ; FETCH OFFSET
ADD T1,(L) ; COMPUTE ADR OF BLOCK
HLRZ T2,B$1PTR(T1) ; FETCH POINTER TO NEXT BLOCK
SKIPE (T2) ; A BLOCK AFTER THIS ONE?
JRST EXPAN1 ; YES, MUST RE-ALLOC. AND BLT
; BLOCK IS AT END OF CORE. JUST EXTEND IT.
;
; ALLOCATE A BLOCK OF 'ADDLEN'-C$NREF WORDS (WHICH IS IMMEDIATELY AFTER BLOCK)
PUSH P,L ; SAVE AC L
MOVEI L,-C$NREF(N) ; FETCH LEN OF ANNEX BLOCK
HRLI L,TMPREF ; TMPREF WILL REFERENCE THE ANNEX BLOCK
SETZM TMPREF ; TMPREF WILL POINT TO FIRST DATA WORD
PUSHJ P,REQM ; ALLOCATE THE ANNEX BLOCK
POP P,L ; RESTORE AC L
MOVE T2,TMPREF ; FETCH ADR OF ANNEX BLOCK
HRLI T2,-C$NREF+1 ; MAKE AOBJN PTR FOR CLEARING ALL REFS
EXPAN0: SETZM B$1PTR(T2) ; CLEAR 2 REFS
AOBJN T2,EXPAN0 ; AND TRY FOR NEXT REF WORD
HLRZ T1,L ; FETCH ADR OF MAIN BLOCK
ADD T1,(L) ; . . .
HLRZ T2,B$1PTR(T1) ; FETCH POINTER TO ANNEX BLOCK
ADDI T2,(N) ; MAKE IT POINT PAST ANNEX BLOCK
HRLM T2,B$1PTR(T1) ; PUT IT BACK IN MAIN BLOCK
JRST GPOPJ ; AND RETURN TO CALLER
; (GARBAGE COLLECTION NEEDED)
; ALLOCATE A BIGGER BLOCK AND BLT OLD BLOCK TO IT
EXPAN1: PUSH P,L ; SAVE AC L
MOVEI L,(T2) ; COMPUTE LENGTH OF OLD BLOCK
SUBI L,(T1) ; . . .
MOVEI T3,(L) ; SAVE LENGTH OF OLD BLOCK
ADDI L,(N) ; COMPUTE NEW LENGTH
HRLI L,TMPREF ; ADR OF REF TO NEW BLOCK
SETZM TMPREF ; REF WILL BE TO FIRST DATA WORD
PUSHJ P,REQM ; ALLOCATE A NEW,BIGGER BLOCK
; BLT OLD BLOCK TO NEW BLOCK
POP P,L ; RESTORE AC L
MOVE T4,TMPREF ; FETCH ADR OF NEW BLOCK
MOVEI X,(T4) ; COPY OF "
HLRZ T1,L ; FETCH 'OFFSET'
ADD T1,(L) ; COMPUTE ADR OF OLD BLOCK
HRLI X,(T1) ; MAKE SOURCE OF BLT POINTER
MOVEI T2,(T3) ; FETCH LENGTH OF OLD BLOCK
ADDI T2,(X) ; END OF DEST
BLT X,(T2) ; BLT THE OLD BLOCK TO NEW
; FIX UP THE REFERENCES TO NEW BLOCK
MOVE T2,TMPREF ; FETCH ADR OF NEW BLOCK
SUBI T2,(T1) ; COMPUTE REFERENCE RELOCATION CONSTANT
HRLI T1,-C$NREF ; MAKE AOBJN POINTER FOR LOOP
JRST EXPAN3 ; AND JUMP INTO LOOP FOR FIRST REF
EXPAN2: HLRZ X,B$1PTR(T1) ; FETCH ADR OF LH REF
JUMPE X,EXPAN3 ; NONE. TYR RH REF
HRRZS B$1PTR(T1) ; CLEAR THE REF FROM OLD BLOCK
HRLM X,B$1PTR(T4) ; AND REF TO NEW BLOCK
MOVE T3,(X) ; FETCH CONTENTS OF REF
ADDI T3,(T2) ; AND RELOCATE IT
HRRM T3,(X) ; AND RESTORE IT
EXPAN3: HRRZ X,B$1PTR(T1) ; FETCH ADR OF RH REF
JUMPE X,EXPAN4 ; NONE. TRY NEXT REF WORD
HLLZS B$1PTR(T1) ; CLEAR THE REF FROM OLD BLOCK
HRRM X,B$1PTR(T4) ; ADD REF TO NEW BLOCK
MOVE T3,(X) ; FETCH CONTENTS OF REF
ADDI T3,(T2) ; RELOCATE IT
HRRM T3,(X) ; AND RESTORE CONTENTS
EXPAN4: MOVEI T4,1(T4) ; INCR PTR TO NEXT REF IN NEW BLOCK
AOBJN T1,EXPAN2 ; AND LOOP FOR ALL REFS OF OLD BLOCK
JRST GPOPJ ; AND RETURN TO CALLER
; (AND FLAG THAT GARBAGE COLLECTION NEEDED)
SUBTTL COMPRS - Compress a Block of Core
; CALL: MOVEI N,<#WORDS> ; # WORDS TO REMOVE FROM END OF BLOCK
; MOVX L,<OFFSET,,ADRREF> ; FOR THE BLOCK
; PUSHJ P,COMPRS
; (RETURN)
;
; SMASHES ACS X,T1-T3
COMPRS: CAIG N,-B$1PTR ; CAN WE COMPRESS THE BLOCK?
POPJ P, ; NO, IT WOULDN'T DO ANY GOOD
; COMPUTE THE ADR OF FIRST DATA WORD IN BLOCK
HLRZ T1,L ; FETCH THE OFFSET
ADD T1,(L) ; ADD TO POINTER INTO BLOCK
MOVS T2,B$1PTR(T1) ; FETCH FIRST WORD OF BLOCK
MOVEI T3,(T2) ; SAVE ADR OF END OF BLOCK +1
SUBI T2,(N) ; COMPUTE NEW END OF BLOCK+1
MOVSM T2,B$1PTR(T1) ; PUT THE WORD BACK IN FIRST WORD OF BLOCK
SETZM (T2) ; CLEAR THE UNNEEDED PART OF BLOCK
MOVEI X,1(T2) ; FORM BLT POINTER TO CLEAR
HRLI X,(T2) ; . . .
BLT X,C$NREF(T2) ; CLEAR THE REFERENCES FOR THE "NEW" BLOCK
HRLZM T3,(T2) ; SET POINTER TO NEXT BLOCK FOR "NEW" BLOCK
POPJ P, ; AND RETURN TO CALLER
SUBTTL SETSTK - INITIALIZE A DYNAMIC STACK
; CALL: STSTK (AC,LEN,REF)
; (RETURN)
;
; SMASHES ACS X,T1,T2,T3,N,L
SETSTK: HLRZ T3,T1 ; FETCH REF ADR
MOVEI L,(T3) ; AND COPY INTO AC L
PUSHJ P,RELM ; RELEASE ANY EXISTING STACK
MOVE L,T1 ; FETCH <REF,,LEN>
PUSHJ P,REQM ; AND ALLOCATE THE NEW STACK
MOVNI X,(T1) ; FETCH -LEN
HRLOI X,(X) ; FORM "IOWD LEN,0"
ADD X,(T3) ; FINISH THE PDP
POP P,T2 ; POP OUR RETURN ADR
MOVEM X,(N) ; INITIALIZE THE PDP POINTER
PUSH P,T2 ; PUSH OUR RETURN ADR
HRL N,T1 ; FORM <LEN,,AC>
HRLM N,B$2PTR+1(X) ; BIND AC TO PDL
MOVEI L,(T3) ; FETCH ADR OF REF
PJRST ADDPDL ; AND ADD PDL TO THE PROTECTED PDL LIST
; AND RETURN TO CALLER
SUBTTL ADDPDL - Add a PDL to PDLTAB
; CALL: MOVE N,[<INCREMENTAL LENGTH,,ADR>]
; MOVE L,[<OFFSET,,ADRREF>]
; PUSHJ P,ADDPDL
; (RETURN)
;
; NOTE: ARGUMENTS ARE DESCRIBED IN THE 'FNDPDL' ROUTINE.
;
; USES ACS X,T1,T2
ADDPDL: PUSHJ P,FNDPDL ; SEE IF THE PDL ALREADY EXISTS
JUMPE T1,[ERROR (PTS)] ; NO, AND THERE'S NO MORE ROOM!!
MOVEM N,(T1) ; STORE <INC. LEN.,,ADR> IN PDLTAB
MOVEM L,C$NPDL(T1) ; STORE <OFFSET,,ADRRES> IN PDLTAB
POPJ P, ; AND RETURN TO CALLER
SUBTTL DELPDL - Remove a PDL from PDLTAB
; CALL: MOVEI N,ADR
; PUSHJ P,DELPDL
; (RETURN)
;
; NOTE: ARGUMENTS ARE DESCRIBED IN THE 'FNDPDL' ROUTINE
DELPDL: PUSHJ P,FNDPDL ; FIND THE PDL IN PDLTAB
POPJ P, ; NOT THERE. GOOD, SAVES US THE TROUBLE
SETZM (T1) ; KNOCK THE PDL OUT OF PDLTAB
POPJ P, ; AND RETURN TO CALLER
SUBTTL FNDPDL - Find a PDL in PDLTAB
; CALL: MOVEI N,ADR
; PUSHJ P,FNDPDL
; (FAIL RETURN) ; AC T1 POINTS TO FIRST FREE ENTRY
; OR IS ZERO IF PDLTAB IS FULL
; (SUCCESS RETURN) ; AC T1 POINTS TO PDL ENTRY IN PDLTAB
;
; PDLTAB:
; ----------------------------------------------
; ! INCREMENTAL LENGTH ! ADR !
; !--------------------------------------------!
; / . . . /
; !--------------------------------------------!
; ! OFFSET ! ADRREF !
; !--------------------------------------------!
; / . . . /
; ----------------------------------------------
;
;
; 'INCREMENTAL LENGTH' IS THE # WORDS ADDED TO PDL ON EACH POV.
;
; 'ADR' IS THE ADDRESS OF PDP FOR THE DESIRED PDL.
;
; 'ADRREF' IS THE ADDRESS OF REFERENCE TO THE PDL.
;
; 'OFFSET' IS THE DIFFERENCE BETWEEN THE RH OF ADRREF AND THE
; ADDRESS OF FIRST WORD OF PDL.
;
; USES ACS X,T1,T2
FNDPDL: MOVE T1,[IOWD C$NPDL,PDLTAB+1] ; AOBJN PTR FOR SEARCHING
; THROUGH PDLTAB
SETZ T2, ; IN CASE THERE ARE NO FREE ENTRIES
FNDPD1: HRRZ X,(T1) ; FETCH 'ADR' OF A PDL ENTRY FROM PDLTAB
CAIN X,(N) ; IS IT THE 'ADR' WE WANT?
JRST CPOPJ1 ; YES
SKIPN (T1) ; NO, IS IT A FREE ENTRY?
MOVEI T2,(T1) ; YES, REMEMBER ITS ADDRESS
AOBJN T1,FNDPD1 ; LOOP FOR ALL ENTRIES IN PDLTAB
MOVEI T1,(T2) ; CAN'T FIND DESIRED PDL. RETURN FF ADR.
POPJ P, ; AND GIVE FAIL RETURN TO CALLER
SUBTTL APRTRP - APR Trap handler (POV Recovery)
APRTRP: MOVEM X,ACSAVE+X ; SAVE AC X
MOVE X,.JBCNI ; FETCH REASON FOR APR TRAP
TXNE X,AP.ILM ;[420] IS IT BECAUSE OF ILL MEM REF?
ERROR (ILM) ;[420] YES, REPORT IT TO LUSER
TXNN X,AP.POV ; IS IT BECAUSE OF PDL OVERFLOW?
ERROR (UAT) ; NO. ** UNENABLED APR TRAP **
; SAVE ACS T1,T5,N,L,P
MOVEM P,ACSAVE+P ; SAVE AC P
MOVEM L,ACSAVE+L ; SAVE AC L
MOVEM N,ACSAVE+N ; SAVE AC N
MOVE X,[<T1,,ACSAVE+T1>] ; SO WE CAN SAVE T1-T5
BLT X,ACSAVE+T5 ; ALL AT ONCE
; SETUP TEMP CONTROL PDP
MOVE P,[IOWD C$TPDL,TPDL] ; SETUP TEMP PDL PDP
MOVEI N,P ; CHANGE THE PDL ENTRY IN PDLTAB FOR
PUSHJ P,FNDPDL ; THE CONTROL PDL
ERROR (MCP) ; ** MISSING CONTROL PDL **
MOVEI X,ACSAVE+P ; TO POINT TO ACSAVE+P
HRRM X,(T1) ; WHERE THE REAL P IS HIDDEN
MOVEI T3,(T1) ; SAVE 'P' INDEX INTO PDLTAB TO SAVE TIME
MOVE T5,PDL ; FETCH ADR OF CONTROL PDL
HRLM X,B$2PTR(T5) ; AND REFERENCE ACSAVE+P TO IT
; FIND THE PDP WHICH CAUSED THE OVERFLOW
MOVE T1,[IOWD C$NPDL,PDLTAB+1] ; FOR LOOPING THROUGH PDLTAB
APR1: SKIPN T2,(T1) ; A NULL ENTRY IN PDLTAB?
JRST APR2 ; YES, IGNORE IT
SKIPL (T2) ; NO, IS THIS THE OVERFLOWED PDL?
JRST APR3 ; YES. STOP THE SEARCH
APR2: AOBJN T1,APR1 ; NO, KEEP SEARCHING THROUGH PDLTAB
ERROR (CFP) ; ** CAN'T FIND OVERFLOWED PDL **
; AC T1 POINTS TO PDLTAB ENTRY FOR PDL THAT OVERFLOWED
;
; EXPAND THE PDL THAT OVERFLOWED
APR3: HLRZ N,(T1) ; FETCH THE INCREMENTAL LENGTH FOR PDL
MOVE L,C$NPDL(T1) ; FETCH <OFFSET,,ADRREF> FOR PDL
PUSHJ P,EXPAND ; AND EXPAND THE PDL
; PATCH UP THE PDP (IE: RESTORE -VE COUNT TO LH)
MOVNI N,(N) ; COMPUTE -VE OF INCREMENTAL LENGTH
HRLM N,(T2) ; AND FIX UP THE PDP
MOVEI X,P ; FETCH ADR CONTROL PDP
HRRM X,(T3) ; AND STORE IN ITS PDLTAB ENTRY
MOVE T5,PDL ; FETCH ADR OF CONTROL PDL
HRLM X,B$2PTR(T5) ; AND REFERENCE AC P TO IT
; RESTORE ACS X,T1-T5,N,L,P
MOVE P,ACSAVE+P ; RESTORE AC P
MOVE L,ACSAVE+L ; RESTORE AC L
MOVE N,ACSAVE+N ; RESTORE AC N
MOVE X,[<ACSAVE+T1,,T1>] ; RESTORE ACS T1-T5,X
BLT X,X ; ALL IN TWO INSTRUCTIONS
; RETURN TO POINT OF CALL
JRST @.JBTPC ; RETURN TO POINT OF CALL
SUBTTL UUOTRP - LUUO Handler
UUOTRP: PORTAL .+1 ;[325] IN CASE OF LOWSEG LUUO
LDB X,[POINT 9,.JBUUO,8] ; FETCH THE LUUO OPCODE
CAIN X,LUUERR ; IS IT AN ERROR CALL?
JRST ERRHAN ; YES, GOTO THE ERROR HANDLER
CAIN X,LUUCER ; NO, IS IT A ":" ERROR CALL?
JRST CERR ; YES
CAIN X,LUUCR1 ; IS IT SPECIAL ":" ERROR CALL?
JRST CER1 ; YES
CAIN X,LUUWRN ; IS IT A WARNING CALL?
JRST WARHAN ; YES
CAIN X,LUUCEO ; IS IT A "CHECK EO VALUE" CALL?
JRST CEO ; YES
ERROR (IUU) ; NO, ** ILLEGAL LUUO **
; CER1 - POP TOP OF STACK AND FALL INTO CERR1
CER1: POP P,X ; POP TOP OF STACK
; JRST CERR ; AND FALL INTO CERR
; CERR - GIVE ERROR MSG IF ":" FLAG OFF, ELSE GIVE FAIL RETURN
CERR: TXNN F,F$COL ; IS THIS A ":" MODIFIED COMMAND?
JRST ERRHAN ; NO, GIVE AN ERROR MESSAGE
POP P,X ; YES, CLEAN UP THE STACK
JRST FAIRET ; AND GIVE A "FAIL" RETURN
; WARHAN - GIVE A WARNING MESSAGE
WARHAN: MOVEI C,"%" ; MESSAGE STARTS WITH "%"
JRST ERRH1 ; JUMP INTO MESSAGE HANDLER
; CEO - JUMP TO SPECIFIED ADR IF A FEATURE IS DISABLED
CEO: LDB X,[POINT 4,.JBUUO,12] ; FETCH # FROM LUUO CALL
CAMG X,EOVAL ; IS THAT FEATURE ENABLED?
POPJ P, ; YES, RETURN TO POINT OF CALL PLUS ONE
POP P,X ; NO, CLEAN UP PDL...
JRST @.JBUUO ; AND JUMP TO THE SPECIFIED ADR
SUBTTL REENTR - Reenter Processing (after ^C^C.REENTER)
REENTR: PORTAL .+1 ;[363] KI/KL RE-ENTRY GATEKEEPER
TXO F,F$REE ;[317] WE'LL STOP AFTER THIS CMD IS DONE
JRST @.JBOPC ;[317] BUT CONTINUE LEST WE SCREW UP
; RESTRT - RESTART AFTER ^C
RESTRT: PORTAL .+1 ;[375] KI/KL ENTRY GATEKEEPER
RESET ;[375] RESET THE WORLD
STORE (X,LOWBEG,LOWEND,0) ;[375] CLEAR LOWSEG
MOVX X,<-1,,.GTPRG> ;[375] GET MY PROGRAM NAME
GETTAB X, ;[375] ONLY SURE WAY
MOVX X,'XTEC ' ;[375] ???
MOVEM X,SEGNAM ;[375] SAVE "SEGMENT NAME"
SETZ F, ;[375] CLEAR ALL FLAGS
JRST $XTEC ;[375] CONTINUE "START"
SUBTTL ERRHAN - Error Handler
ERRHAN: CLRBFI ; CLEAR TYPE-AHEAD
MOVEI C,"?" ; MESSAGE STARTS WITH A "?"
ERRH1: PUSH P,N ; SAVE AC N
PUSH P,M ; AND AC M
SETZM OUTADR ; FORCE OUTPUT TO USER'S TERMINAL
SETZM INPADR ; GO BACK TO TTY FOR INPUT
SETZM INPCHR ; . . .
TXZ F,F$NTI ; . . .
PUSHJ P,TCHR ; TYPE THE LEADING MESSAGE CHAR
MOVE T5,EHVAL ; FETCH MESSAGE LENGTH
TXNN T5,JW.WPR ; TYPE PREFIX?
JRST ERRH3 ; NO, SKIP THE PREFIX
; PREFIX TO MESSAGE (IE: 'XTC???')
MOVSI N,'XTC' ; FETCH THREE CHAR ABBREV. FOR NAME
HRR N,.JBUUO ; FETCH '???' OF THE ERROR CALL
CAXN N,'XTCILM' ;[420] ILL MEM REF?
SETZM PTVAL ;[420] .:=0
PUSHJ P,TSIX ; AND TYPE THE PREFIX ('XTC???')
TXNN T5,JW.WFL ; WANT MESSAGE TOO?
JRST ERRH88 ; NO, DONE WITH MESSAGE TYPING
ERRH2: MOVEI N,[ASCIZ/ -/] ; YES, TYPE A DASH BETWEEN PREFIX AND IT
PUSHJ P,TSTR ; . . .
; MUST GETSEG <C$ERRS> TO TYPE LONG MESSAGES
ERRH3: PUSH P,[<ERRH99>] ; SAVE RETURN ADR
MOVE X,[<C$ERRS>] ; FETCH NAME OF ERROR SEGMENT
MOVEM X,GSGNAM ; AND STORE IN GETSEG BLOCK
PUSH P,[<XTCERR>] ; FETCH ADR OF WHERE TO GO IN XTCERR
PJRST GETSG ; AND GO TO THE ERROR SEGMENT
ERRH88: PUSHJ P,TCRLF ; GO TO A NEW LINE
ERRH89: LDB X,[POINT 9,.JBUUO,8] ; FETCH ERROR OPCODE
CAIN X,LUUWRN ; A WARNING?
JRST ERRH94 ;[416] YES, NEVER EXIT
MOVX X,C$CCNM ; FETCH THE NAME OF THE CCL CMD BUFFER
CAMN X,MACNAM ; ERROR IN CCL COMMAND?
EXIT 1, ; YES, EXIT FOR FATAL CCL CMD ERROR
ERRH94: MOVEI C,"*" ; TYPE FAKE PROMPT CHAR
PUSHJ P,TCHR ; . . .
PUSHJ P,GETCH ; AND PEEK AT FIRST CHAR
CAIN C,"/" ; WANT MORE OF MESSGAE?
JRST ERRH2 ; YES
CAIE C,"?" ; NO, WANT LAST TEN COMMANDS?
JRST ERRH98 ; NO, DONE
; TYPE LAST TEN COMMANDS
PUSHJ P,ERRCTY ; TYPE LAST 10 COMMANDS
JRST ERRH89 ; AND GO BACK FOR MORE
; SAVE THE CHAR WE PEEKED AT
ERRH98: MOVEM C,INPCHR ;SAVE THE CHAR WE PEEKED AT
; FINISH UP WITH MESSAGE TYPING
ERRH99: LDB X,[POINT 9,.JBUUO,8] ; FETCH OPCODE OF LAST MSG CALL
POP P,M ; RESTORE AC M
POP P,N ; RESTORE AC N
CAIN X,4 ; WAS IT A WARNING CALL?
POPJ P, ; YES, RETURN TO CALLER
; ERRREC - RECOVER FROM AN ERROR
ERRREC: SETZM MACLVL ; CLEAR THE MACRO NESTING LEVL COUNT
STSTK (QP,C$QPLN,QPDL) ; REINITIALIZE THE
; Q-REGISTER PDL
MOVE X,QP ; FETCH THE PDP FOR QPDL
PUSH X,[<0>] ; AND PUSH 3 ZEROS TO MARK BEGINNING
PUSH X,[<0>] ; . . .
PUSH X,[<0>] ; . . .
MOVEM X,QP ; AND STORE THE UPDATED PDP
SETZM INPADR ; CLEAR THE ADR OF GET-A-CHAR ROUTINE
TXZ F,F$NTI ; CLEAR SOME FLAGS
SKIPN X,MACBUF ; MACBUF POINT TO SOMETHING?
JRST ERRR1 ; NO
HRRZS T$1REF(X) ; YES, UNBIND IT
SETZM T$ACRF(X) ; AND UNBIND THE AC REFS
SETZM MACBUF ; CLEAR MACBUF
MOVE N,CMDBID ; AND UNBIND THE CURRENT COMMAND BUFFER
PUSHJ P,DELBLK ; . . .
ERRR1: MOVE T5,@PDL ; FETCH TOP LEVEL RETURN ADR
STSTK (P,C$PDLL,PDL) ; REINITIALIZE THE CONTROL PDL
JRST (T5) ; AND RETURN TO TOP LEVEL
; (WHOEVER THAT IS!)
>;; FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
SUBTTL ERCTY - TYPE LAST FEW COMMANDS AFTER AN ERROR
; LAST 10 (OR SO) CHARS FROM COMPIILATION ERRORS
;
; LAST 10 COMMANDS FOR EXECUTION ERRORS
ERRCTY: SKIPN MACLVL ; COMPILATION ERROR?
JRST ERRCTC ; YES
; TYPE LAST 10 COMMANDS FOR EXECUTION ERRORS
MOVE T2,TENIDX ; FETCH POINTER TO LAST COMMAND
MOVEI T4,^D10 ; FETCH LOOP COUNTER
ERRCT1: MOVEI T2,1(T2) ; POINT TO NEXT COMMAND
IDIVI T2,^D10 ; FORM INDEX INTO 'TENCMD'
MOVEI T2,(T3) ; . . .
MOVE N,TENCMD(T3) ; FETCH INFO ABOUT COMMAND
JUMPE N,ERRCT2 ; IGNORE IF NULL
PUSH P,T2 ; SAVE AC T2 FROM 'TMSG'
PUSHJ P,TMSG ; TYPE THE COMMAND
POP P,T2 ; RESTORE AC T2
ERRCT2: SOJG T4,ERRCT1 ; LOOP FOR ALL 10 COMMANDS
; DONE. TYPE ?<CR><LF> AND RETURN TO CALLER
ERRCT3: MOVEI N,[ASCIZ/?
/] ; TYPE ?<CR><LF>
PJRST TSTR ; AND RETURN TO CALLER
; TYPE LAST 10 (OR SO) CHARS FOR A COMPILATION ERROR
ERRCTC: PUSHJ P,CURCHA ; FETCH CURRENT POSITION IN COMMAND STRING
SUBI T1,^D9 ; BACKUP 10 CHARS
MOVEI T4,^D10 ; SETUP LOOP COUNT
CAIL T1,T$DATA*5 ; TO BEG OF COMMAND BUFFER?
JRST ERRCC1 ; NO, ALL IS OK
SUBI T4,(T1) ; NO 10 CHARS. ADJUST POINTER AND COUNT
MOVEI T1,T$DATA*5 ; POINT TO FIRST CHAR IN COMMAND BUFFER
ERRCC1: IDIVI T1,5 ; FORM BYTE POINTER TO COMMAND STRING
HLL T1,CBPTBL-1(T2) ; . . .
ADD T1,@CMDBUF ; . . .
ERRCC2: ILDB C,T1 ; FETCH A COMMAND STRING CHAR
PUSHJ P,TCCHR ; AND TYPE IT
SOJG T4,ERRCC2 ; AND TYPE UP TO 10 CHARS
JRST ERRCT3 ; DONE. FINISH UP AND RETURN TO CALLER
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
SUBTTL SAVPCM - SAVE LAST COMMAND STRING IN A Q-REGISTER
SAVPCM: PUSHJ P,GETCH ; FETCH THE NEXT CHAR
CAIN C,"(" ; IS IT A LONG Q-REGISTER NAME?
JRST SAVPC3 ; YES
CAIN C,"*" ; NO, IS IT THE SPECIAL Q-REG "*"?
JRST SAVPC1 ; YES
PUSHJ P,CHKAN ; NO, IS IT A NORMAL Q-REGISTER NAME?
ERROR (IQN) ; NO, ** ILLEGAL Q-REGISTER NAME **
SAVPC1: MOVSI N,'A'-"A"(C) ; PUT SIXBIT CHAR IN AC N
LSH N,^D12 ; AND LEFT JUSTIFY IT
SAVPC2: PUSH P,N ; SAVE THE Q-REGISTER NAME
SKIPN N,CMDBID ; FETCH THE BUFFER ID OF LAST COMMAND
JRST BEGIN1 ; OOPS! NO PREVIOUS COMMAND (IGNORE IT)
SETZ L, ; SO THAT AC T1 WILL POINT TO BUFFER
PUSHJ P,FNDBLK ; FIND THE LAST COMMAND BUFFER
JRST BEGIN1 ; GONE. FORGET IT!
AOS T$RCNT(T1) ; INCR. REFERENCE COUNT FOR BUFFER
POP P,T1 ; RESTORE THE Q-REGISTER NAME
MOVX T2,QB$TXT ; SET THE "TEXT" BIT
MOVE T3,CMDBID ; FETCH THE BUFFER ID OF BUFFER
TXZ F,F$REF ; FLAG THAT T3 HAS A BUFFER ID
PUSHJ P,QSTOR ; AND STORE THE BUFFER IN Q-REGISTER
JRST BEGIN1 ; AND CONTINUE WHERE WE LEFT OFF
; SCAN A FANCY Q-REGISTER NAME
SAVPC3: PUSHJ P,GSIX ; PICK UP THE Q-REGISTER NAME
PUSHJ P,GCHR ; SCAN THE NEXT CHAR
CAIE C,")" ; IS IT A ")"?
ERROR (IQN) ; NO, ILLEGAL Q-REGISTER NAME
JRST SAVPC2 ; YES, CONTINUE
>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
SUBTTL Phased Pure Low Segment Code
RELOC 0 ; DOWN TO THE LOW SEGMENT
LOCODE: ; DEFINE WHERE LOW SEGMENT CODE GOES
RELOC ; BACK TO THE HIGH SEGMENT
HICODE: ; DEFINE START OF PHASED CODE
PHASE LOCODE ; KEEP IN PHASE WITH THE LOWSEGMENT
; GETSG - ROUTINE TO TRANSFER CONTROL BETWEEN CONTROL AND ERROR SEGMENT
GETSG: MOVEM 0,ACSAVE ; SAVE AC 0
MOVEM 1,ACSAVE+1 ; SAVE AC 1
SKIPA 1,.+1 ; LOAD BLT POINTER TO SAVE ACS
<2,,ACSAVE+2> ; BLT POINTER
BLT 1,ACSAVE+17 ; SAVE ALL ACS
RUNENT: MOVE X,.JBSA ; SAVE START ADR
MOVEM X,SADSAV ; . . .
MOVE X,.JBREN ; SAVE REENTER ADR
MOVEM X,RENSAV ; . . .
MOVSI 1,1 ; RELEASE CURRENT SEGMENT
CORE 1, ; . . .
JFCL ; (WHY SHOULD IT FAIL?)
MOVEI 1,GSGBLK ; LOAD ADR OF GETSEG ARG BLOCK
GETSEG 1, ; GETSEG THE DESIRED SEGMENT
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
JRST GTSGF ;[322] GETSEG FAILED
>;; END FOR FTXTEC
FOR FTXTCERR,<
HALT .-1 ;[325] GETSEG FAILED FOR XTEC
>;; END FOR FTXTCERR
FOR FTXTEC!FTXTCERR,<
MOVE X,SADSAV ; RESTORE START ADR
MOVEM X,.JBSA ; . . .
MOVE X,RENSAV ; RESTORE REENTER ADR
MOVEM X,.JBREN ; . . .
MOVSI 17,ACSAVE ; RESTORE ACS
BLT 17,17 ; . . .
POPJ P, ; AND PROCEED
GTSGF: MOVE X,SEGNAM ;[322] ATTEMPT TO GET XTEC BACK
MOVEM X,GSGNAM ;[322] SET NAME TO XTEC
MOVEI 1,GSGBLK ;[322] LOAD ADDR OF GETSEG ARG BLOCK
GETSEG 1, ;[322] GET XTEC BACK
HALT .-1 ;[322] WE'RE LOST
OUTSTR SEGERR ;[364] TYPE ERROR MESSAGE
MOVE X,SADSAV ;[322] RESTORE START ADR
MOVEM X,.JBSA ;[322] . . .
MOVE X,RENSAV ;[322] RESTORE REENTER ADR
MOVEM X,.JBREN ;[322] . . .
MOVSI 17,ACSAVE ;[322] RESTORE ACS
BLT 17,17 ;[322] . . .
POP P,X ;[322] DROP PDP
POP P,X ;[322] . . .
JRST <IFDEF ERRH88,<ERRH88>> ;[325] CONTINUE AS IF NOTHING HAPPENED
SEGERR: ASCIZ/
?XTCERR - CANNOT GETSEG ERROR SEGMENT/
GSGBLK: ; ARBLK FOR GETSEG MUUO
GSGDEV: 0 ; THE DEVICE NAME
GSGNAM: 0 ; THE SEGMENT NAME
GSGLOW: 0 ; FILE EXTENSION FOR LOW FILE
0 ; WE DON'T USE THIS
GSGPPN: 0 ; THE SEGMENT PPN
0 ; WE DON'T USE THIS
; TEMP STORAGE FOR GETSEG ROUTINE
SADSAV: BLOCK 1 ; SAVE AREA FOR .JBSA
RENSAV: BLOCK 1 ; SAVE AREA FOR .JBREN
LOCEND==.-1 ; DEFINE END OF LOWSEGMENT CODE
DEPHASE ; BACK TO HISEG RELOCATABLE CODE
SUBTTL Impure Low Segment Data
RELOC LOCEND-LOCODE ; RELOC TO LOWSEG AFTER CODE
LOWBEG: ; DEFINE BEGINNING OF IMPURE LOWSEG DATA
CCJNAM: BLOCK 1 ; OUR CCL JOB NUMBER (IE: '###XTC')
SEGNAM: BLOCK 1 ; NAME OF CONTROL SEGMENT
SBNAME: BLOCK 1 ; HOLDS A SIXBIT NAME
PDL: BLOCK 1 ; CONTROL PUSHDOWN STACK
TPDL: BLOCK C$TPDL ; TEMP PDL FOR APRTRP ROUTINE
ACSAVE: BLOCK ^D16 ; SAVE AREA FOR ACS
TENIDX: BLOCK 1 ; INDEX INTO 'TENCMD'
TENCMD: BLOCK ^D10 ; INFO IN LAST 10 COMMANDS EXECUTED
HEAD: BLOCK 1 ; POINTER TO FIRST BLOCK OF DYNAMIC STORAGE
GSIZE: BLOCK 1 ; #WORDS ALLOCATED SINCE LAST GARBAGE COLLECTION
PDLTAB: BLOCK 2*C$NPDL ; TABLE OF THE PDLS THAT ARE
; OVERFLOW PROTECTED
TMPREF: BLOCK 1 ; USED AS A TEMPORARY REFERNCE
; TO A BLOCK
TMPRFG: BLOCK 1 ; TEMP REF TO TEXT BUFFER FOR $G ROUTINE
TAGPDL: BLOCK 1 ; POINTER TO TAG DEFINITION PDL
FRDREF: BLOCK 1 ; REFERENCE TO FILE-READ BUFFER
REFPDL: BLOCK 1 ; POINTER TO TAG REFERENCE PDL
LNKLST: BLOCK 2 ; POINTERS FOR LINKED LIST
LNKID: BLOCK 1 ; COUNTER FOR ASSIGNING NEW LINKED-LIST IDS
QTAB: BLOCK 1 ; POINTER TO Q-REGISTER TABLE
QPDL: BLOCK 1 ; POINTER TO Q-REGISTER PDL
QR: BLOCK 1 ; Q-REGISTER TABLE PDP
QP: BLOCK 1 ; Q-REGISTER PDL PDP
CMDBID: BLOCK 1 ; BUFFER ID FOR CURRENT COMMAND BUFFER
PCMBID: BLOCK 1 ; BUFFER ID FOR PREVIOUS COMMAND
CURCMD: BLOCK 1 ; POINTER TO CURRENT COMMAND BUFFER
CMDCNT: BLOCK 1 ; COUNT OF CHARS LEFT IN COMMAND BUFFER
; DURING SCAN
CMDBP: BLOCK 1 ; RELATIVE BYTE POINTER TO COMMAND BUFFER
; DURING SCAN
CMDBUF: BLOCK 1 ; ADR OF REF TO COMMAND BUFFER DURING
; DECODE&COMPILE AND EXECUTION
LASSPC: BLOCK 1 ; ADR OF LAST FILE SPEC REFERENCED
RUNOFS: BLOCK 1 ; RUNOFFSET FOR WHEN WE RUN A PROGRAM
RBSPC: BLOCK .RBSTS+1 ; EXTENDED LOOKUP/RENAME/ENTER ARG BLOCK
FILSPC: BLOCK FS$LTH ; FILE SPEC BLOCK FOR CDC
LERSPC: BLOCK FS$LTH ; LAST "ER" FILE-SPEC
LEWSPC: BLOCK FS$LTH ; LAST "EW" OR "EA" FILE-SPEC
LEBSPC: BLOCK FS$LTH ; LAST "EB" FILE-SPEC
LEISPC: BLOCK FS$LTH ; LAST "EI" OR "EP" FILE-SPEC
LEESPC: BLOCK FS$LTH ; LAST "EE" FILE SPEC
LEDSPC: BLOCK FS$LTH ; LAST "ED" FILE-SPEC
LELSPC: BLOCK FS$LTH ;[330] LAST "EL" FILE-SPEC
LREERR: BLOCK 1 ; LAST LOOKUP/RENAME/ENTER ERROR CODE
INIBH: BLOCK C$BFHD ; BUFFER HEADER FOR INI FILES
INIBF: BLOCK C$NBUF*<C$BUFL+3> ; BUFFERS FOR INI FILES
LOGBH: BLOCK C$BFHD ;[330] LOG FILE BUFFER HEADER
LOGBF: BLOCK C$NBUF*<C$BUFL+3> ;[330] LOG FILE BUFFER
OUTADR: BLOCK 1
INPADR: BLOCK 1 ; WHERE TO GO FOR INPUT CHAR
IOSTS: BLOCK 1 ; I/O STATUS FOR LAST I/O ERROR
OUTBH: BLOCK C$BFHD ; BUFFER HEADER FOR OUTPUT
OUTBF: BLOCK C$NBUF*<C$BUFL+3>; OUTPUT BUFFERS
INPBH: BLOCK C$BFHD ; BUFFER HEADER FOR INPUT
INPBF: BLOCK C$NBUF*<C$BUFL+3> ; INPUT BUFFERS
INPCHN: BLOCK 1 ; CURRENT INPUT CHANNEL (Z CH,0)
INPEOF: BLOCK 1 ; ADR OF WHERE TO GO ON INPUT EOF
INPERR: BLOCK 1 ; ADR OF WHERE TO GO ON INPUT ERROR
INPCHR: BLOCK 1 ; LAST INPUT CHAR IF IT IS TO BE REPEATED
PATHB: BLOCK .PTMAX ;[340] BLOCK FOR PATH. UUO
; FLAGS SET/CLEARED BY "E" COMMANDS
ETVAL: BLOCK 1 ; SUBSTITUTION ON TYPEOUT FLAG
EOVAL: BLOCK 1 ; EDIT OLD FLAG
EUVAL: BLOCK 1 ; CASE FLAGGING ON TYPEOUT FLAG
EHVAL: BLOCK 1 ; ERROR MESSAGE LENGTH FLAG
ESVAL: BLOCK 1 ; AUTOMATIC TYPEOUT AFTER SEARCH FLAG
; SEARCH ARGUMENTS AND MATRIX
SRHARG: BLOCK C$SRHL/5 ; TEXT OF LAST SEARCH ARGUMENT
SRHCTR: BLOCK 1 ; COUNT OF CHARS IN SRHARG
SRHLEN: BLOCK 1 ; THE LENGTH OF THE LAST SEARCH MATCH
SRHSMP: BLOCK 1 ; BIT POINTER TO THE LAST POSITION
; IN THE SEARCH MATRIX
SRHTAB: BLOCK SRHLN ; THE SEARCH MATRIX
; POINTERS AND VALUES FOR THE MAIN TEXT EDITING BUFFER
TXTBUF: BLOCK 1 ; POINTER TO THE MAIN TEXT EDITING BUFFER
PTVAL: BLOCK 1 ; CURRENT BUFFER POSITION POINTER
PAGCNT: BLOCK 1 ; CURRENT PAGE NUMBER
MKRMBP: BLOCK 1 ; BYTE POINTER FOR STORING LAST PARTIAL
; WORD IN THE "MAKE ROOM" ROUTINE
MKRMB1: BLOCK 1 ; SAME AS ^ BUT FOR DOWNWARD MOVE
APDADR: BLOCK 1 ; ADR OF READ-A-CHAR ROUTINE
APDFLG: BLOCK 1 ; CURRENT INPUT I/O FLAGS
PCHADR: BLOCK 1 ; ADR OF WRITE-A-CHAR ROUTINE
PCHFLG: BLOCK 1 ; CURRENT OUTPUT I/O FLAGS
LSNCTR: BLOCK 1 ; HOLDS A LINE-SEQUENCE NUMBER
LSNCT1: BLOCK 1 ; COUNTS DIGITS FOR AN LSN
; VARIABLES FOR MACRO CALLS
MACFLG: BLOCK 1 ;[344] FLAG FOR MACRO W/ ARGUMENTS
MACNAM: BLOCK 1 ; Q-REGISTER NAME OF CURRENT MACRO
MACBID: BLOCK 1 ; BUFFER ID FOR CURRENT MACRO
MACLVL: BLOCK 1 ; NESTING LEVEL COUNTER FOR MACROS
MACBUF: BLOCK 1 ; REFERENCE TO TEMP BUFFER
LOWEND==.-1 ; DEFINE END OF IMPURE LOWSEGMENT DATA
; PATCHING SPACE
PAT: BLOCK C$PATL ; PATCHING SPACE
RELOC ; BACK TO HISEG RELOCATABLE
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC, END XTEC ; *** THE END ***
FOR FTXTCERR, END ; *** THE END ***