SUBTTL Text Editor and COrrector RC CLEMENTS/PMH/CAM/JMP/GSB/RCM/CBD/JCS/Nothead
SUBTTL Introduction
;Version number
TECVER==124
TECMIN==1
TECEDT==355
TECWHO==2
SEARCH JOBDAT,MACTEN,UUOSYM ;UNIVERSAL FILES
.DIRECTIVE .XTABM ;TENEX STYLE MACRO'S
TWOSEG 400K ;TWO SEGMENTS
SALL
SHOW. %%JOBD ;JOBDAT VERSION NUMBER
SHOW. %%MACT ;MACTEN VERSION NUMBER
SHOW. %%UUOS ;UUOSYM'S VERSION NUMBER
;COPYRIGHT 1970,1971,1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
;COPYRIGHT 1975 SNEVETS CORP.,BOHOKEN, J.N.
;COPYRIGHT 1976 ARMADILLO U., AUSTINTATIOUS, USA
;Copyright 1978 Privateer U, Bourbon Strut, Nude Oleander, Lousyanna
IFN 0 <
THE FOLLOWING SYMBOL IS USED BY THE 'EE' COMMAND CONTINUE ROUTINE
TO DECIDE WHETHER THE VERSION OF TECO.SHR THAT IT GOTSEG WILL WORK
PROPERLY WITH THE LOW FILE THAT GOTSEG IT. IT MUST BE INCREMENTED
EVERY TIME THE LOW SEGMENT OF TECO IS ALTERED >
XP %TECOV, 26
LOC .JBVER
VRSN. TEC ;VERSION NUMBER
LOC .JBREN
EXP REE ;REENTRY ADDRESS
RELOC 400K
SUBTTL Table of Contents
; Table of Contents for TECO
;
;
; Section Page
;
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents . . . . . . . . . . . . . . . . . . 2
; 3. REVISION HISTORY . . . . . . . . . . . . . . . . . . . 3
; 4. MACRO DEFINITIONS
; 4.1 .CLNAM . . . . . . . . . . . . . . . . . . . . 4
; 4.2 CHKEO, ERROR . . . . . . . . . . . . . . . . . 5
; 5. DEFAULT ASSEMBLY PARAMETERS . . . . . . . . . . . . . 6
; 6. ACCUMULATOR ASSIGNMENTS . . . . . . . . . . . . . . . 7
; 7. CONTROL FLAGS
; 7.1 AC FF . . . . . . . . . . . . . . . . . . . . 8
; 7.2 AC F2 . . . . . . . . . . . . . . . . . . . . 9
; 8. I-O CHANNELS . . . . . . . . . . . . . . . . . . . . . 10
; 9. MISC PARAMETERS . . . . . . . . . . . . . . . . . . . 11
; 10. PSEUDO RUN UUO IF NEEDED . . . . . . . . . . . . . . . 12
; 11. STARTUP TIME INITIALIZATION . . . . . . . . . . . . . 13
; 12. TEXT BUFFER INITIALIZATION . . . . . . . . . . . . . . 15
; 13. REENTER COMMAND . . . . . . . . . . . . . . . . . . . 16
; 14. INITIALIZATION OF JOB DEPENDENT PARAMETERS . . . . . . 17
; 15. CCL Command processor . . . . . . . . . . . . . . . . 18
; 16. RETURN NON-NULL TTY CHARACTER IN CH. . . . . . . . . . 22
; 17. TYPE A CHARACTER. . . . . . . . . . . . . . . . . . . 24
; 18. MESSAGE TYPE-OUT & NUMBER TYPE-OUT . . . . . . . . . . 27
; 19. RETURN NEXT COMMAND CHAR AT CURRENT LEVEL . . . . . . 29
; 20. SCAN COMMAND STRING FOR CHARACTER IN TT . . . . . . . 30
; 21. SKAN ROUTINE DISPATCH TABLES . . . . . . . . . . . . . 33
; 22. ACCEPT COMMAND STRING ROUTINE . . . . . . . . . . . . 35
; 23. EXPAND THE COMMAND BUFFER . . . . . . . . . . . . . . 37
; 24. PROCESS SPECIAL COMMAND EDITING CHARACTERS . . . . . . 39
; 25. BACK UP BYTE POINTER IN AA, LOAD APPROPRIATE CHARACT . 41
; 26. SPECIAL "IMMEDIATE" COMMAND PROCESSOR . . . . . . . . 42
; 27. RUBOUT PROCESSOR . . . . . . . . . . . . . . . . . . . 44
; 28. VIDEO RUBOUT PROCESSOR . . . . . . . . . . . . . . . . 46
; 29. COMMAND DECODER . . . . . . . . . . . . . . . . . . . 50
; 30. NUMERIC INPUT, VALRET, & ALTMODE PROCESSOR . . . . . . 51
; 31. COMMA & PARENTHESES PROCESSOR . . . . . . . . . . . . 52
; 32. MATHEMATICAL & LOGICAL OPERATORS . . . . . . . . . . . 53
; 33. FLAGS - EOF, FORM FEED & . H Z POSITIONS . . . . . . . 54
; 34. = & ^T COMMANDS . . . . . . . . . . . . . . . . . . . 55
; 35. ^H, ^F AND ^^ COMMANDS . . . . . . . . . . . . . . . . 56
; 36. EXTENDED ^T OPERATIONS . . . . . . . . . . . . . . . . 57
; 37. BACKSLASH PROCESSOR . . . . . . . . . . . . . . . . . 58
; 38. nA COMMAND . . . . . . . . . . . . . . . . . . . . . . 59
; 39. Q-REGISTER COMMANDS
; 39.1 U & Q . . . . . . . . . . . . . . . . . . . . 60
; 39.2 % . . . . . . . . . . . . . . . . . . . . . . 62
; 39.3 X . . . . . . . . . . . . . . . . . . . . . . 63
; 39.4 G . . . . . . . . . . . . . . . . . . . . . . 65
; 39.5 M, W, [ & ] . . . . . . . . . . . . . . . . . 66
; 40. MISCELLANEOUS CHARACTER DISPATCHER . . . . . . . . . . 67
; 41. ^G COMMAND (GETTAB OR EXIT) . . . . . . . . . . . . . 68
; 42. E COMMANDS
; 42.1 DISPATCH ROUTINE & TABLE . . . . . . . . . . . 69
; 42.2 EL (SETUP AND OUTPUT ROUTINES) . . . . . . . . 70
; 42.3 EE (SAVE TECO'S STATE) . . . . . . . . . . . . 72
; 42.4 NEL & EE (LOW CORE) . . . . . . . . . . . . . 74
; 42.5 EE (RESTART CODE) . . . . . . . . . . . . . . 75
; 42.6 EI & EP (EDIT INSERT & EDIT PUT) . . . . . . . 76
; 42.7 EX & EXIT ROUTINES . . . . . . . . . . . . . . 80
; 42.8 ED (RUN UUO ON EXIT) . . . . . . . . . . . . . 82
; 42.9 ET, EO & EU . . . . . . . . . . . . . . . . . 83
; 42.10 ES . . . . . . . . . . . . . . . . . . . . . . 84
; 42.11 EH (CHANGE ERROR MESSAGE LEVEL) . . . . . . . 85
; 42.12 EV (SET TERMINAL CHARACTERISTICS) . . . . . . 86
; 42.13 TERMINAL CHARACTERISTICS TABLES . . . . . . . 88
; 42.14 EK (KILL) AND EN (RENAME) . . . . . . . . . . 90
; 42.15 ER (PREPARE TO READ A FILE) . . . . . . . . . 91
; 42.16 FILE SPEC SETUP . . . . . . . . . . . . . . . 93
; 42.17 EB (EDIT BACKUP PROCESSOR) . . . . . . . . . . 94
; 42.18 I/O ERROR ROUTINES . . . . . . . . . . . . . . 97
; 42.19 EW (EDIT WRITE) . . . . . . . . . . . . . . . 98
; 42.20 EZ & EF . . . . . . . . . . . . . . . . . . . 102
; 42.21 EM (MTAPE UUO'S) . . . . . . . . . . . . . . . 103
; 42.22 EB (FINISH UP COMMAND) . . . . . . . . . . . . 104
; 42.23 EW (SUBROUTINES FOR EW) . . . . . . . . . . . 107
; 42.24 MISC. ROUTINES . . . . . . . . . . . . . . . . 108
; 43. ^V, ^W, ^X COMMANDS . . . . . . . . . . . . . . . . . 110
; 44. ROUTINE TO PARSE FILE DESIGNATOR . . . . . . . . . . . 111
; 45. TABLES FOR FILSPEC PARSER . . . . . . . . . . . . . . 115
; 46. Y . . . . . . . . . . . . . . . . . . . . . . . . . . 118
; 47. ^Y ! ^P - QUICK PAGE SCAN COMMANDS . . . . . . . . . . 120
; 48. READ A CHARACTER FROM INPUT FILE . . . . . . . . . . . 121
; 49. INSERT COMMAND . . . . . . . . . . . . . . . . . . . . 122
; 50. ALPHA CASE CONVERTED . . . . . . . . . . . . . . . . . 126
; 51. CHECK FOR NON-CONTROL CHARACTERS . . . . . . . . . . . 127
; 52. NI . . . . . . . . . . . . . . . . . . . . . . . . . . 128
; 53. T COMMAND . . . . . . . . . . . . . . . . . . . . . . 129
; 54. V COMMAND . . . . . . . . . . . . . . . . . . . . . . 130
; 55. PUT A CHARACTER IN THE OUTPUT FILE . . . . . . . . . . 131
; 56. PW . . . . . . . . . . . . . . . . . . . . . . . . . . 135
; 57. NJ, NC, & NL COMMANDS . . . . . . . . . . . . . . . . 137
; 58. ROUTINE TO RETURN CURRENT ARGUMENT IN B . . . . . . . 138
; 59. ND . . . . . . . . . . . . . . . . . . . . . . . . . . 139
; 60. Searches
; 60.1 Commands . . . . . . . . . . . . . . . . . . . 140
; 60.2 pattern source setup . . . . . . . . . . . . . 141
; 60.3 set up search matrix . . . . . . . . . . . . . 143
; 60.4 New fast search routine . . . . . . . . . . . 158
; 60.5 Old slow but sure routine . . . . . . . . . . 161
; 60.6 pattern found . . . . . . . . . . . . . . . . 163
; 60.7 Autotype after succesful searches . . . . . . 164
; 60.8 Pattern not found in this buffer . . . . . . . 165
; 61. <> . . . . . . . . . . . . . . . . . . . . . . . . . . 167
; 62. OTAG$ . . . . . . . . . . . . . . . . . . . . . . . . 169
; 63. " ' PROCESSING . . . . . . . . . . . . . . . . . . . . 171
; 64. EXECUTE INDIVIDUAL " COMMANDS . . . . . . . . . . . . 172
; 65. ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z . . . . . 173
; 66. ERROR MESSAGE PRINTOUT . . . . . . . . . . . . . . . . 174
; 67. ROUTINE TO TYPE C(TT) IN SIXBIT . . . . . . . . . . . 179
; 68. ERROR PROCESSING ROUTINES . . . . . . . . . . . . . . 180
; 69. DISPATCH TABLE FOR SPECIAL INFORMATION TYPEOUT . . . . 181
; 70. SPECIAL INFORMATION TYPEOUT ROUTINES . . . . . . . . . 182
; 71. UUO HANDLER . . . . . . . . . . . . . . . . . . . . . 184
; 72. COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND . . 185
; 73. ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS. . 186
; 74. ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT O . 187
; 75. ROUTINES TO MOVE CHARACTERS AROUND . . . . . . . . . . 188
; 76. GARBAGE COLLECTOR . . . . . . . . . . . . . . . . . . 191
; 77. AUTOMATIC MEMORY EXPANSION . . . . . . . . . . . . . . 195
; 78. COMMAND DISPATCH TABLE . . . . . . . . . . . . . . . . 197
; 79. LOW SEGMENT . . . . . . . . . . . . . . . . . . . . . 198
SUBTTL REVISION HISTORY
COMMENT {
START OF VERSION 123A
205 FIX LOOPING EEE.
206 FIX FILE SPEC SCANNER WHEN TRACE MODE USED.
207 CHANGE CORE ERROR MESSAGE.
210 ADD ^G WITH NO ARGUMENT TO RETURN MY JOB NUMBER.
211 FIX :EP SO IT WORKS.
212 IMPLEMENT ^Y.
213 SO PEOPLE WITHOUT TECO.INI CAN ^G^G *I$$ FIRST COMMAND.
214 EI-EP SEES DEVICE.
215 NO TYPEOUT AFTER ^C^C REE.
216 EP[P,PN] INTERFERED WITH EB.
217 REMOVE FEATURE TO APPEND LOOKUP/ENTER/RENAME ERROR CODE TO PDL OV'S.
220 FIX RANDOM CORE MESSAGES FROM INI FILES.
221 INTERFACE TO JOBDAT.UNV AND CORRECT MISC BUGS.
A) FIX 'MAKE' OR 'TECO' FILE.'.' WORK CORRECTLY
B) SUPPORT SOS PAGE MARKS
C) SET TTY NO ALT COMPATIBLITY
D) DELAY IN CLEARING EB AND OUTPUT FLAGS ON EX
COMMAND IN CASE ERROR OCCURS IN PROCESSING
222 SEARCH MACTEN AS WELL AS JOBDAT
223 INTERFACE WITH MACTEN MORE COMPLETELY. CLEAN UP THE SUBTTLS AND
CHANGE NUMERICS TO BE THE INSTRUCTIONS
224 FIX ENTER ERROR 17'S FOR PEEPLE WHO HAVE FANCY DISK ALLOCATION
ON IN THE MONITOR.
225 FIX PROBLEM WITH U MACRO. ADD TED: AS THE DEFAULT DEVICE ON
AN EI OR EP COMMAND.
226 MAKE EP DEFAULT TO DSK: INSTEAD OF TED:
227 MAKE ERROR MESSAGE FINDER FASTER
230 FIX ^Y WITH NO ARG TO NOT THROW AWAY CURRENT PAGE
231 ADD USETI ON ER'D FILE FOR CONVENIENCE.
232 FIX EA TO WORK IF FILE NO EXIST, MAKE TE FILE[NOT ME] TO
WRITE FILE ON [DEFAULT]
233 PREVENT S^ES$ FROM ALLOWING "." TO ESCAPE THE TEXT BUFFER.
234 FIX :SEARCH IN AN ITERATION TO NOT LEAVE GARBAGE AROUND.
235 FIX PROBLEMS WITH TECENT-20 ERRORS. EXTENDED ENTER USED THE
SAME AREA AS DID THE SEARCH MATRIX. THEREFORE TO SOLVE
THE PROBLEM MAKE THAT AND THE DSKCHR BLOCK SEPERATE AREAS.
***START OF U. TX. REVISIONS**** (236-249 NOT USED;PATCHES ONLY,
SEE TEC124.DIF FOR NEW FEATURES)
250 INSTALLED DEBUG SWITCH TO SAVE SYMBOL TABLE AND READ TECO.ERR
FROM [-] RATHER THAN SYS:. (= DEC #140)
251 PATCH FOR LARGE Q-REG STACK (SPR # 13756)
252 DO AN INITIAL CORE UUO IF .JBFF > .JBREL-202 TO PREVENT
ILL MEM REF'S.
253 MAKE ^G IGNORE ET SETTING AND ALWAYS USE ARROW MODE
254 FIX ^ BUG (SPR # 18802)
255 FIX ILL Q-REG NAME (DEC EDIT # 170)
256 MAKE BYTE PTR. BACKUP MORE EFFICIENT
257 DONT LET EXTRA BLANKS IN AN ARITHMETIC EXPRESSION CAUSE TROUBLE
(DEC EDIT # 167)
260 MAKE SURE M,NP FLAGS BIT 35 OF FIRST SEQ. NUMBER.
REMOVE DEC #122 WHICH ONLY DID IT FOR HP.
261 MORE SEQ# FIXING: /SUPLSN NEEDS TO USE SLOW PUNCH ROUTINE
FILES PROCESSED BY SOS NO LONGER MESSED UP. INSTALL EQUIVALENTS
OF DEC #'S 115, 141, 150.
262 STILL MORE SEQ# FIXING: DON'T ALLOW NULL CHARACTERS IN FILE
(INTENDED FOR STARTING SEQ #'S ON WORD BOUNDARIES) IF /SUPLSN
IS SET.
263 ZERO DOUBLE ARG FLAG IN SEARCHES SO THAT SUBSEQUENT COMMANDS
DON'T GET CONFUSED.
264 FIX :FS...$$ SO IT RECOGNIZES DOUBLE ALTMODE. (SPR # 18199)
265 FIX GARBAGE COLLECTION BUG (DEC EDIT # 161)
266 FIX ?ILL COMMAND ^ (SPR # 18607)
NOTE: ALL DEC EDITS THROUGH 171 OR THEIR EQUIVALENTS ARE IN.
START OF VERSION 124
267 FIX ADDRESS CHECK ON LOOKUP OF TMP FILE WHEN TMPCOR FAILS.
270 MAKE UUO ERROR MSG TYPE ENTIRE INSTRUCTION (SPR#19879)
271 FIX GARBAGE COLLECTION FROM EC AND EP. Q-REGISTER STACK WASN'T
GETTING COLLECTED SINCE AC 17 CLOBBERED.
272 FIX ILL. UUO MSG AFTER .REENTER WHILE AC'S HAVE FAST CODE TO
MOVE CHARACTERS. FIX MINOR BUGS IN FILESPEC SCANNER AND /R.
273 MAKE EXTENDED CCL COMMAND STRING WORK WITH .TMP FILES
274 FIX ILL. UUO. BUG RIGHT THIS TIME...(EDIT 272 GOOFED).
275 FIX BAD ARG PROCESSING TO MAKE THINGS LIKE -1^F= AND
:5-1^T== AND -1A== WORK PROPERLY. FINALLY GET EI ARG
PROCESSING TO WORK PROPERLY. M,NEIFILE$ WORKS, AS WELL AS
MEIFILE$ AS WELL AS M,EIFILE$ (WHERE FILE HAS THE SECOND
ARG ALREADY).
276 FIX BUG IN ERROR MSG FILE ACCESS. MAKE ^G WITH ONLY ONE
ARG DO A PEEK INSTEAD OF A GETTAB.
277 SAVE A WORD WASTED BY EDIT 261. INSTALL DEC EDIT 172 (PROPER BOUNDS
CHECKING). INSTALL EQUIVALENT OF DEC EDIT # 174.
300 FIX FAILURE WHEN RENAMING THE .TMP FILE (EB) IN AN AREA NOT
YOUR OWN.
*** BACK TO STEVENS/RAPIDATA AGAIN
277A FIX BUG IN REENTER (P MAY NOT CONTAIN A PDL)
300A FIX ARGS FOR TRMOP. TO GET TTY WIDTH
301 CHANGE E SELECTION ALGORITHM
302 CHANGE .RB??? DEFINITIONS SO THAT THEY USE UUOSYM.
303 Removed.
304 CHANGE THE FLAG NAMES AND THE DEFINITIONS. NOW USE THE TX??
MACROS FROM MACTEN FOR THE FLAGS.
FF FLAGS ==> F.????
F2 FLAGS ==> S.????
305 BISSW was added to allow TECO to make limited use of the
Business Instruction Set. The code will not be removed,
but it will also not be used. It turns out to be considerably
slower than TECO's old mechanism and move string backwards.
is not possible.
306 Change the error code for Undefined Terminal Type
307 See edit 277.
310 Add /INPLACE so that EB will ER EW to same place.
311 Finish fixing the flags (Edit 304).
312 Remove the PDP6 feature test.
***BACK TO TEXAS...
313 Increase efficiency of FS when both strings are the same length
by skipping character-moving code.
314 Work on CRT stuff some more. Make treatment of no wrap-around
better. Add ^N20 to error routines to type list of valid CRT types.
315 Modify EW defaulting so that it won't use the ER device if it is
an ersatz. (For the same reason that it won't use ER's PPN.)
Equivalents of DEC EDITS up to 174 are in. Also 176.
316 Fix SKAN routine so that the character after a PW
is not ignored and so that @FD/.../ gets scanned properly.
317 Fix /SUPLSN. Slow punch routine will be used on a sequenced
file IF /SUPLSN not set for INPUT file. Minor bugs in
default PPN handler, initalization, and edit 313.
320 Fix EA so that privileged programs don't bomb if the LOOKUP
fails. (Monitor thinks USETI is a super.) Fix bug in *i
command: X3 routine should not add the garbage collection
constant in this case. Add ADDS 580 terminal by popular
demand. Fix a very rare ill mem ref bug: if MEMSIZ falls
exactly on a 1K boundary, and Z is allowed to equal MEMSIZ,
then the routine at NROOM6 fails, since it must reference
(Z/5)+1. So make sure Z always stays less than MEMSIZ.
321 Fix X command to allow buffer length of greater than 2**18
characters; i.e. do not use immediate instructions to perform
necessary arithmetic.
***The following adapted from Storage Technology Corp.'s revisions.
322 Fix double OCT error if first character of new command is
8 or 9.
323 Add "\\" command which reads/writes same as "\" but in octal.
324 Add VT50 terminal.
325 Add three immediate commands which work if they are the
first things typed: = 1LT, <^H> = -1LT, and, in the
spirit of DDT, <;> = 0LT. Fix several bugs in log file processing:
^G's were getting inserted twice; * commands weren't being
inserted at all; first character in log file (usually *)
missing if previous command was ^G^G'ed.
326 Change INIT to OPEN in TTOPEN and CCLTMP.
Fix an obscure search bug which makes S^ES$ blow up
if the character after the end of the buffer HAPPENS
to be a blank or tab.
327 Fix serious problem arising when ^P and ^Y are used on
sequenced files. n^P usually threw away page n-1; ^Y
went into an infinite loop.
330 Fix bug in \\.
331 Fix Ill Mem Ref in ";" immediate command. Add H1500, ADM3A,
ACT-IV, ACT-V and HP2640 terminals. Improve handling of
; and ^H commands. Modify ET command: 2ET means image typeout.
Clear digit string bit to prevent 2.5 or 3Z4 from returning
wierd values.
332 Improve U command. m,nUi will now store the value n into
Q-reg i, and return m. This allows m,nUiUj to store two
values, such as those passed to a macro. Improve [ command.
n[i now behaves like [inUi, allowing the Q-reg to be saved
before a value is stored. m,n[i[j will work as described
above. Issue error msg if attempt to store a number smaller than
-377777,,0 octal.
333 Support File Daemon, improve protection logic for EB's.
.BAK files will always be given a protection of 0xx or 4xx.
334 Replace complete searching algorithm. (U. of New Orleans)
335 Change EO level to 3, and restore several of the obolete
DEC features for EO < 3, such as position of pointer after
searches, etc. (NSA)
336 Don't shrink too much after an EI file is processed, so that
the purpose of "R TECO 50K" isn't defeated by the initial
EITECO.INI.
337 Change EI-EP file defaulting. If no device or directory is
specified, first look on [-], then on [,,TEC]/SCAN,
and finally on TED:. Add /DEFAULT I/O switch to clear
sticky defaults. Read TECO.ERR from the device and PPN that
TECO was run from; if that fails, try SYS:. Other minor
changes to error message processing. Change /READ to /READONLY.
340 Add warning message for ER and EB when file is found in
directory other than the one specified (LIB: or /SCAN).
Fix /INPLACE so it will really overwrite the file in these
cases. Fix EN so file stays in the same directory unless
a new directory is explicitly given.
341 Fix Ill mem ref in ^N processing for new search.
342 Fix backwards bounded searches which occur after the pointer.
For example, HK IA12345$ J 6,0S123$$ shouldn't fail.
Fix core problem preventing REENTER after ^Z.
343 Modify CCL command handler to support MAKE A=B command. Change
our pseudo altmode character from % to $ (dollar sign).
Make EWfile/APPEND$ equivalent to EAfile$. Make EBfile/READONLY$
equivalent to ERfile$.
344 Fix several bugs in slow search algorithm. Due to overwhelming
popular demand, finally remove DEC's "feature" which
treats all searches inside iterations as colon searches.
Such searches will never issue an error message, but
if EO > 2, they will now return no value. Semi-colons
will still work correctly, since a ; with no arg looks at
what happened in the last search. Searches using a previous
string will now remember the exact match setting.
345 Fix LSN routines to properly handle page marks. (DEC edit 217).
346 Implement generalized nA command, which returns the ASCII value
of the nth character to the right of the pointer. 0A
returns the character to the left, and -nA returns the
n+1st character to the left of the pointer. If .+n-1 is
out of bounds, a 0 is returned. An m,nA command will
cause m to be returned if the character is out of bounds.
Implement :nA command to append n lines to the buffer.
347 Implement the nV command equivalent to n-1TnT.
*** Start of Version 124A ***
NOTE: All applicable DEC edits through 226 have been installed.
350 Make sure there is room for at least 5000 characters when
TECO starts up.
351 Don't issue "Superseding existing file" message if /INPLACE.
Fix V command for negative numbers.
352 Fix Ill mem ref in CCL command processor when TMP file doesn't
end with or "}".
353 Fix problem with EB close routine so that it doesn't get fooled
by old .BAK and .TMP files not in the default path.
354 Fix Ill. Mem. Ref. after TECO runs out of core.
355 Fix another Ill. Mem. Ref in EP command. Make EP a little faster.
{
SUBTTL MACRO DEFINITIONS -- .CLNAM
COMMENT \
MACRO TO GENERATE TEXT CONTAINING CORRECT VERSION INFORMATION
DEFINE THE MACRO .NAME TO BE WHAT YOU WANT, FOR EXAMPLE:
DEFINE .NAME(V,M,E,W)<
TITLE PROGRAM %'V'M'('E')'W
>
THEN CALL THE .CLNAM MACRO:
.CLNAM FOO
WHERE THERE ARE SYMBOLS DEFINED AS THE VERSION, MINOR VERSION
(1=A, 2=B, ETC), EDIT, AND "WHO" VALUE. IT WILL GENERATE EXACTLY
WHAT'S IN THE .NAME DEFINITION, WITH THE DUMMY ARGS SUBSTITUTED
APPROPRIATELY (INCLUDING THE MINOR VERSION).
THE SYMBOLS "FOOVER", "FOOMIN", "FOOEDT", AND "FOOWHO" ARE USED
SIMILAR TO THE WAY THE VRSN. MACRO WORKS.
\
DEFINE .CLNAM(FOO)<
DEFINE .CLNM(LETTER,WHO)<
IRPC LETTER,<
IFE "A"-"'LETTER'"+FOO'MIN-1,<
STOPI
IFIDN <@>,<
IFE FOO'WHO< .NAME(\FOO'VER,,\FOO'EDT,)>
IFN FOO'WHO< .NAME(\FOO'VER,,\FOO'EDT,-WHO)>>
IFDIF <@>,<
IFE FOO'WHO< .NAME(\FOO'VER,LETTER,\FOO'EDT,)>
IFN FOO'WHO< .NAME(\FOO'VER,LETTER,\FOO'EDT,-WHO)>>>>>
IFG FOO'MIN-^D26,< FOO'MIN==0
PRINTX %MINOR VERSION TOO LARGE - IGNORED>
IFG FOO'WHO-7,< FOO'WHO==0
PRINTX %WHO VERSION TOO LARGE - IGNORED>
.CLNM(@ABCDEFGHIJKLMNOPQRSTUVWXYZ,\FOO'WHO)
>
DEFINE .NAME(V,M,E,W),<
TITLE TECO %'V'M(E)'W TEXT EDITOR AND CORRECTOR
>
.CLNAM TEC
SUBTTL MACRO DEFINITIONS -- CHKEO, ERROR
;CHECK EO FLAG: CHKEO EO#,ADDR
;IF EOFLAG > EO#, RETURN AT CALL+1
;OTHERWISE GO TO ADDR
DEFINE CHKEO(E,A)
<1B22+B30,,A>
;TYPE ERROR MSG: ERROR E.XXX
;TYPE MESSAGE CORRESPONDING TO 'XXX'
;THEN GO TO GO
;THE FOLLOWING IS THE DEFINITION OF THE REGULAR ERROR UUO
DEFINE ERROR(X)
<1B8+'X'
'X'=<''X''>&777777>
;THE FOLLOWING IS THE DEFINITION OF THE COLONABLE ERROR MESSAGES
;THIS IS USED FOR THE NEW ERROR HANDLING WITH COLON CONTRUCTION
;IF AN ERROR OCCURS AND THE ..ERROR UUO IS EXECUTED, THE COLON FLAG
;IS CHECKED TO SEE WHETHER YOU SHOULD RETURN A VALUE OF 0 OR PROCEED
;AND TYPE OUT THE ERROR MESSAGE
DEFINE ..ERROR(X)
<1B8+10B12+'X'
'X'=<''X''>&777777>
OPDEF TYPR1 [2B8]
SUBTTL DEFAULT ASSEMBLY PARAMETERS
NDS. CCL, 1 ;CCL CAPABILITY
NDS. TEMP, 1 ;TMPCOR UUO CAPABILITY
NDS. RUBSW, 0 ;DON'T MIMIC MONITOR
NDS. NORUNS, 0 ;RUN UUO CAPABILITY
NDS. AUTOFS, 0 ;DEFAULT IS NON-AUTOTYPE AFTER SEARCHES
NDS. TYCASW, 0 ;DEFAULT TYPE-OUT MODE CAUSES FLAGGING OF
;CHARACTERS IN THE LOWER CASE RANGE WITH '
NDS. SRCHSW, 0 ;DEFAULT PREVAILING SEARCH MODE IS ACCEPT
;EITHER LC OR UC ALPHABETICS AS A MATCH
NDS. BUFSIZ, ^D128 ;128 WORD I/O BUFFERS
NDS. LPDL, 120 ;80 WORD PDL
NDS. LPF, 40 ;32 WORD Q-REGISTER PDL
NDS. VC, 0 ;OLD V COMMAND NOT IMPLEMENTED,
;[347] USE NEW V COMMAND INSTEAD
NDS. EOVAL, 3 ;[335] THE STANDARD SETTING OF THE EO FLAG FOR
;THIS VERSION IS 3
NDS. BUGSW, 0 ;STANDARD IS DON'T SAVE SYMBOLS
NDS. CRT, 1 ;CRT RUBOUT HANDLING CAPABILITY
NDS. BISSW, 0 ;SUPPORT BIS (SLOW...)
;FOR ANY OTHER VERSION ASSEMBLE AS FOLLOWS:
;.R MACRO
;*TECO_TTY:,DSK:TECO.MAC
;CCL=0 (IF CCL NOT WANTED)
;TEMP=0 (IF TMPCOR UUO NOT WANTED)
;ERRMSG=1 (IF SHORT ERROR MESSAGES WANTED OR
; =3 IF EXTRA LONG ERROR MESSAGES WANTED)
;NORUNS=1 (IF RUN UUO SIMULATION WANTED)
;AUTOFS=-1 (IF DEFAULT = AUTOTYPE AFTER SEARCHES WANTED)
;TYCASW=1 (IF TYPE-OUT CASE FLAGGING DEFAULT VALUE
; TO FLAG UPPER CASE INSTEAD OF LOWER CASE
; CHARS. WANTED)
;TYCASW=-1 (IF TYPE-OUT CASE FLAGGING DEFAULT VALUE
; FOR NO FLAGGING WANTED)
;SRCHSW=1 (IF EXACT MODE WANTED AS THE DEFAULT VALUE
; OF THE PREVAILING SEARCH MODE)
;BUFSIZ=^D256 (IF 256-WORD I/O BUFFERS WANTED. ANY
; OTHER CONSTANT BESIDES 256 MAY BE USED.
; TECO USES STANDARD MONITOR BUFFERING,
; BUT IF THE MONITOR PROVIDES BUFFERS
; LARGER THAN 128 WORDS, BUFSIZ MUST BE
; CHANGED SO THAT SUFFICIENT SPACE IS
; RESERVED.
;LPDL=N (WHERE N 120, IF LARGER PDL WANTED)
;LPF=N (WHERE N 40, IF LARGER Q-REGISTER PDL WANTED)
;EOVAL=N (WHERE 0
F.NNUL==1B14 ;NON-NULL INSERT STRING (MIGHT BE ONLY ^V, SAY)
F.NEG== 1B13 ;MINUS SIGN SEEN AS AN OPERATOR
F.XXXX==1B12 ;[343] **** FREE ****
F.EOFI==1B11 ;INPUT CLOSED BY EOF
F.IOPN==1B10 ;INPUT FILE IS OPEN
F.OOPN==1B09 ;OUTPUT FILE IS OPEN
F.EBTP==1B08 ;EB FUNCTION TEMPORARY FLAG
F.FILE==1B07 ;AT LEAST ONE ELEMENT OF FILE SPEC GIVEN
F.PROT==1B06 ;FILE PROTECTION WAS SPECIFIED
F.INIT==1B05 ;INIT FILE READING
F.UBAK==1B04 ;EB IN EFFECT
F.TALK==1B03 ;MESSAGE TYPE OUT IN GRABAK?
F.TYOF==1B02 ;NEED TO OUTPUT A BUFFER
F.TCTL==1B01 ;ALLOW CONTROL CHARS TYPED WITHOUT "^"
F.CCL== 1B00 ;TECO COMMAND REQUESTS Y AFTER EB
SUBTTL CONTROL FLAGS -- AC F2
;RIGHT HALF - AC F2
S.CTLV==1B35 ;^V SEEN INSIDE TEXT
S.CTVV==1B34 ;DOUBLE ^V SEEN INSIDE TEXT
S.CTLW==1B33 ;^W SEEN INSIDE TEXT
S.CTWW==1B32 ;DOUBLE ^W SEEN INSIDE TEXT
S.XMAT==1B31 ;EXACT MATCH SEARCH MODE
S.EMAT==1B30 ;TEMPORARILY ACCEPT EITHER UPPER OR LOWER CASE
S.LCTT==1B29 ;TTY LINE HAS LC BIT ON
S.NCFL==1B28 ;TYPE MESSAGE WITH NO CASE FLAGGING
S.OCTL==1B27 ;OCTAL RADIX
S.CTLR==1B26 ;^R SEEN AT INPUT TIME
S.SKMR==1B25 ;WATCH FOR ^R WHEN SKIMMING
S.SKMQ==1B24 ;WATCH FOR ^Q WHEN SKIMMING
S.NTRC==1B23 ;DISABLE TRACING
S.TXTC==1B22 ;TYPE , ETC INSTEAD OF PRINTER CONTROLS
S.SFSN==1B21 ;SKANNING FS OR FN
S.NCCT==1B20 ;NO CONTROL COMMANDS IN TEXT EXCEPT ^T, ^R
S.LCAS==1B19 ;CONVERT UPPER CASE TO LOWER CASE BY DEFAULT
S.UCAS==1B18 ;CONVERT LOWER CASE TO UPPER CASE BY DEFAULT
;LEFT HALF - AC F2
S.GOIN==1B17 ;A COMMAND STRING HAS BEEN SEEN
S.CTLN==1B16 ;^N IN SEARCH ARGUMENT
S.NALT==1B15 ;DON'T CONVERT OLD ALTMODES TO 033
;**** S.NRAD & S.YANK ARE EQUAL, THIS IS OK
S.NRAD==1B14 ;NULL REPLACEMENT ALTMODE DELIMITED
S.YANK==1B14 ;^Y NOT ^P IN PROGRESS
S.LOPN==1B13 ;LOG FILE OPEN
S.INFO==1B12 ;INFORM USER OF ANY CORE CHANGE WHEN DONE
S.DOIT==1B11 ;M AS OPPOSED JUST HX*
S.XXXX==1B10 ;[331] ***FREE***
S.EA== 1B09 ;EDIT APPEND IN PROGRESS
S.MINS==1B08 ;MINUS SEARCH
S.DELS==1B07 ;TO DELETE TO FROM START TO PT SEARCH
S.ASTR==1B06 ;DON'T PRINT STAR
S.SSEQ==1B05 ;SUPPRESS SEQUENCE NOS ON INPUT
S.SLOG==1B04 ;UNDER NO CIRCUMSTANCES SEN CHARACTER TO LOG FILE
S.OLOG==1B03 ;WHEN AT TYOA, STICK IT IN THE LOG FILE ONLY
S.LIN== 1B02 ;PUT YOUR TYPE IN IN THE LOG FILE
S.LOUT==1B01 ;PUT TECO'S TYPE OUT IN THE LOG FILE
S.DPPN==1B00 ;REMEMBER TO DEFAULT TO ZERO PPN
SUBTTL I-O CHANNELS
;I-O CHANNELS
INCHN== 2
OUTCHN==3
TTY== 4 ;CHANNEL FOR TTY IO
CCLCHN==5 ;CHANNEL FOR THE CCL TMP FILE
ERRCHN==6 ;CHANNEL FOR ERROR MESSAGE FILE
LOGCHN==7 ;CHANNEL TO WRITE LOG FILE ON (IF ANY)
SAVCHN==10 ;TO WRITE LOW SEG SAVE ON
INICHN==11 ;TO READ INI FILE ON
SUBTTL MISC PARAMETERS
BEGPAG==200 ;FAKE ASCII CHAR = BEGINNING OF BUFFER
ENDPAG==201 ;FAKE ASCII CHAR = END OF BUFFER IF NO EOL AT END
SPCTAB==202 ;FAKE ASCII CHAR = SIGNAL TO SEARCH FOR A STRING OF SPACE/TABS
SMATLN==^D131 ;Number of characters in the search matricies
BITMLN==SMATLN/^D36+1 ;Number of words needed to hold SMATLN bits
STABLN==^D131 ;Length of Otag$ build table
GCTBL== LPF+40
EE1==1B12 ;PRINT UUO ERROR CODE AFTER ?XXX
EE2==2B12 ;PRINT I/O ERROR CODE AFTER ?XXX
EE3==3B12 ;PRINT NOTHING AFTER ?XXX BECAUSE NO CORE FOR ERROR FILE
EO21== 1 ;TURN OFF SPECIAL VERSION 22+ FEATURES IF EO VALUE = 1
EODEC== 2 ;[335] Same for version 124+
SUBTTL PSEUDO RUN UUO IF NEEDED
IFN NORUNS,<
IFN CCL,<
NORUN1: IOWD .-.,INHERE ;MODIFIED FOR LENGTH
0
NORUN2: CORE 15,
EXIT ;NOT ENOUGH CORE TO GET COMPIL
IN CCLCHN,NORUN1 ;READ THE FILE
JRST NORBLT ;TO THE ACS
EXIT ;NO GOOD.
INHERE: ;WHERE CODE APPEARS
NORAC: ;WHERE TO READ AC DATA FROM
PHASE 0
NORBLT: BLT NORTOP,.-. ;ADR MODIFIED
RESET
AOS 1,.JBSA ;ADR + 1
JRST (1) ;START COMPIL
NORTOP: XWD INHERE+1,75 ;MOVE COMPIL DOWN
DEPHASE
>>
SUBTTL STARTUP TIME INITIALIZATION
JRST RST ;THIS MUST BE IN 400010 WHEN SSAVED
;THIS IS USED BY THE EE COMMAND ROUTINE
;SAVED IN THE LOW SEGMENT TO START TECO
;AFTER A SAVE
TECO:
IFN CCL,<
TDZA B,B
MOVNI B,1 ;THE CCL ENTRY
>
RESET ;INITIALIZE ALL IO
SETZB F2,LOCORE ;CLR DATA IN CASE OF ^C,ST & CLEAR F2
MOVE A,[XWD LOCORE,LOCORE+1]
IFE BUGSW,
IFN BUGSW,
IFN CCL,
MOVEM 11,ERRDEV ;[337] Save device we RUN from, for TECO.ERR
MOVEM 7,ERRPPN ;[337] Save PPN as well
MOVE A,[PUSHJ P,UUOH] ;SET UUO TRAP
MOVEM A,.JB41
MOVE P,[XWD -LPDL,PDL] ;START ONE WORD DOWN
HRRZ B,.JBFF ;MAKE SURE WE HAVE AT LEAST 1000. FREE WDS
ADDI B,^D1000 ;[350]
CAML B,.JBREL
CORE B,
JFCL ;KEEP GOING...WITH LUCK WE WILL AT LEAST GET
;THE PROPER ?COR MESSAGE
HRRZ A,.JBREL ;.JBFF=.JBREL-202
SUBI A,47 ;[352] Buffer space for TMPCOR, etc.
EXCH A,.JBFF
IFN BUGSW,
ADD A,[677,,-1] ;CBUF=[000700,,FF-1]
MOVEM A,CBUF
MOVEI A,201(A)
IMULI A,5
MOVEM A,BEG ;BEG:=(CBUF+200)*5
MOVEM A,PT ;PT:=(CBUF+200)*5
MOVEM A,Z ;Z:=(CBUF+200)*5
MOVEM A,QRBUF ;QRBUF:=(CBUF+200)*5
PUSHJ P,SETUP ;SET UP STUFF
;Fall through to next page...
HRREI A,TYCASW ;GET WHATEVER IS DEFAULT TYPE-OUT CASE FLAGGING MODE
MOVEM A,TYCASF ;AND MAKE IT CURRENT
HRRZI A,EOVAL ;INITIALIZE EO FLAG
MOVEM A,EOFLAG
HRREI A,AUTOFS ;INIT AUTOTYPE-AFTER-SEARCHES FLAG
MOVEM A,AUTOF
IFN CRT,<
HLRZ A,CRTGEN ;GET "GENERAL CRT" FLAGS
MOVEM A,CRTTYP ;STORE
MOVEI A,BACRUB
HRLI A,VCRT
BLT A,CTUSEQ
>
SETOM INI ;REMEMBER TO DO INI FILE
IFN BISSW,< ;BIS SUPPORT
SETZM A ;SEE IF KL10
BLT A,0 ;...
MOVEM A,BIS ;NOTE RESULT
> ;END IFN BISSW
;Fall through to next page...
SUBTTL TEXT BUFFER INITIALIZATION
;COMPUTE A VALUE WHICH IS 2/3 THE SIZE OF THE CHARACTER BUFFER.IF
;1/3 IS LESS THAN 128 CHARACTERS, THE BUFFER WILL BE 2/3 FILLED ON
;A "Y" OR "A" COMMAND,OTHERWISE, THE BUFFER WILL BE FILLED TO THE
;TOTAL AVAILABLE BUFFER - 128 CHARACTERS. PAYING ATTENTION TO THE
;FORM FEED AND LF OPERATORS.
;IT SHOULD BE NOTED THAT IN THE CASE OF AUTOMATIC
;MEMORY EXPANSION, THESE INSTRUCTIONS MUST BE RE-EXECUTED
;TO INSURE PROPER MEMORY BOUNDS.
PUSH P,INITG ;FOR IN LINE CODING POPJ
CRE23: MOVE A,.JBFF ;LATEST VALUE OF FF
IMULI A,5 ;5 CHARACTERS PER MEM WORD
MOVEM A,MEMSIZ ;MEMSIZ:=C(.JBFF)*5
INITG: POPJ P,.+1 ;EXIT OR CONTINUE
MOVE A,CBUF
MOVEI A,100(A)
MOVEM A,CBUFH ;CBUFH:=CBUF+77
MOVEI A,SYL
MOVEM A,DLIM ;DLIM:=SYL
HRLOI A,10014
MOVEM A,NROOM2 ;NROOM2:=XWD 10014,-1
MOVEI FF,0 ;CLEAR FLAG REGISTER
SKIPE SRHMOD ;IF DEFAULT SEARCH MODE IS NOT 0,
TXOA FF,F.PMAT ;MAKE EXACT MODE CURRENT
GOE: TXZA FF,777777-F.TRAC-F.EMSG-F.FORM-F.SEQ
GO: TXZ FF,777777-F.TRAC-F.FORM-F.SEQ
TXZ F2,S.SSEQ!S.SLOG!S.NTRC!S.OCTL ;[322]
MOVE P,[XWD -LPDL,PDL] ;INITIALIZE PUSHDOWN LIST
MOVEM P,PDLSAV
SETZM PDL ;FLAG PDL TOP - NOTE: PDL FLAGS ARE
;0 = TOP OF PDL
;-1= LAST ITEM IS AN ITERATION
;+1= LAST ITEM IS A PARENTHESIS
;>1= LAST ITEM IS A MACRO
SETZM XCTING ;NO LONGER DOING ANYTHING
SETZM EQM ;CLEAR THE MACRO LEVEL COUNT
MOVE PF,[XWD -LPF-1,PFL-1]
AOSE INI ;TO DO THE INI FILE?
JRST CLIS
MOVSI E,(MOVE B,) ;FIX ILL UUO PROB IN INI FILES
HLLM E,DLIM
PUSHJ P,CLREXT ;SET UP EXTENDED LOOKUP BLOCK
TXO F2,S.DOIT ;DO INI FILE
SETOM XCTING ;SO IT DO IT
PUSHJ P,TTOPEN ;OPEN THE TTY
MOVSI E,'INI' ;SET UP EXTENSION
PUSHJ P,INIFIL ;GET IT INTO CORE
JRST CLIS ;GO DO REST
SUBTTL REENTER COMMAND
REE: CLRBFO ;STOP TYPEOUT
MOVEM P,TEMPP ;PRESERVE P
MOVE P,[IOWD 4,TEMPDL] ;SET UP STACK FOR SURE
PUSH P,E ;SAVE AN AC
MOVEI E,TTY ;CLOSE TTY
RESDV. E, ;RESET TTY
JFCL
PUSHJ P,TTOPEN ;REOPEN TTY
POP P,E ;RESTORE E, AFTER USE BY TTOPEN
MOVE P,TEMPP ;RESTORE P
RELEAS ERRCHN, ;FIX ADR CHECK
AOSE XCTING ;COMMAND IN PROGRESS?
JRST GO ;NO, GO AND LISTEN FOR INPUT
JRSTF @.JBOPC ;CONTINUE
;ROUTINE TO FIX PDL OV'S
PDLOV: MOVSI D,'PDL' ;FAKE AN ERROR MESSAGE
TLNE P,-1 ;MAIN PDL ERROR?
MOVSI D,'PDQ' ;Q REG STACK
HLRZM D,.JBUUO ;PDL OV
MOVEI B,"[" ;IN CASE PDQ
SKIPE CTGLEV ;WERE WE IN THE MIDDLE OF A ^G SEARCH?
MOVEI B,7 ;YES
MOVEM B,ARGSTO ;SAVE IT
SETZ D, ;DON'T APPEND A LOOKUP/ENTER/RENAME ERROR CODE!
JRSTF ERRPDL ;CAUSE ERROR UUO TO HAPPEN
SUBTTL INITIALIZATION OF JOB DEPENDENT PARAMETERS
SETUP: MOVEI A,PDLOV ;WHERE TO GO ON PDLOV
MOVEM A,.JBAPR ;SAVE
MOVX A,AP.REN!AP.POV ;ENABLE FOR PDL OV TRAPPING
APRENB A, ;SET TRAP
GETPPN A, ;GET USER'S PROJ-PROG #
JFCL ;[317]IN CASE SKIP RETURN
MOVEM A,USRPPN
SETOM DEFPTH ;GET DEFAULT PATH
MOVE E,[11,,DEFPTH]
PATH. E,
MOVEM A,DEFPTH+2 ;IF NOT, JUST PPN
MOVSI A,'DSK' ;DEFAULT DEVICE
MOVEM A,ERSPEC ;SAVE FOR DEFAULT ER COMMAND
SETOM MONITR ;GET MONITOR SERIES NUMBER
MOVX A,%CNSTS
GETTAB A, ;WHICH MONITOR?
JRST TECO2 ;3 SERIES (MONITR=-1)
TXNE A,ST%TDS ;WHAT MONITOR ?
AOS MONITR ;5 SERIES (MONITR=+1)
AOS MONITR ;4 SERIES (MONITR=0)
TECO2: MOVE A,[F%FDAE&LH.ALF!.GTFET] ;[333] See if FILDAE is there
GETTAB A, ;[333]
SETZ A, ;[333] Assume not
SETZM FDAEM ;[333] Ditto
TXNE A,F%FDAE&RH.ALF ;[333] Well?
SETOM FDAEM ;[333] Yes
PJOB A, ;GET JOB #
MOVEM A,JOBN
MOVEI C,3 ;SET CTR
JOBLUP: IDIVI A,12 ;CONVERT JOB# TO DECIMAL ASCII IN LEFT HALF
ADDI AA,20
LSHC AA,-6
SOJG C,JOBLUP
HRRI B,(SIXBIT /TEC/) ;FORM NAME ###TEC
MOVEM B,TMPTEC ;SAVE
HRROI A,.GTWCH ;GOING TO GET ERROR MESSAGE LEVEL BITS
GETTAB A, ;GET WATCH BITS
SETZ A,
TXNN A,JW.WMS
TXO A,JW.WPR!JW.WFL ;ASSUME FIRST LINE!PREFIX
TXNE A,JW.WCN
TXO A,JW.WFL
MOVEM A,ERRLEN ;-1=SHORT, 0=MEDIUM, +1=LONG
MOVEM A,PRMERR ;SAVE FOR DEFAULT
POPJ P,
SUBTTL CCL Command processor
IFN CCL,<
TTYPT: XWD 440700,TTYBFS ;CCL COMMAND BUFFER PTR
TTYPT2: XWD 260700,TTYBFS ;TO INSERT FILE NAME AFTER EW OR EB
CCLIN:
IFN TEMP,<
SETZ I, ;CLEAR TO DENOTE NO TMPCOR
MOVE A,[XWD 2,TT] ;SET UP FOR TMPCOR READ & DELETE
HRLZI TT,'EDT' ;SET UP READ BLOCK FOR TMPCOR UUO
HRRZ TT1,.JBFF ;[343] Get first free location
ADDI TT1,46 ;[343] Allow more than enough space
CAML TT1,.JBREL ;[343] Do we have it?
CORE TT1, ;[343] No - expand
JFCL ;[343] Do the best we can
HRRZ TT1,.JBFF ;[343] Where to put it
SUB TT1,[XWD 46,1] ;[343] Make an IOWD
TMPCOR A, ;READ AND DELETE FILE EDT
JRST CCLTMP ;NO FILE EDT OR NO TMPCOR UUO
HRRZ AA,.JBFF ;[343] Start of buffer area
HRLI AA,350700 ;PICK UP EDT CHARACTERS, SKIP LINED "S"
JSP I,CCLTM1 ;[343] Denote we have TMPCOR and continue below
>;END OF IFN TEMP
;Here if TMPCOR failed. Read DSK:nnnEDT.TMP.
CCLTMP: HLLZ B,TMPTEC ;GET SIXBIT JOB #
HRRI B,(SIXBIT /EDT/) ;REST OF NAME
MOVEM B,XFILNM+.RBNAM
MOVSI B,(SIXBIT /TMP/)
MOVEM B,XFILNM+.RBEXT
SETZM XFILNM+.RBSIZ ;USE DEFAULT PATH, PREVENT ADR. CHK.
MOVE T,.JBFF ;USE BUFFER SPACE BRIEFLY
OPEN CCLCHN,[EXP .IOASC ;[326]
SIXBIT /DSK/ ;[326] TO READ THE FILE
EXP CCLB] ;[326] INPUT BUFFER
JRST TECO ;IF NO DSK, SAY "*"
INBUF CCLCHN,1 ;DONT ADR CHECK
LOOKUP CCLCHN,XFILNM+.RBNAM ;OPEN THE FILE
JRST TECO ;IT WASNT THERE?
INPUT CCLCHN,0
MOVEM T,.JBFF ;GIVE BACK SPACE
IBP CCLB+.BFPTR ;SKIP THE LINED S
MOVE AA,CCLB+.BFPTR ;[343] Get byte pointer to input
;Fall back into normal process on next page
;Here when we have the command, either from TMP: or from DSK:.
CCLTM1: MOVE T,TTYPT2 ;[343] Get output byte pointer
MOVEI C,2 ;[343] Initialize the character count
HRLI C,-<<46*5>-4> ;[343] Max of 186. chars
MOVEI A,"=" ;[343] Flag no equals sign seen
SETZ TT1, ;[343] Flag no dollar sign seen
;Loop back here on each new character in TMP file
CCLIL: ILDB B,AA ;[343] Get next EDT character
CAIN B,"$" ;[343] Is it a dollar sign? (Our pseudo altmode)
JRST CCLALT ;[343] Yes
CAMN B,A ;[343] First equals sign seen?
JRST CCLEQL ;[343] Yes
CAIE B,.CHCRT ;[343] CR?
CAIN B,.CHALT ;[343] Old altmode?
JRST CCLNUL ;[343] Assume we're done
SKIPE B ;[352] Ignore nulls
CCLIL1: IDPB B,T ;[343] Else store the character
AOBJN C,CCLIL ;[343] Loop for all characters
; Fall through if too many characters; we can't overflow TTYBFS
CCLOVF: JUMPN B,CCLOV1 ;[352] Is current char a null?
LDB B,T ;[352] Yes, assume we're OK, pick up last char
ADD T,[7B5] ;[352] Backup byte pointer
JUMPG T,CCLNUL ;[352]
SUB T,[430000,,1] ;[352] Fixup if necessary
JRST CCLNUL ;[352] Go wrap things up
CCLOV1: ERROR E.CTL ;[343] CCL command too long
; Here when a dollar sign seen
CCLALT: MOVEI B,.CHESC ;[343] Change it into a real altmode
JUMPN TT1,CCLIL1 ;[343] Is this the first one we've seen?
MOVE TT1,AA ;[343] Yes, save input byte pointer
JUMPL A,CCLIL1 ;[343] Was there a prior equal sign?
MOVNI A,2 ;[343] No, so flag to ignore all future equal signs
JRST CCLIL1 ;[343] Return to loop
; Here on the first "=" in the command string (unless $ seen first)
CCLEQL: MOVEI B,.CHESC ;[343] Replace first equals sign
IDPB B,T ;[343] with ER
AOBJP C,CCLOVF ;[343] Count the escape
MOVE D,T ;[343] Save T & C
MOVE E,C ;[343] In case .TE A=B
ADD C,[2,,2] ;[343] Count the "ER" we will add
JUMPGE C,CCLOVF ;[343] Error if too many characters
MOVEI B,"E" ;[343] Since we expect
IDPB B,T ;[343] an input file
MOVEI B,"R" ;[343] spec to follow
IDPB B,T ;[343] the first one.
SETO A, ;[343] Prevent finding later equals
TXO FF,F.CCL ;[343] Do a EY in any case
JRST CCLIL ;[343] and loop back for next character
; Here on a null (End of command). See if it was MAKE or TECO
CCLNUL: MOVEI TT,"W" ;[343] Prepare for EW command
CAILE B,.CHCRT ;WAS BREAK A CRLF?
JRST CCLDUN ;NO. ALTMODE ASSUMED
TXO FF,F.CCL ;REQUEST Y AFTER EB
MOVEI TT,"B" ;[343] Now prepare for EB
AOJN A,CCLDUN ;[343] continue unless EB and "=" was seen
MOVE T,D ;[343] If .TE A=B, we never saw the "="
MOVE C,E ;[343] In case .MA A=B, then .TE
JUMPE TT1,CCLDUN ;[343] Jump ahead unless there was a $ after "A=B"
MOVE AA,TT1 ;[343] There was, so restore input BP to that point
MOVNI A,-2 ;[343] Reset A so we don't do this again
JRST CCLIL ;[343] And return to that point, leaving out the "=B"
CCLDUN: MOVEI B,.CHESC
IDPB B,T ;[343] TERMINATING TWO ALT'S
IDPB B,T ;LAST ALT
ADDI C,3 ;[343] COUNT BOTH ALTS & ADD 1 TO FOOL TYI0
MOVEI B,"E" ;NOW FILL IN THE EB OR EW
MOVE T,TTYPT ;AT THE BEGINNING OF STRING
MOVEM T,TIB+.BFPTR ;ALSO INITIALIZE TO READ THIS
IDPB B,T ;STORE "E"
IDPB TT,T ;[343] And either W or B
HRRZM C,TIB+.BFCNT ;SET BUFR CTR
IFN TEMP, ;[343] IF TMPCOR THEN DON'T HAVE TO CLOSE
SETZM XFILNM+.RBNAM ;BY RENAME TO 0
RENAME CCLCHN,XFILNM ;GO.
JFCL ;NOGO?
CCLDU2: RELEAS CCLCHN,
POPJ P,
>;END OF IFN CCL
SUBTTL RETURN NON-NULL TTY CHARACTER IN CH.
;CALL PUSHJ PDP,TYI
; RETURN
TYI: TXZE FF,F.TYOF ;NEED A TYO?
OUTPUT TTY,0 ;YES. DO SO.
TYI0: SOSG TIB+.BFCNT ;CHARS IN NORMAL MODE?
JRST TYI1 ;NONE LEFT
TYI2: ILDB CH,TIB+.BFPTR ;YES. GET ONE
JUMPE CH,TYI0 ;FLUSH NULLS
TYI3: TXZ FF,F.DDTM ;CLR TTCALL REQUEST FLAG
IFN RUBSW,<
SETO A, ;AIM AT THIS TTY
GETLCH A ;GETSTS
TXNN A,GL.LCP ;SUPPRESS ECHO?
>
CAIE CH,.CHBEL ;BELL?
JRST ALTLIN ;NO, BUT WATCH OUT FOR OLD ALTMODES
TXO F2,S.SLOG ;DON'T PUT THE ^G IN THE LOG FILE
JSP A,CONMES ;ECHO AN "^G" TOO
ASCIZ /^G/
TXZ F2,S.SLOG
MOVEI CH,.CHBEL ;GET BACK BELL
POPJ P,
TYI1: TXNE FF,F.DDTM ;SHOULD TYI BE TTCALL?
JRST TYIDDT ;YES
INPUT TTY,0 ;NO. ORDINARY.
STATO TTY,IO.EOF ;END OF FILE?
JRST TYI2
PUSHJ P,TTOPEN ;CLEAR EOF THE HARD WAY
JRST TYI0 ;^Z WAS SEEN ALREADY. GET ANOTHER CH
;CONVERT 175 & 176 TO ALTMODE (033) UNLESS TTY LC IS ON
ALTLIN: CAIL CH,.CHALT ;OLD ALTMODE?
CAILE CH,.CHAL2
POPJ P, ;NO
TXNN F2,S.NALT ;TEST TTY NO ALT BIT
ALTX: MOVEI CH,.CHESC ;NOT ON, SO CONVERT TO 033
POPJ P,
;CONVERT 175 & 176 TO ALTMODE (033) IF EO = 1
ALTEO: CAIE CH,.CHALT ;OLD ALTMODE?
CAIN CH,.CHAL2
CHKEO EO21,ALTX ;RUNNING OLD MACRO? IF SO, CONVERT
POPJ P, ;NO, 175=RIGHT BRACE, 176=TILDE
TYIDDT: TXZE FF,F.TYOF ;CHARACTERS WAITING FOR OUTPUT?
OUTPUT TTY,0 ;YES, FORCE THEM OUT
INCHRW CH ;WAIT FOR A SINGLE CHARACTER
JRST TYI3
;USE E INSTEAD OF T IN THIS ROUTINE, SINCE IT MAY BE CALLED
; AFTER A REENTER, WHILE T IS BEING USED TO MOVE CHARACTERS
; (FAST AC CODE). E HAS BEEN SAVED AT REE:.
TTOPEN: MOVEI E,TTYBFS
EXCH E,.JBFF ;SET .JBFF AND SAVE IT
OPEN TTY,TTYBLK ;[326] INIT THE CONSOLE
JRST .-1 ;[326] I REALLY WANT TTY
INBUF TTY,1
OUTBUF TTY,1 ;KEEP IT SMALL
MOVEM E,.JBFF ;RESTORE .JBFF
IFN CCL,<
SETZM TYIPT ;SIGNAL CCL BUFFER EMPTY
>
POPJ P,
TTYBLK: EXP IO.FCS!.IOASC ;[326] TTY OPEN BLOCK
SIXBIT /TTY/
TOB,,TIB
SUBTTL TYPE A CHARACTER.
;FOR TYPING TEXT: FOR TYPING MESSAGES:
; MOVE CH,CHARACTER MOVE CH,CHARACTER
; PUSHJ P,TYO PUSHJ P,TYOM
; RETURN RETURN
TYOS: TXOA F2,S.TXTC ;TYPE , ETC INSTEAD OF PRINTER CONTROLS
TYOM: TXZ F2,S.TXTC ;CLR SPECIAL TYPEOUT FLAG
TXOA F2,S.NCFL ;SET NO-CASE-FLAGGING FLAG
TYO: TXZ F2,S.NCFL+S.TXTC ;CLR NO-CASE-FLAGGING FLAG & SPECIAL FLAG
PUSH P,CH ;SAVE CHAR IN CASE ^ OR ' NEEDED
TXZ FF,F.TCTL!F.IMAG ;[331] Zero literal and image flags
SKIPN ETVAL ;[331] ET = 0?
JRST TYOF ;[331] It's 0, so use up-arrow mode
PUSH P,A ;[331] Save a #%&ing AC!
MOVE A,ETVAL ;[331] Get ET value
CAIN A,1 ;[331] ET=1?
TXO FF,F.TCTL ;[331] Yes
CAIN A,2 ;[331] ET=2?
TXO FF,F.IMAG ;[331] Yes, set image mode
POP P,A ;[331] Retore A
JRST TYOB ;[331] Go type character
TYOF: PUSHJ P,ALTEO ;[331] CONVERT OLD ALTMODES IF EO=1
IFN CRT,
IFE CRT,
JRST TYO1 ;BELOW TAB
TXZN F2,S.TXTC ;WANT , ETC INSTEAD OF PRINTER CONTROLS?
JRST TYOJ ;NO
CAIG CH,.CHCRT ;IS IT A PRINTER CONTROL?
JRST TYOH ;YES
CAIE CH,.CHESC ;OR AN ALTMODE?
JRST TYOG ;NO, DO NORMAL THING
MOVEI CH,16 ;ADJUST INDEX FOR ALTMODE
TYOH: MOVEI A,5 ;5 CHAR. CTR
MOVE AA,[POINT 7,TSPTAB-10] ;& PTR TO RIGHT COMBINATION
ADDI AA,(CH)
TYOI: ILDB CH,AA ;TYPE OR WHATEVER
SOJLE A,TYOB ;LAST CHAR GOES OUT VIA TYOB (TO POP CH)
PUSHJ P,TYOA
JRST TYOI
TYOJ: CAIG CH,.CHCRT ;NO, TAB, LF, VT, FF, OR CR?
JRST TYOB ;YES. TYPE IT AND RETURN
CAIN CH,.CHESC
MOVEI CH,"$" ;YES TYPE DOLLAR SIGN
TYOG: CAIGE CH," " ;NO. ANY OTHER CONTROL CHARACTER?
JRST TYO1 ;YES.
TYOC: TXNE F2,S.LCTT+S.NCFL ;TTY LC ON? OR TYPING A MESSAGE?
JRST TYOB ;YES, NO CASE FLAGGING
MOVE A,TYCASF ;WHAT SHOULD BE FLAGGED?
JUMPL A,TYOB ;NOTHING
JUMPG A,TYOD ;UPPER CASE RANGE
CAIGE CH,"A"+" "-1 ;LOWER CASE. IS THIS LC?
JRST TYOB ;NO, SO DON'T FLAG IT
TYOE: MOVEI CH,"'" ;YES, FLAG IT WITH '
PUSHJ P,TYOA
MOVE CH,(P) ;GET BACK THE CHARACTER
TXZ CH,40 ;MAKE IT UPPER CASE
TYOB: PUSHJ P,TYOA ;TYPE CH.
POP P,CH ;RESTORE CH
TXZN FF,F.TCTL!F.IMAG ;[331] CLEAR LITERAL AND IMAGE FLAGS
CAIE CH,.CHBEL ;[331] IF BELL, WE NEED A DING
POPJ P, ;NO, RETURN
JRST TYOA1 ;[325] BUT DON'T PUT THE DING INTO LOG FILE
TYOA: TXNE F2,S.OLOG!S.LOUT ;PUT CHARACTER IN LOG FILE
PUSHJ P,LOGOUT ;RIGHT!
TYOA1: TXNE FF,F.IMAG ;[331] Do we want image typeout?
JRST TYOK ;[331] Yes
TXO FF,F.TYOF ;[325] MARK WILL NEED TO OUTPUT
SOSG TOB+.BFCNT ;OUTPUT SPACE AVAIL?
OUTPUT TTY,0 ;NO. OUTPUT.
IDPB CH,TOB+.BFPTR
CAILE CH,.CHFFD ;FORCE OUTPUT ON LF,FF ETC
POPJ P, ;NO
OUTPUT TTY,0
TXZ FF,F.TYOF ;NO LONGER NEED TO OUTPUT
POPJ P,
TYOK: TXZE FF,F.TYOF ;[331] If output pending...
OUTPUT TTY,0 ;[331] put it out
IONEOU CH ;[331] Output the image character
POPJ P, ;[331] Return
TYO1: PUSH P,CH ;TYPE CONTROL CHARACTER IN FORM "^CH"
MOVEI CH, "^"
PUSHJ P,TYOA ;TYPE ^
POP P,CH
ADDI CH,100 ;CONVERT TO PRINTING CHARACTER
JRST TYOB ;AND TYPE IT.
TYOD: CAIL CH,100 ;IS THIS UPPER CASE?
CAILE CH,137
JRST TYOB ;NO
JRST TYOE ;YES, FLAG IT WITH '
;PRINT THESE INSTEAD OF PRINTER CONTROLS IF S.TXTC FLAG IS ON
TSPTAB: ASCII /^H/
ASCII //
ASCII //
ASCII //
ASCII //
ASCII //
ASCII //
SUBTTL MESSAGE TYPE-OUT & NUMBER TYPE-OUT
;CALL JSP A,CONMES
; ASCIZ /MESSAGE/
; RETURN
CONMES: HRLI A,(POINT 7,,) ;A=POINT 7,MESSAGE-ADDR
ILDB CH,A ;GET MSG CHAR
JUMPE CH,1(A) ;RETURN WHEN 0 FOUND
PUSHJ P,TYOM ;TYPE WITH NO CASE FLAGGING
JRST .-3
;ROUTINE TO OUTPUT DECIMAL (OCTAL IF S.OCTL IS ON) INTEGER
;CALL MOVE B,INTEGER
; MOVEI A,ADDRESS OF OUTPUT ROUTINE
; PUSHJ P,DPT
; RETURN
DPT: MOVEM A,LISTF5
JUMPGE B,DPT1 ;NUMBER > 0?
MOVEI CH,"-" ;NO. OUTPUT -
PUSHJ P,@LISTF5
MOVMS B ;B:=ABSOLUTE VALUE OF B
DPT1: MOVEI A,12 ;RADIX 10
TXZE F2,S.OCTL ;[323] OCTAL RADIX?
MOVEI A,10 ;YES, CHANGE TO RADIX 8
IDIVI B,(A) ;E:=DIGIT
HRLM E,(P) ;PUT DIGIT ON LEFT HALF OF TOP OF PUSH DOWN LIST
JUMPE B,.+2 ;DONE?
PUSHJ P,.-3 ;NO. PUSH THIS DIGIT AND PRINT RETURN ADDRESS.
HLRZ CH,(P) ;YES. CH:=DIGIT
ADDI CH,"0" ;CONVERT IT TO ASCII.
JRST @LISTF5 ;PRINT IT
;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL PUSHJ P,CRR
; RETURN
CRR: JSP A,CONMES ;OUTPUT CRLF
ASCIZ /
/
POPJ P,
;ROUTINE TO TYPE A STRING LITERALLY
OUTIMG: TXO FF,F.IMAG ;[331] Use image mode
OUTMES: HRLI A,(POINT 7,,) ;THIS ROUTINE WILL OUTPUT A STRING LITERALLY
OUTMS1: ILDB CH,A
JUMPE CH,OUTMS2 ;[331]
PUSHJ P,TYOA
TLNE A,700000 ;NO MORE THAN 5 CHARACTERS, THOUGH
JRST OUTMS1
OUTMS2: TXZ FF,F.IMAG ;[331] Clear image flag
POPJ P,
SUBTTL RETURN NEXT COMMAND CHAR AT CURRENT LEVEL
;CALL: PUSHJ P,SKRCH
; ERROR RETURN IF NO MORE CHARS AT THIS LEVEL
; NORMAL RETURN WITH CHAR IN CH
SKRCH: SKIPG COMCNT ;ANY CHARS LEFT?
POPJ P, ;NO, TAKE ERROR RETURN
PUSHJ P,RCH ;YES, GET NEXT
CPOPJ1: AOS (P) ;SKIP RETURN
POPJ P,
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER.
;CALL PUSHJ P,RCH
; RETURN ALWAYS WITH CHARACTER IN CH
RCH: SOSGE COMCNT ;DECREMENT COMMAND BUFFER CHARACTER COUNT
;IS COMMAND BUFFER EMPTY?
JRST RCH2 ;YES. POP UP TO HIGHER MACRO LEVEL.
ILDB CH,CPTR ;NO. GET COMMAND CHARACTER IN CH
PUSHJ P,ALTEO ;CONVERT OLD ALTMODES IF EO = 1
HRRM CH,EATCH ;IN CASE OF FAILURE DURING COLON ANYTHING
TXNE FF,F.TRAC ;IN TRACE MODE?
TXNE F2,S.NTRC ;TRACE ENABLED?
POPJ P, ;NO, RETURN
JRST TYO ;YES, TYPE THE COMMAND
RCH2: POP P,CH ;SAVE RETURN FOR POPJ IN CH
POP P,COMCNT ;GET RID OF FLAG
SOSGE EQM ;DECREMENT THE MACRO COUNT
SETZM EQM ;NEVER ALLOW IT TO GO NEG OR PEOPLE WILL SCREW UP
SOSGE COMCNT ;IF ANG BRAK ON PDL, ITS A INCOMPLETE MACRO
ERROR E.IAB
POP P,COMCNT ;GET COUNT FROM NEXT MACRO LEVEL
POP P,CPTR ;CURRENT POINTER TOO
POP P,COMAX ;NUMBER OF COMMANDS
PUSH P,CH ;GET RETURN BACK ON PDL.
JRST RCH ;TRY AGAIN.
;GET NEXT CHAR FROM CURRENT COMMAND LEVEL WHERE A CHAR IS
;KNOWN TO BE THERE, AND NO TRACING IS WANTED
GCH: SOS COMCNT ;REDUCE CHAR COUNT
ILDB CH,CPTR ;GET CHAR.
JRST ALTEO ;CONVERT OLD ALTMODES AND RETURN
SUBTTL SCAN COMMAND STRING FOR CHARACTER IN TT
;IGNORING PAIRS STARTING WITH CHAR. IN TT1 AND ENDING WITH (TT)
;ASSUMED THAT CPTR IS SET
;NON-SKIP RETURN IF (TT) CAN'T BE FOUND
;SKIP RETURN IF FOUND
;CPTR LEFT SET FOR NEXT CHAR. IN COMMAND STRING
SKAN: TXO F2,S.NTRC ;INHIBIT TRACE ACTION WHILE SKANNING
MOVEI C,0 ;CTR FOR <> AND "...' PAIRS
SKAN0: TXZ F2,S.SKMQ+S.SKMR+S.SFSN ;CLR SKIM FLAGS
PUSHJ P,SKRCH2 ;GET COMMAND CHAR.
SKAN01: CAIN CH,(TT1) ;SECONDARY CHARACTER?
AOJA C,SKAN1 ;YES, COUNT IT
CAIN CH,(TT) ;PRIMARY CHAR?
JRST SKAN10 ;YES!
SKAN1: CHKEO EO21,SKAN0 ;OLD STYLE SKAN IF EO = 1
MOVEI T,SKNTAB ;NO, WATCH OUT FOR TEXT STRINGS
SKAN00: PUSHJ P,DISPAT
JRST SKAN0 ;NOT A TEXT-ARG COMMAND, IGNORE IT
SKAN2: PUSHJ P,SKRCH2 ;GET CHAR AFTER "^"
CAIE CH,"A"+" " ;COULD BE LOWER CASE
CAIN CH,"A"
JRST SKAN7 ;^A COMMAND
CAIN CH,"^"
JRST SKAN11 ;^^ COMMAND
JRST SKAN0 ;ORDINARY CTRL-COMMAND, FORGET IT
SKAN3: PUSHJ P,SKRCH2
MOVEI T,SK3TAB ;WHICH E COMMAND?
JRST SKAN00
SKAN4: PUSHJ P,SKRCH2 ;WHAT FOLLOWS @?
MOVEI T,SK4TAB
PUSHJ P,DISPAT
JRST SKAN4 ;MUST BE 1 OF THESE 4
SKAN09: TXZ F2,S.SFSN ;FOR FD CASE
JRST SKAN12
SKAN9: PUSHJ P,SKIM ;IGNORE TO $
JRST SKAN0
SKAN7: MOVEI T,1 ;IGNORE TO ^A
JRST SKAN5
SKAN8: MOVEI T,"!" ;IGNORE TO !
SKAN5: PUSHJ P,SKIM1 ;IGNORE TO CHAR IN T
JRST SKAN0
SKAN66: TXZ F2,S.SFSN ;FOR @FD CASE
SKAN6: PUSHJ P,SKRCH2 ;GET SEARCH DELIMITER
SKIPA T,CH ;IGNORE TO NEXT OCCURRENCE
SKAN12: MOVEI T,.CHESC ;DELIMITER IS ALTMODE
PUSHJ P,SKIMRQ ;SKIP TO DELIMITER & WATCH OUT FOR ^Q,^R
JRST SKAN0
SKAN13: PUSHJ P,SKRCH2 ;GET INSERT DELIMITER
SKIPA T,CH ;IGNORE TO NEXT OCCURRENCE
SKAN14: MOVEI T,.CHESC ;DELIMITER IS ALTMODE
PUSHJ P,SKIM.R ;SKIP TO DELIMITER & WATCH OUT FOR ^R
JRST SKAN0
SKAN11: PUSHJ P,SKRCH2 ;IGNORE NEXT CHAR.
JRST SKAN0
SKAN16: MOVEI T,SK5TAB ;TABLE FOR @F
JRST SKAN17
SKAN15: MOVEI T,SK1TAB ;TABLE FOR F COMMANDS
SKAN17: TXO F2,S.SFSN ;SIGNAL FS OR FN IN PROGRESS
PUSHJ P,SKRCH2 ;GET CHAR AFTER F
JRST SKAN00
SKAN18: PUSHJ P,SKRCH2 ;CHECK FOR POSSIBLE "PW"
CAIE CH,"W"
CAIN CH,"W"+" "
JRST SKAN0 ;IT IS...FORGET IT
JRST SKAN01 ;IT'S NOT...WE MUST CHECK THIS CHAR FURTHER
SKAN10: SOJGE C,SKAN0 ;IF MATCH JUST ENDS A PAIR, LOOP BACK
TXZ F2,S.NTRC ;ENABLE TRACING
JRST CPOPJ1 ;OTHERWISE, WE HAVE WHAT WE WANT
;SKIM OVER TEXT
;ENTER AT SKIM TO SKIP TO NEXT ALTMODE, GIVING ^R & ^Q NO SPECIAL TREATMENT
;ENTER AT SKIM1 TO SKIP OVER ARBITRARY CHAR IN T, GIVING ^R & ^Q NO SPECIAL TREATMENT
;ENTER AT SKIM.R TO SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER ^R
;ENTER AT SKIMRQ TO SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER EITHER ^R OR ^Q
SKIMRQ: TXO F2,S.SKMQ ;CK FOR ^Q AND ^R
SKIM.R: TXOA F2,S.SKMR ;CK FOR ^R
SKIM: MOVEI T,.CHESC ;SKIP TO NEXT ALTMODE
SKIM1: PUSHJ P,SKRCH ;GET NEXT TEXT CHAR.
JRST APOPJ ;ERROR RETURN FROM SKAN ROUTINE
CAIN CH,(T) ;CHARACTER WE WANT?
JRST SKIM3 ;YES
CAIN CH,.CHCNQ ;^Q?
TXNN F2,S.SKMQ ;YES, CK FLAG ON?
JRST .+2 ;NO
JRST SKIM2 ;YES
CAIN CH,.CHCNR ;^R?
TXNN F2,S.SKMR ;YES, CK FLAG ON?
JRST SKIM1 ;NO, KEEP LOOKING
SKIM2: PUSHJ P,SKRCH ;GOBBLE UP NEXT CHARACTER
JRST APOPJ ;ERROR RETURN FROM SKAN
JRST SKIM1 ;CONTINUE SKIMMING
SKIM3: TXZE F2,S.SFSN ;SKIMMING OVER FS OR FN?
JRST SKIM1 ;YES, IGNORE 1ST DELIMITER
POPJ P,
;GET A SINGLE CHARACTER FROM COMMAND STRING
;TAKE ERROR RETURN FROM SKAN IF THERE ARE NO MORE
SKRCH2: PUSHJ P,SKRCH ;GET A COMMAND CHAR.
APOPJ: POP P,A ;ERROR RETURN FROM SKAN IF NO MORE CHARS.
POPJ P,
SUBTTL SKAN ROUTINE DISPATCH TABLES
SKNTAB: XWD SKAN15,"F"
XWD SKAN14,"I"
XWD SKAN14,.CHTAB ;TAB
XWD SKAN12,"_"
XWD SKAN9,"O"
XWD SKAN8,"!"
XWD SKAN7,.CHCNA ;^A
XWD SKAN11,.CHCCF ;^^
XWD SKAN2,"^"
XWD SKAN3,"E"
XWD SKAN11,"U"
XWD SKAN11,"Q"
XWD SKAN11,"X"
XWD SKAN11,"G"
XWD SKAN11,"W"
XWD SKAN11,"M"
XWD SKAN11,"%"
XWD SKAN11,"["
XWD SKAN11,"]"
XWD SKAN4,"@"
XWD SKAN11,"""" ;"
XWD SKAN12,"S"
XWD SKAN12,"N"
XWD SKAN18,"P"
XWD 0,0
SK1TAB: XWD SKAN12,"S" ;S OR FS
XWD SKAN12,"N" ;N OR FN
XWD SKAN09,"D"
XWD 0,0 ;LIST TERMINATOR
SK3TAB: XWD SKAN9,"I"
XWD SKAN9,"P"
XWD SKAN9,"B" ;EB
XWD SKAN9,"R" ;ER
XWD SKAN9,"W" ;EW
XWD SKAN9,"Z" ;EZ
XWD SKAN9,"D"
XWD SKAN9,"L"
XWD SKAN9,"E"
XWD SKAN9,"N"
XWD SKAN9,"A"
XWD SKAN9,"V"
XWD 0,0
SK4TAB: XWD SKAN16,"F" ;@F
XWD SKAN13,"I" ;@I
XWD SKAN6,"_" ;@_
XWD SKAN6,"S" ;@S
XWD SKAN6,"N" ;@N
XWD 0,0
SK5TAB: XWD SKAN6,"S" ;@FS
XWD SKAN6,"N" ;@FN
XWD SKAN66,"D" ;@FD
XWD 0,0
SUBTTL ACCEPT COMMAND STRING ROUTINE
CLIS1: PUSHJ P,CRR ;TYPE CRLF
CLIS:
IFN CCL,<
SKIPN CCLSW ;NEED CCL COMMAND?
JRST LIS0 ;NO
PUSHJ P,CCLIN ;GET THE CCL COMMAND TO TYI BUFFER
JRST LIS02 ;AND DONT SAY STAR
>
LIS0: AOS INI ;ALLOW ^G^G *I$ ON FIRST COMMAND
PUSHJ P,TTOPEN ;GET TELETYPE
TXNE FF,F.EMSG ;1ST CHARACTER IN ALREADY?
JRST LIS01 ;YES
MOVEI CH,"*"
TXZ F2,S.LCTT ;CLR TTY LC BIT
SETO A, ;GETLCH ON THIS LINE
GETLCH A
TXNE A,GL.LCM ;TTY LC ON?
TXO F2,S.LCTT ;YES, SET TTY LC BIT
TXNN F2,S.LIN ;WANT OUTPUT?
TXO F2,S.SLOG ;SUPPRESS * IN LOG FILE
TXZ FF,F.CCL ;NOT THIS AGAIN
HRRZ TT1,A ;GET UNIVERSAL I/O INDEX
MOVEI TT,.TOALT ;CODE FOR ALT TESTING
MOVE A,[XWD 2,TT] ;SET UP FOR TRMOP
TRMOP. A, ;GET ALTMODE INFO FROM MONITOR
LDB A,[POINTR (F2,S.LCTT)] ;IF THIS FAILS USE LC BIT
SKIPE A ;SHOULD WE CHANGE TO OLD ALTMODES?
TXOA F2,S.NALT ;DON'T CONVERT
TXZ F2,S.NALT ;DO CONVERT
IFN CRT,<
MOVX TT,.TOWID ;GET WIDTH OF TTY
MOVE A,[XWD 2,TT] ;USING A TRMOP.
TRMOP. A,
MOVEI A,^D72 ;ASSUME 72 IF NO TRMOP.
MOVEM A,TTYWID ;STORE IT
>
PUSHJ P,TYOM ;TYPE *
LIS01: TXZ F2,S.SLOG!S.ASTR ;[325] LOG FILE IS FULLY ACTIVE AGAIN
TXOE FF,F.EMSG ;[325] IS ONE ALREADY IN?
JRST LIS01A ;[325] YES
TXO FF,F.DDTM ;[325] NO, FORCE CHARACTER MODE ON IT
PUSHJ P,TYI
LIS01A: CAIN CH,.CHLFD ;[325] IF 1ST CHAR IS LF,
JRST IM1LT ;[325] DO A 1LT.
CAIN CH,";" ;[325] IF IT'S A SEMI-COLON,
JRST IM0LT ;[325] DO A 0LT.
CAIN CH,.CHCNH ;[325] IF IT'S A BACKSPACE,
JRST IMN1LT ;[325] DO A -1LT.
CAIE CH,"*" ;1ST CHAR AN ASTERISK?
JRST LIS02 ;NO, CONTINUE NORMALLY
;SAVE PREVIOUS COMMAND STRING IN NAMED Q-REGISTER
TXNE F2,S.LIN ;[325] PUT THE * INTO LOG FILE?
PUSHJ P,LOGOUT ;[325] YES
SETZM EATCH ;NO CHARACTER READ YET
TXNE F2,S.GOIN ;ANY CMD STRG SEEN YET? IF NOT, * IS ILLEGAL
JRST LIS03 ;OK
$NCS: PUSHJ P,CRR ;MUST PUT CR/LF BEFORE ?NCS
ERROR E.NCS
LIS03: MOVE C,COMLEN ;LENGTH OF STRING
TXNE F2,S.NRAD ;IS IT AN FS...$$?
ADDI C,1 ;YES, DON'T OMIT LAST ALTMODE
ADDI C,2 ;OMIT LAST ALTMODE
MOVEI B,CMDBFR ;POSITION OF FIRST CHAR. IN BYTES
IFN BUGSW,
IMULI B,5
PUSHJ P,X3 ;TRANSFER STRING TO Q-REG
PUSHJ P,TYI ;GET Q-REG NAME FOR * COMMAND
MOVEM CH,EATCH ;SAVE IN CASE ERROR
TXNE F2,S.LIN ;[325] PUT IN LOG FILE?
PUSHJ P,LOGOUT ;[325] YES
MOVE A,TIB+.BFPTR ;GET POINTER TO CURRENT CH
MOVEM A,CPTR ;STORE FOR POSSIBLE ERROR
PUSHJ P,QREGV2 ;STORE 400000 IN QTAB
MOVEM B,QTAB-"0"(CH)
TXZ FF,F.EMSG ;NEXT INPUT CHAR NOT IN
LIS02: SETZM COMCNT ;COMCNT:=0
TXZ F2,S.NRAD ;CLEAR FLAG
SETZM SYMS
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND-1
MOVE AA,CBUF
MOVE B,CBUFH
LI1: TXZ FF,F.ALT+F.BELL+F.XPLN+F.EM
LI2: TXZ F2,S.SLOG ;THINGS MAY AGAIN ENTER LOG FILE
CAILE B,(AA) ;COMMAND BUFFER EXCEEDED?
JRST LI3 ;NO
;TO SEE IF TECO WILL NEED MORE CORE FOR COMMAND
;BUFFER EXPANSION. IF SO, GET IT
MOVE C,Z ;GET THE NUMBER OF CHARACTERS NOW
ADDI C,500 ;WILL WE OVERFLOW IF THIS IS REQUESTED?
CAMGE C,MEMSIZ ;[320] WILL THIS OVERFLOW?
JRST .+5 ;NO, FORGET THIS EVER HAPPENED
MOVEM 17,AC2+15 ;[354] Will overflow, therefore save AC#17
MOVE 17,C ;THIS IS THE REQUEST FOR MEMORY
PUSHJ P,GRABKQ ;GET THE NECESSARY CORE
MOVE 17,AC2+15 ;[354] Restore AC#17
SUBTTL EXPAND THE COMMAND BUFFER
ADDI B,100 ;YES. EXPAND COMMAND BUFFER 100 WORDS.
MOVE C,Z
IDIVI C,5 ;C:=DATA BUFFER END WORD ADDRESS.
MOVE D,QRBUF
PUSH P,F2 ;KLUDGE TO PROTECT F2 UNTIL AC'S ARE REORDERED
IDIVI D,5 ;D:=Q-REG BUFFER BASE WORD ADDRESS.
POP P,F2 ;RESTORE FLAGS
SUBM C,D ;D:=NO. OF WORDS IN Q-REG BUFFER AND DATA BUFFER.
MOVE CH,(C)
MOVEM CH,100(C) ;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS.
SOS C
SOJGE D,.-3
MOVEI C,500
ADDM C,BEG ;BEG:=C(BEG)+500
ADDM C,PT ;PT:=C(PT)+500
ADDM C,Z ;Z:=C(Z)+500
ADDM C,QRBUF ;QRBUF:=C(QRBUF)+500
MOVE D,Z
LI3: MOVEM B,CBUFH ;NO. RESET HIGH END OF COMMAND BUFFER.
TXZN FF,F.EMSG ;1ST CHAR IN ALREADY?
PUSHJ P,TYI ;GET A NON-NULL CHARACTER IN CH
IFN CRT,
CAIN CH,.CHDEL ;RUBOUT?
JRST DELCHR ;YES
LI3A: TXZ F2,S.SLOG
AOS A,COMCNT ;NO. INCREMENT COMMAND CHARACTER COUNT
IDPB CH,AA ;STORE CHARACTER IN COMMAND BUFFER.
LI4: CAIE CH,.CHESC ;ALT-MODE?
JRST LI5 ;NO
TXZN F2,S.CTLR ;PREVIOUS CHAR. A ^R?
JRST LI7 ;NO
CHKEO EO21,LI7 ;IF EO=1, NEVERMIND ^R
LI9: TXZ FF,F.BELL ;ALTMODE CLEARS BELL FLAG
JRST LI2
LI7: TXON FF,F.ALT ;YES. SET ALT-MODE FLAG. WAS IT ON?
JRST LI9 ;NO
MOVEM A,COMAX ;SET COMMAND CHARACTER ADDRESS UPPER BOUND
MOVEM A,COMLEN ;SAVE IN CASE OF * COMMAND NEXT
MOVE AA,CBUF ;INIT COMMAND BYTE PTR
MOVE B,AA ;IN CASE INTO LOG FILE
MOVEM AA,CPTR
SKIPE CCLSW ;READING CCL CMD?
PUSHJ P,TTOPEN ;YES, INIT TTY
TXNE F2,S.LIN ;PUT YOUR TYPIN IN LOG FILE?
PUSHJ P,BUFTYP
TXNN F2,S.LIN ;INPUT TO FILE TOO?
TXO F2,S.SLOG ;NO, SO DON'T PUT THIS CRLF THERE
PUSHJ P,CRR ;TYPE CRLF
TXZ F2,S.SLOG
SETZM CCLSW ;FINISHED WITH CCL READ
SETOM XCTING ;SET NO SCREW I FLAG
JRST CD ;RIGHT, SO DECODE COMMAND
BUFTYP: MOVE A,COMCNT ;HOW MANY CHARACTERS TO TRANSFER
BUFTY0: TXNE F2,S.LOUT ;[325]
TXO F2,S.OLOG
LOGLP: ILDB CH,B ;GET CHARACTER
TXNN F2,S.LOUT ;SENDING OUTPUT TOO?
PUSHJ P,LOGOUT ;NO, SEND VEBATIM
TXNE F2,S.LOUT
PUSHJ P,TYOM ;SEND TO LOG FILE
SOJG A,LOGLP ;EMPTY BUFFER
TXO F2,S.OLOG ;ONLY IN LOG FILE IF ANYWHERE
TXNN F2,S.LOUT
PUSHJ P,CRR
TXZ F2,S.OLOG ;SO TYPE OUT HAPPENS CORRECTLY
POPJ P,
SUBTTL PROCESS SPECIAL COMMAND EDITING CHARACTERS
LI5: CAIN CH,.CHCNR ;^R?
JRST CNTRLR ;YES
TXZ F2,S.CTLR ;NO, CLR FLAG IN CASE PRECEDING CHAR WAS
TXO F2,S.SLOG ;DON'T TYPE ANYTHING INTO LOG FILE HERE
CAIN CH,.CHCNU ;^U?
JRST CNTRLU ;YES
CAIN CH,.CHBEL ;BELL?
JRST LI6 ;YES
TXZN FF,F.BELL ;NO, PREVIOUS CHAR A BELL?
JRST LI1 ;NO, GET NEXT CHARACTER
CAIN CH,"." ;IS THIS A PERIOD?
JRST [MOVE D,COMCNT
SUBI D,2
SETZM COMCNT
MOVE AA,CBUF
ILDB CH,AA
SKIPN D
PUSHJ P,BACKUP
PUSHJ P,RETYP3
JRST LI2] ;RETYPE ENTIRE COMMAND
CAIE CH," " ;YES, IS THIS A SPACE?
JRST LI1 ;NO
PUSHJ P,RETYPE ;YES, GO DO A RETYPE
JRST LI2
RETYPE: PUSHJ P,BACKUP ;BACK OFF ^G
SOS D,COMCNT ;MARK CURRENT POSITION
PUSHJ P,BACKLN ;BACK UP TO BEG OF LINE
JRST RETYP3 ;HIT BEG OF COMMAND STRING
JRST RETY3A ;[331] Found a CR-EOL
RETYP3: PUSH P,CH ;SAVE 1ST CHAR
PUSHJ P,CRR ;TYPE CR-LF BEFORE COMMAND LINE
MOVEI CH,"*" ;RETYPE THE *
PUSHJ P,TYOM
POP P,CH ;RETRIEVE 1ST CHARACTER
RETY3A: PUSH P,ETVAL ;[331] Save ET value
SETZM ETVAL ;[331] ET=0 for retyping
JUMPE CH,RETYP4 ;DON'T PRINT ^@ IF NULL COMMAND STRING
RETYP1: SKIPL COMCNT ;SEE IF ANY COMMANDS
PUSHJ P,TYOM ;TYPE A CHAR OF COMMAND LINE
RETYP4: AOS C,COMCNT ;ADVANCE COMMAND CTR
CAIL C,(D) ;BACK IN PLACE?
JRST RETYP2 ;YES
ILDB CH,AA ;NO, GET NEXT CHAR
JRST RETYP1
RETYP2: POP P,ETVAL ;[331] Restore ET value
CAIN CH,.CHESC ;LOOKING AT AN ALTMODE?
TXO FF,F.ALT ;YES, BETTER SET FLAG
POPJ P, ;RETURN
LI6: TXOE FF,F.BELL ;YES. SET BELL FLAG. TWO SUCCESSIVE BELLS?
SOJA A,LI8 ;YES, REJECT COMMAND
TXO FF,F.DDTM ;GET ANOTHER CHAR WITH TTCALL 0
JRST LI2
LI8: MOVEM A,COMLEN
PUSHJ P,CRR ;YES. TYPE A CRLF
TXO F2,S.GOIN!S.ASTR ;SO YOU CAN DO *I AFTER ^G^G
JRST GO ;AND CLEAR COMMAND BUFFER.
SUBTTL BACK UP BYTE POINTER IN AA, LOAD APPROPRIATE CHARACTER IN CH,
;AND ADJUST COMCNT
BACKUP: ADD AA,[7B5] ;BACK UP CHAR PTR
JUMPG AA,.+2 ;OK NOW?
SUB AA,[430000,,1] ;NO NEEDS FURTHER FIXING
LDB CH,AA ;LOAD CHAR
SOS C,COMCNT ;DECREMENT COMMAND COUNT
POPJ P,
;BACKUP TO BEGINNING OF CURRENT LINE
;CALL: PUSHJ P,BACKLN
; RETURN IF BACKUP WENT TO BEGINNING OF COMMAND STRING
; RETURN IF CR-EOL COMBINATION FOUND
BACKLN: PUSHJ P,BACKUP ;BACK UP ONE CHAR
JUMPLE C,CPOPJ ;RETURN IF NOTHING LEFT
BACKL1: PUSHJ P,CKEOL ;IS THIS AN EOL CHAR?
JRST BACKLN ;NO, KEEP BACKING UP
PUSHJ P,BACKUP ;YES, BACK UP ONE MORE
CAIE CH,.CHCRT ;IS THIS A CR?
JRST BACKL1 ;NO, MAYBE ANOTHER EOL?
JRST CPOPJ1 ;YES, TAKE SKIP RETURN
;PROCESS CONTROL-U
CNTRLU: PUSHJ P,TYOM ;ECHO THE ^U
PUSHJ P,BACKLN ;BACK UP TO BEG OF LINE
JUMPLE C,CTLU1 ;IF NOTHING LEFT, RETYPE *
AOS COMCNT ;KEEP CRLF
IBP AA
CTLU1:
IFN CRT,
PUSHJ P,CRR ;OUTPUT A REGULAR CRLF
JUMPLE C,CLIS ;IF NOTHING LEFT, START FROM SCRATCH
JRST LI1 ;CONTINUE TYPE-IN
;CONTROL-R IN COMMAND MODE PREVENTS AN ALTMODE AFTER IT
;FROM BEING A TERMINATOR
CNTRLR: TXZN F2,S.CTLR ;^R ON ALREADY?
TXO F2,S.CTLR ;NO, SET FLAG
JRST LI1
SUBTTL SPECIAL "IMMEDIATE" COMMAND PROCESSOR
;[325] HERE TO MAKE AN INITIAL DO A "1LT$$"
IM1LT: TXO F2,S.SLOG ;TURN OFF LOG FILE BRIEFLY
MOVEI CH,.CHCRT ;[331] Type a to get to left margin
PUSHJ P,TYOA ;[331]
IFN CRT,<
SKIPE CRTTYP ;DO WE HAVE A SCREEN,
SKIPN DELLF ;AND A WAY OF GOING UP?
JRST IM1LTA ;NO
MOVEI A,DELLF ;WE ARE ON A CRT,
PUSHJ P,OUTIMG ;[331] CANCEL THE SO WE DON'T WASTE SPACE
MOVEI A,BACSEQ ;NOW GET RID OF THE "*" IN CASE OF BLANK LINE
PUSHJ P,OUTMES ;...
> ;END OF CRT
IM1LTA: HRRI B,[BYTE (7) "+","L","T",.CHESC,.CHESC] ;LOG FILE COMMAND
JRST IMCOM ;GO TO THE COMMON CODE
;HERE TO MAKE A <^H> DO A "-LT$$"
IMN1LT: HRRI B,[BYTE (7) "-","L","T",.CHESC,.CHESC] ;[331] COMMAND FOR LOG FILE
TXOA FF,F.NEG ;[331] FAKE A -1 ARG
;AND FALL INTO IM0LT FOR A WHILE...
;HERE TO MAKE A <;> DO A "0LT$$"
IM0LT: TXZ FF,F.NEG ;[331] MAKE SURE F.NEG IS OFF
TXO F2,S.SLOG ;TURN OFF LOG FILE
IFN CRT,<
SKIPE CRTTYP ;[331] ARE WE ON A SCREEN?
JRST [SKIPE CTUSEQ ;[331] YES, DO WE HAVE A LINE DELETE MECHANISM?
JRST [MOVEI A,CTUSEQ ;[331] YES, WE MUST BE ON A SCREEN
PUSHJ P,OUTMES ;[331] DELETE THE LINE
JRST IM0LT1] ;[331] GET BACK IN LINE
;[331] NO EOL, SO WE DO IT WITH BACKSPACE
TXNE FF,F.NEG ;[331] WAS THIS A ;?
JRST [PUSHJ P,BACONE ;[331] YES, SO BLANK OUT THE *
JRST IM0LT1] ;[331] AND JUMP BACK IN LINE
MOVEI A,BACCHR ;[331] IT WAS A ; SO BACK OVER IT
PUSHJ P,OUTMES ;[331]
PUSHJ P,BACTWO ;[331] AND BLANK OUT THE *;
JRST IM0LT1] ;[331] NOW PROCEED
> ;END OF CRT
PUSHJ P,CRR ;NOT A SCREEN--DO A CRLF
IM0LT1: TXNE FF,F.NEG ;HAVE WE ALREADY FAKED A -1 ARG?
JRST IMCOM ;YES, SKIP AHEAD TO COMMON CODE
TXO FF,F.ARG ;FAKE THE PRESENCE OF A 0 ARG.
HRRI B,[BYTE (7) "0","L","T",.CHESC,.CHESC] ;COMMAND FOR LOG FILE
;FALL INTO COMMON CODE
IMCOM: HRLI B,(POINT 7,) ;FORM POINTER FOR LOG FILE COMMAND
MOVEI A,5 ;FIVE CHARACTERS
MOVEM A,COMLEN ;SAVE IN CASE OF * COMMAND
MOVE AA,CBUF ;GET START OF COMMAND BUFFER
POP B,1(AA) ;STORE COMMAND THERE
AOBJP B,.+1 ;READJUST B
TXZ F2,S.SLOG ;TURN LOG FILE BACK ON
TXNN F2,S.LIN ;TO PUT IT INTO LOG FILE?
JRST IMCOM1 ;NO, SKIP THIS
PUSH P,F2 ;SAVE FLAGS
TXZ F2,S.LOUT ;PRETEND /NOOUT SO CRLF GETS PUT IN
PUSHJ P,BUFTY0 ;GO INSERT COMMAND IN LOG FILE
POP P,F2 ;RESTORE FLAGS
IMCOM1: SETZM B ;PUT ZERO INTO B IN CASE WE'RE DOING "0LT"
PUSHJ P,GETARG ;COMPUTE +L/0L/-L
XOR B,C ;APPLY L MOVEMENT TO POINTER
XORM B,PT ;...
TXZ FF,F.ARG!F.ARG2 ;FAKE NO ARGS
PUSHJ P,TYPE ;GO TYPE THE LINE
JRST GO
SUBTTL RUBOUT PROCESSOR
IFE CRT,<
DELCHR: >
RUBOUT: TXO F2,S.SLOG
SKIPG COMCNT ;ANYTHING TYPED IN?
JRST CLIS1 ;NO, RETYPE *
IFN RUBSW,<
SETO A, ;GETLCH ON THIS TTY
GETLCH A ;SET TO SUPPRESS ECHOING
TLO A,4
SETLCH A
PUSHJ P,SPLAT ;ACT LIKE THE MONITOR
JRST RUB4
RUB1: SKIPGE COMCNT ;PAST BEGINNING OF COMMAND STRING YET?
JRST RUB3 ;YES
PUSHJ P,TYIDDT ;GET ONE CHARACTER
CAIE CH,.CHDEL ;RUBOUT?
JRST RUB2 ;NO
RUB4: >
LDB CH,AA ;RELOAD THE CHAR.
SKIPE COMCNT ;UNLESS AT BEGINNING OF COMMAND STRING,
PUSHJ P,TYOM ;ECHO THE DELETED CHAR.
PUSHJ P,BACKUP ;BACK OVER THE CHAR.
IFN RUBSW,
IFE RUBSW,
CAIN CH,"R"-100 ;IF PREVIOUS CHARACTER WAS ^R
TXO F2,S.CTLR ;RESET FLAG
IFE RUBSW, ;RESUME TYPE-IN
IFN RUBSW,<
JRST RUB1 ;TRY NEXT INPUT CHAR.
RUB2: PUSH P,CH ;SAVE THIS GOOD GUY
PUSHJ P,SPLAT ;TYPE THE SECOND \
POP P,CH ;GET THAT CHAR. BACK
CAIE CH,.CHCNU ;CTRL-U?
PUSHJ P,TYOM ;NO, ECHO IT
PUSHJ P,TTCREE ;RESET TTCALL FOR ECHOING
JRST LI3A ;PROCESS THIS CHAR.
RUB3: PUSHJ P,SPLAT ;SECOND \
PUSHJ P,TTCREE ;RESET TTCALL MODE TO NORMAL
JRST CLIS1 ;START A NEW COMMAND STRING
>
;TYPE BACKSLASH
IFN RUBSW,<
SPLAT: MOVEI CH,"\"
JRST TYOM
>
;RESET TTCALL FOR ECHOING
IFN RUBSW,<
TTCREE: SETO A, ;GETLCH ON THIS TTY
GETLCH A
TLZ A,GL.LCP ;TURN OFF NO ECHO BIT
SETLCH A
POPJ P,
>
SUBTTL VIDEO RUBOUT PROCESSOR
IFN CRT,<
DELCHR: MOVE A,CRTTYP ;GET CRT FLAGS
CAIN CH,.CHDEL ;IF ITS A DELETE,
TRNN A,.CRUB. ;AND IT GETS NORMAL TREATMENT
SKIPN CRTTYP ;OR CRTTYP IS 0
JRST RUBOUT ;THEN GO TO OLD ROUTINE
TXO F2,S.SLOG ;NOTHING GOES INTO LOG FILE
MOVEI A,CANRUB ;CANCEL THE EFFECT, IF ANY, OF THE RUBOUT
CAIE CH,.CHDEL
MOVEI A,CANBAK ;OR THE BACKSPACE
PUSHJ P,OUTMES
SKIPG COMCNT ;HAS ANYTHING BEEN SEEN?
JRST BACNON ;NO
PUSHJ P,HORPOS ;GO FIGURE OUT HORIZONTAL POSITION
LDB CH,AA ;GET DOOMED CHARACTER
CAIG CH,.CHBEL ;^G OR LESS?
JRST BACDUB ;YES, THEY ARE TWO WIDE
CAIN CH,.CHCNH ;BACKSPACE?
JRST BACBAK
CAIN CH,.CHTAB ;TAB?
JRST BACTAB
CAIG CH,.CHFFD ;EOL? (LF, VT, FF)
JRST BACEOL
CAIN CH,.CHCRT ;CARRIAGE RETURN?
JRST BACCR
CAIE CH,.CHESC ;ALTMODE,
CAIL CH," " ;BLANK OR GREATER?
JRST BACNOR
BACDUB: PUSHJ P,BACTWO ;HERE TO RUBOUT A CHAR OF WIDTH 2
TRNA ;[331]
BACNOR: PUSHJ P,BACONE
DELDON: PUSHJ P,BACKUP ;WIPE IT FROM COMMAND STRING
CAIL E,(OU) ;ARE WE BACK TO A FREE CRLF?
JRST LI1 ;NO, RETURN
DELFIN: PUSHJ P,HORPOS ;YES, GO RECALCULATE LENGTH
PUSHJ P,BACREW ;AND RETYPE ABOVE LINE
JRST LI1 ;AND RETURN
BACEOL: MOVEI T,1 ;GET MULTIPLIER (LF=1)
CAIE CH,.CHLFD ;IF NOT LF,
MOVE T,VTMUL-13(CH) ;GET REAL MULTIPLIER
MOVEI TT,DELLF-12(CH) ;GET PROPER STRING
MOVEI A,FORCHR ;GET READY TO UNDO THE BACKSPACE
MOVE CH,CRTTYP ;GET THE FLAGS FOR THIS CRT
TRNE CH,.CWAP. ;IF THIS CRT DOES WRAP AROUND,
SKIPE E ;OR IF WE ARE NOT AT THE LEFT MARGIN
PUSHJ P,OUTMES ;THEN CANCEL THE BACKSPACE
EOL1: JUMPLE T,DELDON ;FINISHED?
MOVE A,TT ;GET STRING
PUSHJ P,OUTIMG ;[331] AND TYPE IT
SOJA T,EOL1 ;LOOP
BACCR: MOVEI A,DELCR
PUSHJ P,OUTIMG ;[331]
IBP AA
AOS COMCNT
PUSHJ P,RETYPE ;FAKE A ^G
JRST LI2 ;WE'RE DONE
BACBAK: MOVEI A,FORCHR ;CANCEL A BACKSPACE
PUSHJ P,OUTMES
PUSHJ P,BACKUP
JRST LI1
BACNON: MOVE CH,CRTTYP ;GET FLAGS
TRNE CH,.CNCR. ;SHOULD WE SEND A LONE CR?
JRST CLIS ;NOPE
MOVEI CH,.CHCRT ;TYPE A CR
PUSHJ P,TYOA
JRST CLIS ;AND RETYPE *
HORPOS: MOVE TT1,COMCNT ;SAVE CURRENT CHARACTER COUNT
SETZ E, ;INIT LINE WIDTH TO 0
LDB CH,AA ;GET CURRENT CHAR
PUSHJ P,BACKL1 ;BACK UP TO THE BEGINNING OF CURRENT LINE
AOS E ;IF INITIAL LINE, THEN ACCOUNT FOR *
MOVE T,AA ;SAVE POINTER
MOVE TT,COMCNT ;AND COMMAND COUNT
IBP T ;BUMP THE POINTER UP, TO PLEASE RETYPE
POS2: MOVE OU,E ;SAVE LENGTH
ILDB CH,AA ;GET NEXT CHAR
PUSHJ P,LENCHR ;CALCULATE LENGTH OF CHARACTER
AOS D,COMCNT ;BUMP CHAR COUNT
CAIL D,(TT1) ;ARE WE BACK IN PLACE YET?
POPJ P, ;YES
JRST POS2
BACTAB: PUSHJ P,BACKUP ;GET RID OF THE TAB
CAIGE E,(OU) ;ARE WE AT A FREE CRLF?
JRST DELFIN ;YES
SUBI E,1(OU) ;GET LENGTH OF TAB-1
BTAB1: JUMPLE E,LI1 ;RETURN IF LENGTH IS 0
MOVEI A,BACCHR ;BACK UP
PUSHJ P,OUTMES
SOJA E,BTAB1 ;LOOP
BACREW: MOVEM T,AA ;HERE WHEN WE BACK UP OVER A FREE CRLF
MOVEM TT,COMCNT ;RESTORE AA AND COMCNT (LAST TIME POS=0)
SKIPN DELLF ;IF DELLF IS NULL, DONT BOTHER WITH THIS
JRST BACRW0
MOVEI A,DELLF
PUSHJ P,OUTIMG ;MOVE UP TWO LINES
PUSHJ P,OUTIMG
PUSHJ P,CRR ;TYPE A CRLF TO RESET HOR. POS.
BACRW0: MOVEI CH,"*" ;ARE WE AT THE BEGINING OF A COMMAND?
SKIPN COMCNT
PUSHJ P,TYOA ;YES
BACRW1: LDB CH,AA
PUSHJ P,CKEOL ;WE DONT WANT EOL'S
PJRST RETY3A ;[331] GO FAKE ^G
IBP AA ;GET THE NEXT ONE
AOS COMCNT
JRST BACRW1 ;LOOP
BACONE: MOVEI A,BACSEQ ;TO BACK OVER AND BLANK OUT A CHARACTER
PJRST OUTMES
BACTWO: PUSHJ P,BACONE ;HERE TO DELETE A DOUBLE CHAR
MOVEI A,BACCHR
PUSHJ P,OUTMES
PJRST BACONE ;[331] ONCE AGAIN
;ROUTINE TO CALCULATE THE WIDTH OF A CHARACTER
LENCHR: SETZ D,
CAIE CH,.CHESC ;AN ALTMODE
CAIL CH," " ;OR ANYTHING " " OR OVER
AOJA D,LEN1 ;IS OF WIDTH 1
CAIN CH,.CHCNH ;A BACKSPACE IS -1
SOJA D,LEN2
CAIN CH,.CHLFD ;A LINEFEED IS 0
JRST LEN1
CAIN CH,.CHVTB ;A VERTICAL TAB MAY BE SPECIAL
JRST [ADD D,VTWID
JRST LEN1]
CAIN CH,.CHFFD ;A FORM FEED MIGHT ALSO
JRST [ADD D,FFWID
JRST LEN1]
CAIE CH,.CHTAB ;A TAB?
JRST [ADDI D,2 ;NOPE, ALL ELSE OF WIDTH 2
JRST LEN1]
ADDI E,10 ;STANDARD TAB WIDTH
TXZ E,7 ;BUT MUST BE MULTIPLE OF 8
MOVEI D,10
SKIPA
LEN1: ADD E,D ;THIS IS THE NEW LENGTH
LEN2: CAMG E,TTYWID
POPJ P,
MOVE E,D ;WE ARE AT A FREE CRLF
MOVE T,AA ;SO SAVE THE BP AND THE COUNT
MOVE TT,COMCNT
POPJ P, > ;END OF CRT CONDITIONAL
SUBTTL COMMAND DECODER
STOP: MONRT. ;SIMULATE ^C AT MACRO LEVEL
CD:RET: HRRZS EATCH ;FLAG NOT TO EAT AFTER : ANYTHING FAILS
TXZE FF,F.COLN ;F.COLN WHATEVER?
JRST FFOK ;RETURN -1, WHATEVER IT WAS IT WAS SUCCESSFUL
RETRET: TXZ FF,F.EBTP!F.ARG2!F.ARG!F.LARW!F.NSRH!F.SQIN!F.SRCH
TXZ F2,S.SSEQ!S.DPPN!S.OLOG!S.SLOG!S.MINS!S.DOIT!S.INFO!S.DELS
SKIPE INI ;IF INI FILE IN PROGRESS, NO COMMAND SEEN
TXO F2,S.GOIN ;A COMMAND STRING IS IN
CD1: SETZM NUM ;NO ARGUMENT STRING SEEN
SETZM SYL
TXZ FF,F.NEG ;CLEAR MINUS SIGN FLAG
MOVX A, ;STANDARD ARG OPERATOR IS MOVE B,SYL
CD3: HLLM A,DLIM
CD5: PUSHJ P,RCH
CD9: SKIPN XCTING ;KEEP GOING?
JRST GO ;NO STOP
MOVE A,CH ;GET COMMAND CHARACTER
CAIL CH,"0" ;IS IT A DIGIT?
CAILE CH,"9"
TRNA ;[331] No, go clear flags
JRST CD91 ;[331] Yes, leave flags alone
TXZ FF,F.SYL ;[331] Clear digit string bit
TXZ F2,S.OCTL ;NO, CLEAR OCTAL RADIX FLAG
CD91: CAIE A,140 ;[331] 140 IS ILLEGAL
CAILE A,172 ;ALSO 173-177 ARE ILLEGAL
MOVEI A,0
CAILE A,137 ;REDUCE LOWER CASE TO UPPER
SUBI A,40
ROT A,-1 ;DIV BY 2
JUMPL A,CD92 ;ODD CHARACTER
HLRZ A,DTB(A) ;GET CODE & ADDR FOR EVEN CHAR.
JRST CD93
CD92: HRRZ A,DTB(A) ;GET CODE & ADDR FOR ODD CHAR.
CD93: TXZ F2,S.DOIT!S.INFO!S.MINS!S.EA!S.DPPN!S.YANK ;CLEAR INI FILE FLAGS
TXZ FF,F.INIT!F.FILE
TRNN A,300000 ;IS IT A JRST DISPATCH WITH NO ARG PROCESSING?
JRST (A) ;YES, DO IT
MOVE B,NUM ;NO, TAKE CARE OF ARGUMENTS
MOVE C,DLIM ;GET DLIM
TLNE C,777K ;IF NO OPERATION DON'T DO IT!
XCT C ;NUM:=NUM (DLIM OPERATOR) SYL
MOVEM B,NUM
SETZM SYL ;CLEAR OLD OPERAND
MOVSI C,(MOVE B,) ;DON'T USE THE SAME OP TWICE!
HLLM C,DLIM ;SO RESET DLIM
MOVE C,SARG ;SAVE SECOND ARGUMENT IN C.
TXZ F2,S.CTLV+S.CTVV+S.CTLW+S.CTWW+S.EMAT+S.NCCT ;[344]
MOVEM P,PDLSAV
TRZ A,100000 ;CLR PUSHJ DISPATCH BIT
TRZE A,200000 ;JRST OR PUSHJ DISPATCH?
JRST (A)
PUSHJ P,(A)
JRST RET
SUBTTL NUMERIC INPUT, VALRET, & ALTMODE PROCESSOR
;DIGITS FORM DECIMAL INTEGERS.
CDNUM: TXON FF,F.SYL ;DIGIT STRING ALREADY STARTED?
SETZM SYL ;NO, INIT TO ZERO
MOVEI A,12 ;RADIX 10
TXNN F2,S.OCTL ;OCTAL FLAG ON?
JRST CDNUM1 ;NO
MOVEI A,10 ;YES, RADIX 8
CAILE CH,"7" ;FLAG 8 OR 9 IN OCTAL STRING
ERROR E.OCT
CDNUM1: IMUL A,SYL ;SCALE PREVIOUS VALUE
ADDI A,-60(CH) ;ADD IN NEW DIGIT
;SOME COMMANDS HAVE A NUMERIC VALUE
VALRET: HRRZS EATCH ;CLEAR THE EAT FLAG
MOVEM A,SYL
CD7: TXO FF,F.ARG
JRST CD5
ALTMOD: SKIPN COMCNT ;ANY COMMANDS LEFT?
JRST ALTM2 ;NO
MOVE T,CPTR ;IF NEXT COMMAND CHARACTER IS ALT-MODE, GO
ILDB CH,T
CAIE CH,.CHESC
JRST CD
ALTM1: TXNE FF,F.TRAC ;TRACING?
PUSHJ P,CRR ;YES, TYPE CR/LF BEFORE *
JRST GO
ALTM2: SKIPN EQM ;WITHOUT A MACRO ?
JRST GO ;NO
JRST CD ;MACRO RETURN
;^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER.
UAR: PUSHJ P,SKRCH ;GET NEXT COMMAND CHARACTER.
ERROR E.MEU
TRZ CH,140 ;CHANGE IT TO CONTROL CHARACTER
JRST CD9 ;DISPATCH
SUBTTL COMMA & PARENTHESES PROCESSOR
;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM
COMMA: MOVEM B,SARG ;SAVE CURRENT ARGUMENT IN SARG.
TXZE FF,F.ARG ;WAS THERE A CURRENT ARGUMENT?
TXOE FF,F.ARG2 ;YES. WAS THERE ALREADY A SECOND ARGUMENT?
ERROR E.ARG
JRST CD1 ;YES. CLEAR CURRENT ARGUMENT.
;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN FOR +,-,*,/,& AND #.
OPENP: PUSH P,NUM ;PUSH CURRENT ARGUMENT.
PUSH P,DLIM ;CURRENT OPERATOR
PUSH P,[1] ;SET PAREN FLAG ON PDL
JRST CD1
CLOSEP: POP P,T ;LAST THING ON PDL A LEFT PAREN?
JUMPL T,CLOSE1 ;SOMETHING LIKE (...<...)
SOJN T,CLOSE2 ;MISSING (
MOVEM B,SYL ;YES. SAVE CURRENT ARGUMENT.
POP P,DLIM ;RESTORE OPERATOR
POP P,NUM ;RESTORE ARGUMENT.
JRST CD7
CLOSE1: ERROR E.PAR
CLOSE2: ERROR E.MLP
;^O SETS FLAG FOR OCTAL RADIX INPUT
OCTIN: TXO F2,S.OCTL
JRST CD5 ;RETURN WITHOUT MESSING UP ARGUMENTS
;IF 'HE' CAN HAVE ^F READ THE SWITCHES I CAN HAVE N^F RETURN
;THE TTY NUMBER OF JOB N + 200000 OCTAL OR ZERO IF NONE!!!!
WHERE: TRMNO. B, ;WHAT TTY HE ON
JRST BEGIN ;ZERO, NOT ONE ONE
MOVE A,B ;RETURN VALUE
JRST VALRET ;...
SUBTTL MATHEMATICAL & LOGICAL OPERATORS
;LOGICAL AND
CAND: MOVSI A,(AND B,) ;DLIM = AND B,SYL
JRST CD3
;LOGICAL OR
COR: MOVSI A,(OR B,) ;DLIM = OR B,SYL
JRST CD3
;ADD TAKES ONE OR TWO ARGUMENTS
PLUS: MOVSI A,(ADD B,) ;DLIM = ADD B,SYL
JRST CD3
;SUBTRACT TAKES ONE OR TWO ARGUMENTS
MINUS: MOVSI A,(SUB B,) ;DLIM = SUB B,SYL
TXO FF,F.NEG ;SET FLAG FOR -L, -T, ETC...
JRST CD3
;MULTIPLY TAKES TWO ARGUMENTS
TIMES: MOVSI A,(IMUL B,) ;DLIM = IMUL B,SYL
JRST CD3
;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS
SLASH: MOVSI A,(IDIV B,) ;DLIM = IDIV B,SYL
JRST CD3
SUBTTL FLAGS - EOF, FORM FEED & . H Z POSITIONS
;RETURNS THE VALUE OF THE FORM FEED FLAG
FFEED: TXNE FF,F.FORM ;IS IT SET?
JRST FFOK ;YES, RETURN A -1
JRST BEGIN ;NO, DO BEGIN ROUTINE
;RETURNS THE NUMERIC VALUE 0.
ABEGIN: SKIPL EATCH ;TO MUNCH?
JRST BEGIN ;NO, PIG!
MOVEI B,.CHESC ;TECO'S ALTMODE
HRRZS CH,EATCH ;GET LAST CHARACTER INPUT FROM COMMAND
SAMECH: CAMN CH,B ;SAME?
JRST BEGIN ;RETURN FAILURE VALUE
READNT: PUSHJ P,SKRCH ;GET ANOTHER CHARACTER IF NOT
ERROR E.UCS
JRST SAMECH ;LOOP TIL U SEE IT
BEGIN: MOVEI A,0
JRST VALRET
;^N RETURNS VALUE OF EOF FLAG
EOF: TXNN FF,F.EOFI ;EOF SEEN?
JRST BEGIN ;NO, RETURN 0
JRST FFOK ;YES, RETURN -1
;AN ABBREVIATION FOR B,Z
HOLE: SETZM SARG ;SET SECOND ARGUMENT TO 0.
TXNE FF,F.ARG2 ;FLAG ANY ARGS BEFORE H
ERROR E.ARG
TXOA FF,F.ARG2
;.=NUMBER OF CHARACTERS TO THE LEFT OF THE POINTER
PNT: SKIPA A,PT
;Z=NUMBER OF CHARACTERS IN THE BUFFER
END1: MOVE A,Z
SUB A,BEG
JRST VALRET
;RETURN LENGTH OF LAST TEXT STRING PROCESSED
IFN VC,<
VCMD: MOVE A,VVAL ;LENGTH OF LAST TEXT
JRST VALRET
>
SUBTTL = & ^T COMMANDS
;N= CAUSES THE VALUE OF N TO BE TYPED OUT.
PRNT: TXNN FF,F.ARG ;INSIST ON ARG BEFORE =
ERROR E.NAE
MOVE A,CPTR ;SNEAK A LOOK AT NEXT COMMAND CHAR.
ILDB CH,A
CAIE CH,"=" ;ANOTHER = SIGN?
JRST PRNT9 ;NO
TXO F2,S.OCTL ;YES, THAT MEANS OCTAL RADIX TYPE-OUT
PUSHJ P,SKRCH ;SWALLOW THE EXTRA =
TXZ F2,S.OCTL ;AT END OF MACRO
PRNT9: PUSHJ P,PRNT9S ;PRINT NUMBER
TXZN FF,F.ARG2 ;TWO ARGS?
JRST CRR ;CRLF AND RETURN TO CALLER
JUMPL C,CRR ;NEG ARG MEANS CRLF WANTED
JUMPE C,CPOPJ ;NOTHING IF ZERO
MOVE CH,C ;GET CHARACTER TO BE OUTPUT
JRST TYO ;ELSE TYPE CHAR AND RETURN
;TYPE C(B) IN OCTAL
OCTMS: TXOA F2,S.OCTL ;SET OCTAL RADIX
DECMS: TXZ F2,S.OCTL ;DECIMAL RADIX
PRNT9S: MOVEI A,TYO ;OUTPUT ON TTY
PUSHJ P,DPT ;TYPE NUMBER
;[323] S.OCTL IS NOW CLEARED IN DPT
;[323] TXZ F2,S.OCTL ;CLR RADIX FLAG
POPJ P,
;CAUSES COMMAND INTERPRETATION TO STOP UNTIL THE USER TYPES A CHARACTER
;ON THE TELETYPE AND THEN HAS THE ASCII VALUE OF THE CHARACTER TYPED IN.
SPTYI: SETZM XCTING ;SO NO WAIT FOR INPUT ON ^C REE
TXZE FF,F.COLN ;EXTENDED TTY OPERATIONS?
JRST EXTTTY ;YES
TXO FF,F.DDTM
PUSHJ P,TYI ;GET A SINGLE CHAR.
SETOM XCTING ;RESET FLAG, HAVE CHARACTER
SKIPA A,CH
SUBTTL ^H, ^F AND ^^ COMMANDS
;HAS THE VALUE OF ELAPSED TIME, IN 60THS OF A SECOND, SINCE MIDNITE.
GTIME: TIMER A,
JRST VALRET
;HAS THE VALUE OF THE CONSOLE DATA SWITCHES.
LAT: TXZE FF,F.ARG+F.ARG2 ;EITHER OF THESE ON GO TO WHERE
JRST WHERE ;...
SWITCH A,
JRST VALRET
;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING.
CNTRUP: PUSHJ P,SKRCH ;^^ HAS VALUE OF CHAR FOLLOWING IT
ERROR E.MUU
MOVE A,CH
JRST VALRET
SUBTTL EXTENDED ^T OPERATIONS
;TABLE FOR EXTENDED TTY OPERATIONS
;FORMAT FIRST WORD 1B ON = LEGAL TTCALL
; SECOND WORD 1B ON = SHOULD SKIP (0 RETURNED IF NOT)
; THIRD WORD 1B ON = RETURNS A VALUE ELSE NOTHING
TABLE1: ^B111011111111110000000000000000000000
TABLE2: ^B001001000001100000000000000000000000
TABLE3: ^B101011100000000000000000000000000000
EXTTTY: MOVE A,C ;I LIKE TO DO IT THIS WAY!!
MOVN E,B ;GET - TTCALL NUMBER
SKIPLE E ;WAS IT A NEGATIVE TTCALL?
JRST HACK ;YES
MOVSI CH,400K ;TO DETERMINE WHAT TO DO
LSH CH,(E) ;GET IT
TDNN CH,TABLE1 ;LEGAL?
ERROR E.ITT
CAIN B, ;RESCAN FUDGE FUNCTIONS?
JRST REFUDG ;YES, DO THEM
TXZ FF,F.ARG2 ;SO NO TWO ARGS RETURNS
MOVE E,[TTCALL 0,A] ;FOR XCT
DPB B,[POINT 4,E,12] ;MAKE A TTCALL N,
XCT E ;DO IT
JRST NOSKP ;SEE WHAT TO DO
SETOM XCTING ;RESET I AM DOING SOMETHING FLAG
TDNN CH,TABLE3 ;DOES HE GET -1 OR C(A)
SETO A, ;-1
JRST VALRET ;MAKE IT AVAILABLR
NOSKP: SETOM XCTING ;FIX ACTIVE FLAG
TDNE CH,TABLE2 ;SHOULD HAVE SKIPPED
JRST BEGIN ;RETURN ZERO
TDNN CH,TABLE3 ;RETURN A VALUE?
JRST RET ;NO
JRST VALRET ;ELSE THROW THING IN A AT HIM
REFUDG: SETOM XCTING ;KEEP GOING!!!!
MOVE E,[RESCAN 1] ;ASSUME GOING TO RESCAN COMMAND LINE
TXZE FF,F.ARG2 ;TWO ARGS = RETURN VALUE OF CCL FLAG
MOVE E,[SKIPE CCLSW] ;TEST CCL SWITCH
XCT E
JRST FFOK ;COMMAND THERE = -1
JRST BEGIN ;0, NOTHING THERE
HACK: SETOM XCTING
CAILE E,2 ;LEGAL?
ERROR E.ITT
SETSTS TTY,@NOECHO-1(E)
JRST RET
NOECHO: EXP IO.SUP!IO.FCS!.IOASC
ECHO: EXP IO.FCS!.IOASC
SUBTTL BACKSLASH PROCESSOR
;HAS THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS (OR MINUS SIGN)
;FOLLOWING THE POINTER IN THE BUFFER. THE SCAN TERMINATES ON ANY OTHER
;CHARACTER. THE POINTER IS MOVED OVER THE NUMBER FOUND (IF ANY).
BAKSL: MOVE A,CPTR ;[323] GET THE COMMAND BYTE POINTER
ILDB CH,A ;[323] SNEAK A LOOK AT NEXT CHAR.
CAIN CH,"\" ;[323] IS IT ANOTHER BACKSLASH?
PUSHJ P,SKRCH ;[323] YES, TRY GETTING IT FOR REAL
TXZA F2,S.OCTL ;[323] NOPE, CLEAR OCTAL FLAG
TXO F2,S.OCTL ;[323] SET OCTAL FLAG
TXZE FF,F.ARG ;WHICH KIND OF BACKSLASH?
JRST BAKSL1 ;ARG TO MEMORY
MOVEI A,^D10 ;[323] ASSUME DECIMAL RADIX
TXZE F2,S.OCTL ;[323] IS IT REALLY OCTAL?
MOVEI A,^D8 ;[323] YES, SET IT
MOVE I,PT ;MEMORY TO VALRET
CAML I,Z ;CAN WE READ ANOTHER?
JRST BAKSL3 ;NO
PUSHJ P,GETINC ;CK FOR +,- SIGN
CAIN CH,"+"
JRST BAKSLA ;IGNORE +
CAIE CH,"-"
JRST BAKSL0 ;NO SIGN
TXO FF,F.ARG ;NEGATION FLAG
BAKSLA: CAML I,Z ;OVERDID IT ?
JRST BAKSL3 ;YES. EXIT
PUSHJ P,GETINC ;NO. GET A CHAR
BAKSL0: CAIGE CH,"0"(A) ;[330] DIGIT?
CAIGE CH,"0" ;DIGIT?
SOJA I,BAKSL2 ;NOT A DIGIT. BACKUP AND LEAVE LOOP
SUBI CH,"0" ;CONVERT TO NUMBER
EXCH CH,SYL
IMULI CH,(A) ;[323]
ADDM CH,SYL ;[323] SYL:= RADIX*SYL+CH
JRST BAKSLA ;LOOP
BAKSL3: MOVE I,Z ;HERE ON OVERFLOW
BAKSL2: TXZE FF,F.ARG ;MINUS SIGN SEEN?
MOVNS SYL ;YES. NEGATE
MOVEM I,PT ;MOVE POINTER PAST #
JRST CD7 ;DONE
SUBTTL nA COMMAND
;nA (WHERE n IS A NUMERIC ARGUMENT) = VALUE IN 7-BIT ASCII OF THE
;nTH CHARACTER TO THE RIGHT OF THE POINTER. 0A WILL RETURN THE
;CHARACTER TO THE LEFT OF THE POINTER, -NA WILL RETURN THE N+1st
;CHARACTER TO THE LEFT OF THE POINTER. IF .+N-1 IS NOT WITHIN
;BOUNDS, A 0 WILL BE RETURNED, EXCEPT IN THE CASE OF M,NA, IN
;WHICH CASE M IS RETURNED.
ACMD: TXNE FF,F.ARG ;[346] No argument implies Append
TXNE FF,F.COLN ;[346] Or is there a colon?
JRST APPEND ;Yes. THIS IN AN APPEND COMMAND.
SETZ CH, ;[346] Set up 0 for return value
CHKEO EODEC,ACMD2 ;[346] If EO = 2, do old-style 1A
TXZE FF,F.ARG2 ;[346] Was there a 2nd arg?
MOVE CH,C ;[346] Yes, use it instead
ACMD1: SOS I,B ;[346] Get arg-1
ADD I,PT ;[346] Add in point
CAML I,BEG ;[346] Check bounds
CAML I,Z ;BUFFER EMPTY OR PT=Z
TRNA ;[346] Out of bounds
PUSHJ P,GET ;CH:=CHARACTER TO THE RIGHT OF PT.
MOVE A,CH ;RETURN CH AS VALUE.
JRST VALRET
ACMD2: MOVEI B,1 ;[346] IF EO < 3, make arg=1
JRST ACMD1 ;[346]
SUBTTL Q-REGISTER COMMANDS -- U & Q
;NUI PUTS THE NUMERIC VALUE N IN Q-REGISTER I.
;M,NUI PUTS N INTO Q-REGISTER I AND RETURNS M.
USE: TXNN FF,F.ARG ;INSIST ON ARG BEFORE U
ERROR E.NAU
PUSHJ P,CRANGE ;[332] Go check range of argument
USEA: PUSHJ P,QREGVI ;YES. CH:=Q-REGISTER INDEX.
USEA1: MOVEM B,QTAB-"0"(CH) ;STORE ARGUMENT IN SELECTED Q-REG.
TXZN FF,F.ARG2 ;[332] IS THERE A SECOND ARG?
JRST RET ;[332] NO, RETURN
MOVE A,C ;[332] YES, RETURN IT
JRST VALRET ;[332]
;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.
QREG: PUSHJ P,QTXTST ;GET Q-REGISTER INDEX & CHECK FOR TEXT
JRST VALRET
PUSHJ P,QTEXEI ;GET Q REG ADR
PUSHJ P,GTQCNT ;# CHARS IN Q REG
MOVE B,CPTR ;GET COMMAND POINTER
ILDB CH,B ;QA= (IE TYPE TEXT IN Q REG)?
CAIE CH,"=" ;...
..ERROR E.NNQ
PUSHJ P,SKRCH ;EAT =
..ERROR E.NNQ
MOVE OU,I ;BEG OF Q REG
MOVE B,OU ;START CHARACTER
ADD B,C ;END
MOVEI D,TYO ;ROUTINE TO TYPE CHARS
SETZM XCTING ;SO ^C^C REE WORKS PROPERLY
PUSHJ P,TYPEQ ;TYPE CONTENTS OF Q-REG
SETOM XCTING ;DONE TYPING
JRST RET ;DONE
;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
QREGVI: PUSHJ P,SKRCH ;CH:=NEXT COMMAND STRING CHARACTER.
ERROR E.MIQ
QREGV2: CAIE CH,"*" ;EI REG?
JRST NOTEI
MOVEI CH,"Z"-<"A"-"9"-1>+1 ;INDEX INTO QTAB
POPJ P,
NOTEI: CAIL CH,"A"+" "-1 ;LC LETTER?
TXZ CH,40 ;MAKE UC
CAIGE CH,"0" ;DIGIT?
ERROR E.IQN ;BAD NAME
CAIG CH,"9"
POPJ P, ;YES
CAIL CH,"A" ;LETTER?
CAILE CH,"Z"
ERROR E.IQN ;BAD NAME
SUBI CH,"A"-"9"-1 ;TRANSLATE LETTERS DOWN BY NUMBER OF
POPJ P, ;CHARACTERS BETWEEN 9 AND A. ONLY 36 Q-REG'S
;[332] Routine to check range of number to be stored in a Q-reg.
CRANGE: TLNE B,400000 ;[332] Does arg look like a text pointer?
TLNE B,377777 ;[332] (I.E. less than -377777,,0?)
POPJ P, ;[332] OK, return
ERROR E.AOR ;[337] Out of range
SUBTTL Q-REGISTER COMMANDS -- %
;%I ADDS 1 TO THE QUANTITY IN Q-REGISTER I AND STANDS FOR THE
; NEW VALUE
PCNT: PUSHJ P,QTXTST ;GET Q-REG AND CHECK FOR TEXT
AOSA A,QTAB-"0"(CH) ;INCREMENT Q-REG.
..ERROR E.NNQ
JRST VALRET ;RETURN NEW VALUE.
QTXTST: PUSHJ P,QREGVI ;GET Q-REG INDEX
MOVE A,QTAB-"0"(CH) ;GET Q-REG CONTENTS
TLNE A,400000 ;DOES IT CONTAIN TEXT?
TLNE A,377777
POPJ P, ;YES, NON-SKIP RETURN
JRST CPOPJ1 ;ELSE CONTAINS TEXT
SUBTTL Q-REGISTER COMMANDS -- X
;M,NXI COPIES A PORTION OF THE BUFFER INTO Q-REGISTER I.
; IT SETS Q-REGISTER I TO A DUPLICATE OF THE (M+1)TH
; THROUGH NTH CHARACTERS IN THE BUFFER. THE BUFFER IS UNCHANGED.
;NXI INTO Q-REGISTER I IS COPIED THE STRING OF CHARACTERS STARTING
; IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH
; THE NTH LINE FEED.
X:
IFN VC, ;CLR STRING LENGTH HOLD
PUSHJ P,GETARG ;C:=FIRST STRING ARGUMENT ADDRESS
;B:=SECOND STRING ARGUMENT ADDRESS.
COPYEI: PUSHJ P,CHK1 ;IS SECOND ARG. ADDR. > FIRST ARG. ADDR.?
EXCH B,C ;YES.
SUB C,B ;[321] C:=LENGTH OF STRING
MOVE A,C ;[321] A:=LENGTH OF STRING SAVED
ADDI C,3 ;[321] C:=LENGTH OF STRING+3.
IFN VC,
ADD B,C ;B:=FIRST ARG ADDR + LENGTH OF STRING + 3
PUSHJ P,X3 ;MOVE DATA TO Q-REG BUFR
TXNN FF,F.INIT ;INI FILE THING?
JRST X0 ;[332] NO, MAKE QTAB ENTRY NORMALLY.
MOVEM B,QTAB-"0"+ ;INTO * Q-REG
POPJ P, ;AND RETURN
X0: PUSHJ P,QREGVI ;[332] CH:=Q-Register index
MOVEM B,QTAB-"0"(CH) ;[332] Store argument in selected Q-reg
JRST RET ;[332] Return
;TRANSFER DATA TO Q-REGISTER BUFR
X3: PUSH P,PT
ADDM C,(P) ;(P):=PT + LENGTH OF STRING + 3.
MOVE D,BEG
MOVEM D,PT ;PT:=BEG
PUSHJ P,NROOM ;INSERT STRING AT BEG
MOVE OU,RREL ;RREL CONTAINS RELOCATION CONSTANT IF
;GARBAGE COL. OCCURRED.
ADDM OU,(P) ;RELOCATE TOP OF STRING POINTER.
CAML B,BEG ;[320] IF WE ARE DOING A *I, DON'T CHANGE B!!
ADD B,OU ;B:=FIRST ARG ADDR + LENGTH OF STRING + 3 + RREL
MOVE OU,BEG ;OU:=ADDRESS OF Q-REG BUFFER
ADDM C,BEG ;BEG:=C(BEG)+LENGTH OF STRING + 3
MOVE CH,C ;FIRST CHAR OF BUFFER :=LEAST SIGNIFICANT 7 BITS
PUSHJ P,PUT ;OF LENGTH OF STRING + 3
AOS OU ;SECOND CHAR = MIDDLE 7 BITS OF LENGTH
ROT CH,-7
PUSHJ P,PUT
ROT CH,-7
MOVE I,B ;THIRD CHAR OF BUFFER := MOST SIGNIFICANT 7 BITS
;OF LENGTH OF STRING + 3
AOS OU
X1: PUSHJ P,PUT ;MOVE STRING TO Q-REG BUFFER.
AOS OU
CAIN C,3
JRST X2
PUSHJ P,GETINC
SOJA C,X1
X2: MOVE B,PT ;QTAB ENTRY :=XWD 400000,Q-REG BUFFER
;ADDRESS RELATIVE TO C(QRBUF)
SUB B,QRBUF
TLO B,400000
POP P,PT ;MOVE PT PAST STRING.
POPJ P,
SUBTTL Q-REGISTER COMMANDS -- G
;GI THE TEXT IN Q-REGISTER I IS INSERTED INTO THE BUFFER
; AT THE CURRENT LOCATION OF THE POINTER. THE POINTER IS THEN PUT JUST
; TO THE RIGHT OF THE INSERTION. THE Q-REGISTER IS NOT CHANGED.
QGET:
IFN VC, ;CLR STRING LENGTH HOLD
PUSHJ P,QTEXT ;INIT Q-REG ACCESS
MOVE B,CH ;SAVE INDEX
PUSHJ P,GTQCNT ;C:=LENGTH OF STRING
PUSHJ P,NROOMC ;MOVE FROM PT THROUGH Z UP C POSITIONS
MOVE OU,PT
HRRZ I,QTAB-"0"(B)
ADD I,QRBUF
ADDI I,3
QGET1: JUMPE C,RET ;MOVE STRING INTO DATA BUFFER
PUSHJ P,GETINC
PUSHJ P,PUT
AOS OU,PT
SOJA C,QGET1
;GET 21 BIT Q-REGISTER CHARACTER COUNT
GTQCNT: PUSHJ P,GETINC ;LOW ORDER 7 BITS
MOVEM CH,C
PUSHJ P,GETINC ;MIDDLE 7 BITS
ROT CH,7
IORM CH,C
PUSHJ P,GETINC ;HIGH 7 BITS
ROT CH,^D14
IORM CH,C
SUBI C,3 ;LESS 3 WORDS USED TO STORE THIS COUNT
POPJ P,
;INITIALIZE ACCESS OF TEXT FROM A Q-REGISTER
QTEXT: PUSHJ P,QREGVI ;A=QTAB ENTRY, CH=Q-REG INDEX
QTEXEI: MOVE A,QTAB-"0"(CH)
TLZE A,400000 ;MAKE SURE IT CONTAINS TEXT
TLZE A,377777
..ERROR E.NTQ ;NO TEXT
ADD A,QRBUF
MOVE I,A ;I=Q-REG BUFFER ADDRESS
POPJ P,
SUBTTL Q-REGISTER COMMANDS -- M, W, [ & ]
;MI PERFORM NOW THE TEXT IN Q-REGISTER I AS A SERIES OF COMMANDS.
MJRST: SKIPE EQM ;W @ CMD LEVEL = M
JRST QACCES ;ELSE OK
MAC: PUSHJ P,QTEXT ;INIT Q-REG ACCESS
MAC1: PUSH P,COMAX ;SAVE CURRENT COMMAND STATE
PUSH P,CPTR
PUSH P,COMCNT
PUSH P,. ;FLAG MACRO ON PDL (LARGE POS. NO.)
AOSA EQM ;INCREMENT THE MACRO LEVEL
QACCES: PUSHJ P,QTEXT ;INIT Q REG ACCESS FOR W COMMAND
PUSHJ P,GTQCNT ;GET NUMBER OF CHARACTERS IN MACRO
MOVEM C,COMCNT ;THAT MANY COMMANDS TO COUNT
MOVEM C,COMAX ;AND MAX.
SUBI I,1 ;ADJUST TO SUIT BTAB
IDIVI I,5
MOVE OU,BTAB(OU) ;MAKE A BYTE POINTER
HRR OU,I
MOVEM OU,CPTR ;PUT IT IN CPTR
JRST CD5 ;DON'T FLUSH ANY ARGUMENTS
;]I POPS Q-REGISTER I OFF THE Q-REGISTER PUSHDOWN LIST.
; THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED.
CLOSEB: HLRZ C,PF ;GET PDL COUNT
MOVEI B,"]" ;POP
CAIG C,-LPF-1 ;UNDERFLOW?
ERROR E.PDQ
PUSHJ P,QREGVI ;[332] GET Q-REG INDEX
POP PF,QTAB-"0"(CH) ;[332] POP THE Q-REG
JRST RET ;[332] RETURN
;[I PUSHES Q-REGISTER I ONTO THE Q-REGISTER PUSHDOWN LIST.
;n[i EQUIVALENT TO [i FOLLOWED BY nUi.
;m,n[I EQUIVALENT TO [I FOLLOWED BY m,nUi.
OPENB: TXNE FF,F.ARG ;[332] Is there an argument?
PUSHJ P,CRANGE ;[332] Yes, go check the range
PUSHJ P,QREGVI
PUSH PF,QTAB-"0"(CH) ;[332] PUSH Q-REG
TXNN FF,F.ARG ;[332] WAS THERE AN ARG?
JRST RET ;[332] NO, RETURN
JRST USEA1 ;[332] YES, GO STORE IT
SUBTTL MISCELLANEOUS CHARACTER DISPATCHER
;CALL: MOVE CH,CHARACTER
; MOVEI T,TABLE ADDR
; PUSHJ P,DISPAT
; NOT FOUND RETURN
;ENTER AT DISP1 TO AVOID CONVERTING LC TO UC
DISPAT: CAIG CH,"Z"+" " ;CONVERT LC TO UC
CAIG CH,137
JRST DISP1
TXZ CH,40
DISP1: PUSH P,A ;SAVE AC A WHILE WE USE IT
DISP2: MOVE A,(T) ;GET TABLE ENTRY
JUMPE A,APOPJ ;END OF TABLE
CAIE CH,(A) ;SAME
AOJA T,DISP2 ;NOT A MATCH
HLRZM A,-1(P) ;GOT IT -- PUT DISPATCH ADDR ON PDL
JRST APOPJ ;RESTORE AC A & DISPATCH
;USETI ON ER'D FILE PROCESSOR
;USETI ONLY LEGAL IF NOT EB AND ER IS TRUE
IUSET: JUMPLE B,USTERR ;ARG LESS THAN OR = ZERO LOSES
TXNN FF,F.UBAK ;MUST NOT BE EB IN FORCE
TXNN FF,F.IOPN ;BUT MUST HAVE INPUT FILE OPEN
USTERR: ERROR E.UST
USETI INCHN,(B) ;DO THE USETI
MOVX T,BF.IOU ;MUST CLEAR ALL THE USE BITS
HRRZ A,IBUF ;STARTING HERE
HRRZ B,A ;ENDING HERE TOO
USTILP: ANDCAM T,(A) ;CLEAR THE BIT
HRRZ A,(A) ;NEXT BUFFER
CAME A,B ;DONE?
JRST USTILP ;LOOP FOR ALL BUFFERS
SETZM IBUF+.BFCNT ;FORCE A READ (IN)
STATO INCHN,IO.ERR!IO.EOF ;ANY PROBLEM ARISE?
POPJ P, ;NO, RETURN TO HIM
USETI INCHN,1 ;BACK TO START OF FILE
ERROR E.UST
SUBTTL ^G COMMAND (GETTAB OR EXIT)
;ROUTINE TO EXIT IF EO = 1 (OLD ^G) OR DO GETTAB
BELDMP: CHKEO EO21,DECDMP ;OLD EXIT
TXNE FF,F.ARG ;IF NO ARG THEN RETURN JOB NUMBER
JRST BELDP0 ;THERE IS AN ARG...
PJOB A, ;JOB NUMBER
JRST VALRET ;RETURN IT
BELDP0: MOVE A,B ;GET ADR OR TABLE NO.
TXZN FF,F.ARG2 ;TWO ARGS?
JRST BELPEK ;NOPE, DO A PEEK
HRL A,C ;FORM GETTAB WORD
GETTAB A, ;DO THE GETTAB
SETZ A, ;RETURN ZERO ON ERROR
JRST VALRET ;ELSE RETURN WHATEVER
BELPEK: PEEK A, ;WILL IT WORK?
JRST VALRET ;WE'LL NEVER KNOW...
SUBTTL E COMMANDS -- DISPATCH ROUTINE & TABLE
ECMD: PUSHJ P,SKRCH ;GET CHAR AFTER E
ERROR E.MEE
CAIG CH,"Z"+" " ;LOWER CASE GOES TO UPPER
CAIGE CH,"A"+" " ;...
CAIA
SUBI CH," " ;TO UPPER CASE
HRREI TT,-"A"(CH) ;CONVERT TO TABLE OFFSET
SKIPL TT ;NEG IS ERROR
CAILE TT,"Z"-"A" ;IS BOUNDS
E$$IEC: ERROR E.IEC
LSHC TT,-1 ;CALCULATE TABLE WORD & HALF
MOVE TT,ECTABL(TT) ;GET ADRS OF PROCESSORS
SKIPL TT1 ;HAVE IT
MOVSS TT ;NO, NEED OTHER HALF
JRST (TT) ;GO
;E-COMMAND DISPATCH TABLE
ECTABL: XWD OPNWRA,EBAKUP ;EA,EB
XWD ECORE,RUNFX ;EC,ED
XWD EECMD,CLOSEF ;EE,EF
IFN CCL, XWD E$$IEC,ERRSET
XWD EICMD,E$$IEC ;EI,
XWD EKILL,MAKLOG ;EK,EL
XWD EMTAPE,RENAM ;EM,EN
XWD OLDMOD,EPCMD ;EO,EP
XWD E$$IEC,OPNRD ;,ER
XWD AUTOTY,TYOCTL ;ES,ET
XWD TYCASE,VIDEO ;EU,EV
XWD OPNWR,FINISH ;EW,EX
XWD YANK,ZERDIR ;EY,EZ
SUBTTL E COMMANDS -- EL (SETUP AND OUTPUT ROUTINES)
LOGOUT: TXZN F2,S.ASTR
TXNE F2,S.SLOG ;SKIP LOG FILE?
POPJ P, ;RIGHT
SOSG OLOG+.BFCNT ;DECREMENT BUFFER COUNTER
OUTPUT LOGCHN, ;DUMP BUFFER IF NO ROOM
IDPB CH,OLOG+.BFPTR ;PUT CHARACTER
TXNE F2,S.OLOG ;MISUSING TYOM?
POP P,CH ;YES, FORCE NICE RETURN
POPJ P, ;AND RETURN
MAKLOG: TXNE FF,F.ARG ;ARGUMENT?
JRST CHANGL ;YES, CHANGE OUTPUT SPECIFICATION
TXNE F2,S.LOPN ;DO WE HAVE AN OPEN LOG FILE?
RENAME LOGCHN,LOGFL ;FINAL RENAME FOR PROTECTION
JFCL ;"IMPOSSIBLE ERROR"
SETZM LOGOPN+.OPMOD ;ASCII MODE FOR LOG FILE
TXZ F2,S.LIN!S.LOUT!S.LOPN!S.OLOG
PUSHJ P,DSPEC ;GET FILE SPEC AND DEFAULT
MOVSI E,OLOG ;BUFFER HEADER
MOVEM E,LOGOPN+.OPBUF ;SAVE
MOVEI B,"L" ;TO MAKE CORRECT ERROR MESSAGE TYPE
OPEN LOGCHN,LOGOPN ;OPEN DEVICE
..ERROR E.ODV
MOVEI E,LOGCHN ;MUST BE A DSK!!
DEVTYP E, ;WELL?
JRST ERRILD
TXNE E,77 ;DSK?
JRST ERRILD
SKIPN A,XFILNM+.RBEXT ;SPECIFY AN EXT?
MOVSI A,'LOG' ;THIS IS DEFAULT
MOVEM A,XFILNM+.RBEXT ;SAVE IT
MOVE B,SWITC ;GET SWITCHES
TLNN B,FS.APP ;TO SUPERSEDE OLD FILE?
JRST ENTLOG ;YES
MOVEI E,LOGCHN ;SET UP FOR CHKDEF
LOOKUP LOGCHN,XFILNM ;SEE FILE
SKIPA ;NOT THERE
PUSHJ P,CHKPTH ;SEE IF FOUND ON SPECIFIED DIRECTORY
ENTLOG: SETZM LOGOPN+1 ;NOPE
ENT02: SKIPN LOGOPN+1 ;TO APPEND?
CLOSE LOGCHN, ;NO, CLOSE FILE
PUSHJ P,PPNSPC ;SET UP PPN IN CASE WIPED
ENTER LOGCHN,XFILNM ;ENTER LOG FILE
EE1+..ERROR E.ENT ;ENTER ERROR ON LOG FILE
MOVEI E,LOGFL ;SAVE FILESPEC
PUSHJ P,SPCSAV
SKIPE LOGOPN+1 ;TO USETO?
USETI LOGCHN,-1 ;DO IT
MOVEI E,LOGSPC
EXCH E,.JBFF
OUTBUF LOGCHN,1
MOVEM E,.JBFF ;RESTORE .JBFF FOR LATER
TXO F2,S.LIN!S.LOUT!S.LOPN ;ASSUME ALL INTO LOG FILE
TLNE B,FS.NOO
TXZ F2,S.LOUT
TLNE B,FS.NOI
TXZ F2,S.LIN
POPJ P, ;AND RETURN
DSPEC: PUSHJ P,FILSPC ;GET FILE SPEC
DSPEC1: SKIPN E,XFILNM+.RBNAM ;SPECIFY A NAME?
MOVE E,['TECO ']
MOVEM E,XFILNM+.RBNAM
SKIPN E,FILDEV ;HE SPECIFY A DEVICE
MOVSI E,'DSK' ;ASSUME DSK
MOVEM E,LOGOPN+1 ;SAVE IN OPEN BLOCK
MOVEM E,FILDEV ;FIX IN CASE ERROR
MOVEM E,SPCDEV
POPJ P,
ERRILD: RELEAS LOGCHN,
..ERROR E.ILD
SUBTTL E COMMANDS -- EE (SAVE TECO'S STATE)
EECMD: MOVEM 17,SAVEAC+17 ;PRESERVE 17
MOVEI 17,SAVEAC ;TO SAVE ALL AC'S
BLT 17,SAVEAC+16 ;SAVE THEM
MOVE 17,SAVEAC+17 ;RESTORE AC 17
MOVX E,S.LIN!S.LOUT!S.OLOG!S.LOPN ;CLEAR LOG FILE I-O FLAGS
ANDCAM E,SAVEAC+F2 ;RESAVE FLAG
MOVX E,F.OOPN!F.IOPN!F.UBAK ;NO FILES OPEN
ANDCAM E,SAVEAC+FF ;SAVE IN LOW SEG
PUSHJ P,DSPEC ;DEFAULT
SKIPN E,XFILNM+.RBEXT ;SPECIFY AN EXT?
MOVSI E,'SAV' ;DEFAULT
MOVEM E,XFILNM+.RBEXT ;SAVE IT
MOVSI E,OSAV ;FOR OUTPUT
MOVEM E,LOGOPN+.OPBUF ;SAVE IT
MOVE E,LOGOPN+.OPDEV ;GET DEVICE WE WILL OPEN
DEVCHR E, ;WHAT IS IT
JUMPE E,ERRNXD ;DOESN'T EXIST
TXNE E,DV.OUT ;OUTPUT DEVICE MUST BE CAPABLE OF OUTPUT
TXNN E,DV.M13 ;IN IMAGE BINARY
..ERROR E.ILD
MOVEI E,.IOIBN ;IB FOR SAVE FILE
MOVEM E,LOGOPN+.OPMOD ;SAVE IT
OPEN SAVCHN,LOGOPN ;OPEN IT
..ERROR E.ODV
MOVE E,[GETBLK,,STARTL]
BLT E,STARTL+12 ;MAKE LITTLE PROGRAM IN LOW SEG
ENTER SAVCHN,XFILNM ;ENTER THE OUTPUT FILE
EE1+..ERROR E.ENT ;ERROR
MOVEI E,EEFL ;SAVE FILE SPEC
PUSHJ P,SPCSAV
PUSH P,.JBSA ;SAVE FOR LATER RESTORE
PUSH P,.JBCOR ;...
MOVEI E,STARTL+6 ;WHERE TO START
HRRM E,.JBSA ;FIX JOBSA
MOVE E,.JBFF ;GET .JBFF NOW
HRLM E,.JBSA
HRLM E,.JBCOR ;SO SUBSEQUENT SAV-GET PAIRS WORK
HRRZ A,.JBREL ;THIS IS OUR SIZE
HRRM A,.JBCOR ;FIX ILL MEM REF PROB FOR EE
OUTBUF SAVCHN,1 ;1 OUTPUT BUFFER
MOVEM E,.JBFF ;SO WE NOT SAVE IT
MOVEI A,.JBPFI+1 ;START SAVE AT 115
SAVTOP: SKIPN (A) ;ZERO?
JSP E,MORE ;MORE TO GO?
CAML A,.JBFF ;STOP?
JRST SAVSTP ;RIGHT!
MOVE B,A ;SAVE FIRST NON ZERO WORD
SKIPE (A) ;ZERO?
JSP E,MORE ;NO, SEE IF MORE
SUBM B,A ;NEG NO OF WORDS
MOVSS A ;FORM IOWD
HRRI A,-1(B) ;FORMED
PUSHJ P,SAVOUT ;SEND TO FILE
MOVE E,A ;GET IOWD
MOVE A,1(E) ;GET WORD
PUSHJ P,SAVOUT ;SEND TO FILE
AOBJN E,.-2 ;LOOP FOR THIS GROUP
HRRZI A,1(E) ;NEXT WORD
CAMGE A,.JBFF ;DONE?
JRST SAVTOP ;NO, LOOP
SAVSTP: MOVE A,[JRST STARTL+6] ;SO CORRECT THING HAPPENS
PUSHJ P,SAVOUT ;OUTPUT IT
RENAME SAVCHN,EEFL ;FINAL RENAME FOR PROTECTION
JFCL ;"IMPOSSIBLE ERROR"
RELEAS SAVCHN, ;CLOSE AND RELEASE CHANNEL FOR SAVE FILE
POP P,.JBCOR
POP P,.JBSA
POPJ P, ;DONE
SAVOUT: SOSGE OSAV+.BFCNT ;ROOM THIS BUFFER
JRST OUTSAV ;NO, DUMP AND COME BACK
IDPB A,OSAV+.BFPTR ;STICK WORD
POPJ P, ;RETURN
OUTSAV: OUT SAVCHN, ;DUMP BUFFER
JRST SAVOUT ;GO BACK
GETSTS SAVCHN,B ;ERROR STATUS
POP P,.JBCOR
POP P,.JBSA
EE2+..ERROR E.OUT
MORE: CAML A,.JBFF ;MORE?
JRST (E) ;NO
AOJA A,-2(E) ;NO RETURN .-2
SUBTTL E COMMANDS -- NEL & EE (LOW CORE)
GETBLK: ('SYS')
'TECO '
REPEAT 4,<0>
MOVEI E,STARTL
GETSEG E,
HALT
MOVEI E,%TECOV ;TO MAKE SURE HI AND LOW SEG AGREE
JRST 400010
;ROUTINE TO CHANGE LOG FILE OUTPUT PARAMETERS
CHANGL: PUSHJ P,SKRCH ;GET ANOTHER CHARACTER
..ERROR E.NAL
CAIE CH,.CHESC ;MUST HAVE ALTMODE AFTER NEL
..ERROR E.NAL
TXNN F2,S.LOPN ;HAVE A LOG FILE OPEN?
..ERROR E.NLF
TXZ F2,S.LIN!S.LOUT ;ELSE CLEAR ALL
TRNE B,1 ;OUTPUT?
TXO F2,S.LOUT ;YES
TRNE B,2 ;INPUT?
TXO F2,S.LIN ;YES
JUMPGE B,CPOPJ ;UNLESS B WAS NEGATIVE,
RENAME LOGCHN,LOGFL ;RENAME FOR PROTECTION
JFCL ;CANT HAPPEN
RELEAS LOGCHN, ;IN WHICH CASE JUST CLOSE THE FILE
TXZ F2,S.LIN!S.LOUT!S.LOPN!S.OLOG ;AND ZERO THE FLAGS
POPJ P, ;OK, NOW DO THAT
SUBTTL E COMMANDS -- EE (RESTART CODE)
RST: CAIN E,%TECOV ;WILL THIS WORK
JRST RST1 ;YES
OUTSTR [ASCIZ .?TECWVT Wrong version of TECO GETSEG'd
.]
EXIT
RST1: MOVEI E,REE ;RESET REN ADR
MOVEM E,.JBREN ;SAVE
MOVE E,[PUSHJ P,UUOH] ;FIX .JB41
MOVEM E,.JB41 ;...
MOVSI 17,SAVEAC ;TO RESTORE AC'S
BLT 17,17 ;DO IT
PUSHJ P,TTOPEN ;REOPEN TTY
PUSHJ P,SETUP ;RESET ALL DEFAULTS
POP P,E ;THROW OUT WHERE YOU CAME FROM
MOVEI A,TECO ;START ADR
HRRM A,.JBSA ;SAVE IT
JRST RET ;CONTINUE
;EDIT CORE (IE GARBAGE COLLECT AND SMALLIFY)
ECORE: MOVEM PF,AC2+PF-2 ;[354] PUT PF WHERE GC EXPECTS IT
ECORE1: MOVEI E,CORER ;[354] WHERE GC WILL RETURN
MOVEM E,GCRET
SETOM GCFLG ;GARBAGE COLLECT!
MOVEM F2,SAVEAC ;PRESERVE FLAGS
PUSH P,.JBREL ;SAVE SIZE NOW IN CASE NO CHANGE
JRST GC ;DO IT
CORER: HRRZ A,.JBCOR ;DON'T GET SMALLER THAN THIS
MOVE F2,SAVEAC ;RESTORE FLAGS
MOVE B,Z ;CHARACTER ADR OF LAST CHARACTER
IDIVI B,5 ;WORD ADR
AOJ B, ;YES
CAMGE B,A ;WELL?
MOVE B,A ;ELSE FORCE MIN TO (A)
CORE B, ;DO IT
JFCL
MOVE A,.JBREL
MOVEM A,.JBFF
PUSHJ P,CRE23 ;RECOMPUTE SIZE OF TEXT BUFFER
POP P,A ;GET OLD .JBREL BACK
CAMN A,.JBREL ;DIFFERENT?
POPJ P, ;NO, NO MESSAGE
TXO FF,F.INIT ;FAKE OUT CORE ROUTINE
JRST CORES ;SAY SIZE AND CONTINUE
SUBTTL E COMMANDS -- EI & EP (EDIT INSERT & EDIT PUT)
EICMD: TXOA F2,S.DOIT ;NOTE TO DO MI WHEN DONE READING
EPCMD: TXZ F2,S.DOIT ;JUST READ IT INTO THE Q REG *
PUSHJ P,FILSPC ;GET FILE SPEC
MOVEI A,24 ;EI DEFAULT
PUSHJ P,EIDFSP ;SET THEM UP
SKIPN E,XFILNM+.RBEXT ;SPECIFY EXT?
MOVSI E,'TEC' ;'TEC' IS DEFAULT FOR EI-EP
TXOA F2,S.INFO ;TELL USER OF ANY CORE CHANGE WHEN THRU
INIFIL: TXZ F2,S.INFO ;NEVER DO THIS!
MOVEM E,XFILNM+.RBEXT ;SAVE IT
;***[337]***
;Here to LOOKUP file for EI and EP.
;If no directory or device has been specified, then look for the
;file as follows:
; [-]
; [,,TEC]/SCAN
; TED:
EPIGET: SETZM EPISEQ ;Clear search sequencer
SKIPN FILPPN ;Directory specified?
SKIPE FILDEV ;Or device?
SETOM EPISEQ ;Yes, flag that no search sequence needed
PUSHJ P,DSPEC1 ;DEFAULT DEVICE ETC
SKIPGE EPISEQ ;Do we need a search sequence?
JRST EPIG6 ;No, go read file
TXNE F2,S.INFO ;Are we processing TECO.INI?
JRST EPIG1 ;No, skip ahead
MOVE E,USRPPN ;Yes, always use [,]
MOVEM E,XFILNM+.RBPPN ;Store it
JRST EPIG6 ;Go find the file
EPIG1: MOVEI E,5 ;Initialize search sequencer
MOVEM E,EPISEQ ;Store
EPIG2: SOSG E,EPISEQ ;Get next step in search sequence
JRST LOOKIN ;Finished. File was not found
SETZM FILDEV ;Clear device for possible error msg.
CAIE E,4 ;First step?
JRST EPIG3 ;No
MOVSI E,'DSK' ;Use DSK device
MOVEM E,LOGOPN+1 ;Store
SETZM XFILNM+.RBPPN ;Set default directory
JRST EPIG6 ;Go straight to find it
EPIG3: CAIE E,3 ;Second step?
JRST EPIG3A ;No
MOVEI E,FILPTH ;Set PATH pointer
MOVEM E,XFILNM+.RBPPN ;in LOOKUP block
MOVSI E,'TEC' ;Set [,,TEC]
MOVEM E,FILSFD ;Store
SETZM FILSFD+1 ;Set trailing 0
MOVE E,USRPPN ;Get logged-in PPN
MOVEM E,FILPPN ;Store it
CAMN E,DEFPTH+2 ;Same as default path PPN?
SKIPE DEFPTH+3 ;And no SFD's?
TRNA ;No, then search [,] also
JRST EPIG7 ;Yes, don't bother setting /SCAN
EPIG4: MOVEI E,2 ;Set /SCAN
MOVEM E,FILPTH+1 ;Store
JRST EPIG7 ;Go try
EPIG3A: CAIE E,2 ;Third step?
JRST EPIG5 ;No
MOVE E,USRPPN ;Get logged-in PPN
MOVEM E,XFILNM+.RBPPN ;Store
CAMN E,DEFPTH+2 ;Same as default path?
SKIPE DEFPTH+3
JRST EPIG7 ;No, go try
JRST EPIG2 ;Yes, try next search
EPIG5: ;Must be fourth step
MOVSI E,'TED' ;Use TED:
MOVEM E,LOGOPN+1 ;Store
SETZM E,XFILNM+1 ;Clear directory spec
SETZM FILPPN ;Clear this too for possible error msg.
EPIG6: TXO FF,F.INIT ;INIT FILE READ IN PROGRESS
SETZM LOGOPN+.OPMOD ;ASCII MODE
MOVEI E,IINI ;INPUT BUFFER HEADER
MOVEM E,LOGOPN+.OPBUF ;SAVE IT
MOVE E,LOGOPN+.OPDEV ;DEVICE
DEVCHR E, ;CHARACTERISTICS=?
JUMPE E,ERRNXD ;NO SUCH DEVICE
TXNE E,DV.IN ;INPUT DEVICE SHOULD BE CAPABLE OF INPUT
TXNN E,DV.M0 ;IN ASCII MODE
..ERROR E.ILD
OPEN INICHN,LOGOPN ;OPEN DEVICE
..ERROR E.IDV
EPIG7: LOOKUP INICHN,XFILNM ;LOOK FOR FILE
JRST EPIG2 ;Failed, go step the sequencer
;Found it...Fall through to next page
PUSH P,.JBREL ;SAVE FOR LATER
PUSH P,.JBFF ;[336] Save this too
MOVE E,Z ;END OF TEXT BUFFER
SUB E,BEG ;#CHARS IN IT
MOVEM E,SAVEAC ;REMEMBER IT FOR LATER CLEAN UP
MOVE TT,Z ;WHERE TO PUT BUFFER
IDIVI TT,5 ;IN WORD ADR
ADDI TT,2 ;ASSUME LEFT OVER + 1
MOVEM TT,.JBFF ;FIX IT
INBUF INICHN,1 ;1 INPUT BUFFER
MOVE OU,.JBFF ;WHERE WE WILL PUT THIS
IMULI OU,5 ;ADR AS A NUMBER OF CHARACTERS
MOVEM OU,SAVEAC+1 ;SAVE FOR LATER TRANSFER
MOVEM 17,AC2+15 ;[354] Preserve 17
MOVE 17,(P) ;[355] Retrieve original .JBFF
MOVEM 17,.JBFF ;[355] Put it back so it agrees with MEMSIZ
SETZM 17 ;CLEAR FOR 1 K EXPAND
INILP: SOSGE IINI+.BFCNT ;MORE TO READ?
JRST [IN INICHN, ;NO, READ SOME
JRST INILP ;AND CONTINUE
GETSTS INICHN,B ;GET ERROR BITS
TRNN B,IO.ERR ;ERROR?
JRST INIDON ;NO
JRST EE2ERR] ;SAY INPUT ERROR
ILDB CH,IINI+.BFPTR ;GET CHARACTER
JUMPE CH,INILP ;IGNORE IT
CAML OU,MEMSIZ ;[355] FIT?
PUSHJ P,GRABKQ ;[355] GET A K
PUSHJ P,PUT ;[355] STICK IT IN TEXT BUFFER
AOJA OU,INILP ;[355] DO REST OF IT
CHKPUT: CAML OU,MEMSIZ ;FIT?
PUSHJ P,GRABKQ ;GET A K
PUSHJ P,PUT ;STICK IT IN TEXT BUFFER
AOJA OU,CPOPJ ;DO REST OF IT
INIDON: RELEAS INICHN, ;WE ARE DONE
TXNE F2,S.INFO ;IF THIS OFF, INI FILE
JRST SAVSIZ ;SAV SIZE
MOVEI CH,.CHESC ;TECO'S ALTMODE
PUSHJ P,CHKPUT
PUSHJ P,CHKPUT
SAVSIZ: MOVE 17,AC2+15 ;[354] Restore 17
MOVEM OU,Z ;SAVE ALL THAT STUFF
MOVE C,SAVEAC+1 ;START OF IT
MOVE B,Z ;END OF IT
PUSHJ P,COPYEI ;COPY INTO * Q-REG
MOVE B,BEG ;WHERE IT ALL STARTS
ADD B,SAVEAC ;+ LENGTH
MOVEM B,Z ;WHERE IT ENDS
IDIVI B,5 ;FOR NEW .JBFF
ADDI B,2 ;ASSUME LEFT OVER +1
IORI B,1777 ;MAKE LIKE A JOBREL
SOJ B, ;SAFE
POP P,E ;[336] Restore original .JBFF
CAMLE E,B ;[336] If it is larger than our new one...
MOVE B,E ;[336] then use old one so we don't shrink
MOVEM B,.JBFF ;SAVE
PUSHJ P,CRE23 ;YOU KNOW BY NOW!!
POP P,E ;RESTORE OLD JOBREL
CAMGE B,E ;E
MOVEI A,CCLBLK ;RUN COMPIL
HRLI A,1 ;AT START ADR PLUS ONE
RUN A, ;RUN UUO
JRST DECDMP ;JUST EXIT IF NO RUN.
CCLBLK: SIXBIT /SYS/
SIXBIT /COMPIL/ ;RUN SYS:COMPIL
REPEAT 4,<0>
>
SUBTTL E COMMANDS -- ED (RUN UUO ON EXIT)
IFN NORUNS,<
IFN CCL,<
NORUN: MOVE 1,[SIXBIT /COMPIL/]
MOVSI 2,SAVEXT ;SIXBIT FOR SAV OR DMP
SETZB 3,4
INIT CCLCHN,.IODMP
SIXBIT /SYS/
0
EXIT
LOOKUP CCLCHN,1
EXIT
CALL 1,[SIXBIT /SETNAM/]
HLRO 15,4
HRLM 15,NORUN1
MOVNS 15
MOVEI 16,73(15)
ADDI 15,INHERE
TXO 15,1777
MOVSI NORTOP,NORAC
BLT NORTOP,NORTOP
HRR NORBLT,16
JRST NORUN2
>>
;ROUTINE TO SET UP FOR RUN UUO ON EXIT
RUNFX: HRLZM B,RUNIT+5 ;SAVE STARTING ADR INCREMENT
PUSHJ P,FILSPC ;WHAT WE WILL RUN
SKIPN E,FILDEV ;HE SPECIFY A DEVICE?
MOVSI E,'SYS' ;DEFAULT TO 'SYS'
MOVEM E,RUNIT ;PUT IT IN THE BLOCK
MOVE A,[XFILNM+.RBNAM,,RUNIT+1]
BLT A,RUNIT+4 ;SAVE FILE SPEC
MOVE A,[FILPTH,,RUNIT+6]
BLT A,RUNIT+17 ;SAVE PATH
POPJ P, ;DONE
IDIOT: MOVSI E,1
PUSHJ P,PUN1
JRST CLOSEF
SUBTTL E COMMANDS -- ET, EO & EU
;ET COMMAND
; 0 = Normal typeout
; 1 = Literal typeout
; 2 = Image typeout (IONEOU)
TYOCTL: POP P,CH ;CLR RET. ADDR. FROM PDL
TXNE FF,F.ARG ;ARGUMENT?
JRST TYOCT1 ;YES.
SKIPE A,ETVAL ;[331] Get ET value
CHKEO EODEC,FFOK ;[331] If EO > 2 and non-zero, return -1
JRST VALRET ;[331] Return the value
TYOCT1: CHKEO EODEC,TYOCT3 ;[331] Jump if old style ET
SKIPL B ;[331] Check range
CAILE B,2 ;[331] ...
ERROR E.ETA ;[331] Illegal value
TYOCT2: MOVEM B,ETVAL ;[331] Store value
JRST RET ;RETURN
TYOCT3: JUMPE B,TYOCT2 ;[331] Old ET can be only 0 or 1
MOVEI B,1 ;[331] Non zero means 1
JRST TYOCT2 ;[331] Go store and return
;EO COMMAND
OLDMOD: POP P,CH ;CLR RET. ADDR. FROM PDL
TXNE FF,F.ARG ;ARGUMENT?
JRST OLD1 ;YES, SET FLAG
MOVE A,EOFLAG ;NO, RETURN VALUE OF EOFLAG
JRST VALRET
OLD1: CAIG B,0 ;N <= 0?
MOVEI B,EOVAL ;YES, SET TO STANDARD
CAILE B,EOVAL ;N > STANDARD FOR THIS VERSION?
ERROR E.EOA
MOVEM B,EOFLAG ;SET EOFLAG
JRST RET
;EU COMMAND
TYCASE: POP P,CH ;CLR RET. ADDR. FROM PDL
TXNE FF,F.ARG ;ARGUMENT?
JRST TYCAS1 ;YES
MOVE A,TYCASF ;NO, RETURN VALUE OF TYPE-OUT CASE FLAG
JRST VALRET
TYCAS1: MOVEM B,TYCASF ;SET TYPE-OUT CASE FLAG
JRST RET
SUBTTL E COMMANDS -- ES
AUTOTY: POP P,CH ;CLR RET ADDR FROM PDL
TXNE FF,F.ARG ;ARG?
JRST AUTOT1 ;YES
MOVE A,AUTOF ;NO, RETURN VALUE OF FLAG
JRST VALRET
AUTOT1: MOVEI A,.CHLFD ;USE LF FOR FLAG IF ARG = 1 TO 37
CAIL B,1
CAILE B,37
MOVE A,B ;OTHERWISE USE WHAT HE GAVE
MOVEM A,AUTOF ;SET NEW VALUE IN FLAG
JRST RET
SUBTTL E COMMANDS -- EH (CHANGE ERROR MESSAGE LEVEL)
ERRSET: POP P,CH ;YOU GOT HERE BY PUSHJ DUMMY!!
TXNE FF,F.ARG ;ARG SEEN?
JRST ERRSE1 ;YES, RESET INDICATOR
HLLZ B,ERRLEN ;NO, RETURN CURRENT VALUE OF FLAG
MOVSI E,-3 ;NUMBER OF POSSIBILITIES
TDNE B,JWTABL(E) ;BIT ON?
MOVEI A,1(E)
AOBJN E,.-2 ;NO, LOOP
JRST VALRET
JWTABL: XWD JW.WPR_-22,JW.WPR_-22
XWD JW.WFL_-22,_-22
XWD JW.WCN_-22,_-22
ERRSE1: CAILE B,3 ;3 IS HIEST
MOVEI B,3 ;FORCE IT DOWN IF GREATER
MOVE A,PRMERR ;ASSUME DEFAULT
SKIPLE B ;OK ASSUMPTION?
HRLZ A,JWTABL-1(B) ;NO
MOVEM A,ERRLEN ;2 BECOMES 0 = MEDIUM
JRST RET ;3 BECOMES +1 = LONG
SUBTTL E COMMANDS -- EV (SET TERMINAL CHARACTERISTICS)
VIDEO:
IFE CRT,<..ERROR E.CRT>
IFN CRT,<
POP P,CH ;GET RID OF RETURN ADR
TXNE FF,F.ARG ;ARG SEEN?
JRST VIDCHG ;YES, GO POKE
SETZ E, ;INIT SIXBIT NAME
MOVE OU,[POINT 6,E] ;INIT POINTER
MOVSI I,770000 ;INIT MASK FOR PARTIAL NAME
VID1: PUSHJ P,SKRCH ;GET NEXT CHARACTER
..ERROR E.UTV ;NO MORE
CAIN CH,.CHESC ;ALTMODE?
JRST VID2 ;YES
PUSHJ P,CKSYM ;LEGAL CHARACTER?
SKIPA ;YES
..ERROR E.ICV ;NO
MOVE CH,B ;PUT CHARACTER BACK IN CH
PUSHJ P,PAKSIX ;PACK THE CHARACTER
JRST VID1 ;LOOP
VID2: MOVEM E,SWITHL ;SAVE IN CASE ITS BAD
SETZM SWINDX ;NO MATCH YET
MOVSI T,-NUMCRT ;SET UP INDEX POINTER
VID3: CAMN E,CRTTAB(T) ;EXACT MATCH?
JRST VID5 ;YES
MOVE OU,CRTTAB(T) ;GET IT
AND OU,I ;AND MASK IT
CAME OU,E ;HOW ABOUT NOW?
JRST VID4 ;NOPE
SKIPE SWINDX ;GOT IT--IS THIS THE FIRST?
..ERROR E.ABT ;NOPE-AMBIGUOUS NAME
MOVEM T,SWINDX ;STORE IT
VID4: AOBJN T,VID3 ;GO TRY THE NEXT
SKIPN T,SWINDX ;DID WE GET ONE?
..ERROR E.UTT ;UNKNOWN
VID5: HLRZ A,CRTDSP(T) ;GET 1ST PARAMETER
MOVEM A,CRTTYP
MOVEI A,BACRUB ;NOW SET UP BLT FOR REST OF PARAMETERS
HRL A,CRTDSP(T) ;WITH APPROPRIATE TERMINAL
BLT A,CTUSEQ
JRST RET ;WE'RE DONE
;HERE IF EV HAD NUMERICAL ARGUMENTS.
VIDCHG: PUSHJ P,SKRCH ;GET ANOTHER CHARACTER
..ERROR E.NAV
CAIE CH,.CHESC ;MUST BE ALTMODE
..ERROR E.NAV
TXZN FF,F.ARG2 ;ONLY ONE ARG?
JRST RETEV ;YES, GO RETURN THE VALUE
SKIPLE C
CAILE C,20 ;MAKE SURE FIRST ARG IS BETWEEN 1 AND 16.
..ERROR E.VOR
CAIE C,20 ;EQUAL TO 16?
JRST VDC1 ;NO
CAMN B,[-1] ;YES, IS ARG -1?
HRLZI B,032120 ;YES, CHANGE TO CRLF (SHIFTED 1 RIGHT)
VDC1: CAILE C,6 ;IS THE 1ST ARG GREATER THAN 6?
LSH B,1 ;YES, SHIFT (TECO CAN'T HANDLE BIG NEG. #S)
MOVEM B,CRTTYP-1(C) ;STORE VALUE
JRST RET
RETEV: SKIPLE B ;CHECK RANGE
CAILE B,20
..ERROR E.VOR
MOVE A,CRTTYP-1(B) ;GET VALUE
CAILE B,6 ;NEED TO SHIFT AN ASCIZ TO MAKE IT POS?
LSH A,-1 ;YES
JRST VALRET
SUBTTL E COMMANDS -- TERMINAL CHARACTERISTICS TABLES
CRTTAB: SIXBIT /TTY/ ;TYPES OF CRT'S
SIXBIT /CRT/
SIXBIT /ACT4/ ;[331]
SIXBIT /ACT5/ ;[331]
SIXBIT /ADD580/
SIXBIT /ADM2/
SIXBIT /ADM3/
SIXBIT /ADM3A/ ;[331]
SIXBIT /BEE/
SIXBIT /DPT/
SIXBIT /CDC/
SIXBIT /H1200/
SIXBIT /H1500/ ;[331]
SIXBIT /H2000/
SIXBIT /HP2640/ ;[331]
SIXBIT /VT05/
SIXBIT /VT50/ ;[324]
SIXBIT /VT52/
NUMCRT==.-CRTTAB
;FLAG BITS--STORED IN CRTTYP (PARAMETER 1).
.CCRT.==1 ;TERMINAL IS A CRT
.CNCR.==2 ;DON'T OUTPUT LONE CR TO TERMINAL
.CRUB.==4 ;RUBOUT GETS TRADITIONAL TREATMENT (FOR GENERAL "CRT")
.CWAP.==10 ;TERMINAL DOESN'T WRAP AROUND ON BACKSPACE FROM LEFT MARGIN
;ADDRESSES OF TERMINAL BLOCKS
;LEFT HALF CONTAINS VALUE OF CRTTYP (PARAMETER 1)
CRTDSP: XWD 0,VTTY ;FOR TTY, ONLY THE 0 MATTERS-REST IS GARBAGE
CRTGEN: XWD .CWAP.+.CRUB.+.CCRT.,VCRT ;GENERAL CRT SETTING.
XWD .CCRT.+.CWAP.,VACT4
XWD .CCRT.+.CWAP.,VACT5
XWD .CCRT.,VADD5
XWD .CCRT.,VADM2
XWD .CWAP.+.CCRT.,VADM3
XWD .CWAP.+.CCRT.,VADM3A
XWD .CCRT.,VBEE
XWD .CWAP.+.CCRT.,VDPT
XWD .CCRT.,VCDC
XWD .CCRT.,VHZL1
XWD .CCRT.,VHZL15
XWD .CCRT.,VHZL2
XWD .CWAP.+.CCRT.,VHP26 ;[331] HP2640
XWD .CWAP.+.CCRT.,VVT05
XWD .CWAP.+.CCRT.,VVT50 ;[331]
XWD .CWAP.+.CCRT.,VVT52 ;[331] VT52 same as VT50
VBEE: EXP 10,0,0,4,10
BYTE (7) 10
BYTE (7) 33,103
BYTE (7) 40,10
BYTE (7) 33,101
BYTE (7) 33,101
BYTE (7) 33,101
0
BYTE (7) 10
0
BYTE (7) 15,33,113,15
VACT5:
VACT4: EXP 10,0,0,4,10
BYTE (7) 10
BYTE (7) 40
BYTE (7) 40,10
BYTE (7) 32
BYTE (7) 32
BYTE (7) 32
BYTE (7) 32
BYTE (7) 10
BYTE (7) 0
BYTE (7) 15,36
VADM2: EXP 10,0,1,4,10
BYTE (7) 10
BYTE (7) 40
BYTE (7) 40,10
BYTE (7) 13
BYTE (7) 13
BYTE (7) 13
0
BYTE (7) 10
0
BYTE (7) 15,33,124,15
VTTY: ;DUMMY ADDRESS - ALL THIS IS IGNORED
VCRT: ;GENERAL CRT SETTING = ADM3
VADM3: EXP 10,0,0,0,0
BYTE (7) 10
BYTE (7) 40
BYTE (7) 40,10
EXP 0,0,0,0
BYTE (7) 10
0
0
VADM3A: EXP 10,0,1,4,10
BYTE (7) 10
BYTE (7) 40
BYTE (7) 40,10
BYTE (7) 13
BYTE (7) 13
BYTE (7) 13
BYTE (7) 13
BYTE (7) 10
EXP 0,0
VDPT: EXP 10,0,0,4,8
BYTE (7) 10,31
BYTE (7) 40
BYTE (7) 36 ;THIS MAY BE A LOCAL MOD AT U. OF T.
BYTE (7) 32
BYTE (7) 32
BYTE (7) 32
BYTE (7) 32
BYTE (7) 10,31
BYTE (7) 31
BYTE (7) 15,36
VCDC: EXP 10,0,0,4,8
BYTE (7) 10
BYTE (7) 25
BYTE (7) 40,10
BYTE (7) 32
BYTE (7) 32
BYTE (7) 32
0
BYTE (7) 10,40,10,10
0
0 ;EOL SEEMS TO BE DISABLED ON A CDC (SHOULD BE ^V)
VHP26: EXP 10,0,0,4,10
BYTE (7) 10
BYTE (7) 33,103
BYTE (7) 40,10
BYTE (7) 33,101
BYTE (7) 33,101
BYTE (7) 33,101
BYTE (7) 33,101
BYTE (7) 10,40,10,10
0
BYTE (7) 15,33,113,15
VHZL1: EXP 10,0,0,1,1
BYTE (7) 10
0
BYTE (7) 20,10
BYTE (7) 12
0
0
0
BYTE (7) 10
0
0
VHZL15: EXP 10,0,0,4,10
BYTE (7) 10
BYTE (7) 40
BYTE (7) 40,10
BYTE (7) 176,14
0
0
0
BYTE (7) 10
EXP 0
BYTE (7) 15,176,17,15
VHZL2: EXP 10,0,0,0,0
BYTE (7) 10
BYTE (7) 40
BYTE (7) 40,10
0
0
0
0
BYTE (7) 10
0
BYTE (7) 176,23,177,15 ;[331]
VVT52:
VVT50: EXP 10,0,0,4,10
BYTE (7) 10
BYTE (7) 33,103
BYTE (7) 40,10
BYTE (7) 33,101
BYTE (7) 33,101
BYTE (7) 33,101
BYTE (7) 33,101
BYTE (7) 10
0
BYTE (7) 15,33,113,15
VVT05: EXP 10,0,0,4,8
BYTE (7) 10
BYTE (7) 40
BYTE (7) 40,10
BYTE (7) 32
BYTE (7) 32
BYTE (7) 32
BYTE (7) 36,32 ;[331]
BYTE (7) 10
0
BYTE (7) 15,36
VADD5: EXP 10,0,0,4,8
BYTE (7) 25,10
BYTE (7) 40
BYTE (7) 40,25,10
BYTE (7) 32
BYTE (7) 32
BYTE (7) 32
0
BYTE (7) 25,10
BYTE (7) 25,10
0
SUBTTL E COMMANDS -- EK (KILL) AND EN (RENAME)
EKILL: MOVEI E,OUTCHN
RESDV. E, ;DISCARD FILE
CLOSE OUTCHN,CL.RST ;DO THE BEST WE CAN
TXZ FF,F.UBAK+F.OOPN ;ZERO EB AND EW FLAGS
POPJ P, ;AND RETURN
RENAM: TXNE FF,F.UBAK ;EB IN PROGRESS
..ERROR E.EBO
PUSHJ P,FILSPC ;GET A FILE SPEC (IF ANY)
SKIPE FILDEV
..ERROR E.END
TXZN FF,F.IOPN ;ER IN PROGRESS?
..ERROR E.ENO
TXNN FF,F.FILE ;DID WE SEE ANY FILSPEC AT ALL
JRST RENAM1 ;NO, MUST BE A DELETE
PUSH P,FILPPN ;[340] Save directory spec
PUSHJ P,ERDFSP ;YES, SO FILL IN ALL MISSING PARTS
HRRZ E,INFILE+1 ;INCLUDING DATE STUFF- <000> NEEDS THIS
HRRM E,XFILNM+.RBEXT
POP P,(P) ;[340] Pop the stack
SKIPN 1(P) ;[340] Was an explicit directory given?
SETZM XFILNM+.RBPPN ;[340] No, don't move the file
MOVE E,INFILE+2
TXNE FF,F.PROT ;WAS A FILE PROTECTION SPECIFIED?
TLZ E,777000 ;YES, SO CLEAR OLD PROTECTION
IORM E,XFILNM+.RBPRV ;STORE IT
RENAM1: RENAME INCHN,XFILNM ;CHANGE NAME OR DELETE
JRST RENFLD
RELEASE INCHN,
POPJ P, ;SUCCESSFUL
RENFLD: RELEASE INCHN,
EE1+..ERROR E.RNF
SUBTTL E COMMANDS -- ER (PREPARE TO READ A FILE)
OPNRD: TXZ FF,F.EOFI+F.IOPN ;NOT EOF & CLOSE PREVIOUS INPUT
RELEAS INCHN,0 ;YES. RELEASE IT BEFORE OPENING NEW FILE.
PUSHJ P,CLREXT ;CLEAR LOOKUP BLOCK
PUSHJ P,FILSPC ;GET FILE SPEC
SETZM NFORMS ;HAVE NOT SEEN ANY FORM FEEDS YET
SETZM OPNRI+.OPMOD ;ASCII MODE
PUSHJ P,ERDFSP ;NO SO SET UP DEFAULT FILE SPEC
SKIPN FILPPN ;IS PPN 0?
MOVE E,FILDEV ;INITIALIZE OPEN UUO ARGUMENTS
MOVEM E,OPNR1
PUSHJ P,DEVCHK ;GET DEVICE CHARACTERISTICS
MOVEM E,DEVSAV ;SAVE FOR EB
JUMPE E,ERRNXD ;NO SUCH DEVICE
TXNE E,DV.IN ;MUST BE ABLE TO INPUT
TXNN E,DV.M0 ;IN ASCII MODE
..ERROR E.ILD
MOVEI E,IBUF
MOVEM E,OPNRB
OPEN INCHN,OPNRI ;OPEN INPUT FILE
..ERROR E.IDV
PUSHJ P,OPNIN
HLLZS XFILNM+.RBEXT ;CLEAR EXT RH FOR MON ERR ON DTA
SKIPG MONITR ;IF SERIES 3 OR 4 MONITOR, SHORT LOOKUP
JRST OPNRD1 ;SHORT
MOVE E,DEVSAV ;GET DEVICE CHARACTERISTICS SPR 10-8431
TXNE E,DV.DTA ;IS IT A DECTAPE? SPR 10-8431
JRST OPNRD1 ;YES, SHORT LOOKUP SPR 10-8431
LOOKUP INCHN,XFILNM ;EXTENDED LOOKUP
JRST LKUPER ;ERROR
JRST OPNRD2
OPNRD1: LOOKUP INCHN,XFILNM+.RBNAM ;SHORT LOOKUP
JRST LKUPER ;LOOKUP FAILURE
OPNRD2: PUSHJ P,CHKSPC ;[340] Issue warning if found elsewhere
MOVEI E,INFILE ;SAVE INPUT SPECS
PUSHJ P,SPCSAV
TXO FF,F.IOPN ;INPUT FILE NOW OPEN
MOVSI E,FS.SUP!FS.NOL ;CK SUPLSN SWITCH
AND E,SWITC ;GET SETTING
XORM E,SWITC ;[317]CLEAR THEM HERE, SO NO SUPLSN ON OUTPUT
MOVEM E,INSWIT ;STORE SETTING FOR INPUT
TXZ FF,F.SEQ ;CLR SEQUENCE NUMBER FLAG
IN INCHN, ;READ A BUFFER IN
JRST .+3
PUSHJ P,ANERR ;SOME ERROR, OR JUST EOF
JRST OPNRD3 ;IT WAS EOF-FILE EMPTY MEANS UNSEQUENCED
MOVE B,IBUF+.BFPTR ;GET ADR OF BUFR
MOVE A,1(B) ;FIRST WORD OF BUFR
IOR A,2(B) ;!2ND
MOVEI B,RI ;SLOW INPUT ROUTINE
TLNN E,FS.NOL ;NO LSN'S
TRNN A,1 ;SEQF
;Fall through to next page...
OPNRD3: MOVEI B,RIQ ;USE QUICK ONE
MOVEM B,INCH ;SET UP INPUT ROUTINE
CAIN B,RI ;SLOW?
TXO FF,F.SEQ ;THEN MUST BE SEQUENCED FILE
TXNE FF,F.EBTP ;[343] EB in progress?
POPJ P, ;[343] Yes, return
TXZE FF,F.CCL ;[343] ARE WE HERE FROM A .MAKE COMMAND?
PUSHJ P,YANK ;[343] Yes, do an EY
POPJ P, ;RETURN
OPNIN: MOVEI T,IBUF1 ;GET INPUT BUFFERS
EXCH T,.JBFF
INBUF INCHN,2
MOVEM T,.JBFF
POPJ P,
SUBTTL E COMMANDS -- FILE SPEC SETUP
ERDFSP: TDZA A,A
EWDFSP: MOVEI A,12
EIDFSP: MOVE E,SWITC ;[337] Get file switches
TLNN E,FS.DEF ;[337] /DEFAULT set?
JRST DEFSP1 ;[337] No, continue
MOVSI E,ERSPEC(A) ;[337] Yes, we must clear the block
HRRI E,ERSPEC+1(A) ;[337] Set up the BLT
SETZM ERSPEC(A) ;[337] Zero the block
BLT E,ERSPEC+11(A) ;[337]
DEFSP1: SKIPN E,XFILNM+.RBNAM ;HE TYPE A NAME?
SKIPA E,ERSPEC+1(A) ;[337] NO, GET DEFAULT
MOVEM E,ERSPEC+1(A) ;SAVE IT
MOVEM E,XFILNM+.RBNAM
SKIPN E,XFILNM+.RBEXT ;HE TYPE EXT?
SKIPA E,ERSPEC+2(A) ;[337] NO, GET DEFAULT
MOVEM E,ERSPEC+2(A) ;SAVE
MOVEM E,XFILNM+.RBEXT
MOVSI B,ERSPEC+4(A) ;SET UP PPN
HRRI B,FILPPN
MOVS I,B
SKIPE FILPPN
JRST DFSP1
TXNE F2,S.DPPN
HRLI B,DEFPTH+2 ;HE WANTS [-]
PUSHJ P,CHKERZ ;CHECK FOR ERSATZ DEVICE
HRLI B,SPCPPN ;IT WAS ERSATZ--GET RIGHT PPN
MOVE E,B ;[317]SAVE BLT AC
BLT E,FILPPN+5 ;[317]
HRRI B,SPCPPN ;PUT IT HERE TOO
BLT B,SPCPPN+5
TXNE F2,S.DPPN ;[340] Make [-] default, but not ersatz PPN
DFSP1: BLT I,ERSPEC+9(A) ;NOW MAKE IT THE NEW DEFAULT
MOVE E,FILPPN
MOVEM E,XFILNM+.RBSIZ ;FOR SHORT LOOKUPS AND ENTERS
MOVEI E,FILPTH ;[340] Get pointer to PATH block
SKIPE FILPPN ;[340] Does PATH block have something
MOVEM E,XFILNM+.RBPPN ;[340] Yes, point to it
SKIPN E,FILDEV ;HE TYPE A DEVICE?
SKIPA E,ERSPEC(A) ;[337] NO, GET DEFAULT
MOVEM E,ERSPEC(A) ;SAVE
MOVEM E,FILDEV
POPJ P,
SUBTTL E COMMANDS -- EB (EDIT BACKUP PROCESSOR)
EBAKUP: TXNE FF,F.UBAK ;BACKUP IN PROGRESS NOW?
..ERROR E.EBO
TXO FF,F.EBTP ;SET EB UUO FLAG
PUSHJ P,OPNRD ;READ THE SPECIFIED FILE
MOVE E,SWITC ;[343] Get I/O switches
TLNE E,FS.REA ;[343] /READONLY?
JRST EBAKU3 ;[343] Yes, cancel EB and do an ER
MOVE E,DEVSAV ;GET DEVICE CHARACTERISTICS
TXNN E,DV.DIR ;DEVICE MUST HAVE DIRECTORY
..ERROR E.EBD
TXNE E,DV.DTA ;SKIP IF NOT DECTAPE (E.G. DSK) SPR 10-8431
JRST EBAKU4 ;DO SHORT LOOKUP/ENTER. SPR 10-8431
HLLZS XFILNM+.RBEXT ;CLEAR EXT RH
MOVE E,SWITC ;GET FILE SWITCHES
TLNN E,FS.INP ;/INPLACE EDIT?
JRST EBAKU0 ;NO
TXZ FF,F.EBTP ;NO LONGER EB
MOVE E,[FILPPN,,SPCPPN] ;[340] Save the real path
BLT E,SPCPPN+5 ;[340] so EW goes to the right place
JRST EBAKU6 ;DO ER/EW
EBAKU0: MOVEI E,INCHN
PUSHJ P,CHKDEF ;CHECK TO SEE IF SAME AS DEFAULT
JRST EBAKU2 ;NOPE-JUST DO ER-EW
MOVE E,FILDEV ;SAVE DEVICE NAME
SKIPG MONITR ;SERIES 5 MONITOR?
JRST EBAKU5 ;NO
MOVE E,XFILNM+.RBSIZ ;COMPUTE # BLKS TO ASK FOR
LSH E,-7
AOJ E,
MOVEM E,XFILNM+.RBEST ;SAVE
MOVE E,XFILNM+.RBDEV ;GET PHYSICAL UNIT NAME IN-FILE IS ON
MOVEM E,DCLOC ;DO A DSKCHR ON IT
MOVE E,[5,,DCLOC]
DSKCHR E,
EBAKU4: SKIPA E,FILDEV ;ERROR, USE BEST NAME WE HAVE
MOVE E,DCLOC+.DCSNM ;GET NAME FOR FILESTR IN-FILE IS ON
MOVEM E,FILDEV ;SO WE CAN PUT NEW FILE ON SAME STR
;Fall through to next page...
EBAKU5: MOVEM E,EBDEV
MOVE E,XFILNM+.RBNAM ;SAVE FILENAME
MOVEM E,BAKNAM ;IN BACKUP STORE
HLRZ E,XFILNM+.RBEXT ;AND THE EXTENSION
CAIN E,(SIXBIT /BAK/) ;CANNOT USE EB WITH FILE EXT = "BAK"
..ERROR E.EBF
HRLZM E,BAKNAM+1
LDB E,[POINT 9,XFILNM+.RBPRV,8] ;SAVE PROTECTION OF INPUT FILE
MOVEM E,PROTEC ;SAVE INPUT FILE PROTECTION
MOVEM E,EBPROT ;[333] Also in 2 RENAME switch
MOVE A,E ;[333] Make full access CHKACC block
HRLI A,.ACREN ;[333] and check for enough privs to do it straight
MOVE AA,FILPPN ;[333] PPN of file owner
MOVE B,USRPPN ;[333] Our PPN
MOVEI E,A ;[333] Point to block
CHKACC E, ;[333] See
SETZ E, ;[333] Assume ok
JUMPE E,EBAKU9 ;[333] OK if OK
HRROS EBPROT ;[333] Flag that 2 RENAME's needed at close time
HRLI A,.ACCPR ;[333] See if we can change protection to reasonable
MOVEI E,A ;[333]
CHKACC E, ;[333] Try that
SETZ E, ;[333] Assume OK now (??)
SKIPE E ;[333] Yes, skip to see if we are supposed to write
..ERROR E.EBP ;[333] No, it's too protected
HRLI A,.ACWRI ;[333] Yes, can we write to it
MOVEI E,A ;[333]
CHKACC E, ;[333]
SETZ E, ;[333] ?????
JUMPE E,EBAKU9 ;[333] OK
..ERROR E.EBP ;[333] So sorry
EBAKU9: MOVE E,PROTEC ;[333] Get input file protection back
SKIPE A,SPCPRO
LDB E,[POINT 9,A,8]
MOVEM E,BAKPRO ;THIS IS THE DESIRED PROTECTION FOR THE NEW FILE
MOVSI E,100000 ;MEANWHILE, USE <100> FOR .TMP FILE
MOVEM E,SPCPRO ;SO FINAL RENAME NEVER FAILS.
MOVE E,TMPTEC ;GET "###TEC"
CAME E,XFILNM+.RBNAM ;FILNAM=###TEC?
JRST EBAKU1 ;NO, OK
HLRZ A,XFILNM+.RBEXT ;ALSO EXT="TMP"?
CAIN A,(SIXBIT /TMP/) ;EB###TEC.TMP ILLEGAL
..ERROR E.EBF
EBAKU1: MOVEM E,XFILNM+.RBNAM
MOVEM E,BAKTMP ;SAVE FOR DTA RENAME
MOVSI E,(SIXBIT /TMP/)
MOVEM E,XFILNM+.RBEXT
EBAKU6: PUSHJ P,OPNW4 ;WRITE THE TMP FILE
PUSHJ P,OPNW2
TXNE FF,F.EBTP ;UNLESS NOT BACK-UP,
TXO FF,F.UBAK ;SET IN PROGRESS
EBAKU3: TXZE FF,F.CCL ;EB OR TECO COMMAND?
PUSHJ P,YANK ;TECO, DO A Y ALSO
POPJ P,
EBAKU2: TXZ FF,F.EBTP ;NO LONGER AN EB
SETZM SPCPPN ;FAKE DEFAULT PATH
HLLZS XFILNM+.RBEXT ;RESTORE FILE SPECS
MOVSI E,(SIXBIT /DSK/)
MOVEM E,FILDEV ;MAKE SURE DSK AND NOT SOME ERSATZ.
MOVEM E,SPCDEV ;HERE TOO
JRST EBAKU6
SUBTTL E COMMANDS -- I/O ERROR ROUTINES
LKUPER: RELEAS INCHN,0
TXZ FF,F.IOPN ;LET GO OF INPUT DEVICE
EE1+..ERROR E.FNF
;TYPE OUTPUT ERROR
ENTERR: RELEAS OUTCHN,0
TXZ FF,F.OOPN+F.UBAK ;LET GO OF OUTPUT DEVICE & EB FLAG
LDB E,[POINT 6,XFILNM+.RBEXT,35] ;ERROR CODE
CAIE E,2 ;ERROR CODE 2?
JRST ENTER2 ;NO
MOVE E,WRICHR ;GET DEVICE BITS
TXNE E,DV.DTA ;IF DTA ITS FULL, OTHERWISE ENTER ERROR
..ERROR E.FUL
ENTER2: EE1+..ERROR E.ENT
LOOKIN: RELEAS INICHN, ;DON'T WANT CHANNEL ANYMORE
TXZN F2,S.INFO ;WE PUSH ANYTHING?
POPJ P, ;NO, DON'T WORRY
EE1+..ERROR E.FNF
SUBTTL E COMMANDS -- EW (EDIT WRITE)
OPNWRA: TXOA F2,S.EA ;WE ARE GOING TO APPEND
OPNWR: TXZ F2,S.EA
PUSHJ P,OPNW1
OPNW2: MOVE E,WRICHR ;GET DEVCHR WORD
TXNN E,DV.DTA ;DECTAPE?
SKIPG MONITR ;OR OLD MONITOR
JRST SHRTLK ;SHORT LOOKUP - ENTER
TXNN E,DV.DSK ;A DSK?
JRST SHRTLK ;NO, NO NEED FOR EXTENDED LOOKUP - ENTER
SETO B, ;SET FOR FANCY DISK ALLOCATION
MOVEI E,FILPTH ;[340] Make sure path pointer is set
MOVEM E,XFILNM+.RBPPN ;[340]
TXNE FF,F.EBTP ;THIS AN EB TEMP FILE ENTER?
JRST XENTER ;YES, CARE NOT OF SUPERCEDE
PUSHJ P,PPNSET ;SET UP DEFAULT, IF NECESSARY
AOS FILPTH+1 ;NO SCANNING
LOOKUP OUTCHN,XFILNM ;FILE THERE?
JRST XENTER ;NO, JUST ENTER IT
MOVE B,FILPPN ;SAVE PPN
PUSHJ P,PPNSET ;RESET PPN
TXNE F2,S.EA ;APPENDING?
JRST XENTRE ;YES, DON'T SCREW UP PROT/DATE
CLOSE OUTCHN, ;NO, CLOSE FOR SUPERCEDE
XENTER: SETZM XFILNM+.RBPRV ;CREATION DATE NOW
HLLZS XFILNM+.RBEXT ;...
MOVE E,SPCPRO ;NOW SET UP RIGHT PROT.
TRNE E,1 ;IF <000>, MAKE IT <100>
TLO E,100000
HLLZM E,XFILNM+.RBPRV
XENTRE: SETZM XFILNM+.RBALC ;CLEAR ALLOCATION
ENTER OUTCHN,XFILNM ;ENTER THE FILE
JRST ENTERR ;???
JUMPL B,OPNW5 ;[320] -1 MEANS LOOKUP FAILED, SO SKIP ALL THIS
CAMN B,FILPPN ;FILE IN SAME AREA?
PUSHJ P,SUPERC ;YES, THEN SUPERCEDING
TXNE F2,S.EA ;TO APPEND?
USETI OUTCHN,-1 ;YES, TELL GOD
OPNW5: MOVEI T,OBUF1 ;WHERE OUTPUT BUFFERS MUST BE
EXCH T,.JBFF ;TELL MONITOR TO PUT THEM THERE
OUTBUF OUTCHN,2 ;TWO OF THEM
MOVEM T,.JBFF ;AND RESTORE JOBFF
MOVEI E,OUTFIL ;SAVE FILESPEC
PUSHJ P,SPCSAV
MOVSI E,FS.GEN+FS.SUP ;GET OUTPUT FS.GEN & FS.SUP SWITCHES
AND E,SWITC
MOVE T,INSWIT ;[317]GET INPUT SWITCHES
MOVEI B,PPAQ ;ASSUME QUICK ROUTINE
TLNE E,FS.GEN ;[317]MUST GENERATE LSN'S?
MOVEI B,PPA ;= USE SLOW ONE
TXNE FF,F.SEQ ;[317]SEQUENCED FILE?
TLNE T,FS.SUP ;[317]YES, BUT IS INPUT SUPPRESSING THEM?
SKIPA ;[317]BUFFER WILL NOT HAVE SEQUENCE NUMBERS
MOVEI B,PPA ;[317]USE SLOW ROUTINE
MOVEM B,OUTCH ;SAVE IT
TXO FF,F.OOPN ;OUTPUT FILE NOW OPEN
TLNE E,FS.GEN ;ARE BOTH SET?
TLNN E,FS.SUP
JRST .+2 ;NO, OK
..ERROR E.COS
MOVEM E,OUTSWT ;STORE OUTPUT SWITCH
MOVE E,[<"00000">B34+1] ;INIT LSN GENERATION CTR
MOVEM E,LSNCTR
POPJ P,
DEVICL: MOVE E,OPNWI+.OPDEV ;DEVICE NAME
DEVCHR E, ;WHAT IS IT
CAIN E,0
ERRNXD: ..ERROR E.NXD
TXNE E,DV.OUT ;MUST BE CAPABLE OF OUTPUT
TXNN E,DV.M0 ;IN ASCII MODE
..ERROR E.ILD
POPJ P,
OPNW1: TXZE FF,F.UBAK
TXZA FF,F.OOPN
SKIPA
CLOSE OUTCHN,CL.RST
PUSHJ P,FILSPC
PUSHJ P,EWDFSP ;SET UP DEFAULTS
MOVE E,SWITC ;[343] Get I/O switches
TLNE E,FS.APP ;[343] /APPEND?
TXO F2,S.EA ;[343] Yes, set append flag
SKIPE E,FILDEV ;DO WE HAVE A DEVICE?
JRST OPNW11 ;YES
MOVE E,ERSPEC ;NO, GET ER'S
MOVE T,[XWD 3,E] ;CHECK IF ITS ERSATZ
PATH. T,
TRNE E+1,40 ;WELL?
MOVSI E,'DSK' ;IT IS ERSATZ...SO MAKE IT DSK:
OPNW11: MOVEM E,FILDEV ;STORE DEVICE
MOVEM E,SPCDEV ;HERE TOO
SKIPN E,XFILNM+.RBNAM ;HAVE A NAME?
MOVE E,ERSPEC+1 ;USE ER'S NAME IF NOT
MOVEM E,XFILNM+.RBNAM ;SAVE IT
SKIPN E,XFILNM+.RBEXT ;GET EXT?
MOVE E,ERSPEC+2 ;NO, USE ER'S
HLLZM E,XFILNM+.RBEXT
MOVSI B,(SIXBIT /SFD/) ;CHECK FOR AN .SFD FILE
CAMN B,XFILNM+.RBEXT
JRST OPNW4 ;IS AN .SFD, DONT GET DEFAULT PROT.
SKIPE E,SPCPRO ;WAS A PROTECTION SPECIFIED?
JRST OPNW1A ;YES, GO MAKE IT THE DEFAULT
TXNN F2,S.EA ;IF WE ARE DOING AN EA,
SKIPN E,EWSPEC+3 ;OR IF NO PREVIOUS DEFAULT
JRST OPNW4 ;THEN DONT FIDDLE WITH ANYTHING
MOVEM E,SPCPRO ;MAKE DEFAULT PROT THE CURRENT PROT
OPNW1A: MOVEM E,EWSPEC+3 ;AND THE NEW DEFAULT
TXO FF,F.PROT ;AND SAY WE'VE GOT ONE
; JRST OPNW4 ;FALL THROUGH
OPNW4: TXZE FF,F.OOPN ;CALL HERE FROM EB
RENAME OUTCHN,OUTFIL
JFCL ;CANT HAPPEN
RELEAS OUTCHN,0
SETZM OPNWI+.OPMOD
MOVE E,FILDEV
MOVEM E,OPNWD
PUSHJ P,DEVCHK ;GET DEVICE CHARACTERISTICS
MOVEM E,WRICHR
MOVSI E,OBF
MOVEM E,OPNWB
PUSHJ P,DEVICL ;LEGAL DEVICE?
OPEN OUTCHN,OPNWI
..ERROR E.ODV
MOVEI B,"A"
MOVEI E,OUTCHN
DEVTYP E, ;TYPE OF DEVICE
JRST OILDER
TXNE F2,S.EA ;EDIT APPEND (IE DSK ONLY)?
TRNN E,77 ;.TYDSK?
SKIPA
JRST OILDER
MOVEI T,OBUF1
EXCH T,.JBFF
OUTBUF OUTCHN,2
MOVEM T,.JBFF
POPJ P,
OILDER: RELEAS OUTCHN,
..ERROR E.ILD
SUBTTL E COMMANDS -- EZ & EF
;GET I-O DEVICE CHARACTERISTICS IN AC E
;IF TTY, IT MUST BE AVAILABLE & NOT CONTROLLING A JOB
DEVCHK: DEVCHR E, ;GET CHARACTERISTICS
TXNN E,DV.TTY ;TTY?
POPJ P, ;NO
TXNE E,DV.AVL ;YES, AVAILABLE?
TXNE E,DV.TTA ;CONTROLLING A JOB (INCLUDING USER)?
..ERROR E.TTY
POPJ P, ;NO, IT'S OK
;EZ SELECTS THE OUTPUT DEVICE, ISSUES A REWIND COMMAND TO IT,
; ISSUES A COMMAND TO ZERO ITS DIRECTORY, AND OPENS THE FILE
; SPECIFIED (IF ANY).
ZERDIR: PUSHJ P,OPNW1 ;DETERMINE OUTPUT DEVICE
UTPCLR OUTCHN, ;CLEAR DIRECTORY OF OUTPUT DEVICE
MTAPE OUTCHN,1 ;REWIND OUTPUT DEVICE
JRST OPNW2 ;ENTER FILE
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
; SELECTING A NEW OUTPUT FILE.
CLOSEF: TXNN FF,F.OOPN
POPJ P,
CLOSE OUTCHN,CL.IN
STATZ OUTCHN,IO.ERR
JRST OUTERR
TXNE FF,F.UBAK ;EB IN PROGRESS?
PUSHJ P,BAKCLS ;YES (THIS WILL SKIP RETURN)
RENAME OUTCHN,OUTFIL ;IF NOT EB, THEN RENAME FOR PROTECTION
JFCL ;CANT HAPPEN
RELEAS OUTCHN,0
TXZ FF,F.UBAK!F.OOPN ;CLEAR WRITE AND EB FLAGS
POPJ P,
SUBTTL E COMMANDS -- EM (MTAPE UUO'S)
EMTAPE: TXNN FF,F.IOPN
ERROR E.EMD
MOVE E,OPNR1 ;SET UP INPUT DEVICE NAME
MOVEM E,FILDEV ;IN CASE OF AN ERROR
PUSHJ P,CHK2
CAIGE B,1
ERROR E.EMA
MTAPE INCHN,0(B)
OPEN INCHN,OPNRI ;RE-INIT BUFFERS
ERROR E.IEM
PJRST OPNIN
SUBTTL E COMMANDS -- EB (FINISH UP COMMAND)
;THIS ROUTINE IS CALLED AT EF IF AN EB WAS DONE. IT DOES
;THE WORK OF MAKING THE INPUT FILE HAVE THE EXTENSION .BAK ,
;DELETING ANY PREVIOUS FILE.BAK, AND RENAMING THE NEW OUTPUT
;FILE AS THE ORIGINAL FILE.EXT
BAKCLS: CLOSE INCHN,0
MOVE E,EBDEV ;ORIGINAL EB DEVICE
MOVEM E,FILDEV ;IN CASE OF AN ERROR
TXZN FF,F.IOPN ;INPUT OPEN?
JRST BKCLS4 ;NO
CAMN E,OPNR1 ;ORIGINAL SAME AS CURRENT?
JRST BKCLS2 ;YES
BKCLS4: MOVEM E,OPNR1 ;NO, RE-OPEN ORIGINAL
MOVE E,WRICHR ;GET DEVICE CHARACTERISITECS
TXNN E,DV.DSK ;IS IT DISK ?
JRST BKCLS6 ;NO - JUST DO NORMAL OPEN
MOVX E,UU.PHS ;YES - DO PHYS ONLY OPEN
IORM E,OPNRI+.OPMOD ;. . .
BKCLS6: MOVEI E, ;SETUP ERROR CODE
OPEN INCHN,OPNRI
JRST BKCERR ;ERROR ROUTINE
BKCLS2: MOVE E,BAKNAM
MOVEM E,XFILNM+.RBNAM
MOVSI E,(SIXBIT /BAK/)
MOVEM E,XFILNM+.RBEXT
MOVE E,WRICHR ;[353] Get device characteristics
TXNE E,DV.DTA ;[353] DEC-tape?
JRST BKCLSD ;[353] Yes
MOVEI E,FILPTH ;[353] Set up path pointer
MOVEM E,XFILNM+.RBPPN ;[353]
PUSHJ P,PPNDEF ;[353] Set default path
AOS FILPTH+1 ;[353] No scanning!
MOVE B,PROTEC ;GET PROTECTION OF INPUT FILE
SKIPN FDAEM ;[333] See what protection we want file to be
TRZN B,700 ;[333] No FILDAE, make owner protection 0
TRZ B,300 ;[333] FILDAE, leave 400 on if it is
LOOKUP INCHN,XFILNM ;[353]
JRST BKCLS0 ;[333] .BAK file not there or protection failure
LDB B,[POINTR (XFILNM+.RBPRV,RB.PRV)] ;GET PROTECTION OF BACKUP FILE
SETZM XFILNM+.RBNAM
MOVEI E, ;ERROR CODE IN CASE WE NEED IT
RENAME INCHN,XFILNM ;[353]
JRST BKCERR ;ERROR
JRST BKCLS1 ;[333] Now go rename original file to .BAK
;[353] Here to do short LOOKUP on DEC-tapes
BKCLSD: LOOKUP INCHN,XFILNM+.RBNAM ;[353] Short LOOKUP for DTA
JRST BKCLS1 ;[353] None, assume not there
SETZM XFILNM+.RBNAM ;[353] Zero the file name
RENAME INCHN,XFILNM+.RBNAM ;[353] Delete
JRST BKCERR ;[353] Most strange
JRST BKCLS1 ;[353] Move on
;Here when LOOKUP on .BAK file fails
BKCLS0: HRRZ E,XFILNM+.RBEXT ;[333] Get error code
JUMPE E,BKCLS1 ;[333] 0 means not found, so we're OK
MOVEI E,;[333] Otherwise, load error code
JRST BKCERR ;[333] Can't LOOKUP existing .BAK file
BKCLS1: MOVE E,BAKNAM
MOVEM E,XFILNM+.RBNAM
HLLZ E,BAKNAM+1
MOVEM E,XFILNM+.RBEXT
MOVE E,WRICHR ;[353] Get device characteristics
TXNE E,DV.DTA ;[353] DEC-tape?
JRST BKCLD1 ;[353] Yes
MOVEI E,FILPTH ;[353] Set up default path again
MOVEM E,XFILNM+.RBPPN ;[353] (May have gotten wiped)
PUSHJ P,PPNDEF ;[353]
AOS FILPTH+1 ;[353] No scanning
MOVEI E, ;ERROR CODE
LOOKUP INCHN,XFILNM ;[353]
JRST BKCERR ;ERROR
SKIPG MONITR ;SERIES 5?
JRST BKCLS5 ;NO
SKIPL EBPROT ;[333] Need to do 2 RENAMEs due to protection?
JRST BKCLS5 ;[333] No, skip this bother
MOVE E,PROTEC ;GET PROT OF INPUT FILE
;When we arrive at this point, we know the protection must be
;<2xx>, the only one which requires a double rename but still
;allows us to edit at all.
XORI E,300 ;THEN RENAME IT TO 100 RANGE --
DPB E,[POINTR (XFILNM+.RBPRV,RB.PRV)] ;SO WE CAN DO THE REAL RENAME TO .BAK
MOVEI E, ;ERROR
RENAME INCHN,XFILNM ;[353]
JRST BKCERR ;ERROR
BKCLS5: MOVSI E,(SIXBIT /BAK/)
HLLM E,XFILNM+.RBEXT ;DATE75
DPB B,[POINTR (XFILNM+.RBPRV,RB.PRV)] ;GIVE BAK FILE SAME PROT AS OLD BAK
RENAME INCHN,XFILNM ;[353]
TRNA ;[333] Try to recover
JRST BKCLS8 ;[333] Now go rename the .TMP file
;Here when renaming file to file.BAK with a lower protection fails.
;We will try again, this time keeping the protection the same.
LDB E,[POINT 15,XFILNM+.RBEXT,35] ;[333] Get error code
CAIE E,ERPRT% ;[333] Protection failure?
JRST BKCLS7 ;[333] No, complete loss
HLLZ E,BAKNAM+1 ;[333] Retrieve original extension
MOVEM E,XFILNM+.RBEXT ;[333] Store
MOVEI E,;[333] Setup error code
LOOKUP INCHN,XFILNM ;[353][333] Lookup old source again
JRST BKCERR ;[333] Most strange
MOVSI E,'BAK' ;[333] New extension
HLLM E,XFILNM+.RBEXT ;[333] Change only extension
RENAME INCHN,XFILNM ;[353][333] Try the rename again
TRNA ;[333] It's hopeless
JRST BKCLS8 ;[333] Good, now go rename .TMP file
BKCLS7: MOVEI E,'IRB' ;[333] Set error code
JRST BKCERR ;[333] Go issue message
;Here to rename original file to .BAK on a DEC-tape
BKCLD1: MOVEI E, ;[353] Set up error code
LOOKUP INCHN,XFILNM+.RBNAM ;[353] Lookup original file
JRST BKCERR ;[353] Curious
MOVSI E,'BAK' ;[353] New extension
HLLM E,XFILNM+.RBEXT ;[353] Store it
RENAME INCHN,XFILNM+.RBEXT ;[353] Change the name to .BAK
JRST BKCLS7 ;[353] Sigh
;Fall thru...
;Here to rename .TMP file to new source file
BKCLS8: RELEAS INCHN, ;[353] Make sure input device finished
MOVE E,WRICHR ;[353] GET OUTPUT DEVICE CHARCATERISTICS
TXNN E,DV.DTA ;DECTAPE?
JRST BKCLS3 ;NO
MOVEI E, ;ERROR CODE
LOOKUP OUTCHN,OUTFIL ;DECTAPE, <5 SERIES MONITORS NEED EXTRA LOOKUP
JRST BKCERR ;ERROR
CLOSE OUTCHN,2 ;CLOSE OUTPUT FOR RENAME
BKCLS3: MOVE E,BAKNAM ;RENAME ###TEC.TMP TO ORIGINAL NAME
MOVEM E,XFILNM+.RBNAM
HLLZ E,BAKNAM+1
MOVEM E,XFILNM+.RBEXT
MOVE E,BAKPRO ;GET PROTECTION WE WANTED
SETZM XFILNM+.RBPRV
DPB E,[POINTR (XFILNM+.RBPRV,RB.PRV)] ;PUT IT IN
SETZM XFILNM+.RBSIZ
MOVEI E, ;ERROR CODE
RENAME OUTCHN,XFILNM+.RBNAM
JRST BKCERR ;ERROR
JRST CPOPJ1 ;DO A SKIP RETURN
;ERROR ROUTINE TO MAKE SURE THE .TMP FILE GETS CLOSED WITH THE CORRECT
;PROTECTION
BKCERR: MOVE B,BAKPRO ;GET INTENDED PROTECTION.
DPB B,[POINT 9,OUTFIL+2,8] ;DEPOSIT IT
RENAME OUTCHN,OUTFIL ;PUT IN THE RIGHT ONE
JFCL ;TOO BAD!! WE'VE ALREADY GOT ONE ERROR ON
;OUR HANDS! WE TRIED.
CAIE E,'IRN' ;UNLESS ITS THE IRN ERROR,
TLO E,400 ;FLAG THE UUO ERROR CODE TYPE OUT
TLO E,001000 ;FINISH BUILDING THE ERROR UUO
XCT E ;DO IT!
SUBTTL E COMMANDS -- EW (SUBROUTINES FOR EW)
SHRTLK: LOOKUP OUTCHN,XFILNM+.RBNAM ;FILE THERE?
JRST SHRTOK ;NO, ENTER IT
PUSHJ P,SUPERC ;SAY SUPERCEDING MAYBE
TXNE F2,S.EA ;TO APPEND IS AN ERROR
JRST OILDER
SHRTOK: CLOSE OUTCHN, ;CLOSE FOR NO UPDATING
MOVE A,FILPPN ;GET THE FILE PPN BACK
MOVEM A,XFILNM+.RBSIZ ;SAVE IT
SHRTEN: ENTER OUTCHN,XFILNM+.RBNAM ;AND ENTER THE FILE
JRST ENTERR ;TOUGH COKIES
JRST OPNW5 ;FIX BUFFERS, SWITCHES ETC.
SUPERC: MOVE E,WRICHR ;GET DEVICE CHARACTERISTICS
TXNN FF,F.EBTP ;TEMP FILE ENTER?
TXNN E,DV.DIR ;MUST BE DIRECTORY DEVICE
POPJ P, ;ELSE DO NOTHING
MOVE E,SWITC ;[351] Get I/O switches
TLNN E,FS.INP ;[351] /INPLACE?
TXNE F2,S.EA ;OR APPENDING?
POPJ P, ;YES, RETURN
JSP A,CONMES ;TYPE %SUPERSEDING...
ASCIZ .%Superseding existing file
.
POPJ P,
SUBTTL E COMMANDS -- MISC. ROUTINES
CLREXT: MOVE E,[XFILNM+1,,XFILNM+2] ;CLR EXTENDED LOOKUP ARG BLK
SETZM XFILNM+1
BLT E,SPCPRO
MOVEI E,16
MOVEM E,XFILNM
POPJ P,
;ROUTINE TO CHECK WHETHER THE PATH FILE WAS FOUND ON WAS THE ONE WE
;WANTED TO FIND IT ON.
CHKPTH: MOVE T,[SPCPPN(E)] ;WE WANT TO CHECK SPECIFIED PATH
SKIPN SPCPPN ;UNLESS ITS 0, IN WHICH CASE...
CHKDEF: MOVE T,[DEFPTH+2(E)] ;CHECK AGAINST DEFAULT PATH
MOVEM E,FILPTH
MOVE E,[11,,FILPTH]
PATH. E,
JFCL ;USE THE BEST WE HAVE
MOVSI E,-6 ;CHECK FOR INTENDED PATH
MOVE A,@T
CAME A,FILPPN(E)
POPJ P, ;NOT EQUAL
AOBJN E,.-3
JRST CPOPJ1 ;EQUAL, SKIP RETURN
PPNSET: SKIPN SPCPPN ;WAS A PATH SPECIFIED?
PUSHJ P,CHKERZ ;NO, CHECK FOR ERSATZ DEVICE
JFCL
PPNSPC: MOVE E,[SPCPPN,,FILPTH+2] ;SET UP DIRECTORY PATH
SKIPN SPCPPN ;DEFAULT IF NOT SPECIFIED
PPNDEF: MOVE E,[DEFPTH+2,,FILPTH+2] ;ENTER HERE FOR DEFAULT PATH
BLT E,FILPTH+7
SETZM FILPTH+1 ;ZERO THE SCAN SWITCH
POPJ P,
SPCSAV: MOVE A,E ;ROUTINE TO SAVE A FILESPEC
HRLI A,XFILNM+.RBNAM
BLT A,2(E)
SETZM 3(E)
MOVE A,SPCPRO ;PUT CORRECT PROTECTION IN
ROT A,11 ;POSITION IT
TXNE FF,F.PROT ;IF SPECIFIED
DPB A,[POINT 9,2(E),8]
POPJ P,
;ROUTINE TO CHECK FOR AN ERSATZ DEVICE
CHKERZ: SKIPN SPCDEV ;WAS DEVICE SPECIFIED?
JRST CPOPJ1 ;NO, SKIP RETURN
MOVE E,[11,,SPCDEV] ;SET UP PATH.
PATH. E,
JRST CPOPJ1 ;PATH. FAILED, ASSUME NOT ERSATZ
MOVE E,SPCDEV+.PTSWT ;GET SCAN BITS
TXNN E,PT.IPP ;IS IT AN ERSATZ DEVICE?
JRST CPOPJ1 ;NO, SKIP RETURN
SETZM SPCPPN+1 ;YES, DO THE MONITORS JOB--WE DONT WANT SFDS
POPJ P, ;RETURN
;***[340]***
;ROUTINE TO ISSUE WARNING MESSAGE IF FILE NOT FOUND ON
;SPECIFIED DIRECTORY.
CHKSPC: MOVEI E,INCHN ;Set up input channel for PATH. UUO
PUSHJ P,CHKPTH ;See if file found on specified path
TXNE FF,F.COLN ;If : specified, no warning.
POPJ P, ;Yes, return
JSP A,CONMES ;Type a warning
ASCIZ /%File found in [/
HLRZ B,FILPPN ;Type PPN
PUSHJ P,OCTMS
MOVEI CH,","
PUSHJ P,TYOM
HRRZ B,FILPPN
PUSHJ P,OCTMS
MOVE TT1,[-5,,FILSFD] ;Type SFD's
CHKSP1: SKIPN TT,(TT1) ;End of list?
JRST CHKSP2 ;Yes
MOVEI CH,"," ;No, type another comma
PUSHJ P,TYOM
PUSHJ P,SIXBMS ;And SFD
AOBJN TT1,CHKSP1 ;Loop
CHKSP2: JSP A,CONMES ;Finish message
ASCIZ /]
/
POPJ P,
SUBTTL ^V, ^W, ^X COMMANDS
;^V COMMAND
LOWCAS: TXNE FF,F.ARG ;ARG SEEN?
JUMPE B,CLRCAS ;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS
TXZ F2,S.UCAS ;CLEAR ^W FLAG
TXO F2,S.LCAS ;& SET ^V FLAG
JRST RET
;^W COMMAND
STDCAS: TXNE FF,F.ARG ;ARG SEEN?
JUMPE B,CLRCAS ;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS
TXZ F2,S.LCAS ;CLEAR ^V FLAG
TXOA F2,S.UCAS ;& SET ^W FLAG
CLRCAS: TXZ F2,S.LCAS+S.UCAS ;0^V OR 0^W CLEARS BOTH FLAGS
JRST RET
;^X COMMAND
SETMCH: TXNE FF,F.ARG ;ANY ARGUMENT?
JRST SETMC1 ;YES
TXNE FF,F.PMAT ;NO, FORCED EXACT MATCH FLAG ON?
JRST FFOK ;YES, RETURN -1
JRST BEGIN ;NO, RETURN 0
SETMC1: TXZ FF,F.PMAT ;CLR ^X FLAG
JUMPE B,RET ;IF ARG = 0, FLAG = 0
TXO FF,F.PMAT ;OTHERWISE, SET FLAG
JRST RET
SUBTTL ROUTINE TO PARSE FILE DESIGNATOR
FILSPC: HRROS EATCH ;IF THIS COMMAND FAILS, U MUST EAT TIL ALT
PUSHJ P,CLREXT ;CLEAR EXTENDED ARG BLOCK
SETZM SWITC
MOVNI A,5 ;INITIALIZE SFD COUNTER
MOVEM A,PTHCNT
MOVEI A,1 ;INITIALIZE STATE TO 1
PUSHJ P,ENDPUT ;INIT PACKING WORDS
TXZ FF,F.FILE!F.PROT ;BUT WE HAVEN'T SEEN ANY PART OF FILESPEC YET
FILSP1: PUSH P,A ;SAVE OUR STATE!
PUSHJ P,FILCHR ;GET A CHAR
POP P,A ;RESTORE THE DAMN THING
ASH A,1 ;A HAS CURRENT STATE
CAIG B,6 ;B HAS CHAR TYPE
JRST FILSP2
SUBI B,6 ;MUNG FOR OFFSET
AOS A
FILSP2: IMULI B,6
MOVE T,STPROC-2(A) ;GET PROCEDURE
ROT T,(B)
ANDI T,77 ;T NOW HAS PROC. NUM.
PUSHJ P,@FILPRO-1(T) ;DO IT
MOVE A,STNEXT-2(A) ;GET NEXT STATE
ROT A,(B)
ANDI A,77
CAIE A,^D15 ;IF STATE=15, WE'RE DONE
JRST FILSP1
POPJ P,
FILCHR: PUSHJ P,SKRCH ;GET A CHAR.
ERROR E.UFS
CAIL CH,.CHLFD ;< LF OR
CAILE CH,.CHCRT ;> CR
JRST TOUP ;OK SO FAR
JRST FILCHR ;IGNORE LF,FF,CR,VT
TOUP: CAIL CH,"A"+" " ;CONVERT LOWER CASE
CAILE CH,"Z"+" "
SKIPA
TXC CH," "
MOVEI T,FILDSP ;NOW WE CLASSIFY THE CHARACTER
FILCH1: MOVE B,(T)
JUMPE B,FILCH2
CAIE CH,(B)
AOJA T,FILCH1
HLRZS B
POPJ P,
FILCH2: PUSHJ P,CKSYM ;IS IT A-Z, 0-9, %, $?
SKIPA B,[1] ;YES
MOVEI B,^D12 ;NO, MUST BE OTHER
CAIL CH,"0" ;BUT MIGHT BE OCTAL
CAILE CH,"7" ;...
POPJ P, ;NOPE
AOJA B,CPOPJ ;YES, B=2
PAKSIX: SUBI CH," " ;CONVERT TO SIXBIT
TLNE OU,770K ;IS THERE STILL ROOM?
IDPB CH,OU ;YES, PACK IT
TLNE E,7700 ;SHIFT MASK?
ASH I,-6 ;YES
POPJ P,
PAKOCT: LSH E,3 ;STANDARD NUMBER PACKING
IORI E,-"0"(CH)
POPJ P,
PUTDEV: JUMPE E,ENDPUT ;DONT STORE NULL DEVICE
SKIPE FILDEV ;ALREADY GOT ONE?
..ERROR E.DDV ;YEP
MOVEM E,FILDEV ;STORE IT
MOVEM E,SPCDEV ;HERE TOO
JRST ENDPUT
PUTFIL: JUMPE E,ENDPU1 ;DON'T SAVE NULL FILE NAMES
SKIPE XFILNM+.RBNAM ;DOUBLE FILE NAME?
..ERROR E.DFN
MOVEM E,XFILNM+.RBNAM ;SAVE IT
JRST ENDPUT ;GO RESET PACKING
PUTEXT: IORI E,1 ;SAID . SO REMEMBER NOT TO DEFAULT
SKIPE XFILNM+.RBEXT ;DOUBLE EXT ILLEGAL
..ERROR E.DEX
MOVEM E,XFILNM+.RBEXT ;STORE IT
JRST ENDPUT
PUTPRO: SKIPE XFILNM+.RBPRV ;DOUBLE PROTECTION LOSES
..ERROR E.DPR
CAILE E,777 ;IS IT A LEGAL PROTECTION
..ERROR E.PRO ;NOPE
DPB E,[POINT 9,SPCPRO,8] ;SAVE IT HERE
SKIPE E ;IF <000>,
JRST .+3
MOVEI E,100 ;THEN MAKE IT 100, SO RENAME WORKS
AOS SPCPRO ;AND FLAG SPCPRO
DPB E,[POINT 9,XFILNM+.RBPRV,8] ;PUT IT AWAY
TXO FF,F.PROT ;A PROTECTION WAS SPECIFIED
JRST ENDPUT
PUTPRJ: SKIPN FILPPN ;DO WE ALREADY HAVE A DIRECTORY?
TXNE F2,S.DPPN ;NO, BUT MAYBE HE SPECIFIED DEFAULT
..ERROR E.DDR ;2 DIRECTORY SPECS LOSE
CAIN E,0 ;IS PROJ 0?
HLRZ E,USRPPN ;YES, GET LOGGED-IN PROJ
HRLZM E,FILPPN ;STORE IT
JRST ENDPUT
PUTPRG: CAIN E,0 ;IS PROG 0?
HRRZ E,USRPPN ;YES, GET LOGGED-IN PROG
HRRM E,FILPPN ;STORE IT
MOVE E,FILPPN
MOVEM E,XFILNM+.RBSIZ
MOVEM E,SPCPPN ;SAVE IT HERE TOO
JRST ENDPUT
PUTPTH: JUMPE E,ENDPUT ;DONT STORE NULL SFD'S
AOSLE T,PTHCNT ;COUNT TOTAL SFD'S
..ERROR E.TMS ;TOO MANY
MOVEM E,FILSFD+4(T) ;STORE IT
MOVEM E,SPCPPN+5(T) ;SAVE HERE TOO
ENDPUT: TXO FF,F.FILE ;WE'VE SEEN AT LEAST ONE PART OF FILESPEC
ENDPU1: SETZ E, ;ZERO PACKING WORD
MOVE OU,[POINT 6,E] ;INIT SIXBIT BYTE POINTER
MOVSI I,770K ;INIT SWITCH MASK
POPJ P,
PUTSWI: MOVEM E,SWITHL ;SAVE IN CASE BAD
SETZM SWINDX ;NO SWITCH SEEN YET
MOVSI T,-SWS ;NUMBER OF SWITCHES IN THE WORLD
SWLOOP: CAMN E,SWITAB(T) ;THIS IS IT?
JRST SETSWH ;YES, SET IT
MOVE OU,SWITAB(T) ;YES, GET SWITCH FROM TABLE
AND OU,I ;APPLY MASK TO SWITCH
CAME OU,E ;SAME?
JRST SWHLP ;NO, LOOP
SKIPE SWINDX ;ALREADY HAVE MATCH?
..ERROR E.ABS
MOVEM T,SWINDX ;ELSE SAVE INDEX AND GO ON
SWHLP: AOBJN T,SWLOOP ;LOOP FOR ALL (MAYBE)
SKIPN T,SWINDX ;HAVE SEEN A MATCH?
..ERROR E.UIS
SETSWH: MOVSI OU,400K ;LITE SIGN BIT
MOVNS T
LSH OU,(T) ;SHIFT INTO POSITION
IORM OU,SWITC ;AND SAVE IT
JRST ENDPUT
DEFDIR: SKIPN FILPPN ;DOUBLE DIRECTORY LOSES
TXOE F2,S.DPPN ;SET THE DEFAULT DIRECTORY BIT
..ERROR E.DDR ;EVEN DOUBLE DEFAULT LOSES-WE ARE MEAN
JRST ENDPUT
FILERR: MOVE A,STNEXT-2(A) ;IN THE CASE OF AN ERROR, "NEXT STATE"
ROT A,(B) ;IS REALLY THE ERROR NUMBER
ANDI A,77
JRST FILERT-1(A) ;GO TO IT
FILERT: ..ERROR E.IFN ;ERROR DISPATCH TABLE
..ERROR E.DEX
..ERROR E.BFS
..ERROR E.DIR
..ERROR E.IOS
SUBTTL TABLES FOR FILSPEC PARSER
;CHARACTER TYPE CLASSIFICATION TABLE
FILDSP: ^D3,,.CHESC
^D4,," "
^D4,,.CHTAB
^D5,,","
^D7,,"."
^D8,,"/"
^D9,,":"
^D10,,"["
^D11,,"]"
^D6,,"-"
^D10,,"<"
^D11,,">"
0,,0
;PROCEDURE DISPATCH TABLE
FILPRO: EXP PAKSIX
EXP PAKOCT
EXP PUTDEV
EXP PUTFIL
EXP PUTEXT
EXP PUTPRJ
EXP PUTPRG
EXP PUTPTH
EXP PUTSWI
EXP CPOPJ
EXP FILERR
EXP DEFDIR
EXP PUTPRO
RADIX 10 ;NOTE!!!!
;PROCEDURE TABLE
STPROC: BYTE (6)1,1,4,4,11,11,4,4,3,4,11,11 ;STATE 1
BYTE (6)1,1,5,5,11,11,11,5,11,5,11,11 ;STATE 2
BYTE (6)11,2,11,6,6,12,11,11,11,11,13,11 ;STATE 3
BYTE (6)11,2,7,7,7,11,7,7,11,11,7,11 ;STATE 4
BYTE (6)1,1,8,8,8,11,8,8,11,11,8,11 ;STATE 5
BYTE (6)1,1,9,9,11,11,9,9,11,9,11,11 ;STATE 6
BYTE (6)1,1,10,10,11,11,10,10,11,11,10,11 ;STATE 7
BYTE (6)1,1,10,10,10,11,10,10,11,11,10,11 ;STATE 8
BYTE (6)11,11,11,10,10,11,11,11,11,11,11,11 ;STATE 9
;"NEXT STATE" TABLE
STNEXT: BYTE (6)1,1,15,1,1,1,2,6,1,3,1,1 ;STATE 1
BYTE (6)2,2,15,1,1,1,2,6,3,3,1,1 ;STATE 2
BYTE (6)1,3,3,9,4,7,3,3,3,3,1,1 ;STATE 3
BYTE (6)4,4,15,8,5,4,2,6,4,4,1,4 ;STATE 4
BYTE (6)5,5,15,8,5,4,2,6,4,4,1,4 ;STATE 5
BYTE (6)6,6,15,1,1,1,2,6,3,3,1,1 ;STATE 6
BYTE (6)1,1,15,7,4,4,2,6,3,4,1,1 ;STATE 7
BYTE (6)1,1,15,13,5,4,2,6,3,4,1,4 ;STATE 8
BYTE (6)4,4,4,14,4,4,4,4,4,4,4,4 ;STATE 9
RADIX 8
;FILE SELCTION COMMAND SWITCH TABLE
DEFINE SWTCHS,<
SW APPEND ;;APPEND TO THE LOG FILE (NOT SUPERSEDE)
SW DEFAUL ;;[337] CLEAR STICKY DEFAULTS BEFORE APPLYING FILESPEC
SW GENLSN ;;GENERATE LINE SEQUENCE NUMBER ON OUTPUT
SW INPLACE ;;.TECO DOES ER/EW TO SAME FILESPEC
SW NOIN ;;NO INPUT FROM TTY IN THE LOG FILE
SW NOLSN ;;INTELLIGENT PERSON NOT WANTING LSN'S
SW NOOUT ;;NO TTY TYPEOUT IN THE LOG FILE
SW READON ;;[337] READ ONLY WHEN .TECO
SW SUPLSN ;;SUPPRESS LINE SEQUENCE NUMBERS ON INPUT
>
DEFINE SW,(SWT),<
EXP SIXBIT /SWT/
FS.'SWT==<.BIT.==.BIT._-1>>
.BIT.==1B17
SWITAB: SWTCHS ;GENERATE SWITCH TABLE
SWS==.-SWITAB
SUBTTL Y RENDER THE BUFFER EMPTY. READ INTO THE BUFFER
; UNTIL (A) A FORM FEED CHARACTER IS READ, OR
; (B) THE BUFFER IS WITHIN ONE THIRD OR
;128 CHARACTERS OF CAPACITY AND A LINE FEED IS READ, OR
; (C) AN END OF FILE IS READ, OR
; (D) THE BUFFER IS COMPLETELY FULL.
;THE FORM FEED (IF PRESENT) DOES NOT ENTER THE BUFFER.
YANKER: CHKEO EODEC,YANK ;[335] Y is OK if EO level is 2 or less
SKIPN EQM ;Y ILLEGAL FROM TTY
ERROR E.UEY
YANK:
YANK1: MOVE OU,BEG
MOVEM OU,PT ;PT:=BEG
MOVSI C,377777 ;[346] Set up "infinite" line count
MOVEM C,LFCNT ;[346]
YANK2: TXZ FF,F.FORM ;RESET THE YANK,APPEND FORM FEED FLAG
TXNN FF,F.IOPN ;ERROR IF INPUT NOT SPECIFIED
ERROR E.NFI
;MAINTAIN AT LEAST A MINIMUM SIZE BUFFER OF 3000
;CHARACTERS AT ALL TIMES, WHEN TECO ASKS FOR INPUT FROM
;ANYTHING BUT THE CONSOLE.
MOVE C,PT ;GET .
MOVEM C,Z ;TELL NROOM IT'S AN EXPAND
SUBM OU,C ;BUT EXPAND WITH REAL Z IN MIND
ADDI C,^D3000 ;NEED 3000 ABOVE Z
PUSHJ P,NROOM
YANK6: ADD OU,RREL ;RELOCATE IN CASE GARBAGE COLLECTION DONE
MOVE TT,MEMSIZ ;TOP OF BUFFER
MOVE CH,TT
SUB TT,OU
IDIVI TT,3
SUBM CH,TT
MOVEM TT,M23 ;M23 HAS 2/3 PT
SUBI CH,200
MOVEM CH,M23PL ;M23PL HAS 200 BELOW TOP
MOVE TT,OU ;CHAR ADR
IDIVI TT,5 ;TO WORD ADR
HLL TT,BTAB-1(TT1) ;MAKE BYTE POINTER
YANK4: CAMGE OU,M23 ;2/3 FULL YET?
JRST YANK3 ;NO, KEEP GOING
CAMG OU,M23PL ;YES, GETTING NEAR TOP?
CAIN CH,.CHLFD ;NO. LINE FEED?
JRST YANK51 ;YES. THAT'S ALL.
;NO. GET MORE.
YANK3: PUSHJ P,@INCH ;READ A CHARACTER
JRST YANK51 ;NONE LEFT, CLEAR BUFFER AND RETURN.
IDPB CH,TT ;PUT CHARACTER IN MEMORY
CAIN CH,.CHFFD ;[346] FORM FEED?
JRST YANK5 ;[346] Yes
CAIE CH,.CHLFD ;[346] Line feed?
AOJA OU,YANK4 ;NO. UPDATE DATA BUFFER PTR AND CHECK FOR OVERFLOW.
SOSLE LFCNT ;[346] Yes, decrement line count
AOJA OU,YANK4 ;[346] Still positive...Keep going
AOJA OU,YANK51 ;[346] Time to stop
YANK5: TXO FF,F.FORM ;[346] YANK AND/OR APPEND ENDS ON A FORM FEED
YANK51: MOVEM OU,Z ;YES. SET END OF DATA BUFFER AND RETURN
SKIPE XCTING ;IF OFF STOP
POPJ P,
JRST GO ;RESTART
;A APPEND TO THE END OF THE BUFFER FROM THE SELECTED INPUT
; TERMINATING THE READ IN THE SAME MANNER AS Y. THE POINTER
; IS NOT MOVED BY A.
;:nA SAME AS A EXCEPT THAT INPUT STOPS AFTER THE NTH LINE FEED,
; UNLESS ONE OF THE REGULAR CONDITIONS TERMINATES IT FIRST.
; IF n IS MISSING, 0, OR NEGATIVE, IT IS TAKEN AS 1.
APPEND: MOVE OU,Z ;STORE DATA AT END OF BUFFER.
PUSHJ P,CHK2 ;[346] GET ARG
TXZN FF,F.COLN ;[346] WAS COLON SET?
MOVSI B,377777 ;[346] NO, REGULAR APPEND, SO SET LARGE COUNT
MOVEM B,LFCNT ;[346] STORE COUNT
PUSHJ P,YANK2
JRST RET
SUBTTL ^Y ! ^P - QUICK PAGE SCAN COMMANDS
QYANK: TXO F2,S.YANK ;NOTE QUICK YANK
QPAGE: TXNN FF,F.ARG ;NO ARG MEANS RETURN # OF FF'S SEEN
JRST [MOVE A,NFORMS ;# FF'S SEEN
JRST VALRET] ;SAY IT UNTO THE USER
SKIPLE B ;ZERO IS ILLEGAL ARG
CAMGE B,NFORMS ;BACKWARD OR NEGATIVE ARG?
..ERROR E.IPA
CAMN B,NFORMS ;REQUEST IS FOR THIS PAGE?
JRST RET ;YES, GO AWAY FROM HERE MY BROTHER
TXNE FF,F.EOFI ;EOF?
QERR: ..ERROR E.PTL
PUSH P,B ;SAVE PAGE WE WANT FOR LATER AND
TXO FF,F.NSRH ;NO FREE FORM FEEDS
TXNN F2,S.YANK ;NO OUTPUT?
PUSHJ P,PUNCHR ;PUNCH ANY BUFFER THERE NOW
MOVE B,BEG ;WHERE TEXT BUFFER STARTS
MOVEM B,Z ;NOTHING IN IT NOW
MOVEM B,PT ;PT ALSO = BEG
POP P,B ;GET THE ARGUMENT BACK
SOJ B, ;MINUS 1 SO THAT WHEN NFORMS = B
;WE WANT THE NEXT PAGE
TXNN FF,F.IOPN ;SOMETHING TO READ?
..ERROR E.NFI
TXNN F2,S.YANK ;^Y REQUIRES NO OUTPUT FILE
TXNE FF,F.OOPN ;FILE MUST BE OPEN FOR OUTPUT HERE
CAIA
ERROR E.NFO
TXNE FF,F.SEQ ;SEQUENCED FILE= USE STUPID ROUTINE
JRST STUPID
QLOOP: CAMG B,NFORMS ;FOUND IT YET?
JRST APPEND ;YES, YANK AND RETURN
PUSHJ P,@INCH ;READ A CHARACTER
AOJA B,QERR ;END OF FILE = BAD PAGE ARG
TXNN F2,S.YANK ;NO OUTPUT ON ^Y
PUSHJ P,@OUTCH ;SEND IT TO OUTPUT FILE
SKIPN XCTING ;HE WANT ME TO STOP?
PUSHJ P,CKEOL ;YES, BUT STOP ON EOL
JRST QLOOP ;NOT EOL OR NOT TO STOP
JRST APPEND ;AND YANK A PAGE
STUPID: MOVEM B,SAVEAC ;SAVE B
STUP1: TXNE FF,F.EOFI ;[327] ANYTHING LEFT?
AOJA B,QERR ;[327] NO, RESET B AND GO TYPE ERROR
PUSHJ P,YANK1 ;[327] GET A BUFFER-FULL
TXNN F2,S.YANK ;[327] IF ^Y, WE DON'T NEED TO OUTPUT
PUSHJ P,PUNCHR ;[327] OUTPUT CURRENT BUFFER
MOVE B,SAVEAC ;[327] RESTORE B
CAMLE B,NFORMS ;[327] ARE WE DONE?
JRST STUP1 ;[327] NO, LOOP BACK
PUSHJ P,YANK1 ;[327] YES, SO DO ONE MORE Y
JRST RET ;[327] AND RETURN
SUBTTL READ A CHARACTER FROM INPUT FILE
RI: SOSGE IBUF+.BFCNT ;MORE IN THE BUFFER?
JRST RI3 ;NO, CAUSE THERE TO BE MORE
RI0: ILDB CH,IBUF+.BFPTR ;GET ONE
JUMPE CH,RI ;EAT NULLS
CAIN CH,.CHFFD ;FF?
AOS NFORMS ;NOTE IT IN CASE NEW ^P COMMAND USED
TXZN F2,S.SSEQ ;LAST THIS WAS A SUPPRESSED SEQUENCE #?
JRST RI1 ;NO..
CAIE CH,.CHCRT ;CR (FOR SOS) OR
CAIN CH,.CHTAB ; FOLLOWING IT?
JRST RI ;= EAT IT UP
RI1: LDB T,[POINT 1,@IBUF+.BFPTR,35] ;GET BIT 35 OUT OF CURRENT WORD
JUMPE T,CPOPJ1 ;LEAVE, A LSN
MOVE T,INSWIT ;SUPPRESS SEQ # FLAF ON?
TLNN T,FS.SUP ;?
JRST CPOPJ1
RI2: MOVEI T,4 ;THINGS TO EAT
IBP IBUF+.BFPTR ;INCREMENT BYTE POINTER
SOS IBUF+.BFCNT ;DECREMENT COUNT
SOJG T,.-2 ;A BUNCH OF TIMES
TXO F2,S.SSEQ ;JUST ATE A SEQUENCE NUMBER
JRST RI ;NEXT CHARACTER PLS
RI3: IN INCHN, ;GET A BUFFER
JRST RI ;AND CHAR TOO
ANNERR: TXO FF,F.EOFI ;ELSE ASSUME EOF
ANERR: STATO INCHN,IO.ERR ;ERROR?
POPJ P, ;SINGLE RETURN
INERR: GETSTS INCHN,B ;SAVE ERROR FLAGS
RELEAS INCHN,0
TXZ FF,F.IOPN
EE2ERR: EE2+ERROR E.INP
RIQ: SOSGE IBUF+.BFCNT ;MORE THERE?
JRST [IN INCHN, ;GET SOME
JRST RIQ ;YANK CHAR
JRST ANNERR] ;CHECK FOR ERRORS OR EOF
ILDB CH,IBUF+.BFPTR ;GET CHARACTER
CAIN CH,.CHFFD ;?
AOS NFORMS ;YES, COUNT IT
JUMPN CH,CPOPJ1 ;AND RETURN
JRST RIQ ;ELSE LOOP
SUBTTL INSERT COMMAND
;^ITEXT$ INSERTS AT THE CURRENT POINTER LOCATION THE ^I (TAB)
; AND THE TEXT FOLLOWING THE ^I UP TO BUT NOT INCLUDING THE
; ALT MODE. THE POINTER IS PUT TO THE RIGHT OF THE INSERTED
; MATERIAL.
TAB: TXZ FF,F.ARG ;NO ARGUMENT WANTED
PUSHJ P,TAB2 ;INSERT TAB
IFN VC, ;ADJUST VVAL
;ITEXT$ INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
; THE I UP TO BUT NOT INCLUDING THE FIRST ALT. MODE. THE
; POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.
INSERT: TXNE FF,F.ARG ;IS THERE AN ARGUMENT?
JRST INS1A ;YES. NI COMMAND.
MOVEI CH,.CHESC ;NORMAL TERMINATOR
TXZN FF,F.SLSL ;DID @ PRECEED I?
JRST INSERA ;NO, TERMINATOR = ALTMODE
PUSHJ P,SKRCH ;YES. CH:=USER SELECTED TERMINATOR.
ERROR E.UIN
INSERA: MOVEI B,(CH) ;B=INSERTION TERMINATOR.
SETZM CTGLEV ;ZERO THE ^G NEST COUNTER
MOVEI T,INSER0 ;AND SET ^G ROUTINE RETURN POINT
MOVEM T,CTGRET
PUSH P,CPTR ;SAVE CURRENT POSITION IN CMD STRING
PUSH P,COMCNT
MOVEI C,0 ;COUNT # CHARACTERS TO INSERT IN C AND
;MOVE CPTR TO END OF STRING.
INSER0: PUSHJ P,SKRCH ;GET NEXT CHARACTER
JRST INS0A ;NO MORE CHARS AT THIS LEVEL
SKIPN CTGLEV ;IF WE ARE IN A ^G NEST, IGNORE TERMINATOR
CAIE CH,(B) ;IS IT THE TERMINATOR?
TRNA ;NO, SKIP
JRST INSER2 ;YES, END OF 1ST PASS
TXO FF,F.NNUL ;FLAG NON-NULL STRING (FOR F-SEARCH)
CHKEO EO21,INSER1 ;IF EO=1, CTRL-CHARS ARE JUST TEXT
MOVEI T,IN1TAB ;CK FOR ^V, ^W, ^R, ^T, ^^
TXNE F2,S.NCCT ;^T FLAG ON?
MOVEI T,IN2TAB ;YES, USE RESTRICTED TABLE
PUSHJ P,DISP1
TXNN F2,S.NCCT ;IF ^T ON, ALL OTHER CTL-CHARS LEGAL TEXT
PUSHJ P,CKNCC ;CHECK FOR OTHER CTRL-CHARS (THEY ARE ILLEGAL)
INSER1: AOJA C,INSER0 ;COUNT TEXT CHARACTERS
INSER2: MOVEM C,VVAL ;SAVE LENGTH OF STRING
IFN VC,<
TXZE FF,F.TABS ;TAB INSERTED?
AOS VVAL> ;YES, COUNT IT
TXZ F2,S.NCCT ;REFRESH ^T FLAG
TXNE FF,F.SRCH ;DOING FS OR FN?
JRST SERCHJ ;YES
POP P,COMCNT ;RESET TO BEGINNING OF INSERT TEXT
POP P,CPTR
PUSHJ P,NROOM ;YES. MOVE FROM PT THROUGH Z UP C POSITIONS.
;MOVE INSERTION INTO DATA BUFFER
INS1B: MOVE OU,PT
SETZM CTGLEV ;ZERO ^G NEST COUNTER
MOVEI T,INS1C ;AND SET RETURN POINT
MOVEM T,CTGRET
INS1C: PUSHJ P,GCH ;CH:=CHARACTER FROM COMMAND STRING.
SKIPGE COMCNT ;END OF COMMAND AT THIS LEVEL?
JRST INS0A ;YES
INS1F: CAIN CH,(B) ;IS IT THE TERMINATOR?
SKIPE CTGLEV ;YES, BUT IGNORE IT IF IN ^G NEST
TRNA ;NO, SKIP
POPJ P, ;BUT WE'RE NOT, SO LEAVE
CHKEO EO21,INS1D ;IF EO=1, THERE ARE NO CTL-CHAR. COMMANDS
MOVEI T,INSTAB ;CK FOR CONTROL CHARACTERS
TXNE F2,S.NCCT ;^T FLAG ON?
MOVEI T,INTTAB ;YES, ONLY ^T AND ^R ARE SPECIAL
PUSHJ P,DISP1
INS1E: PUSHJ P,CASE ;CONVERT UC TO LC IF FLAGS WARRANT
INS1D: PUSHJ P,PUT ;NO. STORE CHARACTER IN DATA BUFFER TO RIGHT OF PT.
AOS OU,PT ;PT:=PT+1
JRST INS1C ;LOOP
;DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (COUNT PASS)
IN1TAB: XWD CTRGI,7 ;^G
XWD INSER0,.CHCNV ;^V
XWD INSER0,.CHCNW ;^W
XWD INSER0,.CHCCF ;^^
IN2TAB: XWD INSER4,.CHCNT ;^T
XWD INSER3,.CHCNR ;^R
XWD 0,0 ;END OF LIST
;GET CHARACTER AFTER ^R
INSER3: PUSHJ P,SKRCH ;DON'T COUNT ^R & DON'T DO CHECKS ON CHAR AFTER IT
ERROR E.UIN
JRST INSER1
;CHANGE NO-CONTROL-COMMANDS FLAG
INSER4: TXC F2,S.NCCT
JRST INSER0 ;DON'T COUNT ^T
;^GI CAUSES THE CONTENTS OF Q REG I TO BE INSERTED INTO THE TEXT STRING
;AT THIS POINT
CTRGI: PUSHJ P,SKRCH ;GET THE NAME OF THE Q-REG
ERROR E.ICG ;NOT THERE
PUSH PF,CPTR ;SAVE POINTER
PUSH PF,COMCNT ;AND COUNT
PUSH P,C ;AND LENGTH OF STRING SO FAR
AOS CTGLEV ;BUMP ^G NEST COUNTER
PUSHJ P,QREGV2 ;ACCESS THE Q REGISTER
PUSHJ P,QTEXEI
PUSHJ P,GTQCNT ;LENTH OF Q REG STRING IN C
MOVEI A,(I)
IDIVI A,5 ;FIX THE POINTER
HLL A,BTAB-1(A+1)
MOVEM A,CPTR ;AND STORE IT
MOVEM C,COMCNT ;THE NEW COUNT
POP P,C ;RESTORE INSERT STRING LENGTH
JRST @CTGRET ;RETURN
INS0A: SKIPN CTGLEV ;ARE WE IN A Q-REGISTER?
ERROR E.UIN ;NO, UNTERMINATED INSERT COMMAND
POP PF,COMCNT ;RESTORE COUNT
POP PF,CPTR ;AND POINTER
SOS CTGLEV ;DECREMENT NEST COUNT
JRST @CTGRET ;RETURN
;DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (INSERT PASS)
INSTAB: XWD CTRGI,7 ;^G
XWD INSLOW,.CHCNV ;^V
XWD INSSTD,.CHCNW ;^W
XWD INSSPC,.CHCCF ;^^
INTTAB: XWD INSMAC,.CHCNT ;^T
XWD INSIGR,.CHCNR ;^R
XWD 0,0 ;END OF LIST
;^V CAUSES THE NEXT CHARACTER TO BE CONVERTED TO LOWER CASE (IF UPPER CASE)
;^V^V SETS LOWER CASE MODE UNTIL THE END OF THE TEXT STRING (OR FURTHER NOTICE)
INSLOW: PUSHJ P,C.V ;SET ^V FLAGS
JRST INS1C ;CONTINUE TO NEXT CHAR.
;^W CAUSES NEXT CHAR. TO BE TAKEN AS IS (STANDARD MODE)
;^W^W SETS STANDARD MODE UNTIL END OF TEXT STRING (OR FURTHER NOTICE)
INSSTD: PUSHJ P,C.W ;SET ^W FLAGS
JRST INS1C ;CONTINUE TO NEXT CHAR.
;^R CAUSES NEXT CHAR. TO BE TAKEN AS TEXT
;EVEN IF IT IS A CONTROL CHAR. OR THE TEXT TERMINATOR
INSIGR: PUSHJ P,GCH ;GET NEXT CHAR.
JRST INS1E ;TREAT AS TEXT
;^^ -- IF NEXT CHAR IS @,[,\,],^, OR _, CONVERT IT TO LC RANGE
INSSPC: PUSHJ P,GCH ;GET NEXT CHAR
PUSHJ P,CVTSPC ;CONVERT IF WARRANTED
JRST INS1F
;CHANGE NO-CONTROL-COMMANDS MODE
INSMAC: TXC F2,S.NCCT ;COMPLEMENT ^T FLAG
JRST INS1C ;GO ON TO NEXT CHAR
SUBTTL ALPHA CASE CONVERTED
;SET ^V FLAGS
C.V: TXON F2,S.CTLV ;SET ^V FLAG -- WAS IT ON BEFORE?
POPJ P, ;NO
TXZ F2,S.CTLV+S.CTWW ;YES, SET ^V^V FLAG & CLR OTHERS
TXO F2,S.CTVV
POPJ P,
;SET ^W FLAGS
C.W: TXON F2,S.CTLW ;SET ^W FLAG -- WAS IT ON BEFORE?
POPJ P, ;NO
TXZ F2,S.CTLW+S.CTVV ;YES, SET ^W^W FLAG & CLR OTHERS
TXO F2,S.CTWW
POPJ P,
;CONVERT ALPHABETIC CH TO UPPER OR LOWER CASE ACCORDING TO CASE CONTROL FLAGS
CASE: CAIL CH,"A" ;IS CHAR IN UPPER CASE RANGE?
CAILE CH,"Z"
CAIL CH,"A"+40 ;IS IT IN LOWER CASE RANGE?
CAILE CH,"Z"+40
JRST CASE3 ;NO
CASE2: TXNE F2,S.LCAS ;PREVAILING LOWER CASE?
TRO CH,40 ;YES, CONVERT TO LOWER
TXNE F2,S.UCAS ;PREVAILING UPPER CASE?
TRZ CH,40 ;YES, CONVERT TO UPPER
TXNE F2,S.CTVV ;DOUBLE ^V ON?
TRO CH,40 ;YES, CONVERT TO LC
TXNE F2,S.CTWW ;DOUBLE ^W ON?
TRZ CH,40 ;YES, CONVERT TO UC
TXZE F2,S.CTLV ;SINGLE ^V ON?
TRO CH,40 ;YES, CONVERT TO LC
TXZE F2,S.CTLW ;SINGLE ^W ON?
TRZ CH,40 ;YES, CONVERT TO UC
CASE3: TXZ F2,S.CTLV+S.CTLW ;CLR IN CASE NO CONVERSION
POPJ P,
;CONVERT @, [, \, ], ^, AND _ TO THE EQUIVALENT LC CHARACTER
CVTSPC: CAIL CH,"["
CAILE CH,"_"
CAIN CH,"@"
TRO CH,40 ;CONVERT TO LOWER CASE RANGE
POPJ P,
SUBTTL CHECK FOR NON-CONTROL CHARACTERS
;IF CH<10, OR 15
SUBTTL PUT A CHARACTER IN THE OUTPUT FILE
PPA:
PPA05: SOSGE OBF+.BFCNT ;YES. IS OUTPUT BUFFER FULL?
JRST OUTBFR
MOVE A,OUTSWT ;GET OUTPUT SWITCHES
TXNN FF,F.SEQ ;SEQUENCED FILE?
TLNE A,FS.GEN ;NO, OUTPUT FS.GEN ON?
JRST PPA02 ;YES, GENERATE LSN
TXZ FF,F.SQIN
PPA01: IDPB CH,OBF+.BFPTR ;CH TO OUTPUT BUFFER.
POPJ P, ;RETURN
OUTBFR: OUT OUTCHN, ;DUMP BUFFER
JRST PPA05 ;AND CONTINUE
OUTERR: GETSTS OUTCHN,B ;SAVE ERROR FLAGS
RELEAS OUTCHN,0 ;CLOSE FILE AND RELEASE OUTPUT DEVICE.
TXZ FF,F.OOPN+F.UBAK ;CLEAR OUTPUT FILE OPEN INDICATOR.
EE2+ERROR E.OUT
PPAQ: SOSGE OBF+.BFCNT ;MORE ROOM?
JRST [OUT OUTCHN, ;DUMP BUFFER
JRST PPAQ ;LOOP
JRST OUTERR] ;ELSE ERROR
IDPB CH,OBF+.BFPTR ;SAVE CHARACTER
POPJ P, ;LEAVE
PPA02: TXNN FF,F.SQIN ;WAS LAST CHAR AN EOL OR BEG OF BUFR?
JRST PPA03 ;NO
MOVE AA,OUTSWT ;GET OUTPUT SWITCHES
TLNE AA,FS.SUP ;IF WE ARE SUPRESSING SEQUENCE #'S,
JRST PPA06 ;DON'T WORRY ABOUT PADDING WITH NULLS
MOVE A,OBF+.BFCNT ;ROOM FOR SEQ# IN OUTPUT BUFR?
CAIG A,^D12 ;[345] Page marks need 12 positions
JRST PPA05 ;NO, OUTPUT & COME BACK
PUSHJ P,NULPAD ;[345] Go pad with nulls if necessary
PPA06: TXZ FF,F.SQIN
TXNE FF,F.SEQ ;GENERATE NEW LSN OR OUTPUT EXISTING LSN?
JRST PPA04 ;OUTPUT EXISTING LSN
CAIN CH,.CHFFD ;[345] Form feed?
JRST PPA14 ;[345] Yes, go handle it
MOVE A,LSNCTR ;GET LAST CREATED LSN WITH BIT 35 ON
ADD A,[BYTE (7)106,106,106,107] ;& ADD ASCII 10 TO IT
MOVE T,A
AND T,[BYTE (7)60,60,60,60]
LSH T,-3
MOVE TT,A
AND TT,[BYTE (7)160,160,160,160]
IOR T,TT
SUB A,T
ADD A,[BYTE (7)60,60,60,60]
MOVEM A,LSNCTR ;STORE NEW LSN
PPA06A: AOS OBF+.BFPTR ;& OUTPUT THE 5 DIGITS + BIT 35
MOVEM A,@OBF+.BFPTR
MOVEI A,.CHTAB ;FOLLOWED BY TAB
IDPB A,OBF+.BFPTR
MOVNI A,6 ;ADJUST BUFR CTR
ADDM A,OBF+.BFCNT
PPA03: PUSHJ P,CKEOL ;IS THIS CHAR AN EOL?
JRST PPA01 ;NO
TXO FF,F.SQIN
CAIE CH,.CHFFD ;[345] Form feed?
JRST PPA01 ;[345] No, just output
TLNE AA,FS.SUP ;[345] Suppressing LSN's?
JRST PPA01 ;[345] Yes
MOVEI A,.CHCRT ;[345] No, insert a CRLF
IDPB A,OBF+.BFPTR ;[345] before a page mark
MOVEI A,.CHLFD ;[345] So it will be recognized
IDPB A,OBF+.BFPTR ;[345]
SOS OBF+.BFCNT ;[345] Update the counter
SOS OBF+.BFCNT ;[345]
PUSHJ P,NULPAD ;[345] Go pad with nulls if necessary
JRST PPA14 ;[345] Mark the page
;Routine to pad buffer with nulls till next word boundary
;
NULPAD: LDB A,[POINT 6,OBF+.BFPTR,5] ;GET CURRENT BYTE POSITION
CAIG A,1 ;AT END OF WORD?
POPJ P, ;Yes, return
IBP OBF+.BFPTR ;NO, PAD OUT WORD WITH NULLS
SOS OBF+.BFCNT
JRST NULPAD ;TRY AGAIN
;OUTPUT EXISTING LSN WITH LEADING ZEROS
PPA04: MOVEI A,4 ;INIT 5 DIGIT CTR
MOVEM A,LSNCTR
MOVE A,[<"00000">B34] ;INIT LSN ACCUMULATOR
CAIL CH,"0" ;IS CURRENT CHAR A DIGIT?
CAILE CH,"9"
JRST PPA08 ;NO, FILL IN 5 SPACES
JRST PPA12
PPA10: SOSGE LSNCTR ;DONE 5 DIGITS YET?
JRST PPA09 ;YES
PPA12: LSH A,7 ;PUT DIGIT INTO ACCUMULATOR
DPB CH,[POINT 7,A,34]
CAML I,B
JRST PPA09
ILDB CH,OU ;GET THE NEXT FUCKING CHARACTER
ADDI I,1 ;INCREMENT TEXT PTR
CAIL CH,"0" ;IS IT A DIGIT?
CAILE CH,"9"
JRST PPA09 ;NO
JRST PPA10 ;YES, STORE IT
PPA08: MOVE A,[<" ">B34] ;GET 5 SPACES
PPA08X: CAIE CH," " ;SPACE?
JRST PPA08B ;NO, INSERT 5 SPACES
SOSGE LSNCTR ;HAVE WE SEEN 5 SPACES?
JRST PPA08C ;IF SO, CHECK FOR TAB OR CR
ILDB CH,OU ;GET NEXT CHARACTER
AOJA I,PPA08X ;TRY AGAIN
; HERE IF WE'VE SEEN 5 SPACES MAY BE TECO BLANK SEQUENCE NUMBER,
; SOS PAGE MARK, OR SPACES THE USER HAS INSERTED.
PPA08C: ILDB CH,OU ;GET THE CHAR
AOS I
CAIE CH,.CHCRT ;TEST FOR CR (FOR SOS) OR
CAIN CH,.CHTAB ;TAB TO BE OUTPUT WITH SPACES
JRST PPA09 ;OUTPUT 5 SPACES + CHAR IN CH
; HERE IF NOT 5 SPACES FOLLOWED BY TAB OR CR. THIS IMPLIES
; THAT ANY SPACES SEEN WERE USERS'S TEXT.
PPA08B: SUBI I,4 ;BACK UP TO FIRST CHARACTER
ADD I,LSNCTR ;AND OUTPUT IT WITH BLANK LSN
MOVE OU,I ;FIX BYTE POINTER
IDIVI OU,5
HLL OU,BTAB-1(OU+1)
ILDB CH,OU ;GET PROPER CHARACTER
MOVE AA,OUTSWT ;GET SWITCHES
TLNE AA,FS.SUP ;SUPPRESS SEQ#
JRST PPA01 ;YES
TRO A,1 ;NO SET BIT 35
JRST PPA06A ;OUTPUT SEQ# WITH A TAB
PPA09: MOVE AA,OUTSWT ;GET SWITCHES
TLNE AA,FS.SUP ;SUPPRESS SEQ#'S?
JRST PPA13 ;YES
TRO A,1 ;SET BIT 35
AOS OBF+.BFPTR ;& OUTPUT SEQ #
MOVEM A,@OBF+.BFPTR
MOVNI A,5
ADDM A,OBF+.BFCNT ;& ADJUST BUFR CTR
JRST PPA03 ;CONTINUE
PPA13: CAIE CH,.CHCRT ;ELEMINATE CR (FOR SOS)
CAIN CH,.CHTAB ;IS TERMINATOR A TAB?
AOSA OBF+.BFCNT ;YES, ADJUST BYTE COUNT
JRST PPA01 ;NO, OUTPUT IT
POPJ P, ;AND OMIT IT
;
; Here to insert an SOS type page mark.
;
PPA14: MOVE A,[BYTE (7) 40,40,40,40,40] ;[345] Five spaces
TRO A,1 ;[345] Set the bit
AOS OBF+.BFPTR ;[345] Increment pointer
MOVEM A,@OBF+.BFPTR ;[345] and output
MOVE A,[BYTE (7) .CHCRT,.CHFFD,0,0,0] ;[345] CR,FF
AOS OBF+.BFPTR ;[345] Increment
MOVEM A,@OBF+.BFPTR ;[345] and deposit
MOVNI A,^D9 ;[345] Adjust buffer counter
ADDM A,OBF+.BFCNT ;[345] (We already counted one at PPA:)
TRO FF,F.SQIN ;[345] Set the EOL flag
MOVE A,[<"00000">B34+1] ;[345] Reset the LSN's
MOVEM A,LSNCTR ;[345]
POPJ P, ;[345] Return
SUBTTL PW OUTPUT THE ENTIRE BUFFER, FOLLOWED BY A FORM FEED CHARACTER.
; TO THE SELECTED OUTPUT DEVICE. BUFFER IS UNCHANGED AND POINTER
; IS UNMOVED.
;P IS IDENTICAL TO PWY.
;NP IS IDENTICAL TO PP...P (P PERFORMED N TIMES).
;I,JP OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER. NO FORM
; FEED IS PUT AT THE END. BUFFER UNCHANGED;POINTER UNMOVED.
PUNCHA: MOVEI D,CPPA ;SELECT PPA FOR OUTPUT INDIRECTLY IN CASE I,JP.
TXNE FF,F.ARG2 ;I,JP?
JRST TYPE0 ;YES. GET STRING ARGUMENTS AND OUTPUT.
MOVE E,B ;NO. E:=N
MOVE B,CPTR
ILDB T,B ;T:=COMMAND CHARACTER FOLLOWING P.
TRZ T,40 ;FILTER L.C.
JUMPL E,CPOPJ ;IF N<0, IGNORE P.
CHKEO EO21,PUN1 ;OLD STYLE P ALWAYS GIVES FORM FEED
CAIE T,"W" ;PW ALWAYS GIVES FORM FEED
TXO FF,F.NSRH ;OTHERWISE, FORM GOES OUT ONLY IF FORM CAME IN
PUN1: PUSHJ P,PUNCHR ;PUNCH OUT BUFFER
SKIPE COMCNT ;IF NO COMMANDS LEFT
CAIE T,"W" ;OR COMMAND IS NOT W
JRST PUN3 ;READ NEXT PAGE
CAIG E,1 ;ARG DOWN TO 1 YET?
PUSHJ P,RCH ;YES, THROW AWAY THE W
PUN4: SKIPN XCTING
JRST GO
MOVE C,Z
CAMN C,BEG ;EMPTY BUFFER?
TXNN FF,F.EOFI ;NO. QUIT ON EOF
SOJG E,PUN1 ;YES. E:=E-1. DONE?
CPOPJ: POPJ P, ;YES
PUN2: MOVE OU,BEG ;IF NOTHING READ IN, CLEAR THE BUFFER
MOVEM OU,PT
TXZ FF,F.FORM ;AND THE FORM FEED FLAG
JRST YANK51 ;SET Z=BEG & POPJ
PUNCHR: MOVE C,BEG ;OUTPUT DATA BUFFER.
MOVE B,Z
MOVE D,OUTCH
CAME B,C ;IS PAGE BUFFER EMPTY?
JRST PUNCH1 ;NO
TXNE FF,F.FORM ;YES, IS THERE A FORM-FEED ON THIS BLANK PAGE?
JRST TYPE5 ;YES, OUTPUT IT
POPJ P,
PUNCH1: TXNN FF,F.OOPN ;CAN WRITE?
ERROR E.NFO
JRST TYPE1
PUN3: TXNE FF,F.IOPN ;ANY INPUT FILE?
TXNE FF,F.EOFI ;DONT TRY TO READ IF NO DATA LEFT
JRST PUN2
PUSHJ P,YANK1 ;RENEW BUFFER
JRST PUN4 ;CONTINUE
SUBTTL NJ, NC, & NL COMMANDS
;NJ MOVE THE POINTER TO THE RIGHT OF THE NTH CHARACTER IN THE
; BUFFER. (I.E., GIVE "." THE VALUE N.)
;J SAME AS 0J.
JMP: ADD B,BEG ;PT:=N+BEG
JRST JMP1
;NR SAME AS .-NJ.
REVERS: PUSHJ P,CHK2 ;MAKE SURE THERE IS AN ARGUMENT
MOVNS B ;B:=-C(B)
SKIPA
;NC SAME AS .+NJ. NOTE THAT N MAY BE NEGATIVE.
CHARAC: PUSHJ P,CHK2 ;MAKE SURE THERE IS AN ARGUMENT
ADD B,PT ;B:=PT+C(B)
;IF B LIES BETWEEN BEG AND Z, STORE IT IN PT.
JMP1: PUSHJ P,CHK ;IS C(B) WITHIN DATA BUFFER?
MOVEM B,PT ;YES. PT:=C(B)
JRST RET
;NL IF N>0: MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS
; PASSED OVER N LINE FEEDS.
; IF N<0: MOVE POINTER TO THE LEFT;STOP WHEN IT HAS PASSED
; OVER N+1 EOL'S AND THEN MOVE IT TO THE RIGHT OF
; THE LAST EOL PASSED OVER.
;L SAME AS 1L.
LINE: TXNE FF,F.ARG2 ;ERROR IF THERE ARE 2 ARGS
ERROR E.TAL
PUSHJ P,GETARG ;NO. C:=FIRST STRING ARGUMENT ADDRESS,
;B:=SECOND STRING ARGUMENT ADDRESS.
XOR B,C
XORM B,PT
JRST RET
SUBTTL ROUTINE TO RETURN CURRENT ARGUMENT IN B
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR IF THERE IS NO CURRENT ARGUMENT
;CALL PUSHJ P,CHK2
; RETURN WITH B:=CURRENT ARG.,+1 OR -1
CHK2: TXOE FF,F.ARG ;IS THERE AN ARGUMENT?
POPJ P, ;YES. IT'S ALREADY IN B.
CHK22: MOVEI B,1 ;B=1*SIGN OF LAST OP
TXZE FF,F.NEG ;WAS IT A MINUS SIGN?
MOVNS B ;YUP
POPJ P, ;RETURN
;NK PERFORM NL BUT DELETE EVERYTHING THE POINTER MOVES OVER.
;M,NK DELETE THE (M+1)TH THROUGH THE NTH CHARACTER FROM THE BUFFER.
; THE POINTER IS THEN PUT WHERE THE DELETION TOOK PLACE.
;K SAME AS 1K
KILL: PUSHJ P,GETARG ;C:=FIRST STRING ARG. ADDRESS
;B:=SECOND STRING ARG. ADDRESS
PUSHJ P,CHK1 ;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
MOVEM C,PT ;PT:=C(C)
SUB B,C ;B:=NO. OF CHARACTERS TO KILL.
JUMPE B,RET ;IF NONE, RETURN. OTHERWISE, FALL INTO DELETE
SUBTTL ND DELETE N CHARACTERS FROM THE BUFFER
; IF N IS POSITIVE, DELETE
; THEM JUST TO THE RIGHT OF THE POINTER;IF N IS NEGATIVE, DELETE
; THEM JUST TO ITS LEFT.
;D SAME AS 1D
DELETE: PUSHJ P,CHK2 ;MAKE SURE B CONTAINS AN ARGUMENT
DEL1: MOVM C,B
MOVNS C ;C:=-ABS(B)
ADD B,PT ;B:=PT+B
PUSHJ P,CHK ;STILL IN DATA BUFFER?
CAMGE B,PT ;YES. IS N NEGATIVE?
MOVEM B,PT ;YES. MOVE PT BACK FOR DELETION.
PUSHJ P,NROOM ;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
TXZE F2,S.DELS ;FROM A SEARCH AND DESTROY MISSION?
JRST FND2 ;YES, MAYBE COLON MODIFIER PRESENT
JRST RET
;ROUTINE TO CHECK DATA BUFFER POINTER
;CALL MOVE B,POINTER
; PUSHJ P,CHK
; RETURN IF B LIES BETWEEN BEG AND Z
CHK: MOVE TT,[MOVE B,SYL]
MOVEM TT,DLIM
CAMG B,Z
CAMGE B,BEG
..ERROR E.POP
POPJ P,
;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER
;BOUNDS AND CHECK ORDER RELATION.
;CALL MOVE C,FIRST STRING ARGUMENT ADDRESS
; MOVE B,SECOND STRING ARGUMENT ADDRESS
; PUSHJ P,CHK1
; RETURN
;IF C>B, DOES NOT RETURN.
;C:=MIN(MAX(C,BEG),Z)
;B:=MIN(MAX(B,BEG),Z)
CHK1: CAMLE C,B ;C>B?
ERROR E.SAL
CAMGE C,BEG ;C:=MAX(C(C),BEG)
MOVE C,BEG
CAMLE C,Z ;C:=MIN(C(C),Z)
MOVE C,Z
CAMGE B,BEG ;B:=MAX(C(B),BEG)
MOVE B,BEG
CAMLE B,Z ;B:=MIN(C(B),Z)
MOVE B,Z
POPJ P, ;RETURN
SUBTTL Searches -- Commands
;F Search
FCMD: PUSHJ P,SKRCH ;GET CHAR AFTER F
ERROR E.MEF
TXO FF,F.SRCH ;SET F-SEARCH FLAG
TRZ CH,40 ;UPPER OR lower CASE
CAIN CH,"S" ;FS?
JRST SERCH ;YES
CAIN CH,"N" ;FN?
JRST SERCHP ;YES
TXZ FF,F.SRCH ;MUST NOT BE ON
CAIE CH,"D" ;SEARCH AND DESTROY
ERROR E.IFC
TXO F2,S.DELS ;TO DELETE
JRST SERCH ;S SEARCH ONLY
;_ SEARCH
LARR: TXOA FF,F.LARW ;F.LARW:=1 FOR LEFT ARROW SEARCH
;N SEARCH
SERCHP: TXO FF,F.NSRH ;F.NSRH:=1 FOR N SEARCH
;S SEARCH
SERCH: MOVE E,PT ;OLD POINT
MOVEM E,SAVEAC ;SAVE IN CASE THE SEARCH FAILS
MOVEM E,UPPERB ;[342] PT is upper bound on backward searches
SETZ E, ;ASSUME FIRST OCCURRENCE IN CASE BOUNDED
TXZE FF,F.ARG2 ;TWO ARGS = BOUNDED SEARCH
JRST BOUNDS ;BOUNDED SEARCH
SETZM LOWERB ;SAVE AS DEFAULT LOWER BOUND
PUSHJ P,CHK2 ;GET 1ST ARG
SKIPE B ;ZERO?
JRST SERC33 ;NO
TXNE FF,F.ARG ;THERE MUST BE NO ARG
ERROR E.ISA
SERC33: SKIPGE E,B ;GET ARG WHERE IT WANTS IT
TXOA F2,S.MINS ;[342] MINUS SEARCH
SETZM UPPERB ;[342] No upperbound on forward searches
JRST SERCHA
SUBTTL Searches -- pattern source setup
;Here if bounded search, set up bounds
BOUNDS: PUSHJ P,GETAG6 ;GET THE STRING POINTERS
TXZ FF,F.NSRH!F.LARW!F.ARG ;FN + N GO TO FS AND S
CAMLE C,Z ;TOO BIG
MOVE C,Z
CAMGE C,BEG ;TOO SMALL
MOVE C,BEG
MOVEM C,PT ;PLACE TO START SEARCHIN'
CAML B,C ;MINUS IMPLIED?
JRST SAVESH ;NO, SAVE BOUNDS
EXCH C,B ;YES, EXCHANGE ARGS
TXO F2,S.MINS ;SAY MINUS SEARCH
SAVESH: MOVEM C,LOWERB
MOVEM B,UPPERB
;Adjust upper and lower bounds
SERCHA: MOVE A,BEG ;GOOD LOWER BOUND
MOVE B,Z ;GOOD UPPER BOUND
CAMLE A,LOWERB
MOVEM A,LOWERB
CAMGE B,LOWERB
MOVEM B,LOWERB
SKIPE UPPERB ;FIX ZERO UPPER BOUND
CAMGE B,UPPERB
MOVEM B,UPPERB
CAMLE A,UPPERB
MOVEM A,UPPERB
MOVMS E ;FOR CORRECT MINUS SERCH
MOVEI CH,.CHESC ;USE ALT-MODE DELIMITER IF NO @ SEEN
TXZN FF,F.SLSL ;@ SEEN?
JRST SERCHB ;NO, TERMINATOR = ALTMODE
PUSHJ P,SKRCH ;YES. CH:=USER SPECIFIED DELIMITER.
ERROR E.USR
;Determine whether we can use the previous pattern
SERCHB: MOVEM CH,B ;B:=Pattern source string delimiter
MOVEM CH,ARGTRM ;Save delimiter for FS insertion
SETZM SCNEST ;Search nest level is zero
PUSHJ P,SKRCH ;Look ahead 1 character
ERROR E.USR
CAIE CH,(B) ;Is it the delimiter?
JRST SERCHT ;No, an argument is given
SKIPL SRHCTR ;Yes, use previous pattern string
; unless there was none or last had error
ERROR E.SNA
SKIPN SCTLGA ; but not if remembered pattern source used ^Gi
JRST SCH.E ;OK, use previous matrices
;Move a new pattern source to storage
SERCHT: TXZ F2,S.XMAT ;[344] Clear exact match flag
STORE A,SMATRX,SMATRX+SCLRLN-1,0 ;Clear previous matrices
SETZM SRHCTR ;Clear source pattern length counter
SETZM SCTLGA ;Assume pattern source doesn't use ^Gi
MOVE AA,[POINT 7,SRHARG] ;Point to start of storage area
JRST SERCHD ;1st character already in
SERCHC: PUSHJ P,SKRCH ;Get next character of pattern source
ERROR E.USR
SERCHD: CHKEO EO21,SERCHE ;If EO=1, ^R is just text
CAIE CH,.CHCNR ;^R?
SERCHE: CAIN CH,.CHCNQ ;^Q?
JRST SERCHG ;Yes, next character is text
CAIN CH,(B) ;The delimiter?
JRST SERCH0 ;Yes
CAIN CH,.CHCNT ;^T?
JRST SERCHU ;Yes
TXNE F2,S.NCCT ;^T flag on?
JRST SERCHF ;Yes, ^V and ^W are just text
CAIE CH,.CHCNV ;^V?
CAIN CH,.CHCNW ;^W?
TXO F2,S.XMAT ;Yes, set exact match flag
SERCHF: AOS A,SRHCTR ;Bump string counter
CAILE A,^D80 ;Still fit in store?
ERROR E.STC
IDPB CH,AA ;Yes, store character
JRST SERCHC ; and go back for more
SERCHG: AOS A,SRHCTR ;Count the ^R (^Q)
CAILE A,^D80 ;Will it fit?
ERROR E.STC
IDPB CH,AA ;Yes, store it
PUSHJ P,SKRCH ;Get next character
ERROR E.USR
JRST SERCHF ; and store it as text
SERCHU: TXC F2,S.NCCT ;^T, complement control command switch
JRST SERCHF
SUBTTL Searches -- set up search matrix
SERCH0: TXZ F2,S.NCCT ;Refresh ^T flag
MOVE B,SRHCTR ;Set source pattern length counter
MOVE AA,[POINT 7,SRHARG] ; and pointer
MOVEI D,0 ;Start at beginning of pattern
;Set up a 131 by 36 bit table based on the pattern source.
;The table is implemented as a four word by 36 table, with the first
; 32 bits of the words used for the four portions of the ASCII character
; set (i.e. 0-37, 40-77, 100-137, 140-177) and three of the bits left over
; in the last word used for the "bogus" characters BEGPAG, ENDPAG, and
; SPCTAB. This is a little harder to set up for single letters in the
; pattern source, but is much easier for ranges and makes the fast search
; algorithm setup much faster. The table is then rotated into the old
; TECO 36 by 131 bit table for the actual search matrix.
SCH.1: ILDB CH,AA ;CH:=Next pattern source character
SOJL B,SCH.8 ;End of string?
MOVEI T,S2TABL ;Check for control character in string
TXNE F2,S.NCCT ;^T flag on?
MOVEI T,S3TABL ;Yes, use restricted table
PUSHJ P,DISP1 ;Go search table, don't return if found
CHKEO EO21,SCH.4 ;Not control, if EO=1, force exact mode
TXNN F2,S.NCCT ;If ^T flag on, all control characters are legal
PUSHJ P,CKNCC ;Off, all other control characters are illegal
; (Don't return if any)
SCH.2: TXNE F2,S.EMAT ;Forced either match on?
JRST SCH.3 ;Yes, match either
TXNN F2,S.XMAT ;No, want an exact match?
TXNE FF,F.PMAT ;No, want global exact match?
JRST SCH.4 ;Asked for exact match
SCH.3: CAIL CH,"a" ;Match either, is it lower case?
CAILE CH,"z"
JRST .+2 ;No
SUBI CH,"a"-"A" ;Yes, make it upper case
CAIL CH,"A" ;Is it upper case?
CAILE CH,"Z"
JRST SCH.5 ;No
MOVSI TT1,400000 ;Yes, convert character to bit of 131
MOVNI TT,-"@"(CH) ; want - (-100) for LSH
LSH TT1,0(TT) ;Position bit to letter range
IORM TT1,BITMAT+2(D) ;Set match on upper case
IORM TT1,BITMAT+3(D) ; and lower case characters
JRST SCH.6
SCH.4: PUSHJ P,CASE ;Exact mode, adjust pattern character case
SCH.5: MOVSI T,400000 ;Convert character to bit of 131
MOVE TT,CH ;Copy of character
IDIVI TT,^D32 ;Using 32 bits per word, figure word and bit
ADDI TT,0(D) ; Word plus current pattern position
MOVNS TT1 ;Negative of remainder for bit shift
LSH T,0(TT1) ;Position bit within 32 bit range for each word
IORM T,BITMAT(TT) ; and include it in appropriate word
SCH.6: SKIPE SCNEST ;Nested? (^N, ^E[], ^Gi)
POPJ P, ;Yes, return to caller
ADDI D,4 ;End of a pattern position, on to next
JUMPE B,SCH.8 ;Done if no more characters in pattern source
CAILE D,^D36*4 ; and error if more than 36 positions in pattern
ERROR E.STL
JRST SCH.1 ;More pattern source, get some
;Finished building the 131 by 36 bit search table
SCH.8: SKIPE SCNEST ;In a nest (^E[ with no ] or ^Gi)
POPJ P, ;Yes, let caller carry on
LSH D,-2 ;Really finished, convert index to pattern length
MOVEM D,PATLEN ; and save it
MOVNS SRHCTR ;Flag source pattern length as being legal
JRST ROTATE ;Skip 131 by 36 build subroutines to ROTATE
;Control character dispatch table for second scan of pattern source
S2TABL: XWD CNTLE,.CHCNE ;^E
XWD CNTLG,.CHBEL ;^G
XWD CNTLX,.CHCNX ;^X
XWD CNTLN,.CHCNN ;^N
XWD CNTLS,.CHCNS ;^S
XWD CNTLV,.CHCNV ;^V
XWD CNTLW,.CHCNW ;^W
XWD CNTLBS,.CHCBS ;^\
XWD CNTLCF,.CHCCF ;^^
;Shorter table used for ^T on mode starts here
S3TABL: XWD CNTLT,.CHCNT ;^T
XWD CNTLQ,.CHCNQ ;^Q
XWD CNTLR,.CHCNR ;^R
XWD CNTLLB,.CHESC ;ESCape
XWD 0,0 ;End of list
;Control S matches any separator character (i.e., any character not
; a letter, number, period, dollar, or percent)
CNTLS: MOVX T, ;All control characters but null (?)
IORM T,BITMAT(D) ; on
MOVX T, ;All non-symbol special characters
IORM T,BITMAT+1(D) ; on
MOVX T, ;Upper case range specials
IORM T,BITMAT+2(D) ; on
MOVX T, ;Lower case range specials + ends of page
IORM T,BITMAT+3(D) ; on
JRST SCH.6 ;To next character
;Control X matches any single character
CNTLX: MOVX T, ;All control characters except null (?)
IORM T,BITMAT(D) ; on
TLO T,400000 ;Plus space @ grave
IORM T,BITMAT+1(D) ; all specials and numbers
IORM T,BITMAT+2(D) ; all upper case
IORM T,BITMAT+3(D) ; all lower case
JRST SCH.6 ;To next character
;Control R is the same as Control Q (Provided EO > 1)
; except it doesn't cause rubout problems
CNTLR: CHKEO EO21,SCH.5 ;If EO=1, ^R is just text
;Control Q causes the next character to be taken as text, even if it is
; a control character or the delimiter
CNTLQ: ILDB CH,AA ;Get the next character
SOJA B,SCH.2 ; and process it as ordinary text
;Control V causes the next character to be made lower case
;Two Control V's set lower case mode until further notice
CNTLV: CHKEO EO21,SCH.5 ;If EO=1, ^V is just text
PUSHJ P,C.V ;Set ^V flags
JRST SCH.1 ; and on to next character
;Control W causes the next character to be taken without case conversion
;Two Control W's set standard case mode until further notice
CNTLW: CHKEO EO21,SCH.5 ;If EO=1, ^W is just text
PUSHJ P,C.W ;Set ^W flags
JRST SCH.1 ; and on to next character
;Control \ inverts case match mode, starting at accept either
CNTLBS: CHKEO EO21,SCH.5 ;If EO=1, ^\ is just text
TXC F2,S.EMAT ;Complement accept either flag
JRST SCH.1 ; and on to next character
;When searching for ALTmode under EO=1, both ESCape and ALTmode match
CNTLLB: CHKEO EO21,.+2 ;EO=1?
JRST SCH.5 ;No, accept ESCape only
MOVEI T,000040 ;Yes, mark ALTmode as an acceptable character
IORM T,BITMAT+3(D)
JRST SCH.5 ; and ESCape
;Control circumflex causes immediately following @[\]^_ to be converted to
; the appropriate character in the lower case range
CNTLCF: CHKEO EO21,SCH.5 ;If EO=1, ^^ is just text
JUMPE B,SCH.1 ;[344] If no next character, ignore
ILDB CH,AA ;Get the next character
PUSHJ P,CVTSPC ;Convert it to lower case if appropriate
SOJA B,SCH.2 ; and go process it
;Control T inverts the control character interpretation switch
; The initial setting is that all control character commands are active
; With the switch on, only ^Q, ^R, and ^T commands exist, but all other
; control characters are legal
CNTLT: CHKEO EO21,SCH.5 ;If EO=1, ^T is just text
TXC F2,S.NCCT ;Complement current setting
JRST SCH.1 ; and on to next character
;Control N - invert the sense of the following "character", i.e. accept
; anything but the specified character
CNTLN: MOVSI T,-4 ;Set AOBJN count for the 4 words of this position
HRR T,D ; of the pattern
PUSH P,BITMAT(T) ;Save the current status of the pattern (in case
; of ^E[A,^N^EW] for example)
SETZM BITMAT(T) ;Start over again
AOBJN T,.-2 ;Loop through this position
AOS SCNEST ;Go up a level in complexity
PUSHJ P,SCH.1 ;Build the table for the character
SOS SCNEST ;Now less complex
MOVEI T,4 ;Now go back through the 4 words
MOVEI TT,BITMAT+3(D) ;[341] starting at the high end 'cause of stack
CTLN.1: SETCM TT1,0(TT) ; complementing the resulting setting
TRZ TT1,17 ; (remembering only using 32 bits per word)
POP P,0(TT) ;Get back the original bits
IORM TT1,0(TT) ;Include the new bits wanted
SUBI TT,1 ;Back up to previous word (need a ASOBJN)
SOJG T,CTLN.1 ; and loop through all 4 words
JRST SCH.6 ;Done this "character" position
;Control Gi causes the text in Q register i to be substituted into
; the search string at this point
CNTLG: CHKEO EO21,SCH.5 ;If EO=1, ^G is just text
ILDB CH,AA ;Get name of Q register
SOJL B,CNTLGR ;If none there, error
PUSH PF,AA ;Save source pointer (using Q stack)
PUSH PF,B ; and count
AOS SCNEST ;Bump search nest level
PUSH P,CPTR ;Set up CPTR in case of error (PAIN!)
MOVEM AA,CPTR ; so that error will get the right Q name
PUSHJ P,QREGV2 ;Figure out which Q register
PUSHJ P,QTEXEI ;Set up to read from it
PUSHJ P,GTQCNT ;Set how long it is
POP P,CPTR ;Restore CPTR
MOVE TT,I ;Set up new byte pointer from bogus PT
IDIVI TT,5
HLLZ AA,BTAB-1(TT1) ;Get byte pointer value
HRR AA,TT ; and quotient is address
MOVE B,C ;Copy the string length from GTQCNT
CTLG.1: PUSHJ P,SCH.1 ;Go process the string as pattern source
JUMPLE B,CTLG.2 ;Done yet?
ADDI D,4 ;No, on to next character position
CAILE D,^D36*4 ;Full? (see SCH.6)
ERROR E.STL
JRST CTLG.1 ;No, get next
CTLG.2: POP PF,B ;Restore to scan after the ^Gi
POP PF,AA
SOS SCNEST ;Nesting is back down one
JRST SCH.6 ; and go do next character
CNTLGR: ERROR E.ICG
;Control E commands all go through here
CNTLE: CHKEO EO21,SCH.5 ;If EO=1, ^E is just text
ILDB CH,AA ;Get character after the ^E
SOJL B,CNTLER ;If none, an error
MOVEI T,S4TABL ;Set to search for ^E command characters
PUSHJ P,DISPAT ; and look for legal commands (no return if good)
CNTLER: ERROR E.ICE
;Dispatch table for ^E commands
S4TABL: XWD CNTLEA,"A" ;^EA accept any alpha
XWD CNTLEV,"V" ;^EV accept any lower case alpha
XWD CNTLEW,"W" ;^EW accept any upper case alpha
XWD CNTLED,"D" ;^ED accept any digit
XWD CNTLEL,"L" ;^EL accept any end of line character
XWD CNTLES,"S" ;^ES accept a string of spaces and/or TABs
XWD CNTLEN,74 ;^E accept the ACSII character represented by
XWD CNTLEB,133 ;^E[A,B,C] accept A or B or C or ...
XWD 0,0 ;End of list
;Control EA - accept any alphabetic character
CNTLEA: MOVX T, ;All letters
IORM T,BITMAT+2(D) ; upper case on
;Control EV - accept any lower case alphabetic character
CNTLEV: MOVX T, ;All letters
IORM T,BITMAT+3(D) ; lower case on
JRST SCH.6 ; and on to next character
;Control EW - accept any upper case alphabetic character
CNTLEW: MOVX T, ;All letters
IORM T,BITMAT+2(D) ; upper case on
JRST SCH.6 ; and on to next character
;Control ED - accept any digit
CNTLED: MOVX T, ;All digits
IORM T,BITMAT+1(D) ; on
JRST SCH.6 ; and on to next character
;Control EL - accept any end of line character (including buffer end)
CNTLEL: MOVX T, ;LF, VT, and FF
IORM T,BITMAT(D) ; on
MOVX T, ; end of page
IORM T,BITMAT+3(D) ; on
JRST SCH.6 ; and on to next character
;Control ES - accept any string of spaces and/or TABs
CNTLES: MOVX T, ;A TAB
IORM T,BITMAT(D) ; on
MOVX T, ;A space
IORM T,BITMAT+1(D) ; on
MOVX T, ;The special space/tab bit
IORM T,BITMAT+3(D) ; on
JRST SCH.6 ; and on to next character
;Control E[a,b,c,...] - accept any of "characters" a or b or c
CNTLEB: AOS SCNEST ;Up one nest level (down?)
CTEB.1: PUSHJ P,SCH.1 ;Process the next "character"
ILDB CH,AA ;Get the next pattern source (if already off end
; of string, will catch that anyway at .+1)
SOJL B,CNTLER ;Error if off end of string
CAIN CH,"," ;Another "character" to come?
JRST CTEB.1 ;Yes, go include it too
CAIE CH,"]" ;No, correct ending to ^E command?
ERROR E.ICE
SOS SCNEST ;Yes, one fewer level of nesting now
JRST SCH.6 ; and have finished a "character" position
;Control E - accept the ASCII character whose octal representation is nnn
CNTLEN: MOVEI A,0 ;Clear number accumulator
CTEN.1: ILDB CH,AA ;Get an oit
SOJL B,CNTLER ;Error if run out
CAIN CH,">" ;The other end of the number?
JRST CTEN.2 ;Yes, done
CAIL CH,"0" ;Is it an oit?
CAILE CH,"7"
ERROR E.ICE
LSH A,3 ;Yes, scale up the previous value
ADDI A,-60(CH) ; and add in the new oit
JRST CTEN.1 ; then go try for more
CTEN.2: CAILE A,177 ;Make sure it's legitimate
ERROR E.ICE
MOVE CH,A ;Copy the result as the character
JRST SCH.5 ; and go set the appropriate bit
;Now we need to build up TECO's standard search table, a 36 bit by 131. word
; table with each pattern position being a slice of the 131 words, with all of
; the acceptable characters for each position marked by a bit on in the word
; reached by using the character directly as an index into the table (the extra
; 3 words are for "beginning of page", "end of page", and "this position matches
; strings of spaces and/or TABs"). At the same time we will set up the two
; simple tables for the fast search algorithm (DELTA0 and DELTA1), since it is
; much quicker to do this now if we use the fast one.
;Since DELTA0 and DELTA1 are the same at all points except for entries which
; are not needed in DELTA1, we will build them as one.
;The conversion is done by rotating the 131. bit by 36 word table 90 degrees.
;Since that table was built first (instead of the normal TECO table as in
; standard TECO), the loop is only needed for as many times as there were
; pattern characters (doing it in the other order requires a loop through all
; 131 characters with no possibility for less).
;AC usage: (Other than poor, I want P1-P4)
;D AOBJN pointer with "virtual" index into 131 by 36 table (word index/4)
;I actual word index into 131 by 36 table
;A bit mask specifying pattern position we're currently doing
;AA AOBJN pointer into the 131 bits of an entry of the 131 by 36 table
;TT+TT1 current words worth of the 131 bits and the JFFO result
SLARGE==10777777 ;A special large number for DELTA0 used for
; the characters defining the rightmost pattern
; position
ROTATE: MOVN D,PATLEN ;Get the number of pattern positions used
HRLZS D ; as an AOBJN pointer
MOVEI I,0 ;Clear the actual index
MOVE A,PATLEN ;Initialize DELTA0 and DELTA1 to the number
MOVEM A,DELTA0 ; of positions in the pattern
MOVE AA,[XWD DELTA0,DELTA0+1]
BLT AA,DELTA0+SPCTAB
SUBI A,1 ;Pattern length - 1 is the distance we are from
MOVEM A,ROTLEN ; the end of the pattern at the moment
MOVSI A,400000 ;Start mask at first pattern position
ROTA.1: MOVSI AA,-BITMLN ;Set AOBJN pointer into the 131 bits
ROTA.2: SKIPE TT,BITMAT(I) ;Get 32 of those, seeing if any are on
ROTA.3: JFFO TT,[ ; and if any are, see which the first one is
MOVSI CH,400000 ;Got one, make a mask to turn it off
MOVN T,TT1
LSH CH,0(T)
ANDCM TT,CH ; and do so
ADDI TT1,0(AA) ;Add 0, 32, 64, or 96 to the bit number
IORM A,SMATRX(TT1) ; and turn on the position bit for the character
SKIPN CH,ROTLEN ;Get the current distance from the right end of the pattern
MOVX CH,SLARGE ;At the right, change to the special number
MOVEM CH,DELTA0(TT1) ;Set that in fast loop table
JRST ROTA.3 ;On to next bit
]
ADDI I,1 ;Finished a word of the 131 bit string
ADDI AA,^D31 ;Next word is 32 farther into the 36 by 131 table
AOBJN AA,ROTA.2 ;Loop until all 131 bits done
LSH A,-1 ;On to the next pattern mask position
SOS ROTLEN ; and distance from the end
AOBJN D,ROTA.1 ; and loop through all used pattern position
;Now determine which search method we will use. If ^ES appeared we have to use
; the old slow method. Initially if we need to match BEGPAG or ENDPAG, we will
; use the old method. Also we will arbitrarily select 3 as the shortest string
; which will benefit from using the new search. As an aid, turn off the BEGPAG
; and ENDPAG bits which don't appear at the appropriate end of the pattern,
; since they obviously won't match except there.
FIGSCH: SETZB A,SCHTYP ;Assume an old style search
MOVN D,PATLEN ;Generate a bit mask for the last pattern
MOVSI AA,400000 ; position used in this search
ANDM AA,SMATRX+BEGPAG; (with a side effect of clearing extra begin page bits)
LSH AA,1(D)
MOVE D,PATLEN ;Now see how long the pattern is
CAILE D,2 ;If it is fewer than 3 positions long,
SKIPE SMATRX+SPCTAB ; or if there were any ^ES positions,
JRST SCH.E ; just go use the old search
ANDM AA,SMATRX+ENDPAG;We know pattern is longer than 1, so clear extra end page bits
SKIPN SMATRX+BEGPAG ;If either end of buffer will match,
SKIPE SMATRX+ENDPAG ; ...
JRST SCH.E ; go use old search
SETOM SCHTYP ;We win with the new one, remember that in case
; this was an nSFOO$ type
;We are going to use the new search, set up the more costly DELTA2 table.
;This table is based on the arrangement of characters in the pattern.
;It uses the existence (or non-existance) of matching substrings in the
; pattern to be able to shift the pattern farther than would be indicated by
; DELTA1, e.g. if the pattern is ACACACACACAABC and the part of the searched
; string being examined is CABC, DELTA1 will only shift the pattern right 3
; positions, while "looking" at the pattern will tell a human observer that
; the pattern can be shifted its whole length without missing any possible
; matches.
;A few bits in B for use during the DELTA2 setup
NEDSET==1B35 ;This position of DELTA2 still needs setting up
WNTOFF==1B34 ;We shifted off the end of the pattern this pass
FSTIME==1B33 ;This is the first pass - use a special value instead of
; having to initialize the index matrix (INDMAT)
;AC usage (see comment at ROTATE)
;A the highest entry currently being used in INDMAT
;AA a number used to indicate how far the pattern can be shifted when we
; find a mismatch between sub-pattern strings
;B used for the above flag bits
;C index into INDMAT for updates to it as matches occur in sub-patterns
;CH index into INDMAT for loop
;I index into pattern (*4 since 4 words per pattern position)
;J temporary index into pattern (also *4)
;We want to look for sub-strings in the pattern matching rightmost sub-strings
; of the pattern. If none are found, then as in the above example when more than
; one pattern position has been matched we know we can shift farther than to
; the next occurance of single pattern characters. If some matches are found
; then we can try them next immediately.
;The examination is implemented by using an array of pointers (indices into
; the pattern) (INDMAT), stored in decreasing order and overwritten each pass
; by the pointers for the next pass. When I points to the beginning of the
; rightmost n characters of the pattern, then each pointer in INDMAT points
; to the beginning of a sub-string which matches those n characters. When
; INDMAT has been emptied, all of these sub-strings have been matched and the
; rest of DELTA2 can be set to shift the pattern its entire length. The
; initial setting of INDMAT (implemented by FSTIME) is such that every pattern
; position is examined on the first pass.
MOVEI A,-1(D) ;Start the top of INDMAT at pattern length - 1
MOVEI AA,-1(D) ;Start the non-match shift at pattern length
; (adjusted because a 0-index is subtracted from it)
MOVX B,NEDSET!FSTIME ;The first setting is needs setting, first pass,
; and haven't gone off the end
MOVEI I,-1(D) ;Start at right end of pattern (0-indexed)
LSH I,2 ; adjusted for being 4 word bit strings
MOVEI D,0(I) ;Set initial INDMAT value to shift all less 1
; remembering the first SUBI 4
SET2.2: MOVEI C,0 ;Start used INDMAT entry index off at none
MOVN CH,A ;Make an AOBJN pointer for loop through INDMAT
HRLZS CH
SET2.3: TXNN B,FSTIME ;Get the appropriate INDMAT entry
SKIPA D,INDMAT(CH) ;Not the first time, use the real array
SUBI D,4 ;The first pass, use our fake value
MOVE TT,BITMAT(I) ;Figure out if any of the characters matched
AND TT,BITMAT(D) ; by the position we are looking at at highest
MOVE TT1,BITMAT+1(I) ; level (I) also match at the position indicated
AND TT1,BITMAT+1(D) ; by the substring table (INDMAT - D)
OR TT,TT1
MOVE TT1,BITMAT+2(I) ;(AND the strings together, if result is zero
AND TT1,BITMAT+2(D) ; then no characters match)
OR TT,TT1
MOVE TT1,BITMAT+3(I)
AND TT1,BITMAT+3(D)
OR TT,TT1
JUMPE TT,SET2.5 ;If zero, no matches here
JUMPE D,SET2.4 ;Did we just match with the leftmost position?
MOVEI T,-4(D) ;No, update the index matrix to check the position
MOVEM T,INDMAT(C) ; in front of this for finding substrings
AOSA C ;Remember we used another element of INDMAT
SET2.4: TXO B,WNTOFF ;We matched at the left end, that goes off the end
SET2.5: TXNN B,NEDSET ;Do we still need to set up this position?
JRST SET2.6 ;No, skip all the logical stuff
MOVE TT,BITMAT(D) ;Yes, then we need to figure out if the substring
ANDCM TT,BITMAT(I) ; indicated position (D) character set is a
MOVE TT1,BITMAT+1(D) ; subset of the high level (I) character set
ANDCM TT1,BITMAT+1(I) ; (Done by D .AND. .NOT. I .NE. 0)
OR TT,TT1
MOVE TT1,BITMAT+2(D)
ANDCM TT1,BITMAT+2(I)
OR TT,TT1
MOVE TT1,BITMAT+3(D)
ANDCM TT1,BITMAT+3(I)
OR TT,TT1
JUMPE TT,SET2.6 ;Skip out if it's not
TXZ B,NEDSET ;It is, don't do this again
MOVNI T,4(D) ;We now know that we can shift at least as much
ASH T,-2 ; as the distance from here to the right end
ADD T,PATLEN ; since no substrings matched from here to there
MOVE TT1,I ;Figure out where to put it with
LSH TT1,-2 ; a word table
MOVEM T,DELTA2(TT1) ;Put it there
SET2.6: AOBJN CH,SET2.3 ;Loop through current index matrix
TXZ B,FSTIME ;Finished the first pass
MOVE A,C ;Remember the highest index matrix element used
TXOE B,NEDSET ;Do we still need to set this position?
JRST [ ;Yes, then we can shift it based on how
MOVE T,AA ; far the highest level loop is from
MOVE TT,I ; the right end of the pattern
LSH TT,-2
SUB T,TT
ADD T,PATLEN
MOVEM T,DELTA2(TT)
JRST .+1
]
TXZE B,WNTOFF ;Did this pass go off the end of the pattern
JRST [ ;Yes, need to adjust the amount we
MOVEI AA,-4(I) ; can shift when NEDSET is used
LSH AA,-2 ; immediately above
JRST .+1
]
SUBI I,4 ;Now look a position to the left of last loop
SKIPE A ; unless there is no need to cause no matches
JUMPGE I,SET2.2 ; or because we looked at all of them
JUMPL I,SET2.E ;Did we look at all of them?
ADD AA,PATLEN ;No, need to fill in the rest with the largest
LSH I,-2 ; possible number based on how far we are from
SUB AA,I ; the right end of the pattern and how far the
; setup got
MOVEM AA,DELTA2(I)
ADDI AA,1 ;Each position to the left can shift one farther
SOJGE I,.-2
SET2.E:
;Now, if F search, scan insert argument
SCH.E: TXNN FF,F.SRCH ;F? search?
JRST WCHSCH ;No, go start search
TXZ F2,S.NCCT ;Refresh ^T flag
MOVE CH,ARGTRM ;Get delimiter back
TXZ FF,F.NNUL ;Reset non-null string flag
JRST INSERA ;Go scan insert argument
SERCHJ: POP P,COMBAK ;Save pointers for the insertion (COMCNT)
POP P,CPTBAK ; (CPTR)
; and fall into search
;Here to call the appropriate search
WCHSCH: TXNN F2,S.MINS ;If this time is minus search, force old search
SKIPN SCHTYP ;Which one are we using?
JRST SLOSCH ;The old one
; JRST FSTSCH ;The new one, fall into it
SUBTTL Searches -- New fast search routine
;This is an implementation of the algorithm of Boyer and Moore, published
; in the Communications of the ACM, October 1977, Vol. 20 Number 10, page 762.
; This article serves as the primary documentation for this routine (and the
; DELTA? table setup routines).
;This is the actual search, which uses the numbers in DELTA0, DELTA1, and
; DELTA2 for determining where in the searched string to look. The actual
; character comparisons are done in the tried and true TECO way, with TECO's
; original bit map (there can't be a better way).
;AC usage (ditto)
;A During the slow loop, counts down through the pattern
;AA Contains the bit mask for the last pattern position
;B The base register into the byte pointer table, including (C)
;C A negative index into the byte pointer table
;D The length of the string to be searched
;T During the slow loop, shifts the bit mask through the pattern
;TT The word address of the first byte of the portion of the searched
; string currently being examined
;TT1 The value of C at the start of the current FAST and SLOW loop execution
;The bytes in the searched string are obtained through a window by a table of
; constant byte pointers indexed into by B, C, and TT.
FSTSCH: MOVN T,PATLEN ;Generate the bit mask for the rightmost
MOVSI AA,400000 ; pattern position
LSH AA,1(T)
MOVE I,PT ;Start searching at .
MOVE D,UPPERB ;Figure out how many characters are to be searched
SUB D,I ; i.e. the length of the searched string
ADDI D,1 ;*Note that all this code must use full word
; arithmetic when referring to I, since its
; maximum value is 128K * 5 characters*
TXNE FF,F.ARG ;Is this an nSFOO$$?
JUMPLE E,FND ;Yes, done if we've found that many
MOVX B,<0(C)> ;Start the byte pointer base at 0(C)
FSTS.1: MOVE TT,I ;Convert I into a word and byte address
IDIVI TT,5
MOVE T,D ;Figure the current byte pointer window length
CAILE T,SCHBPL ; the length of string left
MOVEI T,SCHBPL ; or the window size, whichever is less
;Fall through to next page...
MOVN C,T ;Copy that as negative index into table
ADD T,TT1 ;Add the byte in word offset
ADDI T,SCHBPT-1 ; plus the address of the start of the table
HRR B,T ; equals the base address to be negatively
; indexed from
ADD C,PATLEN ;This search starts at the right end of the pattern
JUMPG C,NOFND3 ;If that is to the right of the last character
; of the string, then we didn't find it
MOVE TT1,C ;Save C at the start of the loop, so we can
; tell how many characters we've skipped
;FAST: ;The fast loop in the ACM article
FSTS.3: LDB CH,@B ;Get a character from the searched string
ADD C,DELTA0(CH) ;Shift down based on its existance in the pattern
JUMPLE C,FSTS.3 ; and loop unless it is in the rightmost position
; i.e. if we just had a match (see LARGE)
TLON C,-1 ;Did it match (SLARGE makes the left half 7)
JRST FSTS.5 ;No, we used up our window (left half is zero)
MOVE T,AA ;Start at right end of pattern bit mask
MOVE A,PATLEN ; for that many characters
;SLOW: ;SLOW loop in ACM article
FSTS.4: SOJLE A,FSTS.6 ;If we run out of pattern characters, it matched
LSH T,1 ;Set bit mask to previous pattern position
LDB CH,@B ;Get the next searched string character
TDNE T,SMATRX(CH) ;Does it match?
SOJA C,FSTS.4 ;Yes, back up byte pointer index one and loop
MOVE T,DELTA0(CH) ;No, figure which table shift us the most
TLNN T,-1 ;If we just got SLARGE, use DELTA2 always
CAMGE T,DELTA2-1(A)
MOVE T,DELTA2-1(A)
ADD C,T ;Update our current position by that much
JUMPL C,FSTS.3 ; and go back to FAST unless we exceeded window
;Search failed in this window, see what to do
FSTS.5: JUMPLE D,NOFND3 ;Not found if there is no searched string left
SUB C,TT1 ;See how many characters we skipped
ADDI I,0(C) ;Update current position by that much
SUBI D,0(C) ; and amount left by that much
JRST FSTS.1 ; and try again
;Here when string found, decide where the right end of the pattern is
FSTS.6: SUB C,TT1 ;How much we moved
ADD I,C ;Adjust pointer by that much
ADD I,PATLEN ; but we scanned back by that much too
MOVEM I,PT ;Update . to that point
ADD I,PATLEN ;Now get to right end of pattern
JRST FND ;We did it
;Build the fixed byte pointer table. The following code is done again
; under an XLIST
SCHBPL==^D200 ;Length of window of byte pointers
$A==0 ;Start the base address at zero
;SCHBPT:REPEAT SCHBPL/5+1,< ;Build 5 for each word of bytes, plus extra for
; ; the fact that the first byte may be one of 5
; $M==177B6 ;A mask for the current character of the word
; REPEAT 5,< ;For each word of bytes
; POINTR $A(TT),$M ;Build 5 pointers
; $M==$M_-7 ;Moving mask each time
; >
; $A==$A+1 ;To next word
; >
XLIST
SCHBPT:
IF1,<
BLOCK SCHBPL+5
>
IF2,<
REPEAT SCHBPL/5+1,<
$M==177B6
REPEAT 5,<
POINTR $A(TT),$M
$M==$M_-7
>
$A==$A+1
>
>
LIST
SUBTTL Searches -- Old slow but sure routine
SLOSCH:
SERCH1: MOVN T,PATLEN ;Figure old end of search comparator
MOVSI AA,400000
LSH AA,0(T) ;Which is bit one past end of pattern
MOVE I,PT ;START SEARCHING AT PT
S1: TXNE FF,F.ARG ;IS THERE AN ARGUMENT?
JUMPLE E,FND ;YES. SEEN STRING N TIMES?
MOVE TT,I ;NO, FORM BYTE PTR WHICH WILL BE
SUBI TT,1 ;INCREMENTED BEFORE USE
IDIVI TT,5
HLL TT,BTAB(TT1)
CAMG I,BEG ;AT BEG OF BUFR?
SKIPL SMATRX+BEGPAG ;& 1ST SERCH CHAR = BEG OF BUFR CHAR?
JRST S3 ;NO
MOVSI D,200000 ;YES, START SEARCH AT 2ND SEARCH CHAR
MOVE TT1,TT ;SET DYNAMIC PTR = STATIC PTR
SETOM BCOUNT ;FLAG 1ST IS BEGPAG
JRST S4B ;ENTER SEARCH LOOP
S3: MOVSI D,400000 ;START SEEKING MATCH FOR 1ST CHAR
MOVE TT1,TT ;SET DYNAMIC PTR=STATIC PTR
JRST S4A
S4: TDNE D,SMATRX+SPCTAB ;IS SPACE/TAB STRING BIT SET?
JRST SPTB ;YES
S4E: CAML I,UPPERB ;DON'T ALLOW I OUTSIDE BOUNDS
JRST S4D ;...
ADDI I,1 ;LOOK AT NEXT LOC, XCEPT 1ST TIME THRU
S4C: LSH D,-1 ;ADVANCE TO NEXT CHAR POSITION
S4B: CAMN D,AA ;END OF SEARCH TABLE?
JRST FND ;YES.
S4A: ILDB CH,TT1 ;NO, GET NEXT CHAR
TDNE D,SMATRX(CH) ;IS IT A MATCH?
JRST S4 ;YES, GO TO NEXT TABLE ENTRY.
S4D: AOSN BCOUNT ;IF WE FAILED WITH BEGPAG
JRST S3 ;THEN TRY AGAIN WITH 1ST CHAR
TXNE F2,S.MINS ;BACKWARDS SEARCH
JRST SR4A
CAML I,UPPERB ;TOO FAR?
JRST NOFND
AOS I,PT
IBP TT ;MOVE STATIC BYTE PTR
JRST S3 ;KEEP LOOKING
SR4A: SOS I,PT ;DECREMENT PT
CAMGE I,LOWERB ;DONE
JRST NOFND
ADD TT,[7B5] ;PREVIOUS BYTE (MAYBE)
JUMPGE TT,S3 ;DEFINITELY
HRLI TT,(POINT 7,,34);FIX
SOJA TT,S3 ;DECREMENT AND GO
;Skip over a string of spaces and/or TABs while searching
SPTB: CAIE CH," " ;But was the character we matched a space
CAIN CH,.CHTAB ; or a TAB?
JRST SPTB.1 ;Yes, then accept more
JRST S4E ;No, look at next pattern position
SPTB.1: ADDI I,1 ;Advance to next buffer location
CAML I,UPPERB ;End of buffer?
JRST S4C ;Yes, no more then
MOVEM TT1,ERR1 ;Save current byte pointer (using ERR1 as temp)
ILDB CH,TT1 ;Look at next character
CAIE CH," " ;Is it a space?
CAIN CH,.CHTAB ; or a TAB?
JRST SPTB.1 ;Yes, keep on trucking
MOVE TT1,ERR1 ;No, end of string, restore pointer to last space/tab
JRST S4C ; and continue search
SUBTTL Searches -- pattern found
FND: SETOM SFINDF ;NO. SFINDF:=-1
MOVE A,I
SUB A,PT ;COMPUTE LENGTH OF SEARCH ARG
MOVE B,I ;SAVE CURRENT POINTER
TXNN F2,S.MINS
JRST NOTMIN
;[342] Test removed since upper-bound was set to PT at the start.
;[342] CAMLE I,SAVEAC ;LEGAL FIND?
;[342] SOSA I,PT
SOSA I,PT
JRST WCHSCH ;No, continue search
NOTMIN: MOVEM I,PT ;ELSE GO FORWARD
SOJG E,WCHSCH ;Try again if haven't found it n times
MOVEM B,PT
TXNE F2,S.DELS ;SEARCH AND DESTROY
JRST [MOVE B,SAVEAC ;GET OLD PT
SUB B,PT ;MINUS POINT AFTER SEARCH
JRST DEL1] ;DELETE !(B)!
TXNN FF,F.SRCH ;F-SEARCH?
JRST FND3 ;NO
MOVE C,VVAL ;YES, GET INSERT SIZE
SUB C,A ;[321]INSERT MINUS DELETE
MOVNS A ;SET PT TO BEGINNING OF STRING FOUND
ADDM A,PT
PUSHJ P,NROOM ;STRETCH OR SCRUNCH THE HOLE
MOVE B,ARGTRM ;GET TERMINATOR TO LOOK FOR
MOVE A,COMBAK ;RESET COMCNT & CPTR TO BEGINNING
MOVEM A,COMCNT ;OF INSERT ARGUMENT
MOVE A,CPTBAK
MOVEM A,CPTR
PUSHJ P,INS1B ;INSERT THE 2ND ARG
PUSHJ P,ZEROTT ;DO AUTO-TYPE IF REQUIRED
MOVE CH,ARGTRM
TXZN FF,F.NNUL ;WAS THERE A NON-NULL INSERT?
CAIE CH,.CHESC ;ALTMODE TERMINATOR?
JRST FND2 ;NO
TXO F2,S.NRAD ;FLAG SO 2ND ALTMODE STAYS AROUND
JRST ALTM1 ;YES, FS$$ TERMINATES EXECUTION
FND3:
IFN VC, ;SAVE LENGTH OF STRING
PUSHJ P,ZEROTT ;AUTOTYPE
FND2: TXZE FF,F.COLN ;COLON MODIFIER?
JRST FFOK ;YES, RETURN VALUE
CHKEO EODEC,FND4 ;[344] IF old TECO, must check for < ... >
JRST RET ;[344] Don't return a value
FND4: SKIPL (P) ;IN AN ITERATION?
JRST RET ;NO, RETURN NO VALUE
FFOK: MOVNI A,1 ;YES. RETURN VALUE OF -1
JRST VALRET
SUBTTL Searches -- Autotype after succesful searches
;IF AUTOF IS NON-ZERO
;INCLUDE POINTER MARKER = ASCII CHAR IN AUTOF IF AUTOF > 0
ZEROTT: TXNE FF,F.COLN ;NO AUTOTYPE ON COLON SEARCHES
POPJ P,
SKIPL -1(P) ;IN AN ITERATION?
SKIPN AUTOF ;AUTOTYPE WANTED?
POPJ P,
TXO FF,F.ARG ;DO 0T
SETZ B,
PUSHJ P,TYPE
HRRZ CH,AUTOF
SKIPL AUTOF ;PTR MARKER WANTED?
PUSHJ P,TYOM ;YES
MOVEI B,1 ;DO 1T
PUSHJ P,TYPE
TXZ FF,F.ARG
POPJ P,
SUBTTL Searches -- Pattern not found in this buffer
NOFND: TDNN D,SMATRX+ENDPAG ;[344] ENDPAG GOOD FOR A MATCH HERE?
JRST NOFND3 ;NO
CAMN I,Z ;[344] Yes, but only if we're at Z
JRST FND ;ENDPAG MATCHES!
NOFND3: MOVE I,BEG ;SEARCH FAILED
MOVEM I,PT ;PT=BEG
SETZM SFINDF ;SFINDF=0
TXNN F2,S.MINS ;See if this needs to look at a new buffer
TXNN FF,F.NSRH!F.LARW; Minus searches never do, but N and _ do
JRST RESTPT ;No new buffer, the search lost
MOVEM E,SRHCNT ;YES. SAVE SEARCH COUNT
MOVEI B,1 ;PUNCH 1 PAGE ONLY
TXNE FF,F.NSRH ;N SEARCH?
PUSHJ P,PUNCHA ;YES. PUNCH THIS BUFFER AND REFILL IT.
TXNN FF,F.IOPN ;ANY INPUT FILE?
JRST BEGIN1 ;NO
TXNE FF,F.EOFI ;MORE DATA?
TXNE FF,F.FORM
JRST NOFND4 ;YES
MOVE E,BEG ;EOF & NO FORM SEEN
CAMN E,Z ;CHECK BUFFER CONTENTS
JRST BEGIN1 ;NO MORE DATA
NOFND4: TXNE FF,F.LARW ;LEFT ARROW SEARCH?
PUSHJ P,YANK1 ;YES. FILL BUFFER.
MOVE E,SRHCNT ;RESTORE SEARCH COUNT.
MOVE A,BEG
MOVEM A,LOWERB
MOVE A,Z
MOVEM A,UPPERB
JRST WCHSCH ;Go do search with this buffer full
RESTPT: CHKEO EODEC,BEGIN1 ;[335] Leave pointer at top for EO of 2 or less
MOVE A,SAVEAC ;GET OLD PT
MOVEM A,PT ;RESTORE IT
BEGIN1: TXZ FF,F.NSRH+F.LARW ;[344] Clear N and _ flags.
TXNN FF,F.SRCH ;F-SEARCH?
JRST NOFND5 ;[344] No
MOVE CH,ARGTRM ;GET INSERT TERMINATOR
TXZN FF,F.NNUL ;WAS IT A NULL INSERT?
CAIE CH,.CHESC ;YES, WAS IT AN ALTMODE TERMINATOR?
JRST NOFND5 ;[344] No
TXO F2,S.NRAD ;[344] Flag so second altmode gets put in *i
NOFND5: TXZE FF,F.COLN ;[344] Colon modified?
JRST NOFND6 ;[344] Yes, return a 0
NOFND2: SKIPL (P) ;[344] IN AN ITERATION?
ERROR E.SRH ;[344] No, give error message
CHKEO EODEC,NOFND6 ;[344] If old TECO, return 0
TXNN F2,S.NRAD ;[344] Null insert?
JRST RET ;[344] No, new TECO returns nothing
JRST ALTM1 ;[344] Yes, end the command
NOFND6: TXNE F2,S.NRAD ;[344] Was it a null insert?
JRST ALTM1 ;[344] Yes, that terminates execution
JRST BEGIN ;[344] No, return a 0
SRHMOD: EXP SRCHSW ;DEFAULT SEARCH MODE
SUBTTL <> ITERATION BRACKETS. COMMAND INTERPRETATION IS SENT
; BACK TO THE < WHEN THE > IS ENCOUNTERED.
LSSTH: PUSH P,ITERCT ;SAVE ITERATION COUNT
PUSH P,COMAX ;KEEP MAX FOR GARBAGE COLLECTION
PUSH P,CPTR ;SAVE COMMAND STATE
PUSH P,COMCNT
SETOM ITERCT ;ITERCT:=-1
PUSH P,ITERCT ;-1 FLAGS ITERATION ON PDL
TXZN FF,F.ARG ;IS THERE AN ARGUMENT?
JRST RET ;NO
JUMPLE B,INCMA1 ;IF ARG NOT > 0, SKIP OVER <>
MOVEM B,ITERCT ;YES. ITERCT:=ARGUMENT
JRST RET
GRTH: SKIPN XCTING ;CONTINUE?
JRST GO
SKIPGE A,(P) ;IS THERE A LEFT ANGLE BRACKET?
JRST GRTH2 ;YES. OTHERWISE ITS A MISSING < OR
SOJE A,GRTH9 ;SOMETHING LIKE <...(...>
ERROR E.MLA
GRTH2: SOSN ITERCT ;ITERCT:=ITERCT-1. DONE?
JRST INCMA2 ;YES
MOVE A,-2(P) ;NO. RESTORE COMMAND STATE TO START OF ITERATION.
MOVEM A,CPTR
MOVE A,-1(P)
MOVEM A,COMCNT
TXNE FF,F.TRAC ;TRACING?
PUSHJ P,CRR ;YES. OUTPUT CRLF
JRST RET
GRTH9: ERROR E.MRP
;; IF NOT IN AN ITERATION, GIVES ERROR. IF IN AN ITERATION AND
; IF THE MOST RECENT SEARCH FAILED, SEND COMMAND TO FIRST UNMATCHED
; > TO THE RIGHT. OTHERWISE, NO EFFECT.
SEMICL: SKIPL (P) ;ERROR IF NOT IN <...>
ERROR E.SNI
TXNN FF,F.ARG ;YES. IF NO ARG,
MOVE B,SFINDF ;USE LAST SEARCH SWITCH (0 OR -1).
JUMPL B,CD ;IF ARG <0, JUST RET + EXECUTE LOOP
INCMA1: MOVEI TT,">" ;SKAN FOR >
MOVEI TT1,"<" ;IGNORE <...> STRINGS
PUSHJ P,SKAN
ERROR E.MRA
INCMA2: SUB P,[XWD 3,3] ;POP OUT A LEVEL
POP P,COMAX ;RESTORE MAX. COUNT
POP P,ITERCT
JRST RET
;!TAG! TAG DEFINITION. THE TAG IS A NAME FOR THE LOCATION IT
; APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING.
EXCLAM: PUSHJ P,SKRCH ;LOOK FOR NEXT !
ERROR E.UTG
CAIE CH,"!"
JRST EXCLAM
JRST RET
SUBTTL OTAG$ GO TO THE TAG NAMED TAG.
; THE TAG MUST APPEAR IN THE
; CURRENT MACRO OR COMMAND STRING.
OG: MOVE A,CPTR
MOVE AA,A
IDIVI AA,17
CAMN A,SYMS(B)
JRST OGFND
SKIPN SYMS(B)
JRST OGNF
CAMN A,SYMS+1(B)
ES1: AOJA B,OGFND
SKIPN SYMS+1(B)
ES2: AOJA B,OGNF
CAMN A,SYMS+2(B)
AOJA B,ES1
SKIPN SYMS+2(B)
ADDI B,2
OGNF: PUSH P,CPTR
PUSH P,B
MOVEI D,STAB
OG1: PUSHJ P,SKRCH ;GET NEXT COMMAND CHAR
ERROR E.MEO
CAIL D,STAB+STABLN-1 ;DON'T RAVAGE YOURSELF
ERROR E.TTL
MOVEM CH,(D) ;STAB ... _ TAG
CAIE CH,.CHESC
AOJA D,OG1
MOVEI A,"!" ;TAG TERMINATOR
MOVEM A,(D)
SETZM 1(D)
MOVE B,COMCNT ;MAKE PTR TO START OF THIS COMMAND LEVEL
SUB B,COMAX
IDIVI B,5
ADD B,CPTR
JUMPE E,OG7 ;NO REMAINDER
SOS B
MOVMS E
JRST .(E)
IBP B
IBP B
IBP B
IBP B
OG7: MOVEM B,CPTR
MOVE B,COMAX ;GET # OF CMD CHARS AT THIS LEVEL
MOVEM B,COMCNT
OG2: MOVEI TT,"!" ;SKAN FOR !
MOVEI TT1,-1 ;NO SECONDARY CHAR.
PUSHJ P,SKAN
ERROR E.TAG
TXO F2,S.NTRC ;DON'T TYPE EVERY TAG WHILE TRACING
MOVEI E,STAB ;INIT SEARCH STRING TO 1ST CHAR AFTER !
OG5: SKIPN (E) ;OVER STRING?
JRST OG3 ;YES
PUSHJ P,SKRCH ;NO. GET A CHAR
ERROR E.TAG
CAMN CH,(E) ;MATCH ?
AOJA E,OG5 ;YES. MOVE ON.
CAIN CH,"!" ;NO, ARE WE AT END OF A TAG?
JRST OG2 ;YES, LOOK FOR ANOTHER
MOVEI E,"!" ;NO, SKIP TO NEXT !
OG6: PUSHJ P,SKRCH ;GET NEXT CHAR OF TAG
ERROR E.UTG
CAIE CH,(E) ;!?
JRST OG6 ;NO, KEEP GOING
JRST OG2 ;YES, LOOK FOR ANOTHER TAG
OG3: TXZ F2,S.NTRC ;RE-ENABLE TRACING
POP P,A ;GET INDEX TO SYMBOL TABLE
POP P,SYMS(A) ;SAVE POSITION OF THIS O COMMAND
MOVE B,COMCNT ;SAVE COMCNT FOR THIS TAG
MOVEM B,CNTS(A)
MOVE B,CPTR ;SAVE TAG POSITION IN COMMAND STRING
MOVEM B,VALS(A)
JRST RET
OGFND: MOVE A,VALS(B)
MOVEM A,CPTR
MOVE A,CNTS(B)
MOVEM A,COMCNT
JRST RET
SUBTTL " ' PROCESSING
;N"G HAS NO EFFECT IF N IS GREATER THAT 0. OTHERWISE,
; SEND COMMAND INTERPRETATION TO NEXT MATCHING '.
; THE " AND ' MATCH SIMILAR TO ( AND ).
;N"L SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"N SEND COMMAND TO MATCHING ' UNLESS N NOT = 0.
;N"E SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"F SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"U SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"T SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"S SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"C SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS A LETTER, NUMBER, PERIOD (.), DOLLAR SIGN ($),
; OR PER CENT (%).
;N"A SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS ALPHABETIC.
;N"D SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS A DIGIT.
;N"V SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS LOWER CASE ALPHABETIC.
;N"W SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS UPPER CASE ALPHABETIC.
DQUOTE: TXNN FF,F.ARG ;ERROR IF NO ARG BEFORE "
ERROR E.NAQ
PUSHJ P,SKRCH ;GET CHAR AFTER "
ERROR E.MEQ
MOVEI T,DQTABL ;INDEX DISPATCH TABLE
PUSHJ P,DISPAT ;DISPATCH FOR CHAR. AFTER "
ERROR E.IQC
;" COMMAND DISPATCH TABLE
DQTABL: XWD DQ.G,"G"
XWD DQ.L,"L"
XWD DQ.N,"N"
XWD DQ.E,"E"
XWD DQ.C,"C"
XWD DQ.L,"T"
XWD DQ.E,"F"
XWD DQ.L,"S"
XWD DQ.E,"U"
XWD DQ.A,"A"
XWD DQ.D,"D"
XWD DQ.V,"V"
XWD DQ.W,"W"
XWD 0,0 ;END OF LIST
SUBTTL EXECUTE INDIVIDUAL " COMMANDS
DQ.V: TRZN B,40 ;EXECUTE "V
JRST NOGO ;IF BIT 30 NOT ON IT CAN'T BE L.C.
DQ.A: TRZ B,40 ;EXECUTE "A -- TREAT UC & LC ALIKE
DQ.W: CAIL B,"A" ;EXECUTE "W
CAILE B,"Z"
JRST NOGO ;IT IS NOT A LETTER
JRST RET ;IT IS A LETTER
DQ.D: CAIL B,"0" ;EXECUTE "D
CAILE B,"9"
JRST NOGO ;IT IS NOT A DIGIT
JRST RET ;IT IS A DIGIT
DQ.C: PUSHJ P,CKSYM1 ;EXECUTE "C
JRST RET ;IT IS A SYMBOL CHAR
JRST NOGO ;IT'S NOT A SYMBOL CHAR
DQ.G: MOVNS B ;EXECUTE "G
DQ.L: JUMPL B,RET ;EXECUTE "L
JRST NOGO ;TEST FAILED
DQ.N: JUMPN B,RET ;EXECUTE "N
JRST NOGO ;TEST FAILED
DQ.E: JUMPE B,RET ;EXECUTE "E, "F, "U
NOGO: MOVEI TT,"'" ;SKAN FOR '
MOVEI TT1,"""" ;IGNORE "...' STRINGS
PUSHJ P,SKAN
ERROR E.MAP
JRST RET
SUBTTL ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z
;CALL PUSHJ P,CKSYM
; RETURN IF $,%,.,0-9,A-Z
; RETURN ON ALL OTHER CHARACTERS
CKSYM: MOVEI B,(CH) ;ENTER AT CKSYM1 IF CHAR ALREADY IN B
CKSYM1: CAIE B,"$" ;$ OR %?
CAIN B,"%"
POPJ P, ;YES
CAIN B,"." ;NO. POINT?
POPJ P, ;YES.
CAIGE B,"0" ;NO. DIGIT OR LETTER?
JRST CPOPJ1 ;NO
CAIG B,"9" ;MAYBE. DIGIT?
POPJ P, ;YES.
CKSYM2: TRZ B,40 ;LC TO UC
CAIL B,"A" ;LETTER?
CAILE B,"Z"
JRST CPOPJ1 ;NO.
POPJ P, ;YES
SUBTTL ERROR MESSAGE PRINTOUT
ERRP: MOVE P,PDLSAV ;RESTORE PDL
HRRZ B,.JBUUO ;GET ERROR CODE
LDB D,[POINT 4,.JBUUO,12] ;GET SPECIAL CODE
CAIE B,'COR' ;CORE IS ALWAYS FATAL
TRNN D,10 ;COLONABLE ERROR?
TXZ FF,F.COLN ;NO,TURN OFF FLAG
TXZE FF,F.COLN
JRST ABEGIN
ERRPDL: SETZM XCTING ;NO LONGER XCTING
MOVE B,.JBREL ;.JBREL NOW
MOVEM B,RELSAV
SETZM CCLSW ;NO PECULIAR THINGS FOR ME
TXO FF,F.EMSG ;ERROR PROCEDURE IN PROGRESS
HRLZ B,.JBUUO ;GET ERROR CODE
CLRBFI ;CLEAR TTY
PUSHJ P,TTOPEN
MOVEI CH,"?" ;TYPE ?
PUSHJ P,TYOM
MOVSI TT,'TEC'
HLR TT,B
MOVX A,JW.WPR ;HOW MUCH WE PRINT
TDNE A,ERRLEN ;WELL
PUSHJ P,SIXBMS
TRZ D,10 ;SPECIAL FLAG
JUMPE D,ERRP04 ;NO SPECIAL ERROR EXTENSION
CAIN D,3 ;FLAG=EE3?
JRST ERRP05 ;YES
MOVEI CH,"-" ;NO, TYPE EXTENSION (MONITOR ERROR CODE)
PUSHJ P,TYOM
LDB B,[POINT 6,XFILNM+.RBEXT,35] ;GET UUO ERROR FLAG
SOJLE D,ERRP03 ;1 IMPLIES IT IS A UUO ERROR
HRRZI B,IO.ERR ;GET I-O ERROR FLAGS
AND B,ARGSTO
ERRP03: PUSHJ P,OCTMS ;TYPE ERROR CODE IN OCTAL
ERRP04: MOVE B,ERRLEN ;HOW MUCH MESSAGE WANTED?
TXNE B,JW.WFL
JRST ERRP02
PUSHJ P,CRR ;HE WANTS ONLY ?XXX, SO END LINE
JRST ERRP5 ;BETTER SEE IF HE WANTS MORE
ERRP02: MOVEI CH," " ;1ST LINE OF MESSAGE AUTOMATIC
PUSHJ P,TYOM ;TYPE TAB
ERRP0: SKIPN TT,ERRDEV ;[337] Get device TECO was run from
MOVSI TT,'DSK' ;[337] If 0, we're probably debugging: use DSK
DEVCHR TT, ;[337] Legal device?
JUMPE TT,ERRPSY ;[337] Nope, go use SYS:
TXNN TT,DV.DIR ;[337] Had better be a directory device
JRST ERRPSY ;[337] Strange...
SKIPN TT,ERRDEV ;[337] Retrieve name again
MOVSI TT,'DSK' ;[337]
MOVEM TT,ERRBLK+1 ;[337] Store in OPEN block
MOVEI TT,IO.SYN ;[337] Set status
MOVEM TT,ERRBLK ;[337]
MOVEI TT,ERRHDR ;[337] Set input buffer header
MOVEM TT,ERRBLK+.OPBUF;[337]
OPEN ERRCHN,ERRBLK ;[337] Open TECO.ERR device
JRST ERRPSY ;[337] Failed
JRST ERRP00 ;[337] Success
ERRPSY: MOVE TT,ERRDEV ;[337] Get device
CAMN TT,[SIXBIT/SYS/] ;[337] Equal to SYS:?
JRST NOERRS ;[337] Yes, give up
MOVSI TT,'SYS' ;[337] No, try SYS:
MOVEM TT,ERRDEV ;[337] Remember for next time
JRST ERRP0 ;[337] Try again
;Here when OPEN succeeds
ERRP00: MOVE TT,Z ;[337] GET ACTUAL FIRST FREE LOC
IDIVI TT,5
ADDI TT,2
MOVEI T,*2(TT) ;ROOM FOR 2 DISK BUFFERS?
MOVE B,.JBREL ;NO COMMENT
CAML T,.JBFF
PUSHJ P,GRABJR ;NO, GET 1K CORE
EXCH TT,.JBFF ;GET INPUT BUFFER
INBUF ERRCHN,2
MOVEM TT,.JBFF
MOVSI A,(SIXBIT /ERR/)
MOVEM A,TECERR+1 ;SET UP FILE EXTENSION
SETZM TECERR+2
MOVE TT,ERRPPN ;[337] Get PPN used in RUN
MOVEM TT,TECERR+3 ;[337] Store
HRL A,JOBN ;GET JOBNUMBER
HRRI A,.GTPRG ;& JOBNAME TABLE ADDRESS
GETTAB A, ;GET JOBNAME
JRST ERRP01 ;CAN'T
MOVEM A,TECERR ;SET FILE NAME
LOOKUP ERRCHN,TECERR ;LOOKUP JOBNAME.ERR
JRST ERRP01 ;NOT THERE, SO USE TECO.ERR
JRST ERRP1 ;FOUND
ERRP01: MOVE A,[SIXBIT /TECO/]
MOVEM A,TECERR
MOVEM TT,TECERR+3 ;[337] Store PPN again
LOOKUP ERRCHN,TECERR ;FIND TECO.ERR
JRST ERRPSY ;[337] Lookup failed
ERRP1: HRRZ D,.JBUUO ;GET ERROR CODE AGAIN
ERRP2: PUSHJ P,ERRWRD ;GET A WORD FROM FILE IN A
CAIN D,(A) ;IS THIS THE CODE WE WANT?
JRST ERRP3 ;YES
JUMPN A,ERRP2 ;NO, KEEP LOOKING IF NOT END OF INDEX
;FALL INTO ?TECEEE IF END OF INDEX
NOERRS: TXO FF,F.XPLN+F.EM ;CANT DO /
JSP A,CONMES ;PRINT BAD NEWS
ASCIZ /
?TECEEE Unable to Read Error Message File
/
JRST ERRP5
ERRP3: HLRZS A ;GET DISK ADR OF MESSAGE
IDIVI A,BUFSIZ ;GET DISK BLOCK AND WORD ADDR
USETI ERRCHN,1(A) ;TELL MONITOR WHAT BLOCK I WANT
IN ERRCHN,0 ;GET THAT BLOCK
CAIA ;BETTER WORK
JRST NOERRS ;DIDN'T
ADDM AA,ERRHDR+.BFPTR ;FIX ADDR
IMULI AA,5 ;CHANGE TO CHARS
SUB AA,ERRHDR+.BFCNT ;GET CORRECT COUNT
MOVNM AA,ERRHDR+.BFCNT ;FIX IT
PUSHJ P,ERRPRN ;YES, PRINT EVERYTHING UP TO THE LF
TXO FF,F.EM ;NOTE THAT THE 1ST LINE HAS BEEN TYPED
ERRP5: MOVE A,COMAX
SUB A,COMCNT
MOVEM A,ERR1 ;ERR1:=COMAX-COMCNT
MOVE A,CPTR
MOVEM A,ERR2 ;ERR2:=CPTR
MOVE A,ERRLEN ;DOES HE WANT THE WHOLE THING AUTOMATICALLY?
TXNE FF,F.XPLN ;MAYBE PREVENT LOOPING IF NO ERROR MES FILE
JRST ERRP6
TXNE A,JW.WCN
JRST XPLAIN
ERRP6: TXZN FF,F.CCL ;GET HERE FROM A "TECO" COMMAND?
JRST ERRP6A ;NO
LDB CH,[POINT 6,XFILNM+.RBEXT,35] ;CHECK FOR ?FNF-00
JUMPN CH,ERRP6A ;IT'S NOT
HRRZ CH,.JBUUO ;MAYBE
CAIN CH,(SIXBIT /FNF/)
MONRT. ;EXIT, BUT ALLOW CONT "/" FOR ERROR
ERRP6A: MOVEI CH,"*" ;TYPE * FOR NEXT COMMAND
PUSHJ P,TYOM
TXO FF,F.DDTM
PUSHJ P,TYI ;GET A CHARACTER NOW
CAIN CH,"?" ;QUESTION MARK?
JRST ERRTYP ;YES, TYPE BAD COMMAND
TXNE FF,F.XPLN ;EXPLANATION TYPED YET?
JRST ERRP7 ;YES, CAN'T DO THAT AGAIN
CAIE CH,"/" ;NO, IS IT A SLASH?
JRST ERRP7 ;NO
TXNN FF,F.EM ;YES, 1ST LINE DONE YET?
JRST ERRP0 ;NO
JRST XPLAIN ;OK, TYPE MORE EXPLANATION OF ERROR
ERRP7: RELEAS ERRCHN,
TXNN FF,F.XPLN!F.EM ;MED OR LONG MSG TYPED ?
JRST GOE ;NO, SKIPE CORE CONTRACTION
MOVE B,RELSAV ;GO BACK TO CORE WE HAD BEFORE
CORE B,
JFCL ;REDUCTION WON'T FAIL
JRST GOE ;GET REST OF COMMAND
ERRPRN: PUSHJ P,ERRCHR ;GET A CHAR FROM ERR. FILE
ERRPR2: CAIE CH,.CHCNN ;^N?
JRST ERRPR3 ;NO, SKIP
PUSHJ P,ERRCHR ;GET 1ST DIGIT AFTER ^N
MOVEI T,-60(CH)
IMULI T,^D10 ;PUT IT IN TEN'S PLACE
PUSHJ P,ERRCHR ;GET 2ND DIGIT
ADDI T,-60(CH)
ROT T,-1 ;DIVIDE TOTAL BY 2 & SAVE BIT 35
HLRZ CH,ETABL(T) ;GET LEFT SIDE ADDR IN CASE EVEN
TLNE T,400000 ;EVEN OR ODD?
HRRZ CH,ETABL(T) ;ODD, GET ADDR FROM RIGHT SIDE
JRST (CH) ;TYPE SPECIAL INFORMATION
ERRPR3: PUSHJ P,TYOM ;PRINT NORMAL CHARS.
CAIE CH,.CHLFD ;LF?
JRST ERRPRN ;NO
POPJ P,
;GET A CHARACTER FROM SYS:TECO.ERR
ERRCHR: SOSGE ERRHDR+.BFCNT ;ANY CHARS. IN BUFFER?
JRST ERRCH2 ;NO
ILDB CH,ERRHDR+.BFPTR ;YES, GET NEXT
POPJ P, ;DO NOT IGNORE NULLS
ERRCH2: IN ERRCHN,0 ;GET NEXT BUFFER
JRST ERRCHR ;OK, NOW GET A CHAR.
ERRCH3: POP P,A ;UNABLE TO READ TECO.ERR
JRST NOERRS
;GET 1K CORE FOR ERROR MESSAGE FILE READ-IN
GRABJR: ADDI B,^D1024 ;ADD 1K
CORE B,
JRST ERRCH3 ;CAN'T GET IT
POPJ P,
;CAN'T PRINT ERROR FILE BECAUSE OF NO CORE
ERRP05: TXO FF,F.XPLN+F.EM
RELEAS INICHN,
JSP A,CONMES
ASCIZ / Storage Capacity Exceeded
/
PUSHJ P,ECORE1 ;[354] GARBAGE COLLECT AND SMALLIFY
MOVE B,.JBREL ;.JBREL NOW
MOVEM B,RELSAV ;SO AS TO NOT CAUSE HUGIFICATION
JRST ERRP6A ;DON'T GET I-O TO UNASSIGNED CHANNEL
SUBTTL ROUTINE TO TYPE C(TT) IN SIXBIT
;CALL MOVE TT,[SIXBIT /MESSAGE/]
; PUSHJ P,SIXBMS
; RETURN
SIXBMS: SKIPN CH,TT ;ALL SPACES?
JRST SIXBM2 ;YES
MOVNI B,6
MOVE E,[POINT 6,TT]
ILDB CH,E
JUMPE CH,CPOPJ
SIXBM2: ADDI CH," "
PUSHJ P,TYOM
AOJL B,.-4
POPJ P,
SUBTTL ERROR PROCESSING ROUTINES
ERRTYP: SKIPN AA,ERR2 ;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
JRST [MOVEI CH,"*" ;THIS HAD TO BE IT
PUSHJ P,TYOM ;TYPE IT
SKIPE CH,EATCH ;GET Q REG NAME IF GOT THAT FAR
PUSHJ P,TYOM ;TYPE IT
JRST LASTQ] ;AND TYPE FINAL QUESTION MARK
MOVEI B,12
SUBI AA,2 ;BACK POINTER UP 10 CHARACTERS.
ILDB CH,AA ;GET CHARACTER
CAMG B,ERR1 ;WAS IT IN THE COMMAND BUFFER?
PUSHJ P,TYOM ;YES. TYPE IT.
CAME AA,ERR2 ;HAVE WE REACHED THE BAD COMMAND?
SOJA B,.-4 ;NO. DO IT AGAIN.
LASTQ: JSP A,CONMES ;PRINT A ? TO MARK END
ASCIZ /?
/
JRST ERRP6A
XPLA2: PUSHJ P,ERRPR2 ;PRINT UP TO LF
XPLAIN: PUSHJ P,ERRCHR ;IS NEXT CHAR A "?" OR ^A,^B, ... ^H?
CAILE CH,10 ;TEXT ENDS WITH A NULL OR CONTROL-A OR B
JRST XPLA2 ;NO, KEEP GOING
XPLA1: TXO FF,F.XPLN ;SET FLAG THAT XPLANATION IS TYPED
JRST ERRP6 ;YES, STOP HERE
;ROUTINE TO READ A WORD FROM THE FILE OPEN IN ASCII MODE
ERRWRD: SOSGE ERRHDR+.BFCNT ;ANY LEFT?
JRST ERRWR2 ;NO, GET SOME
MOVNI A,4 ;SUBTRACT 5 FROM COUNT
ADDM A,ERRHDR+.BFCNT ;(1 SUBTRACTED BY SOS ABOVE)
AOS A,ERRHDR+.BFPTR ;INCR ADR
MOVE A,(A) ;GET THE WORD
POPJ P,
ERRWR2: IN ERRCHN,0 ;GET NEXT BUFFER
JRST ERRWRD ;READ
JRST ERRCH3 ;ERROR
SUBTTL DISPATCH TABLE FOR SPECIAL INFORMATION TYPEOUT
;BASED ON CHARACTER AFTER CONTROL-N
ETABL: XWD ECOMCH,EOUTFL ;00 01
XWD EFILEN,EERNUM ;02 03
XWD EDEVNM,EPROJN ;04 05
XWD EARG1,EPROTC ;06 07
XWD EEBFN,EINFIL ;08 09
XWD EEBFIL,EIOFLG ;10 11
XWD ESTAB,ESKIP ;12 13
XWD EISKIP,0 ;14 15
XWD EEOVAL,EESRCH ;16 17
XWD EECTRL,EESWIT ;18 19
XWD EECRTS,0 ;20 21
SUBTTL SPECIAL INFORMATION TYPEOUT ROUTINES
EECTRL: SKIPA CH,ARGSTO ;GET BAD CHAR FROM TEXT STRING
ECOMCH: LDB CH,CPTR ;GET LAST COMMAND STRING CHAR.
PUSHJ P,TYOS
JRST ERRPRN
EOUTFL: MOVEI TT1,OUTFIL ;AIM AT OUTPUT FILENAME
EOUTF2: MOVE TT,(TT1)
PUSHJ P,SIXBMS ;PRINT FILENAME
HLLZ TT,1(TT1)
JUMPE TT,ERRPRN ;SKIP REST IF NO EXTENSION
MOVEI CH,"."
PUSHJ P,TYOM
EOUTF3: PUSHJ P,SIXBMS ;PRINT EXTENSION
JRST ERRPRN
EFILEN: MOVEI TT1,XFILNM+.RBNAM ;GET FILENAME REF'D BY UUO
JRST EOUTF2
EERNUM: LDB B,[POINT 6,XFILNM+.RBEXT,35] ;GET 2-DIGIT ERROR CODE
EERNU1: PUSHJ P,OCTMS ;TYPE IT
JRST ERRPRN
EDEVNM: SKIPN TT,FILDEV ;[337] GET DEVICE NAME
JRST ERRPRN ;[337] No device to be typed.
PUSHJ P,SIXBMS ;[337] Type it
MOVEI CH,":" ;[337] Get colon
PUSHJ P,TYOM ;[337] Type it
JRST ERRPRN ;[337] Continue
EPROJN: SKIPN FILPPN ;[337] Is there a PPN?
JRST ERRPRN ;[337] No, skip this.
MOVEI CH,"[" ;[337] Get a bracket
PUSHJ P,TYOM ;[337] Type it
HLRZ B,FILPPN ;TYPE PROJECT NUMBER
PUSHJ P,OCTMS
MOVEI CH,"," ;TYPE COMMA
PUSHJ P,TYOM
HRRZ B,FILPPN ;TYPE PROGRAMMER NUMBER
PUSHJ P,OCTMS
MOVE TT1,[XWD -5,FILSFD] ;TYPE SFD'S
ERSFDS: SKIPN TT,(TT1) ;GET ONE
JRST EPROJ2 ;[337] IF ZERO, WE'RE DONE
MOVEI CH,","
PUSHJ P,TYOM
ERSFD1: PUSHJ P,SIXBMS
AOBJN TT1,ERSFDS ;LOOP BACK
EPROJ2: MOVEI CH,"]" ;[337] Close the brackets
PUSHJ P,TYOM ;[337]
JRST ERRPRN
EECRTS:
IFN CRT,<
MOVE CH,"[" ;[337] Make it look good
PUSHJ P,TYOM ;[337]
MOVE TT1,[IOWD NUMCRT,CRTTAB+1] ;TYPE OUT VALID CRT TYPES
MOVE TT,(TT1)
JRST ERSFD1 >
IFE CRT,
EESWIT: MOVE TT,SWITHL ;GET I/O SWITCH NAME
JRST EOUTF3
EARG1: MOVE B,ARGSTO ;GET ARG BACK
EARG1A: PUSHJ P,DECMS ;PRINT IT
JRST ERRPRN
EPROTC: LDB B,[POINT 9,XFILNM+.RBPRV,8] ;GET FILE PROTECTION
MOVEI CH,"0" ;[337] Possible leading 0
CAIGE B,100 ;[337] 3 digit protection?
PUSHJ P,TYOM ;[337] No, type a leading 0
MOVEI CH,"0" ;[337] Once again...
CAIGE B,10 ;[337] 2 digit protection?
PUSHJ P,TYOM ;[337] No, type another leading 0
JRST EERNU1
EEBFN: MOVE TT,BAKNAM ;EB FILENAME
JRST EOUTF3 ;PRINT IT WITHOUT EXTENSION
EINFIL: MOVEI TT1,INFILE ;AIM AT INPUT FILENAME
JRST EOUTF2
EEBFIL: MOVEI TT1,BAKNAM ;AIM AT EB ORIGINAL FILENAME
JRST EOUTF2
EIOFLG: HRRZI B,IO.ERR ;RETRIEVE I/O ERROR FLAGS
AND B,ARGSTO
JRST EERNU1
ESTAB: MOVEI TT,STAB ;INDEX STAB WHERE TAG RESIDES
ESTAB1: MOVE CH,(TT)
JUMPE CH,ERRPRN ;THAT'S ALL
PUSHJ P,TYOS
AOJA TT,ESTAB1
EISKIP: LDB TT,[POINT 4,ARGSTO,21] ;GET I/O ERROR FLAGS
SKIPA
ESKIP: LDB TT,[POINT 6,XFILNM+.RBEXT,35]
ESKIP2: PUSHJ P,ERRCHR ;LOOK FOR ^A
CAIN CH,2 ;^B ENCOUNTERED?
JRST ERRPRN ;YES, PRINT DEFAULT MESSAGE
CAIE CH,1
JRST ESKIP2 ;NOT ^A
PUSHJ P,ERRCHR ;GET 1ST DIGIT AFTER ^A
MOVEI T,-60(CH)
LSH T,3 ;MULT BY 8
PUSHJ P,ERRCHR ;GET NEXT DIGIT
ADDI T,-60(CH)
CAME TT,T ;THIS THE NUMBER WE WANT?
JRST ESKIP2 ;NO
JRST ERRPRN ;YES, NOW START PRINTING
EEOVAL: MOVEI B,EOVAL ;GET MAXIMUM EOFLAG FOR THIS VERSION
JRST EARG1A
EESRCH: MOVE TT,[POINT 7,SRHARG] ;GET PTR TO SEARCH STRING
MOVM B,SRHCTR ;& STRING CTR
EESRH2: ILDB CH,TT ;GET STRING CHAR
PUSHJ P,TYOS ;TYPE IT
SOJE B,ERRPRN ;WATCH STRING CTR
JRST EESRH2 ;NOT FINISHED YET
SUBTTL UUO HANDLER
UUOH:
MOVEM B,ARGSTO ;SAVE POSSIBLE ARG
LDB B,[POINT 9,.JBUUO,8] ;GET UUO TYPE
CAIL B,20 ;CHKEO?
JRST CEO ;YES
CAIN B,1 ;ERROR UUO?
JRST ERRP ;YES
UUOERR: HRRZ B,(P) ;ADDRESS OF ILLEGAL UUO
SUBI B,1
MOVE D,@B ;GET COMPLETE UUO INSTRUCTION
MOVEM D,FILPPN ;STORE IT
SETZM FILPPN+1 ;WE DON'T WANT ANY SFD'S TYPED!
ERROR E.UUO
;CHKEO EO#,ADDR
;IF EOFLAG > EO#, RETURN AT CALL+1 (FEATURE IS LEFT ON)
;OTHERWISE GO TO ADDR (FEATURE IS TURNED OFF)
CEO: PUSH P,A ;SAVE AC
LDB B,[POINT 8,.JBUUO,12] ;GET EO TEST VALUE
MOVE A,EOFLAG ;GET LAST SETTING OF EOFLAG
CAIG A,(B) ;EOFLAG > TEST VALUE?
JRST CEO1 ;NO
CEO2: POP P,A ;RESTORE AC A
MOVE B,ARGSTO ;RESTORE AC B
POPJ P, ;RETURN
CEO1: HRRZ A,.JBUUO ;GET DISPATCH ADDR
HRRM A,-1(P) ;PUT ON PDL AS RET. ADDR.
JRST CEO2
SUBTTL COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND
QUESTN: TXCN FF,F.TRAC ;COMPLEMENT TRACE FLAG
JRST RET
PUSHJ P,CRR ;TYPE CR/LF AFTER TRACE MODE EXIT
JRST RET
COMMEN: PUSHJ P,SKRCH ;GET A COMMENT CHAR
ERROR E.UCA
CAIN CH,1 ;^A
JRST [TXNN FF,F.TRAC
OUTPUT TTY, ;FORCE OUTPUT TO TTY
JRST RET] ;AND LEAVE
TXNN FF,F.TRAC ;OMIT DOUBLE TYPE-OUT WHEN TRACING
PUSHJ P,TYOM ;TYPE IT
JRST COMMEN
;ILLEGAL CHARACTER OR COMMAND
ERRA: MOVE B,CH ;DONT USE TEXT BUFFER, SO THAT ^ WORKS
ERROR E.ILL
SUBTTL ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS.
;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER.
;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES,
;TO ARGUMENTS.
;CALL PUSHJ P,GETARG
; RETURN WITH FIRST ARGUMENT ADDRESS IN C, SECOND IN B.
;IF THE EO VALUE HAS BEEN SET TO 1, THE ONLY EOL CHAR IS LINE FEED.
;IF EO > 1, THE EOL CHARS ARE LF, VT, AND FF (& END OF BUFFER IF
;LAST CHAR IN BUFR IS NOT AN EOL)
GETARG: TXNE FF,F.ARG2 ;IS THERE A SECOND ARGUMENT?
JRST GETAG6 ;YES
;N SIGN INDICATES DIRECTION RELATIVE TO PT.
GETNAG: PUSHJ P,CHK2 ;NO, GET 1ST ARG (+ OR - 1 IF NONE THERE)
MOVE I,PT ;IN:=PT
GETAG4: JUMPLE B,GETAG2 ;WAS LAST ARGUMENT FUNCTION -?
CAMN I,Z ;NO. ARGUMENT IS LOCATION OF NTH EOL FORWARD FROM PT.
;IS PT AT END OF BUFFER?
JRST GETAG1 ;YES.
PUSHJ P,GETINC ;NO. CH:=NEXT DATA BUFFER CHARACTER, IN:=IN+1
PUSHJ P,CKEOL ;IS IT AN EOL?
JRST GETAG4 ;NO. TRY AGAIN.
SOJG B,GETAG4 ;YES. NTH EOL?
GETAG1: MOVE B,I ;YES. RETURN FIRST ARGUMENT IN C
MOVE C,PT ;SECOND IN B.
POPJ P,
;M,N
GETAG6: ADD B,BEG ;C:=M+BEG
ADD C,BEG ;B:=N+BEG
POPJ P,
GETAG2: SOS I ;SET I FOR CHAR BEFORE PT
CAMGE I,BEG ;PASSED BEGINNING OF BUFFER?
JRST GETAG3 ;YES. IN:=BEG
PUSHJ P,GETINC ;NO. CH:=NEXT DATA BUFFER CHARACTER. IN:=IN+1
PUSHJ P,CKEOL ;IS IT AN EOL?
SOJA I,GETAG2 ;NO. BACK UP ONE POSITION AND TRY AGAIN.
AOJLE B,.-1 ;YES. NTH EOL?
GETAG3: CAMGE I,BEG ;YES. PASSED BEGINNING OF BUFFER?
MOVE I,BEG ;YES. RESET TO BEGINNING.
MOVE C,I ;NO. RETURN FIRST ARGUMENT IN C.
MOVE B,PT ;SECOND IN B
POPJ P,
SUBTTL ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT OF THE POINTER
;AND INCREMENT THE POINTER.
;CALL MOVE I,POINTER (AS A CHARACTER ADDRESS)
; PUSHJ P,GETINC
; RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN IN.
GETINC: PUSHJ P,GET
AOJA I,CPOPJ
GET: MOVE TT,I
IDIVI TT,5
HLL TT,BTAB(TT1)
LDB CH,TT
POPJ P,
PUT: MOVE TT,OU
IDIVI TT,5
HLL TT,BTAB(TT1)
DPB CH,TT
POPJ P,
;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT OF A CHARACTER ADDRESS POINTER
XWD 440700,0
BTAB: XWD 350700,0
XWD 260700,0
XWD 170700,0
XWD 100700,0
XWD 10700,0
;CHECK IF CH = EOL CHARACTER
;CALL: PUSHJ P,CKEOL
; RETURN IF CH NOT = EOL
; RETURN IF CH IS EOL CHAR
CKEOL: CAIN CH,.CHLFD ;LINE FEED?
JRST CPOPJ1 ;YES, IT IS AN EOL!
CHKEO EO21,CPOPJ ;IF EO=1, LF IS ONLY POSSIBLE EOL
CAIE CH,.CHVTB ;VERTICAL TAB?
CAIN CH,.CHFFD ;FORM FEED?
AOS (P) ;YES, SKIP RETURN
POPJ P, ;NO
SUBTTL ROUTINES TO MOVE CHARACTERS AROUND
NROOMC:
IFN VC, ;SAVE LENGTH OF STRING
NROOM: SETZM CRREL ;[317]ZERO THE RELOCATION WORDS
SETZM RREL ;[317]
JUMPE C,CPOPJ ;IF 0, THERE'S NOTHING TO DO
MOVEM 17,AC2+15 ;SAVE 17
MOVEI 17,NROOM9 ;ANTICIPATE GARBAGE COLLECTION
MOVEM 17,GCRET ;THIS THE EXIT DISPATCH
MOVE 17,PT
CAMN 17,Z ;PT=Z? I.E., DATA BUFFER EXPANSION?
JRST NROOM1 ;YES.
NROOM0: MOVE 17,[XWD 2,AC2] ;NO. SAVE ACS 2 THROUGH 16.
BLT 17,AC2+14
JUMPL C,NROOM6 ;DELETION?
SETOM GCFLG ;NO.
;MOVE STRING STORAGE UP C CHARACTERS STARTING AT PT.
NROOM9: MOVE F2,AC2+F2-2 ;IN CASE CORE ERROR
MOVE 17,Z
ADD 17,C
CAML 17,MEMSIZ ;WILL REQUEST OVERFLOW MEMORY?
JRST GC ;YES. GARBAGE COLLECT.
;MOVE FROM PT THROUGH Z UP C POSITIONS
MOVE 14,C ;NO.
IDIVI 14,5 ;AC14:=Q(REQ/5), AC15:=REM(REQ/5)
IMULI 15,7 ;AC15:=(REM(REQ/5))*7
MOVN 13,15 ;AC13:=-(REM(REQ/5))*7
MOVEI 15,-43(15) ;AC15:=(REM(REQ/5))*7-43
MOVE 11,PT
IDIVI 11,5 ;AC11:=Q(PT/5), AC12:=REM(PT/5)
MOVNI 16,-5(12)
IMULI 16,7 ;AC16:=-(REM(PT/5)-5)*7
DPB 16,[XWD 300600,NROOM2] ;SET SIZE FIELD OF LAST PARTIAL WORD POINTER.
ADDI 14,1(11) ;AC14:=Q(REQ/5)+Q(PT/5)+1
MOVE 16,Z
IDIVI 16,5 ;AC16:=Q(Z/5)
MOVEI B,1(16)
SUB B,11 ;B:=Q(Z/5)+1-Q(PT/5)=NO. OF WORDS TO MOVE.
;PUT MOVE ROUTINE IN FAST ACS
HRLI 11,200000+B+A*40 ;AC11:=MOVE A,[Q(PT/5)](B)
HRLOI 12,241000+A*40 ;AC12:=ROT A,-1
HRLI 13,245000+A*40 ;AC13:=ROTC A,-(REM(REQ/5))*7
HRLI 14,202000+B+AA*40 ;AC14:=MOVEM AA,[Q(PT/5)+1](B)
HRLI 15,245000+A*40 ;AC15:=ROTC A,(REM(REQ/5))*7-43
MOVE 17,[JRST,NROOM7] ;AC16:=SOJGE B,11
MOVE 16,.+1 ;AC17:=JRST NROOM7
SOJGE B,11 ;B:=B-1. DONE?
NROOM7: ROTC A,43(13) ;YES. STORE LAST PARTIAL WORD.
DPB A,NROOM2
ADDM C,Z ;Z:=Z+REQ
NROOM5: MOVE 17,[XWD 2,AC2] ;RESTORE ACS AND RETURN.
MOVSS 17
BLT 17,17
POPJ P,
;A CALL FOR A BUFFER EXPANSION, WHERE PT=Z. IF
;THERE IS NOT ENOUGH ROOM, PERFORM THE GARBAGE COLLECTION ROUTINE
;IF THERE IS STILL NO ROOM, GET THE NECESSARY CORE FROM THE
;MONITOR TO SATISFY THIS REQUEST
NROOM1: ADD 17,C ;TOTAL SPACE REQUIREMENT
CAMGE 17,MEMSIZ ;[320] IS THERE ENOUGH?
JRST .+4 ;YES, THEREFORE, UPDATE Z AND EXIT
MOVEI 17,GCRETA ;EXIT DISPATCH FOR THE
MOVEM 17,GCRET ;GARBAGE COLLECTION ROUTINE
JRST NROOM0 ;GO DO THE GARBAGE COLLECTION
ADDM C,Z ;UPDATE Z, SIZE IS OK
MOVE 17,AC2+15 ;RESTORE AC#17
POPJ P, ;EXIT OUT
;NOT ENOUGH ROOM FOR THE EXPANSION, GARBAGE COLLECTION HAS BEEN
;PERFORMED, IF NEED BE, GRAB A K FROM THE MONITOR (OR MORE)
GCRETA: MOVE 17,Z ;GET TOTAL SO FAR
ADD 17,C ;ADD IN THE REQUEST
MOVE F2,AC2+F2-2
CAML 17,MEMSIZ ;STILL IN NEED OF CORE?
PUSHJ P,GRABAK ;YES, GET THE REQUIRED CORE FROM THE MONITOR
ADDM C,Z ;UPDATE Z AND EXIT
JRST NROOM5 ;RESTORE ALL AC'S AND RETURN TO SEQUENCE
;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
NROOM6:IFN BISSW,< ;KL10 BIS SUPPORT
SKIPN BIS ;KL10?
JRST NBIS6 ;NO
MOVE 15,PT ;CHARACTER ADDRESS OF TEXT POINTER
IDIVI 15,5 ;WORD ADDR
HLL 15,BTAB-1(16) ;BYTE POINTER TO DESTINATION
MOVE 11,Z ;LAST BYTE ADDR IN TEXT BUFFER
ADDM C,Z ;UPDATE Z
MOVMS 12,C ;NUMBER OF CHARACTERS TO MOVE DOWN
ADD 12,PT ;SOURCE BYTE
SUB 11,12 ;# BYTES TO MOVE
MOVE 14,11 ;# BYTES TO MOVE TO DESTINATION
IDIVI 12,5 ;SOURCE WORD ADDR
HLL 12,BTAB-1(13) ;SOURCE BYTE POINTER
SETZM 13 ;NOT USED BY US
EXTEND 11,[MOVSLJ ;MOVE STRING LEFT JUSTIFIED
EXP 0] ;NO FILL
E$$EMF: ERROR (EMF) ;EXTENDED MOVE FAILED
JRST NROOM3 ;RESTORE ACS
NBIS6:> ;END IFN BISSW
MOVE 14,PT ;INITIALIZE PARTIAL WORD POINTER.
IDIVI 14,5 ;AC14:=Q(PT/5), AC15:=REM(PT/5)
MOVEM 14,B ;B:=Q(PT/5)
HRRZM 14,NROOM4
IMULI 15,7
DPB 15,[XWD 300600,NROOM4] ;SIZE:=(REM(PT/5))*7
MOVNI 15,-44(15)
DPB 15,[XWD 360600,NROOM4] ;POSITION:=44-(REM(PT/5))*7
MOVE 11,Z
IDIVI 11,5 ;AC11:=Q(Z/5)+1, AC12:=REM(Z/5)
ADDI 11,1
MOVE 13,C
IDIVI 13,5
ADDI 13,-1(11) ;AC13:=Q(Z/5)-Q(REQ/5)
MOVNM 14,12 ;AC12:=(REM(REQ/5))*7
IMULI 12,7
MOVNI 15,-43(12) ;AC15:=43-(REM(REQ/5))*7
SUBI B,1(13) ;B:=Q(PT/5)+Q(REQ/5)-Q(Z/5)-1:=# WORDS TO MOVE
NROOM8: HRLI 11,200000+B+AA*40 ;AC11:=MOVE AA,[Q(Z/5)+1](B)
HRLI 12,245000+A*40 ;AC12:=ROTC A,(REM(REQ/5))*7
HRLI 13,202000+B+A*40 ;AC13:=MOVEM A,[Q(Z/5)-Q(REQ/5)](B)
MOVE 14,[ADDM A,@13] ;AC14:=ADDM A,@13
HRLI 15,245000+A*40 ;AC15:=ROTC A,43-(REM(REQ/5))*7
MOVE 17,[JRST NROOM3] ;AC16:=AOJLE B,11
ADDM C,Z ;AC17:=JRST NROOM3
LDB C,NROOM4
MOVE A,@11 ;Z:=C(Z)-REQ
ROT A,-1 ;A:=Q(PT/5)+Q(REQ/5) RIGHT JUSTIFIED.
MOVE 16,.+1
AOJLE B,11 ;B:=B+1. DONE?
NROOM3: DPB C,NROOM4 ;YES. DEPOSIT PARTIAL WORD.
JRST NROOM5
SUBTTL GARBAGE COLLECTOR
GC: AOSE GCFLG ;FIRST ATTEMPT?
JRST PRENR9 ;TRY TO EXPAND MEMORY
SETOM GCPTR ;YES. GCPTR:=-1
SETZM SYMS ;CLEAR SYMS,VALS AND CNTS TABLES
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND-1
MOVEI T,CPTR ;COMMAND BUFFER
PUSHJ P,GCMA
MOVEI T,(P)
PUSHJ P,GCMA ;NO. GARBAGE COLLECT ALL BYTE POINTERS ON IT.
CAILE T,PDL+1
SOJA T,.-2
HRRZ T,AC2+PF-2 ;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
CAIL T,PFL
PUSHJ P,GCM
CAILE T,PFL
SOJA T,.-2
MOVE T,[XWD -45,QTAB] ;GARBAGE COLLECT Q-REGISTERS.
PUSHJ P,GCM
AOBJN T,.-1
MOVE I,BEG ;MAKE SURE STUFF BEFORE BEG
SUB I,QRBUF ;IS COLLECTED
MOVEI T,0 ;MARK THIS AS LAST COLLECTION
PUSHJ P,GCM3 ;STORE IT ON TH GC LIST
MOVE I,QRBUF
GCS1A: MOVSI TT,200000 ;TT>MAX. NO. CHARACTERS IN WORLD
MOVE OU,GCPTR ;GO BACKWARDS THROUGH GCTAB
GCS1: HRRZ A,GCTAB(OU) ;RELOCATE
ADD A,QRBUF
CAMGE A,I
JRST GCS2
CAMGE A,TT ;SET TT TO HIGHEST CHARACTER POSITION
MOVE TT,A
GCS2: SOJGE OU,GCS1
CAMN TT,[1B1] ;ANYTHING IN GCTAB ? [EDIT #116]
JRST GCS4A ;NO, DON'T SAVE INFINITY[EDIT #116]
MOVE F2,TT ;HIGHEST CHARACTER.
IDIVI I,5 ;C(QRBUF)/5
IDIVI F2,5 ;HIGH CHAR/5
AOS I ;C(QRBUF)/5+1
MOVS OU,F2
MOVE T,F2
SUB T,I ;HIGH CHAR/5-C(QRBUF)/5+1
JUMPLE T,GCS4A ;ANYTHING TO GET?
HRR OU,I ;XWD HIGH CH/5,C(QRBUF)/5+1=NREG
MOVE B,Z ;GET TOP OF BUFR FOR BLT
HRRZ F2,(P) ;SEE WHO CALLED NROOM
CAIN F2,YANK6 ;WAS IT APPEND?
MOVE B,AC2+OU-2 ;YES, MUST USE THE REAL Z FOR THE BLT
IDIVI B,5
SUB B,T ;Z/5-NREG
BLT OU,(B) ;MOVE STUFF DOWN
MOVNS OU,T
IMULI OU,5 ;OUT:=-5*NREG
ADDM OU,BEG ;BEG:=C(BEG)-5*NREG
ADDM OU,PT ;PT:=C(PT)-5*NREG
ADDM OU,Z ;Z:=C(Z)-5*NREG
ADDM OU,RREL ;RREL:=C(RREL)-5*NREG
MOVE CH,GCPTR ;UPDATE INSERTER
GCS3: HRRZI TT1,GCTAB(CH)
HRRZ A,(TT1)
ADD A,QRBUF
CAMGE A,TT
JRST GCS4
ADDM OU,(TT1)
HLRZ A,(TT1)
JUMPE A,GCS4 ;NO PTR TO BEG
CAIN A,CPTR ;IN COMMAND BUFFER?
ADDM T,CRREL ;YES. UPDATE COMMAND POINTER RELOCATION
SKIPL (A) ;Q-REG?
ADDM T,(A) ;NO
SKIPGE (A) ;Q-REG?
ADDM OU,(A) ;YES. RELOCATE BASE POINTER.
GCS4: SOJGE CH,GCS3 ;DONE?
ADD TT,OU ;YES. IN:=C(TT)-5*NREG
GCS4A: CAML TT,BEG ;LAST COLLECTION?
JRST @GCRET ;YES, RETURN
MOVE I,TT
PUSH P,C
PUSHJ P,GTQCNT
ADD I,C
POP P,C
JRST GCS1A
GCM: MOVE I,(T)
TLZE I,400000 ;DOES Q-REG CONTAIN TEXT?
TLZE I,377777
POPJ P, ;NO
ADD I,QRBUF ;YES. ENTER POINTER IN GCTAB
GCM2: CAML I,BEG ;REGION BEFORE TEXT BUFFER?
POPJ P, ;NO. FORGET IT.
SUB I,QRBUF ;YES. IN:=# CHARACTERS TO RETREIVE.
;IN Q-REG BUFFER AREA?
JUMPL I,CPOPJ ;NO. FORGET IT.
GCM3: AOS TT,GCPTR ;YES. TO BE GRABBED.
CAIL TT,GCTBL ;AM I WINNING?
ERROR E.GCE
HRL I,T ;XWD ADDRESS OF BYTE POINTER,NO. CHARACTERS
MOVEM I,GCTAB(TT) ;SAVE DATA
POPJ P, ;DONE THIS POINTER
;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP
;OF STRING - NO. OF CHARACTERS.
GCMA: HLRZ TT,(T) ;LEFT HALF OF PTR
TRC TT,700 ;DOES T POINT TO A TEXT BYTE POINTER?
TRNE TT,7700
POPJ P, ;NO
MOVE I,-1(T) ;MAYBE. GET WORD BEFORE POINTER. (MAX)
SUB I,1(T) ;MAX-CT
LSH TT,-14 ;BYTE POSITION
IDIVI TT,7 ;NO. OF CHARACTERS
MOVEI TT1,4-3+1 ;2
SUB TT1,TT ;2-NO. OF CHARACTERS
HRRZ TT,(T) ;POINTER WORD ADDRESS (UNRELOCATED)
IMULI TT,5 ;5*ADDRESS
ADD TT,TT1
SUBM TT,I ;5*ADDRESS-NO. CHARS+2+CT-MAX
JRST GCM2
SUBTTL AUTOMATIC MEMORY EXPANSION
;MEMORY WILL BE EXPANDED UNDER ONE OF THESE CONDITIONS.
; 1.AN INTERNAL BUFFER EXPANSION CANNOT BE PERFORMED,
; TO DO SO WOULD OVERFLOW THE PRESENT MEMORY
; CAPACITY. THE INTERNAL OPERATIONS WHICH DESCOVER
; THE NEED FOR EXPANSION ARE:
; A.COMMAND BUFFER EXPANDING
; B.THE Q-REG GET (GI)
; C.THE Q-REG LOAD (NXI)
; D.ANY OF THE INSERTS
; E.COMMAND ACCEPTANCE ROUTINE
; 2.THE DATA BUFFER WILL BE MAINTAINED AT A MINIMUM
; NUMBER OF 5000 CHARACTERS BEFORE NEW DATA IS LOADED
; FROM AN INPUT DEVICE OTHER THAN THE CONSOLE. Q-REG
; USAGE SHORTENS THE NUMBER OF AVAILABLE CHARACTERS
; DIRECTLY, AND NORMAL TECO COMMANDS ARE GREATLY IMPARED
; OTHERWISE.
;SAVE THE ACCUMULATORS
GRABAK: TXOA FF,F.TALK ;TALKATIVE GRAB
GRABKQ: TXZ FF,F.TALK ;GRAB A K QUIETLY
MOVEM CH,SAV16 ;TO SAVE THE ACCUMULATORS
MOVEI CH,SAVE ;WHILE WE SCOOT ALL OVER THE
BLT CH,SAV16-1 ;THE PLACE
;COUNT THE NUMBER OF BLOCKS NEEDED TO FILL THE REQUEST
MOVEI F2,^D1024 ;1 BLOCK OF CORE
MOVEI B,1 ;WE WILL NEED AT LEAST ONE BLOCK
ADDM F2,.JBFF ;UP THE FIRST FREE COUNT
PUSHJ P,CRE23 ;COMPUTE A NEW MEMSIZ AND 2/3 VALUE
CAML 17,MEMSIZ ;WILL THIS BE ENOUGH CORE?
AOJA B,.-3 ;NO, COMPUTE ANOTHER BLOCK
;NUMBER OF BLOCKS HAVE BEEN FOUND
;OBTAIN THE NEEDED CORE FROM THE MONITOR
MOVE B,.JBFF ;TO HELP OUT THE MONITOR
CAMG B,.JBREL ;NEED TO ASK?
JRST EXITZ ;NO
CORE B, ;MAKE THE CALL TO THE MONITOR
JRST NOTANY ;NO CORE (OR NOT ENOUGH) AVAILABLE
TXNN FF,F.INIT ;IF PROCESSING INI FILE NO RANDON [NK...
TXNN FF,F.TALK ;MESSAGE DESIRABLE?
JRST EXITZ ;NO
CORES: MOVEI CH,"["
PUSHJ P,TYOM
MOVE B,.JBREL ;SIZE OF CORE NOW
ADDI B,1
ASH B,-12
PUSHJ P,DECMS ;PRINT
JSP A,CONMES
ASCIZ /K Core]
/
TXNE FF,F.INIT ;INIT FILES NEED NO AC RESTORE!
POPJ P, ;SO DON'T
;RESTORE THE AC'S AND EXIT FROM THIS COR GET ROUTINE
EXITZ: MOVSI CH,SAVE ;FROM TO
BLT CH,CH ;ALL AC'S AS THEY WERE
POPJ P, ;AND EXIT
;NO CORE AVAILABLE (OR NOT ENOUGH)
NOTANY: HLRZ A,.JBSA ;GET LAST FIGURE OF CORE BOUND
MOVEM A,.JBFF ;AND STORE IT
PUSHJ P,CRE23 ;COMPUTE THE MEMSIZE VALUES AGAIN
MOVSI CH,SAVE ;RESTORE THE ACCUMULATORS
BLT CH,CH ;& INFORM THE OUTSIDE WORLD THAT THEY LOSE
EE3+ERROR E.COR
;THIS IS AN AUXILARY SPOT FOR ENTRANCE FROM GC2
;GET THE REQUIRED CORE TO SAVE THE JOB IF POSSIBLE
PRENR9: PUSHJ P,GRABAK ;GET THE REQUIRED CORE
JRST NROOM9 ;GO TRY THE INSERT AGAIN
SUBTTL COMMAND DISPATCH TABLE
DEFINE DSP (C1,A1,C2,A2)<
XWD <B20+A1>,<B20+A2>>
;CODES INDICATE TYPE OF DISPATCH
JR==0 ;FOR SIMPLE JRST DISPATCH
HR==1 ;FOR DISPATCH TO A COMMAND PERFORMED BY A SUBROUTINE
MV==2 ;FOR JRST DISPATCH AFTER PROCESSING PRECEDING NUMERIC ARGUMENTS
DTB: DSP(JR,ERRA,JR,COMMEN) ;^@ ^A
DSP(JR,ERRA,JR,STOP) ;^B ^C
DSP(JR,ERRA,JR,FFEED) ;^D ^E
DSP(MV,LAT,MV,BELDMP) ;^F ^G
DSP(JR,GTIME,HR,TAB) ;^H TAB
DSP(JR,CD5,JR,ERRA) ;LF VT
DSP(HR,TYO,JR,CD5) ;FF CR
DSP(JR,EOF,JR,OCTIN) ;^N ^O
DSP(MV,QPAGE,JR,ERRA) ;^P ^Q
DSP(JR,ERRA,JR,ERRA) ;^R ^S
DSP(MV,SPTYI,HR,IUSET) ;^T ^U
DSP(MV,LOWCAS,MV,STDCAS) ;^V ^W
DSP(MV,SETMCH,MV,QYANK) ;^X ^Y
DSP(JR,DECDMP,JR,ALTMOD) ;^Z ^[
DSP(JR,ERRA,JR,ERRA) ;^BKSLH ^]
DSP(JR,CNTRUP,JR,ERRA) ;^^ ^LFTARR
DSP(MV,PLUS,JR,EXCLAM) ;SPACE !
DSP(MV,DQUOTE,MV,COR) ;" #
DSP(JR,ERRA,JR,PCNT) ;$ %
DSP(MV,CAND,JR,CD) ;& '
DSP(JR,OPENP,MV,CLOSEP) ;( )
DSP(MV,TIMES,MV,PLUS) ;* +
DSP(MV,COMMA,MV,MINUS) ;, -
DSP(JR,PNT,MV,SLASH) ;. /
DSP(JR,CDNUM,JR,CDNUM) ;0 1
DSP(JR,CDNUM,JR,CDNUM) ;2 3
DSP(JR,CDNUM,JR,CDNUM) ;4 5
DSP(JR,CDNUM,JR,CDNUM) ;6 7
DSP(JR,CDNUM,JR,CDNUM) ;8 9
DSP(MV,COLON,MV,SEMICL) ;: ;
DSP(MV,LSSTH,HR,PRNT) ;< =
DSP(JR,GRTH,JR,QUESTN) ;> ?
DSP(MV,ATSIGN,MV,ACMD) ;@ A
DSP(JR,BEGIN,MV,CHARAC) ;B C
DSP(MV,DELETE,HR,ECMD) ;D E
DSP(MV,FCMD,JR,QGET) ;F G
DSP(JR,HOLE,HR,INSERT) ;H I
DSP(MV,JMP,MV,KILL) ;J K
DSP(MV,LINE,JR,MAC) ;L M
DSP(MV,SERCHP,JR,OG) ;N O
DSP(HR,PUNCHA,JR,QREG) ;P Q
DSP(MV,REVERS,MV,SERCH) ;R S
DSP(HR,TYPE,MV,USE) ;T U
DSP(HR,VCMD,JR,MJRST) ;V W
DSP(MV,X,HR,YANKER) ;X Y
DSP(JR,END1,MV,OPENB) ;Z [
DSP(MV,BAKSL,MV,CLOSEB) ;BKSLH ]
DSP(JR,UAR,MV,LARR) ;^ LFTARR
SUBTTL LOW SEGMENT
RELOC 0 ;TO THE LOW SEGMENT
LOCORE==. ;START OF THE LOW SEGMENT
IFN BISSW,<
BIS: BLOCK 1 ;FLAG TO INDICATE KL-10
>
INI: BLOCK 1 ;FLAG FOR TO DO INI FILE
TEMPP: BLOCK 1 ;PLACE TO SAVE P ON REENTER
TEMPDL: BLOCK 1 ;TEMP PDL
IFN CCL,<
CCLB: BLOCK 3 ;THE HEADER FOR CCL FILE IO
TYIPT: BLOCK 1
> ;END IFN CCL
TTYBFS: BLOCK 46 ;100 MODE TTY BFRS
TIB: BLOCK 3 ;BUFFER HEADER
TOB: BLOCK 3 ;DITTO
JOBN: BLOCK 1 ;JOB #
USRPPN: BLOCK 1 ;USER PROJ-PROG #
MONITR: BLOCK 1 ;MONITOR LEVEL: 0=3,1=4,2=5
IBUF: BLOCK 3
OBF: BLOCK 3
IBUF1: BLOCK 2*
OBUF1: BLOCK 2*
EATCH: BLOCK 1 ;FOR LAST INPUT CHARACTER IN CASE ERROR OCCURS
DLIM: BLOCK 1
NUM: BLOCK 1
SYL: BLOCK 1
SARG: BLOCK 1
PDLSAV: BLOCK 1
VVAL: BLOCK 1 ;LENGTH OF LAST TEXT STRING PROCESSED
XFILNM: BLOCK 17
FILDEV: BLOCK 1 ;DEVICE SPECIFIED
FILPTH: BLOCK 2 ;DIRECTORY BLOCK
FILPPN: BLOCK 1
FILSFD: BLOCK 5 ;UP TO 5 SFD'S
SWITC: BLOCK 1 ;SWITCH BIT STORE (EACH BIT IS 1 SWITCH)
SPCDEV: BLOCK 2 ;FOR SAVING DEVICE LAST SPECIFIED
;(1 EXTRA WD FOR PATH. UUO)
SPCPPN: BLOCK 7 ;FOR SAVING PATH LAST SPECIFIED
SPCPRO: BLOCK 1 ;FOR SAVING PROTECTION
BAKNAM: BLOCK 2 ;FOR THE BACKUP NAME
PTHCNT: BLOCK 1 ;TO COUNT SFD'S
;***** DO NOT SEPARATE
ERSPEC: BLOCK 12 ;FOR DEFAULT ER FILE SPEC
EWSPEC: BLOCK 12 ;FOR DEFAULT EW FILE SPEC
;(SAME AS XFILNM ABOVE EXCEPT
;EWSPEC=DEVICE, EWSPEC+(4 - 9) = PATH
EISPEC: BLOCK 12 ;FOR DEFAULT INI FILE SPEC
;***** DO NOT SEPARATE
RUNIT: BLOCK 17 ;FOR RUN ON SOMETHING WHEN YOU EXIT
PRMERR: BLOCK 1 ;FOR PERMANENT ERROR BITS
LOGOPN: BLOCK 3 ;FOR LOG FILE OPEN BLOCK AND FLAG FOR APPEND
OLOG: BLOCK 3 ;BUFFER HEADER FOR LOG FILE
EEFL: BLOCK 4 ;BLOCK FOR STORING EE FILSPEC
LOGFL: BLOCK 4 ;FOR LOG FILE FILESPEC
IINI: BLOCK 3 ;BUFR HEADER FOR INI FILES
LOGSPC: BLOCK BUFSIZ+3 ;RESERVE 200 WORDS IN CASE A LOG FILE IS DESIRED
OSAV: BLOCK 3 ;OUTPUT BUFFER HEADER FOR SAVE CHANNEL
STARTL: BLOCK 13 ;FOR GET SEG STUFF
EOFLAG: BLOCK 1 ;EDIT OLD FLAG
TYCASF: BLOCK 1 ;TYPE-OUT CASE FLAG: 0 = TYPE ' BEFORE LC
;+ = TYPE ' BEFORE UC;- = DON'T TYPE FLAGS
AUTOF: BLOCK 1 ;NON-ZERO IMPLIES AUTOTYPE AFTER SEARCHES
;POSITIVE IMPLIES TYPE AUTOF AS A PTR MARKER
IFN CRT,<
TTYWID: BLOCK 1 ;CURRENT LINE WIDTH
CRTTYP: BLOCK 1 ;TYPE OF CRT IN USE
BACRUB: BLOCK 1 ;AUXILLARY DELETE CHAR, RIGHT JUSTIFIED
VTWID: BLOCK 1 ;WIDTH OF VERTICAL TAB
FFWID: BLOCK 1 ;WIDTH OF FORM FEED
VTMUL: BLOCK 1 ;MULTIPLIER FOR DELVT
FFMUL: BLOCK 1 ;MULTIPLIER FOR DELFF
BACCHR: BLOCK 1 ;BACKSPACE CHARACTER SEQUENCE
FORCHR: BLOCK 1 ;NONDESTRUCTIVE FORWARD CURSOR, OR BLANK
BACSEQ: BLOCK 1 ;BACKUP AND DELETE SEQUENCE
DELLF: BLOCK 1 ;EOL RUBOUT STRINGS (LF, VT, FF)
DELVT: BLOCK 1
DELFF: BLOCK 1
DELCR: BLOCK 1 ;CARRIAGE RETURN RUBOUT STRING
CANRUB: BLOCK 1 ;STRING TO CANCEL RUBOUT
CANBAK: BLOCK 1 ;STRING TO CANCEL BACKSPACE
CTUSEQ: BLOCK 1 ;STRING TO PROCESS CONTROL-U
> ;END IFN CRT
OUTCH: BLOCK 1 ;ADR OF OUTPUT ROUTINE
INCH: BLOCK 1 ;ADR OF INPUT ROUTINE
OPNRI: BLOCK 1 ;INPUT FILE OPEN ARGUMENTS, OPNRD+4(1)
OPNR1: BLOCK 1 ;INPUT DEVICE. INIT+27(0),OPNRD+6
OPNRB: BLOCK 1 ;INITIALIZE TO XWD 0,INBUF. OPNRD+10
BAKTMP: BLOCK 1 ;FOR DECTAPE TEMP NAME
PROTEC: BLOCK 1 ;EB INPUT FILE PROTECTION
DEVSAV: BLOCK 1 ;DEVICE CHARACTERISTICS
EBDEV: BLOCK 1 ;EB DEVICE NAME
TMPTEC: BLOCK 1 ;SAVE FOR ###TEC. FILE NAME
BAKPRO: BLOCK 1 ;DESIRED PROTECTION FOR THE NEW FILE
OPNWI: BLOCK 1 ;OUTPUT FILE OPEN ARGUMENTS. OPNW1+4(1)
OPNWD: BLOCK 1 ;OUTPUT DEVICE. OPNW1+6
OPNWB: BLOCK 1 ;OUTBUT BUFFER HEADER ADDRESS. OPNW1+10(OUTBUF)
WRICHR: BLOCK 1 ;CHARACTERISTICS OF WRITE DEVICE
OUTFIL: BLOCK 4 ;STORE FOR OUTPUT FILENAME
INFILE: BLOCK 4 ;STORE FOR INPUT FILENAME
SWINDX: BLOCK 1 ;FOR SWITCH INDEX SCAN
SWITHL: BLOCK 1 ;SWITCH CHAR HOLD
INSWIT: BLOCK 1 ;INPUT SWITCHES
OUTSWT: BLOCK 1 ;OUTPUT SWITCHES
LSNCTR: BLOCK 1 ;LSN GENERATION CTR
CTGRET: BLOCK 1 ;RETURN ADDRESS FOR ^G ROUTINE
ARGTRM: BLOCK 1 ;FS, FN 2ND ARG TERMINATOR
COMBAK: BLOCK 1 ;STORE FOR COMCNT DURING FS, FN
CPTBAK: BLOCK 1 ;DITTO CPTR
SRHCNT: BLOCK 1 ;SEARCH COUNT STORE
;Search table stuff
; *** Do not separate vvv
SMATRX: BLOCK SMATLN ;The old TECO search bit table
BITMAT: BLOCK BITMLN*^D36 ;The new rotated search bit table
DELTA2: BLOCK ^D36 ;The table which knows what the pattern looks like
SCLRLN==.-SMATRX
; *** Do not separate ^^^
DELTA0: BLOCK SMATLN ;The tables which know where characters are
DELTA1: BLOCK SMATLN ; in the pattern
INDMAT: BLOCK ^D36 ;A table of indicies into the pattern
PATLEN: BLOCK 1 ;Number of positions in pattern
ROTLEN: BLOCK 1 ;Current distance from the right end of the pattern
SCNEST: BLOCK 1 ;Nest level counter during searches, 0 if none
SCHTYP: BLOCK 1 ;0 if old TECO search, -1 if new search
SCTLGA: BLOCK 1 ;0 if pattern source has no ^Gi, -1 if it does
CTGLEV: BLOCK 1 ;SEARCH FOR TEXT IN Q-REG NEST COUNTER
ITERCT: BLOCK 1
SFINDF: BLOCK 1
ERRDEV: BLOCK 1 ;[337] Device for TECO.ERR
ERRPPN: BLOCK 1 ;[337] PPN for TECO.ERR
ERRBLK: BLOCK 3 ;[337] OPEN block for TECO.ERR
TECERR: BLOCK 4 ;LOOKUP SPECS FOR TECO.ERR
ERRHDR: BLOCK 3 ;RING HEADER FOR TECO.ERR
RELSAV: BLOCK 1 ;STORE FOR .JBREL
ARGSTO: BLOCK 1 ;STORE FOR ARGUMENT (IF ANY)
ERR1: BLOCK 1
ERR2: BLOCK 1
COMLEN: BLOCK 1 ;LENGTH OF BASIC COMMAND STRING
LISTF5: BLOCK 1 ;OUTPUT DISPATCH
NROOM2: BLOCK 1 ;POINTER TO LAST PARTIAL WORD ON UPWARD MOVE.
GCRET: BLOCK 1 ;GC EXIT DISPATCH
NROOM4: BLOCK 1 ;PARTIAL WORD POINTER FOR DOWNWARD MOVE
BEG: BLOCK 1
PT: BLOCK 1
Z: BLOCK 1
QRBUF: BLOCK 1
;*** DO NOT SEPARATE ***
COMAX: BLOCK 1 ;TOTAL # OF CHARS AT CUR. CMD. LEVEL
CPTR: BLOCK 1 ;EXECUTION-TIME CMD STRING PTR
COMCNT: BLOCK 1 ;# OF CHARS REMAINING TO BE EXECUTED AT THIS LEVEL
;*** DO NOT SEPARATE ***
CBUFH: BLOCK 1
CBUF: BLOCK 1
MEMSIZ: BLOCK 1
IFN CCL,<
CCLSW: BLOCK 1
> ;END IFN CCL
GCPTR: BLOCK 1
CRREL: BLOCK 1
GCFLG: BLOCK 1
RREL: BLOCK 1
M23: BLOCK 1
M23PL: BLOCK 1
ERRLEN: BLOCK 1 ;TYPE OF ERROR MESSAGES WANTED BY DEFAULT
AC2: BLOCK 16 ;SAVE AC2-AC17 IN NROOM ROUTINE
STAB: BLOCK STABLN ;SEARCH MATRIX
DEFPTH: BLOCK 11 ;DEFAULT PATH
DCLOC: BLOCK 5 ;DSKCHR BLOCK
NFORMS: BLOCK 1 ;NUMBER OF FORM FEED SEEN
XCTING: BLOCK 1
BCOUNT: BLOCK 1
ETVAL: BLOCK 1 ;[331] ET VALUE
EBPROT: BLOCK 1 ;[333] BAK PROTECTION & 2 RENAME SWITCH
FDAEM: BLOCK 1 ;[333] FILE DAEMON PRESENCE IF NON-ZERO
EPISEQ: BLOCK 1 ;[337] Controls EI-EP LOOKUP sequence
LFCNT: BLOCK 1 ;[346] Line feed count for :nA command
;*********
EXTRAS: BLOCK 17 ;[331] AVAILABLE LOCATIONS SO LOW SEG
; DOESN'T HAVE TO CHANGE
;*********
SYMS: BLOCK 22 ;LIS+4(0),OG3+1,GC+3(0)
VALS: BLOCK 22 ;LIS+4(0),OG3+3,GC+3(0)
CNTS: BLOCK 22 ;LIS+4(0),OG3+2,GC+3(0)
SYMEND: BLOCK 0
EQM: BLOCK 1 ;LEVEL OF MACRO NESTING
SRHCTR: BLOCK 1 ;# OF CHARS IN SEARCH ARGUMENT (MUST PRECEDE SRHARG)
SRHARG: BLOCK ^D16 ;STORE FOR SEARCH ARGUMENT
PFL: BLOCK LPF+1
GCTAB: BLOCK GCTBL ;GCS3+4,GCM2+13
QTAB: BLOCK 45 ;Q-REGISTER TABLE
;USEA+1,PCNT+1
PDL: BLOCK LPDL+1
SAVEAC: BLOCK 2 ;THIS MUST BE IMMEDIATELY BEFORE SAVE!
LOWERB==SAVEAC+1
UPPERB==SAVEAC+2
SAVE: BLOCK 16 ;AC STORAGE FOR GC
SAV16: BLOCK 1
IFE BUGSW,<
CMDBFR: BLOCK 0 ;COMMAND BUFFER
> ;END IFE BUGSW
IFN BUGSW,<
CMDBFR: BLOCK 1
>;END IFN BUGSW
LOWEND==.-1
RELOC
LIT ;SO PATCH SPACE IS AT TOP OF HI-SEG
PATCH: END TECO