Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50474/teco10.mac
There are no other files named teco10.mac in the archive.
; TECO-10 DEC Standard TECO for TOPS-10 and TOPS-20
;
;Feature tests
;
IFNDEF TOPS20,TOPS20==1 ;[16000] TOPS-20 JSYS's
IFNDEF TOPS10,TOPS10==0 ;[16000] TOPS-10 UUOS
IFNDEF FTXTEC,FTXTEC==1
IFNDEF FTXTCERR,FTXTCERR==TOPS20 ;[21000] No need to swap segs on 20
SEARCH JOBDAT,MACTEN,UUOSYM ;[366] DEFINE SYSTEMY THINGS
IFN TOPS20, SEARCH MONSYM ;[21000] 20-Systemy things too
SALL ; SUPPRESS MACRO EXPANSIONS
;Hiseg origin MOVED to allow lowseg to get bigger
TWOSEGMENTS 640000 ; THIS IS A TWO SEGMENT PROGRAM
.HIGH.=: 640000 ;[15000] Hiseg origin
.DIRECTIVE .XTABM ; TENEXY MACRO'S
DEFINE $TITLE(VTECO)<
IFN FTXTEC&FTXTCERR&TOPS20,<
TITLE. TECO20,VTECO,DEC Standard TECO for TOPS-20
>
IFE FTXTEC&FTXTCERR,<
IFN FTXTEC&TOPS10 ,TITLE. TECO10,VTECO,DEC Standard TECO for TOPS-10
IFN FTXTCERR,TITLE. TECERR,VTECO,ERROR SEGMENT FOR TECO10
>>
;MAKE THE RIGHT TITLE
$TITLE 3(25427) ; EDIT LEVEL 1-Oct-79
SUBTTL J KRUPANSKY/M CRISPIN/A Nourse/JWK/MRC/AWN
SUBTTL Introduction to TECO-10
; TECO-10 is a text editor for the DECsystem-10. It conforms, for
; the most part, with the DEC TECO standard, making it largely
; compatable with TECO-11 and TECO-8. It is also largely upward-compatable
; with the "official" DECsystem-10 TECO.
;
; TECO-10 is adapted from XTEC, and has all of the features of XTEC,
; though some have had their names changed to conform to the standard.
;
; New features (not in XTEC) include:
;
; W and :W Display Window support
; EQ and E% dump mode I/O between qregisters and files
; q-registers can have text and numerics simultaneously
; ET and ED compatable with TECO-11 and TECO-8, including
; read-with-no-wait, control-C intercept,
; read-with-no-echo, cancel ^O, detached flag ...
; [ and ] pass values through unchanged
; m,nUq does nUq and returns m as value
; n:A append n lines from input file
; E* do arbitrary TRMOP. to own terminal
; nEJ commands 0EJ job #, 1EJ TTY #, 2EJ PPN
; EK cancel EB or EW
; q-register () is the text buffer, can be shared with other q-regs
;
; The following XTEC commands have been renamed:
;
; ENfilespec$ to E=filespec$
; EN$ to E=/DELETE$
; EDfilespec$ to E&filespec$
; n^U to nE#
; EAfilespec$ to EWfilespec/APPEND$ (both work for now)
;
; The history of XTEC follows...
;
; 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
;
;
; 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
;TECO10 EDIT HISTORY..
;[1000] ??-NOV-76 /AWN - FIX :EB AND :EL BLOWING UP
;[2000] 13-MAY-77 /AWN - MAKE ^C,REE STOP TYPING
;[3000] 13-MAY-77 /AWN - INSTALL RANDOM-ACCESS Q COMMAND
;[4000] 30-JUN-77 /AWN - FIX ERROR MESSAGES
; AND MAKE :,@ NOT WIPE ARGUMENTS
; AND SAVE BOTH MACRO ARGUMENTS
; AND TYPE ERROR MESSAGES INVOLVING SFD'S BETTER
;[5000] 12-JUL-77 /AWN - MAKE COMPIL NOT CLOBBER FLAGS
; AND MAKE ARG FLAGS GET SHUT OFF WHEN ARGS USED
; IN SEVERAL CASES WHEN THEY WEREN'T
; ALSO FIX UP DPY PROCESSING.
;[6000] 4-AUG-77 /AWN - RANDOM ACCESS Q COMMAND BECOMES ^B
;[7000] 24-AUG-77 /AWN - AUTOMATIC MACRO EXECUTION AFTER COMMAND
;[10000] 14-JAN-78 /AWN - ^Q & ^D command (TRMOPs & Q reg compare)
; And typing of ^L, BLISS symbol constituants
; Plus about 4 months of random patches
;[11000] 9-Feb-78 /AWN - Allow window to supress echoing,
; And Trace & ^A typeout to stop on REEnter
;[12000] 20-Jul-78 /AWN - Simultaneous text & numeric q registers
; & allow text buffer to be accessed as q-register
;[13000] 26-Oct-78 /AWN - Fix numerous bugs that show up when
; buffer size does not fit in 18 bits.
; Put in additional display support,
; ^@,^\, new ED,FB,FZ,FH,FL,FC,FP,FF,:W,V,| commands
;[14000] 26-Jan-79 /AWN Make PDP-11 compatable: ^_ not operator
; "R,^ER,2ED,FD changed to FK,allow non-special controls
; OFO error, == unsigned, scope editing
;[15000] 28-Feb-79 /AWN More PDP-11 compatability stuff:
; nA POP if out of range, nY NYA -nP NPA, EX NFO
; CRLF after $$, 16ED for preserve . after SRH
; Search in <> not always return value,
; Fix passing of values to & from macros
; E% for write q-register out in dump mode
; EN changed to E^, EA to EW/APPEND,
; FB to F0, FC to FX, FL to FY
; Move special :W stuff to 17:W & above
; Implement Harvard FB & FC bounded search
; ::S anchored search ::M compile only
; Fixes to line editing, echoing
; In search: ^A to ^EM, ^B to ^EB
; W runs macro '[W]', :W out of range runs '[:W]'
;[16000] 8-Mar-79 /AWN - Fix PDP-11/PDP-8 compatability stuff:
; Turn off echo when prompt happens
; Fix n@I// m,nPW FR doing autotype if ES.ne.0
; flush NTQ on "M" & "FQ" commands
; make <Sfoo$;> not give error on failure
; Make n^T & ^Atext^A typeout immediate
; fix n^_ remove EN rename
; fix range check on nA command, return -1 not POP
; change remaining YNL error to YCA & fix yank protect
; Make :G pretty print, put in ::G to print literally
; give error on bad "E<char> commands
; Put in ^B, put in n:A, different :A
; make n^T not return value, don't ignore nulls in macro
; put in ::ER,::EB,::EI,::EW,::EE to set defaults
;[17000] Make EO value 3. Put in 1ED mode, take out ^T mode
; Fix truncate mode
;[20000] Make EXPAND validate pointers before using them
; Halt if CORE UUO that can't fail, does.
;[21000] Make TECO-10 runnable on TOPS-20 (not fully JSYSized)
; Swap args if in wrong order.
; Fix ILM on delete from completely full buffer.
; FIX BNF on E? command, and make it echo always
; Also execute q(*EXIT) when EX or ^Z done
; And force echo back on in case of error
;[22000] Make q(*EXIT) execute before checking for NFO on EX
; Teach EE command to write .EXE files
; Make EB work in place by default
; Make EB use same device for .TMP file as input file
;[23000] FT command for setting tabs.
; Escape OK as delimiter for long q-names
; Make it work on TOPS-20
;[24000] Make it work right on TOPS-20
;[25000] Fix rub-outs and ^G's in GETCMD and flakey TABS
; Fix I/O to unassigned ch in FILEWR
SUBTTL Assembly Parameters
SHOW. %%JOBDAT ; VERSION OF JOBDAT
SHOW. %%MACTEN ; VERSION OF MACTEN
SHOW. %%UUOSYM ; VERSION OF UUOSYM
NDS. C$PDLL, 200 ; CONTROL PDL LENGTH
NDS. C$OBFL, 100 ;[12000] Size of terminal output buffer
NDS. C$NREF, 4 ; # 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*^D30 ; 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, -1 ; 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, 'TECERR' ; NAME OF THE ERROR SEGMENT
NDS. C$3NAM, 'TEC' ; 3 LETTER ABBREVIATION OF OUR NAME
; USED FOR TEMP FILES,ETC.
NDS. C$SEXT,'EXE' ;[21000] Default save file extension
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, 3 ;[406] DEFAULT "EO" VALUE OF THIS VERSION
NDS. C$MAXD,^D2000 ;[15000] Larger than this isn't temporary
NDS. FTBSRO,1 ;[16000] Accept backspace as rubout
NDS. FTPRIV,1 ;[12000] Assemble priveleged operations
NDS. C$NTS,24 ;[21000] This many TAB stops
IFN TOPS10&TOPS20,<
PRINTX ?XTEC for TOPS-10 and TOPS-20, can't do both at once
PASS2
END
>
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
>
; ECHO - O/S dependent macro to turn echo on or off
DEFINE ECHO (STATE),<
%STATE==0
IFB <STATE>,<%STATE==1>
IFIDN <STATE>,<ON>,<%STATE==1>
FOR TOPS10,<SETSTS TTYC,300-<%STATE*200> >
FOR TOPS20,<IFN %STATE,<PUSHJ P,ECON>
IFE %STATE,<PUSHJ P,ECOFF> >
PURGE %STATE >
;SKPECHO -- O/S-Dependant macro to skip if echo is ON
DEFINE SKPECHO(STATE),<
IFB <STATE>,<...ST==1>
IFNB <STATE>,<IFIDN <STATE>,<ON>,<...ST==1>
IFIDN <STATE>,<OFF>,<...ST==0>>
IFN ...ST,<
FOR TOPS10,<STATZ TTYC,IO.SUP>
FOR TOPS20,<MOVE T1,OURTTY
RFMOD
TXNE T2,TT%ECO>
>
IFE ...ST,<
FOR TOPS10,<STATO TTYC,IO.SUP>
FOR TOPS20,<MOVE T1,OURTTY
RFMOD
TXNN T2,TT%ECO>
>
PURGE ...ST
>
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)
< MOVE X,EOVAL
CAIG X,NUM
JRST ADR
>
;< <LUUCEO>B8+<NUM>B12+<Z ADR>>
; I/O CHANNELS
INP== 1 ; INPUT CHANNEL
OUT== 2 ; OUTPUT CHANNEL
LOG== 3 ;[330] LOG CHANNEL
TTYC== 16 ;[4000] TTY 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$REF==1B0 ; RH contains address
QB$BID==1B1 ; RH contains buffer ID
Q$VAL== 2 ; NUMERIC VALUE OF Q-REGISTER
Q$PTR== Q$BIT ; LINKED-LIST ID FOR TEXT BUFFER
; INDICES INTO A DYNAMIC MEMORY BLOCK (RELATIVE TO FIRST DATA WORD)
B$1PTR==-C$NREF ; FIRST POINTER WORD
B$2PTR==B$1PTR+1 ; SECOND POINTER WORD
B$3PTR==B$2PTR+1 ; THIRD POINTER WORD
B$4PTR==B$3PTR+1 ; FOURTH POINTER WORD [12000]
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$BIT== T$BID ;[12000] bits in left half
TB$CMP==400000,,0 ;[12000] compiled
TB$BUF==200000,,0 ;[12000] this is the current text buffer
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$OPN==BIT ;[15000] This file is open
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$DEL==BIT ;[15000] /DELETE for temp files
FB$$IO==FB$LSN!FB$ASC!FB$SIX!FB$OCT!FB$GEN!FB$SUP!FB$PRV!FB$APP!FB$NOO!FB$NOI!FB$NON!FB$DEL
; 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 (TEMP)
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$2CO==BIT ; END OF LINE CHAR SEEN
F$EOL==F$REF ; Last character read was an EOL
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$UAR==BIT ; Up-arrow really is up-arrow
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 ; UPCASE LETTERS TILL END OF STR OR FURTHER NOTICE
F$CNX==BIT ; EXACT SEARCH MODE
F$EXM==BIT ; EXACT SEARCH MODE CAUSED BY ^V OR ^W
F$EMA==BIT ; EXACT SEARCH MODE CAUSED BY ^\
F$CNN==F$REF ; PREVIOUS CHAR WAS ^N(SEARCH MATRIX GENERATION)
F$BPG==F$REF ; 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$XXX==BIT ;reserved
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$2CO!F$DTM ; ARGUMENT FLAGS (CDC)
F$$TX==F$UAR!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 ET Word (ETVAL) Bit Definitions
ET$EXT==1 ; EXACT TYPEOUT (TRADITIONAL USE OF ET)
ET$DPY==2 ; SCOPE
ET$LC==4 ;[12000] lower case
ET$SUP==10 ;[12000] NO ECHO
ET$CCO==20 ;[12000] cancel ^O
ET$NST==40 ;[12000] Non-blocking TTY input
ET$DET==100 ;[12000] Detach(ed)
ET$ABO==200 ;[12000] Abort on error
;[12000] Teco has not prompted yet
ET$TRN==400 ;[12000] Truncate to TTY width
ET$VTX==1000 ;[12000] VT52/55/61
ET$VT11==2000 ;[12000] VT11 (GT40)
ET$CCT==100000 ;[12000] Trap ^C (reset if ^C typed)
;ED FLAGS...
;[12000]
ED$UAR==1 ;[12000] Uparrow in searches means uparrow
ED$YOK==2 ;[12000] Y & _ always OK
ED$NOV==4 ;[12000] Novice mode
ED$SSF==20 ;[14000] "." stays intact on search fail
ED$BLI==40 ;[12000] Symbol constituants: A-Z,0-9,$,%,_
ED$LLL==100 ;[12000] It's a line if it looks like a line
ED$SKP==200000 ;[12000] ^\ caused a skip
ED$OPT==400000 ;[12000] Optimize compilation
;DMODE bits
DM$ACR==1 ;Terminal does auto CRLF's (Linear addressing)
DM$NL==2 ;Terminal does <CR> also when <LF> typed out
DM$INS==4 ;Terminal is in INSERT mode
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 (RUNP) ; SETUP FILE TO BEW RUN ON EXIT
TV (EI) ; EXECUTE AN INDIRECT COMMAND FILE
TV (EQ) ; 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 (RENM) ; 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 (USI) ;[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) ; Maybe output all and RETURN LOWSEG SIZE IN WORDS
TV (ECS) ; SET THE LOWSEGMENT SIZE
TV (QRX) ;[3000] R/A Q REGISTER CMD
TV (QCM) ;[10000] Q-register compare
TV (TRMO) ;[10000] TRMOP.'s
TV (EXE) ;[12000] Execute instruction
TV (EY) ;[12000] EY always , Y only if buffer empty
TV (STQ) ;[12000] store in q-register
TV (CNQ) ;[12000] # of chars in next n lines
TV (E) ;[12000] Go to end of nth line
TV (CNU) ;[12000] Insert to q-register
TV (EK) ;[12000] Flush output file, cancel EB
TV (V) ;[12000] Type n lines either side of .
TV (W) ;[12000] window manipulation
TV (COLW) ;[12000] manipulate window parameters
TV (ETS) ;[12000] Set ET flags
TV (EJ) ;[12000] Set or retrieve system stuff
TV (FOUT) ;[12000] Force all tty output out
TV (TCHR) ;[12000] Type a character on current TTY
TV (FF1) ;[12000] Adjust FL & FC
TV (FF2) ;[12000] Adjust FL & FC
TV (EBAR) ;[14000] E_ (like _ but always legal)
TV (CKR) ;[14000] Check for alphanumeric
TV (EPCT) ;[14000] E% cmd (write out from q-register)
TV (BSL) ;[14000] nFB, nFC line mode bounded search
TV (CW2) ;[15000] m,n:W
TV (GETC) ;[15000] E?q get cmd into q-register
TV (GCHR) ;[16000] ^T Get a character
TV (AL) ;[16000] Append a few lines of text
LIST
SALL>
;THESE INSTRUCTIONS MUST BE THE FIRST DATA WORDS IN HISEG
$EECON:
FOR TOPS10,<
XTCERR:
>
FOR FTXTEC, PORTAL $EECNT ;[325] CALL EE CONTINUE
FOR FTXTCERR,< NOTFOR FTXTEC,<
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
; CLEAR IMPURE LOW SEGMENT DATA
FOR TOPS10,RESET ;[20000] Make sure .JBFF get set up!
STORE (T2,LOWBEG,LOWEND,0)
; INITIALIZE PURE LOW SEGMENT CODE
FOR TOPS10,<
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)
TLNN .SGPPN,777777 ;[15000] Could this be a path block
JRST [JUMPE .SGPPN, [MOVE X, [.PTMAX,,GSGPAT] ;nothing
SETOM GSGPAT+.PTFCN ;so read default
PATH. X, ; if we can
JRST [GETPPN .SGPPN ;do best we can
JFCL ;The useless JACCT skip
JRST .+1] ;back to main code
JRST PTPPPZ] ;We have the path block...
MOVSI X,-.PTMAX ;- # of words to copy
HRLI .SGPPN,(<MOVE T2,0(X)>) ;Make into MOVE T2,75(X)
PTPPPL:! XCT .SGPPN ; Fetch first word
MOVEM T2,GSGPAT(X) ;and store it
AOBJN X,PTPPPL ; Back for more if any left
PTPPPZ:! MOVEI .SGPPN,GSGPAT ;Put addr of path block in PPN place
JRST .+1] ; Back to main code
MOVEM .SGPPN,GSGPPN ; STORE OUR DIRECTORY
MOVEM .SGDEV,GSGDEV ; STORE OUR DEVICE
MOVEM .SGLOW,GSGLOW ; SAVE OUR LOW FILE EXTENSION
>;END IFN TOPS10
; 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
HALT .+1 ;[20000] Shouldn't occur
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 ; deallocate
MOVE L,[<TMPREF,,C$TBLN>] ; ARG FOR ALLOCATING TEXT BUFFER
PUSHJ P,REQM ; ALLOCATE THE TEXT BUFFER
MOVE X,TMPREF ;[12000] Save address of buffer
MOVEM X,TXTBUF ;[12000]
MOVEI L,TXTBUF ;[12000]
HRRM L,B$4PTR(X) ;[12000] Put addr of ref in safer place
HLLZS B$1PTR(X) ;[12000] & zap the old one
MOVEI L,TMPREF ;[12000] Now add to linked list
PUSHJ P,ADDBLK ;[12000]
MOVEI X,NOOF ;[304] FETCH ADR FOR NO OUTPUT FILE ERROR
MOVEM X,PCHADR ;[304] TO PREVENT ILL. UUOS
; Open the TTY so we can control echoing
PUSHJ P,TTOPEN ;[12000]
; Set up prompts so that they will happen
MOVX X,<ASCIZ "*"> ;[12000] This is a "*" to start with
MOVEM X,PROMPT ;[12000] put it in the prompt buffer
; Set up string to type after accepting command (initially CRLF)
MOVSI X,(BYTE (7) 15,12) ;[14000]
MOVEM X,TARCMD ;[14000] Make Stan Rabinowitz happy
; 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> ; . . .
; SET UP DELIMITERS FOR TEXT AND COMMANDS
MOVEI X,33 ;[12000] ESCAPEs to start with
MOVEM X,DELIM ;[12000] 1 for text
MOVEM X,CDELIM ;[12000] 2 for command delimiter
MOVEM X,CDELIM+1 ;[12000] ...
;[12000] Initialize ET value
MOVX X,ET$ABO ;[12000] Abort flag starts out set
MOVE T1,OURTTY ;[12000] Check LC characteristic of terminal
GETLCH T1 ;[12000] so we can set 4ET
TXNE T1,GL.LCM ;[12000] if it is set
TXO X,ET$LC ;[12000] it was
MOVEM X,ETVAL ;[12000] ET is now initialized
MOVX X,<BYTE (7)40,10> ;[15000] Initialize character wiper-outer
MOVEM X,WIPEC ;[15000] so dpy mode will work, sort of
; INITIALIZE EO VALUE
MOVEI X,C$EOVL ;[3000] SET UP EO VALUE TO CURRENT
MOVEM X,EOVAL ;[3000]
; 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,LRPSPC+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,C$SEXT ; 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
; [12000] Clear the abort flag if it was set
MOVE X,ETVAL ;[21000] Get ET
TXZE X,ET$SUP!ET$ABO ;[14000] Echoing supressed?
ECHO ON ;[21000] turn it back on
MOVEM X,ETVAL ;[21000] Turn off 'supress' and 'abort'
; OUTPUT PROMPT
TXZ F,F$$RG!F$TRC ;[352] CLEAR ARG FLAGS [16000] AND TRACE
SETZM COL ;[23000] This is column 0
SKIPG INPCHR ; ALREADY HAVE FIRST CHAR?
PUSHJ P,TSTAR ; NO, TYPE PROMPT
; CHECK FOR THE "*" COMMAND (IE: SAVE LAST COMMAND IN A Q-REGISTER)
BEGIN0:
PUSHJ P,GETCHL ; 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
PUSHJ P,GETCMD ;[12000] Call routine to get a command
JRST BEGIN ;[12000] luser musta typed ^G^G
MOVEI N,TARCMD ;[14000] Type this After Reading CMD
PUSHJ P,TXSTR ;[14000]
PUSHJ P,FOUT ;[16000] Force it out now
MOVX X,ET$SUP ;[16000] See if echo should be supressed
TDNE X,ETVAL ;[16000] ...
ECHO OFF ;[21000] Turn it off
MOVE N,CMDBID ;[14000] Get N back
;Now prepare to execute the command we got (BID is in N)
MOVE L,['[CCMD]'] ; MAKE A NAME FOR THE CMD BUFFER
TXO F,F$CMP ; FLAG THAT BUFFER MUST BE COMPILED
PUSHJ P,MACRO ; AND COMPILE&EXECUTE THE CMD BUFFER
TXZ F,F$COL!F$2CO ;[15000] Clear left over colons
SKIPN N,QREG+<'!'*2> ;[23000] Try to get text of q!
JRST BEGIN ;[7000] NOT TEXT SO GIVE UP
MOVSI L,'! ' ;[7000] AUTOMATIC MACRO NAME
PUSHJ P,MACRO ;[7000] DO THE MACRO
JRST BEGIN ; GO BACK FOR ANOTHER COMMAND
SUBTTL GETCMD -- Get a command string from current input source
; GETCMD - Get a command string from the current input source
; routine allocates its own storage for commands
;
; CALL: PUSHJ P,GETCMD
; <RETURN 1> ;user erased the command, just prompt
; <RETURN 2> ;execute the command. BID is in N
GETCMD:
; 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 (BNF) ; 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
RDLOOP: PUSHJ P,GETCHL ; FETCH NEXT INPUT CHAR [12000] in line mode
RDLP0:
TXZE F,F$REE ;[20000] Did we ^C.REE?
JRST RDEMP ;[20000] Yes, start over
FOR FTBSRO,<CAIE C,.CHCNH> ;BACKSPACE OK TOO
CAIN C,.CHDEL ; IS CHAR A RUBOUT?
JRST RDRUB ; YES
CAIN C,.CHLFD ;[10000] Is this a linefeed
JRST [SKPECHO ;[24000] check echoing
JRST .+1 ;[14000] Leave screen position alone!
AOS T1,ROW ;[10000] Increment linefeed count
CAMGE T1,LENGTH ;[12000] Did it cause a scroll
JRST .+1 ;[12000] NO, continue
AOSG SCFWD ;[12000] Yes, say so
SETZM ROW ;[12000] For terminals that go back to top
JRST .+1] ;[12000] Remember that we scrolled
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
CAMN C,CDELIM ; IS CHAR A DELIMITER?
JRST RDCDEL ; YES
CAIN C,.CHCNR ; IS CHAR A ^R?
JRST RDCNR ; YES
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:
SKPECHO ;[24000] Skip if echo on
JRST RDRB2 ;[14000] Off, so don't type anything
MOVE X,ETVAL ;[16000] Check ET for DPY
TRNN X,ET$DPY ;[5000]
JRST RDRB1 ;[5000] NOT
MOVE N,C ;[24000] Save our "RUBOUT"
PUSHJ P,RDLDB ;[5000] PICK UP THE CHARACTER
JRST RDEMP1 ;[23000] None left
CAIN N,177 ;[5000] REALLY RUBOUT?
JRST [MOVE N,C ;[25000] Remember rubbed-out char
MOVEI C,10 ;[5000] YES SO DO BACKSPACE
PUSHJ P,TCHR ;[5000]
HRRZS COL ;[14000] Un-confuse cursor count
MOVE C,N ;[24000] Put back rubbed-out character
JRST .+1] ;[5000]
CAIN C,12 ;[5000] LINEFEED IS SPECIAL
JRST [MOVEI N,RLF ;[12000] Get sequence for reverse LF
PUSHJ P,T0XSTR ;[5000] UNDO THE LINEFEED
PUSHJ P,RDDLDB ;[5000] LOOK AT PREVIOUS CHARACTER
JRST RDRTYP ;[5000] NONE, SO DON'T WORRY
CAIE C,15 ;[5000] CARRIAGE RETURN?
JRST RDRTYP ;[5000] NO SO RETYPE LINE
PUSHJ P,TCHR ;[5000] TYPE IT
JRST RDLOOP] ;[5000] BACK FOR MORE
CAIGE C," " ;[5000] CONTROL CHAR?
JRST [PUSHJ P,RDDLDB ;[5000] NOW BACK UP
JFCL ;[5000] IGNORE ERROR
JRST RDRTYP]
MOVEI N,WIPEC ;[5000] SPACE,BACKSPACE
PUSHJ P,T0XSTR ;[5000]
SOS COL ;[14000] Tell screen processor we backed up
PUSHJ P,RDDLDB ;[5000] NOW BACK UP
JFCL ;[5000] NOTHING LEFT?
JRST RDLOOP ;[5000] DONE
RDRB1: ;[5000] LABEL ADDED
PUSHJ P,RDLDB ;[5000] GET THE RUBBED OUT CHARACTER
JRST RDEMP ;[5000] NONE THERE
PUSHJ P,TCCHR ; ECHO THE RUBBED OUT CHAR
RDRB2: PUSHJ P,RDDLDB ;[5000] RUB IT OUT
JRST RDEMP1 ;[5000] NOTHING THERE
JRST RDLOOP ; GO BACK FOR MORE INPUT
; RDCNU - PROCESS ^U (KILL CURRENT LINE OF COMMAND BUFFER)
RDCNU: MOVE X,ETVAL ;[5000] SEE IF DPY
TRNE X,ET$DPY ;[5000]
JRST [PUSHJ P,CLRLIN ;[5000] wipe the whole line out
JRST RDCNU1] ;[5000]
;[5000] XXX INSTEAD OF ^U
; PUSHJ P,TCCHR ; ECHO THE ^U
MOVEI N,[ASCIZ / XXX/] ;[5000]
PUSHJ P,TXSTR ;[5000]
PUSHJ P,TCRLF ; GO TO A NEW LINE
RDCNU1: ;[5000] LABEL ADDED
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:
SKPECHO (OFF) ;[25000] Check echoing
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
CAIN C,"*" ; IS IT A * ??
JRST [MOVE T4,[POINT 7,T$DATA(T5)]
MOVE T1,@CURCMD ;RETYPE ENTIRE COMMAND BUFFER
PUSHJ P,TCRLF ;NEW LINE
PUSHJ P,TSTAR ;[5000] TYPE A STAR TO START
JUMPE T1,RDRTY2 ;[10000] go away if buffer empty
SETZM @CURCMD ;ZERO LENGTH (IT WILL BE RESTORED)
JRST RDRTY1]
; ^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
MOVE X,ETVAL ;[5000] SEE IF DPY
TRNE X,ET$DPY ;[5000]
JRST [PUSHJ P,CLRLIN ;[12000] Clear the whole line
JRST .+2]
PUSHJ P,TCRLF ; GO TO A NEW LINE
PUSHJ P,RDFLF ; FIND THE PREVIOUS LINE FEED
PUSHJ P,TSTAR ;[5000] TYPE A STAR
SUB T1,@CURCMD ; MAKE A LOOP COUNT FOR RETYPING LINE
JUMPE T1,RDRTY2 ; DONE IF NOTHING TO RETYPE
RDRTY1: PUSHJ P,RDILDB ; FETCH NEXT CHAR ON LINE
PUSHJ P,TPCHR ; AND TYPE IT [5000] PRETTILY
SOJG T1,RDRTY1 ; LOOP FOR ALL CHARS ON LINE
RDRTY2: JRST RDLOOP ; DONE. GO BACK FOR SOME MORE INPUT
; TSTAR - TYPE A PROMPT
TSTAR: MOVEI N,PROMPT ;[5000] ROUTINE TO TYPE A STAR
PUSHJ P,T0XSTR ;[5000]
MOVE N,PROMSZ ;[14000] # of char positions used by prompt
SOJA N,UPDPRC ;[14000] Update cursor position & return
; 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
MOVE N,CMDBID ;[30000] Get back Buffer ID
POPJ P, ;[12000] nonskip return (don't execute)
; RDCDEL - SEE IF END OF COMMAND STRING
RDCDEL: SKIPN CDELIM+1 ;[12000] Don't check if only 1 char delimiter
JRST RDFIN ;[12000] it was
PUSHJ P,GETCH ; FETCH NEXT INPUT CHAR
CAME C,CDELIM+1 ;[12000] Other char of delimiter?
JRST RDLP0 ; NO, SEE IF IT HAS ANY SPECIAL MEANING
CAMN C,DELIM ;[12000] Store if also text delim (FS$$)
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:
MOVE X,CURCMD ; FETCH ADR OF REF TO BUFFER
HRRZS T$1REF(X) ; AND UNBIND THE REF
SETZM CURCMD ; AND ZERO "CURCMD"
MOVE N,CMDBID ; AND FETCH BUFFER ID FOR COMMAND BUFFER
JRST CPOPJ1 ;[12000] Win return (go execute)
SUBTTL Command Decoder Dispatch Table
;[13000] Changed so that high segment origin can be raised above 400000
; Note that it still cannot be lowered below 400000
DEFINE DSP(D1,C1,D2,C2)<EXP <C1+D1>,<C2+D2>>
D$JR== 1B1 ; SIMPLE JRST DISPATCH
D$EJ== 0 ; EVALUATE PRECEDING ARG AND THEN JRST
DSPTBL: DSP (D$JR,CDBPT,D$JR,CDCNA) ; ^@ ^A
DSP (D$EJ,CDCNB,D$JR,CDCNC) ; ^B ^C
DSP (D$EJ,CDCND,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,CDCCLR,D$JR,CDCCLR);LF VT [5000] CLEAR FLAGS
DSP (D$JR,CDCNL,D$JR,CDCIGN); FF CR [5000] ON <CR><LF><VT><ESC>
DSP (D$JR,CDCNN,D$JR,CDOCT) ; ^N ^O
DSP (D$EJ,CDCNP,D$EJ,CDCNQ) ; ^P ^Q
DSP (D$JR,CDERR,D$JR,CDCNS) ; ^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$EJ,CDCBS,D$JR,CDERR) ; ^\ ^]
DSP (D$JR,CDCUA,D$EJ,CDCBA) ; ^^ ^_
DSP (D$JR,CDCIGN,D$JR,CDEXC); SPACE ! !Space no longer does +
DSP (D$EJ,CDQUO,D$EJ,CDOR) ; " #
DSP (D$JR,CDCCLR,D$EJ,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$EJ,CDQ) ; P Q
DSP (D$EJ,CDR,D$EJ,CDS) ; R S
DSP (D$EJ,CDT,D$EJ,CDU) ; T U
DSP (D$EJ,CDV,D$EJ,CDW) ; 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) ; ^ _
DSP (D$JR,CDERR,D$JR,CDERR) ; ` {
DSP (D$JR,CDVBAR,D$JR,CDERR) ; | }
DSP (D$JR,CDNOT,D$JR,CDERR) ; ~
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 and [12000] all arg flags
PUSH CP,[TXZ F,F$$RG] ;[12000] Clear all flags at run time
; 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
CDCLF:
CDCCLR: TXZ F,F$COL!F$2CO ;[23000] Clear : and :: flag
PUSH CP,[TXZ F,F$COL!F$2CO] ;[12000] at run time too
CDCRET: TXZE F,F$COL!F$2CO ; 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
CAILE T1,"Z"+40 ; In high non-alpha range?
MOVEI T1,-32(T1) ;[12000] Starts after <140>
; 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
TXNE T2,D$JR ; 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 CDCC1 ; [12000] no, save oper till we get one
PUSH CP,T5 ; NO, GEN CODE FOR THE EVALUATION OF ARG
HRLI T5,(MOVE ARG,) ; [12000] remove pending operation, if any
;[13000] Now JRST to the routine
CDCC1: JRST (T2) ; DISPATCH TO SPECIFIC CMD DECODER
CDCPOO: TXZN F,F$1RG ;[12000] Clear argument flag
PUSH CP,[SETZ ARG,] ;[12000] Clear arg if there wasn't one
JRST CDCIGN ;[12000] But leave value alone
; 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
PUSH CP,[TXZ F,F$COL]; FETCH CODE TO CLEAR ":" FLAG
; 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 CDCIGN ; 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] ;[7000] CHANGED BACK. AND CONTINUE CD
PUSH CP,[JSP PC,$$STOP] ; YES, GEN CALL TO "STOP"
JRST CDCCLR ; AND CONTINUE CD
; CDBPT - ^@ - Gen BPT warning for debugging, etc.
;
; GEN: WARN(BPT)
CDBPT: MOVE X,EDVAL ;[12000] Don't do it if ED$OPT
TXNE X,ED$OPT ;[12000] is set in ED
JRST CDCIGN ;[12000]
PUSH CP,[SKIPL BRKFLG] ;[12000] Gen code to check flag
PUSH CP,[WARN(BPT)] ;[12000] gen LUUO into code
JRST CDCIGN ;[12000] don't touch args, etc.
; 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
MOVEI C,.CHCNA ; SCAN FOR NEXT ^A
;[21000] Check now so not off by 1
TXNE F,F$DTM ;[12000] Unless delimited text mode
PUSHJ P,CMDGCH ;[12000] It was so do it
JFCL ;[21000] He will lose later
PUSHJ P,CURCHA ; FETCH CURRENT CHAR ADDRESS IN BUFFER
MOVSI T2,(T1) ; AND SAVE FOR LATER
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
; CDESTAR - E* - TRMOPs [10000]
CDCND:
CDESTA:
TXNE F,F$2RG ;[10000] See if 2 arguments given
PUSH CP,[TXO F,F$2RG] ;[10000] tell the runtime routine
PUSH CP,[JSP PC,$$TRMO] ;[10000]
JRST CDCVAL ;[10000]
CDCNQ: PUSHJ P,ARGK ;[12000] Default arg to 1
PUSH CP,[JSP PC,$$CNQ] ;[12000] # of characters in next n lines
JRST CDCVAL ;[12000]
; CDFQ - FQ - Compare text buffer with Q-register
CDFQ: PUSH CP,[JSP PC,$$QCM] ; [10000]
PUSHJ P,MAKQNM ; [10000]
JRST CDCVAL ; [10000]
; CDCNB - ^B return the date in system-dependant format
CDCNB:
FOR TOPS10!TOPS20,<PUSH CP,[DATE VALUE,]> ;[16000] Get the date from the sys
JRST CDCVAL ;[16000] That is our value
; CDQRX - nQ - Return nth character from a Q-Register
CDQRX: PUSH CP,[JSP PC,$$QRX] ; [10000]
PUSHJ P,MAKQNM ; [10000]
JRST CDCVAL ; [10000]
; 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
;m,n^\ Execute instruction in n with m in AC VALUE
CDCBS: PUSH CP,[JSP PC,$$EXE] ; Gen call to $$EXE
JRST CDCVAL ; and continue
; CDCNS - ^S - Return -SRHLEN (length of last search)
CDCNS: PUSH CP,[MOVN VALUE,SRHLEN] ;[12000] negative length of search
JRST CDCVAL ;[12000] return value
; CDCNT - ^T - COMMAND TO RETURN VALUE OF INPUT CHAR
CDCNT: TXZE F,F$COL ;[16000] :^T (TTCALL) ?
JRST CDCNT0 ;[16000] Yes go there
TXNE F,F$1RG ;[12000] 1 argument given?
JRST [PUSH CP,[JSP PC,$$TCHR] ;[16000] Type this character
JRST CDCRET] ;[16000] Do NOT return a value
PUSH CP,[JSP PC,$$GCHR] ;[16000] Read a character from the terminal
JRST CDCVAL ;[16000] Return that as value
CDCNT0:!TXZN F,F$2RG ;[410] TWO ARGS?
PUSH CP,[SETZ SARG,] ;[410] NO, INSURE SECOND ARG 0!
PUSH CP,[JSP PC,$$TTC] ;[16000] Gen call to TTCALL routine
JRST CDCVAL ; AND CONTINUE CD
; CDCNU - N^U - USETI TO DESIRED BLOCK ON INPUT FILE
CDCNU: SKIPN EOVAL ;[12000] do USETI if EO=0 only
JRST CDCNU1 ;[12000] EO=0
;DO Q-REGISTER STORE FROM TEXT
TXNE F,F$1RG ;[12000] Argument present?
JRST [PUSH CP,[TXO F,F$1RG] ;[12000] need to know at run time
JRST .+1] ;[12000] Also don't want text
PUSH CP,[JSP PC,$$CNU] ;[12000] Gen call
PUSHJ P,MAKQNM ;[12000] get Q-register name
PUSHJ P,CDCINS ;[12000] and text argument
JRST CDCRET ;[12000] RETURN
CDCNU1: PUSHJ P,ARGK ;[333] MAKE SURE IT HAS AN ARG
PUSH CP,[JSP PC,$$USI] ;[333] GEN CALL TO $$USI
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:
;
; L or < EXECUTE COMMANDS IF N.LT.0
; G or > EXECUTE COMMANDS IF N.GT.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
; R [14000] EXECUTE COMMANDS IF N IS VALUE OF AN ASCII LETTER OR DIGIT
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 (GLNEFUTSCADVWR)
<.CHLAB,,CDQL> ;[14000] Left angle-bracket for less than 0
<.CHRAB,,CDQG> ;[14000] Right ... greater than 0
<"=",,CDQE> ;"= for "E
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
CDQR: PUSH CP,[JSP PC,$$CKR] ;[14000] Gen call to see if alphanumeric
JRST CDQJA ;[14000]
; 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
PUSHJ P,CHKCON ;[12000] See that we're in a conditional
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
;[12000] CDVBAR - | - "ELSE" construct
CDVBAR: MOVE X,(P) ;[12000] Check nexting of things
PUSHJ P,CHKCON ;[12000]
MOVE X,-1(P) ;[12000] Get addr of start of conditional
PUSH CP,[JRST 0(R)] ;[12000] Jump past "ELSE" clause
MOVEI T1,1(CP) ;[12000] "ELSE" Will jump past that jump
SUB T1,@CMDBUF ;[12000] relative to buffer
ADD X,@CMDBUF ;[12000] Make X absolute
HRRM T1,(X) ;[12000] The jump instruction is now complete
SOJ T1, ;[12000] Put pointer to that jump on stack
MOVEM T1,-1(P) ;[12000] will fix up on next "'" or "|"
JRST CDCRET ;[12000] Continue
;[12000] CHKCON -- Check that we're in a conditional
;
CHKCON: CAIG X,P$CON ;[12000] Out of range?
JUMPG X,CDAPO1(X) ;[12000] Dispatch unless negative
;[12000] in which case, fall into CDAPO1
CDAPO1:
ERROR (MSC) ; ** MISSING START OF CONDITIONAL **
ERROR (MRP) ; ** MISSING ) **
ERROR (CON) ; ** CONFUSED USE OF CONDITIONALS **
POPJ P, ;[12000] Return
; 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
MOVEI C,"!" ; SCAN FOR CLOSING "!"
TXZE F,F$DTM ;[12000] Check for delimited text mode
PUSHJ P,CMDGCH ;[12000] @!/foo/ or something like that
JFCL ;[12000] If CMDGCH fails, so will FNDCH
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
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: MOVE C,DELIM ;[12000] Scan till delimiter found
TXZE F,F$DTM ;[12000] Special delimiter?
PUSHJ P,CMDGCH ;[12000] Yes
JFCL ;[12000] Will get an error anyway
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
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 CDCPOO ; AND CONTINUE SCAN
; CDSUB - - - GEN "SUB ARG,VALUE" FOR A SUBTRACTION
CDSUB: HRLI T5,(SUB ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCPOO ; AND CONTINUE CD
; CDMUL - * - GEN "IMUL ARG,VALUE" FOR A MULTIPLICATION
CDMUL: HRLI T5,(IMUL ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCPOO ; AND CONTINUE SCAN
; CDDIV - / - GEN "IDIV ARG,VALUE" FOR A DIVISION
CDDIV: HRLI T5,(IDIV ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCPOO ; AND CONTINUE SCAN
; CDAND - & - GEN "AND ARG,VALUE" FOR LOGICAL "AND" OPERATION
CDAND: HRLI T5,(AND ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCPOO ; AND CONTINUE CD
; CDOR - # - GEN "OR ARG,VALUE" FOR LOGICAL "OR" OPERATION
CDOR: HRLI T5,(OR ARG,) ; SETUP OPCODE FOR LATER EVAL
JRST CDCPOO ; AND CONTINUE CD
; CDXOR - ^_ - GEN "XOR ARG,VALUE" FOR LOGICAL "XOR" OPERATION
CDXOR: HRLI T5,(XOR ARG,) ;[12000] SETUP OPCODE FOR LATER EVAL
JRST CDCPOO ;[12000] AND CONTINUE COMMAND
; CDNOT - ~ - GEN "SETC ARG,VALUE" FOR LOGICAL "NOT" OPERATION
CDNOT: HRLI T5,(SETCM ARG,) ;[12000] SETUP OPCODE FOR LATER EVAL
JRST CDCPOO ;[12000] AND CONTINUE
; CDCBA - ^_ - GEN "SETCAM ARG,VALUE" for logical (postfix operator) not
CDCBA: PUSH CP,[SETCAM ARG,VALUE] ;[14000] Generate it [16000] correctly
JRST CDCVAL ;[14000] return value
; 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
;[14000] Sets flag for :: if : flag is already set
CDCOL: MOVE X,[TXO F,F$COL] ;[14000] Do this unless set already
TXOE F,F$COL ;[14000] [310] FLAG THAT ":" SEEN
HRRI X,(F$COL!F$2CO) ;[14000] ::, so set that instead
PUSH CP,X ;[14000] set at run time
TXOA F,(X) ;[14000] and now, and skip
;[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
SKIPN EOVAL ;[3000] [13000] Throw away only if EO=0
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: MOVE X,[JSP PC,$$NA] ; GET CALL TO $$NA
TXNE F,F$COL ;[16000] :nA appends n lines
HRRI X,$$AL ;[16000] Get Append line routine
PUSH CP,X ;[16000] Gen whatever...
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:
CDSIC: ;Come here to insert any self-inserting character & following text
PUSHJ P,CMDBCH ;[14000] Back up so char inserts itself
JRST CDI0 ;[14000] (tab) is just like i(tab)
; 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
CDI0: 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: MOVE C,DELIM ;[12000] use default delimiter
TXNE F,F$DTM ;[12000] check for @I//
PUSHJ P,CMDGCH ;[12000] get another delimiter
JFCL ;[16000] Will lose later anyway
MOVEI T3,(C) ;[12000] Save whatever delimiter it was
PUSHJ P,CMDGCH ; YES, MAKE SURE FOLLOWING CHAR IS SAME
ERROR (NDI) ; NO. ** NO DELIMITER AFTER I **
CAIE C,(T3) ;[12000] is it the delimiter
ERROR (NDI) ; NO. SAME ERROR
PUSH CP,[JSP PC,$$NI] ; GEN CALL TO $$NI
JRST CDCRET ; 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: TXNN F,F$1RG ;[12000] any argument given?
PUSH CP,[SETZ ARG,] ;[12000] no so make it zero
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: ;[16000] Fix so m,nPW doesn't do W
PUSHJ P,ARGK ; NO, KLUDGE ARG IF NOT PRESENT
PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
SKP ;[303] NONE, MEANS NOT PW
CAIN C,"W" ; IS COMMAND "PW"?
JRST CDP1 ; Yes, gobble character
PUSHJ P,CMDBCH ; NOT "W", BACK UP OVER THE CHAR
SKIPA X,[JSP PC,$$P] ; AND GEN CALL TO $$P FOR "P" OR "NP"
CDP1: MOVE X,[JSP PC,$$PW] ; YES. FETCH CALL TO $$PW
TXNE F,F$2RG ;[16000] m,nP?
HRRI X,$$BP ;[16000] Gen code for bounded punch
PUSH CP,X ;[16000] Gen it, whatever it was
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: TXNE F,F$1RG!F$2RG ;[14000] Given an argument?
ERROR (NYA) ;[14000] Yes. He probably blew it
SKIPE MACLVL ;[12000] IN A MACRO?
JRST CDEY ; YES, TREAT SAME AS "EY"
PUSHJ P,ARGK ;[12000] Default to 1
PUSH CP,[JSP PC,$$Y] ;[12000] Allow yank if buffer empty
JRST CDCRET ;[12000] continue compiling
; 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>
<"Q",,CDFQ> ;[12000] FQ -- QCM Compare Q-reg w/ text
<"N",,CDFN>
<"D",,CDFD>
<"R",,CDFR> ;[12000] FR command (Replace on last search)
<"Y",,CDFY> ;[14000] Vertical cursor position
<"X",,CDFX> ;[14000] Horizontal cursor position
<"C",,CDFC> ;[14000] Bounded search/replace
<"P",,CDFP> ;[12000] FY,FX
<"0",,CDF0> ;[14000] Start of window
<"B",,CDFB> ;[14000] Bounded search
<"Z",,CDFZ> ;[12000] End of window
<"H",,CDFH> ;[12000] F0,FZ
<"F",,CDFF> ;[12000] Adjust cursor
<"K",,CDFK> ;[14000] FK replaces FD
<"T",,CDFT> ;[21000] Tab stops
FLTH==.-FTBL
; CDFB - FBSTR$ - BOUNDED SEARCH
CDFB: PUSHJ P,ARGK ;[15000] Default arg if none
MOVE T2,[JSP PC,$$BS] ;[14000] Fetch call to 2-arg form
TXNN F,F$2RG ;[14000] Have we 2 argments?
HRRI T2,$$BSL ;[14000] NO. must be line argument
JRST CDS1 ;[14000] Join common search code
; CDFC - FCSTR1$STR2$ - BOUNDED SEARCH/REPLACE
CDFC: PUSHJ P,ARGK ;[15000] Default arg if none
MOVE T2,[JSP PC,$$BS] ;[14000] Fetch call for 2-arg form
TXNN F,F$2RG ;[14000] Have we 2 arguments?
HRRI T2,$$BSL ;[14000] No. must be a line argument
JRST CDFS1 ;[14000] Gen it & fall into common FS code
; 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
TXNN F,F$COL ; ALREADY RETURNING A VALUE?
PUSH CP,[TXO F,F$COL] ; 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
PUSH P,T2 ;[21000] Save the delimiter
PUSHJ P,SSTGSM ; GEN THE SEARCH MATRIX FOR SYNTAX CHECK
POP P,T3 ;[21000] Get back delimiter
POP P,T4 ; RESTORE AC T4
PUSH CP,[JSP PC,$$FS] ; GEN THE CALL TO THE SUBSTITUTE ROUTINE
PUSHJ P,CDI1 ; SCAN THE INSERTION [21000] knowing the delim
JRST CDS2 ; GEN CODE FOR SEARCH AUTOTYPE
; CDFR Entry for doing replace after already having done search
;
CDFR: PUSH CP,[JSP PC,$$FS] ; GEN THE CALL TO THE SUBSTITUTE ROUTINE
PUSHJ P,CDCINS ; SCAN THE INSERTION
JRST CDCRET ; Continue compilation...
; CDFD -FDSTR$ - Find & destroy "STR" [14000]
; GEN: JSP PC,$$S
; <CHAR.ADR,,TEXT.LENGTH>
; JSP PC,$$FS
; <0> ;Just like FS with null second argument
CDFD: 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 CDFD1 ; NO, CONTINUE NORMALLY
MOVE X,[TXO F,F$COL] ;[12000] gen code for setting bit if needed
TXNN F,F$COL ; ALREADY RETURNING A VALUE?
PUSH CP,X ; NO, GEN CODE TO SET FLAG
CDFD1:
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] ;[14000] Gen call to replace routine
PUSH CP,[0] ;[14000] replace with nothing
JRST CDS2 ;[14000] Gen code for search autotype
; CDFK - FKSTR$ - 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
CDFK: ;[14000] Used to be FD
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 CDFK1 ;[377] NO, NORMAL FD
TXNN F,F$COL ;[377] ALREADY RETURNING A VALUE?
PUSH CP,[TXO F,F$COL];[377] GEN CODE TO SET FLAG
CDFK1: 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
; VARIOUS WINDOW PARAMETERS [12000]
CDFH: ;Set or retrieve start & end of window
TXCN F,F$2RG ;[12000] 2 arguments given?
JRST [PUSH CP,[MOVE SARG,WINB] ;[12000] Return both values
PUSH CP,[MOVE VALUE,WINZ] ;[12000] ...
JRST CDCVAL] ;[12000] Return values
PUSH CP,[MOVEM SARG,WINB] ;[12000] Set the Window beginning
;[12000] Fall through to set Window end
CDFZ: ;Set or retrieve End of window
SKIPA X,[MOVE VALUE,WINZ] ;[12000]
CDF0: ;Set or retrieve Start of window
MOVE X,[MOVE VALUE,WINB] ;[12000] Fetch the row the cursor is on
JRST CDRSV ;[12000] Do it to it
CDFP: ;Set or retrieve both row & column of cursor position
TXCN F,F$2RG ;[12000] 2 arguments given?
JRST [PUSH CP,[MOVE SARG,ROW] ;[12000] Return both values
PUSH CP,[MOVE VALUE,COL] ;[12000] ...
JRST CDCVAL] ;[12000] Return values
PUSH CP,[MOVEM SARG,ROW] ;[12000] Set the row
;[12000] Fall through to set column
CDFX: ;Set or retrieve column cursor is in
SKIPA X,[MOVE VALUE,COL] ;[12000] Fetch the column the cursor is on
CDFY: ;Set or retrieve row cursor is in
MOVE X,[MOVE VALUE,ROW] ;[12000] Fetch the row the cursor is on
CDRSV: ;[12000] Entry to generate
; MOVE VALUE,FOO if no arg, or
; MOVEM ARG,FOO if there is an arg
TXNN F,F$1RG ;[12000] Does it have an argument?
JRST CDCFVA ;[12000] Gen it & return value
CDCFNV: HRLI X,(MOVEM ARG,) ;[12000] Change the value
CDCFV2: PUSH CP,X ;[12000] Gen the instruction
JRST CDCRET ;[12000] Return no value
CDCFVA: PUSH CP,X ;[12000] Gen the instruction
JRST CDCVAL ;[12000] Return value
; CDFF - FF - Adjust cursor position
CDFF: MOVE X,[JSP PC,$FF2] ;[12000] Fetch call to 2-arg form
TXZN F,F$2RG ;[12000] 2 args different
HRRI X,$FF1 ;[12000] from 1 arg
PUSH CP,X ;[12000] Put into code
JRST CDCVAL ;[12000] Continue & return value
; CDFT - Get or Set TAB stops ;[21000]
CDFT: MOVE X,EDVAL ;[23000] If optimizing, ...
TXNE X,ED$OPT ;[23000] no range check
JRST CDFT0 ;[23000] ...
PUSH CP,[SKIPL ARG] ;[23000] Negative n.g.
PUSH CP,[CAIL ARG,C$NTS] ;[25000] or too big
PUSH CP,[ERROR (AOR)];[23000] ** ARG OUT OF RANGE **
CDFT0: TXZN F,F$2RG ;[21000] 2 ARGS?
JRST [PUSH CP,[MOVE VALUE,TSTOPS(ARG)] ;[21000] Gen code
JRST CDCVAL] ;[21000] Return value
PUSH CP,[MOVEM SARG,TSTOPS(ARG)] ;[21000] Gen code to set
JRST CDCRET ;[21000] Return no value
; 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
TXNN F,F$COL ; ALREADY A ":" SEARCH ?
PUSH CP,[TXO F,F$COL]; 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 CDCRET ; YES, DON'T AUTOTYPE AFTER SEARCH
PUSHJ P,CHKITR ; IN AN ITERATION? [16000] removed2 inst
JRST [PUSH CP,[JSP PC,$$0TT] ; GEN CALL TO SEARCH AUTOTYPE ROUTINE
JRST CDCRET] ;[16000] And don't fake a ; in any case
PUSHJ P,CMDGCH ;[16000] See if ; follows
JRST .+3 ;[16000] Don't check the character, then
CAIE C,";" ;[16000] Is this a ; ?
PUSHJ P,CMDBCH ;[16000] Back up over it
PUSH CP,[JSP PC,$$SEMF] ;[16000] Exit if I fail
PUSH CP,[TXZ F,F$COL!F$2CO] ;[16000] Clear colons at runtime
JRST CDCRET ;[16000] Return no value
; 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
; CDV - V or nV - (1-n)TnT - TYPE TEXT FROM BUFFER IN WHOLE LINES
CDV: PUSHJ P,ARGK ;[12000] In case of no args do 0TT
PUSH CP,[JSP PC,$$V] ;[12000] Gen call to $$V
JRST CDCRET ;[12000] no value
; CDW - W or nW or n:W or m,n:W - Manipulate screen parameters or window
CDW: TXZE F,F$COL ;[12000] W or :W?
JRST CDCOLW ;[12000] :W
TXNN F,F$1RG ;[15000] Set argument defaults
PUSH CP,[MOVE ARG,DEFARG] ;[15000] no args at all
TXNN F,F$2RG ;[15000] No second argument anyway
PUSH CP,[MOVE SARG,DEFARG] ;[15000] ...
PUSH CP,[JSP PC,$$W] ;[15000] Gen macro call to ([W])
JRST CDCRET ;[12000] no value
CDCOLW:
MOVE X,[JSP PC,$$COLW] ;[15000] Gen macro call to ([:W])
TXZE F,F$2RG ;[15000] 1 or 2 arg form
HRRI X,$$CW2 ;[15000] 2 arg.
PUSH CP,X ;[15000] Gen it
JRST CDCVAL ;[15000] and/or set/read parameter
REPEAT 0,<
TXZE F,F$2RG ;[12000] 2 args?
JRST [PUSH CP,[JSP PC,$$COLW] ;[12000] Gen call to setter
JRST CDCCLR] ;[12000] return no value
MOVE X,EDVAL ;[12000] see if 'optimized'
TXNE X,ED$OPT ;[12000] if so, no range check!!
JRST CDCW1 ;[12000] skip check (hope his macro's debugged!)
PUSH CP,[CAIG ARG,CWMAX] ;[12000] range check
PUSH CP,[SKIPGE ARG] ;[12000] negative n.g too
PUSH CP,[ TDZA VALUE,VALUE] ;[12000] n.g. return 0
CDCW1:! PUSH CP,[MOVE VALUE,CWVEC(ARG)] ;[12000] Get parameter
JRST CDCVL1 ;[12000] Continue (return value)
>
; CDU - NUQ - STORE NUMERIC ARG IN Q-REGISTER
CDU: TXNN F,F$1RG ; AN ARG PRESENT?
ERROR (NAU) ; NO. ** NO ARG BEFORE U **
PUSHJ P,GENQRG ;[22000] Parse the q-register name
JRST [PUSH CP,[JSP PC,$$U] ; GEN CODE TO CALL ROUTINE
PUSH CP,N ;[22000] WHICH STORES Q-REGISTER CONTENTS
JRST CDU1] ; GEN THE Q-REGISTER NAME INTO CODE
ADD N,[MOVEM ARG,QREG+1] ;[22000] Generate instruction
CDU0: PUSH CP,N ;[22000] into code
TXZN F,F$COL ;[23000] :U fudges text also
JRST CDU1 ;[23000] NOT THIS TIME
PUSH CP,[TXZ F,F$COL];[23000] Clear : at run time
SOJA N,CDU0 ;[23000] do the text, too
CDU1: TXZN F,F$2RG ;[14000] Did we get 2 arguments
JRST CDCRET ; AND CONTINUE CD
PUSH CP,[MOVE VALUE,SARG] ;[14000] Second one is our value
JRST CDCVAL ;[14000] So return a value
; CDQ - QQ - RETURN VALUE OF A NUMERIC Q-REGISTER
CDQ:
TXZE F,F$1RG!F$COL ;[12000] Check IF ANY ARGS or ":Q"
JRST [MOVE X,EOVAL ;[12000] See if random access enabled
CAIGE X,3 ;[12000] (i.e. if EO GEQ 3)
JRST .+1 ;[12000] it wasn't
PUSH CP,[JSP PC,$$QRX] ;[12000] get nth char of text
JRST CDQ0] ; [12000] rejoin
MOVE X,EDVAL ;[22000] Do winning thing if optimizing
TXNE X,ED$OPT ;[22000] ...
JRST [PUSHJ P,GENQRG ;[22000] We are, so try to win
JRST [PUSH CP,[JSP PC,$$Q] ;[22000] But we can't win
CDQFZ: PUSH CP,N ;[22000] 'cause it's a long name
JRST CDCVAL] ;[22000] so do the same old thing
ADD N,[MOVE VALUE,QREG+1] ;[22000] Build instruction
JRST CDQFZ] ;[22000] And generate the code
PUSH CP,[JSP PC,$$Q] ; GEN CALL TO RETURN CONTENTS OF Q-REGISTER
CDQ0: 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 CDCCLR ; AND CONTINUE CD
; CDCPCT - %Q - INCREMENT Q AND RETURN RESULTING VALUE
CDPCT: PUSHJ P,GENQRG ;[22000] Parse q-register name
JRST [TXNE F,F$1RG ;[12000] Argument present?
PUSH CP,[TXO F,F$1RG] ;[12000] yes
PUSH CP,[JSP PC,$$INC] ; GEN CALL TO $$INC
PUSH CP,N ; GEN Q-REGISTER NAME INTO CODE
JRST CDCVAL] ;[22000] Return value
ADD N,[ADDB ARG,QREG+1] ;[22000] Make instruction
TXNN F,F$1RG ;[23000] Any arguments?
JRST [HRLI N,(AOS VALUE,) ;[23000] Just increment it then
PUSH CP,N ;[23000] gen into code
JRST CDCVAL] ;[23000] Return value
PUSH CP,N ;[22000] and generate code
PUSH CP,[MOVE VALUE,ARG] ;[22000] Make it return the value
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" FILENTROL AND FLAG COMMANDS
CDE: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
JRST CDEND ;[12000] Go to end of line
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 **
;[12000] E(space) go to end of that line
CDEND: PUSHJ P,ARGK ;[12000] Default is 1
PUSH CP,[JSP PC,$$E] ;[12000] Do it
JRST CDCRET ;[12000] Back for more (no value)
; DISPATCH TABLE FOR "E" COMMANDS
DEFINE EC(CMDS)<IRPC CMDS,<<"CMDS",,CDE'CMDS>>>
ECTBL:
EC (ABCDEFGHIJKLMNOPQRSTUWXYZ)
<"%",,CDEPCT> ;[14000] E% write out q-register
<"@",,CDEATS> ;[12000] E@ set delimiter
<"#",,CDCNU1> ;[12000] USETI (not standard)
<"&",,CDEAND> ;[14000] E& run program when we exit
<"!",,CDSCD> ;[12000] E! set command delimiter
<"_",,CDEBAR> ;[14000] Unprotectable "_" cmd.
<"*",,CDESTA> ;[14000] TRMOP.
<"=",,CDEEQU> ;[14000] Rename input file
<"?",,CDEQUE> ;[15000] E?q get cmd into q-register
<" ",,CDEND> ;[16000] E<CR> E<LF> E<SPACE> E$ E<ALT>
<15,,CDEND> ;[16000] get the E command
<12,,CDEND> ;[16000]
<.CHESC,,CDEND> ;[16000]
<"$",,CDEND> ;[16000]
<42,,CDEQUE> ;[16000] E"q get cmd into q-register
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,$$EY] ; 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
; CDEK - EK - FLUSH OUTPUT FILE and Cancel "EB" if any
;
; GEN: JSP PC,$$EK
; (RETURN)
CDEK: PUSH CP,[JSP PC,$$EK] ; GEN CALL TO $$EK
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: SKIPN EOVAL ;[12000] 0EO does run with ED
JRST CDEAND ;[12000] same as E&
MOVE X,[MOVE VALUE,EDVAL] ;[12000] Prepare to fetch value
CDCRSB: ;[12000] Enter here to set or get bits
TXNN F,F$2RG ;[12000] 2 arguments?
JRST CDRSV ;[12000] no, just like all the others
HRLI X,(ANDCAM SARG,) ;[12000] Clear these bits first
PUSH CP,X ;[12000] gen into code
HRLI X,(IORM ARG,) ;[12000] now set these bits
JRST CDCFV2 ;[12000] Gen into code & return no value
CDEAND: PUSH CP,[JSP PC,$$RUNP] ; GEN CALL TO $$RUNP
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
CDEBAR: ;[14000] E_ same as _ but always legal
PUSHJ P,ARGK ;[14000] Generate an argument if none
MOVE T2,[JSP PC,$$EBAR] ;[14000] Call to routine
JRST CDS0 ;[14000] Join search code
; CDEP - EPFILE-SPEC$ - READ A FILE INTO Q-REGISTER "*"
CDEP:
PUSH CP,[JSP PC,$$EQ] ; GEN CALL TO $$EQ
PUSH CP,['* '] ;[12000] Q-register name for EP command
JRST CDEXX ; SCAN FILE-SPEC AND CONTINUE CD
; CDEQ - EQ(Q-REG)FILE-SPEC$ - READ A FILE INTO Q-REGISTER
CDEQ: PUSH CP,[JSP PC,$$EQ] ; GEN CALL TO $$EQ
PUSHJ P,MAKQNM ;[12000] Get q-register name
JRST CDEXX ; SCAN FILE-SPEC AND CONTINUE CD
; CDEPCT - E%(Q-REG)FILE-SPEC$ - WRITE A FILE FROM Q-REGISTER
CDEPCT: PUSH CP,[JSP PC,$$EPCT] ; GEN CALL TO $$EPCT
PUSHJ P,MAKQNM ;[12000] Get q-register name
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
; CDECAR - E^FILE-SPEC$ - RENAME CURRENT INPUT FILE
CDEN: ERROR (UEN) ;[16000] Unimplemented command
CDEEQU:
PUSH CP,[JSP PC,$$RENM] ; GEN CALL TO $$ECAR
JRST CDEXX ; SCAN FILE-SPEC AND CONTINUE CD
CDEQUE:
PUSH CP,[JSP PC,$$GETC] ;[15000] Gen call
PUSHJ P,MAKQNM ;[15000] And q-register name
JRST CDCVAL ;[15000] Will return -1 unless cmd erased
; CDET - ET OR NET - RETURN OR SET SUBSTITUTION TYPEOUT FLAG
CDET: TXZE F,F$1RG ; IS AN ARG PRESENT?
JRST CDET1 ; YES
PUSH CP,[MOVE VALUE,ETVAL] ; NO, GEN CODE TO RETURN ET FLAGS
JRST CDCVAL ; AND CONTINUE SCAN
CDET1: TXZE F,F$2RG ;[12000] 2 arg form?
PUSH CP,[TXO F,F$2RG] ;[12000] Gen into code
PUSH CP,[JSP PC,$$ETS] ;[12000] Gen call to run-time routine
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
; CDEATS -- Set or return current delimiter
CDEATS:
TXNN F,F$1RG ;[12000] Arg?
JRST [PUSH CP,[MOVE VALUE,DELIM] ;[12000] No
JRST CDCVAL] ;[12000]
PUSH CP,[MOVEM ARG,DELIM] ;[12000] Set delimiter at run time also
TXNN F,F$2RG ;[12000] 2 character delimiter?
PUSH CP,[HRLM SARG,DELIM] ;[12000] yes
JRST CDCRET ;[12000] continue (novalue)
; CDSCD -- Set or return current command delimiter
CDSCD:
TXNN F,F$1RG ;[12000] Arg?
JRST [PUSH CP,[MOVE VALUE,CDELIM] ;[12000] No
JRST CDCVAL] ;[12000]
PUSH CP,[MOVEM ARG,CDELIM] ;[12000] Set delimiter at run time also
TXNE F,F$2RG ;[12000] 2 character delimiter?
PUSH CP,[MOVEM SARG,CDELIM+1] ;[12000] yes
JRST CDCRET ;[12000] continue (novalue)
; 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
; CDEJ - EJ - GET JOB #, TTY #, OR PPN
CDEJ: PUSHJ P,ARGK ;[12000] Fake arg if none
IFN FTPRIV,<
TXNE F,F$2RG ;[12000] Remember 2 args at run time
PUSH CP,[TXO F,F$2RG] ;[12000] if these features are enabled
>
PUSH CP,[JSP PC,$$EJ] ;[12000] Job #,TTY #,PPN
JRST CDCVAL ;[12000] Return value
; 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 CDCIGN ; AND CONTINUE CD
; CDRSB - ]I - POP THE Q-REGISTER PDL INTO A Q-REGISTER
CDRSB: TXNE F,F$COL ;[24000] :]q returns value always
TXO F,F$1RG ;[24000] so remember we did so
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: MOVE X,EDVAL ;[11000] Will we ever want to trace this???
TXNE X,ED$OPT ;[11000]
POPJ P, ;[11000] Hope not
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: MOVE X,EDVAL ;[11000] Non-trace mode??
TXNE X,ED$OPT ;[11000] Bit on means no trace
POPJ P, ;[11000]
ADD T4,@CMDBUF ; MAKE IT ABSOLUTE POINTER TO DUMMY BP
HLRZ X,T4 ; FETCH THE OLD CHAR COUNT
SUB X,CMDCNT ; SUBTRACT 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 **
;[15000] Breaks ^U command!
; TXZE F,F$DTM ;[14000] @-FORM?
; JRST MAKQN4 ;[14000] Yes @M'FOO'
CAIN C,"(" ; EXTENDED Q-REGISTER NAME?
AOJA C,MAKQN4 ; YES, PICK UP 6-CHAR NAME
CAIN C,33 ;[22000] Escape?
JRST MAKQN4 ;[22000] Yes, use ITS Teco form
CAIL C," " ;[10000] Too small?
CAILE C,172 ;[10000] Too big?
ERROR (IQN) ;[10000] YES
CAILE C,140 ;[10000] Lower case?
MOVEI C,-40(C) ;[10000] Yes, shift it
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
MAKQN4: PUSH P,[MAKQN2] ;[23000] Save the return address for POPJ
; CSIXT - Get a Q-register name into N. The delimiter is in C.
CSIXT: MOVE T3,C ;[23000] Save away terminator
MOVE T1,[POINT 6,N] ;[14000] Set up byte pointer to N
SETZ N, ;[14000] Start off fresh
CSIXTL: PUSHJ P,CMDGCH ;[14000] Next character
ERROR (UQN) ;[14000] lose
CAIN C,(T3) ;[14000] Is this our delimiter?
POPJ P, ;[14000] Yes, we're done
CAIGE C,40 ;[14000] Not a control, we hope
ERROR (UQN) ;[14000] byte the bag
CAIL C,140 ;[14000] Lower case range?
MOVEI C,-40(C) ;[14000] not any more
MOVEI C,-40(C) ;[14000] Convert to sixbit
TLNE T1,770000 ;[14000] Any room here?
IDPB C,T1 ;[14000] Store it
JRST CSIXTL ;[14000] Back for more
; GENQRG -SCAN Q-REGISTER NAME AND GENERATE INTO CODE
;
; CALL: PUSHJ P,GENQRG
; (RETURN 1) With terminator in C, Q-register-name in N
; (RETURN 2) With q-register name (ASCII) in C, Q-index in N
;
; USES ACS C,N
GENQRG: PUSHJ P,CMDGCH ; FETCH NEXT COMMAND CHAR
ERROR (MIQ) ; NONE LEFT. ** MISSING Q-REGISTER NAME **
CAIN C,"(" ; EXTENDED Q-REGISTER NAME?
AOJA C,.+2 ; YES, PICK UP 6-CHAR NAME
CAIN C,33 ;[22000] Escape?
PJRST CSIXT ;[22000] Yes, use ITS Teco form
CAIL C," " ;[10000] Too small?
CAILE C,172 ;[10000] Too big?
ERROR (IQN) ;[10000] YES
CAILE C,140 ;[10000] Lower case?
MOVEI C,-40(C) ;[10000] Yes, shift it
GENQR1: MOVEI N,'A'-"A"(C) ; YES, CONVERT TO SIXBIT
ASH N,1 ;[23000] 2 words per entry, pleeze
JRST CPOPJ1 ; RETURN TO CALLER
; 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
COMMENT \ [14000] Allow control characters
; 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
TXNE F,F$DTM ;[4000] DON'T WORRY IF @ TYPED BEFORE
POPJ P, ;[4000] JUST RETURN QUIETLY
CHKEO 2,CPOPJ ;[4000] ALLOW FOR 1EO ONLY
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: MOVE T3,DELIM ; 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
;[16000]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
CDI2A:
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
;[14000] Don't bitch about control characters
; 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: TLNE T3,777 ;[12000] 2-CHARACTER delimiter??
JRST [PUSHJ P,CMDGCH ;[12000] Look at next character
HLRZ T1,T3 ;[12000] and next char of delimiter
CAIN T1,C ;[12000] Are they the same?
JRST .+1 ;[12000] yes
PUSHJ P,CMDBCH ;[12000] no, back up!!
MOVEI C,(T3) ;[12000] first char matched, delimiter
JRST CDI2A] ;[12000] go back to scanning
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>
<"Q"-100,,CDICR> ;[16000] Win with ^Q also
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
TXNN F,F$DTM ;[14000] @-type command
SKIPA C,DELIM ;[14000] No. use default delimiter
PUSHJ P,CMDGCH ;[14000] Yes, get delimiter
JFCL ;[24000] ...
PUSH P,T4 ; SAVE AC T4
PUSH P,C ;[14000] Save whatever delimiter it was
PUSHJ P,GFSPED ; AND SCAN THE FILE SPEC
POP P,X ;[14000] Get back delimiter
POP P,T4 ; RESTORE AC T4
CAME C,X ;[14000] See if that was it
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
IDIVI T1,5 ; COMPUTE RELATIVE START ADR OF CODE
MOVEI T1,T$DATA(T1) ; ADD OVERHEAD WORDS FOR TEXT BUFFER
; 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
MOVE SARG,SARGSV ;[3000] RESTORE 2ND ARGUMENT IF ANY
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
SETZM @CMDBUF ;[14000] Clear pointer to 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
PUSHJ P,QGET ;[12000] Save text in q-register
JRST [TXZN F,F$COL ;[23000] No q register
TDZA T2,T2 ;[23000] No text
MOVE T2,ARG ;[23000] Fabricate it
MOVE T3,ARG ;[23000] Numeric value always
PUSHJ P,QSTOR ;[23000] Store it
JRST (PC)] ;[23000] return
TXZE F,F$COL ;[23000] :U affects text also
MOVEM ARG,Q$PTR(T5) ;[23000] so put it there too
MOVEM ARG,Q$VAL(T5) ; 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
$Q0: ;[3000] LABEL ADDED
SKIPE VALUE,T3 ; PUT NUMERIC VALUE IN AC VALUE
JRST (PC) ; AND RETURN TO CALLER
$Q1: MOVE X,4(PC) ;[374] FETCH NEXT INSTRUCTION
SKIPE N,T2 ;[23000] Get text if any
CAME X,[JSP PC,$$DEC] ;[370] QI= CONSTRUCTION?
JRST (PC) ;[23000] USE NUMERIC VALUE ANYWAY!
ADDI PC,5 ;[374] BUMP PC SO NOT TO CALL $DEC
MOVEI L,TMPRFG ;[370] TMPRFG WILL REFERENCE THE TEXT BUFFER
PUSHJ P,FNDBLK ;[370] FIND THE BLOCK WITH THE ID
ERROR (BNF) ;[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
$QRX: ;[3000] RANDOM ACCESS Q REGISTER HACK
PUSHJ P,NXTWRD ;[3000] Q REGISTER NAME IS NEXT
MOVE T1,N ;[3000] SIXBIT NAME IN N
PUSHJ P,QGET ;[3000] GET IT
JRST FAIRET ;[3000] TREAT LIKE REGULAR FOR COMPATABLILTY
TXNN T2,QB$BID ;[3000] IS IT A TEXT Q REGISTER?
JRST $Q0 ;[12000] No do like numeric
MOVEI N,(T2) ;[3000] GET BID
PUSH P,SARG ;[3000] ALAS L AND SARG ARE 1 AND THE SAME
MOVEI L,TMPRFG ;[3000] TMPRFG WILL REFERENCE IT
PUSHJ P,FNDBLK ;[3000] GET THE TEXT BUFFER ITSELF
ERROR (XXX) ;[3000] ?
POP P,SARG ;[3000] RESTORE 2ND ARGUMENT IF ANY
TXZE F,F$COL ;[12000] :Q? (return # of characters)
JRST [MOVE VALUE,@TMPRFG ;[12000] Get character count
JRST $G2] ;[12000] Un-reference & continue execution
JUMPL ARG,$QRX2 ;[10000] Negative #'s are special case
CAML ARG,@TMPRFG ;[3000] MAKE SURE IT IS IN RANGE
CERROR (ARG) ;[3000] IT WASN'T
MOVE T1,ARG ;[3000] MAKE A BYTE POINTER
IDIVI T1,5 ;[3000] 5 CHARS/WORD
ADD T1,[POINT 7,T$DATA] ;[3000]
ADD T1,TMPRFG ;[3000]
IBP T1 ;[3000] FIND THE PLACE IN THE WORD
SOJGE T2,.-1 ;[3000]
LDB VALUE,T1 ;[3000] GET IT AS OUR VALUE
TXZE F,F$2RG ;[5000] CHECK & CLEAR THE ARG FLAG
;[3000] AND CLOBBER IT IF 2 ARGS GIVEN
DPB SARG,T1 ;[3000]
JRST $G2 ;[3000] DONE unreference & return
$QRX2: MOVMS ARG ;[10000]
CAIL ARG,QXNLEN ;[10000] CHECK RANGE
CERROR(ARG) ;[10000] LOSE
XCT QXNTBL(ARG) ;[10000] DO SOMETHING
QXNTBL: JRST $G2 ;[10000] Return
MOVE VALUE,@TMPRFG ;[10000] Get length of Q-REG text
PUSHJ P,[MOVE VALUE,TMPRFG ;[10000]
ADDI VALUE,3 ;[10000]
POPJ P,] ;[10000]
QXNLEN==.-QXNTBL ;[10000]
; $INC - ADD ARG TO A Q-REGISTER AND RETURN RESULTING VALUE
;
; CALL: JSP PC,$$INC
; (RETURN) ; WITH VALUE IN AC 'VALUE'
$INC: TXNE F,F$1RG ;[12000] Were we passed a value
SKIPA VALUE,ARG ;[12000] Yes, use it
MOVEI VALUE,1 ;[12000] No. default to 1
PUSHJ P,NXTWRD ; FETCH THE Q-REGISTER NAME
MOVE T1,N ; AND COPY INTO AC T1
PUSHJ P,QFIND ; FIND THE Q-REGISTER
JRST $INC0 ;[12000] No Q-register there yet
ADDB VALUE,Q$VAL(T5) ; YES, INCREMENT IT
JRST (PC) ;[12000] and return the value
$INC0: SETZ T2, ;[12000] Set no flags
MOVE T3,VALUE ;[12000] and value for q-register
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
SETZB T2,T3 ;[23000] Use null q-reg
MOVEI N,(T2) ; FETCH POSSIBLE TEXT BUFFER ID
TXNE T2,QB$BID ; 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
JUMPN N,.+2 ;[24000] Only empty if both of these are
JUMPE T2,[CERROR (PES)] ; ** POPPED EMPTY STACK **
MOVEM X,QP ; AND STORE THE UPDATED QPDL PDP
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
TXZE F,F$COL ;[25000] :]q should return -1 or 0
SETO VALUE, ;[25000] and we won if we got here
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 unless ":" used
TXZN F,F$COL ;[12000] Skip CRLF if :=
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: MOVE T1,ETVAL ;[10000] Clear screen & window if display
TXNE T1,ET$DPY ;[10000]
JRST [PUSHJ P,FOUT ;[12000] Force out pending text
OUTSTR HOME ;[12000] Go to top of screen
OUTSTR WIPES ;[12000] and clear it all
MOVSI T1,200000 ;[10000]
IORM T1, SCFWD ;[10000] Indicate window messed up
SETZM ROW ;[12000] Clear row...
SETZM COL ;[12000] ... and column
JRST (PC)] ;[10000]
MOVEI C,.CHFFD ; FETCH A FORMFEED CHAR
PUSHJ P,TCHR ; TYPE IT
JRST (PC) ; AND RETURN TO CALLER
$QCM: MOVE VALUE,ARG ;[10000] Value will be index in qreg
PUSHJ P,NXTWRD ;[10000] Q register name
MOVE T1,N ;[10000]
PUSHJ P,QGET ;[10000] Get the q-register
JRST FAIRET ;[16000] no such q-register
TXNN T2,QB$BID ;[10000] Must contain text
JRST FAIRET ;[16000] no such q-register
MOVEI N,(T2) ;[12000] Buffer ID
MOVEI L,TMPRFG ;[10000] This will reference it
PUSHJ P,FNDBLK ;[10000] Find the text buffer
ERROR (BNF) ;[10000] Ouch
MOVE T1,TMPRFG ;[10000] Addr of buffer
MOVEI T1,3(T1) ;[10000] Skip overhead words
MOVE T3,ARG ;[10000] Adjust the byte pointer
IDIVI T3,5 ;[10000]
ADDI T1,(T3) ;[10000] Add enough words
HLL T1,CBPTBL-1(T4) ;[10000]
MOVE T3,PTVAL ;[10000] Get "."
MOVE T2,@TXTBUF ;[10000] Get length of text buffer
SUB T2,T3 ;[10000] Subtract "." to get chars left
JUMPLE T2,$G2 ;[12000] At end of buffer already
JUMPL ARG,$G2 ;[10000] or too small
MOVE T4,@TMPRFG ;[10000] Get length of q-register
SUB T4,ARG ;[10000] subtract starting place therein
CAML T2,T4 ;[10000] use the lower limit
MOVE T2,T4 ;[10000]
IDIVI T3,5 ;[10000] Turn into a word
MOVEI T3,T$DATA(T3) ;[14000] Skip overhead words here so don't lose
HLL T3,CBPTBL-1(T4) ;[10000] and a byte pointer
ADD T3,TXTBUF ;[10000] to the current character
QCMLP: SOJL T2,$G2 ;[12000] See if we got to the end
ILDB C,T1 ;[10000] Get char from text buffer
ILDB T4,T3 ;[10000] and from q-register
CAIE C,(T4) ;[10000] are they the same?
JRST $G2 ;[10000] no. un-reference & return index to caller
PUSHJ P,UPDCDC ;[12000] Adjust cursor position
AOS PTVAL ;[10000] Move the pointer
AOJA VALUE,QCMLP ;[10000] bump index
; end $QCM
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 "."
ADD T1,ARG ;[12000] Add the argument to this
JUMPL T1,.+2 ;[12000] error if negative result
CAML T1,@TXTBUF ;[24000] Check for out of bounds correctly
JRST SUCRET ;[16000] it is so return -1
PUSHJ P,GET ; FETCH THE CHAR AFTER "."
MOVE VALUE,C ; COPY THE VALUE
JRST (PC) ; AND RETURN TO CALLER
;[13000] Execute an arbitrary instruction (at your peril!!)
;CALL: JSP PC,$$EXE ;with instruction in ARG
; contents of SARG will be moved to VALUE first
$EXE: MOVE VALUE,SARG ;Most useful for UUO's
MOVEI X,CWVEC ;address of :W vector for TRMOPing
MOVE T5,EDVAL ;[13000] Get ED bits
XCT ARG ;do it
TXZA T5,ED$SKP ;[13000] remember that we didn't skip
TXO T5,ED$SKP ;[13000] or that we did
MOVEM T5,EDVAL ;[13000] save what ever we got
JRST (PC) ;[13000] Continue execution
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
MOVE X,EDVAL ;[14000] See if BLISS symbol const. set
TXNN X,ED$BLI ;[14000] Check bit (32ED)
JRST CKC0 ;[14000] It wasn't
CAIE C,"&" ;[14000] It was, so check for "&"
CAIN C,"_" ;[14000] Check for "_"
JRST 1(PC) ;[14000] Skip return
JRST (PC) ;[14000] regular return
CKC0: 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
; $CKR - Skip if argument is an alphanumeric ascii character
;
; CALL: JSP PC,$$CKR
; (Fail return)
; (Success return)
$CKR: MOVE C,ARG ;[14000] Get into character register
PUSHJ P,CHKAN ;[14000] Check for alphanumeric
JRST (PC) ;[14000] nope
JRST 1(PC) ;[14000] yes
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: POPJ P, ;[13000] Return to caller
; 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
; $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>
<"Q"-100,,$ITR> ;^Q & ^R are both quoting characters
<"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)
;[16000] ^T mode removed as useless
;$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
; $CNQ - return # of characters in next n lines
$CNQ: PUSHJ P,EVL2RG ;[12000] Convert to string addresses
MOVE VALUE,ARG ;[12000] The value to return...
SUB VALUE,SARG ;[12000] is the difference between them
JRST (PC) ;[12000] Return it
; $E - go to END of specified line
;
;CALL: JSP PC,$$E
; (RETURN)
$E: PUSHJ P,EVL2RG ;[12000]
$E1: CAMN T4,@TXTBUF ;[12000] At end of buffer?
JRST $E9 ;[12000] Yes, stay there
PUSHJ P,GETINC ;[12000] Get next character
CAIN C,15 ;[12000] Stop on <CR> or any line terminator
SOJA T4,$E9 ;[12000] do so
PUSHJ P,CHKEOL ;[12000] ...
JRST $E1 ;[12000] try next charcter
SOJ T4, ;[12000] it was a terminator, back over it
$E9: MOVEM T4,PTVAL ;[12000] save result
JRST (PC) ;[12000] 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: PUSHJ P,FOUT ;[16000] Force out pending output
TXZ F,F$COL ;[12000] Clear ':' flag
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,^D35 ; IS TTCALL # IN RANGE?
TDNN T1,TTLMAP ; . . . ?
ERROR (ITT) ; NO, ** ILLEGAL TTCALL **
TDNE T1,TTXMAP ;[11000] Is this one special
JRST $TTC2 ; YES, DO SPECIAL KLUDGE
LSH ARG,^D23 ; PUT TTCALL # IN AC FIELD
IOR ARG,[TTCALL 0,VALUE] ; AND FROM A TTCALL INSTRUCTION
$TTC0: XCT ARG ; EXECUTE IT
JRST $TTC1 ; IT DIDN'T SKIP
TDNN T1,TTVMAP ; 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 RET
JRST (PC) ; NO, HAS ITS OWN VALUE
;
; Some terminal-related functions that aren't TTCALL's [11000]
;
$TTC2: CAIE ARG,^D8 ;[11000] Is this RESCAN or CCL?
JRST [SKIPN SARG ;[11000] 1 OR 2 ARGS?
SKIPA ARG,TT1VEC-^D16(ARG) ;[11000] 1 ARGUMENT
MOVE ARG,TT2VEC-^D16(ARG) ;[11000] 2 ARGS
JRST $TTC0] ;[11000] and execute it
; SPECIAL KLUDGE FOR RESCAN TTCALL
;
; IF AC SARG.EQ.0 DO A "RESCAN 1", ELSE TAKE ON VALUE ON CCL FLAG
MOVE X,[RESCAN 1] ; FETCH THE "RESCAN" INSTRUCTION
JUMPE SARG,$TTC3 ; WANT TO CHECK CCL FLAG?
MOVE X,[TXNE (F,F$CCL)] ; YES, FETCH PROPER INSTRUCTION
$TTC3: XCT X ; PERFORM THE INSTRUCTION (WHATEVER IT IS)
JRST SUCRET ; SUCCESS RETURN. VALUE:=.TRUE.
JRST FAIRET ; FAIL RETURN. VALUE:=.FALSE.
TT1VEC: MOVE VALUE,INPCHR ;[11000] Get saved character
GETSTS TTYC,VALUE ;[11000] Get status of TTY
TT2VEC: HRRZM SARG,INPCHR ;[11000] Save char for typein
SETSTS TTYC,(SARG) ;[11000] SETSTS for TTY
; BIT MAPS FOR TTCALLS
TTLMAP: <^B111011111111110011,,0> ; MAP OF LEGAL TTCALL #'S
TTXMAP: <^B000000001000000011,,0> ; Map of args that are not TTCALLS
TTSMAP: <^B001001000001100000,,0> ; MAP OF TTCALLS THAT SKIP
TTVMAP: <^B101011100000000000,,0> ; [10000] TTCALLS that return values
$TRMO: ;[10000] Generalized TRMOP. routine
MOVE T3,SARG ;[10000] Second argument is arg to TRMOP.
MOVE T1,ARG ;[10000] Function code is first arg
PUSHJ P,FOUT ;[12000] Force out pending terminal output
MOVE VALUE,[2,,T1] ;[10000] Arg block will be in T1-T3
MOVE T2,OURTTY ;[12000] Get our terminal number
TXZE F,F$2RG ;[11000] if there is any,that is
HRLI VALUE,3 ;[10000] Make length of arglist=3
TRMOP. VALUE, ;[10000] DO IT
JRST FAIRET ;[10000] It didn't work
JRST (PC) ;[10000] Return value, if any
; $GETC: Get command into q-register
; CALL: JSP PC,$$GETC
; <Q.REG.NAME>
; (RETURN)
$GETC:
ECHO ON ;[21000] Always echo this
PUSHJ P,GETCMD ;[15000] Do it
TDZA VALUE,VALUE ;[15000] user typed ^G^G or something
SETO VALUE, ;[15000] Got something ...
MOVX X,ET$SUP ;[21000] See if echo should be off
TDNE X,ETVAL ;[21000] i.e., ET & 8 = 8
ECHO OFF ;[21000] Turn echo back off again
PUSH P,N ;[15000] Save BID of cmd buffer
PUSHJ P,REFBLK ;[21000] Bump the reference count
PUSHJ P,NXTWRD ;[15000] Get q register name
MOVE T1,N ;[15000] into T1 for QGET
POP P,N ;[15000] Get back BID
PUSHJ P,QGET ;[15000] try to get q-register
SETZB T2,T3 ;[15000] no sweat
HRRI T2,(N) ;[15000] New BID
TXO T2,QB$BID ;[15000] text flag now on
TXZ F,F$REF ;[15000] This is a BID not a pointer
PUSHJ P,QSTOR ;[15000] Store away...
JRST (PC) ;[15000] Return
; $TCHR - type (& log) a character
; CALL: MOVX ARG,char
; JSP PC,$$TCHR
; (RETURN)
$TCHR: MOVEI C,(ARG) ;[12000] Character to type
PUSHJ P,TCCHR ;[12000] always type nice
PUSHJ P,FOUT ;[16000] Force it out now
JRST (PC) ;[12000] continue execution
; $GCHR - Input a character from terminal (AND LOG IT!)
; CALL: JSP PC,$$GCHR
; (return with character in VALUE, or -1 if no char and ET$NST set)
$GCHR: PUSHJ P,FOUT ;[16000] Force out output first
$GCHR0: SKIPE VALUE,INPCHR ;[20000] Do we have a character somewhere
JRST [SETZM INPCHR ;[20000] Only once please
JRST (PC)] ;[20000] Yes, use it
MOVX X,ET$NST ;[16000] no stall set?
FOR TOPS10!TOPS20,<
TDNE X,ETVAL ;[16000] no stall set?
JRST [INCHRS VALUE ;[16000] Try to get a character
JRST SUCRET ;[16000] didn't, return -1
JRST (PC)] ;[16000] did, return character
$GCHRW: INCHRW VALUE ;[16000] Wait until the cows come home
>
TXNN F,F$LOG ;[16000] Log this?
JRST (PC) ;[16000] No log file at all
MOVX X,FB$NOO ;[16000] log input?
TDNE X,LELSPC+FS$FLG ;[16000] ...
PUSHJ P,LOGPH1 ;[16000] log it
JRST (PC) ;[16000] continue
; $FF2 - m,nFF - adjust cursor co-ordinates (FX,FY) as if we had done m,nT
$FF2: PUSHJ P,CHK2RG ;[12000] Make sure args in bounds
MOVE T4,SARG ;[12000] Starting point
SUB ARG,SARG ;[12000] # of chars
FF2LP:! SOJL ARG,(PC) ;[12000] exit if done
PUSHJ P,GETINC ;[12000] Get a character
PUSHJ P,UPDCDC ;[12000] Update FX & FY
JRST FF2LP ;[12000] back for more
$FF1: MOVE T5,ARG ;[12000] We will put the row
ADD T5,ROW ;[12000] we want to be in in T5
MOVE T4,PTVAL ;[12000] Start at .
PUSH P,ROW ;[14000] Save current row
PUSH P,COL ;[14000] and column
PUSH P,LENGTH ;[15000] and length of screen
SETZM ROW ;[12000] Initialize row
SETZM COL ;[12000] & col, start at beginning
HRLOI X,377777 ;[15000] Make length very large
MOVEM X,LENGTH ;[15000] indeed
FF1L: CAMLE T4,@TXTBUF ;[12000] Check for end of buffer
JRST FF1Z ;[12000] hit it, finish up
PUSHJ P,GETINC ;[12000] Get a character
PUSHJ P,UPDCDC ;[12000] move cursor position
JUMPL ARG,[CAMLE T5,ROW ;[12000] Got to right row yet?
JRST FF1L ;[12000] No, keep going
JRST FF1Z] ;[12000] yes, finish up
CAML T5,ROW ;[12000] must go past it first
JRST FF1L ;[12000] not yet...
SOJ T4, ;[12000] Yes, back up into it again
FF1Z: SOS VALUE,T4 ;[12000] Undo the INC from GETINC
POP P,LENGTH ;[15000] Put back length of screen
POP P,COL ;[14000] Restore old co-ordinates
POP P,ROW ;[14000] ...
JRST (PC) ;[12000] continue execution
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
JRST $SF ;[14000] ** SEARCH FAILED **
JRST (PC) ; SEARCH SUCCEEDED. RETURN TO CALLER
$SF: TXNE F,F$2CO ;[14000] ::S never steps on pointer
JRST $SF1 ;[14000] so don't
MOVE X,EDVAL ;[14000] Preserve pointer?
TXNN X,ED$SSF ;[14000] IF SET
$SF0: SETZM PTVAL ;[14000] step on it
$SF1: CERROR (SRH) ;[14000] ** SEARCH FAILED **
JRST (PC) ;[14000] Recover from it?
; $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 , $EBAR
; $BAR - NON-STOP SEARCH FOR A STRING (NO OUTPUT)
; $BAR & $EBAR are the same except that $EBAR does not check for 2ED
;
; 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: TXNN F,F$UWR ;[16000] _ OK if no output file
JRST $EBAR ;[16000] ....
MOVE X,EDVAL ;[14000] Check for 2ED
TXNN X,ED$YOK ;[14000] Procede if set
CERROR (YCA) ;[14000] not allowed
$EBAR: 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 $SF0 ; 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 $BSL, $BS and $FS
; $BSL - Line mode bounded search
;
; CALL: JSP PC,$$BSL
; <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)
$BSL: JUMPGE ARG,.+2 ;[15000] Not minus search
TXOA F,F$MSR ;[15000] Is minus search
TXZ F,F$MSR ;[15000] no indeed!
PUSHJ P,EVL2RG ;[14000] Convert line args to char args
TXNE F,F$MSR ;[15000] Reverse args for -nFB
EXCH ARG,SARG ;[15000] so it will be a backwards search
;[14000] and fall into $BS
; $BS - SEARCH FOR AN OCCURRANCE OF A STRING WITHIN SPECIFIED BOUNDS
;
; CALL: JSP PC,$$BS
; <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: TXO F,F$MSR ; SET THE MINUS SEARCH FLAG
CAML ARG,SARG ;[314] MINUS SEARCH?
TXZA F,F$MSR ; NO, CLEAR FLAG
EXCH SARG,ARG ; Exchange arguments
PUSHJ P,CHK2RG ; CHECK THE ARGS FOR VALIDITY
;[14000]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
CERROR (SRH) ;[14000] ** 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 ; OR 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 ; . . .
SKIPG C,ESVAL ; FETCH THE SEARCH TYPE CHAR
JRST $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
; $V - Type some lines either side of the pointer
;
; CALL: JSP PC,$$V
; (RETURN)
$V: PUSH P,ARG ;[12000] Save argument
MOVN ARG,ARG ;[12000]
AOJ ARG, ;[12000] ARG=(1-ARG)
PUSHJ P,EVL2RG ;[12000] returns start in SARG
MOVE ARG,(P) ;[12000] get back original ARG
MOVEM SARG,(P) ;[12000] Save start of stuff to type
PUSHJ P,EVL2RG ;[12000] This will get end addr
POP P,SARG ;[12000] now we have the correct arguments
PUSHJ P,TYPE0 ;[12000] Type it out
JRST (PC) ;[12000] continue execution
CWOORZ: MOVE SARG,DEFARG ;[15000] Set default 2nd arg
CWOORG: SKIPA T1,['[:W] '] ;[14000] n:W =nM([:W]) if n out of range
; $W - W or nW - Do window stuff
; CALL: JSP PC,$$W
; (RETURN)
$W:
MOVX T1,<'[W] '> ;[14000] W = M([W])
TXO F,F$COL!F$1RG!F$2RG ;[14000] No error if no macro
SETOM MACFLG ;[15000] Don't let COMPIL forget args
PJRST M1 ;[14000] Execute the macro, if any
; $COLW - n:w or m,n:w - manipulate window parameters
; CALL: JSP PC,$$COLW
; (RETURN)
$COLW:
JUMPL ARG,CWOORZ ;[12000] negative n.g.
CAILE ARG,CWMAX ;[12000] Range check
JRST CWOORZ
MOVE VALUE,CWVEC(ARG);[15000] Get the value
TXZ F,F$COL!F$2CO ;[15000] Clear colon flags
JRST (PC) ;[15000] & return it
; $CW2 - M,N:W = set window parameters
; CALL: JSP PC,$$CW2
; (RETURN)
$CW2:
JUMPL ARG,CWOORG ;[15000] No negative entries in table
CAIG ARG,CWMAX ;[15000] Store nothing if out of range
MOVEM SARG,CWVEC(ARG) ;[12000] Store the value
JRST CWOORG ;[15000] Execute the macro
; $EJ - Return some parameter from system
;
; CALL: JSP PC,$$EJ
; (RETURN)
EJMIN==-1 ;[22000] Fix for MACRO bug?
$EJ: CAML ARG,[EJMIN] ;[22000] Return 0 if out of range
CAILE ARG,EJMAX ;[12000] Range check
JRST FAIRET ;[12000] This will return zero always
XCT EJVEC(ARG) ;[12000] Get the parameter
JFCL ;[12000] some skip, some don't
IFN FTPRIV,< ;[12000] Priveleged options
TXZN F,F$2RG ;[12000] Should we try to set one of these?
JRST (PC) ;[12000] Win if we survived this far
XCT EJSVEC(ARG) ;[12000] why not?
JFCL ;[12000] Ignore skip return or lack thereof
>
JRST (PC) ;[12000] We're done
EJMIN==<.-EJVEC>
MOVX VALUE,1000+TOPS20 ;[22000] CPU type=1000, O/S type =0 or 1
EJVEC: ;[12000] Dispatch table
PJOB VALUE, ;[12000] Get our job number
MOVE VALUE,OURTTY ;[12000] Get our terminal number
GETPPN VALUE, ;[12000] Get our PPN
EJMAX==<.-EJVEC> ;[12000] Maximum legal value
SETZ VALUE, ;[12000] EJSVEC[-1] for bad arguments
EJSVEC: JRST FAIRET ;[12000] Can't change job number
MOVEM SARG,OURTTY ;[12000] Make this our output sink
CHGPPN SARG, ;[12000] Change our PPN, return old one
SUBTTL $A and $P and $PW and $BP
; $A - APPEND NEXT PAGE ONTO CURRENT BUFFER
;
; CALL: JSP PC,$$A
; (RETURN)
$A: TXNN F,F$COL ;[16000] :A returns 0 if EOF else -1
JRST A0 ;[16000] not :A
TXNE F,F$EOF ;[16000] So check for EOF
JRST FAIRET ;[16000] It was, so fail
SETO VALUE, ;[16000] Win unless no input file
A0: PUSHJ P,APPEND ; APPEND THE NEXT INPUT PAGE
JRST (PC) ; AND RETURN TO CALLER
; $AL - Append n lines to the buffer from the input file
; CALL: MOVX ARG,<# OF LINES> ;[16000]
; JSP PC,$$AL ;[16000]
; (RETURN) ;[16000]
$AL: TXNE F,F$EOF ;[16000] At EOF already
JRST FAIRET ;[16000] Yes
PUSHJ P,APPENL ;[16000] append lines
JRST SUCRET ;[16000] CONTINUE EXECUTION
; $P - PUNCH CURRENT PAGE AND YANK IN A NEW PAGE
;
; CALL: JSP PC,$$P
; (RETURN)
$P: JUMPGE ARG,.+2 ;[14000] We don't tolerate negative arguments
CERROR (IPA) ;[14000] and this was one
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: TXNE F,F$UWR ;[16000] Y is OK if no output file
SKIPN @TXTBUF ;[12000] Naked "Y" legal if buffer empty
JRST $EY ;[14000] ok
MOVE X,EDVAL ;[14000] "Y" legal always if 2ED set
TXNN X,ED$YOK ;[14000]
CERROR (YCA) ;[12000] no good
$EY: 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] . . .
; $USI - USETI TO DESIRED BLOCK ON INPUT FILE
;
; CALL: JSP PC,$$USI ; WITH BLOCK # IN "ARG"
; (RETURN)
$USI: 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 $CNU,$X,$XL
; $CNU - Store text string in q-register
;
; CALL: JSP PC,$$CNU
; <Q.REGISTER.NAME>
; <CHARADR,,LEN>
; (RETURN)
$CNU:
PUSHJ P,NXTWRD ;[12000] Get Q-register name
MOVE T1,N ;[12000] QGET wants it in T1
PUSHJ P,QGET ;[12000] Get current contents
SETZB T2,T3 ;[12000] Q-register does not exist
PUSH P,T1 ;[12000] Save Q-register stuff on stack
PUSH P,T2 ;[12000]
PUSH P,T3 ;[12000]
PUSHJ P,NXTWRD ;[12000] Text is from cmd buffer (^U cmd)
HLRZ L,N ;[12000] Get character addr in cmd buffer
MOVEI T5,(N) ;[12000] length of insert string
JUMPN T5,$CNU00 ;[12000] rejoin common code
TXNE F,F$1RG ;[12000] if there was an argument
AOJA T5,.+2 ;[15000] Allocate space for 1 char
$CNU00: TXZ F,F$1RG ;[24000] Ignore the argument
PUSH P,L ;[12000] Save L
MOVEI T3,<T$DATA*5>+4 ;[12000]Add in overhead words
ADD T3,T5 ;[13000] and # of characters (36 bits worth)
IDIVI T3,5 ; COMPUTE SIZE IN WORDS
TXNE F,F$COL ;[12000] :^U is append to q-register
JRST [TXNN T2,777777 ;[12000] Any text to append to?
JRST .+1 ;[12000] No (just like X)
MOVEI L,TXREF ;[12000] Get address of text here
MOVEI N,(T2) ;[12000] BID here
PUSHJ P,FNDBLK ;[12000] look for it
ERROR (BNF) ;[12000] OOPS
MOVEI N,-T$DATA(T3) ;[12000] # of words to expand
PUSHJ P,EXPAND ;[12000] Expand it
MOVE T1,TXREF ;[12000] Get start of buffer
MOVX T2,TB$CMP ;[12000] Will have to be recompiled
ANDCAM T2,T$BIT(T1) ;[12000] since we will step on the code
MOVE N,T$CCNT(T1) ;[12000] Find end of buffer
IDIVI N,5 ;[12000] In words, please
ADDM T5,T$CCNT(T1) ;[12000] update size of it
HLL N,CBPTBL-1(M) ;[12000] Find correct byte
ADDI N,T$DATA(T1) ;[12000] Add in addr of start of text
JRST $CNU01] ;[12000] done
MOVEI L,(T3) ;[12000] Get length of block to allocate
HRLI L,TXREF ; TXREF WILL REFERENCE THE TEXT BUFFER
SETZM TXREF ; CLEAR TXREF
PUSHJ P,REQM ; ALLOCATE THE TEXT BUFFER
MOVE N,[POINT 7,T$DATA] ; FORM BYTE POINTER TO BUFFER
ADD N,TXREF ; . . .
ADDM T5,T$CCNT-T$DATA(N) ; SAVE # CHARS TO BE PUT IN Q-REGISTER
$CNU01: POP P,T3 ; RESTORE Char adr into T3
IDIVI T3,5 ; CONVERT TO A BYTE POINTER
HLL T3,CBPTBL-1(T4) ; . . .
TXO T3,<Z (R)> ;[12000] Make relative to cmd buffer
TXZ F,F$$TX ;[15000] Clear all these flags to start
TXZN F,F$1RG ;[15000] Single character numeric insert?
JRST $CNU02 ;[15000] NO
SETZ T5, ;[15000] no more after this one
MOVE C,ARG ;[15000] Get the character
JRST $CNU4 ;[15000] Just insert it, nothing fancy
$CNU02: SOJL T5,$X2 ; JUMPE WHEN FINISHED STORING
$CNU1: ILDB C,T3 ; FETCH NEXT CHAR FROM TEXT STRING
; CHECK FOR SPECIAL CONTROL CHARACTERS
MOVE T1,[IOWD $CNU1L,$CNUT1+1] ; POINTER TO CTL CHAR DISPATCH TABLE
; TXNE F,F$CNT ; IN ^T MODE?
; MOVE T1,[IOWD $CNU2L,$CNUT2+1] ; YES, USE SHORT DISPATCH TABLE
PUSHJ P,DISPAT ; DISPATCH ON SPECIAL CONTROL CHARS
$CNU3: PUSHJ P,CASE ; DO ANY REQUIRED CASE CONVERSIONS ON CCHAR
$CNU4: IDPB C,N ;[14000] Store it
JRST $CNU02 ;[14000] loop
; DISPATCH TABLES FOR SPECIAL CONTROL CHARS IN INSERT TEXT STRINGS
$CNUT1: <"V"-100,,$CNUTV>
<"W"-100,,$CNUTW>
<"^"-100,,$CNUTU>
$CNUT2:; [16000] removed <"T"-100,,$CNUTT>
<"R"-100,,$CNUTR>
<"Q"-100,,$CNUTR>
$CNU2L==.-$CNUT2
$CNU1L==.-$CNUT1
; ^V - DOWNCASE FOLLOWING LETTER
; ^V^V - DOWNCASE LETTERS UNTIL END OF STRING OR FURTHER NOTICE
$CNUTV: PUSHJ P,CNV ; SET THE DOWNCASE FLAGS
JRST $CNU1 ; AND PROCESS NEXT CHAR
; ^W - UPCASE FOLLOWING LETTER
; ^W^W - UPCASE LETTERS UNTIL END OF STRING OR FURTHER NOTICE
$CNUTW: PUSHJ P,CNW ; SET UPCASE FLAGS
JRST $CNU1 ; AND PROCESS NEXT CHAR
; ^^ - INSERT LC EQUIVALENT OF FOLLOWING CHAR (@,[,\,],_)
$CNUTU: ILDB C,T3 ; FETCH THE NEXT CHAR
PUSHJ P,CNUAR ; DOWNCASE IF @,[,\,],OR _
JRST $CNU4 ; AND COUNT CHAR AND PROCESS NEXT CHAR
; ^R - QUOTE THE NEXT CHAR (IE: TAKE AS TEXT)
$CNUTR: ILDB C,T3 ; FETCH THE NEXT CHAR
JRST $CNU3 ; DO CASE CONVERSIONS AND STORE IN BUFFER
; ^T - COMPLEMENT ^T MODE FLAG (IN ^T MODE ONLY ^T AND ^R ARE SPECIAL)
;[16000] ^T mode removed
;$CNUTT: TXC F,F$CNT ; COMPLEMENT THE ^T MODE FLAG
; JRST $CNU1 ; AND PROCESS NEXT CHAR
; $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
$X0: PUSHJ P,NXTWRD ;[12000] Get Q-register name
MOVE T1,N ;[12000] QGET wants it in T1
PUSHJ P,QGET ;[12000] Get current contents
SETZB T2,T3 ;[12000] Q-register does not exist
PUSH P,T1 ;[12000] Save Q-register stuff on stack
PUSH P,T2 ;[12000]
PUSH P,T3 ;[12000]
JUMPL SARG,[PUSHJ P,NXTWRD ;[12000] Text is from cmd buffer (^U cmd)
HLR SARG,N ;[12000] Get character addr in cmd buffer
MOVEI T5,(N) ;[12000] length of insert string
JUMPN T5,$X00 ;[12000] rejoin common code
TXNN F,F$1RG ;[12000] if there was an argument
JRST $X00 ;[12000] (there wasn't) (null insert)
TLZ SARG,200000 ;[12000] Remember to insert character only
AOJA T5,$X00] ;[12000] then insert it as a character
MOVE T5,ARG ; COMPUTE SIZE OF TEXT BUFFER NEEDED
SUB T5,SARG ; . . .
$X00: PUSH P,SARG ;[12000] Save SARG a.k.a L
MOVEI T3,<T$DATA*5>+4 ;[12000]Add in overhead words
ADD T3,T5 ;[13000] and # of characters (36 bits worth)
IDIVI T3,5 ; COMPUTE SIZE IN WORDS
TXNE F,F$COL ;[12000] :X is append to q-register
JRST [TXNN T2,777777 ;[12000] Any text to append to?
JRST .+1 ;[12000] No (just like X)
MOVEI L,TXREF ;[12000] Get address of text here
MOVEI N,(T2) ;[12000] BID here
PUSHJ P,FNDBLK ;[12000] look for it
ERROR (BNF) ;[12000] OOPS
MOVEI N,-T$DATA(T3) ;[12000] # of words to expand
PUSHJ P,EXPAND ;[12000] Expand it (we already have overhead words)
MOVE T1,TXREF ;[12000] Get start of buffer
MOVX T2,TB$CMP ;[12000] Will have to be recompiled
ANDCAM T2,T$BIT(T1) ;[12000] since we will step on the code
MOVE T3,T$CCNT(T1) ;[12000] Find end of buffer
IDIVI T3,5 ;[12000] In words, please
ADDM T5,T$CCNT(T1) ;[12000] update size of it
HLL T3,CBPTBL-1(T4) ;[12000] Find correct byte
ADDI T3,T$DATA(T1) ;[12000] Add in addr of start of text
JRST $X01] ;[12000] done
MOVEI L,(T3) ;[12000] Get length of block to allocate
HRLI L,TXREF ; TXREF WILL REFERENCE THE TEXT BUFFER
SETZM TXREF ; CLEAR TXREF
PUSHJ P,REQM ; ALLOCATE THE TEXT BUFFER
MOVE T3,[POINT 7,T$DATA] ; FORM BYTE POINTER TO BUFFER
ADD T3,TXREF ; . . .
ADDM T5,-T$DATA(T3) ; SAVE # CHARS TO BE PUT IN Q-REGISTER
$X01: POP P,SARG ; RESTORE AC SARG
LDB T1,[4200,,SARG] ; FETCH START CHAR.ADR [13000] 34 bits worth
IDIVI T1,5 ; CONVERT TO A BYTE POINTER
HLL T1,CBPTBL-1(T2) ; . . .
JUMPL SARG,[TXO T1,<Z (R)> ;[12000] Make relative to cmd buffer
TLNN SARG,200000 ;[12000] inserting character?
MOVE T1,[70700,,ARG] ;[12000] ASCII char in ARG
JRST $X1] ;[12000] Jump into loop
ADD T1,TXTBUF ; . . .
ADDI T1,T$DATA ; Add in overhead words
$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:
POP P,T3 ;[12000] Get it off the stack
POP P,T2 ;[12000]
POP P,T1 ;[12000]
TXZE F,F$COL ;[12000] If it was :X... (also clear ":" flag)
TRNN T2,777777 ;[12000] ...and it already had text...
TXOA T2,QB$BID ; FLAG Q-REGISTER AS A TEXT BUFFER
JRST [MOVE T1,TXREF ;[12000] ...then the Q-register is already stored
SETZM TXREF ;[12000] Clear our reference
HRRZS T1,B$2PTR(T1) ;[12000] And the pointer to it
JRST (PC)] ;[12000] And go away
HRRI T2,TXREF ; 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
JRST (PC) ; ** NO TEXT IN Q-REGISTER **
TXNN T2,QB$BID ; IS THERE TEXT IN THE Q-REGISTER?
JRST (PC) ; ** NO TEXT IN Q-REGISTER **
MOVEI N,(T2) ; 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 (BNF) ; SHOULDN'T OCCUR. ** CAN'T FIND Q-REGISTER **
MOVE T5,@TMPRFG ;[21000](36bits) FETCH THE # CHARS IN Q-REG
MOVE T1,T5 ; T5:=# CHARS IN Q-REGISTER
TXNN F,F$COL ;[12000] don't mung buffer if :G, just type
PUSHJ P,MKROOM ; AND MAKE ROOM FOR THEM
MOVE T3,[POINT 7,T$DATA] ; FORM BYTE POINTER TO Q-REGISTER IN T3
ADD T3,TMPRFG ; . . .
TXZE F,F$COL ;[12000] :G means type it
JRST [COLGLP: SOJL T5,$G2 ;[12000] no more chars
ILDB C,T3 ;[12000] Get character
TXNN F,F$2CO ;[16000] ::G Type literally
JRST [PUSHJ P,TCCHR ;[16000] Type normally
JRST COLGLP] ;[16000] back for more
PUSHJ P,TCHR ;[12000] Type it
JRST COLGLP] ;[12000] back for more
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
TXZ F,F$COL!F$2CO ;[16000] Don't leave : flags on
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
M1: MOVEM SARG,SARGSV ;[3000] DO NOT LOSE 2ND ARGUMENT TO MACRO
PUSHJ P,QGET ; GET INFO ON THE Q-REGG
JRST (PC) ;[16000] no
TXNN T2,QB$BID ; IS THERE TEXT IN Q-REGISTER?
JRST (PC) ;[16000] no text
MOVE L,T1 ; PUT Q-REG-NAME IN AC L
MOVEI N,(T2) ; PUT BUFFER ID IN AC N
PUSHJ P,MACRO ; NOW COMPILE&EXECUTE THE MACRO
JRST (PC) ;[14000] Leave the returned value alone
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: SKIPN EOVAL ;[12000] Don't output all if EO=0
JRST $EC1 ;[12000] EO=0 so just garbage collect
MOVSI ARG,1 ;[12000] Do infinity P commands
TXNE F,F$UWR ;[12000] As long as there is an output file
PUSHJ P,PUNBUF ;[12000]
TXZE F,F$UBK ;[12000] Push everything along for EB
PUSHJ P,BAKCLS ;[12000] INP to .BAK OUT to INP
RELEAS OUT, ;[12000] Close up output file
TXZ F,F$UWR ;[12000] No more output file
MOVEI T1,NOOF ;[12000] Set up error if try to output
MOVEM T1,PCHADR ;[12000] to avoid blowing up
$EC1: 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:
FOR TOPS10, PUSHJ P,POSSYM ;[14000] Page out DDT & symbol table
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
TXNE F,F$GCN ;[14000] Only if it would do something useful
PUSHJ P,GARCOL ; PERFORM A GARBAGE COLLECTION
; SET OUR CORE SIZE
MOVEI X,(ARG) ; FETCH REQUESTED CORE SIZE
CAMGE X,.JBFF ; NOT TOO SMALL?
MOVE X,.JBFF ;[16000] As small as we can, then
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
HALT .+1 ;[20000] Should never 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
; $ETS - Change ET flags and do appropriate other things
;
; CALL: JSP PC,$ETS
; (RETURN)
$ETS: TXZN F,F$2RG ;[12000] 2 argument form?
JRST $ETS1 ;[12000] NO
IOR ARG,ETVAL ;[12000] ARG is bits to set
ANDCM ARG,SARG ;[12000] SARG is bits to clear
$ETS1: MOVMS T1,ARG ;[12000] Make -1 into 1 for compatability
XOR T1,ETVAL ;[12000] See which ones changed
TXNE ARG,ET$CCT ;[20000] Did he want ^C trapping?
JRST [SETZM INTBLK+2 ;[20000] Make sure it can happen
SETZM INTBLK+3 ;[20000] ....
MOVEI X,INTRPT ;[20000] Address of handler
MOVEM X,INTBLK ;[20000] into block
MOVEI X,ER.ICC ;[20000] Set bit in block for ^C trap
MOVEM X,INTBLK+1 ;[20000]...
MOVEI X,INTBLK ;[20000] Address of block
MOVEM X,.JBINT ;[20000] into .JBINT so monitor will use it
JRST .+1] ;[20000] Continue
TXZE T1,ET$DET ;[12000] Detached flag changed?
JRST [HRLZ T2,OURTTY ;[12000] Assume detaching
TXNN ARG,ET$DET ;[12000] Is he detaching, or attaching?
HRRI T2,777777 ;[12000] Attaching (detached flag turned off)
ATTACH T2, ;[12000] do it, whatever it was
TXC ARG,ET$DET ;[12000] Failed, flip the flag
PUSHJ P,TTOPEN ;[12000] Re-open the terminal
TXNN ARG,ET$DET ;[12000] If attached reset terminal stuff
TXO T1,<ET$SUP!ET$LC> ;[12000] Force setting status
JRST .+1] ;[12000] continue
TXZE T1,ET$SUP ;[12000] Turn echoing on or off?
JRST [TXNN ARG,ET$SUP ;[12000] on or off?
JRST [ECHO ON ;[21000] on (bit was off)
JRST .+1] ;[21000] ...
ECHO OFF ;[21000] Off (bit was on)
JRST .+1] ;[12000] ...
TXZE T1,ET$LC ;[12000] Turn LC input on or off?
FOR TOPS10!TOPS20,<
JRST [MOVE T2,OURTTY ;[12000] Twiddle line characteristics
GETLCH T2 ;[12000] Get them first
TXNN ARG,ET$LC ;[12000] Check our LC bit
TXZA T2,GL.LCM ;[12000] it's off, so clear this one
TXO T2,GL.LCM ;[12000] set it
SETLCH T2 ;[12000] in the monitor
JRST .+1] ;[12000]
>
TXZE ARG,ET$CCO ;[12000] Did he set Cancel-control-O
FOR TOPS10,<
SKPINC ;[12000] Yes, so cancel it
JFCL ;[12000] don't care if it skips
>
FOR TOPS20,<
PUSHJ P,CLRCCO ;[21000]
>
MOVEM ARG,ETVAL ;[12000] Save the bits that are left
JRST (PC) ;[12000] Continue execution
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 $RUNP
; $ER - SETUP A FILE FOR INPUT
;
; CALL: JSP PC,$$ER
; <FILE.SPEC>
; (RETURN)
$ER: MOVE X,FS$FLG(PC) ; FETCH FILE-SPEC FLAGS
TXZE X,FB$EXE ; /EXECUTE?
JRST $EI ; YES DO AN "EI"
MOVEI L,LERSPC ; FETCH ADR OF "ER" FILE-SPEC
TXNE F,F$2CO ;[16000] ::ER just sets defaults
PJRST SFSDEF ;[16000] so go do that instead
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 X,FB$APP ;[14000] EW/APPEND does indeed append
PJRST $APP ;[14000] so append instead
MOVEI L,LEWSPC ; FETCH ADR OF "EW" FILE-SPEC
TXNE X,FB$DEL ;[20000] /SUPERSEDE?
TXO L,1B1 ;[20000] Yes. remember that
TXZE F,F$2CO ;[16000] ::EW just sets defaults
PJRST SFSDEF ;[16000] so go do that instead
TXNE F,F$UBK ; "EB" IN PROGRESS?
CERROR (EBO) ; YES, ** EW WHEN EB IN PROGRESS **
TXNE F,F$UWR ;[14000] Check for open output file
CERROR (OFO) ;[14000] Output file open error
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
; $EK - Cancel EB and flush output file
;
; CALL: JSP PC,$$EK
; (RETURN)
$EK: MOVEI T1,OUT ;[12000] Prepare to do RESDV.
TXZN F,F$UBK ;[12000] Clear EB, skip RESDV. if was set.
RESDV. T1, ;[12000] Output file is no more
RELEAS OUT, ;[12000] Save .TMP file if from EB
TXZ F,F$UWR ;[12000] Not writing output file
MOVEI X,NOOF ;[12000] Cause error if we try
MOVEM X,PCHADR ;[12000] to write to it.
JRST (PC) ;[12000] done
; NOOF - COME HERE WHEN WE WANT TO PUNCH A CHAR BUT NO OUTPUT FILE
NOOF: ERROR (NFO) ;[304] ** NO OUTPUT FILE **
; $RUNP - SETUP FILE TO BE RUN ON EXIT
;
; CALL: JSP PC,$$RUNP
; <FILE.SPEC>
; (RETURN)
$RUNP: MOVEM ARG,RUNOFS ; STORE /RUNOFFSET:N
MOVEI L,LRPSPC ; FETCH ADR OF LAST "E&" FILE-SPEC
PUSHJ P,SETFSP ; AND FILL IN THE DEFAULTS
;[14000]TXO F,F$EDC ; no more 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: ;[1000] EBO CHECK MOVED DOWN TO MAKE SURE
;[1000] WE EAT ALL ARGUMENTS (ELSE WE BLOW UP)
MOVE X,FS$FLG(PC) ; FETCH FILE-SPEC FLAGS
TXNE X,FB$EXE ; /EXECUTE?
JRST $EI ; YES, DO AN "EI" INSTEAD OF "EB"
; SETUP THE EB FILESPEC
MOVEI L,LEBSPC ; FETCH ADR OF THE EB FILESPEC
TXZE F,F$2CO ;[16000] ::EB just sets defaults
PJRST SFSDEF ;[16000] so do that, don't open anything
PUSHJ P,SETFSP ; AND FILL IT IN
TXNE F,F$UBK ; "EB" ALREADY IN PROGRESS?
CERROR (EBO) ; YES, ERROR
FOR TOPS10,<
; MAKE SURE DEVICE IS A DSK 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
MOVE T2,LEBSPC+FS$FLG ;[23000] /INPLACE always does real EB
TXNE T2,FB$DEL ;[23000] ...
JRST $EB1 ;[23000]
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
MOVEI T2,FILSPC+FS$PTH-1 ;[23000] Limit of BLT
FOR TOPS10,<
MOVEI X,INP ;[23000] Get the path for the file
MOVEM X,FILSPC+FS$PTH ;[23000] Set up for uuo
MOVE X,[.PTMAX,,FILSPC+FS$PTH] ;[23000] ...
PATH. X, ;[23000]
MOVEI T2,FILSPC+FS$LTH-1 ;[23000] lose.......
>;end TOPS10
BLT T1,(T2) ;[24000] copy rest
; 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 SUCRET ; AND RETURN TO CALLER
; FILE NOT IN OUR UFD. JUST DO ER-EW SEQUENCE
>;END TOPS10 ONLY
$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
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 $APP - Append to file
; $APP - SETUP FOR APPENDING TO A FILE (OUTPUT)
;
; CALL: JSP PC,$$APP
; <FILE.SPEC>
; (RETURN)
$EA:
$APP:
TXNE F,F$UBK ; "EB" IN PROGRESS?
CERROR (EBO) ; YES, ** EA WHEN EB IN PROGRESS **
TXNE F,F$UWR ;[14000] "EW" or "EA" in progress?
CERROR (OFO) ;[14000] Yes, "OUTPUT FILE OPEN"
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
TXZE F,F$2CO ;[16000] ::EI just sets defaults
PJRST SFSDF0 ;[16000] so go do that instead
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
TXZE F,F$2CO ;[16000] ::EL just sets defaults
PJRST SFSDF0 ;[16000] so go do that instead
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 $RENM
; $RENM - RENAME CURRENT INPUT FILE
;
; CALL: JSP PC,$$RENM
; <FILE.SPEC>
; (RETURN)
$RENM: MOVEI L,LERSPC ; FETCH ADR OF FILE-SPEC
MOVE X,FS$FLG(PC) ;[15000] Get flags from real filespec
TXNE X,FB$DEL ;[15000] Delete?
TLO L,400000 ;[15000] Yes, remember it
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 **
JUMPL L,[SETZ T1, ;[15000] Try to delete it
RENAME INP,T1;[15000] by renaming it to 0
JRST ECARDE ;[15000] failed
JRST ECAR0] ;[15000] it worked
MOVE N,[Z INP,] ; FETCH THE INPUT CHANNEL
PUSHJ P,FILRNM ; AND PERFORM THE RENAME
JRST ECARRE ; RENAME FAILED
ECAR0: RELEAS INP, ; CLOSE THE FILE
TXZ F,F$URD ; AND CLEAR THE "ER" FLAG
JRST SUCRET ; AND GIVE SUCCESS RETURN TO CALLER
ECARDE: MOVEM T2,LREERR ;[16000] Remember last error
ECARRE: 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, $EQ & E%
; $EQ - READ A FILE INTO Q-REGISTER
;
; CALL: JSP PC,$$EQ
; <Q-REG>
; <FILE.SPEC>
; (RETURN)
$EQ: PUSHJ P,NXTWRD ;[12000] Get Q-register name first
MOVEM N,ACSAVE+N ;[15000] Stash in M
MOVEI L,LERSPC ; FETCH ADR OF LAST "ER" FILE SPEC
MOVE X,FS$FLG(PC) ;[15000] Check flag for /DELETE
TXNE X,FB$DEL ;[15000] Which is NEVER set by SETFSP
TLO L,400000 ;[15000] Set bit in L to do it
PUSHJ P,SETFSP ; AND FILL IN PARTS
PUSHJ P,FILERD ; READ THE FILE INTO A BUFFER
MOVE T1,ACSAVE+N ;[14000] Get back Q-register name
PUSHJ P,QGET ;[12000] Get current contents
SETZB T2,T3 ;[12000] None yet
TXO T2,QB$BID ; SET THE "TEXT" BIT
HRR T2,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
; $EPCT - WRITE A FILE FROM Q-REGISTER
;
; CALL: JSP PC,$$EPCT
; <Q-REG>
; <FILE.SPEC>
; (RETURN)
$EPCT: PUSHJ P,NXTWRD ;[12000] Get Q-register name first
MOVE T1,N ;[14000] argument to QGET
PUSHJ P,QGET ;[14000] Find the Q-register
CERROR (NTQ) ;[14000] lose
TXNN T2,QB$BID ;[14000] Look for text
CERROR (NTQ) ;[14000] lose
MOVEI N,(T2) ;[14000] BID argument to FILEWR
MOVEI L,LEWSPC ; FETCH ADR OF LAST "EW" FILE SPEC
MOVE X,FS$FLG(PC) ;[15000] Check flag for /SUPERSEDE
TXNE X,FB$DEL ;[24000] Which may be on in default!!
TLO L,200000 ;[15000] Set bit in L to do it
PUSHJ P,SETFSP ; AND FILL IN PARTS
PUSHJ P,FILEWR ; WRITE THE FILE FROM THE BUFFER
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 **
TXNE F,F$UWR ;[14000] Check for output file open already
CERROR (OFO) ;[14000] Yes error "OUTPUT FILE OPEN"
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 or MAGTAPE
PUSHJ P,OPENWR ; RE-OPEN AND ENTER THE FILE
JRST SUCRET ; AND GIVE SUCCESS RETURN TO CALLER
; SFSDEF - Set filespec defaults, but don't open any file
SFSDEF: SETZM FS$EXT(L) ;[16000] Clear extension also
SFSDF0: SETZM FS$FLG(L) ;[16000] Clear out flags
SETZM FS$NAM(L) ;[16000] and name (leave device alone)
SETZM FS$PRV(L) ;[16000] and protection word...
HRLI X,FS$PRV(L) ;[16000] Set up BLT pointer
HRRI X,FS$PRV+1(L) ;[16000] to zero rest of block
BLT X,FS$LTH-1(L) ;[16000] and zero it
PUSHJ P,SETFSP ;[16000] and fill in from code
JRST SUCRET ;[16000] Return win
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
TXZE F,F$2CO ;[16000] ::EE just sets defaults
PJRST SFSDF0 ;[16000] so go do that instead
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 or .EXE
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 **
MOVEI M,^D75 ;[15000] Save file would probably get this big
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
HLRZ X,FS$EXT(L) ;[21000] Make .EXE file if extension is .EXE
CAIN X,'EXE' ;[21000] ...
JRST $EEXE ;[21000] Write an .EXE file
; 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
$EEND: 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
$EERR: 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
; $EEXE -- Write an .EXE file
$EEXE:
MOVE N,[1776,,3] ;[21000] Build directory in buffer
PUSHJ P,$EE3 ;[21000] Write start of directory section
MOVE N,[100000,,1] ;[21000] Writable, starting @ file page 1
PUSHJ P,$EE3 ;[21000] ...
HRLZ N,.JBREL ;[21000] Get length of loseg
TLZ N,777 ;[21000] Convert to page # - 1
PUSHJ P,$EE3 ;[21000] # of pages-1 , Process page 0
MOVE N,[1777,,1] ;[21000] Terminating section
PUSHJ P,$EE3 ;[21000] ...
OUTPUT 0, ;[21000] Force it out
SETSTS 0,.IODMP ;[21000] Change to dump mode
MOVE T1,[IOWD 1,INIBF+3] ;[21000] Now zeros for rest of page
SETZB T2,INIBF+3 ;[21000] I/O list is now in T1 & T2
REPEAT <<1000/C$BUFL>-1>,<
OUTPUT 0,T1 ;[21000] ...
>
MOVEI T1,INIBF+3 ;[21000] Prepare to BLT bottom of page 0
BLT T1,INIBF+C$BUFL+2 ;[21000] do it (we can't dump that stuff)
MOVE T1,[IOWD C$BUFL,INIBF+3] ;[21000] Set up I/O list
OUTPUT 0,T1 ;[21000] Write out jobdat & then some
MOVN T1,.JBREL ;[21000] Get back - size of loseg
ADDI T1,C$BUFL-1 ;[21000] Allow for what we already wrote
MOVSI T1,(T1) ;[21000] Build I/O word for rest of core
HRRI T1,C$BUFL-1 ;[21000] ...
OUT 0,T1 ;[21000] And finally catch I/O errors
JRST $EEND ;[21000] We're done
JRST $EERR ;[21000] We lost
; $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
PUSHJ P,TTOPEN ;[11000] Open the TTY for echo control
MOVE X,.JBVER ;[325] FETCH LOWSEG VERSION #
XOR X,.HIGH.+.JBHVR ;[12000] [325] COMPARE WITH HISEG VERSION #
TLNE X,777777 ;[12000] Check left half only
ERROR (VAI) ;[311] NO, VERSIONS ARE INCOMPATIBLE
MOVEI X,INTBLK ;[20000] Set up .JBINT for ^C trap if needed
MOVEM X,.JBINT ;[20000] or even if not needed...
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,LRPSPC+FS$DEV ; AND STORE IN RUN FILE-SPEC
MOVE X,['COMPIL'] ; FETCH COMPIL'S NAME
MOVEM X,LRPSPC+FS$NAM ; AND STORE IN FILE-SPEC
SETZM LRPSPC+FS$EXT ; CLEAR THE FILE EXTENSION
SETZM LRPSPC+FS$PPN ; AND THE PPN
MOVEI X,1 ; /RUNOFFSET:1
MOVEM X,RUNOFS ; . . .
;[14000]TXO F,F$EDC ;No more 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 ; Is there an 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
; [21000] Now execute the *EXIT macro, if there is one.
MOVX T1,'*EXIT ' ;[21000] Get name of macro
PUSHJ P,QGET ;[21000] Try to find one
JRST $EX2 ;[21000] ain't none
TXNN T2,QB$BID ;[21000] Any text in it?
JRST $EX2 ;[21000] NOPE
MOVE N,T2 ;[21000] Get the buffer ID
MOVX L,'*EXIT ' ;[21000] Remember the macro name
PUSHJ P,MACRO ;[21000] Execute it
$EX2: SKIPN @TXTBUF ;[22000] Don't bitch if no text
JRST $EX3 ;[22000] as is the case
TXNN F,F$UWR ;[22000] ANY OUTPUT FILE?
ERROR (NFO) ;[14000] Don't let luser lose his text
$EX3: 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: SKIPN LRPSPC+FS$NAM ;[14000] See if we have a program to run
JRST MONRT1 ; NO, JUST EXIT
; DO A RUN MUUO ON FILE SPECIFIED IN LAST "ED" COMMAND
MOVE T1,LRPSPC+FS$DEV ; FETCH THE DEVICE NAME
MOVE T2,LRPSPC+FS$NAM ; FETCH THE FILE NAME
MOVE T3,LRPSPC+FS$EXT ; FETCH THE FILE EXTENSION
SETZB T4,T5+1 ; ZERO UNUSED WORDS OF RUN BLOCK
MOVE T5,LRPSPC+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+<Y>B19+TEXT.LENGTH> ; X:=1 IF EXACT MODE
; ; X:=0 IF BOTH UC AND LC MATCH
; ; Y:= (ED & 1)
;
; 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
MOVE T2,DELIM ; [12000] Get default 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
MOVX X,ED$UAR ;[16000] Up-arrow mode??
TDNE X,EDVAL ;[16000] ...
TRO T3,200000 ;[16000] Remember it forever
; 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
SSTP2X: AOJ T4, ; INCREMENT THE TEXT LENGTH COUNT
CAIN C,"^" ;[16000] Is this an uparrow??
TRNE T3,200000 ;[16000] do we care?
JRST SSTP2Y ;[16000] no
PUSHJ P,CMDGCH ;[16000] Get the next character...
ERROR (USR) ;[16000] Un-terminated search error
ANDI C,37 ;[16000] Make it a control character
JRST SSTP2X ;[16000] And do all our good stuff to it
SSTP2Y: 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
SSTUSR: 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
TRZE T3,1B19 ;[16000] Compiled with uparrow mode?
TXO F,F$UAR ;[16000] Remember it for a while at least
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
SSTG1X: 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
;[14000] Don't bitch about controls
; 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>
<"^",,SSGUA> ;[16000] Up-arrow mode
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,.,%,$)
; ^B - Same as ^S but easier to type on tubes with PAGE set
SSGEM: XORM N,SRHTAB+$CHSPC ;[10000] Any number of... (^EM)
SOJG T3,SSTGS1 ;[10000]
ERROR(ICA) ;[10000]
SSGEB:
SSGCNS: MOVE X,[<-SRHLN+3,,1>] ; SET SEARCH MATRIX FOR ALL CHARS
PUSHJ P,SSGSTB ; EXCEPT NULL AND FAKE CHARS EXCEPT BEGPAGE
MOVE T1,EDVAL ;[10000] ^O40ED = bliss mode
TXNE T1,ED$BLI ;[10000]
JRST [XORM N,SRHTAB+"_" ;[10000]
XORM N,SRHTAB+"&" ;[10000]
JRST .+2] ;[10000]
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: SOJLE T3,SSTUSR ;[20000] Un-terminated search error
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
; ^ - Take next character as control, if enabled
SSGUA: TXNE F,F$UAR ;[16000] Is up-arrow really up-arrow?
JRST SSTGS4 ;[16000] Yes, treat as ordinary character
ILDB C,T2 ;[16000] Fetch the following character
ANDI C,37 ;[16000] Make it a control
SOJA T3,SSTG1X ;[16000] and process it
; ^E COMMANDS
SSGCNE: ILDB C,T2 ; FETCH THE FOLLOWING CHAR
PUSHJ P,UPCASE ;[12000] Make upper case
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>
<"B",,SSGEB> ;[14000] ^EB = ^S
<"M",,SSGEM> ;[14000] ^EMc any number of c
<"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
EXCH T4,PTVAL ;[14000] Start at this place
MOVEM T4,ACSAVE ;[15000] Save real .
MOVE T4,PTVAL ;[15000] Get back real l.b.
PJRST SEARC0 ; 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: MOVE X,PTVAL ; FETCH "."
MOVEM X,ACSAVE ; AND SAVE FOR LATER CHECKING
SEARC0: ;[15000] . already saved
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
TXO F,F$MSR ;TRY NEGATIVE FIRST
CAMG T4,T5 ; IS THIS A MINUS SEARCH?
; (IE: BACKWARDS)
TXZA F,F$MSR ; NO , KEEP ARGS THIS WAY AND ZAP 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 CHARACTERS 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$2CO!F$REE ;[14000] Anchored search?? or aborted?
JRST SRCHF1 ;[14000] Yes. it failed.
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 MULTIPLE CHARACTERS
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
MOVE X,T2 ; SAVE CURRENT BP
ILDB C,T2 ; GET NEXT CHAR FROM BUFFER
TDNE M,SRHTAB(C) ;[10000] Skip whatever it was
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: CAML N,T4 ; SUCCEED WITHIN BOUNDS? [16000] boundary
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
EXCH ARG,SARG ;[21000] Then fix them!
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
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
;[14000]MOVE X,[%LDSTP] ; FETCH DEFAULT PROTECTION
;[14000]GETTAB X, ; . . .
;[14000] MOVX X,<055B8> ; (IN CASE GETTAB FAILS)
SETZ X, ;[14000] Let system do the defaulting
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
;[3000] JRST SETFS3 ; AND RETURN TO CALLER
MOVE T2,[-C$SFDL,,PATHB+3] ;[3000] COPY SFD IF THAT IS THE DEFAULT
JRST SETF1X ;[3000] JUMP INTO SFD CODE
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,<
;[4000] TXNN T1,FB$SFD ; SFDS IN FILE SPEC?
;[4000] JRST SETFS3 ; NO, RETURN TO CALLER
MOVE T2,[XWD -C$SFDL,FS$SFD] ;[425] SETUP AOBJN LOOP COUNTER
ADDI T2,(PC) ; MAKE IT POINT TO FIRST SFD
SETF1X: ;[3000] LABEL ADDED TO MAKE SFD'S WIN
MOVEI T3,FS$SFD(L) ; FETCH ADR OF WHERE TO STORE SFDS
SETFS2: MOVE X,(T2) ;[3000] FETCH SFD FROM FILE SPEC
;[3000] DON'T 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
SETZM PTVAL ;[12000] to prevent ?XTCPOP...
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,2(T1) ;[342] YES, GET PPN [4000] FOR REAL
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
; APPENL Append (ARG) lines to the buffer
APPENL: TXO F,F$EOL ;[16000] Remember it's linewise append
JRST APPEN0 ;[16000] Jump into common APPEND code
; 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$EOL ;[16000] Not stop on end-of-line
APPEN0: 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: TXNN F,F$EOL ;[16000] Stop on end of line?
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
TXNE F,F$EOL ;[16000] Stop on end of line?
SOJG ARG,APPND1 ;[16000] Yes, decr count & maybe continue
; 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
;[12000] will compile if TB$CMP in buffer is off
; 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
MOVE VALUE,ARG ;[14000] Pass argument to macro
; 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 (BNF) ; CAN'T. ERROR
MOVE X,MACBUF ; FETCH ADR OF BUFFER
AOS T$RCNT(X) ; AND INCREMENT REFERENCE COUNT
; COMPILE BUFFER IF TB$CMP IS OFF
MOVEI L,MACBUF ; FETCH ADR OF REF TO BUFFER
PUSH P,F ;[5000] DON'T LET FLAGS BE CLOBBERED BY COMPIL
TXO F,F$CMP ;[12000] It is now compile-time
MOVE T1,MACBUF ;[12000] Check COMPILED flag for buffer
TXZ F,F$COL ;[23000] Clear colon flag for COMPIL
MOVE T2,T$BIT(T1) ;[12000] Get buffer flags
TXZN F,F$2CO ;[23000] Clear :: too, but if it's on...
JUMPL T2,MACRO2 ;[12000] it is already compiled
MACROY: TXNE T2,TB$BUF ;[12000] if it is the text buffer...
ERROR (XTB) ;[12000] then it should NOT be compiled
PUSH P,SARGSV ;[14000] Save argument to macro
PUSH P,ARG ;[23000] Save other argument
PUSHJ P,COMPIL ; YES
POP P,VALUE ;[23000] Pass value to macro
POP P,SARGSV ;[14000] Restore SARG
MOVE T1,MACBUF ;[12000] now set that bit
MOVX T2,TB$CMP ;[12000]
IORM T2,T$BIT(T1) ;[12000] in the buffer hdr
MACRO2: POP P,F ;[5000] RESTORE FLAGS
TXZ F,F$CMP!F$COL ;[4000] SO ERRORS WILL BE KNOWN TO BE
;[4000] EXECUTION TIME ERRORS
AOS MACLVL ; COUNT THE NESTING OF MACROS
; EXECUTE THE COMPILED BUFFER
MOVEI L,MACBUF ; FETCH ADR OF REF TO BUFFER
TXZN F,F$2CO ;[14000] ::M compile but do not execute
PUSHJ P,EXECUT ; AND EXECUTE THE BUFFER
; POP INFO ABOUT PREVIOUS MACRO OFF CONTROL PDL
TXZ F,F$2CO!F$COL ;[23000] Don't leave colons on
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?)
JUMPL L,OPENW0 ;[20000] /SUPERCEDE was given so don't care
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
OPENW0: 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
SETZ M, ;[15000] Don't know size now
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: MOVX L,<FLAGS,,FILSPC> ;FLAGS: 400000 = delete after read
; PUSHJ P,FILERD
; (RETURN) ; WITH BUFFER ID IN AC N
;
; SMASHES ACS X,T1-T5
FILERD: MOVEI T1,.IODMP ; USE CHANNEL ZERO [13000] Dump mode
MOVE T2,FS$DEV(L) ;Get device name [13000]
SETZB T3,N ;[13000] no b.r.h. for dump mode (& use ch 0)
CAMN T2,['TMP '] ;[15000] Did he really want TMPCOR
JRST [HLLZ T2,FS$NAM(L) ;[15000] Yes, get name
MOVE T1,[.TCRRF,,T2] ;[15000] Set up to read
TMPCOR T1, ;[15000] into null buffer to get length
JRST [SETZM FILSPC ;[15000] Zero FILSPC file block
MOVE X,[FILSPC,,FILSPC+1] ;[15000] so we can
BLT X,FILSPC+FS$LTH-1 ;[15000] use it for the .TMP
MOVE X,CCJNAM ;[15000] Get job # in left half
HLR X,FS$NAM(L) ;[15000] file name in rt half
MOVEM X,FILSPC+FS$NAM ;[15000] i.e. 003EDT
MOVSI X,'TMP' ;[15000] .TMP
MOVEM X,FILSPC+FS$EXT ;[15000] 003EDT.TMP
MOVSI X,'DSK' ;[15000] DSK:
MOVEM X,FILSPC+FS$DEV ;[15000] DSK:003EDT.TMP
HRRI L,FILSPC ;[15000]
PJRST FILERD] ;[15000] And read the file
PUSH P,L ;[15000] Save addr of file block
MOVEI L,T$DATA(T1) ;[15000] Allocate a block that big
HRLI L,FRDREF ;[15000] FRDREF will point to it
PUSHJ P,MAKBUF ;[15000] Get a place to put this thing
MOVEM T5,@FRDREF ;[15000] This many chars in the buffer
MOVNI T3,(L) ;[15000] Negative length
MOVSI T3,(T3) ;[15000] in left half...
HRR T3,FRDREF ;[15000] Address -1 in right half
ADDI T3,T$DATA-1 ;[15000] (include overhead words)
MOVE T1,[.TCRRF,,T2] ;[15000] Assume just read
POP P,L ;[15000] Get back addr of file block
HLLZ T2,FS$NAM(L) ;[15000] Get back file name
TLZE L,400000 ;[15000] Flag is sign bit of L
HRLI T1,.TCRDF ;[15000] Then do read & delete
TMPCOR T1, ;[15000] Read, or read & delete the file
ERROR (XXX) ;[15000] What happened?
JRST FRD5] ;[15000] Go clean up
OPEN 0,T1 ;[13000] Try the open
CERR1 (IDV) ; ** INPUT DEVICE OPEN FAILURE **
PUSHJ P,FILLKP ; LOOKUP THE INPUT FILE
CERR1 (FNF) ; ** FILE NOT FOUND **
PUSH P,L ;[15000] Save addr of file block
MOVSI L,FRDREF ;[13000] Addr of ref in left half
HRR L,RBSPC+.RBSIZ ;[13000] Size of file in words in right half
PUSHJ P,MAKBUF ; AND MAKE A BUFFER FOR TEXT OF FILE
POP P,L ;[15000] Get file block addr back
; 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?
;[13000] Use dump mode (Many times faster)
JUMPE T5,FRDZ ;[15000] Zero-length, finish up
MOVEM T5,@FRDREF ;[13000] Store length of buffer
MOVN T1,RBSPC+.RBSIZ ;[13000] Negative length in words
MOVSI T1,(T1) ;[13000] Should be in left half
HRR T1,FRDREF ;[13000] Build address to read in data
ADDI T1,T$DATA-1 ;[13000] Skip over overhead words
SETZ T2, ;[13000] I/O list in T1,T2
IN 0,T1 ;[13000] Read it all in at once
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
;[13000] Remove nulls from the end of the file only
FRD5:
MOVE T1,@FRDREF ;[13000] Get # of chars in buffer
FRD5A: SOJLE T1,FRDZ ;[13000] First char is #0
PUSHJ P,CTOBP ;[13000] Make byte pointer
ADD T1,FRDREF ;[13000] Make absolute
ADDI T1,T$DATA ;[13000] Skip overhead words
LDB C,T1 ;[13000] Get the character
JUMPN C,FRDZ ;[13000] not NULL, leave alone
SOSLE T1,@FRDREF ;[13000] 1 less character
JRST FRD5A ;[13000] try again if any left
; DONE READING FILE. CLEAN UP AND RETURN TO CALLER
FRDZ: MOVE X,FRDREF ; FETCH BASE ADR OF BUFFER
HRRZS T$1REF(X) ; AND DELETE THE REF TO BUFFER
SETZM FRDREF ; AND CLEAR 'FRDREF'
JUMPGE L,CPOPJ ;[15000] no /DELETE switch
CAIL T5,C$MAXD ;[15000] If it is fairly long
POPJ P, ;[16000] he probably didn't mean it
SETZ T1, ;[15000] Very short rename block
RENAME 0,T1 ;[15000] STOMP!!!
JRST [MOVEM T2,LREERR ;[16000] Remember error code
CERR1 (RNF)] ;[16000] ** RENAME FAILURE **
POPJ P, ; AND RETURN TO CALLER
; FILEWR - WRITE A FILE FROM A TEXT BUFFER
;
; CALL: MOVEI L,FILSPC
; MOVEI N,BID
; PUSHJ P,FILEWR
; (RETURN)
;
; SMASHES ACS X,T1-T5
FILEWR: MOVE T5,L ;[14000] Save away filespec pointer
MOVEI L,FRDREF ;[14000] FRDREF will reference block
PUSHJ P,FNDBLK ;[14000] Find our block ...
ERROR (BNF) ;[14000] What block???
MOVE L,T5 ;[14000] Get back addr of file block
MOVE T1,FRDREF ;[14000] We will need the length
MOVE T5,T$CCNT(T1) ;[14000] of the block.
ADDI T5,4 ;[14000] Round up so we don't lose anything
IDIVI T5,5 ;[14000] Convert to words
ADDI T1,T$DATA-1(T5) ;[15000] Get addr of last word
MOVE X,[EXP <3777,,777777>,<17,,777777>,77777,377,1](X)
ANDCAM X,(T1) ;[15000] Use bit mask to clear invalid chars
FWR0: MOVEI T1,.IODMP ;[13000] Dump mode
MOVE T2,FS$DEV(L) ;Get device name [13000]
SETZB T3,N ;[13000] no b.r.h. for dump mode & Chn 0
CAMN T2,['TMP '] ;[15000] Is it TMPCOR
JRST [MOVNI T3,(T5) ;[15000] Negative # of words
MOVSI T3,(T3) ;[15000] In left half
HRR T3,FRDREF ;[15000] Addr-1 in right half
ADDI T3,T$DATA-1 ;[15000] (Include overhead words)
HLLZ T2,FS$NAM(L) ;[15000] 3-letters of name
MOVE T1,[.TCRWF,,T2] ;[15000] Write TMPCOR
TMPCOR T1, ;[15000] T2 & T3 are argument block
JRST [SETZM FILSPC ;[15000] Use temp file block
MOVE X,[FILSPC,,FILSPC+1] ;[15000] so we can
BLT X,FILSPC+FS$LTH-1 ;[15000] use it for the .TMP
MOVE X,CCJNAM ;[15000] Get job # in left half
HLR X,FS$NAM(L) ;[15000] file name in rt half
MOVEM X,FILSPC+FS$NAM ;[15000] i.e. 003EDT
MOVSI X,'TMP' ;[15000] .TMP
MOVEM X,FILSPC+FS$EXT ;[15000] 003EDT.TMP
MOVSI X,'DSK' ;[15000] DSK:
MOVEM X,FILSPC+FS$DEV ;[15000] DSK:003EDT.TMP
MOVX L,<1B0+FILSPC> ;[20000] Always supercede
PJRST FWR0] ;[15000] Write it
JRST FWRZ] ;[15000] All done
OPEN 0,T1 ;[13000] Try the open
JRST [MOVE X,FRDREF ;[20000] Clean up reference first
HRRZS X,B$2PTR(X) ;[20000]
CERR1 (ODV)] ;[20000] and then give error
MOVEI M,177(T5) ;[14000] Estimated length of file (round up)
ASH M,-7 ;[15000] Convert to blocks (IDIVI step on R)
PUSHJ P,FILENN ; ENTER THE OUTPUT FILE
JRST [MOVE X,FRDREF ;[20000] Clean up reference first
HRRZS X,B$2PTR(X) ;[20000] to not leave bad pointer around
CERR1 (ENT) ] ;[20000] Then give error
JUMPE T5,FWR9 ;[15000] Zero-length file
MOVNI T1,(T5) ;[13000] Negative length in words
MOVSI T1,(T1) ;[13000] Should be in left half
HRR T1,FRDREF ;[13000] Build address to read in data
ADDI T1,T$DATA-1 ;[13000] Skip over overhead words
SETZ T2, ;[13000] I/O list in T1,T2
OUT 0,T1 ;[13000] Write it all out at once
JRST FWR9 ; YES, DONE WRITING FILE
GETSTS 0,IOSTS ; NO, FETCH I/O STATUS
ERROR (OER) ; AND GIVE AN OUTPUT ERROR MSG
FWR9:
MOVX T1,<17B12> ;[14000] We want to set the mode
ANDCAM T1,RBSPC+.RBPRV ;[14000] back to ASCII
SETZM RBSPC+.RBALC ;[14000] Don't de-allocate any blocks!!!
MOVEI T1,.RBSTS ;[22000] Reset count since RENAME believes
MOVEM T1,RBSPC+.RBCNT ;[22000] that the whole word is the count
RENAME RBSPC ;[14000] Rename it back to ASCII mode
CLOSE 0, ;[14000] Rename failed, try to Close the file
RELEASE 0, ;[14000] and release it.
FWRZ: MOVEI L,(L) ;[24000] Clear supersede/delete bit
PJRST FRDZ ;[14000] and un-reference the block
; 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+10(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
HLRZ L,(P) ; FETCH REF FROM AC L<LH>
PUSHJ P,FNDBLK ; AND BIND 'REF' TO BUFFER
ERROR (XXX) ; ? ? ?
POP P,L ; RESTORE AC L
MOVEI T5,(L) ; AND PUT IN AC T5 [13000]
IMULI T5,5 ; COMPUTE # CHARS IN BUFFER
SUBI T5,<T$DATA+10>*5; MINUS #CHARS TAKEN UP BY OVERHEAD
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
TYPE0: 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: MOVE T1,SARG ; FETCH 36 BIT [13000] ADR OF NEXT CHAR
PUSHJ P,GET ; ANF FETCH CHAR FROM BUFFER
CAIN C,177 ;[10000] Rubout forces next character
AOJA SARG,[MOVE T1,SARG ;[10000] [13000] 36 bits
CAML SARG,ARG ;[16000] Still in bounds?
POPJ P, ;[16000] All done
PUSHJ P,GET ;[10000] to print as itself regardless
PUSHJ P,TCHR ;[10000]
SOJA T4,.+2] ;[10000]
PUSHJ P,TCCHR ; AND TYPE IT
AOJ SARG, ; INCREMENT TO NEXT CHAR
TXNN F,F$REE ;[2000] MAKE IT STOP IF WE REENTER
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
FILRNM: MOVE T1,[RENAME 0,RBSPC] ; Set up RENAME opcode
JRST FILL1 ; and jump right in
FILENT: SKIPA T1,[ENTER 0,RBSPC] ; SETUP THE ENTER OPCODE
FILLKP: MOVE T1,[LOOKUP 0,RBSPC] ; SETUP THE LOOKUP OPCODE
FILL1: TLO L,200000 ;[20000] Set the Supersede bit
FILLNS: HRRM 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
TLNN L,200000 ;[20000] Non-superceding enter??
TRO X,RB.NSE ;[20000] Yes.
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
;[14000] ;If I want it huge I must have a reason
CAXLE M,^D1500 ; 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
FILL2A: ;[4000] LABEL MOVED SO ERROR CODE RIGHT
SKIPA T2,RBSPC+.RBEXT ; FAILED. GET ERROR CODE AND SKIP
JRST CPOPJ1 ; SUCCEEDED. GIVE SUCCESS RETURN TO CALLER
FILL2B: HRRZM T2,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
; FILENN - FILE ENTER (non-superceding if TLO L,200000)
FILENN: MOVE T1,[ENTER 0,RBSPC] ; SETUP THE ENTER OPCODE
JRST FILLNS ; AND DO Possibly non-superceding ENTER
; 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 FILL2B ; 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
MOVE X,ETVAL ;[12000] Check abort flag
TXNE X,ET$ABO ;[12000] Go to monitor if set
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 N,PROMPT ; TYPE FAKE PROMPT
PUSHJ P,TXSTR ; . . .
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
IFN FTXTEC&FTXTCERR, POPJ P, ;[21000] Just return
IFE FTXTEC&FTXTCERR, 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 Current char, LEBSPC
<CNNFIL,,CNNERC> ; 02 03 LASSPC, Lookup/enter code (#)
<CNNDEV,,CNNPTH> ; 04 05 Output dev, LASSPC path
<CNNARG,,CNNPRO> ; 06 07 ARG, LASSPC PROTECTION
<CNNEBF,,CNNIFL> ; 08 09 LEBSPC name, LEBSPC
<CNNEBN,,CNNIOF> ; 10 11 LEBSPC, IO flags (#)
<CNNTAG,,CNNSKP> ; 12 13 TAG, Lookup/Enter (text)
<CNNISK,,0> ; 14 15 IO error bits (text)
<CNNEOV,,CNNSRH> ; 16 17 EO, Search arg
<CNNTSC,,CNNSWT> ; 18 19 MACNAM, switch
<CNNEWF,,CNNERF> ; 20 21 EW, ER
<CNNCNT,,CNNCND> ; 22 23 ^T, ^D
<CNNSAR,,CNNFLG> ; 24 25 SARG, FLAGS
<CNNVAL,,0> ;26 0 VALUE,
; ^N00 - TYPE CURRENT COMMAND CHAR
CNNCCH: SKIPGE CMDCNT ;[20000] Less than nothing
SETZM CMDCNT ;[20000] Should really be just nothing
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 EB 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
; ^N24 - TYPE SARG VALUE [12000]
CNNSAR: SKIPA N,SARG ;[12000] Fetch 2nd argument
; ^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: MOVEI L,LEBSPC ;[12000] FETCH LAST EB SPEC
PJRST TFSPEC ;[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 Current MACRO name
CNNTSC: MOVE N,MACNAM ;[12000] current macro name
PJRST TSIX ;[12000] in SIXBIT
; ^N19 - TYPE SWITCH NAME
CNNSWT: MOVE N,SBNAME ; FETCH THE SWITCH NAME
PJRST TSIX ; TYPE IT AND RETURN
; ^N20 - TYPE EW FILE-NAME AND EXTENSION
CNNEWF: MOVEI L,LEWSPC ; FETCH ADR OF LAST OUTPUT FILE-SPEC
PJRST TFSPEC ; AND TYPE FILE-NAME AND RETURN
; ^N21 - TYPE ER FILE-NAME AND EXTENSION
CNNERF: MOVEI L,LERSPC ; FETCH ADR OF LAST INPUT FILE-SPEC
PJRST TFSPEC ; AND TYPE FILE-NAME AND RETURN
; ^N22 - Type current ET value [12000]
CNNCNT: SKIPA N,ETVAL ;[12000] Get the ET value
; ^N23 - Type the currrent ED value [12000]
CNNCND: MOVE N,EDVAL ;[12000] Get the ED value
PJRST TOCT ;[12000] Type in octal
; ^N24 gets CNNSAR, which is just before CNNARG
; ^N25 - Type the global flags [12000]
CNNFLG: MOVE N,F ;[12000] Get the flags
PJRST TOCT ;[12000] Type in octal
; ^N26 - Type the current VALUE [12000]
CNNVAL: MOVE N,VALUE ;[12000] Get VALUE
PJRST TDEC ;[12000] type in decimal
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 BNF,< Block not found
This is an internal error and should be reported. A block of text,
such as a previously-executed command, or q-register text, was not
in the linked list of such blocks.
>
ERRGEN BPT,< Breakpoint in macro "18"
The most recent EB file was: "10"
The most recent ER file was: "21"
The most recent EW file was: "20"
The most recent search argument was: "17"
EO=16, ET=22, ED=23
ARG=06, SARG=24, VALUE=26,
Flags="25"
>
ERRGEN CCM,< CCL Command Missing
TECO10 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 TECO10 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 TECO10 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,< 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, or an EK to cancel the current EB.
>
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.
04File "02" already exists
ENTER UUO failure 4. Re-issue the command with the /SUPERSEDE switch,
if you really want to supersede the file. Otherwise use a different
name, or (assuming you do not intend to read your current "ER" file
any more, do an "ER" to the file that would be superseded, and
an "E=newname$" to rename it.
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.
41Undefined Network Node.
ENTER UUO failure 41. The device 04 cannot be opened
because the node on which it resides is not on line. Try again later.
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 TECO10.
This must be an older version of TECO10 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.
41Undefined Network Node.
LOOKUP UUO failure 41. The device 04 cannot be opened
because the node on which it resides is not on line. Try again later.
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 IDV,< Input Device 04 not Available
Open 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
"E" was interpreted as part of a 2-letter command.
"E00" is not recognized as a command.
>
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
"F" was interpreted as part of a 2-letter command.
"F00" is not recognized as a command.
>
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, E&, EE, EI,
E=, EQ, E%, EW, or EZ command and the terminator.
>
ERRGEN ILL,< Illegal Command: 00
The character "00" is not defined as a valid TECO10 command.
>
ERRGEN ILM,< Illegal Memory Reference
TECO10 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 IPA,< Illegal argument to "P" command
The "P" command can take a numeric argument, which is the number of
pages to move. A negative argument is illegal.
>
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,
"<, ">, "=, "R, "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 2 formats:
(1) X , where "X" is a printing character (except `,{,|,},~)
(2) (FOO) where "FOO" is up to 6 alphanumerics, or is in quotes.
>
ERRGEN IQR,< Illegal Character "00" in Q-Register Name, please retype
The Q-register name given in the "*" command contains
an illegal character. Re-type the "*" and a legal q-register name.
A Q-register name must be in one 2 formats:
(1) X , where "X" is a printing character (except `,{,|,},~)
(2) (FOO) where "FOO" is up to 6 alphanumerics, or is in quotes.
>
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).
:8^T will do a RESCAN, :1,8^T tests for CCL entry point.
>
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 LLB,< Linked-list broken
This is an internal error. The linked list of q-register values, etc.
is broken. Try to save your edits and exit. This is an internal error
which should be reported. Save your output.
>
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 in macro "18" is an "O" command with no
delimiter to mark the end of the tag-name.
>
ERRGEN MEQ,< Macro Ending with "
The macro "18" ends with a " character. This is an
incomplete command. " must be followed by 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 ^
The macro "18" ends with a ^ character. This is an
incomplete command. ^ followed by a character converts the character
into a control character for command parsing. The
character was not there.
>
ERRGEN MIQ,< Macro Ending with "00"
The macro "18" ends with the "00" command.
This command requires a Q-register name of 1 character
or up to 6 characters in parentheses.
>
ERRGEN MLA,< Missing Left Angle Bracket
There is a right angle bracket that has no
matching left angle bracket. An iteration must
be complete within the macro or command.
>
ERRGEN MLP,< Missing (
There is a right parenthesis that is not matched
by a corresponding left parenthesis.
>
ERRGEN MRA,< Missing Right Angle Bracket
There is a left angle bracket that has no
matching right angle bracket. An iteration must
be complete within the macro or command.
>
ERRGEN MRP,< Missing )
There is a right parenthesis that is not matched
by a corresponding left 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 ^^
The macro "18" ends with either a 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 NDI,< No Delimiter After I
If the I command has a numeric argument it must be followed
by a null text string i.e.: 33I$ or 33@i//
>
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 NSI,< Null Switch Name is Illegal
A switch name must consist of one or more alphanumeric characters.
>
ERRGEN NTQ,< No text in Q-register
The Q-register "19" does not contain text.
>
ERRGEN NYA,< Numeric argument to "Y" or "EY" command
The "Y" command does not take numeric arguments.
Did you type "0YY" instead of "0TT"?
>
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 OFO,< EW Before Current Output file Closed
An EB,EW,EA, or EZ command may not be given while an output file is open.
Give an EF to close the file if you wish to save the output file as it is,
or an EK to throw away the current output file.
>
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.
>
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.
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.) This can also occur on a "]()" command since
the numeric value will be used for ".".
This can also occur with the nA command (A with numeric argument)
if (.+n) attempts to access a character off either end of the buffer.
>
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 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 TECO10. If desired, the user
may re-assemble TECO10 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 UEN,< Unimplemented "EN" command
The EN command is not implemented, sorry.
>
ERRGEN UFS,< Macro Ending with Unterminated File Selection Command
The last command in the macro "18" is a file selection command
(ER, EW, EB, ED, EL, EI, EN, or EZ) with no delimiter 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 incompatability
The current version of TECO10 may be incompatable with save files
written with the EE command with an old version of TECO10.
Re-compile all your macros and re-issue the EE command if possible.
If this is not possible, it may be possible to continue, but random
errors may occur.
>
ERRGEN XTB,< Attempt to execute the Text editing Buffer.
The Q-register 18 is currently sharing with the blank Q-register,
which is the Text-editing buffer. Do "HX18m18".
>
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.
>
ERRGEN YCA,< "Y" or "_" command aborted due to non-empty buffer
The "Y" and "_" commands are only legal if the editing buffer is empty,
or if 2ED is set, or in a macro.
"EY" is the same command as "Y" but without this restriction.
"E_" is the same command as "_" but without this restriction.
>
; 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,T1,T2,T3,T4
;GFSPEC: PUSH P,. ;[23000] No delmiter if entered here
; PUSHJ P,GFSPED ;[24000] So call other one
; POP P,(P) ;[24000] Fix up stack
; POPJ P, ;[24000] And return
; GFSPED - Same as GFSPEC except takes a delimiter on Stack
GFSPED: 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: CAMN C,-1(P) ;[24000] Check delimiter
JRST GFS9 ;[23000] That's it, end of file spec
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
GFS9: 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?
JRST [CAIE C,.CHRAB;[23000] Protection?
ERROR (IPP) ; NO, ** ILLEGAL PPN **
JRST SWPRO9] ;[23000] Yes, store it
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,[XWD -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
PAIR DELETE,SWDEL ;[15000] /DELETE (for temp files & TMPCOR)
PAIR SUPERS,SWDEL ;[20000] /SUPERCEDE for E% & EW
PAIR INPLAC,SWDEL ;[23000] /INPLACE (for EB)
PAIR BINARY,SWOCT ;[23000] /BINARY (no zap nulls)
>
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
PUSHJ P,GCHR ; FETCH NEXT CHAR
SWPRO9: 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
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: TXOA T4,FB$EXE ; SET THE "/EXECUTE" FLAG
; 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: TXOA T4,FB$ASC ; SET /ASCII
; 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: TXOA T4,FB$OCT ; SET /OCTAL
; 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: TXOA T4,FB$SUP ; SET /SUPLSN
; 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: TXOA T4,FB$NOO ;[330] SET /NOOUT
; SWNOI - /NOIN - DO NOT GENERATE INPUT
SWNOI: TXO T4,FB$NOI ;[330] SET /NOIN
JRST GFS0 ;[330] AND CONTINUE FILE-SPEC SCAN
; SWDEL - /DELETE - DELETE (TMPCOR FILE) AFTER READING
SWDEL: TXOA T4,FB$DEL ;[15000]
; 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,CHKSCB ;[10000] IS IT A LETTER/DIGIT? or &_%$
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: CAIL C,140 ;[14000] In LC range?
MOVEI C,-40(C) ;[14000] Yes, but not any more
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,<
; GETCHL - GET NEXT INPUT CHARACTER FROM CURRENT INPUT SOURCE
; (IN LINE MODE [12000])
;
; CALL: PUSHJ P,GETCHL
; (RETURN) ; WITH CHAR IN AC C
;
; USES AC C and X
GETCHL:
IFE TOPS20,<
SKIPE C,INPCHR ; REPEAT THE LAST CHAR?
JRST GETCHF ; YES
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 IN LINE MODE
SKIPE TTOBUF ;[12000] Check for pending TTY output
PUSHJ P,FOUT ;[12000] Force it out now
GETCLW: INCHWL C ; INPUT A CHAR INTO AC C
JRST CKLOGI ;[12000] See if log file in use
>;END IFE TOPS20
; GETCH - GET NEXT INPUT CHARACTER FROM CURRENT INPUT SOURCE
;
; CALL: PUSHJ P,GETCH
; (RETURN) ; WITH CHAR IN AC C
;
; USES AC C and X
GETCH: SKIPN C,INPCHR ; REPEAT THE LAST CHAR?
JRST GETCH0 ; NO
GETCHF:!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
SKIPE TTOBUF ;[12000] Check for pending TTY output
PUSHJ P,FOUT ;[12000] Force it out
GETCHW: INCHRW C ; INPUT A CHAR INTO AC C
; PUNCH CHAR TO LOG FILE IF I SAID SO
CKLOGI: 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
GODDT:: 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
;[16000]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,X AND M ARE SMASHED
TOCT:
;[14000] SKIPA X,[^D8] ; FETCH OCTAL RADIX
TOCT0: SETZ C, ;[14000] Start fresh
ROTC C,-3 ;[14000] Get 1 digit worth in reverse order
LSH C,-41 ;[14000] right justify
MOVEI C,"0"(C) ;[14000] Make digit
HRLM C,(P) ;[14000] Save on stack (instead of flags)
JUMPE N,.+2 ;[14000] Supress leading zeroes
PUSHJ P,TOCT0 ;[14000] Call ourself recursively
HLRZ C,(P) ;[14000] Get a digit
JRST TCHR ;[14000] Type it out
TDEC: MOVEI X,^D10 ; FETCH DECIMAL RADIX
JUMPGE N,TDEC0 ; NO "-" SIGN NEEDED
;[1000] FIX LOGFILE CODE BASHING RADIX
MOVE M,X ;[1000]SAVE RADIX
MOVEI C,"-" ; "-" SIGN NEEDED
PUSHJ P,TCHR ; TYPE THE "-" SIGN
MOVM N,N ; AND TAKE ABSOLUTE VALUE OF NUMBER
MOVE X,M ;[1000] RESTORE RADIX
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,FOUT ; IF DONE, RETURN TO CALLER
TXNE F,F$REE ;[10000] REEnter done?
PJRST FOUT ;[16000] yes shaddup & force it out
ILDB C,T1 ; FETCH NEXT CHAR OF MESSAGE
PUSHJ P,TCCHR ; AND TYPE IT
SOJA N,TMSG1 ; AND TRY AGAIN
; TTOPEN - Open the TTY so we can do echo control
TTOPEN:
IFN TOPS10,<
OPEN TTYC,[EXP IO.LEM ;[11000]
SIXBIT 'TTY' ;[11000]
Z] ;[11000]
OPEN TTYC,[EXP 0, ;[12000] to avoid...
SIXBIT 'NUL' ;[12000] I/O to unassigned ...
Z] ;[12000] ...channel
JFCL
SETO X, ;[12000] Get our line #
TRMNO. X, ;[12000] from the system
JRST TTYODT ;[21000] It's detached
>
FOR TOPS20,<
PUSHJ P,SAVE5 ;[21000] Save AC's that will get clobbered
MOVX T1,.FHSLF ;[21000] Our process
GPJFN ;[21000] Make sure primary output is TTY
MOVEI T2,(T2) ;[21000] Output is in right half
CAIE T2,.CTTRM ;[21000] Is it?
JRST [MOVE X,T2 ;[21000] no. leave it alone
JRST TTYOPX] ;[21000] in the right AC
GJINF ;[21000] Yes, so stuff real terminal in
SKIPG X,T4 ;[21000] or -1 if detached
JRST TTYODT ;[21000] remember that we are detached
TXO X,.TTDES ;[21000] Make it a real TTY designator
TTYOPX:>
MOVEM X,OURTTY ;[12000] Remember its number
MOVE X,[POINT 7,TTOBUF] ;[12000] Set up byte pointer
MOVEM X,TTOPTR ;[12000] for terminal output
;Find out terminal width & length
FOR TOPS10,<
MOVEI X,.TOPSZ ;[13000] Length
MOVEM X,TOOFUN ;
MOVE X,[2,,TOOFUN] ;[13000] Addr,,len for UUO
TRMOP. X,
>
MOVEI X,^D24 ;[13000] safe guess
MOVEM X,LENGTH
FOR TOPS10,<
MOVEI X,.TOWID ;[13000] Width
MOVEM X,TOOFUN ;
MOVE X,[2,,TOOFUN] ;[13000] Addr,,len for UUO
TRMOP. X,
>
MOVEI X,^D80
MOVEM X,WIDTH ;[13000] Save it away
MOVEI X,.TOOUS ;[12000] Function code for TRMOP.
MOVEM X,TOOFUN ;[12000] (equivalent to OUTSTR)
MOVEI X,TTOBUF ;[12000] Set up argument also
MOVEM X,TOOADR ;[12000] address of output
POPJ P,
TTYODT: MOVX X,ET$DET ;[12000] Set detached flag
IORM X,ETVAL ;[12000]
POPJ P, ;[12000]
>; END FOR FTXTEC!FTXTCERR
FOR FTXTCERR,<
; TSSTR - 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
;[3000] ADD CODE TO PRINT SFD
MOVEI T1,FS$SFD(L) ;[3000] T1 POINTS TO START OF SFD'S
TPATH3: SKIPN N,(T1) ;[3000] FETCH NEXT ONE AND SKIP
JRST TPATH1 ;[3000] NO MORE
MOVEI C,"," ;[3000] SEPARATE WITH COMMAS
PUSHJ P,TCHR ;[3000]
PUSHJ P,TSIX ;[3000] TYPE THE SFD NAME
AOJA T1,TPATH3 ;[3000] BACK FOR MORE
>;; 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: MOVE X,ETVAL ;[6000] CHECK ONLY LAST BIT
TRNE X,ET$EXT ;[6000]
PJRST TCHR ; YES, NO SUBSTITUTIONS FOR NON-PRINTING CHARS
TPCHR: ;[5000] ENTER HERE TO ALWAYS PRETTYPRINT
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: CAIN C,14 ;[10000]Form Feed special handling
JRST [;MOVE X,ETVAL ;[10000]
TXNE X,ET$DPY ;[10000] TUBE
JRST TCC4 ;[10000]
JRST TCHR] ;[12000] Type as is (more or less)
SKIPE EOL ;Anything special at end of line?
JRST [CAIN C,15 ;If so,
POPJ P, ; ... then ignore <CR>
CAIE C,12 ;and do special stuff to <LF>
JRST .+1 ; (which this wasn't)
PUSH P,N ; Don't clobber N
MOVEI N,EOL ;Get it,
PUSHJ P,TXSTR ;Type it,
POP P,N ; restore N
SETZM COL ;should be at left margin now
AOS ROW ;of next line
PUSHJ P,UPDCRO ;adjust things if it scrolled
MOVEI C,12 ;get back C (we knew what it was, anyway)
POPJ P,] ;and return
CAIN C,.CHTAB ;[13000] Is this a TAB?
JRST [SKIPN TTAB ;[13000] anything to type in its place?
JRST .+1 ;[13000] no, really type a TAB
PUSH P,N ;[13000]
MOVEI N,TTAB ;[13000] Type this string instead
PUSHJ P,T0XSTR ;[13000] ...
PUSHJ P,TABSTP ;[21000] Find next tab stop
PUSH P,X ;[21000] And save it
TCCT0: AOS N,COL ;[13000] Always increment column by 1 at least
JUMPL N,.+2 ;[25000] Don't screw us if we're lost
CAML N,(P) ;[21000] Did we get there yet?
JRST [MOVEI N,TTABND ;[16000] Sequence for end of tab
PUSHJ P,T0XSTR ;[16000] do it
MOVEI C,.CHTAB ;[13000] Restore C
POP P,X ;[21000] Fix up stack
POP P,N ;[13000] Restore N, check cursor & return
POPJ P,] ;[13000]
MOVEI N,CFWD ;[13000] Advance the physical cursor
PUSHJ P,T0XSTR ;[13000] by typing whatever does that
JRST TCCT0] ;[13000] And check again
JUMPE C,[SKIPN TNULL ;[15000] Do we have anything for NULLs?
JRST .+1 ;[15000] do the usual thing
PUSH P,N ;[15000] Type the specified sequence
MOVEI N,TNULL ;[15000] ...
PUSHJ P,T0XSTR ;[15000] ...
POP P,N ;[15000] Get back old value of N
AOS COL ;[15000] Assume this uses 1 character position
POPJ P,] ;[15000] done
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
; T0XSTR -- Type an ASCIZ string without disturbing the column setting
; (useful for typing escape sequences & other wierd stuff
; same calling sequence as TXSTR
T0XSTR: PUSH P,COL ;[13000] Type something out
HRROS COL ;[15000] Turn off counting
PUSHJ P,TXSTR ;without disturbing
POP P,COL ;the cursor column
POPJ P, ;[13000]
; TXSTR TYPE AN ASCIZ STRING WITH NO REFORMATTING
;
; CALL: MOVEI N,[ASCIZ/STRING/
; PUSHJ P,TXSTR
; (RETURN)
TXSTR: HRLI N,(POINT 7,) ;[7000] BYTE PTR
TXSTR0: ILDB C,N ;[7000]
JUMPE C,CPOPJ ;[7000]
PUSHJ P,TCHR ;[7000]
JRST TXSTR0 ;[7000]
; CLRLIN -- Clear a whole line from the screen
;
; CALL: PUSHJ P,CLRLIN ;uses text in WIPEL to erase to end of line
;
CLRLIN: MOVEI C,15 ;[12000] naked carriage return first
PUSHJ P,TCHR ;[12000]
MOVEI N,WIPEL ;[12000] erase to end of line
SETZM COL ;[23000] Clear the column count
PJRST T0XSTR ;[12000] type that & return
; TCRLF - OUTPUT A CRLF
;
; CALL IS: PUSHJ P,TCRLF ;
; (ONLY RETURN)
; ACS B AND C ARE SMASHED
TCRLF: SETZM COL ;[23000] Clear column counter
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: MOVX X,ET$TRN ;[16000] Check for truncate mode
TDNE X,ETVAL ;[16000] ...
JRST [MOVE X,COL ;[16000] See if we're off the wall yet
CAIE C,10 ;[21000] Always let backspace through
CAMGE X,WIDTH ;[16000] ...
JRST .+1 ;[16000] still OK
CAILE C,15 ;[21000] Always let CR,LF,VT,FF through
CAIGE C,12 ;[21000] ...
JRST .+1 ;[21000] ...
POPJ P,] ;[16000] Don't actually type this character
JUMPE C,[PUSHJ P,FOUT ;[24000] Null is text terminator, so
IFN TOPS10,< PUSH P,TOOFUN;[24000] Save old function code
PUSH P,TOOADR;[24000] Save old address
SETZM TOOADR ;[24000] Prepare to output a null
MOVEI X,.TOOUC;[24000] Just 1 character
MOVEM X,TOOFUN;[24000]
MOVE X,[3,,TOOBLK] ;[24000] Set up to do it
TRMOP. X, ;[24000] We did it
JFCL ;[24000] We didn't, but who cares?
POP P,TOOADR ;[24000] Restore old address
POP P,TOOFUN ;[24000] and old function code
>;End IFN TOPS10 ;[24000]
IFN TOPS20,< PUSHJ P,SAVE2;[24000] Save registers
MOVE T1,OURTTY;[24000] Get our terminal JFN
SETZ T2, ;[24000] And our null character
BOUT ;[24000] Output it
ERJMP .+1 ;[24000] Ignore any error
>;END IFN TOPS20
JRST TCHUPD] ;[24000] return
SKIPE TTOEND ;[12000] See if room in the buffer
PUSHJ P,FOUT ;[12000] There isn't, make some
IDPB C,TTOPTR ;[12000] Store it in the output buffer
SKIPL COL ;[12000] -1FC disables checking
TCHUPD: PUSHJ P,UPDCAD ;[12000] Update cursor address
TLZN C,1 ;[12000] Set by UPDCAD if free CRLF needed
POPJ P, ; AND RETURN TO CALLER
PUSH P,C ;[12000] Save C
PUSHJ P,TCRLF ;[12000] Do the CRLF
POP P,C ;[12000] Get back C
POPJ P, ;[12000]
$FOUT: ;[12000] Entry From user code to force out TTY output
;[12000] Call: JSP PC,$$FOUT ;clobbers X
PUSH P,PC ;[12000] Put return addr where POPJ will see it
;[12000] and fall into FOUT
FOUT: ;[12000] Entry from hiseg to force out TTY output
;[12000] Call: PUSHJ P,FOUT ;clobbers X
FOR TOPS10,<
MOVE X,[3,,TOOBLK] ;[12000] Prepare for TRMOP.
TRMOP. X, ;[12000] Output all of that stuff
JFCL ;[12000] Failed, ignore it
>
FOR TOPS20,<
PUSHJ P,SAVE5 ;[21000] Save the AC's
MOVE T1,OURTTY ;[21000] Destination designator
RFMOD ;[21000] Get the current mode bits
PUSH P,T2 ;[21000] and save them
TRZ T2,300 ;[21000] Put in image mode
SFMOD
HRROI T2,TTOBUF ;[21000] Output buffer pointer
SETZB T3,T4 ;[21000] no count, terminate on null byte
SOUT ;[21000] Do it
ERJMP .+1 ;[24000] Ignore error
POP P,T2 ;[21000] Get back old mode setting
SFMOD ;[21000] and restore terminal to that state
>
SETZM TTOBUF ;[12000] Zero the output buffer
MOVE X,[TTOBUF,,TTOBUF+1] ;[12000]
BLT X,TTOEND ;[12000]
MOVE X,[POINT 7,TTOBUF] ;[12000] Reset byte pointer
MOVEM X,TTOPTR ;[12000]
POPJ P, ;[12000] return
FOR TOPS20,< ;Terminal mode manipulation
CLRCCO: PUSH P,[TT%OSP] ;[21000] Clear "supress output" bit
SKIPA
ECOFF: PUSH P,[TT%ECO] ;[21000] Bit to clear
CLRFMO: PUSH P,T1 ;[21000] Clobber no registers
PUSH P,T2
MOVE T1,OURTTY ;[21000]
RFMOD ;[21000] What do we have now
TDZE T2,-2(P) ;[24000] Set the bits
SFMOD ;[21000] Set it unless already set
JRST SETFMZ ;[21000] Join common restoring code
ECON: PUSH P,[TT%ECO] ;[21000] Bit to set
SETFMO: PUSH P,T1 ;[21000] Clobber no registers
PUSH P,T2
MOVE T1,OURTTY ;[21000]
RFMOD ;[21000] What do we have now
TDON T2,-2(P) ;[21000] Set the bits
SFMOD ;[21000] Set it unless already set
SETFMZ: POP P,T2 ;[21000] Restore registers
POP P,T1 ;[21000] ...
ADJSP P,-1 ;[21000] Throw this away
POPJ P, ;[21000] return
>;end TOPS20
;UPDCDC [12000] Update cursor address, assuming controls get reformatted
;
; CALL: MOVEI C,CHARACTER
; PUSHJ P,UPDCAD
; (return with things updated)
; uses C
;
UPDCDC: CAIL C,177 ;do nothing with rubout or greater
POPJ P, ;
SKIPL EUVAL ;Check for case flagging
JRST [CAIG C,"A"+40 ;check for lower case
CAIGE C,"Z"+40 ;
JRST [CAIG C,"Z" ;check for upper case
CAIGE C,"A" ;
JRST .+1
JUMPE X,UPDPRC
JRST UPDCC2] ;Upper case being flagged
JUMPG X,UPDPRC ;lower case not being flagged
JRST UPDCC2] ;lower case is being flagged
CAIGE C,40 ;Real printing character
CAIN C,.CHESC ;ESCAPE prints as $
JRST UPDPRC ;so treat like printing character
CAIE C,15 ;assume uparrow'ed if not <CR> or <LF>...
CAIN C,12 ;
JRST UPDCAD ;Treat like it is
CAIN C,11 ; ... or <TAB>
JRST UPDCAD ;
UPDCC2: MOVE X,ETVAL ;[21000] See if simulating
TXNE X,ET$EXT ;[21000] Image mode
PJRST UPDCAD ;[21000] Yes, do it like it is
PUSHJ P,UPDPRC ;advance 1 print position,
PJRST UPDPRC ;and another print position
;UPDCAD [12000] Update cursor address (ROW, COL & possibly SCFWD)
; due to having typed a character on the screen
; CALL: MOVEI C,CHARACTER
; PUSHJ P,UPDCAD
; (return with things updated)
UPDCAD: CAIL C,177 ;do nothing with rubout or greater
POPJ P,
CAIL C,40 ;check for control character
JRST UPDPRC ;it was a printing character
CAIN C,15 ;Carriage return?
JRST [SKIPN EOL ;[21000] not if anything to type there
SETZM COL ;go to column 0
POPJ P,] ;and return
CAIN C,12 ;Linefeed?
JRST [SKIPE X,DPYALL ;[21000] do we have to allow for a marker char
JRST [ADDB X,COL ;[21000] Yes, do it
PUSHJ P,UPDPC0 ;[21000] and allow for a stray CRLF
JRST UPDEOL] ;[21000]
UPDEOL: AOS ROW ;next line
MOVE X,DMODE ;Check for NEWLINE mode
SKIPN EOL ;[21000] EOL is assumed to do both
TXNE X,DM$NL ;if set, assume <CR> also
SETZM COL ;IN NEWLINE MODE
JRST UPDCRO] ;check for scroll happening
CAIN C,9 ;TAB?
JRST [PUSHJ P,TABSTP ;[21000] Find next one
MOVEM X,COL ;[21000] We're there
JRST UPDPC0] ;[21000] adjust for it
HRROS COL ;disable checking, we don't know what
POPJ P, ;this character does anyway
UPDPRC: AOS X,COL ;increment column, then check for right margin
UPDPC0: CAMGE X,WIDTH ;if over, do something about it
POPJ P, ;it wasn't so don't worry about it
SETZM COL ;Assume somebody typed a CRLF
AOS ROW ;Go to next row
MOVE X,DMODE ;Check for auto crlf by terminal or something
TXNN X,DM$ACR ;if set, we don't do free CRLFs
TLO C,1 ;Set the bit so somebody might
;
;UPDCRO - enter here with ROW & COL set up to adjust for scrolling
; that might have occurred
UPDCRO: MOVE X,LENGTH ;check the row for scrolling
CAMLE X,ROW ;if greater than length of screen
POPJ P, ;it wasn't
SOJL X,[SETZM ROW ;Terminal does not scroll (goes to top?)
POPJ P,]
MOVEM X,ROW ;say we're at the bottom line
AOS SCFWD ;and just scrolled
POPJ P,
; TABSTP -- Find next TAB stop & return it in X
; CALL: PUSHJ P,TABSTP
; (return) with column of next tab stop in X
TABSTP: PUSH P,N ;[21000] Save this
MOVSI N,1-C$NTS ;[21000] AOBJN for # of tab stops
TABST0: MOVE X,TSTOPS(N) ;[21000] Get one
CAMLE X,COL ;[21000] Is this the one?
JRST TABSTZ ;[21000] Yes, return it
AOBJN N,TABST0 ;[21000] No, try next one
MOVE X,COL ;[21000] no more, stay here
TABSTZ: POP P,N ;[21000] Restore this
POPJ P, ;[21000] & Return
>;; 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
CHKSCB: CAIE C,"_" ;[10000] _ and & OK in BLISS
CAIN C,"&" ;[10000]
JRST CPOPJ1 ;[10000]
JRST CHKSC
CHKSCA: CAIN C,"." ;[10000] . OK in MACRO
JRST CPOPJ1 ;[10000] Unless we are in BLISS mode
CHKSC: CAIE C,"%" ;[10000] Percent sign ok
CAIN C,"$" ;[10000] Dollarsign too
JRST CPOPJ1 ;[10000]
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
CAIN C,.CHLFD ;[12000] LF always wins
JRST CPOPJ1 ;[12000]
MOVE X,EDVAL ;[11000] Check ED value
TXNE X,ED$LLL ;[11000] If set FF is not line terminator
POPJ P, ;[12000] NO
MOVE X,EOVAL ;[12000] Check EO value too
SOJE X,CPOPJ ;[12000] EO=1 means linefeeds only also
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: MOVE X,[.PTMAX,,PATHB];[3000][340] LOAD LENGTH AND ADDRESS OF PATH
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
;[12000] Page out DDT & Symbol table
; Call: PUSHJ P,POSSYM
; (only return)
FOR TOPS10,< ;[21000] Can't do this on TOPS-20 so don't try
POSSYM: SKIPN T1,.JBSYM ;[12000] Symbol table addr & len
POPJ P, ;[12000] no symbols loaded
PUSHJ P,POSSUM ;[12000] put those pages out
SKIPN T1,.JBDDT ;[12000] do DDT
POPJ P, ;[12000] no DDT
HLRZ T2,T1 ;[12000] get # of pages for DDT
SUBM T1,T2 ;[12000] into T2
HRLM T2,T1 ;[12000]
PJRST POSSUM ;[12000] Page it out
;[12000] POSSUM -- Page out some pages
;Call MOVE T1,[-LEN,,ADDR] (in words)
; PUSHJ P,POSSUM
; (only return) ;will not complain if can't page out as requested
POSSUM: TLZ T1,777 ;[12000] convert to pages
ASH T1,-9 ;[12000]
POSPGS: MOVEI T4,(T1) ;[12000] Page it out
MOVEI T2,T3 ;[12000] addr of argument block (in AC's)
MOVEI T3,1 ;[12000] Swap a page in or out
TLO T4,400000 ;[12000] OUT
PAGE. T2, ;[12000] do it
JFCL ;[12000] We tried
AOBJN T1,POSPGS ;[12000] loop back
POPJ P, ;[12000] done
>;END FOR TOPS10
; 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$???+(BID or ADRREF)
; MOVE T3,VALUE
; 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
JUMPE T2,QSTOR1 ;[23000] Any text in q-reg?
TXNN F,F$REF ; IS ADRREF A TEXT BUFFER ID?
JRST QSTOR1 ; NO
; MUST ADD TEXT BUFFER TO THE LINKED LIST AND GET ITS ID
MOVEI L,(T2) ; FETCH THE ADR OF REFERENCE
PUSHJ P,ADDBLK ; ADD THE BLOCK TO THE LINKED-LIST
HRRI T2,(N) ; AND RETURN THE TEXT-BUFFER ID
;[12000] Check for short name, or blank (THE TEXT BUFFER)
QSTOR1:
TDNN T1,[007777,,777777] ;[22000] See if short name
JRST [JUMPE T1,[PUSH P,T3 ;numeric value to .
TXNN T2,QB$BID ;Check for text q-register
JRST QSTR1A ;no text, leave buffer alone
SETZ L,
MOVEI N,(T2) ;Yes, find it
PUSHJ P,FNDBLK
ERROR(BNF) ;OOPS
MOVX T2,TB$BUF ;Set text buffer flag
HLLM T2,T$BIT(T1) ;in buffer header &clr others
EXCH T1,TXTBUF ;Point to text buffer
HLLZS B$4PTR(T1) ;zero old back pointer
HRRZS N,T$BID(T1) ;Get old BID and clear flags
PUSHJ P,DELBLK ;Get rid of it
MOVEI L,TXTBUF ;Save reference
MOVE T1,TXTBUF ;Get back new buffer
HRRM L,B$4PTR(T1)
QSTR1A: POP P,T3 ;[12000] Get numeric val back
CAMLE T3,@TXTBUF ;[12000] Check . value
SETZ T3, ;[15000] out of range
MOVEM T3,PTVAL ;[12000] Store it, it's OK
JRST QSTOR3] ;Restore ACs & return
LDB T5,[350700,,T1] ;[23000] Get q-register index
ADDI T5,QREG-1 ;[23000] Make address
JRST QSTREX] ;[23000] Save in existing q-reg
; NOW SEE IF THE Q-REGISTER ALREADY EXISTS
PUSHJ P,QFIND ; SEE IF THE Q-REGISTER EXISTS
JRST QSTOR2 ; NO, CREATE A NEW Q-REGISTER
; STORE NEW VALUES IN EXISTING Q-REGISTER
QSTREX: MOVE X,Q$BIT(T5) ; SAVE OLD Q-BITS
HRRZ N,Q$PTR(T5) ; SAVE OLD Q-ID
MOVEM T2,Q$BIT(T5) ; SET NEW Q-BITS/Q-ID
MOVEM T3,Q$VAL(T5) ; SET NEW Q-VALUE
TXNE X,QB$BID ; 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
TDNN T1,[007777,,777777] ;[22000] Single letter?
JRST [JUMPE T1,[MOVX T2,QB$BID ;[12000] It contains both
HRR T2,TXTBUF ;[12000] Get addr of buffer
HRR T2,T$BID(T2) ;[12000] Get buffer ID
MOVE T3,PTVAL ;[12000] . is numeric value
JRST CPOPJ1] ;[12000] win
LDB T2,[350700,,T1] ;[22000] Get the index
MOVE T3,QREG+<Q$VAL-Q$BIT>(T2) ;[22000] Get the value
MOVE T2,QREG(T2) ;[22000] And the bid/bits
JRST CPOPJ1]
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
;This will not find the text buffer
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: JUMPE T1,CPOPJ ;[14000] Nothing to do
JUMPL T1,MKRM1 ;[13000] need never expand if deleting
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 N,@TXTBUF ; fetch # chars in text buffer
ADDI N,4(T1) ; plus # chars requested
IDIVI N,5 ; CONVERTED TO WORDS
SUB 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 12,15 ; AC12:=-(REM(REQ/5))*7
MOVEI 15,-43(15) ; AC15:=(REM(REQ/5))*7-43
MOVE 10,PTVAL ; PT (CURRENT BUFFER POSITION)
IDIVI 10,5 ; AC10:=Q(PT/5) , AC12:=REM(PT/5)
ADD 10,TXTBUF ; MAKE AC10 AN ABSOULUTE ADR
MOVEI 10,T$DATA(10) ; . . .
MOVNI 16,-5(11) ; AC11:=-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(10) ; 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,10 ; T2:=Q(Z/5)+1-Q(PT/5)=# WORDS TO MOVE
; PUT SHIFT ROUTINE IN FAST ACS
HRLI 10,(MOVE T2,0(T4)) ; AC10:=MOVE T2,[Q(PT/5)](T4)
HRLOI 11,(ROT T2,0) ; AC11:=ROT T2,-1
HRLI 12,(ROTC T2,0) ; AC12:=ROTC T2,-(REM(REQ/5))*7
MOVE 13,[TRZ T3,1] ; AC13:=TRZ T3,1 ;[14000] Clear LSN bit
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,10 ; T2:=T2-1. DONE?
; SHIFT IS ALMOST FINISHED
MKRM2: PORTAL .+1 ;[316] BACK FROM FAST ACS
ROTC T2,43(12) ; 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"
ADDI 11,<T$DATA*5>+4 ;[21000] Don't shift someone else
IDIVI 11,5 ; AC11:=Q(Z/5) , AC12:=REM(Z/5)
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)
;
; CLOBBERS AC X
;[12000] Saves AC L. This is the same AC as SARG and we want to allow
; all arguments to pass through $PUSH & $POP
REFBLK: PUSH P,L ;[12000] Save AC L
SETZ L, ; T1 WILL POINT TO BLOCK
PUSHJ P,FNDBLK ; FIND THE BLOCK WITH SPECIFIED ID
SKP ; NONE. RETURN TO CALLER
AOS T$RCNT(T1) ; ADD ONE TO THE REFERENCE COUNT
POP P,L ;[12000] Restore AC L
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
;[12000] Searches LNKLST backwards (most recently created first)
FNDBLK: SKIPN T1,LNKLST+1 ;[12000] ANYTHING IN LINKED LIST?
POPJ P, ; NO, GIVE FAIL RETURN TO CALLER
; FIND THE BLOCK GIVEN ITS ID
FNDBK1: CAIN T1,LNKLST ;[12000] AT END OF LIST?
POPJ P, ; YES, GIVE UP AND GIVE FAIL RETURN TO CALLER
HRRZ X,T$BID-B$2PTR(T1) ;[12000] FETCH ID OF THIS BLOCK
CAIN X,(N) ; IS THIS THE ID WE WANT?
JRST FNDBK2 ; YES
HRRZ T1,-1(T1) ;[12000] NO, FETCH POINTER TO NEXT BLOCK IN LIST
JUMPN T1,FNDBK1 ; [14000] Check for non-zero AND TRY IT
ERROR (LLB) ;[14000] Linked list is broken
; FOUND BLOCK WITH SPECIFIED ID. SET UP REFERENCE TO IT
FNDBK2: MOVEI T1,C$NREF-1(T1) ;[12000] 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
HALT .+1 ;[20000] Shouldn't happen ever
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
; MOVEI T5,ADDR OF NEXT BLOCK
; JSP L,FIXREF
; (RETURN)
;
; SMASHES ACS X,T1,T2. USES AC T3,T5
FIXREF: JUMPE T3,(L) ; RETURN IF RELOC.CONSTANT=ZERO
MOVEI T2,(T4) ;[14000] Make AOBJN pointer in temp AC
HRLI T2,-C$NREF ; MAKE AOBJN POINTER FOR LOOPING
JRST FIXRF2 ; AND JUMP INTO LOOP FOR FIRST REF
FIXRF1: HLRZ T1,(T2) ; FETCH ADR OF LH REF
JUMPE T1,FIXRF2 ; NONE. TRY RH
HRRZ X,(T1) ; FETCH THE CONTENTS OF REF
CAIGE X,(T5) ;[14000] Check this 'ref'
CAIGE X,(T4) ;[14000] Does it point to this block at all??
JRST [HRRZS (T2) ;[14000] NO!!! It's bogus, get rid of it!
JRST FIXRF2] ;[14000] Try next one.
SUBI X,(T3) ; RELOCATE IT
HRRM X,(T1) ; AND RESTORE IT
FIXRF2: HRRZ T1,(T2) ; FETCH ADR OF RH REF
JUMPE T1,FIXRF3 ; NONE. TRY NEXT WORD
HRRZ X,(T1) ; FETCH CONTENTS OF REF
CAIGE X,(T5) ;[14000] Check this 'ref'
CAIGE X,(T4) ;[14000] Does it point to this block at all??
JRST [HLLZS (T2) ;[14000] NO!!! It's bogus, get rid of it!
JRST FIXRF3] ;[14000] See if any more
SUBI X,(T3) ; RELOCATE IT
HRRM X,(T1) ; AND RESTORE IT
FIXRF3: AOBJN T2,FIXRF1 ; LOOP FOR ALL REFERENCE WORDS
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,EXPREF ; EXPREF WILL REFERENCE THE ANNEX BLOCK
SETZM EXPREF ; EXPREF WILL POINT TO FIRST DATA WORD
PUSHJ P,REQM ; ALLOCATE THE ANNEX BLOCK
POP P,L ; RESTORE AC L
MOVE T2,EXPREF ; 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,EXPREF ; ADR OF REF TO NEW BLOCK
SETZM EXPREF ; 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,EXPREF ; 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,-1(T2) ;[12000] BLT !!ONLY!! THE OLD BLOCK TO NEW
; FIX UP THE REFERENCES TO NEW BLOCK
MOVE T2,EXPREF ; FETCH ADR OF NEW BLOCK
SUBI T2,(T1) ; COMPUTE REFERENCE RELOCATION CONSTANT
HRLI T1,-C$NREF ; MAKE AOBJN POINTER FOR LOOP
HLRZ T5,B$1PTR(T1) ;[20000] Fetch add of blk after old one
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
HRRZ T3,(X) ; FETCH CONTENTS OF REF
CAIGE T3,(T5) ;[20000] Is the ref for real??
CAIGE T3,B$1PTR-C$NREF(T1) ;[20000] ... (not a definitive test)
JRST EXPAN3 ;[20000] It's bogus! skip it
ADDI T3,(T2) ; AND RELOCATE IT
HRRM T3,(X) ; AND RESTORE IT
HRLM X,B$1PTR(T4) ; AND REF TO NEW BLOCK
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
HRRZ T3,(X) ; FETCH CONTENTS OF REF
CAIGE T3,(T5) ;[20000] Is the ref for real??
CAIGE T3,B$1PTR-C$NREF(T1) ;[20000] ... (not a definitive test)
JRST EXPAN4 ;[20000] It's bogus, skip it
ADDI T3,(T2) ; RELOCATE IT
HRRM T3,(X) ; AND RESTORE CONTENTS
HRRM X,B$1PTR(T4) ; ADD REF TO NEW BLOCK
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 17,ACSAVE+17 ; SAVE AC 17
MOVEI 17,ACSAVE ;[12000] Build BLT argument
BLT 17,ACSAVE+16 ;[12000] don't save 17 again but save all others
MOVE 17,ACSAVE+17 ;[12000] restore it instead
; Find out what hit us
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 **
; 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
;[15000] Loses if run a saved XTEC program & restart & LOSEG name different
; 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:
FOR TOPS10!TOPS20,<
CLRBFI ; CLEAR TYPE-AHEAD
>
ECHO ON ;[21000] Turn echo on, regardless
MOVEI C,"?" ; MESSAGE STARTS WITH A "?"
ERRH1: PUSH P,N ; SAVE AC N
PUSH P,M ; AND AC M
PUSH P,C ;[12000] Save the prefix character
MOVEI N,ERRPRE ;[12000] Error message prefix characters
PUSHJ P,TXSTR ;[12000] with no reformatting
POP P,C ;[12000] Get back the prefix character
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: 'TEC???')
HRRZ N,.JBUUO ; FETCH '???' OF THE ERROR CALL
CAIN N,'ILM' ;[420] ILL MEM REF?
SETZM PTVAL ;[420] .:=0
HRLI N,'TEC' ; FETCH THREE CHAR ABBREV. FOR NAME
PUSHJ P,TSIX ; AND TYPE THE PREFIX ('TEC???')
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
IFE FTXTEC&FTXTCERR,<
MOVE X,[ERRSEG:<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
>
IFN FTXTEC&FTXTCERR,<
PJRST ERMT
>
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
MOVE X,ETVAL ;[12000] Check abort flag (initially set)
TXNE X,ET$ABO ;[12000] Go to monitor if set
JRST [PUSHJ P,FOUT ;[20000] Make sure he sees the message
MONRT. ;[20000] STOP
JRST .+1] ;[20000] he musta typed continue
ERRH94: MOVEI N,PROMPT ; TYPE FAKE PROMPT CHAR
PUSHJ P,TXSTR ; . . .
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: MOVEI N,ERRPOS ;[12000] Output the error posfix characters
PUSHJ P,TXSTR ;[12000] with no reformatting
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 C,.CHBEL ;[14000] ^G stops us even in a warning
JRST [SETZM INPCHR ;[14000] This is not command input
MOVEI X,OUT ;[20000] Flush output file?
TXNN F,F$UWR ;[20000] Unless there is supposed to be one
RESDV. X, ;[20000] ...
JFCL ;[20000] ....
JRST ERRREC] ;[14000] Go back to command level
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
;[14000] Leave the poor Q-register PDL alone!
; 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
JRST BEGIN ;[13000] Sometimes, you can't trust
;[13000] even the base of the stack
; (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:
TXNE F,F$CMP ;[4000] WERE WE COMPILING?
;[4000] 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 text up to error [12000] FOR A COMPILATION ERROR
ERRCTC: PUSHJ P,CURCHA ; FETCH CURRENT POSITION IN COMMAND STRING
MOVEI T4,-T$DATA*5(T1);[12000] Character count is all but ovhd words
MOVE T1,[POINT 7,T$DATA] ;[12000] Pointer to start of buffer
ADD T1,@CMDBUF ;[12000] once we add in the address, that is
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
CAIG C,172 ;[12000] Any SIXBITable character will do
CAIGE C,40 ;[12000]
JRST SAVOOPS ;[12000] no good
SAVPC1: CAIL C,140 ;[14000] Make upper case if necessary
MOVEI C,-40(C) ;[14000] it was...
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
PUSHJ P,QGET ;[12000] fetch old one if any
SETZB T2,T3 ;[12000] none there
TXO T2,QB$BID ; SET THE "BID" BIT
HRR T2,CMDBID ;[12000] BID moved ; FETCH THE BUFFER ID
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 ")"?
SAVOOPS: ERROR (IQR) ;[20000] no good, but he can try again
JRST SAVPC2 ; YES, CONTINUE
>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
SUBTTL Phased (sometimes) Pure Low Segment Code
RELOC 0 ; DOWN TO THE LOW SEGMENT
LOCODE: ; DEFINE WHERE LOW SEGMENT CODE GOES
IFN TOPS10,< ; No Performance Advantage to this on a 20
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 17,ACSAVE+17 ; SAVE AC 17
MOVEI 17,ACSAVE ; Set up BLT pointer
BLT 17,ACSAVE+16 ; SAVE ALL ACS
RUNENT: TDZA X,X ;[15000] Not CCL entry
MOVX X,<F$CCL> ;[15000] It is a CCL entry
IORM X,ACSAVE ;[15000] Set it if we entered that way
; it will not be cleared if we didn't
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,< NOTFOR FTXTEC&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
MOVEI N,SEGERR ;[364] TYPE ERROR MESSAGE
PUSHJ P,TXSTR ;[16000] Type in correct order, please
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/
IFNDEF $GCHRW,<$GCHRW==<$GCHR0==0>> ;This is for TECERR
INTRPT: ;[20000] (next 20 lines) .JBINT sent us here
EXCH X,INTBLK+3 ; Look at bits
TLNE X,777775 ; Anything but ^C?
ERROR (XXX) ; CHOKE
MOVE X,ETVAL ; Are we supposed to care about this?
TXZN X,ET$CCT ; ...
JRST INTRPN ; program doesn't want it
MOVEM X,ETVAL ; program does, in fact.
HRRZ X,INTBLK+2 ; See if we are waiting for ^T
CAIN X,$GCHRW ; ...
MOVEI X,$GCHR0 ;[20000] Re-try the held character
HRRM X,INTBLK+2 ;[20000] by backing up a bit...
MOVEI X,3 ; And stuff a ^C in there
MOVEM X,INPCHR ; This way so non-blocking ^T works too.
INTRPZ: EXCH X,INTBLK+3 ; Restore AC
JRST @INTBLK+2 ; Continue execution
INTRPN: MONRT. ; Stop here
JRST INTRPZ ; continue execution
;note that the block is not zeroed, so we won't come here again
;unless he sets 32768ET again
GSGBLK: ; ARG BLK FOR GETSEG MUUO
GSGDEV: FOR TOPS10,0 ; THE DEVICE NAME
FOR TOPS20,'SYS '
GSGNAM: FOR TOPS10,0 ; THE SEGMENT NAME
FOR TOPS20,'TECO20'
GSGLOW: 0 ; FILE EXTENSION FOR LOW FILE
0 ; WE DON'T USE THIS
GSGPPN: 0 ; THE SEGMENT PPN
0 ; WE DON'T USE THIS
GSGPAT: REPEAT .PTMAX,<0> ;[15000] GETSEG path block
; TEMP STORAGE FOR GETSEG ROUTINE
SADSAV: BLOCK 1 ; SAVE AREA FOR .JBSA
RENSAV: BLOCK 1 ; SAVE AREA FOR .JBREN
;Interrupt block for .JBINT
INTBLK: BLOCK 4 ;[20000]
TSTOPS: EXP 10,20,30,40,50,60,70,100,110,120,130,140,150,160,170,200
REPEAT <C$NTS-<.-TSTOPS>>,<Z> ;[21000] Tab stops go here
LOCEND==. ; DEFINE END OF LOWSEGMENT CODE
FOR TOPS10,<
DEPHASE ; BACK TO HISEG RELOCATABLE CODE
>
SUBTTL Impure Low Segment Data
IFN TOPS10,<
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
EXPREF: BLOCK 1 ;[12000] TEMP REF FOR EXPAND
TXREF: BLOCK 1 ;[12000] TEMP REF FOR $X
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
LRPSPC: BLOCK FS$LTH ; LAST "E&" 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
EDVAL: BLOCK 1 ;[12000] ED flags
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
;[23000] Permanent Q-register table
QREG: BLOCK <100*2> ;[23000] Single-letter q-registers
; THE MAIN TEXT EDITING BUFFER
TXTBUF: BLOCK 1 ; POINTER TO THE MAIN TEXT EDITING BUFFER
PTVAL==QREG+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
SARGSV==ACSAVE+SARG ;[3000] PLACE TO SAVE SARG SO IT CAN BE PASSED TO A MACRO
DELIM: BLOCK 1 ;[12000] Default text delimiter
CDELIM: BLOCK 2 ;[12000] command delimiter (up to 2 chars, unpacked)
CWVEC: ;[12000] :W stuff starts here
WFLAGS: BLOCK 1 ;[12000] :W flags
WIDTH: BLOCK 1 ;[12000] Width of terminal
LENGTH: BLOCK 1 ;[12000] Length of terminal
DPYALL: BLOCK 1 ;[12000] 'DISPLAY ALL' mode
MARK: BLOCK 1 ;[12000] MARK pointer value
HOLD: BLOCK 1 ;[12000] scroll if within n lines of border
F0:
WINB: BLOCK 1 ;[14000] Start of window
BLOCK 12 ;[14000] Reserved
DMODE: BLOCK 1 ;[12000] Display mode bits
SCFWD: BLOCK 1 ;[10000] # of linefeeds typed at bottom
SCREV: BLOCK 1 ;[12000] # of reverse
PROMSZ: BLOCK 1 ;[14000] # of character positions for prompt
RLF: BLOCK 1 ;[12000] Reverse linefeed character
WIPEC: BLOCK 2 ;[12000] Delete a character
EOL: BLOCK 2 ;[12000] What to type at end of line
TTAB: BLOCK 2 ;[13000] Tab simulation
WIPEL: BLOCK 1 ;[12000] Clear to end of line
WIPES: BLOCK 1 ;[12000] Clear to end of screen
HOME: BLOCK 1 ;[12000] Go to top of screen
CFWD: BLOCK 2 ;[12000] Forward-space
ERRPRE: BLOCK 4 ;[12000] Prefix to error messages
ERRPOS: BLOCK 4 ;[12000] Postfix to error messages
CAD: BLOCK 1 ;[12000] Direct cursor addressing
PROMPT: BLOCK 4 ;[12000] The prompt characters
BRKFLG: BLOCK 1 ;[12000] Enable breakpoints if negative
TARCMD: BLOCK 4 ;[14000] Type after every command
DEFARG: BLOCK 1 ;[15000] Default argument
TNULL: BLOCK 2 ;[15000] Type this for nulls
TTABND: BLOCK 1 ;[16000] Put this at the end of tabs
CWMAX==<.-CWVEC> ;[14000] Maximum legal arg to :W
TOOBLK: ;[12000] TRMOP. output block. DO NOT CHANGE THE ORDER OF THE NEXT 3
TOOFUN: BLOCK 1 ;[12000] TRMOP. block for output
OURTTY: BLOCK 1 ;[12000] Our TTY #
TOOADR: BLOCK 1 ;[12000] Argument to TRMOP. (addr of buffer)
ROW:
FY: BLOCK 1 ;[12000] Row cursor is in
COL:
FX: BLOCK 1 ;[12000] Column...
;WINB was moved into the CWVEC (6:W) for PDP-11 compatability
WINZ:
FZ: BLOCK 1 ;[12000] End of window
TTOPTR: BLOCK 1 ;[12000] Terminal output byte ptr
TTOBUF: BLOCK C$OBFL ;[12000] Terminal output buffer
TTOEND: BLOCK 1 ;[12000] 1 word of overdraw (no count needed)
LOWEND==.-1 ; DEFINE END OF IMPURE LOWSEGMENT DATA
RELOC ; BACK TO HISEG RELOCATABLE
LIT
; PATCHING SPACE
PAT: REPEAT C$PATL,<Z> ; PATCHING SPACE
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC, END XTEC ; *** THE END ***
FOR FTXTCERR, NOTFOR FTXTEC, END ; *** THE END ***