;	TECO-20		DEC Standard TECO for TOPS-10 and TOPS-20

;
;Feature tests
;
	IFNDEF TOPS20,TOPS20==1	;[16000] TOPS-20 JSYS's
	IFNDEF TOPS10,TOPS10==0	;[16000] TOPS-10 UUOS

	IFNDEF FTXTEC,FTXTEC==1
	IFNDEF FTXTCERR,FTXTCERR==TOPS20 ;[21000] No need to swap segs on 20


	SEARCH	JOBDAT,MACTEN,UUOSYM	;[366] DEFINE SYSTEMY THINGS
	IFN TOPS20, SEARCH MONSYM	;[21000] 20-Systemy things too

	SALL			; SUPPRESS MACRO EXPANSIONS

;Hiseg origin MOVED to allow lowseg to get bigger
	TWOSEGMENTS	640000	; THIS IS A TWO SEGMENT PROGRAM
	.HIGH.=: 640000		;[15000] Hiseg origin

	.DIRECTIVE	.XTABM	; TENEXY MACRO'S

	DEFINE	$TITLE(VTECO)<
IFN FTXTEC&FTXTCERR&TOPS20,<
	TITLE. 	TECO20,VTECO,DEC Standard TECO for TOPS-20
>
IFE FTXTEC&FTXTCERR,<
IFN FTXTEC&TOPS10 ,TITLE.	TECO10,VTECO,DEC Standard TECO for TOPS-10
IFN FTXTCERR,TITLE.	TECERR,VTECO,ERROR SEGMENT FOR TECO10
>>

;MAKE THE RIGHT TITLE

	$TITLE	3(25427)		; EDIT LEVEL 1-Oct-79

	SUBTTL	J KRUPANSKY/M CRISPIN/A Nourse/JWK/MRC/AWN
	SUBTTL	Introduction to TECO-10

; TECO-10 is a text editor for the DECsystem-10.  It conforms, for
; the most part, with the DEC TECO standard, making it largely 
; compatable with TECO-11 and TECO-8.  It is also largely upward-compatable
; with the "official" DECsystem-10 TECO.
;
; TECO-10 is adapted from XTEC, and has all of the features of XTEC,
; though some have had their names changed to conform to the standard.
;
; New features (not in XTEC) include:
;
;	W and :W	Display Window support
;	EQ and E%	dump mode I/O between qregisters and files
;	q-registers can have text and numerics simultaneously
;	ET and ED	compatable with TECO-11 and TECO-8, including
;			read-with-no-wait, control-C intercept,
;			read-with-no-echo, cancel ^O, detached flag ...
;	[ and ]		pass values through unchanged
;	m,nUq		does nUq and returns m as value
;	n:A		append n lines from input file
;	E*		do arbitrary TRMOP. to own terminal
;	nEJ commands	0EJ job #, 1EJ TTY #, 2EJ PPN
;	EK		cancel EB or EW
;	q-register ()	is the text buffer, can be shared with other q-regs
;
; The following XTEC commands have been renamed:
;
;	ENfilespec$	to	E=filespec$
;	EN$		to	E=/DELETE$
;	EDfilespec$	to	E&filespec$
;	n^U		to	nE#
;	EAfilespec$	to	EWfilespec/APPEND$ (both work for now)
;
; The history of XTEC follows...
;
;  XTEC IS BASED ON DIGITAL EQUIPMENT CORPORATION'S TECO WHICH
; WAS WRITTEN BY RC CLEMENTS/PMH/CAM.
;  MANY OF THE EXTERNAL CHANGES ARE BASED ON CHANGES MADE TO TECO
; AT STEVENS INSTITUTE OF TECHNOLOGY BY J POTOCHNAK AND G BROWN.
;
; XTEC.MAC WAS WRITTEN BY J KRUPANSKY/JWK, BEGINNING
; 12-AUG-74 AT THE COMPUTER CENTER OF STEVENS INSTITUTE OF TECHNOLOGY,
; HOBOKEN, NJ 07030.
;
; CODE FOR THE ^U, ^Y, EL, FD, <ARGS>M, AND <ARGS>EI COMMANDS, AS
; WELL AS THE /APPEND, /NOIN, /NONSTD, AND /NOOUT I/O SWITCHES
; WAS WRITTEN BY MARK CRISPIN AT THE CHEMISTRY AND CHEMICAL ENGINEERING
; DEPARTMENT OF STEVENS INSTITUTE OF TECHNOLOGY.
	SUBTTL	TABLE OF CONTENTS

;			TABLE OF CONTENTS
;
;
;			   SECTION			      PAGE
;    1. Introduction to XTEC..................................   1
;    2. TABLE OF CONTENTS.....................................   2
;    3. Revision History......................................   3
;    4. Assembly Parameters...................................   4
;    5. ASSEMBLY INSTRUCTIONS.................................   5
;    6. AC Definitions........................................   6
;    7. Macro Definitions.....................................   7
;    8. OPDEFs and Symbol Definitions.........................   8
;    9. Flag AC Bit Definitions...............................  11
;   10. Transfer Vector Table for Command Execution...........  12
;   11. Startup Initialization................................  13
;   12. Compile&Execute XTEC Option Line from DSK:SWITCH.INI..  16
;   13. COMPILE&EXECUTE DSK:XTEC.INI[,] if it exists..........  18
;   14. CCL Setup.............................................  19
;   15. Command Input Processor...............................  21
;   16. Read a Command String into the Command Buffer.........  22
;   17. Subroutines for Reading a Command String..............  24
;   18. Command String is Stored. Process it..................  25
;   19. Command Decoder Dispatch Table........................  26
;   20. COMPIL - Command Decoder and Compiler.................  27
;   21. Command Decoding and Compilation Routines.............  31
;   22. Command Decoding and Compilation Subroutines..........  57
;   23. EXECUT - Execute a Command............................  63
;   24. $CTM - TRACE MODE TYPE-OUT............................  65
;   25. $EH AND $EHS..........................................  66
;   26. $U AND $Q AND $INC....................................  67
;   27. $PUSH AND $POP........................................  68
;   28. $DEC AND $OCT AND $CNE AND $CNN AND $FFD..............  69
;   29. $UP AND $LOW AND CLRCAS AND $CX AND $CXS..............  70
;   30. $CNZ and $MES and $NA.................................  71
;   31. $CKC and $CHA and $CKD and $CKV and $CKW..............  72
;   32. $SEMF and $SEMZ and $SEM and $STOP....................  73
;   33. $R and $C and $J......................................  74
;   34. $KL and $L and $D.....................................  75
;   35. $TAB and $I and $NI and $L............................  76
;   36. $BS1 and $BS2.........................................  77
;   37. $TTC..................................................  78
;   38. $S and $N.............................................  79
;   39. $BAR..................................................  80
;   40. $BS and $FS...........................................  81
;   41. $TL and $T and $0TT...................................  82
;   42. $A and $P and $PW and $BP.............................  83
;   43. $Y and $CNP AND $CNY AND $CNU.........................  84
;   44. $XL...................................................  85
;   45. $G....................................................  86
;   46. FAIRET and SUCRET.....................................  87
;   47. $M....................................................  88
;   48. $EC and $ECS and $TTY.................................  89
;   49. $GTB and $PEK - GETTAB and PEEK.......................  91
;   50. $ER and $EW and $EF and $ED...........................  92
;   51. $EB...................................................  93
;   52. $EA...................................................  94
;   53. $EI...................................................  95
;   54. $EL AND $ELA..........................................  96
;   55. $EN...................................................  97
;   56. $EP...................................................  98
;   57. $EM and $EZ...........................................  99
;   58. $EE................................................... 100
;   59. $EG and $EX and MONRET................................ 101
;   60. SSTPSC - Prescan a Search String...................... 102
;   61. SSTGSM - Generate a Search Matrix..................... 104
;   62. SERCH and BSERCH - Perform a Search................... 111
;   63. SEARCH - The Actual Search Routine.................... 112
;   64. Command Execution Subroutines......................... 116
;   65. SETFSP - Fill in Defaults for a File Spec............. 122
;   66. SETRAD - Set the Adr of Read-a-Char Routine........... 124
;   67. SETWAD - Set Adr of Punch-a-Char Routine.............. 125
;   68. PUNBUF - Punch part of Input File..................... 126
;   69. PUNCH - Punch part of Text Buffer..................... 127
;   70. ASCPCH - Punch an ASCII Character..................... 128
;   71. SIXPCH - Punch a SIXBIT ASCII Character............... 129
;   72. OCTPCH - Punch an Octal Digit......................... 130
;   73. LSNPCH - Punch a Char and Turn on Bit35 for LSNS...... 131
;   74. GENPCH - Punch a Char and Generate LSNS............... 133
;   75. BAKCLS - Finish "EB" that is in Progress.............. 135
;   76. YANK and APPEND....................................... 137
;   77. ASCAPD - Read an ASCII Char........................... 139
;   78. SUPARD - Read a Char and Suppress LSNS................ 140
;   79. OCTAPD - Read an Octal Digit.......................... 141
;   80. SIXAPD - Read a SIXBIT ASCII Char..................... 142
;   81. MACRO - Compile and Execute a Macro................... 143
;   82. OPENRD - Select a File for Input...................... 145
;   83. OPENWR - Select a File for Output..................... 146
;   84. FILERD - Read a File into a Text Buffer............... 147
;   85. TYPEL and TYPE - Type part of Text Buffer............. 149
;   86. FILOPN - Open a Device and Setup Buffers.............. 150
;   87. FILLKP, FILENT, AND FILRNM - File LOOKUP/ENTER/RENAM.. 152
;   88. ERMT - Error Message Typeout.......................... 155
;   89. ERRTXT - Text of All Error Messages................... 158
;   90. GXXXXX - Character Input Routines..................... 159
;   91. LOGPCH - PUNCH A CHARACTER TO LOG FILE................ 167
;   92. CMDGCH AND CMDBCH - Get char from command buffer...... 168
;   93. TXXXXX - OUTPUT ROUTINES.............................. 169
;   94. MISCELLANEOUS ROUTINES................................ 175
;   95. QSTOR - Store a value/text-buffer in a Q-register..... 179
;   96. QGET - Return a Q-register............................ 181
;   97. QFIND - Find a Q-register in QTAB..................... 182
;   98. MKROOM - Make room for an arbitrary # of chars in ma.. 183
;   99. ADDBLK - Add a block to the Linked-List............... 186
;  100. REFBLK - Add one to the Reference Count for A BLOCK .. 187
;  101. DELBLK - Un-Reference a Block in Linked-List.......... 188
;  102. FNDBLK - Find a Block (given its id) in the Linked-L.. 189
;  103. SAVE AC ROUTINES...................................... 190
;  104. REQM - REQUEST MEMORY (CORE ALLOCATION)............... 191
;  105. RELM - RELEASE MEMORY................................. 192
;  106. GARCOL - GARBAGE COLLECTION ROUTINE................... 193
;  107. FIXREF - RELOCATE THE REFERNECES TO A DYNAMIC BLOCK... 195
;  108. EXPAND - Expand a Block of Core....................... 196
;  109. COMPRS - Compress a Block of Core..................... 198
;  110. SETSTK - INITIALIZE A DYNAMIC STACK................... 199
;  111. ADDPDL - Add a PDL to PDLTAB.......................... 200
;  112. DELPDL - Remove a PDL from PDLTAB..................... 201
;  113. FNDPDL - Find a PDL in PDLTAB......................... 202
;  114. APRTRP - APR Trap handler (POV Recovery).............. 203
;  115. UUOTRP - LUUO Handler................................. 205
;  116. REENTR - Reenter Processing (after ^C^C.REENTER)...... 206
;  117. ERRHAN - Error Handler................................ 207
;  118. ERCTY - TYPE LAST FEW COMMANDS AFTER AN ERROR......... 210
;  119. SAVPCM - SAVE LAST COMMAND STRING IN A Q-REGISTER..... 211
;  120. Phased Pure Low Segment Code.......................... 212
;  121. Impure Low Segment Data............................... 213
	SUBTTL	Revision History

;[301]	22-FEB-75	/JK - ^C START NO LONGER GETS ILL. MEM. REF.
;[302]	22-FEB-75	/JK - CHANGE EJ CMD TO ^G (FOR GETTABS AND PEEKS)
;[303]	22-FEB-75	/JK - MAKE PW CMD WORK
;[304]	22-FEB-75	/JK - NO ILL UUO IF NO OUTPUT FILE
;[305]	22-FEB-75	/JK - OLD FORM OF = AND == ARE NOW COMPATIBLE
;			      WITH DEC TECO. N,M= (AND ==) MEAN:
;			      N.LT.0 - TYPE A CRLF AFTER NUMBER
;			      N.EQ.0 - TYPE NOTHING AFTER NUMBER
;			      N.GT.0 - TYPE CHAR WHOSE CODE IS N AFTER NUMBER
;[306]	22-FEB-75	/JK - N^F RETURNS TTY#+^O200000 OF JOB N
;[307]	22-FEB-75	/JK - FIX BUG ABOUT ^R IN INSERTS
;[310]	22-FEB-75	/JK - MAKE ":" AND "@" THROW AWAY PREV. ARGS
;[311]	22-FEB-75	/JK - CHECK VERSION IF EE FILE
;[312]	22-FEB-75	/JK - PREVENT MACROS FROM USING MUCH CORE
;[313]	5-APR-75	/JK - PREVENT ?IO TO UNAS... WHEN "CONTINUE" IS
;				TYPED AFTER "EX$$"
;[314]	5-APR-75	/JK - MAKE BOUNDED SEARCHES WORK
;[315]	5-APR-75	/JK - PREVENT <LF><LF> IN SWITCH.INI FROM
;				CAUSING INFINITE LOOP
;[316]	5-APR-75	/JK - ADD SOME MORE PORTALS
;[317]	5-APR-75	/JK - MAKE ^C^C.REENTER PRESERVE THINGS
;[320]	10-APR-75	/MC - MAKE [311] WORK PROPERLY
;[321]	10-APR-75	/MC - FIX ^P
;[322]	10-APR-75	/MC - PREVENT MISSING CCL FILE, XTCERR FROM HALTING
;[323]	10-APR-75	/JK(MC) - FIX CRLF IN TRACE MODE
;[324]	10-APR-75	/JK(MC) - FIX SPACE BEFORE COMMAND BUG
;[325]	11-APR-75	/MC - EXTEND [316], CLEAN UP [320] AND [322]
;[326]	11-APR-75	/MC - PREVENT ILLEGAL UUO IF RUN XTCERR
;[327]	12-APR-75	/MC - N^Y YANKS TO PAGE N, ^Y= SAME AS ^P=
;[330]	14-APR-75	/MC - EL FILESPEC MAKES A LOG FILE
;[331]	14-APR-75	/MC - FIX UP ERROR TEXT
;[332]	15-APR-75	/MC - FIX TWO ARGS CARRYING TOO FAR IN ^G, ^T
;[333]	15-APR-75	/MC - N^U USETI'S TO BLOCK N ON INPUT FILE
;[334]	15-APR-75	/MC - /NONSTD OPENS DECTAPE IN NON-STANDARD MODE
;[335]	21-APR-75	/MC - FIX ?IO TO UNAS... WHEN USING EE & LOG FILES
;[336]	26-APR-75	/MC - ^G W/O AN ARGUMENT DOES A PJOB
;[337]	26-APR-75	/MC - FIX UP ERROR MESSAGE ?XTCBAK
;[340]	29-APR-75	/MC - GET DEFAULT PATH BY PATH., NOT GETPPN
;[341]	29-APR-75	/MC - IGNORE .BAK FILE ON OTHERS IN SEARCH LIST
;[342]	30-APR-75	/MC - [-] DOES A PATH., NOT A SETZM
;[343]	10-MAY-75	/MC - FIX HASH AT BEGINNING OF IMMEDIATE LINE TRACE
;[344]	13-MAY-75	/MC - ARGUMENTS CAN BE PASSED TO MACROS BY M
;[345]	13-MAY-75	/MC - EXTEND [344] FOR EI
;[346]	20-MAY-75	/MC - PREVENT ARGUMENTED MACROS FROM GOBBLING CORE
;[347]	6-JUN-75	/MC - USE MACTEN & UUOSYM RATHER THAN C
;[350]	18-JUN-75	/MC - FIX SAVEGET LOCS GETTING CLOBBERED(ST)
;[351]	18-JUN-75	/MC - FIX NNNEDT.TMP NOT BEING READ
;[352]	18-JUN-75	/MC - FIX MACRO RESULT GOING TOO FAR
;[353]	18-JUN-75	/MC - FIX "REENTER" FLAG IN COMMAND STRING
;[354]	18-JUN-75	/MC - FIX DOUBLE PAGES IN BAD ^P ARG
;[355]	18-JUN-75	/MC - FIX EB ON ANOTHER PPN GOING WRONG PLACE
;[356]	18-JUN-75	/MC - FIX EL/APPEND WITH NO LOG FILE
;[357]	18-JUN-75	/MC - FIX .JBCOR POP'ED INTO .JBSA IN "EE"
;[360]	18-JUN-75	/MC - FIX /SIXBIT IN OUTPUT
;[361]	18-JUN-75	/MC - FIX /SUPLSN CAUSING ILL MEM REF
;[362]	18-JUN-75	/MC - FIX ?XTCSRH ERROR TEXT
;[363]	18-JUN-75	/MC - FIX MISSING PORTAL IN "REENTR"
;[364]	18-JUN-75	/MC - FIX ?XTCERR W/ LOWER CASE FLAGGING
;[365]	3-JUL-75	/MC - FIX EB ON OTHERS IN SEARCH LIST
;[366]	3-JUL-75	/MC - USE JOBDAT & MACTEN MORE FULLY
;[367]	3-JUL-75	/MC - PATCH UP CCL CODE
;[370]	3-JUL-75	/MC - MAKE QI= WORK ON ASCII Q-REG
;[371]	3-JUL-75	/MC - MAKE EI LOOK ON TED: IF SPEC NOT OKAY
;[372]	3-JUL-75	/MC - FIX PPN SPEC OVERDEFAULTING ON [,]
;[373]	3-JUL-75	/MC - FIX BUG WITH ^^ AND ^R/^Q IN SEARCHES
;[374]	7-JUL-75	/MC - MAKE [370] WORK
;[375]	7-JUL-75	/MC - MAKE "START" DO A RESTART
;[376]	7-JUL-75	/MC - FIX SPURIOUS %XTCSEF ON OTHERS IN SL
;[377]	7-JUL-75	/MC - ADD FD <-- FIND AND DESTROY(!)
;[400]	4-AUG-75	/MC - FIX ILL MEM REF IN CCL(HOPEFULLY LAST)
;[401]	4-AUG-75	/MC - MAKE ">" THROW AWAY VALUE(TECO COMPATABLE)
;[402]	4-AUG-75	/MC - FIX "0-" BEING = 0 (I.E. :D-LT)
;[403]	4-AUG-75	/MC - FIX "-S" ALWAYS SUCCESSFUL(!)
;[404]	4-AUG-75	/MC - FIX NO "%XTCSEF" ON [-]
;[405]	4-AUG-75	/MC - FIX "?" RETURNING FROM XTCERR TO XTEC
;[406]	4-AUG-75	/MC - IMPLEMENT "EO" PROPERLY
;[407]	6-SEP-75	/MC - USE TITLE., PRETTY UP SOME CODE
;[410]	6-SEP-75	/MC - FIX :8^T ALWAYS FAILING
;[411]	29-OCT-75	/MC - FIX EH= RETURNING WRONG VALUE
;[412]	29-OCT-75	/MC - FIX P AT END OF FILE NOT ZEROING "."
;[413]	29-OCT-75	/MC - FIX EW TO DIRECTORY DEVICE AFTER EW
;				TO NON-DIRECTORY DEVICE TRYING TO
;				USE PPN 1 GREATER THAN IT SHOULD
;[414]	29-OCT-75	/MC - FIX EW TO NUL: GETTING %XTCSEF
;[415]	29-OCT-75	/MC - FIX [,] MEANING NOTHING!
;[416]	29-OCT-75	/MC - ALLOW "/" FOR % MESSAGES
;[417]	2-DEC-75	/MC - CLEAN UP CODE
;[420]	2-DEC-75	/MC - ADD ILLEGAL MEM REF TRAPPING
;[421]	2-DEC-75	/MC - [415] DID NOT WORK, REMOVE IT AND FIX ORIGINAL PROBLEM
;[422]	3-DEC-75	/MC - MAKE ERROR SEGMENT USE AN INDEX
;[423]	15-DEC-75	/MC - MAKE JWK HAPPY BY REMOVING ALTMODE CONVERSION
;[424]	1-JAN-75	/MC - REMOVE [423] (I WAS RIGHT AFTER ALL)
;[425]	1-JAN-75	/MC - FIX SFD HANDLING
;[426]	5-JAN-75	/MC - FIX MISSING ERROR TEXTS
;[427]	8-JAN-75	/MC MAKE ^U WORK IMMEDIATELY

;TECO10 EDIT HISTORY..


;[1000]	??-NOV-76	/AWN - FIX :EB AND :EL BLOWING UP
;[2000] 13-MAY-77	/AWN - MAKE ^C,REE STOP TYPING
;[3000] 13-MAY-77	/AWN - INSTALL RANDOM-ACCESS Q COMMAND
;[4000] 30-JUN-77	/AWN - FIX ERROR MESSAGES
;				AND MAKE :,@ NOT WIPE ARGUMENTS
;				AND SAVE BOTH MACRO ARGUMENTS
;			     AND TYPE ERROR MESSAGES INVOLVING SFD'S BETTER
;[5000] 12-JUL-77	/AWN - MAKE COMPIL NOT CLOBBER FLAGS
;			AND MAKE ARG FLAGS GET SHUT OFF WHEN ARGS USED
;			IN SEVERAL CASES WHEN THEY WEREN'T
;			ALSO FIX UP DPY PROCESSING.
;[6000] 4-AUG-77	/AWN - RANDOM ACCESS Q COMMAND BECOMES ^B
;[7000] 24-AUG-77	/AWN - AUTOMATIC MACRO EXECUTION AFTER COMMAND
;[10000] 14-JAN-78	/AWN - ^Q & ^D command (TRMOPs & Q reg compare)
;			And typing of ^L, BLISS symbol constituants
;			Plus about 4 months of random patches
;[11000] 9-Feb-78	/AWN - Allow window to supress echoing,
;			And Trace & ^A typeout to stop on REEnter
;[12000] 20-Jul-78	/AWN - Simultaneous text & numeric q registers
;			& allow text buffer to be accessed as q-register
;[13000] 26-Oct-78	/AWN - Fix numerous bugs that show up when
;			buffer size does not fit in 18 bits.
;			Put in additional display support,
;			^@,^\, new ED,FB,FZ,FH,FL,FC,FP,FF,:W,V,| commands
;[14000] 26-Jan-79	/AWN Make PDP-11 compatable: ^_ not operator
;			"R,^ER,2ED,FD changed to FK,allow non-special controls
;			OFO error, == unsigned, scope editing
;[15000] 28-Feb-79	/AWN More PDP-11 compatability stuff:
;			nA POP if out of range, nY NYA -nP NPA, EX NFO
;			CRLF after $$, 16ED for preserve . after SRH
;			Search in <> not always return value,
;			Fix passing of values to & from macros
;			E% for write q-register out in dump mode
;			EN changed to E^, EA to EW/APPEND,
;			FB to F0, FC to FX, FL to FY
;			Move special :W stuff to 17:W & above
;			Implement Harvard FB & FC bounded search
;			::S anchored search ::M compile only
;			Fixes to line editing, echoing
;			In search: ^A to ^EM, ^B to ^EB
;			W runs macro '[W]', :W out of range runs '[:W]'
;[16000] 8-Mar-79	/AWN - Fix PDP-11/PDP-8 compatability stuff:
;			Turn off echo when prompt happens
;			Fix n@I//	m,nPW	FR doing autotype if ES.ne.0
;			flush NTQ on "M" & "FQ" commands
;			make <Sfoo$;> not give error on failure
;			Make n^T & ^Atext^A typeout immediate
;			fix n^_		remove EN rename
;			fix range check on nA command, return -1 not POP
;			change remaining YNL error to YCA & fix yank protect
;			Make :G pretty print, put in ::G to print literally
;			give error on bad "E<char> commands
;			Put in ^B,	put in n:A, different :A
;			make n^T not return value, don't ignore nulls in macro
;			put in ::ER,::EB,::EI,::EW,::EE to set defaults
;[17000]		Make EO value 3. Put in 1ED mode, take out ^T mode
;			Fix truncate mode
;[20000]		Make EXPAND validate pointers before using them
;			Halt if CORE UUO that can't fail, does.
;[21000]		Make TECO-10 runnable on TOPS-20 (not fully JSYSized)
;			Swap args if in wrong order.
;			Fix ILM on delete from completely full buffer.
;			FIX BNF on E? command, and make it echo always
;			Also execute q(*EXIT) when EX or ^Z done
;			And force echo back on in case of error
;[22000]		Make q(*EXIT) execute before checking for NFO on EX
;			Teach EE command to write .EXE files
;			Make EB work in place by default
;			Make EB use same device for .TMP file as input file
;[23000]		FT command for setting tabs.
;			Escape OK as delimiter for long q-names
;			Make it work on TOPS-20
;[24000]		Make it work right on TOPS-20
;[25000]		Fix rub-outs and ^G's in GETCMD and flakey TABS
;			Fix I/O to unassigned ch in FILEWR

	SUBTTL	Assembly Parameters

	SHOW.	%%JOBDAT	; VERSION OF JOBDAT
	SHOW.	%%MACTEN	; VERSION OF MACTEN
	SHOW.	%%UUOSYM	; VERSION OF UUOSYM

	NDS.	C$PDLL,	200	; CONTROL PDL LENGTH
	NDS.	C$OBFL, 100	;[12000] Size of terminal output buffer
	NDS.	C$NREF,	4	; # REFERNECE WORDS FOR A DYNAMIC MEMORY BLOCK
	NDS.	C$PATL,	^D16	; SIZE OF THE PATCHING SPACE
	NDS.	C$GSIZ,	^D500	; HOW MUCH TO GROW BEFORE GARBAGE COLLECTING
	NDS.	C$CMDL,	^D100	; # WORDS IN INITIAL COMMAND BUFFER
	NDS.	C$SFDL,	5	; # NESTED SFDS ALLOWED IN FILESPECS
	NDS.	C$CODL,	^D100	; # WORDS TO ADD TO COMMAND BUFFER FOR CODE
	NDS.	C$NPDL,	^D7	; # PDLS THAT CAN BE OVERFLOW PROTECTED
	NDS.	C$TPDL,	^D30	; SIZE OF APRTRP TEMP CONTROL PDL
	NDS.	C$LPDL,	^D16	; SIZE OF TAG PDL
	NDS.	C$RPDL,	^D16	; SIZE OF TAG REFERENCE PDL
	NDS.	C$QRLN,	3*^D30	; 3 TIMES MIN # Q-REGISTERS
	NDS.	C$QPLN,	3*^D10	; 3 TIMES MIN SIZE OF Q-REGISTER PDL
	NDS.	C$NBUF,	2	; # BUFFERS FOR A DEVICE
	NDS.	C$TBLN,	^D1200	; INITIAL #WORDS IN MAIN TEXT EDITING BUFFER
	NDS.	C$FILB,	^D10	; N MEANS FILL BUFFER TILL (N-1)/N FULL
	NDS.	C$EUVL,	-1	; DEFAULT CASE FLAGGING FLAG VALUE
				; -1=NONE
				;  0=FLAG LOWER CASE
				; +1=FLAG UPPER CASE
	NDS.	C$BUFL,	^D128	; # WORDS IN A MONITOR BUFFER
	NDS.	C$BFHD,	3	; # WORDS IN A BUFFER HEADER
	NDS.	C$SRHL,	^D80	; # CHARS IN SEARCH TEXT
	NDS.	C$ERRS,	'TECERR' ; NAME OF THE ERROR SEGMENT
	NDS.	C$3NAM,	'TEC'	; 3 LETTER ABBREVIATION OF OUR NAME
				; USED FOR TEMP FILES,ETC.
	NDS.	C$SEXT,'EXE'	;[21000] Default save file extension
	NDS.	C$TPRV,	<177>	; PROTECTION CODE FOR TEMP FILES
	NDS.	C$CCNM,	'[CCL] ' ; MACRO NAME OF THE CCL COMMAND
				; SO WE CAN EXIT ON 'FNF'
	NDS.	C$EOVL, 3	;[406] DEFAULT "EO" VALUE OF THIS VERSION
	NDS.	C$MAXD,^D2000	;[15000] Larger than this isn't temporary
	NDS.	FTBSRO,1	;[16000] Accept backspace as rubout
	NDS.	FTPRIV,1	;[12000] Assemble priveleged operations
	NDS.	C$NTS,24	;[21000] This many TAB stops

	IFN TOPS10&TOPS20,<
	 PRINTX ?XTEC for TOPS-10 and TOPS-20, can't do both at once
	 PASS2
	 END
	>
	SUBTTL	ASSEMBLY INSTRUCTIONS

COMMENT!

TO GENERATE A PRODUCTION VERSION:

	.LOAD @XTEC
	.SSAVE
	.LOAD/COMP @XTCERR
	.SSAVE

TO GENERATE A VERSION WITH DDT:

	.DEBUG @XTEC
	.SAVE
	.DEBUG/COMP @XTCERR
	.SAVE

!;; END OF COMMENT
	SUBTTL	AC Definitions

F==	0			; FLAGS
T1==	1			; TEMP
T2==	T1+1			; TEMP
T3==	T2+1			; TEMP
T4==	T3+1			; TEMP
T5==	T4+1			; TEMP
X==	6			; SUPER TEMP (HARDLY EVER SAVED)
C==	7			; CHARACTER
N==	C+1			; NAME OR NUMBER OR WORD
M==	N+1			; MASK OR NUMBER OR WORD
L==	16			; ARG OR ARG POINTER
P==	17			; CONTROL PDP

; ACS USED IN COMMAND COMPILATION

CP==	12			; CODE GENERATION PDP
TAG==	13			; TAG STACK
REF==	14			; TAG REFERENCE STACK

; ACS USED IN COMMAND EXECUTION

PC==	TAG			; PC (IE: JSP PC,$$XX)
ARG==	REF			; ARGUMENT
VALUE==	15			; VALUE RETURNED BY A COMMAND
SARG==	L			; SECOND ARG
R==	CP			; RELOCATION REGISTER TO START
				; OF COMMAND BUFFER
	SUBTTL	Macro Definitions

; FOR - MACRO TO OPEN A CONDITIONAL IF ARG IS TRUE
;
; CALL:	FOR FTXXXX,<
; CLOSED BY: >;; END OF FOR FTXXXX

	DEFINE	FOR (WHO)
<IFE WHO,XLIST
 IFN WHO,<LIST
	SALL>
 IFN WHO,>

; NOTFOR - MACRO TO OPEN A CONDITIONAL IF ARG IS FALSE
;
; CALL IS:	NOTFOR	FTXXXX,<
; CLOSED BY:	>;; END NOTFOR FTXXXX

	DEFINE	NOTFOR (WHO)
<IFN WHO,XLIST
 IFE WHO,<LIST
	SALL>
 IFE WHO,>

; BIT - MACRO TO DEFINE SUCCESSIVE BIT POSITIONS
;
; BIT(VALUE) DEFINES THE INITAIL BIT POSITION (EG: BIT (1B0) )
; BIT() RETURNS NEXT BIT POSITION BEGINNING WITH INITIAL VALUE (EG: FOO=BIT)

	DEFINE	BIT (INIVAL)
<IFB <INIVAL>,<<1B<<BIT$$$==BIT$$$+1>-1>>>IFNB <INIVAL>,<BIT$$$==^L<INIVAL>>>

; INT - MACRO TO DEFINE SUCCESSIVE INTEGERS
;
; BIT(VALUE) DEFINES THE INITIAL INTEGER (EG: INT (0) )
; BIT() RETURNS NEXT INTEGER BEGINNING WITH INITIAL VALUE (EG: ONE= INT)

	DEFINE	INT (INIVAL)
<IFB <INIVAL>,<<<INT$$$==INT$$$+1>-1>>IFNB <INIVAL>,<INT$$$==INIVAL>>

; SKP - MACRO TO GENERATE A JRST OVER THE NEXT N INSTRUCTIONS
;
; SKP() IS EQUIVALENT TO "JRST .+2"
; SKP(N) IS EQUIVALENT TO "JRST .+1+N" AND SKIPS THE NEXT N INSTRUCTIONS

	DEFINE	SKP (N)
<IFB <N>,<JRST .+2>
IFNB <N>,<JRST .+1+N>>

; GEN - MACRO TO GENERATE A KEYWORD&DISPATCH TABLE
;
; GEN(XXX) GENERATES A TABLE AT ADR 'XXXTBL' WITH LENGTH 'XXXLTH'
; USER MUST DEFINE 'XXX' AS A MACRO:
;	DEFINE XXX
;<	PAIR	NAME,ADR,BITS
;	PAIR	LASTNM,ADRN,BITS>
; TO GENERATE THE TABLE:
;	GEN	(XXX); AT ADR 'XXXTBL' WITH LENGTH 'XXXLTH'

	DEFINE	GEN (TAB)
<DEFINE PAIR (NAME,ADR,BITS)<<SIXBIT/NAME/>>
TAB'TBL:
	XLIST
	TAB;;			; GENERATE KEYWORDS
TAB'LTH==.-TAB'TBL
	DEFINE	PAIR (NAME,ADR,BITS)<EXP BITS+ADR>
	TAB;;			; GENERATE DISPATCH TABLE
	LIST
	SALL
>

; STSTK - MACRO TO SETUP AN EXPANDABLE STACK

	DEFINE	STSTK (AC,LEN,REF)
<IFIDN <AC>,<P>,<MOVE P,[IOWD C$TPDL,TPDL]>
	MOVE	T1,[<REF,,LEN>]
	MOVEI	N,AC
	PUSHJ	P,SETSTK
>

; ECHO - O/S dependent macro to turn echo on or off

	DEFINE	ECHO	(STATE),<
	%STATE==0
	IFB <STATE>,<%STATE==1>
	IFIDN <STATE>,<ON>,<%STATE==1>
	FOR TOPS10,<SETSTS TTYC,300-<%STATE*200> >
	FOR TOPS20,<IFN %STATE,<PUSHJ P,ECON>
		    IFE %STATE,<PUSHJ P,ECOFF> >
	PURGE	%STATE >

;SKPECHO -- O/S-Dependant macro to skip if echo is ON

	DEFINE	SKPECHO(STATE),<
	IFB <STATE>,<...ST==1>
	IFNB <STATE>,<IFIDN <STATE>,<ON>,<...ST==1>
		      IFIDN <STATE>,<OFF>,<...ST==0>>
	IFN ...ST,<
	FOR TOPS10,<STATZ TTYC,IO.SUP>
	FOR TOPS20,<MOVE T1,OURTTY
		    RFMOD
		    TXNE T2,TT%ECO>
	>
	IFE ...ST,<
	FOR TOPS10,<STATO TTYC,IO.SUP>
	FOR TOPS20,<MOVE T1,OURTTY
		    RFMOD
		    TXNN T2,TT%ECO>
	>
	PURGE ...ST
	>

	SUBTTL	OPDEFs and Symbol Definitions

; ERROR - A MACRO TO GENERATE AN ERROR CALL LUUO

LUUERR==1			; LUUO OPCODE FOR 'ERROR'
	DEFINE	ERROR (CODE)
<	BYTE	(9)LUUERR(4)0(1)0(4)0(18)<E$'CODE==<''CODE''&777777>>>

; CERROR MACRO TO GENERATE ERROR CALL FOR POSSIBLE ":" COMMANDS

LUUCER==2			; LUUO OPCODE FOR 'CERROR'
	DEFINE	CERROR (CODE)
<	BYTE	(9)LUUCER(4)0(1)0(4)0(18)<E$'CODE==<''CODE''&777777>>>

; CERR1 - MACRO FOR LUUO CALL SAME AS 'CERROR' BUT POPS TOP OF STACK

LUUCR1==3			; LUUO OPCODE FOR 'CERR1'
	DEFINE	CERR1 (CODE)
<	BYTE	(9)LUUCR1(4)0(1)0(4)0(18)<E$'CODE==<''CODE''&777777>>>

; WARN - MACRO FOR LUUO TO TYPE A WARNING MESSAGE

LUUWRN==4			; LUUO OPCODE FOR 'WARN'
	DEFINE	WARN (CODE)
<	BYTE(9)LUUWRN(4)0(1)0(4)0(18)<W$CODE==<''CODE''&777777>>>

; CHKEO - MACRO TO JUMP IF A FEATURE IS DISABLED

LUUCEO==5			; LUUO OPCODE FOR 'CHKEO'
	DEFINE	CHKEO(NUM,ADR)
<	MOVE X,EOVAL
	CAIG X,NUM
	 JRST ADR
>
;<	<LUUCEO>B8+<NUM>B12+<Z ADR>>

; I/O CHANNELS

INP==	1			; INPUT CHANNEL
OUT==	2			; OUTPUT CHANNEL
LOG==	3			;[330] LOG CHANNEL
TTYC==	16			;[4000] TTY CHANNEL

; MISCELLANEOUS SYMBOLS

.CHSPC==040			; A SPACE CHAR
.CHLAB=="<"			; LEFT ANGLE BRACKET
.CHRAB==">"			; RIGHT ANGLE BRACKET
; SYMBOLS FOR Q-REGISTER ELEMENTS. INDEX BY ADR OF Q-REGISTER

Q$NAM==	0			; SIXBIT NAME OF Q-REGISTER
Q$BIT==	1			; MISCELLANEOUS BITS
	QB$REF==1B0		; RH contains address
	QB$BID==1B1		; RH contains buffer ID
Q$VAL==	2			; NUMERIC VALUE OF Q-REGISTER
Q$PTR==	Q$BIT			; LINKED-LIST ID FOR TEXT BUFFER

; INDICES INTO A DYNAMIC MEMORY BLOCK (RELATIVE TO FIRST DATA WORD)

B$1PTR==-C$NREF			; FIRST POINTER WORD
B$2PTR==B$1PTR+1		; SECOND POINTER WORD
B$3PTR==B$2PTR+1		; THIRD POINTER WORD
B$4PTR==B$3PTR+1		; FOURTH POINTER WORD [12000]
B$DATA==0			; FIRST DATA WORD

; INDICES INTO A TEXT BUFFER (RELATIVE TO FIRST DATA WORD)

T$PBUF==B$1PTR			; POINTER TO PREVIOUS BUFFER
T$NBUF==B$2PTR			; POINTER TO NEXT BUFFER
T$1REF==B$2PTR			; POINTER TO A STATIC REFERENCE
T$ACRF==B$3PTR			; POINTERS TO TWO AC REFERENCES
T$CCNT==B$DATA			; CHARACTER COUNT FOR BUFFER
T$RCNT==T$CCNT+1		; REFERENCE COUNT FOR BUFFER
T$BID==	T$RCNT+1		; BUFFER ID
T$BIT== T$BID			;[12000] bits in left half
   TB$CMP==400000,,0		;[12000] compiled
   TB$BUF==200000,,0		;[12000] this is the current text buffer
T$DATA==T$BID+1			; FIRST DATA WORD FOR TEXT BUFFER
; INDICES INTO A FILE SPEC BLOCK

	INT(0)			; INDICES START WITH ZERO
FS$FLG==INT			; FLAGS FOR FILE SPEC
	BIT(1B0)		; FLAG BITS START WITH ZERO
	FB$OPN==BIT		;[15000] This file is open
	FB$DEV==BIT		; DEVICE NAME SEEN
	FB$NAM==BIT		; FILE NAME SEEN
	FB$EXT==BIT		; FILE EXTENSION SEEN
	FB$PRV==BIT		; /PROTECT:<NNN> SEEN
	FB$PRJ==BIT		; PROJECT NUMBER SEEN
	FB$PRG==BIT		; PROGRAMMER NUMBER SEEN
	FB$PTH==BIT		; SOME SORT OF PATH SEEN
	FB$DDR==BIT		; DEFAULT DIRECTORY SEEN
	FB$SFD==BIT		; SFDS SEEN
	FB$EXE==BIT		; /EXECUTE
	FB$LSN==BIT		; /LSN - DO LSN PROCESSING
	FB$ASC==BIT		; /ASCII - DON'T DO LSN PROCESSING
	FB$SIX==BIT		; /SIXBIT - PROCESS A SIXBIT FILE
	FB$OCT==BIT		; /OCTAL - PROCESS A BINARY FILE
	FB$GEN==BIT		; /GENLSN - GENERATE LSN'S ON OUTPUT
	FB$SUP==BIT		; /SUPLSN - SUPPRESS LSN'S ON INPUT
	FB$APP==BIT		;[330] /APPEND - APPEND TO LOG FILE
	FB$NOO==BIT		;[330] /NOOUT - NO TYPEOUT IN LOG
	FB$NOI==BIT		;[330] /NOIN - NO TYPEIN IN LOG
	FB$NON==BIT		;[334] /NONSTD - NON STANDARD DECTAPE
	FB$DEL==BIT		;[15000] /DELETE for temp files
FB$$IO==FB$LSN!FB$ASC!FB$SIX!FB$OCT!FB$GEN!FB$SUP!FB$PRV!FB$APP!FB$NOO!FB$NOI!FB$NON!FB$DEL
				; THE I/O SWITCH BITS
FS$DEV==INT			; SIXBIT DEVICE NAME
FS$NAM==INT			; SIXBIT FILE NAME
FS$EXT==INT			; SIXBIT FILE EXTENSION
FS$PRV==INT			; PROTECTION, ETC.
FS$PTH==INT			; PATH
 FS$PPN==FS$PTH+2		; PPN
 FS$SFD==FS$PTH+3		; FIRST SFD
	FS$LTH==FS$SFD+C$SFDL	; LENGTH OF FILE SPEC BLOCK

; FAKE CHARACTERS FOR SEARCH MATRIX

$CHBEG==200			; SIGNALS MATCH WITH BEGINNING OF BUFFER
$CHEND==201			; SIGNALS MATCH WITH END OF BUFFER IF NO EOL AT END
$CHSPC==202			; SIGNALS MATCH WITH MULTIPLE SPACES/TABS

SRHLN==$CHSPC+1			; # WORDS IN SEARCH MATRIX
	SUBTTL	Flag AC Bit Definitions

	BIT	(1B0)		; PRIME THE BIT GENERATOR
F$CCL==BIT			; CCL ENTRY WAS MADE
F$GCN==BIT			; GARBAGE COLLECTION IS NEEDED
F$1RG==BIT			; AN ARGUMENT IS PRESENT (CDC)
F$2RG==BIT			; A SECOND ARG IS PRESENT (CDC)
F$TRC==BIT			; IN TRACE MODE
F$REF==BIT			; T3=ADRREF(NOT ID) FOR QSTOR ROUTINE (TEMP)
F$EOF==BIT			; END OF FILE REACHED
F$FFD==BIT			; FORM FEED AT END OF BUFFER
F$NTI==BIT			; GETCH ROUTINE IS NOT INPUTTING FROM USER'S TERMINAL
F$2CO==BIT			; END OF LINE CHAR SEEN
F$EOL==F$REF			; Last character read was an EOL
F$LSF==BIT			; LAST SEARCH FAILED
F$COL==BIT			; THIS IS A ":" COMMAND (TRAP ON ERRORS)
F$DTM==BIT			; DELIMITED TEXT MODE
F$DNC==BIT			; DOWNCASE ALL INPUT LETTERS
F$UPC==BIT			; UPCASE ALL INPUT LETTERS
F$UAR==BIT			; Up-arrow really is up-arrow
F$CNV==BIT			; DOWNCASE THE NEXT CHAR IF IT IS A LETTER
F$CVV==BIT			; DOWNCASE LETTERS TILL END OF STR OR FURTHER NOTICE
F$CNW==BIT			; UPCASE NEXT CHAR IF A LETTER
F$CWW==BIT			; UPCASE LETTERS TILL END OF STR OR FURTHER NOTICE
F$CNX==BIT			; EXACT SEARCH MODE
F$EXM==BIT			; EXACT SEARCH MODE CAUSED BY ^V OR ^W
F$EMA==BIT			; EXACT SEARCH MODE CAUSED BY ^\
F$CNN==F$REF			; PREVIOUS CHAR WAS ^N(SEARCH MATRIX GENERATION)
F$BPG==F$REF			; FIRST CHAR MATCHED WITH BEGINNING OF PAGE
F$MSR==BIT			; DOING MINUS SEARCH
F$NOF==BIT			; TEMPORARILY SUPPRESS CASE FLAGGING
F$URD==BIT			; A FILE IS OPEN FOR READING
F$UWR==BIT			; A FILE IS OPEN FOR WRITING
F$UBK==BIT			; "EB" IN PROGRESS
F$XXX==BIT			;reserved
F$CMP==BIT			; COMPILE TEXT BUFFER (USED BY "MACRO")
F$STB==BIT			; SUPPRESS NEXT CHAR IF A TAB (FOR LSNS)
F$LSN==BIT			; CURRENT INPUT FILE HAS LSNS
F$REE==BIT			;[317] STOP BEFORE EXECUTING NEXT CMD
F$LOG==BIT			;[330] LOG FILE IN USE

F$$RG==F$1RG!F$2RG!F$COL!F$2CO!F$DTM	; ARGUMENT FLAGS (CDC)
F$$TX==F$UAR!F$CNV!F$CVV!F$CNW!F$CWW!F$EXM!F$EMA!F$CNN ; TEXT MODE FLAGS
				; FOR TEXT INSERTION
F$$IO==F$URD!F$UWR!F$UBK!F$LOG	; I/O FLAGS
	SUBTTL ET Word (ETVAL) Bit Definitions

	ET$EXT==1		; EXACT TYPEOUT (TRADITIONAL USE OF ET)
	ET$DPY==2		; SCOPE
	ET$LC==4		;[12000] lower case
	ET$SUP==10		;[12000] NO ECHO
	ET$CCO==20		;[12000] cancel ^O
	ET$NST==40		;[12000] Non-blocking TTY input
	ET$DET==100		;[12000] Detach(ed)
	ET$ABO==200		;[12000] Abort on error
				;[12000] Teco has not prompted yet
	ET$TRN==400		;[12000] Truncate to TTY width
	ET$VTX==1000		;[12000] VT52/55/61
	ET$VT11==2000		;[12000] VT11 (GT40)
	ET$CCT==100000		;[12000] Trap ^C (reset if ^C typed)

;ED FLAGS...
;[12000]

	ED$UAR==1		;[12000] Uparrow in searches means uparrow
	ED$YOK==2		;[12000] Y & _ always OK
	ED$NOV==4		;[12000] Novice mode
	ED$SSF==20		;[14000] "." stays intact on search fail

	ED$BLI==40		;[12000] Symbol constituants: A-Z,0-9,$,%,_
	ED$LLL==100		;[12000] It's a line if it looks like a line

	ED$SKP==200000		;[12000] ^\ caused a skip
	ED$OPT==400000		;[12000] Optimize compilation

;DMODE bits
	DM$ACR==1		;Terminal does auto CRLF's (Linear addressing)
	DM$NL==2		;Terminal does <CR> also when <LF> typed out
	DM$INS==4		;Terminal is in INSERT mode
	SUBTTL	Transfer Vector Table for Command Execution

	DEFINE	TV (CMD)<$$'CMD: IFNDEF $'CMD,<PORTAL BEGIN>
IFDEF $'CMD,<PORTAL $'CMD>>; GEN A TRANSFER VECTOR

; CMDTVT - MACRO TO DEFINE THE COMMAND TRANSFER VECTOR TABLE
; ***** THIS TABLE SHOULD BE GENERATED BEFORE ANYTHING THAT COULD
;	POSSIBLY CHANGE (PREFERABLY AT START OF HISEG)

	DEFINE	CMDTVT<XLIST
	TV	(CTM)		; TYPE COMMAND IF IN TRACE MODE
	TV	(ER)		; SELECT FILE FOR INPUT
	TV	(EM)		; POSITION MAGNETIC TAPE
	TV	(EW)		; SELECT FILE FOR OUTPUT
	TV	(EZ)		; ZERO DIRECTORY AND SELECT FILE FOR OUTPUT
	TV	(EB)		; EDIT BACKUP
	TV	(RUNP)		; SETUP FILE TO BEW RUN ON EXIT
	TV	(EI)		; EXECUTE AN INDIRECT COMMAND FILE
	TV	(EQ)		; READ A FILE INTO Q-REGISTER
	TV	(EA)		; APPEND TO A FILE
	TV	(EE)		; SAVE STATE IN A RUNNABLE FILE
	TV	(EL)		;[330] MAKE A LOG FILE
	TV	(ELA)		;[330] ALTER LOG FILE PARAMERERS
	TV	(RENM)		; RENAME CURRENT INPUT FILE
	TV	(EH)		; RETURN MESSAGE LENGTH
	TV	(EHS)		; SET MESSAGE LENGTH
	TV	(GTB)		; GETTAB MUUO (N,M^G)
	TV	(PEK)		; PEEK MUUO (N^G)
	TV	(Y)		; CLEAR BUFFER AND INPUT ONE PAGE
	TV	(CNY)		;[327] YANK IN SPECIFIED PAGE
	TV	(USI)		;[333] USETI TO SPECIFIED BLOCK
	TV	(A)		; APPEND A PAGE
	TV	(J)		; MOVE POINTER TO ABSOLUTE POSITION
	TV	(C)		; ADVANCE POINTER N POSITIONS
	TV	(R)		; BACKUP POINTER N POSITIONS
				; EQUIVALENT TO -NC
	TV	(L)		; MOVE TO A LINE RELATIVE TO "."
	TV	(T)		; TYPE TEXT FROM BUFFER BETWEEN TWO POINTS
	TV	(TL)		; TYPE N LINES FROM BUFFER
	TV	(0TT)		; TYPE CURRENT LINE IF LAST SEARCH SUCCEEDED
	TV	(DEC)		; TYPE THE DECIMAL INTEGER N
	TV	(OCT)		; TYPE THE OCTAL INTEGER N
	TV	(MES)		; TYPE A MESSAGE
	TV	(TTY)		;[306] RETURN TTY#+^O200000 OF JOB N
	TV	(FFD)		; TYPE A FORMFEED
	TV	(TTC)		; PERFORM ANY TTCALL
	TV	(D)		; DELETE CHARACTERS
	TV	(K)		; DELETE TEXT BETWEEN TWO POINTS
	TV	(KL)		; DELETE LINES OF TEXT
	TV	(I)		; INSERT TEXT
	TV	(NI)		; INSERT CHARACTER WITH THE ASCII VALUE N
	TV	(TAB)		; TAB INSERT (IE: INSERT <TAB> THEN TEXT
	TV	(BS1)		; INSERT THE ASCII REPRESENTATION OF DECIMAL N
	TV	(BS2)		; VALUE OF NUMBER TO RIGHT OF POINTER
	TV	(UP)		; TRANSLATE TO UPPER CASE
	TV	(CX)		; ^X - RETURN VALUE OF EXACT SEARCH MODE FLAG
	TV	(CXS)		; N^X - SET EXACT SEARCH MODE FLAG
	TV	(LOW)		; TRANSLATE TO LOWER CASE
	TV	(PW)		; OUTPUT THE CURRENT PAGE AND APPEND
				; A FORMFEED TO IT
	TV	(P)		; OUTPUT CURRENT PAGE
	TV	(BP)		; OUTPUT PART OF CURRENT PAGE (WITHIN BOUNDS)
	TV	(CNP)		; POSITION TO A PAGE IN FILE
	TV	(EF)		; CLOSE THE OUTPUT FILE
	TV	(CNZ)		; CLOSE THE OUTPUT FILE AND EXIT
	TV	(EX)		; OUTPUT REMAINDER OF FILE AND EXIT
				; EXIT TO THE MONITOR
	TV	(EG)		; "EX" AND DO LAST COMPILE-CLASS COMMAND
	TV	(S)		; SEARCH FOR A STRING ON CURRENT PAGE
	TV	(BS)		; BOUNDED SEARCH
	TV	(FS)		; CHANGE STR1 TO STR2 ON CURRENT PAGE
	TV	(N)		; SAME AS "S" BUT USE REST OF FILE
	TV	(BAR)		;SAME AS "N" BUT DON'T OUTPUT
	TV	(SEM)		; JUMP OUT OF CURRENT ITERATION
	TV	(SEMF)		; JUMP OUT OF CURRENT ITERATION IF LAST SEARCH FAILED
	TV	(SEMZ)		; JUMP OUT OF CURRENT ITERATION IF ARG IS ZERO
	TV	(CKC)		; CHECK IF ARG IS A SYMBOL CONSTITUENT
	TV	(CKA)		; CHECK IF ARG IS A LETTER
	TV	(CKD)		; CHECK IF ARG IS A DIGIT
	TV	(CKV)		; CHECK IF ARG IS A LOWER CASE LETTER
	TV	(CKW)		; CHECK IF ARG IS AN UPPER CASE LETTER
	TV	(U)		; STORE INTEGER IN Q-REGISTER
	TV	(Q)		; RETURN VALUE STORED IN Q-REGISTER
	TV	(INC)		; INCREMENT Q-REGISTER BY 1 AND RETURN VALUE
	TV	(X)		;EXTRACT TEXT FROM TEXT BUFFER
	TV	(XL)		; STORE LINES FROM BUFFER INTO Q-REGISTER
	TV	(G)		;GET TEXT FROM A Q-REGISTER
	TV	(M)		; EXECUTE THE TEXT IN A Q-REGISTER
				; AS A COMMAND STRING
	TV	(PUSH)		; PUSH CONTENTS OF A Q-REGISTER ON QPDL
	TV	(POP)		; POP QPDL INTO A Q-REGISTER
	TV	(NA)		;VALUE OF CHAR FOLLOWING POINTER
				; POINTER
	TV	(CNE)		; RETURN VALUE OF THE FORMFEED FLAG.
	TV	(CNN)		; RETURN VALUE OF THE END-OF-FILE FLAG
	TV	(STOP)		; <ALT><ALT> (IE: STOP EXECUTION)
	TV	(EC)		; Maybe output all and RETURN LOWSEG SIZE IN WORDS
	TV	(ECS)		; SET THE LOWSEGMENT SIZE
	TV	(QRX)		;[3000] R/A Q REGISTER CMD
	TV	(QCM)		;[10000] Q-register compare
	TV	(TRMO)		;[10000] TRMOP.'s
	TV	(EXE)		;[12000] Execute instruction
	TV	(EY)		;[12000] EY always , Y only if buffer empty
	TV	(STQ)		;[12000] store in q-register
	TV	(CNQ)		;[12000] # of chars in next n lines
	TV	(E)		;[12000] Go to end of nth line
	TV	(CNU)		;[12000] Insert to q-register
	TV	(EK)		;[12000] Flush output file, cancel EB
	TV	(V)		;[12000] Type n lines either side of .
	TV	(W)		;[12000] window manipulation
	TV	(COLW)		;[12000] manipulate window parameters
	TV	(ETS)		;[12000] Set ET flags
	TV	(EJ)		;[12000] Set or retrieve system stuff
	TV	(FOUT)		;[12000] Force all tty output out
	TV	(TCHR)		;[12000] Type a character on current TTY
	TV	(FF1)		;[12000] Adjust FL & FC
	TV	(FF2)		;[12000] Adjust FL & FC
	TV	(EBAR)		;[14000] E_ (like _ but always legal)
	TV	(CKR)		;[14000] Check for alphanumeric
	TV	(EPCT)		;[14000] E% cmd (write out from q-register)
	TV	(BSL)		;[14000] nFB, nFC line mode bounded search
	TV	(CW2)		;[15000] m,n:W
	TV	(GETC)		;[15000] E?q get cmd into q-register
	TV	(GCHR)		;[16000] ^T Get a character
	TV	(AL)		;[16000] Append a few lines of text
	LIST
	SALL>

;THESE INSTRUCTIONS MUST BE THE FIRST DATA WORDS IN HISEG

$EECON:
FOR TOPS10,<
XTCERR:
>
FOR FTXTEC,	PORTAL	$EECNT		;[325] CALL EE CONTINUE
FOR FTXTCERR,< NOTFOR FTXTEC,<
	PORTAL	ERMT		;[325] CALL ERROR ROUTINE
>>
FOR FTXTEC!FTXTCERR,SALL		;[410] RESTORE LISTING

; GENERATE THE COMMAND TRANSFER VECTOR TABLE HERE

FOR FTXTEC,<
	CMDTVT
	SUBTTL	Startup Initialization

XTEC:	PORTAL	.+2		; ENTRY POINT FOR NORMAL ENTRY
	 PORTAL	.+2		; ENTRY POINT FOR CCL ENTRY
	TDZA	T1,T1		; THIS IS THE NORMAL ENTRY POINT
	 MOVX	T1,F$CCL	; THIS IS THE CCL ENTRY POINT

; CLEAR IMPURE LOW SEGMENT DATA

	FOR TOPS10,RESET	;[20000] Make sure .JBFF get set up!
	STORE	(T2,LOWBEG,LOWEND,0)

; INITIALIZE PURE LOW SEGMENT CODE

FOR TOPS10,<
	MOVE	T2,[<HICODE,,LOCODE>] ; SETUP BLT POINTER
	BLT	T2,LOCEND	; BLT CODE TO LOWSEGMENT

; STORE INFORMATION ABOUT WHERE WE CAME FROM

	MOVEM	.SGNAM,GSGNAM	; STORE OUR NAME
	MOVEM	.SGNAM,SEGNAM	; (DITTO)
	TLNN	.SGPPN,777777	;[15000] Could this be a path block
	 JRST	[JUMPE .SGPPN,	[MOVE X, [.PTMAX,,GSGPAT] ;nothing
				 SETOM GSGPAT+.PTFCN ;so read default
				 PATH. X, ; if we can
				  JRST	[GETPPN .SGPPN ;do best we can
					  JFCL ;The useless JACCT skip
					 JRST .+1] ;back to main code
				 JRST PTPPPZ] ;We have the path block...
		 MOVSI X,-.PTMAX ;- # of words to copy
		 HRLI .SGPPN,(<MOVE T2,0(X)>) ;Make into MOVE T2,75(X)
	PTPPPL:! XCT	.SGPPN	; Fetch first word
		 MOVEM T2,GSGPAT(X) ;and store it
		 AOBJN X,PTPPPL	; Back for more if any left
	PTPPPZ:! MOVEI .SGPPN,GSGPAT ;Put addr of path block in PPN place
		 JRST .+1]	; Back to main code
	MOVEM	.SGPPN,GSGPPN	; STORE OUR DIRECTORY
	MOVEM	.SGDEV,GSGDEV	; STORE OUR DEVICE
	MOVEM	.SGLOW,GSGLOW	; SAVE OUR LOW FILE EXTENSION
>;END IFN TOPS10

; INITIALIZE FLAGS

	MOVE	F,T1		; T1 HAS CCL ENTRY FLAG

; RELEASE EXTRA CORE

$XTEC:	MOVE	X,.JBFF		;[375] FETCH FIRST FREE ADR
	MOVEM	X,HEAD		; DYNAMIC FREE CORE WILL START THERE
	MOVEI	T1,(X)		; SAVE THE ADR
	CORE	X,		; TELL MONITOR EXACTLY HOW MUCH CORE WE NEED
	 HALT	.+1		;[20000] Shouldn't occur
	SETZM	(T1)		; FIRST FREE LOC MUST BE ZERO
				; (FOR THE CORE MANAGEMENT ROUTINES)

; SETUP APR TRAP ADDRESS

	MOVEI	X,APRTRP	; FETCH ADR OF APR TRAP HANDLER
	MOVEM	X,.JBAPR	; AND STORE IN JOBDAT WHERE MONITOR CAN SEE IT

; ENABLE FOR APR POV & ILM TRAPS

	MOVX	X,AP.REN!AP.POV!AP.ILM	; ENABLE FOR PDL OV AND ILL MEM REF AGAIN AND AGAIN
	APRENB	X,		; TELL THE MONITOR TO ENABLE THE APR FOR US
; SETUP ADDRESS OF LUUO HANDLER

	MOVE	X,[PUSHJ P,UUOTRP] ; LUUOS WILL CAUSE PUSHJ TO UUOTRP
	MOVEM	X,.JB41		; STORE INSTRUCTION IN JOBDAT

; SETUP ADDRESS OF REENTER HANDLER (FOR ^C^C.REENTER)

	MOVEI	X,REENTR	; FETCH ADR OF REENTER HANDLER
	MOVEM	X,.JBREN	; AND STORE IT IN JOBDAT WHERE MONITOR WILL SEE IT
	MOVEI	X,RESTRT	;[375] LOAD RESTART ADR
	HRRM	X,.JBSA		;[350] SO SAVEGET DOESN'T GET CLOBBERED

; SETUP TEMPORARY CONTROL PDP

	MOVE	P,[IOWD C$TPDL,TPDL] ;[301] SETUP TEMP PDP

; INITIALIZE THE MAIN TEXT EDITING BUFFER

	MOVEI	L,TXTBUF	; FETCH ADR OF REFERENCE TO IT
	PUSHJ	P,RELM		; deallocate
	MOVE	L,[<TMPREF,,C$TBLN>] ; ARG FOR ALLOCATING TEXT BUFFER
	PUSHJ	P,REQM		; ALLOCATE THE TEXT BUFFER

	MOVE	X,TMPREF	;[12000] Save address of buffer
	MOVEM	X,TXTBUF	;[12000]
	MOVEI	L,TXTBUF	;[12000]
	HRRM	L,B$4PTR(X)	;[12000] Put addr of ref in safer place
	HLLZS	B$1PTR(X)	;[12000] & zap the old one

	MOVEI	L,TMPREF	;[12000] Now add to linked list
	PUSHJ	P,ADDBLK	;[12000]

	MOVEI	X,NOOF		;[304] FETCH ADR FOR NO OUTPUT FILE ERROR
	MOVEM	X,PCHADR	;[304] TO PREVENT ILL. UUOS

; Open the TTY so we can control echoing

	PUSHJ	P,TTOPEN	;[12000]

; Set up prompts so that they will happen

	MOVX	X,<ASCIZ "*">	;[12000] This is a "*" to start with
	MOVEM	X,PROMPT	;[12000] put it in the prompt buffer

; Set up string to type after accepting command (initially CRLF)

	MOVSI	X,(BYTE (7) 15,12)	;[14000]
	MOVEM	X,TARCMD	;[14000] Make Stan Rabinowitz happy

; INITIALIZE CASE FLAGGING TO C$EUVL

IFE C$EUVL+1,<SETOM EUVAL>	; -1=FLAG NONE
IFE C$EUVL,<SETZM EUVAL>	;  0=FLAG LOWER CASE
IFE C$EUVL-1,<MOVEI X,1		; +1=FLAG UPPER CASE
	MOVEM	X,EUVAL>	; . . .

; SET UP DELIMITERS FOR TEXT AND COMMANDS

	MOVEI	X,33		;[12000] ESCAPEs to start with
	MOVEM	X,DELIM		;[12000] 1 for text
	MOVEM	X,CDELIM	;[12000] 2 for command delimiter
	MOVEM	X,CDELIM+1	;[12000] ...

;[12000] Initialize ET value

	MOVX	X,ET$ABO	;[12000] Abort flag starts out set
	MOVE	T1,OURTTY	;[12000] Check LC characteristic of terminal
	GETLCH	T1		;[12000] so we can set 4ET
	TXNE	T1,GL.LCM	;[12000] if it is set
	 TXO	X,ET$LC		;[12000] it was
	MOVEM	X,ETVAL		;[12000] ET is now initialized
	MOVX	X,<BYTE (7)40,10> ;[15000] Initialize character wiper-outer
	MOVEM	X,WIPEC		;[15000] so dpy mode will work, sort of

; INITIALIZE EO VALUE

	MOVEI	X,C$EOVL	;[3000] SET UP EO VALUE TO CURRENT
	MOVEM	X,EOVAL		;[3000]

; INITIALIZE "LAST" FILE SPECIFICATIONS

	MOVSI	X,'DSK'		; DEFAULT DEVICE IS 'DSK'
	MOVEM	X,LERSPC+FS$DEV	; FOR "ER" FILE-SPEC
	MOVEM	X,LEWSPC+FS$DEV	; AND LAST "EW" FILE-SPEC
	MOVEM	X,LEBSPC+FS$DEV	; AND LAST "EB" FILE-SPEC
	MOVEM	X,LEISPC+FS$DEV	; AND LAST "EI" FILE-SPEC
	MOVEM	X,LRPSPC+FS$DEV	; AND LAST "ED" FILE-SPEC
	MOVEM	X,LEESPC+FS$DEV	; AND LAST "EE" FILE-SPEC
	MOVEM	X,LELSPC+FS$DEV	;[330] AND LAST "EL" FILE-SPEC
	MOVE	X,SEGNAM	;[330] DEFAULT LOG NAME IS MY NAME
	MOVEM	X,LELSPC+FS$NAM	;[330] . . .
	MOVSI	X,'LOG'		;[330] DEFAULT LOG EXTENSION IS 'LOG'
	MOVEM	X,LELSPC+FS$EXT	;[330] . . .
	MOVSI	X,'TEC'		; FETCH DEFAULT EXT. FOR "EI"
	MOVEM	X,LEISPC+FS$EXT	; AND SET DEFAULT FILE EXT. FOR "EI"
	MOVSI	X,C$SEXT		; FETCH DEFAULT FILE EXT FOR SAVE FILE
	MOVEM	X,LEESPC+FS$EXT	; AND STORE FOR LATER

; INITIALIZE THE BYTE POINTER FOR MOVING LAST PARTIAL WORD IN 'MKROOM'

	MOVE	X,[POINT 0,-1(14),34] ; FETCH THE BYTE POINTER
	MOVEM	X,MKRMBP	; AND STORE FOR USE BY 'MKROOM'
; SETUP THE CONTROL PDL POINTER

	STSTK	(P,C$PDLL,PDL)	; SETUP THE CONTROL PDL POINTER

; SETUP Q-REGISTER TABLE (QTAB)

	STSTK	(QR,C$QRLN,QTAB)

; SETUP Q-REGISTER PUSHDOWN LIST (QPDL)

	STSTK	(QP,C$QPLN,QPDL)
	MOVE	X,QP		; FETCH THE PDP FOR QPDL
	PUSH	X,[<0>]		; AND PUSH 3 ZEROS TO MARK BEGINNING
	PUSH	X,[<0>]		; . . .
	PUSH	X,[<0>]		; . . .
	MOVEM	X,QP		; AND STORE THE UPDATED PDP

; SETUP OUR CCL JOB NUMBER (IE: '###XTC')

	PUSHJ	P,MAKCJN	; MAKE OUR CCL JOB NUMBER
				; AND STORE IN "CCJNAM"

; FETCH MESSAGE LENGTH

	GTMSG.	(X)		; GETTAB MESSAGE LENGTH
	MOVEM	X,EHVAL		; AND STORE FOR LATER

; STARTUP INITIALIZATION COMPLETE.
	SUBTTL	Compile&Execute XTEC Option Line from DSK:SWITCH.INI[,]

; SEE IF DSK:SWITCH.INI[-] EXISTS

	MOVE	N,[Z INP,0]	;  SETUP INPUT CHANNEL
	MOVEM	N,INPCHN	; . . .
	MOVEI	M,INIBH		; FETCH ADR OF INPUT BUFFER HEADER
	MOVEI	L,FILSPC	; FETCH ADR OF FILE-SPEC
	SETZM	FS$FLG(L)	; CLEAR FILE-SPEC FLAGS
	MOVSI	X,'DSK'		; DEVICE IS 'DSK'
	MOVEM	X,FS$DEV(L)	; . . .
	MOVE	X,['SWITCH']	; NAME IS 'SWITCH'
	MOVEM	X,FS$NAM(L)	; . . .
	MOVSI	X,'INI'		; EXTENSION IS 'INI'
	MOVEM	X,FS$EXT(L)	; . . .
;	GETPPN	X,		; GET OUR PPN
;	 JFCL			; (IN CASE OF JACCT)
;	MOVEM	X,FS$PPN(L)	; AND USE AS PPN FOR FILE
	SETZM	FS$PPN(L)	;[340] USE DEFAULT PATH FOR PPN
	SETZM	FS$SFD(L)	; CLEAR SFDS
	PUSHJ	P,FILOPN	; OPEN DSK:
	 JRST	NOSWI		; NO SWITCH.INI
	PUSHJ	P,FILLKP	; LOOKUP SWITCH.INI[-]
	 JRST	NOSWI		; NO SWITCH.INI

	MOVEI	X,[TXO F,F$EOF	; ADR OF WHERE TO GO ON EOF
		   MOVEI C,.CHESC
		   POPJ P,]
	MOVEM	X,INPEOF	; STORE ADR OF EOF PROCESSOR
	MOVEI	X,[ERROR (IES)]	; FETCH ADR OF WHERE TO GO ON INPUT ERROR
	MOVEM	X,INPERR	; AND STORE FOR LATER
	MOVEI	X,INIBH		; FETCH ADR OF BUFFER HEADER
	MOVEM	X,INPBH		; AND STORE FOR LATER
	TXO	F,F$NTI		; NOT INPUTTING FROM USER'S TERMINAL

; TRY TO FIND THE XTEC LINE IN SWITCH.INI

INI1:	PUSHJ	P,GSIX		; PICKUP NAME FROM SWITCH.INI LINE
	JUMPE	N,INI2		; NONE. IGNORE THIS LINE
	XOR	N,SEGNAM	; SEE IF IT IS THE XTEC LINE
	JUMPE	N,INI3		; YES
INI2:	PUSHJ	P,GEOL		; NO, EAT THE LINE
	TXZN	F,F$EOF		; END OF FILE?
	 JRST	INI1		; NO, KEEP SEARCHING FOR XTEC LINE
	JRST	NOSWI		; YES, THEN THERE IS NO XTEC LINE
; COPY THE XTEC LINE TO COMMAND BUFFER AND EXECUTE IT

INI3:	MOVEI	L,CURCMD	; FETCH ADR OF THE COMMAND BUFFER
	PUSHJ	P,RELM		; FREE IT
	MOVE	L,[<CURCMD,,C$CMDL+T$DATA>] ; ALLOCATE NEW COMMAND BUFFER
	PUSHJ	P,REQM		; . . .
	MOVE	T3,[POINT 7,T$DATA(T5)] ; SETUP BYTE POINTER TO CMD BUFFER
	MOVEI	T4,C$CMDL*5-2	; SETUP COUNT OF CHARS LEFT IN BUFFER

INI4:	PUSHJ	P,GCHR		; FETCH NEXT CHAR FROM SWITCH.INI
	MOVE	T5,CURCMD	; FETCH BASE ADR OF COMMAND BUFFER
	SOJL	T4,INI5		; BUFFER IS FULL
	AOS	(T5)		; COUNT THE CHAR
	IDPB	C,T3		; AND STORE IT IN THE BUFFER
	TXZN	F,F$EOL		; WHOLE LINE IN BUFFER?
	 JRST	INI4		; NO, FETCH ANOTHER CHAR

INI5:	MOVEI	C,.CHESC	; APPEND TWO ALTMODES TO LINE
	IDPB	C,T3		; . . .
	IDPB	C,T3		; . . .
	AOS	(T5)		; AND COUNT THEM
	AOS	(T5)		; . . .

; NOW COMPILE AND EXECUTE THE LINE

	MOVEI	L,CURCMD	; FETCH ADR OF COMMAND BUFFER
	PUSHJ	P,ADDBLK	; ADD THE BUFFER TO THE LINKED LIST
	MOVEM	N,CMDBID	; SAVE THE BUFFER ID
	MOVE	L,['[SINI]']	; GIVE THE BUFFER A NAME
	TXO	F,F$CMP		; FLAG TO "FORCE COMPILATION"
	PUSHJ	P,MACRO		; AND COMPILE&EXECUTE THE BUFFER
	MOVE	N,CMDBID	; RESTORE THE BUFFER ID
	PUSHJ	P,DELBLK	; AND DELETE THE BUFFER

NOSWI:;	JRST	INISET		; DO XTEC.INI IF IT EXISTS
	SUBTTL	COMPILE&EXECUTE DSK:XTEC.INI[,] if it exists

INISET:	MOVEI	L,FILSPC	; FETCH ADR OF FILE-SPEC

	SETZM	FS$FLG(L)	; CLEAR THE FILE-SPEC FLAGS
	MOVSI	X,'DSK'		; DEVICE IS 'DSK'
	MOVEM	X,FS$DEV(L)	; . . .
	MOVE	X,SEGNAM	; NAME IS NAME OF THIS SEGMENT
	MOVEM	X,FS$NAM(L)	; . . .
	MOVSI	X,'INI'		; EXTENSION IS 'INI'
	MOVEM	X,FS$EXT(L)	; . . .
;	GETPPN	X,		; GET OUR PPN
;	 JFCL			; (IN CASE OF JACCT)
;	MOVEM	X,FS$PPN(L)	; USE AS FILE PPN
	SETZM	FS$PPN(L)	;[340] USE DEFAULT PATH FOR PPN
	SETZM	FS$SFD(L)	; CLEAR SFDS
	SETZ	N,		; USE CHANNEL ZERO
	MOVEI	M,INIBH		; FETCH ADR OF INPUT BUFFER HEADER
	PUSHJ	P,FILOPN	; AND TRY TO FIND FILE
	 JRST	NOINI		; NOT THERE. NO XTEC.INI FILE
	PUSHJ	P,FILLKP	; TRY TO FIND FILE STILL
	 JRST	NOINI		; NOT THERE. NO XTEC.INI FILE
	RELEAS	0,		; RELEASE THE CHANNEL
	PUSHJ	P,FILERD	; AND READ THE FILE
	MOVEM	N,CMDBID	; SAVE THE BUFFER ID
	MOVE	L,['[XINI]']	; GIVE THE COMMAND A NAME
	TXO	F,F$CMP		; FORCE COMPILATION
	PUSHJ	P,MACRO		; AND COMPILE&EXECUTE THE MACRO
	MOVE	N,CMDBID	; RESTORE THE BUFFER ID
	PUSHJ	P,DELBLK	; AND DELETE THE BLOCK

NOINI:	RELEAS	0,		; RELEASE CHANNEL ZERO
;	JRST	CCLSET		; DO CCL SETUP IF NECESSARY
	SUBTTL	CCL Setup

CCLSET:	TXNN	F,F$CCL		; WAS CCL ENTRY MADE?
	 JRST	NOCCL		; NO

; TRY TO READ TMPCOR CCL FILE

	MOVE	T1,[<.TCRDF,,[EXP 'EDT   ',<IOWD 200,INPBF+3>]>]
				; SETUP TMPCOR ARG BLOCK
	TMPCOR	T1,		; TRY TO READ TMPCOR CCL FILE
	 JRST	CCLST1		; CAN'T. TRY DSK:###EDT.TMP[-]

; SETUP BYTE POINTER FOR TMPCOR BUFFER

	MOVE	X,[POINT 7,INPBF+3,6] ; POINT TO 2ND CHAR OF BUFFER
				; (TO IGNORE THE LINED "S")
	MOVEM	X,INPBH+1	; STORE THE BP IN INPUT BUFFER HEADER
	JRST	CCLST2		; AND FIND THE "TECO" COMMAND

; TRY TO READ DSK:###EDT.TMP

CCLST1:	INIT	INP,.IOASL	; INIT 'DSK'
	 ('DSK')		; . . .
	 <0,,INPBH>		; . . .
CCLERR:	 ERROR	(CCM)		; ** CCL COMMAND MISSING **
	MOVE	T1,CCJNAM	; AND LOOKUP ###EDT.TMP
	HRRI	T1,'EDT'	; . . .
	MOVSI	T2,'TMP'	; . . .
	SETZB	T3,T4		; . . .
	LOOKUP	INP,T1		;[351] . . .
	 ERROR	(CCM)		;[322] BALK
	MOVEI	T1,INPBF	;[400] LOAD ADDR OF INPUT BUFFER
	EXCH	T1,.JBFF	;[400] SWAP TO FOOL MONITOR
	INBUF	INP,C$NBUF	;[400] SET UP 1 BUFFER AT INPBF
	MOVEM	T1,.JBFF	;[400] RESTORE .JBFF
	INPUT	INP,		; INPUT DISK BUFFER
	IBP	INPBH+1		; AND SKIP OVER THE LINED "S"
	SETZ	T1,		;[367] ZERO FILENAME MEANS DELETE
	RENAME	INP,T1		;[367] DELETE IT
	 JFCL			;[367] SORRY HUN
	RELEAS	INP,		;[367] FREE CHANNEL

; READ FILE SPEC OF FORM SFILE-SPEC<ALT> OR SFILE-SPEC<CR>
;	(<ALT> MEANS DO "EW", <CR> MEANS DO "EB" AND "EY")

CCLST2:	MOVEI	L,CURCMD	; ALLOCATE COMMAND BUFFER
	PUSHJ	P,RELM		; . . .
	MOVE	L,[<CURCMD,,200>] ; . . .
	PUSHJ	P,REQM		; . . .
	MOVE	T3,CURCMD	; SETUP BYTE POINTER TO CMD BUFFER
	ADD	T3,[POINT 7,T$DATA,13] ; . . .
	MOVE	T5,T3		; SAVE BP TO THE "B" OF "EB"
	MOVSI	X,("EB"B13)	; SETUP FOR AN "EB" COMMAND
	MOVEM	X,(T3)		; . . .
	SETZ	T4,		; CLEAR THE CHAR COUNT
; PUT THE FILE-SPEC IN THE COMMAND BUFFER

CCLST3:	ILDB	C,INPBH+1	; FETCH CCL CHAR
	JUMPE	C,CCLERR	;[367] NULL IN CCL MEANS SOMETHING FUNNY
	CAIE	C,.CHALT	; IS CHAR AN OLD ALTMODE?
	 CAIN	C,.CHAL2	; (TRY ALL FLAVORS!)
	  MOVEI	C,.CHESC	; YES, CONVERT TO NEW STYLE <ALT>
	IDPB	C,T3		; AND PUT  IN COMMAND BUFFER
	CAIN	C,.CHCRT	; IS IT A <CR>?
	 JRST	CCLST4		; YES, FILE-SPEC IS COMPLETE
	CAIE	C,.CHESC	; IS IT <ALT>?
	 AOJA	T4,CCLST3	; NO, COUNT AND TRY NEXT CHAR

; SFILE-SPEC$ - COMMAND TO CREATE A FILE

	MOVEI	C,"W"		; CHANGE "EB" TO "EW"
	DPB	C,T5		; . . .
	JRST	CCLST5		; AND FINISH UP

; SFILE-SPEC<CR> - COMMAND TO "TECO" A FILE-SPEC

CCLST4:	MOVEI	C,.CHESC	; ADD AN <ALT> TO COMMAND
	DPB	C,T3		;[367] . . .
	MOVEI	C,"E"		; ADD "EY" TO READ IN FIRST PAGE
	IDPB	C,T3		; . . .
	MOVEI	C,"Y"		; . . .
	IDPB	C,T3		; . . .
	MOVEI	T4,3(T4)	; COUNT THE <ALT>EY

; APPEND <ALT><ALT> TO COMMAND AND EXECUTE IT

CCLST5:	MOVEI	C,.CHESC	; FETCH AN <ALT>
	IDPB	C,T3		; APPEND <ALT> TO COMMAND
	IDPB	C,T3		; AND ANOTHER FOR GOOD LUCK
	MOVEI	T4,3(T4)	; COUNT <ALT><ALT> PLUS TERM CHAR
	MOVEM	T4,@CURCMD	; STORE CHAR COUNT FOR BUFFER

	MOVEI	L,CURCMD	; FETCH ADR OF COMMAND BUFFER
	PUSHJ	P,ADDBLK	; ADD THE BUFFER TO THE LINKED LIST
	MOVEM	N,CMDBID	; SAVE THE BUFFER ID
	MOVX	L,C$CCNM	; GIVE THE CCL BUFFER A NAME
	TXO	F,F$CMP		; FLAG TO "FORCE COMPILATION"
	PUSHJ	P,MACRO		; AND COMPILE&EXECUTE THE BUFFER
	MOVE	N,CMDBID	; RESTORE THE BUFFER ID
	PUSHJ	P,DELBLK	; AND DELETE THE BUFFER

NOCCL:	TXZ	F,F$NTI		; INPUT FROM USER'S TERMINAL AGAIN
	SETZM	INPADR		; . . .
	SETZM	INPCHR		; . . .
;	JRST	BEGIN		; AND BEGIN NORMAL COMMAND PROCESSING
	SUBTTL	Command Input Processor

BEGIN:

; SETUP THE CONTROL PDL POINTER

	STSTK	(P,C$PDLL,PDL)	; SETUP CONTROL PDL

; [12000] Clear the abort flag if it was set

	MOVE	X,ETVAL		;[21000] Get ET
	TXZE	X,ET$SUP!ET$ABO	;[14000] Echoing supressed?
	 ECHO	ON		;[21000] turn it back on
	MOVEM	X,ETVAL		;[21000] Turn off 'supress' and 'abort'

; OUTPUT PROMPT

	TXZ	F,F$$RG!F$TRC	;[352] CLEAR ARG FLAGS [16000] AND TRACE
	SETZM	COL		;[23000] This is column 0
	SKIPG	INPCHR		; ALREADY HAVE FIRST CHAR?
	 PUSHJ	P,TSTAR		; NO, TYPE PROMPT

; CHECK FOR THE "*" COMMAND (IE: SAVE LAST COMMAND IN A Q-REGISTER)
BEGIN0:
	PUSHJ	P,GETCHL	; READ NEXT INPUT CHAR
	CAIN	C,"*"		; IS IT A "*"?
	 JRST	SAVPCM		; YES, SAVE PREVIOUS COMMAND IN Q-REGISTER
	MOVEM	C,INPCHR	; NO, SAVE THE FIRST CHAR OF COMMAND STRING

; RELEASE THE PREVIOUS COMMAND BUFFER

BEGIN1:	SKIPE	N,PCMBID	; A PREVIOUS COMMAND?
	 PUSHJ	P,DELBLK	; YES, DELETE ITS BUFFER
	MOVE	N,CMDBID	; NO, FETCH CURRENT BUFFER ID
	MOVEM	N,PCMBID	; AND SAVE AS BID FOR "PREVIOUS" COMMAND
	PUSHJ	P,GETCMD	;[12000] Call routine to get a command
	 JRST	BEGIN		;[12000] luser musta typed ^G^G
	MOVEI	N,TARCMD	;[14000] Type this After Reading CMD
	PUSHJ	P,TXSTR		;[14000]
	PUSHJ	P,FOUT		;[16000] Force it out now
	MOVX	X,ET$SUP	;[16000] See if echo should be supressed
	TDNE	X,ETVAL		;[16000] ...
	 ECHO	OFF		;[21000] Turn it off
	MOVE	N,CMDBID	;[14000] Get N back

;Now prepare to execute the command we got (BID is in N)

	MOVE	L,['[CCMD]']	; MAKE A NAME FOR THE CMD BUFFER
	TXO	F,F$CMP		; FLAG THAT BUFFER MUST BE COMPILED
	PUSHJ	P,MACRO		; AND COMPILE&EXECUTE THE CMD BUFFER
	TXZ	F,F$COL!F$2CO	;[15000] Clear left over colons

	SKIPN	N,QREG+<'!'*2>	;[23000] Try to get text of q!
	 JRST	BEGIN		;[7000] NOT TEXT SO GIVE UP
	MOVSI	L,'!  '		;[7000] AUTOMATIC MACRO NAME
	PUSHJ	P,MACRO		;[7000] DO THE MACRO
	JRST	BEGIN		; GO BACK FOR ANOTHER COMMAND
SUBTTL GETCMD -- Get a command string from current input source

; GETCMD - Get a command string from the current input source
;		routine allocates its own storage for commands
;
; CALL:	PUSHJ	P,GETCMD
;	<RETURN	1>		;user erased the command, just prompt
;	<RETURN 2>		;execute the command. BID is in N
GETCMD:

; ALLOCATE A NEW COMMAND BUFFER

	MOVE	L,[<CURCMD,,C$CMDL+T$DATA>] ; ARG FOR ALLOCATING BLOCK
	PUSHJ	P,REQM		; ALLOCATE NEW COMMAND BUFFER

	MOVEI	L,CURCMD	; FETCH ADR OF REF TO BUFFER
	PUSHJ	P,ADDBLK	; AND ADD THE BLOCK TO THE LINKED LIST
	MOVEM	N,CMDBID	; AND SAVE ITS BUFFER ID
	PUSHJ	P,FNDBLK	; "CURCMD" WILL REFERENCE THE BUFFER
	 ERROR	(BNF)		; CAN'T FIND BLOCK. SHOULDN'T OCCUR!

; SETUP CHAR COUNTS AND BYTE POINTER FOR COMMAND BUFFER

	SETZ	T5,		; ZAP THE CHAR COUNT
	MOVEI	T3,C$CMDL*5	; # CHARS WE CAN PUT IN BUFFER
	MOVE	T4,[POINT 7,T$DATA(T5)] ; BYTE POINTER
	TXO	F,F$NOF		; SUPPRESS CASE FLAGGING

; NOW READ COMMAND STRING

RDLOOP:	PUSHJ	P,GETCHL	; FETCH NEXT INPUT CHAR [12000] in line mode

RDLP0:
	TXZE	F,F$REE		;[20000] Did we ^C.REE?
	 JRST	RDEMP 		;[20000] Yes, start over
	FOR	FTBSRO,<CAIE	C,.CHCNH>	;BACKSPACE OK TOO
	CAIN	C,.CHDEL	; IS CHAR A RUBOUT?
	 JRST	RDRUB		; YES
	CAIN	C,.CHLFD	;[10000] Is this a linefeed
	 JRST	[SKPECHO	;[24000] check echoing
		  JRST .+1	;[14000] Leave screen position alone!
		 AOS T1,ROW	;[10000] Increment linefeed count
		 CAMGE T1,LENGTH ;[12000] Did it cause a scroll
		  JRST .+1	;[12000] NO, continue
		 AOSG SCFWD	;[12000] Yes, say so
		  SETZM ROW	;[12000] For terminals that go back to top
		 JRST .+1]	;[12000] Remember that we scrolled

	CAIN	C,.CHBEL	; IS CHAR A BELL(^G)?
	 JRST	RDBEL		; YES

	CAIN	C,.CHCNU	; IS CHAR A ^U?
	 JRST	RDCNU		; YES

; STORE THE CHAR IN COMMAND BUFFER BEFORE CHECKING FOR <ALT> OR ^R

	PUSHJ	P,RDIDPB	; STORE THE CHAR IN COMMAND BUFFER

	CAMN	C,CDELIM	; IS CHAR A DELIMITER?
	 JRST	RDCDEL		; YES

	CAIN	C,.CHCNR	; IS CHAR A ^R?
	 JRST	RDCNR		; YES

	JRST	RDLOOP		; ORDINARY CHAR. GO BACK FOR ANOTHER

; STORE CHAR IN COMMAND BUFFER

RDLP1:	PUSHJ	P,RDIDPB	; JAM THE CHAR INTO THE COMMAND BUFFER
	JRST	RDLOOP		; AND GO BACK FOR FOR INPUT

; RDRUB - PROCESS A RUBOUT

RDRUB:
	SKPECHO			;[24000] Skip if echo on
	 JRST	RDRB2		;[14000] Off, so don't type anything
	MOVE	X,ETVAL		;[16000] Check ET for DPY
	TRNN	X,ET$DPY	;[5000]
	 JRST 	RDRB1		;[5000] NOT
	MOVE	N,C		;[24000] Save our "RUBOUT"
	PUSHJ	P,RDLDB		;[5000] PICK UP THE CHARACTER
	 JRST	RDEMP1		;[23000] None left
	CAIN	N,177		;[5000] REALLY RUBOUT?
	 JRST	[MOVE N,C	;[25000] Remember rubbed-out char
		 MOVEI C,10	;[5000] YES SO DO BACKSPACE
		 PUSHJ P,TCHR	;[5000]
		 HRRZS COL	;[14000] Un-confuse cursor count
		 MOVE C,N	;[24000] Put back rubbed-out character
		 JRST .+1]	;[5000]
	CAIN	C,12		;[5000] LINEFEED IS SPECIAL
	   JRST [MOVEI N,RLF	;[12000] Get sequence for reverse LF
		 PUSHJ P,T0XSTR	;[5000] UNDO THE LINEFEED
		 PUSHJ P,RDDLDB	;[5000] LOOK AT PREVIOUS CHARACTER
		  JRST RDRTYP	;[5000] NONE, SO DON'T WORRY
		 CAIE C,15	;[5000] CARRIAGE RETURN?
		  JRST RDRTYP	;[5000] NO SO RETYPE LINE
		 PUSHJ P,TCHR	;[5000] TYPE IT
		 JRST RDLOOP]	;[5000] BACK FOR MORE
	CAIGE C," "		;[5000] CONTROL CHAR?
	 JRST	[PUSHJ P,RDDLDB	;[5000] NOW BACK UP
		  JFCL		;[5000] IGNORE ERROR
		 JRST RDRTYP]
	MOVEI	N,WIPEC		;[5000] SPACE,BACKSPACE
	PUSHJ	P,T0XSTR	;[5000]
	SOS	COL		;[14000] Tell screen processor we backed up
	PUSHJ	P,RDDLDB	;[5000] NOW BACK UP
	 JFCL			;[5000] NOTHING LEFT?
	JRST	RDLOOP		;[5000] DONE
RDRB1:				;[5000] LABEL ADDED
	PUSHJ	P,RDLDB		;[5000] GET THE RUBBED OUT CHARACTER
	 JRST	RDEMP		;[5000] NONE THERE
	PUSHJ	P,TCCHR		; ECHO THE RUBBED OUT CHAR
RDRB2:	PUSHJ	P,RDDLDB	;[5000] RUB IT OUT
	 JRST	RDEMP1		;[5000] NOTHING THERE
	JRST	RDLOOP		; GO BACK FOR MORE INPUT

; RDCNU - PROCESS ^U (KILL CURRENT LINE OF COMMAND BUFFER)

RDCNU:	MOVE	X,ETVAL		;[5000] SEE IF DPY
	TRNE	X,ET$DPY	;[5000]
	 JRST	[PUSHJ P,CLRLIN	;[5000] wipe the whole line out
		 JRST RDCNU1]	;[5000]
;[5000] XXX INSTEAD OF ^U
;	PUSHJ	P,TCCHR		; ECHO THE ^U
	MOVEI	N,[ASCIZ / XXX/] ;[5000]
	PUSHJ	P,TXSTR		;[5000]
	PUSHJ	P,TCRLF		; GO TO A NEW LINE
RDCNU1:				;[5000] LABEL ADDED
	PUSHJ	P,RDFLF		; FIND THE PREVIOUS LINEFEED CHAR
	 JRST	RDEMP1		; NOTHING LEFT
	JRST	RDLOOP		; FOUND LF. GO BACK FOR SOME MORE INPUT
; RDBEL - PROCESS ^G

RDBEL:
	SKPECHO	(OFF)		;[25000] Check echoing
	 PUSHJ	P,TCCHR		; ECHO "^G"
	PUSHJ	P,GETCH		; PICK UP CHAR THAT FOLLOWS THE ^G
	CAIN	C,.CHSPC	; IS CHAR A SPACE?
	 JRST	RDRTYP		; YES, RETYPE CURRENT LINE
	CAIN	C,.CHBEL	; IS CHAR ANOTHER ^G?
	 JRST	RDKILL		; YES, KILL ENTIRE COMMAND
	CAIN	C,"*"		; IS IT A * ??
	 JRST	[MOVE	T4,[POINT 7,T$DATA(T5)]
		 MOVE	T1,@CURCMD	;RETYPE ENTIRE COMMAND BUFFER
		 PUSHJ	P,TCRLF		;NEW LINE
		 PUSHJ	P,TSTAR		;[5000] TYPE A STAR TO START
		 JUMPE	T1,RDRTY2	;[10000] go away if buffer empty
		 SETZM	@CURCMD		;ZERO LENGTH (IT WILL BE RESTORED)
		 JRST	RDRTY1]

; ^G IS JUST ANOTHER TEXT CHAR. STORE IT IN COMMAND BUFFER

	MOVEI	T1,(C)		; STORE THE CHAR THAT FOLLOWS THE ^G
	MOVEI	C,.CHBEL	; FETCH A ^G
	PUSHJ	P,RDIDPB	; STORE THE ^G IN COMMAND BUFFER
	MOVEI	C,(T1)		; FETCH THE CHAR THAT FOLLOWS THE ^G
	JRST	RDLP0		; AND SEE IF IT HAS SOME SPECIAL MEANING

; RDRTYP - ^G<SP> - RETYPE CURRENT LINE FROM COMMAND BUFFER

RDRTYP:	MOVE	T1,@CURCMD	; FETCH CURRENT CHAR COUNT FOR COMMAND BUFFER
	MOVE	X,ETVAL		;[5000] SEE IF DPY
	TRNE	X,ET$DPY	;[5000]
	 JRST	[PUSHJ P,CLRLIN	;[12000] Clear the whole line
		 JRST .+2]
	PUSHJ	P,TCRLF		; GO TO A NEW LINE
	PUSHJ	P,RDFLF		; FIND THE PREVIOUS LINE FEED
	 PUSHJ	P,TSTAR		;[5000] TYPE A STAR
	SUB	T1,@CURCMD	; MAKE A LOOP COUNT FOR RETYPING LINE
	JUMPE	T1,RDRTY2	; DONE IF NOTHING TO RETYPE

RDRTY1:	PUSHJ	P,RDILDB	; FETCH NEXT CHAR ON LINE
	PUSHJ	P,TPCHR		; AND TYPE IT [5000] PRETTILY
	SOJG	T1,RDRTY1	; LOOP FOR ALL CHARS ON LINE

RDRTY2:	JRST	RDLOOP		; DONE. GO BACK FOR SOME MORE INPUT

; TSTAR - TYPE A PROMPT 

TSTAR:	MOVEI	N,PROMPT	;[5000] ROUTINE TO TYPE A STAR
	PUSHJ	P,T0XSTR	;[5000]
	MOVE	N,PROMSZ	;[14000] # of char positions used by prompt
	SOJA	N,UPDPRC	;[14000] Update cursor position & return

; RDKILL - ^G^G - KILL ENTIRE COMMAND BUFFER

RDKILL:
	PUSHJ	P,TCCHR		; ECHO THE SECOND ^G
RDEMP:	PUSHJ	P,TCRLF		; GO TO A NEW LINE
RDEMP1:	MOVE	X,CURCMD	; FETCH ADR OF BUFFER
	HRRZS	X,T$1REF(X)	; AND UNBIND FROM CURCMD
	SETZM	CURCMD		; UNBIND CURCMD FROM BUFFER
	MOVE	N,CMDBID	;[30000] Get back Buffer ID
	POPJ	P,		;[12000] nonskip return (don't execute)

; RDCDEL - SEE IF END OF COMMAND STRING

RDCDEL:	SKIPN	CDELIM+1	;[12000] Don't check if only 1 char delimiter
	 JRST	RDFIN		;[12000] it was
	PUSHJ	P,GETCH		; FETCH NEXT INPUT CHAR
	CAME	C,CDELIM+1	;[12000] Other char of delimiter?
	 JRST	RDLP0		; NO, SEE IF IT HAS ANY SPECIAL MEANING
	CAMN	C,DELIM		;[12000] Store if also text delim (FS$$)
	 PUSHJ	P,RDIDPB	; YES, STORE IT IN BUFFER
	JRST	RDFIN		; AND WE'RE DONE READING COMMAND STRING

; RDCNR - ^R - QUOTE THE NEXT CHAR

RDCNR:	PUSHJ	P,GETCH		; FETCH NEXT INPUT CHAR
	CAIE	C,.CHDEL	; IS IT A RUBOUT?
	 CAIN	C,.CHCNU	; OR A ^U?
	  JRST	RDLP0		; YES, CAN'T QUOTE RUBOUT OR ^U
	JRST	RDLP1		; NO, STORE THE QUOTED CHAR IN COMMAND BUFFER
SUBTTL	Subroutines for Reading a Command String

; RDIDPB - IDPB CHAR INTO THE COMMAND BUFFER

RDIDPB:	SOJL	T3,RDIDP1	; JUMP IF NO MORE ROOM IN BUFFER
	MOVE	T5,CURCMD	; FETCH BASE ADR OF COMMAND BUFFER
	IDPB	C,T4		; STORE THE CHAR IN IT
	AOS	@CURCMD		; COUNT THE CHARS IN COMMAND BUFFER
	POPJ	P,		; AND RETURN TO CALLER

; EXPAND THE COMMAND BUFFER

RDIDP1:	MOVEI	N,C$CMDL	; HOW MUCH TO EXPAND BY
	MOVEI	L,CURCMD	; ADR OF THE BUFFER REFERENCE
	PUSHJ	P,EXPAND	; EXPAND THE COMMAND BUFFER
	MOVEI	T3,C$CMDL*5	; CAN PUT THIS MANY MORE CHARS IN BUFFER
	JRST	RDIDPB		; CONTINUE WHERE WE LEFT OFF

; RDDLDB - DLDB LAST CHAR FROM COMMAND BUFFER

RDDLDB:	SKIPN	@CURCMD		; ANYTHING LEFT IN COMMAND BUFFER?
	 POPJ	P,		; NO, GIVE NON-SKIP RETURN
	ADD	T4,[<7B5>]	; BACK UP A BYTE
	JUMPG	T4,.+3		; OK
	 HRRI	T4,-1(T4)	; MUST BACK UP A WORD
	 HRLI	T4,(POINT 7,(T5),34) ; TO LAST BYTE IN PREVIOUS WORD
	SOS	@CURCMD		; DECREMENT THE CHAR COUNT
	MOVE	T5,CURCMD	; FETCH BASE ADR OF COMMAND BUFFER
	LDB	C,T4		; AND FETCH CHAR FROM BUFFER
	JRST	CPOPJ1		; GIVE SKIP RETURN TO CALLER

; RDLDB - LDB CHAR FROM COMMAND BUFFER

RDLDB:	SKIPN	@CURCMD		; ANYTHING IN BUFFER?
	 POPJ	P,		; NO, GIVE NON-SKIP RETURN TO CALLER
	MOVE	T5,CURCMD	; YES, FETCH BASE ADR OF COMMAND BUFFER
	LDB	C,T4		; FETCH CHAR FROM BUFFER
	JRST	CPOPJ1		; AND GIVE SKIP RETURN TO CALLER

; RDILDB - ILDB CHAR FROM COMMAND BUFFER

RDILDB:	MOVE	T5,CURCMD	; FETCH BASE ADR OF COMMAND BUFFER
	ILDB	C,T4		; FETCH NEXT CHAR FROM IT
	AOS	@CURCMD		; COUNT THE CHAR
	POPJ	P,		; AND RETURN TO CALLER

; RDFLF - FIND PREVIOUS LINEFEED IN COMMAND BUFFER

RDFLF:	PUSHJ	P,RDLDB		; FETCH CURRENT CHAR FROM COMMAND BUFFER
	 POPJ	P,		; NONE LEFT. GIVE CALLER NON-SKIP RETURN
	CAIN	C,.CHLFD	; IS CHAR A LINEFEED?
	 JRST	CPOPJ1		; YES, GIVE CSKIP RETURN TO CALLER
	PUSHJ	P,RDDLDB	; NO, BACK UP A CHAR
	 POPJ	P,		; NONE LEFT, GIVE NON-SKIP RETURN TO CALLER
	JRST	RDFLF		; KEEP LOOKING FOR THE PREVIOUS LF
	SUBTTL	Command String is Stored. Process it.

RDFIN:
	MOVE	X,CURCMD	; FETCH ADR OF REF TO BUFFER
	HRRZS	T$1REF(X)	; AND UNBIND THE REF
	SETZM	CURCMD		; AND ZERO "CURCMD"
	MOVE	N,CMDBID	; AND FETCH BUFFER ID FOR COMMAND BUFFER
	JRST	CPOPJ1		;[12000] Win return (go execute)
	SUBTTL	Command Decoder Dispatch Table

;[13000] Changed so that high segment origin can be raised above 400000
;	Note that it still cannot be lowered below 400000

	DEFINE	DSP(D1,C1,D2,C2)<EXP <C1+D1>,<C2+D2>>

D$JR== 1B1	; SIMPLE JRST DISPATCH
D$EJ== 0	; EVALUATE PRECEDING ARG AND THEN JRST


DSPTBL:	DSP	(D$JR,CDBPT,D$JR,CDCNA)	; ^@	^A
	DSP	(D$EJ,CDCNB,D$JR,CDCNC)	; ^B	^C
	DSP	(D$EJ,CDCND,D$JR,CDCNE)	; ^D	^E
	DSP	(D$EJ,CDCNF,D$EJ,CDCNG)	; ^F	^G
	DSP	(D$JR,CDCNH,D$EJ,CDTAB)	; ^H	TAB
	DSP	(D$JR,CDCCLR,D$JR,CDCCLR);LF	VT [5000] CLEAR FLAGS
	DSP	(D$JR,CDCNL,D$JR,CDCIGN); FF	CR [5000] ON <CR><LF><VT><ESC>
	DSP	(D$JR,CDCNN,D$JR,CDOCT)	; ^N	^O
	DSP	(D$EJ,CDCNP,D$EJ,CDCNQ)	; ^P	^Q
	DSP	(D$JR,CDERR,D$JR,CDCNS)	; ^R	^S
	DSP	(D$EJ,CDCNT,D$EJ,CDCNU)	; ^T	^U
	DSP	(D$EJ,CDCNV,D$EJ,CDCNW)	; ^V	^W
	DSP	(D$EJ,CDCNX,D$EJ,CDCNY)	; ^X	^Y
	DSP	(D$JR,CDCNZ,D$JR,CDALT)	; ^Z	^[
	DSP	(D$EJ,CDCBS,D$JR,CDERR)	; ^\	^]
	DSP	(D$JR,CDCUA,D$EJ,CDCBA)	; ^^	^_
	DSP	(D$JR,CDCIGN,D$JR,CDEXC); SPACE	! !Space no longer does +
	DSP	(D$EJ,CDQUO,D$EJ,CDOR)	; "	#
	DSP	(D$JR,CDCCLR,D$EJ,CDPCT); $	%
	DSP	(D$EJ,CDAND,D$JR,CDAPO)	; &	'
	DSP	(D$JR,CDLPA,D$EJ,CDRPA)	; (	)
	DSP	(D$EJ,CDMUL,D$EJ,CDADD)	; *	+
	DSP	(D$EJ,CDCOM,D$EJ,CDSUB)	; ,	-
	DSP	(D$JR,CDPT,D$EJ,CDDIV)	; .	/
	DSP	(D$JR,CDDIG,D$JR,CDDIG)	; 0	1
	DSP	(D$JR,CDDIG,D$JR,CDDIG)	; 2	3
	DSP	(D$JR,CDDIG,D$JR,CDDIG)	; 4	5
	DSP	(D$JR,CDDIG,D$JR,CDDIG)	; 6	7
	DSP	(D$JR,CDDIG,D$JR,CDDIG)	; 8	9
	DSP	(D$JR,CDCOL,D$EJ,CDSEM)	; :	;
	DSP	(D$EJ,CDLAB,D$EJ,CDEQU)	; <	=
	DSP	(D$JR,CDRAB,D$JR,CDQST)	; >	?
	DSP	(D$JR,CDATS,D$EJ,CDA)	; @	A
	DSP	(D$JR,CDB,D$EJ,CDC0)	; B	C
	DSP	(D$EJ,CDD,D$EJ,CDE)	; D	E
	DSP	(D$EJ,CDF,D$JR,CDG)	; F	G
	DSP	(D$JR,CDH,D$EJ,CDI)	; H	I
	DSP	(D$EJ,CDJ,D$EJ,CDK)	; J	K
	DSP	(D$EJ,CDL,D$EJ,CDM)	; L	M
	DSP	(D$EJ,CDN,D$JR,CDO)	; N	O
	DSP	(D$EJ,CDP,D$EJ,CDQ)	; P	Q
	DSP	(D$EJ,CDR,D$EJ,CDS)	; R	S
	DSP	(D$EJ,CDT,D$EJ,CDU)	; T	U
	DSP	(D$EJ,CDV,D$EJ,CDW)	; V	W
	DSP	(D$EJ,CDX,D$EJ,CDY)	; X	Y
	DSP	(D$JR,CDZ,D$JR,CDLSB)	; Z	[
	DSP	(D$EJ,CDBKSL,D$JR,CDRSB) ; \	]
	DSP	(D$JR,CDUAR,D$EJ,CDBAR)	; ^	_
	DSP	(D$JR,CDERR,D$JR,CDERR) ; `	{
	DSP	(D$JR,CDVBAR,D$JR,CDERR) ; |     }
	DSP	(D$JR,CDNOT,D$JR,CDERR) ; ~

CDERR:	ERROR	(ILL)		; ILLEGAL COMMAND

; PDL FLAGS

P$BEG==	0			; BEGINNING OF COMMAND STRING
P$PAR==	1			; LEFT PARENTHESIS
P$ITR==	2			; LEFT ANGLE BRACKET
P$CON==	3			; " FOR CONDITIONAL
	SUBTTL	COMPIL - Command Decoder and Compiler
; CALL:	MOVEI	L,COMMAND.BUFFER
;	PUSHJ	P,COMPIL
;	(RETURN)
;
; GENERATES CODE AT THE END OF THE COMMAND BUFFER
;
; T4 HOLDS RELATIVE ADDRESS OF LAST CALL TO $$CTM
;
; T5 HOLDS INSTRUCTION TO PERFORM ON TWO ARGUMENTS
;
; USEAS ACS X,T1-T5

COMPIL:	MOVEM	L,CMDBUF	; SAVE ADR OF REF TO COMMAND BUFFER

; SETUP CHAR COUNT AND BYTE POINTER FOR COMMAND BUFFER

	HRRZ	X,@(L)		; FETCH CHAR COUNT
	MOVEM	X,CMDCNT	; AND STORE FOR CMDGCH ROUTINE
	MOVE	X,[POINT 7,T$DATA(R)] ; FETCH BP
	MOVEM	X,CMDBP		; AND STORE FOT 'CMDGCH' ROUTINE

; SETUP FOR GENERATING CODE AT END OF COMMAND BUFFER

	MOVEI	N,C$CODL	; INITIAL SIZE OF CODE SPACE
	PUSHJ	P,EXPAND	; ADD TO EXISTING SIZE OF COMMAND BUFFER
	HRRZ	T1,@(L)		; FETCH CHAR COUNT FOR BUFFER
	IDIVI	T1,5		; CONVERT TO WORDS
	MOVEI	CP,T$DATA(T1)	; CP HAS RELATIVE ADR OF WHERE CODE
				; WILL START
	MOVE	N,[<C$CODL,,CP>] ; ADD CURCMD TO THE LIST OF OVERFLOW
	PUSHJ	P,ADDPDL	; . . .
	HRLI	CP,-C$CODL+1	; MAKE CP INTO A PDL POINTER

	MOVE	T1,(L)		; FETCH ADR OF BUFFER
	MOVEI	X,CP		; FETCH ADR OF "CP"
	MOVEM	X,T$ACRF(T1)	; AND BIND "CP" TO BUFFER
	ADD	CP,T1		; FIX UP AC CP

; INITIALIZE TAG AND TAG REFERENCE PDLS

	STSTK	(TAG,C$LPDL,TAGPDL) ; SETUP TAG PDL
	STSTK	(REF,C$RPDL,REFPDL) ; SETUP TAG REF PDL
	PUSH	REF,[<0>]	; PUSH TWO ZEROS ON TAG REF PDL
	PUSH	REF,[<0>]	; . . .

; INITIALIZE PDL FLAG FOR BEGINNING OF COMMAND STRING

	PUSH	P,[<P$BEG>]	; FLAG BEGINNING OF PDL

; INITIALIZE THE  INSTRUCTION IN T5

	MOVEI	T5,VALUE	; SETUP THE Y FIELD OF INST.

; GEN CODE TO CLEAR THE ":" COMMAND FLAG and [12000] all arg flags

	PUSH	CP,[TXZ F,F$$RG] ;[12000] Clear all flags at run time

; KLUDGE FOR START OF TRACE MODE

	MOVEI	T4,T4		; SO THAT 'GENCT1' WILL BE A NO-OP
	SUB	T4,@CMDBUF	;[343] (IE: WILL NOT GEN CODE)

; CHECK FOR MACRO CALL, OTHERWISE CLEAR ARGUMENT FLAGS

	SKIPN	MACFLG		;[344] A MACRO COMPILATION?
	 JRST	CDCRET+2	;[344] NO, CLEAR FLAGS AND START CD
	SETZM	MACFLG		;[344] CLEAR THE FLAG FOR LATER
	JRST	CDCRT1		;[344] AND CONTINUE CD WITH FLAGS
; HERE FOLLOWS THE MAIN LOOP OF THE COMMAND DECODER AND COMPILER
CDCLF:		
CDCCLR:	TXZ	F,F$COL!F$2CO		;[23000] Clear : and :: flag
	 PUSH	CP,[TXZ F,F$COL!F$2CO]	;[12000] at run time too

CDCRET:	TXZE	F,F$COL!F$2CO	; A ":" SEEN SINCE LAST COMMAND?
	 JRST	CDCVL1		; YES
	TXZ	F,F$$RG		; CLEAR ARG FLAGS

CDCRT1:	HRLI	T5,(MOVE ARG,)	; SET INST. TO [MOVE ARG,VALUE]

CDCBOP:;	TXNN	F,F$1RG		; AN ARG SEEN?
;	 PUSH	CP,[SETZ ARG,]	; NO, GEN CODE TO CLEAR ARG
CDCIGN:	PUSHJ	P,GENCT1	; TRACE MODE WILL DUMP CMDS TO THIS POINT

	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 JRST	CDCFN1		; END OF COMMAND STRING

	PUSHJ	P,GENCTM	; NEXT TRACE DUMP WILL START HERE

; UPCASE CHAR

	PUSHJ	P,UPCASE	; UPCASE THE CHAR

; FETCH THE COMMAND DISPATCH ADDRESS

CDCCC:	MOVEI	T1,(C)		; FETCH COPY OF COMMAND CHAR
	CAILE	T1,"Z"+40	; In high non-alpha range?
	  MOVEI	T1,-32(T1)	;[12000] Starts after <140>
;	ROT	T1,-1		; DIVIDE IT BY 2
	MOVE	T2,DSPTBL(T1)	; FETCH TWO POSSIBLE DISPATCH ADRS
;	JUMPL	T1,.+2		; RH OF T2 HAS RIGHT DSPADR
;	 HLRZ	T2,T2		; LH OF T2 HAS RIGHT DSPADR

; SEE WHAT KIND OF DISPATCH IT IT

	TXNE	T2,D$JR		; NON-SIMPLE JRST?
	 JRST	(T2)		; NO, DO A SIMPLE JRST DISPATCH

; MUST "EVAL" PRECEDING ARG BEFORE DISPATCHING

	TXNN	F,F$1RG		; AN ARG TO BE EVAL'D?
	 JRST	CDCC1		; [12000] no, save oper till we get one
	PUSH	CP,T5		; NO, GEN CODE FOR THE EVALUATION OF ARG
	HRLI	T5,(MOVE ARG,)	; [12000] remove pending operation, if any

;[13000] Now JRST to the routine

CDCC1:	JRST	(T2)		; DISPATCH TO SPECIFIC CMD DECODER

CDCPOO:	TXZN	F,F$1RG		;[12000] Clear argument flag
	 PUSH	CP,[SETZ ARG,]	;[12000] Clear arg if there wasn't one
	JRST	CDCIGN		;[12000] But leave value alone
; HERE AFTER A ":" COMMAND HAS BEEN SEEN

CDCVL1:
;	SKIPA	X,.+1		; FETCH CODE TO CLEAR ":" COMMAND FLAG
;	 TXZ	F,F$COL		; (THIS WAY BECAUSE OF MACRO BUG)
;	PUSH	CP,X		; GEN INTO CODE
	PUSH	CP,[TXZ F,F$COL]; FETCH CODE TO CLEAR ":" FLAG
;	JRST	CDCVAL		; DON'T FORGET: COMMAND RETURNS A VALUE
; HERE WHEN A COMMAND RETURNS A VALUE

CDCVAL:	TXO	F,F$1RG		; FLAG THAT ARG SEEN
	JRST	CDCIGN		; AND CONTINUE SCAN

; END OF COMMAND STRING. GENERATE A "POPJ P,"

CDCFIN:	PUSHJ	P,GENCT1	; FINISH LAST TRACE DUMP CALL
CDCFN1:	TXZ	F,F$REE		;[353] CLEAR "REENTER" FLAG
	POP	P,X		; CLEAR "BEGINNING OF PDL" FLAG
	PUSH	CP,[POPJ P,]	; GEN CALL TO "RETURN" ROUTINE
	JUMPE	X,CDCFN2	; NORMAL, NOW FIXUP TAG REFERENCES
	SUBI	X,2		; MANIPULATE PDL FLAGS
	JUMPL	X,[ERROR (MRP)]	; ** MISSING ")" **
	JUMPE	X,[ERROR (MRA)]	; ** MISSING RAB **
	ERROR	(MAP)		; ** MISSING "'" **
; PATCH ALL TAG REFERENCES NOW THAT WE KNOW WHERE ALL TAGS ARE

; MAK AOBJN POINTER TO TAG PDL

CDCFN2:	MOVE	T5,TAGPDL	; FETCH ADR OF TAG PDL
	SUBI	T5,(TAG)	; COMPUTE LENGTH OF TAG PDL
	MOVSI	T5,(T5)		; FORM AOBJN POINTER
	HRR	T5,TAGPDL	; . . .

; POP TAG REFERENCES ONE AT A TIME AND PATCH THE TAG ADDRESS

CDCFN3:	POP	REF,N		; POP LAST TAG REF LENGTH
	POP	REF,M		; POP LAST TAG REF CHAR ADDRESS
	JUMPE	M,CDCFN8	; DONE. RELEASE TAG AND REF

	HLRZ	T1,M		; FETCH CHAR ADDRESS OF TAG REF
	SOJ	T1,		; 'CAUSE BP WILL BE INCREMENTED FIRST
	PUSHJ	P,CTOBP		; AND CONVERT TO A BYTE POINTER
	ADD	T1,@CMDBUF	; MAKE BP ABSOLUTE
	MOVE	T4,T1		; AND SAVE BP FOR LATER

; FIND A TAG WITH SAME LENGTH AS TAG REFERENCE

	MOVE	T3,T5		; FETCH AOBJN LOOP COUNTER
	JUMPG	T3,CDCFNE	; IF NO TAGS, ** TAG NOT FOUND **

CDCFN4:	MOVE	X,1(T3)		; FETCH LENGTH OF NEXT TAG
	CAIN	X,(N)		; SAME LENGTH AS REFERENCE?
	 JRST	CDCFN6		; YES, NOW CHECK FOR TAG MATCH
CDCFN5:	AOBJN	T3,CDCFN4	; NO, TRY THE NEXT TAG
CDCFNE:	ERROR	(TAG)		; ** REFERENCE TO UNDEFINED TAG **

; GOT A TAG WITH SAME LENGTH. CHACK IF TEXT MATCHES

CDCFN6:	HLRZ	T1,(T3)		; FETCH CHAR ADR OF TAG
	SOJ	T1,		;  'CAUSE BP WILL BE INCREMENTED FIRST
	PUSHJ	P,CTOBP		; AND CONVERT IT TO A BP
	ADD	T1,@CMDBUF	; MAKE BP ABSOLUTE
	MOVE	T2,T4		; COPY BP FOR REFERENCE
	MOVEI	15,(N)		; COPY REFERENCE LENGTH FOR LOOP COUNT
	JUMPE	15,CDCFN9	; IF LEN=0, THEN MATCH SUCCEEDS

CDCFN7:	ILDB	X,T2		; FETCH  REF CHAR
	ILDB	C,T1		; FETCH TAG CHAR
	CAIE	X,(C)		; STILL MATCH?
	 JRST	CDCFN5		; NO, TRY NEXT TAG
	SOJG	15,CDCFN7	; YES, LOOP FOR ALL CHARS OF TAG

; FOUND MATCH. PATCH UP THE REFERENCE

CDCFN9:	ADD	M,@CMDBUF	; COMPUTE ABSOLUTE ADR OF "JRST"
	MOVE	X,(T3)		; FETCH RELATIVE ADR OF TAG
	HRRM	X,(M)		; PATCH THE "JRST TAG(R)"
	JRST	CDCFN3		; AND PROCESS THE NEXT TAG REFERENCE

; RELEASE TAG,REF, AND CP AS PDLS

CDCFN8:	MOVEI	N,TAG		; RELEASE TAG
	PUSHJ	P,DELPDL	; . . .
	MOVEI	L,TAGPDL	; DELETE THE TAGPDL
	PUSHJ	P,RELM		; . . .
	MOVEI	N,REF		; RELEASE REF
	PUSHJ	P,DELPDL	; . . .
	MOVEI	L,REFPDL	; RELEASE THE TAG REFERENCE PDL
	PUSHJ	P,RELM		; . . .
	MOVEI	N,CP		; RELEASE CP
	PJRST	DELPDL		; AND RETURN TO CALLER
	SUBTTL	Command Decoding and Compilation Routines

; CDUAR - "^" - TRANSLATE NEXT CHAR TO A CONTROL CHAR

CDUAR:	PUSHJ	P,CMDGCH	; FETCH THE NEXT CHAR
	 ERROR	(MEU)		; ** MACRO ENDING WITH ^ **
	TRZ	C,140		; TRANSLATE THE CHAR TO CONTROL RANGE
	JRST	CDCCC		; AND PROCESS THE CONTROL CHAR

; CDALT - ALTMODE
;	- SINGLE ALTMODE WILL BE IGNORED
;	- TWO ALTMODES GENERATE "JSP PC,$$STOP"

CDALT:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 JRST	CDCFIN		; END OF COMMAND STRING
	CAIE	C,.CHESC	; A SECOND ALTMODE?
	 JRST	[PUSHJ P,CMDBCH	; NO, BACKUP OVER THE CHAR
		 JRST  CDCRET]	;[7000] CHANGED BACK.  AND CONTINUE CD
	PUSH	CP,[JSP PC,$$STOP]  ; YES, GEN CALL TO "STOP"
	JRST	CDCCLR		; AND CONTINUE CD

; CDBPT - ^@ - Gen BPT warning for debugging, etc.
;
; GEN:	WARN(BPT)

CDBPT:	MOVE	X,EDVAL		;[12000] Don't do it if ED$OPT
	TXNE	X,ED$OPT	;[12000]  is set in ED
	 JRST	CDCIGN		;[12000]
	PUSH	CP,[SKIPL BRKFLG] ;[12000] Gen code to check flag
	PUSH	CP,[WARN(BPT)]	;[12000] gen LUUO into code
	JRST	CDCIGN		;[12000] don't touch args, etc.

; CDCNA - ^A - GEN COMMAND TO TYPE A STRING ENCLOSED IN ^A'S
; IE:	^ATHIS IS A MESSAGE^A
;
; GEN:	JSP	PC,$$MES
;	<CHAR ADDRESS IN BUFFER,,CHAR COUNT>

CDCNA:	PUSH	CP,[JSP PC,$$MES] ; GEN CALL TO TYPE MESSAGE
	MOVEI	C,.CHCNA	; SCAN FOR NEXT ^A
				;[21000] Check now so not off by 1
	TXNE	F,F$DTM		;[12000] Unless delimited text mode
	 PUSHJ	P,CMDGCH	;[12000] It was so do it
	 JFCL			;[21000] He will lose later

	PUSHJ	P,CURCHA	; FETCH CURRENT CHAR ADDRESS IN BUFFER
	MOVSI	T2,(T1)		; AND SAVE FOR LATER

	PUSHJ	P,FNDCH		; . . .
	 ERROR	(UCA)		; ** UNTERMINATED ^A COMMAND **
	HRRI	T2,(N)		; FETCH CHAR COUNT FOR MESSAGE
	PUSH	CP,T2		; STORE <CHAR ADR,,CHAR COUNT> IN CODE
	JRST	CDCRET		; AND CONTINUE CD

; CDCNC - ^C - COMMAND TO DO A MONRT.

CDCNC:	PUSH	CP,[EXIT 1,]	; GEN THE MONRT.
	JRST	CDCRET		; AND CONTINUE CD

; CDCNE - ^E - COMMAND TO RETURN THE VALUE OF THE FORMFEED FLAG

CDCNE:	PUSH	CP,[JSP PC,$$CNE] ; GEN CODE TO FETCH VALUE OF FF FLAG
	JRST	CDCVAL		; AND CONTINUE CD
; CDCNF - ^F RETURNS CONTENTS OF CONSOLE SWITCH REGISTER
;	N^F RETURNS TTY#+^O200000 OF JOB N

CDCNF:	MOVE	X,[JSP PC,$$TTY] ;[306] ASSUME WE WANT TTY#
	TXNN	F,F$1RG		;[306] WANT TTY#?
	 MOVE	X,[SWITCH VALUE,] ;[306] NO, WANT CONSOLE SWITCHES
	PUSH	CP,X		;[306] GEN CODE FOR WHATEVER
	JRST	CDCVAL		; AND CONTINUE SCAN

; CDCNG - N,M^G=GETTAB, N^G=PEEK

CDCNG:	MOVE	X,[JSP PC,$$GTB] ;[302] ASSUME GETTAB
	TXZN	F,F$2RG		;[332] 2 ARGS FOR GETTAB?
	 HRRI	X,$$PEK		;[302] NO, ONE ARG FOR PEEK
	TXNN	F,F$1RG		;[336] WANT PJOB?
	 MOVE	X,[PJOB VALUE,]	;[336] YES, NO GETTAB/PEEK
	PUSH	CP,X		;[302] GEN THE CALL TO WHATEVER
	JRST	CDCVAL		;[302] AND CONTINUE WITH SCAN

; CDCNH - ^H - COMMAND TO RETURN TIME OF DAY IN JIFFIES

CDCNH:	PUSH	CP,[TIMER VALUE,] ; GEN CODE TO FETCH TIME OF DAY IN JIFFIES
	JRST	CDCVAL		; AND CONTINUE CD

; CDCNL - ^L - COMMAND TO TYPE A FORMFEED

CDCNL:	PUSH	CP,[JSP PC,$$FFD] ; GEN CODE TO TYPE A FORMFEED
	JRST	CDCRET

; CDESTAR - E* - TRMOPs [10000]

CDCND:
CDESTA:
	TXNE	F,F$2RG		;[10000] See if 2 arguments given
	 PUSH	CP,[TXO F,F$2RG]	;[10000] tell the runtime routine
	PUSH	CP,[JSP PC,$$TRMO]	;[10000]
	JRST	CDCVAL		;[10000]

CDCNQ:	PUSHJ	P,ARGK		;[12000] Default arg to 1
	PUSH	CP,[JSP PC,$$CNQ] ;[12000] # of characters in next n lines
	JRST	CDCVAL		;[12000]


; CDFQ - FQ - Compare text buffer with Q-register


CDFQ:	PUSH	CP,[JSP PC,$$QCM] ; [10000]
	PUSHJ	P,MAKQNM	  ; [10000]
	JRST	CDCVAL		  ; [10000]
; CDCNB - ^B return the date in system-dependant format

CDCNB:
FOR TOPS10!TOPS20,<PUSH CP,[DATE VALUE,]> ;[16000] Get the date from the sys
	JRST	CDCVAL		;[16000] That is our value

; CDQRX - nQ - Return nth character from a Q-Register

CDQRX:	PUSH	CP,[JSP PC,$$QRX] ; [10000]
	PUSHJ	P,MAKQNM	; [10000]
	JRST	CDCVAL		  ; [10000]

; CDCNN - ^N - COMMAND TO RETURN THE VALUE OF THE END-OF-FILE FLAG

CDCNN:	PUSH	CP,[JSP PC,$$CNN] ; GEN CODE TO RETURN VALUE OF EOF FLAG
	JRST	CDCVAL		; AND CONTINUE CD

; CDCNP - ^P OR N^P - RETURN CURRENT PAGE # OR POSITION TO SPECIFIED PAGE

CDCNP:	TXNE	F,F$1RG		; AN ARG PRESENT?
	 JRST	CDCNP1		; YES, POSITION TO SPECIFIED PAGE

; ^P - RETURN THE # OF THE CURRENT PAGE

CDCNP2:	PUSH	CP,[MOVE VALUE,PAGCNT] ; GEN CODE TO RETURN PAGE #
	JRST	CDCVAL		; AND CONTINUE CD

; N^P - POSITION TO SPECIFIED PAGE

CDCNP1:	PUSH	CP,[JSP PC,$$CNP] ; GEN CODE TO CALL $$CNP
	JRST	CDCRET		; AND CONTINUE CD

;m,n^\ Execute instruction in n with m in AC VALUE

CDCBS:	PUSH	CP,[JSP PC,$$EXE] ; Gen call to $$EXE
	JRST	CDCVAL		; and continue
; CDCNS - ^S - Return -SRHLEN (length of last search)

CDCNS:	PUSH	CP,[MOVN VALUE,SRHLEN] ;[12000] negative length of search
	JRST	CDCVAL		;[12000] return value


; CDCNT - ^T - COMMAND TO RETURN VALUE OF INPUT CHAR

CDCNT:	TXZE	F,F$COL		;[16000] :^T (TTCALL) ?
	 JRST	CDCNT0		;[16000] Yes go there
	TXNE	F,F$1RG		;[12000] 1 argument given?
	 JRST	[PUSH CP,[JSP PC,$$TCHR] ;[16000] Type this character
		 JRST CDCRET]	;[16000] Do NOT return a value
	PUSH	CP,[JSP PC,$$GCHR] ;[16000] Read a character from the terminal
	JRST	CDCVAL		;[16000] Return that as value

CDCNT0:!TXZN 	F,F$2RG		;[410] TWO ARGS?
	 PUSH	CP,[SETZ SARG,]	;[410] NO, INSURE SECOND ARG 0!
	PUSH	CP,[JSP PC,$$TTC] ;[16000] Gen call to TTCALL routine
	JRST	CDCVAL		; AND CONTINUE CD

; CDCNU - N^U - USETI TO DESIRED BLOCK ON INPUT FILE

CDCNU:	SKIPN	EOVAL		;[12000] do USETI if EO=0 only
	 JRST	CDCNU1		;[12000] EO=0

;DO Q-REGISTER STORE FROM TEXT
	TXNE	F,F$1RG		;[12000] Argument present?
	 JRST	[PUSH CP,[TXO F,F$1RG] ;[12000] need to know at run time
		 JRST .+1]	;[12000] Also don't want text
	PUSH	CP,[JSP PC,$$CNU] ;[12000] Gen call
	PUSHJ	P,MAKQNM	;[12000] get Q-register name
	PUSHJ	P,CDCINS	;[12000] and text argument
	JRST	CDCRET		;[12000] RETURN

CDCNU1:	PUSHJ	P,ARGK		;[333] MAKE SURE IT HAS AN ARG
	PUSH	CP,[JSP PC,$$USI] ;[333] GEN CALL TO $$USI
	JRST	CDCRET		;[333] AND CONTINUE CD

; CDCNV - N^V OR ^V - DOWNCASE ALL TEXT

CDCNV:	PUSHJ	P,ARGK		; MAKE SURE IT HAS AN ARG
	PUSH	CP,[JSP PC,$$LOW] ; GEN CALL TO $$LOW
	JRST	CDCRET		; AND CONTINUE CD

; CDCNW - N^W OR ^W - UPCASE ALL TEXT

CDCNW:	PUSHJ	P,ARGK		; MAKE SURE IT HAS AN ARG
	PUSH	CP,[JSP PC,$$UP] ; GEN CALL TO $$UP
	JRST	CDCRET		; AND CONTINUE CD
; CDCNY - ^Y OR N^Y - RETURN CURRENT PAGE # OR YANK TO SPECIFIED PAGE

CDCNY:	TXNN	F,F$1RG		;[327] AN ARG PRESENT?
	 JRST	CDCNP2		;[327] YES, TREAT AS ^P

; N^Y - YANK TO SPECIFIED PAGE

	PUSH	CP,[JSP PC,$$CNY] ;[327] GEN CODE TO CALL $$CNY
	JRST	CDCRET		;[327] AND CONTINUE CD
; CDCNX - N^X OR ^X - SET OR RETURN EXACT SEARCH MODE FLAG

CDCNX:	MOVE	X,[JSP PC,$$CX]	; FETCH CALL TO $$CX
	TXNE	F,F$1RG		; IS IT A SET CMD?
	 HRRI	X,$$CXS		; YES, FETCH ADR OF "SET" ROUTINE
	PUSH	CP,X		; GEN CALL TO WHATEVER
	TXNE	F,F$1RG		; WAS IT A "SET" CMD?
	 JRST	CDCRET		; YES, CONTINUE CD
	JRST	CDCVAL		; NO, IT RETURNS A VALUE

; CDCNZ - ^Z - CLOSE OUTPUT FILE AND RETURN TO MONITOR COMMAND LEVEL

CDCNZ:	PUSH	CP,[JSP PC,$$CNZ] ; GEN CODE TO CALL $$Z
	JRST	CDCRET		; AND CONTINUE CD

; CDCUA - ^^X - VALUE OF THE ARBITRARY CHAR "X"

CDCUA:	PUSHJ	P,CMDGCH	; GET NEXT CHAR
	 ERROR	(MUU)		; NONE LEFT. ** MACRO ENDING WITH ^^ **
	HRLI	C,(MOVEI VALUE,) ; FORM: MOVEI VALUE,"X"
	PUSH	CP,C		; AND GEN THE INST. INTO CODE
	JRST	CDCVAL		; AND CONTINUE CD
; CDQUO - " - BEGINNING OF A CONDITIONAL
;
; FORMAT OF A CONDITIONAL IS:
;
;	N"X...COMMANDS...'
;
; WHERE N IS A NUMERIC ARGUMENT, X IS A LETTER, AND
; ...COMMANDS... IS ANY SEQUENCE OF COMMANDS (INCLUDING
; MORE CONDITIONALS. THE COMMANDS ARE EXECUTED IF N.X.0 IS TRUE.
;
; X IS:
;
; L or <	EXECUTE COMMANDS IF N.LT.0
; G or >	EXECUTE COMMANDS IF N.GT.0
; N		EXECUTE COMMANDS IF N.NE.0
; E		EXECUTE COMMANDS IF N.EQ.0
; F		EXECUTE COMMANDS IF N.EQ.0 (FALSE OF FAILURE)
; U		EXECUTE COMMANDS IF N.EQ.0 (UNSUCCESSFUL)
; T		EXECUTE COMMANDS IF N.LT.0 (TRUE)
; S		EXECUTE COMMANDS IF N.LT.0 (SUCCESS)
; C		EXECUTE COMMANDS IF N IS VALUE OF AN ASCII LETTER,
;			DIGIT, ".", "%", OR "$".
; A		EXECUTE COMMANDS IF N IS VALUE OF AN ASCII LETTER
; D		EXECUTE COMMANDS IF N IS VALUE OF AN ASCII DIGIT
; V		EXECUTE COMMANDS IF N IS VALUE OF AN ASCII LOWER CASE LETTER
; W		EXECUTE COMMANDS IF N IS VALUE OF AN ASCII UPPER CASE LETTER
; R [14000]	EXECUTE COMMANDS IF N IS VALUE OF AN ASCII LETTER OR DIGIT

CDQUO:	TXNN	F,F$1RG		; AN ARG PRESENT?
	 ERROR	(NAQ)		; NO, ** NO ARG BEFORE " **

	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR ("X")
	 ERROR	(MEQ)		; NONE LEFT. ** MACRO ENDING WITH " **
	PUSHJ	P,UPCASE	; UPCASE THE CHAR
	MOVE	T1,[IOWD CONLTH,CONTBL] ; AOBJN PTR TO "X" TABLE
	PUSHJ	P,DISPAT	; DISPATCH TO PROPER CONDITIONAL
	 ERROR	(IQC)		; ** ILLEGAL " COMMAND **

	DEFINE	QC(CMDS)<IRPC CMDS,<<"CMDS",,CDQ'CMDS>>>
CONTBL:	QC	(GLNEFUTSCADVWR)
	<.CHLAB,,CDQL>		;[14000] Left angle-bracket for less than 0
	<.CHRAB,,CDQG>		;[14000] Right ...		greater than 0
	<"=",,CDQE>		;"= for "E
CONLTH==.-CONTBL
; CDQG - N"G...' - EXECUTE COMMANDS IF N.GT.0

CDQG:	PUSH	CP,[JUMPLE ARG,0(R)] ; GEN CODE TO SKIP COMMANDS
	JRST	CDQCJ		; FINISH CONDITIONAL

; CDQT - N"T...' - EXECUTE COMMANDS IF N IS TRUE

CDQT:

; CDQS - N"S...' - EXECUTE COMMANDS IF N IS SUCCESSFUL

CDQS:

; CDQL - N"L...' - EXECUTE COMMANDS IF N.LT.0

CDQL:	PUSH	CP,[JUMPGE ARG,0(R)] ; GEN CODE TO SKIP COMMANDS
	JRST	CDQCJ		; FINISH CONDITIONAL

; CDQN - N"N...' - EXECUTE COMMANDS IF N.NE.0

CDQN:	PUSH	CP,[JUMPE ARG,0(R)] ; GEN CODE TO SKIP COMMANDS
	JRST	CDQCJ		; FINISH THE CONDITIONAL

; CDQF - N"F...' - EXECUTE COMMANDS IF N IS FALSE

CDQF:

; CDQU - N"U...' - EXECUTE COMMANDS IF N IS UNSUCCESSFUL

CDQU:

; CDQE - N"E...' - EXECUTE COMMANDS IF N.EQ.0

CDQE:	PUSH	CP,[JUMPN ARG,0(R)] ; GEN CODE TO SKIP COMMANDS
	JRST	CDQCJ		; FINISH THE CONDITIONAL

; CDQC - N"C...' - EXECUTE COMMANDS IF N IS A SYMBOL CONSTITUENT

CDQC:	PUSH	CP,[JSP PC,$$CKC] ; GEN CALL TO SEE IF A SYMBOL CONSTITUENT
	JRST	CDQJA		; FINISH CONDITIONAL

; CDQA - N"A...' - EXECUTE COMMANDS IF N IS A LETTER

CDQA:	PUSH	CP,[JSP PC,$$CKA] ; GEN CALL TO SEE IF A LETTER
	JRST	CDQJA		; FINISH CONDITIONAL

CDQR:	PUSH	CP,[JSP PC,$$CKR] ;[14000] Gen call to see if alphanumeric
	JRST	CDQJA		;[14000]

; CDQD - N"D...' - EXECUTE COMMANDS IF N IS A DIGIT

CDQD:	PUSH	CP,[JSP PC,$$CKD] ; GEN CALL TO SEE IF A DIGIT
	JRST	CDQJA		; FINISH CONDITIONAL

; CDQV - N"V...' - EXECUTE COMMANDS IF N IS A LOWER CASE LETTER

CDQV:	PUSH	CP,[JSP PC,$$CKV] ; GEN CALL TO SEE IF A LC LETTER
	JRST	CDQJA		; FINISH CONDITIONAL

; CDQW - N"W...' - EXECUTE COMMANDS IF N IS AN UPPER CASE LETTER

CDQW:	PUSH	CP,[JSP PC,$$CKW] ; GEN CALL TO SEE IF A UC LETTER
CDQJA:	PUSH	CP,[JRST 0(R)]	; GEN CODE TO SKIP COMMANDS

CDQCJ:	MOVEI	X,(R)		; REMEMBER WHERE CONDITIONAL BEGINS
	SUB	X,@CMDBUF	; . . .
	PUSH	P,X		;  . . .
	PUSH	P,[<P$CON>]	; FLAG THAT A CONDITIONAL IS ON PDL
	JRST	CDCRET		; AND CONTINUE CD
; CDAPO - ' - FINISH WAHT " BEGAN (IE: END OF A CONDITIONAL)

CDAPO:	POP	P,X		; POP THE PDL FLAG
	PUSHJ	P,CHKCON	;[12000] See that we're in a conditional

	POP	P,X		; POP THE ADR OF START OF CONDITIONAL
	ADD	X,@CMDBUF	; MAKE IT AN ABSOLUTE ADR

	MOVEI	T1,1(CP)	; FETCH ADR OF END OF CONDITIONAL
	SUB	T1,@CMDBUF	; AND MAKE IT RELATIVE
	HRRM	T1,(X)		; FINISH THE SKIP OVER COMMANDS
				; FOR WHEN CONDITIONAL COMMANDS
				; ARE NOT EXECUTED
	JRST	CDCRET		; AND CONTINUE CD


;[12000] CDVBAR - | - "ELSE" construct

CDVBAR:	MOVE	X,(P)		;[12000] Check nexting of things
	PUSHJ	P,CHKCON	;[12000]
	MOVE	X,-1(P)		;[12000] Get addr of start of conditional
	PUSH	CP,[JRST 0(R)]	;[12000] Jump past "ELSE" clause
	MOVEI	T1,1(CP)	;[12000] "ELSE" Will jump past that jump
	SUB	T1,@CMDBUF	;[12000] relative to buffer
	ADD	X,@CMDBUF	;[12000] Make X absolute
	HRRM	T1,(X)		;[12000] The jump instruction is now complete
	SOJ	T1,		;[12000] Put pointer to that jump on stack
	MOVEM	T1,-1(P)	;[12000] will fix up on next "'" or "|"
	JRST	CDCRET		;[12000] Continue

;[12000]  CHKCON -- Check that we're in a conditional
;
CHKCON:	CAIG	X,P$CON		;[12000] Out of range?
	JUMPG	X,CDAPO1(X)	;[12000] Dispatch unless negative
				;[12000] in which case, fall into CDAPO1
CDAPO1:
	ERROR	(MSC)		; ** MISSING START OF CONDITIONAL **
	ERROR	(MRP)		; ** MISSING ) **
	ERROR	(CON)		; ** CONFUSED USE OF CONDITIONALS **
	POPJ	P,		;[12000] Return
; CDQST - ? - COMMAND TO COMPLEMENT TRACE MODE FLAG

CDQST:	SKIPA	X,.+1		; A MACRO BUG FORCES US TO DO THIS
	 TXC	F,F$TRC		; INST. TO COMPLEMENT THE TRACE FLAG
	PUSH	CP,X		; GEN CODE TO COMPLEMENT TRACE FLAG
	JRST	CDCRET		; AND CONTINUE CD

; CDCOM - , - DELIMITS FIRST AND SECOND ARGUMENTS

CDCOM:	TXZE	F,F$1RG		; ARG ALREADY SEEN?
	 TXOE	F,F$2RG		; AND NOT BOTH ARGS?
	  ERROR	(ARG)		; NO. ",ARG" AND "ARG,ARG,ARG" ILLEGAL
	PUSH	CP,[MOVE SARG,ARG] ; GEN CODE TO SAVE SECOND ARG
	JRST	CDCRT1		; AND CONTINUE CD

; CDLPA - ( - PERFORM OPERATIONS INSIDE "()" FIRST
;
; GEN:	PUSH	P,ARG
;	<EVAL INSIDE PARENS>
;	MOVE	VALUE,ARG
;	POP	P,ARG

CDLPA:	PUSH	CP,[PUSH P,ARG] ; GEN CODE TO SAVE ARG
	PUSH	P,T5		; SAVE CURRENT OPERATION
	PUSH	P,[<P$PAR>]	; FLAG THAT A "(" IS ON PDL
	JRST	CDCRT1		; AND CONTINUE CD

; CDRPA - ) - FINISH WHAT CDLPA STARTED

CDRPA:	POP	P,X		; POP PDL FLAG
	JUMPE	X,CDRPA2	; ** CONFUSED USE OF () **
	SOJG	X,CDRPA1	; ** MISSING LEFT PARENTHESIS **

	PUSH	CP,[MOVE VALUE,ARG] ; GEN CODE TO SAVE ARG
	PUSH	CP,[POP P,ARG]	; GEN CODE TO RESTORE OLD ARG
	POP	P,T5		; RESTORE PREVIOUS OPERATION
	JRST	CDCVAL		; AND CONTINUE WITH CD

CDRPA1:	ERROR	(PAR)		; ** CONFUSED USE OF () **
CDRPA2:	ERROR	(MLP)		; ** MISSING ( **
; CDEXC - !TAG! - COMMAND TO DEFINE A TAG (IE: LABEL)

CDEXC:	TXZ	F,F$1RG!F$2RG	;[310] THROW AWAY PREV. CMDS
	MOVEI	C,"!"		; SCAN FOR CLOSING "!"
	TXZE	F,F$DTM		;[12000] Check for delimited text mode
	 PUSHJ	P,CMDGCH	;[12000] @!/foo/ or something like that
	 JFCL			;[12000] If CMDGCH fails, so will FNDCH
	PUSHJ	P,CURCHA	; FETCH CURRENT CHAR ADR IN BUFFER
	MOVSI	T1,(T1)		; . . .
	HRRI	T1,1(CP)	; FETCH CURRENT ADR IN CODE
	SUB	T1,@CMDBUF	; . . .
	PUSH	TAG,T1		; STORE INFO ABOUT TAG DEFINITION
	PUSHJ	P,FNDCH		; . . .
	 ERROR	(UTG)		; ** UNTERMINATED TAG **
	PUSH	TAG,N		; STORE LENGTH OF TAG
	JRST	CDCRET		; AND CONTINUE CD

; CDO - OTAG$ - COMMAND TO BRANCH TO A TAG

CDO:	MOVE	C,DELIM		;[12000] Scan till delimiter found
	TXZE	F,F$DTM		;[12000] Special delimiter?
	 PUSHJ	P,CMDGCH	;[12000] Yes
	 JFCL			;[12000] Will get an error anyway
	PUSH	CP,[JRST 0(R)]	; GEN CODE TO BRANCH TO TAG
				; NOTE THAT Y FIELD MUST BE FILLED
				; IN WHEN THE TAG ADR IS KNOWN
	PUSHJ	P,CURCHA	; FETCH CURRENT CHAR ADR IN BUFFER
	MOVSI	T1,(T1)		; . . .
	HRRI	T1,(CP)		; FETCH CURRENT ADR ON CODE
	SUB	T1,@CMDBUF	; . . .
	PUSH	REF,T1		; AND STORE INFO ABOUT THE TAG REFERENCE
	PUSHJ	P,FNDCH		; . . .
	 ERROR	(MEO)		; ** MACRO ENDING WITH O COMMAND **
	PUSH	REF,N		; STORE LENGTH OF TAG REFERENCE
	JRST	CDALT		; AND CONTINUE WITH SCAN
; CDLAB - LAB - AN ITERATION
;
; GEN:	PUSH	P,ARG
;	MOVEI	X,%FIN
;	PUSH	P,X
; %ST:	SOSGE	-1(P)		; OR "SOSA -2(P)" IF NO ARG
;	 JSP	PC,$$SEM
;	...
;	JRST	%ST(R)
;%FIN:	POP	P,X

CDLAB:	PUSH	CP,[PUSH P,ARG]	; GEN CODE TO STORE REPEAT COUNT
	PUSH	CP,[MOVEI X,0]	; GEN CODE TO STORE %FIN ADR
	PUSH	CP,[PUSH P,X]	; . . .
	MOVE	X,[SOSGE -1(P)]	; FETCH THE CONDITIONAL INST.
	TXNN	F,F$1RG		; AN ARG PRESENT?
	 HRLI	X,(SOSA 0(P))	; NO, WILL LOOP FOREVER
	PUSH	CP,X		; GEN THE CONDITIONAL INST.
	PUSH	CP,[JSP PC,$$SEM] ; GEN THE "JUMP OUT OF LOOP"
				; FOR WHEN REPEAT COUNT RUNS OUT
	MOVEI	X,-3(CP)	; SAVE THE ADR OF THE "MOVEI"
	SUB	X,@CMDBUF	; . . .
	PUSH	P,X		; SO THAT CDRAB CAN PATCH IT
	PUSH	P,[<P$ITR>]	; SET ITERATION PDL FLAG
	JRST	CDCRET		; AND CONTINUE CD

; CDRAB - RAB - FINISH WHAT CDLAB STARTED

CDRAB:	POP	P,X		; POP THE PDL FLAG
	JUMPE	X,[ERROR (MLA)]	; ** MISSING LAB **
	SOJE	X,[ERROR (MRP)]	; ** MISSING ) **
	SOJG	X,[ERROR (MAP)]	; ** MISSING ' **

	POP	P,X		; POP ADR OF "MOVEI"
	MOVEI	T1,2(X)		; COMPUTE ADR OF %ST(R)
	HRLI	T1,(JRST 0(R))	; MAKE "JRST %ST(R)"
	PUSH	CP,T1		; AND GEN IT INTO CODE
	PUSH	CP,[POP P,X]	; GEN CODE TO CLEAR TEMP REPEAT COUNT
	MOVEI	T1,(CP)		; COPY CURRENT ADR IN CODE
	SUB	T1,@CMDBUF	; MAKE IT RELATIVE
	ADD	X,@CMDBUF	; COMPUTE ABS. ADR. OF "MOVEI"
	HRRM	T1,(X)		; FINISH "MOVEI X,%FIN"
	TXZ	F,F$1RG!F$2RG	;[401] CLEAR ARGUMENTS
	JRST	CDCRT1		; AND CONTINUE SCAN
; CDADD - + - GEN "ADD ARG,VALUE" FOR AN ADDITION

CDADD:	HRLI	T5,(ADD ARG,)	; SETUP OPCODE FOR LATER EVAL
	JRST	CDCPOO		; AND CONTINUE SCAN

; CDSUB - - - GEN "SUB ARG,VALUE" FOR A SUBTRACTION

CDSUB:	HRLI	T5,(SUB ARG,)	; SETUP OPCODE FOR LATER EVAL
	JRST	CDCPOO		; AND CONTINUE CD

; CDMUL - * - GEN "IMUL ARG,VALUE" FOR A MULTIPLICATION

CDMUL:	HRLI	T5,(IMUL ARG,)	; SETUP OPCODE FOR LATER EVAL
	JRST	CDCPOO		; AND CONTINUE SCAN

; CDDIV - / - GEN "IDIV ARG,VALUE" FOR A DIVISION

CDDIV:	HRLI	T5,(IDIV ARG,)	; SETUP OPCODE FOR LATER EVAL
	JRST	CDCPOO		; AND CONTINUE SCAN

; CDAND - & - GEN "AND ARG,VALUE" FOR LOGICAL "AND" OPERATION

CDAND:	HRLI	T5,(AND ARG,)	; SETUP OPCODE FOR LATER EVAL
	JRST	CDCPOO		; AND CONTINUE CD

; CDOR - # - GEN "OR ARG,VALUE" FOR LOGICAL "OR" OPERATION

CDOR:	HRLI	T5,(OR ARG,)	; SETUP OPCODE FOR LATER EVAL
	JRST	CDCPOO		; AND CONTINUE CD

; CDXOR - ^_ - GEN "XOR ARG,VALUE" FOR LOGICAL "XOR" OPERATION

CDXOR:	HRLI	T5,(XOR ARG,)	;[12000] SETUP OPCODE FOR LATER EVAL
	JRST	CDCPOO		;[12000] AND CONTINUE COMMAND

; CDNOT - ~ - GEN "SETC ARG,VALUE" FOR LOGICAL "NOT" OPERATION

CDNOT:	HRLI	T5,(SETCM ARG,)	;[12000] SETUP OPCODE FOR LATER EVAL
	JRST	CDCPOO		;[12000] AND CONTINUE

; CDCBA - ^_ - GEN "SETCAM ARG,VALUE" for logical (postfix operator) not

CDCBA:	PUSH	CP,[SETCAM ARG,VALUE] ;[14000] Generate it [16000] correctly
	JRST	CDCVAL		;[14000] return value
; CDOCT - ^O - AN OCTAL NUMBER FOLLOWS

CDOCT:	SETZ	N,

CDOCT1:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 JRST	CDDIG5		; NO MORE
	CAIG	C,"7"		; AN OCTAL DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  JRST	CDDIG4		; NO, END OF NUMBER
	LSH	N,3		; MAKE ROOM FOR THE OCTAL DIGIT
	IORI	N,-"0"(C)	; AND "OR" IN THE DIGIT
	JRST	CDOCT1		; AND GO BACK FOR ANOTHER DIGIT

; CDDIG - A DIGIT - A DECIMAL INTEGER FOLLOWS

CDDIG:	SETZ	N,		; START WITH N:=0
	JRST	CDDIG3		; AND JUMP INTO THE LOOP

CDDIG2:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 JRST	CDDIG5		; NO MORE
CDDIG3:	CAIG	C,"9"		; IS CHAR A DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  JRST	CDDIG4		; NO. END OF NUMBER
	IMULI	N,^D10		; YES, MAKE ROOM FOR DIGIT
	ADDI	N,-"0"(C)	; AND ADD IN THE DIGIT
	JRST	CDDIG2		; AND GO BACK FOR ANOTHER DIGIT

CDDIG4:	PUSHJ	P,CMDBCH	; REPEAT THE CHAR THAT'S NOT A DIGIT

; GEN:	SKIPA	VALUE,.+1(R)
;	<NUMBER>
; OR
;	MOVEI	VALUE,<NUMBER>

CDDIG5:	TLNN	N,-1		; WILL NUMBER FIT IN 18. BITS?
	 JRST	CDDIG7		; YES, GEN A "MOVEI"
	MOVEI	T1,2(CP)	; NO, FETCH ABSOLUTE ".+1"
	SUB	T1,@CMDBUF	; MAKE RELATIVE ".+1"
	HRLI	T1,(SKIPA VALUE,0(R)); FORM "SKIPA VALUE,.+1(R)"
	PUSH	CP,T1		; STORE "SKIPA" IN CODE
CDDIG6:	PUSH	CP,N		; STORE <NUMBER> IN CODE
	JRST	CDCVAL		; AND CONTINUE CD

CDDIG7:	HRLI	N,(MOVEI VALUE,) ; FORM: MOVEI VALUE,<NUMBER>
	JRST	CDDIG6		; AND CONTINUE
; CDEQU - TYPE A NUMERIC QUANTITY
;
;	N= (OR N==) - TYPE NUMBER IN DECIMAL (OR OCTAL) FOLLOWED BY CRLF
;	N,M= (OR :N,M==) - TYPE NUMBER FOLLOWED BY CRLF IF N.LT.0,
;				BY NOTHING IF N.EQ.0, OR
;				BY CHAR WHOSE CODE IS N IF N.GT.0

CDEQU:	TXNN	F,F$1RG!F$2RG	;[305] WAS THERE AN ARG?
	 ERROR	(NAE)		; NO. ** NO ARG BEFORE "=" **
	TXNN	F,F$2RG		;[305] THE TWO ARG FORM??
	 PUSH	CP,[SETO SARG,]	;[305] NO, GEN CODE TO FORCE CRLF AFTER NUMBER
	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 JRST	CDEQU1		; NONE LEFT. ASSUME "="
	CAIE	C,"="		; A SECOND "="?
	 JRST	CDEQU1		; NO, IT'S "="

	PUSH	CP,[JSP PC,$$OCT] ; GEN CALL TO TYPE IN OCTAL
	JRST	CDCRET		; AND CONTINUE CD

CDEQU1:	PUSHJ	P,CMDBCH	; BACKUP OVER THE CHAR THAT'S NOT "="
	PUSH	CP,[JSP PC,$$DEC] ; GEN CALL TO TYPE IN DECIMAL
	JRST	CDCRET		; AND CONTINUE CD

; CDSEM - ; OR N; - JUMP OUT OF CURRENT ITERATION
;	; - IF LAST SEARCH FAILED
;	N; - IF N.EQ.0

CDSEM:	PUSHJ	P,CHKITR	; CHECK IF WE'RE IN AN ITERATION
	 ERROR	(SNI)		; NO, ** ; NOT IN ITERATION **

CDSEM2:	TXNE	F,F$1RG		; AN ARG PRESENT?
	 JRST	CDSEM3		; YES

	PUSH	CP,[JSP PC,$$SEMF] ; NO, EQN CODE IF POP OUT OF
				; CUR. ITERATION IF LAST SEARCH FAILED
	JRST	CDCRET		; CONTINUE CD

CDSEM3:	PUSH	CP,[JSP PC,$$SEMZ] ; GEN CODE TO JUMP OUT OF
				; CUR. ITERATION IF ARG.GE.0
	JRST	CDCRET		; CONTINUE CD

; CDCOL - : - NEXT COMMAND WILL RETURN 0 IF IT FAILS, -1 IF IT SUCCEEDS
;[14000] Sets flag for :: if : flag is already set

CDCOL:	MOVE	X,[TXO F,F$COL]	;[14000] Do this unless set already
	TXOE	F,F$COL		;[14000] [310] FLAG THAT ":" SEEN 
	 HRRI	X,(F$COL!F$2CO)	;[14000] ::, so set that instead
	PUSH	CP,X		;[14000] set at run time
	TXOA	F,(X)		;[14000] and now, and skip
				;[310] INTO THE COMMON CODE

; CDATS - @ - NEXT TEXT STRING IS IN DELIMITED TEXT MODE
;	(EG: @I/TEXT/$ , @FS/STRING/NEWSTR/$)

CDATS:	 TXO	F,F$DTM		; FLAG THAT WE ARE IN DELIMITED TEXT MODE
	SKIPN	EOVAL		;[3000] [13000] Throw away only if EO=0
	 TXZ	F,F$1RG!F$2RG	;[310] THROW AWAY PREV. ARGS
	JRST	CDCRT1		; AND CONTINUE CD
; CDA - A OR NA - APPEND TO BUFFER OR RETURN VALUE OF CHAR
;	TO RIGHT OF TEXT POINTER

CDA:	TXNE	F,F$1RG		; APPEND?
	 JRST	CDNA		; NO, RETURN VALUE OF NEXT CHAR IN BUFFER

; A - APPEND TO TEXT BUFFER

	PUSH	CP,[JSP PC,$$A]	; GEN CALL TO $$A
	JRST	CDCRET		; AND CONTINUE CD

; NA - RETURN THE VALUE OF THE CHAR TO THE RIGHT OF THE TEXT POINTER

CDNA:	MOVE	X,[JSP PC,$$NA] ; GET CALL TO $$NA
	TXNE	F,F$COL		;[16000] :nA appends n lines
	 HRRI	X,$$AL		;[16000] Get Append line routine
	PUSH	CP,X		;[16000] Gen whatever...
	JRST	CDCVAL		; AND CONTINUE CD

; CDB - B - RETURN VALUE OF BEGINNING OF BUFFER; 0

CDB:	PUSH	CP,[SETZ VALUE,] ; GEN CODE TO RETURN 0
	JRST	CDCVAL		; AND CONTINUE CD

; CDPT - . - RETURN VALUE OF THE BUFFER POINTER

CDPT:	PUSH	CP,[MOVE VALUE,PTVAL] ; GEN CODE TO FETCH VALUE OF "."
	JRST	CDCVAL		; AND CONTINUE CD

; CDH - H - AN ABBREVIATION FOR "B,Z"

CDH:	TXOE	F,F$2RG		; "ARG,H"?
	 ERROR	(ARG)		; YES. ** ILLEGAL ARG CONSTRUCTION **
	PUSH	CP,[SETZ SARG,]	; GEN CODE TO RETURN "B" IN SARG

; CDZ - Z - RETURN VALUE OF THE END OF TH BUFFER

CDZ:	PUSH	CP,[MOVE VALUE,@TXTBUF]	; GEN CODE TO RETURN VALUE OF Z
	JRST	CDCVAL		; AND CONTINUE CD
; CDTAB - <TAB>TEXT$ - INSERT A TAB CHAR AND TEXT INTO MAIN TEXT BUFFER

CDTAB:
CDSIC:	;Come here to insert any self-inserting character & following text

	PUSHJ	P,CMDBCH	;[14000] Back up so char inserts itself
	JRST	CDI0		;[14000] (tab) is just like i(tab)

; CDI - NI$ OR ITEXT$ - INSERT CHARACTER OR TEXT INTO MAIN TEXT BUFFER

CDI:	TXNE	F,F$1RG		; IS AN ARG PRESENT?
	 JRST	CDNI		; YES, IT'S "NI$"

; ITEXT$ OR @I/TEXT/$ - INSERT TEXT INTO BUFFER AT CURRENT POSITION

CDI0:	PUSH	CP,[JSP PC,$$I]	; GEN CODE TO CALL $$I
CDIN1:	PUSHJ	P,CDCINS	; SCAN THE INSERTION ARGUMENT
	JRST	CDALT		; AND CONTINUE CD

; CNDI - NI$ - INSERT THE CHAR WHOSE ASCII CODE IS N

CDNI:	MOVE	C,DELIM		;[12000] use default delimiter
	TXNE	F,F$DTM		;[12000] check for @I//
	 PUSHJ	P,CMDGCH	;[12000] get another delimiter
	 JFCL			;[16000] Will lose later anyway
	MOVEI	T3,(C)		;[12000] Save whatever delimiter it was
	PUSHJ	P,CMDGCH	; YES, MAKE SURE FOLLOWING CHAR IS SAME
	 ERROR	(NDI)		; NO. ** NO DELIMITER AFTER I **
	CAIE	C,(T3)		;[12000] is it the delimiter
	 ERROR	(NDI)		; NO. SAME ERROR
	PUSH	CP,[JSP PC,$$NI] ; GEN CALL TO $$NI
	JRST	CDCRET		; AND CONTINUE CD

; CDD - D OR ND - DELETE AN ARBITRARY # CHARACTERS FROM TEXT BUFFER

CDD:	PUSHJ	P,ARGK		; KLUGE ARG IF NECESSARY
	PUSH	CP,[JSP PC,$$D]	; GEN CALL TO $$D
	JRST	CDCRET		; AND CONTINUE CD

; CDC0 - C OR -C OR NC - MOVE THE BUFFER POINTER OVER N CHARS

CDC0:	PUSHJ	P,ARGK		; KLUDGE THE ARG IF THERE WASN'T ANY
	PUSH	CP,[JSP PC,$$C]	; GEN CODE TO CALL $$C
	JRST	CDCRET		; AND CONTINUE CD

; CDR - R OR -R OR NR - MOVE THE BUFFER POINTER BACKWARDS N CHARS

CDR:	PUSHJ	P,ARGK		; KLUDGE THE ARG IF THERE WASN'T ANY
	PUSH	CP,[JSP PC,$$R]	; GEN CODE TO CALL $$R
	JRST	CDCRET		; AND CONTINUE CD

; CDJ - J OR NJ - POSITION THE BUFFER POINTER TO A SPECIFIC POSITION

CDJ:	TXNN	F,F$1RG		;[12000] any argument given?
	 PUSH	CP,[SETZ ARG,]	;[12000] no so make it zero
	PUSH	CP,[JSP PC,$$J]	; GEN CODE TO CALL $$J
	JRST	CDCRET		; AND CONTINUE CD
; CDP - P OR NP OR N,MP OR PW OR NPW - PUNCH ALL OR PART OF CURRENT PAGE
;	- P - PUNCH ALL OF CURRENT PAGE
;	- NP - PUNCH CURRENT PAGE AND NEXT N-1 PAGES
;	- N,MP - PUNCH CHARS N+1 THRU M AND LEAVE BUFFER INTACT
;	- PW - PUNCH CURRENT PAGE AND APPEND FF CHAR AND LEAVE BUFFER INTACT
;	- NPW - PERFORM "PW" N TIMES

CDP:	;[16000] Fix so m,nPW doesn't do W
	PUSHJ	P,ARGK		; NO, KLUDGE ARG IF NOT PRESENT
	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 SKP			;[303] NONE, MEANS NOT PW
	CAIN	C,"W"		; IS COMMAND "PW"?
	 JRST	CDP1		;  Yes, gobble character
	PUSHJ	P,CMDBCH	; NOT "W", BACK UP OVER THE CHAR
	SKIPA	X,[JSP PC,$$P]	; AND GEN CALL TO $$P FOR "P" OR "NP"
CDP1:	 MOVE	X,[JSP PC,$$PW] ; YES. FETCH CALL TO $$PW
	TXNE	F,F$2RG		;[16000] m,nP?
	 HRRI	X,$$BP		;[16000] Gen code for bounded punch
	PUSH	CP,X		;[16000] Gen it, whatever it was
	JRST	CDCRET		; AND CONTINUE CD

CDP2:	PUSH	CP,[JSP PC,$$BP] ; GEN CALL TO $$BP FOR "N,MP"
	JRST	CDCRET		; AND CONTINUE CD

; CDY - Y OR NY - RENDER THE BUFFER EMPTY AND APPEND A BUFFER

CDY:	TXNE	F,F$1RG!F$2RG	;[14000] Given an argument?
	 ERROR	(NYA)		;[14000] Yes. He probably blew it
	SKIPE	MACLVL		;[12000] IN A MACRO?
	JRST	CDEY		; YES, TREAT SAME AS "EY"
	PUSHJ	P,ARGK		;[12000] Default to 1
	PUSH	CP,[JSP PC,$$Y]	;[12000] Allow yank if buffer empty
	JRST	CDCRET		;[12000] continue compiling
; CDF - FXXX - THE "F" COMMANDS

CDF:	PUSHJ	P,CMDGCH	; FETCH THE NEXT COMMAND CHARACTER
	 ERROR	(MEF)		; NONE LEFT. ** MACRO ENDING WITH F **
	PUSHJ	P,UPCASE		; UPCASE THE CHAR
	MOVE	T1,[IOWD FLTH,FTBL+1] ; FETCH PTR TO DISPATCH TABLE
	PUSHJ	P,DISPAT	; AND DISPATCH ON THE CHAR
	ERROR	(IFC)		; ** ILLEGAL F COMMAND **

; DISPATCH TABLE FOR THE "F" COMMANDS

FTBL:	<"S",,CDFS>
	<"Q",,CDFQ>		;[12000] FQ -- QCM Compare Q-reg w/ text
	<"N",,CDFN>
	<"D",,CDFD>
	<"R",,CDFR>		;[12000] FR command (Replace on last search)
	<"Y",,CDFY>		;[14000] Vertical cursor position
	<"X",,CDFX>		;[14000] Horizontal cursor position
	<"C",,CDFC>		;[14000] Bounded search/replace
	<"P",,CDFP>		;[12000] FY,FX
	<"0",,CDF0>		;[14000] Start of window
	<"B",,CDFB>		;[14000] Bounded search
	<"Z",,CDFZ>		;[12000] End of window
	<"H",,CDFH>		;[12000] F0,FZ
	<"F",,CDFF>		;[12000] Adjust cursor
	<"K",,CDFK>		;[14000] FK replaces FD
	<"T",,CDFT>		;[21000] Tab stops
FLTH==.-FTBL

; CDFB - FBSTR$	 -  BOUNDED SEARCH

CDFB:	PUSHJ	P,ARGK		;[15000] Default arg if none
	MOVE	T2,[JSP PC,$$BS] ;[14000] Fetch call to 2-arg form
	TXNN	F,F$2RG		;[14000] Have we 2 argments?
	 HRRI	T2,$$BSL	;[14000] NO. must be line argument
	JRST	CDS1		;[14000] Join common search code

; CDFC - FCSTR1$STR2$  - BOUNDED SEARCH/REPLACE

CDFC:	PUSHJ	P,ARGK		;[15000] Default arg if none
	MOVE	T2,[JSP PC,$$BS] ;[14000] Fetch call for 2-arg form
	TXNN	F,F$2RG		;[14000] Have we 2 arguments?
	 HRRI	T2,$$BSL	;[14000] No. must be a line argument
	JRST	CDFS1		;[14000] Gen it & fall into common FS code

; CDFN - FNSTR1$STR2$  - FIND "STR1" (USING N-SEARCH) AND SUBSTITUTE "STR2"

CDFN:	SKIPA	T2,[JSP PC,$$N]	; FETCH CALL FOR N-SEARCH

; CDFS - FSSTR1$STR2$ - FIND "STR1" (USING S-SEARCH) AND SUBSTITUTE "STR2"
;
; GEN:	JSP	PC,$$S
;	<CHAR.ADR,,TEXT.LENGTH>
;	JSP	PC,$$FS
;	<CHAR.ADR,,CHAR.LENGTH>

CDFS:	 MOVE	T2,[JSP PC,$$S]	; FETCH CALL FOR S-SEARCH
	PUSHJ	P,ARGK		; KLUDGE ARG IF NOT PRESENT
	TXNE	F,F$2RG		; IS IT A BOUNDED SEARCH?
	 HRRI	T2,$$BS		; YES (SAME FOR FS,FN)
	PUSHJ	P,CHKITR	; IN AN ITERATION?
	 JRST	CDFS1		; NO, CONTINUE NORMALLY
	TXNN	F,F$COL		; ALREADY RETURNING A VALUE?
	 PUSH	CP,[TXO F,F$COL] ; NO, GEN CODE TO SET FLAG
CDFS1:	PUSH	CP,T2		; GEN THE SEARCH CALL
	PUSH	P,T4		; SAVE AC T4
	PUSHJ	P,SSTPSC	; PRESCAN THE SEARCH ARG
	PUSH	P,T2		;[21000] Save the delimiter
	PUSHJ	P,SSTGSM	; GEN THE SEARCH MATRIX FOR SYNTAX CHECK
	POP	P,T3		;[21000] Get back delimiter
	POP	P,T4		; RESTORE AC T4
	PUSH	CP,[JSP PC,$$FS] ; GEN THE CALL TO THE SUBSTITUTE ROUTINE
	PUSHJ	P,CDI1		; SCAN THE INSERTION [21000] knowing the delim
	JRST	CDS2		; GEN CODE FOR SEARCH AUTOTYPE

; CDFR	Entry for doing replace after already having done search
;

CDFR:	PUSH	CP,[JSP PC,$$FS] ; GEN THE CALL TO THE SUBSTITUTE ROUTINE
	PUSHJ	P,CDCINS	; SCAN THE INSERTION
	JRST	CDCRET		; Continue compilation...

; CDFD -FDSTR$ - Find & destroy "STR" [14000]
; GEN:	JSP	PC,$$S
;	<CHAR.ADR,,TEXT.LENGTH>
;	JSP	PC,$$FS
;	<0>			;Just like FS with null second argument

CDFD:	 MOVE	T2,[JSP PC,$$S]	; FETCH CALL FOR S-SEARCH
	PUSHJ	P,ARGK		; KLUDGE ARG IF NOT PRESENT
	TXNE	F,F$2RG		; IS IT A BOUNDED SEARCH?
	 HRRI	T2,$$BS		; YES (SAME FOR FS,FN)
	PUSHJ	P,CHKITR	; IN AN ITERATION?
	 JRST	CDFD1		; NO, CONTINUE NORMALLY
	MOVE	X,[TXO F,F$COL]	;[12000] gen code for setting bit if needed
	TXNN	F,F$COL		; ALREADY RETURNING A VALUE?
	 PUSH	CP,X		; NO, GEN CODE TO SET FLAG
CDFD1:
	PUSH	CP,T2		; GEN THE SEARCH CALL
	PUSH	P,T4		; SAVE AC T4
	PUSHJ	P,SSTPSC	; PRESCAN THE SEARCH ARG
	PUSHJ	P,SSTGSM	; GEN THE SEARCH MATRIX FOR SYNTAX CHECK
	POP	P,T4		; RESTORE AC T4
	PUSH	CP,[JSP PC,$$FS] ;[14000] Gen call to replace routine
	PUSH	CP,[0]		;[14000] replace with nothing
	JRST	CDS2		;[14000] Gen code for search autotype


; CDFK - FKSTR$ - FIND "STR" (USING S-SEARCH) AND DESTROY ALL UP TO
;		  AND INCLUDING "STR"
;
; GEN:	PUSH	P,PTVAL
;	JSP	PC,$$S
;	<CHAR.ADR,,TEXT.LENGTH>
;	POP	P,ARG
;	SUB	ARG,PTVAL
;	JSP	PC,$$D

CDFK:				;[14000] Used to be FD
	PUSH	CP,[PUSH P,PTVAL] ;[377] GEN CODE TO SAVE VALUE OF "."
	MOVE	T2,[JSP PC,$$S]	;[377] FETCH CALL FOR S-SEARCH
	PUSHJ	P,ARGK		;[377] KLUDGE ARG IF NOT PRESENT
	TXNE	F,F$2RG		;[377] BOUNDED SEARCH?
	 HRRI	T2,$$BS		;[377] YES
	PUSHJ	P,CHKITR	;[377] IN AN ITERATION?
	 JRST	CDFK1		;[377] NO, NORMAL FD
	TXNN	F,F$COL		;[377] ALREADY RETURNING A VALUE?
	 PUSH	CP,[TXO F,F$COL];[377] GEN CODE TO SET FLAG
CDFK1:	PUSH	CP,T2		;[377] GEN THE SEARCH CALL
	PUSH	P,T4		;[377] SAVE AC T4
	PUSHJ	P,SSTPSC	;[377] PRESCAN SEARCH ARG
	PUSHJ	P,SSTGSM	;[377] GEN THE SEARCH MATRIX FOR SYNTAX CHECK
	POP	P,T4		;[377] RESTORE AC T4

	PUSH	CP,[POP P,ARG]	;[377] GEN CODE TO GET OLD VALUE OF "."
	PUSH	CP,[SUB ARG,PTVAL] ;[377] GEN CODE TO COMPUTE DESTORY #
	PUSH	CP,[JSP PC,$$D]	;[377] GEN CODE TO DESTROY
	JRST	CDS2		;[377] GEN CODE FOR SEARCH AUTOTYPE

; VARIOUS WINDOW PARAMETERS [12000]

CDFH:	;Set or retrieve start & end of window

	TXCN	F,F$2RG		;[12000] 2 arguments given?
	 JRST	[PUSH CP,[MOVE SARG,WINB] ;[12000] Return both values
		 PUSH CP,[MOVE VALUE,WINZ] ;[12000] ...
		 JRST CDCVAL]	;[12000] Return values
	PUSH	CP,[MOVEM SARG,WINB] ;[12000] Set the Window beginning
				;[12000] Fall through to set Window end


CDFZ:	;Set or retrieve End of window

	SKIPA	X,[MOVE VALUE,WINZ]	;[12000]

CDF0:	;Set or retrieve Start of window

	MOVE	X,[MOVE VALUE,WINB] ;[12000] Fetch the row the cursor is on
	JRST	CDRSV		;[12000] Do it to it

CDFP:	;Set or retrieve both row & column of cursor position

	TXCN	F,F$2RG		;[12000] 2 arguments given?
	 JRST	[PUSH CP,[MOVE SARG,ROW] ;[12000] Return both values
		 PUSH CP,[MOVE VALUE,COL] ;[12000] ...
		 JRST CDCVAL]	;[12000] Return values
	PUSH	CP,[MOVEM SARG,ROW] ;[12000] Set the row
				;[12000] Fall through to set column

CDFX:	;Set or retrieve column cursor is in

	SKIPA	X,[MOVE VALUE,COL] ;[12000] Fetch the column the cursor is on
CDFY:	;Set or retrieve row cursor is in

	MOVE	X,[MOVE VALUE,ROW] ;[12000] Fetch the row the cursor is on

CDRSV:	;[12000] Entry to generate
		;	MOVE VALUE,FOO	if no arg, or
		;	MOVEM ARG,FOO	if there is an arg

	TXNN	F,F$1RG		;[12000] Does it have an argument?
	 JRST	CDCFVA		;[12000] Gen it & return value

CDCFNV:	HRLI	X,(MOVEM ARG,)	;[12000] Change the value
CDCFV2:	PUSH	CP,X		;[12000] Gen the instruction
	JRST	CDCRET		;[12000] Return no value

CDCFVA:	PUSH	CP,X		;[12000] Gen the instruction
	JRST	CDCVAL		;[12000] Return value

; CDFF - FF - Adjust cursor position

CDFF:	MOVE	X,[JSP PC,$FF2]	;[12000] Fetch call to 2-arg form
	TXZN	F,F$2RG		;[12000] 2 args different
	 HRRI	X,$FF1		;[12000] from 1 arg
	PUSH	CP,X		;[12000] Put into code
	JRST	CDCVAL		;[12000] Continue & return value

; CDFT - Get or Set TAB stops	;[21000]

CDFT:	MOVE	X,EDVAL		;[23000] If optimizing, ...
	TXNE	X,ED$OPT	;[23000] no range check
	 JRST	CDFT0		;[23000] ...
	PUSH	CP,[SKIPL ARG]	;[23000] Negative n.g.
	PUSH	CP,[CAIL ARG,C$NTS] ;[25000] or too big
	PUSH	CP,[ERROR (AOR)];[23000] ** ARG OUT OF RANGE **
CDFT0:	TXZN	F,F$2RG		;[21000] 2 ARGS?
	 JRST	[PUSH CP,[MOVE VALUE,TSTOPS(ARG)] ;[21000] Gen code
		 JRST CDCVAL]	;[21000] Return value
	PUSH	CP,[MOVEM SARG,TSTOPS(ARG)] ;[21000] Gen code to set
	JRST	CDCRET		;[21000] Return no value

; CDK - K OR NK OR N,MK - REMOVE LINES FROM TEXT BUFFER

CDK:	PUSHJ	P,ARGK		; KLUDGE ARG IF NONE PRESENT
	MOVE	X,[JSP PC,$$K]	; FETCH CALL TO $$K FOR N,MK
	TXNN	F,F$2RG		; IS IT "N,MK"?
	 HRRI	X,$$KL		; NO, IT'S "NK"
	PUSH	CP,X		; GEN THE CALL TO $$K OR $$KL
	JRST	CDCRET		; AND CONTINUE CD

; CDL - L OR NL - MOVE TO ANOTHER LINE RELATIVE TO "."

CDL:	PUSHJ	P,ARGK		; IN CASE NO ARG PRESENT
	TXNE	F,F$2RG		; TWO ARGS PRESENT?
	 ERROR	(TAL)		; YES. ** TWO ARGUMENTS FOR L **
	PUSH	CP,[JSP PC,$$L]	; GEN CALL TO $$L
	JRST	CDCRET		; AND CONTINUE CD

; CDS - STEXT$ - SEARCH THE TEXT BUFFER  FOR AN OCCURRANCE OF "TEXT"
;	NSTEXT$ - NTH OCCURRANCE
;	N,MSTEXT$ - WITHIN BOUNDS
;	-STEXT$ - BACKWARDS SEARCH
;	-NSTEXT$ - NTH OCCURRANCE (SEARCHING BACKWARDS)
;	M,NSTEXT$ - WITHIN BOUNDS N,M (SEARCHING BACKWARDS, M.GT.N)

CDS:	PUSHJ	P,ARGK		; IN CASE THERE IS NO ARG PRESENT
	MOVE	T2,[JSP PC,$$S]	; FETCH CODE TO CALL $$S
CDS0:	TXNE	F,F$2RG		; TWO ARGUMENTS PRESENT?
	 HRRI	T2,$$BS		; YES, THEN IT'S A BOUNDED SEARCH
	PUSHJ	P,CHKITR	; IN AN ITERATION?
	 JRST	CDS1		; NO

;; SEARCHES INSIDE ITERATIONS ARE THE SAME AS ":" SEARCHES

	TXNN	F,F$COL		; ALREADY A ":" SEARCH ?
	 PUSH	CP,[TXO F,F$COL]; NO, GEN THE INST. TO SET ":" FLAG
CDS1:	PUSH	CP,T2		; GEN THE CALL TO $$S OR $$BS
	PUSH	P,T4		; SAVE AC L
	PUSHJ	P,SSTPSC	; PRESCAN THE SEARCH STRING
	PUSHJ	P,SSTGSM	; GENERATE DUMMY SEARCH MATRIX
				; TO CHECK SYNTAX
	POP	P,T4		; RESTORE AC L
CDS2:	TXNE	F,F$COL		; IS IT A ":" SEARCH?
	 JRST	CDCRET		; YES, DON'T AUTOTYPE AFTER SEARCH
	PUSHJ	P,CHKITR	; IN AN ITERATION? [16000] removed2 inst
	 JRST	[PUSH CP,[JSP PC,$$0TT] ; GEN CALL TO SEARCH AUTOTYPE ROUTINE
		 JRST CDCRET]	;[16000] And don't fake a ; in any case
	PUSHJ	P,CMDGCH	;[16000] See if ; follows
	 JRST	.+3		;[16000] Don't check the character, then
	CAIE	C,";"		;[16000] Is this a ; ?
	 PUSHJ	P,CMDBCH	;[16000] Back up over it
	PUSH	CP,[JSP PC,$$SEMF] ;[16000] Exit if I fail
	PUSH	CP,[TXZ F,F$COL!F$2CO] ;[16000] Clear colons at runtime
	JRST	CDCRET		;[16000] Return no value

; CDN - SAME AS THE S COMMAND EXCEPT SEARCH THRU WHOLE FILE

CDN:	PUSHJ	P,ARGK		; IN CASE NO ARG IS PRESENT
	MOVE	T2,[JSP PC,$$N]	; FETCH CALL TO $$N
	JRST	CDS0		; AND SCAN REST OF "N" COMMAND

; CDBAR - SAME AS "N" SEARCH EXCEPT THAT NOTHING IS OUTPUT

CDBAR:	PUSHJ	P,ARGK		; IN CASE NO ARG IS PRESENT
	MOVE	T2,[JSP PC,$$BAR] ; FETCH CALL TO $$BAR
	JRST	CDS0		; SCAN SEARCH ARG AND CONTINUE CD

; CDT - T OR NT OR N,MT - TYPE TEXT FROM BUFFER

CDT:	PUSHJ	P,ARGK		; IN CASE NO ARGS
	MOVE	X,[JSP PC,$$T]	; FETCH CALL TO $$T
	TXNN	F,F$2RG		; IS IT "N,MT"?
	 HRRI	X,$$TL		; NO, IT'S "NT"
	PUSH	CP,X		; GEN THE CALL TO $$T OR $$TL
	JRST	CDCRET		; AND CONTINUE CD

; CDV - V or nV - (1-n)TnT - TYPE TEXT FROM BUFFER IN WHOLE LINES

CDV:	PUSHJ	P,ARGK		;[12000] In case of no args do 0TT
	PUSH	CP,[JSP PC,$$V] ;[12000] Gen call to $$V
	JRST	CDCRET		;[12000] no value

; CDW - W or nW or n:W or m,n:W - Manipulate screen parameters or window

CDW:	TXZE	F,F$COL		;[12000] W or :W?
	 JRST	CDCOLW		;[12000] :W
	TXNN	F,F$1RG		;[15000] Set argument defaults
	 PUSH	CP,[MOVE ARG,DEFARG] ;[15000] no args at all
	TXNN	F,F$2RG		;[15000] No second argument anyway
	 PUSH	CP,[MOVE SARG,DEFARG] ;[15000] ...
	PUSH	CP,[JSP PC,$$W] ;[15000] Gen macro call to ([W])
	JRST	CDCRET		;[12000] no value

CDCOLW:
	MOVE	X,[JSP PC,$$COLW] ;[15000] Gen macro call to ([:W]) 
	TXZE	F,F$2RG		;[15000] 1 or 2 arg form
	 HRRI	X,$$CW2		;[15000] 2 arg.
	PUSH	CP,X		;[15000] Gen it
	JRST	CDCVAL		;[15000] and/or set/read parameter
REPEAT 0,<
	TXZE	F,F$2RG		;[12000] 2 args?
	 JRST	[PUSH CP,[JSP PC,$$COLW] ;[12000] Gen call to setter
		 JRST CDCCLR]	;[12000] return no value
	MOVE	X,EDVAL		;[12000] see if 'optimized'
	TXNE	X,ED$OPT	;[12000] if so, no range check!!
	 JRST	CDCW1		;[12000] skip check (hope his macro's debugged!)
	PUSH CP,[CAIG ARG,CWMAX]	;[12000] range check
	PUSH CP,[SKIPGE ARG]		;[12000] negative n.g too
	PUSH CP,[ TDZA VALUE,VALUE]	;[12000] n.g. return 0
CDCW1:!	PUSH CP,[MOVE VALUE,CWVEC(ARG)] ;[12000] Get parameter
	JRST CDCVL1		;[12000] Continue (return value)
>
; CDU - NUQ - STORE NUMERIC ARG IN Q-REGISTER

CDU:	TXNN	F,F$1RG		; AN ARG PRESENT?
	 ERROR	(NAU)		; NO. ** NO ARG BEFORE U **

	PUSHJ	P,GENQRG	;[22000] Parse the q-register name
	 JRST	[PUSH	CP,[JSP PC,$$U]	; GEN CODE TO CALL ROUTINE
		 PUSH	CP,N	;[22000] WHICH STORES Q-REGISTER CONTENTS
		 JRST	CDU1]	; GEN THE Q-REGISTER NAME INTO CODE
	ADD	N,[MOVEM ARG,QREG+1]	;[22000] Generate instruction
CDU0:	PUSH	CP,N			;[22000] into code
	TXZN	F,F$COL		;[23000] :U fudges text also
	 JRST	CDU1		;[23000] NOT THIS TIME
	PUSH	CP,[TXZ F,F$COL];[23000] Clear : at run time
	SOJA	N,CDU0		;[23000] do the text, too
CDU1:	TXZN	F,F$2RG		;[14000] Did we get 2 arguments
	 JRST	CDCRET		; AND CONTINUE CD
	PUSH	CP,[MOVE VALUE,SARG] ;[14000] Second one is our value
	JRST	CDCVAL		;[14000] So return a value

; CDQ - QQ - RETURN VALUE OF A NUMERIC Q-REGISTER

CDQ:
	TXZE	F,F$1RG!F$COL	;[12000] Check IF ANY ARGS or ":Q"
	 JRST	[MOVE X,EOVAL	;[12000] See if random access enabled
		 CAIGE X,3	;[12000] (i.e. if EO GEQ 3)
		  JRST .+1	;[12000] it wasn't
		 PUSH CP,[JSP PC,$$QRX] ;[12000] get nth char of text
		 JRST CDQ0]	; [12000] rejoin
	MOVE	X,EDVAL		;[22000] Do winning thing if optimizing
	TXNE	X,ED$OPT	;[22000] ...
	 JRST	[PUSHJ P,GENQRG	;[22000] We are, so try to win
		  JRST	[PUSH CP,[JSP PC,$$Q] ;[22000] But we can't win
CDQFZ:			 PUSH CP,N	;[22000] 'cause it's a long name
			 JRST CDCVAL]	;[22000] so do the same old thing
		 ADD N,[MOVE VALUE,QREG+1] ;[22000] Build instruction
		 JRST CDQFZ]	;[22000] And generate the code

	PUSH	CP,[JSP PC,$$Q]	; GEN CALL TO RETURN CONTENTS OF Q-REGISTER
CDQ0:	PUSHJ	P,MAKQNM	; GEN THE Q-REGISTER NAME INTO CODE
	JRST	CDCVAL		; AND CONTINUE CD

; CDX - NXQ OR N,MXQ OR XQ - STORE TEXT FROM BUFFER INTO Q-REGISTER

CDX:	PUSHJ	P,ARGK		; KLUDGE THE ARG IF NOT PRESENT
	MOVE	X,[JSP PC,$$X]	; FETCH THE CALL TO $$X
	TXNN	F,F$2RG		; IS ARG A # OF LINES?
	 HRRI	X,$$XL		; YES, FETCH CALL TO $$XL
	PUSH	CP,X		; GEN THE CALL TO $$X OR $$XL
	PUSHJ	P,MAKQNM	; GEN THE Q-REGISTER NAME
	JRST	CDCRET		; AND CONTINUE CD

; CDG - GQ - GET THE TEXT CONTAINED IN A Q-REGISTER AND INSERT INTO BUFFER

CDG:	PUSH	CP,[JSP PC,$$G]	; GEN CALL TO $$G
	PUSHJ	P,MAKQNM	; GEN THE Q-REGISTER NAME
	JRST	CDCCLR		; AND CONTINUE CD

; CDCPCT - %Q - INCREMENT Q AND RETURN RESULTING VALUE

CDPCT:	PUSHJ	P,GENQRG	;[22000] Parse q-register name
	 JRST	[TXNE	F,F$1RG		;[12000] Argument present?
		  PUSH	CP,[TXO F,F$1RG] ;[12000] yes
		 PUSH	CP,[JSP PC,$$INC] ; GEN CALL TO $$INC
		 PUSH	CP,N	; GEN Q-REGISTER NAME INTO CODE
		 JRST CDCVAL]	;[22000] Return value
	ADD	N,[ADDB ARG,QREG+1] ;[22000] Make instruction
	TXNN	F,F$1RG		;[23000] Any arguments?
	 JRST	[HRLI N,(AOS VALUE,) ;[23000] Just increment it then
		 PUSH CP,N	;[23000] gen into code
		 JRST CDCVAL]	;[23000] Return value
	PUSH	CP,N		;[22000] and generate code
	PUSH	CP,[MOVE VALUE,ARG] ;[22000] Make it return the value
	JRST	CDCVAL		; AND CONTINUE CD

; CDM - MQ - COMPILE AND EXECUTE THE TEXT IN Q-REGISTER Q

CDM:	HLR	X,F		;[344] COPY FLAGS
	ANDI	X,(F$$RG)	;[344] AND TO GET ONLY ARG FLAGS
				;[344] I REALIZE THIS MEANS ARG FLAGS
				;[344] CAN ONLY BE IN LEFT HALF, BUT
				;[344] THEY ARE HERE, AND WE CAN'T TXO
				;[344] AT RUN TIME!!!
	JUMPE	X,.+2		;[344] SKIP NEXT INSTRUCTION IF NO ARGS
	PUSH	CP,[SETOM MACFLG] ;[344] SET THE MACRO FLAG AT EXECUTION
	HRLI	X,(TLO F,)	;[344] FINISH MAKING INSTRUCTION
	PUSH	CP,X		;[344] SAVE THE ARG FLAG SETTING THING
	PUSH	CP,[JSP PC,$$M]	; GEN CALL TO $$M
	PUSHJ	P,MAKQNM	; GEN THE Q-REGISTER NAME INTO CODE
	JRST	CDCVAL		; AND CONTINUE CD
; CDE - EX... - "E" FILENTROL AND FLAG COMMANDS

CDE:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 JRST	CDEND		;[12000] Go to end of line
	PUSHJ	P,UPCASE	; UPCASE THE CHAR
	MOVE	T1,[IOWD ECLTH,ECTBL+1] ; AOBJN PTR TO "E" CMD DISPATCH TABLE
	PUSHJ	P,DISPAT	; DISPATCH TO SPECIFIC "E" COMMAND
	 ERROR	(IEC)		; ** ILLEGAL E COMMAND **

;[12000] E(space)  go to end of that line
CDEND:	PUSHJ	P,ARGK		;[12000] Default is 1
	PUSH	CP,[JSP PC,$$E]	;[12000] Do it
	JRST	CDCRET		;[12000] Back for more (no value)

; DISPATCH TABLE FOR "E" COMMANDS

	DEFINE	EC(CMDS)<IRPC CMDS,<<"CMDS",,CDE'CMDS>>>

ECTBL:
	EC	(ABCDEFGHIJKLMNOPQRSTUWXYZ)
	<"%",,CDEPCT>		;[14000] E% write out q-register
	<"@",,CDEATS>		;[12000] E@ set delimiter
	<"#",,CDCNU1>		;[12000] USETI (not standard)
	<"&",,CDEAND>		;[14000] E& run program when we exit
	<"!",,CDSCD>		;[12000] E! set command delimiter
	<"_",,CDEBAR>		;[14000] Unprotectable "_" cmd.
	<"*",,CDESTA>		;[14000] TRMOP.
	<"=",,CDEEQU>		;[14000] Rename input file
	<"?",,CDEQUE>		;[15000] E?q get cmd into q-register
	<" ",,CDEND>		;[16000] E<CR> E<LF> E<SPACE> E$ E<ALT>
	<15,,CDEND>		;[16000] get the E command
	<12,,CDEND>		;[16000]
	<.CHESC,,CDEND>		;[16000]
	<"$",,CDEND>		;[16000]
	<42,,CDEQUE>		;[16000] E"q get cmd into q-register

ECLTH==.-ECTBL
; CDEY - EY - NEW FORM OF THE "YANK" COMMAND

CDEY:	PUSHJ	P,ARGK		; ASSUME ARG OF "1" IF NONE GIVEN
	PUSH	CP,[JSP PC,$$EY]	; GEN CALL TO $$Y
	JRST	CDCRET		; AND CONTINUE CD

; CDEC - EC AND NEC - RETURN AND SET LOWSEGMENT SIZE
;
; GEN:	JSP	PC,$$EC		; (OR $$ECS TO SET LOWSEG SIZE)
;	<RETURN>

CDEC:	MOVE	X,[JSP PC,$$EC] ; FETCH CALL TO $$EC
	TXNE	F,F$1RG		; IS IT "NEC"?
	 HRRI	X,$$ECS		; YES, GEN CALL TO $$ECS
	PUSH	CP,X		; GEN THE CALL TO WHATEVER

	TXNE	F,F$1RG		; RETURN A VALUE?
	 JRST	CDCRET		; NO, CONTINUE CD
	JRST	CDCVAL		; YES, CONTINUE CD

; CDEB - EBFILESPEC$ - SETUP FOR EDITTING A FILE
;
; GEN:	JSP	PC,$$EB
;	<FILE.SPEC>
;	(RETURN)

CDEB:	PUSH	CP,[JSP PC,$$EB] ; GEN CALL TO $$EB
CDEXX:	PUSHJ	P,CDFSPC	; GEN THE FILE SPEC
	JRST	CDALT		; AND CONTINUE CD

; CDER - ERFILESPEC$ - SETUP FOR READING A FILE
;
; GEN:	JSP	PC,$$ER
;	<FILE.SPEC>
;	(RETURN)

CDER:	PUSH	CP,[JSP PC,$$ER] ; GEN CALL TO $$ER
	JRST	CDEXX		; GEN FILE SPEC AND CONTINUE CD

; CDEW - EWFILESPEC$ - SETUP FOR WRITING TO A FILE
;
; GEN:	JSP	PC,$$EW
;	<FILE.SPEC>
;	(RETURN)

CDEW:	PUSH	CP,[JSP PC,$$EW] ; GEN CALL TO $$EW
	JRST	CDEXX		; GEN FILE SPEC AND CONTINUE CD
; CDEZ - EZFILESPEC$ - ZERO DIRECTORY AND SETUP FOR WRITING TO A FILE
;
; GEN:	JSP	PC,$$EZ
;	<FILE.SPEC>
;	(RETURN)

CDEZ:	PUSH	CP,[JSP PC,$$EZ] ; GEN CALL TO $$EZ
	JRST	CDEXX		; GEN FILE SPEC AND CONTINUE CD

; CDEF - EF - CLOSE OUTPUT FILE
;
; GEN:	JSP	PC,$$EF
;	(RETURN)

CDEF:	PUSH	CP,[JSP PC,$$EF] ; GEN CALL TO $$EF
	JRST	CDCRET		; AND CONTINUE CD

; CDEK - EK - FLUSH OUTPUT FILE  and  Cancel "EB" if any
;
; GEN:	JSP	PC,$$EK
;	(RETURN)

CDEK:	PUSH	CP,[JSP PC,$$EK] ; GEN CALL TO $$EK
	JRST	CDCRET		; AND CONTINUE CD

; CDEX - EX - PUNCH REST OF INPUT FILE AND EXIT
;
; GEN:	JSP	PC,$$EX
;	(RETURN)		; IF USER TYPES "CONTINUE" AFTER EXIT

CDEX:	PUSH	CP,[JSP PC,$$EX] ; GEN CALL TO $$EX
	JRST	CDCRET		; AND CONTINUE CD

; CDEG - EG - PUNCH REST OF INPUT FILE AND EXIT AND PERFORM LAST
;	COMPILE-CLASS COMMAND

CDEG:	PUSH	CP,[JSP PC,$$EG] ; GEN CALL TO $$EG
	JRST	CDCRET		; AND CONTINUE CD

; CDEM - NEM - PERFORM MAGTAPE OP N
;
; GEN:	JSP	PC,$$EM
;	(RETURN)

CDEM:	PUSH	CP,[JSP PC,$$EM] ; GEN CALL TO $$EM
	JRST	CDCRET		; AND CONTINUE CD

; CDED - EDFILE-SPEC$ - SETUP FILE TO BE RUN ON EXIT

CDED:	SKIPN	EOVAL		;[12000] 0EO does run with ED
	 JRST	CDEAND		;[12000]  same as E&
	MOVE	X,[MOVE VALUE,EDVAL] ;[12000] Prepare to fetch value
CDCRSB:				;[12000] Enter here to set or get bits
	TXNN	F,F$2RG		;[12000] 2 arguments?
	 JRST	CDRSV		;[12000] no, just like all the others
	HRLI	X,(ANDCAM SARG,) ;[12000] Clear these bits first
	PUSH	CP,X		;[12000] gen into code
	HRLI	X,(IORM ARG,)	;[12000] now set these bits
	JRST	CDCFV2		;[12000] Gen into code & return no value

CDEAND:	PUSH	CP,[JSP PC,$$RUNP] ; GEN CALL TO $$RUNP
	JRST	CDEXX		; SCAN FILE SPEC AND CONTINUE CD

; CDEI - EIFILE-SPEC$ - EDIT INDIRECT (EXECUTE AN INDIRECT COMMAND FILE)

CDEI:	HLR	X,F		;[345] COPY FLAGS
	ANDI	X,(F$$RG)	;[345] ISOLATE ARGUMENT FLAGS
	JUMPE	X,.+2		;[345] SKIP NEXT IF NO ARG
	PUSH	CP,[SETOM MACFLG] ;[345] SET THE MACRO ARGUMENT FLAG
	HRLI	X,(TLO F,)	;[345] FINISH RESETTING FLAGS INST.
	PUSH	CP,X		;[345] SAVE FOR RUN TIME
	PUSH	CP,[JSP PC,$$EI] ; GEN CALL TO $$EI
	JRST	CDEXX		; SCAN FILE-SPEC AND CONTINUE CD

CDEBAR:				;[14000] E_ same as _ but always legal
	PUSHJ	P,ARGK		;[14000] Generate an argument if none
	MOVE	T2,[JSP PC,$$EBAR] ;[14000] Call to routine
	JRST	CDS0		;[14000] Join search code
; CDEP - EPFILE-SPEC$ - READ A FILE INTO Q-REGISTER "*"

CDEP:
	PUSH	CP,[JSP PC,$$EQ] ; GEN CALL TO $$EQ
	PUSH	CP,['*     ']	;[12000] Q-register name for EP command
	JRST	CDEXX		; SCAN FILE-SPEC AND CONTINUE CD

; CDEQ - EQ(Q-REG)FILE-SPEC$ - READ A FILE INTO Q-REGISTER

CDEQ:	PUSH	CP,[JSP PC,$$EQ] ; GEN CALL TO $$EQ
	PUSHJ	P,MAKQNM	;[12000] Get q-register name
	JRST	CDEXX		; SCAN FILE-SPEC AND CONTINUE CD

; CDEPCT - E%(Q-REG)FILE-SPEC$ - WRITE A FILE FROM Q-REGISTER

CDEPCT:	PUSH	CP,[JSP PC,$$EPCT] ; GEN CALL TO $$EPCT
	PUSHJ	P,MAKQNM	;[12000] Get q-register name
	JRST	CDEXX		; SCAN FILE-SPEC AND CONTINUE CD

; CDEE - EEFILE-SPEC$ - SAVE STATE IN A FILE (A RUNNABLE FILE)

CDEE:	PUSH	CP,[JSP PC,$$EE] ; GEN CALL TO $$EE
	JRST	CDEXX		; SCAN FILE-SPEC AND CONTINUE CD

; CDEA - EAFILE-SPEC$ - SAME AS "EW" BUT APPEND TO EXISTING FILE

CDEA:	PUSH	CP,[JSP PC,$$EA] ; GEN CALL TO $$EA
	JRST	CDEXX		; SCAN FILE SPEC AND CONTINUE CD

; CDECAR - E^FILE-SPEC$ - RENAME CURRENT INPUT FILE

CDEN:	ERROR	(UEN)		;[16000] Unimplemented command

CDEEQU:
	PUSH	CP,[JSP PC,$$RENM] ; GEN CALL TO $$ECAR
	JRST	CDEXX		; SCAN FILE-SPEC AND CONTINUE CD

CDEQUE:
	PUSH	CP,[JSP PC,$$GETC]	;[15000] Gen call
	PUSHJ	P,MAKQNM	;[15000] And q-register name

	JRST	CDCVAL		;[15000] Will return -1 unless cmd erased
; CDET - ET OR NET - RETURN OR SET SUBSTITUTION TYPEOUT FLAG

CDET:	TXZE	F,F$1RG		; IS AN ARG PRESENT?
	 JRST	CDET1		; YES
	PUSH	CP,[MOVE VALUE,ETVAL] ; NO, GEN CODE TO RETURN ET FLAGS
	JRST	CDCVAL		; AND CONTINUE SCAN

CDET1:	TXZE	F,F$2RG		;[12000] 2 arg form?
	 PUSH	CP,[TXO F,F$2RG] ;[12000] Gen into code
	PUSH	CP,[JSP PC,$$ETS] ;[12000] Gen call to run-time routine
	JRST	CDCRET		; AND CONTINUE CD

; CDEO - EO OR NEO - RETURN OR SET EDIT OLD FLAG

CDEO:	TXNE	F,F$1RG		; IS AN ARG PRESENT?
	 JRST	CDEO1		; YES
	PUSH	CP,[MOVE VALUE,EOVAL] ; NO, GEN CODE TO RETURN EO FLAG
	JRST	CDCVAL		; AND CONTINUE CD

CDEO1:	PUSH	CP,[CAIL ARG,]	;[406] GEN CODE TO CHECK FOR .LT.0
	PUSH	CP,[CAILE ARG,C$EOVL] ;[406] GEN CODE TO CHECK FOR .LE.MAXIMUM
	PUSH	CP,[CERROR (EOA)] ;[406] "EO" ARGUMENT ERROR
	PUSH	CP,[MOVEM ARG,EOVAL] ; GEN CODE TO SET EO FLAG
	JRST	CDCRET		; AND CONTINUE CD

; CDEATS -- Set or return current delimiter

CDEATS:
	TXNN	F,F$1RG		;[12000] Arg?
	 JRST	[PUSH CP,[MOVE VALUE,DELIM] ;[12000] No
		 JRST CDCVAL]	;[12000]
	PUSH	CP,[MOVEM ARG,DELIM] ;[12000] Set delimiter at run time also
	TXNN	F,F$2RG		;[12000] 2 character delimiter?
	 PUSH	CP,[HRLM SARG,DELIM] ;[12000] yes
	JRST	CDCRET		;[12000] continue (novalue)

; CDSCD -- Set or return current command delimiter

CDSCD:
	TXNN	F,F$1RG		;[12000] Arg?
	 JRST	[PUSH CP,[MOVE VALUE,CDELIM] ;[12000] No
		 JRST CDCVAL]	;[12000]
	PUSH	CP,[MOVEM ARG,CDELIM] ;[12000] Set delimiter at run time also
	TXNE	F,F$2RG		;[12000] 2 character delimiter?
	 PUSH	CP,[MOVEM SARG,CDELIM+1] ;[12000] yes
	JRST	CDCRET		;[12000] continue (novalue)

; CDEU - EU OR NEU - SET OR RETURN CASE FLAGING FLAG

CDEU:	TXNE	F,F$1RG		; IS AN ARG PRESENT?
	 JRST	CDEU1		; YES
	PUSH	CP,[MOVE VALUE,EUVAL] ; NO, GEN CODE TO RETURN EU FLAG
	JRST	CDCVAL		; AND CONTINUE CD

CDEU1:	PUSH	CP,[MOVEM ARG,EUVAL] ; GEN CODE TO SET EU FLAG
	JRST	CDCRET		; AND CONTINUE CD

; CDEH - EH OR NEH - RETURN OR SET ERROR MESSAGE LENGTH FLAG

CDEH:	MOVE	X,[JSP PC,$$EHS] ;[325] FETCH CALL TO EH SET ROUTINE
	TXNN	F,F$1RG		; "SET" COMMAND?
	 HRRI	X,$$EH		; NO, FETCH ADR OF "RETURN" ROUTINE
	PUSH	CP,X		; AND GEN THE CALL TO WHATEVER
	TXNE	F,F$1RG		; "SET"?
	 JRST	CDCRET		; YES, CONTINUE CD
	JRST	CDCVAL		; NO, CONTINUE CD

; CDEJ - EJ - GET JOB #, TTY #, OR PPN

CDEJ:	PUSHJ	P,ARGK		;[12000] Fake arg if none
IFN FTPRIV,<
	TXNE	F,F$2RG		;[12000] Remember 2 args at run time
	 PUSH	CP,[TXO F,F$2RG] ;[12000] if these features are enabled
>
	PUSH	CP,[JSP PC,$$EJ] ;[12000] Job #,TTY #,PPN
	JRST	CDCVAL		;[12000] Return value

; CDES - ES OR NES - RETURN OR SET THE AUTOTYPEOUT AFTER SEARCH FLAG

CDES:	TXNE	F,F$1RG		; IS AN ARG PRESENT?
	 JRST	CDES1		; YES
	PUSH	CP,[MOVE VALUE,ESVAL] ; NO, GEN CODE TO RETURN ES FLAG
	JRST	CDCVAL		; AND CONTINUE CD

CDES1:	PUSH	CP,[MOVEM ARG,ESVAL] ; GEN CODE TO SET ES FLAG
	JRST	CDCRET		; AND CONTINUE CD

; CDEL - ELFILESPEC$ - SETUP FOR WRITING OR MODIFYING LOG FILE
;
; GEN:	JSP	PC,$$EL
;	<FILE.SPEC>
;	(RETURN)

CDEL:	TXNE	F,F$1RG		;[330] ARG PRESENT?
	 JRST	CDEL1		;[330] YES, TO MODIFY
	PUSH	CP,[JSP PC,$$EL] ;[330] GEN CALL TO $$EL
	JRST	CDEXX		;[330] GEN FILE SPEC AND CONTINUE CD

CDEL1:	PUSH	CP,[JSP PC,$$ELA] ;[330] GEN CALL TO $$ELA
	JRST	CDCRET		;[330] AND CONTINUE CD
; CDBKSL - \ OR N\ - RETURN VALUE OF NUMBER AFTER POINTER IN
;	TEXT BUFFER OR INSERT ASCII REPRESENTATION OF N

CDBKSL:	MOVE	X,[JSP PC,$$BS1] ; FETCH THE CALL TO $$BS1
	TXNN	F,F$1RG		; IS IT "N\"?
	 HRRI	X,$$BS2		; NO, ITS "\"
	PUSH	CP,X		; GEN THE CALL TO $$BS1 OR $$BS2
	TXNE	F,F$1RG		; RETURN A VALUE?
	 JRST	CDCRET		; NO. CONTINUE CD
	JRST	CDCVAL		; YES, CONTINUE CD
; CDLSB - [I - PUSH A Q-REGISTER ON THE Q-REGISTER PDL

CDLSB:	PUSH	CP,[JSP PC,$$PUSH] ; GEN CODE TO CALL $$PUSH
CDLSB1:	PUSHJ	P,MAKQNM	; GEN THE Q-REGISTER NAME INTO CODE
	JRST	CDCIGN		; AND CONTINUE CD

; CDRSB - ]I - POP THE Q-REGISTER PDL INTO A Q-REGISTER

CDRSB:	TXNE	F,F$COL		;[24000] :]q returns value always
	 TXO	F,F$1RG		;[24000] so remember we did so
	PUSH	CP,[JSP PC,$$POP] ; GEN CODE TO CALL $$POP
	JRST	CDLSB1		; FINISH CODE AND CONTINUE CD
	SUBTTL	Command Decoding and Compilation Subroutines

; GENCTM - GENERATE CALL TO "CHECK FOR TRACE MODE" ROUTINE
;	IF IN TRACE MODE, THIS WILL CAUSE TEXT OF COMMAND TO BE TYPED.
;
; CALL:	PUSHJ	P,GENCTM
;	(RETURN)
;
; GEN:	JSP	PC,$$CTM
;	<CHAR POSITION IN BUFFER,,CHAR COUNT>
;
; NOTE:	THE CHAR COUNT IS STORED AS ZERO AND THEN FILLED IN
;	BY A CALL TO 'GENCT1' AFTER THE COMMAND HAS BEEN SCANNED.
;	THE RELATIVE ADR OF THE ZERO WILL BE STORED IN AC CT.
;
; USES ACS X,T1,T4

GENCTM:	MOVE	X,EDVAL		;[11000] Will we ever want to trace this???
	TXNE	X,ED$OPT	;[11000]
	 POPJ	P,		;[11000] Hope not
	PUSH	CP,[JSP PC,$$CTM] ; GEN THE CALL TO "CHECK FOR TRACE MODE"
	PUSHJ	P,CURCHA	; FETCH CURRENT CHAR ADR IN BUFFER
	MOVSI	X,-1(T1)	; . . .
	PUSH	CP,X		; AND GEN INTO CODE
				; NOTE THAT CHAR COUNT WILL BE FILLED
				; IN BY 'GENCT1'
	MOVEI	T4,(CP)		; FETCH CURRENT POSITION IN CODE
	SUB	T4,@CMDBUF	; MAKE IT A RELATIVE ADR
	HRL	T4,CMDCNT	; ALSO STORE THE CURRENT CHAR COUNT
	POPJ	P,		; AND RETURN TO CALLER

; GENCT1 - STORE THE CHAR COUNT IN THE LAST CALL TO "CHECK TRACE MODE"
;
; CALL:	PUSHJ	P,GENCT1
;	(RETURN)
;
; USES ACS X,T1,T4

GENCT1:	MOVE	X,EDVAL		;[11000] Non-trace mode??
	TXNE	X,ED$OPT	;[11000] Bit on means no trace
	 POPJ	P,		;[11000]
	ADD	T4,@CMDBUF	; MAKE IT ABSOLUTE POINTER TO DUMMY BP
	HLRZ	X,T4		; FETCH THE OLD CHAR COUNT
	SUB	X,CMDCNT	; SUBTRACT THE CURRENT CHAR COUNT
	AOJ	X,		; MAKE IT THE ACTUAL CHAR COUNT (NOT -1)
	HRRM	X,(T4)		; AND STORE THE LENGTH OF TRACE
				; MESSAGE IN CALL TO $$CTM
	POPJ	P,		; AND RETURN TO CALLER

>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
; CURCHA - RETURN CURRENT CHARACTER ADDRESS IN BUFFER
;
; CALL:	PUSHJ	P,CURCHA
;	(RETURN)		; WITH CHAR ADR IN AC T1
;
; USES AC T1

CURCHA:	MOVE	T1,@CMDBUF	; FETCH ADR OF COMMAND BUFFER
	MOVE	T1,(T1)		; FETCH # CHARS IN BUFFER
	SUB	T1,CMDCNT	; MINUS # LEFT IN BUFFER
	MOVEI	T1,5*T$DATA(T1)	; REMEMBER OVERHEAD WORDS BEFORE TEXT
	POPJ	P,		; AND RETURN TO CALLER

>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
; MAKQNM -SCAN Q-REGISTER NAME AND GENERATE INTO CODE
;
; CALL:	PUSHJ	P,MAKQNM
;	(RETURN)
;
; USES ACS C,N

MAKQNM:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 ERROR	(MIQ)		; NONE LEFT. ** MISSING Q-REGISTER NAME **
;[15000] Breaks ^U command!
;	TXZE	F,F$DTM		;[14000] @-FORM?
;	 JRST	MAKQN4		;[14000] Yes @M'FOO'
	CAIN	C,"("		; EXTENDED Q-REGISTER NAME?
	 AOJA	C,MAKQN4	; YES, PICK UP 6-CHAR NAME
	CAIN	C,33		;[22000] Escape?
	 JRST	MAKQN4		;[22000] Yes, use ITS Teco form
                                                                          
	CAIL	C," "		;[10000] Too small?
	CAILE	C,172		;[10000] Too big?
	 ERROR	(IQN)		;[10000] YES
	CAILE	C,140		;[10000] Lower case?
	 MOVEI	C,-40(C)	;[10000] Yes, shift it
MAKQN1:	MOVSI	N,'A'-"A"(C)	; YES, CONVERT TO SIXBIT
	LSH	N,^D12		; AND LEFT JUSTIFY
MAKQN2:	PUSH	CP,N		; AND GEN INTO CODE
	POPJ	P,		; RETURN TO CALLER

; PICK UP A 6-CHAR LETTER/DIGIT Q-REGISTER NAME

MAKQN4:	PUSH	P,[MAKQN2]	;[23000] Save the return address for POPJ


; CSIXT - Get a Q-register name into N.  The delimiter is in C.


CSIXT:	MOVE	T3,C		;[23000] Save away terminator
	MOVE	T1,[POINT 6,N]	;[14000] Set up byte pointer to N
	SETZ	N,		;[14000] Start off fresh
CSIXTL:	PUSHJ	P,CMDGCH	;[14000] Next character
	 ERROR	(UQN)		;[14000] lose
	CAIN	C,(T3)		;[14000] Is this our delimiter?
	 POPJ	P,		;[14000] Yes, we're done
	CAIGE	C,40		;[14000] Not a control, we hope
	 ERROR	(UQN)		;[14000] byte the bag
	CAIL	C,140		;[14000] Lower case range?
	 MOVEI	C,-40(C)	;[14000] not any more
	MOVEI	C,-40(C)	;[14000] Convert to sixbit
	TLNE	T1,770000	;[14000] Any room here?
	 IDPB	C,T1		;[14000] Store it
	JRST	CSIXTL		;[14000] Back for more



; GENQRG -SCAN Q-REGISTER NAME AND GENERATE INTO CODE
;
; CALL:	PUSHJ	P,GENQRG
;	(RETURN 1)	With terminator in C, Q-register-name in N
;	(RETURN 2)	With q-register name (ASCII) in C, Q-index in N
;
; USES ACS C,N

GENQRG:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 ERROR	(MIQ)		; NONE LEFT. ** MISSING Q-REGISTER NAME **
	CAIN	C,"("		; EXTENDED Q-REGISTER NAME?
	 AOJA	C,.+2		; YES, PICK UP 6-CHAR NAME
	CAIN	C,33		;[22000] Escape?
	 PJRST	CSIXT		;[22000] Yes, use ITS Teco form

	CAIL	C," "		;[10000] Too small?
	CAILE	C,172		;[10000] Too big?
	 ERROR	(IQN)		;[10000] YES
	CAILE	C,140		;[10000] Lower case?
	 MOVEI	C,-40(C)	;[10000] Yes, shift it
GENQR1:	MOVEI	N,'A'-"A"(C)	; YES, CONVERT TO SIXBIT
	ASH	N,1		;[23000] 2 words per entry, pleeze
	JRST	CPOPJ1		; RETURN TO CALLER

; FNDCH - FIND NEXT OCCURRANCE OF A CHARACTER IN COMMAND STRING
;
; CALL:	MOVEI	C,CHAR
;	PUSHJ	P,FNDCH
;	(FAIL RETURN)
;	(SUCCESS RETURN)	; WITH COUNT IN AC N OF CHARS SCANNED
;
; USES ACS C,T1

FNDCH:	MOVEI	T1,(C)		; SAVE THE CHAR TO BE SEARCHED FOR
	SETZ	N,		; CLEAR THE SCANNED CHAR COUNT

FNDCH1:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 POPJ	P,		; NONE LEFT. GIVE FAIL RETURN TO CALLER
	CAIE	C,(T1)		; IS IT THE CHAR WE WANT?
	 AOJA	N,FNDCH1	; NO, COUNT IT AND CONTINUE SCAN
	JRST	CPOPJ1		; YES, RETURN TO CALLER WITH SUCCESS RETURN

; UPCASE - UPCASE THE CHAR IN AC C IF IT IS A LOWER CASE LETTER
;
; CALL:	MOVEI	C,CHAR
;	PUSHJ	P,UPCASE
;	(RETURN)		; WITH UPCASED CHAR IN AC C
;
; USES AC C

UPCASE:	CAIG	C,"Z"+40	; IS CHAR LC?
	 CAIGE	C,"A"+40	; . . . ?
	  POPJ	P,		; NO, JUST RETURN TO CALLER
	TRZ	C,40		; YES, UPCASE THE CHAR
	POPJ	P,		; AND RETURN TO CALLER
; ARGK - IF NO ARG PRESENT GEN "-1" IF LAST OP WAS "SUB" OR "+1" IF NOT
;
; CALL:	PUSHJ	P,ARGK
;	(RETURN)		; WITH CODE GENERATED TO KLUDGE ARG
;
; USES AC X

ARGK:	TXNE	F,F$1RG		; IS AN ARG PRESENT?
	 POPJ	P,		; YES, NO SPECIAL KLUDGES

; NO ARG. GEN "-1" IF "-" SEEN OR "+1" IF "-" NOT SEEN

	MOVE	X,[MOVEI ARG,1]	; CODE FOR "+1"
	TLNE	T5,(4B8)	; WAS LAST OP "SUB"?
	 TLO	X,(MOVNI)	; YES, GEN "MOVNI ARG,1"
	PUSH	CP,X		; STORE THE ARG KLUDGE CODE
	HRLI	T5,(MOVE ARG,)	;[402] SET POSSIBLE "SUB" TO "MOVE"
	POPJ	P,		; AND RETURN TO CALLER


COMMENT \	[14000] Allow control characters

; CHKNCC - GIVE ERROR IF CHARACTER IS A CONTROL CHAR
;	(EXCEPT FOR THE COMMON OUTPUT CONTROL CHARACTERS)
;
; CALL:	MOVEI	C,CHAR
;	PUSHJ	P,CHKNCC
;	(SUCCESS RETURN)
;
; 'ERROR (ICT)' IS GIVEN IF THE CHAR IS AN UN-COMMON CONTROL CHAR
;
; USES AC C

CHKNCC:	CAIGE	C,.CHSPC	; CHECK FOR CONTROL CHARS
	 CAIG	C,.CHCRT	; . . .
	CAIGE	C,.CHCNH	; . . .
	 CAIN	C,.CHESC	; . . .
	  POPJ	P,		; NOT A CONTROL CHAR. GIVE SUCCESS RETURN TO CALLER
	TXNE	F,F$DTM		;[4000] DON'T WORRY IF @ TYPED BEFORE
	 POPJ	P,		;[4000] JUST RETURN QUIETLY
	CHKEO	2,CPOPJ		;[4000] ALLOW FOR 1EO ONLY
	ERROR	(ICT)		; YES, GIVE ERROR

\

; CHKITR - SKIP IF IN AN ITERATION
;
; CALL:	PUSHJ	P,CHKITR
;	(NOT-IN-AN-ITERATION RETURN)
;	(IN-AN-ITERATION RETURN)
;
; SMASHES ACS X,T1

CHKITR:	MOVE	T1,P		; COPY THE CONTROL PDP

; SEE IF AN ITERATION IS ON THE PDL (CONDITIONALS ALLOWED BEFORE IT)

CHKIT1:	MOVE	X,-1(T1)		; FETCH PDL FLAG
	CAIN	X,P$ITR		; IS IT AN ITERATION?
	 JRST	CPOPJ1		; YES, GIVE SUCCESS RETURN TO CALLER
	SOJ	T1,		; NO, GET READY TO BACKUP ON PDL
	CAIN	X,P$CON		; IS IT A CONDITIONAL?
	 SOJA	T1,CHKIT1	; YES, THEY'RE ALLOWED.KEEP LOOKING BACK
	POPJ	P,		; NO, GIVE FAIL RETURN TO CALLER
; CDCINS - SCAN AN INSERTION ARGUMENT
;
; CALL:	PUSHJ	P,CDCINS
;	(RETURN)
;
; GEN:	<CHAR.ADR,,CHAR.LENGTH>
;
; SMASHES ACS X,T1,T3,C

CDCINS:	MOVE	T3,DELIM	; FETCH THE DELIMITER CHAR
	TXZN	F,F$DTM		; ARE WE IN DELIMITED TEXT MODE?
	 JRST	CDI1		; NO

; FETCH THE DELIMITER CHAR FOR DELIMITED TEXT MODE

	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 ERROR	(UIN)		; NONE LEFT. ** UNTERMINATED INSERT **
	MOVEI	T3,(C)		; SAVE THE TEXT DELIMITER

CDI1:	PUSHJ	P,CURCHA	; FETCH THE CHAR ADR OF TEXT
	MOVSI	T2,(T1)		; AND SAVE FOR LATER. ALSO, RH OF T2
				; IS CHAR COUNT(NOT SPECIALS) FOR TEXT
;[16000]TXZ	F,F$CNT		; CLEAR THE ^T FLAG

; SCAN THE TEXT STRING TO COUNT CHARS AND CHECK VALID USE OF CONTROLS

CDI2:	PUSHJ	P,CMDGCH	; FETCH THE NEXT COMMAND CHAR
	 ERROR	(UIN)		; NONE LEFT. ** UNTERMINATED INSERT **

	CAIN	C,(T3)		; IS IT THE DELIMITER CHAR?
	 JRST	CDI4		; YES. SCAN IS COMPLETE

; DO SPECIAL CHECKING IF THE CHAR IS A CONTROL CHAR

CDI2A:
	MOVE	T1,[IOWD CDIC1L,CDIC1+1] ; AOBJN POINTER FOR DISPATCH
;	TXNE	F,F$CNT		; ^T MODE? (IE: ^R AND ^T ARE ONLY SPECIALS)
;	 MOVE	T1,[IOWD CDIC2L,CDIC2+1] ; YES, USE SHORT DISPATCH
	PUSHJ	P,DISPAT	; DISPATCH ON THE SPECIAL CONTROL CHAR
;[14000]	Don't bitch about control characters
;	TXNN	F,F$CNT		; NOT A SPECIAL CONTROL. IN ^T MODE?
;	 PUSHJ	P,CHKNCC	; NO, MAKE SURE CHAR IS NOT A CONTROL
CDI3:	AOJA	T2,CDI2		; COUNT THE TEXT CHAR AND GO BACK FOR MORE

; DONE WITH SCAN OF TEXT STRING. STORE SOME INFO ABOUT IT IN CODE

CDI4:	TLNE	T3,777		;[12000] 2-CHARACTER delimiter??
	 JRST	[PUSHJ P,CMDGCH	;[12000] Look at next character
		 HLRZ T1,T3	;[12000] and next char of delimiter
		 CAIN T1,C	;[12000] Are they the same?
		  JRST .+1	;[12000] yes
		 PUSHJ P,CMDBCH	;[12000] no, back up!!
		 MOVEI C,(T3)	;[12000] first char matched, delimiter
		 JRST CDI2A]	;[12000] go back to scanning
	PUSH	CP,T2		; GEN <CHARADR,,LENGTH> INTO CODE
	POPJ	P,		; AND RETURN TO CALLER

; DISPATCH TABLES FOR CONTROL CHARS IN INSERT TEXT STRINGS

CDIC1:	<"V"-100,,CDI2>
	<"W"-100,,CDI2>
	<"^"-100,,CDI2>

CDIC2:;	<"T"-100,,CDICT>
	<"R"-100,,CDICR>
	<"Q"-100,,CDICR>	;[16000] Win with ^Q also
CDIC2L==.-CDIC2
CDIC1L==.-CDIC1

; ^T - COMPLEMENT THE ^T MODE FLAG

;CDICT:	TXC	F,F$CNT		; COMPLEMENT THE ^T FLAG
;	JRST	CDI2		; AND CONTINUE SCAN OF TEXT STRING

; ^R - TAKE THE NEXT CHAR AS TEXT

CDICR:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 ERROR	(UIN)		; NONE LEFT. ** UNTERMINATED INSERT **
	JRST	CDI3		; HIDE THE CHAR AND CONTINUE
; CDFSPC - SCAN  A FILE SPEC AND GEN INTO CODE
;
; (SEE PARAMETER DEFINITIONS FOR STUCTURE OF A FILESPEC BLOCK)

CDFSPC:	MOVEI	X,CDFSP2	; FETCH ADR OF ROUTINE THAT SCNS A CHAR
	MOVEM	X,INPADR	; AND STORE FOR 'GETCH' ROUTINE
	SETZM	INPCHR		; IN CASE A CHAR IS WAITING FROM BEFORE
	STORE	(X,FILSPC,FILSPC+FS$LTH-1,0) ; CLEAR THE FILE.SPEC
	MOVEI	L,FILSPC	; FETCH ADR OF FILE SPEC BLOCK
	TXNN	F,F$DTM		;[14000] @-type command
	 SKIPA	C,DELIM		;[14000] No. use default delimiter
	 PUSHJ	P,CMDGCH	;[14000] Yes, get delimiter
	 JFCL			;[24000] ...
	PUSH	P,T4		; SAVE AC T4
	PUSH	P,C		;[14000] Save whatever delimiter it was
	PUSHJ	P,GFSPED	; AND SCAN THE FILE SPEC
	POP	P,X		;[14000] Get back delimiter
	POP	P,T4		; RESTORE AC T4
	CAME	C,X		;[14000] See if that was it
	 ERROR	(IFS)		; NO. ** ILLEGAL FILE SPEC **

; NOW GEN THE FILE SPEC INTO THE CODE

	MOVE	X,[IOWD FS$LTH,FILSPC+1] ; FETCH AOBJN PTR TO FILESPEC

CDFSP1:	PUSH	CP,(X)		; GEN A WORD OF THE FILESPEC
	AOBJN	X,CDFSP1	; LOOP FOR ALL WORDS OF FILE SPEC

	SETZM	INPADR		; CLEAR ADR OF INPUT ROUTINE
	POPJ	P,		; AND RETURN TO CALLER

; ROUTINE TO SCAN A CHAR FOR FILE SPEC
; IGNORES: SPACE,TAB,<LF>,<VT>,<FF>,AND <CR>

CDFSP2:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
	 ERROR	(UFS)		; NONE LEFT. ** UNTERMINATED FILE SPEC **
	CAIE	C,.CHSPC	; IS CHAR A SPACE?
	 CAIG	C,.CHCRT	; OR TAB,<LF>,<VT>,<FF>, OR <CR> ?
	  CAIGE	C,.CHTAB	; . . . ?
	   POPJ	P,		; NO RETURN THE CHAR
	JRST	CDFSP2		; YES, IGNORE THE CHAR
	SUBTTL	EXECUT - Execute a Command

; CALL:	MOVEI	L,ADRREF	; ADR OF REFERENCE TO COMMAND BUFFER
;	PUSHJ	P,EXECUT
;	(RETURN)
;
; ADRREF:	<BUFFER>
;
; BUFFER:
;	--------------
;	! CHAR COUNT !
;	!------------!
;	! REF. COUNT !
;	!------------!
;	! BUFFER ID  !
;	!------------!
;	!            !
;	!   ASCII    !
;	!            !
;	!  COMMAND   !
;	!            !
;	!------------!
;	!            !
;	! EXECUTABLE !
;	!            !
;	!   CODE     !
;	!            !
;	--------------
;
; USES ALL ACS

EXECUT:	MOVEM	L,CMDBUF	; SAVE ADR OF REF TO COMMAND BUFFER
	MOVE	T1,@(L)		; FETCH # CHARS IN TEXT BUFFER
	IDIVI	T1,5		; COMPUTE RELATIVE START ADR OF CODE
	MOVEI	T1,T$DATA(T1)	; ADD OVERHEAD WORDS FOR TEXT BUFFER
; FORMALIZE THE FACT THAT R AND CP REFERENCE THE BUFFER

	MOVE	R,(L)		; FETCH ADR OF COMMAND BUFFER
	MOVE	X,[<PC,,R>]	; FETCH ADRS OF AC REFS
	MOVEM	X,T$ACRF(R)	; AND BIND THE AC REFS TO BUFFER

; ENABLE FOR CASE FLAGGING (BASED ON EU FLAG)

	TXZ	F,F$NOF		; CLEAR THE "SUPPRESS CASE FLAGGING" FLAG

; CLEAR "LAST TEN COMMANDS" TABLE

	STORE	(X,TENIDX,TENIDX+^D10,0) ; CLEAR COMMAND TABLE

; BEGIN EXECUTION

	ADDI	T1,1(R)		; FIND BEGINNING OF CODE
	MOVE	SARG,SARGSV	;[3000] RESTORE 2ND ARGUMENT IF ANY
	PUSHJ	P,(T1)		; BEGIN EXECUTION OF CODE
	HRRZS	T$1REF(R)	; UNBIND FIXED REF TO BUFFER
	SETZM	T$ACRF(R)	; UNBIND AC REFS FROM BUFFER
	SETZM	@CMDBUF		;[14000] Clear pointer to buffer
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	$CTM - TRACE MODE TYPE-OUT

; $CTM - CHECK FOR TRACE MODE. IF ON, TYPE TEXT
;
; CALL:	JSP	PC,$$CTM
;	<CHAR ADR IN BUFFER,,CHAR COUNT>
;	(RETURN)


$CTM:	TXZE	F,F$REE		;[317] WANT TO STOP NOW?
	 JRST	ERRREC		;[317] YES, STOP!

	AOS	T1,TENIDX	; INCREMENT AND FETCH INDEX INTO CMD TABLE
	IDIVI	T1,^D10		; MAKE ID MODULO 10.
	MOVEM	T2,TENIDX	; STORE THE NEW INDEX
	PUSHJ	P,NXTWRD	; FETCH ARG
	MOVEM	N,TENCMD(T2)	; STORE CMD INFOR IN THE TABLE FOR THE
				; "LAST TEN COMMANDS"
	TXNN	F,F$TRC		; IN TRACE MODE?
	 JRST	(PC)		; NO, RETURN
	PUSHJ	P,TMSG		; YES, TYPE THE COMMAND
	JRST	(PC)		; AND RETURN TO CALLER
	SUBTTL	$EH AND $EHS

; $EH - RETURN CURRENT MESSAGE LENGTH
;
; CALL:	JSP	PC,$$EH
;	(RETURN)		; WITH VALUE IN AC VALUE

$EH:	SETZ	VALUE,		;[411] ASSUME ZERO
	MOVE	T1,EHVAL	; FETCH MESSAGE LENGTH
	MOVSI	X,-3		; GET READY TO CONVERT TO A NUMBER
	TDNE	T1,JWTBL(X)	; BIT SET?
	 AOJ	VALUE,		;[411] YES, INCREMENT MESSAGE LENGTH
	AOBJN	X,.-2		; AND TRY FOR ALL POSSIBLE LENGTHS
	JRST	(PC)		; DONE, RETURN TO CALLER

; $EHS - SET THE MESSAGE LENGTH
;
; CALL:	JSP	PC,$$EHS	; WITH NEW LENGTH IN AC ARG
;	(RETURN)

$EHS:	CAILE	ARG,3		; ARG TOO LARGE?
	 MOVEI	ARG,3		; YES, USE LARGEST LEGAL
	MOVX	X,JW.WPR!JW.WFL	; FETCH DEFAULT LENGTH
	JUMPLE	ARG,.+2		; SKIP IF ARG IS NEGATIVE
	 HRLZ	X,JWTBL-1(ARG)	; FETCH LENGTH FROM TABLE
	MOVEM	X,EHVAL		; STORE THE NEW MESSAGE LENGTH
	JRST	(PC)		; AND RETURN TO CALLER

; JWTBL - TABLE FOR CONVERTING MESSAGE LENGTHS

JWTBL:	<JW.WPR>_-^D18,,<JW.WPR>_-^D18
	<JW.WFL>_-^D18,,<JW.WPR!JW.WFL>_-^D18
	<JW.WCN>_-^D18,,<JW.WPR!JW.WFL!JW.WCN>_-^D18
	SUBTTL	$U AND $Q AND $INC

; $U - STORE ARG IN IN SPECIFIED Q-REGISTER
;
; CALL:	JSP	PC,$$U
;	<Q-REGISTER NAME>
;	(RETURN)

$U:	PUSHJ	P,NXTWRD	; FETCH Q-REGISTER NAME
	MOVE	T1,N		; INTO AC T1
	PUSHJ	P,QGET		;[12000] Save text in q-register
	 JRST	[TXZN F,F$COL	;[23000] No q register
		  TDZA T2,T2	;[23000] No text
		  MOVE T2,ARG	;[23000] Fabricate it
		  MOVE T3,ARG	;[23000] Numeric value always
		  PUSHJ P,QSTOR	;[23000] Store it
		  JRST (PC)]	;[23000] return

	TXZE	F,F$COL		;[23000] :U affects text also
	 MOVEM	ARG,Q$PTR(T5)	;[23000] so put it there too
	MOVEM	ARG,Q$VAL(T5)	; AND STORE THE VALUE IN Q-REGISTER
	JRST	(PC)		; AND RETURN TO CALLER

; $Q - RETURN  THE NUMERIC VALUE OF SPECIFIED Q-REGISTER
;
; CALL:	JSP	PC,$$Q
;	<Q-REGISTER NAME>
;	(RETURN)		; WITH NUMERIC VALUE IN VALUE

$Q:	PUSHJ	P,NXTWRD	; FETCH THE Q-REGISTER NAME
	MOVE	T1,N		; INTO AC T1
	PUSHJ	P,QGET		; FETCH THE Q-REGISTER
	 JRST	FAIRET		; DOESN'T EXIST. RETURN ZERO
;	TXNN	T2,QB$NUM	; IS Q-REGISTER NUMERIC?
;	 JRST	$Q1		;[370] SEE IF TO TYPE ASCII Q-REG
$Q0:				;[3000] LABEL ADDED
	SKIPE	VALUE,T3	; PUT NUMERIC VALUE IN AC VALUE
	 JRST	(PC)		; AND RETURN TO CALLER
$Q1:	MOVE	X,4(PC)		;[374] FETCH NEXT INSTRUCTION
	SKIPE	N,T2		;[23000] Get text if any
	CAME	X,[JSP PC,$$DEC] ;[370] QI= CONSTRUCTION?
	 JRST	(PC)		;[23000] USE NUMERIC VALUE ANYWAY!
	ADDI	PC,5		;[374] BUMP PC SO NOT TO CALL $DEC
	MOVEI	L,TMPRFG	;[370] TMPRFG WILL REFERENCE THE TEXT BUFFER
	PUSHJ	P,FNDBLK	;[370] FIND THE BLOCK WITH THE ID
	 ERROR	(BNF)		;[370] EEK!!!!!!!
	HRRZ	T1,@TMPRFG	;[370] FETCH # OF CHARS
	MOVE	T3,[POINT 7,T$DATA] ;[370] LOAD BYTE POINTER TO Q-REG
	ADD	T3,TMPRFG	;[370] JUSTIFY IT TO Q-REG
$Q2:	SOJL	T1,$G2		;[370] GO TO UNBIND ROUTINE IN $G WHEN DONE
	ILDB	C,T3		;[370] GET A CHARACTER
	PUSHJ	P,TCCHR		;[370] TYPE THE CHARACTER
	JRST	$Q2		;[370] TRY THE NEXT ONE

$QRX:				;[3000] RANDOM ACCESS Q REGISTER HACK
	PUSHJ	P,NXTWRD	;[3000] Q REGISTER NAME IS NEXT
	MOVE	T1,N		;[3000] SIXBIT NAME IN N
	PUSHJ	P,QGET		;[3000] GET IT
	 JRST	FAIRET		;[3000] TREAT LIKE REGULAR FOR COMPATABLILTY
	TXNN	T2,QB$BID	;[3000] IS IT A TEXT Q REGISTER?
	 JRST	$Q0		;[12000] No do like numeric
	MOVEI	N,(T2)		;[3000] GET BID
	PUSH	P,SARG		;[3000] ALAS L AND SARG ARE 1 AND THE SAME
	MOVEI	L,TMPRFG	;[3000] TMPRFG WILL REFERENCE IT
	PUSHJ	P,FNDBLK	;[3000] GET THE TEXT BUFFER ITSELF
	 ERROR	(XXX)		;[3000] ?
	POP	P,SARG		;[3000] RESTORE 2ND ARGUMENT IF ANY
	TXZE	F,F$COL		;[12000] :Q? (return # of characters)
	 JRST	[MOVE VALUE,@TMPRFG ;[12000] Get character count
		 JRST $G2]	;[12000] Un-reference & continue execution
	JUMPL	ARG,$QRX2	;[10000] Negative #'s are special case
	CAML	ARG,@TMPRFG	;[3000] MAKE SURE IT IS IN RANGE
	 CERROR	(ARG)		;[3000] IT WASN'T
	MOVE	T1,ARG		;[3000] MAKE A BYTE POINTER
	IDIVI	T1,5		;[3000] 5 CHARS/WORD
	ADD	T1,[POINT 7,T$DATA] ;[3000]
	ADD	T1,TMPRFG	;[3000]
	IBP	T1		;[3000] FIND THE PLACE IN THE WORD
	SOJGE	T2,.-1		;[3000]
	LDB	VALUE,T1	;[3000] GET IT AS OUR VALUE
	TXZE	F,F$2RG		;[5000] CHECK & CLEAR THE ARG FLAG
				;[3000] AND CLOBBER IT IF 2 ARGS GIVEN
	 DPB	SARG,T1		;[3000]
	JRST	$G2		;[3000] DONE unreference & return
$QRX2:	MOVMS	ARG		;[10000]
	CAIL	ARG,QXNLEN	;[10000] CHECK RANGE
	 CERROR(ARG)		;[10000] LOSE
	XCT	QXNTBL(ARG)	;[10000] DO SOMETHING

QXNTBL:	JRST	$G2		;[10000] Return
	MOVE	VALUE,@TMPRFG	;[10000] Get length of Q-REG text
	PUSHJ	P,[MOVE VALUE,TMPRFG	;[10000]
		   ADDI VALUE,3		;[10000]
		   POPJ P,]		;[10000]
QXNLEN==.-QXNTBL			;[10000]

; $INC - ADD ARG TO A Q-REGISTER AND RETURN RESULTING VALUE
;
; CALL:	JSP	PC,$$INC
;	(RETURN)		; WITH VALUE IN AC 'VALUE'

$INC:	TXNE	F,F$1RG		;[12000] Were we passed a value
	 SKIPA	VALUE,ARG	;[12000] Yes, use it
	MOVEI	VALUE,1		;[12000] No. default to 1
	PUSHJ	P,NXTWRD	; FETCH THE Q-REGISTER NAME
	MOVE	T1,N		; AND COPY INTO AC T1
	PUSHJ	P,QFIND		; FIND THE Q-REGISTER
	 JRST	$INC0		;[12000] No Q-register there yet
	ADDB	VALUE,Q$VAL(T5)	; YES, INCREMENT IT
	JRST	(PC)		;[12000] and return the value
$INC0:	SETZ	T2,		;[12000] Set no flags
	MOVE	T3,VALUE	;[12000] and value for q-register
	PUSHJ	P,QSTOR		; AND SET THE NEW VALUE OF Q-REGISTER
	JRST	(PC)		; AND RETURN TO CALLER
	SUBTTL	$PUSH AND $POP
; $PUSH - PUSH A Q-REGISTER ON THE Q-REGISTER PDL
;
; CALL:	JSP	PC,$$PUSH
;	<Q-REGISTER NAME>
;	(RETURN)

$PUSH:	PUSHJ	P,NXTWRD	; FETCH THE Q-REGISTER NAME
	MOVE	T1,N		; INTO AC T1
	PUSHJ	P,QGET		; FETCH THE Q-REGISTER
	 SETZB	T2,T3		;[23000] Use null q-reg
	MOVEI	N,(T2)		; FETCH POSSIBLE TEXT BUFFER ID
	TXNE	T2,QB$BID	; IS Q-REGISTER A TEXT BUFFER?
	 PUSHJ	P,REFBLK	; YES,  ADD ONE TO ITS REFERENCE COUNT
	MOVE	X,QP		; FETCH PQ PDL
	AOBJN	X,.+1		; INCREMENT IT
	EXCH	X,QP		; AND STORE IT
	PUSH	X,T1		; PUSH Q-REGISTER NAME
	MOVE	X,QP		; FETCH QPDL PDP
	AOBJN	X,.+1		; INCREMENT Q PDL
	EXCH	X,QP		; AND STORE IT
	PUSH	X,T2		; PUSH Q-REGISTER BITS
	MOVE	X,QP		; FETCH QPDL PDP
	AOBJN	X,.+1		; INCREMENT IT
	EXCH	X,QP		; AND STORE IT
	PUSH	X,T3		; PUSH Q-REGISTER VALUE/ID
	JRST	(PC)		; RETURN TO CALLER

; $POP - POP THE Q-REGISTER PDL INTO THE SPECIFIED Q-REGISTER
;
; CALL:	JSP	PC,$$POP
;	<Q-REGISTER NAME>
;	(RETURN)

$POP:	PUSHJ	P,NXTWRD	; FETCH THE Q-REGISTER NAME
	MOVE	T1,N		; INTO AC T1
	MOVE	X,QP		; FETCH Q PDL
	POP	X,T3		; POP THE PUSHED VALUE
	POP	X,T2		; POP THE PUSHED BITS
	POP	X,N		; POP THE PUSHED Q-REGISTER NAME
	JUMPN	N,.+2		;[24000] Only empty if both of these are
	JUMPE	T2,[CERROR (PES)] ; ** POPPED EMPTY STACK **
	MOVEM	X,QP		; AND STORE THE UPDATED QPDL PDP
	TXZ	F,F$REF		; T3 DOES NOT CONTAIN TEXT BUFFER REFERENCE
				; (IE: IT CONTAINS VALUE/TEXT BUFFER ID)
	PUSHJ	P,QSTOR		; STORE THE POPPED Q IN SPECIFIED Q-REGISTER
	TXZE	F,F$COL		;[25000] :]q should return -1 or 0
	 SETO	VALUE,		;[25000] and we won if we got here
	JRST	(PC)		; AND RETURN TO CALLER
	SUBTTL	$DEC AND $OCT AND $CNE AND $CNN AND $FFD

; $DEC - TYPE ARG IN DECIMAL
;
; CALL:	JSP	PC,$$DEC
;	(RETURN)

$DEC:	MOVE	N,ARG		; MOVE ARG INTO PROPER AC
	PUSHJ	P,TDEC		; AND TYPE IT IN DECIMAL
	JRST	$OCT1		;[305] SEE IF MORE TO DO

; $OCT - TYPE ARG IN OCTAL
;
; CALL:	JSP	PC,$$OCT
;	(RETURN)

$OCT:	MOVE	N,ARG		; MOVE ARG INTO ANOTHER AC
	PUSHJ	P,TOCT		; AND TYPE IT IN OCTAL

; SEE IF WE MUST SUFFIX NUMBER WITH ANYTHING

$OCT1:	JUMPE	SARG,(PC)	;[305] N.EQ.0 MEANS NOTHING TO SUFFIX. RETURN
	JUMPG	SARG,$OCT2	;[305] N.GT.0 MEANS SUFFIX CHAR

; N.LT.0 MEANS SUFFIX CRLF TO OUTPUT unless ":" used

	TXZN	F,F$COL		;[12000] Skip CRLF if :=
	PUSHJ	P,TCRLF		;[305] SUFFIX A CRLF
	JRST	(PC)		;[305] AND RETURN TO CALLER

; N.GT.0 MEANS SUFFIX CHAR WHOSE CODE IS N TO OUTPUT

$OCT2:	MOVEI	C,(SARG)	;[305] FETCH THE CHAR TO OUTPUT
	PUSHJ	P,TCHR		;[305] TYPE THE CHAR
	JRST	(PC)		;[305] AND RETURN TO CALLER

; $CNE - RETURN VALUE OF THE FORMFEED FLAG (0=OFF,-1=ON)
;
; CALL:	JSP	PC,$$CNE
;	(RETURN)		; WITH RESULT IN AC VALUE

$CNE:	SETZ	VALUE,		; FORMFEED FLAG IS OFF
	TXNE	F,F$FFD		; BUT IS IT?
	 SETO	VALUE,		; NO, IT'S ON
	JRST	(PC)		; RETURN TO CALLER

; $CNN - RETURN THE VALUE OF THE END-OF-FILE FLAG (0=OFF,-1=ON)
;
; CALL:	JSP	PC,$$CNN
;	(RETURN)		; WITH RESULT IN AC VALUE

$CNN:	SETZ	VALUE,		; THE EOF FLAG IS OFF
	TXNE	F,F$EOF		; BUT IS IT?
	 SETO	VALUE,		; NO, IT'S ON
	JRST	(PC)		; RETURN TO CALLER

; $FFD - TYPE A FORMFEED
;
; CALL:	JSP	PC,$$FFD
;	(RETURN)

$FFD:	MOVE	T1,ETVAL	;[10000] Clear screen & window if display
	TXNE	T1,ET$DPY	;[10000]
	 JRST	[PUSHJ P,FOUT	;[12000] Force out pending text
		 OUTSTR HOME	;[12000] Go to top of screen
		 OUTSTR WIPES	;[12000] and clear it all
		 MOVSI T1,200000	;[10000]
		 IORM T1, SCFWD	;[10000] Indicate window messed up
		 SETZM ROW	;[12000] Clear row...
		 SETZM COL	;[12000] ... and column
		 JRST (PC)]	;[10000]
	MOVEI	C,.CHFFD	; FETCH A FORMFEED CHAR
	PUSHJ	P,TCHR		; TYPE IT
	JRST	(PC)		; AND RETURN TO CALLER

$QCM:	MOVE	VALUE,ARG	;[10000] Value will be index in qreg
	PUSHJ	P,NXTWRD	;[10000] Q register name
	MOVE	T1,N		;[10000]
	PUSHJ	P,QGET		;[10000] Get the q-register
	 JRST	FAIRET		;[16000] no such q-register
	TXNN	T2,QB$BID	;[10000] Must contain text
	 JRST	FAIRET		;[16000] no such q-register
	MOVEI	N,(T2)		;[12000] Buffer ID
	MOVEI	L,TMPRFG	;[10000] This will reference it
	PUSHJ	P,FNDBLK	;[10000] Find the text buffer
	 ERROR  (BNF)		;[10000] Ouch
	MOVE	T1,TMPRFG	;[10000] Addr of buffer
	MOVEI	T1,3(T1)	;[10000] Skip overhead words
	MOVE	T3,ARG		;[10000] Adjust the byte pointer
	IDIVI	T3,5		;[10000]
	ADDI	T1,(T3)		;[10000] Add enough words
	HLL	T1,CBPTBL-1(T4)	;[10000]
	MOVE	T3,PTVAL	;[10000] Get "."
	MOVE	T2,@TXTBUF	;[10000] Get length of text buffer
	SUB	T2,T3		;[10000] Subtract "." to get chars left
	JUMPLE	T2,$G2		;[12000] At end of buffer already
	JUMPL	ARG,$G2		;[10000] or too small
	MOVE	T4,@TMPRFG	;[10000] Get length of q-register
	SUB	T4,ARG		;[10000] subtract starting place therein
	CAML	T2,T4		;[10000] use the lower limit
	 MOVE	T2,T4		;[10000]
	IDIVI	T3,5		;[10000] Turn into a word
	MOVEI	T3,T$DATA(T3)	;[14000] Skip overhead words here so don't lose
	HLL	T3,CBPTBL-1(T4)	;[10000] and a byte pointer
	ADD	T3,TXTBUF	;[10000] to the current character
QCMLP:	SOJL	T2,$G2		;[12000] See if we got to the end
	ILDB	C,T1		;[10000] Get char from text buffer
	ILDB	T4,T3		;[10000] and from q-register
	CAIE	C,(T4)		;[10000] are they the same?
	 JRST	$G2		;[10000] no. un-reference & return index to caller
	PUSHJ	P,UPDCDC	;[12000] Adjust cursor position
	AOS	PTVAL		;[10000] Move the pointer
	AOJA	VALUE,QCMLP	;[10000] bump index

; end $QCM
	SUBTTL	$UP AND $LOW AND CLRCAS AND $CX AND $CXS

; $UP - SET THE "UPCASE ALL TEXT" FLAG (OR CLEAR IF ARG.EQ.0)
;
; CALL:	JSP	PC,$$UP
;	(RETURN)

$UP:	JUMPE	ARG,CLRCAS	; IF ARG.EQ.0 CLEAR ALL CASE FLAGS
	TXZ	F,F$DNC		; IF ARG.NE.0 THEN CLEAR "DOWNCASE" FLAG
	TXO	F,F$UPC		; AND SET THE "UPCASE" FLAG
	JRST	(PC)		; AND RETURN TO CALLER

; $LOW - SET THE "DOWNCASE ALL TEXT" FLAG (OR CLEAR IF ARG.EQ.0)
;
; CALL:	JSP	PC,$$LOW
;	(RETURN)

$LOW:	JUMPE	ARG,CLRCAS	; IF ARG.EQ.0, CLEAR ALL CASE FLAGS
	TXZ	F,F$UPC		; IF ARG.NE.0, CLEAR "UPCASE" FLAG
	TXO	F,F$DNC		; AND SET THE "DOWNCASE" FLAG
	JRST	(PC)		; AND RETURN TO CALLER

; CLRCAS - CLEAR "UPCASE" AND "DOWNCASE" FLAGS

CLRCAS:	TXZ	F,F$UPC!F$DNC	; CLEAR FLAGS
	JRST	(PC)		; AND RETURN TO CALLER

; $CX - RETURN THE VALUE OF THE "EXACT SEARCH MODE" FLAG
;
; CALL:	JSP	PC,$$CX
;	(RETURN)		; WITH VALUE IN AC VALUE
;				; -1=EXACT SEARCH MODE
;				; 0=BOTH UPPER&LOWER MATCH

$CX:	TXNE	F,F$CNX		; IN "EXACT SEARCH MODE"?
	 JRST	SUCRET		; YES, RETURN VALUE OF -1
	JRST	FAIRET		; NO, RETURN VALUE OF 0

; $CXS - SET THE "EXACT SEARCH MODE" FLAG
;
; CALL:	JSP	PC,$$CXS
;	(RETURN)

$CXS:	TXZ	F,F$CNX		; CLEAR THE "EXACT SEARCH MODE" FLAG
	JUMPE	ARG,(PC)	; RETURN IF CALLER WANTS IT CLEARED
	TXO	F,F$CNX		; NO, HE WANTS IT SET
	JRST	(PC)		; NOW RETURN TO CALLER
	SUBTTL	$CNZ and $MES and $NA
; $CNZ - CLOSE OUTPUT FILE AND EXEIT TO MONITOR COMMAND LEVEL
;
; CALL:	JSP	PC,$$CNZ
;	(RETURN)		; IF USER TYPES "CONTINUE"

$CNZ:	JRST	$EX1		; DO "EF^C"

; $MES - TYPE A MESSAGE (UNLESS IN TRACE MODE)
;
; CALL:	JSP	PC,$$MES
;	<CHAR ADR IN BUFFER,,CHAR COUNT>
;	(RETURN)

$MES:	PUSHJ	P,NXTWRD	; FETCH THE ARG
	TXNN	F,F$TRC		; IN TRACE MODE?
	 PUSHJ	P,TMSG		; NO, TYPE THE MESSAGE
	JRST	(PC)		; AND RETURN TO CALLER

; $NA - RETURN THE ASCII VALUE OF THE CHAR FOLLOWING TEXT POINTER
;
; CALL:	JSP	PC,$$NA
;	(RETURN)

$NA:	MOVE	T1,PTVAL	; FETCH "."
	ADD	T1,ARG		;[12000] Add the argument to this
	JUMPL	T1,.+2		;[12000] error if negative result
	CAML	T1,@TXTBUF	;[24000] Check for out of bounds correctly
	 JRST	SUCRET		;[16000] it is so return -1
	PUSHJ	P,GET		; FETCH THE CHAR AFTER "."
	MOVE	VALUE,C		; COPY THE VALUE
	JRST	(PC)		; AND RETURN TO CALLER

;[13000] Execute an arbitrary instruction (at your peril!!)
;CALL:	JSP	PC,$$EXE	;with instruction in ARG
;				 contents of SARG will be moved to VALUE first
$EXE:	MOVE	VALUE,SARG	;Most useful for UUO's
	MOVEI	X,CWVEC		;address of :W vector for TRMOPing
	MOVE	T5,EDVAL	;[13000] Get ED bits
	XCT	ARG		;do it
	TXZA	T5,ED$SKP	;[13000] remember that we didn't skip
	TXO	T5,ED$SKP	;[13000] or that we did
	MOVEM	T5,EDVAL	;[13000] save what ever we got
	JRST	(PC)		;[13000] Continue execution
	SUBTTL	$CKC and $CHA and $CKD and $CKV and $CKW

; $CKC - SKIP IF ARG IS ASCII CODE FOR A SYMBOL CONSTITUENT
;	(IE: A-Z,0-9,%,.,$)
;
; CALL:	JSP	PC,$CKC
;	(FAIL RETURN)
;	(SUCCESS RETURN)

$CKC:	MOVE	C,ARG		; FETCH THE ARG CHARACTER
	PUSHJ	P,CHKAN		; IS IT CODE FOR A LETTER/DIGIT?
	 SKP			; NO, TRY AGAIN
	JRST	1(PC)		; YES, GIVE SUCCESS RETURN
	CAIE	C,"%"		; IS CHAR "%"?
	 CAIN	C,"$"		; OR "$"?
	  JRST	1(PC)		; YES, GIVE SUCCESS RETURN
	MOVE	X,EDVAL		;[14000] See if BLISS symbol const. set
	TXNN	X,ED$BLI	;[14000] Check bit (32ED)
	 JRST	CKC0		;[14000] It wasn't
	CAIE	C,"&"		;[14000] It was, so check for "&"
	CAIN	C,"_"		;[14000] Check for "_"
	 JRST	1(PC)		;[14000] Skip return
	JRST	(PC)		;[14000] regular return
CKC0:	CAIN	C,"."		; NO, IS IT "."?
	 JRST	1(PC)		; YES, GIVE SUCCESS RETURN
	JRST	(PC)		; NO, GIVE FAIL RETURN

; $CKA - SKIP IF ARG IS ASCII CODE FOR A LETTER (UPPER OR LOWER)
;
; CALL:	JSP	PC,$CKA
;	(FAIL RETURN)
;	(SUCCESS RETURN)

$CKA:	CAIG	ARG,"Z"+40	; IS ARG WAY OUT OF RANGE?
	 CAIGE	ARG,"A"		; . . . ?
	  JRST	(PC)		; YES. GIVE FAIL RETURN
	CAIGE	ARG,"A"+40	; NO, IS CHAR A LETTER?
	 CAIG	ARG,"Z"		; . . . ?
	  JRST	1(PC)		; YES, GIVE SUCCESS RETURN
	JRST	(PC)		; NO, GIVE FAIL RETURN

; $CKD - SKIP IF ARG IS ASCII CODE FOR A DIGIT
;
; CALL:	JSP	PC,$CKD
;	(FAIL RETURN)
;	(SUCCESS RETURN)

$CKD:	CAIG	ARG,"9"		; IS ARG CODE FOR DIGIT?
	 CAIGE	ARG,"0"		; . . . ?
	  JRST	(PC)		; NO, GIVE FAIL RETURN
	JRST	1(PC)		; YES, GIVE SUCCESS RETURN

; $CKV - SKIP IF ARG IS ASCII CODE FOR A LOWER CASE LETTER
;
; CALL:	JSP	PC,$CKV
;	(FAIL RETURN)
;	(SUCCESS RETURN)

$CKV:	CAIG	ARG,"Z"+40	; IS ARG CODE FOR A LOWER CASE LETTER?
	 CAIGE	ARG,"A"+40	; . . . ?
	  JRST	(PC)		; NO, GIVE FAIL RETURN
	JRST	1(PC)		; YES, GIVE SUCCESS RETURN

; $CKW - SKIP IF ARG IS ASCII CODE FOR AN UPPER CASE LETTER
;
; CALL:	JSP	PC,$$CKW
;
; CALL:	JSP	PC,$$CKW
;	(FAIL RETURN)
;	(SUCCESS RETURN)

$CKW:	CAIG	ARG,"Z"		; IS ARG CODE FOR AN UPPER CASE LETTER?
	 CAIGE	ARG,"A"		; . . . ?
	  JRST	(PC)		; NO, GIVE FAIL RETURN
	JRST	1(PC)		; YES, GIVE SUCCESS RETURN

; $CKR - Skip if argument is an alphanumeric ascii character
;
; CALL:	JSP	PC,$$CKR
;	(Fail return)
;	(Success return)

$CKR:	MOVE	C,ARG	;[14000] Get into character register
	PUSHJ	P,CHKAN	;[14000] Check for alphanumeric
	 JRST	(PC)	;[14000] nope
	JRST	1(PC)	;[14000] yes

	SUBTTL	$SEMF and $SEMZ and $SEM and $STOP
; $SEMF - JUMP OUT OF CURRENT ITERATION IF LAST SEARCH FAILED (ELSE CONTINUE)
;
; CALL:	JSP	PC,$$SEMF
;	(RETURN IF LAST SEARCH SUCCEEDED)

$SEMF:	TXNN	F,F$LSF		; DID LAST SEARCH FAIL?
	 JRST	(PC)		; NO, RETURN TO CALLER
	JRST	$SEM		; YES, JUMP OF OF CURRENT ITERATION

; $SEMZ - JUMP OUT OF CURRENT ITERATION IF ARG.EQ.0 (ELSE CONTINUE)
;
; CALL:	JSP	PC,$$SEMZ
;	(RETURN IF ARG.LT.0)

$SEMZ:	JUMPN	ARG,(PC)	; RETURN TO CALLER IF ARG NON-ZERO
;	JRST	$SEM		; ARG.EQ.0. JUMP OUT OF CURRENT ITERATION

; $SEM - JUMP OUT OF CURRENT ITERATION
;
; CALL:	JSP	PC,$$SEM

$SEM:	POP	P,X		; POP "OUT OF ITERATION" ADR
	ADDI	X,(R)		; MAKE IT AN ABSOLUTE ADR
	JRST	(X)		; AND POP OUT OF THE ITERATION

; $STOP - STOP MACRO EXECUTION
;
; CALL:	JSP	PC,$$STOP
;
; DOES A "POPJ P," TO RETURN TO WHOEVER INVOKED THIS MACRO/COMMAND

$STOP:	POPJ	P,		;[13000] Return to caller
;	JRST	ERRREC		; SAME AS RECOVERING FROM AN ERROR
	SUBTTL	$R and $C and $J

; $R - MOVE THE BUFFER POINTER BACKWARDS N CHARS
;
; CALL:	JSP	PC,$$R
;	(RETURN)

$R:	MOVN	ARG,ARG		; MAKE ARG FOR "R" INTO ARG FOR "C"

; $C - MOVE THE BUFFER POINTER AHEAD N CHARS
;
; CALL:	JSP	PC,$$C
;	(RETURN)

$C:	ADD	ARG,PTVAL	; MAKE ARG FOR "C" INTO ARG FOR "J"

; $J - MOVE THE BUFFER POINTER TO A SPECIFIC POSITION
;
; CALL:	JSP	PC,$$J
;	(RETURN)

$J:	PUSHJ	P,CHKARG	; CHECK THE ARG FOR VALIDITY
	 CERROR	(POP)		; ** ATTEMPT TO MOVE POINTER OFF PAGE **
	MOVEM	ARG,PTVAL	; ARG IS OK. SET NEW "." VALUE
	JRST	SUCRET		; AND RETURN TO CALLER
	SUBTTL	$KL and $L and $D

; $KL - REMOVE LINES FROM TEXT BUFFER
;
; CALL:	JSP	PC,$$KL
;	(RETURN)

$KL:	PUSHJ	P,EVL2RG	; CONVERT LINE ARG TO CHAR ADDRESSES
	SKP			; AND FALL INTO $K

; $K - REMOVE TEXT BETWEEN TWO POINTS FROM THE TEXT BUFFER
;
; CALL:	JSP	PC,$$K
;	(RETURN)

$K:	PUSHJ	P,CHK2RG	; MAKE SURE ARGS ARE IN BOUNDS OF BUFFER
	MOVEM	SARG,PTVAL	; ".":=N (OF N,M)
	SUB	ARG,SARG	; COMPUTE # CHARS TO BE DELETED
	JUMPE	ARG,(PC)	; RETURN TO CALLER IF NOTHING TO DELETE
				; ELSE FALL INTO $D

; $D - DELETE SPECIFIED # CHARACTERS FROM MAIN TEXT BUFFER
;
; CALL:	JSP	PC,$$D
;	(RETURN)

$D:	MOVM	T1,ARG		; SAVE ARG AS ARG FOR 'MKROOM'
	ADD	ARG,PTVAL	; TURN ARG INTO A BUFFER ADDRESS
	PUSHJ	P,CHKARG	; AND MAKE SURE IT'S BETWEEN B AND Z
	 CERROR	(POP)		; ** ATTEMPT TO MOVE POINTER OFF PAGE **
	CAMGE	ARG,PTVAL	; DOING -ND?
	 MOVEM	ARG,PTVAL	; YES, BACKUP THE POINTER
	MOVN	T1,T1		; ARG TO MKROOM IS A NEGATIVE # TO DELETE
	PUSHJ	P,MKROOM	; DELETE THE CHARACTERS
	JRST	SUCRET		; AND RETURN TO CALLER
	SUBTTL	$TAB and $I and $NI and $L


; $I - INSERT A TEXT STRING INTO THE TEXT BUFFER AT CURRENT POSITION
;
; CALL:	JSP	PC,$$I
;	<CHAR ADR OF TEXT,# TEXT CHARS>
;	(RETURN)

$I:	PUSHJ	P,NXTWRD	; FETCH <CHARADR,,#CHARS>
	HLRZ	T1,N		; FETCH THE CHARADR
	SOJ	T1,		; 'CAUSE BP WILL BE INCREMENTED BEFORE USE
	PUSHJ	P,CTOBP		; AND CONVERT IT TO A BYTE POINTER
	IOR	T1,[Z 0(R)]	; BYTE POINTER IS RELATIVE TO CODE
	MOVE	T3,T1		; SAVE THE BYTE POINTER FOR LATER
	MOVEI	N,(N)		; FETCH THE CHAR COUNT
	TXZ	F,F$$TX		; CLEAR TEXT MODE FLAGS

; MAKE ROOM IN THE TEXT BUFFER FOR THE INSERT TEXT

	MOVEI	T1,(N)		; FETCH # CHARS TO BE INSERTED
	PUSH	P,T3		; SAVE AC  T3
	PUSH	P,N		; SAVE AC N
	PUSHJ	P,MKROOM	; MAKE ROOM FOR THE INSERT TEXT
	POP	P,N		; RESTORE AC N
	POP	P,T3		; RESTORE AC T3

; INSERT THE TEXT INTO THE BUFFER A CHAR AT A TIME

$I0:	JUMPE	N,(PC)		; RETURN TO CALLER IF INSERTION IS NULL

$I1:	ILDB	C,T3		; FETCH NEXT CHAR FROM TEXT STRING

; CHECK FOR SPECIAL CONTROL CHARACTERS

	MOVE	T1,[IOWD $IT1L,$IT1+1] ; POINTER TO CTL CHAR DISPATCH TABLE
;	TXNE	F,F$CNT		; IN ^T MODE?
;	 MOVE	T1,[IOWD $IT2L,$IT2+1] ; YES, USE SHORT DISPATCH TABLE
	PUSHJ	P,DISPAT	; DISPATCH ON SPECIAL CONTROL CHARS
$I3:	PUSHJ	P,CASE		; DO ANY REQUIRED CASE CONVERSIONS ON CCHAR
$I4:	MOVE	T1,PTVAL	; FETCH ADR OF WHERE CHAR WILL GO
	PUSHJ	P,PUT		; INSERT THE CHAR IN THE TEXT BUFFER AT "."
	AOS	PTVAL		; ".":="."+1
	SOJG	N,$I1		; LOOP FOR ALL CHARS IN TEXT STRING
	JRST	(PC)		; DONE. RETURN TO CALLER

; DISPATCH TABLES FOR SPECIAL CONTROL CHARS IN INSERT TEXT STRINGS

$IT1:	<"V"-100,,$ITV>
	<"W"-100,,$ITW>
	<"^"-100,,$ITU>

$IT2:;	<"T"-100,,$ITT>
	<"Q"-100,,$ITR>	;^Q & ^R are both quoting characters
	<"R"-100,,$ITR>
$IT2L==.-$IT2
$IT1L==.-$IT1

; ^V - DOWNCASE FOLLOWING LETTER
; ^V^V - DOWNCASE LETTERS UNTIL END OF STRING OR FURTHER NOTICE

$ITV:	PUSHJ	P,CNV		; SET THE DOWNCASE FLAGS
	JRST	$I1		; AND PROCESS NEXT CHAR

; ^W - UPCASE FOLLOWING LETTER
; ^W^W - UPCASE LETTERS UNTIL END OF STRING OR FURTHER NOTICE

$ITW:	PUSHJ	P,CNW		; SET UPCASE FLAGS
	JRST	$I1		; AND PROCESS NEXT CHAR

; ^^ - INSERT LC EQUIVALENT OF FOLLOWING CHAR (@,[,\,],_)

$ITU:	ILDB	C,T3		; FETCH THE NEXT CHAR
	PUSHJ	P,CNUAR		; DOWNCASE IF @,[,\,],OR _
	JRST	$I4		; AND COUNT CHAR AND PROCESS NEXT CHAR

; ^R - QUOTE THE NEXT CHAR (IE: TAKE AS TEXT)

$ITR:	ILDB	C,T3		; FETCH THE NEXT CHAR
	JRST	$I3		; DO CASE CONVERSIONS AND STORE IN BUFFER

; ^T - COMPLEMENT ^T MODE FLAG (IN ^T MODE ONLY ^T AND ^R ARE SPECIAL)
;[16000] ^T mode removed as useless
;$ITT:	TXC	F,F$CNT		; COMPLEMENT THE ^T MODE FLAG
;	JRST	$I1		; AND PROCESS NEXT CHAR

; $NI - INSERT ASCII CHARACTER FOR CODE IN ARG IN TEXT BUFFER AT "."
;
; CALL:	JSP	PC,$$NI
;	(RETURN)

$NI:	MOVE	C,ARG		; COPY ARG INTO AC C
	PUSHJ	P,INSCHR	; PUT CHAR INTO BUFFER AT "."
	JRST	(PC)		; AND RETURN TO CALLER

; $L - MOVE BUFFER POINTER AHEAD AN ARBITRARY NUMBER(-,0,+) OF LINES
;
; CALL:	JSP	PC,$$L
;	(RETURN)

$L:	PUSHJ	P,EVL2RG	; CONVERT LINE ARG TO STRING ADDRESSES
	MOVEM	T4,PTVAL	; PTVAL:=ADR OF NTH LINE
	JRST	(PC)		; RETURN TO CALLER

; $CNQ - return # of characters in next n lines

$CNQ:	PUSHJ	P,EVL2RG	;[12000] Convert to string addresses
	MOVE	VALUE,ARG	;[12000] The value to return...
	SUB	VALUE,SARG	;[12000] is the difference between them
	JRST	(PC)		;[12000] Return it


; $E - go to END of specified line
;
;CALL: JSP PC,$$E
;	(RETURN)

$E:	PUSHJ	P,EVL2RG	;[12000]
$E1:	CAMN	T4,@TXTBUF	;[12000] At end of buffer?
	 JRST	$E9		;[12000] Yes, stay there
	PUSHJ	P,GETINC	;[12000] Get next character
	CAIN	C,15		;[12000] Stop on <CR> or any line terminator
	 SOJA	T4,$E9		;[12000] do so
	PUSHJ	P,CHKEOL	;[12000] ...
	 JRST	$E1		;[12000] try next charcter
	SOJ	T4,		;[12000] it was a terminator, back over it
$E9:	MOVEM	T4,PTVAL	;[12000] save result
	JRST	(PC)		;[12000] Return to caller
	SUBTTL	$BS1 and $BS2

; $BS1 - N\ - INSERT ASCII REPRESENTATION OF N TO RIGHT OF "."
;
; CALL:	JSP	PC,$$BS1
;	(RETURN)

$BS1:	MOVEI	X,[AOJA T1,CPOPJ] ; TO COUNT # DIGITS IN NUMBER
	MOVEM	X,OUTADR	; SAVE ADR OF "OUTPUT" A CHAR ROUTINE
	SETZ	T1,		; CLEAR THE COUNT OF CHARS IN NUMBER
	MOVE	N,ARG		; FETCH THE NUMBER
	PUSHJ	P,TDEC		; COMPUTE # DIGITS IN NUMBER
	PUSHJ	P,MKROOM	; MAKE ROOM FOR THE NUMBER
	MOVEI	X,[AOS T1,PTVAL	; TO PUT ASCII CHARS IN THE TEXT BUFFER
		   SOJA T1,PUT]	; . . .
	MOVEM	X,OUTADR	; SAVE ADR OF OUTPUT A CHAR ROUTINE
	MOVE	N,ARG		; FETCH THE NUMBER AGAIN
	PUSHJ	P,TDEC		; AND STORE THE ASCII REPRESENTATION
				; IN THE TEXT BUFFER
	SETZM	OUTADR		; DO NORMAL OUTPUT NOW
	JRST	(PC)		; AND RETURN TO CALLER

; $BS2 - \ - RETURN THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS
;	(POSSIBLY +/- SIGN) FOLLOWING ".". "." IS POSITIONED
;	AFTER THE LAST DIGIT OR CHAR OF NUMBER
;
; CALL:	JSP	PC,$$BS2
;	(RETURN)		; WITH VALUE IN AC VALUE

$BS2:	SETZ	VALUE,		; CLEAR THE VALUE
	TXZ	F,F$1RG		; USED TO REMEMBER THAT "-" SEEN
	MOVE	T4,PTVAL	; FETCH "."
	CAML	T4,@TXTBUF	; AT END OF BUFFER?
	 JRST	$BS23		; YES, RETURN ZERO
$BS20:	PUSHJ	P,GETINC	; NO. FETCH CHAR FROM BUFFER
	CAIN	C,"+"		; IS IT "+" SIGN?
	 JRST	$BS20		; YES, IGNORE "+"
	CAIE	C,"-"		; IS IT "-" SIGN?
	 JRST	$BS22		; NO
	TXO	F,F$1RG		; YES, FLAG THAT "-" SEEN

$BS21:	CAML	T4,@TXTBUF	; AT END OF BUFFER?
	 JRST	$BS23		; YES
	PUSHJ	P,GETINC	; NO, FETCH NEXT CHAR

$BS22:	CAIG	C,"9"		; IS IT A DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  SOJA	T4,$BS24	; NO
	IMULI	VALUE,^D10	; YES, MAKE ROOM FOR THE DIGIT
	ADDI	VALUE,-"0"(C)	; AND ADD IN THE DIGIT
	JRST	$BS21		; AND TRY FOR ANOTHER DIGIT

$BS23:	MOVE	T4,@TXTBUF	; FETCH Z

$BS24:	TXNE	F,F$1RG		; A "-" SIGN SEEN?
	 MOVN	VALUE,VALUE	; YES, NEGATE THE NUMBER
	MOVEM	T4,PTVAL	; POSITION "." AFTER THE NUMBER
	JRST	(PC)		; AND RETURN TO CALLER
	SUBTTL	$TTC

; $TTC - GENERAL PURPOSE TTCALL ROUTINE
;
; CALL:	JSP	PC,$$TTC	; WITH TTCALL # IN AC ARG
;	(RETURN)

$TTC:	PUSHJ	P,FOUT		;[16000] Force out pending output
	TXZ	F,F$COL		;[12000] Clear ':' flag
	MOVE	VALUE,SARG	; SO THAT OUTCHR,SETLCH, AND IONEOU WILL WORK
	MOVX	T1,1B0		; INIT POINTER INTO BIT MAP
	MOVNI	X,(ARG)		; MAKE RIGHT SHIFT COUNT FROM TTCALL #
	LSH	T1,(X)		; FORM POINTER INTO BIT MAP
	CAIG	ARG,^D35	; IS TTCALL # IN RANGE?
	 TDNN	T1,TTLMAP	; . . . ?
	  ERROR	(ITT)		; NO, ** ILLEGAL TTCALL **

	TDNE	T1,TTXMAP	;[11000] Is this one special
	 JRST	$TTC2		; YES, DO SPECIAL KLUDGE

	LSH	ARG,^D23	; PUT TTCALL # IN AC FIELD
	IOR	ARG,[TTCALL 0,VALUE] ; AND FROM A TTCALL INSTRUCTION
$TTC0:	XCT	ARG		; EXECUTE IT
	 JRST	$TTC1		; IT DIDN'T SKIP

	TDNN	T1,TTVMAP	; HAVE A VALUE WHEN IT SKIPS?
	 SETO	VALUE,		; YES, SET VALUE:=.TRUE.
	JRST	(PC)		; NO, HAS ITS OWN VALUE. RETURN TO CALLER

; TTCALL DIDN'T SKIP

$TTC1:	TDNE	T1,TTSMAP	; WAS TTCALL A "SKIP" TYPE?
	 JRST	FAIRET		; YES, RETURN VALUE OF ZERO FOR NON-SKIP RET
	JRST	(PC)		; NO, HAS ITS OWN VALUE
;
; Some terminal-related functions that aren't TTCALL's [11000]
;

$TTC2:	CAIE	ARG,^D8		;[11000] Is this RESCAN or CCL?
	 JRST	[SKIPN	SARG	;[11000] 1 OR 2 ARGS?
		 SKIPA ARG,TT1VEC-^D16(ARG) ;[11000] 1 ARGUMENT
		 MOVE ARG,TT2VEC-^D16(ARG) ;[11000] 2 ARGS
		 JRST   $TTC0]	;[11000] and execute it

; SPECIAL KLUDGE FOR RESCAN TTCALL
;
; IF AC SARG.EQ.0 DO A "RESCAN 1", ELSE TAKE ON VALUE ON CCL FLAG
	MOVE	X,[RESCAN 1]	; FETCH THE "RESCAN" INSTRUCTION
	JUMPE	SARG,$TTC3	; WANT TO CHECK CCL FLAG?
	 MOVE	X,[TXNE (F,F$CCL)] ; YES, FETCH PROPER INSTRUCTION
$TTC3:	XCT	X		; PERFORM THE INSTRUCTION (WHATEVER IT IS)
	 JRST	SUCRET		; SUCCESS RETURN. VALUE:=.TRUE.
	JRST	FAIRET		; FAIL RETURN. VALUE:=.FALSE.

TT1VEC:	MOVE VALUE,INPCHR	;[11000] Get saved character
	GETSTS TTYC,VALUE		;[11000] Get status of TTY

TT2VEC:	HRRZM SARG,INPCHR	;[11000] Save char for typein
	SETSTS TTYC,(SARG)		;[11000] SETSTS for TTY

; BIT MAPS FOR TTCALLS

TTLMAP:	<^B111011111111110011,,0> ; MAP OF LEGAL TTCALL #'S
TTXMAP: <^B000000001000000011,,0> ; Map of args that are not TTCALLS
TTSMAP:	<^B001001000001100000,,0> ; MAP OF TTCALLS THAT SKIP
TTVMAP:	<^B101011100000000000,,0> ; [10000] TTCALLS that return values

$TRMO:	;[10000]	Generalized TRMOP. routine
	MOVE	T3,SARG		;[10000] Second argument is arg to TRMOP.
	MOVE	T1,ARG		;[10000] Function code is first arg
	PUSHJ	P,FOUT		;[12000] Force out pending terminal output
	MOVE	VALUE,[2,,T1]	;[10000] Arg block will be in T1-T3
	MOVE	T2,OURTTY	;[12000] Get our terminal number
	TXZE	F,F$2RG		;[11000] if there is any,that is
	 HRLI	VALUE,3		;[10000] Make length of arglist=3
	TRMOP.	VALUE,		;[10000] DO IT
	 JRST	FAIRET		;[10000] It didn't work
	JRST	(PC)		;[10000] Return value, if any


; $GETC:	Get command into q-register
; CALL:	JSP	PC,$$GETC
;	<Q.REG.NAME>
;	(RETURN)
$GETC:
	ECHO	ON		;[21000] Always echo this
	PUSHJ	P,GETCMD	;[15000] Do it
	TDZA	VALUE,VALUE	;[15000] user typed ^G^G or something
	SETO	VALUE,		;[15000] Got something ...
	MOVX	X,ET$SUP	;[21000] See if echo should be off
	TDNE	X,ETVAL		;[21000] i.e., ET & 8 = 8
	 ECHO	OFF		;[21000] Turn echo back off again
	PUSH	P,N		;[15000] Save BID of cmd buffer
	PUSHJ	P,REFBLK	;[21000] Bump the reference count
	PUSHJ	P,NXTWRD	;[15000] Get q register name
	MOVE	T1,N		;[15000] into T1 for QGET
	POP	P,N		;[15000] Get back BID
	PUSHJ	P,QGET		;[15000] try to get q-register
	 SETZB	T2,T3		;[15000] no sweat
	HRRI	T2,(N)		;[15000] New BID
	TXO	T2,QB$BID	;[15000] text flag now on
	TXZ	F,F$REF		;[15000] This is a BID not a pointer
	PUSHJ	P,QSTOR		;[15000] Store away...
	JRST	(PC)		;[15000] Return

; $TCHR - type (& log) a character
; CALL:	MOVX	ARG,char
;	JSP	PC,$$TCHR
;	(RETURN)

$TCHR:	MOVEI	C,(ARG)		;[12000] Character to type
	PUSHJ	P,TCCHR		;[12000] always type nice 
	PUSHJ	P,FOUT		;[16000] Force it out now
	JRST	(PC)		;[12000] continue execution

; $GCHR - Input a character from terminal (AND LOG IT!)
; CALL:	JSP	PC,$$GCHR
;	(return with character in VALUE, or -1 if no char and ET$NST set)

$GCHR:	PUSHJ	P,FOUT		;[16000] Force out output first
$GCHR0:	SKIPE	VALUE,INPCHR	;[20000] Do we have a character somewhere
	 JRST	[SETZM INPCHR	;[20000] Only once please
		 JRST (PC)]	;[20000] Yes, use it
	MOVX	X,ET$NST	;[16000] no stall set?
FOR TOPS10!TOPS20,<
	TDNE	X,ETVAL		;[16000] no stall set?
	 JRST	[INCHRS VALUE	;[16000] Try to get a character
		  JRST SUCRET	;[16000] didn't, return -1
		 JRST (PC)]	;[16000] did, return character
$GCHRW:	INCHRW	VALUE		;[16000] Wait until the cows come home
>
	TXNN	F,F$LOG		;[16000] Log this?
	 JRST	(PC)		;[16000] No log file at all
	MOVX	X,FB$NOO	;[16000] log input?
	TDNE	X,LELSPC+FS$FLG	;[16000] ...
	 PUSHJ	P,LOGPH1	;[16000] log it
	JRST	(PC)		;[16000] continue


; $FF2 - m,nFF - adjust cursor co-ordinates (FX,FY) as if we had done m,nT

$FF2:	PUSHJ	P,CHK2RG	;[12000] Make sure args in bounds
	MOVE	T4,SARG		;[12000] Starting point
	SUB	ARG,SARG	;[12000] # of chars
FF2LP:!	SOJL	ARG,(PC)	;[12000] exit if done
	PUSHJ	P,GETINC	;[12000] Get a character
	PUSHJ	P,UPDCDC	;[12000] Update FX & FY
	JRST	FF2LP		;[12000] back for more

$FF1:	MOVE	T5,ARG		;[12000] We will put the row
	ADD	T5,ROW		;[12000]  we want to be in in T5
	MOVE	T4,PTVAL	;[12000] Start at .
	PUSH	P,ROW		;[14000] Save current row
	PUSH	P,COL		;[14000]  and column
	PUSH	P,LENGTH	;[15000]  and length of screen
	SETZM	ROW		;[12000] Initialize row
	SETZM	COL		;[12000] & col, start at beginning
	HRLOI	X,377777	;[15000] Make length very large
	MOVEM	X,LENGTH	;[15000] indeed
FF1L:	CAMLE	T4,@TXTBUF	;[12000] Check for end of buffer
	 JRST	FF1Z		;[12000] hit it, finish up
	PUSHJ	P,GETINC	;[12000] Get a character
	PUSHJ	P,UPDCDC	;[12000] move cursor position
	JUMPL	ARG,[CAMLE T5,ROW ;[12000] Got to right row yet?
		      JRST FF1L ;[12000] No, keep going
		     JRST FF1Z] ;[12000] yes, finish up
	CAML	T5,ROW		;[12000] must go past it first
	 JRST	FF1L		;[12000] not yet...
	SOJ	T4,		;[12000] Yes, back up into it again
FF1Z:	SOS	VALUE,T4	;[12000] Undo the INC from GETINC
	POP	P,LENGTH	;[15000] Put back length of screen
	POP	P,COL		;[14000] Restore old co-ordinates
	POP	P,ROW		;[14000] ...
	JRST	(PC)		;[12000] continue execution
	SUBTTL	$S and $N

; $S - SEARCH FOR AN OCCURRANCE OF A STRING IN THE TEXT BUFFER
;
; CALL:	JSP	PC,$$S
;	<CHAR.ADR,,<X>B18+TEXT.LENGTH>
;				; CHAR.ADR:=ADR OF SEARCH ARGUMENT
;				; X:=0 IF BOTH LC AND UC LETTERS MATCH
;				; X:=1 IF EXACT SEARCH MODE
;				; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
;	(RETURN)

$S:	JUMPGE	ARG,$S1		; IF FORWARD SEARCH, THEN DO IT NOW
$S0:	MOVE	T4,@TXTBUF	; REVERSE BOUNDS FOR MINUS SEARCH
	SETZ	T5,		; . . .
	MOVM	ARG,ARG		; AND MAKE REPEAT FACTOR POSITIVE
	PUSHJ	P,BSERCH	; PERFORM THE SEARCH
	 JRST	$SF		; SEARCH FAILED
	JRST	(PC)		; SEARCH SUCCEEDED. RETURN TO CALLER

$S1:	PUSHJ	P,SERCH		; DO THE FORWARD SEARCH
	 JRST	$SF		;[14000] ** SEARCH FAILED **
	JRST	(PC)		; SEARCH SUCCEEDED. RETURN TO CALLER

$SF:	TXNE	F,F$2CO		;[14000] ::S never steps on pointer
	 JRST	$SF1		;[14000] so don't
	MOVE	X,EDVAL		;[14000] Preserve pointer?
	TXNN	X,ED$SSF	;[14000] IF SET
$SF0:	 SETZM	PTVAL		;[14000] step on it
$SF1:	CERROR	(SRH)		;[14000] ** SEARCH FAILED **
	JRST	(PC)		;[14000] Recover from it?

; $N - NON-STOP SEARCH FOR A STRING
;
; CALL:	JSP	PC,$$N
;	<CHAR.ADR,,<X>B18+TEXT.LENGTH>
;				; CHAR.ADR:=ADR OF SEARCH ARGUMENT
;				; X:=0 IF BOTH LC AND UC LETTERS MATCH
;				; X:=1 IF EXACT SEARCH MODE
;				; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
;	(RETURN)

$N:	JUMPL	ARG,$S0		; BACKWARDS SEARCH (ONLY IN CURRENT BUFFER)

$N1:	PUSHJ	P,SERCH		; SEARCH REST OF CURRENT BUFFER
	 SKP			; SEARCH FAILED
	JRST	(PC)		; SEARCH SUCCEEDED. RETURN TO CALLER
	SETZ	T4,		; GET READY TO PUNCH OUT ENTIRE BUFFER
	MOVE	T5,@TXTBUF	; . . .
	PUSHJ	P,PUNCH		; PUNCH OUT THE ENTIRE BUFFER
	MOVEI	C,.CHFFD	; GET READY IN CASE <FF> CHAR NEEDED
	TXNE	F,F$FFD		; NEED <FF> AT END OF BUFFER?
	 PUSHJ	P,@PCHADR	; YES, PUNCH A <FF> CHAR
	TXNE	F,F$EOF		; AT END OF FILE?
	 JRST	[PUSHJ P,YANK	; YES, YANK  THE BUFFER CLEAR
		 CERROR (SRH)]	; AND GIVE SEARCH FAIL ERROR
	PUSHJ	P,YANK		; NO, YANK THE NEXT BUFFER
	SOJA	PC,$N1		; BACKUP PC TO <CHAR.ADR,,CHAR.LENGTH>
				; AND CONTINUE SEARCH IN NEXT PAGE
	SUBTTL	$BAR , $EBAR
; $BAR - NON-STOP SEARCH FOR A STRING (NO OUTPUT)
; $BAR & $EBAR are the same except that $EBAR does not check for 2ED
;
; CALL:	JSP	PC,$$BAR
;	<CHAR.ADR,,<X>B18+TEXT.LENGTH>
;				; CHAR.ADR:=ADR OF SEARCH ARGUMENT
;				; X:=0 IF BOTH LC AND UC LETTERS MATCH
;				; X:=1 IF EXACT SEARCH MODE
;				; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
;	(RETURN)

$BAR:	TXNN	F,F$UWR		;[16000] _ OK if no output file
	 JRST	$EBAR		;[16000] ....
	MOVE	X,EDVAL		;[14000] Check for 2ED
	TXNN	X,ED$YOK	;[14000] Procede if set
	 CERROR	(YCA)		;[14000] not allowed
$EBAR:	JUMPL	ARG,$S0		; BACKWARDS SEARCH (ONLY IN CURRENT BUFFER)

$BAR1:	PUSHJ	P,SERCH		; SEARCH REST OF CURRENT BUFFER
	 SKP			; SEARCH FAILED
	JRST	(PC)		; SEARCH SUCCEEDED. RETURN TO CALLER
	TXNE	F,F$EOF		; SEARCH FAILED. AT END OF FILE?
	 JRST	$SF0		; YES, STOP SEARCHING
	PUSHJ	P,YANK		; READ NEXT BUFFER
	SOJA	PC,$BAR1	; POINT PC TO SEARCH ARGUMENT
				; AND TRY THE SEARCH AGAIN IN NEXT BUFFER
	SUBTTL	$BSL, $BS  and $FS
; $BSL - Line mode bounded search
;
; CALL:	JSP	PC,$$BSL
;	<CHAR.ADR,,<X>B18+TEXT.LENGTH>
;				; CHAR.ADR:=ADR OF SEARCH ARGUMENT
;				; X:=0 IF BOTH LC AND UC LETTERS MATCH
;				; X:=1 IF EXACT SEARCH MODE
;				; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
;	(RETURN)

$BSL:	JUMPGE	ARG,.+2		;[15000] Not minus search
	 TXOA	F,F$MSR		;[15000] Is minus search
	TXZ	F,F$MSR		;[15000] no indeed!
	PUSHJ	P,EVL2RG	;[14000] Convert line args to char args
	TXNE	F,F$MSR		;[15000] Reverse args for -nFB
	 EXCH	ARG,SARG	;[15000] so it will be a backwards search
				;[14000] and fall into $BS

; $BS  - SEARCH FOR AN OCCURRANCE OF A STRING WITHIN SPECIFIED BOUNDS
;
; CALL:	JSP	PC,$$BS
;	<CHAR.ADR,,<X>B18+TEXT.LENGTH>
;				; CHAR.ADR:=ADR OF SEARCH ARGUMENT
;				; X:=0 IF BOTH LC AND UC LETTERS MATCH
;				; X:=1 IF EXACT SEARCH MODE
;				; TEXT.LENGTH IS LENGTH OF SEARCH ARGUMENT
;	(RETURN)

$BS:	TXO	F,F$MSR		; SET THE MINUS SEARCH FLAG
	CAML	ARG,SARG	;[314] MINUS SEARCH?
	 TXZA	F,F$MSR		; NO, CLEAR FLAG
	 EXCH	SARG,ARG	; Exchange arguments
	PUSHJ	P,CHK2RG	; CHECK THE ARGS FOR VALIDITY
;[14000]MOVEM	SARG,PTVAL	; ".":=LOWER BOUND
	TXZE	F,F$MSR		; MINUS SEARCH?
	 EXCH	SARG,ARG	; YES, REVERSE THE ARGS
	MOVE	T4,SARG		; FETCH THE LOWER BOUND
	MOVE	T5,ARG		; FETCH THE UPPER BOUND
	MOVEI	ARG,1		;[314] SEARCH FOR FIRST OCCURRANCE
	PUSHJ	P,BSERCH	; AND DO THE SEARCH
	 CERROR	(SRH)		;[14000] ** SEARCH FAILED **
	JRST	(PC)		; SEARCH SUCCEEDED. RETURN TO CALLER

; $FS - SUBSTITUTE A STRING FOR THE LAST SEARCH STRING
;
; CALL:	JSP	PC,$$FS
;	<CHAR.ADR,,CHAR.LENGTH>
;	(RETURN)

$FS:	PUSHJ	P,NXTWRD	; FETCH <ADR,,LEN>
	TXNE	F,F$LSF		; DID LAST SEARCH FAIL?
	 JRST	(PC)		; YES, DON'T INSERT TEXT STRING
	MOVEI	T1,(N)		; FETCH INSERTION LENGTH (IN CHARS)
	MOVE	X,PTVAL		; FETCH VALUE OF "."
	SUB	X,SRHLEN	; MINUS LENGTH OF LAST SEARCH MATCH
	MOVEM	X,PTVAL		; POSITION "." BEFORE LAST SEARCH ARG
	SUB	T1,SRHLEN	; MINUS LENGTH OF LAST SEARCH MATCH
	PUSHJ	P,MKROOM	; ADJUST BUFFER FOR INSERTION
	HLRZ	T1,-1(PC)	; FETCH CHAR.ADR
	SOJ	T1,		; 'CAUSE BP WILL BE INCREMENTED BEFORE USE
	PUSHJ	P,CTOBP		; CONVERT IT TO A BYTE POINTER
	IOR	T1,[Z 0(R)]	; BYTE POINTER IS RELATIVE TO CODE
	MOVE	T3,T1		; SAVE THE BYTE POINTER FOR LATER
	TXZ	F,F$$TX		; CLEAR TEXT MODE FLAGS
	HRRZ	N,-1(PC)	; FETCH # CHARS TO BE INSERTED
	JRST	$I0		; AND DO THE INSERT
	SUBTTL	$TL and $T and $0TT

; $TL - TYPE LINES FROM TEXT BUFFER
;
; CALL:	JSP	PC,$$TL
;	(RETURN)

$TL:	PUSHJ	P,TYPEL		; CALL THE "TYPE LINES" ROUTINE
	JRST	(PC)		; AND RETURN TO CALLER

; $T - TYPE TEXT BETWEEN TWO POINTS FROM THE TEXT BUFFER
;
; CALL:	JSP	PC,$$T
;	(RETURN)

$T:	PUSHJ	P,TYPE		; CALL THE "TYPE" ROUTINE
	JRST	(PC)		; AND RETURN TO CALLER

; $0TT - TYPE CURRENT LINE IF LAST SEARCH SUCCEEDED AND ES.NE.0
;
; CALL:	JSP	PC,$$0TT
;	(RETURN)

$0TT:	TXNN	F,F$LSF		; DID LAST SEARCH FAIL?
	 SKIPN	ESVAL		; OR SEARCH AUTOTYPE FLAG OFF?
	  JRST	(PC)		; YES, SKIP THE SEARCH AUTOTYPE
	SETZ	ARG,		; TYPE UP TO CURRENT POSITION ON LINE (IE: "0T")
	PUSHJ	P,TYPEL		; . . .
	SKIPG	C,ESVAL		; FETCH THE SEARCH TYPE CHAR
	 JRST	$0TT1		; DON'T TYPE SEARCH MARKER
	CAIGE	C,.CHSPC	; IS SEARCH MARKER A CONTROL CHAR?
	 MOVEI	C,.CHLFD	; YES, SUBSTITUTE A <LF>
	PUSHJ	P,TCHR		; TYPE THE SEARCH MARKER CHAR

$0TT1:	MOVEI	ARG,1		; TYPE REST OF CURRENT LINE (IE: "T")
	PUSHJ	P,TYPEL		; . . .
	JRST	(PC)		; AND RETURN TO CALLER

; $V - Type some lines either side of the pointer
;
; CALL: JSP	PC,$$V
;	(RETURN)

$V:	PUSH	P,ARG		;[12000] Save argument
	MOVN	ARG,ARG		;[12000]
	AOJ	ARG,		;[12000] ARG=(1-ARG)
	PUSHJ	P,EVL2RG	;[12000] returns start in SARG
	MOVE	ARG,(P)		;[12000] get back original ARG
	MOVEM	SARG,(P)	;[12000] Save start of stuff to type
	PUSHJ	P,EVL2RG	;[12000] This will get end addr
	POP	P,SARG		;[12000] now we have the correct arguments
	PUSHJ	P,TYPE0		;[12000] Type it out
	JRST	(PC)		;[12000] continue execution

CWOORZ:	MOVE	SARG,DEFARG	;[15000] Set default 2nd arg
CWOORG:	SKIPA	T1,['[:W]  ']	;[14000] n:W =nM([:W]) if n out of range

; $W - W or nW - Do window stuff
; CALL: JSP PC,$$W
;	(RETURN)

$W:
	MOVX	T1,<'[W]   '>	;[14000] W = M([W])
	TXO	F,F$COL!F$1RG!F$2RG	;[14000] No error if no macro
	SETOM	MACFLG		;[15000] Don't let COMPIL forget args
	PJRST	M1		;[14000] Execute the macro, if any

; $COLW - n:w or m,n:w - manipulate window parameters
; CALL: JSP PC,$$COLW
;	(RETURN)

$COLW:
	JUMPL	ARG,CWOORZ	;[12000] negative n.g.
	CAILE	ARG,CWMAX	;[12000] Range check
	 JRST	CWOORZ
	MOVE	VALUE,CWVEC(ARG);[15000] Get the value
	TXZ	F,F$COL!F$2CO	;[15000] Clear colon flags
	JRST	(PC)		;[15000] & return it

; $CW2 - M,N:W = set window parameters
; CALL:	JSP PC,$$CW2
;	(RETURN)
$CW2:
	JUMPL	ARG,CWOORG	;[15000] No negative entries in table
	CAIG	ARG,CWMAX	;[15000] Store nothing if out of range
	 MOVEM	SARG,CWVEC(ARG)	;[12000] Store the value
	JRST	CWOORG		;[15000] Execute the macro

; $EJ - Return some parameter from system
;
; CALL: JSP	PC,$$EJ
;	(RETURN)
EJMIN==-1			;[22000] Fix for MACRO bug?

$EJ:	CAML	ARG,[EJMIN]	;[22000] Return 0 if out of range
	CAILE	ARG,EJMAX	;[12000] Range check
	 JRST	FAIRET		;[12000] This will return zero always
	XCT	EJVEC(ARG)	;[12000] Get the parameter
	 JFCL			;[12000] some skip, some don't
IFN FTPRIV,<			;[12000] Priveleged options
	TXZN	F,F$2RG		;[12000] Should we try to set one of these?
	 JRST	(PC)		;[12000] Win if we survived this far
	XCT	EJSVEC(ARG)	;[12000] why not?
	 JFCL			;[12000] Ignore skip return or lack thereof
>
	JRST	(PC)		;[12000] We're done

EJMIN==<.-EJVEC>
	MOVX	VALUE,1000+TOPS20 ;[22000] CPU type=1000, O/S type =0 or 1

EJVEC:				;[12000] Dispatch table
	PJOB	VALUE,		;[12000] Get our job number
	MOVE	VALUE,OURTTY	;[12000] Get our terminal number
	GETPPN	VALUE,		;[12000] Get our PPN
EJMAX==<.-EJVEC>		;[12000] Maximum legal value

	SETZ	VALUE,		;[12000] EJSVEC[-1] for bad arguments

EJSVEC:	JRST	FAIRET		;[12000] Can't change job number
	MOVEM	SARG,OURTTY	;[12000] Make this our output sink
	CHGPPN	SARG,		;[12000] Change our PPN, return old one
	SUBTTL	$A and $P and $PW and $BP

; $A - APPEND NEXT PAGE ONTO CURRENT BUFFER
;
; CALL:	JSP	PC,$$A
;	(RETURN)

$A:	TXNN	F,F$COL		;[16000] :A returns 0 if EOF else -1
	 JRST	A0		;[16000] not :A
	TXNE	F,F$EOF		;[16000] So check for EOF
	  JRST FAIRET		;[16000] It was, so fail
	SETO VALUE,		;[16000] Win unless no input file
A0:	PUSHJ	P,APPEND	; APPEND THE NEXT INPUT PAGE
	JRST	(PC)		; AND RETURN TO CALLER

; $AL - Append n lines to the buffer from the input file

; CALL:	MOVX	ARG,<# OF LINES>	;[16000]
;	JSP	PC,$$AL		;[16000]
;	(RETURN)		;[16000]

$AL:	TXNE	F,F$EOF		;[16000] At EOF already
	 JRST	FAIRET		;[16000] Yes 
	PUSHJ	P,APPENL	;[16000] append lines
	JRST	SUCRET		;[16000] CONTINUE EXECUTION

; $P - PUNCH CURRENT PAGE AND YANK IN A NEW PAGE
;
; CALL:	JSP	PC,$$P
;	(RETURN)

$P:	JUMPGE	ARG,.+2		;[14000] We don't tolerate negative arguments
	 CERROR	(IPA)		;[14000] and this was one
	SETZM	PTVAL		;[412] INSURE "." IS CLEARED
	PUSHJ	P,PUNBUF	; PUNCH "ARG" BUFFERS
	JRST	(PC)		; AND RETURN TO CALLER

; $PW - PUNCH CURRENT PAGE AND ALWAYS APPEND A FORMFEED
;	DOES NOT AFFECT THE PAGE IN ANY WAY
;
; CALL:	JSP	PC,$$PW
;	(RETURN)

$PW:	JUMPLE	ARG,(PC)	; DO NOTHING IF ARG.LE.0

$PW1:	SETZ	T4,		; T4:=LOWER BOUND (IE: B)
	MOVE	T5,@TXTBUF	; T5:=UPPER BOUND (IE: Z)
	PUSHJ	P,PUNCH		; PUNCH OUT THE ENTIRE BUFFER
	MOVEI	C,.CHFFD	; FETCH A FORM.FEED CHAR
	PUSHJ	P,@PCHADR	; AND PUNCH IT
	SOJG	ARG,$PW1	; KEEP PUNCHING UNTILL ARG RUNS OUT
	JRST	(PC)		; ARG RAN OUT. RETURN TO CALLER

; $BP - PUNCH PART OF CURRENT PAGE (BETWEEN TWO BOUNDS)
;	DOES NOT AFFECT THE PAGE IN ANY WAY
;
; CALL:	JSP	PC,$$BP
;	(RETURN)

$BP:	PUSHJ	P,CHK2RG	; CHECK ARGS FOR VALIDITY
	MOVE	T4,SARG		; T4:=LOWER BOUND
	MOVE	T5,ARG		; T5:=UPPER BOUND
	PUSHJ	P,PUNCH		; PUNCH PART OF THE BUFFER
	JRST	(PC)		; AND RETURN TO CALLER
	SUBTTL	$Y and $CNP AND $CNY AND $CNU

; $Y - RENDER THE BUFFER AND YANK A NEW BUFFER
;
; CALL:	JSP	PC,$$Y
;	(RETURN)

$Y:	TXNE	F,F$UWR		;[16000] Y is OK if no output file
	SKIPN	@TXTBUF		;[12000] Naked "Y" legal if buffer empty
	 JRST	$EY		;[14000] ok
	MOVE	X,EDVAL		;[14000] "Y" legal always if 2ED set
	TXNN	X,ED$YOK	;[14000]
	 CERROR	(YCA)		;[12000] no good
$EY:	MOVE	X,PCHFLG	; FETCH FLAGS FOR LAST "EB" OR "EW"
	TXNE	X,FB$EXE	; /EXECUTE?
	 JRST	SUCRET		; YES, SKIP THE YANK
	JUMPLE	ARG,SUCRET	; DO NOTHING IF ARG.LE.0

$Y1:	PUSHJ	P,YANK		; YANK A BUFFER
	SOJG	ARG,$Y1		; KEEP YANKING UNTIL ARG RUNS OUT
	JRST	SUCRET		; ARG RAN OUT. RETURN TO CALLER

; $CNP - PUNCH INPUT FILE TILL SPECIFIED PAGE IS IN BUFFER
;
; CALL:	JSP	PC,$$CNP	; WITH PAGE # IN "ARG"
;	(RETURN)

$CNP:	CAMGE	ARG,PAGCNT	; ARG BEFORE CURRENT PAGE?
	 ERROR	(PPC)		; YES, ** PAGE PREVIOUS TO CURRENT PAGE **
	CAMN	ARG,PAGCNT	;[320] CHECK IF ALREADY THERE
	JRST	(PC)		;[320] YES: RETURN NOW
	SOJ	ARG,		; ARG:=# FORMFEEDS TO SKIP OVER

$CNP1:	CAMG	ARG,PAGCNT	; SKIPPED OVER DESIRED # FORMFEEDS?
	 JRST	$CNP2		; YES, PUNCH THIS BUFFER AND YANK FIRST
	SETZ	T4,		; PUNCH CURRENT PAGE
	MOVE	T5,@TXTBUF	; . . .
	PUSHJ	P,PUNCH		; . . .
	MOVEI	C,.CHFFD	; FETCH A <FF> CHAR JUST IN CASE
	TXNE	F,F$FFD		; NEED A <FF>?
	 PUSHJ	P,@PCHADR	; YES, PUNCH THE <FF> AT END OF PAGE
	TXNE	F,F$EOF		; AT END OF FILE?
	 JRST	$CNP3		;[354] PAGE NOT FOUND
	PUSHJ	P,YANK		; NO, READ NEXT PAGE
	JRST	$CNP1		; AND SEE IF IT'S THE ONE WE WANT

$CNP2:	MOVEI	ARG,1		; PUNCH CURRENT PAGE AND YANK NEXT
	JRST	$P		; . . .

$CNP3:	SETZM	PTVAL		;[354] ".":=B (DOES A "J")
	SETZM	@TXTBUF		;[354] Z:=B (DOES AN "HK")
	ERROR	(PNF)		;[354] GIVE ERROR MESSAGE

; $CNY - YANK INPUT FILE TILL SPECIFIED PAGE IS IN BUFFER
;
; CALL:	JSP	PC,$$CNY	; WITH PAGE # IN "ARG"
;	(RETURN)

$CNY:	CAMGE	ARG,PAGCNT	;[327] ARG BEFORE CURRENT PAGE?
	 ERROR	(PPC)		;[327] YES ** PAGE PREVIOUS TO CURRENT PAGE **
	CAMN	ARG,PAGCNT	;[327] SEE IF ALREADY THERE
	JRST	(PC)		;[327] YES: RETURN NOW
	SOJ	ARG,		;[327] ARG:=(PAGE DESIRED-1)

$CNY1:	CAMG	ARG,PAGCNT	;[327] AT LAST BEFORE?
	 JRST	$CNY2		;[327] YES: YANK IN LAST
	TXNE	F,F$EOF		;[327] AT END OF FILE?
	 ERROR	(PNF)		;[327] YES, ** PAGE NOT FOUND **
	PUSHJ	P,YANK		;[327] YANK IN A PAGE
	JRST	$CNY1		;[327] LOOP FOR ANOTHER PAGE

$CNY2:	MOVEI	ARG,1		;[327] YANK ONE LAST TIME
	JRST	$Y1		;[327] . . .

; $USI - USETI TO DESIRED BLOCK ON INPUT FILE
;
; CALL:	JSP	PC,$$USI	; WITH BLOCK # IN "ARG"
;	(RETURN)

$USI:	TXNN	F,F$URD		;[333] IS A FILE OPEN FOR INPUT?
	 CERROR	(NFI)		;[333] NO, BALK
	USETI	INP,(ARG)	;[333] PICK DESIRED BLOCK
	MOVEI	X,INPBF		;[427] TO BE PLACED IN .JBFF
	EXCH	X,.JBFF		;[427] GET CURRENT .JBFF AND SAVE TEMP
	INBUF	INP,C$NBUF	;[427] REND BUFFERS AND MAKE NEW ONES
	EXCH	X,.JBFF		;[427] RESTORE .JBFF
	INPUT	INP,		;[427] INPUT A NEW BUFFER
	JRST	(PC)		;[333] ALL DONE
	SUBTTL	$CNU,$X,$XL

; $CNU - Store text string in q-register
;
; CALL:	JSP	PC,$$CNU
;	<Q.REGISTER.NAME>
;	<CHARADR,,LEN>
;	(RETURN)

$CNU:
	PUSHJ	P,NXTWRD	;[12000] Get Q-register name
	MOVE	T1,N		;[12000] QGET wants it in T1
	PUSHJ	P,QGET		;[12000] Get current contents
	 SETZB	T2,T3		;[12000] Q-register does not exist
	PUSH	P,T1		;[12000] Save Q-register stuff on stack
	PUSH	P,T2		;[12000]
	PUSH	P,T3		;[12000]
	PUSHJ	P,NXTWRD	;[12000] Text is from cmd buffer (^U cmd)
	HLRZ	L,N		;[12000] Get character addr in cmd buffer
	MOVEI	T5,(N)		;[12000] length of insert string
	JUMPN	T5,$CNU00	;[12000] rejoin common code
	TXNE	F,F$1RG		;[12000] if there was an argument
	 AOJA	T5,.+2		;[15000] Allocate space for 1 char
$CNU00:	TXZ	F,F$1RG		;[24000] Ignore the argument
	PUSH	P,L		;[12000] Save L
	MOVEI	T3,<T$DATA*5>+4	;[12000]Add in overhead words
	ADD	T3,T5		;[13000] and # of characters (36 bits worth)
	IDIVI	T3,5		; COMPUTE SIZE IN WORDS
	TXNE	F,F$COL		;[12000] :^U is append to q-register
	 JRST	[TXNN	T2,777777	;[12000] Any text to append to?
		  JRST	.+1		;[12000] No  (just like X)
		 MOVEI	L,TXREF		;[12000] Get address of text here
		 MOVEI	N,(T2)		;[12000] BID here
		 PUSHJ	P,FNDBLK	;[12000] look for it
		  ERROR	(BNF)		;[12000] OOPS
		 MOVEI	N,-T$DATA(T3)	;[12000] # of words to expand
		 PUSHJ	P,EXPAND	;[12000] Expand it
		 MOVE	T1,TXREF	;[12000] Get start of buffer
		 MOVX	T2,TB$CMP	;[12000] Will have to be recompiled
		 ANDCAM	T2,T$BIT(T1)	;[12000] since we will step on the code
		 MOVE	N,T$CCNT(T1)	;[12000] Find end of buffer
		 IDIVI	N,5		;[12000] In words, please
		 ADDM	T5,T$CCNT(T1)	;[12000] update size of it
		 HLL	N,CBPTBL-1(M)	;[12000] Find correct byte
		 ADDI	N,T$DATA(T1)	;[12000] Add in addr of start of text
		 JRST	$CNU01]		;[12000] done
	MOVEI	L,(T3)		;[12000] Get length of block to allocate
	HRLI	L,TXREF		; TXREF WILL REFERENCE THE TEXT BUFFER
	SETZM	TXREF		; CLEAR TXREF
	PUSHJ	P,REQM		; ALLOCATE THE TEXT BUFFER
	MOVE	N,[POINT 7,T$DATA] ; FORM BYTE POINTER TO BUFFER
	ADD	N,TXREF	; . . .
	ADDM	T5,T$CCNT-T$DATA(N)	; SAVE # CHARS TO BE PUT IN Q-REGISTER
$CNU01:	POP	P,T3		; RESTORE Char adr into T3
	IDIVI	T3,5		; CONVERT TO A BYTE POINTER
	HLL	T3,CBPTBL-1(T4)	; . . .
	TXO	T3,<Z (R)>	;[12000] Make relative to cmd buffer
	TXZ	F,F$$TX		;[15000] Clear all these flags to start
	TXZN	F,F$1RG		;[15000] Single character numeric insert?
	 JRST	$CNU02		;[15000] NO
	SETZ	T5,		;[15000] no more after this one
	MOVE	C,ARG		;[15000] Get the character
	JRST	$CNU4		;[15000] Just insert it, nothing fancy

$CNU02:	SOJL	T5,$X2		; JUMPE WHEN FINISHED STORING

$CNU1:	ILDB	C,T3		; FETCH NEXT CHAR FROM TEXT STRING

; CHECK FOR SPECIAL CONTROL CHARACTERS

	MOVE	T1,[IOWD $CNU1L,$CNUT1+1] ; POINTER TO CTL CHAR DISPATCH TABLE
;	TXNE	F,F$CNT		; IN ^T MODE?
;	 MOVE	T1,[IOWD $CNU2L,$CNUT2+1] ; YES, USE SHORT DISPATCH TABLE
	PUSHJ	P,DISPAT	; DISPATCH ON SPECIAL CONTROL CHARS
$CNU3:	PUSHJ	P,CASE		; DO ANY REQUIRED CASE CONVERSIONS ON CCHAR
$CNU4:	IDPB	C,N		;[14000] Store it
	JRST	$CNU02		;[14000] loop

; DISPATCH TABLES FOR SPECIAL CONTROL CHARS IN INSERT TEXT STRINGS

$CNUT1:	<"V"-100,,$CNUTV>
	<"W"-100,,$CNUTW>
	<"^"-100,,$CNUTU>

$CNUT2:;	[16000] removed 	<"T"-100,,$CNUTT>
	<"R"-100,,$CNUTR>
	<"Q"-100,,$CNUTR>
$CNU2L==.-$CNUT2
$CNU1L==.-$CNUT1

; ^V - DOWNCASE FOLLOWING LETTER
; ^V^V - DOWNCASE LETTERS UNTIL END OF STRING OR FURTHER NOTICE

$CNUTV:	PUSHJ	P,CNV		; SET THE DOWNCASE FLAGS
	JRST	$CNU1		; AND PROCESS NEXT CHAR

; ^W - UPCASE FOLLOWING LETTER
; ^W^W - UPCASE LETTERS UNTIL END OF STRING OR FURTHER NOTICE

$CNUTW:	PUSHJ	P,CNW		; SET UPCASE FLAGS
	JRST	$CNU1		; AND PROCESS NEXT CHAR

; ^^ - INSERT LC EQUIVALENT OF FOLLOWING CHAR (@,[,\,],_)

$CNUTU:	ILDB	C,T3		; FETCH THE NEXT CHAR
	PUSHJ	P,CNUAR		; DOWNCASE IF @,[,\,],OR _
	JRST	$CNU4		; AND COUNT CHAR AND PROCESS NEXT CHAR

; ^R - QUOTE THE NEXT CHAR (IE: TAKE AS TEXT)

$CNUTR:	ILDB	C,T3		; FETCH THE NEXT CHAR
	JRST	$CNU3		; DO CASE CONVERSIONS AND STORE IN BUFFER

; ^T - COMPLEMENT ^T MODE FLAG (IN ^T MODE ONLY ^T AND ^R ARE SPECIAL)
;[16000] ^T mode removed
;$CNUTT:	TXC	F,F$CNT		; COMPLEMENT THE ^T MODE FLAG
;	JRST	$CNU1		; AND PROCESS NEXT CHAR


; $XL - EXTRACT LINES FROM THE TEXT BUFFER AND STORE IN A Q-REGISTER
;
; CALL:	JSP	PC,$$XL
;	<Q.REGISTER.NAME>
;	(RETURN)

$XL:	PUSHJ	P,EVL2RG	; CONVERT LINE ARG TO CHAR ARGS
	SKP			; AND FALL INTO $X

; $X - EXTRACT CHARACTERS FROM THE TEXT BUFFER AND STORE IN A Q-REGISTER
;
; CALL:	JSP	PC,$$X
;	<Q.REGISTER.NAME>
;	(RETURN)

$X:	PUSHJ	P,CHK2RG	; MAKE SURE ARGS ARE OKAY
$X0:	PUSHJ	P,NXTWRD	;[12000] Get Q-register name
	MOVE	T1,N		;[12000] QGET wants it in T1
	PUSHJ	P,QGET		;[12000] Get current contents
	 SETZB	T2,T3		;[12000] Q-register does not exist
	PUSH	P,T1		;[12000] Save Q-register stuff on stack
	PUSH	P,T2		;[12000]
	PUSH	P,T3		;[12000]
	JUMPL	SARG,[PUSHJ P,NXTWRD ;[12000] Text is from cmd buffer (^U cmd)
		      HLR SARG,N ;[12000] Get character addr in cmd buffer
		      MOVEI T5,(N) ;[12000] length of insert string
		      JUMPN T5,$X00 ;[12000] rejoin common code
		      TXNN F,F$1RG ;[12000] if there was an argument
		       JRST $X00   ;[12000] (there wasn't) (null insert)
		      TLZ SARG,200000 ;[12000] Remember to insert character only
		      AOJA T5,$X00] ;[12000] then insert it as a character
	MOVE	T5,ARG		; COMPUTE SIZE OF TEXT BUFFER NEEDED
	SUB	T5,SARG		; . . .
$X00:	PUSH	P,SARG		;[12000] Save SARG a.k.a L
	MOVEI	T3,<T$DATA*5>+4	;[12000]Add in overhead words
	ADD	T3,T5		;[13000] and # of characters (36 bits worth)
	IDIVI	T3,5		; COMPUTE SIZE IN WORDS
	TXNE	F,F$COL		;[12000] :X is append to q-register
	 JRST	[TXNN	T2,777777	;[12000] Any text to append to?
		  JRST	.+1		;[12000] No  (just like X)
		 MOVEI	L,TXREF		;[12000] Get address of text here
		 MOVEI	N,(T2)		;[12000] BID here
		 PUSHJ	P,FNDBLK	;[12000] look for it
		  ERROR	(BNF)		;[12000] OOPS
		 MOVEI	N,-T$DATA(T3)	;[12000] # of words to expand
		 PUSHJ	P,EXPAND	;[12000] Expand it (we already have overhead words)
		 MOVE	T1,TXREF	;[12000] Get start of buffer
		 MOVX	T2,TB$CMP	;[12000] Will have to be recompiled
		 ANDCAM	T2,T$BIT(T1)	;[12000] since we will step on the code
		 MOVE	T3,T$CCNT(T1)	;[12000] Find end of buffer
		 IDIVI	T3,5		;[12000] In words, please
		 ADDM	T5,T$CCNT(T1)	;[12000] update size of it
		 HLL	T3,CBPTBL-1(T4)	;[12000] Find correct byte
		 ADDI	T3,T$DATA(T1)	;[12000] Add in addr of start of text
		 JRST	$X01]		;[12000] done
	MOVEI	L,(T3)		;[12000] Get length of block to allocate
	HRLI	L,TXREF		; TXREF WILL REFERENCE THE TEXT BUFFER
	SETZM	TXREF		; CLEAR TXREF
	PUSHJ	P,REQM		; ALLOCATE THE TEXT BUFFER
	MOVE	T3,[POINT 7,T$DATA] ; FORM BYTE POINTER TO BUFFER
	ADD	T3,TXREF	; . . .
	ADDM	T5,-T$DATA(T3)	; SAVE # CHARS TO BE PUT IN Q-REGISTER
$X01:	POP	P,SARG		; RESTORE AC SARG
	LDB	T1,[4200,,SARG]	; FETCH START CHAR.ADR [13000] 34 bits worth
	IDIVI	T1,5		; CONVERT TO A BYTE POINTER
	HLL	T1,CBPTBL-1(T2)	; . . .
	JUMPL	SARG,[TXO T1,<Z (R)> ;[12000] Make relative to cmd buffer
		      TLNN SARG,200000 ;[12000] inserting character?
			MOVE T1,[70700,,ARG] ;[12000] ASCII char in ARG
		      JRST $X1]	;[12000] Jump into loop
	ADD	T1,TXTBUF	; . . .
	ADDI	T1,T$DATA	; Add in overhead words

$X1:	SOJL	T5,$X2		; JUMPE WHEN FINISHED STORING
	ILDB	C,T1		; FETCH NEXT CHAR FROM MAIN TEXT BUFFER
	IDPB	C,T3		; AND STORE IN Q-REGISTER
	JRST	$X1		; AND TRY NEXT CHAR

; STORE COMPLETE. BIND THE TEXT BUFFER TO THE Q-REGISTER NAME

$X2:
	POP	P,T3		;[12000] Get it off the stack
	POP	P,T2		;[12000]
	POP	P,T1		;[12000]
	TXZE	F,F$COL		;[12000] If it was :X... (also clear ":" flag)
	 TRNN	T2,777777	;[12000] ...and it already had text...
	TXOA	T2,QB$BID	; FLAG Q-REGISTER AS A TEXT BUFFER
	 JRST	[MOVE T1,TXREF	;[12000] ...then the Q-register is already stored
		 SETZM TXREF	;[12000] Clear our reference
		 HRRZS T1,B$2PTR(T1) ;[12000] And the pointer to it
		 JRST (PC)]	;[12000] And go away
	HRRI	T2,TXREF	; FETCH ADR OF REFERENCE TO TEXT BUFFER
	TXO	F,F$REF		; FLAG THAT T3 HAS ADR OF REFERENCE
	PUSHJ	P,QSTOR		; BIND THE TEXT BUFFER TO THE Q-REGISTER NAME
	JRST	(PC)		; AND RETURN TO CALLER
	SUBTTL	$G

; $G - GET THE TEXT CONTAINED IN A Q-REGISTER AND INSERT IN BUFFER
;
; CALL:	JSP	PC,$$G
;	<Q.REGISTER.NAME>
;	(RETURN)

$G:	PUSHJ	P,NXTWRD	; FETCH THE Q-REGISTER NAME
	MOVE	T1,N		; AND COPY INTO AC T1
	PUSHJ	P,QGET		; GET THE Q-REGISTER
	 JRST	(PC)		; ** NO TEXT IN Q-REGISTER **
	TXNN	T2,QB$BID	; IS THERE TEXT IN THE Q-REGISTER?
	 JRST	(PC)		; ** NO TEXT IN Q-REGISTER **

	MOVEI	N,(T2)		; FETCH THE TEXT BUFFER ID FOR Q-REGISTER
	MOVEI	L,TMPRFG	; TMPRFG WILL REFERENCE THE TEXT BUFFER
	PUSHJ	P,FNDBLK	; FIND THE BLOCK WITH THE ID
	 ERROR	(BNF)		; SHOULDN'T OCCUR. ** CAN'T FIND Q-REGISTER **

	MOVE	T5,@TMPRFG	;[21000](36bits) FETCH THE # CHARS IN Q-REG

	MOVE	T1,T5		; T5:=# CHARS IN Q-REGISTER
	TXNN	F,F$COL		;[12000] don't mung buffer if :G, just type
	 PUSHJ	P,MKROOM	; AND MAKE ROOM FOR THEM

	MOVE	T3,[POINT 7,T$DATA] ; FORM BYTE POINTER TO Q-REGISTER IN T3
	ADD	T3,TMPRFG	; . . .

	TXZE	F,F$COL		;[12000] :G means type it
	 JRST	[COLGLP:	SOJL	T5,$G2	;[12000] no more chars
				ILDB	C,T3	;[12000] Get character
				TXNN	F,F$2CO	;[16000] ::G Type literally
				 JRST	[PUSHJ P,TCCHR ;[16000] Type normally
					 JRST COLGLP]	;[16000] back for more
				PUSHJ	P,TCHR	;[12000] Type it
				JRST	COLGLP]	;[12000] back for more

	MOVE	T1,PTVAL	; FETCH VALUE OF "."
	ADDI	T1,T$DATA*5	; SKIP OVER OVERHEAD WORDS
	IDIVI	T1,5		; CONVERT TO A BYTE POINTER
	HLL	T1,CBPTBL-1(T2)	; . . .
	ADD	T1,TXTBUF	; . . .
	ADDM	T5,PTVAL	; SET NEW VALUE OF "."

; INSERT THE TEXT FROM THE Q-REGISTER INTO THE MAIN TEXT BUFFER

$G1:	SOJL	T5,$G2		; JUMP IF DONE
	ILDB	C,T3		; FETCH NEXT CHAR FROM Q-REGISTER
	IDPB	C,T1		; AND INSERT INTO TEXT BUFFER
	JRST	$G1		; AND TRY FOR NEXT CHAR

; INSERTION COMPLETE. UNBIND THE Q-REG. TEXT BUFFER FROM TMPRFG

$G2:	MOVE	X,TMPRFG	; FETCH THE ADR OF Q-REG. TEXT BUFFER
	HRRZS	B$2PTR(X)	; AND UNBIND FROM TMPRFG
	TXZ	F,F$COL!F$2CO	;[16000] Don't leave : flags on
	JRST	(PC)		; RETURN TO CALLER
	SUBTTL	FAIRET and SUCRET

; FAIRET - RETURN ZERO IF COMMAND FAILED

FAIRET:	SETZ	VALUE,		; SET VALUE:=0
	JRST	(PC)		; AND RETURN TO CALLER

; SUCRET - RETURN -1 IF COMMAND SUCCEEDED

SUCRET:	SETO	VALUE,		; SET VALUE:=-1
	JRST	(PC)		; AND RETURN TO CALLER
	SUBTTL	$M

; $M - COMPILE AND EXECUTE THE TEXT OF A Q-REGISTER
;
; CALL:	JSP	PC,$$M
;	<Q-REG-NAME>
;	(RETURN)

$M:	PUSHJ	P,NXTWRD	; FETCH THE Q-REG-NAME
	MOVE	T1,N		; AND COPY INTO AC T1
M1:	MOVEM	SARG,SARGSV	;[3000] DO NOT LOSE 2ND ARGUMENT TO MACRO
	PUSHJ	P,QGET		; GET INFO ON THE Q-REGG
	 JRST	(PC)		;[16000] no
	TXNN	T2,QB$BID	; IS THERE TEXT IN Q-REGISTER?
	 JRST	(PC)		;[16000] no text
	MOVE	L,T1		; PUT Q-REG-NAME IN AC L
	MOVEI	N,(T2)		; PUT BUFFER ID IN AC N
	PUSHJ	P,MACRO		; NOW COMPILE&EXECUTE THE MACRO
	JRST	(PC)		;[14000] Leave the returned value alone
	SUBTTL	$EC and $ECS and $TTY

; $EC - RETURN THE NUMBER OF WORDS IN THE LOWSEGMENT (IE: .JBFF-1)
;
; CALL:	JSP	PC,$$EC
;	(RETURN)		; WITH SIZE IN AC 'VALUE'

$EC:	SKIPN	EOVAL		;[12000] Don't output all if EO=0
	 JRST	$EC1		;[12000] EO=0 so just garbage collect
	MOVSI	ARG,1		;[12000] Do infinity P commands
	TXNE	F,F$UWR		;[12000] As long as there is an output file
	 PUSHJ	P,PUNBUF	;[12000]
	TXZE	F,F$UBK		;[12000] Push everything along for EB
	 PUSHJ	P,BAKCLS	;[12000] INP to .BAK  OUT to INP
	RELEAS	OUT,		;[12000] Close up output file
	TXZ	F,F$UWR		;[12000] No more output file
	MOVEI	T1,NOOF		;[12000] Set up error if try to output
	MOVEM	T1,PCHADR	;[12000] to avoid blowing up
$EC1:	PUSHJ	P,GARCOL	; GARBAGE COLLECT FIRST
	MOVE	VALUE,.JBFF	; FETCH SIZE OF LOWSEG+1
	SOJA	VALUE,(PC)	; COMPUTE LOWSEG SIZE AND RETURN TO CALLER

; $ECS - SET THE LOWSEGMENT SIZE (.JBCOR AND .JBREL)
;
; CALL:	JSP	PC,$$ECS	; WITH # WORDS IN AC 'ARG'
;	(RETURN)

; COMPRESS THE TEXT BUFFER TO MAX(C$TBLN,(C$FILB/(C$FILB-1)*Z+4)/5)
; THEN GARBAGE COLLECT
; AND THEN SET OUR LOWSEG SIZE

$ECS:
FOR TOPS10, PUSHJ P,POSSYM	;[14000] Page out DDT & symbol table
	MOVE	T1,@TXTBUF	; FETCH Z
	IMULI	T1,C$FILB	; COMPUTE C$FILB*Z
	IDIVI	T1,C$FILB-1	; COMPUTE C$FILB/(C$FILB-1)*Z
	ADDI	T1,4		; COMPUTE C$FILB/(C$FILB-1)*Z+4
	IDIVI	T1,5		; COMPUTE (C$FILB/(C$FILB-1)*Z+4)/5
	CAIGE	T1,C$TBLN	; COMPUTE MAX OF ^ AND C$TBLN (ASSUME ^)
	 MOVEI	T1,C$TBLN	; C$TBLN IS THE MAX

	MOVE	X,TXTBUF	; FETCH ADR OF TEXT BUFFER
	HLRZ	N,B$1PTR(X)	; FETCH ADR OF END+1 OF TEXT BUFFER
	SUBI	N,T$DATA(X)	; COMPUTE # WORDS IN TEXT BUFFER
	SUBI	N,(T1)		; COMPUTE # WORDS TO COMPRESS OUT
	MOVEI	L,TXTBUF	; FETCH ADR OF TEXT BUFFER REF
	PUSHJ	P,COMPRS	; AND COMPRESS THE TEXT BUFFER TO MIN SIZE

	TXNE	F,F$GCN		;[14000] Only if it would do something useful
	 PUSHJ	P,GARCOL	; PERFORM A GARBAGE COLLECTION

; SET OUR CORE SIZE

	MOVEI	X,(ARG)		; FETCH REQUESTED CORE SIZE
	CAMGE	X,.JBFF		; NOT TOO SMALL?
	 MOVE	X,.JBFF		;[16000] As small as we can, then
	CORE	X,		; ASK THE SYSTEM FOR THE CORE
	 JRST	$ECS2		; FAILED. GET AS MUCH AS WE CAN
; STORE INFO ABOUT OUR SIZE IN JOBDAT

$ECS1:	MOVE	X,.JBREL	; FETCH OUR NEW SIZE
	HRLI	X,(X)		; FORM <SIZE,,SIZE>
	MOVEM	X,.JBCOR	; AND STORE IN .JBCOR
	HRLM	X,.JBSA		; SET OUR SIZE IN CASE OF A RESET
	JRST	(PC)		; AND RETURN TO CALLER

; CORE MUUO FAILED. GET AS MUCH CORE AS WE CAN

$ECS2:	LSH	X,^D10		; CONVERT # K TO WORDS
	SOJ	X,		; CONVERT TO A "HIGHEST ADDR"
	HRRZ	T1,.JBHRL	; FETCH SIZE OF HIGH SEGMENT
	IORI	T1,1777		; AND CONVERT TO "HIGHEST ADDR"
	SUBI	X,(T1)		; COMPUTE MAX LOWSEG SIZE
	CORE	X,		; AND ASK THE SYSTEM FOR IT
	 HALT	.+1		;[20000] Should never fail
	JRST	$ECS1		; GOT IT. STORE INFO AND RETURN

; $TTY - RETURN TTY#+^O200000 FOR JOB N
;
; CALL:	JSP	PC,$$TTY
;	(RETURN)		; WITH TTY#+^O200000 IN AC VALUE

$TTY:	MOVE	VALUE,ARG	;[306] FETCH THE ARG
	TRMNO.	VALUE,		;[306] ASK MONITOR FOR TTY#+^O200000
	 SETZ	VALUE,		;[306] FAILED - RETURN ZERO
	JRST	(PC)		;[306] AND RETURN TO CALLER

; $ETS - Change ET flags and do appropriate other things
;
; CALL:	JSP	PC,$ETS
;	(RETURN)

$ETS:	TXZN	F,F$2RG		;[12000] 2 argument form?
	 JRST	$ETS1		;[12000] NO
	IOR	ARG,ETVAL	;[12000] ARG is bits to set
	ANDCM	ARG,SARG	;[12000] SARG is bits to clear

$ETS1:	MOVMS	T1,ARG		;[12000] Make -1 into 1 for compatability
	XOR	T1,ETVAL	;[12000] See which ones changed
	TXNE	ARG,ET$CCT	;[20000] Did he want ^C trapping?
	 JRST	[SETZM INTBLK+2	;[20000] Make sure it can happen
		 SETZM INTBLK+3	;[20000] ....
		 MOVEI X,INTRPT ;[20000] Address of handler
		 MOVEM X,INTBLK ;[20000] into block
		 MOVEI X,ER.ICC ;[20000] Set bit in block for ^C trap
		 MOVEM X,INTBLK+1 ;[20000]...
		 MOVEI X,INTBLK ;[20000] Address of block
		 MOVEM X,.JBINT ;[20000] into .JBINT so monitor will use it
		 JRST .+1]	;[20000] Continue
	TXZE	T1,ET$DET	;[12000] Detached flag changed?
	 JRST	[HRLZ T2,OURTTY ;[12000] Assume detaching
		 TXNN ARG,ET$DET ;[12000] Is he detaching, or attaching?
		  HRRI T2,777777 ;[12000] Attaching (detached flag turned off)
		 ATTACH T2,	;[12000] do it, whatever it was
		  TXC ARG,ET$DET ;[12000] Failed, flip the flag
		 PUSHJ P,TTOPEN	;[12000] Re-open the terminal
		 TXNN ARG,ET$DET ;[12000] If attached reset terminal stuff
		  TXO T1,<ET$SUP!ET$LC>	;[12000] Force setting status
		 JRST .+1]	;[12000] continue
	TXZE	T1,ET$SUP	;[12000] Turn echoing on or off?
	 JRST	[TXNN ARG,ET$SUP ;[12000] on or off?
		  JRST [ECHO ON	;[21000] on (bit was off)
			JRST .+1] ;[21000] ...
		 ECHO	OFF	;[21000] Off (bit was on)
		 JRST .+1]	;[12000] ...
	TXZE	T1,ET$LC	;[12000] Turn LC input on or off?
FOR TOPS10!TOPS20,<
	 JRST	[MOVE T2,OURTTY ;[12000] Twiddle line characteristics
		 GETLCH T2	 ;[12000] Get them first
		 TXNN ARG,ET$LC	;[12000] Check our LC bit
		  TXZA T2,GL.LCM ;[12000] it's off, so clear this one
		 TXO T2,GL.LCM	;[12000] set it
		 SETLCH T2	;[12000] in the monitor
		 JRST .+1]	;[12000]
>
	TXZE	ARG,ET$CCO	;[12000] Did he set Cancel-control-O
FOR TOPS10,<
	 SKPINC			;[12000] Yes, so cancel it
	 JFCL			;[12000] don't care if it skips
>
FOR TOPS20,<
	 PUSHJ	P,CLRCCO	;[21000] 
>
	MOVEM	ARG,ETVAL	;[12000] Save the bits that are left
	JRST	(PC)		;[12000] Continue execution
	SUBTTL	$GTB and $PEK - GETTAB and PEEK

; $GTB - PERFORM A GETTAB MUUO FOR USER
;
; CALL:	JSP	PC,$$GTB
;	(RETURN)		; WITH GETTAB RESULT IN AC 'VALUE'

$GTB:	HRLI	ARG,(SARG)	; FORM GETTAB MUUO ARGUMENT
	GETTAB	ARG,		; ASK MONITOR FOR INFORMATION
	 TDZA	VALUE,VALUE	; FAILED, RETURN ZERO
	MOVE	VALUE,ARG	; PUT RESULT IN AC 'VALUE'
	JRST	(PC)		; AND RETURN TO CALLER

; $PEK - PERFORM A PEEK MUUO FOR USER
;
; CALL:	JSP	PC,$$PEK
;	(RETURN)		; WITH RESULT IN AC 'VALUE'

$PEK:	PEEK	ARG,		; ASK MONITOR FOR THE INFORMATION
	MOVE	VALUE,ARG	; PUT RESULT IN AC 'VALUE'
	JRST	(PC)		; AND RETURN TO CALLER
	SUBTTL	$ER and $EW and $EF and $RUNP
; $ER - SETUP A FILE FOR INPUT
;
; CALL:	JSP	PC,$$ER
;	<FILE.SPEC>
;	(RETURN)

$ER:	MOVE	X,FS$FLG(PC)	; FETCH FILE-SPEC FLAGS
	TXZE	X,FB$EXE	; /EXECUTE?
	 JRST	$EI		; YES DO AN "EI"
	MOVEI	L,LERSPC	; FETCH ADR OF "ER" FILE-SPEC
	TXNE	F,F$2CO		;[16000] ::ER just sets defaults
	 PJRST	SFSDEF		;[16000] so go do that instead
	PUSHJ	P,SETFSP	; FILL IN THE DEFAULTS
	PUSHJ	P,OPENRD	; AND OPEN THE FILE FOR READING
	PUSHJ	P,SETRAD	; SET THE ADR OF THE READ-A-CHAR ROUTINE
	JRST	SUCRET		; AND RETURN TO CALLER

; $EW - SETUP A FILE FOR OUTPUT
;
; CALL:	JSP	PC,$$EW
;	<FILE.SPEC>
;	(RETURN)

$EW:	MOVE	X,FS$FLG(PC)	; FETCH FILE-SPEC FLAGS
	TXNE	X,FB$EXE	; /EXECUTE?
	 JRST	$EI		; YES, DO AN "EI" INSTEAD OF "EW"
	TXNE	X,FB$APP	;[14000] EW/APPEND does indeed append
	 PJRST	$APP		;[14000] so append instead
	MOVEI	L,LEWSPC	; FETCH ADR OF "EW" FILE-SPEC
	TXNE	X,FB$DEL	;[20000] /SUPERSEDE?
	 TXO	L,1B1		;[20000] Yes. remember that
	TXZE	F,F$2CO		;[16000] ::EW just sets defaults
	 PJRST	SFSDEF		;[16000] so go do that instead
	TXNE	F,F$UBK		; "EB" IN PROGRESS?
	 CERROR	(EBO)		; YES, ** EW WHEN EB IN PROGRESS **
	TXNE	F,F$UWR		;[14000] Check for open output file
	 CERROR	(OFO)		;[14000] Output file open error
	PUSHJ	P,SETFSP	; FILL IN THE DAFAULTS
	PUSHJ	P,OPENWR	; AND OPEN THE FILE FOR WRITING
	PUSHJ	P,SETWAD	; SET THE ADR OF THE WRITE-A-CHAR ROUTINE
	JRST	SUCRET		; AND RETURN TO CALLER

; $EF - CLOSE OUTPUT FILE
;
; CALL:	JSP	PC,$$EF
;	(RETURN)

$EF:	TXZE	F,F$UBK		; "EB" IN PROGRESS?
	 PUSHJ	P,BAKCLS	; YES, FINISH IT
	RELEAS	OUT,		; RELEASE THE OUTPUT CHANNEL
	TXZ	F,F$UWR		; NO LONGER WRITING TO A FILE
	MOVEI	X,NOOF		;[304] FETCH ADR FOR NO OUTPUT FILE
	MOVEM	X,PCHADR	;[304] TO PREVENT ILL. UUOS
	JRST	(PC)		; RETURN TO CALLER


; $EK - Cancel EB and flush output file
;
; CALL: JSP	PC,$$EK
;	(RETURN)

$EK:	MOVEI	T1,OUT		;[12000] Prepare to do RESDV.
	TXZN	F,F$UBK		;[12000] Clear EB, skip RESDV. if was set.
	 RESDV.	T1,		;[12000] Output file is no more
	RELEAS	OUT,		;[12000] Save .TMP file if from EB
	TXZ	F,F$UWR		;[12000] Not writing output file
	MOVEI	X,NOOF		;[12000] Cause error if we try
	MOVEM	X,PCHADR	;[12000] to write to it.
	JRST	(PC)		;[12000] done

; NOOF - COME HERE WHEN WE WANT TO PUNCH A CHAR BUT NO OUTPUT FILE

NOOF:	ERROR	(NFO)		;[304] ** NO OUTPUT FILE **

; $RUNP - SETUP FILE TO BE RUN ON EXIT
;
; CALL:	JSP	PC,$$RUNP
;	<FILE.SPEC>
;	(RETURN)

$RUNP:	MOVEM	ARG,RUNOFS	; STORE /RUNOFFSET:N
	MOVEI	L,LRPSPC	; FETCH ADR OF LAST "E&" FILE-SPEC
	PUSHJ	P,SETFSP	; AND FILL IN THE DEFAULTS
;[14000]TXO	F,F$EDC		; no more FLAG THAT WE MUST RUN A PROG. ON EXIT
	JRST	SUCRET		; AND RETURN TO CALLER
	SUBTTL	$EB

; $EB - SETUP A FILE FOR EDITING WITH BACKUP PROTECTION
;
; CALL:	JSP	PC,$$EB
;	<FILE.SPEC>
;	(RETURN)

$EB:				;[1000] EBO CHECK MOVED DOWN TO MAKE SURE
				;[1000] WE EAT ALL ARGUMENTS (ELSE WE BLOW UP)
	MOVE	X,FS$FLG(PC)	; FETCH FILE-SPEC FLAGS
	TXNE	X,FB$EXE	; /EXECUTE?
	 JRST	$EI		; YES, DO AN "EI" INSTEAD OF "EB"

; SETUP THE EB FILESPEC

	MOVEI	L,LEBSPC	; FETCH ADR OF THE EB FILESPEC
	TXZE	F,F$2CO		;[16000] ::EB just sets defaults
	 PJRST	SFSDEF		;[16000] so do that, don't open anything
	PUSHJ	P,SETFSP	; AND FILL IT IN
	TXNE	F,F$UBK		; "EB" ALREADY IN PROGRESS?
	 CERROR	(EBO)		; YES, ERROR

FOR TOPS10,<
; MAKE SURE DEVICE IS A DSK OR DECTAPE (OR OTHER DIRECTORY DEVICE)

	MOVE	X,FS$DEV(L)	; FETCH THE DEVICE NAME
	DEVCHR	X,		; AND FIND ITS CHARACTERISTICS
	TXNN	X,DV.DIR	; IS IT A DIRECTORY DEVICE?
	 CERROR	(EBD)		; NO, ** EB FOR DEVICE IS ILLEGAL **

; MAKE SURE FILNAME IS NOT ###XTC.TMP OR EXTENSION .BAK

	MOVE	T5,FS$NAM(L)	; FETCH THE FILE NAME
	HLRZ	T1,FS$EXT(L)	; FETCH THE FILE EXTENSION
	CAMN	T5,CCJNAM	; IS FILE NAME '###XTC'?
	 CAIE	T1,'TMP'	; AND EXTENSION .TMP?
	  CAIN	T1,'BAK'	; OR EXTENSION .BAK?
	 CERROR	(EBF)		; YES, ** ILLEGAL EB FILENAME **

; SELECT THE FILE FOR READING

	PUSHJ	P,OPENRD	; SELECT FILE FOR INPUT

; IF PPN IS NOT OURS, JUST DO ER-EW SEQUENCE

	PUSHJ	P,GETPTH	;[342] FETCH MY PATH
	MOVE	T1,RBSPC+.RBPPN	; GET PPN OR ADDRESS THEREOF
	JUMPE	T1,$EB1		; DEFAULT PPN IS ALWAYS MINE
	TXNN	T1,LH.ALF	; A PPN?
	 MOVE	T1,2(T1)	; NO AN ADDRESS--GET THE PPN
	MOVE	T2,LEBSPC+FS$FLG	;[23000] /INPLACE always does real EB
	TXNE	T2,FB$DEL	;[23000] ...
	 JRST	$EB1		;[23000]
	CAME	X,T1		; SAME AS THAT OF FILE?
	 JRST	$EB2		; NO, JUST DO ER-EW SEQUENCE

; SETUP THE FILESPEC FOR THE TEMP FILE

$EB1:
	MOVE	T1,[<LEBSPC,,FILSPC>] ; COPY INPUT SPEC FOR TEMP FILE
	MOVEI	T2,FILSPC+FS$PTH-1 ;[23000] Limit of BLT
FOR TOPS10,<
	MOVEI	X,INP		;[23000] Get the path for the file
	MOVEM	X,FILSPC+FS$PTH ;[23000] Set up for uuo
	MOVE	X,[.PTMAX,,FILSPC+FS$PTH] ;[23000] ...
	PATH.	X,		;[23000]
	 MOVEI	T2,FILSPC+FS$LTH-1 ;[23000] lose.......
>;end TOPS10
	BLT	T1,(T2)		;[24000] copy rest

; PUT TEMP FILE ON SAME FILE-STRUCTURE AS INPUT FILE

	MOVE	X,RBSPC+.RBDEV	; FETCH THE FS OF INPUT FILE
	ANDCMI	X,'__'		; MASK TO FIRST 4 CHARS
	MOVEM	X,FILSPC+FS$DEV	; AND USE AS DEVICE FOR TEMP FILE

; FILENAME FOR TEMP FILE IS ###XTC

	MOVE	X,CCJNAM	; FETCH CCL JOB NAME
	MOVEM	X,FILSPC+FS$NAM ; SET FILENAME FOR TEMP FILE TO ###XTC

; FILE EXTENSION FOR TEMP FILE IS 'TMP'

	MOVSI	X,'TMP'		; FETCH THE TEMP FILE EXTENSION
	MOVEM	X,FILSPC+FS$EXT	; AND STORE IT

; USE FILE PROTECTION OF INPUT FILE FOR OUTPUT FILE
; UNLESS PROTECTION WAS SPECIFIED IN FILESPEC

	LDB	X,[POINT 9,RBSPC+.RBPRV,8] ; FETCH PROT. OF INPUT FILE
	MOVE	T1,LEBSPC+FS$FLG ; FETCH FILE SPEC FLAGS
	TXNN	T1,FB$PRV	; /PROTECT:NNN SPECIFIED?
	 DPB	X,[POINT 9,LEBSPC+FS$PRV,8] ; NO, SAVE PROT OF INPUT FILE

; MAKE SURE WE CAN RENAME INPUT FILE

	CAIL	X,<300>		; CAN WE RENAME THE FILES?
	 CERROR	(EBP)		; NO, ** EB PROTECTED FILES **

	DPB	X,[POINT 9,LEBSPC+FS$PRV,8] ; SAVE PROTECTION FOR LATER
	MOVEI	X,C$TPRV	; FETCH THE PROT. FOR TEMP FILE
	DPB	X,[POINT 9,FILSPC+FS$PRV,8] ; SET PROT. FOR TEMP FILE

;  OPEN THE TEMP FILE

	MOVSI	N,(<Z OUT,>)	; FETCH THE OUTPUT CHANNEL
	MOVSI	M,OUTBH		; FETCH ADR OF OUTPUT BUFFER HEADER
	MOVEI	L,FILSPC	; FETCH ADR OF FILE SPEC
	PUSHJ	P,FILOPN	; OPEN THE TEMP FILE
	 CERROR	(ODV)		; ** OUTPUT OPEN FAILURE **

; SET THE ESTIMATED SIZE OF THE TEMP FILE TO THE SIZE OF INPUT FILE

	MOVE	M,RBSPC+.RBSIZ	; FETCH SIZE OF INPUT FILE
	LSH	M,-7		; CONVERT TO BLOCKSIZE
	AOJ	M,		; AND ROUND UP

; ENTER THE TEMP FILE

	PUSHJ	P,FILENT	; ENTER THE TEMP FILE
	 CERROR	(ENT)		; ** ENTER FAILURE **

IFN 0,<; DON'T USE THIS UNLESS DATE75 KLUDGE INSERTED!!!
; SAVE CREATION DATE

	LDB	X,[POINT  23,RBSPC+.RBPRV,35] ; FETCH CREATION INFO
	DPB	X,[POINT 27,LEBSPC+FS$PRV,35] ; AND SAVE FOR LATER>

; DONE WITH "EB" SETUP

	TXO	F,F$UBK!F$UWR!F$URD ; FLAG THAT "EB" IN PROGRESS
				; AND THAT WE ARE READING AND WRITING
	PUSHJ	P,SETRAD	; SET ADR OF READ-A-CHAR ROUTINE
	PUSHJ	P,SETWAD	; SET ADR OF WRITE-A-CHAR  ROUTINE
	JRST	SUCRET		; AND RETURN TO CALLER

; FILE NOT IN OUR UFD. JUST DO ER-EW SEQUENCE
>;END TOPS10 ONLY

$EB2:	MOVE	X,[<LEBSPC,,LERSPC>] ; COPY EB SPEC TO ER SPEC
	BLT	X,LERSPC+FS$LTH-1 ; . . .

	MOVE	X,[<LEBSPC,,LEWSPC>] ; COPY EB SPEC TO EW SPEC
	BLT	X,LEWSPC+FS$LTH-1 ; . . .
	MOVSI	X,'DSK'		;[355] BACK TO DSK:
	MOVEM	X,LEWSPC+FS$DEV	;[355] . . .
	PUSHJ	P,GETPTH	;[355] GET MY PATH
	MOVEM	X,LEWSPC+FS$PPN	;[355] POINT TO ME, NOT TO HIM(HER?)

; SELECT THE INPUT FILE FOR READING

	MOVEI	L,LERSPC	; FETCH ADR OF ER FILESPEC
	PUSHJ	P,OPENRD	; AND SELECT IT FOR READING
	PUSHJ	P,SETRAD	; SET THE ADR OF THE READ-A-CHAR ROUTINE

; SELECT THE OUTPUT FILE FOR WRITING

	MOVEI	L,LEWSPC	;[355] SELECT ADR OF EW FILESPEC
	PUSHJ	P,OPENWR	; SELECT  OUTPUT FILE FOR READING
	PUSHJ	P,SETWAD	; AND SET ADR OF PUNCH-A-CHAR ROUTINE

; DONE. RETURN TO CALLER

	JRST	SUCRET		; GIVE SUCCESS RETURN TO CALLER
	SUBTTL	$APP - Append to file

; $APP - SETUP FOR APPENDING TO A FILE (OUTPUT)
;
; CALL:	JSP	PC,$$APP
;	<FILE.SPEC>
;	(RETURN)

$EA:
$APP:
	TXNE	F,F$UBK		; "EB" IN PROGRESS?
	 CERROR	(EBO)		; YES, ** EA WHEN EB IN PROGRESS **
	TXNE	F,F$UWR		;[14000] "EW" or "EA" in progress?
	 CERROR (OFO)		;[14000] Yes, "OUTPUT FILE OPEN"

	MOVEI	L,LEWSPC	; FETCH ADR OF LAST "EW" FILE SPEC
	PUSHJ	P,SETFSP	; AND FILL IN PARTS
	TXZ	F,F$UWR		; FLAG THAT NO FILE FOR OUTPUT

	MOVSI	N,(<Z OUT,>)	; SETUP OUTPUT CHANNEL
	MOVSI	M,OUTBH		; SETUP ADR OF OUTPUT BUFFER HEADER
	PUSHJ	P,FILOPN	; OPEN THE OUTPUT DEVICE
	 CERROR	(ODV)		; ** OPEN FAILURE FOR OUTPUT DEVICE **
	SETZ	T5,		; CLEAR "NO USETI NEEDED" FLAG
	PUSHJ	P,FILLKP	; LOOKUP THE OUTPUT FILE
	 SETO	T5,		;  FLAG THAT USETI NOT NEEDED
	PUSHJ	P,FILENT	; ENTER THE OUTPUT FILE
	 CERROR	(ENT)		; ** ENTER FAILURE **
	JUMPN	T5,.+2		; IF LOOKUP FAILED, NO USETI NEEDED
	 USETI	OUT,-1		; POSITION TO END OF FILE FOR APPENDING

	TXO	F,F$UWR		; FLAG THAT A FILE IS NOW READY FOR OUTPUT
	PUSHJ	P,SETWAD	; SET THE ADR OF PUNCH-A-CHAR ROUTINE
	JRST	SUCRET		; AND GIVE SUCCESS RETURN TO CALLER
	SUBTTL	$EI

; $EI - EXECUTE AN INDIRECT FILE AS A COMMAND STRING
;
; CALL:	JSP	PC,$$EI
;	<FILE.SPEC>
;	(RETURN)

$EI:	MOVEI	L,LEISPC	; FETCH ADR OF "EI" FILE-SPEC
	TXZE	F,F$2CO		;[16000] ::EI just sets defaults
	 PJRST	SFSDF0		;[16000] so go do that instead
	PUSHJ	P,SETFSP	; AND FILL IN DEFAULTS
	SETZ	N,		;[371] USE CHANNEL 0
	MOVEI	M,INIBH		;[371] FETCH ADDR OF BUFFER HEADER
	PUSHJ	P,FILOPN	;[371] OPEN THE DEVICE
	 CERROR	(IDV)		;[371] ** INPUT DEVICE OPEN FAILURE **
	PUSHJ	P,FILLKP	;[371] FIND THE FILE
	 PUSHJ	P,$EI1		;[371] COULDN'T, TRY IT ON TED:
	PUSHJ	P,FILERD	; AND READ THE FILE INTO A BUFFER
	PUSH	P,N		; SAVE THE BUFFER ID
	MOVE	L,['[EICM]']	; GIVE THE COMMAND A NAME
	TXO	F,F$CMP		; FORCE COMPILATION
	PUSHJ	P,MACRO		; AND COMPILE&EXECUTE THE MACRO
	POP	P,N		; RESTORE THE BUFFER ID
	PUSHJ	P,DELBLK	; AND DELETE THE BUFFER
	JRST	SUCRET		; AND GIVE SUCCESS RETURN TO CALLER
$EI1:	SETZM	LEWSPC+FS$PPN	;[371] IGNORE PPN NOW
	MOVSI	X,'TED'		;[371] TRY THE TECO MACRO LIBRARY
	MOVEM	X,LEISPC+FS$DEV	;[371] SET IT FOR TRY
	POPJ	P,		;[371] RETURN TO TRY IT
	SUBTTL	$EL AND $ELA

; $EL - MAKE A LOG FILE
;
; CALL:	JSP	PC,$$EL
;	<FILE.SPEC>
;	(RETURN)

$EL:	MOVEI	L,LELSPC	;[330] FETCH ADR OF "EL" FILE-SPEC
	TXZE	F,F$2CO		;[16000] ::EL just sets defaults
	 PJRST	SFSDF0		;[16000] so go do that instead
	PUSHJ	P,SETFSP	;[330] AND FILL IN DEFAULTS
	MOVSI	N,(<Z LOG,0>)	;[330] FETCH THE LOG CHANNEL
	MOVSI	M,LOGBH		;[330] SETUP ADR OF LOG BUFFER HEADER
	PUSHJ	P,FILOPN	;[330] OPEN THE LOG DEVICE
	 CERROR	(LDV)		;[330] ** OPEN FAILURE **
	MOVE	X,FS$FLG(L)	;[330] LOAD FLAGS
	SETZ	T5,		;[356] SAY USETI IS COOL
	TXNE	X,FB$APP	;[330] APPEND?
	PUSHJ	P,FILLKP	;[330] YES, ENTER UPDATE MODE
	 SETO	T5,		;[330] EITHER NO APPEND OR NO FILE
	SETZ	M,		;[330] DON'T ESTIMATE ANY SIZE
	PUSHJ	P,FILENT	;[330] ENTER FILE
	 CERROR	(LFE)		;[330] ** ENTER FAILURE **
	MOVE	X,FS$FLG(L)	;[330] GET LOG FLAGS
	TXNN	X,FB$NOO!FB$NOI	;[330] SEE IF ANY ON
	TXO	X,FB$NOO!FB$NOI	;[330] NO, TURN ALL ON
	CAIE	T5,		;[356] IS USETI COOL?
	 TXZ	X,FB$APP	;[356] NO, THE NARCS GOT AHOLD OF IT
	TXZE	X,FB$APP	;[330] APPEND?
	USETI	LOG,-1		;[330] YES, APPEND TO PREVIOUS FILE
	MOVEM	X,FS$FLG(L)	;[330] SAVE LOG FLAGS
	TXO	F,F$LOG		;[330] INDICATE LOG FILE TO WRITE TO
	JRST	SUCRET		;[330] SUCESSFUL RETURN

; $ELA - ALTER LOG FILE PARAMETERS
;
; CALL:	JSP	PC,$$ELA
;	<FILE.SPEC>
;	(RETURN)

$ELA:	CAIL	ARG,		;[330] CHECK ARG FOR VALIDITY(0.LE.ARG.LEL3)
	CAILE	ARG,3		;[330] . . .
	 CERROR	(ILS)		;[330] ** ILLEGAL EL SPECIFICATION **
	TXNN	F,F$LOG		;[330] SEE IF LOG FILE OPEN
	 CERROR	(NLF)		;[330] ** NO LOG FILE OPEN **
	MOVE	X,LELSPC+FS$FLG	;[330] LOAD LOG FILE SPECS
	TXZ	X,FB$NOO!FB$NOI	;[330] ZERO FLAGS
	TXNE	ARG,1		;[330] SEE IF ODD
	TXO	X,FB$NOI	;[330] YES, /NOIN AT LEAST
	TXNE	ARG,2		;[330] SEE IF /NOOUT
	TXO	X,FB$NOO	;[330] YES
	MOVEM	X,LELSPC+FS$FLG	;[330] SAVE FLAG SPECS
	JRST	SUCRET		;[330] GIVE SUCCESS RETURN
	SUBTTL	$RENM

; $RENM - RENAME CURRENT INPUT FILE
;
; CALL:	JSP	PC,$$RENM
;	<FILE.SPEC>
;	(RETURN)

$RENM:	MOVEI	L,LERSPC	; FETCH ADR OF FILE-SPEC
	MOVE	X,FS$FLG(PC)	;[15000] Get flags from real filespec
	TXNE	X,FB$DEL	;[15000] Delete?
	 TLO	L,400000	;[15000] Yes, remember it

	PUSHJ	P,SETFSP	; AND FILL IN PARTS
	TXNE	F,F$UBK		; "EB" IN PROGRESS?
	 CERROR	(EBO)		; YES, ** EB IN PROGRESS **
	TXNN	F,F$URD		; "ER" IN PROGRESS?
	 CERROR	(ENO)		; NO, ** NO DEVICE OPEN FOR INPUT **
	JUMPL	L,[SETZ T1,	;[15000] Try to delete it
		   RENAME INP,T1;[15000] by renaming it to 0
		    JRST ECARDE	;[15000] failed
		   JRST ECAR0]	;[15000] it worked
	MOVE	N,[Z INP,]	; FETCH THE INPUT CHANNEL
	PUSHJ	P,FILRNM	; AND PERFORM THE RENAME
	 JRST	ECARRE		; RENAME FAILED
ECAR0:	RELEAS	INP,		; CLOSE THE FILE
	TXZ	F,F$URD		; AND CLEAR THE "ER" FLAG
	JRST	SUCRET		; AND GIVE SUCCESS RETURN TO CALLER

ECARDE:	MOVEM	T2,LREERR	;[16000] Remember last error
ECARRE:	RELEAS	INP,		; RELEAS THE INPUT CHANNEL
	TXZ	F,F$URD		; NO LONGER READING A FILE
	TXNE	F,F$COL		; IS THIS A ":" COMMAND?
	 JRST	FAIRET		; YES, RETURN TO CALLER
	CERROR	(RNF)		; NO, ** RENAME FAILURE **
	SUBTTL	$EP, $EQ & E%

; $EQ - READ A FILE INTO Q-REGISTER
;
; CALL:	JSP	PC,$$EQ
;	<Q-REG>
;	<FILE.SPEC>
;	(RETURN)

$EQ:	PUSHJ	P,NXTWRD	;[12000] Get Q-register name first
	MOVEM	N,ACSAVE+N	;[15000] Stash in M
	MOVEI	L,LERSPC	; FETCH ADR OF LAST "ER" FILE SPEC
	MOVE	X,FS$FLG(PC)	;[15000] Check flag for /DELETE
	TXNE	X,FB$DEL	;[15000] Which is NEVER set by SETFSP
	 TLO	L,400000	;[15000] Set bit in L to do it
	PUSHJ	P,SETFSP	; AND FILL IN PARTS
	PUSHJ	P,FILERD	; READ THE FILE INTO A BUFFER
	MOVE	T1,ACSAVE+N	;[14000] Get back Q-register name
	PUSHJ	P,QGET		;[12000] Get current contents
	 SETZB	T2,T3		;[12000] None yet
	TXO	T2,QB$BID	; SET THE "TEXT" BIT
	HRR	T2,N		; FETCH THE BUFFER ID
	TXZ	F,F$REF		; FLAG THAT T3 HAS A BUFFER ID
	PUSHJ	P,QSTOR		; AND STORE BUFFER IN Q-REGISTER
	JRST	SUCRET		; AND GIVE SUCCESS RETURN TO CALLER

; $EPCT - WRITE A FILE FROM Q-REGISTER
;
; CALL:	JSP	PC,$$EPCT
;	<Q-REG>
;	<FILE.SPEC>
;	(RETURN)

$EPCT:	PUSHJ	P,NXTWRD	;[12000] Get Q-register name first
	MOVE	T1,N		;[14000] argument to QGET
	PUSHJ	P,QGET		;[14000] Find the Q-register
	 CERROR	(NTQ)		;[14000] lose
	TXNN	T2,QB$BID	;[14000] Look for text
	 CERROR	(NTQ)		;[14000] lose
	MOVEI	N,(T2)		;[14000] BID argument to FILEWR
	MOVEI	L,LEWSPC	; FETCH ADR OF LAST "EW" FILE SPEC
	MOVE	X,FS$FLG(PC)	;[15000] Check flag for /SUPERSEDE
	TXNE	X,FB$DEL	;[24000] Which may be on in default!!
	 TLO	L,200000	;[15000] Set bit in L to do it
	PUSHJ	P,SETFSP	; AND FILL IN PARTS
	PUSHJ	P,FILEWR	; WRITE THE FILE FROM THE BUFFER
	JRST	SUCRET		; AND GIVE SUCCESS RETURN TO CALLER
	SUBTTL	$EM and $EZ
; $EM - PERFORM MAGTAPE OPERATIONS
;
; CALL:	JSP	PC,$$EM
;	(RETURN)

$EM:	TXNE	F,F$UBK		; "EB" IN PROGRESS?
	 CERROR	(EBO)		; YES, ** EB IN PROGRESS **
	TXNN	F,F$URD		; "ER" IN PROGRESS?
	 CERROR	(EMD)		; NO, ** NO DEVICE SELECTED FOR EM **
	CAIGE	ARG,1		; IS OPCODE LEGAL?
	 CERROR	(EMA)		; NO, ** ILLEGAL MAGTAPE OP **
	MTAPE	INP,(ARG)	; YES, PERFORM THE MAGTAPE OPERATION
	MOVEI	L,LERSPC	; FETCH THE ADR OF LAST "ER" FILSPC
	MOVE	N,[Z INP,]	; FETCH THE I/O CHANNEL
	MOVEI	M,INPBH		; FETCH THE ADR OF THE INPUT BUFFER HEADER
	PUSHJ	P,FILOPN	; AND OPEN THE INPUT DEVICE AGAIN
	 CERROR	(IEM)		; CAN'T, ** OPEN FAILURE FOR INPUT DEVICE **
	JRST	SUCRET		; DONE. RETURN TO CALLER

; $EZ - CLEAR DECTAPE DIRECTORY AND DO AN "EW" FOR FILE
;
; CALL:	JSP	PC,$$EZ
;	<FILE.SPEC>
;	(RETURN)

$EZ:	TXNE	F,F$UBK		; "EB" IN PROGRESS?
	 CERROR	(EBO)		; YES, ** EB IN PROGRESS **
	TXNE	F,F$UWR		;[14000] Check for output file open already
	 CERROR	(OFO)		;[14000] Yes error "OUTPUT FILE OPEN"
	MOVEI	L,LEWSPC	; FETCH ADR OF LAST "EW" FILE-SPEC
	PUSHJ	P,SETFSP	; AND FILL IN PARTS
	MOVE	N,[Z OUT,]	; FETCH OUTPUT CHANNEL
	MOVSI	M,OUTBH		; FETCH ADR OF OUTPUT BUFFER HEADER
	PUSHJ	P,FILOPN	; AND OPEN THE OUTPUT DEVICE
	 CERROR	(ODV)		; CAN'T, ** OPEN FAILURE FOR OUTPUT DEVICE **
	UTPCLR	OUT,		; CLEAR THE DECTAPE DIRECTORY
	MTREW.	OUT,		; REWIND THE DECTAPE or MAGTAPE
	PUSHJ	P,OPENWR	; RE-OPEN AND ENTER THE FILE
	JRST	SUCRET		; AND GIVE SUCCESS RETURN TO CALLER

; SFSDEF - Set filespec defaults, but don't open any file
SFSDEF:	SETZM	FS$EXT(L)	;[16000] Clear extension also

SFSDF0:	SETZM	FS$FLG(L)	;[16000] Clear out flags
	SETZM	FS$NAM(L)	;[16000] and name (leave device alone)
	SETZM	FS$PRV(L)	;[16000] and protection word...
	HRLI	X,FS$PRV(L)	;[16000] Set up BLT pointer
	HRRI	X,FS$PRV+1(L)	;[16000] to zero rest of block
	BLT	X,FS$LTH-1(L)	;[16000] and zero it
	PUSHJ	P,SETFSP	;[16000] and fill in from code
	JRST	SUCRET		;[16000] Return win
	SUBTTL	$EE

; $EE - WRITE OUT LOWSEG AS A ZERO-COMPRESSED SAVE FILE (RUNNABLE)
;
; CALL:	JSP	PC,$$EE
;	<FILE-SPEC>
;	(RETURN)

$EE:	MOVEI	L,LEESPC	; FETCH ADR OF FILE-SPEC
	TXZE	F,F$2CO		;[16000] ::EE just sets defaults
	 PJRST	SFSDF0		;[16000] so go do that instead
	PUSHJ	P,SETFSP	; AND FILL IN DEFAULTS
	PUSH	P,.JBSA		; SAVE .JBSA
	PUSH	P,.JBCOR	; SAVE .JBCOR
	PUSH	P,X		; MAKE SURE ENOUGH ROOM ON STACK
	PUSH	P,X		; . . .
	PUSH	P,X		; . . .
	PUSH	P,X		; . . .
	POP	P,X		; . . .
	POP	P,X		; . . .
	POP	P,X		; . . .
	POP	P,X		; . . .

; REDUCE SIZE BY FORCING A GARBAGE COLLECTION

	PUSHJ	P,GARCOL	; GARBAGE COLLECT

; STORE .JBFF IN .JBSA AND .JBCOR AND CHANGE START ADR TO 'RUNENT'

	MOVEI	X,RUNENT	; FETCH NEW START ADR
	MOVEM	X,.JBSA		; AND STORE IN .JBSA
	MOVE	X,.JBFF		; FETCH .JBFF
	HRLM	X,.JBSA		; AND STORE IN .JBSA
	HRLI	X,(X)		; PUT .JBFF IN BOTH HALVES OF .JBCOR
	HLRZ	T1,.JBCOR	; FETCH .JBCOR
	CAIGE	T1,(X)		; NEED TO SET .JBCOR?
	 MOVEM	X,.JBCOR	; YES, SET .JBCOR

; SAVE FLAGS AND ACS FOR RESTORATION ON NEXT RUN

	MOVE	T1,F		; FETCH FLAGS
	TXZ	T1,F$$IO	; AND CLEAR I/O FLAGS
	MOVEM	T1,ACSAVE	; AND SAVE FOR NEXT RUN
	PUSH	P,.JBDDT	; STORE DDT START ADR
	PUSH	P,[<$EECON>]	; STORE ADR OF WHERE TO GO AFTER RUN&GETSEG
	MOVE	1,[<2,,ACSAVE+2>] ; SETUP BLT POINTER
	BLT	1,ACSAVE+17	; AND SAVE ACS FOR NEXT RUN

; INIT DSK:FILE.SAV or .EXE

	SETZ	N,		; USE CHANNEL 0
	MOVSI	M,INIBH		; FETCH ADR OF INPUT BUFFER HEADER
	PUSHJ	P,FILOPN	; OPEN THE DEVICE ('DSK')
	 CERROR	(ODV)		; ** OUTPUT DEVICE OPEN FAILURE **
	MOVEI	M,^D75		;[15000] Save file would probably get this big
	PUSHJ	P,FILENT	; ENTER THE FILE (FILE.SAV[,])
	 CERROR	(ENT)		; ** ENTER ERROR **

	SETSTS	.IOIBN		; CHANGE TO IMAGE BINARY MODE
	MOVEI	X,(POINT 36,)	; FETCH PROPER BYTE SIZE
	HRLM	X,INIBH+1	; AND SET IT IN BUFFER HEADER
	HLRZ	X,FS$EXT(L)	;[21000] Make .EXE file if extension is .EXE
	CAIN	X,'EXE'		;[21000] ...
	 JRST	$EEXE		;[21000] Write an .EXE file

; NOW WRITE OUT THE FILE IN ZERO-COMPRESSED FORMAT

	MOVEI	N,.JBPFI+1	; WHEN TO START SAVING

$EE1:	SKIPN	(N)		; FIND A NON-ZERO?
	 JSP	L,$EE5		; NO, TRY NEXT WORD
	CAML	N,.JBFF		; YES, AT END OF CORE?
	 JRST	$EE2		; YES, DONE

; FOUND A NON-ZERO WORD. COUNT # CONSECUTIVE NON-ZERO AND WRITE OUT

	MOVE	M,N		; SAVE AC N
	SKIPE	(N)		; FIND A ZERO?
	 JSP	L,$EE5		; NO, KEEP LOOKING
	SUBM	M,N		; YES, COMPUTE # CONSECUTIVE
	MOVS	N,N		; AND FORM AN IOWD
	HRRI	N,-1(M)		; FORM: IOWD LEN,,ADR
	PUSHJ	P,$EE3		; AND WRITE OUT THE IOWD
	MOVE	C,N		; SAVE CURRENT ADR
	MOVE	N,1(C)		; FETCH A NON-ZERO DATA WORD
	PUSHJ	P,$EE3		; WRITE OUT A WORD OF DATA
	AOBJN	C,.-2		; AND DO FOR ALL CONSECUTIVE NON-ZEROS
	MOVEI	N,1(C)		; COMPUTE ADR OF WHERE TO START
				; SEARCH FOR NEXT NON-ZERO DATA
	CAMGE	N,.JBFF		; ARE WE DONE?
	 JRST	$EE1		; NO, KEEP GOING

; DONE. FINISH UP.

$EE2:	MOVE	N,[JRST RUNENT]	; FETCH INST. TO START PROGRAM
	PUSHJ	P,$EE3		; AND WRITE TO
$EEND:	POP	P,X		; CLEAN UP STACK
	POP	P,X		;[357] . . .
	POP	P,.JBCOR	; RESTORE .JBCOR
	POP	P,.JBSA		; AND RESTORE .JBSA
	RELEAS	0,		; RELEAS CHANNEL 0
	JRST	(PC)		; AND RETURN TO CALLER

; OUTPUT ONE WORD TO FILE

$EE3:	SOSGE	INIBH+2		; ANY ROOM LEFT IN BUFFER?
	 JRST	$EE4		; NO, OUTPUT THE BUFFER
	IDPB	N,INIBH+1	; YES, STORE THE CHAR IN BUFFER
	POPJ	P,		; AND RETURN TO CALLER

; OUTPUT BUFFER TO FILE

$EE4:	OUT	0,		; OUTPUT THE BUFFER
	 JRST	$EE3		; AND CONTINUE
$EERR:	GETSTS	0,IOSTS		; FAILED. GET STATUS OF CHANNEL
	POP	P,X		; CLEAN STACK
	POP	P,X		; . . .
	POP	P,.JBCOR	; RESTORE .JBCOR
	POP	P,.JBSA		; RESTORE .JBSA
	ERROR	(OUT)		; AND GIVE OUTPUT ERROR MESSAGE

; CHECK IF AC N.GE..JBFF ELSE RETURN .-2

$EE5:	CAML	N,.JBFF		; .GE..JBFF?
	 JRST	(L)		; YES, JUST NORMAL RETURN
	AOJA	N,-2(L)		; NO, INCR. N AND RETURN .-2


; $EEXE -- Write an .EXE file

$EEXE:
	MOVE	N,[1776,,3]	;[21000] Build directory in buffer
	PUSHJ	P,$EE3		;[21000] Write start of directory section
	MOVE	N,[100000,,1]	;[21000] Writable, starting @ file page 1
	PUSHJ	P,$EE3		;[21000] ...
	HRLZ	N,.JBREL	;[21000] Get length of loseg
	TLZ	N,777		;[21000] Convert to page # - 1
	PUSHJ	P,$EE3		;[21000] # of pages-1 , Process page 0
	MOVE	N,[1777,,1]	;[21000] Terminating section
	PUSHJ	P,$EE3		;[21000] ...
	OUTPUT	0,		;[21000] Force it out
	SETSTS	0,.IODMP	;[21000] Change to dump mode
	MOVE	T1,[IOWD 1,INIBF+3] ;[21000] Now zeros for rest of page
	SETZB	T2,INIBF+3		;[21000] I/O list is now in T1 & T2
REPEAT <<1000/C$BUFL>-1>,<
	OUTPUT	0,T1		;[21000] ...
>
	MOVEI	T1,INIBF+3	;[21000] Prepare to BLT bottom of page 0
	BLT	T1,INIBF+C$BUFL+2 ;[21000] do it (we can't dump that stuff)
	MOVE	T1,[IOWD C$BUFL,INIBF+3] ;[21000] Set up I/O list
	OUTPUT	0,T1		;[21000] Write out jobdat & then some
	MOVN	T1,.JBREL	;[21000] Get back  - size of loseg
	ADDI	T1,C$BUFL-1	;[21000] Allow for what we already wrote
	MOVSI	T1,(T1)		;[21000] Build I/O word for rest of core
	HRRI	T1,C$BUFL-1	;[21000] ...
	OUT	0,T1		;[21000] And finally catch I/O errors
	 JRST	$EEND		;[21000] We're done
	JRST	$EERR		;[21000] We lost

; $EECON - COME HERE AFTER RUN&GETSEG IN AN "EE" SAVE FILE

$EECNT:	RESET			;[320] CLEAR THE WORLD
	POP	P,X		; RESTORE THE DDT START ADR
	SETDDT	X,		; . . . (WHAT? YOU'VE NEVER USED 'SETDDT'???)
	POP	P,.JBCOR	; RESTORE .JBCOR
	POP	P,.JBSA		; RESTORE .JBSA
	MOVE	X,[PUSHJ P,UUOTRP] ;[325] RESTORE LUUO TRAP
	MOVEM	X,.JB41		;[325] . . .
	MOVX	X,AP.REN!AP.POV!AP.ILM	; ENABLE APR FOR PDL OV AND ILL MEM REF
	APRENB	X,		; . . .
	PUSHJ	P,MAKCJN	; MAKE OUR CCL JOB NUMBER
	PUSHJ	P,TTOPEN	;[11000] Open the TTY for echo control
	MOVE	X,.JBVER	;[325] FETCH LOWSEG VERSION #
	XOR	X,.HIGH.+.JBHVR	;[12000] [325] COMPARE WITH HISEG VERSION #
	TLNE	X,777777	;[12000] Check left half only
	 ERROR	(VAI)		;[311] NO, VERSIONS ARE INCOMPATIBLE
	MOVEI	X,INTBLK	;[20000] Set up .JBINT for ^C trap if needed
	MOVEM	X,.JBINT	;[20000] or even if not needed...
	JRST	(PC)		; AND CONTINUE WITH WHATEVER WAS
				; AFTER THE "EE" COMMAND
	SUBTTL	$EG and $EX and MONRET
; $EG - PERFORM "EX" AND DO PREVIOUS COMPILE-CLASS MONITOR COMMAND
;
; CALL:	JSP	PC,$$EG
;	(CONTROL IS TRANSFERRED TO SYS:COMPIL)

$EG:	MOVSI	X,'SYS'		; FETCH SYSTEM DEVICE NAME
	MOVEM	X,LRPSPC+FS$DEV	; AND STORE IN RUN FILE-SPEC
	MOVE	X,['COMPIL']	; FETCH COMPIL'S NAME
	MOVEM	X,LRPSPC+FS$NAM	; AND STORE IN FILE-SPEC
	SETZM	LRPSPC+FS$EXT	; CLEAR THE FILE EXTENSION
	SETZM	LRPSPC+FS$PPN	; AND THE PPN
	MOVEI	X,1		; /RUNOFFSET:1
	MOVEM	X,RUNOFS	; . . .
;[14000]TXO	F,F$EDC		;No more FLAG THAT A PROGRAM IS TO BE RUN
;	JRST	$EX		; AND DO THE "EX"

; $EX - PUNCH REST OF INPUT FILE AND EXIT OR RUN A PROGRAM
;
; CALL:	JSP	PC,$$EX
;	(RETURN IF USER TYPES .CONTINUE)

$EX:	SKPINL			; PUT USER'S TERMINAL BACK IN .IOASL MODE
	 JFCL			; . . .
	MOVSI	ARG,1		; PUNCH REST OF INPUT FILE
	TXNE	F,F$UWR		; Is there an output file
	 PUSHJ	P,PUNBUF	; YES, PUNCH THE REST OF THE INPUT FILE

$EX1:
	TXNE	F,F$UBK		; AN "EB" IN PROGRESS?
	 PUSHJ	P,BAKCLS	; YES, FINISH IT

; [21000] Now execute the *EXIT macro, if there is one.

	MOVX	T1,'*EXIT '	;[21000] Get name of macro
	PUSHJ	P,QGET		;[21000] Try to find one
	 JRST	$EX2		;[21000] ain't none
	TXNN	T2,QB$BID	;[21000] Any text in it?
	 JRST	$EX2		;[21000] NOPE
	MOVE	N,T2		;[21000] Get the buffer ID
	MOVX	L,'*EXIT '	;[21000] Remember the macro name
	PUSHJ	P,MACRO		;[21000] Execute it

$EX2:	SKIPN	@TXTBUF		;[22000] Don't bitch if no text
	 JRST	$EX3		;[22000] as is the case
	TXNN	F,F$UWR		;[22000] ANY OUTPUT FILE?
	 ERROR	(NFO)		;[14000] Don't let luser lose his text

$EX3:	RELEAS	INP,		; RELEAS INPUT AND OUTPUT CHANNELS
	RELEAS	OUT,		; . . .
	RELEAS	LOG,		;[330] . . .
	TXZ	F,F$$IO		 ;[313] RESET I/O FLAGS
;	JRST	MONRET		; AND EXIT (OR RUN A PROGRAM)

; MONRET - EXIT TO MONITOR COMMAND LEVEL OR RUN A PROGRAM

MONRET:	SKIPN	LRPSPC+FS$NAM	;[14000] See if we have a program to run
	 JRST	MONRT1		; NO, JUST EXIT

; DO A RUN MUUO ON FILE SPECIFIED IN LAST "ED" COMMAND

	MOVE	T1,LRPSPC+FS$DEV ; FETCH THE DEVICE NAME
	MOVE	T2,LRPSPC+FS$NAM ; FETCH THE FILE NAME
	MOVE	T3,LRPSPC+FS$EXT ; FETCH THE FILE EXTENSION
	SETZB	T4,T5+1		; ZERO UNUSED WORDS OF RUN BLOCK
	MOVE	T5,LRPSPC+FS$PPN ; FETCH THE PPN
	MOVEI	C,T1		; SETUP ADR OF RUN BLOCK
	HRL	C,RUNOFS	; PLUS THE RUNOFFSET
	RUN	C,		; DO THE RUN MUUO
	 HALT	.-1		; LET MONITOR DO ERROR PROCESSING

; DO A MONRT. AND CONTINUE IF USER TYPES "CONTINUE"

MONRT1:	MONRT.			; RETURN TO MONITOR COMMAND LEVEL
	JRST	(PC)		; RETURN TO CALLER IF USER TYPES COONTINUE
	SUBTTL	SSTPSC - Prescan a Search String

; SSTPSC - PRESCAN A SEARCH STRING
;
; GEN:	<CHAR.ADR,,<X>B18+<Y>B19+TEXT.LENGTH>	; X:=1 IF EXACT MODE
	;					; X:=0 IF BOTH UC AND LC MATCH
;						; Y:= (ED & 1)
;
; CALL:	PUSHJ	P,SSTPSC
;	(RETURN)
;
; SMASHES ACS X,T1-T4,C
;
; T2 HOLDS DELIMITER CHAR
; T3 HOLDS <CHAR.ADR,,<X>B18>
; T4 HOLDS <TEXT LENGTH>

SSTPSC:	SETZ	T4,		; CLEAR THE TEXT LENGTH COUNT
	MOVE	T2,DELIM	; [12000] Get default delimiter
	TXZN	F,F$DTM		; IS STRING IN DELIMITED MODE?
	 JRST	SSTPS1		; NO, ALTMODE IS THE DELIMITER
	PUSHJ	P,CMDGCH	; YES, FETCH THE DELIMITER CHAR
	 ERROR	(USR)		; NONE LEFT. ** UNTERMINATED SEARCH ARGUMENT **
	MOVEI	T2,(C)		; COPY THE DELIMITER CHAR

SSTPS1:	PUSHJ	P,CURCHA	; FETCH ADR OF SEARCH STRING IN COMMAND STRING
	MOVSI	T3,(T1)		; SAVE THE CHAR.ADR OF STRING
	MOVX	X,ED$UAR	;[16000] Up-arrow mode??
	TDNE	X,EDVAL		;[16000] ...
	 TRO	T3,200000	;[16000] Remember it forever

; SCAN THE COMMAND STRING UNTIL THE DELIMITER CHAR IS SEEN

SSTPS2:	PUSHJ	P,CMDGCH	; FETCH THE NEXT COMMAND CHAR
	 ERROR	(USR)		; NONE LEFT. ** UNTERMINATED SEARCH ARGUMENT **
	CAIN	C,(T2)		; IS IT THE DLIMITER CHAR?
	 JRST	SSTPS4		; YES, SCAN IS COMPLETE
SSTP2X:	AOJ	T4,		; INCREMENT THE TEXT LENGTH COUNT
	CAIN	C,"^"		;[16000] Is this an uparrow??
	 TRNE	T3,200000	;[16000] do we care?
	  JRST	SSTP2Y		;[16000] no
	PUSHJ	P,CMDGCH	;[16000] Get the next character...
	 ERROR	(USR)		;[16000] Un-terminated search error
	ANDI	C,37		;[16000] Make it a control character
	JRST	SSTP2X		;[16000] And do all our good stuff to it
SSTP2Y:	CAIE	C,.CHCNR	; IS IT ^R?
	 CAIN	C,.CHCNQ	; OR ^Q?
	  JRST	SSTPS3		; YES
;	CAIN	C,.CHCNT	; IS IT ^T?
;	 TXCA	F,F$CNT		; YES, SET THE "^R AND ^T ARE ONLY SPECIALS" FLAG
;	TXNE	F,F$CNT		; ARE WE IN ^T MODE?
;	 JRST	SSTPS2		; YES, ^R AND ^T ARE THE ONLY SPECIAL CONTROL CHARS
	CAIE	C,.CHCNV	; NO, ^V?
	 CAIN	C,.CHCNW	; OR ^W?
	  TRO	T3,1B18		; YES, SET THE EXACT MODE FLAG
	JRST	SSTPS2		; AND CONTINUE SCAN
; ^R AND ^Q - TAKE NEXT CHAR AS TEXT

SSTPS3:	PUSHJ	P,CMDGCH	; FETCH NEXT COMMAND CHAR
SSTUSR:	 ERROR	(USR)		; NONE LEFT. ** UNTERMINATED SEARCH ARGUMENT **
	AOJA	T4,SSTPS2	; AND CONTINUE SCAN

; SCAN COMPLETE. GEN <CHAR.ADR,,<X>B18+TEXT.LENGTH>

SSTPS4:	CAILE	T4,C$SRHL	; TOO MANY CHARS?
	 ERROR	(STC)		; YES, ** TOO MANY CHARS IN SEARCH STRING **
	IOR	T3,T4		; FORM <CHAR.ADR,,<X>B18+TEXT.LENGTH>
	PUSH	CP,T3		; AND GEN IT INTO CODE
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	SSTGSM - Generate a Search Matrix

; SSTGSM -  GENERATE SEARCH MATRIX FOR A SEARCH ARGUMENT
;	- COPIES SEARCH STRING FROM COMMAND STRING TO 'SRHARG'
;	- GENERATE SEARCH MATRIX INTO 'SRHTAB'
;	- STORES LENGTH OF SEARCH ARGUMENT IN 'SRHCTR'
;	- STORES BIT POINTER FOR SEARCH MATRIX IN 'SRHSMP'
;
; CALL:	MOVE	T3,[<CHAR.ADR,,<X>B18+TEXT.LENGTH>]
;				; X:=1 IF SEARCH IS TO BE MADE IN EXACT MODE
;				; X:=0 IF SEARCH IS TO MATCH BOTH LC AND UC
;	PUSHJ	P,SSTGSM
;	(RETURN)
;
; IF 'TEXT.LENGTH' IS ZERO, PREVIOUS SEARCH ARGUMENT AND MATRIX ARE USED.
;
; ACS X,T1-T4,N,M ARE SMASHED
;
; T2  HOLDS BYTE POINTER TO SOURCE
; T3 HOLDS COUNT OF CHARS LEFT IN TEXT
; T4 HOLDS BYTE POINTER TO 'SRHARG'
; N HOLDS BIT POSITION FOR SEARCH MATRIX
; M HOLDS ^E NESTING LEVEL

SSTGSM:	TXZ	F,F$$TX		; CLEAR SOME FLAGS
	HLRZ	T1,T3		; FETCH CHAR.ADR OF SEARCH STRING
	SOJ	T1,		; 'CAUSE BP WILL BE INCREMENTED BEFORE USE
	PUSHJ	P,CTOBP		; CONVERT CHAR.ADR-1 TO A BYTE POINTER
	MOVE	T2,T1		; PUT THE BP IN AC T2
	ADD	T2,@CMDBUF	; MAKE IT AN ABSOLUTE ADR
	TRZE	T3,1B18		; SEARCH IN EXACT MODE?
	 TXO	F,F$EXM		; YES
	TRZE	T3,1B19		;[16000] Compiled with uparrow mode?
	 TXO	F,F$UAR		;[16000] Remember it for a while at least
	MOVEI	T3,(T3)		; COMPUTE TEXT.LENGTH COUNT
	JUMPE	T3,CPOPJ	; DONE IF SEARCH STRING IS NULL
	STORE	(X,SRHTAB,SRHTAB+SRHLN-1,0) ; CLEAR THE SEARCH MATRIX
	MOVEM	T3,SRHCTR	; STORE THE LENGTH OF THE SEARCH STRING
	MOVE	T4,[POINT 7,SRHARG] ; SETUP BP TO SRHARG
	STORE	(X,SRHARG,SRHARG+^D<80/5-1>,0) ; CLEAR SEARCH ARG
	MOVSI	N,(1B0)		; INIT THE SEARCH MATRIX BIT POINTER
	SETZ	M,		; CLEAR ^E[...] LEVEL COUNT
; SCAN SEARCH STRING AND SET UP SEARCH MATRIX

SSTGS1:	ILDB	C,T2		; FETCH CHAR FROM SEARCH STRING
	IDPB	C,T4		; AND STORE IN SRHARG
SSTG1X:	MOVE	T1,[IOWD S2TL,S2T+1] ; SETUP PTR TO SPECIAL CTL CHAR TABLE
;	TXNE	F,F$CNT		; IN ^T MODE?
;	 MOVE	T1,[IOWD S3TL,S3T+1] ; YES, USE SHORT DISPATCH TABLE
	PUSHJ	P,DISPAT	; DISPATCH ON SPECIAL CONTROL CHARS
;[14000] Don't bitch about controls
;	TXNN	F,F$CNT		; NOT SPECIAL. IN ^T MODE?
;	 PUSHJ	P,CHKNCC	; YES, CHECK FOR ILLEGAL CONTROL COMMANDS

SSTGS2:	TXNE	F,F$EMA		; ACCEPT EITHER LC OR UC?
	 JRST	SSTGS8		; YES
	TXNN	F,F$CNX		; EXACT SEARCH MODE?
	 TXNE	F,F$EXM		; . . . ?
	  JRST	SSTGS3		; YES

; BOTH LC AND UC LETTERS MATCH

SSTGS8:	CAIG	C,"Z"+40	; IS CHAR A LC LETTER?
	 CAIGE	C,"A"+40	; . . . ?
	  SKP			; NO
	TRZ	C,40		; YES, UPCASE IT
	CAIG	C,"Z"		; IS CHAR UC LETTER?
	 CAIGE	C,"A"		; . . . ?
	  JRST	SSTGS3		; NO
	XORM	N,SRHTAB+40(C)	; YES, SET THE LC ENTRY FOR LETTER ALSO
	JRST	SSTGS4		; NOW SET THE UC ENTRY FOR LETTER

SSTGS3:	PUSHJ	P,CASE		; TAKE CARE OF CASE SETTING FOR CHAR
SSTGS4:	XORM	N,SRHTAB(C)	; SET SEARCH MATRIX ENTRY FOR CHAR
SSTGS5:	SOJ	T3,		; DECREMENT # CHARS LEFT IN SEARCH STRING
	JUMPN	M,CPOPJ		; RETURN IF GATHERING DATA FOR ^E[A,B,C]
	TXZN	F,F$CNN		; WAS PREVIOUS CHAR ^N?
	 JRST	SSTGS6		; NO
	ANDCAM	N,SRHTAB+$CHBEG	; CLEAR FAKE CHARACTERS
	ANDCAM	N,SRHTAB+$CHSPC	; . . .
	ANDCAM	N,SRHTAB+$CHEND	; . . .
SSTGS6:	LSH	N,-1		; ADVANCE SEARCH MATRIX TO NEXT POSITION
SSTGS9:	JUMPLE	T3,SSTGS7	; SCAN COMPLETE
	JUMPN	N,SSTGS1	; KEEP SCANNING IF .LT.36. CHARS
	ERROR	(STL)		; NO. ** SEARCH STRING TOO LONG **

; SCAN COMPLETE. STORE BIT POINTER FOR SEARCH MATRIX

SSTGS7:	MOVEM	N,SRHSMP	; STORE SEARCH MATRIX POINTER
	POPJ	P,		; AND RETURN TO CALLER
; DISPATCH TABLES FOR SPECIAL CONTROL COMMANDS IN SEARCH STRINGS
;  DURING SEARCH MATRIX

S2T:	<.CHCNE,,SSGCNE>
	<.CHCNX,,SSGCNX>
	<.CHCNN,,SSGCNN>
	<.CHCNS,,SSGCNS>
	<.CHCNV,,SSGCNV>
	<.CHCNW,,SSGCNW>
	<.CHCBS,,SSGCBS>
	<.CHCCF,,SSGCUP>
	<"^",,SSGUA>	;[16000] Up-arrow mode

S3T:;	<.CHCNT,,SSGCNT>
	<.CHCNQ,,SSGCNQ>
	<.CHCNR,,SSGCNR>
S3TL==.-S3T
S2TL==.-S2T
; ^X - SET SEARCH MATRIX TO MATCH ANY ARBITRARY CHARACTER

SSGCNX:	MOVE	X,[<-SRHLN+4,,1>] ; TO SET ALL CHARS
				; EXCEPT NULL AND FAKE CHARS

SSGSET:	PUSHJ	P,SSGSTB	; SET CHARACTER(S) IN SEARCH MATRIX
	JRST	SSTGS5		; AND CONTINUE SCAN

; ^N - SET SEARCH MATRIX TO REVERSE SENSE OF SEARCH FOR THE
;	ARBITRARY CHARACTER THAT FOLLOWS (MAY BE ^E,^N,ETC.)

SSGCNN:	MOVE	X,[<-SRHLN+4,,1>] ; SET SEARCH MATRIX FOR ALL CHARS (EXCEPT NULL)
	PUSHJ	P,SSGSTB	; . . .
	TXO	F,F$CNN		; FLAG THAT A ^N WAS SEEN
	SOJG	T3,SSTGS1	; AND CONTINUE SCAN
	ERROR	(ICN)		; NO CHARS LEFT. ** ILLEGAL ^N COMMAND **

; ^S - SET SEARCH MATRIX TO MATCH NON-SYMBOL CONSTITUENTS
;	(IE: NOT(A-Z,0-9,.,%,$)

; ^B - Same as ^S but easier to type on tubes with PAGE set

SSGEM:	XORM	 N,SRHTAB+$CHSPC	;[10000] Any number of... (^EM)
	SOJG	T3,SSTGS1		;[10000]
	ERROR(ICA)			;[10000]

SSGEB:
SSGCNS:	MOVE	X,[<-SRHLN+3,,1>] ; SET SEARCH MATRIX FOR ALL CHARS
	PUSHJ	P,SSGSTB	; EXCEPT NULL AND FAKE CHARS EXCEPT BEGPAGE
	MOVE	T1,EDVAL	;[10000] ^O40ED = bliss mode
	TXNE	T1,ED$BLI	;[10000]
	 JRST	[XORM N,SRHTAB+"_"	;[10000]
		 XORM N,SRHTAB+"&"	;[10000]
		 JRST .+2]	;[10000]
	XORM	N,SRHTAB+"."	; DON'T ALLOW "."
	XORM	N,SRHTAB+"%"	; DON'T ALLOW "%"
	XORM	N,SRHTAB+"$"	; DON'T ALLOW "$"
	MOVE	X,[<-^D10,,"0">] ; DON'T ALLOW DIGITS
	PUSHJ	P,SSGSTB	; . . .

SSGEA:	MOVE	X,[<-^D26,,"A">] ; ENTRY POINT FOR ^EA
	PUSHJ	P,SSGSTB	; SET/CLEAR UC LETTERS

SSGEV:	MOVE	X,[<-^D26,,"A"+40>] ; ENTRY POINT FOR ^EV
	JRST	SSGSET		; SET/CLEAR UC LETTERS

; ^V - DOWNCASE FOLLOWING CHAR IF A LETTER
; ^V^V - DOWNCASE FOLLOWING LETTERS TILL END OF STRING OR FURTHER NOTICE

SSGCNV:	PUSHJ	P,CNV		; SET FLAGS FOR ^V
	SOJA	T3,SSTGS9	; AND CONTINUE SCAN

; ^W - UPCASE THE FOLLOWING CHAR IF A LETTER
; ^W^W - UPCASE FOLLOWING LETTERS TILL END OF STRING OR FURTHER NOTICE

SSGCNW:	PUSHJ	P,CNW		; SET FLAGS FOR ^W
	SOJA	T3,SSTGS9	; AND CONTINUE SCAN

; ^\ - COMPLEMENT FORCED EXACT SEARCH MODE

SSGCBS:	TXC	F,F$EMA		; COMPLEMENT THE FORCED EXACT SEARCH MODE FLAG
	SOJA	T3,SSTGS9	; AND CONTINUE SCAN
; ^^ - DOWNCASE THE FOLLOWING CHAR IF @,[,\,],OR _

SSGCUP:	SOJLE	T3,SSTUSR	;[20000] Un-terminated search error
	ILDB	C,T2		; FETCH THE FOLLOWING CHAR
	IDPB	C,T4		; AND STORE IN SRHARG
	PUSHJ	P,CNUAR		;DOWNCASE IT IF @,[,\,],_
	SOJA	T3,SSTGS2	; AND CONTINUE SCAN

; ^T - COMPLEMENT THE ^T MODE. DISABLES ALL CONTROL COMMANDS EXCEPT ^R,^Q,^T

;SSGCNT:	TXC	F,F$CNT		; COMPLEMENT ^T MODE FLAG
;	SOJA	T3,SSTGS9	; AND CONTINUE SCAN

; ^R - TAKE THE FOLLOWING CHAR AS TEXT

SSGCNR:

; ^Q - TAKE THE FOLLOWING CHAR AS TEXT

SSGCNQ:	ILDB	C,T2		; FETCH THE FOLLOWING CHAR
	IDPB	C,T4		; AND STORE IT IN SRHARG
	SOJA	T3,SSTGS2	;[373] AND CONTINUE SCAN

; ^ - Take next character as control, if enabled

SSGUA:	TXNE	F,F$UAR		;[16000] Is up-arrow really up-arrow?
	 JRST	SSTGS4		;[16000] Yes, treat as ordinary character
	ILDB	C,T2		;[16000] Fetch the following character
	ANDI	C,37		;[16000] Make it a control
	SOJA	T3,SSTG1X	;[16000] and process it

; ^E COMMANDS

SSGCNE:	ILDB	C,T2		; FETCH THE FOLLOWING CHAR
	PUSHJ	P,UPCASE	;[12000] Make upper case
	IDPB	C,T4		; AND STORE IT IN SRHARG
	SOJLE	T3,SSGCEE	; NONE LEFT. ** ^E COMMAND ERROR **
	MOVE	T1,[IOWD S4TL,S4T+1] ; FETCH PTR TO DISPATCH TABLE
	PUSHJ	P,DISPAT	; DISPATCH ON THE FOLLOWING CHAR
SSGCEE:	ERROR	(ICE)		; ** ILLEGAL ^E COMMAND **

; DISPATCH TABLE FOR ^E COMMANDS DURING SEARCH MATRIX GENERATION

S4T:	<"A",,SSGEA>
	<"B",,SSGEB>	;[14000] ^EB = ^S
	<"M",,SSGEM>	;[14000] ^EMc any number of c
	<"V",,SSGEV>
	<"W",,SSGEW>
	<"D",,SSGED>
	<"L",,SSGEL>
	<"S",,SSGES>
	<.CHLAB,,SSGEAB>
	<"[",,SSGESB>
S4TL==.-S4T
; ^EW - SET SEARCH MATRIX FOR UPPER CASE LETTERS

SSGEW:	SKIPA	X,[<-^D26,,"A">] ; FETCH AOBJN PTR FOR UC LETTERS

; ^ED - SET SEARCH MATRIX FOR DIGITS

SSGED:	 MOVE	X,[<-^D10,,"0">] ; FETCH AOBJN PTR FOR DIGITS
	JRST	SSGSET		; SET SEARCH MATRIX AND CONTINUE SCAN

; ^EL - SET SEARCH MATRIX TO MATCH END-OF-LINE DELIMITERS

SSGEL:	MOVE	X,[<-3,,.CHLFD>] ; FETCH AOBJN POINTER FOR <LF><VT><FF>
	JRST	SSGSET		; AND SET SEARCH MATRIX AND CONTINUE SCAN

; ^ES - SET SEARCH MATRIX TO MATCH ARBITRARY # SPACES AND/OR TABS

SSGES:	XORM	N,SRHTAB+.CHSPC	; SET THE SPACE ENTRY IN SEARCH MATRIX
	XORM	N,SRHTAB+.CHTAB	; SET THE TAB ENTRY
	XORM	N,SRHTAB+$CHSPC	; SET ENTRY FOR ARBITRARY #
	JRST	SSTGS5		; AND CONTINUE SCAN

; ^E<NNN> - SET SEARCH MATRIX TO MATCH ASCII CHAR WHOSE OCTAL CODE IS NNN

SSGEAB:	SETZ	X,		; SET NUMBER:=0

SSGEA1:	ILDB	C,T2		; FETCH NEXT CHAR
	IDPB	C,T4		; AND STORE IN SRHARG
	SOJL	T3,SSGCEE	; ERROR IF NO CHARS LEFT
	CAIN	C,.CHRAB	; IS CHAR A RIGHT ANGLE BRACKET?
	 JRST	SSGEA2		; YES, DONE WITH NNN
	CAIG	C,"7"		; IS CHAR AN OCTAL DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  ERROR	(ICE)		; NO. ** ILLEGAL ^E COMMAND **
	LSH	X,3		; YES, MAKE ROOM FOR THE DIGIT
	IORI	X,-"0"(C)	; AND ADD IN THE DIGIT
	JRST	SSGEA1		; AND TRY FOR ANOTHER DIGIT

SSGEA2:	ANDI	X,177		; MAKE OCTAL CODE 7 BITS
	XORM	N,SRHTAB(X)	; AND SET ENTRY IN SEARCH MATRIX
	JRST	SSTGS5		; AND CONTINUE SCAN
; ^E[A,B,C] - ACCEPT "A" XOR "B" XOR "C" FOR THIS CHAR POSITION
;	A,B,C ARE ANY STRING ELEMENTS INCLUDING ^E COMMANDS

SSGESB:	AOJ	M,		; COUNT THE LEVELS OF ^E NESTING

SSGES1:	PUSHJ	P,SSTGS1	; PROCESS FOLLOWING CHAR
	ILDB	C,T2		; FETCH NEXT CHAR
	IDPB	C,T4		; AND STORE IN SRHARG
	SOJL	T3,SSGCEE	; ERROR IF NONE LEFT
	CAIN	C,","		; IS CHAR ","?
	 JRST	SSGES1		; YES, CONTINUE [A,B,...]
	CAIE	C,"]"		; NO IS CHAR TERMINATING "]"?
	 ERROR	(ICE)		; NO. ** ILLEGAL ^E COMMAND **
	SOJA	M,SSTGS5	; YES, DECR ^E NESTING COUNT AND CONTINUE SCAN

; SSGSTB - SET SEARCH MATRIX FOR MULTIPLE CHARACTERS IN SAME POSITION
;
; CALL:	MOVE	X,[<-LEN,,START.CHAR>]
;	PUSHJ	P,SSGSTB
;	(RETURN)
;
; SMASHES AC X

SSGSTB:	XORM	N,SRHTAB(X)	; SET ONE CHAR POSITION

	AOBJN	X,SSGSTB	; LOOP FOR ALL CHARS IN RANGE
	POPJ	P,		; DONE. RETURN TO CALLER
	SUBTTL	SERCH and BSERCH - Perform a Search
; SERCH - PERFORM A SEARCH ON THE MAIN TEXT BUFFER FROM "." ON
;
; CALL:	PUSHJ	P,SERCH
;	(FAIL RETURN)
;	(SUCCESS RETURN)
;
; SMASHES ACS X,T1-T5,C,N,M

SERCH:	MOVE	T4,PTVAL	; LOWER BOUND:="."
	MOVE	T5,@TXTBUF	; UPPER BOUND:=Z

; BSERCH - PERFORM A SEARCH ON THE MAIN TEXT BUFFER WITHIN SPECIFIED BOUNDS
;
; CALL:	MOVEI	T4,LBOUND	; LOWER BOUND
;	MOVEI	T5,UBOUND	; UPPER BOUND
;	PUSHJ	P,BSERCH
;	(FAIL RETURN)
;	(SUCCESS RETURN)

BSERCH:	PUSH	P,T4		; SAVE AC T4
	PUSH	P,T5		; SAVE AC T5
	PUSHJ	P,NXTWRD	; FETCH <CHAR.ADR,,TEXT.LENGTH>
	MOVE	T3,N		; AND COPY INTO AC T3
	PUSHJ	P,SSTGSM	; GENERATE THE SEARCH MATRIX
	POP	P,T5		; RESTORE AC T5
	POP	P,T4		; RESTORE AC T4
	EXCH	T4,PTVAL	;[14000] Start at this place
	MOVEM	T4,ACSAVE	;[15000] Save real .
	MOVE	T4,PTVAL	;[15000] Get back real l.b.
	PJRST	SEARC0		; PERFORM THE SEARCH
	SUBTTL	SEARCH - The Actual Search Routine

; SEARCH - SEARCH THE MAIN TEXT BUFFER (WITHIN BOUNDS) FOR A STRING
;
; CALL:	MOVEI	ARG,N		; FIND THE NTH OCCURRANCE
;	MOVEI	T4,LBOUND	; LOWER BOUND CHAR.ADR
;	MOVEI	T5,UBOUND	; UPPER BOUND. CHAR.ADR
;	PUSHJ	P,SEARCH
;	(FAIL RETURN)		; "." IS B

;	(SUCCESS RETURN)	; "." IS AFTER END OF STRING
;
; IT IS ASSUMED THAT SEARCH ARG HAS BEEN COPIED TO 'SRHARG', ITS LENGTH
; STORED IN 'SRHCTR', AND THE SEARCH MATRIX IS IN 'SRHTAB'
;
; SMASHES ACS X,T1,T2,C,N,M
;
; N HOLDS STATIC CHAR.ADR POINTER
; T1 HOLDS STATIC BYTE POINTER
; T2 HOLDS DYNAMIC BYTE POINTER
; M HOLDS BUT POINTER FOR SEARCH MATRIX

SEARCH:	MOVE	X,PTVAL		; FETCH "."
	MOVEM	X,ACSAVE	; AND SAVE FOR LATER CHECKING
SEARC0:			;[15000] . already saved
	SKIPN	SRHCTR		; WAS THERE A PREVIOUS SEARCH ARGUMENT?
	 ERROR	(SNA)		; NO. ** SEARCH WITH NO INITIAL ARGUMENT **
	MOVE	T3,SRHSMP	; FETCH THE BIT POINTER TO THE LAST
				; POSITION IN THE SEARCH MATRIX
	TXO	F,F$MSR		;TRY NEGATIVE FIRST
	CAMG	T4,T5		; IS THIS A MINUS SEARCH?
				; (IE: BACKWARDS)
	 TXZA	F,F$MSR		; NO , KEEP ARGS THIS WAY AND ZAP FLAG
	EXCH	T4,T5		; EXCHANGE BOUNDS BACK IF NOT MINUS SEARCH
; MAIN SEARCH LOOP

SEARC1:	JUMPLE	ARG,SEARCS	; SUCCESS IF WE'VE FOUND THE NTH OCCURRANCE
	MOVE	N,PTVAL		; COPY OF "."
	MOVE	T1,N		; COPY CURRENT CHAR.ADR
	ADDI	T1,5*T$DATA-1	; T1:=CHAR.ADR-1 IN BUFFER
	IDIVI	T1,5		; TURN CHAR.ADR INTO A BP
	HLL	T1,CBPTBL(T2)	; . . .
	ADD	T1,TXTBUF	; ADD IN THE BASE ADR OF TEXT BUFFER
	MOVE	T2,T1		; COPY BP INTO AC T2
	JUMPG	N,SEARC2	; JUMP IF NOT AT BEG OF BUFFER

; AT BEGINNING OF BUFFER. SEE IF IT MATCHES FIRST CHAR OF SEARCH

	SKIPL	SRHTAB+$CHBEG	; DOES BEG OF BUFFER MATCH?
	 JRST	SEARC2		; NO
	MOVX	M,1B1		; YES, START SEARCH AT WITH SECOND CHAR
	TXO	F,F$BPG		; FLAG THAT BEG OF BUFFER MATCHES
	JRST	SEARC5		; AND JUMP INTO THE SEARCH LOOP

; SEE IF SEARCH MATCHES BEGINNING AT CURRENT POSITION

SEARC2:	CAML	N,T4		; WITHIN BOUNDS?
	 CAMLE	N,T5		; . . . ?
	  JRST	SEARC5		; NO
	MOVX	M,1B0		; START WITH FIRST CHAR
	MOVE	T2,T1		; DYNAMIC BP:=STATIC BP
	JRST	SEARC7		; JUMP INTO THE SEARCH

; CHECK INDIVIDUAL CHARS

SEARC3:	TDNE	M,SRHTAB+$CHSPC ; MULTIPLE CHARACTERS THIS POSITION?
	 JRST	SERSPC		; YES
	AOJ	N,		; ADVANCE STATIC POINTER

SEARC4:	LSH	M,-1		; ADVANCE SEARCH MATRIX POSITION

SEARC5:	CAMN	M,T3		; END OF SEARCH MATRIX?
	 JRST	SEARCS		; YES, FOUND A MATCH

SEARC7:	ILDB	C,T2		; FETCH CHAR FROM TEXT BUFFER
	TDNE	M,SRHTAB(C)	; DOES CHAR MATCH SEARCH MATRIX?
	 JRST	SEARC3		; YES, TRY NEXT CHAR IN BUFFER
; SEARCH STRING DOES NOT MATCH. ADVANCE STATIC POINTER

	TXZE	F,F$BPG		; AT BEG OF BUFFER?
	 JRST	SEARC2		; YES, NOW TRY FIRST CHAR OF SEARCH STRING
	TXNE	F,F$2CO!F$REE	;[14000] Anchored search?? or aborted?
	 JRST	SRCHF1		;[14000] Yes. it failed.
	TXNE	F,F$MSR		; DOING A MINUS SEARCH?
	 JRST	SEARC6		; YES
	AOS	N,PTVAL		; ADVANCE THE STATIC CHAR.ADR POINTER
	CAMLE	N,T5		; WITHIN BOUNDS?
	 JRST	SRCHF1		; NO
	IBP	T1		; YES, INCREMENT THE STATIC BP
	JRST	SEARC2		; AND TRY AGAIN

SEARC6:	SOS	N,PTVAL		; BACKUP THE STATIC CHAR.ADR POINTER
	CAMGE	N,T4		; ABOVE LOWER BOUND?
	 JRST	SRCHF1		; NO, SEARCH FAILED
	ADD	T1,[<7B5>]	; YES, DECREMENT STATIC BP
	JUMPGE	T1,SEARC2	; AND TRY AGAIN
	HRLI	T1,(POINT 7,,34) ; . . .
	SOJA	T1,SEARC2	; . . .

; SERSPC - SKIP OVER MULTIPLE CHARACTERS

SERSPC:	AOJ	N,		; ADVANCE TO NEXT CHAR IN BUFFER
	CAML	N,T4		; PAST END OF SEARCH BOUNDS?
	 CAMLE	N,T5		; . . . ?
	  JRST	SEARC4		; YES, STOP SKIPPING

	MOVE	X,T2		; SAVE CURRENT BP
	ILDB	C,T2		; GET NEXT CHAR FROM BUFFER
	TDNE	M,SRHTAB(C)	;[10000] Skip whatever it was
	  JRST	SERSPC		; YES, SKIP IT

	MOVE	T2,X		; NO, RESTORE BP
	JRST	SEARC4		; AND GO BACK FOR MORE OF SEARCH
; SEARCH FAILED

SRCHF1:	MOVE	X,ACSAVE	; FETCH ORIGINAL "."
	MOVEM	X,PTVAL		; AND RESTORE IT
	TXO	F,F$LSF		; "LAST SEARCH FAILED"
	SETZ	VALUE,		; VALUE:=0
	POPJ	P,		; GIVE FAIL RETURN TO CALLER

; SEARCH SUCCEEDED

SEARCS:	CAML	N,T4		; SUCCEED WITHIN BOUNDS? [16000] boundary 
	 CAMLE	N,T5		; . . . ?
	  JRST	SRCHF1		; NO, FAILED
	TXZ	F,F$LSF		; "LAST SEARCH SUCCEEDED"
	MOVE	X,N		; SAVE CURRENT POINTER
	MOVE	T2,PTVAL	; SAVE OLD "."
	TXNE	F,F$MSR		; DO A MINUS SEARCH?
	 JRST	SRCHS2		; YES

; CHECK IF WE'RE SEARCHING FOR THE NTH OCCURRANCE (N.GT.1)

SRCHS1:	MOVEM	N,PTVAL		; POSITION "." AFTER SEARCH MATCH-1
	SOJG	ARG,SEARC1	; KEEP GOING IF N.GT.1
	MOVEM	X,PTVAL		; POSITION "." AFTER SEARCH
	SUB	X,T2		; COMPUTE THE LENGTH OF THE SEARCH MATCH
	MOVEM	X,SRHLEN	; AND STORE FOR LATER USE
	SETO	VALUE,		; SET VALUE TO "SUCCESS"
	JRST	CPOPJ1		; AND RETURN TO CALLER

SRCHS2:	CAMG	N,ACSAVE	; MATCH AFTER "." FOR MINUS SEARCH?
	 SOSA	N,PTVAL		; NO, SEARCH A SUCCESS. DECR "."
	SOSA	N,PTVAL		; YES, DECR "."
	 JRST	SRCHS1		; AND SEE IF WE HAVE TO SEARCH AGAIN
	JRST	SEARC1		; AND TRY AGAIN
	SUBTTL	Command Execution Subroutines

; NXTWRD - RETURN WORD AT PC AND INCREMENT PC
;
; CALL:	PUSHJ	P,NXTWRD
;	(RETURN)		; WITH WORD IN AC N
;
; USES ACS X,N. UPDATES PC

NXTWRD:	MOVE	N,(PC)		; FETCH WORD AT CURRENT PC
	AOJA	PC,CPOPJ	; INCREMENT PC AND RETURN

; CHKARG - MAKE SURE ARG IS BETWEEN "B" AND "Z"
;
; CALL:	PUSHJ	P,CHKARG	; WITH ARG IN AC 'ARG'
;	(FAIL RETURN)		; ARG IS OUT OF BOUNDS
;	(SUCCESS RETURN)	; ARG IS OKAY

CHKARG:	JUMPL	ARG,.+2		; ERROR IF ARG IS .LT.0
	 CAMLE	ARG,@TXTBUF	; IS ARG .LE.Z?
	  POPJ	P,		; NO, GIVE FAIL RETURN
	JRST	CPOPJ1		; YES, GIVE SUCCESS RETURN TO CALLER

; CHK2RG - MAKE SURE SARG,ARG ARE IN BUFFER AND ERROR IF ARG.LT.SARG
;
; CALL:	PUSHJ P,CHK2RG
;
; MODIFIES ACS ARG,SARG

CHK2RG:	CAMLE	SARG,ARG	; ARE ARGS IN PROPER ORDER
	 EXCH	ARG,SARG	;[21000] Then fix them!
	CAMLE	SARG,@TXTBUF	; SARG.GT.Z?
	 MOVE	SARG,@TXTBUF	; YES, USE Z AS SARG
	JUMPGE	SARG,.+2	; SARG.GE.ZERO?
	 SETZ	SARG,		; NO, USE B AS SARG
	CAMLE	ARG,@TXTBUF	; ARG.GT.Z?
	 MOVE	ARG,@TXTBUF	; YES, USE Z AS SARG
	JUMPGE	ARG,.+2		; ARG.GE.ZERO?
	 SETZ	ARG,		; NO, USE B AS ARG
	POPJ	P,		; AND RETURN TO CALLER
; EVL2RG - CONVERT SINGLE LINE ARG TO CHARACTER ADRESSES ARGS
;
; CALL:	PUSHJ	P,EVL2RG
;	(RETURN)		; WITH START ADR IN ARG AND END ADR IN SARG
;
; USES ACS T1,T2,T4. MODIFIES ARG,SARG

EVL2RG:	MOVE	T4,PTVAL	; FETCH CURRENT CHAR ADR
	JUMPLE	ARG,EVL2R3	; JUMP IF ARG IS .LE.ZERO

; ARG.GT.ZERO. GO TO THE N-1ST END-OF-LINE

EVL2R1:	CAMN	T4,@TXTBUF	; AT END OF BUFFER YET?
	 JRST	EVL2R2		; YES. THAT'S AS FAR AS WE GO
	PUSHJ	P,GETINC	; FETCH CURRENT CHAR FROM BUFFER AND INCR T4
	PUSHJ	P,CHKEOL	; IS CHAR END OF LINE?
	 JRST	EVL2R1		; NO, KEEP GOING
	SOJG	ARG,EVL2R1	; YES, KEEP GOING TILL NTH ONE

EVL2R2:	MOVE	ARG,T4		; FIRST ARG IS WHERE NTH LINE FROM "." IS
	MOVE	SARG,PTVAL	; SECOND ARG IS "."
	POPJ	P,		; RETURN TO CALLER

; ARG.LE.ZERO. GO BACK N END-OF-LINES

EVL2R3:	SOJ	T4,		; START LOOKING AT "."-1

EVL2R4:	MOVE	T1,T4		; FETCH CHAR ADR
	JUMPL	T1,EVL2R5	; STOP WHEN BEGINNING OF BUFFER HIT
	PUSHJ	P,GET		; FETCH CHAR FROM BUFFER
	PUSHJ	P,CHKEOL	; END OF LINE?
	 SOJA	T4,EVL2R4	; NO, BACK UP ANOTHER CHAR
	AOJLE	ARG,.-1		; YES, KEEP GOING TILL THE NTH ONE
	AOSA	SARG,T4		; SECOND ARG IS "." MINUS N LINES

EVL2R5:	SETZB	SARG,T4		; IF BEG OF BUFFER HIT, SARG:=0
	MOVE	ARG,PTVAL	; FIRST ARG IS "."
	POPJ	P,		; RETURN TO CALLER
; CNV - SET ^V (DOWNCASE NEXT CHAR) FLAG OR LOCK ^V^V FLAG
;
; CALL:	PUSHJ	P,CNV
;	(RETURN)

CNV:	TXON	F,F$CNV		; SET THE ^V FLAG
	 POPJ	P,		; RETURN TO CALLER IF IT WAR CLEAR
	TXZ	F,F$CNV!F$CWW	; WAS SET. CLEAR AND SET ^V^V LOCK FLAG
	TXO	F,F$CVV		; SET ^V^V LOCK FLAG
	POPJ	P,		; AND RETURN TO CALLER

; CNW - SET ^W (UPCASE NEXT CHAR) FLAG OR LOCK ^W^W FLAG
;
; CALL:	PUSHJ	P,CNW
;	(RETURN)

CNW:	TXON	F,F$CNW		; SET THE ^W FLAG
	 POPJ	P,		; RETURN TO CALLER IF IT WAS CLEAR
	TXZ	F,F$CNW!F$CVV	; WAS SET. CLEAR IT
	TXO	F,F$CWW		; AND SET ^W^W LOCK FLAG
	POPJ	P,		; AND RETURN TO CALLER

; CNUAR - DOWNCASE CHAR IF IT IS @,[,\,],OR _
;
; CALL:	PUSHJ	P,CNUAR
;	(RETURN)

CNUAR:	CAIL	C,"["		; IS IT ONE OF @,[,\,],OR _ ?
	 CAILE	C,"_"		; . . . ?
	  CAIN	C,"@"		; . . . ?
	   TRO	C,40		; YES, DOWNCASE THE CHAR
	POPJ	P,		; AND RETURN TO CALLER
; CASE - PUT CHAR IN PROPER CASE (BASED ON FLAGS)
;
; CALL:	MOVEI	C,CHAR
;	PUSHJ	P,CASE
;	(RETURN)

CASE:	CAIL	C,"A"		; IS CHAR A LETTER?
	 CAILE	C,"Z"		; . . . ?
	CAIL	C,"A"+40	; . . . ?
	 CAILE	C,"Z"+40	; . . . ?
	  JRST	CASE1		; NO, CLEAR TEMPORARY CASE FLAGS

; SET THE LETTER TO THE PROPER CASING

	TXNE	F,F$DNC!F$CNV!F$CVV ; DOWNCASE CHAR?
	 TRO	C,40		; YES
	TXNE	F,F$UPC!F$CNW!F$CWW ; UPCASE CHAR?
	 TRZ	C,40		; YES

; CLEAR TEMPORARY CASE FLAGS

CASE1:	TXZ	F,F$CNW!F$CNV	; CLEAR TEMP CAPE FLAGS
	POPJ	P,		; AND RETURN TO CALLER
; GETINC - GET CHAR FROM ADR SPECIFIED IN T4 AND INCREMENT T4
;
; CALL:	MOVEI	T4,CHAR.ADR
;	PUSHJ	P,GETINC
;	(RETURN)		; WITH CHAR IN AC C AND T4 INCREMENTED
;
; MODIFIES AC T4, SMASHES AC C

GETINC:	AOS	T1,T4		; GET ADR INTO T1,INCR T4
	SOJA	T1,GET		; DECR T1, CALL GET

; GET - FETCH CHAR AT SPECIFIED ADR FROM TEXT BUFFER
;
; CALL:	MOVEI	T1,CHAR.ADR
;	PUSHJ	P,GET	
;	(RETURN)		; WITH CHAR IN AC C
;
; SMASHES ACS T1,T2,C

GET:	IDIVI	T1,5		; COMPUTE WORD ADR
	ADD	T1,TXTBUF	; . . .
	MOVEI	T1,T$DATA(T1)	; (OVERHEAD WORDS IN BEG OF BUFFER)
	HLL	T1,CBPTBL(T2)	; MAKE INTO A BYTE POINTER
	LDB	C,T1		; AND FETCH CHAR AT SPECIFIED ADR
	POPJ	P,		; AND RETURN TO CALLER
; INSCHR - INSERT A CHARACTER INTO BUFFER AT "."
;
; CALL:	MOVEI	C,CHAR
;	PUSHJ	P,INSCHR
;	(RETURN)

INSCHR:	MOVEI	T1,1		; WILL MAKE ROOM FOR ONE CHAR
	PUSHJ	P,MKROOM	; . . .
	AOS	T1,PTVAL	; ".":="."+1
	SOJA	T1,PUT		; PUT CHAR AT "."-1

; PUT - PUT CHAR IN BUFFER AT SPECIFIED ADDRESS
;
; CALL:	MOVEI	T1,CHAR.ADR
;	MOVEI	C,CHAR
;	PUSHJ	P,PUT
;	(RETURN)
;
; SMASHES ACS T1,T2

PUT:	IDIVI	T1,5		; COMPUTE WORD ADDRESS
	ADD	T1,TXTBUF	; . . .
	MOVEI	T1,T$DATA(T1)	; (OVERHEAD WORDS AT BEG OF BUFFER)
	HLL	T1,CBPTBL(T2)	; MAKE INTO A BYTE POINTER
	DPB	C,T1		; AND PUT CHAR IN BUFFER
	POPJ	P,		; RETURN TO CALLER
	SUBTTL	SETFSP - Fill in Defaults for a File Spec

; SETFSP - Store a File Spec in LFSPC
; USES WHAT IS ALREADY IN LFSPC AS DEFAULTS
;
; CALL:	MOVEI	PC,FILSPC
;	PUSHJ	P,SETFSP
;	(RETURN)
;
; SMASHES ACS X,T1-T3

SETFSP:	MOVE	T1,FS$FLG(PC)	; FETCH FILE SPEC FLAGS
	TXNE	T1,FB$$IO	; ANY I/O SWITCHES?
	 MOVEM	T1,FS$FLG(L)	; YES, USE THEM INSTEAD OF PREVIOUS SWITCHES

	MOVE	X,FS$DEV(PC)	; FETCH THE DEVICE NAME
	TXNE	T1,FB$DEV	; FILE SPEC HAVE A DEVICE?
	 MOVEM	X,FS$DEV(L)	; YES, STORE IT

	MOVE	X,FS$NAM(PC)	; FETCH THE FILE NAME
	TXNE	T1,FB$NAM	; FILE SPEC HAVE A FILE NAME?
	 MOVEM	X,FS$NAM(L)	; YES, STORE IT

	MOVE	X,FS$EXT(PC)	; FETCH FILE EXTENSION
	TXNE	T1,FB$EXT	; FILE SPEC HAVE AN EXTENTION?
	 MOVEM	X,FS$EXT(L)	; YES, STORE IT

;[14000]MOVE	X,[%LDSTP]	; FETCH DEFAULT PROTECTION
;[14000]GETTAB	X,		; . . .
;[14000] MOVX	X,<055B8>	; (IN CASE GETTAB FAILS)
	SETZ	X,		;[14000] Let system do the defaulting
	TXNE	T1,FB$PRV	; /PROTECT:NNN SPECIFIED?
	 MOVE	X,FS$PRV(PC)	; YES, FETCH THE PROTECTION CODE
	MOVEM	X,FS$PRV(L)	; AND STORE IT

	TXNN	T1,FB$DDR	; DEFAULT DIRECTORY SPECIFIED?
	 JRST	SETFS1		; NO
;	SETZM	FS$PPN(L)	; YES, SET DEFAULT DIRECTORY
	PUSHJ	P,GETPTH	;[342] FETCH MY PATH
	MOVEM	X,FS$PPN(L)	;[342] SET DEFAULT DIRECTORY
;[3000]	JRST	SETFS3		; AND RETURN TO CALLER
	MOVE	T2,[-C$SFDL,,PATHB+3] ;[3000] COPY SFD IF THAT IS THE DEFAULT
	JRST	SETF1X		;[3000] JUMP INTO SFD CODE

SETFS1:
	TXNN	T1,FB$PTH	; PATH SPECIFIED?
	 JRST	SETFS3		; NO, RETURN TO CALLER
	GETPPN	X,		; YES, MAKE SURE PPN STORED
	 JFCL			; (IN CASE OF JACCT)
	MOVEM	X,FS$PPN(L)	;[421] INITIALIZE DEFAULT
	MOVE	X,FS$PPN(PC)	; FETCH PPN FROM FILE SPEC
	TXNE	T1,FB$PRJ	; PROJECT # SPECIFIED IN FILE SPEC?
	 HLLM	X,FS$PPN(L)	; YES, STORE IT
	TXNE	T1,FB$PRG	; PROGRAMMER # SPECIFIED IN FILE SPEC?
	 HRRM	X,FS$PPN(L)	; YES, STORE IT
IFN C$SFDL,<
;[4000]	TXNN T1,FB$SFD	; SFDS IN FILE SPEC?
;[4000]	 JRST	SETFS3		; NO, RETURN TO CALLER
	MOVE	T2,[XWD -C$SFDL,FS$SFD] ;[425] SETUP AOBJN LOOP COUNTER
	ADDI	T2,(PC)		; MAKE IT POINT TO FIRST SFD
SETF1X:				;[3000] LABEL ADDED TO MAKE SFD'S WIN
	MOVEI	T3,FS$SFD(L)	; FETCH ADR OF WHERE TO STORE SFDS

SETFS2:	MOVE	X,(T2)		;[3000] FETCH SFD FROM FILE SPEC 
				;[3000] DON'T SKIP IF NONE
	 MOVEM	X,(T3)		; STORE THE SFD
	MOVEI	T3,1(T3)	; POINT TO NEXT SFD IN STORED FILE SPEC
	AOBJN	T2,SETFS2	; AND LOOP FOR ALL SFDS
>;; END IFN C$SFDL

SETFS3:	MOVEI	PC,FS$LTH(PC)	; SKIP OVER THE FILE SPEC
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	SETRAD - Set the Adr of Read-a-Char Routine
; SETRAD - SET ADR OF THE READ-A-CHAR ROUTINE
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,SETRAD
;	(RETURN)
;
; SAMSHES ACS X,T1

SETRAD:	MOVE	T1,FS$FLG(L)	; FETCH FILE-SPEC FLAGS
	MOVEM	T1,APDFLG	; AND SAVE FOR LATER USE
	TXZ	F,F$LSN		; CLEAR THE "FILE IS LINE-SEQ." FLAG

	TXNN	T1,FB$SUP	; /SUPLSN?
	 TXNN	T1,FB$ASC!FB$SIX!FB$OCT ; OR UNSPEC. ASCII?
	  JRST	SETR1		; YES, CHECK INPUT FILE FOR LSNS

	MOVE	X,[<ASCAPD,,7>]	; FETCH ADR OF ASCII ROUTINE AND BYTE SIZE
	TXNE	T1,FB$SIX	; /SIXBIT?
	 MOVE	X,[<SIXAPD,,6>]	; ADR OF SIXBIT ROUTINE AND BYTE SIZE
	TXNE	T1,FB$OCT	; /OCTAL?
	 MOVE	X,[<OCTAPD,,3>]	; ADR OF OCTAL ROUTINE AND BYTE SIZE
	HLRZM	X,APDADR	; SAVE ADR OF GET-A-CHAR ROUTINE
	DPB	X,[POINT 6,INPBH+1,11] ; SET BYTE SIZE IN BUFFER HEADER
	POPJ	P,		; AND RETURN TO CALLER

; CHECK INPUT FILE FOR LSN'S

SETR1:	INPUT	INP,		; INPUT THE FIRST BLOCK
	MOVE	T1,INPBH+1	; FETCH ADR OF BUFFER
	MOVE	X,1(T1)		; FETCH FIRST WORD OF FILE
	IOR	X,2(T1)		; AND THE SECOND WORD ALSO
	MOVEI	T1,ASCAPD	; PROBABLY NORMAL ASCII
	TRNN	X,1B35		; IS IT LINE-SEQUENCE-NUMBERED?
	  JRST	SETR2		; NO
	MOVE	T2,FS$FLG(L)	; YES. FETCH I/O SWITCH FLAGS
	TXNN	T2,FB$SUP	; /SUPLSN?
	 TXO	F,F$LSN		; NO, REMEMBER THAT FILE HAS LINE-SEQ#S
	TXNE	T2,FB$SUP	; /SUPLSN?
	 MOVEI	T1,SUPAPD	; YES, FETCH ADR OF LSN ROUTINE
SETR2:	MOVEM	T1,APDADR	; STORE ADR OF GET-A-CHAR ROUTINE
	MOVEI	X,7		; FETCH ASCII BYTE SIZE
	DPB	X,[POINT 6,INPBH+1,11] ; AND STORE IN BUFFER HEADER
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	SETWAD - Set Adr of Punch-a-Char Routine

; SETWAD - SET ADR OF WRITE-A-CHAR ROUTINE
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,SETWAD
;	(RETURN)
;
; SMASHES ACS X,T1

SETWAD:	MOVE	T1,FS$FLG(L)	; FETCH FILE-SPEC FLAGS
	MOVEM	T1,PCHFLG	; AND SAVE FOR LATER

	MOVE	X,[<ASCPCH,,7>]	; FETCH ADR ASCII ROUTINE AND BYTE SIZE
	TXNE	F,F$LSN		; IS INPUT FILE LINE-NUMBERED?
	 HRLI	X,LSNPCH	; YES, PASS NUMBERS TO OUTPUT
	TXNE	T1,FB$GEN	; /GENLSN?
	 HRLI	X,GENPCH	; YES, FETCH ADR OF GENLSN ROUTINE
	TXNE	T1,FB$ASC	; /ASCII?
	 HRLI	X,ASCPCH	; YES, FETCH ADR OF ASCII ROUTINE
	TXNE	T1,FB$SIX	; /SIXBIT?
	 MOVE	X,[<SIXPCH,,6>]	; YES, FETCH ADR OF SIXBIT ROUTINE
	TXNE	T1,FB$OCT	; /OCTAL?
	 MOVE	X,[<OCTPCH,,3>]	; YES, FETCH ADR OF OCTQL ROUTINE
	HLRZM	X,PCHADR	; AND SAVE ADR OF WHATEVER ROUTINE
	DPB	X,[POINT 6,OUTBH+1,11] ; SET BYTE SIZE IN BUFFER HEADER

	MOVE	X,["00000"B34]	; INIT THE LSN COUNTER
	MOVEM	X,LSNCTR	; . . .
	SETZM	LSNCT1		; . . .
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	PUNBUF - Punch part of Input File

; PUNBUF - PUNCH AN ARBITRARY # BUFFERS OF INPUT FILE
;
; CALL:	MOVEI	ARG,N		; # BUFFERS TO PUNCH (INCLUDING CURRENT)
;	PUSHJ	P,PUNBUF
;	(RETURN)
;
; SMASHES ACS X,T1-T4

PUNBUF:	JUMPLE	ARG,CPOPJ	; DO NOTHING IF ARG.LE.0
	SETZM	PTVAL		;[12000] to prevent ?XTCPOP...

PUNB1:	SETZ	T4,		; T4:=LOWER BOUND (IE: B)
	MOVE	T5,@TXTBUF	; T5:=UPPER BOUND (IE: Z)
	PUSHJ	P,PUNCH		; PUNCH OUT THE ENTIRE PAGE
	MOVEI	C,.CHFFD	; IN CASE FORM FEED NEEDED
	TXNE	F,F$FFD		; WAS FORM.FEED SEEN ON INPUT?
	 PUSHJ	P,@PCHADR	; YES, PUNCH A FORM.FEED
	SETZM	@TXTBUF		; CLEAR CHAR COUNT FOR BUFFER
	TXNN	F,F$EOF		; END OF FILE?
	 TXNN	F,F$URD		; OR NOT READING A FILE?
	  POPJ	P,		; YES, RETURN TO CALLER NOW
	PUSHJ	P,YANK		; YANK A NEW BUFFER
	SOJG	ARG,PUNB1	; KEEP PUNCHING PAGES TILL ARG RUNS OUT
	POPJ	P,		; ARG RAN OUT. RETURN TO CALLER
	SUBTTL	PUNCH - Punch part of Text Buffer

; PUNCH - PUNCH OUT PART OF TEXT BUFFER
;
; CALL:	MOVEI	T4,LBOUND	; LOWER BOUND CHAR.ADR
;	MOVEI	T5,UBOUND	; UPPER BOUND CHAR.ADR
;	PUSHJ	P,PUNCH
;	(RETURN)
;
; SMASHES ACS T1,T2,T3. USES ACS T4,T5

PUNCH:	TXO	F,F$STB		; FLAG THAT WE'RE AT BEG OF BUFFER
	SETZM	LSNCT1		; CLEAR BYTE COUNTER FOR LSNS
	MOVE	T3,T5		; T3:=LOWER BOUND
	SUB	T3,T4		; T3:=# CHARS TO PUNCH
	JUMPE	T3,CPOPJ	; NONE TO PUNCH. RETURN TO CALLER
	TXNN	F,F$UWR		; ANY FILE FOR OUTPUT?
	 ERROR	(NFO)		; NO, ** NO FILE FOR OUTPUT **
	MOVE	T1,T4		; FETCH LOWER BOUND
	IDIVI	T1,5		; AND FORM A BYTE POINTER THAT WILL
	HLL	T1,CBPTBL-1(T2)	; BE INCREMENTED BEFORE USE
	ADD	T1,TXTBUF	; MAKE BP ABSOLUTE TO TEXT BUFFER
	ADDI	T1,T$DATA	; SKIP OVER OVERHEAD WORDS OF BUFFER

; MAIN PUNCH LOOP

PUNCH1:	ILDB	C,T1		; FETCH NEXT CHAR FROM TEXT BUFFER
	PUSHJ	P,@PCHADR	; AND PUNCH IT OUT
	SOJG	T3,PUNCH1	; AND TRY FOR ANOTHER CHAR
	TXZ	F,F$STB		; CLEAR TEMP FLAG TO MAKE "YANK" HAPPY
	POPJ	P,		; ALL DONE. RETURN TO CALLER
	SUBTTL	ASCPCH - Punch an ASCII Character

; ASCPCH - PUNCH AN ASCII CHAR

ASCPCH:	SOSGE	OUTBH+2		; ROOM IN OUTPUT BUFFER?
	 JRST	ASCP1		; NO
	IDPB	C,OUTBH+1	; YES, STORE CHAR IN OUTPUT BUFFER
	POPJ	P,		; AND RETURN TO CALLER

; ASK MONITOR FOR A NEW OUTPUT BUFFER

ASCP1:	OUT	OUT,		; ASK MONITOR FOR NEXT BUFFER
	 JRST	ASCPCH		; AND CONTINUE

; OUTERR - OUTPUT ERROR OCCURRED

OUTERR:	GETSTS	OUT,IOSTS	; GET I/O STATUS FOR OUTPUT CHANNELL
	ERROR	(OUT)		; AND GIVE AN ERROR MESSAGE
	SUBTTL	SIXPCH - Punch a SIXBIT ASCII Character

; SIXPCH - PUNCH A SIXBIT CHARACTER AFTER CONVERTING FROM ASCII

SIXPCH:	SOSGE	OUTBH+2		; ROOM IN OUTPUT BUFFER?
	 JRST	SIXP1		; NO
	MOVEI	X,'A'-"A"(C)	; CONVERT ASCII TO SIXBIT
	IDPB	X,OUTBH+1	;[360] AND STORE IN OUTPUT BUFFER
	POPJ	P,		; AND RETURN TO CALLER

; ASK MONITOR FOR A NEW OUTPUT BUFFER

SIXP1:	OUT	OUT,		; ASK MONITOR FOR A NEW OUTPUT BUFFER
	 JRST	SIXPCH	; GOT IT. CONTINUE
	JRST	OUTERR		; FAILED! (SOME RANDOM ERROR)
	SUBTTL	OCTPCH - Punch an Octal Digit

; OCTPCH - PUNCH AN OCTAL DIGIT AFTER CONVERTING FROM ASCII

OCTPCH:	SOSGE	OUTBH+2		; ROOM IN OUTPUT BUFFER?
	 JRST	OCTP1		; NO
	MOVEI	C,-"0"(C)	; CONVERT CHAR TO OCTAL
	IDPB	C,OUTBH+1	; AND STORE IN OUTPUT BUFFER
	POPJ	P,		; AND RETURN TO CALLER

; ASK MONITOR FOR A NEW OUTPUT BUFFER

OCTP1:	OUT	OUT,		; ASK MONITOR FOR A NEW OUTPUT BUFFER
	 JRST	OCTPCH		; GOT IT. CONTINUE
	JRST	OUTERR		; FAILED! (SOME RANDOM ERROR)
	SUBTTL	LSNPCH - Punch a Char and Turn on Bit35 for LSNS

; LSNPCH - PUNCH A CHAR AND TURN ON BIT35 FOR LSNS

LSNPCH:	TXZN	F,F$STB		; AT BEGINNING OF BUFFER?
	 SKIPE	LSNCT1		; IN AN LSN?
	  JRST	LSNP1		; YES

	PUSHJ	P,CHKEOL	; NO, IS CHAR END-OF-LINE?
	 JRST	ASCPCH		; NO, JUST PUNCH IT
	MOVEI	X,5		; YES, SET THE LSN FLAG
	MOVEM	X,LSNCT1	; . . .
	MOVE	X,["00000"B34]	; AND GET READY TO JUSTIFY LSN
	MOVEM	X,LSNCTR	; . . .
	PJRST	ASCPCH		; AND PUNCH TO <EOL> CHAR

; ADD LEADING ZEROS TO AN EXISTING LSN BEFORE PUNCHING IT

LSNP1:	SOSGE	LSNCT1		; DONE WITH LSN?
	 JRST	LSNP2		; NO, HAVEN'T BEGUN IT YET
	CAIG	C,"9"		; IS CHAR A DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  JRST	LSNP5		; NO, PUNCH THE LSN NOW

	MOVE	X,LSNCTR	; NO, FETCH WHAT WE HAVE ALREADY
	LSH	X,7		; SHIFT IT ONE CHAR
	DPB	C,[POINT 7,X,34] ; AND PUT NEXT DIGIT IN
	MOVEM	X,LSNCTR	; AND SAVE AGAIN
	SKIPN	LSNCT1		; IS THE LSN DONE?
	 JRST	LSNP4		; YES
	POPJ	P,		; NO, RETURN TO CALLER

; INIT LSN COUNTER WHEN AT BEGINNING OF BUFFER

LSNP2:	MOVEI	X,5		; INIT THE DIGIT COUNTER
	MOVEM	X,LSNCT1	; . . .
	MOVE	X,["00000"B34]	; INIT THE LSN
	MOVEM	X,LSNCTR	; . . .
	JRST	LSNP1		; AND PLACE FIRST DIGIT IN LSN
; NOW PUNCH THE LSN

LSNP4:	SETZM	LSNCT1		; CLEAR THE DIGIT COUNTER
	MOVE	X,OUTBH+2	; FETCH BYTE COUNT
	SUBI	X,5		; ACCOUNT FOR LSN
	JUMPG	X,.+2		; SKIP IF ROOM FOR LSN
	 OUTPUT	OUT,		; MAKE ROOM FOR THE LSN
	SKIPN	OUTBH+2		; WAS IT A DUMMY OUTPUT?
	 OUTPUT	OUT,		; YES, DO A REAL OUTPUT
	AOS	X,OUTBH+1	; POINT TO NEXT WORD
	MOVE	N,LSNCTR	; FETCH THE LSN
	IORI	N,1		; TURN ON THE LSN BIT (BIT35)
	MOVEM	N,(X)		; AND PUNCH THE LSN
	LDB	N,[POINT 6,OUTBH+1,5] ; FETCH # BITS LEFT IN WORD
	IDIVI	N,7		; CONVERT TO CHARACTERS
	MOVEI	N,5(N)		; ACCOUNT FOR 5 CHARS OF LSN
				; PLUS NULLS TO PAD WORD
	MOVNI	N,(N)		; . . .
	ADDM	N,OUTBH+2	; . . .
	MOVEI	X,(POINT 7,,34) ; FIX BYTE POINTER TO NEXT WORD
	HRLM	X,OUTBH+1	; . . .
	POPJ	P,		; AND RETURN TO CALLER

; PUNCH LSN AND THE CHAR AFTER IT

LSNP5:	PUSH	P,C		; SAVE THE CHAR
	PUSHJ	P,LSNP4		; PUNCH THE LSN
	POP	P,C		; RESTORE THE CHAR
	PJRST	ASCPCH		; AND PUNCH IT AND RETURN TO CALLER
	SUBTTL	GENPCH - Punch a Char and Generate LSNS

; GENPCH - PUNCH A CHAR GENERATING AN LSN FOR EACH LINE

GENPCH:	SKIPN	LSNCT1		; NEED AN LSN?
	 JRST	GENP1		; YES

	PUSHJ	P,CHKEOL	; NO, IS THIS CHAR AN END-OF-LINE?
	 PJRST	ASCPCH		; NO, JUST PUNCH IT AND RETURN
	SETZM	LSNCT1		; YES, FLAG THAT WE NEED AN LSN SOON
	PJRST	ASCPCH		; AND PUNCH THE END-OF-LINE CHAR

; GENERATE AN LSN FOR CURRENT LINE

GENP1:	PUSH	P,C		; SAVE THE CURRENT OUTPUT CHAR
	MOVE	X,OUTBH+2	; IS THERE ROOM FOR THE LSN IN BUFFER?
	SUBI	X,12		; . . . ?
	JUMPG	X,.+2		; SKIP IF ROOM
	 OUTPUT	OUT,		; MAKE ROOM

; PAD OUT CURRENT WORD WITH NULLS

GENP2:	LDB	X,[POINT 6,OUTBH+1,5] ; FETCH CURRENT BYTE POSITION
	CAIG	X,1		; AT END OF WORD?
	 JRST	GENP3		; YES, READY FOR LSN
	IBP	OUTBH+1		; NO, PAD WITH ANOTHER NULL
	SOS	OUTBH+2		; DECREMENT BYTE COUNT
	JRST	GENP2		; AND TRY AGAIN
; GENERATE A NEW LSN (OLD+10) AND STORE IN OUTPUT BUFFER

GENP3:	MOVE	X,LSNCTR	; FETCH OLD LSN

; ***** FOLLOWING CODE WORKS BY MAGIC (FROM DEC TECO) *****

	ADD	X,[BYTE(7)106,106,106,107]
	MOVE	N,X
	AND	N,[BYTE(7)60,60,60,60]
	LSH	N,-3
	MOVE	T2,X
	AND	T2,[BYTE(7)160,160,160,160]
	IOR	N,T2
	SUB	X,N
	ADD	X,[BYTE(7)60,60,60,60]

; ***** END OF MAGIC CODE *****

	MOVEM	X,LSNCTR	; STORE NEW LSN FOR LATER USE
	AOS	OUTBH+1		; POINT TO NEXT WORD OF OUTPUT BUFFER
	IORI	X,1B35		; SET THE LSN BIT IN LSN
	MOVEM	X,@OUTBH+1	; STORE THE LSN IN OUTPUT BUFFER
	MOVNI	X,5		; ACCOUNT FOR THE 5 CHARS OF LSN
	ADDM	X,OUTBH+2	; . . .
	SETOM	LSNCT1		; FLAG THAT LSN IS DONE
	MOVEI	C,.CHTAB	; AND PUNCH A <TAB> AFTER THE LSN
	PUSHJ	P,ASCPCH	; . . .
	POP	P,C		; RESTORE THE LAST OUTPUT CHAR
	PJRST	ASCPCH		; AND RETURN TO CALLER
	SUBTTL	BAKCLS - Finish "EB" that is in Progress

; BAKCLS - FINISH "EB" THAT IS IN PROGRESS
;
; 1) DELETE .BAK FILE
; 2) RENAME ORIGINAL FILE TO .BAK
; 3) RENAME .TMP FILE TO ORIGINAL NAME
;
; CALL:	PUSHJ	P,BAKCLS
;	(RETURN)
;
; SMASHES ACS X,T1-T2

BAKCLS:

; DELETE .BAK FILE

	MOVE	X,[<LEBSPC,,FILSPC>] ; FETCH BLT POINTER
	BLT	X,FILSPC+FS$LTH-1 ; COPY ORIGINAL FILE-SPEC
	MOVSI	X,'BAK'		; AND CHANGE FILE EXTENSION
	MOVEM	X,FILSPC+FS$EXT	; TO .BAK

	MOVE	N,[Z INP,]	; FETCH INPUT I/O CHANNEL
	MOVEI	M,INPBH		; FETCH ADR OF INPUT BUFFER HEADER
	MOVEI	L,FILSPC	; FETCH ADR OF BACKUP FILE SPEC
	PUSHJ	P,FILOPN	; AND OPEN THE INPUT DEVICE
	 ERROR	(IRN)		; CAN'T. ** INPUT FAILURE FOR RENAME **
	PUSHJ	P,FILLKP	; LOOKUP THE .BAK FILE
	 JRST	BAKCL2		; NONE THERE (SAVES US THE TROUBLE OF DELETING IT)
	PUSHJ	P,GETPTH	;[342] GET MY DEFAULT PATH
	MOVE	T1,RBSPC+.RBPPN	;[342] GET PPN
	TXNN	T1,LH.ALF	;[342] AN ADDRESS?
	 MOVE	T1,2(T1)	;[342] YES, GET PPN [4000] FOR REAL
	CAME	X,T1		;[342] COMPARE WITH LOOKUP'ED PPN
	 JRST	BAKCL2		;[341] IT'S ON LIB: PROBABLY

; SAVE PROTECTION OF ORIGINAL .BAK FILE FOR NEW .BAK FILE

	LDB	X,[POINT 9,RBSPC+.RBPRV,8] ; FETCH .BAK PROTECTION
	DPB	X,[POINT 9,FILSPC+FS$PRV,8] ; AND STORE FOR NEW .BAK FILE

	SETZ	T1,		; DELETE THE .BAK FILE
	RENAME	INP,T1		; . . .
	 ERROR	(BAK)		; CAN'T . ** CAN'T DELETE .BAK FILE **

; RENAME ORIGINAL FILE TO .BAK

BAKCL2:	MOVSI	N,(Z INP,)	; FETCH INPUT CHANNEL
	MOVEI	L,LEBSPC	; FETCH ADR OF ORIGINAL FILE-SPEC
	PUSHJ	P,FILLKP	; AND LOOK IT UP
	 ERROR	(ILR)		; CAN'T. ** LOOKUP FAILURE FOR INPUT FILE **
; SEE IF ORIGINAL FILE IS PROTECTED <2??>

	LDB	X,[POINT 9,RBSPC+.RBPRV,8] ; FETCH ORIGINAL FILE PROT
	CAIGE	X,<200>		; PROTECTED <2??>?
	 JRST	BAKCL3		; NO, MAKES THINGS EASIER

;  ORIGINAL FILE IS PROTECTED <2??>
; RENAME IT TO <1??> SO THAT WE CAN RENAME IT

	XORI	X,<300>		; CHANGE PROTECTION TO <1??>
	PUSH	P,LEBSPC+FS$PRV	; SAVE ORIGINAL PROTECTION
	DPB	X,[POINT 9,LEBSPC+FS$PRV,8] ; SET THE <1??> PROTECTION
	PUSHJ	P,FILRNM	; AND RENAME THE ORIGINAL FILE TO NEW PROT.
	 ERROR	(IRB)		; CAN'T RENAME IT !?!
	POP	P,LEBSPC+FS$PRV	; RENAMED IT. RESTORE ORIGINAL PROTECTION

; NOW REANME THE ORIGINAL FILE TO .BAK

BAKCL3:	MOVEI	L,FILSPC	; FETCH ADR OF .BAK FILE-SPEC

; PROTECTION OF .BAK FILE WILL BE <0NM> (IF WAS PROTECTED <LNM>
; THIS IS SO THAT .BAK FILES CAN BE EASILY DELETED

	MOVSI	X,(<700>B8)	; CLEAR THE OWNER FIELD IN PROTECTION CODE
	ANDCAM	X,FILSPC+FS$PRV	; . . .
	PUSHJ	P,FILRNM	; AND RENAME ORIGINAL TO .BAK
	 ERROR	(IRB)		; CAN'T. ** RENAME FAILURE FOR .BAK FILE **

; RENAME '###XTC.TMP' TO ORIGINAL FILE

	MOVSI	N,(Z OUT,)	; FETCH OUTPUT CHANNEL
	MOVEI	L,LEBSPC	; FETCH ADR OF ORIGINAL FILE-SPEC
	PUSHJ	P,FILRNM	; AND RENAME .TMP FILE TO ORIGINAL
	 ERROR	(RNO)		; CAN'T. ERROR

; DONE WITH "EB"

	TXZ	F,F$URD!F$UWR!F$UBK ; CLEAR I/O FLAGS
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	YANK and APPEND

; APPENL Append (ARG) lines to the buffer
APPENL:	TXO	F,F$EOL		;[16000] Remember it's linewise append
	JRST	APPEN0		;[16000] Jump into common APPEND code

; YANK - RENDER THE MAIN TEXT BUFFER EMPTY AND APPEND A NEW BUFFER
;
; CALL:	PUSHJ	P,YANK
;	(RETURN)

YANK:	SETZM	PTVAL		; ".":=B
	SETZM	@TXTBUF		; Z:=B MAKES THE BUFFER EMPTY
;	PJRST	APPEND		; APPEND A NEW BUFFER AND RETURN TO CALLER

; APPEND - READ INPUT CHARACTERS UNTIL:
;
; 1) A FORM.FEED CHARACTER IS ENCOUNTERED, OR
; 2) END.OF.FILE IS ENCOUNTERED, OR
; 3) BUFFER IS WITHIN FI/C$FILB FULL AND A LINE.FEED
;    CHARACTER IS ENCOUNTERED, OR
; 4) BUFFER IS WITHIN 128. CHARACTERS OF CAPACITY
;
; T1 HOLDS BYTE POINTER FOR STORING CHARS IN TEXT BUFFER
; T3 HOLDS # CHARS LEFT TILL BUFFER IS (C$FILB-1)/C$FILB FULL
; T4 HOLDS # CHARS LEFT TILL BUFFER IS WITHIN 128. CHARS OF FULL
; T5 HOLDS NEW Z (OLD PLUS #CHARS SEEN)
;
; SMASHES ACS X,T1-T5,C

APPEND:	TXZ	F,F$EOL		;[16000] Not stop on end-of-line
APPEN0:	TXZ	F,F$FFD		; CLEAR THE FORMFEED FLAG
	TXNN	F,F$URD		; IS A FILE OPEN FOR INPUT?
	 CERR1	(NFI)		; NO, ** NO FILE OPEN FOR INPUT **
; SETUP NEW Z

	MOVE	T5,@TXTBUF	; NEW Z:=OLD Z


; MAKE SURE THAT THERE IS ROOM FOR AT LEAST 3000. CHARACTERS IN BUFFER

	MOVE	T4,@TXTBUF	; FETCH Z
	EXCH	T4,PTVAL	; T4:=. , ".":=Z
	MOVEI	T1,^D3000	; FETCH 3000.
	ADD	T1,PTVAL	; T1:=3000.+Z
	SUB	T1,T4		; T1:=3000.+Z-"."
	PUSHJ	P,MKROOM	; MAKE ROOM FOR CHARS
	MOVEM	T4,PTVAL	; ".":="."
; COMPUTE # CHARS LEFT TILL BUFFER IS WITH 128. CHARS OF FULL

	MOVE	X,TXTBUF	; COMPUTE CAPACITY OF BUFFER
	HLRZ	T1,B$1PTR(X)	; . . .
	SUBI	T1,(X)		; . . .
	IMULI	T1,5		; CONVERT WORDS TO CHARS
	SUBI	T1,^D128	; MINUS 128. CHARS
	IDIVI	T1,^D12		; MAKE SURE A MULTIPLE OF 12.
	IMULI	T1,^D12		; . . .
	MOVE	T4,T1		; AND PUT IN AC T4
	SUB	T4,T5		; MINUS # CHARS ALREADY IN BUFFER

; COMPUTE # CHARS LEFT TILL BUFFER IS (C$FILB-1)/C$FILB FULL

	MOVE	T3,T4		; FETCH # CHARS WE CAN PUT IN BUFFER
	ADDI	T3,^D128	; COMPUTE BUFFER CAPACITY
	MOVE	T1,T3		; T1:=BUFFER CAPACITY
	IDIVI	T1,C$FILB	; COMPUTE 1/C$FILB OF BUFFER CAPACITY
	SUB	T3,T1		; COMPUTE # CHARS LEFT TILL BUFFER (C$FILB-1)/C$FILB FULL

; SETUP BYTE POINTER FOR STORING CHARS IN TEXT BUFFER

	MOVE	T1,T5		; FETCH Z
	ADDI	T1,5*T$DATA	; TO SKIP OVER OVERHEAD WORDS OF BUFFER
	IDIVI	T1,5		; AND FORM A BYTE POINTER THAT WILL
	HLL	T1,CBPTBL-1(T2)	; BE INCREMENTED BEFORE USE
	ADD	T1,TXTBUF	; MAKE BP ABSOLUTE

	SETZ	C,		; CLEAR THE CURRENT CHAR

; MAIN READ LOOP

APPND1:	TXNN	F,F$EOL		;[16000] Stop on end of line?
	 SOJGE	T3,@APDADR	; NEXT CHAR IF LOTS OF ROOM
	JUMPLE	T4,APPND2	; STOP IF WITHIN 128. CHARS OF FULL
	CAIE	C,.CHLFD	; WAS LAST CHAR A LINE.FEED?
	 JRST	@APDADR		; NO, FETCH NEXT CHAR
	TXNE	F,F$EOL		;[16000] Stop on end of line?
	 SOJG	ARG,APPND1	;[16000] Yes, decr count & maybe continue

; APPEND COMPLETE

APPND2:	MOVEM	T5,@TXTBUF	; STORE NEW VALUE OF "Z"
	POPJ	P,		; AND RETURN TO CALLER

; "IN" MUUO FAILED. SEE WHAT HAPPENED

APPND3:	STATO	INP,IO.EOF	; END OF FILE?
	 JRST	APPND4		; NO, SOME RANDOM I/O ERROR
	TXO	F,F$EOF		; YES, REMEMBER THAT
	JRST	APPND2		; AND FINISH UP

; INPUT ERROR

APPND4:	GETSTS	INP,IOSTS	; FETCH STATUS OF INPUT CHANNEL
	ERROR	(INP)		; AND GIVE ERROR MESSAGE
	SUBTTL	ASCAPD - Read an ASCII Char

; ASCAPD - FETCH NEXT ASCII INPUT CHAR AND STORE IN TEXT BUFFER

ASCAPD:	SOSGE	INPBH+2		; ANY MORE CHARS IN INPUT BUFFER?
	 JRST	ASCA1		; NO, FETCH NEW BUFFER FULL
	ILDB	C,INPBH+1	; YES, FETCH NEXT CHAR
	CAIN	C,.CHFFD	;; IS IT A FORM-FEED?
	 JRST	ASCA2		; YES
	JUMPE	C,ASCAPD	; NO, STORE CHAR IN TEXT BUFFER
	IDPB	C,T1		; STORE THE CHAR IN TEXT BUFFER
	AOJ	T5,		; Z:=Z+1
	SOJA	T4,APPND1	; AND TRY FOR NEXT CHAR

; INPUT NEW BUFFER

ASCA1:	IN	INP,		; ASK MONITOR FOR NEXT BUFFER
	 JRST	ASCAPD		; GOT IT. FETCH NEXT CHAR
	JRST	APPND3		; FAILED. FIND OUT WHY

; FORM-FEED CHAR ENCOUNTERED. FLAG IT AND STOP THE APPEND

ASCA2:	TXO	F,F$FFD		; FLAG THAT A <FF> SEEN
	AOS	PAGCNT		; INCREMENT PAGE COUNTER
	JRST	APPND2		; AND STOP THE APPEND
	SUBTTL	SUPARD - Read a Char and Suppress LSNS

; SUPAPD - IGNORE LSNS ON INPUT(/SUPLSN) AND STORE CHAR IN TEXT BUFFER

SUPAPD:	SOSGE	INPBH+2		; ANY MORE CHARS IN INPUT BUFFER?
	 JRST	SUPAP2		; NO, FETCH NEXT BUFFER
	ILDB	C,INPBH+1	; YES, FETCH NEXT CHAR
	JUMPE	C,SUPAPD	; IGNORING NULLS
	CAIN	C,.CHFFD	; IS CHAR A FORM-FEED?
	 JRST	ASCA2		; YES
	MOVE	X,@INPBH+1	; FETCH CURRENT INPUT WORD
	TRNN	X,1B35		; IS IT A LINE-SEQUENCE-NUMBER?
	 JRST	SUPAP1		; NO

; SUPPRESS LINE-SEQUENCE-NUMBERS AND THE FOLLOWING <TAB>

	AOS	INPBH+1		;[361] IGNORE THE LSN BY MOVING TO NEXT WORD
	MOVE	X,INPBH+2	; FETCH THE CHAR COUNT
	SUBI	X,5		;[361] AND SUBTRACT 5 CHARS
	MOVEM	X,INPBH+2	; . . .
	JRST	SUPAPD		; AND GO BACK FOR ANOTHER CHAR

; TAB EATEN BY MAGIC IN PREVIOUS ROUTINE.  HOW?
; THE BYTE POINTER POINTS TO THE SECOND BYTE IN THE WORD WHEN IT
; HITS THIS ROUTINE.  RATHER THAN RESET AND GOBBLE IT AGAIN, I
; LEAVE IT THAT WAY.  BECAUSE OF THIS, THE FIRST CHARACTER AFTER THE
; LSN, WHICH IS OF NECESSITY A <TAB>, IS TOTALLY IGNORED!
; THIS MAGIC WAS PART OF [361].

; STORE CHAR IN TEXT BUFFER

SUPAP1:	IDPB	C,T1		; STORE CHAR IN TEXT BUFFER
	AOJ	T5,		; Z:=Z+1
	SOJA	T4,APPND1	; AND GO BACK FOR ANOTHER CHAR

; INPUT NEXT BUFFER FROM MONITOR

SUPAP2:	IN	INP,		;ASK MONITOR FOR NEXT INPUT BUFFER
	 JRST	SUPAPD		; GOT IT
	JRST	APPND3		; FAILED. FIND OUT WHY
	SUBTTL	OCTAPD - Read an Octal Digit

; OCTAPD - FETCH NEXT OCTAL INPUT DIGIT AND STORE CHAR IN TEXT BUFFER

OCTAPD:	SOSGE	INPBH+2		; ANY MORE DIGITS IN INPUT BUFFER?
	 JRST	OCTA1		; NO, FETCH NEXT INPUT BUFFER
	ILDB	C,INPBH+1	; YES, FETCH NEXT OCTAL DIGIT
	MOVEI	C,"0"(C)	; AND CONVERT TO ASCII CHAR
	IDPB	C,T1		; AND STORE IN TEXT BUFFER
	AOJ	T5,		; Z:=Z+1
	SOJA	T4,APPND1	; AND TRY FOR NEXT CHAR

; INPUT NEW BUFFER AND GET READY FOR OCTAL PROCESSING

OCTA1:	IN	INP,		; ASK MONITOR FOR A NEW BUFFER
	 JRST	OCTAPD		; GOT IT. CONTINUE
	JRST	APPND3		; FAILED. FIND OUT WHY
	SUBTTL	SIXAPD - Read a SIXBIT ASCII Char
; SIXAPD - FETCH NEXT SIXBIT INPUT CHAR AND PUT IN TEXT BUFFER

SIXAPD:	SOSGE	INPBH+2		; ANY MORE CHARS IN INPUT BUFFER?
	 JRST	SIXA1		; NO, GET ANOTHER BUFFER
	ILDB	C,INPBH+1	; YES, FETCH NEXT CHAR
	MOVEI	C,"A"-'A'(C)	; AND CONVERT SIXBIT TO ASCII
	IDPB	C,T1		; STORE THE ASCII CHAR IN TEXT BUFFER
	AOJ	T5,		; Z:=Z+1
	SOJA	T4,APPND1	; AND GO BACK FOR MORE

; FETCH A NEW INPUT BUFFER

SIXA1:	IN	INP,		; ASK MONITOR FOR NEXT INPUT BUFFER
	 JRST	SIXAPD		; GOT IT. CONTINUE
	JRST	APPND3		; FAILED. FIND OUT WHY
	SUBTTL	MACRO - Compile and Execute a Macro
; MACRO - COMPILE AND EXECUTE A TEXT BUFFER
;
; CALL:	MOVE	L,[SIXBIT/Q-REG-NAME/]
;	MOVX	N,BID
;[12000] will compile if TB$CMP in buffer is off
;	TX?	F,F$CMP		; ?=O TO COMPILE, ?=Z TO SUPPRESS COMPILE
;	PUSHJ	P,MACRO
;	(RETURN)

MACRO:

; PUSH NAME,BID,REL.PC ON CONTROL PDL

	PUSH	P,MACNAM	; SAVE NAME OF CURRENT MACRO
	PUSH	P,MACBID	; SAVE BUFFER ID FOR CURRENT MACRO
	MOVEM	L,MACNAM	; STORE NEW MACRO NAME
	MOVEM	N,MACBID	; AND IT'S BUFFER ID
	SUB	PC,R		; COMPUTE RELATIVE PC
	PUSH	P,PC		; AND SAVE CURRENT RELATIVE PC
	MOVE	VALUE,ARG	;[14000] Pass argument to macro

; CLEAR AC AND MACBUF REFERENCES TO CURRENT MACRO TEXT BUFFER

	SKIPN	MACLVL		; IN A MACRO NOW?
	 JRST	MACRO1		; NO, NO REFS TO CLEAR
	MOVE	X,MACBUF	; YES, FETCH BASE ADR OF BUFFER
	HRRZS	T$1REF(X)	; UNBIND MACBUF FROM BUFFER
	SETZM	T$ACRF(X)	; UNBIND ACS FROM BUFFER

; FIND THE BUFFER FOR MACRO BUFFER ID

MACRO1:	MOVEI	L,MACBUF	; FETCH ADR OF BUFFER REF
	PUSHJ	P,FNDBLK	; FIND THE BUFFER FOR BID
	 ERROR	(BNF)		; CAN'T. ERROR
	MOVE	X,MACBUF	; FETCH ADR OF BUFFER
	AOS	T$RCNT(X)	; AND INCREMENT REFERENCE COUNT

; COMPILE BUFFER IF TB$CMP IS OFF

	MOVEI	L,MACBUF	; FETCH  ADR OF REF TO BUFFER
	PUSH	P,F		;[5000] DON'T LET FLAGS BE CLOBBERED BY COMPIL
	TXO	F,F$CMP		;[12000] It is now compile-time
	MOVE	T1,MACBUF	;[12000] Check COMPILED flag for buffer
	TXZ	F,F$COL		;[23000] Clear colon flag for COMPIL
	MOVE	T2,T$BIT(T1)	;[12000] Get buffer flags
	TXZN	F,F$2CO		;[23000] Clear :: too, but if it's on...
	 JUMPL	T2,MACRO2	;[12000] it is already compiled
MACROY:	TXNE	T2,TB$BUF	;[12000] if it is the text buffer...
	 ERROR (XTB)		;[12000] then it should NOT be compiled
	PUSH	P,SARGSV	;[14000] Save argument to macro
	PUSH	P,ARG		;[23000] Save other argument
	PUSHJ	P,COMPIL	; YES
	POP	P,VALUE		;[23000] Pass value to macro
	POP	P,SARGSV	;[14000] Restore SARG
	MOVE	T1,MACBUF	;[12000] now set that bit
	MOVX	T2,TB$CMP	;[12000]
	IORM	T2,T$BIT(T1)	;[12000] in the buffer hdr
MACRO2:	POP	P,F		;[5000] RESTORE FLAGS
	TXZ	F,F$CMP!F$COL	;[4000] SO ERRORS WILL BE KNOWN TO BE
				;[4000] EXECUTION TIME ERRORS
	AOS	MACLVL		; COUNT THE NESTING OF MACROS

; EXECUTE THE COMPILED BUFFER

	MOVEI	L,MACBUF	; FETCH ADR OF REF TO BUFFER
	TXZN	F,F$2CO		;[14000] ::M compile but do not execute
	 PUSHJ	P,EXECUT	; AND EXECUTE THE BUFFER
; POP INFO ABOUT PREVIOUS MACRO OFF CONTROL PDL

	TXZ	F,F$2CO!F$COL	;[23000] Don't leave colons on
	POP	P,PC		; RESTORE RELATIVE RETURN PC
	POP	P,N		; RESTORE BUFFER ID
	POP	P,MACNAM	; RESTORE NAME OF PREVIOUS MACRO

; RELEASE CURRENT BUFFER

	EXCH	N,MACBID	; STORE PREVIOUS MACRO BUFFER ID
				; AND FETCH CURRENT ONE INTO AC N
	PUSHJ	P,DELBLK	; AND DELETE THE CURRENT MACRO REF

; RESTORE PREVIOUS MACRO

	SOSN	MACLVL		; DECREMENT THE MACRO NESTING COUNT
	 POPJ	P,		; AND RETURN TO CALLER IF NO LONGER IN A MACRO

	MOVE	N,MACBID	; FETCH BUFFER ID FOR PREVIOUS MACRO
	MOVEI	L,MACBUF	; FETCH ADR OF BUFFER REFERENCE
	PUSHJ	P,FNDBLK	; AND FIND THE PREVIOUS MACRO BUFFER
	 ERROR	(XXX)		; CAN'T. SHOULDN'T OCCUR!

	MOVE	R,MACBUF	; FETCH ADR OF BUFFER
	ADDI	PC,(R)		; MAKE PC ABSOLUTE
	MOVE	X,[<PC,,R>] 	; FETCH AC REFERENCES
	MOVEM	X,T$ACRF(R)	; AND BIND AC REFS TO BUFFER
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	OPENRD - Select a File for Input

; OPENRD - SELECT A FILE FOR INPUT
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,OPENRD
;	(RETURN)
;
; SMASHES ACS N,M. USES AC L

OPENRD:	SETZM	PAGCNT		; CLEAR THE PAGE COUNTER
	TXZ	F,F$URD!F$EOF!F$FFD ; CLEAR SOME FLAGS
	MOVSI	N,(<Z INP,0>)	; CHANNEL FOR FILOPN
	MOVEI	M,INPBH		; INPUT BUFFER HEADER FOR FILOPN
	PUSHJ	P,FILOPN	; OPEN DEVICE FOR INPUT
	 CERR1	(IDV)		; INPUT DEVICE OPEN FAILURE
	PUSHJ	P,FILLKP	; LOOKUP THE FILE
	 CERR1	(FNF)		; FILE NOT FOUND
	TXO	F,F$URD		; NOW READING FROM A FILE
	POPJ	P,		; RETURN TO CALLER
	SUBTTL	OPENWR - Select a File for Output

; OPENWR - SELECT A FILE FOR OUTPUT
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,OPENWR
;	(RETURN)
;
; SMASHES ACS M,N. USES AC L

OPENWR:	TXZ	F,F$UWR		; CLEAR SOME FLAGS
	MOVSI	N,(<Z OUT,0>)	; CHANNEL FOR FILOPN
	MOVE	M,[<OUTBH,,INIBH>] ; BUFFER HEADERS FOR OUTPUT CHANNEL
				; (INIBH 'CAUSE WE LOOKUP A FILE)
	PUSHJ	P,FILOPN	; OPEN DEVICE FOR OUTPUT
	 CERR1	(ODV)		; OUTPUT DEVICE OPEN FAILURE

; SEE IF THE FILE ALREADY EXISTS (IE: ARE WE SUPERCEDING IT?)

	JUMPL	L,OPENW0	;[20000] /SUPERCEDE was given so don't care
	SKIPN	X,FS$PPN(L)	;[404] IS PPN [-] ?
	 PUSHJ	P,GETPTH	;[404] YES, GET PATH(NO WANT 0!)
	MOVEM	X,FS$PPN(L)	;[404] SAVE UPDATED PPN SPEC
	PUSH	P,FS$PPN(L)	;[365] THE PPN WILL GET CLOBBERED BY OTHERS
	PUSHJ	P,FILLKP	; SEE IF THE FILE IS THERE
	 TDZA	T5,T5		; NO, FLAG THAT IT DOESN'T EXIST
	MOVE	T5,FS$PPN(L)	;[376] FILE IS THERE. FETCH ITS REAL PPN
	POP	P,FS$PPN(L)	;[365] THE ONE HE(SHE?) WANTED, NOT OTHERS

; DO THE REAL ENTER

OPENW0:	MOVE	X,FS$DEV(L)	; FETCH THE DEVICE NAME
	DEVCHR	X,		; AND GET ITS CHARACTERISTICS
	TXNN	X,DV.MTA	;[414] NUL: CAN BE MTA AND DIR.(!)
	 TXNN	X,DV.DIR	; IS IT A DIRECTORY DEVICE?
	  SETZ	T5,		;[413] NO, FLAG AS ZERO
	CLOSE	OUT,		; CLOSE THE OUTPUT CHANNEL
	SETZ	M,		;[15000] Don't know size now
	PUSHJ	P,FILENT	; DO THE ENTER
	 CERR1	(ENT)		; ** ENTER UUO FAILURE **

; SEE IF WE ARE SUPERCEDING THE FILE

	JUMPE	T5,.+3		;[376] NOT SUPERCEDING IF FLAG 0
	CAMN	T5,FS$PPN(L)	;[376] DOES FILE "REALLY" EXIST?
	 WARN	(SEF)		; YES, GIVE MSG ABOUT SUPERCEDE

; DONE. FLAG THAT "EW" IN OPERATION AND RETURN TO CALLER

	TXO	F,F$UWR		; FLAG THAT "EW" IN OPERATION
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	FILERD - Read a File into a Text Buffer

; FILERD - READ A FILE INTO A TEXT BUFFER
;
; CALL:	MOVX	L,<FLAGS,,FILSPC>	;FLAGS: 400000 = delete after read
;	PUSHJ	P,FILERD
;	(RETURN)		; WITH BUFFER ID IN AC N
;
; SMASHES ACS X,T1-T5

FILERD:	MOVEI	T1,.IODMP	; USE CHANNEL ZERO [13000] Dump mode
	MOVE	T2,FS$DEV(L)	;Get device name [13000]
	SETZB	T3,N		;[13000] no b.r.h. for dump mode (& use ch 0)
	CAMN	T2,['TMP   ']	;[15000] Did he really want TMPCOR
	 JRST	[HLLZ T2,FS$NAM(L) ;[15000] Yes, get name
		 MOVE T1,[.TCRRF,,T2] ;[15000] Set up to read
		 TMPCOR T1,	;[15000] into null buffer to get length
		  JRST	[SETZM FILSPC		;[15000] Zero FILSPC file block
			 MOVE X,[FILSPC,,FILSPC+1] ;[15000] so we can
			 BLT X,FILSPC+FS$LTH-1	;[15000] use it for the .TMP
			 MOVE X,CCJNAM		;[15000] Get job # in left half
			 HLR X,FS$NAM(L)	;[15000] file name in rt half
			 MOVEM X,FILSPC+FS$NAM	;[15000] i.e. 003EDT
			 MOVSI X,'TMP'		;[15000] .TMP
			 MOVEM X,FILSPC+FS$EXT	;[15000] 003EDT.TMP
			 MOVSI X,'DSK'		;[15000] DSK:
			 MOVEM X,FILSPC+FS$DEV	;[15000] DSK:003EDT.TMP
			 HRRI L,FILSPC		;[15000]
			 PJRST FILERD]	;[15000] And read the file

		 PUSH P,L	;[15000] Save addr of file block
		 MOVEI L,T$DATA(T1) ;[15000] Allocate a block that big
		 HRLI L,FRDREF	;[15000] FRDREF will point to it
		 PUSHJ P,MAKBUF	;[15000] Get a place to put this thing
		 MOVEM T5,@FRDREF ;[15000] This many chars in the buffer
		 MOVNI T3,(L)	;[15000] Negative length
		 MOVSI T3,(T3)	;[15000] in left half...
		 HRR T3,FRDREF	;[15000] Address -1 in right half
		 ADDI T3,T$DATA-1 ;[15000] (include overhead words)
		 MOVE T1,[.TCRRF,,T2] ;[15000] Assume just read
		 POP P,L	;[15000] Get back addr of file block
		 HLLZ T2,FS$NAM(L) ;[15000] Get back file name
		 TLZE L,400000	;[15000] Flag is sign bit of L
		   HRLI T1,.TCRDF ;[15000] Then do read & delete
		 TMPCOR T1,	;[15000] Read, or read & delete the file
		   ERROR (XXX)	;[15000] What happened?
		 JRST FRD5]	;[15000] Go clean up
	OPEN	0,T1		;[13000] Try the open
	 CERR1	(IDV)		; ** INPUT DEVICE OPEN FAILURE **
	PUSHJ	P,FILLKP	; LOOKUP THE INPUT FILE
	 CERR1	(FNF)		; ** FILE NOT FOUND **

 	PUSH	P,L		;[15000] Save addr of file block
	MOVSI	L,FRDREF	;[13000] Addr of ref in left half
	HRR	L,RBSPC+.RBSIZ	;[13000] Size of file in words in right half
	PUSHJ	P,MAKBUF	; AND MAKE A BUFFER FOR TEXT OF FILE
	POP	P,L		;[15000] Get file block addr back

; READ THE FILE INTO THE BUFFER

;FRD1:	SOSGE	INIBH+2		; ANY MORE CHARS IN INPUT BUFFER?
;	 JRST	FRD2		; NO
;	ILDB	C,INIBH+1	; YES, FETCH THE NEXT ONE
;	JUMPE	C,FRD1		; IGNORE NULLS
;	JRST	FRD3		;PROCESS THE CHAR
;
; INPUT NEXT INPUT BUFFER

;FRD2:	IN	0,		; INPUT NEXT BUFFER
;	 JRST	FRD1		; AND FETCH A CHAR
;	STATZ	0,IO.EOF	; FAILED. END-OF-FILE?

;[13000] Use dump mode (Many times faster)

	JUMPE	T5,FRDZ		;[15000] Zero-length, finish up
	MOVEM	T5,@FRDREF	;[13000] Store length of buffer
	MOVN	T1,RBSPC+.RBSIZ	;[13000] Negative length in words
	MOVSI	T1,(T1)		;[13000] Should be in left half
	HRR	T1,FRDREF	;[13000] Build address to read in data
	ADDI	T1,T$DATA-1	;[13000] Skip over overhead words
	SETZ	T2,		;[13000] I/O list in T1,T2
	IN	0,T1		;[13000] Read it all in at once
	 JRST	FRD5		; YES, DONE READING FILE
	GETSTS	0,IOSTS		; NO, FETCH I/O STATUS
	ERROR	(IER)		; AND GIVE AN INPUT ERROR MSG

; STORE THE CHAR IN THE TEXT BUFFER

;FRD3:	SOJL	T5,FRD4		; OUT OF ROOM. EXPAND THE TEXT BUFFER
;	MOVE	T3,FRDREF	; ROOM LEFT. FETCH BASE ADR OF TEXT BUFFER
;	IDPB	C,T4		; AND STORE THE CHAR IN BUFFER
;	AOS	T$CCNT(T3)	; AND INCREMENT THE CHAR COUNT
;	JRST	FRD1		; AND FETCH ANOTHER INPUT CHAR
; EXPAND THE TEXT BUFFER WHEN OUT OF ROOM

;FRD4:	PUSH	P,C		; SAVE AC C
;	PUSH	P,N		; SAVE AC N
;	MOVEI	N,C$CMDL	; FETCH #WORDS TO ADD
;	MOVEI	L,FRDREF	; FETCH ADR OF BUFFER REFERENCE
;	PUSHJ	P,EXPAND	; AND EXPAND THE BUFFER
;	MOVEI	T5,C$CMDL*5-2	; AND RESET THE # CHARS THAT CAN FIT IN BUFFER
;	POP	P,N		; RESTORE AC N
;	POP	P,C		; RESTORE AC C
;	JRST	FRD3		; AND STORE LAST INPUT CHAR

;[13000] Remove nulls from the end of the file only

FRD5:
	MOVE	T1,@FRDREF	;[13000] Get # of chars in buffer
FRD5A:	SOJLE	T1,FRDZ		;[13000] First char is #0
	PUSHJ	P,CTOBP		;[13000] Make byte pointer
	ADD	T1,FRDREF	;[13000] Make absolute
	ADDI	T1,T$DATA	;[13000] Skip overhead words
	LDB	C,T1		;[13000] Get the character
	JUMPN	C,FRDZ		;[13000] not NULL, leave alone
	SOSLE	T1,@FRDREF	;[13000] 1 less character
	 JRST	FRD5A		;[13000] try again if any left

; DONE READING FILE. CLEAN UP AND RETURN TO CALLER

FRDZ:	MOVE	X,FRDREF	; FETCH BASE ADR OF BUFFER
	HRRZS	T$1REF(X)	; AND DELETE THE REF TO BUFFER
	SETZM	FRDREF		; AND CLEAR 'FRDREF'
	JUMPGE	L,CPOPJ		;[15000] no /DELETE switch
	CAIL	T5,C$MAXD	;[15000] If it is fairly long
	 POPJ	P,		;[16000] he probably didn't mean it
	SETZ	T1,		;[15000] Very short rename block
	RENAME	0,T1		;[15000] STOMP!!!
	 JRST	[MOVEM T2,LREERR ;[16000] Remember error code
		 CERR1 (RNF)]	;[16000] ** RENAME FAILURE **
	POPJ	P,		; AND RETURN TO CALLER

; FILEWR - WRITE A FILE FROM A TEXT BUFFER
;
; CALL:	MOVEI	L,FILSPC
;	MOVEI	N,BID
;	PUSHJ	P,FILEWR
;	(RETURN)
;
; SMASHES ACS X,T1-T5

FILEWR:	MOVE	T5,L		;[14000] Save away filespec pointer
	MOVEI	L,FRDREF	;[14000] FRDREF will reference block
	PUSHJ	P,FNDBLK	;[14000] Find our block ...
	 ERROR	(BNF)		;[14000] What block???
	MOVE	L,T5		;[14000] Get back addr of file block
	MOVE	T1,FRDREF	;[14000] We will need the length
	MOVE	T5,T$CCNT(T1)	;[14000]  of the block.
	ADDI	T5,4		;[14000] Round up so we don't lose anything
	IDIVI	T5,5		;[14000] Convert to words
	ADDI	T1,T$DATA-1(T5)	;[15000] Get addr of last word
	MOVE	X,[EXP <3777,,777777>,<17,,777777>,77777,377,1](X)
	ANDCAM	X,(T1)		;[15000] Use bit mask to clear invalid chars
FWR0:	MOVEI	T1,.IODMP	;[13000] Dump mode
	MOVE	T2,FS$DEV(L)	;Get device name [13000]
	SETZB	T3,N		;[13000] no b.r.h. for dump mode & Chn 0
	CAMN	T2,['TMP   ']	;[15000] Is it TMPCOR
	 JRST	[MOVNI T3,(T5)	;[15000] Negative # of words
		 MOVSI T3,(T3)	;[15000] In left half
		 HRR T3,FRDREF	;[15000] Addr-1 in right half
		 ADDI T3,T$DATA-1	;[15000] (Include overhead words)
		 HLLZ T2,FS$NAM(L)	;[15000] 3-letters of name
		 MOVE T1,[.TCRWF,,T2]	;[15000] Write TMPCOR
		 TMPCOR T1,		;[15000] T2 & T3 are argument block
		  JRST	[SETZM FILSPC ;[15000] Use temp file block
			 MOVE X,[FILSPC,,FILSPC+1] ;[15000] so we can
			 BLT X,FILSPC+FS$LTH-1	;[15000] use it for the .TMP
			 MOVE X,CCJNAM		;[15000] Get job # in left half
			 HLR X,FS$NAM(L)	;[15000] file name in rt half
			 MOVEM X,FILSPC+FS$NAM	;[15000] i.e. 003EDT
			 MOVSI X,'TMP'		;[15000] .TMP
			 MOVEM X,FILSPC+FS$EXT	;[15000] 003EDT.TMP
			 MOVSI X,'DSK'		;[15000] DSK:
			 MOVEM X,FILSPC+FS$DEV	;[15000] DSK:003EDT.TMP
			 MOVX L,<1B0+FILSPC>	;[20000] Always supercede
			 PJRST FWR0]		;[15000] Write it
		 JRST FWRZ]	;[15000] All done
	OPEN	0,T1		;[13000] Try the open
	 JRST	[MOVE X,FRDREF	;[20000] Clean up reference first
		 HRRZS X,B$2PTR(X) ;[20000]
		 CERR1 (ODV)]	;[20000] and then give error
	MOVEI	M,177(T5)	;[14000] Estimated length of file (round up)
	ASH	M,-7		;[15000] Convert to blocks (IDIVI step on R)
	PUSHJ	P,FILENN	; ENTER THE OUTPUT FILE
	 JRST	[MOVE X,FRDREF	;[20000] Clean up reference first
		 HRRZS X,B$2PTR(X) ;[20000] to not leave bad pointer around
		 CERR1 (ENT) ]	;[20000] Then give error

	JUMPE	T5,FWR9		;[15000] Zero-length file
	MOVNI	T1,(T5)		;[13000] Negative length in words
	MOVSI	T1,(T1)		;[13000] Should be in left half
	HRR	T1,FRDREF	;[13000] Build address to read in data
	ADDI	T1,T$DATA-1	;[13000] Skip over overhead words
	SETZ	T2,		;[13000] I/O list in T1,T2
	OUT	0,T1		;[13000] Write it all out at once
	 JRST	FWR9		; YES, DONE WRITING FILE
	GETSTS	0,IOSTS		; NO, FETCH I/O STATUS
	ERROR	(OER)		; AND GIVE AN OUTPUT ERROR MSG

FWR9:
	MOVX	T1,<17B12>	;[14000] We want to set the mode
	ANDCAM	T1,RBSPC+.RBPRV	;[14000] back to ASCII
	SETZM	RBSPC+.RBALC	;[14000] Don't de-allocate any blocks!!!
	MOVEI	T1,.RBSTS	;[22000] Reset count since RENAME believes
	MOVEM	T1,RBSPC+.RBCNT	;[22000] that the whole word is the count
	RENAME	RBSPC		;[14000] Rename it back to ASCII mode
	 CLOSE	0,		;[14000] Rename failed, try to Close the file
	RELEASE	0,		;[14000] and release it.
FWRZ:	MOVEI	L,(L)		;[24000] Clear supersede/delete bit
	PJRST	FRDZ		;[14000] and un-reference the block


; MAKBUF - ALLOCATE A TEXT BUFFER AND SETUP CHAR COUNT AND BYTE POINTER
;
; CALL:	MOVE	L,[<REF,,LEN>]
;	PUSHJ	P,MAKBUF
;	(RETURN)
;
; T4:=BYTE POINTER TO BUFFER (INDEXED BY T3)
; T5:=CHAR COUNT FOR BUFFER(# CHARS THAT'L FIT IN BUFFER)

MAKBUF:	PUSH	P,L		; SAVE AC L
	HLRZ	L,L		; FETCH 'REF'
	PUSHJ	P,RELM		; AND RELEASE ANY EXISTING BLOCK
	POP	P,L		; RESTORE AC L
	HRRI	L,T$DATA+10(L)	; DON'T FORGET BUFFER INFO WORDS!
	PUSHJ	P,REQM		; AND ALLOCATE THE BUFFER
	PUSH	P,L		; SAVE AC L
	HLRZ	L,L		; FETCH 'REF'
	PUSHJ	P,ADDBLK	; PUT BUFFER IN LINKED LIST
	HLRZ	L,(P)		; FETCH REF FROM AC L<LH>
	PUSHJ	P,FNDBLK	; AND BIND 'REF' TO BUFFER
	 ERROR	(XXX)		; ? ? ?
	POP	P,L		; RESTORE AC L
	MOVEI	T5,(L)		; AND PUT IN AC T5 [13000]
	IMULI	T5,5		; COMPUTE # CHARS IN BUFFER
	SUBI	T5,<T$DATA+10>*5; MINUS #CHARS TAKEN UP BY OVERHEAD
	MOVE	T4,[POINT 7,T$DATA(T3)] ; FETCH BP TO BUFFER
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	TYPEL and TYPE - Type part of Text Buffer

; TYPEL - TYPE LINES OF TEXT BUFFER
;
; CALL:	MOVEI	ARG,N		; "N" OF "NT" COMMAND
;	PUSHJ	P,TYPEL
;	(RETURN)
;
; SMASHES ACS X,T1,T4

TYPEL:	PUSHJ	P,EVL2RG	; CHANGE LINE ARG TO CHAR ADDRESSES
	SKP			; AND FALL INTO "TYPE"

; TYPE - TYPE TEXT FROM TEXT BUFFER (BETWEEN TWO CHAR ADDRESSES)
;
; CALL:	MOVEI	SARG,CHAR.ADR1	; LOWER BOUND
;	MOVEI	ARG,CHAR.ADR2	; UPPER BOUND
;	PUSHJ	P,TYPE
;	(RETURN)
;
; SMASHES ACS X,T1-T4

TYPE:	PUSHJ	P,CHK2RG	; MAKE SURE ARGS ARE IN BOUNDS
TYPE0:	MOVE	T4,ARG		; COPY SECOND ARGUMENT (M OF N,M)
	SUB	T4,SARG		; COMPUTE # CHARS TO BE TYPED
	JUMPE	T4,CPOPJ	; NOTHING TO TYPE. JUST RETURN TO CALLER

$T1:	MOVE	T1,SARG		; FETCH 36 BIT [13000] ADR OF NEXT CHAR
	PUSHJ	P,GET		; ANF FETCH CHAR FROM BUFFER
	CAIN	C,177		;[10000] Rubout forces next character
	 AOJA	SARG,[MOVE T1,SARG	;[10000] [13000] 36 bits
		      CAML SARG,ARG	;[16000] Still in bounds?
			POPJ P,		;[16000] All done
		      PUSHJ P,GET	;[10000] to print as itself regardless
		      PUSHJ P,TCHR	;[10000]
		      SOJA T4,.+2]	;[10000]
	PUSHJ	P,TCCHR		; AND TYPE IT
	AOJ	SARG,		; INCREMENT TO NEXT CHAR
	TXNN	F,F$REE		;[2000] MAKE IT STOP IF WE REENTER
	SOJG	T4,$T1		; LOOP FOR ALL CHARS TO BE TYPED

	POPJ	P,		; DONE. RETURN TO CALLER
	SUBTTL	FILOPN - Open a Device and Setup Buffers


; CALL:	MOVE	N,[Z CH,0]
;	MOVE	M,[<OBUF,,IBUF>]
;	MOVEI	L,FILSPC
;	PUSHJ	P,FILOPN
;	(OPEN FAILURE RETURN)
;	(SUCCESS)
;
; 'CH' IS THE I/O CHANNEL TO BE USED
; 'OBUF' IS THE ADR OF THE OUTPUT BUFFER HEADER
; 'IBUF' IS THE ADR OF THE INPUT BUFFER HEADER
; 'FILSPC' IS THE ADR OF THE FILE SPECIFICATION
;
; USES ACS X,T1-T3

FILOPN:	MOVEM	L,LASSPC	; SAVE ADR OF FILSPC IN CASE OF ERROR
	MOVEI	T1,.IOASL	; INIT IN ASCII LINE MODE
	MOVE	T2,FS$DEV(L)	; FETCH THE SIXBIT DEVICE NAME

; MAKE SURE DEVICE IS NOT A TTY CONTROLLED BY A JOB

	MOVE	X,T2		; FETCH DEVICE NAME
	DEVCHR	X,		; AND ITS CHARACTERISTICS
	TXNN	X,DV.TTY	; IS DEVICE A TTY?
	 JRST	FILOP2		; NO, OKAY
	TXNE	X,DV.AVL	; YES, IS IT AVAILABLE?
	 TXNE	X,DV.TTA	; AND NOT CONTROLLED BY A JOB?
	  ERROR	(TTY)		; NO, ERROR

FILOP2:	MOVE	T3,M		; FETCH THE ADRS OF THE BUFFER HEADERS
	MOVE	X,FS$FLG(L)	;[334] GET FLAGS
	TXNE	X,FB$NON	;[334] SEE IF DECTAPE NON STANDARD
	 TXO	T1,IO.NSD	;[334] NON-STANDARD DECTAPE
	MOVE	X,[OPEN 0,T1]	; SETUP THE OPEN
	IOR	X,N		; FILL IN THE CHANNEL
	XCT	X		; DO THE OPEN
	 POPJ	P,		; OFEN FAILURE
; DO INBUF/OUTBUF

	TLNN	M,-1		; OUTPUT HEADER SPECIFIED?
	 JRST	FILOP1		; NO

; DO OUTBUF TO SETUP OUTPUT BUFFERS

	HLRZ	T1,M		; FETCH ADR OF OUTPUT BUFFER HEADER
	MOVEI	T1,3(T1)	; FETCH ADR OF OUTPUT BUFFERS
	EXCH	T1,.JBFF	; AND PUT WHERE MONITOR CAN SEE IT
	MOVE	X,[OUTBUF 0,C$NBUF] ; GET READY FOR OUTBUF
	IOR	X,N		; FILL IN THE CHANNEL
	XCT	X		; DO THE OUTBUF
	MOVEM	T1,.JBFF	; RESTORE .JBFF

FILOP1:	TRNN	M,-1		; INPUT HEADER SPECIFIED?
	 JRST	CPOPJ1		; NO, GIVE SUCCESS RETURN

; DO INBUF TO SETUP INPUT BUFFERS

	MOVEI	T1,3(M)		; FETCH ADR OF WHERE BUFFERS WILL GO
	EXCH	T1,.JBFF	; AND PUT WHERE MONITOR WILL SEE IT
	MOVE	X,[INBUF 0,C$NBUF] ; GET READY FOR INBUF
	IOR	X,N		; FILL IN THE CHANNEL
	XCT	X		; DO THE INBUF
	MOVEM	T1,.JBFF	; RESTORE .JBFF
	JRST	CPOPJ1		; AND RETURN TO CALLER
	SUBTTL	FILLKP, FILENT, AND FILRNM - File LOOKUP/ENTER/RENAME

; CALL:	MOVE	N,[Z CH,0]
;	MOVEI	M,<ESTSIZ>	; ESTIMATED SIZE OF OUTPUT FILE
;	MOVEI	L,FILSPC
;	PUSHJ	P,FILLKP	; OR "PUSHJ P,FILENT"
;				; OR "PUSHJ P,FILRNM"
;	(LOOKUP/ENTER ERROR)
;	(SUCCESS RETURN)
;
; 'CH' IS THE I/O CHANNEL TO BE USED
; 'FILSPC' IS THE ADR OF THE FILE SPECIFICATION
;
; USES ACS X,T1-T4
FILRNM:	MOVE	T1,[RENAME 0,RBSPC] ; Set up RENAME opcode
	JRST	FILL1		; and jump right in

FILENT:	SKIPA	T1,[ENTER 0,RBSPC] ; SETUP THE ENTER OPCODE

FILLKP:	 MOVE	T1,[LOOKUP 0,RBSPC] ; SETUP THE LOOKUP OPCODE
FILL1:	TLO	L,200000	;[20000] Set the Supersede bit
FILLNS:	HRRM	L,LASSPC	; SAVE ADR OF FILE SPEC

; CHECK IF DEVICE IS DISK. IF NOT, USE SHORT BLOCK

	MOVE	X,FS$DEV(L)	; FETCH THE DEVICE NAME
	DEVCHR	X,		; AND ITS CHARACTERISTICS
	TXNN	X,DV.DSK	; IS IT A DISK?
	 JRST	FILL5		; NO, USE SHORT BLOCK

; CLEAR EXTENDED LOOKUP/RENAME/ENTER ARG BLOCK

	STORE	(X,RBSPC,RBSPC+.RBSTS,0) ; CLEAR ARG BLOCK

; SET ARG COUNT

	MOVEI	X,.RBSTS	; FETCH COUNT OF ARGS/VALUES
	TLNN	L,200000	;[20000] Non-superceding enter??
	 TRO	X,RB.NSE	;[20000] Yes.
	MOVEM	X,RBSPC+.RBCNT ; AND STORE IN ARG BLOCK

; SET PPN

	SKIPE	X,FS$PPN(L)	; ANY PPN GIVEN?
	 MOVEI	X,FS$PTH(L)	; YES, FETCH ADR OF PATH SPEC
	MOVEM	X,RBSPC+.RBPPN	; AND STORE IN ARG BLOCK

; SET FILENAME

	MOVE	X,FS$NAM(L)	; FETCH FILENAME
	MOVEM	X,RBSPC+.RBNAM	; AND STORE IN ARG BLOCK

; SET FILE EXTENSION

	MOVE	X,FS$EXT(L)	; FETCH THE FILE EXTENSION
	MOVEM	X,RBSPC+.RBEXT	; AND STORE IN ARG BLOCK
; SET FILE PROTECTION

	MOVE	X,FS$PRV(L)	;  FETCH THE FILE PROTECTION
	MOVEM	X,RBSPC+.RBPRV	; AND STORE IN ARGUMENT BLOCK

; SET ESTIMATED SIZE OF FILE

;[14000] ;If I want it huge I must have a reason
	CAXLE	M,^D1500	; INSURE VALUE IS WITHIN REASON
	 SETZ	M,		; WELL, DON'T TRY TO MAKE IT HUGE!!
	MOVEM	M,RBSPC+.RBEST	; SET ESTIMATED SIZE OF FILE

; CHECK FOR A UFD

	HLRZ	X,FS$EXT(L)	; FETCH FILE EXTENSION
	CAIN	X,'UFD'		; IS IT A UFD?
	 JRST	FILL3		; YES, DO SPECIAL PROCESSING

; DO THE LOOKUP/RENAME/ENTER

FILL2:	IOR	T1,N		; MAKE THE LOOKUP/RENAME/ENTER INST.
	XCT	T1		; AND EXECUTE IT
FILL2A:				;[4000] LABEL MOVED SO ERROR CODE RIGHT
	 SKIPA	T2,RBSPC+.RBEXT	; FAILED. GET ERROR CODE AND SKIP
	JRST	CPOPJ1		; SUCCEEDED. GIVE SUCCESS RETURN TO CALLER
FILL2B:	HRRZM	T2,LREERR	; STORE THE ERROR CODE FOR LATER
	POPJ	P,		; AND GIVE FAIL RETURN TO CALLER

; FILE IS A UFD

; SET PPN TO [1,1]

FILL3:	MOVE	X,[<1,,1>]	; FETCH MFD PPN ([1,1])
	MOVEM	X,RBSPC+.RBPPN	; AND STORE IN ARG BLOCK

; SET FILE NAME TO PPN OF FILESPEC

	MOVE	X,FS$PPN(L)	; FETCH PPN OF FILE SPEC
	MOVEM	X,RBSPC+.RBNAM	; AND STORE IN ARG BLOCK

; SET THE "I AM A DIRECTORY BIT" IN .RBSTS WORD

	MOVX	X,RP.DIR	; FETCH THE "I AM A DIRECTORY" BIT
	MOVEM	X,RBSPC+.RBSTS	; AND STORE IN ARG BLOCK

	JRST	FILL2		; AND DO THE LOOKUP/RENAME/ENTER
; FILENN - FILE ENTER (non-superceding if TLO L,200000)

FILENN:	MOVE	T1,[ENTER 0,RBSPC] ; SETUP THE ENTER OPCODE
	JRST	FILLNS		; AND DO Possibly non-superceding ENTER

; FOR NON-DISK, USE SHORT ARG BLOCK

FILL5:	MOVE	X,T1		; COPY THE LOOKUP/RENAME/ENTER INST.
	MOVE	T1,FS$NAM(L)	; FETCH THE FILE NAME
	MOVE	T2,FS$EXT(L)	; FETCH THE FILE EXTENSION
	MOVE	T3,FS$PRV(L)	; FETCH THE FILE PROTECTION
	SKIPE	T4,FS$PPN(L)	; ANY PATH?
	 MOVEI	T4,FS$PTH(L)	; YES, FETCH ADR OF PATH SPEC

; FORM THE LOOKUP/RENAME/ENTER INSTRUCTION

	IOR	X,N		; FILL IN THE CHANNEL
	HRRI	X,T1		; FILL IN ADR OF ARG BLOCK
	XCT	X		; PERFORM THE LOOKUP/RENAME/ENTER
	 JRST	FILL2B		; FAILED

; SAVE SOME INFO IN EXTENDED ARG BLOCK

	MOVEM	T3,RBSPC+.RBPRV	; SAVE CREATION INFO
	JRST	CPOPJ1		; SUCCEEDED. GIVE SUCCESS RETURN TO CALLER

>;; END FOR FTXTEC
FOR FTXTCERR,<
	SUBTTL	ERMT - Error Message Typeout

ERMT:	MOVE	X,.JBREN	; SAVE REENTER ADR FOR OTHER SEGMENT
	MOVEM	X,RENSAV	; AND SAVE FOR RETURN

	MOVEM	P,SADSAV	; SAVE THE CONTROL PDP

	MOVEI	X,[MOVE P,SADSAV ; SET NEW REENTER ADR
		   JRST ERMT3]	; . . .
	MOVEM	X,.JBREN	; . . .


; SEARCH FOR THE THREE LETTER ERROR CODE

	HRLZ	X,.JBUUO	;[422] GET ERROR CODE

; LOAD INDEX AOBJN POINTER

	MOVSI	N,-ERRLEN	;[422] LOAD LENGTH OF TABLE IN AOBJN FORMAT

; SEARCH FOR THE ERROR

ERMT1:	HLLZ	C,ERRTAB(N)	;[422] FETCH CODE IN TABLE
	CAMN	X,C		;[422] FOUND?
	 JRST	ERMT2		;[422] HOORAY! FOUND IT!!
	AOBJN	N,ERMT1		;[422] CONTINUE SEARCHING
	JRST	ERMTE		;[422] OOPS! FORGOT TO PUT CODE IN TEXT!

; CODE WAS FOUND

ERMT2:	MOVX	T5,<POINT 7,>	;[422] MAKE T5 A BYTE POINTER TO ERRTAB
	HRR	T5,ERRTAB(N)	;[422] . . .
	PUSHJ	P,ERMTL		; TYPE THE LINE

; CHECK IF EXTENDED MESSAGE DESIRED

	MOVE	X,EHVAL		; FETCH MESSAGE LENGTH
	TXNE	X,JW.WCN	; WANT MESSAGE CONTINUATION?
	 JRST	ERMT5		; YES
	SETO	T4,		; CLEAR FLAG THAT WE TYPE ALL OF MSG

ERMT3:	LDB	T1,[POINT 9,.JBUUO,8] ; FETCH LUUO OPCODE
	CAIN	T1,LUUWRN	; A WARNING?
	 JRST	ERMT34		;[416] YES, NEVER DIE

	MOVE	X,ETVAL		;[12000] Check abort flag
	TXNE	X,ET$ABO	;[12000] Go to monitor if set
	 EXIT	1,		; YES, EXIT FOR FATAL CCL ERROR
				; (USER CAN TYPE "CONTINUE" FOR
				;  MORE INFORMATION)

; PEEK AT NEXT INPUT CHAR TO SEE IF USER WANTS CONTINUATION OF MSG

ERMT34:	MOVEI	N,PROMPT	; TYPE FAKE PROMPT
	PUSHJ	P,TXSTR		; . . .
	PUSHJ	P,GETCH		; AND PEEK AT FIRST CHAR
	CAIN	C,"/"		; WANT CONTINUATION OF MESSAGE?
	 AOJLE	T4,ERMT5	; YES, IF WE HAVEN'T TYPED IT YET
	CAIN	C,"?"		; WANT TO SEE LAST 10 COMMANDS?
	 JRST	ERMT4		; YES
	MOVEM	C,INPCHR	; NO, SAVE CHAR FOR LATER
	JRST	ERMTZ		; AND FINISH UP

; TYPE LAST 10 COMMANDS

ERMT4:	PUSH	P,T4		;[405] SAVE MSG FLAG...
	PUSHJ	P,ERRCTY	; TYPE LAST 10 COMMANDS
	POP	P,T4		;[405] BECAUSE "ERRCTY" CLOBBERS IT
	JRST	ERMT3		; AND GO BACK FOR MORE

; GIVE EXTENDED MESSAGE

ERMT5:	ILDB	C,T5		; FETCH NEXT CHAR FROM TEXT
	CAIG	C,.CHCNH	;  IS CHAR ^@,...,^H?
	 JRST	ERMT3		; YES, THEN WE'RE DONE
	PUSHJ	P,TCHR		; NO, TYPE THE CHAR
	PUSHJ	P,ERMTL		; AND REST OF LINE
	JUMPE	C,ERMT3		;[422] IF NULL, QUIT
	JRST	ERMT5		; AND TRY FOR ANOTHER LINE

; DONE. RETURN TO CONTROL SEGMENT

ERMTZ:	MOVE	X,RENSAV	; RESTORE PREVIOUS REENTER ADR
	MOVEM	X,.JBREN	; . . .
	MOVE	P,SADSAV	; RESTORE PREVIOUS CONTROL PDP

	MOVE	X,SEGNAM	; FETCH NAME OF CONTROL SEGMENT
	MOVEM	X,GSGNAM	; AND STORE IN GETSEG BLOCK
IFN FTXTEC&FTXTCERR,	POPJ P,	;[21000] Just return
IFE FTXTEC&FTXTCERR,	PJRST	GETSG		; AND DO THE GETSEG

; CAN'T FIND THE ERROR CODE IN TEXT

ERMTE:	MOVEI	N,[ASCIZ/ *** UNDEFINED ERROR CODE ***
/]
	PUSHJ	P,TSTR		; TYPE THE MESSAGE
	JRST	ERMTZ
; TYPE A LINE FROM ERROR MESSAGE TEXT

ERMTL:	ILDB	C,T5		; FETCH NEXT CHAR OF TEXT
	JUMPE	C,CPOPJ		;[422] RETURN IF NULL
	CAIN	C,.CHCNN	; IS IT A CONTROL-N?
	 JRST	ERMTLN		; YES, PROCESS IT
	PUSHJ	P,TCHR		; NO, TYPE THE CHAR
	CAIN	C,.CHLFD	; IS IT A <LF>?
	 POPJ	P,		; YES, RETURN TO CALLER
	JRST	ERMTL		; NO, KEEP TYPING THE LINE

; ERMTLN - PROCESS CONTROL-N IN LINE OF TEXT

ERMTLN:	ILDB	X,T5		; FETCH FIRST DIGIT ON ^NDD
	MOVEI	X,-"0"(X)	; CONVERT CHAR TO A DECIMAL DIGIT
	IMULI	X,^D10		; MAKE ROOM FOR SECOND DIGIT
	ILDB	C,T5		; FETCH SECOND DIGIT
	ADDI	X,-"0"(C)	; ADD IN THE SECOND DIGIT
	ROT	X,-1		; DIVIDE BY TWO AND KEEP THE REMAINEDER
	MOVE	T1,CNNTBL(X)	; FETCH TWO ADDR DISPATCH ENTRY
	JUMPL	X,.+2		; SKIP IF NUMBER IS ODD
	 HLRZ	T1,T1		; ODD, FETCH OTHER DISPATCH ADDR
	PUSHJ	P,(T1)		; AND DISPATCH
	JRST	ERMTL		; DONE. CONTINUE MESSAGE PROCESSING

; CNNTBL - DISPATCH TABLE FOR ^N ITEMS IN MESSAGES

CNNTBL:
	<CNNCCH,,CNNOFL>	; 00 01		Current char, LEBSPC
	<CNNFIL,,CNNERC>	; 02 03		LASSPC, Lookup/enter code (#)
	<CNNDEV,,CNNPTH>	; 04 05		Output dev, LASSPC path
	<CNNARG,,CNNPRO>	; 06 07		ARG, LASSPC PROTECTION
	<CNNEBF,,CNNIFL>	; 08 09		LEBSPC name, LEBSPC
	<CNNEBN,,CNNIOF>	; 10 11		LEBSPC, IO flags (#)
	<CNNTAG,,CNNSKP>	; 12 13		TAG, Lookup/Enter (text)
	<CNNISK,,0>		; 14 15		IO error bits (text)
	<CNNEOV,,CNNSRH>	; 16 17		EO, Search arg
	<CNNTSC,,CNNSWT>	; 18 19		MACNAM, switch
	<CNNEWF,,CNNERF>	; 20 21		EW, ER
	<CNNCNT,,CNNCND>	; 22 23		^T, ^D
	<CNNSAR,,CNNFLG>	; 24 25		SARG, FLAGS
	<CNNVAL,,0>		;26 0		VALUE, 
; ^N00 - TYPE CURRENT COMMAND CHAR

CNNCCH:	SKIPGE	CMDCNT		;[20000] Less than nothing
	 SETZM	CMDCNT		;[20000] Should really be just nothing
	PUSHJ	P,CMDBCH	; BACKUP 2 CHARS
	PUSHJ	P,CMDBCH	; . . .
	PUSHJ	P,CMDGCH	; GET PREVIOUS CHAR
	 JFCL			; (WHY???)
	CAIN	C,"^"		; IS THIS AN ^<CHAR> COMMAND?
	 PUSHJ	P,TCHR		; YES, TYPE AN "^" FIRST
	PUSHJ	P,CMDGCH	; AND FETCH THE CURRENT CHAR
	 JFCL			; (SHOULDN'T OCCUR)
	PJRST	TSCHR		; TYPE THE CHAR AND RETURN TO CALLER

; ^N01 - TYPE EB FILE-NAME AND EXTENSION

CNNOFL:	MOVEI	L,LEBSPC	; FETCH ADR OF LAST OUTPUT FILE-SPEC
	PJRST	TFSPEC		; AND TYPE FILE-NAME AND RETURN

; ^N02 - TYPE FILE-NAME REFERENCES BY LAST UUO

CNNFIL:	MOVE	L,LASSPC	; FETCH ADR OF LAST FILE SPEC
	PJRST	TFSPEC		; AND TYPE THE FILE-NAME AND EXTENSION

; ^N03 - TYPE MONITOR ERROR CODE (L-E-R)

CNNERC:	MOVE	N,LREERR	; FETCH LAST LOOKUP/RENAME/ENTER CODE
	PJRST	TOCT		; AND TYPE IT IN OCTAL

; ^N04 - TYPE OUTPUT DEVICE NAME

CNNDEV:	MOVEI	L,LEBSPC	; FETCH ADDR OF LAST OUTPUT FILE-SPEC
	TXNN	F,F$UBK		; DOING "EB"?
	 MOVEI	L,LEWSPC	; NO, DOING "EW"
	PJRST	TDEV		; AND TYPE THE DEVICE NAME

; ^N05 - TYPE LAST FILE-SPEC PATH

CNNPTH:	MOVE	L,LASSPC	; FETCH ADR OF LAST FILE-SPEC
	PJRST	TPATH		; AND TYPE PATH AND RETURN

; ^N24 - TYPE SARG VALUE [12000]

CNNSAR:	SKIPA	N,SARG		;[12000] Fetch 2nd argument

; ^N06 - TYPE ARG VALUE

CNNARG:	MOVE	N,ARG		; FETCH THE ARG VALUE
	PJRST	TDEC		; TYPE IT AND RETURN

; ^N07 - TYPE LAST FILE PROTECTION

CNNPRO:	MOVE	N,LASSPC	; FETCH LAST FILE-SPEC
	PJRST	TPROT		; TYPE PROTECTION AND RETURN

; ^N08 - TYPE LAST "EB" FILE-NAME

CNNEBF:	MOVE	N,LEBSPC+FS$NAM	;[337] GET .BAK NAME
	PJRST	TSIX		;[337] TYPE FILE-NAME AND RETURN

; ^N09 - TYPE LAST INPUT FILE NAME

CNNIFL:	MOVEI	L,LEBSPC	; FETCH ADR OF LAST INPUT FILE-SPEC
	PJRST	TFSPEC		; TYPE FILE-NAME AND RETURN

; ^N10 - TYPE ORIGINAL "EB" FILE-NAME

CNNEBN:	MOVEI	L,LEBSPC	;[12000] FETCH LAST EB SPEC
	PJRST	TFSPEC		;[237] TYPE ORIGINAL SPEC

; ^N11 - TYPE I/O STATUS FLAGS

CNNIOF:	HRRZ	N,IOSTS		; FETCH I/O STATUS FLAGS
	PJRST	TOCT		; AND TYPE IN OCTAL

; ^N12 - TYPR CURRENT TAG

CNNTAG:	HLRZ	T1,1(REF)	; FETCH CHAR.ADR OF CURRENT TAG
	IDIVI	T1,5		; AND FORM A BYTE POINTER
	HLL	T1,CBPTBL-1(T2)	; . . .
	ADD	T1,@CMDBUF	; MAKE IT ABSOLUTE
	MOVE	T2,2(REF)	; FETCH CHAR COUNT FOR TAG

CNNTG1:	JUMPE	T2,CPOPJ	; RETURN IF DONE
	ILDB	C,T1		; FETCH NEXT CHAR FROM TAG
	PUSHJ	P,TCCHR		; AND TYPE IT
	SOJA	T2,CNNTG1	; AND TRY FOR ANOTHER CHAR

; ^N13 - SKIP TO ^ANN WHEN NN IS LRE ERROR CODE IN OCTAL
;	(LRE="LOOKUP/RENAME/ENTER")

CNNSKP:	LDB	T2,[POINT 6,LREERR,35] ; FETCH LRE ERROR CODE

CNNSK1:	ILDB	C,T5		; FETCH NEXT TEXT CHAR
	CAIN	C,.CHCNB	; ^B?
	 POPJ	P,		; YES, PRINT DEFAULT MESSAGE
	CAIE	C,.CHCNA	; ^A?
	 JRST	CNNSK1		; NO, TRY AGAIN WITH NEXT CHAR

; FOUND ^A. SEE IF NN MATCHES

	ILDB	C,T5		; FETCH FIRST OCTAL DIGIT
	MOVEI	T1,-"0"(C)	; CONVERT TO A NUMBER
	LSH	T1,3		; MAKE ROOM FOR SECOND DIGIT
	ILDB	C,T5		; FETCH THE SECOND DIGIT
	IORI	T1,-"0"(C)	; ADD IN THE SECOND DIGIT
	CAIE	T1,(T2)		; DOES NN MATCH?
	 JRST	CNNSK1		; NO, TRY AGAIN
	POPJ	P,		; YES, TYPE OUT THE LINE

; ^N14 -SKIP TO ^ANN WHERE NN IS OCTAL FOR BITS 18-21 OF I/O STATUS

CNNISK:	LDB	T2,[POINT 4,IOSTS,21] ; FETCH 4 RELEVANT STATUS BITS
	JRST	CNNSK1		; AND FIND THE PROPER MESSAGE

; ^N16 - TYPE "EO" VALUE

CNNEOV:	MOVEI	N,C$EOVL	;[406] FETCH THE "EO" VALUE
	PJRST	TDEC		; TYPE IT AND RETURN

; ^N17 - TYPE SEARCH ARG

CNNSRH:	MOVEI	N,SRHARG	; FETCH ADR OF SEARCH ARG
	PJRST	TSSTR		; TYPE IT AND RETURN 

; ^N18 - TYPE Current MACRO name

CNNTSC:	MOVE	N,MACNAM	;[12000] current macro name
	PJRST	TSIX		;[12000] in SIXBIT

; ^N19 - TYPE SWITCH NAME

CNNSWT:	MOVE	N,SBNAME	; FETCH THE SWITCH NAME
	PJRST	TSIX		; TYPE IT AND RETURN

; ^N20 - TYPE EW FILE-NAME AND EXTENSION

CNNEWF:	MOVEI	L,LEWSPC	; FETCH ADR OF LAST OUTPUT FILE-SPEC
	PJRST	TFSPEC		; AND TYPE FILE-NAME AND RETURN

; ^N21 - TYPE ER FILE-NAME AND EXTENSION

CNNERF:	MOVEI	L,LERSPC	; FETCH ADR OF LAST INPUT FILE-SPEC
	PJRST	TFSPEC		; AND TYPE FILE-NAME AND RETURN

; ^N22 - Type current ET value [12000]

CNNCNT:	SKIPA	N,ETVAL		;[12000] Get the ET value

; ^N23 - Type the currrent ED value [12000]

CNNCND:	MOVE	N,EDVAL		;[12000] Get the ED value
	PJRST	TOCT		;[12000] Type in octal

; ^N24 gets CNNSAR, which is just before CNNARG

; ^N25 - Type the global flags [12000]

CNNFLG:	MOVE	N,F		;[12000] Get the flags
	PJRST	TOCT		;[12000] Type in octal

; ^N26 - Type the current VALUE [12000]
CNNVAL:	MOVE	N,VALUE		;[12000] Get VALUE
	PJRST	TDEC		;[12000] type in decimal



	SUBTTL	ERRTXT - Text of All Error Messages

	CINFO.			; CLEAR THE INFO/REDEF MECHANISM

; MACRO TO DEFINE AN ERROR TEXT

	DEFINE	ERRGEN(PREFIX,TEXT)<
LSTOF.
E$$'PREFIX':	ASCIZ\'TEXT'\
	INFO.	(REDEF.,<%EGEN	('PREFIX')>)
LSTON.
>
	ERRGEN	ARG,< Improper Arguments
The following argument combinations are illegal:
1)	,		(no argument before comma)
2)	M,N,		(where M and N are numeric terms)
3)	H,		(because H=B,Z is already two arguments)
4)	,H		(H following other arguments)
>
	ERRGEN	ASN,< Ambiguous Switch Name: /19
The switch "/19" is not uniquely abbreviated, i.e. more than
one switch will match "/19".  A longer, unique form of the
switch should be used.
>
	ERRGEN	BAK,< Cannot Delete Old Backup File
Failure in RENAME process at close of editing job initiated by an EB
command or a TECO command. There exists an old backup file 08.BAK
with a protection 07 such that it cannot be deleted. Hence the
input file 10 cannot be renamed to "08.BAK". The output file
is closed with the filename "01". The RENAME MUUO
error code is 03.
>
	ERRGEN	BNF,< Block not found
This is an internal error and should be reported.  A block of text,
such as a previously-executed command, or q-register text, was not
in the linked list of such blocks.
>
	ERRGEN	BPT,< Breakpoint in macro "18"
The most recent EB file was: "10"
The most recent ER file was: "21"
The most recent EW file was: "20"
The most recent search argument was: "17"
EO=16,	ET=22,	ED=23
ARG=06,	SARG=24,	VALUE=26,
Flags="25"
>
	ERRGEN	CCM,< CCL Command Missing
TECO10 was run with a run-offset of one (1) and there was no file
'EDT' in TMPCOR or '###EDT.TMP' on the user's disk area.
>
	ERRGEN	CEF,< Core expansion failure
The current operation requires more memory storage than XTEC now has
and TECO10 is unable to obtain more core from the monitor. This message
can occur as a result of any one of the following things:
1) Command buffer overflow while a long command string is being typed,
2) Q-register buffer overflow caused by an X or [ command.
3) Too many Q-registers in use (.gt.5000),
4) Too much nesting or recursion of the M command.
5) Editing buffer overflow caused by an insert command or
    a read command or other causes.
>
	ERRGEN	CFP,< Can't Find Overflowed PDL
A PDL overflow trap occurred, but TECO10 could not find the PDL
that caused the overflow.  This is an internal error and should be
reported, along with a teletype printout showing what the user was
doing.
>
	ERRGEN	CON,< Confused use of conditionals
Conditionals, parenthesized arguments, and iterations must be properly
nested.  The user probably used some construct like: N"E...(...' where
an iteration or parenthesized argument is begun in a conditional
but not terminated in the same conditional.
>
	ERRGEN	EBD,< EB with Device 04 is Illegal
The EB command and the TECO command may be specified only with
file structured devices (ie: disk and DECtape.)
>
	ERRGEN	EBF,< EB with Illegal File 02
The EB command and the TECO command may not be used with a file
having the filename extension ".BAK" or a file having the name
"NNNXTC.TMP" where NNN is the user's job number. The user must
either use an ER-EW sequence or rename the file.
>
	ERRGEN	EBO,< EW Before Current EB Closed
An ER or EW command may not be given while an EB command is in
progress. Give an EF to close the files if you wish
to do an ER or EW, or an EK to cancel the current EB.
>
	ERRGEN	EBP,< EB Illegal because of file 02 Protection
The file 02 cannot be edited with an EB command or a TECO command
because it has a protection 07 such that it cannot be renamed
at close time.
>
	ERRGEN	EMA,< EM with Illegal Argument
The argument N in an NEM command must be greater than zero.
>
	ERRGEN	EMD,< EM with no Input Device Open
EM commands apply only to the input device, and should be preceded
by an ER (or equivalent) command. To position a tape for output, that
unit should be temporarily opened for input while doing the EM commands.
>
	ERRGEN	END,< EN with a Device is Illegal
Since it is not possible to RENAME across devices. There must be
no device specified in an EN command. The device is specified
in the ER command which selected the file.
>
	ERRGEN	ENO,< EN REQUIRES AN OPEN INPUT FILE
EN commands apply to the file currently open for input. You must
execute an ER command to select the file to be RENAME'd or deleted
before executing an EN.
>
	ERRGEN	ENT,< 13

00Illegal Output Filename "02"
ENTER UUO failure 0. The filename "02" specified for the
output file cannot be used. the format is invalid.

01Output UFD for the file "02" not found
ENTER UUO failure 1. The file 02 specified
for output by an EE, EW, EA, EZ, OR MAKE command cannot be created
because there is no user file directory with the project-programmer
number 05 on device 04.

02Output Protection Failure
ENTER UUO failure 2. The file 02 specified
for output by an EE, EA, EZ, EB, MAKE, or TECO command cannot be
created either because it already exists and is write-protected against
the user, or because the UFD it is to be entered into is write-
protected against the user.

03Output File being Modified
ENTER UUO failure 3. The file 02 specified for output
by an EE, EW, EA, EZ, EB, or TECO command cannot be created
because it is currently being created or modified by another job.

04File "02" already exists
ENTER UUO failure 4. Re-issue the command with the /SUPERSEDE switch,
if you really want to supersede the file.  Otherwise use a different
name, or (assuming you do not intend to read your current "ER" file
any more, do an "ER" to the file that would be superseded, and
an "E=newname$" to rename it.

06Output UFD or RIB Error
ENTER UUO failure 6. The output file 02 cannot be
created because a bad directory block was encountered by the
monitor while the ENTER was in progress. The user may try
repeating the EE, EW, EA, EB, or TECO COMMAND, BUT IF The ERROR
PERSISTS, IT IS IMPOSSIBLE TO PROCEED. Notify your system manager.

14No Room or Quota Exceeded on 04
ENTER UUO FAILURE 14. The output file 02 cannot be
created because there is no more free space on device 04 or
because the user's quota is already exceeded there.

15Write Lock on 04
ENTER UUO failure 15. The output file 02 cannot be
created because the output file structure is write-locked.

16Monitor Table Space Exhausted
ENTER UUO failure 16. The output file 02 cannot be
created because there is not enough table space left in the
monitor to allow the enter. The user may try repeating the
EE, EW, EA, EB, or TECO command, but if the error persists
he or she will have to wait till conditions improve.

23Output SFD Not Found
ENTER UUO failure 23. The output file 02 cannot be
created because the Sub-File-Directory on which it should be
entered cannot be found.

24Search List Empty
ENTER UUO failure 24. The output file 02 cannot be
created because the user's file structure search list is empty.

25Output SFD Nested Too Deeply
ENTER UUO failure 25. The output file 02 cannot be
created because the specified SFD path for the ENTER
is nested too deeply.

26No Create for Specified SFD Path
ENTER UUO failure 26. The output file 02 cannot be
created because the specified sfd path for the ENTER
is set for no creation.

41Undefined Network Node.
ENTER UUO failure 41.  The device 04 cannot be opened
because the node on which it resides is not on line. Try again later.
ENTER FAILURE 03 on Output File 02
The attempted ENTER of the output file 02 has failed and
the monitor has returned an error code of 03. This error
is not expected to occur on an ENTER. Please report it to your
systems manager with the tty printout showing what you were doing.
>
	ERRGEN	EOA,< 06EO Argument Too Large
The argument 06 given with an EO command is larger than the
standard (maximum) setting of eo=16 for this version of TECO10.
This must be an older version of TECO10 than the user thinks he
is using; the features corresponding to EO=06 do not exist.
>
	ERRGEN	FNF,< 13

00Input File 02 not Found
LOOKUP UUO failure 0. The file 02 specified for input by an
ER, EB, EI, EP, OR TECO command was not found on the
input device 04.

01Input UFD - not Found
LOOKUP UUO failure 1. The file 02 specified for input by
an ER, EB, EI, EP, OR TECO command cannot be found
because there is no User File Directory with project-programmer
number 05 on device 04.

02Input Protection Failure
LOOKUP UUO failure 2. The file 02 specified for input
by an ER, EB, EI, EP OR TECO command cannot be read
because it is read-protected 07 against the user.

06Input UFD or RIB Error
LOOKUP UUO failure 6. The input file 02 cannot be
read because a bad directory block was encountered by the
monitor while the LOOKUP was in progress.  The user may try
repeating the ER, EB, EI, EP OR TECO command, but if the error
persists all is lost.  Notify your system manager.

16Monitor Table Space Exhausted
LOOKUP UUO failure 16.  The input file 02 cannot be
read because there is not enough table space left in the
monitor to allow the LOOKUP.  The user may try repeating the
ER, EB, EI, EP, OR TECO command, but if the error persists
he or she will have to wait until conditions improve.

23Input SFD not Found
LOOKUP UUO failure 23. The input file 02 cannot be found
because the sub-file-directory on which it should be looked up
cannot be found.

24Search List Empty
LOOKUP UUO failure 24.  The input file 02 cannot be
found because the user's file structure search list is empty.

25Input SFD Nested Too Deeply
LOOKUP UUO failure 25. The input file 02 cannot be found
because the specified SFD path for the LOOKUP is
nested too deeply.

41Undefined Network Node.
LOOKUP UUO failure 41.  The device 04 cannot be opened
because the node on which it resides is not on line. Try again later.
Lookup Failure (03) on Input File 02
The attempted LOOKUP on the input file 02 has failed and
the monitor has returned an error code of 03. This error
is not expected to occur on a LOOKUP. Please give the
terminal prinout showing what you were doing to your system manager.
>
	ERRGEN	ICE,< Illegal ^E Command in Search Argument
A search argument contains a ^E command that is either not defined
or incomplete. The only valid ^E commands in search arguments are:
^EA, ^ED, ^EV, ^EW, ^EL, ^ES, ^E<NNN>, and ^E[A,B,C,...].
>
	ERRGEN	ICN,< Illegal ^N Command in Search Argument
When used in a search argument, the ^N command must be followed
by a character.
>
	ERRGEN	IDV,< Input Device 04 not Available
Open failure. Unable to initialize the device 04
for input. Either the device is being used by someone else right
now, or else it does not exist in the system.
>
	ERRGEN	IEC,< Illegal Character "00" After E
"E" was interpreted as part of a 2-letter command.
"E00" is not recognized as a command.
>
	ERRGEN	IEM,< Re-Init Failure on Device 04 After EM
Unable to re-initialize the device 04 after executing an
EM command on it.  If this error persists after retrying to
initialize the device with an ER command(or EW command
if output to the device is desired), consult your system manager.
>
	ERRGEN	IER,< Input Error While Reading a File
While reading an initialization, EI, EP, etc. an i/o error
occurred.
>
	ERRGEN	IES,< Input Error While Reading SWITCH.INI
An I/O error occurred whilst reading SWITCH.INI.
>
	ERRGEN	IFC,< Illegal Character "00" After F
"F" was interpreted as part of a 2-letter command.
"F00" is not recognized as a command.
>
	ERRGEN	IFS,< Illegal Character "00" in File Specification
File specifications must be of the form: DEV:FILE.TXT[PATH]
where DEV, FILE, and EXT are alphanumeric strings. No
characters other than these may appear between the EB, E&, EE, EI,
E=, EQ, E%, EW, or EZ command and the terminator.
>
	ERRGEN	ILL,< Illegal Command: 00
The character "00" is not defined as a valid TECO10 command.
>
	ERRGEN	ILM,< Illegal Memory Reference
TECO10 made an illegal memory reference.  This is an internal
error and should be reported, along with a teletype printout showing
what the user was doing.  The value of the buffer pointer is set to
the beginning of the buffer; the buffer and file should (hopefully)
remain intact.
>
	ERRGEN	ILR,< Cannot LOOKUP Input File 09 to RENAME it
Failure in rename process at close of editing job initiated by
an EB command or a TECO command. Unable to do a LOOKUP on the
original input file 10 in order to RENAME it to
"08.BAK". The output file is closed with the name "01".
The LOOKUP UUO error code is 03.
>
	ERRGEN	ILS,< Illegal EL Specification
A numeric specification for the EL command must be greater
than or equal to 0, and less than or equal to 3.
>
	ERRGEN	INP,< Input Error 11 on File 09
A read error has occurred during input. The input file 09
has been released. The user may try again to read the file, but if
the error persists, the user will have to return to his or her backup file.
The input device error flags (status word right half with bits 22-35
masked out) are 11 (14

01BLOCK TOO LARGE).

02PARITY OR CheCKSUM ERROR).

03BLOCK TOO LARGE AND PARITY ERROR).

04DEVICE ERROR, DATA MISSED).

05BLOCK TOO LARGE AND DEVICE ERROR).

06PARITY ERROR AND DEVICE ERROR).

07BLOCK TOO LARGE, PARITY ERROR, AND DEVICE ERROR).

10IMPROPER MODE).

11BLOCK TOO LARGE AND IMPROPER MODE).

12PARITY ERROR AND IMPROPER MODE).

13BLOCK TOO LARGE, PARITY ERROR, AND IMPROPER MODE).

14DEVICE ERROR AND IMPROPER MODE).

15BLOCK TOO LARGE, DEVICE ERROR, AND IMPROPER MODE).

16PARITY ERROR, DEVICE ERROR, AND IMPROPER MODE).

17BLOCK TOO LARGE, PARITY ERROR, DEVICE ERROR,
AND IMPROPER MODE).
>
	ERRGEN	IPA,< Illegal argument to "P" command
The "P" command can take a numeric argument, which is the number of
pages to move.  A negative argument is illegal.
>
	ERRGEN	IPP,< Illegal Character "00" in PPN
A PPN IS OF The FORM [PJ,PG,SFD1,...,SFDN]
WheRE "PJ", "PG", AND ",SFD1,...,SFDN" ARE OPTIONAL.
"PJ" AND "PG" MUST BE OCTAL NUMBERS. AN SFD is an alphanumeric
or quoted string.
>
	ERRGEN	IPR,< Illegal Character 00 in /PROTECT Switch
The format of the /PROTECT switch is: /PROTECT:NNN
Where NNN is an octal number and may optionally be
enclosed in angle brackets (ie: /protect:<nnn>.)
>
	ERRGEN	IQC,< Illegal Character "00" after " Command
The ONLY VALID " COMMANDS ARE "G, "L, "N, "E, "C,
"<, ">, "=, "R, "A, "D, "V, "W, "T, "F, "S, and "U.
>
	ERRGEN	IQN,< Illegal Character "00" in Q-Register Name
A Q-register name must be in one 2 formats:
(1)	X , where "X" is a printing character (except `,{,|,},~)
(2)	(FOO) where "FOO" is up to 6 alphanumerics, or is in quotes.
>
	ERRGEN	IQR,< Illegal Character "00" in Q-Register Name, please retype
The Q-register name given in the "*" command contains
an illegal character.  Re-type the "*" and a legal q-register name.
A Q-register name must be in one 2 formats:
(1)	X , where "X" is a printing character (except `,{,|,},~)
(2)	(FOO) where "FOO" is up to 6 alphanumerics, or is in quotes.
>
	ERRGEN	IRB,< Cannot Rename Input File 09 to 08.BAK
Failure in rename process at close of editing job initiated by an
EB command or a TECO command. The attempt to rename the original
input file 10 to the backup filename "08.BAK" 
has failed. The output file is closed with the name "01".
The RENAME UUO error code is 03.
>
	errgen	IRN,< Cannot Re-Init Device 04 for Rename Process
Failure in rename process at close of editing job initiated by
an EB command or a TECO command.  Cannot reinitialize
the original input device 04 in order to rename the input file
01 to 08.BAK.  The output file is closed with the
name 02.
>
	ERRGEN	ISW,< Illegal Character "00" in a Switch
AN ARGUMENT WAS EXPECTED AFTER The SWITCH "/19". A
COLON (:) WAS EXPECTED.
>
	ERRGEN	ITT,< Illegal TTCALL Type Value 06
The EXTENDED TTCALL command must take the form "arg1,arg2:^T"
where arg1 is the (optional) TTCALL argument and arg2 is the
TTCALL type in decimal. The second argument must be a
legitimate TTCALL type, With 0-13 legal except for 3(OUTSTR).
:8^T will do a RESCAN, :1,8^T tests for CCL entry point.
>
	ERRGEN	IUU,< Illegal LUUO
A local uuo was encountered which is not legal. This error
should not occur. close your files and report this problem
to your system manager.
>
	ERRGEN	LDV,< Cannot Access Log Device
I can't get that device for a log file, dummy!
>
	ERRGEN	LFE,< Cannot ENTER Log File
I can't make the file, dummy!
>
	ERRGEN	LLB,< Linked-list broken
This is an internal error.  The linked list of q-register values, etc.
is broken.  Try to save your edits and exit.  This is an internal error
which should be reported. Save your output.
>
	ERRGEN	MAP,< Missing '
Every conditional (opened with the " command) must be closed
with the ' command.
>
	ERRGEN	MCP,< Missing Control PDL
A pdl overflow was trapped and the control pdl was found to be
missing. This error should not occur. Close your files
and report the problem to your system manager.
>
	ERRGEN	MEE,< Macro Ending with E
A command macro being executed from a Q-register ends with the
character "E". This is an incomplete command.  E is the initial
character of an entire set of commands. The other character
of the command begun by E must be in the same macro with the E.
>
	ERRGEN	MEF,< Macro Ending with F
A command macro being executed from a Q-register ends with the
character "F". This is an incomplete command.  F is the initial
character of an entire set of commands. The other character
of the command begun by F must be in the same macro with the F.
>
	ERRGEN	MEO,< Macro Ending with Unterminated O Command
The  last command in macro "18" is an "O" command with no
delimiter to mark the end of the tag-name.
>
	ERRGEN	MEQ,< Macro Ending with "
The macro "18" ends with a " character.  This is an
incomplete command.  " must be followed by G, L, N, E, C, A, D,
V, W, T, F, S, or U to indicate the condition under which the
following commands are to be executed. This character must be in
the Q-register with the ".
>
	ERRGEN	MEU,< Macro Ending with ^
The macro "18" ends with a ^ character.  This is an
incomplete command.  ^ followed by a character converts the character
into a control character for command parsing.  The
character was not there.
>
	ERRGEN	MIQ,< Macro Ending with "00"
The macro "18" ends with the "00" command.
This command requires a Q-register name of 1 character
or up to 6 characters in parentheses.
>
	ERRGEN	MLA,< Missing Left Angle Bracket
There is a right angle bracket that has no
matching left angle bracket.  An iteration must
be complete within the macro or command.
>
	ERRGEN	MLP,< Missing (
There is a right parenthesis that is not matched
by a corresponding left parenthesis.
>
	ERRGEN	MRA,< Missing Right Angle Bracket
There is a left angle bracket that has no
matching right angle bracket.  An iteration must
be complete within the macro or command.
>
	ERRGEN	MRP,< Missing )
There is a right parenthesis that is not matched
by a corresponding left parenthesis.
>
	ERRGEN	MSC,< Missing Start of Conditional
A ' command (end of conditional) was encountered.  Every '
command must be matched by a preceding " (start of conditional)
command.
>
	ERRGEN	MUU,< Macro Ending with ^^
The macro "18" ends with either a control-^
or ^^. This is an incomplete command. The ^^command takes
a single character text argument that must be in the Q-register
with the ^^.
>
	ERRGEN	NAE,< No Argument Before =
The command N= or N== causes that value N to be typed. The
= command must be preceded by either a specific numeric
argument or a command that returns a numeric value.
>
	ERRGEN	NDI,< No Delimiter After I
If the I command has a numeric argument it must be followed
by a null text string i.e.: 33I$ or 33@i//
>
	ERRGEN	NAQ,< No Argument Before "
The " command must be preceded by a single numeric argument
on which the decision to execute the following commands
or skip to the matching ' is based.
>
	ERRGEN	NAU,< No Argument Before U
The command NUI stores the value N in Q-register I.
The U command must be preceded by either a specific numeric
argument or a command that returns a numeric value.
>
	ERRGEN	NFI,< No File for Input
Before issuing an input command (Y, ^Y,  or A) it is necessary
to open an input file by use of an ER, EB, or TECO command.
>
	ERRGEN	NFO,< No File for Output
Before giving an output command (PW, P, ^P, N, EX, or EG) it is
necessary to open an output file by use of an EA, EB, EW, EZ, MAKE,
or TECO command.
>
	ERRGEN	NLF,< No Log File Open
A command of the form nEL was given, but there is no log file
open to have parameters modified.
>
	ERRGEN	NSI,< Null Switch Name is Illegal
A switch name must consist of one or more alphanumeric characters.
>
	ERRGEN	NTQ,< No text in Q-register
The Q-register "19" does not contain text.
>
	ERRGEN	NYA,< Numeric argument to "Y" or "EY" command
The "Y" command does not take numeric arguments.
Did you type "0YY" instead of "0TT"?
>
	ERRGEN	ODV,< Output Device 04 Not Available
Initialization failure. Unable to initialize the device 04
for output. Either the device is being used by someone else
right now, or it is write locked, or else it does not exist in
the system.
>
	ERRGEN	OFO,< EW Before Current Output file Closed
An EB,EW,EA, or EZ command may not be given while an output file is open.
Give an EF to close the file if you wish to save the output file as it is,
or an EK to throw away the current output file.
>
	ERRGEN	OUT,< Output Error 11. Output File 10 Closed
An error on the output device is fatal.
The output file is closed at the end of the last data that
was successfully output. It has the filename "01".
See the TECO Reference Manual section 4.4 for a recovery
technique. The output device flags (status word right half
with bits 22-35 masked out) are 11 (14

00End of Tape).

01Block Number Too Large, Device Full or Quota Exceeded).

02Parity or Checksum Error).

Block Number Too Large and Parity Error).

04Device Error, Data Missed).

05Block Number Too Large and Device Error).

06Oarity Error and Device Error).

07Block Number Too Large, Parity Error, and Device Error).

10Improper Mode or Device Write Locked).

11Block Number Too Large and Improper Mode).

12Parity Error and Improper mode).

13Block Number Too Large, Parity Error, and Improper Mode).

14Device Error and Improper Mode).

15Block Number Too Large, Device Error, and Improper Mode).

16Parity Error, Device Error, and Improper Mode).

17Block Number Too Large, Parity Error, Device Error,
and Improper Mode).
>
	ERRGEN	OWL,< OUTPUT ERROR writing LOG FILE
AN OUTPUT ERROR OCCURED, DUMMY!
>
	ERRGEN	PAR,< Confused Use of Parentheses
An iteration may not be contained within a parenthesized expression.
>
	ERRGEN	PES,< Attempt to Pop  Empty Stack
A ] command (pop off q-register stack into a q-register) was
encountered when there was nothing on the q-register stack.
>
	ERRGEN	PNF,< Page Number 06 Not Found
An attempt to move to page 06 of the input file 02
was made with the ^P or ^Y command. that page does not exist in the
input file.
>
	ERRGEN	POP,< Attempt to move Pointer Off Page.
The argument specified with a J, C, R, or D command must point to
a position within the current size of the buffer. (ie: between B
and Z inclusive.)  This can also occur on a "]()" command since
the numeric value will be used for ".".
This can also occur with the nA command (A with numeric argument)
if (.+n) attempts to access a character off either end of the buffer.

>
	ERRGEN	PPC,< Attempt to Move Previous to Current page with ^P or ^Y
The argument to a ^P or ^Y command is an absolute page number in the
file. it must be greater than or equal to the current page number.
>
	ERRGEN	PTS,< PDL Table Too Small
There are not enough ENTRIES in the pdl table. This error is not
expected to occur. Close your files and report the problem to your
system manager.
>
	ERRGEN	RNF,< 13

01UFD for 02 Not Found
RENAME UUO failure 1. The new filespec 01 specified
by an EN command cannot be used because there is no directory
05 on device 04.

02Protection Failure for 01
RENAME UUO faulure 2. the filespec 01 specified
by an EN command cannot be used because you are not privileged
to RENAME the input file.

03File Being Modified
RENAME UUO failure 3. The filespec 02 specified
by an EN command cannot be used because the input file is being
modified by someone.

04Rename Filename 02 already exists
RENAME UUO failure 4. The filespec 02 specified
by an EN command could not be used because there is already
a file by that name.

06UFD or RIB Error
RENAME UUO failure 6. The filespec 02 specified
by an EN command could not be used because a bad directory
block was encountered by the monitor. Notify your system manager.

22Cannot Delete a Non-Empty Directory
RENAME UUO failure 22. The filespec 02 specified
by an EN command could not be used because the input file was
a directory which was not empty, and therefore cannot be deleted.

23Output SFD Not Found
RENAME UUO failure 23. The output file 02 specified
by an EN command could not be used because the Sub-File-Directory
on which the file should be placed does not exist.
RENAME failure 03 for 02
The attempted Rename of the Input file has failed and
the monitor has returned an error code of 03. This error should
probably not happen on a RENAME. Please report
the problem to your systems manager.
>
	ERRGEN	RNO,< Cannot Rename Output File 01
Failure in rename process at close of EDITING job initiated by
an EB command or a TECO command. The attempt to rename the output
file 01 to the name "10" originally specified in the
EB or TECO command has failed. The original input file 10
as been renamed "08.BAK", BUT The OUTPUT FILE IS CLOSED WITH
The NAME "01". The RENAME UUO error code is 03.
>
	ERRGEN	SEF,< Superceding Existing File: 02
The output file 02 already exists on 04.
This message is warning the user that his or her existing file is
being overwritten.
>
	ERRGEN	SNA,< Initial Search With No Argument
A search command with null argument has been given, but there
was no preceding search command from which the argument could be
taken.
>
	ERRGEN	SNI,< ; Not in Iteration
The semicolon command may be used only in an iteration.
>
	ERRGEN	SRH,< Cannot Find "17"
A search command not preceded by a colon modifier and not
within an iteration has failed to find the specified character
string "17".
If an S, FS, FD, or any negative or bounded search fails, the pointer is
unchanged. After an n or _ search fails, the last page of the
input file has been read and, in the case of N, output, and the
buffer cleared.
>
	ERRGEN	STC,< Search String Too Long
The maximum length of a search string is 80 characters, including
all string control commands and their arguments.
>
	ERRGEN	STL,< Search String Too Long
The maximum length of a search string is 36 character positions,
not counting extra characters required to specify a single position.
>
	ERRGEN	TAG,< Missing Tag !12!
The tag !12! specified by an O command cannot be found.
This tag must be in the same macro level as the O command
referencing it.
>
	ERRGEN	TAL,< Two Arguments With L
The L command takes at most one numeric argument, namely, the
number of lines over which the buffer pointer is to be moved.
>
	ERRGEN	TSD,< Too Many Nested SFD'S
The number of Sub-File-Directories specified in
a path exceeds the number allowed by TECO10. If desired, the user
may re-assemble TECO10 with 'C$SFDL' equal to the desired
nesting level of SFD'S.
>
	ERRGEN	TTY,< Illegal TTY I/O Device
A teletype may be specified as an input/output device in an
ER, EW, EZ, or MAKE command only if it is not being used
to control an attached job, the user's own  terminal.
>
	ERRGEN	UAT,< Unenabled APR Trap
An APR trap occurred which was not enabled. This
error should not occur. Please report it to your systems manager.
>
	ERRGEN	UCA,< Unterminated ^A Command
A ^A message type-out command has been given,
but there is no corresponding ^A to mark the end
of the message. ^A commands must be complete within a
single macro level.
>
	ERRGEN	UEN,< Unimplemented "EN" command
The EN command is not implemented, sorry.
>
	ERRGEN	UFS,< Macro Ending with Unterminated File Selection Command
The last command in the macro "18" is a file selection command
(ER, EW, EB, ED, EL, EI, EN, or EZ) with no delimiter to mark the
end of the file specification.
The file selection command must be complete within the Q-register.
>
	ERRGEN	UIN,< Unterminated Insert Command
An insert command (possibly an @ insert command) has been given
without terminating the text argument at the same macro level.
>
	ERRGEN	UQN,< Unterminated Q-Register Name (missing ) )
If a multi-character q-register name is specified, it must be
terminated by a right parenthesis. the format is:
<command>(<q-reg-name>)
>
	ERRGEN	USN,< Unknown Switch Name: /19
The switch "/19" is not defined with either input or output
file selection commands. The currently implemented switches are:
/PROTECT, /ASCII, /LSN, /NOIN, /NOOUT, /APPEND, /SIXBIT, /OCTAL,
/NONSTD, /GENLSN, and /SUPLSN.
>
	ERRGEN	USR,< Unterminated Search Command
A search command (possibly an @ search command) has been given
without terminating the text argument at the same macro level.
>
	ERRGEN	UTG,< Unterminated Tag
A command string tag has been indicated by a ! command,
but there is no corresponding ! to mark the end of the tag.
Tags must be complete within a single command level.
>
	ERRGEN	VAI,< Version incompatability
The current version of TECO10 may be incompatable with save files
written with the EE command with an old version of TECO10.
Re-compile all your macros and re-issue the EE command if possible.
If this is not possible, it may be possible to continue, but random
errors may occur.
>
	ERRGEN	XTB,< Attempt to execute the Text editing Buffer.
The Q-register 18 is currently sharing with the blank Q-register,
which is the Text-editing buffer.  Do "HX18m18".
>
	ERRGEN	XXX,< Should Not Occur.
Please report this problem to your systems manager as soon as
possible. sorry for the inconvenience. try to close your files
if possible.
>
	ERRGEN	YCA,< "Y" or "_"  command aborted due to non-empty buffer
The "Y" and "_" commands are only legal if the editing buffer is empty,
or if 2ED is set, or in a macro.
"EY" is the same command as "Y" but without this restriction.
"E_" is the same command as "_" but without this restriction.
>

; NOW, DEFINE THE INDEX TABLE

	DEFINE	%EGEN(CODE)<''CODE'',,E$$'CODE>

	INFO.	<DEFINE %TABLE>

ERRTAB:	LSTOF.
%TABLE
	LSTON.

ERRLEN==.-ERRTAB	; DEFINE LENGTH OF TABLE

>;; END FOR FTXTCERR
FOR FTXTEC,<
	SUBTTL	GXXXXX - Character Input Routines

; GFSPEC - SCAN A FILE SPECIFICATION AND STORE IN A FILE SPEC BLOCK
;
; SEE PARAMETER DEFINITIONS FOR FORMAT OF A FILE SPEC BLOCK
;
; CALL:	MOVEI	L,FILE.SPEC.BLOCK
;	PUSHJ	P,GFSPEC
;	(RETURN)
;
; SMASHES ACS X,C,N,T1,T2,T3,T4

;GFSPEC:	PUSH	P,.		;[23000] No delmiter if entered here
;	PUSHJ	P,GFSPED	;[24000] So call other one
;	POP	P,(P)		;[24000] Fix up stack
;	POPJ	P,		;[24000] And return


; GFSPED - Same as GFSPEC except takes a delimiter on Stack

GFSPED:	MOVX	T4,FB$$IO	; FETCH IMAGE OF I/O FLAGS FOR FILE-SPEC
	AND	T4,FS$FLG(L)	; AND KEEP PREVIOUS I/O FLAGS

GFS0:	PUSHJ	P,GSIX		; PICK UP A SIXBIT NAME
	JUMPE	N,GFS1		; NONE THERE
	PUSHJ	P,GCHR		; PICKUP CHAR AFTER SIXBIT NAME
	CAIE	C,":"		; IS NAME A DEVICE NAM?
	 JRST	GFSNAM		; NO, IT'S A FILE NAME

; STORE DEVICE NAME

	MOVEM	N,FS$DEV(L)	; STORE THE DEVICE NAME IN SILE SPEC BLOCK
	TXO	T4,FB$DEV	; FLAG THAT DEVICE WAS SEEN
	JRST	GFS0		; AND TRY FOR MORE OF FILE SPEC

; PICK UP NEXT CHAR

GFS1:	PUSHJ	P,GCHR		; PICKUP THE NEXT CHAR

; DISPATCH FOR SPECIAL FILESPEC DELIMITERS

GFS2:	CAMN	C,-1(P)		;[24000] Check delimiter
	 JRST	GFS9		;[23000] That's it, end of file spec
	CAIN	C,"."		; "."?
	 JRST	GFSEXT		; YES, FILE EXTENSION FOLLOWS
	CAIE	C,.CHLAB	; LEFT ANGLE BRACKET?
	 CAIN	C,"["		; "["?
	  JRST	GFSPTH		; YES, PATH FOLLOWS
	CAIN	C,"/"		; "/"?
	 JRST	GFSSWI		; YES, SWITCH FOLLOWS
	CAIE	C,.CHSPC	; IS CHAR A BLANK?
	 CAIN	C,.CHTAB	; OR A TAB?
	  JRST	GFS1		; YES, IGNORE IT
GFS9:	MOVEM	T4,FS$FLG(L)	; NO. STORE FILE SPEC FLAGS
	POPJ	P,		; AND RETURN TO CALLER

; STORE FILE NAME

GFSNAM:	MOVEM	N,FS$NAM(L)	; STORE THE FILE NAME IN SPEC BLOCK
	TXO	T4,FB$NAM	; FLAG THAT A FILE NAME WAS SEEN
	JRST	GFS2		; AND CHECK THE DELIMITER CHAR
; STORE FILE EXTENSION

GFSEXT:	PUSHJ	P,GSIX		; SCAN THE FILE EXTENSION
	MOVEM	N,FS$EXT(L)	; AND STORE IT IN THE SPEC BLOCK
	TXO	T4,FB$EXT	; FLAG THAT A FILE EXT WAS SEEN
	JRST	GFS1		; AND GO BACK FOR MORE

; STORE PATH: [-], [PJ,PG],[PJ,PG,SFD1,...,SFDN] (PJ AND/OR PG MAY BE NULL)

GFSPTH:	TXO	T4,FB$PTH	; FLAG THAT SOME SORT OF PATH SEEN
	PUSHJ	P,GCHR		; FETCH NEXT COMMAND CHAR
	CAIE	C,"-"		; "-"?
	 JRST	GFSP3		; NO
	SETZM	FS$PPN(L)	; YES, DEFAULT DIRECTORY IS ZERO PPN
	TXO	T4,FB$DDR	; FLAG THAT DEFAULT DIRECTORY SEEN

	PUSHJ	P,GCHR		; FETCH NEXT CHAR
GFSP2:	CAIE	C,.CHRAB	; NORMAL PATH TERMINATION?
	 CAIN	C,"]"		; . . . ?
	  JRST	GFS0		; YES,
	MOVEM	C,INPCHR	; NO, DON'T LOSE THE CHAR
	JRST	GFS0		; AND GO BACK FOR MORE OF FILE SPEC

GFSP3:	CAIG	C,"7"		; IS CHAR AN OCTAL DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  JRST	GFSP4		; NO
	MOVEM	C,INPCHR	; YES, REPEAT THE DIGIT
	PUSHJ	P,GOCT		; AND SCAN THE OCTAL PROJECT NUMBER
	HRLM	N,FS$PPN(L)	; STORE THE PROJECT NUMBER
	TXO	T4,FB$PRJ	; FLAG THAT PROJECT NUMBER SEEN
	PUSHJ	P,GCHR		; AND FETCH NEXT CHAR

GFSP4:	CAIE	C,","		; IS IT A COMMA?
	 JRST	[CAIE C,.CHRAB;[23000] Protection?
		  ERROR (IPP)	; NO, ** ILLEGAL PPN **
		 JRST SWPRO9]	;[23000] Yes, store it
	PUSHJ	P,GCHR		; YES, FETCH NEXT CHAR
	CAIG	C,"7"		; IS IT AN OCTAL DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  JRST	GFSP5		; NO
	MOVEM	C,INPCHR	; YES, REPEAT THE CHAR
	PUSHJ	P,GOCT		; AND SCAN THE PROGRAMMER NUMBER
	HRRM	N,FS$PPN(L)	; AND STORE THE PROGRAMMER NUMBER
	TXO	T4,FB$PRG	; FLAG THAT PROGRAMMER NUMBER WAS SEEN
	PUSHJ	P,GCHR		; FETCH THE NEXT CHAR

GFSP5:	CAIE	C,","		; IS IT A ","?
	 JRST	GFSP2		; NO
; SFD'S

IFE C$SFDL,<ERROR (TSD)>	; SFD'S NOT ALLOWED
IFN C$SFDL,<
	TXO	T4,FB$SFD	; FLAG THAT SFDS SEEN
	MOVE	T3,[XWD -C$SFDL,FS$SFD] ; FETCH AOBJN POINTER FOR SFD'S
	ADDI	T3,(L)		; POINTS INTO FILE.SPEC BLOCK

GFSSFD:	PUSHJ	P,GSIX		; PICK UP AN SFD NAME
	MOVEM	N,(T3)		; AND STORE IN FILE SPEC BLOCK
	PUSHJ	P,GCHR		; FETCH THE DELIMITER
	CAIE	C,","		; MORE SFD'S TO COME?
	 JRST	GFSP2		; NO
	AOBJN	T3,GFSSFD	; YES
	ERROR	(TSD)		; ** TOO MANY NESTED SFD'S **
>;; END IFN C$SFDL

; SWITCHES

GFSSWI:	PUSHJ	P,GSIX		; PICK UP THE SWITCH NAME
	JUMPE	N,[ERROR (NSI)]	; ** NULL SWITCH ILLEGAL **
	PUSH	P,L		; SAVE AC L
	MOVE	L,[IOWD SWILTH,SWITBL+1] ; FETCH PTR TO SWITCH TABLE
	PUSHJ	P,MATCH		; AND LOOKUP THE SWITCH NAME
	 ERROR	(USN)		; ** UNKNOWN SWITCH NAME **
	 ERROR	(ASN)		; ** AMBIGUOUS SWITCH NAME **
	MOVE	X,SWILTH(L)	; FETCH DISPATCH ADR
	POP	P,L		; RESTORE AC L
	JRST	(X)		; AND DISPATCH TO THE SWITCH HANDLER

	DEFINE	SWI
<	PAIR	PROTEC,SWPRO
	PAIR	EXECUT,SWEXE
	PAIR	LSN,SWLSN
	PAIR	ASCII,SWASC
	PAIR	SIXBIT,SWSIX
	PAIR	OCTAL,SWOCT
	PAIR	GENLSN,SWGEN
	PAIR	SUPLSN,SWSUP
	PAIR	APPEND,SWAPP	;;[330] /APPEND
	PAIR	NOOUT,SWNOO	;;[330] /NOOUT
	PAIR	NOIN,SWNOI	;;[330] /NOIN
	PAIR	NONSTD,SWNON	;;[334] /NONSTD
	PAIR	DELETE,SWDEL	;[15000] /DELETE (for temp files & TMPCOR)
	PAIR	SUPERS,SWDEL	;[20000] /SUPERCEDE for E% & EW
	PAIR	INPLAC,SWDEL	;[23000] /INPLACE (for EB)
	PAIR	BINARY,SWOCT	;[23000] /BINARY (no zap nulls)
>
	GEN	(SWI)		; GENERATE THE SWITCH TABLE
; SWPRO - /PROTECT:<NNN> - FILE PROTECTION

SWPRO:	PUSHJ	P,GCHR		; MAKE SURE A COLON FOLLOWS
	CAIE	C,":"		; DOES ONE?
	 ERROR	(ISW)		; NO, ** ILLEGAL SWITCH **
	PUSHJ	P,GCHR		; YES, FETCH NEXT CHAR
	CAIN	C,.CHLAB	; LEFT ANGLE BRACKET?
	 PUSHJ	P,GCHR		; YES, IGNORE IT
	CAIG	C,"7"		; AN OCTAL DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  ERROR	(IPR)		; NO, ** ILLEGAL PROTECTION **
	MOVEM	C,INPCHR	; YES, REPEAT THE DIGIT
	PUSHJ	P,GOCT		; AND PICK UP THE WHOLE OCTAL NUMBER
	PUSHJ	P,GCHR		; FETCH NEXT CHAR
SWPRO9:	LSH	N,^D27		; PUT NUMBER IN FILE PROTECTION FIELD
	MOVEM	N,FS$PRV(L)	; AND STORE IN FILE SPEC
	TXO	T4,FB$PRV	; FLAG THAT /PROTECT:<NNN> SEEN
	CAIE	C,.CHRAB	; IS IT RIGH-ANGLE-BRACKET?
	 MOVEM	C,INPCHR	; NO, REPEAT THE CHAR
	JRST	GFS0		; AND GO BACK FOR MORE OF FILE SPEC

; SWEXE - /EXECUTE - FORCES AN "EI" ON FILE

SWEXE:	TXOA	T4,FB$EXE	; SET THE "/EXECUTE" FLAG

; SWLSN - /LSN - KEEP LINE-SEQUENCE NUMBERS IF A FILE HAS THEM

SWLSN:	TXO	T4,FB$LSN	; SET /LSN
	JRST	GFS0		; AND CONTINUE FILE-SPEC SCAN

; SWASC - /ASCII - DON'T CHECK FOR LINE-SEQUENCE-NUMBERS

SWASC:	TXOA	T4,FB$ASC	; SET /ASCII


; SWSIX - /SIXBIT - FILE IS IN SIXBIT FORMAT

SWSIX:	TXO	T4,FB$SIX	; SET /SIXBIT
	JRST	GFS0		; AND CONTINUE FILE-SPEC SCAN

; SWOCT - /OCTAL - FILE IS A BINARY FILE

SWOCT:	TXOA	T4,FB$OCT	; SET /OCTAL


; SWGEN - /GENLSN - GENERATE LINE-SEQUENCE NUMBERS ON OUTPUT

SWGEN:	TXO	T4,FB$GEN	; SET /GENLSN
	JRST	GFS0		; AND CONTINUE FILE-SPEC SCAN

; SWSUP - /SUPLSN - SUPPRESS LINE-SEQUENCE-NUMBERS ON INPUT

SWSUP:	TXOA	T4,FB$SUP	; SET /SUPLSN


; SWAPP - /APPEND - APPEND THIS LOG TO LOG FILE

SWAPP:	TXO	T4,FB$APP	;[330] SET /APPEND
	JRST	GFS0		;[330] AND CONTINUE FILE-SPEC SCAN

; SWNOO - /NOOUT - DO NOT GENERATE OUTPUT

SWNOO:	TXOA	T4,FB$NOO	;[330] SET /NOOUT


; SWNOI - /NOIN - DO NOT GENERATE INPUT

SWNOI:	TXO	T4,FB$NOI	;[330] SET /NOIN
	JRST	GFS0		;[330] AND CONTINUE FILE-SPEC SCAN

; SWDEL - /DELETE - DELETE (TMPCOR FILE) AFTER READING

SWDEL:	TXOA	T4,FB$DEL	;[15000]

; SWNON - /NONSTD - OPEN DECTAPE IN NON STANDARD MODE

SWNON:	TXO	T4,FB$NON	;[334] SET /NONSTD
	JRST	GFS0		;[334] AND CONTINUE FILE-SPEC SCAN
; GSIX - GET A SIXBIT NAME
;
; CALL:	PUSHJ	P,GSIX
;	(RETURN)		; WITH NAME IN AC N, MASK IN AC M
;
; USES ACS C,N,M,T1,T2,T3

GSIX:	MOVE	T1,[POINT 6,N]	; SETUP BP TO NAME
	SETZB	N,M		; CLEAR NAME AND MASK
	MOVSI	T2,'_  '	; SETUP THE MASKING WORD
	PUSHJ	P,GCHR		; FETCH FIRST CHAR
	CAIN	C,"*"		; IS IT "*"?
	 JRST	GSIX2		; YES, HANDLE SPECIALLY
	CAIE	C,""""		; A QUOTED SIXBIT NAME?
	 CAIN	C,"'"		; . . . ?
	  JRST	GSIX3		; YES
	SKP			; NO

GSIX1:	 PUSHJ	P,GCHR		; FETCH NEXT CHAR
	PUSHJ	P,CHKSCB		;[10000]  IS IT A LETTER/DIGIT? or &_%$
	 JRST	RPOPJ		; NO, REPEAT IT AND RETURN TO CALLER
	MOVEI	C,'A'-"A"(C)	; YES, CONVERT THE CHAR TO SIXBIT
	TRNN	N,'_'		; ROOM FOR ANOTHER CHAR IN NAME?
	 IDPB	C,T1		; YES, STORE THE CHAR IN NAME
	IOR	M,T2		; AND MASK THE CHAR
	LSH	T2,-6		; SHIFT THE MASKING WORD
	JRST	GSIX1		; AND TRY FOR ANOTHER CHAR

; '*' IS A SPECIAL NAME (IE: 'ALL')

GSIX2:	SETZ	M,		; CLEAR THE MASK
	MOVSI	N,'*  '		; SET NAME TO '*     '
	POPJ	P,		; AND RETURN TO CALLER

; SCAN A QUOTED SIXBIT NAME

GSIX3:	MOVEI	T3,(C)		; SAVE THE DELIMITER CHAR

GSIX4:	PUSHJ	P,GCHR		; PICK UP THE NEXT CHAR
	CAIE	C,(T3)		; IS IT THE DELIMITER?
	 JRST	GSIX5		; NO
	PUSHJ	P,GCHR		; YES, PICK UP THE NEXT CHAR
	CAIE	C,(T3)		; TWO OCCURRANCES OF THE DELIMITER?
	 JRST	RPOPJ		; NO, FINISH UP AND RETURN TO CALLER

GSIX5:	CAIL	C,140		;[14000] In LC range?
	 MOVEI	C,-40(C)	;[14000] Yes, but not any more
	MOVEI	C,'A'-"A"(C)	; CONVERT CHAR TO SIXBIT
	TRNN	N,'_'		; ROOM IN NAME FOR CHAR?
	 IDPB	C,T1		; YES, STORE CHAR IN NAME
	IOR	M,T2		; FILL IN MASK FOR CURRENT POSITION
	LSH	T2,-6		; AND SHIFT IT TO NEXT POSITION
	JRST	GSIX4		; AND TRY FOR ANOTHER CHAR

RPOPJ:	MOVEM	C,INPCHR	; STORE THE CHAR SO IT REPEATS NEXT TIME
	POPJ	P,		; AND RETURN TO CALLER
; GOCT - GET AN OCTAL NUMBER
;
; CALL:	PUSHJ	P,GOCT
;	(RETURN)		; WITH OCTAL NUMBER IN AC N
;
; SMASHES ACS X,C,N

GOCT:	SETZ	N,		; CLEAR NUMBER

GOCT0:	PUSHJ	P,GETCH		; FETCH NEXT CHAR
	CAIG	C,"7"		; IS CHAR AN OCTAL DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  JRST	RPOPJ		; NO, REPEAT THE CHAR AND RETURN TO CALLER
	LSH	N,3		; MAKE ROOM FOR THE OCTAL DIGIT
	IORI	N,-"0"(C)	; AND ADD IN THE OCTAL DIGIT
	JRST	GOCT0		; AND CONTINUE

; GEOL - EAT CHARS TILL END OF LINE SEEN
;
; CALL:	PUSHJ	P,GEOL
;	(RETURN)
;
; USES AC C

GEOL:	SETZM	INPCHR		;[315] CLEAR SAVED CHAR
	TXZE	F,F$EOL		; END OF LINE YET?
	 POPJ	P,		; YES, CLEAR AND RETURN TO CALLER
	PUSHJ	P,GCHR		; NO, FETCH NEXT CHAR
	JRST	GEOL		; AND SEE IF END OF LINE YET

; GCHR - GET NEXT CHAR AND CHECK IF END OF LINE
;
; CALL:	PUSHJ	P,GCHR
;	(RETURN)		; WITH CHAR IN AC C
;
; USES AC C

GCHR:	PUSHJ	P,GETCH		; FETCH NEXT INPUT CHAR
	CAIN	C,.CHCNZ	; A CONTROL-Z?
	 TXO	F,F$EOL		; YES, SET END OF LINE
	CAIE	C,.CHESC	; ALTMODE?
	 CAIG	C,.CHFFD	; <LF>,<VT>,OR <FF>?
	  CAIGE	C,.CHLFD	; . . . ?
	   POPJ	P,		; NO, JUST RETURN TO CALLER
	TXO	F,F$EOL		; YES, SET EOL
	POPJ	P,		; AND RETURN TO CALLER

>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
; GETCHL - GET NEXT INPUT CHARACTER FROM CURRENT INPUT SOURCE
;		(IN LINE MODE [12000])
;
; CALL:	PUSHJ	P,GETCHL
;	(RETURN)		; WITH CHAR IN AC C
;
; USES AC C and X

GETCHL:
IFE TOPS20,<
	SKIPE	C,INPCHR	; REPEAT THE LAST CHAR?
	 JRST	GETCHF		; YES
	SKIPE	C,INPADR	; ADR OF AN INPUT ROUTINE?
	 PJRST	(C)		; YES, GO TO IT
	TXNE	F,F$NTI		; INPUT FROM USER'S TERMINAL?
	 JRST	GETCH2		; NO, FROM SOMEWHERE ELSE

; INPUT A CHAR FROM USER'S TERMINAL IN LINE MODE

	SKIPE	TTOBUF		;[12000] Check for pending TTY output
	 PUSHJ	P,FOUT		;[12000] Force it out now
GETCLW:	INCHWL	C		; INPUT A CHAR INTO AC C
	JRST	CKLOGI		;[12000] See if log file in use
>;END IFE TOPS20

; GETCH - GET NEXT INPUT CHARACTER FROM CURRENT INPUT SOURCE
;
; CALL:	PUSHJ	P,GETCH
;	(RETURN)		; WITH CHAR IN AC C
;
; USES AC C and X

GETCH:	SKIPN	C,INPCHR	; REPEAT THE LAST CHAR?
	 JRST	GETCH0		; NO
GETCHF:!SETZM	INPCHR		; YES, CLEAR THE SAVED CHAR
	POPJ	P,		; AND RETURN TO CALLER WITH THE LAST CHAR

GETCH0:	SKIPE	C,INPADR	; ADR OF AN INPUT ROUTINE?
	 PJRST	(C)		; YES, GO TO IT
	TXNE	F,F$NTI		; INPUT FROM USER'S TERMINAL?
	 JRST	GETCH2		; NO, FROM SOMEWHERE ELSE

; INPUT A CHAR FROM USER'S TERMINAL

	SKIPE	TTOBUF		;[12000] Check for pending TTY output
	 PUSHJ	P,FOUT		;[12000] Force it out
GETCHW:	INCHRW	C		; INPUT A CHAR INTO AC C

; PUNCH CHAR TO LOG FILE IF I SAID SO

CKLOGI:	TXNN	F,F$LOG		;[330] DID I SAY SO?
	JRST	NOLOGI		;[330] NO LOG INPUT
	MOVE	X,LELSPC+FS$FLG	;[330] GET LOG FLAGS
	TXNE	X,FB$NOO	;[330] AM I ALLOWED TO RECORD INPUT?
	PUSHJ	P,LOGPH1	;[330] RECORD INPUT

; IF CHAR IS ^D, THEN ENTER DDT

NOLOGI:	SKIPE	.JBDDT		; DO WE HAVE DDT?
	 CAIE	C,.CHCND	; AND IS CHAR A ^D?
	  POPJ	P,		; NO, JUST RETURN WITH THE CHAR

	MOVE	C,.JBDDT	; FETCH DDT START ADR
GODDT::	PUSHJ	P,(C)		; PUSHJ TO DDT
	JRST	GETCH		; BACK FROM DDT. INPUT ANOTHER CHAR

; INPUT A CHAR. NOT FROM USER'S TERMINAL

GETCH2:	MOVE	X,INPBH		; FETCH ADR OF INPUT BUFFER HEADER
GETCH3:	SOSGE	.BFCTR(X)	; ANY CHARS LEFT IN BUFFER?
	 JRST	GETCH4		; NO
	ILDB	C,.BFPTR(X)	; YES, FETCH NEXT ONE
	JUMPE	C,GETCH3	; IGNORE NULLS
	POPJ	P,		; RETURN WITH CHAR

; FETCH NEW INPUT BUFFER

GETCH4:	MOVSI	X,(IN)		; SETUP THE IN OPCODE
	IOR	X,INPCHN	; "OR" IN THE CHANNEL
	XCT	X		; DO THE "IN"
	 JRST	GETCH2		;  AND GET CHAR FROM BUFFER
	MOVE	X,[STATO 0,IO.EOF] ; FAILED. SEE WHAT HAPPENED
	IOR	X,INPCHN	; FILL IN THE CHANNEL
	XCT	X		; DO THE "STATO CH,IO.EOF"
	 JRST	@INPERR		; SOME RANDOM INPUT ERROR
	PUSHJ	P,@INPEOF	; END OF FILE
	POPJ	P,		; RETURN TO CALLER AFTER EOF
	SUBTTL	LOGPCH - PUNCH A CHARACTER TO LOG FILE

; LOGPCH - PUNCH A CHARACTER TO LOG FILE

LOGPCH:	SOSGE	LOGBH+2		;[330] ROOM IN LOG BUFFER?
	JRST	LOGP1		;[330] NO
	IDPB	C,LOGBH+1	;[330] YES, STORE CHARACTER IN LOG BUFFER
	POPJ	P,		;[330] AND RETURN TO CALLER

; ASK MONITOR FOR A NEW LOG BUFFER

LOGP1:	OUT	LOG,		;[330] OUTPUT TO LOG
	JRST	LOGPCH		;[330] AND CONTINUE
for ftxtec,ERROR (OWL)		;[330] ** OUTPUT ERROR WRITING LOG **
for ftxtcerr,<
	outstr	e$$owl		;[326] no endless loops
	jrst	logpch		;[326] continue
>;; end for ftxtcerr
for ftxtec!ftxtcerr,sall	; restore listing

; LOGPH1 - PUNCH AN INPUT CHARACTER TO LOG FILE

LOGPH1:	TXNN	X,FB$NOI	;[330] /NOOUT SET?
	PJRST	LOGPCH		;[330] YES, PUNCH LITERALLY
	PUSH	P,C		;[330] SAVE CHAR
	CAIN	C,.CHESC	;[330] ALTMODE?
	MOVEI	C,"$"		;[330] MAKE "$"
	CAIG	C,.CHCNH	;[330] .LE.^H ?
	JRST	LOGPH2		;[330] YES, ^ FORM
	CAIL	C,.CHCNN	;[330] .LT.^N ?
	 CAILE	C,.CHCUN	;[330] .LE.^_ ?
	  JRST	LOGPH3		;[330] NOT AN ^ CHAR
LOGPH2:	IORI	C,"@"		;[330] MAKE PRINTABLE ASCII
	PUSH	P,C		;[330] SAVE IT
	MOVEI	C,"^"		;[330] FETCH UPARROW
	PUSHJ	P,LOGPCH	;[330] PUNCH IT
	POP	P,C		;[330] GET CHAR BACK
LOGPH3:	PUSHJ	P,LOGPCH	;[330] PUNCH WHATEVER
	POP	P,C		;[330] GET WHAT IT WAS ORIGINALLY
	POPJ	P,		;[330] RETURN
	SUBTTL	CMDGCH AND CMDBCH - Get char from command buffer

; CMDGCH - FETCH NEXT CHAR FROM COMMAND BUFFER
;
; CALL:	PUSHJ	P,CMDGCH
;	(FAIL RETURN)		; NO CHARS LEFT IN BUFFER
;	(SUCCESS RETURN)	; CHAR IS IN AC C
;
; USES ACS C,X

CMDGCH:	SOSGE	CMDCNT		; ANY CHARS LEFT?
	 POPJ	P,		; NO, GIVE FAIL RETURN
	MOVE	X,R		; SAVE AC R
	MOVE	R,@CMDBUF	; YES, FETCH BASE ADR OF COMMAND BUFFER
	ILDB	C,CMDBP		; AND FETCH NEXT CHAR FROM BUFFER
	MOVE	R,X		; RESTORE AC R
;[16000]JUMPE	C,CMDGCH	; IGNORING NULLS
	JRST	CPOPJ1		; RETURN TO CALLER WITH CHAR IN AC C

; CMDBCH - BACK UP ONE CHAR FOR COMMAND BUFFER
;
; CALL:	PUSHJ	P,CMDBCH
;	(RETURN)
;
; USES AC X

CMDBCH:	AOS	CMDCNT		; ADD ONE TO THE CHAR COUNT
	MOVE	X,CMDBP		; FETCH THE BP
	ADD	X,[<7>B5]	; BACKUP THE BP
	JUMPG	X,.+3		; IT'S OK
	 HRRI	X,-1(X)		; GO BACK A FULL WORD
	 HRLI	X,(POINT 7,(CP),34) ; TO LAST BYTE IN PREVIOUS WORD
	MOVEM	X,CMDBP		; STORE THE UPDATED BP
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	TXXXXX - OUTPUT ROUTINES

; TSIX - TYPE A SIXBIT WORD (NO TRAILING SPACES)
;
; CALL IS:	PUSHJ	P,TSIX	; WITH SIXBIT WORD IN AC N
;		(RETURN)
;
; ACS C,N ARE SMASHED

TSIX:	JUMPE	N,CPOPJ		; RETURN IF ONLY BLANKS LEFT
	SETZ	C,		; CLEAR THE CHAR
	LSHC	C,6		; GRAB NEXT CHAR (SIXBIT)
	MOVEI	C,"A"-'A'(C)	; CONVERT TO ASCII CHAR
	PUSHJ	P,TCHR		; TYPE THE CHAR
	JRST	TSIX		; AND LOOP BACK FOR NEXT CHAR

; TOCT AND TDEC - OUTPUT AN OCTAL/DECIMAL NUMBER WITH POSSIBEL "-" SIGN
;
; CALL IS:     PUSHJ   P,TOCT	; OR PUSHJ   P,TDEC
;	       (ONLY RETURN)
; NUMBER SHOULD BE IN AC N
; ACS C,N,X AND M ARE SMASHED

TOCT:
;[14000] SKIPA	X,[^D8] 	; FETCH OCTAL RADIX
TOCT0:	SETZ	C,		;[14000] Start fresh
	ROTC	C,-3		;[14000] Get 1 digit worth in reverse order
	LSH	C,-41		;[14000] right justify
	MOVEI	C,"0"(C)	;[14000] Make digit
	HRLM	C,(P)		;[14000] Save on stack (instead of flags)
	JUMPE	N,.+2		;[14000] Supress leading zeroes
	PUSHJ	P,TOCT0		;[14000] Call ourself recursively
	HLRZ	C,(P)		;[14000] Get a digit
	JRST	TCHR		;[14000] Type it out


TDEC:	 MOVEI	X,^D10		; FETCH DECIMAL RADIX
	JUMPGE	N,TDEC0		; NO "-" SIGN NEEDED
				;[1000] FIX LOGFILE CODE BASHING RADIX
	MOVE	M,X		;[1000]SAVE RADIX
	MOVEI	C,"-"		; "-" SIGN NEEDED
	PUSHJ	P,TCHR		; TYPE THE "-" SIGN
	MOVM	N,N		; AND TAKE ABSOLUTE VALUE OF NUMBER
	MOVE	X,M		;[1000] RESTORE RADIX

TDEC0:	IDIVI	N,(X)		; EXTRACT A DIGIT INTO AC M
	HRLM	M,(P)		; SAVE THE DIGIT
	JUMPE	N,.+2		; SKIP IF NO MORE DIGITS
	 PUSHJ	P,TDEC0		; MORE DIGITS, EXTRACT THEM

; POP DIGITS OFF STACK IN THE ORDER THEY ARE TO BE OUTPUT

	HLRZ	C,(P)		; POP DIGIT OFF STACK
	MOVEI	C,"0"(C)	; TURN DIGIT INTO A CHAR
	PJRST	TCHR		; OUTPUT THE DIGIT AND ALL THAT FOLLOW
; TMSG - TYPE PART THE THE COMMAND BUFFER
;
; CALL:	MOVE	N,[<CHAR.ADR,,CHAR.LEN>]
;	PUSHJ	P,TMSG
;	(RETURN)
;
; SMASHES ACS N,T1,T2,X

TMSG:	HLRZ	T1,N		; FETCH CHAR.ADR
	MOVEI	T1,-1(T1)	; 'CAUSE BYTE POINTER WILL BE INCREMENTED BEFORE USE
	PUSHJ	P,CTOBP		; CONVERT CHAR.ADR TO BYTE POINTER
	IORX	T1,<Z (R)>	; EVERYTHING IS INDEXED BY R
	MOVEI	N,(N)		; KEEP ONLY THE CHAR COUNT

TMSG1:	JUMPLE	N,FOUT 		; IF DONE, RETURN TO CALLER
	TXNE	F,F$REE		;[10000] REEnter done?
	 PJRST	FOUT		;[16000] yes shaddup & force it out
	ILDB	C,T1		; FETCH NEXT CHAR OF MESSAGE
	PUSHJ	P,TCCHR		; AND TYPE IT
	SOJA	N,TMSG1		; AND TRY AGAIN

; TTOPEN - Open the TTY so we can do echo control

TTOPEN:
IFN TOPS10,<
	OPEN	TTYC,[EXP IO.LEM ;[11000]
		      SIXBIT 'TTY' ;[11000]
		      Z]		;[11000]
	 OPEN	TTYC,[EXP 0,	;[12000] to avoid...
		      SIXBIT 'NUL' ;[12000] I/O to unassigned ...
		      Z]	;[12000] ...channel
	JFCL

	SETO	X,	;[12000] Get our line #
	TRMNO.	X,	;[12000] from the system
	 JRST	TTYODT	;[21000] It's detached
>
FOR TOPS20,<
	PUSHJ	P,SAVE5		;[21000] Save AC's that will get clobbered
	MOVX	T1,.FHSLF	;[21000] Our process
	GPJFN			;[21000] Make sure primary output is TTY
	MOVEI	T2,(T2)		;[21000] Output is in right half
	CAIE	T2,.CTTRM	;[21000] Is it?
	 JRST	[MOVE X,T2	;[21000] no. leave it alone
		 JRST TTYOPX]	;[21000] in the right AC
	GJINF			;[21000] Yes, so stuff real terminal in
	SKIPG	X,T4		;[21000] or -1 if detached
	 JRST	TTYODT		;[21000] remember that we are detached
	TXO	X,.TTDES	;[21000] Make it a real TTY designator
TTYOPX:>
	MOVEM	X,OURTTY	;[12000] Remember its number
	MOVE	X,[POINT 7,TTOBUF] ;[12000] Set up byte pointer
	MOVEM	X,TTOPTR	;[12000] for terminal output
;Find out terminal width & length

FOR TOPS10,<
	MOVEI	X,.TOPSZ	;[13000] Length
	MOVEM	X,TOOFUN	;
	MOVE	X,[2,,TOOFUN]	;[13000] Addr,,len for UUO
	TRMOP.	X,
>
	 MOVEI	X,^D24		;[13000] safe guess
	MOVEM	X,LENGTH

FOR TOPS10,<
	MOVEI	X,.TOWID	;[13000] Width
	MOVEM	X,TOOFUN	;
	MOVE	X,[2,,TOOFUN]	;[13000] Addr,,len for UUO
	TRMOP.	X,
>
	 MOVEI	X,^D80
	MOVEM	X,WIDTH		;[13000] Save it away

	MOVEI	X,.TOOUS	;[12000] Function code for TRMOP.
	MOVEM	X,TOOFUN	;[12000] (equivalent to OUTSTR)
	MOVEI	X,TTOBUF	;[12000] Set up argument also
	MOVEM	X,TOOADR	;[12000] address of output
	POPJ	P,

TTYODT:	MOVX	X,ET$DET	;[12000] Set detached flag
	IORM	X,ETVAL		;[12000]
	POPJ	P,		;[12000]
>; END FOR FTXTEC!FTXTCERR
FOR FTXTCERR,<
; TSSTR - TYPE AN ASCIZ STRING WITH SPECIAL CHARS (EG: <TAB>)
;
; CALL:	MOVEI	N,[ASCIZ/STR/
;	PUSHJ	P,TSSTR
;	(RETURN)
;
; SMASHES AC C. AC N WILL POINT TO LAST WORD OF STRING

TSSTR:	HRLI	N,(POINT 7,)	; FORM BYTE POINTER TO ASCIZ STRING

TSSTR0:	ILDB	C,N		; FETCH NEXT CHAR OF STRING
	JUMPE	C,CPOPJ		; RETURN IF A NULL
	PUSHJ	P,TSCHR		; TYPE CHAR
	JRST	TSSTR0		; AND TRY FOR ANOTHER CHAR

; TSCHR - TYPE A CHAR. IF SPECIAL, TYPE AS <XXX> (EG: <TAB>)
;
; CALL:	MOVEI	C,"CHAR"
;	PUSHJ	P,TSCHR
;	(RETURN)
;
; SMASHES AC X,C,T1. USES AC N

TSCHR:	MOVE	T1,[IOWD SCHTL,SCHT+1] ; FETCH POINTER TO SPECIAL CHAR TABLE

TSCHR0:	HRRZ	X,(T1)		; FETCH A CHAR FROM SPECIAL CHAR TABLE
	CAIN	C,(X)		; SAME AS OUR CHAR?
	 JRST	TSCHR1		; YES
	AOBJN	T1,TSCHR0	; NO, TRY ANOTHER CHAR IN TABLE

	PJRST	TCCHR		; NONE LEFT. TYPE AS A NORMAL CHAR

; TYPE A SPECIAL CHAR AS <XXX> (EG: .CHTAB AS <TAB>)

TSCHR1:	PUSH	P,T1		; SAVE T1 FOR LATER
	MOVEI	C,.CHLAB	; TYPE A LEFT WIDGET
	PUSHJ	P,TCHR		; . . .
	POP	P,T1		; RESTORE AC T1
	PUSH	P,N		; SAVE AC N
	HLLZ	N,(T1)		; FETCH "XXX" OF <XXX>
	PUSHJ	P,TSIX		; AND TYPE IT IN SIXBIT
	POP	P,N		; RESTORE AC N
	MOVEI	C,.CHRAB	; AND TYPE RIGHT WIDGET
	PJRST	TCHR		; . . . AND RETURN TO CALLER

; SCHT - SPECIAL CHARACTER TABLE

	DEFINE	SCH (NAME,CODE)<<<SIXBIT/NAME/>_-^D18,,CODE>>

SCHT:
	SCH(TAB,.CHTAB)
	SCH(LF,.CHLFD)
	SCH(VT,.CHVTB)
	SCH(FF,.CHFFD)
	SCH(CR,.CHCRT)
	SCH(ESC,.CHESC)
SCHTL==.-SCHT
; TFSPEC - TYPE A COMPLETE FILE-SPEC IN FORM:  DEV:FILE.EXT[PATH]
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,TFSPEC
;	(RETURN)
;
; SMASHES ACS X,C,N,M

TFSPEC:	PUSHJ	P,TDEV		; TYPE "DEV:"
	PUSHJ	P,TFILE		; TYPE "FILE.EXT"
	PJRST	TPATH		; TYPE "[PATH]"

; TDEV - TYPE A DEVICE NAME IN FORM:  DEV:
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,TDEV
;	(RETURN)
;
; SMASHES ACS C,N

TDEV:	MOVE	N,FS$DEV(L)	; FETCH THE DEVICE NAME
	PUSHJ	P,TSIX		; AND TYPE IT
	MOVEI	C,":"		; FETCHA ":"
	PJRST	TCHR		; AND TYPE IT

; TFILE - TYPE A FILE-NAME AND EXTENSION IN FORM:   FILE.EXT
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,TFILE
;	(RETURN)
;
; SMASHES ACS C,N

TFILE:	MOVE	N,FS$NAM(L)	; FETCH THE FILE-NAME
	PUSHJ	P,TSIX		; AND TYPE IT
	MOVEI	C,"."		; TYPE A "."
	PUSHJ	P,TCHR		; . . .
	MOVE	N,FS$EXT(L)	; FETCH THE EXTENSION
	PJRST	TSIX		; TYPE IT AND RETURN TO CALLER

; TPROT - TYPE FILE PROTECTION IN FORMAT:   <NNN>
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,TPROT
;	(RETURN)
;
; SMASHES ACS C,N,M

TPROT:	MOVEI	C,.CHLAB	; TYPE LEFT WIDGET
	MOVE	N,FS$PRV(L)	; FETCH FILE PROTECTION
	MOVEI	C,"0"		; FETCH A ZERO
	CAIL	N,^D100		; A THREE DIGIT NUMBER?
	 PUSHJ	P,TCHR		; NO, ADD A LEADING ZERO
	CAIL	N,^D10		; A TWO DIGIT NUMBER?
	 PUSHJ	P,TCHR		; NO, ADD ANOTHER LEADING ZERO
	PUSHJ	P,TDEC		; TYPE THE FILE-PROTECTION
	MOVEI	C,.CHRAB	; AND TYPE A RIGHT WIDGET
	PJRST	TCHR		; AND RETURN TO CALLER

; TPATH - TYPE A PATH IN FORM: [-] OR [N,N] OR [N,N,SFD,...]
;
; CALL:	MOVEI	L,FILSPC
;	PUSHJ	P,TPATH
;	(RETURN)
;
; SMASHES ACS C,N,M

TPATH:	MOVEI	C,"["		; TYPE LEADING DELIMITER
	PUSHJ	P,TCHR		; . . .
	MOVE	X,FS$FLG(L)	; FETCH FILE-SPEC FLAGS
	TXNN	X,FB$DDR	; DEFAULT DIRECTORY?
	 JRST	TPATH2		; NO
	MOVEI	C,"-"		; YES, TYPE AS [-]
	PUSHJ	P,TCHR		; . . .

TPATH1:	MOVEI	C,"]"		; TYPE CLOSING DELIMITER
	PJRST	TCHR		; AND RETURN TO CALLER

TPATH2:	HLRZ	N,FS$PPN(L)	; FETCH PROJECT NUMBER
	JUMPE	N,.+2		; DON'T PRINT IF ZERO
	 PUSHJ	P,TOCT		; TYPE PROJECT NUMBER IN OCTAL
	MOVEI	C,","		; TYPE A ","
	PUSHJ	P,TCHR		; . . .
	HRRZ	N,FS$PPN(L)	; FETCH THE PROGRAMMER NUMBER
	JUMPE	N,.+2		; DON'T PRINT IF ZERO
	 PUSHJ	P,TOCT		; TYPE PROGRAMMER NUMBER IN OCTAL
				;[3000] ADD CODE TO PRINT SFD
	MOVEI	T1,FS$SFD(L)	;[3000] T1 POINTS TO START OF SFD'S
TPATH3:	SKIPN	N,(T1)		;[3000] FETCH NEXT ONE AND SKIP
	 JRST	TPATH1		;[3000] NO MORE
	MOVEI	C,","		;[3000] SEPARATE WITH COMMAS
	PUSHJ	P,TCHR		;[3000]
	PUSHJ	P,TSIX		;[3000] TYPE THE SFD NAME
	AOJA	T1,TPATH3	;[3000] BACK FOR MORE

>;; END FOR FTXTCERR
FOR FTXTEC!FTXTCERR,<
; TCCHR - OUTPUT A CHAR, ALTMODE AS "$", CONTROL CHARS AS "^"CHAR UNLESS ET.NE.0
;		^I,^J,^K,^L,^M OUTPUT AS THEMSELVES CASE FLAGGING UNLESS F$NOF
;
; CALL IS:	PUSHJ	P,TCCHR	; WITH CHAR IN AC C
;		(ONLY RETURN)
;
; AC C IS SMASHED

TCCHR:	MOVE	X,ETVAL		;[6000] CHECK ONLY LAST BIT
	TRNE	X,ET$EXT	;[6000]
	PJRST	TCHR		; YES, NO SUBSTITUTIONS FOR NON-PRINTING CHARS
TPCHR:				;[5000] ENTER HERE TO ALWAYS PRETTYPRINT
	CAIE	C,.CHESC	; AN ALTMODE?
	 JRST	TCC0		; NO

; OUTPUT AN ALTMODE AS "$"

	MOVEI	C,"$"		; FETCH A "$"
	PJRST	TCHR		; AND OUTPUT IT

TCC0:	TXNE	F,F$NOF		; SUPPRESS CASE FLAGGING?
	 JRST	TCC3		; YES
	PUSH	P,C		; NO. SAVE CHAR
	CAIG	C,"_"		; IS IT A UC LETTER?
	 CAIGE	C,"A"		; . . . ?
	  JRST	TCC2		; NO

; FLAG UC LETTER IF EU:=+

	SKIPG	EUVAL		; FLAG UC LETTERS?
	 JRST	TCC11		; NO
TCC1:	MOVEI	C,"'"		; YES, FLAG WITH "'"
	PUSHJ	P,TCHR		; TYPE THE "'"
TCC11:	POP	P,C		; RESTORE THE ORIGINAL CHAR
	JRST	TCC3		; TYPE IT AND RETURN TO CALLER

TCC2:	CAIG	C,"_"+40	; IS CHAR AN UC LETTER?
	 CAIGE	C,"A"+40	; . . . ?
	  JRST	TCC11		; NO
	SKIPN	EUVAL		; YES, FLAG IT?
	 JRST	TCC1		; YES
	JRST	TCC11		; DON'T FLAG IT

TCC3:	CAIN	C,14		;[10000]Form Feed special handling
	 JRST	[;MOVE X,ETVAL	;[10000]
		 TXNE X,ET$DPY	;[10000] TUBE
		  JRST TCC4	;[10000]
		 JRST TCHR]	;[12000] Type as is (more or less)
	SKIPE	EOL		;Anything special at end of line?
	 JRST	[CAIN C,15	;If so,
		  POPJ P,	; ... then ignore <CR>
		 CAIE C,12	;and do special stuff to <LF>
		  JRST .+1	; (which this wasn't)
		 PUSH P,N	; Don't clobber N
		 MOVEI N,EOL	;Get it,
		 PUSHJ P,TXSTR	;Type it,
		 POP P,N	; restore N
		 SETZM COL	;should be at left margin now
		 AOS ROW	;of next line
		 PUSHJ P,UPDCRO	;adjust things if it scrolled
		 MOVEI C,12	;get back C (we knew what it was, anyway)
		 POPJ P,]	;and return
	CAIN	C,.CHTAB	;[13000] Is this a TAB?
	 JRST	[SKIPN TTAB	;[13000] anything to type in its place?
		  JRST .+1	;[13000] no, really type a TAB
		 PUSH P,N	;[13000]
		 MOVEI N,TTAB	;[13000] Type this string instead
		 PUSHJ P,T0XSTR	;[13000] ...
		 PUSHJ P,TABSTP	;[21000] Find next tab stop
		 PUSH  P,X	;[21000] And save it
	TCCT0:	 AOS N,COL	;[13000] Always increment column by 1 at least
		 JUMPL N,.+2	;[25000] Don't screw us if we're lost
		 CAML N,(P)	;[21000] Did we get there yet?
		 JRST [MOVEI N,TTABND ;[16000] Sequence for end of tab
		       PUSHJ P,T0XSTR ;[16000] do it
		       MOVEI C,.CHTAB ;[13000] Restore C
		       POP P,X	;[21000] Fix up stack
		       POP P,N	;[13000] Restore N, check cursor & return
		       POPJ P,] ;[13000]
		 MOVEI N,CFWD	;[13000] Advance the physical cursor
		 PUSHJ P,T0XSTR	;[13000] by typing whatever does that
		 JRST TCCT0]	;[13000] And check again

	JUMPE C,[SKIPN TNULL	;[15000] Do we have anything for NULLs?
		  JRST .+1	;[15000] do the usual thing
		 PUSH P,N	;[15000] Type the specified sequence
		 MOVEI N,TNULL	;[15000] ...
		 PUSHJ P,T0XSTR	;[15000] ...
		 POP P,N	;[15000] Get back old value of N
		 AOS COL	;[15000] Assume this uses 1 character position
		 POPJ P,]	;[15000] done
	CAIG	C,.CHCNH	; ^@-^H?
	 JRST	TCC4		; YES, SPECIAL OUTPUT
	CAIL	C,.CHCNN	; ^N-^_?
	 CAILE	C,.CHCUN	; . . . ?
	  PJRST	TCHR		; NO, OUTPUT CHAR AS IS

; OUTPUT CHAR AS "^"CHAR (^@-^H,^N-^_)

TCC4:	IORI	C,"@"		; MAKE CHAR READABLE
	PUSH	P,C		; SAVE CHAR
	MOVEI	C,"^"		; FETCH THE "^" CHAR
	PUSHJ	P,TCHR		;  OUTPUT "^"
	POP	P,C		; RESTORE READABLE FORM OF CHAR
	PJRST	TCHR		; AND OUTPUT IT
; TSTR - TYPE AN ASCIZ STRING
;
; CALL:	MOVEI	N,[ASCIZ/STRING/]
;	PUSHJ	P,TSTR
;	(RETURN)

TSTR:	HRLI	N,(POINT 7,)	; FORM BYTE POINTER

TSTR0:	ILDB	C,N		; FETCH NEXT CHAR OF ASCIZ STRING
	JUMPE	C,CPOPJ		; AND RETURN IF NULL
	PUSHJ	P,TCCHR		; TYPE THE CHAR
	JRST	TSTR0		; AND LOOP FOR ALL CHARS OF STRING

; T0XSTR -- Type an ASCIZ string without disturbing the column setting
; (useful for typing escape sequences & other wierd stuff
;	same calling sequence as TXSTR

T0XSTR:	PUSH	P,COL		;[13000] Type something out
	HRROS	COL		;[15000] Turn off counting
	PUSHJ	P,TXSTR		;without disturbing
	POP	P,COL		;the cursor column
	POPJ	P,		;[13000]

; TXSTR TYPE AN ASCIZ STRING WITH NO REFORMATTING
;
; CALL: MOVEI N,[ASCIZ/STRING/
;	PUSHJ P,TXSTR
;	(RETURN)

TXSTR:	HRLI	N,(POINT 7,)	;[7000] BYTE PTR
TXSTR0:	ILDB	C,N		;[7000]
	JUMPE	C,CPOPJ		;[7000]
	PUSHJ	P,TCHR		;[7000]
	JRST	TXSTR0		;[7000]

; CLRLIN -- Clear a whole line from the screen
;
; CALL:	PUSHJ	P,CLRLIN	;uses text in WIPEL to erase to end of line
;
CLRLIN:	MOVEI	C,15		;[12000] naked carriage return first
	PUSHJ	P,TCHR		;[12000]
	MOVEI	N,WIPEL		;[12000] erase to end of line
	SETZM	COL		;[23000] Clear the column count
	PJRST	T0XSTR		;[12000] type that & return

; TCRLF - OUTPUT A CRLF
;
; CALL IS:	PUSHJ	P,TCRLF ;
;		(ONLY RETURN)
; ACS B AND C ARE SMASHED

TCRLF:	SETZM	COL		;[23000] Clear column counter
	MOVEI	C,.CHCRT	; FETCH A CR CHAR
	PUSHJ	P,TCHR		; AND TYPE IT
	MOVEI	C,.CHLFD	; FETCH A <LF> CHAR
;	PJRST	TCHR		; AND TYPE IT AND RETURN

; TCHR - OUTPUT A SINGLE CHAR
;
; CALL IS:	PUSHJ	P,TCHR
;		(ONLY RETURN)
; AC C SHOULD CONTAIN CHAR. AC C IS PRESERVED

TCHR:	SKIPE	OUTADR		; OUTPUT TO NON-TERMINAL?
	 PJRST	@OUTADR		; YES, GO TO ROUTINE

; PUNCH CHAR TO LOG FILE IF I SAID SO

	TXNN	F,F$LOG		;[330] DID I SAY SO?
	JRST	NOLOGO		;[330] NO LOG OUTPUT FOR YOU
	MOVE	X,LELSPC+FS$FLG	;[330] GET LOG FLAGS
	TXNE	X,FB$NOI	;[330] RECORD OUTPUT?
	PUSHJ	P,LOGPCH	;[330] YES, PUNCH IT

; TYPE CHAR ON USER'S TERMINAL

NOLOGO:	MOVX	X,ET$TRN	;[16000] Check for truncate mode
	TDNE	X,ETVAL		;[16000] ...
	 JRST	[MOVE X,COL	;[16000] See if we're off the wall yet
		 CAIE C,10	;[21000] Always let backspace through
		 CAMGE X,WIDTH	;[16000] ...
		  JRST .+1	;[16000] still OK
		 CAILE C,15	;[21000] Always let CR,LF,VT,FF through
		 CAIGE C,12	;[21000] ...
		  JRST .+1	;[21000] ...
		 POPJ P,]	;[16000] Don't actually type this character
	JUMPE	C,[PUSHJ P,FOUT	;[24000] Null is text terminator, so
IFN TOPS10,<	   PUSH P,TOOFUN;[24000] Save old function code
		   PUSH P,TOOADR;[24000] Save old address
		   SETZM TOOADR	;[24000] Prepare to output a null
		   MOVEI X,.TOOUC;[24000] Just 1 character
		   MOVEM X,TOOFUN;[24000]
		   MOVE X,[3,,TOOBLK] ;[24000] Set up to do it
		   TRMOP. X,	;[24000] We did it
		    JFCL	;[24000] We didn't, but who cares?
		   POP P,TOOADR ;[24000] Restore old address
		   POP P,TOOFUN ;[24000] and old function code
>;End IFN TOPS10		;[24000]
IFN TOPS20,<	   PUSHJ P,SAVE2;[24000] Save registers
		   MOVE T1,OURTTY;[24000] Get our terminal JFN
		   SETZ T2,	;[24000] And our null character
		   BOUT		;[24000] Output it
		   ERJMP .+1	;[24000] Ignore any error
>;END IFN TOPS20
		   JRST TCHUPD]	;[24000] return
	SKIPE	TTOEND		;[12000] See if room in the buffer
	 PUSHJ	P,FOUT		;[12000] There isn't, make some
	IDPB	C,TTOPTR	;[12000] Store it in the output buffer
	SKIPL	COL		;[12000] -1FC disables checking
TCHUPD:	PUSHJ	P,UPDCAD	;[12000] Update cursor address
	TLZN	C,1		;[12000] Set by UPDCAD if free CRLF needed
	 POPJ	P,		; AND RETURN TO CALLER
	PUSH	P,C		;[12000] Save C
	PUSHJ	P,TCRLF		;[12000] Do the CRLF
	POP	P,C		;[12000] Get back C
	POPJ	P,		;[12000]

$FOUT:	;[12000] Entry From user code to force out TTY output
	;[12000] Call:	JSP PC,$$FOUT	;clobbers X
	PUSH	P,PC		;[12000] Put return addr where POPJ will see it
				;[12000] and fall into FOUT
FOUT:	;[12000] Entry from hiseg to force out TTY output
	;[12000] Call:	PUSHJ P,FOUT	;clobbers X
FOR TOPS10,<
	MOVE	X,[3,,TOOBLK]	;[12000] Prepare for TRMOP.
	TRMOP.	X,		;[12000] Output all of that stuff
	 JFCL			;[12000] Failed, ignore it
>
FOR TOPS20,<
	PUSHJ	P,SAVE5		;[21000] Save the AC's
	MOVE	T1,OURTTY	;[21000] Destination designator
	RFMOD			;[21000] Get the current mode bits
	PUSH	P,T2		;[21000] and save them
	TRZ	T2,300		;[21000] Put in image mode
	SFMOD
	HRROI	T2,TTOBUF	;[21000] Output buffer pointer
	SETZB	T3,T4		;[21000] no count, terminate on null byte
	SOUT			;[21000] Do it
	ERJMP	.+1		;[24000] Ignore error
	POP	P,T2		;[21000] Get back old mode setting
	SFMOD			;[21000] and restore terminal to that state
>
	SETZM	TTOBUF		;[12000] Zero the output buffer
	MOVE	X,[TTOBUF,,TTOBUF+1] ;[12000]
	BLT	X,TTOEND	;[12000]
	MOVE	X,[POINT 7,TTOBUF] ;[12000] Reset byte pointer
	MOVEM	X,TTOPTR	;[12000]
	POPJ	P,		;[12000] return

FOR TOPS20,< ;Terminal mode manipulation

CLRCCO:	PUSH	P,[TT%OSP]	;[21000] Clear "supress output" bit
	SKIPA

ECOFF:	PUSH	P,[TT%ECO]	;[21000] Bit to clear

CLRFMO:	PUSH	P,T1		;[21000] Clobber no registers
	PUSH	P,T2
	MOVE	T1,OURTTY	;[21000]
	RFMOD			;[21000] What do we have now
	TDZE	T2,-2(P)	;[24000] Set the bits
	 SFMOD			;[21000] Set it unless already set
	JRST	SETFMZ		;[21000] Join common restoring code


ECON:	PUSH	P,[TT%ECO]	;[21000] Bit to set

SETFMO:	PUSH	P,T1		;[21000] Clobber no registers
	PUSH	P,T2
	MOVE	T1,OURTTY	;[21000]
	RFMOD			;[21000] What do we have now
	TDON	T2,-2(P)	;[21000] Set the bits
	 SFMOD			;[21000] Set it unless already set
SETFMZ:	POP	P,T2		;[21000] Restore registers
	POP	P,T1		;[21000] ...
	ADJSP	P,-1		;[21000] Throw this away
	POPJ	P,		;[21000] return

>;end TOPS20

;UPDCDC [12000] Update cursor address, assuming controls get reformatted
;
;	CALL:	MOVEI	C,CHARACTER
;		PUSHJ	P,UPDCAD
;		(return with things updated)
;						uses  C
;

UPDCDC:	CAIL	C,177		;do nothing with rubout or greater
	 POPJ	P,		;
	SKIPL	EUVAL		;Check for case flagging
	 JRST	[CAIG C,"A"+40	;check for lower case
		 CAIGE C,"Z"+40 ;
		  JRST	[CAIG C,"Z" ;check for upper case
			 CAIGE C,"A" ;
			  JRST .+1
			 JUMPE X,UPDPRC
			 JRST UPDCC2] ;Upper case being flagged
		 JUMPG X,UPDPRC	;lower case not being flagged
		 JRST UPDCC2]	;lower case is being flagged
	CAIGE	C,40		;Real printing character
	CAIN	C,.CHESC	;ESCAPE prints as $
	 JRST	UPDPRC		;so treat like printing character
	CAIE	C,15		;assume uparrow'ed if not <CR> or <LF>...
	CAIN	C,12		;
	 JRST	UPDCAD		;Treat like it is
	CAIN	C,11		; ... or <TAB>
	 JRST	UPDCAD		;
UPDCC2:	MOVE	X,ETVAL		;[21000] See if simulating
	TXNE	X,ET$EXT	;[21000] Image mode
	 PJRST	UPDCAD		;[21000] Yes, do it like it is
	PUSHJ	P,UPDPRC	;advance 1 print position,
	PJRST	UPDPRC		;and another print position


;UPDCAD	[12000] Update cursor address (ROW, COL & possibly SCFWD)
;		due to having typed a character on the screen
;	CALL:	MOVEI	C,CHARACTER
;		PUSHJ	P,UPDCAD
;		(return with things updated)

UPDCAD:	CAIL	C,177		;do nothing with rubout or greater
	 POPJ	P,
	CAIL	C,40		;check for control character
	 JRST	UPDPRC		;it was a printing character
	CAIN	C,15		;Carriage return?
	 JRST	[SKIPN EOL	;[21000] not if anything to type there
		  SETZM COL	;go to column 0
		 POPJ P,]	;and return
	CAIN	C,12		;Linefeed?
	 JRST	[SKIPE X,DPYALL	;[21000] do we have to allow for a marker char
		  JRST	[ADDB X,COL     ;[21000] Yes, do it
			 PUSHJ P,UPDPC0 ;[21000] and allow for a stray CRLF
			 JRST UPDEOL]   ;[21000]
	UPDEOL:	 AOS ROW	;next line
		 MOVE X,DMODE	;Check for NEWLINE mode
		 SKIPN EOL	;[21000] EOL is assumed to do both
		 TXNE X,DM$NL	;if set, assume <CR> also
		  SETZM COL	;IN NEWLINE MODE
		 JRST UPDCRO]	;check for scroll happening
	CAIN	C,9		;TAB?
	JRST	[PUSHJ P,TABSTP ;[21000] Find next one
		 MOVEM X,COL    ;[21000] We're there
		 JRST UPDPC0]   ;[21000] adjust for it

	HRROS	COL		;disable checking, we don't know what
	POPJ	P,		;this character does anyway

UPDPRC:	AOS	X,COL		;increment column, then check for right margin
UPDPC0:	CAMGE	X,WIDTH		;if over, do something about it
	 POPJ	P,		;it wasn't so don't worry about it
	SETZM	COL		;Assume somebody typed a CRLF
	AOS	ROW		;Go to next row
	MOVE	X,DMODE		;Check for auto crlf by terminal or something
	TXNN	X,DM$ACR	;if set, we don't do free CRLFs
	 TLO	C,1		;Set the bit so somebody might
;
;UPDCRO	- enter here with ROW & COL set up to adjust for scrolling
;		that might have occurred

UPDCRO:	MOVE	X,LENGTH	;check the row for scrolling
	CAMLE	X,ROW		;if greater than length of screen
	 POPJ	P,		;it wasn't
	SOJL	X,[SETZM ROW	;Terminal does not scroll (goes to top?)
		   POPJ P,]
	MOVEM	X,ROW		;say we're at the bottom line
	AOS	SCFWD		;and just scrolled
	POPJ	P,



; TABSTP -- Find next TAB stop & return it in X
; CALL:		PUSHJ P,TABSTP
;	(return) with column of next tab stop in X

TABSTP:	PUSH	P,N		;[21000] Save this
	MOVSI	N,1-C$NTS	;[21000] AOBJN for # of tab stops
TABST0:	MOVE	X,TSTOPS(N)	;[21000] Get one
	CAMLE	X,COL		;[21000] Is this the one?
	 JRST	TABSTZ		;[21000] Yes, return it
	AOBJN	N,TABST0	;[21000] No, try next one
	MOVE	X,COL		;[21000] no more, stay here
TABSTZ:	POP	P,N		;[21000] Restore this
	POPJ	P,		;[21000] & Return
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
	SUBTTL	MISCELLANEOUS ROUTINES

; CHKAN - SEE IF A CHAR IS ALPHA-NUMERIC (LETTER/DIGIT)
;
; CALL IS:	PUSHJ	P,CHKAN	; WITH CHAR IN AC C
;		(NOT A-N)
;		(CHAR IS A-N)
;
; AC C SHOULD CONTAIN THE CHAR TO BE CHECKED
CHKSCB:	CAIE	C,"_"		;[10000] _ and & OK in BLISS
	CAIN	C,"&"		;[10000]
	 JRST	CPOPJ1		;[10000]
	JRST	CHKSC

CHKSCA:	CAIN	C,"."		;[10000] . OK in MACRO
	 JRST	CPOPJ1		;[10000] Unless we are in BLISS mode
CHKSC:	CAIE	C,"%"		;[10000] Percent sign ok
	CAIN	C,"$"		;[10000] Dollarsign too
	 JRST	CPOPJ1		;[10000]
CHKAN:	CAIG	C,"Z"+40	; IS CHAR LOWER CASE?
	 CAIGE	C,"A"+40	; . . .
	  SKP			; NO
	MOVEI	C,-40(C)	; YES, UPCASE THE LETTER
	CAIG	C,"Z"		; IS CHAR A LETTER OR DIGIT?
	 CAIGE	C,"0"		; . . . ?
	  POPJ	P,		; NO, GIVE ERROR RETURN
	CAIGE	C,"A"		; IS IT ?
	 CAIG	C,"9"		; . . . ?
	  JRST	CPOPJ1		; YES! GIVE SKIP RETURN
	POPJ	P,		; NO, GIVE ERROR RETURN

; CHKEOL - SKIP IF CHARACTER IN AC C IS AN END-OF-LINE CHARACTER (<LF>,<VT>,<FF>)
;
; CALL:	MOVEI	C,CHAR
;	PUSHJ	P,CHKEOL
;	(FAIL RETURN)
;	(SUCCESS RETURN)
;
; USES AC C

CHKEOL:	CAIG	C,.CHFFD	; IS CHAR <LF>,<VT>, OR <FF>?
	 CAIGE	C,.CHLFD	; . . . ?
	  POPJ	P,		; NO, GIVE FAIL RETURN TO CALLER
	CAIN	C,.CHLFD	;[12000] LF always wins
	 JRST	CPOPJ1		;[12000]
	MOVE	X,EDVAL		;[11000] Check ED value
	TXNE	X,ED$LLL	;[11000] If set FF is not line terminator
	 POPJ	P,		;[12000] NO
	MOVE	X,EOVAL		;[12000] Check EO value too
	SOJE	X,CPOPJ		;[12000] EO=1 means linefeeds only also
	JRST	CPOPJ1		; YES, GIVE SUCCESS RETURN TO CALLER

; MAKCJN - MAKE OUR CCL JOB NUMBER (IE: '###XTC')
;
; CALL:	PUSHJ	P,MAKCJN
;	(RETURN)		; WITH CCL JOB NUMBER IN "CCJNAM"
;
; SMASHES ACS X,T1-T3

MAKCJN:	MOVSI	T3,C$3NAM	; INITIALIZE TO '   XTC'
	PJOB	T1,		; FETCH OUR JOB NUMBER
	MOVEI	X,3		; FETCH #DIGITS IN '###'

MAKCJ1:	IDIVI	T1,^D10		; EXTRACT A DIGIT
	MOVEI	T2,'0'(T2)	; AND CONVERT TO A SIXBIT DIGIT
	LSHC	T2,-6		; AND ADD TO THE CCL JOB NAME
	SOJG	X,MAKCJ1	; AND DO SAME FOR NEXT DIGIT

	MOVEM	T3,CCJNAM	; STORE THE CCL JOB NUMBER (IE: '###XTC')
				; IN "CCJNAM"
	POPJ	P,		; AND RETURN TO CALLER

; GETPTH - GET MY DEFAULT PATH FROM PATH.(SUPERIOR TO SETZM'ING)
;
; CALL:	PUSHJ	P,GETPTH
;	(RETURN)		; WITH PATH IN X
;
; SMASHES AC X (VERY HARD TO COMPREHEND WHY).  THE ROUTINE IS USED
; IN GETTING THE DEFAULT PATH, TO ENABLE PEOPLE WHO CHANGE THEIR PATH
; TO HAVE THE RIGHT THING DONE FOR THEM, INCLUDING READING THEIR UFD!
; THIS ROUTINE INITIALLY WAS PART OF $EB, AS MAIN-LINE CODE.

GETPTH:	MOVE	X,[.PTMAX,,PATHB];[3000][340] LOAD LENGTH AND ADDRESS OF PATH
 	SETOM	PATHB+.PTFCN	;[340] PATHB_-1,,.PTFRD
	PATH.	X,		;[340] GET MY DEFAULT PATH
	 CAIA			;[340] SICK MONITOR, USE GETPPN
	SKIPA	X,PATHB+.PTPPN	;[340] GET PPN FROM PATH BLOCK
	GETPPN	X,		;[342] GET OUR PPN
	 JFCL			;[342] (JACCT SKIP)
	MOVEM	X,PATHB+.PTPPN	;[341] IN CASE OF SICK MONITOR FOR BAKCLS
	POPJ	P,		;[342] AND RETURN TO CALLER

;[12000] Page out DDT & Symbol table
; Call:		PUSHJ	P,POSSYM
;		(only return)

FOR TOPS10,<			;[21000] Can't do this on TOPS-20 so don't try
POSSYM:	SKIPN	T1,.JBSYM	;[12000] Symbol table addr & len
	 POPJ	P,		;[12000] no symbols loaded
	PUSHJ	P,POSSUM	;[12000] put those pages out
	SKIPN	T1,.JBDDT	;[12000] do DDT
	 POPJ	P,		;[12000] no DDT
	HLRZ	T2,T1		;[12000] get # of pages for DDT
	SUBM	T1,T2		;[12000] into T2
	HRLM	T2,T1		;[12000]
	PJRST	POSSUM		;[12000] Page it out

;[12000] POSSUM -- Page out some pages
;Call	MOVE	T1,[-LEN,,ADDR]	(in words)
;	PUSHJ	P,POSSUM
;	(only return)	;will not complain if can't page out as requested

POSSUM:	TLZ	T1,777		;[12000] convert to pages
	ASH	T1,-9		;[12000]
POSPGS:	MOVEI	T4,(T1)		;[12000] Page it out
	MOVEI	T2,T3		;[12000] addr of argument block (in AC's)
	MOVEI	T3,1		;[12000] Swap a page in or out
	TLO	T4,400000	;[12000] OUT
	PAGE.	T2,		;[12000] do it
	 JFCL			;[12000] We tried
	AOBJN	T1,POSPGS	;[12000] loop back
	POPJ	P,		;[12000] done
>;END FOR TOPS10

; MATCH - SEE IF A WORD IS IN A TABLE
;
; IF TABLE ENTRY BEGINS WITH '*', THEN ANY ABBREVIATION WINS.
;
; CALL:	MOVE	N,[SIXBIT/NAME/]
;	PUSHJ	P,MATCH	; WITH WORD IN AC N, MASK IN AC M
;	(NO FIND RETURN)
;	(AMBIGUOUS WORD RETURN)
;	(SUCCESS RETURN); AC L POINTS TO WORD IN TABLE
;
; ACS X,T1,T2,L ARE SMASHED

MATCH:	MOVEM	N,SBNAME	; STORE THE SIXBIT NAME
	SETO	T2,		; USED TO COUNT MATCHES

MAT0:	MOVE	X,(L)		; FETCH WORD FROM TABLE
	TXNE	X,3B1		; IS FIRST CHAR '*' ?
	 JRST	MAT2		; NO, CHECK THE NORMAL WAY
	LSH	X,6		; YES, SHIFT OUT THE '*'
	XOR	X,N		; SEE IF A MATCH OR ABBREV.
	TXZ	X,77		; IGNORE LAST CHAR BECAUSE TABLE ENTRY
				; DOESN'T HAVE IT
	AND	X,M		; DO THE MASKING
	JUMPE	X,CPOPJ2	; WIN IF MATCH OR ANY ABBREV. !
	JRST	MAT1		; LOSE IF NOT MATCH OR AN ABBREV.

MAT2:	XOR	X,N		; AN EXACT MATCH?
	JUMPE	X,CPOPJ2	; YES, SUCCESS!

	AND	X,M		; NO, AN ABBREVIATION?
	JUMPN	X,MAT1		; NO
	AOJG	T2,MAT1		; YES, COUNT IT. FIRST ONE?
	 MOVEI	T1,(L)		; YES, SAVE ADR OF WORD IN TABLE

MAT1:	AOBJN	L,MAT0		; TRY NEXT WORD IN TABLE

	MOVEI	L,(T1)		; ALL DONE. GET ADR OF FIRST MATCH
	JUMPL	T2,CPOPJ	; THERE WEREN'T ANY MATCHES
	JUMPE	T2,CPOPJ2	; SUCCESS, UNIQUE MATCH!
	JRST	CPOPJ1		; AMBIGUOUS, MORE THAN ONE MATCH
; DISPAT - LOOKUP A HALFWORD AND DISPATCH IF MATCH
;
; CALL:	MOVEI	C,XWD		; THE HALFWORD TO BE SEARCHED FOR
;	MOVE	T1,[IOWD LTH,TAB]
;	PUSHJ	P,DISPAT
;	(NOFIND RETURN)
;	IF FOUND, DISPATCH TO ADDRESS IN LH OF TABLE ENTRY
;
; TAB:
;	<XWD,,ADR>
;	<XWD,,ADR>
;	. . .
; LTH==.-TAB
;
; USES ACS X,L,C

DISPAT:	HLRZ	X,(T1)		; FETCH XWD FROM TABLE ENTRY
	CAIN	X,(C)		; THE ONE WE'RE LOOKING FOR?
	 JRST	DISPA1		; YES, DISPATCH
	AOBJN	T1,DISPAT	; NO, LOOP FOR ALL TABLE ENTRIES
	POPJ	P,		; NOFIND. GIVE NOFIND RETURN

; FOUND IT! DISPATCH

DISPA1:	POP	P,X		; IGNORE RETURN ADR TO CALLER
	MOVE	X,(T1)		; FETCH THE DISPATCH ADDRESS
	JRST	(X)		; AND DISPATCH

>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<

; CTOBP - CONVERT A CHARACTER ADDRESS TO A BYTE POINTER
;
; CALL:	MOVEI	T1,CHARADR
;	PUSHJ	P,CTOBP
;	(RETURN)		; WITH BP IN AC T1
;
; USES ACS T1,T2

CTOBP:	IDIVI	T1,5		; CONVERT TO WORD ADR + EXTRA
	HLL	T1,CBPTBL(T2)	; CONVERT EXTRA TO BIT POSITION
	POPJ	P,		; AND RETURN TO CALLER

; CBPTBL - CONVERSION TABLE FROM CHAR NUMBER(0-5) TO BYTE POINTER

	POINT	7,,
CBPTBL:	POINT 7,,6
	POINT 7,,13
	POINT 7,,20
	POINT 7,,27
	POINT 7,,34

>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
	SUBTTL	QSTOR - Store a value/text-buffer in a Q-register

; CALL:	MOVE	T1,[SIXBIT/NAME/]
;	MOVX	T2,QB$???+(BID or ADRREF)
;	MOVE	T3,VALUE
;	TX?	F,F$REF		; ?=Z IF ADRREF IS REALLY A TEXT-BUFFER ID
;				; ?=O IF ADRREF IS ADR OF REFERENCE TO A TEXT BUFFER
;	PUSHJ	P,QSTOR
;	(RETURN)
;
; PRESERVES ACS (EXCEPT X)

QSTOR:	PUSH	P,N		; SAVE AC N
	PUSH	P,L		; SAVE AC L
	JUMPE	T2,QSTOR1	;[23000] Any text in q-reg?
	TXNN	F,F$REF		; IS ADRREF A TEXT BUFFER ID?
	  JRST	QSTOR1		; NO

; MUST ADD TEXT BUFFER TO THE LINKED LIST AND GET ITS ID

	MOVEI	L,(T2)		; FETCH THE ADR OF REFERENCE
	PUSHJ	P,ADDBLK	; ADD THE BLOCK TO THE LINKED-LIST
	HRRI	T2,(N)		; AND RETURN THE TEXT-BUFFER ID


;[12000] Check for short name, or blank (THE TEXT BUFFER)

QSTOR1:
	TDNN	T1,[007777,,777777]	;[22000] See if short name
	 JRST [JUMPE T1,[PUSH	P,T3		;numeric value to .
			 TXNN	T2,QB$BID	;Check for text q-register
			  JRST	QSTR1A		;no text, leave buffer alone
			 SETZ	L,
			 MOVEI	N,(T2)		;Yes, find it
			 PUSHJ	P,FNDBLK
			  ERROR(BNF)		;OOPS
			 MOVX	T2,TB$BUF	;Set text buffer flag
			 HLLM	T2,T$BIT(T1)	;in buffer header &clr others
			 EXCH	T1,TXTBUF	;Point to text buffer
			 HLLZS	B$4PTR(T1)	;zero old back pointer
			 HRRZS	N,T$BID(T1)	;Get old BID and clear flags
			 PUSHJ	P,DELBLK	;Get rid of it
			 MOVEI	L,TXTBUF	;Save reference
			 MOVE	T1,TXTBUF	;Get back new buffer
			 HRRM	L,B$4PTR(T1)
	QSTR1A:		 POP	P,T3		;[12000] Get numeric val back
			 CAMLE	T3,@TXTBUF	;[12000] Check . value
			  SETZ	T3,		;[15000] out of range
			 MOVEM	T3,PTVAL	;[12000] Store it, it's OK
			 JRST	QSTOR3]		;Restore ACs & return
		LDB T5,[350700,,T1] ;[23000] Get q-register index
		ADDI T5,QREG-1	;[23000] Make address
		JRST QSTREX]	;[23000] Save in existing q-reg

; NOW SEE IF THE Q-REGISTER ALREADY EXISTS

	PUSHJ	P,QFIND		; SEE IF THE Q-REGISTER EXISTS
	 JRST	QSTOR2		; NO, CREATE A NEW Q-REGISTER

; STORE NEW VALUES IN EXISTING Q-REGISTER

QSTREX:	MOVE	X,Q$BIT(T5)	; SAVE OLD Q-BITS
	HRRZ	N,Q$PTR(T5)	; SAVE OLD Q-ID

	MOVEM	T2,Q$BIT(T5)	; SET NEW Q-BITS/Q-ID
	MOVEM	T3,Q$VAL(T5)	; SET NEW Q-VALUE

	TXNE	X,QB$BID	; WAS OLD Q-REGISTER A TEXT BUFFER?
	 PUSHJ	P,DELBLK	; YES, DELETE IT
	JRST	QSTOR3		; RESTORE ACS AND RETURN TO CALLER
; ADD A NEW Q-REGISTER TO QTAB

QSTOR2:	MOVE	X,QR		; FETCH QTAB PDP
	AOBJN	X,.+1		; INCREMENT IT
	EXCH	X,QR		; AND STORE IT
	PUSH	X,T1		; SET NEW Q-REGISTER NAME
	MOVE	X,QR		; FETCH QTAB PDP
	AOBJN	X,.+1		; INCREMENT QTAB PDP
	EXCH	X,QR		; AND STORE IT
	PUSH	X,T2		; SET NEW Q-REGISTER BITS
	MOVE	X,QR		; FETCH QTAB PDP
	AOBJN	X,.+1		; INCREMENT QTAB PDP
	EXCH	X,QR		; AND STORE IT
	PUSH	X,T3		; SET NEW Q-REGISTER VALUE/TEXT-BUFFER-ID

; RESTORE ACS AND RETURN TO CALLER

QSTOR3:	POP	P,L		; RESTORE AC L
	POP	P,N		; RESTORE AC N
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	QGET - Return a Q-register

; CALL:	MOVE	T1,[SIXBIT/NAME/]
;	PUSHJ	P,QGET
;	(RETURN)		; T1:= SIXBIT Q-REGISTER NAME
;				; T2:= BITS
;				; T3:= NUMERIC VALUE/TEXT-BUFFER-ID
;
; USES ACS T1-T3

QGET:

	MOVEM	T1,SBNAME	; SAVE THE Q-REGISTER NAME
	TDNN	T1,[007777,,777777] ;[22000] Single letter?
	 JRST	[JUMPE	T1,[MOVX T2,QB$BID	;[12000] It contains both
			    HRR	T2,TXTBUF	;[12000] Get addr of buffer
			    HRR	T2,T$BID(T2)	;[12000] Get buffer ID
			    MOVE T3,PTVAL	;[12000] . is numeric value
			    JRST CPOPJ1]		;[12000] win
		 LDB T2,[350700,,T1] ;[22000] Get the index
		 MOVE T3,QREG+<Q$VAL-Q$BIT>(T2) ;[22000] Get the value
		 MOVE T2,QREG(T2) ;[22000] And the bid/bits
		 JRST CPOPJ1]

	PUSHJ	P,QFIND		; FIND THE SPECIFIED Q-REGISTER
	 POPJ	P,		; IT DOESN'T EXIST
	MOVE	T2,Q$BIT(T5)	; FETCH BITS INTO AC T2
	MOVE	T3,Q$VAL(T5)	; FETCH VALUE/TEXT-BUFFER-ID INTO AC T3
	JRST	CPOPJ1		; AND RETURN TO CALLER
	SUBTTL	QFIND - Find a Q-register in QTAB

; CALL:	MOVE	T1,[SIXBIT/NAME/]
;	PUSHJ	P,QFIND
;	(FAIL RETURN)
;	(SUCCESS RETURN)
;
; USES ACS T1,T5
;This will not find the text buffer

QFIND:

; MAKE A AOBJN POINTER FOR SEARCHING THROUGH QTAB

	MOVE	T5,QTAB		; FETCH BASE ADR OF Q-REGISTER TABLE
	MOVEI	X,(T5)		; COPY OF SAME
	SUB	X,QR		; COMPUTE MINUS LENGTH OF Q-REGISTER TABLE
	HRLI	T5,(X)		; <-LEN,,ADR>

; SEARCH FOR THE SPECIFIED Q-REGISTER

QFIND1:	CAMN	T1,(T5)		; IS THIS THE ONE?
	 JRST	CPOPJ1		; YES, GIVE SUCCESS RETURN TO CALLER
	ADD	T5,[<2,,2>]	; NO, POINT TO NEXT Q-REGISTER
	AOBJN	T5,QFIND1	; AND LOOP FOR ALL Q-REGISTERS
	POPJ	P,		; Q-REGISTER NOT FOUND. GIVE FAIL
				; RETURN TO CALLER
	SUBTTL	MKROOM - Make room for an arbitrary # of chars in main text buffer

; CALL:	MOVEI	T1,#CHARS
;	PUSHJ	P,MKROOM
;	(return)
;
; Uses ACs 1-17 DOES NOT PRESERVE 1-5,N,M

MKROOM:	JUMPE	T1,CPOPJ	;[14000] Nothing to do
	JUMPL	T1,MKRM1	;[13000] need never expand if deleting
	MOVE	X,TXTBUF	; fetch reference to text buffer
	HLRZ	T2,B$1PTR(X)	; fetch adr of end of buffer
	SUBI	T2,T$DATA-B$1PTR(X) ; compute size of text buffer in words
	MOVE	N,@TXTBUF	; fetch # chars in text buffer
	ADDI	N,4(T1)		; plus # chars requested
	IDIVI	N,5		; CONVERTED TO WORDS
	SUB	N,T2		; needed size minus what we have
	JUMPLE	N,MKRM1		; we have enough space. just shift buffer

; Add space to main text buffer

	MOVEI	N,^D10(N)	; fetch # words we need (plus some extra)
	PUSH	P,L		; Save AC L
	MOVEI	L,TXTBUF	; Fetch adr of reference to text bufer
	PUSHJ	P,EXPAND	; Expand text buffer to required size
	POP	P,L		; restore AC L

; SAVE ACS

MKRM1:	MOVE	X,[<2,,ACSAVE+2>] ; SETUP BLT POINTER
	BLT	X,ACSAVE+17	; STORE ACS 2-17

; See if part of buffer must be shifted

	MOVE	X,PTVAL		; Fetch buffer pointer
	CAMN	X,@TXTBUF	; At end of buffer?
	 JRST	MKRM3		; yes, don't have to shift buffer contents
	JUMPL	T1,MKRM4	; NO, HAVE TO SHIFT PART OF BUFFER BACKWARDS
				; (IE: FOR THE "D" COMMAND)
; SHIFT FROM "." THROUGH "Z" UP C(T1) CHARACTERS

; GET READY FOR THE UPWARD MOVE

	MOVEI	14,(T1)		; AC14:=REQ (REQUESTED # CHARS)
	IDIVI	14,5		; AC14:=Q(REQ/5) , AC15:=REM(REQ/5)
	IMULI	15,7		; AC15:=(REM(REQ/5))*7
	MOVN	12,15		; AC12:=-(REM(REQ/5))*7
	MOVEI	15,-43(15)	; AC15:=(REM(REQ/5))*7-43
	MOVE	10,PTVAL	; PT (CURRENT BUFFER POSITION)
	IDIVI	10,5		; AC10:=Q(PT/5) , AC12:=REM(PT/5)
	ADD	10,TXTBUF	; MAKE AC10 AN ABSOULUTE ADR
	MOVEI	10,T$DATA(10)	; . . .
	MOVNI	16,-5(11)	; AC11:=-REM(PT/5)-5
	IMULI	16,7		; AC16:=-(REM(PT/5)-5)*7
	DPB	16,[POINT 6,MKRMBP,11] ; SIZE OF LAST PARTIAL WORD
	ADDI	14,1(10)	; AC14:=Q(REQ/5)+Q(PT/5)+1
	MOVE	16,@TXTBUF	; FETCH  CHAR ADR OF END OF BUFFER
	IDIVI	16,5		; AC16:=Q(Z/5)
	MOVEI	T4,T$DATA+1(16)	; COMPUTE # WORDS TO MOVE
	ADD	T4,TXTBUF	; . . .
	SUB	T4,10		; T2:=Q(Z/5)+1-Q(PT/5)=# WORDS TO MOVE

; PUT SHIFT ROUTINE IN FAST ACS

	HRLI	10,(MOVE T2,0(T4)) ; AC10:=MOVE T2,[Q(PT/5)](T4)
	HRLOI	11,(ROT T2,0)	   ; AC11:=ROT T2,-1
	HRLI	12,(ROTC T2,0)	   ; AC12:=ROTC T2,-(REM(REQ/5))*7
	MOVE	13,[TRZ T3,1]	   ; AC13:=TRZ T3,1 ;[14000] Clear LSN bit
	HRLI	14,(MOVEM T3,0(T4)); AC14:=MOVEM T4,[Q(PT/5)+Q(REQ/5)+1](T4)
	HRLI	15,(ROTC 2,0)	   ; AC15:=ROTC T2,(REM(REQ/5))*7-43
	MOVE	16,.+2		   ; AC16:=SOJGE T4,11
	MOVE	17,[JRST MKRM2]	   ; AC17:=JRST MKRM2
	SOJGE	T4,10		   ; T2:=T2-1. DONE?

; SHIFT IS ALMOST FINISHED

MKRM2:	PORTAL	.+1		;[316] BACK FROM FAST ACS
	ROTC	T2,43(12)	; STORE LAST PARTIAL WORD
	DPB	T2,MKRMBP	; . . .

; UPDATE THE # CHARS IN BUFFER

MKRM3:	ADDM	T1,@TXTBUF	; ADD # CHARS TO BUFFER COUNT

; RESTORE ACS AND RETURN TO CALLER

	MOVE	17,[<ACSAVE+2,,2>] ; SETUP BLT POINTER
	BLT	17,17		; ANS RESTORE ACS

	POPJ	P,		; AND RETURN TO CALLER
; SHIFT FROM "."+ABS(T1) THROUGH "Z" DOWN ABS(T1) CHARACTERS

MKRM4:	MOVE	14,PTVAL	; INITIALIZE PARTIAL WORD POINTER
	IDIVI	14,5		; AC14:=Q(PT/5) , AC15:=REM(PT/5)
	ADD	14,TXTBUF	; MAKE AC14 AN ABSOLUTE ADR
	ADDI	14,T$DATA	; . . .
	MOVE	T4,14		; T4:=Q(PT/5)
	HRRZM	14,MKRMB1	; INITIALIZE BP FOR LAST PARTIAL MOVE
	IMULI	15,7		; AC15:=(REM(PT/5))*7
	DPB	15,[POINT 6,MKRMB1,11] ; SIZE:=(REM(PT/5))*7
	MOVNI	15,-44(15)	; AC15:=44-(REM(PT/5))*7
	DPB	15,[POINT 6,MKRMB1,5] ; POSITION:=44-(REM(PT/5))*7
	MOVE	11,@TXTBUF	; FETCH "Z"
	ADDI	11,<T$DATA*5>+4	;[21000] Don't shift someone else
	IDIVI	11,5		; AC11:=Q(Z/5) , AC12:=REM(Z/5)
	ADD	11,TXTBUF	; MAKE AC11 AN ABSOLUTE ADR
	MOVE	13,T1		; AC13:=REQ (# CHARS TO ADD)
	IDIVI	13,5		; AC13:=Q(REQ/5)
	ADDI	13,-1(11)	; AC13:=Q(Z/5)-Q(REQ/5)
	MOVNI	12,(14)		; AC12:=(REM(REQ/5))
	IMULI	12,7		; AC12:=(REM(REQ/5))*7
	MOVNI	15,-43(12)	; AC15:=43-(REM(REQ/5))*7
	SUBI	T4,1(13)	; T2:=Q(PT/5)+Q(REQ/5)+Q(REQ/5)-Q(Z/5)-1
				; = # WORDS TO SHIFT

; NOW  PUT THE BACKWARDS SHIFT ROUTINE IN THE FAST ACS

	HRLI	11,(MOVE T3,(T4)) ; AC11:=MOVE T3,[Q(Z/5)+1](T4)
	HRLI	12,(ROTC T2,0)	  ; AC12:=ROTC T2,(REM(REQ/5))*7
	HRLI	13,(MOVEM T2,(T4))  ; AC13:=MOVEM T2,[Q(Z/5)-Q(REQ/5)](T4)
	MOVE	14,[ADDM T2,@13]  ; AC14:=ADDM T2,@13
	HRLI	15,(ROTC T2,0)	  ; AC15:=ROTC T2,43-(REM(REQ/5))*7
	MOVE	16,MKRM5	  ; AC16:=AOJLE T2,11
	MOVE	17,[JRST MKRM6]	  ; AC17:=JRST KMRM6

	LDB	T5,MKRMB1	; FECTH THE LAST PARTIAL WORD
	MOVE	T2,@11		; FETCH FIRST WORD
	ROT	T2,-1		; T2:=Q(PT/5)+Q(REQ/5) RIGHT JUSTIFIED
MKRM5:	AOJLE	T4,11		; T2:=T2+1. DONE?

; DOWNWARD SHIFT IS ALMOST DONE

MKRM6:	PORTAL	.+1		;[316] BACK FROM FAST ACS
	DPB	T5,MKRMB1	; STORE THE LAST PARTIAL WORD
	JRST	MKRM3		; DONE. RESTORE ACS AND RETURN
	SUBTTL	ADDBLK - Add a block to the Linked-List

; CALL:	MOVEI	L,ADRREF
;	PUSHJ	P,ADDBLK
;	(RETURN)		; ID IS RETURNED IN AC N
;
; ACS PRESERVED

ADDBLK:	PUSHJ	P,SAVE2		; SAVE ACS
	MOVE	T1,(L)		; FETCH ADR OF BLOCK
	SETZM	(L)		; CLEAR THE REFERENCE
	SKIPN	T2,LNKLST+1	; ANYTHING IN LINKED-LIST?
	 MOVEI	T2,LNKLST	; NO
	HRRM	T2,B$1PTR(T1)	; LNKLST+1 REFERENCES 2ND WORD OF BLOCK
	MOVEI	X,B$1PTR(T1)	; FETCH ADR OF FIRST WORD
	HRRM	X,(T2)		; 2ND WORD OF LAST BLOCK REFERENCES
				; FIRST WORD OF NEW BLOCK
	MOVEI	X,LNKLST+1	; FETCH ADR OF LNKLST+1
	HRRM	X,B$2PTR(T1)	; 2ND WORD OF NEW BLOCK REFERENCES
				; LNKLST+1
	MOVEI	X,B$2PTR(T1)	; FETCH ADR OF  2ND WORD OF NEW BLOCK
	MOVEM	X,LNKLST+1	; LNKLST+1 REFERENCES 2ND WORD OF NEW BLOCK

; ASSIGN AN ID TO THIS NEW BLOCK

	AOS	N,LNKID		; GENERATE A NEW ID
				; AND RETURN IT IN AC N
	MOVEM	N,T$BID(T1)	; STORE BID FOR BLOCK

; INITIALIZE THE REFERENCE COUNT FOR THIS BLOCK TO 1

	MOVEI	X,1		; INIT REFERENCE COUNT TO 1
	MOVEM	X,T$RCNT(T1)	; AND STORE IT AS 4TH WORD OF NEW BLLOCK
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	REFBLK - Add one to the Reference Count for A BLOCK IN LINKED-LIST

; CALL:	MOVEI	N,ID
;	PUSHJ	P,REFBLK
;	(RETURN)
;
;	CLOBBERS AC X
;[12000] Saves AC L.	This is the same AC as SARG and we want to allow
;			all arguments to pass through $PUSH & $POP

REFBLK:	PUSH	P,L		;[12000] Save AC L
	SETZ	L,		; T1 WILL POINT TO BLOCK
	PUSHJ	P,FNDBLK	; FIND THE BLOCK WITH SPECIFIED ID
	 SKP			; NONE. RETURN TO CALLER
	AOS	T$RCNT(T1)	; ADD ONE TO THE REFERENCE COUNT
	POP	P,L		;[12000] Restore AC L
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	DELBLK - Un-Reference a Block in Linked-List

; CALL:	MOVEI	N,ID
;	PUSHJ	P,DELBLK
;	(RETURN)
;
; ACS PRESERVED (EXCEPT X,L)

DELBLK:	PUSHJ	P,SAVE5		; SAVE ACS T1-T5
	SETZ	L,		; T1 WILL POINT TO BLOCK
	PUSHJ	P,FNDBLK	; FIND THE BLOCK WITH THE SPECIFIED ID
	 POPJ	P,		; DOESN'T EXIST. RETURN TO CALLER

	SOSLE	T$RCNT(T1)	; DECREMENT THE REFERENCE COUNT
	 POPJ	P,		; OTHERS USING BLOCK. LEAVE IT IN LIST

; REMOVE THE BLOCK FROM THE LIST

	HRRZ	T2,T$PBUF(T1)	; FETCH POINTER TO PREVIOS BLOCK
	HRRZ	T3,T$NBUF(T1)	; FETCH POINTER TO NEXT BLOCK
	HLLZS	T$PBUF(T1)	; DELETE ALL REFERENCES TO BLOCK
	HRLI	T1,-C$NREF	; MAKE AOBJN POINTER TO DELETE REFS

DELBK0:	SETZM	T$1REF(T1)	; CLEAR 2 REFS
	AOBJN	T1,DELBK0	; AND TRY NEXT 2 REFS

; PATCH THE LINKS AROUND THE BLOCK

DELBK1:	HRRM	T3,(T2)		; LAST POINTS TO NEXT
	HRRM	T2,(T3)		; NEXT POINTS TO LAST
GPOPJ:	TXO	F,F$GCN		; FLAG THAT A GARBAGE COLLECTION NEEDED
	POPJ	P,		; AND RETURN TO CALLER
	POPJ	P,		; AND RETURN TO CALLER
	
	SUBTTL	FNDBLK - Find a Block (given its id) in the Linked-List

; CALL:	MOVEI	N,ID
;	MOVEI	L,ADRREF	; WILL REFERENCE THE BLOCK WHEN FOUND
;				; OR "SETZ L," IF T1 IS TO POINT TO BLOCK
;	PUSHJ	P,FNDBLK
;	(FAIL RETURN)
;	(SUCCESS RETURN)	; ADRREF WILL REFERENCE THE BLOCK
;				; IF L=0, THEN T1 POINTS TO BLOCK
;
; SMASHES ACS X,T1,T2
;[12000] Searches LNKLST backwards (most recently created first)

FNDBLK:	SKIPN	T1,LNKLST+1	;[12000] ANYTHING IN LINKED LIST?
	 POPJ	P,		; NO, GIVE FAIL RETURN TO CALLER

; FIND THE BLOCK GIVEN ITS ID

FNDBK1:	CAIN	T1,LNKLST	;[12000] AT END OF LIST?
	 POPJ	P,		; YES, GIVE UP AND GIVE FAIL RETURN TO CALLER
	HRRZ	X,T$BID-B$2PTR(T1) ;[12000] FETCH ID OF THIS BLOCK
	CAIN	X,(N)		; IS THIS THE ID WE WANT?
	 JRST	FNDBK2		; YES
	HRRZ	T1,-1(T1)	;[12000] NO, FETCH POINTER TO NEXT BLOCK IN LIST
	JUMPN	T1,FNDBK1	; [14000] Check for non-zero AND TRY IT
	 ERROR	(LLB)		;[14000] Linked list is broken

; FOUND BLOCK WITH SPECIFIED ID. SET UP REFERENCE TO IT

FNDBK2:	MOVEI	T1,C$NREF-1(T1) ;[12000] FETCH ADR OF FIRST DATA WORD IN BLOCK
	JUMPE	L,CPOPJ1	; RETURN IF T1 SHOULD POINT TO BLOCK
	MOVEM	T1,(L)		; STORE IT IN REFERENCE
	HRLM	L,B$2PTR(T1)	; BIND THE REFERENCE TO BLOCK
	JRST	CPOPJ1		; AND GIVE SUCCESS RETURN TO CALLER
	SUBTTL	SAVE AC ROUTINES
SAVE2:	POP	P,X		; SAVE RETURN ADDRESS
	PUSH	P,T1		; SAVE T1
	PUSH	P,T2		; SAVE T2
	PUSHJ	P,(X)		; RETURN
	SKP			; CPOPJ RETURN
	AOS	-2(P)		; CPOPJ1 RETURN
REST2:	POP	P,T2		; RESTORE T2
	POP	P,T1		; RESTORE T1
	POPJ	P,		; AND RETURN

SAVE5:	POP	P,X		; SAVE RETURN ADDRESS
	PUSH	P,T1		; SAVE T1
	PUSH	P,T2		; SAVE T2
	PUSH	P,T3		; SAVE T3
	PUSH	P,T4		; SAVE T4
	PUSH	P,T5		; SAVE T5
	PUSHJ	P,(X)		; RETURN
	SKP			; CPOPJ RETURN
	AOS	-5(P)		; CPOPJ1 RETURN
	POP	P,T5		; RESTORE T5
	POP	P,T4		; RESTORE T4
	POP	P,T3		; RESTORE T3
	JRST	REST2		; RESTORE T2,T1 AND RETURN
>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<

	SUBTTL	CPOPJX - Various POPJ Returns

; CPOPJ:  NON-SKIP RETURN
; CPOPJ1: SKIP RETURN
; CPOPJ2: DOUBLE-SKIP RETURN

CPOPJ2:	AOS	(P)
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,		; RETURN TO CALLER
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
	SUBTTL	REQM - REQUEST MEMORY (CORE ALLOCATION)

; REQM - CORE ALLOCATION ROUTINE
;
; CALL IS:	MOVE	L,[XWD ADRREF,LENGTH]
;		PUSHJ	P,REQM
;		(RETURN)
;
; CALLER MUST ALSO SET UP 'ADRREF' (REQM WILL ADD THE ADR OF
; THE FIRST DATA WORD IN THE ALLOCATED BLOCK TO THE RH OF 'ADRREF')
;
; ACS PRESERVED

REQM0:	TXNN	F,F$GCN		; GARBAGE COLLECTION NEEDED ?
	 JRST	REQM3		; NO, SIZE OF BLOCK.GT.C$GSIZ
	PUSHJ	P,GARCOL	; PERFORM A GARBAGE COLLECTION
	SKP			; ACS ALREADY SAVED

REQM:	PUSHJ	P,SAVE2		; SAVE T1,T2
	MOVE	X,.JBFF		; FETCH ADR OF FIRST FREE LOCATION
	MOVEI	T1,(X)		; " IN T1
	ADDI	T1,C$NREF(L)	; ADD REQUESTED LENGTH PLUS OVERHEAD WORDS
	MOVEI	T2,(L)		; FETCH REQUESTED LENGTH
	ADDB	T2,GSIZE	; ACCUMULATE # WORDS ALLOCATED SINCE
				; LAST GARBAGE COLLECTION
	CAMG	T1,.JBREL	; DO WE HAVE THE CORE?
	 JRST	REQM1		; YES
	CAILE	T2,C$GSIZ	; NO, TIME FOR A GARBAGE COLLECTION?
	 JRST	REQM0		; YES, PERFORM ONE
REQM3:	MOVEI	T2,(T1)		; NO, FETCH ADR OF HIGHEST LOC WE WANT
	CORE	T2,		; AND ASK MONITOR FOR THE CORE
	 JRST	REQM2		; NOT ENOUGH CORE!

REQM1:	MOVEI	T2,1(X)		; FETCH ADR OF START OF NEW BLOCK
	HRLI	T2,(X)		; SET UP A BLT POINTER ...
	BLT	T2,(T1)		; AND ZERO OUT THE NEW BLOCK
	MOVEM	T1,.JBFF	; SAVE POINTER TO FIRST FREE LOCATION
	HRLM	T1,(X)		; SETUP POINTER TO NEXT BLOCK
	HLRM	L,(X)		; SETUP POINTER TO FIRST REFERENCE
	SETZM	(T1)		; ZERO THE FIRST FREE LOCATION
	HLRZ	T1,L		; FETCH ADR OF REFERENCE
	MOVEI	X,C$NREF(X)	; FETCH ADR OF FIRST DATA WORD
	ADD	X,(T1)		; ADD ADR FIRST DATA TO RH OF REFERENCE
	HRRM	X,(T1)		; AND UPDATE THE REFERENCE
	POPJ	P,		; AND RETURN

REQM2:	TXNE	F,F$GCN		; IS A GARBAGE COLLECTION NEEDED?
	 JRST	REQM0		; YES, PERFORM ONE
	ERROR	(CEF)		; NO, GIVE AN ERROR :
				; "CORE EXPANSION FAILURE"
	SUBTTL	RELM - RELEASE MEMORY

; RELM - RELEASE A BLOCK OF MEMORY
;
; CALL IS:	MOVE	L,[XWD OFFSET,ADRREF]
;		PUSHJ	P,RELM
;		(RETURN)
;
; 'OFFSET' IS THE DIFFERENCE BETWEEN THE RH OF 'ADRREF' AND ADR OF FIRST DATA.
;
; ACS PRESERVED

RELM:	SKIPN	(L)		; IS REFERENCE BOUND TO ANY BLOCK?
	 POPJ	P,		; NO, GIVE IMMEDIATE RETURN
	TXO	F,F$GCN		; GARBAGE COLLECTION NEEDED
	HLRE	X,L		; FETCH THE OFFSET
	MOVN	X,X		; NEGATE THE OFFSET
	ADD	X,(L)		; ADD THE REFERENCE
	HLLZS	B$1PTR(X)	; ZAP THE 1ST REFERENCE
	HRLI	X,-C$NREF+1	; MAKE AOBJN POINTER FOR REST

RELM0:	SETZM	B$2PTR(X)	; CLEAR 2 REFS
	AOBJN	X,RELM0		; AND TRY NEXT REFS

	SETZM	(L)		; ZERO THE REFERENCE
	POPJ	P,		; AND RETURN
	SUBTTL	GARCOL - GARBAGE COLLECTION ROUTINE

; GARCOL - GARBAGE COLLECTION ROUTINE
;
; CALL IS:	PUSHJ	P,GARCOL
;		(RETURN)
;
; ACS PRESERVED

GARCOL:	PUSHJ	P,SAVE5		; SAVE T1,T2,T3,T4,T5
	PUSH	P,L		; SAVE AC L
	SETZ	T3,		; ZERO THE RELOCATION FACTOR
	MOVE	T4,HEAD		; FETCH ADR OF FIRST BLOCK OF CORE

; LOOP FOR EVERY BLOCK OF CORE

GCLOOP:	SKIPN	X,(T4)		; END OF LIST?
	 JRST	GCDONE		; YES, FINISH UP
	HLRZ	T5,(T4)		; FETCH ADR OF NEXT BLOCK
	MOVE	T1,1(T4)	; FETCH 2ND REFERENCE WORD (1ST IS IN Z)
	JUMPN	T1,GCMOVE	; MOVE BLOCK IF IT IS REFERENCED
	TRNE	X,-1		; IS BLOCK REFERENCED?
	 JRST	GCMOVE		;YES, MOVE IT

; THIS IS AN UNBOUND BLOCK

	HLRZ	X,X		; FETCH ADR OF NEXT BLOCK
	SUBI	X,(T4)		; COMPUTE LENGTH OF THIS BLOCK
	ADDI	T3,(X)		; ACCUMULATE THE RELOCATION FACTOR

; TRY NEXT BLOCK

GCNEXT:	MOVEI	T4,(T5)		; LOAD ADR OF NEXT BLOCK
	JRST	GCLOOP		; AND TRY NEXT BLOCK

; MOVE THIS BLOCK (IF RELOCATION IS NON-ZERO)
;
; FIRST FIX UP REFERENCES

GCMOVE:	JSP	L,FIXREF	; RELOCATE THE REFERENCES

; NOW RELOCATE THE BLOCK

GCM3:	MOVEI	T2,(T4)		; FETCH ADR OF BLOCK
	SUBI	T2,(T3)		; ADR WHERE BLOCK WILL GO
	HRLI	T2,(T4)		; ADR WHERE IT IS NOW
	HLRZ	T1,(T4)		; ADR OF END OF BLOCK+1
	SUBI	T1,(T3)		; END OF WHERE IT WILL GO
	MOVEI	X,(T2)		; SAVE ADR OF NEW POSITION OF BLOCK
	BLT	T2,-1(T1)	; MOVE THE BLOCK
	HRLM	T1,(X)		; STORE POINTER TO NEXT BLOCK
	JRST	GCNEXT		; NOW TRY THE NEXT BLOCK
; FINISH UP AFTER THE GARBAGE COLLECTION

GCDONE:	MOVNI	T1,(T3)		; FETCH NEGATIVE RELOCATION FACTOR
	ADDB	T1,.JBFF	; UPDATE POINTER TO FIRST FREE
	SETZM	(T1)		; ZERO THE FIRST FREE LOC
	HLRZ	X,.JBCOR	; FETCH MIN CORE SIZE
	CAIGE	T1,(X)		; BELOW MINIMUM SIZE?
	 MOVEI	T1,(X)		; YES, USE MINIMUM SIZE
	CORE	T1,		; RELEASE UNNEEDED CORE
	 HALT	.+1		;[20000] Shouldn't happen ever
	SETZM	GSIZE		; CLEAR "# WORDS ALLOCATED SINCE LAST
				;  GARBAGE COLLECTION"
	TXZ	F,F$GCN		; SET "GARBAGE COLLECTION NOT NEEDED"
	POP	P,L		; RESTORE AC L
	POPJ	P,		; AND RETURN
	SUBTTL	FIXREF - RELOCATE THE REFERNECES TO A DYNAMIC BLOCK

; CALL:	MOVEI	T4,BLOCK
;	MOVEI	T3,RELOC.CONSTANT
;	MOVEI	T5,ADDR OF NEXT BLOCK
;	JSP	L,FIXREF
;	(RETURN)
;
; SMASHES ACS X,T1,T2. USES AC T3,T5

FIXREF:	JUMPE	T3,(L)		; RETURN IF RELOC.CONSTANT=ZERO

	MOVEI	T2,(T4)		;[14000] Make AOBJN pointer in temp AC
	HRLI	T2,-C$NREF	; MAKE AOBJN POINTER FOR LOOPING
	JRST	FIXRF2		; AND JUMP INTO LOOP FOR FIRST REF

FIXRF1:	HLRZ	T1,(T2)		; FETCH ADR OF LH REF
	JUMPE	T1,FIXRF2	; NONE. TRY RH
	HRRZ	X,(T1)		; FETCH THE CONTENTS OF REF
	CAIGE	X,(T5)		;[14000] Check this 'ref'
	CAIGE	X,(T4)		;[14000] Does it point to this block at all??
	 JRST	[HRRZS (T2)	;[14000] NO!!! It's bogus, get rid of it!
		 JRST FIXRF2]	;[14000] Try next one.
	SUBI	X,(T3)		; RELOCATE IT
	HRRM	X,(T1)		; AND RESTORE IT

FIXRF2:	HRRZ	T1,(T2)		; FETCH ADR OF RH REF
	JUMPE	T1,FIXRF3	; NONE. TRY NEXT WORD
	HRRZ	X,(T1)		; FETCH CONTENTS OF REF
	CAIGE	X,(T5)		;[14000] Check this 'ref'
	CAIGE	X,(T4)		;[14000] Does it point to this block at all??
	 JRST	[HLLZS (T2)	;[14000] NO!!! It's bogus, get rid of it!
		 JRST FIXRF3]	;[14000] See if any more
	SUBI	X,(T3)		; RELOCATE IT
	HRRM	X,(T1)		; AND RESTORE IT

FIXRF3:	AOBJN	T2,FIXRF1	; LOOP FOR ALL REFERENCE WORDS

	JRST	(L)		; DONE. RETURN TO CALLER
	SUBTTL	EXPAND - Expand a Block of Core

; CALL:	MOVEI	N,ADDLEN
;	MOVE	L,[<OFFSET,,ADRREF>]
;	PUSHJ	P,EXPAND
;	(RETURN)
;
; 'ADDLEN' IS THE # WORDS TO ADD AT END OF BLOCK
; 'OFFSET' IS THE DIFFERENCE BETWEEN THE RH OF 'ADRREF' AND ADDRESS
;	OF FIRST DATA WORD IN BLOCK.
; 'ADRREF' IS THE ADDRESS OF THE REFERENCE TO BLOCK.
;
; USES AC X. ALL OTHER ACS PRESERVED.

EXPAND:	PUSHJ	P,SAVE5		; SAVE T1-T5

; SEE IF BLOCK TO BE EXPANDED IS LAST IN CORE

	HLRZ	T1,L		; FETCH OFFSET
	ADD	T1,(L)		; COMPUTE ADR OF BLOCK
	HLRZ	T2,B$1PTR(T1)	; FETCH POINTER TO NEXT BLOCK
	SKIPE	(T2)		; A BLOCK AFTER THIS ONE?
	 JRST	EXPAN1		; YES, MUST RE-ALLOC. AND BLT

; BLOCK IS AT END OF CORE. JUST EXTEND IT.
;
; ALLOCATE A BLOCK OF 'ADDLEN'-C$NREF WORDS (WHICH IS IMMEDIATELY AFTER BLOCK)

	PUSH	P,L		; SAVE AC L
	MOVEI	L,-C$NREF(N)	; FETCH LEN OF  ANNEX BLOCK
	HRLI	L,EXPREF	; EXPREF WILL REFERENCE THE ANNEX BLOCK
	SETZM	EXPREF		; EXPREF WILL POINT TO FIRST DATA WORD
	PUSHJ	P,REQM		; ALLOCATE THE ANNEX BLOCK
	POP	P,L		; RESTORE AC L

	MOVE	T2,EXPREF	; FETCH ADR OF ANNEX BLOCK
	HRLI	T2,-C$NREF+1	; MAKE AOBJN PTR FOR CLEARING ALL REFS

EXPAN0:	SETZM	B$1PTR(T2)	; CLEAR 2 REFS
	AOBJN	T2,EXPAN0	; AND TRY FOR NEXT REF WORD

	HLRZ	T1,L		; FETCH ADR OF MAIN BLOCK
	ADD	T1,(L)		; . . .
	HLRZ	T2,B$1PTR(T1)	; FETCH POINTER TO ANNEX BLOCK
	ADDI	T2,(N)		; MAKE IT POINT PAST ANNEX BLOCK
	HRLM	T2,B$1PTR(T1)	; PUT IT BACK IN MAIN BLOCK
	JRST	GPOPJ		; AND RETURN TO CALLER
				; (GARBAGE COLLECTION NEEDED)
; ALLOCATE A BIGGER BLOCK AND BLT OLD BLOCK TO IT

EXPAN1:	PUSH	P,L		; SAVE AC L
	MOVEI	L,(T2)		; COMPUTE LENGTH OF OLD BLOCK
	SUBI	L,(T1)		; . . .
	MOVEI	T3,(L)		; SAVE LENGTH OF OLD BLOCK
	ADDI	L,(N)		; COMPUTE NEW LENGTH
	HRLI	L,EXPREF	; ADR OF REF TO NEW BLOCK
	SETZM	EXPREF		; REF WILL BE TO FIRST DATA WORD
	PUSHJ	P,REQM		; ALLOCATE A NEW,BIGGER BLOCK

; BLT OLD BLOCK TO NEW BLOCK

	POP	P,L		; RESTORE AC L
	MOVE	T4,EXPREF	; FETCH ADR OF NEW BLOCK
	MOVEI	X,(T4)		; COPY OF "
	HLRZ	T1,L		; FETCH 'OFFSET'
	ADD	T1,(L)		; COMPUTE ADR OF OLD BLOCK
	HRLI	X,(T1)		; MAKE SOURCE OF BLT POINTER
	MOVEI	T2,(T3)		; FETCH LENGTH OF OLD BLOCK
	ADDI	T2,(X)		; END OF DEST
	BLT	X,-1(T2)	;[12000] BLT !!ONLY!! THE OLD BLOCK TO NEW

; FIX UP THE REFERENCES TO NEW BLOCK

	MOVE	T2,EXPREF	; FETCH ADR OF NEW BLOCK
	SUBI	T2,(T1)		; COMPUTE REFERENCE RELOCATION CONSTANT

	HRLI	T1,-C$NREF	; MAKE AOBJN POINTER FOR LOOP
	HLRZ	T5,B$1PTR(T1)	;[20000] Fetch add of blk after old one
	JRST	EXPAN3		; AND JUMP INTO LOOP FOR FIRST REF
EXPAN2:	HLRZ	X,B$1PTR(T1)	; FETCH ADR OF LH REF
	JUMPE	X,EXPAN3	; NONE. TYR RH REF
	HRRZS	B$1PTR(T1)	; CLEAR THE REF FROM OLD BLOCK
	HRRZ	T3,(X)		; FETCH CONTENTS OF REF
	CAIGE	T3,(T5)		;[20000] Is the ref for real??
	CAIGE	T3,B$1PTR-C$NREF(T1) ;[20000] ... (not a definitive test)
	 JRST	EXPAN3		;[20000] It's bogus! skip it
	ADDI	T3,(T2)		; AND RELOCATE IT
	HRRM	T3,(X)		; AND RESTORE IT
	HRLM	X,B$1PTR(T4)	; AND REF TO NEW BLOCK

EXPAN3:	HRRZ	X,B$1PTR(T1)	; FETCH ADR OF RH REF
	JUMPE	X,EXPAN4	; NONE. TRY NEXT REF WORD
	HLLZS	B$1PTR(T1)	; CLEAR THE REF FROM OLD BLOCK
	HRRZ	T3,(X)		; FETCH CONTENTS OF REF
	CAIGE	T3,(T5)		;[20000] Is the ref for real??
	CAIGE	T3,B$1PTR-C$NREF(T1) ;[20000] ... (not a definitive test)
	 JRST	EXPAN4		;[20000] It's bogus, skip it
	ADDI	T3,(T2)		; RELOCATE IT
	HRRM	T3,(X)		; AND RESTORE CONTENTS
	HRRM	X,B$1PTR(T4)	; ADD REF TO NEW BLOCK

EXPAN4:	MOVEI	T4,1(T4)	; INCR PTR TO NEXT REF IN NEW BLOCK
	AOBJN	T1,EXPAN2	; AND LOOP FOR ALL REFS OF OLD BLOCK
	JRST	GPOPJ		; AND RETURN TO CALLER
				; (AND FLAG THAT GARBAGE COLLECTION NEEDED)
	SUBTTL	COMPRS - Compress a Block of Core

; CALL:	MOVEI	N,<#WORDS>	; # WORDS TO REMOVE FROM END OF BLOCK
;	MOVX	L,<OFFSET,,ADRREF> ; FOR THE BLOCK
;	PUSHJ	P,COMPRS
;	(RETURN)
;
; SMASHES ACS X,T1-T3

COMPRS:	CAIG	N,-B$1PTR	; CAN WE COMPRESS THE BLOCK?
	 POPJ	P,		; NO, IT WOULDN'T DO ANY GOOD

; COMPUTE THE ADR OF FIRST DATA WORD IN BLOCK

	HLRZ	T1,L		; FETCH THE OFFSET
	ADD	T1,(L)		; ADD TO POINTER INTO BLOCK

	MOVS	T2,B$1PTR(T1)	; FETCH FIRST WORD OF BLOCK
	MOVEI	T3,(T2)		; SAVE ADR OF END OF BLOCK +1
	SUBI	T2,(N)		; COMPUTE NEW END OF BLOCK+1
	MOVSM	T2,B$1PTR(T1)	; PUT THE WORD BACK IN FIRST WORD OF BLOCK

	SETZM	(T2)		; CLEAR THE UNNEEDED PART OF BLOCK
	MOVEI	X,1(T2)		; FORM BLT POINTER TO CLEAR
	HRLI	X,(T2)		; . . .
	BLT	X,C$NREF(T2)	; CLEAR THE REFERENCES FOR THE "NEW" BLOCK
	HRLZM	T3,(T2)		; SET POINTER TO NEXT BLOCK FOR "NEW" BLOCK
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	SETSTK - INITIALIZE A DYNAMIC STACK

; CALL:	STSTK	(AC,LEN,REF)
;	(RETURN)
;
; SMASHES ACS X,T1,T2,T3,N,L

SETSTK:	HLRZ	T3,T1		; FETCH REF ADR
	MOVEI	L,(T3)		; AND COPY INTO AC L
	PUSHJ	P,RELM		; RELEASE ANY EXISTING STACK
	MOVE	L,T1		; FETCH <REF,,LEN>
	PUSHJ	P,REQM		; AND ALLOCATE THE NEW STACK
	MOVNI	X,(T1)		; FETCH -LEN
	HRLOI	X,(X)		; FORM "IOWD LEN,0"
	ADD	X,(T3)		; FINISH THE PDP
	POP	P,T2		; POP OUR RETURN ADR
	MOVEM	X,(N)		; INITIALIZE THE PDP POINTER
	PUSH	P,T2		; PUSH OUR RETURN ADR
	HRL	N,T1		; FORM <LEN,,AC>
	HRLM	N,B$2PTR+1(X)	; BIND AC TO PDL
	MOVEI	L,(T3)		; FETCH ADR OF REF
	PJRST	ADDPDL		; AND ADD PDL TO THE PROTECTED PDL LIST
				; AND RETURN TO CALLER
	SUBTTL	ADDPDL - Add a PDL to PDLTAB

; CALL:	MOVE	N,[<INCREMENTAL LENGTH,,ADR>]
;	MOVE	L,[<OFFSET,,ADRREF>]
;	PUSHJ	P,ADDPDL
;	(RETURN)
;
; NOTE:	ARGUMENTS ARE DESCRIBED IN THE 'FNDPDL' ROUTINE.
;
; USES ACS X,T1,T2

ADDPDL:	PUSHJ	P,FNDPDL	; SEE IF THE PDL ALREADY EXISTS
	 JUMPE	T1,[ERROR (PTS)] ; NO, AND THERE'S NO MORE ROOM!!
	MOVEM	N,(T1)		; STORE <INC. LEN.,,ADR> IN PDLTAB
	MOVEM	L,C$NPDL(T1)	; STORE <OFFSET,,ADRRES> IN PDLTAB
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	DELPDL - Remove a PDL from PDLTAB

; CALL:	MOVEI	N,ADR
;	PUSHJ	P,DELPDL
;	(RETURN)
;
; NOTE:	ARGUMENTS ARE DESCRIBED IN THE 'FNDPDL' ROUTINE

DELPDL:	PUSHJ	P,FNDPDL	; FIND THE PDL IN PDLTAB
	 POPJ	P,		; NOT THERE. GOOD, SAVES US THE TROUBLE
	SETZM	(T1)		; KNOCK THE PDL OUT OF PDLTAB
	POPJ	P,		; AND RETURN TO CALLER
	SUBTTL	FNDPDL - Find a PDL in PDLTAB

; CALL:	MOVEI	N,ADR
;	PUSHJ	P,FNDPDL
;	(FAIL RETURN)	; AC T1 POINTS TO FIRST FREE ENTRY
				; OR IS ZERO IF PDLTAB IS FULL
;	(SUCCESS RETURN)	; AC T1 POINTS TO PDL ENTRY IN PDLTAB
;
; PDLTAB:
;	----------------------------------------------
;	! INCREMENTAL LENGTH ! ADR                   !
;	!--------------------------------------------!
;	/		. . .			     /
;	!--------------------------------------------!
;	!    OFFSET          !  ADRREF		     !
;	!--------------------------------------------!
;	/		. . .			     /
;	----------------------------------------------
;
;
; 'INCREMENTAL LENGTH' IS THE # WORDS ADDED TO PDL ON EACH POV.
;
; 'ADR' IS THE ADDRESS OF PDP FOR THE DESIRED PDL.
;
; 'ADRREF' IS THE ADDRESS OF REFERENCE TO THE PDL.
;
; 'OFFSET' IS THE DIFFERENCE BETWEEN THE RH OF ADRREF AND THE
;	ADDRESS OF FIRST WORD OF PDL.
;
; USES ACS X,T1,T2

FNDPDL:	MOVE	T1,[IOWD C$NPDL,PDLTAB+1] ; AOBJN PTR FOR SEARCHING
				; THROUGH PDLTAB
	SETZ	T2,		; IN CASE THERE ARE NO FREE ENTRIES

FNDPD1:	HRRZ	X,(T1)		; FETCH 'ADR' OF A PDL ENTRY FROM PDLTAB
	CAIN	X,(N)		; IS IT THE 'ADR' WE WANT?
	 JRST	CPOPJ1		; YES

	SKIPN	(T1)		; NO, IS IT A FREE ENTRY?
	 MOVEI	T2,(T1)		; YES, REMEMBER ITS ADDRESS
	AOBJN	T1,FNDPD1	; LOOP FOR ALL ENTRIES IN PDLTAB

	MOVEI	T1,(T2)		; CAN'T FIND DESIRED PDL. RETURN FF ADR.
	POPJ	P,		; AND GIVE FAIL RETURN TO CALLER
	SUBTTL	APRTRP - APR Trap handler (POV Recovery)

APRTRP:	MOVEM	17,ACSAVE+17	; SAVE AC 17
	MOVEI	17,ACSAVE	;[12000] Build BLT argument
	BLT	17,ACSAVE+16	;[12000] don't save 17 again but save all others
	MOVE	17,ACSAVE+17	;[12000] restore it instead

; Find out what hit us

	MOVE	X,.JBCNI	; FETCH REASON FOR APR TRAP
	TXNE	X,AP.ILM	;[420] IS IT BECAUSE OF ILL MEM REF?
	 ERROR	(ILM)		;[420] YES, REPORT IT TO LUSER
	TXNN	X,AP.POV	; IS IT BECAUSE OF PDL OVERFLOW?
	 ERROR	(UAT)		; NO. ** UNENABLED APR TRAP **

; SETUP TEMP CONTROL PDP

	MOVE	P,[IOWD C$TPDL,TPDL] ; SETUP TEMP PDL PDP

	MOVEI	N,P		; CHANGE THE PDL ENTRY IN PDLTAB FOR
	PUSHJ	P,FNDPDL	; THE CONTROL PDL
	 ERROR	(MCP)		; ** MISSING CONTROL PDL **

	MOVEI	X,ACSAVE+P	; TO POINT TO ACSAVE+P
	HRRM	X,(T1)		; WHERE THE REAL P IS HIDDEN
	MOVEI	T3,(T1)		; SAVE 'P' INDEX INTO PDLTAB TO SAVE TIME
	MOVE	T5,PDL		; FETCH ADR OF CONTROL PDL
	HRLM	X,B$2PTR(T5)	; AND REFERENCE ACSAVE+P TO IT

; FIND THE PDP WHICH CAUSED THE OVERFLOW

	MOVE	T1,[IOWD C$NPDL,PDLTAB+1] ; FOR LOOPING THROUGH PDLTAB

APR1:	SKIPN	T2,(T1)		; A NULL ENTRY IN PDLTAB?
	 JRST	APR2		; YES, IGNORE IT
	SKIPL	(T2)		; NO, IS THIS THE OVERFLOWED PDL?
	 JRST	APR3		; YES. STOP THE SEARCH
APR2:	AOBJN	T1,APR1		; NO, KEEP SEARCHING THROUGH PDLTAB
	ERROR	(CFP)		; ** CAN'T FIND OVERFLOWED PDL **
; AC T1 POINTS TO PDLTAB ENTRY FOR PDL THAT OVERFLOWED
;
; EXPAND THE PDL THAT OVERFLOWED

APR3:	HLRZ	N,(T1)		; FETCH THE INCREMENTAL LENGTH FOR PDL
	MOVE	L,C$NPDL(T1)	; FETCH <OFFSET,,ADRREF> FOR PDL
	PUSHJ	P,EXPAND	; AND EXPAND THE PDL

; PATCH UP THE PDP (IE: RESTORE -VE COUNT TO LH)

	MOVNI	N,(N)		; COMPUTE -VE OF INCREMENTAL LENGTH
	HRLM	N,(T2)		; AND FIX UP THE PDP
	MOVEI	X,P		; FETCH ADR CONTROL PDP
	HRRM	X,(T3)		; AND STORE IN ITS PDLTAB ENTRY
	MOVE	T5,PDL		; FETCH ADR OF CONTROL PDL
	HRLM	X,B$2PTR(T5)	; AND REFERENCE AC P TO IT

; RESTORE ACS X,T1-T5,N,L,P

	MOVE	P,ACSAVE+P	; RESTORE AC P
	MOVE	L,ACSAVE+L	; RESTORE AC L
	MOVE	N,ACSAVE+N	; RESTORE AC N
	MOVE	X,[<ACSAVE+T1,,T1>] ; RESTORE ACS T1-T5,X
	BLT	X,X		; ALL IN TWO INSTRUCTIONS

; RETURN TO POINT OF CALL

	JRST	@.JBTPC		; RETURN TO POINT OF CALL
	SUBTTL	UUOTRP - LUUO Handler

UUOTRP:	PORTAL	.+1		;[325] IN CASE OF LOWSEG LUUO
	LDB	X,[POINT 9,.JBUUO,8] ; FETCH THE LUUO OPCODE
	CAIN	X,LUUERR	; IS IT AN ERROR CALL?
	 JRST	ERRHAN		; YES, GOTO THE ERROR HANDLER
	CAIN	X,LUUCER	; NO, IS IT A ":" ERROR CALL?
	 JRST	CERR		; YES
	CAIN	X,LUUCR1	; IS IT SPECIAL ":" ERROR CALL?
	 JRST	CER1		; YES
	CAIN	X,LUUWRN	; IS IT A WARNING CALL?
	 JRST	WARHAN		; YES
	CAIN	X,LUUCEO	; IS IT A "CHECK EO VALUE" CALL?
	 JRST	CEO		; YES
	ERROR	(IUU)		; NO, ** ILLEGAL LUUO **

; CER1 - POP TOP OF STACK AND FALL INTO CERR1

CER1:	POP	P,X		; POP TOP OF STACK
;	JRST	CERR		; AND FALL INTO CERR

; CERR - GIVE ERROR MSG IF ":" FLAG OFF, ELSE GIVE FAIL RETURN

CERR:	TXNN	F,F$COL		; IS THIS A ":" MODIFIED COMMAND?
	 JRST	ERRHAN		; NO, GIVE AN ERROR MESSAGE
	POP	P,X		; YES, CLEAN UP THE STACK
	JRST	FAIRET		; AND GIVE A "FAIL" RETURN

; WARHAN - GIVE A WARNING MESSAGE

WARHAN:	MOVEI	C,"%"		; MESSAGE STARTS WITH "%"
	JRST	ERRH1		; JUMP INTO MESSAGE HANDLER

; CEO - JUMP TO SPECIFIED ADR IF A FEATURE IS DISABLED

CEO:	LDB	X,[POINT 4,.JBUUO,12] ; FETCH # FROM LUUO CALL
	CAMG	X,EOVAL		; IS THAT FEATURE ENABLED?
	 POPJ	P,		; YES, RETURN TO POINT OF CALL PLUS ONE
	POP	P,X		; NO, CLEAN UP PDL...
	JRST	@.JBUUO		; AND JUMP TO THE SPECIFIED ADR
	SUBTTL	REENTR - Reenter Processing (after ^C^C.REENTER)

REENTR:	PORTAL	.+1		;[363] KI/KL RE-ENTRY GATEKEEPER
	TXO	F,F$REE		;[317] WE'LL STOP AFTER THIS CMD IS DONE
	JRST	@.JBOPC		;[317] BUT CONTINUE LEST WE SCREW UP

; RESTRT - RESTART AFTER ^C

RESTRT:	PORTAL	.+1		;[375] KI/KL ENTRY GATEKEEPER
	RESET			;[375] RESET THE WORLD
	STORE	(X,LOWBEG,LOWEND,0) ;[375] CLEAR LOWSEG
;[15000] Loses if run a saved XTEC program & restart & LOSEG name different
;	MOVX	X,<-1,,.GTPRG>	;[375] GET MY PROGRAM NAME
;	GETTAB	X,		;[375] ONLY SURE WAY
;	 MOVX	X,'XTEC  '	;[375] ???
;	MOVEM	X,SEGNAM	;[375] SAVE "SEGMENT NAME"
	SETZ	F,		;[375] CLEAR ALL FLAGS
	JRST	$XTEC		;[375] CONTINUE "START"
	SUBTTL	ERRHAN - Error Handler

ERRHAN:
FOR TOPS10!TOPS20,<
	CLRBFI			; CLEAR TYPE-AHEAD
>
	ECHO	ON		;[21000] Turn echo on, regardless
	MOVEI	C,"?"		; MESSAGE STARTS WITH A "?"
ERRH1:	PUSH	P,N		; SAVE AC N
	PUSH	P,M		; AND AC M
	PUSH	P,C		;[12000] Save the prefix character
	MOVEI	N,ERRPRE	;[12000] Error message prefix characters
	PUSHJ	P,TXSTR		;[12000] with no reformatting
	POP	P,C		;[12000] Get back the prefix character
	SETZM	OUTADR		; FORCE OUTPUT TO USER'S TERMINAL
	SETZM	INPADR		; GO BACK TO TTY FOR INPUT
	SETZM	INPCHR		; . . .
	TXZ	F,F$NTI		; . . .
	PUSHJ	P,TCHR		; TYPE THE LEADING MESSAGE CHAR

	MOVE	T5,EHVAL	; FETCH MESSAGE LENGTH
	TXNN	T5,JW.WPR	; TYPE PREFIX?
	 JRST	ERRH3		; NO, SKIP THE PREFIX

; PREFIX TO MESSAGE (IE: 'TEC???')

	HRRZ	N,.JBUUO	; FETCH '???' OF THE ERROR CALL
	CAIN	N,'ILM'		;[420] ILL MEM REF?
	 SETZM	PTVAL		;[420] .:=0
	HRLI	N,'TEC'		; FETCH THREE CHAR ABBREV. FOR NAME
	PUSHJ	P,TSIX		; AND TYPE THE PREFIX ('TEC???')
	TXNN	T5,JW.WFL	; WANT MESSAGE TOO?
	 JRST	ERRH88		; NO, DONE WITH MESSAGE TYPING

ERRH2:	MOVEI	N,[ASCIZ/ -/]	; YES, TYPE A DASH BETWEEN PREFIX AND IT
	PUSHJ	P,TSTR		; . . .

; MUST GETSEG <C$ERRS> TO TYPE LONG MESSAGES

ERRH3:	PUSH	P,[<ERRH99>]	; SAVE RETURN ADR
IFE FTXTEC&FTXTCERR,<
	MOVE	X,[ERRSEG:<C$ERRS>]	; FETCH NAME OF ERROR SEGMENT
	MOVEM	X,GSGNAM	; AND STORE IN GETSEG BLOCK
	PUSH	P,[<XTCERR>]	; FETCH ADR OF WHERE TO GO IN XTCERR
	PJRST	GETSG		; AND GO TO THE ERROR SEGMENT
>
IFN FTXTEC&FTXTCERR,<
	PJRST	ERMT
>
ERRH88:	PUSHJ	P,TCRLF		; GO TO A NEW LINE
ERRH89:	LDB	X,[POINT 9,.JBUUO,8] ; FETCH ERROR OPCODE
	CAIN	X,LUUWRN	; A WARNING?
	 JRST	ERRH94		;[416] YES, NEVER EXIT
	MOVE	X,ETVAL		;[12000] Check abort flag (initially set)
	TXNE	X,ET$ABO	;[12000] Go to monitor if set
	 JRST	[PUSHJ P,FOUT	;[20000] Make sure he sees the message
		 MONRT.		;[20000] STOP
		 JRST .+1]	;[20000] he musta typed continue
ERRH94:	MOVEI	N,PROMPT	; TYPE FAKE PROMPT CHAR
	PUSHJ	P,TXSTR		; . . .
	PUSHJ	P,GETCH		; AND PEEK AT FIRST CHAR
	CAIN	C,"/"		; WANT MORE OF MESSGAE?
	 JRST	ERRH2		; YES
	CAIE	C,"?"		; NO, WANT LAST TEN COMMANDS?
	 JRST	ERRH98		; NO, DONE
; TYPE LAST TEN COMMANDS

	PUSHJ	P,ERRCTY	; TYPE LAST 10 COMMANDS
	JRST	ERRH89		; AND GO BACK FOR MORE

; SAVE THE CHAR WE PEEKED AT

ERRH98:	MOVEM	C,INPCHR	;SAVE THE CHAR WE PEEKED AT

; FINISH UP WITH MESSAGE TYPING

ERRH99:	MOVEI	N,ERRPOS	;[12000] Output the error posfix characters
	PUSHJ	P,TXSTR		;[12000] with no reformatting
	LDB	X,[POINT 9,.JBUUO,8] ; FETCH OPCODE OF LAST MSG CALL
	POP	P,M		; RESTORE AC M
	POP	P,N		; RESTORE AC N
	CAIN	C,.CHBEL	;[14000] ^G stops us even in a warning
	 JRST	[SETZM INPCHR	;[14000] This is not command input
		 MOVEI X,OUT	;[20000] Flush output file?
		 TXNN F,F$UWR	;[20000] Unless there is supposed to be one
		  RESDV. X,	;[20000] ...
		   JFCL		;[20000] ....
		 JRST ERRREC]	;[14000] Go back to command level
	CAIN	X,4		; WAS IT A WARNING CALL?
	 POPJ	P,		; YES, RETURN TO CALLER
; ERRREC - RECOVER FROM AN ERROR

ERRREC:	SETZM	MACLVL		; CLEAR THE MACRO NESTING LEVL COUNT
;[14000] Leave the poor Q-register PDL alone!
;	STSTK	(QP,C$QPLN,QPDL) ; REINITIALIZE THE
				; Q-REGISTER PDL
;	MOVE	X,QP		; FETCH THE PDP FOR QPDL
;	PUSH	X,[<0>]		; AND PUSH 3 ZEROS TO MARK BEGINNING
;	PUSH	X,[<0>]		; . . .
;	PUSH	X,[<0>]		; . . .
;	MOVEM	X,QP		; AND STORE THE UPDATED PDP

	SETZM	INPADR		; CLEAR THE ADR OF GET-A-CHAR ROUTINE
	TXZ	F,F$NTI		; CLEAR SOME FLAGS
	SKIPN	X,MACBUF	; MACBUF POINT TO SOMETHING?
	 JRST	ERRR1		; NO
	HRRZS	T$1REF(X)	; YES, UNBIND IT
	SETZM	T$ACRF(X)	; AND UNBIND THE AC REFS
	SETZM	MACBUF		; CLEAR MACBUF
	MOVE	N,CMDBID	; AND UNBIND THE CURRENT COMMAND BUFFER
	PUSHJ	P,DELBLK	; . . .
ERRR1:	MOVE	T5,@PDL		; FETCH TOP LEVEL RETURN ADR
	STSTK	(P,C$PDLL,PDL)	; REINITIALIZE THE CONTROL PDL
;;;	JRST	(T5)		; AND RETURN TO TOP LEVEL
	JRST	BEGIN		;[13000] Sometimes, you can't trust
				;[13000] even the base of the stack
				; (WHOEVER THAT IS!)

>;; FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
	SUBTTL	ERCTY - TYPE LAST FEW COMMANDS AFTER AN ERROR

; LAST 10 (OR SO) CHARS FROM COMPIILATION ERRORS
;
; LAST 10 COMMANDS FOR EXECUTION ERRORS

ERRCTY:
	TXNE	F,F$CMP		;[4000] WERE WE COMPILING?
;[4000]	SKIPN	MACLVL		; COMPILATION ERROR?
	 JRST	ERRCTC		; YES

; TYPE LAST 10 COMMANDS FOR EXECUTION ERRORS

	MOVE	T2,TENIDX	; FETCH POINTER TO LAST COMMAND
	MOVEI	T4,^D10		; FETCH LOOP COUNTER

ERRCT1:	MOVEI	T2,1(T2)	; POINT TO NEXT COMMAND
	IDIVI	T2,^D10		; FORM INDEX INTO 'TENCMD'
	MOVEI	T2,(T3)		; . . .
	MOVE	N,TENCMD(T3)	; FETCH INFO ABOUT COMMAND
	JUMPE	N,ERRCT2	; IGNORE IF NULL
	PUSH	P,T2		; SAVE AC T2 FROM 'TMSG'
	PUSHJ	P,TMSG		; TYPE THE COMMAND
	POP	P,T2		; RESTORE AC T2
ERRCT2:	SOJG	T4,ERRCT1	; LOOP FOR ALL 10 COMMANDS

; DONE. TYPE ?<CR><LF> AND RETURN TO CALLER

ERRCT3:	MOVEI	N,[ASCIZ/?
/]				; TYPE ?<CR><LF>
	PJRST	TSTR		; AND RETURN TO CALLER

;Type text up to error [12000] FOR A COMPILATION ERROR

ERRCTC:	PUSHJ	P,CURCHA	; FETCH CURRENT POSITION IN COMMAND STRING
	MOVEI	T4,-T$DATA*5(T1);[12000] Character count is all but ovhd words
	MOVE	T1,[POINT 7,T$DATA] ;[12000] Pointer to start of buffer
	ADD	T1,@CMDBUF	;[12000] once we add in the address, that is

ERRCC2:	ILDB	C,T1		; FETCH A COMMAND STRING CHAR
	PUSHJ	P,TCCHR		; AND TYPE IT
	SOJG	T4,ERRCC2	; AND TYPE UP TO 10 CHARS
	JRST	ERRCT3		; DONE. FINISH UP AND RETURN TO CALLER

>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
	SUBTTL	SAVPCM - SAVE LAST COMMAND STRING IN A Q-REGISTER

SAVPCM:	PUSHJ	P,GETCH		; FETCH THE NEXT CHAR
	CAIN	C,"("		; IS IT A LONG Q-REGISTER NAME?
	 JRST	SAVPC3		; YES
	CAIG	C,172		;[12000] Any SIXBITable character will do
	CAIGE	C,40		;[12000]
	 JRST	SAVOOPS		;[12000] no good
SAVPC1:	CAIL	C,140		;[14000] Make upper case if necessary
	 MOVEI	C,-40(C)	;[14000] it was...
	MOVSI	N,'A'-"A"(C)	; PUT SIXBIT CHAR IN AC N
	LSH	N,^D12		; AND LEFT JUSTIFY IT

SAVPC2:	PUSH	P,N		; SAVE THE Q-REGISTER NAME
	SKIPN	N,CMDBID	; FETCH THE BUFFER ID OF LAST COMMAND
	 JRST	BEGIN1		; OOPS! NO PREVIOUS COMMAND (IGNORE IT)

	SETZ	L,		; SO THAT AC T1 WILL POINT TO BUFFER
	PUSHJ	P,FNDBLK	; FIND THE LAST COMMAND BUFFER
	 JRST	BEGIN1		; GONE. FORGET IT!
	AOS	T$RCNT(T1)	; INCR. REFERENCE COUNT FOR BUFFER
	POP	P,T1		; RESTORE THE Q-REGISTER NAME
	PUSHJ	P,QGET		;[12000] fetch old one if any
	 SETZB	T2,T3		;[12000] none there
	TXO	T2,QB$BID	; SET THE "BID" BIT
	HRR	T2,CMDBID	;[12000] BID moved ; FETCH THE BUFFER ID
	TXZ	F,F$REF		; FLAG THAT T3 HAS A BUFFER ID
	PUSHJ	P,QSTOR		; AND STORE THE BUFFER IN Q-REGISTER
	JRST	BEGIN1		; AND CONTINUE WHERE WE LEFT OFF

; SCAN A FANCY Q-REGISTER NAME

SAVPC3:	PUSHJ	P,GSIX		; PICK UP THE Q-REGISTER NAME
	PUSHJ	P,GCHR		; SCAN THE NEXT CHAR
	CAIE	C,")"		; IS IT A ")"?
SAVOOPS:  ERROR	(IQR)		;[20000] no good, but he can try again
	JRST	SAVPC2		; YES, CONTINUE

>;; END FOR FTXTEC
FOR FTXTEC!FTXTCERR,<
	SUBTTL	Phased (sometimes) Pure Low Segment Code


	RELOC	0		; DOWN TO THE LOW SEGMENT
LOCODE:				; DEFINE WHERE LOW SEGMENT CODE GOES
IFN TOPS10,<			; No Performance Advantage to this on a 20
	RELOC			; BACK TO THE HIGH SEGMENT
HICODE:				; DEFINE START OF PHASED CODE
	PHASE	LOCODE		; KEEP IN PHASE WITH THE LOWSEGMENT
>
; GETSG - ROUTINE TO TRANSFER CONTROL BETWEEN CONTROL AND ERROR SEGMENT

GETSG:	MOVEM	17,ACSAVE+17	; SAVE AC 17
	MOVEI	17,ACSAVE	; Set up BLT pointer
	BLT	17,ACSAVE+16	; SAVE ALL ACS

RUNENT:	TDZA	X,X		;[15000] Not CCL entry
	 MOVX	X,<F$CCL>	;[15000] It is a CCL entry
	IORM	X,ACSAVE	;[15000] Set it if we entered that way
				; it will not be cleared if we didn't
	MOVE	X,.JBSA		; SAVE START ADR
	MOVEM	X,SADSAV	; . . .
	MOVE	X,.JBREN	; SAVE REENTER ADR
	MOVEM	X,RENSAV	; . . .
	MOVSI	1,1		; RELEASE CURRENT SEGMENT
	CORE	1,		; . . .
	 JFCL			; (WHY SHOULD IT FAIL?)
	MOVEI	1,GSGBLK	; LOAD ADR OF GETSEG ARG BLOCK
	GETSEG	1,		; GETSEG THE DESIRED SEGMENT
>;; END FOR FTXTEC!FTXTCERR
FOR FTXTEC,<
	 JRST	GTSGF		;[322] GETSEG FAILED
>;; END FOR FTXTEC
FOR FTXTCERR,< NOTFOR FTXTEC&FTXTCERR,<
	 HALT	.-1		;[325] GETSEG FAILED FOR XTEC
>>;; END FOR FTXTCERR ...
FOR FTXTEC!FTXTCERR,<
	MOVE	X,SADSAV	; RESTORE START ADR
	MOVEM	X,.JBSA		; . . .
	MOVE	X,RENSAV	; RESTORE REENTER ADR
	MOVEM	X,.JBREN	; . . .
	MOVSI	17,ACSAVE	; RESTORE ACS
	BLT	17,17		; . . .
	POPJ	P,		; AND PROCEED

GTSGF:	MOVE	X,SEGNAM	;[322] ATTEMPT TO GET XTEC BACK
	MOVEM	X,GSGNAM	;[322] SET NAME TO XTEC
	MOVEI	1,GSGBLK	;[322] LOAD ADDR OF GETSEG ARG BLOCK
	GETSEG	1,		;[322] GET XTEC BACK
	 HALT	.-1		;[322] WE'RE LOST
	MOVEI	N,SEGERR	;[364] TYPE ERROR MESSAGE
	PUSHJ	P,TXSTR		;[16000] Type in correct order, please
	MOVE	X,SADSAV	;[322] RESTORE START ADR
	MOVEM	X,.JBSA		;[322] . . .
	MOVE	X,RENSAV	;[322] RESTORE REENTER ADR
	MOVEM	X,.JBREN	;[322] . . .
	MOVSI	17,ACSAVE	;[322] RESTORE ACS
	BLT	17,17		;[322] . . .
	POP	P,X		;[322] DROP PDP
	POP	P,X		;[322] . . .
	JRST	<IFDEF ERRH88,<ERRH88>>	;[325] CONTINUE AS IF NOTHING HAPPENED
SEGERR:	ASCIZ/
?XTCERR - CANNOT GETSEG ERROR SEGMENT/

IFNDEF $GCHRW,<$GCHRW==<$GCHR0==0>> ;This is for TECERR
INTRPT:				;[20000] (next 20 lines) .JBINT sent us here
	EXCH	X,INTBLK+3	; Look at bits
	TLNE	X,777775	; Anything but ^C?
	 ERROR	(XXX)		; CHOKE
	MOVE	X,ETVAL		; Are we supposed to care about this?
	TXZN	X,ET$CCT	; ...
	 JRST	INTRPN		; program doesn't want it
	MOVEM	X,ETVAL		; program does, in fact.
	HRRZ	X,INTBLK+2	; See if we are waiting for ^T
	CAIN	X,$GCHRW	; ...
	 MOVEI	X,$GCHR0	;[20000] Re-try the held character
	HRRM	X,INTBLK+2	;[20000] by backing up a bit...
	MOVEI	X,3		; And stuff a ^C in there
	MOVEM	X,INPCHR	; This way so non-blocking ^T works too.
INTRPZ:	EXCH	X,INTBLK+3	; Restore AC
	JRST	@INTBLK+2	; Continue execution

INTRPN:	MONRT.			; Stop here
	JRST	INTRPZ		; continue execution
	;note that the block is not zeroed, so we won't come here again
	;unless he sets 32768ET again


GSGBLK:				; ARG BLK FOR GETSEG MUUO
GSGDEV:	FOR TOPS10,0		; THE DEVICE NAME
	FOR TOPS20,'SYS   '
GSGNAM:	FOR TOPS10,0		; THE SEGMENT NAME
	FOR TOPS20,'TECO20'
GSGLOW:	0			; FILE EXTENSION FOR LOW FILE
	0			; WE DON'T USE THIS
GSGPPN:	0			; THE SEGMENT PPN
	0			; WE DON'T USE THIS
GSGPAT: REPEAT .PTMAX,<0>	;[15000] GETSEG path block

; TEMP STORAGE FOR GETSEG ROUTINE

SADSAV:	BLOCK	1		; SAVE AREA FOR .JBSA
RENSAV:	BLOCK	1		; SAVE AREA FOR .JBREN

;Interrupt block for .JBINT

INTBLK:	BLOCK	4		;[20000]


TSTOPS:	EXP 10,20,30,40,50,60,70,100,110,120,130,140,150,160,170,200
	REPEAT <C$NTS-<.-TSTOPS>>,<Z>			;[21000] Tab stops go here


LOCEND==.			; DEFINE END OF LOWSEGMENT CODE
FOR TOPS10,<
	DEPHASE			; BACK TO HISEG RELOCATABLE CODE
>

	SUBTTL	Impure Low Segment Data


IFN TOPS10,<
	RELOC	LOCEND-LOCODE	; RELOC TO LOWSEG AFTER CODE
>


LOWBEG:				; DEFINE BEGINNING OF IMPURE LOWSEG DATA

CCJNAM:	BLOCK	1		; OUR CCL JOB NUMBER (IE: '###XTC')
SEGNAM:	BLOCK	1		; NAME OF CONTROL SEGMENT
SBNAME:	BLOCK	1		; HOLDS A SIXBIT NAME
PDL:	BLOCK	1		; CONTROL PUSHDOWN STACK
TPDL:	BLOCK	C$TPDL		; TEMP PDL FOR APRTRP ROUTINE
ACSAVE:	BLOCK	^D16		; SAVE AREA FOR ACS
TENIDX:	BLOCK	1		; INDEX INTO 'TENCMD'
TENCMD:	BLOCK	^D10		; INFO IN LAST 10 COMMANDS EXECUTED
HEAD:	BLOCK	1		; POINTER TO FIRST BLOCK OF DYNAMIC STORAGE
GSIZE:	BLOCK	1		; #WORDS ALLOCATED SINCE LAST GARBAGE COLLECTION
PDLTAB:	BLOCK	2*C$NPDL	; TABLE OF THE PDLS THAT ARE
				; OVERFLOW PROTECTED
TMPREF:	BLOCK	1		; USED AS A TEMPORARY REFERNCE
				; TO A BLOCK
TMPRFG:	BLOCK	1		; TEMP REF TO TEXT BUFFER FOR $G ROUTINE
EXPREF:	BLOCK	1		;[12000] TEMP REF FOR EXPAND
TXREF:	BLOCK	1		;[12000] TEMP REF FOR $X
TAGPDL:	BLOCK	1		; POINTER TO TAG DEFINITION PDL
FRDREF:	BLOCK	1		; REFERENCE TO FILE-READ BUFFER
REFPDL:	BLOCK	1		; POINTER TO TAG REFERENCE PDL
LNKLST:	BLOCK	2		; POINTERS FOR LINKED LIST
LNKID:	BLOCK	1		; COUNTER FOR ASSIGNING NEW LINKED-LIST IDS
QTAB:	BLOCK	1		; POINTER TO Q-REGISTER TABLE
QPDL:	BLOCK	1		; POINTER TO Q-REGISTER PDL
QR:	BLOCK	1		; Q-REGISTER TABLE PDP
QP:	BLOCK	1		; Q-REGISTER PDL PDP
CMDBID:	BLOCK	1		; BUFFER ID FOR CURRENT COMMAND BUFFER
PCMBID:	BLOCK	1		; BUFFER ID FOR PREVIOUS COMMAND
CURCMD:	BLOCK	1		; POINTER TO CURRENT COMMAND BUFFER
CMDCNT:	BLOCK	1		; COUNT OF CHARS LEFT IN COMMAND BUFFER
				; DURING SCAN
CMDBP:	BLOCK	1		; RELATIVE BYTE POINTER TO COMMAND BUFFER
				; DURING SCAN
CMDBUF:	BLOCK	1		; ADR OF REF TO COMMAND BUFFER DURING
				; DECODE&COMPILE AND EXECUTION
LASSPC:	BLOCK	1		; ADR OF LAST FILE SPEC REFERENCED
RUNOFS:	BLOCK	1		; RUNOFFSET FOR WHEN WE RUN A PROGRAM
RBSPC:	BLOCK	.RBSTS+1	; EXTENDED LOOKUP/RENAME/ENTER ARG BLOCK
FILSPC:	BLOCK	FS$LTH		; FILE SPEC BLOCK FOR CDC
LERSPC:	BLOCK	FS$LTH		; LAST "ER" FILE-SPEC
LEWSPC:	BLOCK	FS$LTH		; LAST "EW" OR "EA" FILE-SPEC
LEBSPC:	BLOCK	FS$LTH		; LAST "EB" FILE-SPEC
LEISPC:	BLOCK	FS$LTH		; LAST "EI" OR "EP" FILE-SPEC
LEESPC:	BLOCK	FS$LTH		; LAST "EE" FILE SPEC
LRPSPC:	BLOCK	FS$LTH		; LAST "E&" FILE-SPEC
LELSPC:	BLOCK	FS$LTH		;[330] LAST "EL" FILE-SPEC
LREERR:	BLOCK	1		; LAST LOOKUP/RENAME/ENTER ERROR CODE
INIBH:	BLOCK	C$BFHD		; BUFFER HEADER FOR INI FILES
INIBF:	BLOCK	C$NBUF*<C$BUFL+3> ; BUFFERS FOR INI FILES
LOGBH:	BLOCK	C$BFHD		;[330] LOG FILE BUFFER HEADER
LOGBF:	BLOCK	C$NBUF*<C$BUFL+3> ;[330] LOG FILE BUFFER
OUTADR:	BLOCK	1
INPADR:	BLOCK	1	; WHERE TO GO FOR INPUT CHAR
IOSTS:	BLOCK	1		; I/O STATUS FOR LAST I/O ERROR
OUTBH:	BLOCK	C$BFHD		; BUFFER HEADER FOR OUTPUT
OUTBF:	BLOCK	C$NBUF*<C$BUFL+3>; OUTPUT BUFFERS
INPBH:	BLOCK	C$BFHD		; BUFFER HEADER FOR INPUT
INPBF:	BLOCK	C$NBUF*<C$BUFL+3> ; INPUT BUFFERS
INPCHN:	BLOCK	1		;  CURRENT INPUT CHANNEL (Z CH,0)
INPEOF:	BLOCK	1		; ADR OF WHERE TO GO ON INPUT EOF
INPERR:	BLOCK	1		; ADR OF WHERE TO GO ON INPUT ERROR
INPCHR:	BLOCK	1		; LAST INPUT CHAR IF IT IS TO BE REPEATED
PATHB:	BLOCK	.PTMAX		;[340] BLOCK FOR PATH. UUO

; FLAGS SET/CLEARED BY "E" COMMANDS

EDVAL:	BLOCK	1		;[12000] ED flags
ETVAL:	BLOCK	1		; SUBSTITUTION ON TYPEOUT FLAG
EOVAL:	BLOCK	1		; EDIT OLD FLAG
EUVAL:	BLOCK	1		; CASE FLAGGING ON TYPEOUT FLAG
EHVAL:	BLOCK	1		; ERROR MESSAGE LENGTH FLAG
ESVAL:	BLOCK	1		; AUTOMATIC TYPEOUT AFTER SEARCH FLAG

; SEARCH ARGUMENTS AND MATRIX

SRHARG:	BLOCK	C$SRHL/5	; TEXT OF LAST SEARCH ARGUMENT
SRHCTR:	BLOCK	1		; COUNT OF CHARS IN SRHARG
SRHLEN:	BLOCK	1		; THE LENGTH OF THE LAST SEARCH MATCH
SRHSMP:	BLOCK	1		; BIT POINTER TO THE LAST POSITION
				; IN THE SEARCH MATRIX
SRHTAB:	BLOCK	SRHLN		; THE SEARCH MATRIX

;[23000] Permanent Q-register table

QREG:	BLOCK	<100*2>		;[23000] Single-letter q-registers

; THE MAIN TEXT EDITING BUFFER

TXTBUF:	BLOCK	1		; POINTER TO THE MAIN TEXT EDITING BUFFER
PTVAL==QREG+1			; CURRENT BUFFER POSITION POINTER
PAGCNT:	BLOCK	1		; CURRENT PAGE NUMBER
MKRMBP:	BLOCK	1		; BYTE POINTER FOR STORING LAST PARTIAL
				; WORD IN THE "MAKE ROOM" ROUTINE
MKRMB1:	BLOCK	1		; SAME AS ^ BUT FOR DOWNWARD MOVE
APDADR:	BLOCK	1		; ADR OF READ-A-CHAR ROUTINE
APDFLG:	BLOCK	1		; CURRENT INPUT I/O FLAGS
PCHADR:	BLOCK	1		; ADR OF WRITE-A-CHAR ROUTINE
PCHFLG:	BLOCK	1		; CURRENT OUTPUT I/O FLAGS
LSNCTR:	BLOCK	1		; HOLDS A LINE-SEQUENCE NUMBER
LSNCT1:	BLOCK	1		; COUNTS DIGITS FOR AN LSN

; VARIABLES FOR MACRO CALLS

MACFLG:	BLOCK	1		;[344] FLAG FOR MACRO W/ ARGUMENTS
MACNAM:	BLOCK	1		; Q-REGISTER NAME OF CURRENT MACRO
MACBID:	BLOCK	1		; BUFFER ID FOR CURRENT MACRO
MACLVL:	BLOCK	1		; NESTING LEVEL COUNTER FOR MACROS
MACBUF:	BLOCK	1		; REFERENCE TO TEMP BUFFER


SARGSV==ACSAVE+SARG ;[3000] PLACE TO SAVE SARG SO IT CAN BE PASSED TO A MACRO
DELIM:	BLOCK	1		;[12000] Default text delimiter
CDELIM:	BLOCK	2		;[12000] command delimiter (up to 2 chars, unpacked)
CWVEC:				;[12000] :W stuff starts here
WFLAGS:	BLOCK	1		;[12000] :W flags
WIDTH:	BLOCK	1		;[12000] Width of terminal
LENGTH:	BLOCK	1		;[12000]  Length of terminal
DPYALL:	BLOCK	1		;[12000] 'DISPLAY ALL' mode
MARK:	BLOCK	1		;[12000] MARK pointer value
HOLD:	BLOCK	1		;[12000]  scroll if within n lines of border
F0:
WINB:	BLOCK	1		;[14000] Start of window
	BLOCK	12		;[14000] Reserved
DMODE:	BLOCK	1		;[12000] Display mode bits
SCFWD:	BLOCK	1		;[10000] # of linefeeds typed at bottom
SCREV:	BLOCK	1		;[12000] # of reverse 
PROMSZ:	BLOCK	1		;[14000] # of character positions for prompt

RLF:	BLOCK	1		;[12000] Reverse linefeed character
WIPEC:	BLOCK	2		;[12000] Delete a character
EOL:	BLOCK	2		;[12000] What to type at end of line
TTAB:	BLOCK	2		;[13000] Tab simulation
WIPEL:	BLOCK	1		;[12000] Clear to end of line
WIPES:	BLOCK	1		;[12000] Clear to end of screen
HOME:	BLOCK	1		;[12000] Go to top of screen
CFWD:	BLOCK	2		;[12000] Forward-space
ERRPRE:	BLOCK	4		;[12000] Prefix to error messages
ERRPOS:	BLOCK	4		;[12000] Postfix to error messages
CAD:	BLOCK	1		;[12000] Direct cursor addressing
PROMPT:	BLOCK	4		;[12000] The prompt characters
BRKFLG:	BLOCK	1		;[12000] Enable breakpoints if negative
TARCMD:	BLOCK	4		;[14000] Type after every command
DEFARG:	BLOCK	1		;[15000] Default argument
TNULL:	BLOCK	2		;[15000] Type this for nulls
TTABND:	BLOCK	1		;[16000] Put this at the end of tabs

CWMAX==<.-CWVEC>		;[14000] Maximum legal arg to :W

TOOBLK:	;[12000] TRMOP. output block. DO NOT CHANGE THE ORDER OF THE NEXT 3
TOOFUN:	BLOCK	1		;[12000] TRMOP. block for output
OURTTY:	BLOCK	1		;[12000] Our TTY #
TOOADR:	BLOCK	1		;[12000] Argument to TRMOP. (addr of buffer)

ROW:
FY:	BLOCK	1		;[12000] Row cursor is in
COL:
FX:	BLOCK	1		;[12000] Column...

;WINB was moved into the CWVEC (6:W) for PDP-11 compatability
WINZ:
FZ:	BLOCK	1		;[12000] End of window


TTOPTR:	BLOCK	1		;[12000] Terminal output byte ptr
TTOBUF:	BLOCK	C$OBFL		;[12000] Terminal output buffer
TTOEND:	BLOCK	1		;[12000] 1 word of overdraw (no count needed)


LOWEND==.-1			; DEFINE END OF IMPURE LOWSEGMENT DATA

	RELOC			; BACK TO HISEG RELOCATABLE
LIT

; PATCHING SPACE

PAT:	REPEAT	C$PATL,<Z>	; PATCHING SPACE
>;; END FOR FTXTEC!FTXTCERR

FOR FTXTEC,	END	XTEC	; *** THE END ***
FOR FTXTCERR, NOTFOR FTXTEC,	END		; *** THE END ***