Google
 

Trailing-Edge - PDP-10 Archives - BB-D480G-SB_FORTRAN10_V11.0_short - forddt.mac
There are 27 other files named forddt.mac in the archive. Click here to see a list.
Title FORDDT	FORTRAN INTERACTIVE DEBUGGING AID ,11(405)
SUBTTL	P.E.T. HARDING/DBT/FLD/MD/JMT/MA/SJW/JNG/DCE/BPK/CKS/DCC/BAH/BL/TGS/MRB
;	Brad Merrill/BCM/AlB/MEM/PLB/CDM	10-Jul-86


;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


EDITNO==405	;EDIT NO
VERSION==11	;MAJOR VERSION NO
VMINOR==0	;MINOR VERSION NO
VWHO==0		;WHO LAST EDITED


.JBDDT=74
.JBREN=124
.JBVER=137


; Get universals and HELPER

IFNDEF	TOPS20,<TOPS20==-1>	;[147] 0 = TOPS10, -1 = TOPS20
IFNDEF	EXTHLP,<EXTHLP==0>	;[147] -1 If using external HELPER

IFN EXTHLP,<			;[147] external HELPER

IFE TOPS20,<.TEXT 'REL:HELPER/SEGMENT:LOW'> ;[142] load HELPER in low-seg

IFN TOPS20,<.REQUEST SYS:HELPER> ;[142] Load HELPER

	>			;[147] end IFN EXTHLP

IFE TOPS20,<
	SEARCH	UUOSYM,MACTEN	;[142] Get -10 monitor symbols
	OPDEF	XMOVEI	[MOVEI]	;[310] define XMOVEI for -10
	OPDEF	EFIW	[EXP]	;[310] make sure its defined
	OPDEF	IFIW	[EXP]	;[310] ditto
	>			;end IFE TOPS20

IFN TOPS20,<SEARCH MONSYM,MACSYM> ;[142] Get -20 monitor symbols





;Report what code is being assembled.

IF1,
<IFE TOPS20,<
	PRINTX [Assembling for TOPS10]
>;END OF IFE TOPS20

IFN TOPS20,<
	PRINTX [Assembling for TOPS20]
>;END OF IFN TOPS20
>;END OF IF1

;[300]
; These locations may not exist on TOPS-20 as of V10.  The symbol tables
; will be in PDV's and the version number and reenter address are stored
; in the program entry vector.  FORDDT will not load with LINK V6 if the
; LOC's remain, so until we can resolve the problems associated with JOBDAT
; vestiges, the LOC's themselves will be for TOPS10 only.
;
IFE TOPS20,<
LOC	.JBVER

BYTE(3)VWHO(9)VERSION(6)VMINOR(18)EDITNO	;SETS FORDDT VERSION #

LOC	.JBREN
RE.ENT				;SETS THE RE - ENTER ADDRESS

LOC	.JBDDT
SFDDT				;[145] MAKES DEBUG PROG,FORDDT WORK

RELOC
> ;END IFN TOPS20


	SUBTTL	REVISION HISTORY

COMMENT \

***** Begin Revision History *****

21		REMOVE ALL HIBERNATE CALLS - JUST USE TTCALL 4
22		CHANGE TRACE% TO TRACE.
23		BEGIN UPDATE FOR (1) SYMBOL TABLE LOOKUP ALGORITHMS
				 (2) GENERAL CLEAN UP
24		(CONTINUING)
25		CONTINUING;  ALSO REWRITE OF LOOK
26		CONTINUING;  REWRITE OF OFFSET
			     REMOVAL OF 'BIGCOD'
27		CONTINUING
30		CONTINUING;  INCLUDING SYMBOL USAGE CLEANUP AND REMOVAL
			     OF SYMSET
31		CONTINUING;  REMOVAL OF MOST 'DEBUG' CONDITIONAL CODE
			     AND INTCPT CONDITIONAL AND CODE
32		CONTINUING;  REMOVAL OF SMART PORTION OF LOOK
33		CONTINUING;  FIXUP OF PAUSE LOGIC
34		CONTINUING;  REINSERT OF SMART CODE TO LOOK - IGNORE
			     UDDT, FORDDT, AND JOBDAT ON LOOKUP.
35		FINAL EDIT OF UPDATE - PATCH AREA GOES UNDER DEBUG
		   CONDITIONAL, CALL TO DO MACRO IS FIXED, SO THIS WILL
		   NOW ASSEMBLE WITH MACRO V50.
36		ANOTHER FINAL - HIERARCHY IN LOOK;  FNDSYM RESOLVED
37		CONTINUING FINAL - SCATTERED BUGS
40		FIX AC LONG ASCII AND RASCII
		FIX - LOCATE FOR LOCALS OUTSIDE OPEN
		FIX - DIM A(X(1)/1)
41		FIX USAGE OF PROGRAMS NAMED OTHER THAN MAIN.
42		INITIALIZE  ODF (NUMERIC BASE) FOR GROUP TYPEOUT
43		ADD  CURGRP (BIT MASK ) TO NOTE CURRENT GROUPS
		ACTIVE IN A TYPEOUT  AND CATCH RECURSION
44		FIX UP "LOOK" SO THAT IF "MATHSM" IS NON-0 THAT IT
		WILL ACCEPT ONLY A SYMBOL WHOSE NAME IS IN "MATHSM"
45		FIX PAUSE TYPING TO LISTEN TO TTY BETTER
46		CHECK RANGES TO SEE THAT EACH  SYMBOL IS THE SAME

***** Begin Version 4A *****

47		DIFFERENTIATES ASCII- AND RASCII-MODE "TYPE"-OUTPUT
50		ALLOWS = AS DELIMITER IN ACCEPT STATEMENTS
51		FIXES "HELP" TO LIST COMMANDS
52		FIX TYPEOUT OF COMPLEX VALUES
53	15732	FIX TYPOUT OF SYMBOL WHEN LOCAL SYMBOL FOUND BEFORE GLOBAL
54	15732	***** DELETED *****TYPE OUT NAMES OF ARGUMENTS WHEN PAUSE AT
		ROUTINE
55	15708	MAKE TYPE KNOW ABOUT FORMAL ARGUMENTS

***** Begin Version 4B *****

56	16928	ACCEPT LOWER CASE MODE MODIFIERS
57	17043	IF TWO SYMBOLS HAVE SAME ADDRESS VALUE AND SAME
		NAME VALUE , THEN THEY MUST BE IN COMMON , SO LOOK
		SHOULD SUCCEED (OK SKIP 2 RETURN)
		ALSO REMEMBER NAME OF ARRAY FOR DIM COMMAND.
60	17272	IF ARRAY INFORMATION DOES NOT EXIST, TELL THE USER
		BUT DO NOT GIVE FDTIER ERROR.
61	17574	IF ERROR HAPPENS IN TYPING GROUP, CURRENT GROUP VARIABLE
		IS NOT CLEARED AND LATER GIVES ERROR FDTRGR.
62	18059	ADD INFORMATION IN THE "WHAT" OUTPUT
		(LOCATION OF THE PAUSE LABEL)
63	18374	GIVE CORRECT INFORMATION FOR "WHAT" COMMAND:
		SINGLE VARIABLE NAME + ARRAY NAMES AND SUBSCRIPT
		+ LOCATION OF NAMES
64	S19206	DONT TYPE EXTRA CRLF BETWEEN TYPED VALUES.
65	18715	ACCEPT COMMENTS ON COMMAND LINES
		DELIMITER IS !  TO END OF LINE OR OTHER !
66	 --- 	FIX TEST FOR ARRAY BOUNDS EXCEEDED IN DIM COMMAND
67	19541	FIX LOWER CASE RANGE CHECK
70	QA570	FIX REENTER MESSAGE TO ALWAYS GIVE SECTION NAME

***** Begin Version 5A ***** 7-Nov-76

71	20553	TYPING A FORMAT STATEMENT CAUSES AN E8 INTERNAL
		ERROR IF THE PROGRAM WAS NOT COMPILED WITH THE
		/DEBUG SWITCH. ADD MORE INFORMATIVE ERROR MESSAGE
		AREAS AFFECTED: FRMSET, ERR41
72	10088	WHEN TYPING AN ARRAY, THE INDEXES ARE NOT CORRECTLY
		TYPED IF AND ONLY IF THE IS A HIGH SEGMENT SYMBOL
		TABLE (FOR EXAMPLE FOROTS IS LOADED WITH SYMBOLS).
73	21818	WHEN TYPING A COMPLEX ITEM OR ARRAY, OR ACCEPTING A
		VALUE FOR A COMPLEX ARRAY, FORDDT DOESN'T NOTICE THAT
		EACH ENTRY IS TWO WORDS AND MESSES UP SUBSCRIPTS ETC.
74	21988	FORDDT CANT SET BREAK POINTS (PAUSE) IN HIGH SEGMENT
		OF A FORTRAN PROGRAM. ROUTINE CHKADR CLOBBERS (T)
75	21910	WHEN DOING A START, PROGRAM SHOULD CLEAR
		ANY SUPPLIED ARGUMENTS FROM THE TTY BUFFER.
76	21910	FIX ERROR IN ACCEPT ROUTINE WHICH CAUSES UNNECESSARY
		WARNING MESSAGE WHEN EXACTLY 5 (OR EXACTLY 10 IF IN
		LONG MODE) CHARACTERS ARE ACCEPTED
77	21910	MAKE THE PAUSE COMMAND WITH NO ARGUMENTS DISPLAY
		THE PAUSES.
100		Add TOPS20 conditional, make FORDDT run in native
		mode under TOPS-20.
101	QA2171	FIX FORDDT OUTPUT TO USE FOROTS CORRECTLY AFTER OTS EDIT
		  661: OUTPUT MUST START WITH + AND CLEAR TTY BUFFER
		  AFTERWARDS

***** Begin Version 5B ***** 8-Nov-77

102	11018	PREVENT LOOP IF SYMBOL TABLE HAS BEEN BLT'ED TO
		ZERO, AS CAN HAPPEN WITH AN OVERLAID PROGRAM.
103	QA2182	PUT "SEARCH MONSYM" FROM EDIT 100 UNDER "IFN TOPS20"
		  AND MOVE IT TO AFTER THE DEFINITION OF TOPS20
104	24427	PREVENT ILLEGAL MEMORY REFERENCE IF SYMBOL TABLE ENDS
		  EXACTLY AND THE END OF LEGAL MEMORY.
105	11395	HANDLE TYPE WITH MULTIPLE ARGUMENTS.  FORDDT WAS
		BLOWING UP IF FIRST ARG WAS FORMAL ARRAY, BECAUSE
		FORMAL ARRAY FLAG NEVER GOT CLEARED.
106	25207	CHANGE FDTNAR NOT AN ARRAY TO FDTNAA.  THIS AVOIDS
		CONFLICT WITH FDTNAR NOT AFTER REENTER.
107		FIX SYMBOL SEARCH TERMINATION TEST (OFF BY 2).
110	25384	FIX TYPE OF A FORMAL ARRAY IN SMALL PROGRAMS.
111	11839	ACCEPT STMNT EATS FIRST CHARACTER OF INPUT VALUE
112	27201	MAKE USE OF TYPEOUTS AND MODE CONTROL MORE CONSISTANT
113	12316	RESTRICT USE OF DOUBLE PRECISION IN CONDITIONALS
114	-----	CLEAN UP SOME TOPS-20 CODE:  IMPLEMENT NONTRIVIAL DDT
		COMMAND, FIX HALTF WHEN COMND JSYS GIVES AN ERROR
		RETURN, REMOVE SOME REDUNDANT CODE IN LISTEN
115	-----	GET VMDDT ON TOPS-10 WHEN DDT ISN'T LOADED WITH PROG

116	28581	Implement use of logicals (.TRUE. and .FALSE.) in
		PAUSE conditionals.
117	-----	Make error messages upper and lower case /BPK
120	-----	Implement logicals into ACCEPT, MODE and TYPE statements
		using the flag "/L".  "/L" was previously used
		to specify long (ie. two word) ASCII, RASCII and OCTAL
		values in the ACCEPT and MODE commands.  This switch
		has been changed to "/B", mnemonic for "BIG".
121	-----	Fix -20 code to clear bad lines properly.
122	-----	Set .JBDDT when VMDDT is pulled in to prevent overflow
		warnings from FOROTS.
123	-----	Prevent infinite loop on TOPS-20 if .JBHSO is 0 but
		.JBHRL isn't.
124	-----	Fix logical TYPEing so that all positive values are .FALSE.
		and all negative values are .TRUE.
125	-----	Add a new entry point (%FDDT) to be used when returning
		from DDT in place of .F10 (which will still work).
126	-----	Add ?FDT prefix to COMND JSYS error messages.
127	-----	Call FOROTS routine DEC. to interpret real, integer,
		complex, and double precision numbers instead of IN. .
130	-----	Call HELPER to print out FORDDT.HLP when the HELP command
		is issued.
131	-----	Search universal FDDT20 to define TOPS20 instead of
		defining it within FORDDT.
132	29363	Fix various problems that occur when core file is filled
		during GROUP and TYPE commands.
133	29261	Fix up error handling when reading program name.
		Use command JSYS when reading program name on -20.
134	-----	PAUSE sometimes hangs if a line terminator is typed in an
		inappropriate place.  Fix it.
135	-----	When looking up symbol in symbol table, make sure we
		compare the whole symbol and not just the right half-word
136	-----	PAUSE command doesn't allow comments in all places.
		fix it.

***** Begin Version 6 ***** 9-Jun-80

137	-----   Add G-floating capability for input/output. Use of G-floating
		is determined at initialization time by the presence
		of the symbol "..GFL.". If ..GFL. is missing, default
		to D-floating. If ..GFL. is present, use G-floating.

140	-----	Fix COMND trailing space problem. On the -20, the COMND JSYS
		is used to parse the first keyword. COMND supplies an extra
		space which makes FORDDT think that there are arguments
		following the keyword. This bug fix edits the COMND text buffer
		before doing a RSCAN JSYS and passing it to FORDDT's parsing
		code. It appropiately skips over comments. /DCC 3-July-80

141	----	Fix G-floating bug. Symbol ..GFL. was changed to a deleted
		output global symbol, breaking FORDDT's symbol lookup routine.
		One line patch at: EVAL1. Replace existing line with
		MOVSI R,GLOBAL!DELO      /DCC 5-August-80

142	-----	Use the new FOROTS routine to get high-segment symbol table
		pointer.  This is in case the high segment is protected.
		Make sure HELPER gets loaded into the low-seg and that we
		look for it on REL: on TOPS-10.  Fix up	some error messages.
		Relocate univeral searches.

143	-----	Assume that FOROTS and FORLIB are loaded from now on.  So
		remove almost all the SKIPIF macro calls.  This also fixes
		the problem of GHSSYP recursively calling itself.

144	QA5031	Change output format to suppress FOROTS's CR, as FORDDT types
		a CR also.  Also remove FORBUF, which is now unnecessary.

145	-----	Make FORDDT the entry point for FORTRAN users who wish to
		call FORDDT as an error routine.  SFDDT is the new entry
		point for initializing FORDDT (including reseting all files
		opened by FOROTS).  SFDDT replaces the old FORDDT symbol.  
		Replace FORBUF.
		  NOTE: Since FORDDT is now a global symbol, users should be
		careful if they decide to use the label FORDDT as a program,
		subroutine or function name.

146	-----	New calling sequence for FOROP.

147	-----	Fix up help code so that we get FORDDT.HLP ourselves instead
		of using HELPER.  This way FOROTS' data will not get stomped
		on.  Conditionalize out the old code for the time being.
		Redefine AC0 to be accumulator 0 and redefine the memory
		location previously defined as AC0 to be SAVACS. Also,
		remove universal file FDDT20.

150	-----	Change so that all JSYSs consistently end with a percent sign
		(%).  Also clean up the listing a bit (e.g., change PAGE
		pseudo-ops to form-feeds, delete definitions already defined
		in UUOSYM, etc.).

151	16084	FORDDT always flags lowercase on ASCII typeout.  On TOPS20,
		don't do any flagging--the monitor and user commands will do
		it.  On TOPS10, if the terminal is set to uppercase, flag the
		lowercase character; if it is set to lowercase, don't do any
		flagging (default is no flagging).

152    Q20-1675	Prevent FORDDT from getting arithmetic overflows in its
		symbol offset calculation.

153	-----	Report what is assembling (TOPS10 or TOPS20).  Also PURGE
		some symbols which my conflict with users' subroutine names.

154	-----	Move setting .JBREN to before the call to RESET. Use a
		different mechanism for detecting multiple REENTER entries.

*****  Begin Version 7 *****

155	-----	Change START2 to look for global symbol instead of program
		name when finding START address, since there can now be
		character descriptors in front of executable code. (BL)
		Change also in GETPRG.

156	-----	Fix bug in ACCEPT code...when ACCEPTing /ASCII/BIG input
		into a range of double precision array elements, the
		second word of the last element within the range was
		not ACCEPTed, due to RANGE being set to the address of
		the first word of the element. (BL)

157	-----	Lots of code to make FORDDT TYPE and ACCEPT character
		scalars and arrays.

160	-----	Make character scalars work again.

161	-----	Fix problem recognizing character arrays using /DEBUG.

162	-----	Enable type-out of character strings at PAUSEes.
		Also insert check for G-floating arrays in RAYNAM
		F10-array-checking.

163	-----	Insert new address-checking code: allow R/W to low-
		segment, R only from High-segment.
		Array range checking now done only if array pointer
		is in symbol table (if compiled /DEBUG).
		Inserted <widgets> around (most) error messages.

164	-----	Fix bug in multiple type-out modes.

165	CDM	1-Sept-82
	Change
	TRNE	T5,1B13
	to
	TRNE	T5,(1B13)
	to make it assemble without warnings.

166	BL	3-NOV-82
	Eliminate check of indirect bit in CKBPTR...it was failing legal
	byte pointers

167	BL	3-Nov-82
	Insert code to simulate V6 EDIT 155...we were getting array type-out
	failures on formal arrays

170	BL	17-Nov-82
	Change a TLNE to a TRNE in OFFSET, so we test the correct output mode
	options.
	Change test of return instruction in START4 so that it tests the
	instruction, not the address of its storage location. This was
	causing a subroutine which had been entered via a NEXT to be repeated
	if a GOTO was then performed.

171	BL	18-Nov-82
	Merge in V6 EDIT 165...fix problems with TYPE of variables in
	COMMON.

172	BL	2-Dec-82
	Reinstate the check of the indirect bi in CKBPTR...but do it right!!! 

173	BL	12-13-82
	Move swapping of local and default type-out modes in DISP10 so that
	OFFSET is called with the right option. (was causing inaccurate
	subscripts).

	174	BL	7-Jan-83
	Move %FDDT (reentry from DDT) so that user-modes are not reset.

175	BL	11-Jan-83
	typo at DISP10+4.


176	BL 13-Jan-83
	Revise EDIT 174 so that %fddt still performs everything except the
	resetting of modes.

		 ***** End V7 Development *****

;.BEGINR 	***** Begin V7 Maintenance *****
;.COMPONENT FORDDT
;.VERSION 7
;.AUTOPATCH 7
;.EDIT	177	ALLOW " = " CONSTRUCTS IN ACCEPT,IMPLEMENT ERR= DECODE CALLS
;;	Since "ACCEPT A=3" is allowed (although a user error), also allow
;;	"ACCEPT A = 3" style constructs.  Push a 'STOP!!' billboard on FORDDT's
;;	stack so FORERR's PC finder will not loop.  Install an ERR= argument
;;	for calls to DECODE so truly illegal arguments passed to FOROTS will
;;	not abort debugging.
;		TGS,09-APR-83,SPR:20-19167
;		A:SRC FORDDT.MAC
;.EDIT	200	ACCEPT NAME/MODE<CR> HANGS
;;	ACCEPT Name/Mode<CR> hangs waiting for another CRLF.  Treat this and
;;	other cases where ACCEPT command lines terminate without any value
;;	supplied by the user as cases of bad syntax.
;		TGS,14-JUN-83,SPR:NONE
;		A:SRC FORDDT.MAC
;.EDIT	201	PROBLEM TYPING VARIABLE NAME WHEN SAME AS PROGRAM NAME
;;	If the PROGRAM name is the same as a variable name, then TYPEing
;;	the variable name yields "MAIN PROGRAM(1) = " etc. 
;		TGS,22-JUL-83,SPR:10-34002
;		A:SRC FORDDT.MAC
;.EDIT	202	1+NTH ARRAY NAME TYPED OUT AS "PAT..(n)"
;;	Typing an array on TOPS10 will garble the 2nd through nth array
;;	element name, typing it as PAT..
;		TGS,28-JUL-83,SPR:10-34001
;		A:SRC FORDDT.MAC
;.EDIT	203	PROBLEMS AFTER PAUSING AT MAIN.
;;	Setting a breakpoint at MAIN. will cause an ?Ill mem ref on
;;	TOPS10 as soon as the program is STARTed. On TOPS20 a private
;;	page may be created; in addition, a subsequent STRACE after
;;	the START will loop, finally getting an ?Ill instruction.
;		TGS,29-JUL-83,SPR:NONE
;		A:SRC FORDDT.MAC
;.EDIT	204	GARBLED ENTRY NAME ON TOPS20 CALL TO FORDDT
;;	On TOPS20, having found a valid offset during a low-seg symbol
;;	table search, do not then search the hiseg symbol table as well.
;		TGS,1-AUG-83,SPR:NONE
;		A:SRC FORDDT.MAC
;;.ENDA		7-SEP-83
;.EDIT	205	ACCEPT/S ECHO TYPEOUT ALWAYS IN FLOATING POINT
;;	ACCEPT/S <var> will always echo in floating point format, regardless
;;	of the current MODE setting.
;		TGS,19-SEP-83,SPR:10-34142
;		A:SRC FORDDT.MAC
;;.ENDA		3-OCT-83
;;.ENDA		31-OCT-83
;;.EDIT	206	RESERVED FOR AUTOPATCH
;.ENDA
;.AUTOPATCH 8
;;.ENDA		27-DEC-83
;;.ENDA		20-JAN-84
;;.ENDA		16-FEB-84
;.EDIT	207	NOOP EDIT TO UPDATE OUR VERSION 
;;	Update the edit number and thereby teach Autopatch to update it
;;	also. No code changes.
;		TGS,24-FEB-84,SPR:NONE
;		A:SRC FORDDT.MAC
;;.ENDA		23-MAR-84
;;.ENDA		26-APR-84
;.ENDA
;.AUTOPATCH 9
;;.ENDA		18-MAY-84
;.EDIT	210	FIX COMPLEX ARRAY TYPE OUT
;;	Recognize a complex array as a double word array.
;		MRB,5-JUN-84,SPR:20-20178
;		A:SRC FORDDT.MAC
;.EDIT	211	WARN IF WE CAN'T HACK IWI ERRORS FROM FOROTS
;;	FORDDT can't do anything useful if the user has set a breakpoint
;;	in an IOLST function call, since any TYPE or ACCEPT command will
;;	call FOROTS, thus getting an "I/O within I/O" (IWI) error.  Check
;;	at breakpoint processing by calling FO$UDB FOROP and warn if this
;;	breakpoint is "restricted".  Type an error if the user tries to
;;	ACCEPT or TYPE under IWI conditions.
;;	NOTE: This edit must not be installed unless FOROTS Edit 3432 has
;;	been installed.
;		TGS,7-JUN-84,SPR:20-20133
;		A:SRC FORDDT.MAC
;.EDIT	212	MONSYM "ENDSTR" CONFLICT
;;	Change label ENDSTR, as it may conflict with future releases of
;;	MONSYM and give a compilation error.
;		TGS,22-JUN-84,SPR:NONE
;		A:SRC FORDDT.MAC
;;.EDIT	213	RESERVED FOR AUTOPATCH
;;.EDIT	214	RESERVED FOR AUTOPATCH
;;.ENDA		22-JUN-84
;.EDIT	215	HACK AN OFFSET WHEN NEXTING WITHOUT LOCAL SYMBOLS
;;	If a program or program unit has been loaded /NOLOCALS, and
;;	the user tries to NEXT from a global pause, don't give up
;;	with FDTIER #7 when trying to print the label or source line.
;;	Use the offset returned by LOOK instead.
;		TGS,28-JUN-84,SPR:10-34742
;		A:SRC FORDDT.MAC
;;.EDIT	216	RESERVED FOR AUTOPATCH
;;.ENDA		19-JUL-84
;.EDIT	217	TYPE CHAR(VAR)/C TYPES VAR(1)...
;;	Each time SYMIN reads a variable it stores the symbol pointer in
;;	CRYSYM for special character array typeout.  Since CHAR(VAR) forms
;;	of variables will cause routine EITHER to call SYM2 recursively,
;;	CRYSYM will be left pointing to the subscript instead of the array
;;	name, causing OFFSET to type the wrong name.
;		TGS,2-AUG-84,SPR:10-34776
;		A:SRC FORDDT.MAC
;;.EDIT	220	RESERVED FOR AUTOPATCH
;;.ENDA		16-AUG-84
;;.ENDA		20-SEP-84
;.ENDA
;.AUTOPATCH 10
;.EDIT	221	NOOP EDIT TO UPDATE OUR VERSION 
;;	Update the edit number and thereby teach Autopatch to update it
;;	also. No code changes.
;		MRB,19-OCT-84,SPR:NONE
;		A:SRC FORDDT.MAC
;;.ENDA		19-OCT-84
;.EDIT	222	ACCEPT VAR/C MAY NOT DISPLAY NEW VALUE
;;	If the ACCEPTed string exactly fills the variable, the ACCEPT
;;	command does not display the new value.
;		TGS,27-NOV-84,SPR:10-34962
;		A:SRC FORDDT.MAC
;.EDIT	223	TYPING FORMAL ARRAY PARAMETERS LACK SUBSCRIPT
;;	A request to TYPE a formal array will type all subscripts
;;	except the first; a one-shot TYPE request (e.g. TYPE ARRAY(2))
;;	will thus not show which subscript is being typed.
;		TGS,7-DEC-84,SPR:10-34961
;		A:SRC FORDDT.MAC
;;.EDIT	224	RESERVED FOR AUTOPATCH
;;.ENDA		26-DEC-84
;;.ENDA		16-JAN-85
;.ENDA
;.ENDV
;.ENDR 		 ***** End V7 Maintenance *****

		***** Begin V10 Development *****

300	EXTENDED ADDRESSING DEVELOPMENT
	Many changes:
		Modify breakpoint table layout and handling.
		Address arithmetic changes.
		Extended FOROTS calls.
		Misc cleanup.
		BCM,18-JUN-84

301	ARRAY DEFINITION TABLE HAS GLOBAL INDICES
	The DIMTAB table is expanded to have three-word entries,
	  and all entries contain global indices.
	The definition of the entries have symbolic names.
	References to the entries are changed from half-word
	  to full-word.
	Miscellaneous cleanup.
	AlB,26-Jun-84

302	HELP COMMAND REQUIRES ONE-WORD GLOBAL BYTE POINTER
	The HELP command requests the allocation of core memory from
	the FOROTS ALCOR. routine.  That routine returns a global
	address, and thus the FORDDT HELP command must turn it into
	a OWGBP in order to get at the assigned buffer (which could be
	in another section under extended addressing).
	AlB,27-Jun-84

303	More development fixes
		Indirect reference in START4 no good in non-zero.
		Bug introduced by edit 170 that showed up in non-zero section.
		Address test failed with extra section number in WT15.
		Dummy the PC using current section number in STEP4.
		Fixed up address arithmetic in AUTOP.
		Push an AC instead of hiding on stack in FP7.
		BCM,28-Jun-84

304	RECOGNIZE GLOBAL SYMBOLS FOR LOCATE
		Fix an indirect reference in QLIST6.
		BCM,29-Jun-84

305	VERIFY THE CORRECT ADDRESS FOR BYTE POINTERS
	A call to CKWRIT was using the updated byte pointer
	after a ADJBP.  Changed to use original address for
	checking page access.
		BCM,9-Jul-84

306	CHECKING LH FLAGS FOR RH VALUE
	Old bug that showed up using flag DOUBLE.
		BCM,9-Jul-84

307	ADDITIONAL WORK FOR EDIT 301
	Needed to correct logic in DISP14 for DOUBLE arrays.
		AlB/BCM,9-Jul-84

310	TOPS-10 ADDITIONAL WORK
	Fix up EFIW,IFIW definitions for -10.
	Fix XJRSTF in RESTOR to have only RH of PC and not get flags.
		BCM,17-Jul-84

311	CANNOT PAUS/GOTO/START AT SOME LOCATIONS
	Insufficient check for FORMAT statement disallowed some legal
	breakpoints.  Fix to check second ascii character for being
	a control character, and if so, assume its NOT a FORMAT statement.
		BCM,17-Jul-84

312	Fix ERR branch & Page access bug in CKWREX.
		BCM,25-Jul-84

313	Development edit. Make extended code work with FORDDT. See spec
	for details.
		BCM,16-Aug-84

314	Get rid of all references to NEARST.
	Clean up the LOOK routine.
		AlB,23-Aug-84

315	Change the search of the symbol table which looks for the name of
	the main program.  Instead of looking for a program name of 'MAIN.',
	use the program which contains the global value 'MAIN.'.
		AlB,24-Aug-84

316	Change the START mechanism such that the main program could be
	in a section other than the one in which FORDDT is loaded.
		AlB,24-Aug-84

317	Add a three-word entry vector for Tops-20.
	The use of .JBREN is retained for Tops-10.
		AlB,24-Aug-84

320	Prepare for the handling of symbol tables which exist in a section
	other than the one in which FORDDT is loaded.

	o Add a temporary 'build a symbol vector' routine. This routine
	will be removed when a FOROP. call is added to do the same thing.
	o Change the SETLST and FIXSYR routines to allow for global indices
	into the symbol tables.
	o Remove SETLXS, which is no longer needed.
	o Modify GHSSYP to take error exit if we are in a non-zero section.
	o Modify OVRLAY so as to call SETLST whenever it detects that
	.JBSYM has changed.
		AlB,27-Aug-84

321	Change the symbol searches to use global addresses.
	Essentially, instead of using the JOBDAT IOWD-style symbol table
	addresses, we use two words: one is a global address into a
	symbol table, and the other is the number of unsearched words.
	This change enables the symbol tables to be anywhere in memory.

	Also made several miscellaneous changes to reflect the fact that
	we may be in a section other than the one in which the symbol
	tables reside.

	Also fixed some problems with array indices being larger than a
	half-word, and with array sizes larger than a half-word.

	Also made some changes just because I couldn't stand to look at
	some rottenly constructed code ONE MORE TIME!!
		AlB,29-Aug-84

322	Fix ACCEPT of character data.  When exactly enough characters were
	entered for the field, the field was not being displayed in
	confirmation.

	Fix TYPE of a range of character array elements.  Prior to this fix,
	only the last element was being TYPEd.
		AlB,30-Aug-84

323	Fix BLDVEC to get the correct section number for symbols.

	Re-do the handling of optional command switches.  It was rather
	confusing as written.  Now register P3 contains the default settings
	in the left half, and the currently active settings in the right half.
		AlB,4-Sep-84

324	Fix CONTINUE. LEAV2 was returning to user program via an indirect jump
	jump through a bogus location.
		AlB,7-Sep-84

325	Add PAUSE ON ERROR command.
		MEM,6-Sep-84

326	Remove references to FGLSNM, which was a flag to tell LOOK (a symbol
	table lookup) that global symbols are Ok.  Since that flag was being
	turned off by CPOPJ1 and CPOPJ2, we sometime could not find a global
	symbol.  Since global symbols are always Ok, we don't need that flag.

	Also changed all references to (erroneous) edit number 2460 and
	replaced them with 325. Put edit number on all places that were
	touched by 325 aka 2460. Fixed bugs in AC save and restore caused
	by edit 325.
		AlB,25-Sep-84

327	Use the routine in FORLIB which determines the location of the
	symbol table.  In this way, we are assured that FOROTS/FORLIB and
	FORDDT are using the same symbol table.
		AlB,25-Sep-84

330	Use the default MODEs when confirming the value ACCEPTed with
	modifier /S.
		AlB,27-Sep-84

331	Instead of typing message "Pause on error", JRST FORDDT
 	which will print message "Entering Forddt at..." and then do a
	breakpoint 0.
		MEM,2-Oct-84

332	Modify pause on error code according to comments made during its
	inspection. Make REMOVE remove pause on error and make WHAT
	display pause on error if it is set.
		MEM,9-Oct-84

333	Fixup problems with edit 321.
		BCM,5-Nov-84

334	Change message, when reentering FORDDT from ^C and running extended,
	from garbage address to "from FORDDT".
		MEM,27-Dec-84

335	Add a TOPS-20 conditional left out of edit 334
		JLC,27-Feb-85

		 ***** End V10 Development *****

;.VERSION 10
;.AUTOPATCH 11
;.EDIT	336	NOOP EDIT TO UPDATE OUR VERSION NUMBER
;;		No code changes. (See edit 221).
;		MRB,9-MAY-85,SPR:NONE
;		A:SRC FORDDT.MAC
;;.ENDA		9-MAY-85
;;.EDIT	337	RESERVED FOR AUTOPATCH
;;.ENDA		24-JUN-85
;;.EDIT	340	FORDDT CRUSHES USER ACS
;;		SAVACS was being used as scratch in PAUSE, START, and RESET
;		PLB,2-JUL-85,SPR:20-20789
;		A:SRC FORDDT.MAC
;;.ENDA
;.ENDA
;.ENDV
;.ENDR REVISION HISTORY

		***** Begin V11 Development *****

400	Become Version 11.
		MRB, 28-Mar-85

401	Add substring support in ACCEPT and TYPE statements.
		MEM, 19-Dec-85

402	Add long symbol support. For each FORDDT memory location that stores
	a symbol we also have a flag word that is zero if the symbol is short.
	When we have a symbol in a register then the LNAME bit of the left
	half is lit when the symbol is long.
		MEM, 17-Feb-86

403	Correct various error messages and an extended addressing problem.
		MEM/MRB, 1-Jun-86

404	CDM	10-Jul-86
	Call ERRSET when doing PAUSE ON ERROR, so that the user will
	get error/warning messages when his program pauses!

405	MEM	26-Sep-86
	In LSPT, check if global address before making OWGBP since KS
	can't handle them.

		 ***** End V11 Development *****
		 ***** End Revision History *****

ENDV11
\;END OF COMMENT
SUBTTL	DEFINITIONS	


;DEFINE ACCUMULATORS

ENTRY FORDDT,FDDT.,.F10,%FDDT
EXTERN .JBREL,.JBHRL,.JBSYM,.JBSA,.JBOPC,.JBDA	;[321]
EXTERN ERRSET			;[404] Set number of ots warnings to receive

IFN EXTHLP,<EXTERN .HELPR>	;[147] for external HELPER


;AC0=<F=0>			;[147] FLAGS
;AC1=<TF=1>			;[147] TEMPORARY FLAGS, RESET ON RETURN TO RET:
;AC2=<R=<T1=<A=2>>>		;[147] POINTERS TO TABLES, CORE, ETC.
;AC3=<S=<T2=<B=3>>>		;[147]
;AC4=<W=<T3=<C=4>>>		;[147] CONTAINS DISPATCH ADDR IN WORD ASSEMBLER
;AC5=<T=<T4=5>>			;[147] TRANSFER DATA
;W1=<T5=6>
;W2=<T6=7>
;TMOD=10				;TYPE MODE FLAGS
;AR=11
;ODF=12				;RADIX DEFINITION
;TT=<P3=13>			;TEMPORARY
;TT1=<P4=14>			;TEMPORARY
;RAY.==15			;POINTS TO NEXT F10 DEFINE ARRAY DIMENSION
;L=16				;[147] POINTER TO ARGUMENT LIST
;P=17				;PUSH DOWN


	T0==0			;FLAGS
	T1==1			;TEMPORARY FLAGS, RESET ON RETURN TO RET:.
	T2==2			;POINTERS TO TABLES, CORE, ETC
	T3==3
	T4==4			;CONTAINS DISPATCH ADDR IN WORD ASSEMBLER
	T5==5			;TRANSFER DATA
	P1==6
	P2==7
	P3==10			;[323] Mode flags (default,,active)
	P4==11
	S1==12			;RADIX DEFINITION
	S2==13			;TEMPORARY
	S3==14			;TEMPORARY
	S4==15			;POINTS TO NEXT F10 DEFINE ARRAY DIMENSION
	L==16			;POINTER TO ARGUMENT LIST
	P==17			;STACK

;DEFINE SYMBOL TABLE SYMBOL TYPES

; The SECONDARY SYMBOL TABLE which starts at the local symbol .SYMTB in each
; module has its start address stored into SSTAB in FORDDT by the code to OPEN
; the current module. This table starts with a count of the number of entries
; in the right half and the left half is zero if the secondary symbol table 
; contains only globals. The first entry in the symbol table (at .SYMTB+1)
; is for the module name. Each entry in the table is two words long. The first
; word has a 3 bit flag field, a 3 bit count of the number of words in the
; symbol name, and a 30 bit address to where the symbol name is stored. The
; second word is the address of the location where the value of the symbol is
; stored.
;
;          +-------------------------------------------------+
; .SYMTB:  |  symtb flag            |         entry count    |
;          +-------+------------+---+------------------------+
;          | flags | word count |           ptr to symbol    | First entry is
;          +-------+------------+----------------------------+ module name
;          |                    address of value of symbol   |
;          +-------+------------+---+------------------------+
;          |                                                 |
;          |                   ...                           |
;          +-------+------------+---+------------------------+
;          | flags | word count |           ptr to symbol    |
;          +-------+------------+----------------------------+
;          |                    address of value of symbol   |
;          +-------+------------+----------------------------+
;
;
;
;


CNTSFT==^D30		;[402] SHIFT TO GET CNT FROM CNT+PTR FOR LONG NAME
LGLOBL==200000		;[402] GLOBAL in secondary symbol table
LPNAME==600000		;[402] program name in secondary symbol table
LFLG==  700000		;[402] flag field in secondary symbol table entries
			

; In LINK's symbol table entries are also 2 words long. The first word contains
; a four bit flag field followed by the radix 50 name. The second word in the 
; address of the symbol value.

;          +-------+------------+----------------------------+
;          | flags |         radix 50 symbol name            |
;          +-------+------------+----------------------------+
;          |                    address of value of symbol   |
;          +-------+------------+----------------------------+
;          |                                                 |
;          |                  ...                            |
;          +-------+------------+----------------------------+
;          | flags |         radix 50 symbol name            |
;          +-------+------------+----------------------------+
;          |                    address of value of symbol   |
;          +-------+------------+----------------------------+

GLOBAL==040000		;GLOBAL SYMBOL
LOCAL==100000		;in ddt and secondary symbol table
PNAME==740000		;PROGRAM NAME
DELI==200000		;DELETE INPUT
DELO==400000		;DELETE OUTPUT


;[137] SYMBOLS REPRESENTING FOROTS ARG TYPES

TP%DPR==10		;[137] D-floating double precision
TP%DPX==13		;[137] G-floating double precision
TP%CPX==14		;[210] Complex
TP%CHR==15		;[157]  Character
FO$HSP==4		;[142] FOR RETURNING HISEG SYBOL TABLE PTR.
FO$GBA==20		;[332] GET BREAK ADDRESS
FO$UDB==23		;[211] FOR RETURNING CONTENTS OF %UDBAD
;	DEFINE SYSTEM PARAMETERS

IFNDEF SYMSPC,<SYMSPC==2>	;[402] 1 word for ptr to symbol
                                ;[402] plus 1 word for flag word

IFNDEF NBP,<NBP==^D10>		;NUMBER OF PUASE REQUESTS

IFNDEF GPMAX,<GPMAX==10>	;NUMBER OF GROUP STRINGS (MAX 35 )

IFNDEF PDSIZ,<PDSIZ==10>	;[327] DEFINE PDL SIZE FOR INITIAL STACK
IFG PDSIZ-100,<PDSIZ==100>	;LIMIT SIZE TO ^D64

IFNDEF CFSIZ,<CFSIZ==^D15>	;CORE FILE LENGTH



IFNDEF DIMSIZ,<DIMSIZ==^D50>	;AMOUNT OF SPACE FOR DIMENSION DEFINITIONS




IFNDEF DEBUG,<DEBUG==0>		;KEEP OFF - DEVELOPMENT ONLY - UNSUPORTED
				IFN DEBUG<  IF1<
	PRINTX	FORDDT - DEVELOPMENT VERSION
					>	>

COMMENT \

NBP	DEFINE THE MAXIMUM NUMBER OF PAUSE REQUESTS ALLOWED
	EACH PAUSE INCREASES CORE REQUIREMENTS BY DECIMAL 10

GPMAX	DEFINE THE MAXIMUM NUMBER OF GROUPS
	EACH GROUP SETTING REQUIRES AN EXTRA DECIMAL 23 LOCATIONS

PDSIZ	DEFINE THE SIZE OF THE PUSH DOWN STACK
	ALLOW SUFFICIENT STACK FOR ALL GROUPS TOGETHER
	LIMITS PDSIZE TO ^D64

CFSIZ	DEFINE THE SIZE OF EACH CORE FILE

DIMSIZ	DEFINE THE NUMBER OF ENTRIES
	USED TO HOLD ARRAY DIMENSION DATA

ESEFIW	location of table of EFIW of JSR's under /EXTEND

SZEFIW	Table of the EFIW's referenced by the JSR instruction.
	Word 0 points to BP1, word 1 points to BP2, etc.  In non-zero
	sections, this table will be copied to the address given by ESEFIW.

ESDIEB	Location of dispatch instruction execute block under /EXTEND

SZDIEB	Table of displaced instruction blocks.  In non-zero sections,
	this table will be copied to the address given by ESDIEB.

\

ESEFIW==.JBDA+1		;[313] location of EFIW table
ESDIEB==ESEFIW+NBP	;[313] location of displaced instruction block table
;FLAG F DEFINITIONS,  LEFT HALF:

EOL==   400000	;END OF USER LINE
FPF==   200000	;PERIOD TYPED FLAG
FEF==   100000	;EXPONENT FLAG

MF==    040000	;MINUS FLAG
SIGN==  020000	;PLUS OR MINUS TYPED
CFLIU== 010000	;CORE FILE IN USE FLAG

OFCFL== 004000	;OUTPUT FROM CORE FILE REQUESTED
CONS==  002000	;CONSTANT SEEN FLAG
GRPFL== 001000	;GROUP FLAG - ALLOWS GROUP LOGIC

AUTO==  000400	;AUTO PROCEDE FLAG
OCTF==  000200	;OCTAL NUMBER TYPED FLAG
;FGLSNM==000100	;[326] ALLOW GLOBAL SYMBOL NAMES (FOR LOOK AND FINDSYM)

LABEL== 000040	;INDICATES STATEMENT LABEL BEING PROCESSED
LFTSQB==000020	;FLAG THAT A [ IS SEEN - SO A ] WILL END THE SPECIFICATION
BAR==   000010	;FLAG THAT WE HAVE SEEN A / IN DIMENSION ANALYSIS

DIMEND==000004	; ) OR ] FOUND I.E. END OF DIMENSION SPEC IMINENT
;[321] FPRNM== 000002	; FIND PROGRAM NAME (FOR FNDSYM)
;[321] FLCLNM==000001	; FIND LOCAL IN CURRENT OPEN PROGRAM (FOR SYMBOL SEARCH)



;RIGHT HALF

POWF==  400000	;POWER FLAG # TO FOLLOW
DOUBLE==200000	;FLAG FOR DOUBLE WORD ARRAY DATA
BASENM==100000	;AN ARRAY BASE NAME HAS BEEN ACCEPTED

TRLABL==040000	;TRACING LABEL ONLY FLAG
;[157]PNAMEF==020000	;PROGRAM NAME SEEN IN SYBOL TABLE SEARCH
CHARS== 020000	;[157]Character array
MDLCLF==010000	;USED BY SYMBOL SEARCHES - MULTIPLY DEFINED LOCAL SYBOL

ID==    004000	;SYMBOL IDENTIFIED FLAG
IDINOS==002000	;SYMBOL IDENTIFIED IN OPEN SECTION
SILENT==001000	;DO NOT TYPE SYMBOL IF FOUND IN 'LOOK'UP

SUBFLG==000400	;SUBSCRIPT FLAG - CHECK SUBSCRIPTS IF ON
FLSHAL==000200	;FLUSH ALL ARRAY NAMES FROM BASRAY ONWARDS
IDPNAM==000100	;IF SET CAUSES 'LOOK' TO REMEMBER SECTION NAME

;[314] NEARST==000040	;IF SET CAUSES 'LOOK' TO RETURN THE NEXT LARGER SYMBOL
F10RAY==000020	;CURRENT ARRAY IS F10 DEFINED
TRLINE==000010	;TRACE AT LINES LEVEL

FORMAL==000004	;HANDLING ARRAY AS SUBROUTINE FORMAL PARAMETER
GFLOAT==000002	;[137] If set, G-floating is in use; else D-floating.
SURGFL= 000001	;ACCEPT  / AND : AS DIMENSION RANGE DELIMETERS
;	*** FLAG T1 ***
;
;	T1 TEMPORARY FLAG DEFINITIONS:
;	CLEARED ON EVERY RETURN TO USER (RET:)
;
;	RIGHT HALF

DCOPFG==000001	;DON'T CHANGE OPEN PROGRAM FOR GROUP
ALPHA== 000002	;PERSUADES ROUTINE EITHER TO RETURN SIXBIT ON NON # INPUT
ACCPT== 000004	;SIGNALS AN ACCEPT IN PROGRESS
ADELIM==000010	;FLAG THAT WE HAVE HAD AN ASCII TEXT DELIMITER
IMPRNG==000020	;REQUEST FOR IMPLIED RANGE
ARRAY.==000040	;AN ARRAY HAS BEEN DETECTED DURING ACCEPT LOGIC
		; ALSO DURING TYPE OFFSET PROCESS
GUDLBL==000100	;A GOOD NUMERIC LABEL FOUND IGNORING LAST CHARACTER
FGLONL==000200	;FIND GLOBAL SYMBOL ONLY
SYMLAB==000400	;SYMBOL IS A LABEL
DCEVAL==001000	;DON'T CALL EVAL ( FROM SYMIN )
COMDEL==002000	;COMMENT PROCESS IN PROGRESS
LGCLEG==004000	;[116] LOGICALS ARE LEGAL WHEN FLAG IS ON
ISLOGI==010000	;[116] WE ARE DEALING WITH A LOGICAL CONSTANT
TYPCMD==020000	;[171] Processing TYPE
COMDAT==040000	;[171] COMMON data
LNAME==	100000	;[402] WE HAVE A LONG SYMBOL NAME IN A REGISTER


;	*** FLAG P3 ***
;
;	DEFINE THE PRINT OPTION FLAGS USED IN LEFT & RIGHT OF P3
;[323]	LEFT HAND - DEFAULT USER SETTING
;[323]	RIGHT HAND  - LOCAL TEMPORARY SETTING (TAKES PRIORITY)

F.==000001	;TYPE FLOATING POINT FORMAT
I.==000002	;TYPE INTEGER FORMAT
O.==000004	;TYPE OCTAL FORMAT
A.==000010	;TYPE ASCII FOMAT
D.==000020	;TYPE DOUBLE PRECISION FORMAT
R.==000040	;TYPE RIGHT JUSTIFIED ASCII
X.==000100	;[157]TYPE COMPLEX FORM
B.==000200	;[120] 'BIG' OPTION REQUESTED
L.==002000	;[120] LOGICAL FORMAT (.TRUE. AND .FALSE.) OR TRACE LABELS
C.==004000	;[157] Character string

S.==000400	;TRACE SOURCE LINES
E.==001000	;TRACE ENTRIES

ANYMOD==400000	;USED BY OPTION TO SHOW LEGAL MODIFIER SEEN



;
;	********** FLAGS FOR LEFT HALF OF COND0 **********

LFTLOG==000001	;[116] LEFT CONSTANT IN CONDITIONAL WAS LOGICAL
RHTLOG==000002	;[116] RIGHT CONSTANT IN CONDITIONAL IS LOGICAL

;FLAG T0 - "STICKY FLAGS"

STIKYS==TRLABL!TRLINE!GFLOAT		;[137] Add "GFLOAT" to mask to be
					;[137]  "and"ed with STKYFL at RET:
;	USEFUL OPDEFS

	OPDEF	PJRST	[JRST]		;PUSHJ/=POPJ





;	POSSIBLE ERROR MESSAGES OF THE FORM ? E#
;	THE ASSOCIATED ERROR MESSAGE IS:
;	  ?FDTIER Internal FORDDT error - (number)
;
;	? E1	CANNOT FIND SYMBOLIC NAME FOR THE PAUSE IN A 'WHAT'
;	? E2	CANNOT FIND SYMBOLIC NAME FOR THIS PAUSE(BREAK)
;	? E3	CANNOT FIND SYMBOLIC NAME FOR AN ARGUMENT OF THE
;		ROUTINE ABOUT TO BE ENTERED
;	? E4	BAD LABEL FOUND WHERE SOURCE LINE OR STATEMENT LABEL EXPECTED
;	? E5	CANNOT FIND SYMBOL IN DIMENSION LOGIC
;	? E6	CANNOT FIND SYSMBOL MATCH IN A RE-ENTER
;	? E7	CANNOT FIND SYMBOL IN A TRACE INTERUPT
;	? E8	CANNOT FIND END OF F10 FORMAT STATEMENT = LABEL+F


;	THESE ERRORS SHOULD NEVER OCCUR - BUT COULD INDICATE THAT
;	THE SYMBOL TABLE HAD BEEN MODIFIED(OVERLAYED?) OR SOMETHING
SUBTTL	MACRO'S	

	;[325] Removed SETPDL

; Each FORDDT symbol is stored as follows:
; The first word may either contain a radix50 name or it may contain a 6 bit 
; word count for the length of the symbol followed by a 30 bit address of the 
; symbol (which is actually .+2). The symbol is long if the LNAME bit in the
; left half of the flag word is set.
;
;       +------------------------+
;       | wordcount| ptr to name | or radix50 name
;       +------------------------+
;       |      flag name         |
;       +------------------------+
;       |      symbol name       |
;       |          ...           |
;       +------------------------+
;
;
;

	DEFINE	CLRFLG(SYM)
	<SETZM	SYM+1>

	DEFINE	SETFLG(SYM)
	<SETOM	SYM+1>

	DEFINE	GETFLG(REG,SYM)
	<MOVE	REG,SYM+1>

	DEFINE	SYMSKN(SYM)
	<SKIPN	SYM+1>

	DEFINE	SYMSKE(SYM)
	<SKIPE	SYM+1>

	DEFINE	LDFLG(SYM)	
<	TRZ	T1,LNAME	; Clear long symbol flag
	SKIPE	SYM+1		; Is this a long symbol?
	TRO	T1,LNAME	; Yes, so set long symbol flag
>

	DEFINE	LDSYM(REG,SYM)	
<	MOVE	REG,SYM		; Load long symbol into register
	TRZ	T1,LNAME	; Clear long symbol flag
	SKIPE	SYM+1		; Is this a long symbol?
	TRO	T1,LNAME	; Yes, so set long symbol flag
>

	DEFINE	STSYM(REG,SYM)  
<	MOVEM	REG,SYM		; Store symbol into memory
	SETZM	SYM+1		; Assume symbol was short
	TRNE	T1,LNAME	; Was symbol long?
	 SETOM	SYM+1		; Yes, so set long symbol flag
>

	DEFINE	MOVSYM(SYM1,REG,SYM2)  
<	MOVE	REG,SYM1+1	;Copy flag word
	MOVEM	REG,SYM2+1
	MOVE	REG,SYM1	;Copy symbol
	MOVEM	REG,SYM2
>

	DEFINE	QUERY
<	TYPE	(? )	>

ife tops20,<
	DEFINE	TYPE(X)
<	OUTSTR	[ASCIZ/X/]	>

	DEFINE	LINE
<	OUTSTR	CRLF	>

	define	atype(x)
<	outstr x	>

	define	stype(x)
<	outstr [asciz x]>

	define	tab
<	outstr	[byte(7)11,0]	>

	define	openp
<	outstr	[byte(7)"(",0]	>

	define	closep
<	outstr	[byte(7)")",0]	>

	define	openb
<	outstr	[byte(7)74,0]	>

	define	closeb
<	outstr	[byte(7)76,0]	>

	define	putchr(x)
<	outchr x>
>				;end of conditional
ifn tops20,<
	define	type(x)
<	push	p,T1
	hrroi	T1,[asciz/x/]
	psout%
	pop	p,T1	>

	define	atype(x)
<	push	p,T1
	hrroi	T1,x
	psout%
	pop	p,T1	>

	define	stype(x)
<	push	p,T1
	hrroi	T1,[asciz x]
	psout%
	pop	p,T1	>

	define	line
<	push	p,T1
	hrroi	T1,[byte(7)15,12,0]
	psout%
	pop	p,T1	>

	define	openp
<	push	p,T1
	hrrzi	T1,"("
	pbout%
	pop	p,T1	>

	define	closep
<	push	p,T1
	hrrzi	T1,")"
	pbout%
	pop	p,T1	>

	define	openb
<	push	p,T1
	hrrzi	T1,74
	pbout%
	pop	p,T1	>

	define	closeb
<	push	p,T1
	hrrzi	T1,76
	pbout%
	pop	p,T1	>

	define	tab
<	push	p,T1
	hrrzi	T1,11
	pbout%
	pop	p,T1	>

	define	putchr(x)
<	push	p,T1
	move	T1,x
	pbout%
	pop	p,T1	>
>				;end of conditional





	DEFINE SKIPIF(STRING)		;IS STRING LOADED? - SKIP IF IT IS
<	MOVE	T5,[SQUOZE 0,STRING]	;GET RAD50 FORM OF 'STRING'
	PUSHJ	P,FINDST		;SEE IF STRING IS LOADED>



	DEFINE PROGIF(NAME)		;IS NAME LOADED?  SKIP IF SO
<	MOVE	T5,[SQUOZE 0,NAME]
	MOVEM	T5,SYM
	PUSHJ	P,FINDP	>		;[321]
;	RECURSION MACRO'S
;
;	MACRO -RECURS- TO SAVE RELEVANT INFORMATION TO
;	ALLOW RECURSION
;	CALL SRUCER TO RESTORE



	DEFINE RECURS(X)
<	XLIST
	IRP(X)<	PUSH	P,X>
	DEFINE SRUCER<NAMLST <X>	>
	LIST	>



	DEFINE NAMLST(X)
<	..A=100
	IRP(X)<DO(\..A,X)>
	..A=..A-1
	IRP(X)<UNDO(\..A)>
	PURGE	..A	>



	DEFINE DO(I,J)
<	..K'I=J
	..A=..A+1	>



	DEFINE UNDO(I)
<	XLIST
	POP	P,..K'I
	..A=..A-1
	PURGE	..K'I
	LIST	>



	DEFINE	JUSTIFY		;JUSTIFY THE OUTPUT & RESET T5
<	PUSHJ	P,JUSTFY	;DO TYPE COMMAND OUTPUT JUSTIFICATION>



	SALL			;SUPPRESS ALL MACRO EXPANSIONS
	DEFINE NAMES<
	XLIST
	C	ACCEPT,ACCEPT
	C	CHARAC,CARRAY
	C	CONTIN,CONTIN
	C	DDT,DDT
	C	DIMENS,DIM
	C	DOUBLE,DUBLE
	C	GROUP,GROUP
	C	GOTO,GOTO
	C	HELP,HELP
	C	LOCATE,Q
	C	MODE,MODE
	C	NEXT,NEXT
	C	OPEN,OPEN
	C	PAUSE,PAUSE
	C	REMOVE,RESET
	C	START,START
	C	STOP,EX.
	C	STRACE,TRACE
	C	TYPE,DISPLA
	C	WHAT,WHAT
	LIST
>

SUBTTL	INITIALIZATION

; Below are all valid entry points to FORDDT except for the entry
; to FORDDT caused by a PAUSE.  The PAUSE entry is a JSR into the table
; at BP1. This table's index is a function of the breakpoint number.
; From there a JSA to BCOM is performed.


; This entry point is used when stepping through a user program
; using the NEXT command.  If a NEXT has been issued, PUSHJ P,STEP4
; will be placed in FDDT..  An XCT FDDT. is performed at the beginning
; of each executable source statement if the /DEBUG:TRACE option was used.

FDDT.:	JFCL			;DEFAULT TO NO TRACE  MODE
				;OTHERWISE PUSHJ P,STEP4 TO TRACE


; This entry point should be used for reentering FORDDT from DDT.
; The DDT command %FDDT<ESC>G should be used.

%FDDT:				;[176] ADD THIS ENTRY POINT FROM DDT
	JSR	SAVE		;[176]SAVE USERS ACS
	PUSHJ	P,REMOVB	;[176]REMOVE PAUSES
	JRST	MODRT2		;[176]Re-enter(DDT only...& skip reset of mode)

;[174]%FDDT:				;[125] ADD THIS ENTRY POINT FROM DDT
.F10:	JSR	SAVE		;SAVE USERS ACS
	PUSHJ	P,REMOVB	;REMOVE PAUSES
	JRST	MODRET		;DO A RE-ENTER - FOR DDT ONLY


; A user may CALL FORDDT from his FORTRAN program.  This will
; fake a breakpoint.  FORDDT must have been run previously, as
; when DEBUG PROG.FOR is used, before the user may call this
; routine.  A CONTINUE may subsequently be used to reenter the
; user program.

FORDDT:				;[145] 'CALL' HERE FROM FORTRAN USER PROG
	POP	P,BP0		;[145] FAKE JSR TO GET RETURN ADDRESS
	SETOM	BP0FLG		;[145] REMEMBER WE WERE 'CALL'ED
	JRST	BP0+1		;[145]


;[317] The Tops-20 entry vector
ENTVEC:	JRST	SFDDT		;[317] Normal start address
REENT.::JRST	RE.ENT		;[317] REENTER address
	Z			;[317] Reserved for user

; This is the entry point when FORDDT is first run.  All
; initialization procedures are performed, including a call
; to FOROTS' RESET.

SFDDT:
	MOVE	P,[IOWD PDSIZ,PDL] ;[327] Stack for use during setup
IFE TOPS20,<
	MOVEI	T5,RE.ENT	;AND SET UP THE RE-ENTER ADDRESS
	MOVEM	T5,.JBREN	;[317]
>
IFN TOPS20,<
	SETZM	EXTEND		;[300] clear the extend flag
	XMOVEI	T5,.		;[317] Are we in
	TLNE	T5,-1		;[317]   non-zero section?
	SETOM	EXTEND		;[300] yes, set the flag
	SKIPE	EXTEND		;[327] In non-zero section?
	HLL	P,T5		;[327] Yes--Set section in stack pointer
>

	JSR	SAVE		;[145] SAVE THE WORLD
	PUSHJ	P,REMOVB	;REMOVE ANY STANDING PAUSE REQUESTS
	LINE
	TYPE(STARTING FORTRAN DDT)
	LINE

	JSP	16,FINIT.##	;[325] INITIALISE THE FOROTS SYSTEM
	0,,0			;[142] DUMMY RESET ARG
	MOVEM	P,SAVACS+17	;[326] So that RESTOR has something
	PUSHJ	P,SETLST	;[320] Set up symbol vector
IFN TOPS20,<
	SKIPE	EXTEND		;[300] non-zero section?
	 JRST	FORDX1		;[300] yes, get extended addrs symbol table
>
	HRRZ	T5,.JBSA	;REMEMBER THE START ADDRESS
	MOVEM	T5,JOBSA	; AND THE
	MOVE	T5,.JBSYM	;  SYMBOL TABLE DETAILS AT THE-
	MOVEM	T5,JOBSYM	;    TIME FORDDT IS ENTERED
ife tops20,<			;This hack doesn't work under TOPS20
	MOVE	T5,[XWD -1,3]	;GET THE CURRENT JOB
	GETTAB	T5,		;   NAME
	 CAIA			;DON'T PANIC IF NO JOB NAME
	MOVEM	T5,JOBNAM	;AND SAVE,
				;THIS WILL SERVE TO DETECT OVERLAYS
	SETZM	TTYLC		;[151] DEFAULT TO DON'T FLAG LOWERCASE
	MOVNI	P2,1		;[151] GET CURRENT JOB'S CONTROLLING TERMINAL UDX
	TRMNO.	P2,		;[151]
	  JRST	FORDD2		;[151] ERROR. DEFAULT TO NO FLAGGING OF LOWERCASE
	MOVEI	P1,.TOLCT	;[151] TRMOP. FUNCTION TO READ LOWERCASE SETTING
	MOVE	T5,[2,,P1]	;[151] SET UP TRMOP. CALL
	TRMOP.	T5,		;[151]
	  JRST	FORDD2		;[151] ERROR. ASSUME LOWERCASE. DOESN'T FLAG LC
	MOVEM	T5,TTYLC	;[151] STORE THE SETTING
FORDD2:				;[151]
> ;END OF IFE TOPS20
IFN TOPS20,<
	JRST	FORDX2		;[300] skip this stuff if not extended
FORDX1:	MOVEI	T1,ESEFIW	;[320] GET THE NON-ZERO VALUE
	MOVEM	T1,EFIWAD	;[313] STORE IT FOR LATER USE
	MOVEI	T1,ESDIEB	;[313] GET THE NON-ZERO VALUE
	MOVEM	T1,DIEBAD	;[313] STORE IT FOR LATER USE
	XHLLI	T1,.		;[313] SECTION # IN LH
	HRLZI	T2,-NBP		;[313] SETUP LOOP CNTR
FORDXL:	HLLM	T1,SZEFIW(T2)	;[313] STORE SECTION #
	AOBJN	T2,FORDXL	;[313] INCR AND LOOP
FORDX2:
>
	XMOVEI	T5,[JRST RET]	;[313] GUARD AGAINST CONTINUE AFTER CNTRL C
	MOVEM	T5,PROC0	;[313] STORE FULL ADDRESS
	MOVEI	T5,1		;RESET THE INITIAL TRACE VALUE
	MOVEM	T5,STPVAL	;   TO ONE
	SETZM	STARTU		;[316] User must 'START'
	PUSHJ	P,RE.NTR	;ALLOW A RE-ENTER TO WORK
	SETOM	ESCAPE		;NO ^C'S SO ALLOW ESCAPES TO FOROTS
;	RE - ENTER ENTRY

RE.RET:				;[326] Removed SETPDL
	SKIPIF	(CEXIT.)	;
	   SETZM T5		;NO CLUDGE CONECTIONS IN THIS PROG
	HRRM	T5,HELLO	;SET UP FOR HELLO MACRO DETECTOR
	MOVE	T0,STKYFL	;REINSTATE THE FLAG REGISTER
				;[137] This routine provides g-floating
				;[137]  capability to those programs
				;[137]  compiled with the /gfl switch.
	TRZ	T0,GFLOAT	;[137] Default to d-floating mode.
	TRO	T1,FGLONL	;[137] Search for globals only in sym table
	MOVE	S3,[SQUOZE 0,..GFL.] ;[137] Store "..GFL." in SYM for EVAL
	MOVEM	S3,SYM
	PUSHJ	P,EVAL		;[137] Search symbol table for "..GFL."
	   JRST	FSET		;[137] Not found, mode is d-floating; done
	MOVE	T0,STKYFL	;[137] Found, reinstate the flag reg(in case
				;[137]  T0 was modified by EVAL)
	TRO	T0,GFLOAT	;[137] Set GFLOAT flag to get g-floating
	MOVEM	T0,STKYFL	;[137] Update sticky flag store.
FSET:	MOVSI	T5,(JFCL)	;RESET THE TRACE ENTRY
	MOVEM	T5,FDDT.	;
	MOVE	T5,M2.F		;GET THE FOROTS FIN CALL
	MOVEM	T5,M2.I		;RE-INSTATE IN FORMAT - AFTER COMPLEX INPUT

;	SET THE DEFAULT TYPING FORMAT TO FLOATING  -  ALSO SET STKYFL

MODRET:	HRRZI	T5,F.		;SET UP TO TYPE FLOATING FORM
	MOVEM	T5,MODFLG	;SAVE AS THE STANDARD DEFAULT
MODRT2:	SKIPE	STARTU		;[402] See if already started
	JRST	RET		;YES - SO NOT FIRST TIME THROUGH

	PUSHJ	P,MAINF		;[315] Find the main program
	  CAIA			;[315] Not found
	JRST	BEGIN3		;[315] Name is in T4

BEGIN2:	 PUSHJ P,GETPRG		;NOT FOUND - GET THE MAIN PROGRAM NAME
	  MOVE	T4,[SQUOZE 0,MAIN.];No name -- Use MAIN. as default
				;DEFAULT MAIN PROG NAME IS MAIN.
BEGIN3:	STSYM	T4,PRGNAM	;[402] Store symbol into PRGNAM
	MOVEM	T4,SYM		;SET SO SETNAM CAN OPEN THE MAIN PROGRAM
	PUSHJ	P,SETNAM	;'OPEN' THE MAIN PROGRAM
SUBTTL	USER INPUT

RET:	MOVE	P3,MODFLG	;[323] Get the default settings into
	HRLS	P3		;[323]   both halves
	AND	T0,[STIKYS]	;MAKE SURE WE SAVE THE GOOD FLAGS
	MOVEM	T0,STKYFL	; IN THE STICKY STORE
	SETZI	T1,		;RESET THE TEMPORARY FLAGS
	SKIPGE	TERMK		;END OF LAST LINE SEEN?
	PUSHJ	P,CLRLIN	;CLEAR OUT THE REST OF USERS LINE
				;[325] Removed SETPDL
	CLEARM	CURGRP		;CLEAR CURRENT GROUP NUMBERS
	CLEARM	SYL
	CLEARM	MATHSM
	CLEARM	SYM
	CLEARM	DEN
	CLEARM	RANGE
	CLEARM	GETCHR
	CLEARM	SECSAV		;CLEAR SECTION NAME SAVED
ife tops20,<
	SKPINL			;CLEARS THE EFFECT -
	JFCL>			;   OF ^O, end of conditional
ifn tops20,<
	push	p,T1		;save T1
	push	p,T2		;save T2
	hrrzi	T1,.priou	;get terminal output designator
	rfmod%			;get terminal JFN word
	tlz	T2,(tt%osp)	;clear ^o effects
	hrrzi	T1,.priou	;get terminal output designator
	sfmod%			;set new JFN word
	pop	p,T2		;restore T2
	pop	p,T1>		;restore T1, end of conditional
	LINE
	PUSHJ	P,OVRLAY	;HAS AN OVERLAY OCCURED

	pushj	p,readcm	;prompt and read user command
	JUMPE	T3,RET		;NO SIGNIFICANT INFORMATION

	MOVEM	T3,COMAND	;SAVE USER COMAND
	JUMPN	T2,BADSYN	;COMMAND TERMINOLOGICAL INEXACTITUDE

	SKIPGE	T2,TERMK	; SPACE IS NOT EOL
	TLZA	T0,EOL		;CLEAR EOL FLAG
	TLO	T0,EOL		;SET EOL FLAG
				;NOW SEE WHAT USER WANTS!
;	ENTER WITH SIXBIT USER COMMAND IN T3
;
;	EXIT TO COMMAND IF RECOGNISED AND UNIQUE, OTHERWISE
;	DISPATCH TO UNKNOWN OR COMMAND NOT UNIQUE ROUTINES
;	N.B.    T2 = DISPATCH ADDRESS
;		T3 = USER COMMAND NAME
;		T4 = OFFICIAL COMMAND NAME

COMCON:	MOVE	T3,COMAND	;GET USER COMMAND IN T3
	MOVEI	S2,DISP		;START OF DISPATCH TABLE
	MOVE	S3,[XWD -DISPL,COMTAB]	;STEP THRO COMMANDS
	MOVE	T2,T3		;COPY USER COMMAND
	SETOI	T5,		;SET ALL ONES MASK
	LSH	T5,-6		;SET MASK IN
	LSH	T2,6		;      T5 TO LENGTH OF
	JUMPN	T2,.-2		;              USER COMMAND
	MOVEI	P4,0		;NO. OF NON-UNIQUE OCURRENCES
	MOVE	T2,S3		;AOBJN FOR COMMAND TABLE
COMLP:	MOVE	T4,(T2)		;GET NEXT COMMAND
	TDZ	T4,T5		;MASK OUT FOR MATCH WITH USER
	CAMN	T3,(T2)		;EXACT MATCH?
	JRST	COMFND		; YES - THIS IS IT

	CAME	T3,T4		;MATCH SO FAR
	JRST	COMNEQ		;NO MATCH AT ALL

	AOS	P4		;FLAG ANOTHER MATCH
	HRL	S2,T2		;MARK LAST INDEX
COMNEQ:	AOBJN	T2,COMLP	;TRIED ALL KNOWN COMMANDS?

	JUMPN	P4,.+2		;UNKNOWN?
	AOS	T2		;SET FOR NONE UNIQUE
	CAIN	P4,1		;WAS THE COMMAND UNIQUE?
	HLR	T2,S2		;YES - REMEMBER THIS INDEX
	MOVEI	S2,DISP		;[303] BASE OF DISPATCH TABLE, AGAIN
COMFND:	MOVE	T4,(T2)		;SAVE OFFICIAL COMMAND NAME
	SUBI	T2,(S3)		;INDEX DOWN DISPATCH
	ADDI	S2,(T2)		;INDEX INTO DISPATCH
	MOVE	T2,(S2)		;GET DISPATCH ADDRESS
	JRST	@T2		;     DISPATCH
	SUBTTL	COMMAND DECODER



	DEFINE C(A,B)
<	SIXBIT/A/	>


COMTAB:	XLIST		;NAMES
	NAMES
	LIST

DISPL=.-COMTAB




	DEFINE C(A,B)
<	IFIW	B	>	;[300]


DISP:	XLIST		;HANDLERS
	NAMES
	EXP	NOTUNQ		;COMMAND NOT UNIQUE
	EXP	ERROR		;UNKNOWN COMMAND
	LIST
SUBTTL	COMMAND SERVICE MODULES


;STRACE - SUBROUTINE CALLING SEQUENCE TRACE (WALK-BACK)

TRACE:	SKIPN	SAVACS+17	;[203] HAS USER INITIALIZED FOROTS?
	 JRST	RET		;[203] NO, JUST RETURN
	SKIPN	STARTU		;[316] User must
	 JRST	ERR4		;[316]   initialize with START
	SKIPN	ESCAPE		;ARE WE ALLOWING ESCAPES
	JRST	ERR30		;NO TRACE
	MOVE	T2,16		;[325] SAVE FORDDT REG 16??
	MOVE	16,SAVACS+16	;[147] - GET FOROTS REG 16
	PUSHJ	P,TRACE.##	;[143] DO A FORTRAN TRACE
	MOVE	16,T2		;[325] Restore Reg 16
	JRST	RET		;END OF TRACE
;	START FUNCTION

START:	MOVSI	T5,(JFCL)	;RESET THE TRACE ENTRY
	MOVEM	T5,FDDT.	;
	PUSHJ	P,CLRLIN	;FLUSH OUT LINE BUFFER
START2:	LDSYM	T5,PRGNAM	;[402]GET THE MAIN PROGRAM NAME
	MOVEM	T5,SYM		;SAVE FOR EVAL
	TRNE	T1,LNAME	;[402]IS LONG PROGRAM NAME FLAG SET?
	 JRST	STRT2B		;[402]  YES

	MOVSI	T2,GLOBAL	;[157]Global prefix
	MOVEM	T2,SYMASK	;[157]Reset mask in case it's been munged
	PUSHJ	P,FINDG		;No, Find the start of short name
	 JRST	ERR8		;NO START ADDRESS		
 	JRST	STRT2C		;[402]

STRT2B: MOVSI	T2,LPNAME	;[402] global/program name in sec. symbol tab
	MOVEM	T2,SYMASK	;[402] Reset mask in case it's been munged
	PUSHJ	P,FINDLG	;[402]
	 JRST	ERR8		;[402]

STRT2C:	MOVEM	T5,STARTU	;[316] Save for go
	MOVEM	T0,STKYFL	;MAKE THE FOROTS FLAG STICK
	PUSHJ	P,RE.NTR	;ALLOW RE-ENTERS AGAIN
	PUSHJ	P,INSRTB	;PUT IN BREAKPOINTS	
	HRRZI	T0,FO$GBA	;[332] HAVE FOROTS RETURN BREAK ADDRESS
	PUSHJ	P,FOROP.	;[325]   IN T0

	MOVE	T5,@T0		;[332] IF @T0=0 THEN NO PAUSE ON ERROR
	JUMPE	T5,START3	;[332] 
	MOVEM	T0,TEM10	;[340] SAVE BREAK ADDRESS
	JSP	L,FINIT.	;[332] INITIALIZE FOROTS
	JFCL			;[332]
	XMOVEI	T4,PAUERR	;[332] RESET PAUSE ON ERROR FLAG
	MOVEM	T4,@TEM10	;[340] STORE VIA BREAK ADDRESS

	XMOVEI	16,ERRARG	;[404] Biggest integer
	PUSHJ	17,ERRSET	;[404] Set number of errors allowed

START3: JSP	T5,RESTORE
	SETZI	16,		;MAKE F40 STRACE WORK	
	JRST	@STARTU		;[316] Start user program

;	GOTO  STATEMENT LABEL OR SYMBOL CONTENTS

GOTO:	JUMPL	T0,START4	;NO ARGUMENTS = START AT LAST GOTO
	PUSHJ	P,SYMIN		;GET USERS ARGUMENT
	  JRST	ERR6		;NONE SUCH
	  CAIA			;NUMERIC
	MOVE	T5,(T5)		;GET CONTENTS
	PUSHJ	P,ONFORM	;ON A FORMAT STATEMENT?
	  JRST	ERR36		;YES - ERROR
	PUSHJ	P,CHKADR	;DO A CHECK OF USER AREA
	 JRST	ERR31		;ILLEGAL - ERROR
	 JFCL
	CAIA
START4:	MOVE	T5,STARTU	;[316] Get start address

	SKIPN	STARTU		;[316] Any start address?
	 JRST	ERR4		;[316] No address - Refuse START and GOTO

	MOVEM	T5,GOLOC	;SET UP FOR EXTASK
	MOVE	T2,SAVACS+17	;[325] Get user P
	MOVSI	T5,(POPJ P,)	;HAVE WE STOPPED AFTER A NEXT?
	LDB	T3,[POINT 23,LEAV,35]	;[303] PICK UP AC,I,E
	TLO	T3,400000		;[303] MAKE THIS AN IFIW
	CAME	T5,@T3		;[303]Have we stopped after NEXT?
	 SKIPA	T5,GOLOC	;[303] NO, so skip the pop and reload T5
	 POP	T2,T5		;[170]YES, POP the user return addr
	MOVEM	T2,SAVACS+17	;[325] And reset his P
	SKIPN	ESCAPE		;HAS A RE ENTER BEEN DONE?
	JRST	ERR30		;YES - ONLY SOME FORM OF CONTINUE ALLOWED
	PUSHJ	P,ONFORM	;SKIP IF NOT A FORMAT AT (T5)
	  JRST	ERR24		;NOT ALLOWED
	PUSHJ	P,RE.NTR	;ALLOW RE-ENTERS AGAIN
	MOVSI	T5,(JFCL)	;RESET THE TRACE ENTRY
	MOVEM	T5,FDDT.	;
	PUSHJ	P,EXTASK	;TRANSFER TO EXTERNAL TASK
;	OPEN

OPEN:	JUMPL	T0,OPEN2	;ASSUME MAIN PROG IF JUST 'OPEN'
	PUSHJ	P,TTYIN		;WHAT NEXT
	JUMPN	T2,BADSYN	;MUST BE LINE END DELIMITER
	JUMPE	T3,BADSYN	;MUST HAVE SOME CHARACTERS
	PUSHJ	P,VALID		;CHECK VALIDITY & GET RAD50 IN T4
OPEN3:	MOVEM	T4,SYM		;SAVE FOR 'OPEN'
	PUSHJ	P,SETNAM	;DO THE OPEN
	JRST	RET		;WHAT NEXT

OPEN2:	LDSYM	T4,PRGNAM	;[402]GET FORTRAN MAIN PROG NAME
	JRST	OPEN3		;OPEN THIS

;	DDT FUNCTION

IFE TOPS20,<			;[114] TOPS-10 HAS UDDT LOADED, SO IT'S IN
				;[114] SYMBOL TABLE
DDT:	PROGIF	(UDDT)		;IS DDT LOADED?
	   JRST	MAPDDT		;[115] NO, GO GET VMDDT
	MOVE	T5,1(T2)	;[321] The address
	HRRZM	T5,GOLOC	;[333] just the RH
	JRST	EXTASK		;TRANSFER TO EXTERNAL TASK

MAPDDT:	MOVE	T5,[.PAGCA,,700] ;[115] CHECK FOR PAGE 700
	PAGE.	T5,		;[115] IS IT THERE?
	  JRST	ERR11		;[115] NO PAGE UUO, NO VMDDT
	TLNN	T5,(PA.GNE)	;[115] DOES PAGE EXIST?
	  JRST	GODDT		;[115] YES, GO TO IT

	MOVEM	17,MRGACS+17	;[115] MERGE WRECKS ALL ACS
	MOVEI	17,MRGACS	;[115] SO SAVE THEM
	BLT	17,MRGACS+16
	MOVEI	T5,['SYS   '	;[115] SET UP TO GET DDT
		   'VMDDT '
		    EXP 0,0,0,0]
	MERGE.	T5,		;[115] GET IT
	  JRST	[MOVSI 17,MRGACS ;[115] CAN'T, TOUGH
		 BLT 17,17
		 JRST ERR11]
	MOVE	T5,[775777,,700000] ;[122] SET .JBDDT
	SETDDT	T5,		;[122]
	MOVSI	17,MRGACS	;[115] PUT ACS BACK
	BLT	17,17

GODDT:	MOVEI	T5,700000	;[115] SET ADDRESS
	MOVEM	T5,GOLOC
	JRST	EXTASK		;[115] GO CALL EXTERNAL TASK
>

IFN TOPS20,<

DDT:	MOVE	T1,[.FHSLF,,770]	;[114] LOOK AT PAGE 770
	RPACS%			;[114] GET PAGE ACCESS BITS
	TXNN	T2,PA%PEX	;[114] DOES PAGE 770 EXIST?
	  JRST	MAPDDT		;[114] NO, GO MAP IN UDDT.EXE
	MOVE	T1,770000	;[300] GET DDT ENTRY VECTOR
	CAMN	T1,[JRST 770002] ;[114] IS IT REALLY DDT?
	  JRST	GODDT		;[114] YES, JUMP TO IT

MAPDDT: 
	MOVEI	T1,.FHSLF	;[114] GET ENTRY VECTOR LOC
	SKIPE	EXTEND			;[300] IS THIS AN EXTENDED PROG?
	JRST	[XGVEC%			;[300] YES, GET X-ENTRY VECTOR
		 DMOVEM	T2,DDTVEC	;[300] SAVE THE DDT ENTRY VECTOR
		 JRST	MAPDD2]		;[300] SKIP THE NON-EXTENDED VERSION
	GEVEC%			;[300] GET NON-EXTENDED ENTRY VECTOR
	MOVEM	T2,DDTVEC	;[300] STORE IT
MAPDD2:				;[300] COMMON JUNCTURE
	MOVX	T1,GJ%SHT+GJ%OLD	;[114] SHORT FORM, FILE MUST EXIST
	HRROI	T2,[ASCIZ /SYS:UDDT.EXE/] ;[114] DDT
	GTJFN%			;[114] FIND IT
	  ERJMP ERR11		;[114] NOT THERE, CAN'T HELP
	HRLI	T1,.FHSLF	;[114] MAP INTO THIS FORK
	TRO	T1,GT%ARG!GT%NOV ;[300] LIGHT SOME FUNCTION CODE BITS
	XMOVEI	T2,GTBLK	;[300] ARG BLOCK FOR GET%	
	HLRZM	T2,GTBLK+.GBASE	;[300] STORE CURRENT SECTION NUMBER
	GET%			;[114] READ IN DDT
	  ERJMP	ERR11		;[114] CAN'T
	DMOVE	T1,.JBSYM	;[300] GET SYMBOL TABLE PTRS FROM SAME SECTION
	MOVEM	T1,@770001	;[114] STORE FOR DDT
	MOVEM	T2,@770002
	MOVEI	T1,.FHSLF	;[114] THIS FORK
	SKIPE	EXTEND			;[300] ARE WE RUNNING EXTENDED?
	 JRST	[DMOVE	T2,DDTVEC	;[300] YES, RESTORE ENTRY VECTOR
		 XSVEC%			;[300] SET THE ENTRY VECTOR
		 JRST	GODDT]		;[300] JOIN COMMON CO
	MOVE	T2,DDTVEC	;[300] RESTORE ENTRY VECTOR
	SEVEC%			;[114] SET ENTRY VECTOR

GODDT:	TYPE	(<To return to FORDDT, type "%FDDT<ESC>G">)
	LINE
	XMOVEI	T2,770000	;[300] GET DDT START ADDRESS
	MOVEM	T2,GOLOC	;[114] SAVE
	JRST	EXTASK		;[114] GO CALL EXTERNAL TASK

>;[114] END IFN TOPS20

;	EXIT FUNCTION

EX.:	JUMPGE	T0,EX.R		;IS THE USER REQUESTING A MONITOR RETURN
	SKIPN	STARTU		;[316] NO - SEE IF A START HAS BEEN DONE
	 JRST	EX.A		;[316] NO START, DO NORMAL EXIT

	PUSHJ	P,CHKIWI	;[211] RECURSIVE IO IF WE CALL EXIT.?
	 JRST	EX.R2		;[211] YES, SIMULATE A STOP/RETURN
	SETZM	STARTU		;[316] No CONTINUE or REENTR
	SETZM	TEM		;SET UP ARG BLOCK
	SETZM	TEM1		;  TO EXIT FOROTS
	PUSHJ	P,INSRTB	;REPLACE PAUSES
	JSP	T5,RESTORE	;RESTORE USERS ACS
	XMOVEI	L,TEM		;[300] GET EXIT ARGBLOCK
	PUSHJ	P,EXIT.##	;[143] DO A FOROTS EXIT

EX.R:	PUSHJ	P,TTYIN		;GET NEXT INPUT
	JUMPN	T3,BADSYN	;LOOKING FOR / - NOCHARACTERS ALLOWED
	JUMPE	T2,BADSYN	;BETTER BE /
	CAIE	T2,"/"
	JRST	BADSYN		;SORRY
	PUSHJ	P,TTYIN		;LOOK FOR RETURN
	JUMPN	T2,BADSYN	;NO MORE CHARACTERS ALLOWED
	JUMPE	T3,BADSYN	;NO CHARACTERS IN INPUT????
	LSHC	T2,6		;GET FIRST CHARACTER
	CAIE	T2,'  R'	;LOOK FOR 'RETURN' - IMPLIED BY R
	JRST	BADSYN		;WE DONT UNDERSTAND ANY OTHER CHARACTER
EX.R2:				;[211]
ife tops20,<
	CALLI	1,12>		;DO A MONRET
ifn tops20,<
	haltf%>			;do a monret
	JRST	RET		;CONTINUE'S ALLOWED
ife tops20,<
ex.a:	exit>			;do a non-returnable return
ifn tops20,<
ex.a:	reset%			;close files, etc.
	haltf%			;stop
	jrst	ex.a>		;and don't permit continues
;	ROUTINE OVERLAY - TO DETECT WHEN THERE HAS BEEN AN APPARENT
;	OVERLAY OF THE PROGRAM.	THIS IS DONE BY OBSERVING THE
;	VALUES OF .JBSA AND .JBSYM EVERY RETURN TO USER MODE
;[320] OVRLAY through OVRL2 rewritten
OVRLAY:
IFN TOPS20,<
	SKIPE	EXTEND		;[321] Don't want this if
	 POPJ	P,>		;[321]   we are in non-zero section
	PUSH	P,T4
	SETZ	T5,		;Becomes non-zero if difference found
	MOVE	T4,.JBSYM	;Lowseg symbol pointer
	EXCH	T4,JOBSYM	;Save new symbol pointer
	JUMPE	T4,OVRL1	;Old value is zero if not inited
	CAMN	T4,JOBSYM	;Compare to last known value
	 JRST	OVRL1		;No change
	PUSHJ	P,SETLST	;Reset the symbol tables
	MOVEI	T5,1		;Remember that we did that

OVRL1:	HRRZ	T4,.JBSA	;The start address
	EXCH	T4,JOBSA	;Swap with previous value
	JUMPE	T4,OVRL2	;Exit if old start not set up
	CAME	T4,JOBSA	;Has this changed?
	 AOJ	T5,		;Yes

OVRL2:	POP	P,T4		;Restore register
	SKIPN	T5		;Any change?
	 POPJ	P,		;No - All is well

	LINE
	TYPE(<%FDTPOV Program overlayed>)
ife tops20,<			;this doesn't work under TOPS20
	MOVE	T5,[XWD -1,3]	;SET FOR PROGRAM NAME
	GETTAB	T5,>		;FIND THE CURRENT NAME,end of conditional
	JRST	OVRL3		;SECRETIVE TYPE??
	SKIPN	JOBNAM		;HAS ANY NAME BEEN STORED?
	MOVEM	T5,JOBNAM	;NO - REMEMBER THIS
	CAMN	T5,JOBNAM	;OVERLAYED BY SYSTEM WHICH DOSN'T CHANGE NAME?
	JRST	OVRL3		;YES

	MOVEM	T5,JOBNAM	;REMEMBER NEW NAME
	TYPE( by )
	PUSHJ	P,SIXBP		;OUTPUT PROGRAM NAME

OVRL3:	TYPE( ***)
	LINE
	SKIPN	T5,JOBOPC	;ANY RE-ENTER ADDRESS?
	MOVE	T5,BCOM		;IF NOT BCOM SHOULD BE USER BREAK
	HRRZ	T5,T5		;JUST THE ADDRESS THANK YOU
	PJRST	WHERE		;TELL WHERE - END OF OVERLAY
;	RE-ENTER LOGIC

RE.ENT:				;[325] Removed SETPDL
	SKIPE	REENTR		;ARE WE ALREADY REENTERED?
	 JRST	ER.ENT		;YES. REPORT
IFE TOPS20,<			;[300]
	MOVEM	P,SAVLOC	;FREE UP A SPARE REG
	HRRZ	P,.JBOPC	;GET THE BREAK P.C.
>				;[300]
	SKIPE	ESCAPE		;RE-ENTERS ALLOWED ONCE(SEE ER.ENT)
	JRST	RE.BRK		;DONT DESTROY USER PROFILE
IFE TOPS20,<			;[300]
	MOVE	P,SAVLOC	;RE-INSTATE THE OLD REG
>				;[300]
	JSR	SAVE		;SAVE THE EXTERNAL PROG STATUS
	PUSHJ	P,REMOVB	;AND REMOVE THE PAUSES
IFE TOPS20,<			;[300]
	MOVE	T5,.JBOPC	;GET THE PROG P.C.
	MOVEM	T5,JOBOPC	;STORE AND FLAG THAT WE ARE HANDLING RE-ENTER
	MOVEM	T5,JOBBRK	;SAVE THE JOB BREAK LOCATION
	MOVEM	T5,STARTU	;[316] ALLOW CONTINUES TO WORK
>				;[300]
	SETOM	REENTR		;SET FLAG THAT WE HAVE REENTERED
	SKIPE	PRGNAM		;[315] Do we have a main program?
	JRST	RE.LOC		;YES

	PUSHJ	P,MAINF		;[315] Find the main program
	 JRST	RE.LOC		;[315] Not found
	STSYM	T4,PRGNAM	;[402] Store main program name
	PUSHJ	P,SETNAM	;OPEN MAIN PROG

;	HERE TO DISPLAY THE CURRENT SUSPEND POINT
;	JOBBRK IS THE BREAK - NEED NOT = JOBOPC

RE.LOC:				;CLEAR THE OUTPUT BUFFER
ife tops20,<
	clrbfo
>
ifn tops20,<
	push	p,t1
	hrrzi	t1,.priou
	cfobf%
	pop	p,t1
>
	TYPE([ Program suspended )
	HRRZ	T5,JOBBRK	;SET UP THE ACTUAL SUSPEND POINT
ifn tops20,<			;[335]
	SKIPN	EXTEND		;[334] IF REENTERING AND PROGRAM IS IN EXTENDED
	JRST	RE.LO2		;[334]   SECTION THEN JUST SAY REENTERING FROM
>				;[335]
	TYPE 	(from FORDDT)	;[334]   FORDDT SINCE WE CAN'T GET ADDRESS
	LINE			;[334]
	SKIPA			;[334]
RE.LO2:	PUSHJ	P,WHERE		;TELL USER WHERE HE IS SUSSPENDED
	TYPE(Open section: )

	LDSYM	T5,OPENED	;[402]WHAT IS THE CURRENTLY OPEN SECTION
	PUSHJ	P,SPT1		;TYPE THAT
	TYPE	( ])
	MOVE	T0,STKYFL	;RESET THE FLAG REGISTER
	JRST	RET		;RETURN TO NORMAL WORKING
ER.ENT:	JRST	RE.LOC		;INDICATE THAT WE ARE ALREADY HANDLING A REENTER

RE.NTR:	SETZM	REENTR		;ALLOW REENTERS AGAIN
	SETZM	JOBOPC		;CLEAR THE RE-ENTER IN PROGRESS FLAG
	SETZM	ESCAPE		;DO NOT ALLOW ESCAPES FROM FORDDT
	POPJ	P,

RE.BRK:				;[325] Removed SETPDL
	SKIPN	STARTU		;[316] Has a start been done?
	 JRST	RE.RET		;[316] No - Return to FORDDT user mode

	MOVE	T5,BCOM		;GET THE PAUSE POINT
	MOVEI	T5,-1(T5)	;CORRECT FOR JSA
	ANDI	T5,-1		;JUST THE ADDRESS PORTION
	MOVEM	T5,JOBBRK	;SAVE THE JOB BREAK FOR RE.LOC
	JRST	RE.LOC		;DISPLAY PROGRAM EXECUTION SUSPENSION


;	ROUTINE TO DISPLAY WHERE THE PROGRAM IS SUSPENDED

WHERE:
IFN TOPS20,<
	SKIPE	EXTEND		;[300] CHECK IF WE ARE RUNNING EXTENDED
	  JRST	[TYPE(in extended section)
		 JRST	RE.L2]	;[300] YES, SAY SO, AND CONTINUE
>
	SKIPN	.JBHRL		;SKIP IF WE HAVE A HIGH SEG.
	JRST	RE.L2

	CAMLE	T5,.JBREL	;ARE WE SUSPENDED OVER THE LOW SEG.
	JRST	[TYPE(in high segment)
		JRST	RE.L2]
	TYPE(in low segment)
RE.L2:	TYPE( at )
;[326]	TLO	T0,FGLSNM	;GLOBALS ARE OK
	PUSHJ	P,LOOK		;DO A SYSMBOL 'LOOK'-UP
	  JRST	[TYPE( an unknown location)	;[300] SAY WE DON'T KNOW
		 JRST RE.L3]	;[300] AND PROCEED
	  CAIA			;NOTHING TYPED
	JRST	RE.L3A		;FOUND AND TYPED
	MOVEM	T5,TEM		;REMEMBER NEAREST REFERENCE
	PUSHJ	P,SPT		;TYPE THE SYMBOL
	TYPE( + )
	MOVE	T5,TEM		;GET THE OFFSET
	PUSHJ	P,TYP4		;DISPLAY AS OCTAL
RE.L3A:	SKIPN	PNAMSV		;DID WE FIND A SECTION NAME
	JRST	RE.L3		;NO
	TYPE( in )
	LDSYM	T5,PNAMSV	;[402]GET THE SECTION NAME
	PUSHJ	P,SPT1		;DISPLAY THAT
RE.L3:	LINE			;
	POPJ	P,		;
;	PAUSE LOGIC

PAUSE:	JUMPL	T0,PSEALL	;DISPLAY ALL PAUSES IF NO ARGUMENTS
	TRO	T1,FGLONL	;FIND GLOBAL SYMBOL ONLY
	SETZM	ONFLG		;[325]
	PUSHJ	P,SYMIN		;GET THE NEXT SYMBOL IN SYM
	   JRST	ONCHK		;[325]NONE SUCH!
	   JRST PAUS11		;[332]	;STATEMENT # FROM USER
	JRST	PAUS10		;SYMBOL - MEANS STOP AT ROUTINE
ONCHK:	CAME	T3,[SIXBIT/ON/] ;[325]
	JRST	ERR6		;[325] INVALID SYMBOL
	JRST	PAUS2		;[325]
PAUS11:	MOVEM	T5,TEM1		;[313] SAVE POINTER TEMPORARILY
	SETZM	TEM		;CLEAR CONDITIONAL REQUEST
	SKIPL	TERMK		;WAS THAT ALL THE USER WANTED?
	JRST	PAUS5		; YES

	PUSHJ	P,TTYIN		; NO,GET MOR
	JUMPN	T2,BADSYN	;DO WE HAVE A LEGAL DELIMITER
	JUMPE	T3,PAUS5	;[136] DID WE REALLY GET ANYTHING?
	SKIPN	ONFLG		;[325]
	JRST	TYPCHK		;[325] NO SUBROUTINE CALLED "ON"
	CAMN	T3,[SIXBIT/ERROR/];[325] 
	JRST	P2OK		;[325] PAUSE ON ERROR
	CAMN	T3,[SIXBIT/ERR/];[325] 
	JRST	P2OK		;[325] 
TYPCHK:	CAMN	T3,[SIXBIT/TYPING/] ;[134] YES, MAYBE A 'TYPING' REQUEST
	JRST	PAUS7		;[134]
	SKIPL	TERMK		;[134] DID WE GET A LINE TERMINATOR?
	JRST	BADSYN		;[134] YES, WRONG PLACE FOR IT
	CAMN	T3,[SIXBIT/AFTER/] ;FORCE USER TO TYPE WHOLE WORD
	JRST	PAUS4		;AFTER REQUESTED
	CAME	T3,[SIXBIT/IF/]	;WAS IT 'IF'?
	JRST	BADSYN		;ANYTHING ELSE MEANS TROUBLE
	TLZ	T0,CONS		;CLEAR CONSTANT SEEN FLAG
	TRO	T1,LGCLEG	;[116] LET EITHER KNOW WE MAY GET LOGICALS
	PUSHJ	P,EITHER	;NUMBER OR SYMBOL SHOULD FOLLOW
	  PUSHJ	P,NUMB		;CONSTANT SEEN
	  MOVEM	T5,COND1	;SAVE CONSTANT
	SKIPL	TERMK		;[134] DID WE GET A LINE TERMINATOR?
	JRST	BADSYN		;[134] YES, WRONG PLACE FOR IT
	CLEARM	COND0		;CLEAR FOR TYPE OF TEST
	TRZE	T1,ISLOGI	;[116] IS IT A LOGICAL CONSTANT
	JRST	[SETZ	T5,		;[116] YES, SET FLAG IN COND0
		TLO	T5,LFTLOG	;[116]
		MOVEM	T5,COND0 	;[116]
		JRST	.+1]		;[116]
	JUMPN	T2,.+2		;DELIMITER?
	PUSHJ	P,GETSKB	;NEXT CHARACTER
	CAIE	T2,"."		;MUST BE . OF .EQ. ETC
	JRST	BADSYN
	PUSHJ	P,TTYIN		;GET SIXBIT STRING
	CAIE	T2,"."		;MUST AGAIN BE TERMINATED BY .
	JRST	BADSYN
	HLRZS	T3,T3		;MORE USEFUL IN RIGHT HALF
	CAIN	T3,'LT '
	JRST	TEST1
	CAIN	T3,'LE '
	JRST	TEST2
	CAIN	T3,'EQ '
	JRST	TEST3
	CAIN	T3,'NE '
	JRST	TEST4
	CAIN	T3,'GT '
	JRST	TEST5
	CAIN	T3,'GE '
	JRST	TEST6
	JRST	BADSYN		;UNKNOWN CONDITION
TEST6:	AOS	COND0		;GE=5
TEST5:	AOS	COND0		;GR=4
TEST4:	AOS	COND0		;NE=3
TEST3:	AOS	COND0		;EQ=2
TEST2:	AOS	COND0		;LE=1
TEST1:	TRO	T1,LGCLEG	;[116] LET EITHER KNOW LOGICALS ARE LEGAL
	PUSHJ	P,EITHER
	  PUSHJ	P,NUMB		;SAVE AS A NUMBER
	  MOVEM	T5,COND2	;SAVE THE LOCATION
	TRZE	T1,ISLOGI	;[116] DID WE GET A LOGICAL CONSTANT?
	JRST	[SETZ	T5,		;[116] YUP, SET COND0 FLAG
		TLO	T5,RHTLOG	;[116]
		ORM	T5,COND0 	;[116]
		JRST	.+1]		;[116]
	MOVE	T5,[JSR	COND]
	MOVEM	T5,TEM		;FORM THE (CONDITIONAL TEST) LOCATION LINK
PAUS5:	SKIPA	T5,[Z 1]	;PROCEDE COUNT=1
PAUS4:	PUSHJ	P,EITHER	;GET USERS PROCEDE COUNT IN T5
	   CAIA			;CONSTANT GIVEN
	   MOVE T5,(T5)		;SYMBOL - GET CONTENTS
	JUMPL	T5,BADSYN	;DO NOT ALLOW NEGATIVE PROCEDE COUNTS
	EXCH	T5,TEM1		;GET BACK BREAKPOINT ADDRESS
	SKIPL	TERMK		;WAS THAT ALL
	JRST	PAUS6		; YES

	MOVEM	T5,SAVLOC	;SAVE PAUSE ADDRESS TEPORARILY
	PUSHJ	P,TTYIN		;GET SIXBIT USER INPUT
	JUMPN	T2,BADSYN
	MOVE	T5,SAVLOC	;[136] RESTORE PAUSE ADDR., IN CASE WE'RE DONE
	JUMPE	T3,PAUS6	;[136] WAS THERE REALLY ANYTHING THERE?
	CAME	T3,[SIXBIT/TYPING/] ;YES
	JRST	BADSYN
PAUS8:	SKIPL	TERMK		;[134] DID WE GET A LINE TERMINATOR?
	JRST	ERR15		;[134] YES, WRONG PLACE FOR IT
	PUSHJ	P,GETNUM	;USER WANTS AUTO DISPLAY
	JUMPN	T5,PAUS3	;ASSUME ZERO MEANS NO INPUT

	CAIN	T2,"/"		;A / HERE DENOTES THAT A GROUP# FOLLOWS
	JRST	PAUS8		;TRY FOR THE NUMBER AGAIN

PAUS3:	CAIL	T5,1		;MAKE SURE HE GETS
	CAILE	T5,GPMAX	;  ONLY A VALID GROUP #
	JRST	ERR15		;COMPLAIN ABOUT GROUP #
	HRLM	T5,TEM1		;[300] GROUP # TO LH OF PROCEDE COUNT
	MOVE	T5,SAVLOC	;[300] GET BACK PAUSE ADDRESS
	TLO	T0,AUTO		;SET THE AUTO PROCEDE FLAG

PAUS6:	PUSHJ	P,ONFORM	;SKIP IF NOT A FORMAT AT (T5)
	  JRST	ERR19
	PUSHJ	P,BPS1		;PLACE ALL PARAMETERS TO EFFECT A PAUSE
	JRST	RET		;DONE!
PAUS7:	SETZI	T5,		;CLEAR PROCEDE COUNT
	EXCH	T5,TEM1		;GET PAUSE PLACE
	MOVEM	T5,SAVLOC	;STORE PAUSE LOCATION
	JRST	PAUS8

PAUS2:	SKIPL	TERMK		;[332] DID WE GET A LINE TERMINATOR?
	JRST	ERR6		;[332] YES, WRONG PLACE FOR IT
	PUSHJ	P,TTYIN		;[325] GET SIXBIT USER INPUT
	JUMPN	T2,BADSYN	;[325]
	CAMN	T3,[SIXBIT /ERROR/];[325] IS IT 'PAUSE ON ERROR'?
	JRST	P2OK		;[325]    YES
	CAME	T3,[SIXBIT /ERR/];[325]   YES
	JRST	BADSYN		;[325]    NO SO PRINT ERROR MESSAGE

P2OK:	SKIPGE	TERMK		;[332] DID WE GET A LINE TERMINATOR?
	PUSHJ	P,CLRLIN	;[332] NO, JUNK AFTER "PAUSE ON ERROR"
	HRRZI	T0,FO$GBA	;[332] HAVE FOROTS RETURN BREAK ADDRESS
	PUSHJ	P,FOROP.	;[325]   IN T0
	PUSH	P,T4		;[340] SAVE T4
	XMOVEI	T4,PAUERR	;[332]
	MOVEM	T4,@T0		;[332] Set address for trap

	XMOVEI	16,ERRARG	;[404] Biggest integer
	PUSHJ	17,ERRSET	;[404] Set number of errors allowed

	POP	P,T4		;[340] RESTORE T4
	JRST	RET		;[325] GET NEXT FORDDT COMMAND

PAUS10:	SKIPE	SUBSCR		;NOR MUST THERE BE AN OFFSET
	JRST	ERR19
	MOVE	T2,@SYMSAV	;GET SYMBOL
	TRNE	T1,LNAME	;[402]Short symbols?
	 JRST	PAU10L		;[402]No
	TLNE	T2,700000	;IS THIS A PROGRAM NAME OR GLOBAL
	JRST	ERR19		;NO SO DONT ALLOW

	TLZ	T2,PNAME	;[331]
	CAMN	T2,[SQUOZE 0,ON];[331] IF IT IS "ON" THEN
	AOS	ONFLG		;[325]   SET "PAUSE ON" FLAG
	JRST	PAU10A		;[402]

PAU10L:	TLNN	T2,LGLOBL	;[402]IS THIS A PROGRAM NAME OR GLOBAL
	JRST	ERR19		;[402]NO SO DONT ALLOW
	MOVE	T2,(T2)		;[402] Get name
	CAMN	T2,[SIXBIT /ON/];[402] IF IT IS "ON" THEN
	AOS	ONFLG		;[325]   SET "PAUSE ON" FLAG
PAU10A:	MOVE	T2,1(T5)	;DOES THIS ROUTINE INVOKE THE 'HELLO' MACRO?
	CAMN	T2,HELLO	;YES IT DOES - STOP 2 ON
	ADDI	T5,2		;
	JRST	PAUS11

ONFLG:	Z			;[325] =1 IF "PAUSE ON"
COND0:	Z			;[116] LEFT = FLAGS;  RIGHT = # OF TEST
COND1:	Z			;SAVE ADDRESS OF FIRST ARGUMENT
COND2:	Z			;SAVES ADDRESS OF SECOND ARGUMENT
COND3:	Z			;SAVE VALUE OF CONSTANT IF DEFINED

NUMB:	TLOE	T0,CONS		;SET CONSTANT SEEN FLAG IF NOT ALREADY SET
	JRST	ERR14
	MOVEM	T5,COND3	;SAVE VALUE OF CONSTANT
	MOVEI	T5,COND3	;SAVE ADDRESS OF CONSTANT
	POPJ	P,


;	ROUTINE TO CHECK IF A FORTRAN FORMAT EXISTS AT
;	THE ADDRESS POINTED TO BY T5
;	RETURN 1   IF IT IS A FORMAT
;	RETURN 2   IF NOT A FORMAT

ONFORM:	LDB	P1,[POINT 7,(T5),6]
	CAIE	P1,"("		;[311] TRUE IF FIRST CHAR IS AN OPEN PAREN
	JRST	CPOPJ1		;NOT A FORMAT STATEMENT
	LDB	P1,[POINT 7,(T5),13] ;[311]
	CAIL	P1," "		;[311] IS IT LESS THAN A BLANK?
	POPJ	P,		;[311] NO, PROBABLY IS A FORMAT STATEMENT
	JRST	CPOPJ1		;[311] NOT FORMAT, CHAR IS A CNTRL CHAR
;	CONTINUE LOGIC


CONTIN:	MOVSI	T5,(JFCL)	;RESET THE TRACE ENTRY
	MOVEM	T5,FDDT.
	SKIPN	STARTU		;[316] Has START been done?
	 JRST	ERR4		;[316] No - Please type START
	SKIPE	T5,JOBOPC	;ARE WE IN A RE-ENTER CONDITION
	JRST	CONT2		;YES - DEAL WITH IT

	MOVEI	T5,[POPJ P,]	;POPJ P,  IS THE EXIT AFTER A 'NEXT'
	CAMN	T5,LEAV		;DID WE DO A 'NEXT' LAST TIME
	JRST	PROCED		;YES - DO NOT TAKE ARGS - RETURN WITH A POPJ

	JUMPL	T0,PROCED	;CONTINUE 1
	PUSHJ	P,EITHER	; NO - GET ARGUMENT
	   CAIA			;NUMBER TYPED
	   MOVE	T5,(T5)		;SYMBOL TYPED - GET CONTENTS
	JUMPL	T5,BADSYN	;DO NOT ALLOW NEGATIVE PROCEDE SETTINGS
	JRST	PROCDX		;SET UP A PROCEDE COUNT

CONT2:	MOVE	T5,JOBOPC	;GET THE CONTINUE P.C.
	MOVEM	T5,GOLOC	;PREPARE TO CONTINUE
	PUSHJ	P,RE.NTR	;ALLOW RE-ENTERS AGAIN
	PUSHJ	P,INSRTB	;PUT BACK PAUSES
	JSP	T5,RESTOR	;RESTORE USER ACS
	JRST	@GOLOC		;[300] DO AN OFFICIAL RE-ENTER, using JRST

;HELP code for using either external HELPER or an internal version
;depending on the value of EXTHLP (1 = use external HELPER, 0 =
;use internal HELPER).  WARNING: The current TOPS10 version of
;HELPER which uses memory above .JBFF for it's input buffers, will
;trash FOROTS' data areas.
;
;NOTE: All of the following help code unless otherwise noted is part
;      of edit [147].

IFN EXTHLP,<			;when using external HELPER
HELP:	MOVE	T1,[SIXBIT/FORDDT/]
	PUSHJ	P,.HELPR	;GIVE 'EM SOME REAL HELP
	JRST	RET		; AND RETURN
	>			;end IFN EXTHLP

;Starting IFE EXTHLP (internal help code).  TOPS-10 native
;help code.

IFE EXTHLP,<			;start internal help code

IFE TOPS20,<			;start -10 internal help code
	DSK=0			;INPUT CHANNEL FOR FORDDT.HLP

HELP:	PUSH	P,T0		;SAVE THE FLAGS

;Generate a home made buffer ring of two buffers and a buffer
;control block.  Use FOROTS' ALCOR and DECOR routines for
;allocating and deallocating the buffer space.

;Allocate the buffer space.

	MOVEI	T1,^D264	;ALLOCATE ENOUGH FOR TWO 128 WORD BUFFERS
	MOVEM	T1,ALCBLK+1	;PUT IT WHERE ALCOR WILL FIND IT
	MOVEI	L,ALCBLK	;POINT TO IT
	PUSHJ	P,ALCOR.##	;LET FOROTS DO IT'S THING
	SKIPG	T0		;A POSITIVE VALUE?
	JRST	ALCFAL		;NO, ALLOCATION FAILED
	MOVEM	T0,ALCBLK+1	;SAVE ADDR FOR DECOR

;Set up the buffer header blocks.

	AOS	T2,T0		;POINT TO 2ND WORD OF BUFFER HDR
	HRLZI	T1,^D129	;SIZE OF BUFFER+1
	HRR	T1,T2		;TACK ON ADDRESS OF 1ST BUFFER HDR+1
	MOVEM	T1,^D131(T2)	;PUT IT IN WORD 2 OF 2ND BUFFER HDR
	ADDI	T1,^D131	;ADDR OF 2ND BUFFER HDR+1
	MOVEM	T1,(T2)		;PUT IT IN WORD 2 OF 1ST BUFFER HDR

;Try to find the help file.

	SETZB	T2,T5		;SET UP A COUNTER AND ZERO T2

GETHLP:	SKIPA	T3,['HLP   ']	;GET HLP:
GETSYS:	MOVSI	T3,'SYS'	;OR GET SYS:
	MOVEI	T4,HLPCTB	;ADDRESS OF BUFFER CONTROL BLOCK
	OPEN	DSK,T2		;OPEN THE DEVICE CHANNEL
	  JRST	HLPNHF		;LOSE...

	MOVE	T1,[EXP BF.VBR]	;SET UP THE BUFFER CONTROL BLOCK
	MOVEM	T1,HLPCTB	;SIGNIFY VIRGIN BUFFER
	HRRM	T0,HLPCTB	;GIVE ADDRESS OF 2ND WORD OF 1ST BUFFER
	SETZM	HLPCTB+1	;ZERO NEXT TWO LOCATIONS
	SETZM	HLPCTB+2

	MOVE	T1,[SIXBIT/FORDDT/] ;FILE NAME
	MOVSI	T2,'HLP'	;EXTENSION
	SETZB	T3,T4		;ZERO NEXT TWO
	LOOKUP	DSK,T1		;LOOKUP FORDDT.HLP
	  TLZA	T2,-1		;CLEAR JUNK, WE BLEW IT
	JRST	NXTBUF		;GOOD--GO READ FILE
	CAIE	T2,ERSNF%	;SFD NOT FOUND?
	CAIN	T2,ERSLE%	;SEARCH LIST EMPTY?
	JRST	NXTSTR		;ONE OF THE ABOVE
	CAILE	T2,ERIPP%	;INCORRECT PPN OR FILE NOT FOUND?
	JRST	HLPNHF		;HORRIBLE DISK ERROR
NXTSTR:	SETZM	T2		;CLEAR PHYSICAL BIT
	AOS	T5		;TRY NEXT CASE
	TRNE	T5,1		;SEE IF ODD
	TXO	T2,UU.PHS	;YES--TRY PHYSICAL ONLY
	JRST	@[GETHLP	;TRY HLP: AGAIN
		  GETSYS	;THEN LOGICAL SYS:
		  GETSYS	;THEN PHYSICAL SYS:
		  HLPNHF]-1(T5) ;THEN GIVE UP

NXTBUF:	IN	DSK,		;GET A BUFFER
	  JRST	OUTBUFF		;OUTPUT THE BUFFER
	STATZ	DSK,IO.ERR	;SEE IF ERRORS
	  JRST	HLPIOE		;YES--ISSUE MESSAGE
	STATZ	DSK,IO.EOF	;DONE YET?
	  JRST	HLPDON		;YES

OUTBUF:	HRRZ	T1,HLPCTB+1	;POINT TO 1ST DATA LOC IN BUFFER
	AOS	T1		;         ''
	OUTSTR	@T1		;OUTPUT THE BUFFER
	JRST	NXTBUF		;GO GET THE NEXT

ALCFAL:	OUTSTR	[ASCIZ	/%FDTCAB Cannot allocate buffer for help file/]
	JRST	HLPRET

HLPIOE:	OUTSTR	[ASCIZ	\%FDTIOE I/O error reading help file\]
	SKIPA
HLPNHF:	OUTSTR	[ASCIZ	/%FDTNHF Cannot find help file/]
	OUTSTR	[ASCIZ	/; I'm sorry, I can't help you/]

HLPDON:	RELEAS	DSK,		;RELEASE DISK CHANNEL
	MOVEI	L,ALCBLK	;NEED TO DEALLOCATE BUFFER SPACE
	PUSHJ	P,DECOR.##	;DO IT
HLPRET:	OUTSTR	CRLF
	POP	P,T0		;RESTORE FLAGS
	JRST	RET		;ALL DONE

HLPCTB:	BLOCK	3
	>			;end IFE TOPS20 (-10 internal help code)

;Continuing IFE EXTHLP (internal help code).  TOPS-20 native
;help code.

IFN TOPS20,<			;start -20 internal help code

HELP:	PUSH	P,T0		;SAVE THE FLAGS

;Use FOROTS' ALCOR and DECOR routines for
;allocating and deallocating the buffer space.

	MOVEI	T1,^D128	;ALLOCATE ONE BLOCK FOR THE FILE
	MOVEM	T1,ALCBLK+1	;PUT IT WHERE ALCOR WILL FIND IT
	XMOVEI	L,ALCBLK	;[300] POINT TO IT
	PUSHJ	P,ALCOR.##	;LET FOROTS DO IT'S THING
	SKIPG	T0		;A POSITIVE VALUE?
	JRST	ALCFAL		;NO, ALLOCATION FAILED
	MOVEM	T0,ALCBLK+1	;SAVE ADDR FOR DECOR
	TLO	T0,(61B5)	;[302] Make it a OWGBP
	MOVEM	T0,ALCPTR	;[302] Remember it

	MOVEI	T3,4		;NUMBER OF ATTEMPTS AT FINDING FILE
GETHLP:	MOVE	T4,[POINT 7,[ASCIZ/HLP:/]] ;GET THE HLP: POINTER
	MOVEM	T4,GTJBLK+2	;PUT IT IN THE GTJFN BLOCK
	JRST	GETIT
GETSYS:	MOVE	T4,[POINT 7,[ASCIZ/SYS:/]] ;GET THE SYS: POINTER
	MOVEM	T4,GTJBLK+2	;PUT IT IN THE GTJFN BLOCK
GETIT:	HRROI	T2,FILENM	;GET POINTER TO 'FORDDT'
	MOVEI	T1,GTJBLK	;LONG FORM GTJFN BLOCK
	GTJFN%			;GET FORDDT.HLP
	  JRST	NXTSTR		;LOSE TEMPORARILY
	HRRM	T1,JFN		;SAVE THE JFN
	MOVE	T2,[FLD(7,OF%BSZ)!OF%RD] ;BYTE SIZE OF 7 AND READ ONLY
	OPENF%			;OPEN THE FILE FOR READ ACCESS
	  JRST	HLPIOE		;SOMETHING WEIRD HAPPENED

PRINT:	MOVE	T1,JFN		;GET JFN
	MOVE	T2,ALCPTR	;[302] POINTER FOR TEXT BUFFER
	MOVEI	T3,^D639	;HELP TEXT BUFFER SIZE IN CHARS (128*5-1)
	SIN%			;FILL THE BUFFER
	  ERJMP	HLPDON		;DON'T CARE ABOUT THIS ERROR
	SETZ	T1,		;NEED A ZERO BYTE
	IDPB	T1,T2		;MAKE SURE ZERO THE LAST BYTE
	MOVE	T1,ALCPTR	;[302] POINT TO BUFFER
	PSOUT%			;OUTPUT ASCIZ STRING
	JRST	PRINT		;IF THERE'S MORE, GO GET IT

NXTSTR:	MOVE	T4,GTJBLK	;GET THE FLAGS
	TXOE	T4,GJ%PHY	;TURN ON PHYSICAL DEVICE BIT
	TXZ	T4,GJ%PHY	;CLEAR PHYSICAL BIT
	MOVEM	T4,GTJBLK	;PUT IT BACK IN GTJFN BLOCK
	SOJLE	T3,HLPNHF	;SEE IF ANY DEVICES LEFT
	CAIG	T3,2		;TIME TO TRY SYS:?
	JRST	GETSYS		;YES, USE SYS:
	JRST	GETHLP		;NO, USE HLP:

HLPDON:	SETZ	T1,		;NEED A ZERO BYTE
	IDPB	T1,T2		;MAKE SURE ZERO THE LAST BYTE
	MOVE	T1,ALCPTR	;[302] POINT TO BUFFER
	PSOUT%			;OUTPUT ASCIZ STRING
	HRROI	T1,CRLF		;OUTPUT CRLF
	PSOUT%
	MOVE	T1,JFN
	CLOSF%			;GET RID OF THE JFN
	  JFCL			;NOT LIKELY
	JRST	HLPRET		;AND RETURN

HLPIOE:	MOVE	T1,JFN		;WE STILL HAVE TO RELEASE THE JFN
	CLOSF%
	  JFCL			;NOT LIKELY
	HRROI	T1,[ASCIZ/%FDTEOH Error opening help file/]
	SKIPA
HLPNHF:	HRROI	T1,[ASCIZ /%FDTNHF Cannot find help file/]
	PSOUT%
	HRROI	T1,[ASCIZ/; I'm sorry I can't help you/]	
	PSOUT%
	HRROI	T1,CRLF
	PSOUT%

HLPRET:	XMOVEI	L,ALCBLK	;[300] NEED TO DEALLOCATE BUFFER SPACE
	PUSHJ	P,DECOR.##	;DO IT
	POP	P,T0		;RESTORE FLAGS
	JRST	RET		;ALL DONE

ALCFAL:	HRROI	T1,[ASCIZ/%FDTCAB Cannot allocate buffer for help file/]
	PSOUT%
	HRROI	T1,CRLF
	PSOUT%
	POP	P,T0		;RESTORE FLAGS
	JRST	RET		;ALL DONE

FILENM:	ASCIZ	/FORDDT/
JFN:	0
GTJBLK: GJ%OLD			;FLAGS
	.NULIO,,.NULIO
	POINT	7,[ASCIZ/HLP:/]	;POINTER TO DEVICE
	0
	0
	POINT	7,[ASCIZ/HLP/]	;POINTER TO EXTENSION
	0
	0
	0

ALCPTR:	BLOCK 1			;[302] OWGBP to allocated buffer
	>			;end IFN TOPS20 (internal -20 help code)

	-1,,0			;NUMBER OF ARGUMENTS TO ALCOR
ALCBLK:	IFIW ALCBLK+1		;[302] POINTER TO ARGUMENT
	BLOCK	1		;NUMBER OF WORDS NEEDED

	>			;end IFE EXTHLP (internal help code)

;	REMOVE LOGIC

RESET:	JUMPL	T0,RESET5	;'RESET' - RESET ALL PAUSES
	TRO	T1,FGLONL	;FIND GLOBAL ONLY IF NOT LABEL
	PUSHJ	P,SYMIN		; NO - MUST BE ANOTHER SYMBOL TO FOLLOW
	  JRST	[CAME T3,[SIXBIT/ON/]
		JRST  ERR6
		JRST  .+1]	;[332]
	  JFCL			;STATEMENT #
RESET6:	MOVEM	T3,TEM11	;[340] SAVE T3
	MOVE	T3,SYMSAV	;[332]

	TRNE	T1,LNAME	;[402]Short symbols?
	 JRST	REST6L		;[402]No
	
	TLZ	T3,PNAME	;[332]
	CAME	T3,[SQUOZE 0,ON];[332] IS IT A "REMOVE ON"
	SKIPL	TERMK		;[332] DID WE GET A LINE TERMINATOR?
	JRST	RSET3		;[332] YES, CAN'T BE PAUSE ON ERRROR
	JRST	REST6A		;[402]
REST6L:	MOVE	T3,(T3)		;[402] Get ptr to name
	MOVE	T3,(T3)		;[402] Get name
	CAMN	T3,[SIXBIT /ON/];[402] IF IT IS "ON" THEN
	SKIPL	TERMK		;[332] DID WE GET A LINE TERMINATOR?
	JRST	RSET3		;[332] YES, CAN'T BE PAUSE ON ERRROR

REST6A:
	PUSHJ	P,TTYIN		;[332] GET SIXBIT USER INPUT
	JUMPN	T2,BADSYN	;[332]
	CAMN	T3,[SIXBIT /ERROR/];[332] IS IT 'REMOVE ON ERROR'?
	JRST	RESET1		;[332] REMOVE ON ERROR
	CAME	T3,[SIXBIT/ERR/];[332] 
	JRST	ERR6		;[332] "REMOVE ON" FOLLOWED BY JUNK
RESET1:	SKIPGE	TERMK		;[332] DID WE GET A LINE TERMINATOR?
	PUSHJ	P,CLRLIN	;[332] "REMOVE ON ERROR" FOLLOWED BY JUNK
	HRRZI	T0,FO$GBA	;[332] HAVE FOROTS RETURN BREAK ADDRESS
	PUSHJ	P,FOROP.	;[332]   IN T0			
	SETZM	@T0		;[332] CLEAR "REMOVE ON ERROR"
	JRST	RET		;[332]	
RSET3:	MOVEI	T2,B1ADR	;[402] LOOK THRO PAUSE POINTS FOR THE RIGHT ONE
RESET3:	MOVE	T3,TEM11	;[340] RESTORE T3, WAS NOT ERROR PAUSE
	HRRZ	T4,(T2)		;GET THE PAUSE CONTENTS
	CAIN	T4,(T5)		;IS THIS IT?
	JRST	RESET2		; YES - REMOVE IT!

	ADDI	T2,3		; NO  - TRY ANOTHER
	CAIG	T2,BNADR	;TRIED ALL POINTS YET?
	JRST	RESET3		; NO - FIND THE NEXT

	JRST	ERR17		;NO - NOT AN ARRAY NAME -  YOU LOSE

RESET2:	MOVE	T4,1(T5)	;DOES THIS ROUTINE USE THE HELLO MACRO
	CAMN	T4,HELLO
	ADDI	T5,1		;YES IT DOES - SO STOP 2 ON
	ADDI	T5,1		;STOP 1 ON FOR NORMAL ROUTINES
	CLEARM	(T2)		;CLEAR LOCATION OF PAUSE
	CLEARM	1(T2)		;CLEAR CONDITIONAL CLAUSE
	CLEARM	2(T2)		;CLEAR PROCEDE COUNT
	JRST	RET		;REMOVED!

RESET5:	CAME	T3,[SIXBIT/REMOVE/] ;DO NOT ALLOW ABREVIATIONS OF REMOVE
	JRST	BADSYN		;THIS ANNOYS MANY USERS
	HRRZI	T0,FO$GBA	;[332] HAVE FOROTS RETURN BREAK ADDRESS
	PUSHJ	P,FOROP.	;[332]   IN T0			
	SETZM	@T0		;[332] CLEAR "PAUSE ON ERROR"
	PJRST	BPS		;RESET ALL PAUSES
;	ACCEPT LOGIC	= ACCEPT NAME/X #

ACCEPT:	JUMPL	T0,BADSYN	;ACCEPT ALONE IS MEANINGLESS!
	SETZM	ARGVAL+1	;CLEAR IN CASE LONG INPUT
	SKIPN	ESCAPE		;ESCAPE TO FOROTS?
	JRST	ERR30		;SORRY
	PUSHJ	P,CHKIWI	;[211] RECURSIVE IO IF WE CALL THE OTS?
	 JRST	ERRIWI		;[211] YES, TELL AND RETURN TO COMMAND LOOP.
	TRO	T1,ACCPT	;ACCEPT IN PROGRESS
	CLEARM	CLMOFF		;[401]
	CLEARM	CLMRNG		;[401]
	CLEARM	SSLOW		;[401]ZERO THE LOWER SUBSTRING BOUND
	CLEARM	SSUP		;[401]ZERO THE UPPER SUBSTRING BOUND
	PUSHJ	P,SYMIN		;GET USERS SYMBOL
	  JRST	ERR6		;SORRY - WE DONT HAVE IT!
	  JRST	ACC2		;STATEMENT # = FORMAT
	MOVEM	T5,TEM2		;STORE FOR UPDATE
;[157]***For character, T5/TEM2=descriptor of array base=SAVLOC
	TRNE	T1,IMPRNG	;IS THIS AN IMPLIED RANGE?
	PUSHJ	P,DISP14	;YES SETUP RANLIM/RANGE IN CASE OF A RANGE
	MOVE	T5,SYMSAV	;GET THE SYMBOL POINTER
	HLRZ	T5,(T5)		;GET RADIX 50 FORM AND FLAGS
	TRNN	T1,LNAME	;[402] if it is not long name - check if local
	JRST	[TRNN	T5,LOCAL;[402]ALLOW ONLY LOCAL VARIABLES TO CHANGE
		JRST	ERR24	;YOU LOOSE
		JRST 	.+1]	;[402]
	MOVE	T2,LSTCHR	;RESTORE USERS LAST CHARACTER

;	HERE HAVING READ A GOOD VARIABLE	= ACCEPT NAME/

	SKIPL	TERMK		;END OF LINE SEEN?
	JRST	BADSYN		;YES - BAD NEWS
	JUMPE	T2,ACCF		;SPACE DELIMITER ASSUMES REAL TO FOLLOW
	CAIN	T2,"="		;ALLOW = AS DELIMITER
	JRST	ACCF
	CAIN	T2,"-"		;A - MEANS A RANGE OF VALUES TO SET
	JRST	ACC23		;
	CAIE	T2,"/"		; WE EXPECT ONLY / FROM NOW ON
	JRST	BADSYN		;ANYTHING ELSE LOOSES
	SETZM	TEM		;[323] No switches yet

ACC22:	PUSH	P,T1		;[402] Save long name flag
	PUSHJ	P,TTYIN		;READ ARGUMENT TYPE REQUIRED BY USER
	POP	P,T1		;[402] Restore long name flag
	JUMPE	T3,BADSYN	;NO CHARACTERS - BAD
	LDB	T5,[POINT 6,T3,5];GET 1ST. CHARACTER TO IDENTIFT ARG TYPE
	CAIE	T5,'B'		;[323] BIG SWITCH ?
	 TRZA	P3,777777-B.	;[323] No - Remove all but 'B'
	TROA	P3,B.		;[120] YES - SET IT AND LOOK FOR ANOTHER SWITCH
	 MOVEM	T5,TEM		;[323] NOT 'BIG', SAVE SWITCH IN CASE B FOLLOWS
	JUMPE	T2,ACC21	;NOTHING FOLLOWS
	CAIN	T2,"="		; ALLOW = AS DELIMITER
	JRST	ACC21		;PROCESS FORMAT
	CAIE	T2,"/"		;ANOTHER SWITCH ?
	JRST	BADSYN		;NO - ONLY / ALLOWED
	JRST	ACC22		;PROCESS ANOTHER SWITCH
;	HERE HAVING READ ALL THE MODE SWITCHES
;[120]	THE LAST SWITCH TAKES PRIORITY (/F/D/C/I/O/A/R/L) /B ALLOWED
;	ACCEPT NAME/B/I
;[156]	We now check to see whether input is /BIG/ASCII into a range
;	of double-precision array elements. If so, RANGE must be
;	incremented to the address of the second word of the last
;	element, in order for the end-of-range check at ACC14 to
;	be valid. (we were losing the second word of the last element).

ACC21:	SKIPL	TERMK		;[200] ALREADY AT EOL?
	 JRST	BADSYN		;[200] YES: BAD COMMAND SYNTAX
	SKIPN	T5,TEM		;[323] Get current mode flags
	 MOVEI	T5,'F'		;[323] Default is 'F'
	SKIPE	RANGE		;[156]looking for a range?
	 JRST	ACC21A		;[156]YES
	SETZM	CLMRNG		;[163]In case character
	JRST	ACC21B		;[163]Go get input
ACC21A:	TRNE	P3,B.		;[323]/BIG?
	 TRNN	T0,DOUBLE	;[306]and double precision?
	  JRST	ACC21B		;[156]NO
	CAIE	T5,'A'		;[156]ASCII?
	 CAIN	T5,'R'		;[156]or RASCII?
	  AOS	RANGE		;[156]YES. Don't lose second word

ACC21B:	CAIN	T5,'S'		;SYMBOLIC?
	JRST	ACCS		;DO SYMBOL INPUT
	CAIN	T5,'A'		;ASCII?
	JRST	ACCA		;PROCESS ASCII
	CAIN	T5,'R'		;RASCII?
	JRST	RASCII		;PROCESS RIGHT JUSTIFIED ASCII
	CAIN	T5,'O'		;OCTAL?
	JRST	ACCO		;PROCESS OCTAL
	CAIN	T5,'C'		;[157]Character?
	JRST	ACCC		;[157] YES. Process string
	TRZ	P3,B.		;[323] IGNORE /BIG FOR THE REST
	CAIN	T5,'F'		;FLOATING?
	JRST	ACCF		;PROCESS A FLOATING INPUT
	CAIN	T5,'D'		;REAL*8?
	JRST	ACCD		;PROCESS REAL*8
	CAIN	T5,'I'		;INTEGER?
	JRST	ACCI		;PROCESS INTEGER INPUT
	CAIN	T5,'X'		;[157]COMPLEX?
	JRST	ACCX		;[157]PROCESS COMPLEX INPUT
	CAIN	T5,'L'		;[120] LOGICAL?
	JRST	ACCL		;[120] PROCESS LOGICAL INPUT
	JRST	BADSYN		;NO OTHER TYPES SUPPORTED
;	ACCEPT A RANGE PROCESSING	= ACCEPT NAME(X)-

ACC23:	MOVE	T5,TEM2		;SAVE THE FIRST VALUE SOMEWHERE SAFE
	MOVEM	T5,RANGE	;SAVE THE FIRST VALUE OF A RANGE
	MOVE	T5,CLMOFF	;[157]Get beginning offset
	MOVEM	T5,CLMRNG	;[157]Save it in case this is /C
	TLZ	T0,GRPFL	;MAKE SURE WE DONT DO GROUP LOGIC
				;OR ACCEPT ANY PRINT MODIFIERS
	MOVE	T5,MATHSM	;[403]SAVE CURRENT SYMBOL
	MOVEM	T5,TEM10	;[403]
	PUSHJ	P,SYMIN		;GET THE NEXT VALUE
	  JRST	ERR6		;DOSNT EXIST
	  JRST	BADSYN		;NUMERICS????
	MOVE	T4,TEM10	;[403]GET FIRST SYMBOL BACK
	CAME	T4,MATHSM	;ARE THEY THE SAME
	JRST	ERR40		;NO - SORRY
	TRNN	T0,CHARS	;[157]Character?
	 JRST	CKRANG		;[157]NO
;	clmrng=first offset given
;	clmoff=offset just received
	MOVE	T2,CLMOFF	;[157]Get the lower offset
	CAMLE	T2,CLMRNG	;[157]Is lower .le. upper?
	 EXCH	T2,CLMRNG	;[157]NO. Make it so
	MOVEM	T2,CLMOFF	;[157]Restore lower offset
	MOVE	T5,SAVLOC	;[157]Restore sym
	JRST	ACCONT		;[157]And continue
CKRANG:	CAML	T5,RANGE	;SORT OUT THE RANGE ORDER
	EXCH	T5,RANGE	;WRONG WAY ROUND
	MOVEM	T5,TEM2		;LOWER VALIUE IN RANLIM, HI IN RANGE
ACCONT:	PUSHJ	P,EVAL		;GET SYMBOL IN SYMSAV
	 JFCL
	MOVE	T5,SYMSAV	;GET THE SYMBOL POINTER
	HLRZ	T5,(T5)		;GET SYMBOL FLAGS
	TRNN	T5,LOCAL	;MODIFY LOCALS ONLY
	JRST	ERR24		;NOT ALLOWED
	MOVE	T2,LSTCHR	;RESTORE USERS LAST CHARACTER
	CAIN	T2,"/"		;MAYBE FORMAT SPECIFIER
	JRST	ACC22		;YES - GO FIND THEM
	SKIPGE	TERMK		;[200] EOL ALREADY?
	JUMPE	T2,ACCF		;[200] NO. SPACE IMPLIES REAL*4
	JRST	BADSYN		;DONT ACCEPT ANYTHING ELSE HERE
;	*** FLOATING INPUT ***

ACCF:	TRO	P3,F.		;[323] DISPLAY TO USER AS FLOATING
	MOVEI	T3,4		;ARG TYPE REAL FOR FOROTS
	PUSHJ	P,FORINP	;YES - ASK FOROTS FOR INPUT

;	HERE TO PLACE ALL ACCEPTED VALUES

ACC10:	MOVE	T5,ARGVAL	;LETS SEE WHAT FOROTS HAS BEEN UP TO
ACC13:	EXCH	T5,TEM2		;[163]Save input value
	PUSHJ	P,CKWRIT	;[163]Validity check
	EXCH	T5,TEM2		;[163]Regain value	
	MOVEM	T5,@TEM2	;PLACE VALUE WHERE USER REQUESTED
	MOVEM	T5,ARGVAL	;SOME PRINT OPTIONS NEED THIS
	AOS	T2,TEM2		;NEXT ARRAY LOCATION
	TRNN	P3,X.!B.!D.	;[323] IF EITHER COMPLEX REAL*8 OR BIG OR -
	TRNE	T0,DOUBLE	;[112] WE HAVE A DOUBLE WORD ARRAY?
	CAIA			;THEN WE PLACE TWO ARGUMENTS
	JRST	ACC14		;IF NOT THEN CHECK THE RANGE CONDITION
	TRO	T0,SILENT	;QUIET
	PUSH	P,MATHSM	;SAVE CURRENT SYMBOL
	PUSH	P,T1		;[402] Save long name flag in T1 for symbol
	MOVE	T5,[SQUOZE 0,.VEND] ;END OF VARIABLE AREA
	MOVEM	T5,MATHSM	;ONLY ACCEPTABLE SYMBOL
	MOVE	T5,TEM2		;GET DESTINATION;T=dest addr
	PUSHJ	P,CKWRIT	;[163]Validity check; return if OK
	PUSHJ	P,LOOK		;FIND A SYMBOL FOR IT
	  JFCL			;NONE-OK
	  JRST	ACC13A		;[402]OFFSET - OK
	POP	P,T1		;[402]
	POP	P,T5		;[402]
	JRST	ERR35		;YES - ERROR
ACC13A:	POP	P,T1		;[402]
	POP	P,T5
	STSYM	T5,MATHSM	;[402]RESTORE CURRENT SYMBOL
	MOVE	T5,ARGVAL+1	;GET THE 2ND WORD
	MOVEM	T5,@TEM2	; - AND PLACE IN NEXT LOCATION
	AOS	T2,TEM2		;YES - SO NEXT DOUBLE WORD
ACC14:	SKIPN	RANGE		;ACCEPT A RANGE ?
	JRST	ACCPUT		;NO - UNLESS IMPLIED
	TRNE	P3,A.		;[323] SPECIAL TREATMENT FOR ASCII ARRAYS
	JRST	[CAMG	T2,RANGE ;END OF ARRAY?
		 JRST	ACC12	;GET SOME MORE
		 JRST	RET	] ;QUIT
	CAMG	T2,RANGE	;ALL DONE ?
	JRST	ACC10		;NO - KEEP GOING
	JRST	RET		;ALL OVER

;	VARIABLE 'ACCEPT'ED - NOW CONFIRM TO USER

ACCPUT:	SOS	T5,TEM2		;REMOVE OFFSET FROM ACC13
ACPUT1:	SETZM	TERMK		;PREPARE FOR -
	SETZM	RANGE		;  INPUT CONFIRMATION
	TRZN	T0,DOUBLE	;CHECK FOR ANY -
	TRNE	P3,X.!B.!D.	;[323] DOUBLE WORD WORKING
	SOS	T5,TEM2		;    AND IF SO CORRECT BASE ADDRESS
	PUSHJ	P,DISP10	;AND LET HIM SEE HIS EFFORTS
	JRST	RET		;END OF ACCEPT
	PUSHJ	P,GETNUM	;GENERAL GET NUMBER ROUTINE
	JRST	ACC13		;STORE FOR USER
;	*** DOUBLE PRECISION INPUT ***

ACCD:	TRO	P3,D.		;[323] DISPLAY TO USER AS REAL*8
	MOVEI	T3,TP%DPR	;[137]Set up for default D-float arg type=10
	TRNE	T0,GFLOAT	;[137]If D-float, skip to FOROTS call.
	MOVEI	T3,TP%DPX	;[137] else, we have G-float, set arg type=13
	PUSHJ	P,FORINP	;REQUEST INPUT
	JRST	ACC10		;PLACE FINAL ARG


;	*** INTEGER INPUT ***

ACCI:	TRO	P3,I.		;[323] DISPLAY TO USER AS INTEGER
	MOVEI	T3,2		;GET ARG TYPE INTEGER FOR FOROTS
	PUSHJ	P,FORINP	;GO TO FOROTS
	JRST	ACC10		;PLACE ARG FOR USER

;	*** COMPLEX INPUT ***

ACCX:	TRO	P3,X.!B.	;[323] DISPLAY TO USER AS VCOMPLEX
ACC11:	PUSHJ	P,GETSKB	;GET SIGNIFIGANT CHARACTER
	CAIE	T2,"("		;MAKE SURE ITS A (
	JRST	ERR32		; ( REQUIRED
	MOVE	T5,[401200,,ARGVAL+1]  ;[300] WHERE TO PUT IMAGINARY OF COMPLEX
	MOVEM	T5,M2.I		;SET UP THE FORMAT
	MOVEI	T3,4		;SET UP FOR TYPE REAL INPUT
	PUSHJ	P,FORINP	;LET FOROTS GET THE REAL PART
	MOVE	T5,M2.F		;RECOVER THE FIN CALL
	MOVEM	T5,M2.I		;AND REMOVE THE COMPLEX SETTING
	JRST	ACC10		;GO PLACE THE RESULTS

;	*** SYMBOLIC INPUT ***

ACCS:	TRNE	P3,B.		;[323] IF 'BIG' SET THEN
	 TROA	P3,X.		;[330] DISPLAY TO USER AS TWO REAL*4
	HLRS	P3		;[330] OTHERWISE USE CURRENT DEFAULT
	MOVE	T5,MATHSM	;[403]SAVE MATHSM
	MOVEM	T5,TEM10	;[403]
	MOVE	T5,SAVLOC	;[403]SAVE SAVLOC AROUND CALL
	MOVEM	T5,TEM11	;[403]
	PUSHJ	P,SYMIN		;GET A USER SYMBOL
	  JRST	ERR6		;CAN'T FIND IT!
	  JRST	BADSYN		;DONT GIVE ME STATEMENT #
	MOVE	T2,TEM11	;[403]
	MOVEM	T2,SAVLOC	;[403]RESTORE SAVLOC
	MOVE	T2,TEM10	;[403]
	MOVEM	T2,MATHSM	;[403]RESTORE
	MOVE	T2,(T5)		;I'LL ACCEPT THAT ONE
	MOVEM	T2,ARGVAL	;SAVE THE FIRST WORD VALUE
	TRNN	P3,B.		;[323] DOUBLE WORD WORKING?
	JRST	ACC10		;NO JUST PLACE SINGLE VALUE
	MOVE	T5,1(T5)	;GET SECOND VALUE
	MOVEM	T5,ARGVAL+1	;STORE THAT
	JRST	ACC10		;   AND EVEN STORE IT
;	*** ASCII INPUT RIGHT JUSTIFIED ***

RASCII:	TRO	P3,R.		;[323] DISPLAY TO USER AS RASCII
	JRST	ACC1		;DO ASCII INPUT TO T


;[120]	** LOGICAL INPUT **

ACCL:	TRO	P3,L.		;[323] DISPLAY TO USER AS LOGICAL
	MOVE	T2,[POPJ P,]	;[120] HOW WE WANT TO RETURN FROM LOGICL
	MOVEM	T2,DONE		;[120]
	TRO	T1,LGCLEG	;[120] LET 'EM WE'RE EXPECTING A LOGICAL
	PUSHJ	P,GETSKB	;[120] GET NEXT CHAR.
	CAIE	T2,"."		;[120] DOES IT START WITH A "."?
	JRST	ERR7		;[120] NO GOOD.
	PUSHJ	P,LOADCH	;[120] GET THE NEXT CHAR.
	PUSHJ	P,LOGICL	;[120] AND LET LOGICL HANDLE THE REST
	JRST	ACC13		;[120] SAVE THE RESULTS


;	*** ASCII INPUT ***

ACCA:	TRO	P3,A.		;[323] DISPLAY TO USER AS ASCII
	MOVE	T5,[ASCII .     .] ;BLANK SECOND WORD FOR POSSIBLE
	MOVEM	T5,ARGVAL+1	;LONG OR DOUBLE
	SKIPN	RANGE		;[120] IGNORE /BIG IF ACCEPTING LONG ASCII
	JRST	ACC1		;OK IF NOT A RANGE
	TRZ	P3,B.		;[323] CLEAR /B FLAG
	TRZ	T0,DOUBLE	;CLEAR DOUBLE
ACC1:	SKIPE	SSLOW		;[400]ASSIGNING INTO SUBSTRING
	JRST	ERR42		;[400]DON'T LET USER - IT WILL MESS UP BYTEPTR
	PUSHJ	P,GETSKB	;GETA SIGNIFICANT USER CHARACTER
	SKIPL	TERMK		;EOL?
	JRST	BADSYN		;YES - SYNTAX ERROR
	MOVEI	P1,(T2)		;SAVE IN T3
ACC12:	SETZM	ARGVAL		;CLEAR FOR DOUBLE LENGTH ASCII
	TRZE	T1,ADELIM	; IF SET WE CLEAR THE REST OF THE ARRAY
	JRST	ACCA2		;
ACC24:	MOVE	T5,[ASCII .     .]	;T BUILDS ASCII INPUT
	TRNE	P3,R.		;[323] BUILD WITH ZERO IF RASCII
	SETZI	T5,
	MOVE	P2,[POINT 7,T5]	;STORES BYTES IN T5
ACC15:	pushj	p,loadch	;NEXT ASCII CHARACTER
	CAIN	T2,(P1)		;TEXT DELIMITER FOUND?
	JRST	ACC18		;YES - CHECK FOR A SECOND
	TRZE	T1,ADELIM	;WAS THE LAST CHARACTER OUR DELIMITER
	JRST	[PUSH P,T2	;YES
		 MOVE T2,[pushj p,loadch] ;FOR GETSKB
		 MOVEM	T2,GETCHR
		 POP	P,T2
		 PUSHJ	P,GETSK2 ;CHECK FOR COMMENT
		 PUSHJ P,CLRLIN	; WIND UP
		 JRST	ACC17]
ACC19:	IDPB	T2,P2		;SAVE USERS TEXT
	TLNE	P2,760000	;FILLED T?
	JRST	ACC15		;NO - TAKE MORE

	CAIA			;DONT CONFUSE THE INDEFINATE ACCEPT
ACC17:	TRO	T1,ADELIM	;SET TO CLEAR REST OF ARRAY IF IN A RANGE
	TRNE	T0,DOUBLE	;TEST FOR ANY DOUBLE WORD -
	JRST	ACC2WD		;  WORKING -
	TRNN	P3,B.		;[323] IMPLIED BY REAL*8 OR B.
	JRST	ACC20		;STORE FINAL SINGLE VALUE IN T5
;	DOUBLE WORD WORKING

ACC2WD:	SKIPN	ARGVAL		;IS THE FIRST VALUE STOREF?
	JRST	ACC3WD		;NO
	MOVEM	T5,ARGVAL+1	;YES STORE SECOND
	JRST	ACC25		;PLACE BOTH VALUES
ACC3WD:	MOVEM	T5,ARGVAL	;HOLD FIRST OF PAIR
	TRNN	T1,ADELIM	;ANY MORE TO COME
	JRST	ACC24		;YES - GO FIND IT
ACC25:	HRRZM	P1,DELCHR	;SAVE DELIMITER FOR CLRLIN
	PUSHJ	P,CLRLIN	;CLEAR REST OF LINE
	TRNN	P3,R.		;[323] ARE WE ACCEPTING RIGHT JUSTIFIED TEXT
	JRST	ACC10		;RELAX JUST ASCII
	MOVE	T2,ARGVAL	;GET BACK THE DOUBLE WORD
	JUMPE	T2,ACC10	;NO TEXT?????
	MOVE	T3,ARGVAL+1	;INTO A LONG SHIFT FORM
	LSH	T2,-1		;FIRST MAKE A CONTINUOUS STRING OF TEXT
	LSHC	T2,-1		;GET READY FOR 7BIT CHARACTER SHIFTS
ACC27:	LDB	T4,[POINT 7,T3,35]
	JUMPN	T4,ACC26	;TEST FOR SUCCESSFUL RIGHT JUSTIFICATION
	LSHC	T2,-7		;NOT YET MOVE DOWN
	JRST	ACC27		;TRY AGAIN
ACC26:	LSH	T2,1		;ASCII-ISE
	TLZE	T3,400000	;SHOULD THERE BE A LOWER BIT FOR T2
	TRO	T2,1		;YES - PUT IT IN
	MOVEM	T2,ARGVAL	;STORE TOP VALUE
	MOVEM	T3,ARGVAL+1	;AND FINALLY LAST VALUE
	JRST	ACC10		;AND GIVE THEM TO THE USER

ACC18:	TRON	T1,ADELIM	;FLAG THIS AS OUR DELIMITER
	JRST	ACC15		;SEE IF NEXT CHARACTER IS SAME
	TRZ	T1,ADELIM	;YES IT IS -
	JRST	ACC19		;PASS ON JUST ONE

ACCA2:	TRZ	P3,A.!R.	;[323] REMOVE THE TEXT FLAGS
	MOVE	T5,[ASCII .     .] ;FILL THE REST OF THE ARRAY
	MOVEM	T5,ARGVAL	;WITH SPACES
	MOVEM	T5,ARGVAL+1
	JRST	ACC13


;	FINISHED TEXT INPUT

ACC20:	HRRZM	P1,DELCHR	;SAVE DELIMITER FOR CLRLIN
	SKIPN	RANGE		;IF NOT IN A RANGE SETTING -
	PUSHJ	P,CLRLIN	;THEN CLEAR THE REST OF THE USER INPUT
	TRNN	P3,R.		;[323] LEFT OR RIGHT JUSTIFY
	JRST	ACC13		;LEFT
	LDB	T2,[POINT 6,P2,5] ;RIGHT - GET THE T4 POINTER RESIDUE
	SETCA	T2,		;RIGHT SHIFT
	LSH	T5,1(T2)	; NOW
	JRST	ACC13		;NOW PLACE TEXT

;	*** CHARACTER STRING INPUT ***		;[157]

ACCC:				;[157]
	TRO	P3,C.		;[323]Display to user properly
	PUSHJ	P,GETSKB	;[157]Look for quote
	SKIPL	TERMK		;[157]EOL?
	 JRST	BADSYN		;[157]YES. Syntax error
ACCC1:	CAIE	T2,"'"		;[157]Single quote?
	 JRST	[TYPE (<%Character string must begin with single quote>)
		JRST	RET]	;[157]Try again
	DMOVE	T2,@SAVLOC	;[157]Get descriptor
	MOVE	T4,T3		;[163]Save length for descriptor check & loop
	IMUL	T3,CLMOFF	;[157]Compute for ADJBP
	SKIPN	SSLOW		;[401]
	JRST	ACOMOF		;[401]
	MOVE	T4,SSUP		;[401]	
	SUB	T4,SSLOW	;[401]
	AOJ	T4,		;[401] t4 = length = upper - (lower - 1)
	ADD	T3,SSLOW	;[401]substring offset
	SOJ	T3,		;[401] t3 = array offset + (lower - 1)
ACOMOF:	ADJBP	T3,T2		;[157]Get BP to element
	MOVEM	T3,ORIGLM	;[157]Save starting address
	MOVEI	T5,T3		;[163]T5=location of descriptor to validate
	PUSHJ	P,CKBPTR	;[163]Validate descriptor; return if OK
	MOVE	T5,T2		;[305]GET THE REAL ADDR TO VALIDATE
	TLZ	T5,770000	;[305]CLEAR THE OWGBP BITS LEAVING ADDR
	PUSHJ	P,CKWRIT	;[163]Check destination; return if OK
INSTRL:	PUSHJ	P,LOADCH	;[157]Get next character
	CAIE	T2,"'"		;[157]Quote?
	 JRST	PUTBYT		;[157]NO. Store it.
	PUSHJ	P,LOADCH	;[157]YES. see if there is another
	CAIN	T2,"'"		;[157]Another quote?
	 JRST	PUTBYT		;[157]YES. Store one only!
	DMOVEM	T3,TEM4		;[157]Save pointer & count
	MOVE	T5,[PUSHJ P,LOADCH] ;[157]for GETSKB
	MOVEM	T5,GETCHR	;[157]Tell GETCHR how to get input
	PUSHJ	P,GETSK1	;[157]Check for comment
	PUSHJ	P,CLRLIN	;[157]Clear extraneous input
	DMOVE	T3,TEM4		;[157]Restore pointer & count
	 JRST	STREND		;[212][157]End of this string


BYT2T5==^D29		;[BL]Bits left if BP points to firstbyte in word
PUTBYT:	IBP	T3		;[163]Destination address
	MOVE	T5,T3		;[163]T5=address to validate
	LDB	P1,[POINT 6,T3,05] ;[163]Get byte position within word
	CAIN	P1,BYT2T5	;[163]First byte in this word?
	PUSHJ	P,CKWRIT	;[163]YES. Validate destination; here +1 if OK
	DPB	T2,T3		;[163]Store byte
	SOJG	T4,INSTRL	;[157]Loop thru input string

	MOVEI	T5,"'"		;[157]Anticipated delimiter
	MOVEM	T5,DELCHR	;[157]Save for CLRLIN

STREND:	MOVEI	T5," "		;[212][157]Fill character
FILSTR:	SOJL	T4,NDSTR1	;[157]Jump if string full
	IDPB	T5,T3		;[157]Store a space
	JRST	FILSTR		;[157]Loop till full
NDSTR1:	MOVE	T4,CLMRNG	;[157]Relative location of last element
	SUB	T4,CLMOFF	;[157]Elements to fill
	JUMPLE	T4,ENDCK	;[157]NONE.....
	MOVE	T5,SAVLOC	;[157]Addr/descriptor
	MOVE	T5,1(T5)	;[157]Get count
	IMULI	T5,(T4)		;[157]Total bytes to move
	MOVE	T4,ORIGLM	;[157]Get source addr
RNGLUP:	ILDB	P1,T4		;[157]Load byte
	IDPB	P1,T3		;[157]Store it
	SOJG	T5,RNGLUP	;[157]
ENDCK:	MOVE T5,[pushj p,loadch];FOR GETSKB
	MOVEM	T5,GETCHR
	PUSHJ	P,GETSK1	;[157]CHECK FOR COMMENT
	SKIPGE	TERMK		;[322]Line terminator?
	PUSHJ	P,CLRLIN	;[322]No - Show user error

	MOVE	T5,SAVLOC	;[322]Restore for display
	SKIPN	CLMRNG		;[157]Accept a range?
	 JRST	ACPUT1		;[157]NO. Go display single element
	JRST	RET		;[157]YES. all done!!!!!
;	*** OCTAL INPUT ***

ACCO:	TRO	P3,O.		;[323] DISPLAY TO USER AS OCTAL
	SETZI	T5,		;CLEAR FOR OCTAL BUILD
	SKIPL	TERMK		;END OF LINE SEEN?
	JRST	ACC13		;YES - ASSUME OCTAL = 0
	PUSHJ	P,GETSKB	;LOOK FOR "-"
	SKIPL	TERMK
	JRST	ACC13		;END OF LINE - =0
	SETZB	P1,P2		;CLEAR BUILD AREA
	MOVEI	T5,^D12		;INITIALIZE COUNT
	TRNE	P3,B.		;[323] CHECK BIG
	MOVEI	T5,^D24		;[120] DOUBLE IT FOR BIG
	CAIA

ACC29:	PUSHJ	P,GETSKB	;GET NEXT CHARACTER
	SKIPL	TERMK		;END OF LINE?
	JRST	ACC16		;
	CAIE	T2,"+"		;PLUS?
	JRST	ACC31
	TLNE	T0,MF		;YES - MINUS SEEN?
	JRST	BADSYN
	JRST	ACC29		;NO - IGNORE THE +
ACC31:	CAIN	T2,42		;DOUBLE QUOTE?
	JRST	ACC29		;YES - IGNORE
	CAIE	T2,"-"
	JRST	ACC16		;NOT A "-"
	TLC	T0,MF		;COMPLEMENT FLAG
	JRST	ACC29		;GET NEXT CHARACTER

ACC16:	SUBI	T2,60		;OCTALISE
	JUMPL	T2,ERR2		;CHARACTER MUST OF COURSE -
	CAIL	T2,10		;   BE OCTAL
	JRST	ERR2		;NOT OCTAL - COMPLAIN
	LSHC	P1,3		;BUILD OCTAL VALUE 
	IOR	P2,T2
	SOJE	T5,ACC28	;CHECK FOR PROPER NUMBER OF CHARACTERS
ACA16:	PUSHJ	P,GETSKB	;GET A CHARACTER
	SKIPGE	TERMK		;END OF LINE
	JRST	ACC16		;BACK FOR MORE
;	HERE WITH LINE END OR FULL WORD(S)

ACC28:	TRNN	P3,B.		;[323] BIG WORKING?
	JRST	ACC30		;AS YOU WERE - STORE OCTAL
	MOVEM	P1,ARGVAL	;STORE LONG OCTAL
	MOVEM	P2,ARGVAL+1
	JRST	ACC32
ACC30:	MOVEM	P2,ARGVAL	;STORE SINGLE OCTAL

;	HERE AT END OF INPUT

ACC32:	PUSHJ	P,CLRLIN	;CLEAR THE LINE
	TLZN	T0,MF		;FLAGGED AS A NEGATIVE #?
	JRST	ACC10		;NORMAL
	SETCMM	ARGVAL		;SET TO NEGATIVE -
	SETCMM	ARGVAL+1	;	= 1'S COMPLEMENT
	AOS	ARGVAL+1	; LETS MAKE IT 2'S COMPLEMENT
	SKIPN	ARGVAL+1
	AOS	ARGVAL
	JRST	ACC10		;NOW PLACE THAT LOT
;	'ACCEPT' FORMAT PROCESSING

ACC2:	SKIPL	TERMK		;[200] EOL ALREADY?
	 JRST	BADSYN		;[200] YES
	PUSHJ	P,EVAL
	   JRST	ERR6		;NO SUCH STATEMENT NO
	PUSHJ	P,FRMSET	;SET UP TO ACCESS A FORMAT STATEMENT
	  JRST	RET		;CANT DO IT!
	MOVE	P1,T4		;FORMAT START
	MOVE	P2,T2		;FORMAT END

;	HERE WITH A RECOGNISED FORMAT REFFERENCE SET UP


ACC3:	MOVE	T5,[POINT 7,(P1)]
	pushj	p,loadch	;GET A USER CHARACTER
	CAIE	T2," "		;BLANKS
	CAIN	T2,11		; AND TABS IGNORED TO START WITH
	JRST	ACC3

	MOVE	T3,[pushj p,loadch]
	MOVEM	T3,GETCHR	;SET TO READ FROM USER
	PUSHJ	P,GETSK2
	CAIE	T2,"("		;FIRST FORMAT CHARACTER MUST BE (
	JUMPA	T2,BADSYN
ACC4:	ILDB	T3,T5		;INCREMENT POINTER NOW
	HRRM	T5,.+1
	CAIG	P2,(P1)		;HAVE WE EXHAUSTED THE FORMAT
	JRST	[JUMPE	T2,RET
		 JRST	ERR13]	;YES
	DPB	T2,T5		;STORE NEXT CHARACTER
	JUMPE	T2,ACC4

ACC6:	pushj	p,loadch	;GET ANOTHER USER FORMAT CHARACTER
	CAIE	T2," "		;NOW ALLOW
	CAIN	T2,11		;BLANKS AND TABS AS USER WANTS
	CAIA
	PUSHJ	P,GETSK2
	JUMPN	T2,ACC7		;NOT THE LAST CHARACTER YET IF NON ZERO
	CAIE	T4,")"		;LAST USER CHARACTER MUST BE A )
	JRST	ERR32		;  IT WASN'T SO COMPLAIN
ACC7:	MOVE	T4,T2		;REMEMBER THE LST USER CHARACTER
	CAIE	T2,37		;DOES USER WANT LINE CONTINUATION = ^_
	JRST	ACC4		;NO - NORMAL

ACC5:	pushj	p,loadch	;ACCEPT ANOTHER USER CHARACTER
	CAIN	T2,12		;UNTIL END OF LAST LINE
	JRST	ACC6
	JRST	ACC5		;DO A CONTINUATION
;	TYPE LOGIC

DISPLA:	SKIPN	ESCAPE		;CAN WE USE FOROTS?
	JRST	ERR30		;NOT AFTER A ^C RE-ENTER
	PUSHJ	P,CHKIWI	;[211] RECURSIVE IO IF WE CALL THE OTS?
	 JRST	ERRIWI		;[211] YES, TELL AND RETURN TO COMMAND LOOP.
	PUSHJ	P,FORBUF	;[211] OK, CLEAR FOROTS BUFFER
	SETZM	CURGRP		;CLEAR CURRENT GROUP STACK FLAGS
	TRO	T1,TYPCMD	;[171] Remember it's a TYPE command
	TLO	T0,CFLIU!GRPFL	;SET CORE FILE IN USE - ALLOW GROUPS
	CLEARM	GETCHR		;THIS IS THE FIRST ACCESS TO CORE FILE THIS LINE
	TLNE	T0,EOL		;USER GAVE ANY ARGUMENTS?
	TLOA	T0,OFCFL	;NO - GET THEM FROM CORE FILE
	TLZ	T0,OFCFL	;YES - PUT THEM INTO CORE FILE
	PUSHJ	P,DISP4		;DISPLAY ROUTINE
	TLZ	T0,CFLIU!OFCFL!GRPFL ;PULL DOWN DANGEROUS FLAGS
	PUSHJ	P,REINOP	;REINSTATE OPEN PROGRAM
	JRST	RET		;END OF TYPE COMMAND

DISP4:	CLEARM	RANGE		;CLEAR FOR RANGE INDICATION
	CLEARM	CLMOFF		;[157]Initialization
	CLEARM	CLMRNG		;[157]
	CLEARM	SSLOW		;[401]ZERO THE LOWER SUBSTRING BOUND
	CLEARM	SSUP		;[401]ZERO THE UPPER SUBSTRING BOUND
	HLRS	P3		;[323] Use default flags
	PUSHJ	P,SYMIN		;GET USERS NEXT SYMBOL VALUE
	   JRST	DISP9		;NOT THERE
	   CAIA			;STATEMENT # FOUND
	JRST	DISP2		;TRUE VARIABLE

;	FORMAT STATEMENT PROCESSOR


DISP13:	PUSHJ	P,FRMSET	;SET UP TO ACCESS A FORMAT STATEMENT
	  JRST	DISP5		;CANNOT DO IT

;	NOW FOUND A RECOGNISED FORMAT STATEMENT

	MOVE	T3,[POINT 7,(T4)]
	MOVEI	P1,SYM		;SET UP FOR SYMBOL PRINT
	TRZ	T1,LNAME	;[402] clear long name flag
	PUSHJ	P,SPT		;PRINT SYMBOL=STATEMENT #
	TYPE(	FORMAT)
DISP6:	ILDB	T5,T3		;GET A CHARACTER FROM THE FORMAT TEXT
	HRRM	T3,.+1		;GET NO OF WORDS DONE
	CAIG	T2,(T4)		;ALL DONE?
	JRST	DISP5		;DONE WITH FORMAT
	putchr	(T5)		;TYPE IT
	JRST	DISP6		;MORE TO DO - BACK FOR MORE
;	SET UP ACCESS TO A FORMAT STATEMENT  T4=START  T2=END
;	SKIP ON SUCCESS.

FRMSET:	MOVEI	T4,(T5)		;SHOULD POINT TO A JRST
	LINE
	LDB	T5,[POINT 7,(T4),6]	;GET FIRST CHARACTER OF FORMAT
	CAIE	T5,"("		;FIRST CHARACTER MUST BE A (
	PJRST	ERR16		;USER LOSES
	MOVE	T5,T4		;ACCEPTED START OF FORMAT -
	MOVEM	T5,SAVLOC	; NOW FIND END OF F10 FORMAT
	HRREI	T5,-12		;CHANGE LABEL+P TO LABEL+F
	ADDM	T5,SYM		;LIKE SO
	PUSH	P,T4		;SAVE (T4)
	PUSHJ	P,EVAL		;LOCATE THE FORMAT END
	  JRST	[POP	P,T4	;[403]
		JRST	ERR41]	;[403]CANT FIND FORMAT END
	POP	P,T4		;RESTORE
	MOVEI	T2,1(T5)	;SET UP END OF FORMAT IN T2
	JRST	CPOPJ1		;T4 START - T2 END . . . ALL SET UP

VAL2:	TAB
	MOVE	T5,RANLIM	;GET THE CURRENT VALUE POINTER
	MOVE	T5,1(T5)	;GET THE NEXT VALUE
	POPJ	P,

;	IMPLIED RANGE   I.E. TYPE ARRAY

DISP2:	CAIN	T2,"-"
	JRST	DISP1		;GET LIMIT OF RANGE
	TRZN	T1,IMPRNG	;IS THIS A SIMULATED RANGE
	JRST	DISP10		; NO - JUST NORMAL

DISP11:	PUSHJ	P,DISP14	;SET UP RANGE WITH UPPER LIMIT
	TLO	T0,GRPFL	;[323] PERMIT GROUP LOGIC AGAIN


;	ONE-SHOT TYPE REQUEST
;	ENTER WITH SYMBOL VALUE IN T5
;	ENSURE TERMK,RANGE=0

DISP10:

	MOVEM	T5,LWT		;SAVE SYMBOL VALUE
	MOVE	T5,(T5)		;GET CONTENTS OF SYMBOLIC ADDRESS
	EXCH	T5,LWT		;SAVE CONTENTS AND GET SYMBOL VALUE
				;SAVE SYMBOL VALUE IN CASE WE DO A RANGE
	MOVEM	T5,RANLIM	;SAVE FOR RANGE NAME ID SUPRESSION
	TRO	P3,ANYMOD	;[173]FLAG FIRST PRINT ON LINE
	PUSHJ	P,OFFSET	;TYPE USERS SYMBOL
	 JRST	DISP9
				;[202]
	EXCH	T5,SYM		;GET BACK SYMBOL CONTENTS

	TRNN	P3,C.		;[157]Character string?
	 JRST	TYPF		;[157]NO. Next test

;	*** TYPE CHARACTER ***
	DMOVE	T2,@SAVLOC	;[157]Load ptr & length
	MOVE	T4,T3		;[163]Save string length
	IMUL	T4,CLMOFF	;[157]Compute for ADJBP
	SKIPN	SSLOW		;[401]
	JRST	DCOMOF		;[401]
	MOVE	T3,SSUP		;[401]	
	SUB	T3,SSLOW	;[401]
	AOJ	T3,		;[401] t3 = length = upper - (lower - 1)
	ADD	T4,SSLOW	;[401]
	SOJ	T4,		;[401] t4 = array offset + (lower - 1)
DCOMOF:	ADJBP	T4,T2		;[157]Create BP to element
	MOVE	T2,T4		;[157]Get the adjusted pointer
CHKPTR:	MOVEI	T5,T2		;[163]T5=Location of descriptor to validate
	PUSHJ	P,CKBPTR	;[163]Validate; return if OK
	MOVE	T5,T2		;[163]T5=address to validate
	PUSHJ	P,CKREAD	;[163]Validate;return if OK
CKBIG:	TRNE	P3,B.		;[157]Display whole string?
	 JRST	TYPEC		;[157]YES. skip size check
	CAILE	T3,^D256	;[157]Large string?
;***	flag
	 MOVEI	T3,^D256	;[157]YES. truncate

TYPEC:	PUSHJ	P,DSPSTR	;[162]Put out string
	JRST	TYPF		;[157][164]Go check for other type-out modes

;	DSPSTR is a routine to display character strings.
;	DSPST1 is an entry point to allow TYPCS (from PAUSE) to display
;	character strings without calling JUSTIFY.

DSPSTR:	JUSTIFY			;[164](VARIABLE NAME),TAB,=
;	TYPE	( )		;[157]Space
DSPST1:	TYPE	(')		;[157]Initial quote
BYTLUP:	IBP	T2		;[163]Destination address
	MOVE	T5,T2		;[163]T5=location of address to validate
	LDB	T4,[POINT 6,T2,05] ;[163]Get byte position within word
	CAIN	T4,BYT2T5	;[163]First byte in this word?
	PUSHJ	P,CKREAD	;[163]YES. Validate source; return here if OK
	LDB	T5,T2		;[163]Store byte
	CAIN	T5,"'"		;[157]Single quote?
	 PUSHJ	P,ASCOUT	;[157]YES. double it
	PUSHJ	P,ASCOUT	;[157]Display it
	SOJG	T3,BYTLUP	;[157]Loop til thru
	TYPE	(')		;[157]Concluding quote
	POPJ	P,
;***	check for truncated string?

;	*** TYPE FLOATING ***

TYPF:	TRNN	P3,F.		;TEST THE FLOATING FLAG
	JRST	TYPD		;NO REAL TRY DOUBLE REAL
	JUSTIFY
	MOVEI	T3,4		;ARG TYPE REAL FOR FOROTS
	PUSHJ	P,FOROUT	;ONE ARG OUTPUT

;	*** TYPE DOUBLE REAL ***

TYPD:	TRNN	P3,D.		;TEST FOR DOUBLE REAL
	JRST	TYPX		;NO FLOATING TRY COMPLEX
	JUSTIFY
	MOVE	T3,RANLIM	;GET ARG POINTER
	MOVE	T5,1(T3)	;GET SECOND ARG
	MOVEM	T5,ARGVAL+1	;SAVE 2ND. HALF FOR FOROTS
	MOVE	T5,(T3)		;RE-INSTATE IST.ARG IN T5
	MOVEI	T3,TP%DPR	;[137]Set up for default D-float arg type=10
	TRNE	T0,GFLOAT	;[137]If D-float, skip to FOROTS call.
	MOVEI	T3,TP%DPX	;[137] else, we have G-float, set are type=13
	PUSHJ	P,FOROUT	;OUTPUT REAL*8

;	*** TYPE COMPLEX ***

TYPX:	TRNN	P3,X.		;[157]TEST FOR COMPLEX TYPE OUT
	JRST	TYPI		;NO COMLEX TRY FOR INTEGER
	JUSTIFY
	MOVE	T3,RANLIM	;GET ARG POINTER
	MOVE	T5,1(T3)	;GET SECOND ARG
	MOVEM	T5,ARGVAL+1	;SAVE 2ND HALF FOR FOROTS
	MOVE	T5,(T3)		;REINSTATE 1ST ARG IN T5
	MOVEI	T3,14		;SET UP ARGTYPE FOR COMPLEX
	PUSHJ	P,FOROUT	;ONE ARG OUTPUT

;	** TYPE INTEGER ***

TYPI:	TRNN	P3,I.		;TYPE AS INTEGER?
	JRST	TYPO		;NO - TRY OCTAL
	JUSTIFY
	MOVEI	S1,^D10		;PREPARE FOR DECIMAL TYPE OUT
	PUSHJ	P,FTOC		;CONSTANT PRINT

;	*** TYPE OCTAL ***

TYPO:	TRNN	P3,O.		;TYPE AS OCTAL?
	JRST	TYPA		;NO - TRY ASCII
	JUSTIFY
	MOVEI	S1,10		;PREPARE FOR OCTAL PRINT
	PUSHJ	P,FTOC		;PRINT IN OCTAL
	TRNN	P3,B.		;[120] DOUBLE WORD
	JRST	TYPA		;NO - TRY ASCII
	PUSHJ	P,VAL2		;GET THE NEXT VALUE
	PUSHJ	P,FTOC		; DISPLAY THAT
;	*** TYPE ASCII ***

TYPA:	TRNN	P3,A.		;TYPE AS ASCII?
	JRST	TYPR		;NO - SEE IF RIGH JUSTIFIED ASCII
	JUSTIFY
	PUSHJ	P,TXT341	;THROW UP ASCII
	TRNN	P3,B.		;[120] DOUBLE?
	JRST	TYPR		;NO - TRY RASCII   ?????????
	PUSHJ	P,VAL2		;GET THE NEXT VALUE
	PUSHJ	P,TXT341	;AND TYPE THAT AS ASCII

;	*** TYPE RIGHT JUSTIFIED ASCII ***

TYPR:	TRNN	P3,R.		;TYPE AS ASCII RIGHT JUSTIFY
	JRST	TYPL		;[120] NO - TRY OCTAL
	JUSTIFY
	TYPE(R)			;RASCII IDENTIFIER
	LSH	T5,1		;MAKE LEFT JUSTIFIED ASCII
	PUSHJ	P,TXT341	;TYPE AS USUAL
	TRNN	P3,B.		;[120] DOUBLE RASCII?
	JRST	TYPL		;[120] NO
	PUSHJ	P,VAL2		;GET NEXT VALUE
	LSH	T5,1		;FAKE ASCII
	PUSHJ	P,TXT341	;TYPE AS ASCII

TYPL:	TRNN	P3,L.		;[120] TYPE AS LOGICAL?
	JRST	TYPS		;[120] NO - SEE IF IN RANGE
	JUSTIFY			;[120]
	JUMPGE	T5,TYPL1	;[124][120] IF POSITIVE, IT'S FALSE
	TYPE(.TRUE.)		;[124][120] IT MUST BE NEGATIVE SO TRUE
	JRST	TYPS		;[124][120]
TYPL1:	TYPE(.FALSE.)		;[124][120] IT'S POSITIVE

TYPS:	TRNN	P3,S.		;/S IS ILLEGAL FOR TYPE
	JRST	TYPN
	JRST	ERR37		; - ERROR
;	HERE AT END OF TYPING - EXAMINE RANGE CONDITION

TYPN:	LINE
	SKIPN	RANGE		;ARE WE IN A RANGE CONDITION
	JRST	DISP5		; NO
	TRNE	P3,C.		;[157]Character string?
	 JRST	TYPC		;[157]YES.
	AOS	T5,RANLIM	; YES INCREMENT VARIABLE
	TRNE	T0,DOUBLE	;[112] IS THIS A DOUBLE WORD ARRAY RANGE
	AOS	T5,RANLIM	;DOUBLE WORD ARRAYS GO UP BY TWO
	CAMG	T5,RANGE		;TO LIMIT OF RANGE
	 JRST	DISP10		;AND TYPE ALL REQUIRED
	JRST	DISP5		;[157]DONE. Go clean up
TYPC:	MOVE	T5,RANLIM	;[157]Restore base
	AOS	T2,CLMOFF	;[157]Count this element
	CAMG	T2,CLMRNG	;[157]Was that the last?
	 JRST	DISP10		;[157]NO. Go type next element

DISP5:	SKIPGE	TERMK		;[323] END OF USER INPUT LINE YET?
	JRST	DISP4		; NO - KEEP GOING
	POPJ	P,		; YES - END OF TYPE COMMAND

JUSTFY:	TRZN	P3,ANYMOD	;SEE IF FIRST OUTPUT THIS VARIABLE
	jrst	[LINE
		jrst	.+1]
	TYPE(	=  )
	MOVE	T5,LWT		;GET BACK THE OUTPUT VARIABLE CONTENTS
	POPJ	P,



;	GET THE LIMIT OF A RANGE CONDITION AND CHECK THE ORDER

DISP1:

;	if character, save original offset, get new offset, save as
;	hi offset. (ranlim?)
;
;
;


	MOVEM	T5,RANGE		;REMEMBER START OF RANGE

	MOVE	T5,CLMOFF	;[157]Get beginning offset
	MOVEM	T5,CLMRNG	;[157]Save it in case this is /C
	TLZ	T0,GRPFL	;NO GROUP REQUESTS HERE OR PRINT MODIFIERS
	MOVE	T5,MATHSM	;[403]SAVE CURRENT SYMBOL
	MOVEM	T5,TEM10	;[403]
	PUSHJ	P,SYMIN		;GET NEXT SYMBOL
	   JRST	DISP9		;BAD LABEL
	   JRST	BADSYN		;STATEMENT NO. ????
	MOVE	T4,TEM10	;[403]GET FIRST SYMBOL BACK
	CAME	T4,MATHSM	;ARE THEY THE SAME
	JRST	ERR40		;NO - SORRY
	TRZE	T0,SUBFLG	;WAS THERE AN IMPLIED RANGE
	JRST	DISP11		;YES - GO DEAL WITH IT

	CAML	T5,RANGE	;SORT OUT SYMBOL ORDER
	EXCH	T5,RANGE	;CHANGE THEIR ORDER
	CAIN	T2,"-"		;"-" IS A DELIMITER BUT IS BAD HERE
	JRST	BADSYN
	TLO	T0,GRPFL	;O.K. FOR GROUPS AGAIN

	TRNN	P3,C.		;[322] MODE Character?
	 JRST	DISP10		;[322] No - Now type range

;	clmrng=first offset given
;	clmoff=offset just received
DISP1B:	MOVE	T2,CLMOFF	;[157]Get the lower offset
	CAMLE	T2,CLMRNG	;[157]Is lower .le. upper?
	 EXCH	T2,CLMRNG	;[157]NO. Make it so
	MOVEM	T2,CLMOFF	;[157]Restore lower offset
	JRST	DISP10		;[157]Go type for the user
SYM4:	TLNE	T0,GRPFL	;ARE WE ALLOWING CORE STRINGS
	CAIE	T2,"/"		;AND IF SO DOES THE USER WANT ONE
	JRST	SYM1		;NOT IN GROUP LOGIC
;	ACCEPT TEMPORARY PRINT OPTION MODIFIERS

SYM15:	PUSHJ	P,OPTION	;GET THE PRINT OPTION SETTINGS
	  JRST	SYM14		;NUMERIC - MUST HAVE BEEN A GROUP REQUEST
	HRLS	P3		;[323] New settings become the default
	SKIPL	TERMK		;EOL?
	JRST	BADSYN		;CAN'T HAVE THAT!
	PJRST	SYMIN		;RESUME SYMIN ACTIVITIES

;	HANDLE GROUP REQUESTS

SYM14:	CAIL	T5,1
	CAILE	T5,GPMAX	;WHICH MUST BE IN RANGE
	JRST	ERR15		;NO GOOD
	CAIE	T2,","		;ALLOW COMMA AS DELIMITER
	JUMPN	T2,BADSYN	;ANYOTHER CHARACTER IS BAD


	PUSHJ	P,SYM5		;PROCESS GROUP CONTENTS


	POP	P,(P)		;REMOVE SYMIN PUSH
	JRST	DISP5		;ANYTHING ELSE ON USERS LINE?

SYM1:	TLNN	T0,GRPFL	;IS GROUP LOGIC IN ACTION
	JRST	RET		;ASSUME NUL INPUT GO BACK TO USER

	POP	P,(P)		;REMOVE THE SYMIN PUSH
	JUMPE	T2,DISP5	;EMPTY GROUP?
	JRST	BADSYN		;MUST BE BAD SYNTAX


;	ROUTINE TO DETERMINE THE LENGTH OF AN IMPLIED RANGE

DISP14:	MOVEM	T5,RANLIM	;SAVE THE BASE ARRAY REFFERENCE
	SETZM	PUTTER		;SET FOR RAYNAM
	PUSHJ	P,GET.RP	;GET THE RANGE PRODUCT FOR THIS ARRAY
	MOVE	T5,DIMTOT	;
	SOJ	T5,		;
	MOVEM	T5,CLMRNG	;[157]In case character
	TRNE	T0,DOUBLE	;[307] IS IT DOUBLE PRECISION?
	LSH	T5,1		;[307] YES, DOUBLE THE RANGE PRODUCT
	ADD	T5,RANLIM	;FORM UPPER RANGE LIMIT
	MOVEM	T5,RANGE	;SAVE THE RANGE
	MOVE	T5,RANLIM	;GET THE START ADDRESS
	POPJ	P,
;	ENTRY POINT FOR A GROUP 'TYPE' REQUEST
;	PUSHJ P,SYM5
;	WITH GROUP # 1-GPMAX IN T5
;	AND TERMK=0

SYM5:	TRZE	T1,DCOPFG	;DON'T OPEN PROG?
	JRST	SYM16		;NO - DON'T
	SKIPN	T4,GRP2(T5)	;GET GROUP'S PROG
	JRST	SYM16		;NULL - IGNORE IT
	CAMN	T4,OPENED	;IS IT CURRENT?
	JRST	SYM16		;YES
	MOVEM	T4,SYM		;NO - SAVE IT
	MOVSYM	OPENED,T4,OLDOPN;[402]Save OPENED into OLDOPN
	TRZ	T1,LNAME	;[402] ASSUME SHORT NAME
	SKIPE	GRPFLG(T5)	;[402] WAS IT SHORT
	 TRO	T1,LNAME	;[402] NO, SET LONG NAME FLAG
	PUSH	P,T5		;SAVE (T5)
	PUSHJ	P,IMPOPN	;DO THE OPEN AND MESSAGE
	POP	P,T5		;RESTORE (T5)

SYM16:	
;	CHECK FOR GROUP RECURSION

	MOVEI	T4,1
	LSH	T4,(T5)		;SET UP MASK BIT
	TDOE	T4,CURGRP	;CHECK AND SET
	JRST	ERR39		;GROUP ALREADY ACTIVE - ERROR
	MOVEM	T4,CURGRP	;SAVE STATE
	PUSH	P,T5		;SAVE T

	IMULI	T5,CFSIZ	;GET RELEVANT GROUP SECTION
	ADD	T5,[POINT 7,GRP1-CFSIZ]	;FORM POINTER TO IT

	RECURS <CFLPTR,CFLST,GETCHR,TERMK>
				;CFLPTR - SAVE CURRENT CORE POINTER
				;CFLST - SAVE CURRENT CORE LIMIT
				;GETCHR - SAVE CURRENT STRING SOURCE
				;TERMK - SAVE CURRENT DELIMITER DESCRIPTOR
	MOVEM	T5,CFLPTR	;SET UP NEW POINTER
	HRRZM	T5,CFLST	;DEFINE NEW STRING LIMIT
	MOVE	T5,[ILDB T2,CFLPTR] ;GET POINTER TO NEW INFORMATION
	MOVEM	T5,GETCHR	;STATE NEW STRING SOURCE
	PUSHJ	P,DISP4		;DO A RE-ENTER

	SRUCER			;POP BACK ALL ABOVE RECURS-ED VALUES

;	CLEAR CURRENT GROUP FLAG

	POP	P,T5		;GET NUMBER BACK
	MOVEI	T4,1
	LSH	T4,(T5)		;SET UP MASK
	TDC	T4,CURGRP	;CLEAR THIS GROUP FLAG
	MOVEM	T4,CURGRP	;SAVE IT

	PJRST	DISP5		;SEE IF THERE IS AN ORIGINAL USER
				;STRING TO PROCESS

DISP3:	PJRST	DISP9		;CANNOT FIND SYMBOL
;OPEN LOGIC
; input:  SYM contains section name
; output: OPENED contains section name
;         SSTAB points to secondary symbol table

SETNAM:	SETZM	SSTAB		;[402] Zero ptr to secondary symbol table
	CLRFLG	OPENED		;[402] Assume short name of open section
	TRNE	T1,LNAME	;[402] Looking for long symbol name?
	JRST	SETLNM		;[402] Yes
	PUSHJ	P,FINDP		;[321] Find program name
	 JRST	ERR6		; NO SUCH NAME
	MOVE	T5,SYM
	MOVEM	T5,OPENED	; PROGRAM NAME OPENED
	JRST	SETNM1		;[402]

SETLNM:	MOVSI	T2,LPNAME	;[402]Global prefix
	MOVEM	T2,SYMASK	;[402]Reset mask in case it's been munged
	PUSHJ 	P,FINDLG	;[402] Yes
	 JRST	ERR6		;[402] No such name
	MOVE	T5,SYM
	STSYM	T5,OPENED	;[402] PROGRAM NAME OPENED
	SOJ	T2,		;[402] Point to top of table
	MOVEM	T2,SSTAB	;[402] STORE PTR TO SECONDARY SYMBOL TABLE
	MOVE	T2,TMPSAV	;[402] Get .SYMTB entry in ddt symbol table
LG9LP:	ADDI	T2,2		;[402] Loop to find ddt entry for program name
	MOVE	T5,(T2)		;[402] Get name of entry
	TLNE	T5,PNAME	;[402] Program name?
	 JRST	LG9LP		;No

SETNM1:	HLRE	T5,1(T2)	;[321] Length of module (negative)
	MOVMM	T5,OPENLZ	;[321] Save positive size
	ADD	T5,T2		;[321] Point to beginning of
	ADDI	T5,2		;[321]   symbols for
	MOVEM	T5,OPENLS	;[321]   this module

	TRNN	T1,LNAME	;[402] Short program name?
	JRST	SETNM2		;[402] No
                                ;[402] Yes, Look for secondary symbol table
	MOVE	T5,[SQUOZE 0,.SYMTB]	;[402] .SYMTB in RAD50
	MOVEM	T5,SYM		;[402]
	PUSHJ	P,FINDL		;[402] Look for local .SYMTB
	 JRST	SETNM2		;[402] No .symtb
	MOVEM	T5,SSTAB	;[402] Store ptr to secondary symbol table 
SETNM2:	MOVE	T5,OPENED	;[402]
	MOVEM	T5,SYM		;[402]
	POPJ	P,
;	DIMENSION LOGIC
;
;	[301] Reworked
;
;	This is the heap which will contain dimension information.
;
;	Each heap entry contains three words, and come in three types:
;	     1) Empty
		DENXT==0	;Global index to next free entry
				;The remaining two words are unused
;
;	     2) Array Header
		DSNXT==0	;Global index to next array header
		DSDIM==1	;Global index to first dimension entry for
				;   this array.
		DSLOC==2	;Global index to the first element of the array

;	     3) Dimension information
		DDNXT==0	;Global index to next dimension for this array
		DDLOW==1	;Lower dimension
		DDRNG==2	;Number of elements (less 1) in this dimension
				;   Higher dimension = DDLOW + DDRNG

;	Bits 1-5 of DSDIM can contain flags.
;	Note that these bits are not used by global indexing.
		DFDBL==1B1	;The array contains double-word data
		DFCHAR==1B2	;The array contains character data

DIMTAB:	XLIST			;Allocate an empty heap
	REPEAT	DIMSIZ-1,<
	EFIW	.+3		;Next empty slot
	EXP	0		;Unused
	EXP	0		;Unused
>
DIMTE:	EXP	0		;Zero index in last entry
	EXP	0
	EXP	0
	LIST

DIMFF:	EFIW	DIMTAB		;Start of free slots
DIMLF:	EFIW	DIMTE		;End of free slots

DIMNAM:	EXP	0		;Global index to first array header
;	ROUTINE TO OBTAIN A FREE DIMTAB ENTRY
;	CALL PUSHJ P,GETRAY
;	     RETURN - ADDRESS OF SLOT IN T5

GETRAY:	MOVE	T5,DIMFF	;[301] Get the start of the free list
	MOVE	T2,DENXT(T5)	;[301] Find the location of the next slot
	JUMPE	T2,GETNON	;END OF LIST REACHED
	MOVEM	T2,DIMFF	;[301] Remove this entry from free list
	POPJ	P,		;RETURN WITH GOOD ENTRY ADDRESS IN T5

GETNON:	PUSHJ	P,FLUSHA	;REMOVE ALL STRUCTURES CREATED FOR
				;THE ARRAY VALUE IN SAVLOC
	TYPE(?FDTDTO Dimension table overflow)
	JRST	RET

;	SUBROUTINE TO RETURN A DIMTAB ENTRY TO THE FREE LIST
;	CALL PUSHJ P,PUTRAY
;	     ENTER WITH ADDRESS OF SLOT IN T5
;	     RETURN

PUTRAY:	MOVE	T2,DIMLF	;[301] Get address of end of free list
	MOVEM	T5,DENXT(T2)	;[301] Append the slot
	SETZM	DSNXT(T5)	;[301] Slot becomes end of list
	MOVEM	T5,DIMLF	;[301] Record that fact
	POPJ	P,
;	ROUTINE TO LOOK THROUGH LIST OF ARRAY NAMES TO FIND IF
;	THIS (SAVLOC) NAME IS ALREADY IN USE
;	CALL PUSHJ	P,RAYNAM
;	RETURN HERE IF NOT FOUND
;	RETURN HERE IF FOUND . . . T5=ADDRESS OF ARRAY,  T3=LAST ARRAY
;				   F10RAY IN T0 IS SET IF F10 DEFINED

RAYNAM:	TRZ	T0,FORMAL!F10RAY ;[105] ASSUME NEITHER HOLDS
				;[202]
	XMOVEI	T3,DIMNAM	;[301] Set up for
	MOVE	T5,(T3)		;[301]   first array
RAY:	JUMPE	T5,RAY3		;T3 WILL POINT TO THE END OF THE LIST
	MOVE	T2,DSLOC(T5)	;[301] THIS IS AN ARRAY BLOCK - GET THE VALUE
	CAMN	T2,SAVLOC	;ARE WE REDEFINING CURRENT NAME?
	JRST	RAY2		; YES - REMOVE THE ENTRY FIRST

	MOVE	T3,T5		;T3 WILL POINT TO THE CURRENT GOOD ENTRY
	MOVE	T5,DSNXT(T5)	;[301] Find the next entry
	JRST	RAY

RAY2:	TRZ	T0,DOUBLE!CHARS	;[301] Assume they are going to be off
	MOVE	T4,DSDIM(T5)	;[301] Flags from array entry
	TLNE	T4,(DFDBL)	;[301] Is it double word?
	TRO	T0,DOUBLE	;[301] Yes - Remember that
	TLNE	T4,(DFCHAR)	;[301] Character array?
	TRO	T0,CHARS	;[157]YES. mark it.
	JRST	CPOPJ1		;ARRAY IDENTIFIED EXIT
;	HERE IF NO USER DEFINITION EXISTS IN FORDDT DIMENSION LISTS
;	NOW CHECK FOR AN F10 DEFINITION

RAY3:	PUSH	P,T5		;SAVE BOTH T5 AND-
	PUSH	P,T3		;  T3 AROUND EVAL
	MOVE	T5,SAVLOC
	TRO	T0,SILENT	;DON'T PRINT SYMBOL
	PUSHJ	P,LOOK		;SETS UP P1 FROM T5
	  JRST	RAYPOP		;
	  JRST	RAYPOP		;DOSENT EXIST
	POP	P,T3		;RETURN T3
	POP	P,T5		; AND T5
	MOVE	S4,P1		;[321] GET THE ARRAY SYMBOL
	MOVE	T2,(S4)		; AND SEE IF WE HAVE AN F10 ARRAY -
	TRNE	T1,LNAME	;[402] Long name?
	JRST	RAY3A		;[402] Yes - skip 
	TLZ	T2,PNAME	;    DEFINITION -
	TLO	T2,(50B5)	;[301] THIS IS THE SAME SYMBOL
RAY3A:	CAME	T2,2(S4)	;[402]   WITH FLAGS 50 SET
	POPJ	P,		;NO - NOT AN F10 DEFINITION

	TRO	T0,F10RAY	;YES - FLAG THIS AS AN F10 ARRAY
	MOVE	S4,3(S4)	;SET POINTER TO ARRAY TABLE INFORMATION
	LDB	T2,[POINT 4,1(S4),12]
	TRZ	T0,DOUBLE	;[162]MAKE SURE DOUBLE IS OFF
	CAIE	T2,TP%DPR	;[112] [161]Double word array?
	 CAIN	T2,TP%DPX	;[162]NO. G-Floating double array?
	  TROA	T0,DOUBLE	;[162]YES FLAG IT & reset character flag
	CAIN	T2,TP%CPX	;[210]Complex is double word array also
	 TRO	T0,DOUBLE	;[210]Yes it's complex
	CAIE	T2,TP%CHR	;[161]Character array?
	 TRZA	T0,CHARS	;[161]NO
	TRO	T0,CHARS	;[161]YES
;[161]	LDB	T2,[POINT 9,1(S4),8]
	LDB	T2,[POINT 7,1(S4),8] ;[161]
	MOVEM	T2,DIMCNT	;SET UP THE NUMBER OF DIMENSIONS

	LDB	T2,[POINT 2,2(S4),1] ;[301] Array & Formal flags (V6 or before)
	CAIN	T2,2		     ;[301] V7 Fortran (or later)?
	 LDB	T2,[POINT 2,2(S4),3] ;[301] Yes - These flags instead
	TRNN	T2,1		;[301] Is it a formal array argument?
	 JRST	RAY5		;[301] No
	TRO	T0,FORMAL	;[301] Yes - Flag it
	XMOVEI	T5,@1(S4)	;[301] Get the actual array base
	MOVEM	T5,FRMSAV	;[301] Save the formal reference

RAY5:	ADDI	S4,3		;[301] SET TO POINT TO THE FIRST DIMENSION
	JRST	CPOPJ1


RAYPOP:	POP	P,T3		;[321] MUST RESET T3-
	POP	P,T5		; AND T5 BEFORE
	POPJ	P,		; GIVING A NO FOUND EXIT
;	ROUTINE TO CREATE AN ARRAY ENTRY
;	MUST HAVE A PAIR OF SUBSCRIPTS IN TEM,TEM1
;	 CALL PUSHJ P,PUTNAM
;	     ENTER WITH SAVLOC = VALUE OF NAME OF ARRAY

PUTNAM:	PUSH	P,T0		;SAVE FLAGS ROUND THE NEXT FEW LINES
	PUSHJ	P,SIMDEF	;SEE IF THIS ARRAY NAME IS AFTER BASE-ARRAY
PUTCHK:	PUSHJ	P,RAYNAM	;HAVE WE USED THIS NAME BEFORE?
	  JRST	PUTOK		;NO  - GO AHEAD - PLACE NEW NAME
	PUSHJ	P,FLUSH		;NAME ALREADY IN USE STAND BY FOR REDEFINITION
	TRZE	T0,FORMAL	;ATTEMPT TO RE-DIMENSION A FORMAL PARAMETER
	JRST	[POP	P,T0	;[403]
		JRST	ERR33]	;[403]NO YOU DON'T
	TRNN	T0,F10RAY	;F10 DEFINED ARRAY?
	JRST	PUTCHK		;RESET ALL
	JRST	ERR28		;WARN OF F10 REDEFINITION

PUTOK:	POP	P,T0		;RESTORE FLAGS FROM ABOVE
	PUSHJ	P,GETRAY	;[301] GET A SLOT - END OF NAMES = T3
	MOVEM	T5,T4		;SAVE FOR NAME DEFINITION - T4
	PUSHJ	P,GETRAY	;[301] GET A SLOT FOR DIMENSION DEFINITION
				;ENSURE WE HAVE 2 SLOTS FREE NOW
				;SAVE PAIN IN 'FLUSHING' LATER
	MOVEM	T4,DSNXT(T3)	;[301] SAY HELLO TO NEW MEMBER
	SETZM	(T4)		;NEW MEMBER BECOMES END OF CHAIN
	MOVE	T2,SAVLOC	;GET THE NEW MEMBERS NAME
	MOVEM	T2,DSLOC(T4)	;[301] ACCEPT THE NEW MEMBER TO THE FAMILY
	TRNE	T0,DOUBLE	;IS THIS A DOUBLE WORD ARRAY
	TLO	T5,(DFDBL)	;[301] YES - SAVE THE FACT
	TRNE	T0,CHARS	;[157]Character array?
	TLO	T5,(DFCHAR)	;[301] YES.
	MOVEM	T5,DSDIM(T4)	;[301] NEW MEMBERS ARE GIVEN A DIMENSION LIST
	PUSHJ	P,PUTSUB	;STORE THE SUBSCRIPTS
	JRST	CPOPJ1		;JUMP OVER POSSIBLE PUTDIM ENTRY

PUTSUB:	MOVE	T2,TEM1		;GET THE UPPER SUBSCRIPT
	SUB	T2,TEM		;[301] Compute the
	MOVEM	T2,DDRNG(T5)	;[301]    dimension range
	MOVE	T2,TEM		;[301] Save the
	MOVEM	T2,DDLOW(T5)	;[301]    lower dimension
	SETZM	DDNXT(T5)	;[301] End of present list
	MOVEM	T5,PUTTER	;SAVE THE END OF THE DIMENSION LIST
	POPJ	P,

;	ROUTINE TO ADD ANOTHER DIMENSION TO AN ARRAY DIMENSION LIST
;	CALL PUSHJ P,PUTDIM
;	     ENTER WITH TEM,TEM1 = LOWER AND UPPER SUBSRIPTS

PUTDIM:	PUSHJ	P,GETRAY	;[301] GET A FREE ENTRY
	MOVE	T2,PUTTER	;FIND WHERE THE LAST DIMENSION WAS STORED
	MOVEM	T5,DDNXT(T2)	;[301] Link new entry to list
	PJRST	PUTSUB		;SAVE THE SUBSCRIPTS
;	ROUTINE TO GET THE DIMENSIONS, IN ORDER, FOR THE ARRAY VALUE(SAVLOC)
;	CALL PUSHJ P,GETDIM
;	WITH ARRAY VALUE IN SAVLOC AND PUTTER = 0 FOR FIRST CALL
;	EXIT WITH TEM=SUB LOWER   TEM1=SUB UPPER

GETDIM:	SKIPE	T5,PUTTER	;IS THIS THE FIRST CALL?
	JRST	GET4		; NO - GET NEXT DIMENSION RANGE

	PUSHJ	P,RAYNAM	;YES - SET UP THE ARRAY REFERENCES
	  JRST	E5		;SAVLOC NAME NOT KNOWN??
	TRNE	T0,F10RAY	;F10 DEFINED?
	JRST	GET3		;YES
	MOVE	T5,DSDIM(T5)	;[301] GET THE START OF DIMENSION LIST
	JRST	GET5		;FIRST TIME IS SPECIAL
GET4:	TRNE	T0,F10RAY	;F10 ARRAY DEFINITION?
	JRST	GET3		;YES
	MOVE	T5,DDNXT(T5)	;[301] GET NEXT DIMENSION IF ANY
GET5:	JUMPE	T5,ERR22	;END OF LIST - TOO MANY DIMENSIONS EXPECTED
	MOVEM	T5,PUTTER	;SAVE LINK TO NEXT DIMENSION
	MOVE	T3,DDLOW(T5)	;[301] Get the
	MOVEM	T3,TEM		;[301]  lower dimension
	ADD	T3,DDRNG(T5)	;[301] Form the
	MOVEM	T3,TEM1		;[301]  upper dimension
	POPJ	P,


;	HERE TO GET THE NEXT UPPER AND LOWER BOUNDS
;	FOR AN F10 DEFINED ARRAY

GET3:	SETOM	PUTTER		;FLAG NOT FIRST TIME FOR F10 ARRAYS
	SOSGE	DIMCNT		;ARE THERE ANY MORE DIMENSIONS TO COME?
 	JRST	ERR22		;NO HARD LUCK
	MOVE	T5,@(S4)	;GET THE LOWER BOUND
	MOVEM	T5,TEM		;SAVE LOWER
	MOVE	T5,@1(S4)	;GET THE UPPER BOUND
	MOVEM	T5,TEM1		;SAVE UPPER
	ADDI	S4,3		;[301] S4 NOW POINTS TO NEXT DIMENSION-
	POPJ	P,		;	IF ANY
;	ROUTINE TO GUARD AGAINST SIMULTANEOUS SINGLE COMMAND RE-DIMENSIONING
;	OF THE SAME ARRAY. THE LOCATION BASRAY CONTAINS A REFFERENCE TO
;	THE ARRAY NAME WHICH STARTED THE CURRENT DIMENSION WORKING
;	AND WILL BE THE POINT IN THE NAMES LIST AFTER WHICH A REDEFINITION
;	OF THE NAME NOW FOUND IN SAVLOC WILL BE ILLEGAL

SIMDEF:	MOVE	T4,SAVLOC	;GET THE NEW ARRAY NAME(VALUE)
	EXCH	T4,BASRAY	;SAVE AND START AT BASE-ARRAY NAME
	PUSHJ	P,RAYNAM	;SET UP POINTERS TO BASE-ARRAY
	  POPJ	P,		;   ????
	MOVEM	T4,BASRAY	;RESET BASE ARRAY AND CURRENT NAME
	TRNE	T0,F10RAY	;F10 DEFINED ARRAY?
	POPJ	P,		;MUST BE A NEW DEFINITION
	PUSHJ	P,RAY		;SEE IF THIS ARRAY NAME OCCURS AFTER BASRAY
	  POPJ	P,		;NO
	TYPE	(?FDTMLD )
	MOVE	T5,SAVLOC	;GET THE OFFENDING VALUE
	PUSHJ	P,LOOK		;DISPLAY IT
	  JFCL
	  JFCL
	TYPE( Multi-level array definition not allowed.)
	PUSHJ	P,FLUSHA	;FLUSH ALL FROM BASRAY TO END OF NAME LIST
	JRST	RET		;EXIT TO USER MODEFORDDT


;	ROUTINE TO ENSURE THAT THERE ARE NO MORE DIMENSIONS
;	TO BE CHECK FOR THIS (SAVLOC) ARRAY

SUBCHK:	PUSHJ	P,MORDIM	;ARE THERE ANY MORE DIMENSIONS LEFT
	POPJ	P,		;O.K.
	JRST	ERR1		;NOT ENOUGH DIMENSION INFO

;	TYPE THE DIMENSION LIST FOR THE ARRAY NAME VALUE IN SAVLOC

DIM1:	PUSHJ	P,RAYNAM	;SET UP REFERENCES TO THIS ARRAY NAME
	JRST	ERR34		;NONE SUCH
	TRNE	T0,F10RAY	;IS THIS AN F10 DEFINED ARRAY
	SKIPA	T4,[EXP SAVLOC-1]  ;IF SO FOOL TYPDIM
	MOVE	T4,T5		;PREPARE FOR TYPDIM
	PUSHJ	P,TYPDIM	;TYPE OUT THE DIMENSIONS
	JRST	RET		;ALL DONE
;	ROUTINE TO REMOVE AND RETURN(GARBAGE COLLECTION) ALL REFERENCE
;	TO THE ARRAYS WHICH FOLLOW THAT DEFINED IN SAVLOC IF FLSHAL IS SET

FLUSHA:	TRO	T0,FLSHAL	;SET UP TO FLUSH ALL FROM BASE-ARRAY
	MOVE	T5,BASRAY	;GET THE BASE ARRAY VALUE
	MOVEM	T5,SAVLOC	;AND SET UP FOR RAYNAM
	PUSHJ	P,RAYNAM	;RESET F10RAY FLAG TO NEW BASRAY SETTING
	  POPJ	P,		;?????

FLUSH:	TRNN	T0,F10RAY	;NOTHING TO DO IF AN F10 ARRAY
	PUSHJ	P,RAYNAM	;SET UP POINTERS TO THE ARRAY IN SAVLOC
	  POPJ	P,		; CAN'T FIND THE ARRAY NAME
				;T3=POINTS TO LAST ARRAY NAME BLOCK
				;T5= CURRENT ARRAY NAME BLOCK
FLUSH2:	MOVE	T4,DSDIM(T5)	;[301] GET DIMENSION LIST ADDRESS
	MOVE	T2,DSNXT(T5)	;[301] GET NEXT MEMBER ADDRESS
	MOVEM	T2,DSNXT(T3)	;[301] LOOP OUT THE OFFENDING ARRAY NAME ENTRY
	PUSHJ	P,PUTRAY	;[301] RETURN A ENTRY
	PUSHJ	P,DELIST	;DELETE THE LIST STARTING AT C(T4)
	TRNN	T0,FLSHAL	;HARD FLUSH?
	POPJ	P,		;JUST ONE ARRAY FOR NOW
	MOVE	T5,DSNXT(T3)	;[301] GET NEXT ARRAY REFERENCE IF ANY
	JUMPE	T5,CPOPJ	;EXIT IF END OF LIST
	JRST	FLUSH2		;MORE TO DO

;ROUTINE TO DELETE A LIST - STARTING IN T4

DELIST:	SKIPN	T5,T4		;TEST FOR END OF LIST - RETURN ENTRY IN T5
	  POPJ	P,		;END OF LIST
	MOVE	T4,DDNXT(T4)	;[301] GET NEXT ENTRY ADDRESS
	PUSHJ	P,PUTRAY	;[301] RETURN THE OLD ENTRY
	PJRST	DELIST		;FOLLOW THROUGH TO END OF LIST

DIM5:	PUSHJ	P,DIMOUT	;DISPLAY ALL ARRAY INFO.
	LINE
	JRST	RET
;	DIMENSION LOGIC
CARRAY:	TROA	T0,CHARS	;[157]Character array

DUBLE:	TRO	T0,DOUBLE	;[112] FLAG THIS AS A DOUBLE WORD ARRAY

DIM:	JUMPL	T0,DIM5		;OUTPUT ALL DIMENSION SPECS
	PUSHJ	P,TTYIN		;GET NEXT USER STRING
	JUMPE	T3,DIM5		;TYPE ALL ARRAYS IF EOL

	PUSHJ	P,ALLNUM	;SEE IF USER TYPED A LABEL
	  JRST	DIM13		;NO - MUST BE VARIABLE
	JRST	BADSYN		;BAD SYNTAX
DIM13:	PUSHJ	P,VALID		;CHECK VALIDITY OF VARIABLE
	STSYM	T4,MATHSM	;[402]THATS WHAT USER TYPED
	MOVEM	T4,SYM		;SAVE FOR 'EVAL'UATION
	PUSHJ	P,EVAL		;EVALUATE SYMBOL
	  JRST	ERR6		;WE DON'T HAVE IT
	MOVEM	T5,SAVLOC	;SAVE ARRAY NAME VALUE
	MOVE	T2,LSTCHR	;RE-INSTATE USERS LAST CHARACTER
	SKIPL	TERMK		;END OF LINE?
	JRST	DIM1		;YES - USER WANTS TO SEE DIMENSION LIST

	PUSHJ	P,NXTCHR	;MOVE TO NEXT SIGNIFICANT CHARACTER
	CAIN	T2,"("		; [ DENOTES START OF DIMENSION DEFINITION
	JRST	DIM14		;COMMAND - WILL NOW BE NON ZERO

	CAIE	T2,"["		; ( IS AN ALTERNATIVE TO [
	JRST	DIM7
	TLO	T0,LFTSQB	;FLAG THAT A LSB FOUND - SO RSB MUST END SPEC
DIM14:	PUSHJ	P,DIMIN		;SET UP A NEW ARRAY DEFINITION
	JRST	RET

DIM7:	CAIE	T2,"/"		;A / IS ACCEPTABLE TO REMOVE ARRAYS
	JRST	BADSYN		;ANYTHING ELSE WONT DO
	PUSHJ	P,TTYIN		;GET NEXT INPUT
	JUMPN	T2,BADSYN	;MUST BE LINE END NOW
	JUMPE	T3,BADSYN	;NO CHARACTERS??
	LSHC	T2,6		;GET THE FIRST SWITCH CHARACTER
	CAIE	T2,'R'		;DID THE USER REQUEST A REMOVE
	JRST	BADSYN		;NO - WELL TOO BAD
	PUSHJ	P,RAYNAM	;SEE IF WE KNOW ABOUT HIS ARRAY
	  JRST	ERR26		;NO - TELL HIM
	PJRST	DMFLSH		;REMOVE IT
;	ROUTINE TO SET UP A NEW ARRAY DEFINITION

DIMIN:	SETZM	DIMTOT		;CLEAR TOTAL ELEMENT COUNT
	TROE	T0,BASENM	;HAS A BASE NAME BEEN ACCEPTED
	JRST	DIM0		;YES - DON'T FLUSH YET
	SETZM	F10RP		;[163]Reset
	PUSH	P,T0		;PROTECT THE DOUBLE FLAG AWHILE
	PUSHJ	P,RAYNAM	;HAVE WE HAD THIS BASE ARRAY BEFORE
	 JRST	DIMBAS		;[163]No references to this array
	TRNE	T0,F10RAY	;[163]Compiler reference?
	 JRST	DRNGPR		;[163]YES. Go get range product
	PUSHJ	P,FLUSH		;[163]Clear user reference
	PUSHJ	P,RAYNAM	;[163]Look for compiler reference
	 JRST	DIMBAS		;[163]None
	TRNN	T0,F10RAY	;[163]Better be F10 defined!!!!
	 JRST	DIMBAS		;[163]NOT!!!!!
DRNGPR:	SETZM	PUTTER		;[163]Reset first-time flag
	PUSHJ	P,GET.RP	;[163]Get the compiled range-product
	MOVE	T5,DIMTOT	;[163]Load the range product
	MOVEM	T5,F10RP	;[163]Save it
	SETZM	DIMTOT		;[163]Clear
bpw==5
DIMBAS:	MOVE	T5,SAVLOC	;GET THE ARRAY VALUE
	MOVEM	T5,BASRAY	;MARK THIS AS OUR BASE ARRAY
	POP	P,T0		;RE-INSTATE THE DOUBLE FLAG IF THERE

DIM0:	TRO	T0,SURGFL	;FLAG THIS CALL AS SUBSCRIPT GATHERING
	PUSHJ	P,EITHER	;READ A SUBSCRIPT
	  CAIA			;CONSTANT
	  MOVE	T5,(T5)		;VARIABLE - GET VALUE
	TRZ	T0,SURGFL	;CLEAR SUBSCRIPT RANGE ACCEPT FLAG
	MOVEM	T5,TEM1		;SAVE TEMPORARILY AS UPPER SUBSRIPT
	PUSHJ	P,NXTCHR	;MOVE TO NEXT CHARACTER
	CAIN	T2,","		;COMMA IS THE USUAL DELIMITER
	JRST	DIMCOM		;PROCESS A COMMA

	CAIE	T2,":"		;A : IS AS GOOD AS A BAR=/
	CAIN	T2,"/"		;BAR IS THE SUBSCRIPT SEPARATOR
	JRST	DIMBAR		;PROCESS A BAR
	TLNN	T0,LFTSQB	;SKIP IF WE HAD A [ TO START
	ADDI	T2,"]"-")"	;ACCEPTABLE DELIMITER IF )
	CAIN	T2,"]"		;ONLY ] ACCEPTED AS DELIMITER
	JRST	DIM4		;DENOTE END OF DEFINITIONS

	PUSHJ	P,FLUSHA	;REMOVE THE PRESUMABLY WRONG DEFINITION
	JRST	BADSYN		;COMPLAIN ABOUT SYNTAX
DIM4:	TLO	T0,DIMEND	;FLAG THAT THIS IS THE END OF THE LIST
DIMCOM:	TLZE	T0,BAR		;HAVE HAD TWO SUBSCRIPTS?
	JRST	DIM2		;YES - CHECK THE ORDER
	MOVEI	T5,1		;ADJUST LOWER SUBSCRIPT TO BE 1
	MOVEM	T5,TEM		;LOWER SCR IN TEM
DIM2:	MOVE	T5,TEM1		;GET THE SECOND SUBSCRIPT
	CAMGE	T5,TEM		;ENSURE THAT IT IS GREATER THAN THE FIRST
	JRST	ERR3		;TELL USER ABAOUT THE ERROR
;[301]	SUB	T5,TEM		;FIND THE RANGE
;[301]	CAIG	T5,777777	;CANT HAVE ARRAYS OWNING WHOLE OF CORE
;[301]	JRST	DIM3		;SUBSCRIPTS OK
;[301]	JRST	ERR27		;BAD SUBSCRIPTS

	SKIPN	DIMTOT		;[301] IS THIS THE FIRST SETTING FOR THIS ARRAY
	PUSHJ	P,PUTNAM	;YES - USE PUTNAM
	PUSHJ	P,PUTDIM	;N0  - ADD ANOTHER DIMENSION
	MOVE	T5,TEM1		;GET UPPER SUBSCRIPT
	SUB	T5,TEM		;FORM RANGE
	AOJ	T5,		;MUST HAVE AT LEAST ONE
	SKIPN	DIMTOT		;IS THIS THE FIRST DIMENSION
	AOS	DIMTOT		;YES - MAKE FIRST RANGE DEFAULT = ONE
	IMULM	T5,DIMTOT	;FORM TOTAL SUBSCRIPT COUNT IN DIMTOT
	TLNN	T0,DIMEND	;WAS A RIGHT SQUARE BRACKET SEEN LAST?
	JRST	DIM0		;NO - BACK FOR MORE

	PUSHJ	P,ARYSIZ	;[301] Get the true size
	 JRST	ERR27		;[301] Too big

	SKIPE	T5,F10RP	;[301] Was there a compiler definition?
	 CAML	T5,DIMTOT	;[301] Yes - Is that less than user wants?
	  POPJ	P,		;[301] Looks OK

	LINE
	TYPE	(<%FDTABX >)	;WARNING
	PUSHJ	P,TYPRAY	;TYPE THE (SAVLOC) ARRAY NAME
	TYPE( compiled array bounds exceeded)
	POPJ	P,
DMFLSH:	PUSHJ	P,FLUSH		;THE WHOLE SETUP FAILS
	JRST	RET

TYPRAY:	MOVE	T5,SAVLOC	;GET THE OFFENDING ARRAY NAME
	TRZ	T0,SILENT	;SPEAK-UP
	PUSHJ	P,LOOK		;SHOW THE USER
	  JFCL
	  JFCL
	POPJ	P,
DIMBAR:	TLOE	T0,BAR		;FLAG A BAR IF NOT ALREADY SET
	JRST	BADSYN
	MOVE	T5,TEM1		;MOVE FIRST SUBSCRIPT TO APPROPRIATE PALCE
	MOVEM	T5,TEM		; IN TEM
	JRST	DIM0		;LOOK FOR SECOND SUBSCRIPT

NXTCHR:	SKIPL	TERMK		;END OF LINE?
	JRST	BADSYN		;YES - SHOULD'T BE
	JUMPN	T2,CPOPJ	;TERMINATOR?
	PJRST	GETSKB		;MOVE TO NEXT SIGNIFICANT CHARACTER

;	DISPLAY ALL ARRAY DATA ENTERED BY USER

DIMOUT:	LINE
ife tops20,<
	SKPINL			;INTERCEPT A USER CONTROL O
	JFCL>			;end of conditional
ifn tops20,<
	push	p,T1		;save T1
	push	p,T2		;save T2
	hrrzi	T1,.priou	;get terminal output designator
	rfmod%			;get terminal JFN word
	tlz	T2,(tt%osp)	;clear ^o effects
	hrrzi	T1,.priou	;get terminal output designator
	sfmod%			;set new JFN word
	pop	p,T2		;restore T2
	pop	p,T1>		;restore T1, end of conditional
	LINE
	SKIPN	T4,DIMNAM	;START AT HEAD OF ARRAY NAMES
	jrst	[TYPE(No )
		jrst	.+1]
	TYPE(Array specifications)
	LINE
	JUMPE	T4,CPOPJ	;EXIT IF NOTHING TO PRINT
	LINE
;[163]	TYPE(USED	MAX	ARRAY	DIMENSIONS)
	TYPE(USED		ARRAY	DIMENSIONS)
	LINE
	MOVE	T4,DIMNAM	;[301] Where first one is
TYPNXT:	JUMPE	T4,CPOPJ	;ALL PROCESSED?

	PUSHJ	P,TYPDIM	;NO - TYPE DIMENSIONS
	MOVE	T4,DSNXT(T4)	;[301] Find next array reference
	JRST	TYPNXT		;LOOK FOR MORE
;	TYPE THE DIMENSION LIST FOR THE ARRAY ENTRY IN T4

TYPDIM:	PUSH	P,T4		;SAVE T4 ROUND LOOK-UP
	LINE
	MOVE	T5,DSLOC(T4)	;[301] GET THE ARRAY NAME VALUE
	MOVEM	T5,SAVLOC	;SAVE THE ARRAY REFERENCE
	PUSHJ	P,GET.RP	;GET THE RANGE PRODUCT = DIMTOT
	MOVE	T5,DIMTOT	;GET TOTAL ELEMENT COUNT
	TRNE	T0,DOUBLE	;[301] Double-word elements?
	 LSH	T5,1		;[301] Yes - Get true size
	TRNN	T0,CHARS	;[163]Character array?
	 JRST	TYPLO		;[163]NO
	MOVE	T2,SAVLOC	;[163]Address/array descriptor
	IMUL	T5,1(T2)	;[163]Length of array in bytes
TYPLO:	PUSHJ	P,TYP0		;AND DISPLAY IT
	TAB
	tab
	SETZM	PUTTER		;RESET FOR RESCAN OF ARRAY'S DIMENSIONS
	MOVE	T5,SAVLOC	;GET THE ARRAY NAME VALUE
	TRZ	T0,SILENT	;[314] TURN OFF PRINT SUPPRESS SWITCH
	PUSHJ	P,LOOK		;DO A LOOK UP ON C(T5)
	  JFCL			;NOT FOUND
	  JRST	[POP	P,T4	;[403]
		JRST	E5]	;[403]  OR NOT EXACT??
	TAB
	TYPE([)
DIM10:	PUSHJ	P,GETDIM	;GET THE SUBSCRIPTS FOR THE NEXT DIMENSION IN TEM,TEM1
	MOVE	T5,TEM		;GET THE LOWER SUBSCRIPT
	PUSHJ	P,TYP0		;AND TYPE IT
	stype(":")
	MOVE	T5,TEM1		;GET TUE UPPER SUBSCRIPT
	PUSHJ	P,TYP0		;AND TYPE THAT
	PUSHJ	P,MORDIM	;ANY MORE DIMENSIONS?
	  JRST	DIM20		;NO
	stype(</,/>)
	JRST	DIM10		;PROCESS NEXT DIMENSION

DIM20:	TYPE(])
	POP	P,T4		;GET BACK ARRAY REFERENCE
	TRNE	T0,F10RAY	;F10 ORIGINATED?
	jrst	[TYPE( - F10 ORIGINATED)
		jrst	.+1]
	TRNE	T0,DOUBLE	;REAL*8
	jrst	[TYPE(  DP)
		jrst	.+1]
	TRNE	T0,CHARS	;[157]Character?
	JRST	[TYPE(  CH)
		JRST	FRMLCK]	;[157]
	TRNN	T0,DOUBLE	;REAL*4
	jrst	[TYPE(  SP)
		jrst	.+1]
FRMLCK:	TRNE	T0,FORMAL	;ARRAY IS A FORMAL ?
	jrst	[TYPE(  FORMAL)
		jrst	.+1]
	POPJ	P,
;	SUBROUTINE TO SEE IF THERE ARE ANY MORE DIMENSIONS TO COME
;	FOR THE CURRENT ARRAY
;	CALL PUSHJ P,MORDIM
;	     RETURN NO MORE
;	     RETURN MORE TO FOLLOW

MORDIM:	TRNE	T0,F10RAY	;F10 DEFINED ARRAY?
	JRST	MORD2		;YES
	SKIPN	T5,PUTTER	;EXIT IF PUTTER = 0
	POPJ	P,		;NO MORE TO COME
	MOVE	T5,DDNXT(T5)	;[301] NO MORE IF NEXT IN LINE = 0
	JUMPE	T5,CPOPJ	;T5 WILL BE ZERO IF THIS IS THE LAST DIMENSION
	JRST	CPOPJ1		;MUST BE MORE THERE

MORD2:	SKIPG	DIMCNT		;ANY MORE DIMENSIONS TO COME?
	POPJ	P,		;NO
	JRST	CPOPJ1		;YES


;	ROUTINE TO GET THE RANGE PRODUCT FOR THE ARRAY WHOSE VALUE
;	IS HELD IN SAVLOC.  EXIT WITH DIMTOT = RANGE PROD.

GET.RP:	SETZM	DIMTOT		;CLEAR THE ELEMENT COUNT CELL
	SETZM	PUTTER		;CLEAR FOR NEW SCAN IN GETDIM
DIM11:	PUSHJ	P,GETDIM	;GET THE NEXT SET OF DIMENSIONS FOR THE (SAVLOC) ARRAY
	MOVE	T5,TEM1		;GET THE UPPER SUBSCRIPT SU
	SUB	T5,TEM		;FORM SU-SL
	AOJ	T5,		;FORM SU-SL+1
	SKIPN	DIMTOT		;FIRST TIME IS SPECIAL
	AOS	DIMTOT
	IMULM	T5,DIMTOT	;FORM TOTAL SPACE DECLARED FOR THIS ARRAY
	PUSHJ	P,MORDIM	;SEE IF THERE ARE ANY MORE DIMENSIONS
	POPJ	P,		;[301] NO - ALL DONE
	JRST	DIM11		;YES - BACK FOR MORE

;[301]	TRNE	T0,DOUBLE	;[112] IS THIS ARRAY DOUBLE WORD
;[301]	ADDM	T5,DIMTOT	;YES - DOUBLE UP THE RANGE ACCESSED
;[301]	POPJ	P,		;WE NOW HAVE THE TRUE SCOPE OF THE ARRAY
;++
; FUNCTIONAL DESCRIPTION:
;
;	The number of elements (DIMTOT) is multiplied by the size of
;	each element to compute the total allocated size of the array.
;	That computed size is checked to insure that the array is not
;	too large.
;
;	Checks are made during the computation to insure that there will
;	be no arithmetic overflow.
;
; CALLING SEQUENCE:
;
;	PUSHJ P,ARYSIZ
;	Return here if array is too large
;	Return here normally
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	DIMTOT contains the number of elements in the array.
;	SAVLOC contains the global address of the array.
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--

;	[301] New

ARYSIZ:	PUSH	P,T4		;Save work registers
	PUSH	P,T5
	MOVE	T4,DIMTOT	;Number of elements in array
	TLNE	T4,(3B1)	;Can we have overflow problems?
	  JRST	ASIZ99		;Yes - Give up
	TRNE	T0,DOUBLE	;Double-word element?
	 LSH	T4,1		;Yes - Double the size
	TRNN	T0,CHARS	;Character data?
	JRST	ASIZ10		;No - Check the limits

	MOVE	T5,SAVLOC	;Yes - Location of pointer/size pair
	MUL	T4,1(T5)	;Multiply by element size
	JUMPN	T4,ASIZ99	;Quit
	TLNE	T5,(3B1)	;  if
	JRST	ASIZ99		;  too big
	MOVE	T4,T5		;Convert from
	ADDI	T4,4		;  characters
	IDIVI	T4,5		;  to words

ASIZ10:	IFN TOPS20,<
	SKIPN	EXTEND		;23 bits OK?
>
	 TLNN	T4,777777	; No - Cannot be more than 18 bits
	  TLNE	T4,777740	; Yes - Cannot be more than 23 bits
	   JRST	ASIZ99		;Too big

	AOS	-2(P)		;We will return to call+2

ASIZ99:	POP	P,T5		;Restore work registers
	POP	P,T4
	POPJ	P,
;	GROUP LOGIC

GROUP:	JUMPL	T0,GRPALL	;DISPLAY ALL GROUPS
	PUSHJ	P,GETNUM	;WHICH GROUP IS THE USER SETTING?
	JUMPLE	T5,ERR15	;NOT VALID
	CAILE	T5,GPMAX	;GPMAX IS THE MOST HE SHOULD ASK FOR
	JRST	ERR15
	GETFLG	T2,OPENED	;[402] Store flag saying whether OPENED has a 
	MOVEM	T2,GRPFLG(T5)	;[402] long name into group table entry
	MOVE	T2,OPENED
	MOVEM	T2,GRP2(T5)	;THIS GROUP BELONGS TO THIS SECTION	
	IMULI	T5,CFSIZ	;END OF GROUP AREA
	SKIPL	TERMK
	JRST	[PUSHJ P,GRTYP	;FORGETFULL USER WANTS TO SEE GROUP CONTENTS
		 JRST RET]
	ADD	T5,[POINT 7,GRP1-CFSIZ]
	MOVEM	T5,CFLPTR	;WHERE TO STORE NEW STRING
	HRRZM	T5,CFLST	;GUARD AGAINST OVERFLOW
	MOVE	T5,[PUSHJ P,I2CFIL]
	MOVEM	T5,GETCHR	;SETUP TTYIN TO READ CORE FILE

GRPMOR:	PUSHJ	P,I2CFIL	;CRAFTY READ AND STORE ROUTINE
	PUSHJ	P,GETSK2	;SET UP ANY DELIMITER FLAGS
	JUMPN	T2,GRPMOR	;IF NO DELIMITERS - DO MORE
	SKIPL	TERMK		;END OF INPUT?
	JRST	RET		; YES - ALL DONE
	JRST	GRPMOR		; NO - DO MORE, WAS A SPACE

;	DISPLAY THE CONTENTS OF THE GROUP WHOSE # IS IN T5

GRTYP:	HRRZM	T5,T3		;
	ADD	T5,[POINT 7,GRP1-CFSIZ,6]  ;[132]
	MOVE	T2,[ILDB T2,T5]
	MOVEM	T2,GETCHR	; INPUT FROM GROUP FILE
GRPNXT:	SETOM	TERMK		;SET UP FOR DELIMETER TEST
	LDB	T2,T5		;[132] GET NEXT CHAR FROM STRING
	PUSHJ	P,GETSK2	;END OF STRING?
	JUMPN	T2,.+2
	MOVEI	T2, " "		;SPACE IS SPECIAL
	SKIPL	TERMK
	POPJ	P,		;YES - IF TERMINAL CHARACTER TERMK +VE
	putchr	(T2)		;SHOW CHARACTER
	IBP	T5		;[132] POSITION FOR NEXT BYTE
	HRRZM	T5,T4
	CAIE	T4,GRP1(T3)	;OVERFLO CHECK
	JRST	GRPNXT		;KEEP GOING
	POPJ	P,		;BETTER STOP
;	GROUP STRING CORE STORAGE

GRP1:	REPEAT	GPMAX,<	XWD	050000,0 ;NULL GROUP CONTENTS
	BLOCK	CFSIZ-1		;SPACE FOR GROUP STRING
			>


GRP2=.-1
	BLOCK	GPMAX		;PROGRAM NAMES FOR GROUPS
GRPFLG:	BLOCK	GPMAX		;[402] FLAG = 0 IF PROGRAM NAME IS SHORT
CURGRP:	BLOCK	1		;BITS  TO FLAG CURRENT GROUP STACK
				;IN ORDER TO CATCH RECURSION
;	WHAT LOGIC

WHAT:	LINE
	TYPE(Open section: )
	LDSYM	T5,OPENED	;[402] Get name of opened section
	PUSHJ	P,SPT1		;TYPE NAME OF OPEN SECTION
	LINE
	SKIPA	T5,[0]		;FLAG DISPLAY OF EVERYTHING
PSEALL:	SETO	T5,		;FLAG DISPLAY OF PAUSES ONLY
	PUSH	P,T5		;SAVE FLAG
	MOVEI	T5,^D10
	MOVEM	T5,S1		;SET RADIX 10 AS STANDARD IN 'WHAT'
	MOVEI	T5,B1ADR	;START OF PAUSES
WT10:	SKIPE	(T5)
	JRST	WT9		;THERE IS AT LEAST ONE PAUSE SET
	ADDI	T5,1		;NO PAUSES SEEN SO FAR
	CAIG	T5,BNADR	;[300] ALL PAUSES EXAMINED?
	JRST	WT10		;NO
	HRRZI	T0,FO$GBA	;[332] HAVE FOROTS RETURN BREAK ADDRESS
	PUSHJ	P,FOROP.	;[332]   IN T0			
        SKIPN	@T0		;[332] IF @T0 IS NOT 0 THEN "PAUSE ON ERROR"
	JRST	[LINE
		TYPE(No pause requests)
		JRST	WT11]   ;[332]

WT9:	LINE
	MOVEI	P4,B1ADR	;GET START OF PAUSES
WT6:	HRRZ	T5,(P4)		;GET THE PAUSE ADDRESS
	JUMPE	T5,WT1		;[402]OMIT IF NO PAUSE SETTING

;	PAUSE IDENTIFICATION

	LINE			;[402]
	TYPE	(Pause: )	;[402]
	MOVE	T5,(P4)		;GET PAUSE ADDRESS
;[326]	TLO	T0,FGLSNM	;GLOBALS OK
	PUSHJ	P,LOOK		;LOOKUP SYMBOL
	  JRST	E1		;NOT THERE??
	  PUSHJ	P,SPT		;TYPE SUBROUTINE NAME
				;ADD PROGRAM NAME WHERE PAUSE IS
	LINE			;[402]
	TYPE	( Located in: )	;[402] 

	SKIPN	T5,PNAMSV	;[402]WAS A PROGRAM NAME FOUND?
	JRST	WT5B		;[402] NO
	PUSH	P,T1		;[402] Save T1
	LDFLG	PNAMSV		;[402]Set longname flag if needed
	PUSHJ	P,SPT1		;DISPLAY THAT
	POP	P,T1		;[402] Restore T1

;	ANY CONDITIONALS?

WT5B:	SKIPE	1(P4)		;[402]IS THIS A CONDITIONAL PAUSE?
	JRST	WT14		; YES


;	PROCEDE SETTING

WT5:	MOVE	T5,1(P4)	;GET CONDITIONAL SETTING
	JUMPN	T5,WT13		;[402] DISPLAY GROUP
	LINE			;[402]
	TYPE	( After: )	;[402]
WT2:	HRRE	T5,2(P4)	;[300] GET PROCEDE COUNT
	PUSHJ	P,FTOC		;TYPE THE PROCEDE COUNT

;	TYPING OPTION = GROUP

WT13:	HLRZ	T5,2(P4)	;[300] GET THE 'TYPING' OPTION
	JUMPE	T5,WT1		;[402] WAS TYPING REQUESTED?
	LINE			;[402]
	TYPE	( Typing Group: );[402]
	HLRZ	T5,2(P4)	;[300] YES - GET GROUP #
	PUSHJ	P,FTOC		;DISPLAY GROUP #


WT1:	SKIPE	(P4)		;[402]
	jrst	[LINE
		jrst	.+1]
	ADDI	P4,3		;MOVE ON TO NEXT PAUSE
	CAIG	P4,BNADR	;DONE ALL PAUSES?
	JRST	WT6		;NO - BACK FOR MORE
	HRRZI	T0,FO$GBA	;[332] HAVE FOROTS RETURN BREAK ADDRESS
	PUSHJ	P,FOROP.	;[332]   IN T0			
        SKIPE	@T0		;[332] IF @T0 IS NOT 0 THEN "PAUSE ON ERROR"
	JRST	[LINE		;[402]
		 TYPE (Pause: ON ERROR);[402]
		 JRST .+1]	;[332]
		 
	JRST	WT11		;FINISHED PAUSE DISPLAY - DO GROUPS


;	TYPE PARAMETERS OF CONDITIONAL PAUSE

WT14:	LINE
	TYPE 	( Condition: )	;[402]
	TYPE(IF )
	HRRZ	T2,P4		;GET CURRENT PAUSE ADDRESS
	SUBI	T2,B1ADR	;REMOVE OFFSETT
	IDIVI	T2,3		;FORM PAUSE#
	LSH	T2,2		;FORM INDEX TO TESTAB
	MOVEM	T2,WT16		;SAVE T2 TEMPORARILY
	MOVE	T5,TESTAB(T2)	;[116] GET LOGICAL FLAGS
	TLNE	T5,LFTLOG	;[116] IS ARG. LOGICAL?
	JRST	WTLLOG		;[116] YES, TAKE CARE OF IT
	MOVE	T5,TESTAB+1(T2)	;GET FIRST ARG ADDRESS
	CAIN	T5,TESTAB+3(T2)	;IS IT A CONSTANT?
	JRST	[MOVE  T5,(T5)	;YES
		 PUSHJ P,TFLOT	;TYPE FLOATING
		 JRST  WT15]
	CLEARM	SAVLOC		;USER DIDNT GIVE ANY INFO!
	CLEARM	SECSAV		;CLEAR SAVED NAME OF SECTION
	PUSHJ	P,OFFSET	;TYPE THE ARGUMENT NAME
	  JRST	E1		;NAME NOT FOUND?
WT15:	MOVE	T2,WT16		;RE-INSTATE T2
	MOVE	T5,TESTAB(T2)	;GET CONDITIONAL TYPE
	TYPE( .)
	atype(TYPTST(T5))	;TYPE THE CONDITION
	TLNE	T5,RHTLOG	;[116] IS THIS ARG. LOGICAL?
	JRST	WTRLOG		;[116] YES, TAKE CARE OF IT
	HRRZ	T5,TESTAB+2(T2)	;[303] GET SECOND ARG ADDRESS
	CAIN	T5,TESTAB+3(T2)	;IS THIS A CONSTANT?
	JRST	[MOVE  T5,(T5)	;YES -
		 PUSHJ P,TFLOT	;TYPE FLOATING
		 JRST  WT5]
	CLEARM	SAVLOC		;USER DIDNT GIVE ANY INFO!
	CLEARM	SECSAV		;CLEAR SAVED NAME OF SECTION
	PUSHJ	P,OFFSET	;DISPLAY THE SECOND ARGUMENT NAME
	  JRST	E1		;NAME NOT FOUND
	JRST	WT5		;RETURN FOR NEXT PAUSE

WTLLOG:	MOVE	T5,@TESTAB+1(T2) ;[124][116] GET VALUE
	JUMPL	T5,WTLTRU	;[124][116] IS IT POSITIVE?
	TYPE(.FALSE.)		;[116] YES, SO .FALSE.
	JRST	WT15		;[116]
WTLTRU:	TYPE(.TRUE.)		;[116] MUST BE .TRUE.
	JRST	WT15		;[116]

WTRLOG:	MOVE	T5,@TESTAB+2(T2)	;[124][116] GET VALUE
	JUMPL	T5,WTRTRU	;[124][116] IS IT POSITIVE?
	TYPE(.FALSE.)		;[116] YES, SO IT'S .FALSE.
	JRST	WT5		;[115]
WTRTRU:	TYPE(.TRUE.)		;[116] MUST BE .TRUE.
	JRST	WT5		;[116]
TYPTST:	ASCIZ/LT. /
	ASCIZ/LE. /
	ASCIZ/EQ. /
	ASCIZ/NE. /
	ASCIZ/GT. /
	ASCIZ/GE. /

WT16:	0

;	GROUP SETTINGS

WT11:	LINE
	POP	P,T5		;GET DISPLAY FLAG BACK
	JUMPL	T5,RET		;DONE IF FLAG IS SET
	PUSHJ	P,GROUPS	;DISPLAY THE USERS GROUP SETTINGS
	PUSHJ	P,DIMOUT	;DISPLAY ANY USER DEFINED ARRAY SPECS.
	LINE
	JRST	RET		;END OF WHAT


;	PUSHJ P,GRPALL TO TYPE ALL GROUP SETTINGS

GRPALL:	PUSHJ	P,GROUPS
	JRST	RET

GROUPS:	MOVEI	P4,GPMAX	;CHECK IF ANY ARE USED

GROU1:	SKIPE	GRP2(P4)	;USED?
	JRST	GROU2		;YES
	SOJG	P4,GROU1	;NO, TRY NEXT
	LINE
	TYPE	(No group specifications)
	POPJ	P,

GROU2:	MOVEI	P4,1		;SET UP FOR FIRST GROUP
	JRST	WT7.5

WT7:	SKIPN	GRP2(P4)	;THIS ONE USED?
	JRST	WT7.3		;NO - IGNORE IT
	LINE
	TLO	T0,CFLIU!OFCFL	;MAKE REQUEST FOR CORE FILE USE
	TYPE(GROUP )
	MOVE	T5,P4
	MOVEI	S1,12		;DECIMAL BASE FOR GROUP NUMBERS
	PUSHJ	P,FTOC		;TYPE GROUP #
	type(:)
	tab
	MOVEI	T5,(P4)		;GET GROUP # BACK
	IMULI	T5,CFSIZ	;POINT TO ACTUAL LOCATION OF GROUP START
	PUSHJ	P,GRTYP		;DISPLAY GROUP CONTENTS
WT7.3:	ADDI	P4,1		;BUMP GROUP NUMBER
WT7.5:	CAIG	P4,GPMAX	;DONE ALL GROUPS?
	JRST	WT7		;NO - BACK FOR MORE

WT8:	TLZ	T0,CFLIU!OFCFL	;REMOVE DANGEROUS FLAGS
	POPJ	P,		;
;	NEXT LOGIC - STEPS THROUGH STATEMENT LABELS(S),
;			SOURCE LINES(L) OR SUBROUTINE ENTRIES(E)

NEXT:	JUMPL	T0,STEP2	;NO ARGUMENTS USES DEFAULTS
	PUSHJ	P,EITHER	;ACCEPT EITHER A NUMERIC OR VARIABLE
	  CAIA			;NUMERIC
	MOVE	T5,(T5)		;GET VARIABLE CONTENTS
	JUMPE	T5,.+2		;ZERO = LAST VALUE SUPPLIED
	MOVEM	T5,STPVAL	;STORE THE NEW STEP VALUE
	CAIE	T2,"/"		;TRACE OPTION FOLLOWS?
	JRST	STEP2		;NO SWITCHES
	PUSHJ	P,OPTION	;FIND WHICH
	JRST	BADSYN		;NO GROUP REQUESTS HERE
	TRNN	P3,L.!S.!E.	;ANY TRACE OPTIONS SELECTED?
	JRST	STEP2		;NO JUST 'NEXT'
	TRZ	T0,TRLABL!TRLINE ;FIRST RESET THE TRACE FLAGS
	TRZE	P3,L.		;DO WE TRACE LINES?
	TRO	T0,TRLINE	;YES
	TRZE	P3,S.		;DO WE TRACE LABELS?
	TRO	T0,TRLABL	;YES
STEP2:	MOVEM	T0,STKYFL	;RECORD THE STICKY FLAGS
	MOVE	T5,STPVAL	;GET THE STEP VALUE
	MOVEM	T5,STPCNT	;AND SET UP THE STEP COUNT
	MOVE	T5,[PUSHJ P,STEP4] ;PREPARE TO SET UP THE TRACE FEATURE
	MOVEM	T5,FDDT.	;LIKE-SO
	SKIPN	STARTU		;[316] Has START been done?
	 JRST	START2		;[316] No -- Simulate START with TRACE on
	SKIPE	T5,JOBOPC	;WAS A RE-ENTER THE LAST ACTION
	JRST	CONT2		;YES - PROCEED FROM THERE
	JRST	PROCED		; NO - DO A NORMAL CONTINUE

;	THIS IS THE ENTRY POINT FOR TRACING EACH SOURCE LINE OR LABEL

STEP4:	JSR	SAVE		;SAVE THE USERS ACS
	PUSHJ	P,REMOVB	;AND REMOVE THE PAUSES
	MOVE	T5,SAVACS+17	;[325] GET THE FORTRAN PDL POINTER TO FIND THE PUSHJ
IFN TOPS20,<
	SKIPE	EXTEND		;[313]
	SKIPA	T5,(T5)		;[313]
>
	HRRZ	T5,(T5)		;[313]
	SOJ	T5,		;P.C. = STOPS ONE ON
	MOVEM	T5,BCOM		;SET UP FOR RE.BRK
	SETZM	SYM		;ACCEPT FIRST SYMBOL FOUND IN 'LOOK'UP
	SETOM	ESCAPE		;ALLOW ESCAPES
	TRO	T0,SILENT	;RIG FOR SILENT RUNNING
;[326]	TLO	T0,FGLSNM	;GLOBALS ARE OK
	SETZM	TROFFS		;[215] CLEAR ANY PREVIOUS OFFSET
	PUSHJ	P,LOOK		;'LOOK'-UP THE INTERCEPT
	  JRST	E7		;JUST HAS TO BE THERE
	  MOVEM	T5,TROFFS	;[215] SAVE OFFSET: WE HAVE NO LOCALS
	PUSH	P,T1		;[402] Save T1
	PUSHJ	P,STEP11	;OPEN AND NAME SECTION IF NEW
	POP	P,T1		;[402] Restore T1
	TRNN	T0,TRLINE!TRLABL ;REQUESTED TO TRACE ENTRIES ONLY?
	JRST	STEP7		;YES
STEP13:	MOVEM	P1,P2		;SAVE THE NOW RECOGNISED SYMBOL(LINE)
	MOVE	T5,TRUFST	;GET THE LAST CHARACTER OF THE LABEL
	CAIN	T5,32		;"P"?
	TRNN	T0,TRLABL	;AND TRACING LABELS?
	CAIA
	JRST	STEP5		;YES - OK
	TRNN	T0,TRLINE	;ARE WE TRACING LINES?
	JRST	STEP7		;NO - IGNORE


;	PREPARE TO TYPE NEXT LABEL OR LINE

STEP5:	SOSG	TABCNT		;COUNT UP TO 8 LABELS PER LINE
	JRST	[line
		 MOVEI	T5,10	;SET FOR 8 LABELS/LINE
		 MOVEM	T5,TABCNT ;RECORD IN TABCNT
		 JRST	.+1]

	TAB
	MOVE	P1,P2		;GET BACK THE NEW FOUND SOURCE LINE
	PUSHJ	P,SPT		;AND PROUDLY DISPLAY IT
	SKIPN	T5,TROFFS	;[215] OFFSET FOUND?
	 JRST	STEP5A		;[215] NO, A REAL LABEL
	TYPE	(+)		;[215] YES, TYPE IT
	PUSHJ	P,TYP4		;[215] IN OCTAL
	SETZM	TROFFS		;[215] AND CLEAR IT
STEP5A:	SKIPL	STPCNT		;[215] SKIP IF AN INFINITE TRACE
	JRST	STEP6		;OTHERWISE GO COUNT DOWN STPCNT


;	HERE BEGINS THE EXIT

STEP7:	PUSHJ	P,LISTEN	;HAS THE USER HAD ENOUGH
	CAIA			;NO
	JRST	STEP8		;ENOUGH - ENOUGH
	PUSHJ	P,INSRTB	;REPLACE PAUSES
	JSP	T5,RESTOR	;RESTORE FORTRAN ACS
	POPJ	P,		;RETURN THE WAY WE CAME IN

;	TRACE COUNT EXHAUSTED?

STEP6:	SOSE	STPCNT		;DECREMENT THE STEP COUNT
	JRST	STEP7		;MORE TO DO - SEE IF THE USER INTERCEPTS

;	TRAP TO USER COMMAND LEVEL

STEP8:	XMOVEI	T5,[POPJ P,]	;[313] MAKE SURE WE DO A POPJ RETURN
	HRRZM	T5,LEAV		;[313] PLACE IT IN THE LEAVE LOCATION
	MOVEM	T5,PROC0	;[313] TO MAKE SURE WE DO A POPJ RETURN TO FORTRAN
	JRST	RET		;NORMAL WORKING
;	XCT REFFERENCE FOUND BUT NOT 'P' OR 'L'

STEP12:	TRZN	T1,GUDLBL	;DID WE FIND A GOOD NUMERIC LABEL?
	JRST	STEP7		;NO  - THEN IT MUST BE A SUBROUTINE
	MOVE	T5,BCOM		;WHAT ARE WE 'LOOK'ING FOR
	TRO	T0,SILENT	;SILENCE AGAIN
	PUSHJ	P,RELOOK	;REFFERENCE DID NOT POINT TO A KNOWN LINE#
	  JRST	E7		;CAN'T FIND A PROPPER REFFERENCE?
	  JRST	E7		;THERE REALLY SHOULD BE SOMETHING THERE
	JRST	STEP13		;VALIDATE THIS ONE THEN


;	ROUTINE TO TYPE OUT NEW SECTION NAME

STEP11:	PUSHJ	P,SAV2AC	;SAVES T5 & P1
	PUSHJ	P,OVRLAY	;LOOK FOR AND TELL WHERE & IF AN OVERLAY HAPPENED
	PUSHJ	P,CMPPO		;[402] Compare PNAMSV and OPENED
	 SKIPA			;[402] Don't match
	POPJ	P,		;YES MATCH so JUST EXIT - AND RESET T5,P1	
	MOVEM	T5,SYM		;SET UP FOR SETNAM
	PUSHJ	P,SETNAM	;AND OPEN THIS SECTION FOR EFFICIENT SEARCHES
	MOVE	T5,OPENED	;WHAT IS THE CURRENTLY OPEN SECTION

	LINE
	type([)
	PUSHJ	P,SPT1		;DISPLAY THE SECTION NAME
	type(])
	tab
	TRNN	T0,TRLINE!TRLABL ;ARE WE TRACING ENTRIES?
	JRST	STEP6		;YES - COUNT THEM - RET: RESETS PDL
	SETZM	TABCNT		;PRODUCE A PRETTY PRINT OF 8 LABELS/LINE
	POPJ	P,		;RESET T5,P1
;	LOCATE LOGIC

Q:	LINE
	JUMPL	T0,BADSYN	;MUST HAVE AN ARGUMENT
	TRO	T1,DCEVAL	;DON'T CALL EVAL
	PUSHJ	P,SYMIN		;GET A SYMBOL REFERENCE
	 TRZ	T0,ID		;SYMBOL FOUND FLAG
	PUSHJ	P,SYMADR	;[327] Get the symbol table
	 JRST	ERR6		;[327] No table -- Error
QLIST2:	PUSHJ	P,FIXSYR	;Maybe skip modules we don't want
	JUMPLE	T4,QLIST9	;[327] Off end of table
	MOVE	T5,(T2)		;PICK UP SYMBOL
	JUMPE	T5,QLIST3
	TLZ	T5,LOCAL	;[402]Locals only
	CAME	T5,[SQUOZE 0,.SYMTB]	;[402] .SYMTB in RAD50
  	JRST	QLST2E		;[402] NO
	MOVE	T5,1(T2)	;[402] PTR to 2ndary symbol table
	MOVE	T5,1(T5)	;[402] First entry is program name
	MOVEM	T5,QLPNAM	;[402] Save long program name
				;[402] T5 has flags+cnt+ptr to name
	TLZ	T5,LFLG		;[402] Clear flag
	LSH	T5,-CNTSFT	;[402] Get word count
	CAIG	T5,1		;[402] Is name more than 1 word?
 	 SETZM	QLPNAM		;[402] No, so we will use short name
	TRNN	T1,LNAME	;[402] Is SYM a long name?
  	JRST	QLST2E		;[402] NO
	PUSH	P,T2		;[402] Save T2
	PUSH	P,SSTAB		;[402] Save SSTAB
	PUSH	P,T4		;[402]  and T4
	MOVE	T5,1(T2)	;[402] VALUE OF .SYMTB
	MOVEM	T5,SSTAB	;[402] Store ptr to this 2ndary symbol table
	PUSHJ	P,FINDLL	;[402]  and search the symbols for a match
	 JRST	QLST2D		;[402] NO MATCH
	MOVEM	T2,QLPNT	;[402] MATCH - Save it
	SETFLG	PNAMSV		;[402]Set flag saying it is long
	POP	P,T4		;[402] Restore T4
	POP	P,SSTAB		;[402] Restore SSTAB
	POP	P,T2		;[402] Restore T2
	JRST	QLIST3		;[402] MATCH
QLST2D:	POP	P,T4		;[402] Restore T4
	POP	P,SSTAB		;[402] Restore SSTAB
	POP	P,T2		;[402] Restore T2
QLST2E:	MOVE	T5,(T2)		;PICK UP SYMBOL
	TLZN	T5,PNAME	;A PROGRAM NAME?
	JRST	QLIST6		;YES
	CAMN	T5,SYM		;NO, IS AN OCCURANCE FOUND?
	MOVEM	T2,QLPNT	;[321] Yes - Remember where
QLIST3:	ADDI	T2,2		;[321] Step to next entry
	SUBI	T4,2		;[321] If there are more in this table,
	JUMPG	T4,QLIST2	;[321] try again
				;[327]

QLIST9:	TRZE	T0,ID		;ANY FOUND
	JRST	RET		;DONE
	JRST	ERR6		;NO - ERROR

QLIST6:	SKIPN	QLPNT		;FOUND THE SYMBOL?
	JRST	QLIST3		;NO
	TRO	T0,ID
	PUSH	P,T1		;[402] Save T1
	SKIPE	QLPNAM		;[402] Do we have a long program name
	JRST	[TRO	T1,LNAME;[402] Yes, set flag to long name
		MOVE	T5,QLPNAM;[402] Get long program name
	 	JRST	QLST6A]	;[402] 
	TRZ	T1,LNAME	;[402] set flag to short name
QLST6A:	PUSHJ	P,SPT1		;No, PRINT THE short PROGRAM NAME

	MOVE	T5,@QLPNT	;[321] GET THE SYMBOL BACK AND
	SYMSKE	PNAMSV		;[402] Is QLPNT a long name?
	JRST	QLST6B		;[402] Yes
	TLNE	T5,GLOBAL	; TEST FOR A GLOBAL SYMBOL
	JRST	QLIST8		; THIS IS A GLOBAL SYMBOL
	JRST	QLIST7		;[402] Not a global
QLST6B:	TLNE	T5,LGLOBL	;[402] Test for a global symbol
	JRST	QLIST8		;[402] Yes, global

QLIST7:	TYPE(	)
	SETZM	QLPNT		;RESET FLAG
	CLRFLG	PNAMSV		;[402] Reset long name flag
	POP	P,T1		;[402] Restore T1
	JRST	QLIST3		; AND SEARCH THE NEXT SET OF SYMBOLS

QLIST8:	type( )
	openp
	MOVE	T5,SYM		;PREPARE TO -
	PUSHJ	P,SPT1		; PRINT THE SYMBOL
	type( IS GLOBAL)
	closep
	JRST	QLIST7		;LOOK FOR MORE - SHOULD BE NONE

;	MODE CHANGE LOGIC

MODE:	JUMPL	T0,MODRET	;'MODE' ALONE - MEANS RESUME STANDARD SETTING
MODNXT:	PUSHJ	P,TTYIN		;GET AN ARGUMENT FROM USER
	JUMPE	T3,BADSYN
	SETZI	P1,		;NO  - PREPARE FOR A MODE CHANGE
	LDB	T3,[POINT 6,T3,5] ;GET FIRST CHARACTER OF USERS ARGUMENT
	CAIN	T3,'F'
	JRST	[TRO	P1,F.
		 JRST	MODMOR]
	CAIN	T3,'D'
	JRST	[TRO	P1,D.
		 JRST	MODMOR]
	CAIN	T3,'I'
	JRST	[TRO	P1,I.
		 JRST	MODMOR]
	CAIN	T3,'O'
	JRST	[TRO	P1,O.
		 JRST	MODMOR]
	CAIN	T3,'R'
	JRST	[TRO	P1,R.
		 JRST	MODMOR]
	CAIN	T3,'X'		;[157]Complex?
	JRST	[TRO	P1,X.	;[157]
		 JRST	MODMOR]
	CAIN	T3,'C'	;[157]Character string?
	 JRST	[TRO	P1,C.	;[157],[164]
		JRST	MODMOR]	;[157]
	CAIN	T3,'L'		;[120]
	JRST	[TRO	P1,L.	;[120]
		JRST	MODMOR]	;[120]
	CAIE	T3,'A'
	JRST	BADSYN
	TRO	P1,A.

MODMOR:	SKIPL	TERMK
	JRST	MODSET		;END OF USER LINE SET MODES

	JUMPE	T2,MODNXT	;SPACE IS A DELIMITER
	CAIE	T2,","		;COMMA IS THE ONLY ARG SEPARATOR
	JRST	BADSYN
	JRST	MODNXT		;GET MORE ARGUMENTS

MODSET:	MOVEM	P1,MODFLG	;SAVE USERS DEFAULT TYPE OPTIONS
	JRST	RET		;END OF MODE CHANGE
SUBTTL SYMBOL TABLE LOGIC

;	SYMBOL EVALUATION ROUTINE - EVALUATES THE SYMBOL IN SYM

EVAL:	MOVSI	T2,LOCAL	;YES, LOOK FOR OUTSIDE LOCALS
	MOVEM	T2,SYMASK	;[321] Set the bit mask
	MOVEI	T2,SYM		;CHECK SYM
	PUSHJ	P,TRUVAR	;LABEL OR STATEMENT #?
	  TROA	T1,SYMLAB	;YES
	TRZ	T1,SYMLAB

	TRNN	T1,LNAME	;[402] Long Symbol?
	JRST	EVAL1A		;[402] No - Short
	TRZE	T1,FGLONL	;LOOKING FOR GLOBALS ONLY?
	TRNE	T1,SYMLAB	;AND THIS IS NOT A LABEL?
	CAIA
	JRST	EVAL1B		;YES

	PUSHJ 	P,FINDLL	;[402] Yes, look for local
	SKIPA			;[402] FAIL
	JRST	EVAL2		;[402] FOUND
	MOVSI	T2,LOCAL!LGLOBL	;[402] Look for outside locals
	SKIPA			;[402]
EVAL1B:	MOVSI	T2,LGLOBL	;[402] Look for globals
	MOVEM	T2,SYMASK 	;[402] Set the bit mask
	PUSHJ	P,FINDLG	;[402] 
	SKIPA			;[402] FAIL
	JRST	EVAL2		;[402] FOUND

	MOVSI	T2,LOCAL	;YES, LOOK FOR OUTSIDE LOCALS
	MOVEM	T2,SYMASK	;[321] Set the bit mask
EVAL1A:	TRZE	T1,FGLONL	;LOOKING FOR GLOBALS ONLY?
	TRNE	T1,SYMLAB	;AND THIS IS NOT A LABEL?
	CAIA
	JRST	EVAL1		;YES
	PUSHJ	P,FINDL		;[321] Find local name
	 CAIA
	JRST	EVAL2		; FOUND
	TRNE	T1,SYMLAB	;IS IT A LABEL?
	 POPJ	P,		;YES - FAIL
EVAL0:	PUSHJ	P,FINDG		;[321] Find a global symbol
	 POPJ	P,		; FAIL

EVAL2:	MOVEM	T2,SYMSAV	;[321] Always save pointer
	MOVE	P1,T2		;
;[BL]	WHAT GOOD IS THIS?????
	MOVE	P2,1(T2)
	SKIPA	T5,1(T2)	;GET VALUE OF SYMBOL
CPOPJ2:	AOS	(P)		;SKIP TWICE
CPOPJ1:	AOS	(P)		;FOUND SYMBOL, SKIP
;[326]	TLZ	T0,FGLSNM	;KILL FLAG
CPOPJ:	POPJ	P,


EVAL1:	MOVSI	T2,GLOBAL!DELO	;[141] GLOBALS ONLY(ALSO DELETED GLOBALS)
	MOVEM	T2,SYMASK	;[402]
	JRST	EVAL0		;GO
;	GET HISEG START ADDRESS IN (T2)

ife tops20,<
GSTAH:	MOVE	T2,[XWD -1,.GTSGN]
	GETTAB	T2,		; GET HISEG INDEX
	 HALT	.		; *****
	HRLZI	T2, (T2)	; GET INDEX
	HRRI	T2,.GTUPM
	GETTAB	T2,		; GET HISEG START
	 HRLZI	T2,400000	;PRE-507 MONITOR - FUDGE VALUE
	HLRZ	T2,T2
	POPJ	P,>		;End of conditional

;[300] ROUTINE IS NOT NEEDED WHEN RUNNING EXTENDED

ifn tops20,<
gstah:	skipn	T2,.jbhso	;[123]get page of high segment
	  movei	T2,400		;[123]not set, guess 400
	lsh	T2,11		;get address of high segment
	popj	p,>		;return,end of conditional
;THIS ROUTINE SETS UP IGNORE LISTS FOR SYMBOL TABLE LOOKUPS.
;[320] Rewritten

SETLST:	SETZ	P4,		;[327] Count
	PUSHJ	P,SYMADR	;[327] Get location of symbol table
	 JRST	SETLS9		;[327] If no table, go away

	ADD	T2,T4		;Get to last entry, plus 1

SETLS2:	SUBI	T2,2		;Back up to
	MOVE	P2,(T2)		;  program name
	HLRE	T5,1(T2)	;Length of table segment for
	MOVMS	T5		;  this program
	ADDI	T2,2		;Get to the first
	SUB	T2,T5		;  entry for this program

	CAME	P2,[SQUOZE 0,UDDT];Grab these programs
	CAMN	P2,[SQUOZE 0,FORDDT]
	JRST	SETLS3
	CAME	P2,[SQUOZE 0,JOBDAT]
	JRST	SETLS4		;Not wanted

SETLS3:	MOVEM	T2,SYMLST(P4)	;Save location of first entry
	MOVEM	T5,SYMLSZ(P4)	;Save length of table segment
	AOJ	P4,		;Count it

SETLS4:	SUB	T4,T5		;Reduce count of entries in table
	JUMPG	T4,SETLS2	;Loop unless done

SETLS9:	MOVEM	P4,SYMCNT	;Number of segments to be ignored
	POPJ	P,

;Skip past any ignored table segments	[321] Rewritten


FIXSYR:	SKIPN	S2,SYMCNT	;Get number of ignored programs
	  POPJ	P,		;Return if none

FIXS1:	CAMN	T2,SYMLST-1(S2)	;One of the ignored programs?
	 JRST	FIXS2		;Yes
	SOJG	S2,FIXS1	;No - Try next one
	POPJ	P,		;No more - Return

FIXS2:	ADD	T2,SYMLSZ-1(S2)	;Step to next program
	SUB	T4,SYMLSZ-1(S2)	;Reduce number of words to search
	JRST	FIXSYR		;Try again

SYMCNT:	BLOCK	1		;Count of programs being ignored
SYMLST:	BLOCK	5		;Indices to segment of programs being ignored
SYMLSZ:	BLOCK	5		;Sizes of those segments

;Find the main program.		[315] New
;	PUSHJ P,MAINF
;	  Return if not found
;	  Return if found, with T4 containing the program name

MAINF:	TRZ	T1,LNAME	;[402] Assume short program name
	MOVE	T5,[SQUOZE 0,MAIN.];Search for this global symbol
	MOVEM	T5,SYM
	MOVSI	T2,GLOBAL
	MOVEM	T2,SYMASK
	PUSHJ	P,FINDG
	 JRST	CPOPJ		;Not found
MAINF1:	ADDI	T2,2		;[321] Step to next entry
	SUBI	T4,2		;[321] Any words left?
	JUMPLE	T4,CPOPJ	;[321] No - No program name
	MOVE	T5,(T2)		;[321] Is this a
	TLNE	T5,PNAME	;[321]   program name?
	JRST	MAINF1		;No--Keep looking
	MOVE	T4,T5		;[321] Yes - This is the name	

;[402] look for long program name after finding short program name
LOOKLP:	TRZ	T1,LNAME	;[402] Assume short program name
	MOVEM	T2,TEM12	;[402] Yes - This is the name
	MOVEM	T4,TEM4		;[402] Save T2,T4 for short name
				;[402]open this symbol table 
	;[402] Set T4 to module length and T2 start of symbol table
	HLRE	T5,1(T2)	;[402]Length of module (negative)
	MOVMM	T5,T4		;[402]Save positive size
	ADD	T2,T5		;[402]Point to beginning of
	ADDI	T2,2		;[402]   symbols for
				;[402]   this module
	MOVE	T5,[SQUOZE 0,.SYMTB]	;[402] .SYMTB in RAD50
	MOVEM	T5,SYM		;[402]
	PUSHJ	P,FINDL1	;[402] Search for local .SYMTB
	 JRST	MAINF2		;[402] No .symtb
	MOVE	T5,1(T5)	;[402] T5 = cnt+ptr
				;[402] Program name (first entry)is at .SYMTB+1
	MOVE	T4,T5		;[402] Copy of T5
	TRO	T1,LNAME	;[402] We have a long name
	JRST	CPOPJ1		;[402] Success with long name

MAINF2:	MOVE	T4,TEM4		;[402] Restore T4 = name
	MOVE	T2,TEM12	;[402] Restore T2 = STE
	JRST	CPOPJ1		;[402] Success with short name
;Find a program name in the symbol table		[321] New
;Entry:	SYM contains the program name
;	PUSHJ P,FINDP
;	  Return if not found
;	  Return if found, with T2 pointing to the symbol entry
FINDP:	PUSHJ	P,SYMADR	;[327] Find the symbol table
	 POPJ	P,		;[327] No table, so symbol not found

	MOVEM	T2,OJBSYM	;Remember the start
	ADD	T2,T4		;Get to last entry
	SUBI	T2,2		;  of this table

FINDP2:	MOVE	T4,(T2)		;Is this the
	CAMN	T4,SYM		;  program we want?
	 JRST	CPOPJ1		;Yes
	HLRE	T4,1(T2)	;No - Get length of module (negative)
	JUMPGE	T4,FINDP9	;[327] If table zeroed, not in table
	ADD	T2,T4		;Step to next program
	CAML	T2,OJBSYM	;Outside the table?
	JRST	FINDP2		;No - Try this one

FINDP9:	POPJ	P,		;[327] Not in table


;Find a local long symbol name in the symbol table	[402] New
;LSYMBF contains the entry to be found, SYM contains cnt+ptr to LSYMBF
;	PUSHJ P,FINDLL
;	  Return if not found
;	  Return if found,
;		with T2 pointing to the symbol entry
;		and  T5 containing symbol value
FINDLL:	MOVE	T5,SYM
	MOVE	T2,SSTAB	;ptr to symbol table
	HRRZ	T4,(T2)		;Number of symbols
	AOJ	T2,		;First entry
FINDL2: PUSHJ	P,CMPSYM	;Compare entry at t2 with T5
	SKIPA
	JRST	CPOPJ1		;Successful return
	SOJLE	T4,CPOPJ	;Reduce count of unsearched words
				;No more entries? = Failure
	ADDI	T2,2		;Step to next entry
	JRST	FINDL2		;Loop 
	
; Compares names in OPENED and PNAMSV	![402] New
;	PUSHJ P,CMPPO
;	  Return if not found
;	  Return if found
; This routine smashes T5 and T2

CMPPO:
	TRZ	T1,LNAME	;Clear long name flag
	SYMSKE	PNAMSV		;Long name in PNAMSV?
	JRST	CMPPOA		;Yes
	SYMSKN	OPENED		;Long name in OPENED?
	JRST	CMPPOC		;No - compare 2 short names
				;PNAMSV is short and OPENED is long
	XMOVEI	T5,PNAMSV	;Input for R50six
	PUSHJ	P,R50SIX	;Convert PNAMSV radix 50 name in R5 to sixbit
	MOVEM	T5,PNAMSV	
	JRST	CMPPOB	

CMPPOA:				;Long name in PNAMSV!
	SYMSKE	OPENED		;Long name in OPENED?
	JRST	CMPPOB		; Yes - compare 2 long names
	XMOVEI	T5,OPENED	;Input for R50six
	PUSHJ	P,R50SIX	;Convert OPENED radix 50 name in R5 to sixbit	
	MOVEM	T5,OPENED	;

CMPPOB:	TRO	T1,LNAME	;Yes - set long name flag
	SETFLG	OPENED
	MOVE	T5,PNAMSV	;WHAT WAS THE SECTION IN WHICH IT WAS FOUND
	MOVEI	T2,OPENED	;
	PUSHJ	P,CMPSYM	;DO WE ALREADY NOW ABOUT IT
	 JRST	CPOPJ		;NO
	JRST	CPOPJ1		;YES JUST EXIT 
CMPPOC:	MOVE	T5,PNAMSV	;WHAT WAS THE SECTION IN WHICH IT WAS FOUND
	CAME	T5,OPENED	;DO WE ALREADY NOW ABOUT IT
	 JRST	CPOPJ		;NO
	JRST	CPOPJ1		;YES JUST EXIT 

;[402] Compare symbol pointed to by ptr to cnt+ptr in T2 and cnt+ptr in T5
;	PUSHJ P,CMPSYM
;	  Return if not found
;	  Return if found
CMPSYM:	PUSH	P,T2		;Save T2,T3,T4,T5
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,T5

	MOVE	T2,(T2)		;Set T2 to point to the first word to compare
	MOVE	T4,T2
	TLZ	T4,LFLG		;clear flag bits
	LSH	T4,-CNTSFT	;Number of words to compare
	MOVE	T3,T5
	TLZ	T3,LFLG		;clear flag bits
	LSH	T3,-CNTSFT
	CAME	T3,T4		;Are lengths of both words the same
	JRST	CRET		;No, so can't match

	TLZ	T5,770000	;clear what is not part of 30bit addr
	TLZ	T2,770000	;clear what is not part of 30bit addr

CLP:	MOVE	T3,(T5)
	CAME	T3,(T2)		;Compare 
	JRST	CRET		;No match
	AOJ	T2,
	SOSE	,T4		;Found - No words left to compare
	AOJA	T5,CLP		;Loop to compare next word

	POP	P,T5		;Restore T2,T3,T4,T5
	POP	P,T4		
	POP	P,T3
	POP	P,T2
	JRST	CPOPJ1		;Match

CRET:	POP	P,T5		;Restore T2,T3,T4,T5
	POP	P,T4		
	POP	P,T3
	POP	P,T2
	JRST	CPOPJ		;No match

;Find a local name in the symbol table		[321] New
;Entry:	SYM contains the program name
;	PUSHJ P,FINDL
;	  Return if not found
;	  Return if found,
;		with T2 pointing to the symbol entry
;		and  T5 containing symbol value
FINDL:	SKIPE	T2,OPENLS	;Any OPEN module?
	 SKIPN	T4,OPENLZ	;Yes - Any symbols in that module?
	  POPJ	P,		;No - Not found

FINDL1:	MOVE	T5,(T2)		;Next symbol
	TLNN	T5,PNAME	;Program name?
	 JRST	FINDL5		;Yes - Ignore it
	TLZ	T5,LOCAL	;Locals only
	CAME	T5,SYM		;One we want?
	 JRST	FINDL8		;No
	MOVE	T5,1(T2)	;Value of symbol
	JRST	CPOPJ1		;Successful return

FINDL5:	TRNE	T1,TYPCMD	;Is this a TYPE command?
	 POPJ	P,		;Yes - Failure

FINDL8:	ADDI	T2,2		;Step to next entry
	SUBI	T4,2		;Reduce count of unsearched words
	JUMPG	T4,FINDL1	;Loop unless done
	POPJ	P,		;Failure

;Find a local or global name in the symbol table	[402] New
;Entry:	SYM contains the program name
;	SYMASK contains either the LOCAL or LGLOBL  or LPNAME bit
;	LPNAME indicates we are looking for an entry name 
; SYM contains ptr to name
;	PUSHJ P,FINDLG
;	  Return if not found
;	  Return if found,
;		with T2 pointing to the symbol entry
;		and  T5 containing the value
FINDLG:	SETZ	P1,		;P1 is zero if we haven't found anything yet
	PUSHJ 	P,SYMADR	;Set T2 to table and T4 to tables size
	 POPJ	P,		;No table
	PUSH	P,T3		;Save T3 
LGLP:	PUSHJ	P,FIXSYR	;if table size = 0 go to next table
	 JUMPLE	T4,LG8		; No more tables
	MOVE	T5,(T2)		;Get name of this entry
	TLZ	T5,LOCAL	;Locals only
	CAME	T5,[SQUOZE 0,.SYMTB] ; .SYMTB in RAD50
	JRST	LGINCR		;NOT .SYMTB
	MOVEM	T2,TMPSAV	
	MOVE	T2,1(T2)	;VALUE OF .SYMTB = ptr to 2ndary symbol table
	MOVE	T5,SYM
	MOVEM	T4,TEM9		;Number of words left
	HRRZ	T4,(T2)		;Number of symbols
	AOJ	T2,		;First entry
LGLPLP: MOVE	T3,(T2)		;Get flg+cnt+ptr to name
	TLNN	T3,LOCAL	;Is this a local?
	JRST	GLBCHK		;No, its a global
	MOVE	T3,SYMASK	;
	TLNE	T3,LOCAL	;Did we want a local
	JRST	LGCHK		;Yes, check it
	JRST	LGNEXT		;No, go to next entry
GLBCHK:	MOVE	T3,SYMASK	;We wanted a global
	TLNN	T3,LGLOBL	;Was this a global?
	 SKIPA			;No, go to next entry
LGCHK:	PUSHJ	P,CMPSYM	;Compare entry at t2 with T5
	SKIPA			;no match
	JRST	LG9		;MATCH	
LGNEXT:	ADDI	T2,2		;Step to next entry
	SOJG	T4,LGLPLP	;Reduce count of unsearched words
				;Loop unless done
	MOVE	T2,TMPSAV	;Failure - Restore T2 and T4
	MOVE	T4,TEM9		;
				;Go to next entry
LGINCR:	ADDI	T2,2		;Increment to next table entry
	SUBI	T4,2		;Decrement table size
	JRST	LGLP
LG8:	MOVEM	T4,TEM9		;Number of words left
	JUMPN	P1,LG9		;something found
	POP	P,T3		;Restore T3
	JRST	CPOPJ
LG9:	POP	P,T3		;Restore T3
	MOVE	T5,1(T2)	;Value of ste 
	MOVE	T4,TEM9		;Restore T4
	JRST	CPOPJ1
;Find a local or global name in the symbol table	[321] New
;Entry:	SYM contains the program name
;	SYMASK contains either the LOCAL or GLOBAL bit
;	PUSHJ P,FINDG
;	  Return if not found
;	  Return if found,
;		with T2 pointing to the symbol entry
;		and  T5 containing the value
FINDG:	SETZ	P1,
	PUSHJ	P,SYMADR	;[327] Find symbol table
	 POPJ	P,		;[327] No table, so symbol not found

FINDG2:	PUSHJ	P,FIXSYR	;Maybe skip this program
	JUMPLE	T4,FINDG8	;If no more entries, quit

	MOVE	T5,(T2)		;Next symbol
	TLNN	T5,PNAME	;Program name?
	 JRST	FINDG7		;Yes - Ignore it

	TDZ	T5,SYMASK	;Clear legal bits
	CAME	T5,SYM		;Is it the one we want?
	 JRST	FINDG7		;No

	MOVE	T5,(T2)		;Get name again
	TLNE	T5,GLOBAL	;Is it a global?
	 JRST	FINDG9		;Yes - We win

	JUMPN	P1,FINDG3	;Is this the first match?
	MOVE	P1,T2		;Yes - Remember it
	MOVEM	T4,TEM9		;Number of words left
	MOVE	T5,1(T2)	;The value
	JRST	FINDG7		;Look some more

FINDG3:	TRO	T0,MDLCLF	;Multiply defined
	TRNN	T1,TYPCMD	;If not 'TYPE',
	 POPJ	P,		;  exit
	CAME	T5,1(T2)	;Same as before?
	 JRST	FINDG7		;No
	TRO	T1,COMDAT	;Yes - It is in COMMON
	JRST	FINDG9		;Succesful exit

FINDG7:	ADDI	T2,2		;Step to next entry
	SUBI	T4,2		;Reduce the number of entries left
	JUMPG	T4,FINDG2	;Loop unless done

FINDG8:	JUMPE	P1,CPOPJ	;Fail if nothing found
	MOVE	T2,P1		;Where it was
	MOVE	T4,TEM9		;Number of words that were left

FINDG9:	MOVE	T5,1(T2)	;Value of symbol
	JRST	CPOPJ1

;[327] Routine NEXTAB removed
SUBTTL	ENTER AND LEAVE FORDDT LOGIC

;	SAVE THE ACS AND PI SYSTEM

SAVEF:	Z			;[300] EXTENDED FLAGS
SAVE:	Z			;SAVE THE ACS AND PI SYSTEM
IFN TOPS20,<
	SKIPE	EXTEND		;[300] ARE WE NON-EXTENDED?
	 XSFM	SAVEF		;[300] NO, SAVE EXTENDED FLAGS
>
	SKIPN	SARS
	  JRST	SAV1
	AOS	SAVE
	JRST	SAV5
SAV1:	MOVEM	T0,SAVACS	;[325] SAVE AC 0
	MOVE	T0,[1,,SAVACS+1] ;[325] Now save
	BLT	T0,SAVACS+17	;[325]   ACs 1-17
	MOVE	T0,SAVACS	;[325] PUT T0 BACK JUST IN CASE...
IFN TOPS20,<
	SKIPE	EXTEND		;[300]
	 JRST	SAV6		;[333] not section 0
>
SAV5:	MOVE	T5, SAVE
	HLLM	T5, SAVPI
	HRRZM	T5, SAVE	;[333] clear left half of PC word
SAV6:	MOVE	T0,STKYFL	;INIT THE FLAG REGISTER
	SETOM	SARS		;FLAG PROTECTING SAVED REGISTERS
	XJRSTF	SAVEF		;[300] JUMP AND RESTORE FLAGS

;	RESTORE ACS AND PI SYSTEM

RESTOR: IFN TOPS20,<
	MOVEM	T5,SAVE		;[300] STORE 30-BIT ADDR
	SKIPN	EXTEND		;[310] IF SECTION 0
> ;END IFN TOPS20
	HRRZM	T5,SAVE		;[310] MAKE SURE RH ADDR PART ONLY
IFN TOPS20,<
	SKIPN	T5,SAVEF	;[313] PICK UP EXTENDED FLAGS IF ANY
>
	MOVE	T5,SAVPI
	TLZ	T5,010037	;DON'T TRY TO RESTORE USER MODE FLAG
	HLLZM	T5,SAVEF	;[300] FOR FLAG RESTORATION
	HRLZI	17,SAVACS	;[325][326]
	BLT	17,17		;[325][326]
	SETZM	SARS
	XJRSTF	SAVEF		;[300]
;	PAUSE LOGIC


BP0:	0			;[145] USERS PC FROM FAKED JSR
	JSA	T5,BCOM		;[145] SAVE T5 AND GO TO BCOM
BP0INS:	TRN			;[300] BREAKPOINT INSTRUCTION
BPNCR1=.-BP0			;[300]

BP1:	XLIST			;TABLE FOR ENTRY FROM BREAKPOINTS
	REPEAT	NBP,<	0	;JSR TO HERE FOR A PAUSE
	JSA	T5, BCOM
	0		;HOLDS INSTRUCTION WHILE PAUSE IS IN PLACE
>
	LIST
B1INS=BP1+2
BPN=.-BPNCR1			;[300]
.SZCNT==0
SZEFIW:	repeat nbp,<
	EFIW BP1+.SZCNT		;[313] TABLE OF EFIW'S REF'D BY JSR
.SZCNT==.SZCNT+3
	>

SZDIEB:	BLOCK	<NBP+1>*3	;[313] DISPLACED INSTR EXECUTE BLOCK TABLE
SZALL==.-SZEFIW-1

DSPBLK:	BLOCK	1		;[313] LOCAL PTR TO DISPLACED INSTR BLOCK
EFIWAD:	EXP	SZEFIW		;[313] SEC 0, DEFAULT VALUES
DIEBAD: EXP	SZDIEB		;[313]
SECDSP:	BLOCK	1		;[313] SECTION FLAG WORD FOR XBLT COPY

;	CONDITIONAL LOGIC

TESTAB:	XLIST
	REPEAT	NBP,<	0	;NUMBER OF TEST
	0	;ADDRESS OF ARG1
	0	;ADDRESS OF ARG2
	0	;CONSTANT VALUE>
	LIST
COMPAR:	CAML	T3,T4
	CAMLE	T3,T4
	CAME	T3,T4
	CAMN	T3,T4
	CAMG	T3,T4
	CAMGE	T3,T4
COND:	0
	MOVEI	T5,BCOM2B-BCOM2	;[300]
	ADDM	T5,COND		;[300]
	HRRZ	T5,BCOM2E	;[313]
	SUBI	T5,B1ADR	;[313]
	IDIVI	T5,3
	LSH	T5,2
	MOVE	T2,TESTAB(T5)
	MOVE	T3,@TESTAB+1(T5)
	MOVE	T4,@TESTAB+2(T5)
	XCT	COMPAR(T2)
	AOS	COND
	JRST	@COND
BCOMAC:	Z			;[300] SAVE T AT BP ENTRY
BCOM:	Z
	TLO	T5,-1		;[300] MAKE POP WORK OUTSIDE SECTION 0
	POP	T5,LEAV		;MOVE INSTRUCTION TO LEAV
	XMOVEI	T5,B1SKP-B1INS(T5) ;[313] GET 30-BIT ADDR
	MOVEM	T5,BCOM1E	;[313] STORE ADDRESS
	AOS	T5		;[313] INCR FOR NEXT PTR
	MOVEM	T5,BCOM2E	;[313] STORE
	AOS	T5		;[313] INCR FOR LAST PTR
	MOVEM	T5,BCOM3E	;[313] STORE
	HLRZ	T5,(T5)		;[313] GET GROUP # IF ANY
	MOVEM	T5,BCOMGP	;[300] STORE GROUP NUMBER
	MOVE	T5,BCOM3E	;[300] GET BACK ADDRESS
	MOVE	T5,BP1-B1CNT(T5) ;GET PC WORD
IFN TOPS20,<
	SKIPN	EXTEND		;[300] SKIP IF EXTENDED
>
	HLLM	T5,LEAV1	;SAVE FLAGS FOR RESTORING
	EXCH	T5,BCOM		; ALSO SAVE PC WORD IN BCOM
	JSR	SAVE		;SAVE ACS

;ADDR MOD TO LOOK AT COND. INST.
BCOM3:	SKIPE	S2,@BCOM2E	;[313] CONDITIONAL BREAK?
	  JSR	COND		;[300] YES, SEE IF CONDITION EXISTS
;ADDR MOD TO LOOK AT PROCEED COUNTER
BCOM2:	HRRE	S2,@BCOM3E	;[313] LOAD PROCEED COUNT
	SOS	S2		;[300] DECR COUNT
	HRRM	S2,@BCOM3E	;[313] STORE IT FOR POSTERITY
	SKIPG	S2		;[300] NOT 0, DON'T BREAK YET
BCOM2B:	  JRST	BREAK		;[300] YOU DESERVE A BREAK TODAY!
	SKIPE	T5,BCOMGP	;[300] TYPING A GROUP?
	  JRST	BCOM1		;[300] YES, GO TYPE A GROUP
	LDB	T5,[POINT 9,LEAV,8] ;GET INSTRUCTION
	CAIL	T5,264		;JSR
	CAILE	T5,266		;JSA,JSP
	  TRNN	T5,700		;UUO
	JRST	PROC1		;MUST BE INTERPRETED
	CAIE	T5,260		;PUSHJ
	CAIN	T5,256		;XCT
	  JRST	PROC1		;MUST BE INTERPRETED
	PUSHJ	P,SETDSP	;[313] SETUP DISPLACED INSTR BLOCK
	XMOVEI	S2,LEAV2	;[313] GET LOC OF RETURN JUMP
	MOVEM	S2,LEAV1	;[313] STORE IT FOR THE XJRSTF JUMP
	JSP	T5,RESTOR	;[313] RESTORE AC's
	XJRSTF	LEAVF		;[300] RESTORE FLAGS, ETC.
LEAVF:	Z			;[300] EXTENDED FLAGS
LEAV1:	Z			;[313] 30-BIT ADDR
LEAV2:	JRST	@DSPBLK		;[324] RETURN THRU THE DISPLACED INSTR BLOCK

BCOMGP:	Z			;[300] HOLD GROUP TO TYPE
BCOM1E:	Z			;[313] HOLD INDEX ADDRESS
BCOM2E:	Z			;[313] HOLD CONDITION CHECKING ADDRESS
BCOM3E:	Z			;[313] HOLD PROCEED COUNT

BCOM1:	MOVE	T5,SAVACS+T5	;[147] RESTORE T5
	PUSHJ	P,LISTEN	;DID THE DOOR BELL RING?
	JRST	BREAK3		;NO - THIS IS NOT A TRUE BREAK
	CAIA			;YES - LETS STOP HERE

BREAK:
;	JSR	SAVE		;SAVE THE WORLD
	TLO	T0,AUTO		;SIGNAL THAT THIS WAS A TRUE BREAK
BREAK3:	PUSHJ	P,REMOVB	;REMOVE BREAKPOINTS
	SETZM	MATHSM		;CLEAR SPECIFIC SYMBOL LOOKUP FLAG
	SETOM	ESCAPE		;USER ENVIRONMENT PROTECTED ALLOW ESCAPES
	PUSHJ	P,TTYCLR	;FLUSH WAITING TTY CHARACTERS FOR INPUT
	PUSHJ	P,CHKIWI	;[211] OK TO CALL THE OTS?
	 TRNA			;[211] NO
	PUSHJ	P,FORBUF	;[145] LET FOROTS CLEAR ITS BUFFER
	HRRZ	T5,BCOM2E	;[313] GET ADR OF CONDITIONAL BREAK INST
	SUBI	T5,B1ADR-3	;CHANGE TO ADDRESS OF $0B
	IDIVI	T5,3		;QUOTIENT IS BREAK POINT NUMBER
	HRRM	T5,BREAK2	;SAVE BREAK POINT #
;NOW DISPLAY BREAK INFORMATION

	SETZI	T1,
	LINE
	SKIPL	BP0FLG		;[145] SKIP IF FORDDT WAS 'CALL'ED
	 JRST	[TYPE (Pause at ) ;[145] ANNOUNCE BREAKPOINT
		 JRST BRKAT]	;[145] PROCEED
	TYPE	(Entering FORDDT from )	;[145] SAY WHERE 'CALL'ED FROM
	SKIPN	T5,PAUFLG	;[331] PAUSE ON ERROR-- PAUSE ADDR IS IN PAUFLG
BRKAT:	MOVE	T5,BCOM		;[145]
	HLLM	T5, SAVPI	;SAVE PROCESSOR FLAGS
	XMOVEI	T5,-1(T5)	;[300] GET JUST THE 30-BIT ADDR MINUS 1
	TRO	T0,SILENT	;SILENCE
;[326]	TLO	T0,FGLSNM	;GLOBALS ARE OK
	PUSHJ	P,LOOK		;TYPE PC AT BREAK
	 JRST	BP0E2		;[145] NO NAME, PROBABLY ERROR
	 CAIA			;[145] OFFSET
	JRST	BPOK		;[145] FOUND AND TYPED

	SKIPL	BP0FLG		;[145] ERROR IF NOT FROM BREAKPOINT 0
	  JRST	E2		;[145]
	MOVEM	T5,TEM		;[145] REMEMBER NEAREST REFERENCE
	PUSHJ	P,SPT		;[145] TYPE SYMBOL
	TYPE	( + )		;[145]
	MOVE	T5,TEM		;[145] TYPE OFFSET
	PUSHJ	P,TYP4		;[145] IN OCTAL
	JRST	BPSEC		;[145]

BPOK:	TRNN	T1,LNAME	;[402] All long symbols?
	JRST	BPOK1		;[402] No
	MOVE	T5,(P1)		;[402]
	TLNE	T5,LGLOBL	;[402] Yes, is symbol global?
	 JRST	LBRK6		;[402] LONG GLOBAL
	JRST	BPOK2		;[402] Not long symbol
BPOK1:	MOVE	T5,(T2)		;[145] GET SYMBOL
	TLNE	T5,GLOBAL	;GLOBAL?
	JRST	BREAK6		;YES - THIS IMPLIES A ROUTINE
BPOK2:	PUSHJ	P,SPT1		;NO, SO PRINT IT
BPSEC:	TYPE( in )		;[145]
	LDSYM	T5,PNAMSV	;[402]GET NAME OF SYMBOL'S SECTION
	MOVEM	T5,SYM		;SAVE IT
	PUSHJ	P,SPT1		;AND TYPE IT
	PUSHJ	P,CMPPO		;[402] Compare PNAMSV and OPENED
	 JRST	BREAK7		;[402] NO MATCH
				;[402] MATCH
BPSECA:	SKIPGE	BP0FLG		;[145] IF FROM BREAKPOINT 0,
	  JRST	BP0RET		;[145] DONE

BREAK4:	LINE
	MOVE	T5,@BCOM1E	;[313] LOAD ADDRESS
	MOVEM	T5,PROC0	;[313] STORE IT
	SKIPN	T5,BCOMGP	;[300] TYPING A GROUP?
	 JRST	BREAK1		;[300] NO
	MOVE	P3,MODFLG	;REMEMBER TO SET UP THE PRINT FLAGS
	HRLS	P3		;[323] IN BOTH HALVES
	TLO	T0,GRPFL!CFLIU!OFCFL ;WE WANT TO ALLOW GROUP LOGIC HERE
	SETZM	TERMK
	PUSHJ	P,SYM5		;DISPLAY USERS GROUP IN 'TYPING' REQUEST
	PUSHJ	P,REINOP	;RE-OPEN PROG
	TLZ	T0,GRPFL!CFLIU!OFCFL ;REMOVE FLAG, IT MAY CAUSE TROUBLE

BREAK1:	MOVSI	T3,400000
BREAK2:	ROT	T3,.-.		;ROT BY # OF BREAK POINT
	TLZE	T0,AUTO		;DO WE HAVE A TRUE BREAK CONDITION?
	ANDCAM	T3,AUTOPI	;YES - END OF 'TYPING' LOGIC
	TDNN	T3,AUTOPI	;DONT PROCEED IF NOT AUTOMATIC
	JRST	BP0RT2		;[211] DONT PROCEED
	JRST	PROCD1

BP0E2:	SKIPN	BP0FLG		;[145] IN BREAKPOINT 0?
	  JRST	E2		;[145] NO, ERROR
	MOVEI	T5,@BCOM	;[145] TYPE IT IN OCTAL
	SUBI	T2,1		;[145] 
	PUSHJ	P,TYP4		;[145] 
BP0RET:	LINE			;[145] 
	MOVNS	BP0FLG		;[145] MAKE IT POSITIVE NOW
BP0RT2:	PUSHJ	P,CHKIWI	;[211] RESTRICTED BREAKPOINT?
	 PUSHJ	P,WRNIWI	;[211] YES, WARN THE USER
	JRST	RET		;[145] INITIALIZE SOME FLAGS ETC.

LBRK6:	PUSH	P,T1		;[402] Save T1
	TRO	T1,LNAME	;[402] Long routine name
	MOVE	T5,(P1)		;[402] Get SYMBOL
	JRST	BRK6		;[402]
BREAK6:	PUSH	P,T1		;[402] Save long name flag
	TRZ	T1,LNAME	;[402] Short routine name
	LDB	T5,[POINT 32,0(P1),35] ;[201] GET SYMBOL
BRK6:	MOVEM	T2,SAVLOC	;NAME OR ROUTINE
	TYPE	(routine )
	PUSHJ	P,SPT1		;[201] TYPE ROUTINE NAME
	POP	P,T1		;[402] Restore T1
	PUSHJ	P,CHKIWI	;[211] CAN WE CALL THE OTS?
	 TRNA			;[211] NO, DON'T PRINT ARGS
	PUSHJ	P,GETARG	;DISPLAY ANY ARGS
	SKIPGE	BP0FLG		;[145] DONE IF FROM BREAKPOINT 0
	  JRST	BP0RET		;[145]
	LDSYM	T5,PNAMSV	;[402]GET PROGRAM NAME
BREAK7:	MOVEM	T5,SYM		;SAVE IT
	PUSHJ	P,IMPOPN	;AND OPEN IT
	SKIPGE	BP0FLG		;[145] IF FROM BREAKPOINT 0,
	  JRST	BP0RET		;[145] DONE
	JRST	BREAK4



; COME HERE IF PAUSE ON ERROR

PAUERR:	POP	P,BP0		;[331] SAVE RETURN ADDRESS TO FOROTS
	SETOM	BP0FLG		;[331]
	MOVE	T5,@1(L)	;[332] SAVE ADDRESS OF ERROR IN USER PGM
	AOJ	T5,		;[331] INCR IT BECAUSE BCOM WILL DECR IT
	MOVEM	T5,PAUFLG	;[331]
	JRST	BP0+1		;[331] 

PROCED:	MOVEI	T5,1		;SET UP FOR PROCEDE OF 1
	HRRE	T2,@BCOM3E	;[313] GET JUST THE PROCEED COUNT
	SKIPG	T2		;[300] DO NOT CHANGE VALUE IF ALREADY SET
PROCDX:	HRRM	T5,@BCOM3E	;[313] STORE PROCEED COUNT
	MOVE	T2,BCOM1E	;[313] ADDR OF BREAK-POINT-TABLE ELEMENT
	SETZM	TEM		;DO NOT RE-INSERT 'CONDITIONAL' INFO.
	MOVE	T3,BCOMGP	;[300] LOAD GROUP #
	JUMPE	T3,.+2		;SET THE AUTO PROCEDE FLAG
	TLO	T0,AUTO		;IF THIS IS A 'TYPING' REQUEST
	PUSHJ	P,AUTOP
PROCD1:	LINE
	TRNA			;[313] SKIP NEXT
PROC0:	Z			;[313] GETS ADDR OF BREAKPOINT
	XMOVEI	T2,@[IFIW @PROC0] ;[313] GETS TO ADDR OF BREAKPOINT
	SKIPE	BP0FLG		;[145] PHANTOM BREAKPOINT?
	  JRST	PROC00		;[145] YES, DON'T WORRY ABOUT LEAV INSTRUCTION
				;[145]   EXCEPT THAT PROC0 MAY BE MODIFIED
	PUSHJ	P,FETCH
	JRST	BPLUP1		; GET HERE ONLY IF MEMORY SHRANK
	MOVEM	T5,LEAV
PROC00:	CLEARM	BP0FLG		;[145] WON'T NEED THIS ANYMORE
	CLEARM	PAUFLG		;[331]
	PUSHJ	P,INSRTB
	JRST	PROC2

PROC1:	MOVE	T5,BCOM		;STORE FLAGS WHERE "RESTORE"
	HLLM	T5,SAVPI	;  CAN FIND THEM
PROC2:	MOVEI	T4,100
	MOVEM	T4,TEM1		;SETUP MAX LOOP COUNT
	JRST	IXCT5

IXCT4:	SUBI	T5,041		;IS UUO "INIT"?
	JUMPE	T5,BPLUP
	AOJGE	T5,IXCT6	;DONT PROCEDE FOR INIT
				;DONT INTERPRET FOR SYSTEM UUOS
	MOVEM	T2,40		;INTERPRET FOR NON-SYSTEM UUOS
	MOVEI	T2,41
IXCT:	SOSL	TEM1
	PUSHJ	P,FETCH
	JRST	BPLUP		;BREAKPOINT LOOPING OR FETCH FAILED
	MOVEM	T5,LEAV

IXCT5:;	SETZM	ESCAPE		;NO ESCAPES FROM FORDDT
	LDB	T5,[POINT 9,LEAV,8] ;GET INSTRUCTION
	CAIN	T5,254		;DON'T DO ANYTHING TO JRST
	JRST	IXCT6
	HLLZ	T5,@BCOM1E		;[403] Get section number
IFN TOPS20,<
	SKIPE	EXTEND			;[403]
>
	SKIPE	T5			;[403]
	TRNA				;[403]
	XMOVEI	T5,.			;[403]
	HLLZM	T5,LEAVX		;[403] Store it
	HRR	T5,LEAV			;[403] Get E
	HRRM	T5,LEAVX		;[403] Store it
	LDB	T5,[POINT 5,LEAV,17]	;[403] PICK UP AC,I
	DPB	T5,[POINT 5,LEAVX,5]	;[403] Store it to complete EFIW
	MOVE	T5,LEAVX		;[403]
	HRLZI	17,SAVACS		;[325][326] SETUP FOR BLT
	BLT	17,17			;[325][326] RESTORE ACS
	XMOVEI	T5,@LEAVX		;[300] NOW GET EFFECTIVE ADDRESS
	MOVEM	T5,LEAVX		;[300] STORE IN AN INTERMEDIATE
	LDB	P1,[POINT 4,LEAV,12]	;PICK UP AC FIELD
	LDB	T5,[POINT 9,LEAV,8]	;PICK UP INSTRUCTION FIELD
					;[325] Removed SETPDL
	CAIN	T5,260
	JRST	IPUSHJ		;INTERPRET PUSHJ

	CAIN	T5,256
	JRST	[MOVE	T2,LEAVX	;[300] GET INSTR POINTED AT
		 JRST	IXCT]		;[300] AND THEN INTERPRET XCT

IXCT6:	PUSHJ	P,SETDSP	;[313] SETUP DISPLACED INSTRUCTION BLOCK
	JSP	T5,RESTOR
	JRST	@DSPBLK		;[313] GO TO THE DISPLACED INSTR BLOCK
LEAV:	0			;INSTRUCTION MODIFIED
	JRST	@BCOM
	AOS	BCOM
	JRST	@BCOM
LEAVX:	0			;[300] 30-BIT ADDRESS

BPLUP:	PUSHJ	P,REMOVB	;BREAKPOINT PROCEED ERROR
BPLUP1:	JSR	SAVE
	JFCL
	JRST	ERR18

IPUSHJ:	PUSHJ	P,FNDDSP	;[313] GET DISPL INSTR BLOCK INFO
	MOVEM	T2,2(T3)	;[313] STORE ADDR OF LOC AFTER BREAKPOINT
	HRRI	T1,2(T3)	;[313] GET PTR TO ADDR
	HLL	T1,[PUSH]	;[313] HELP FORM PUSH INSTR
	DPB	P1,[POINT 4,T1,12] ;[313] STORE AC FIELD INTO A PUSH
	MOVEM	T1,(T3)	;[313] STORE IN DISPL INSTR BLOCK
	HLL	T2,[JRST]	;[313] MAKE THE JRST INSTR
	HRR	T2,LEAVX	;[313] GET ADDR
	MOVEM	T2,1(T3)	;[313] STORE THE JRST INSTRUCTION
	JSP	T5,RESTOR	;RESTORE THE MACHINE STATE
	JRST	@DSPBLK		;[313] JUMP TO THE DISPLACED INSTR BLOCK

IJSA:	MOVE	T5,BCOM		;INTERPRET JSA
	HRL	T5,LEAVX	;[300] GET 18-BIT ADDR (OK FOR SAME SECTION)
	EXCH	T5,SAVACS(P1)	;[147] 
	JRST	IJSR2

IJSR:	MOVE	T5,BCOM		;INTERPRET JSR
IJSR2:	XMOVEI	T2,@LEAVX	;[300] GET 30-BIT EFFECTIVE ADDRESS
	PUSHJ	P,DEPMEM
	 JRST	BPLUP		;ERROR, CAN'T STORE
	AOSA	T5,LEAVX	;[300] INCR THE EFFECTIVE ADDRESS
IJSR3:	MOVE	T5,LEAV
	JRST	RESTOR
IJSP:	MOVE	T4,BCOM		;INTERPRET JSP
	JRST	IJSR3
SETDSP:	PUSHJ	P,FNDDSP
	HLLZ	T4,[JRST]	;THE JRST INSTR
	MOVEM	T2,1(T3)	;STORE RET ADDR
	HLLM	T4,1(T3)	;PUT IN THE JRST INSTRUCTION
	AOS	T2
	MOVEM	T2,2(T3)	;STORE RET ADDR+1
	HLLM	T4,2(T3)	;PUT IN THE JRST INSTRUCTION
	MOVE	T2,LEAV		;GET INSTR
	MOVEM	T2,(T3)		;STORE INSTR
	POPJ	P,
;;;
; Sets up DSPBLK to point to beginning of displaced instruction block.
; T1/ Offset into B0ADR table, will point to 1st word in 3 word entry
; T2/ Original return address
; T3/ Displaced instruction block start address
FNDDSP:	MOVEI	T1,@BCOM1E	;THE TABLE INDEX TO CORRECT FOR
	SUBI	T1,B0ADR	;GET CORRECTED OFFSET
	MOVE	T2,BP0(T1)	;GET RET ADDR FROM ORIGINAL JSR
	HRRZ	T3,T1		;PUT IN OFFSET
IFN TOPS20,<
	SKIPN	EXTEND		;SKIP IF EXTENDED
	 JRST	FNDDS1		;DO THE SEC-0 STUFF
	HLL	T3,T2		;GET SECTION # OF ORIGINAL JSR
	XMOVEI	T3,ESDIEB(T3)	;GET THE ADDR OF START OF DISP INSTR BLK
	TRNA
>
FNDDS1:	MOVEI	T3,SZDIEB(T3)	;GET ADDR OF START OF DISP INSTR BLK
	MOVEM	T3,DSPBLK	;STORE PTR TO START OF DISPATCH BLOCK
	POPJ	P,	
;	INSERT PAUSES REQUESTS

INSRTB:	MOVEI	T3,BP1			;[300] GET ADDR OF BREAKPOINT
	XMOVEI	T4,@EFIWAD		;[313] EFIW TABLE
INSRT1:	SKIPE	T2,B1ADR-BP1(T3)
	PUSHJ	P,FETCH
	JRST	INSRT3
	MOVEM	T5,B1INS-BP1(T3)
IFN TOPS20,<
	DMOVEM	T1,TMPSAV
	HLRZS	T2			;[313] GET THE SECTION NUMBER IN RH
	JUMPE	T2,INSRT2		;[313] IF 0, THEN DON'T COPY
	MOVEI	T5,1B35			;[313] LIGHT RIGHTMOST BIT
	LSH	T5,-1(T2)		;[313] POSITION IS SECTION #
	TDNE	T5,SECDSP		;[313] HAVE TABLES BEEN COPIED TO SEC?
	 JRST	INSRT2			;[313] YES, DON'T BOTHER
	MOVEM	T3,TMPSV1
	MOVEI	T1,SZALL		;[313] WORD COUNT
	HRL	T3,T2			;[313] PUT SEC # BACK IN LH
	HRRI	T3,ESEFIW		;[313] START PLACING STUFF HERE
	XMOVEI	T2,SZEFIW		;[313] SOURCE ADDRESS
	EXTEND	1,[XBLT T1]		;[313] TRANSFER THE STUFF
	MOVE	T3,TMPSV1
	IORM	T5,SECDSP		;[313] SET BIT SAYING WE COPIED
INSRT2:	DMOVE	T1,TMPSAV
>
	MOVE	T5,T4
	HLL	T5,[JSR	@]	;[300] JSR TO BREAKPOINT
	PUSHJ	P,DEPMEM
	 JFCL			;HERE ONLY IF CAN'T WRITE IN HIGH SEG
INSRT3:	ADDI	T3,3
	AOS	T4		;[313] INCR EFIW COUNT
	CAIG	T3,BPN		;[300] HAVE WE DONE ALL BREAK-POINTS?
	 JRST	INSRT1
	POPJ	P,

;REMOVE PAUSE REQUESTS

REMOVB:	MOVEI	T3,BNADR
REMOV1:	MOVE	T5,B1INS-B1ADR(T3)
	SKIPN	T2,(T3)		;[300] THIS BP SET?
	 JRST	RX		;[300] NO!
	PUSHJ	P,DEPMEM
	 JFCL			;HERE ONLY IF NO WRITE IN HIGH SEG
RX:	SUBI	T3,3		;[300] NEXT BREAK POINT
	CAIL	T3,B1ADR	;[300] ALL BPS DONE?
	 JRST	REMOV1		;[300] NO, LOOP AND PROCESS THIS ONE
	POPJ	P,		;
;	HERE TO SET PAUSE BREAKS

BPS:	MOVE	T5,[XWD B1ADR,B1ADR+1]	; CLEAR ALL PAUSES
	CLEARM	B1ADR
	BLT	T5,AUTOPI	;CLEAR OUT ALL PAUSES AND AUTO PROCEDE REGESTER
	JRST	RET
BPS1:	PUSH	P,T5		;[300] SAVE THE ADDR
	MOVE	T2,T5		;[313] COPY THE ADDRESS
	PUSHJ	P,FETCH		;CAN PAUSE BE INSERTED HERE?
	 JRST	[POP P,		;[300] POP THE SAVED ITEM
		 JRST	ERR19]	;[300] NO
	PUSHJ	P,DMEMER	; AGAIN NO
	POP	P,T5		;[300] PUT THE PAUSE ADR BACK IN T5
	SETZM	SAVLOC		;STORES AVAILABLE PAUSE SLOT
	MOVEI	T2,B1ADR	;START OF PAUSE ARGUMENTS
BPS4:	MOVE	T4,@[IFIW (T2)]	;GET ADDRESS OF PAUSE IF ALREADY SET
	CAMN	T4,T5		;[313] SEE IF ALREADY SET (FULL ADDR)
	JRST	BPS5		;YES - USE THIS

	SKIPN	(T2)		;IS IT FREE?
	MOVEM	T2,SAVLOC	;[300] YES - REMEMBER WHERE
	ADDI	T2,3		;LOOK AT NEXT
	CAIG	T2,BNADR	;[300] ALL EXAMINED?
	JRST	BPS4		;NO GO ON IN CASE THIS ADDRESS USED ALREADY

	SKIPN	T2,SAVLOC	;WHERE THERE ANY FREE?
	JRST	ERR9		;NO - UNLUCKY USER
BPS5:	MOVEM	T5,@[IFIW (T2)]	;[300] SET UP PAUSE ADDRESS
	MOVE	T5,TEM		;GET CONDITIONAL IF ANY   L.H. = WHAT TO TYPE
	MOVEM	T5,@[IFIW 1(T2)];[300]
	MOVE	T5,TEM1		;GET THE PROCEDE COUNT
	MOVEM	T5,@[IFIW 2(T2)];[300] PLACE WHERE IT DOES THE MOST GOOD
AUTOP:	SUBI	T2,B1ADR	;AUTO PROCEDE SETUP SUBROUTINE
	IDIVI	T2,3
	MOVEI	T3,1
	LSH	T3,(T2)
	ANDCAM	T3,AUTOPI
	TLNE	T0,AUTO		;DID USER ASK FOR AUTO PROCEDE?
	IORM	T3,AUTOPI	;YES - LET HIM HAVE IT
	HRRZ	T5,TEM		;DID USER ASK FOR A CONDITIONAL
	JUMPE	T5,CPOPJ	;NO - ALL DONE

	LSH	T2,2		;FORM INDEX TO TEST TABLES
	ADDI	T2,TESTAB
	MOVE	T5,COND0
	MOVEM	T5,(T2)		;SAVE TEST NO.
	MOVE	T5,COND1
	CAIN	T5,COND3	;SHOULD THIS BE A CONSTANT
	XMOVEI	T5,3(T2)	;[303] YES CORRECT IT
	MOVEM	T5,1(T2)	;SAVE ADDRESS OF FIRST ARG
	MOVE	T5,COND2
	CAIN	T5,COND3
	XMOVEI	T5,3(T2)	;[303] SAVE ADDRESS OF SECOND ARG
	MOVEM	T5,2(T2)	;SAVE ADDRESS OF SECOND ARG
	MOVE	T5,COND3	;GET CONSTANT IF ANY
	MOVEM	T5,3(T2)	;AND SAVE
	POPJ	P,
SUBTTL MEMORY MANAGER SUBROUTINES

;DEPOSIT INTO MEMORY SUBROUTINE

DEPMEM:	EXCH	T2,T5		;CHECK (T5)
	PUSHJ	P,CHKADR	;LEGAL ADDRESS?
	 POPJ	P,		;NO - ILLEGAL
	 JRST	DEP4		;YES BUT IN HI SEGMENT
	EXCH	T2,T5
	TRNN	T2,777760
	JRST	DEPAC		;DEPOSIT IN AC
	MOVEM	T5,(T2)
	JRST	CPOPJ1		;SKIP RETURN

DEPAC:	MOVEM	T5,SAVACS(T2)	;[147] DEPOSIT IN AC
	JRST	CPOPJ1		;SKIP RETURN
ife tops20,<
DEP4:	EXCH	T2,T5
	MOVEI	S3,0
	SETUWP	S3,		;IS HI SEGMENT PROTECTED? TURN OFF
	POPJ	P,		;PROTECTED, NO SKIP RETURN
	MOVEM	T5,(T2)		;STORE WORD IN HI SEGMENT
	TRNE	S3,1		;WAS WRITE PROTECT ON?
	SETUWP	S3,		;YES, TURN IT BACK ON
	JFCL
	JRST	CPOPJ1>		;skip return, end of conditional
ifn tops20,<
dep4:	exch	T2,T5		;restore T2 and T5
	push	p,T1		;save regs for JSYS
	push	p,T2
	lsh	T2,-11		;form page number from address
	hrrzi	T1,(T2)		;put into T1
	hrli	T1,.fhslf	;[300] get process handle into left half
	rpacs%			;get access bits into T2
	tlne	T2,(pa%wt!pa%cpy) ;[300] can we write to this page?
	  jrst	dep5		;[300] yes, go do it
	and	T2,[pa%wt!pa%rd!pa%cpy!pa%ex]
				;[300] clear out any unneeded bits
	tlo	T2,(pa%cpy)	;[300] get copy-on-write access for page
	spacs%

dep5:	pop	p,T2		;restore T2
	pop	p,T1		;restore flags
	movem	T5,(T2)		;save away T5
	jrst	cpopj1>		;skip return,end of conditional


DMEMER:	PUSHJ	P,DEPMEM	;DEPOSIT AND GO TO ERR IF IT FAILS
	 JRST	ERR19
	POPJ	P,
FETCH:	EXCH	T2,T5		;CHECK (T5)
	PUSHJ	P,CHKADR	;LEGAL ADDRESS?
	 POPJ	P,		;NO
	 JFCL			;HIGH OR LOW OK FOR FETCH
	EXCH	T2,T5
	TRNN	T2,777760	;ACCUMULATOR?
	SKIPA	T5,SAVACS(T2)	;[147] YES
	TRNA			;[300] NO, SKIP
	JRST	CPOPJ1		;SKIP RETURN ONLY FOR LEGAL ADDRESS
IFN TOPS20,<
	PUSH	P,T2		;[300] SAVE THE ADDRESS
	SKIPN	EXTEND		;[313]
	TLZ	T2,-1		;[300] CLEAR ANY LH
>
	MOVE	T5,(T2)		;[300] GET CONTENTS
IFN TOPS20,<
	POP	P,T2		;[300] RESTORE AS BEFORE
>
	JRST	CPOPJ1		;[300] GIVE SKIP RETURN
SUBTTL BINARY TO SYMBOLIC CONVERSION

;	PUSHJ	P,LOOK		;AC T5 CONTAINS BINARY TO BE INTERPRETED
;	  RETURN 1		;NOTHING AT ALL FOUND THAT'S USEFUL
;	  RETURN 2		;SOMETHING FOUND, BUT NO EXACT MATCH
;				; OR MULTIPLY DEFINED IF OFFSET = 0 IN T5
;	  RETURN 3		;EXACT MATCH FOUND AND PRINTED IF T2=0
;				;T2=SYMBOL VALUE IF SILENT FLAG ON
;				;T5 = SYMBOL VALUE BEING 'LOOKED' UP
;				;P1 = ADDRESS OF BEST SYMBOL SO FAR
;				;TRULST=LAST CHARACTER IF LABEL FOUND

LOOK:	SETZM	PNAMSV		;RESET PROGRAM NAME OF SYMBOL
	TRZ	T0,MDLCLF!ID	;[157]Clear flags
	PUSHJ	P,LOKSYM	;CHECK IT
	 POPJ	P,		;NOTHING FOUND
	 JRST	LOOK4		;MULT. DEF. OR OFFSET
	TRNN	T1,LNAME	;[402] Long name?
	MOVE	T2,P1		;No, PTR TO SYMBOL
	MOVEM	P1,LASYM	;[402]SAVE THIS SYMBOL
	MOVE	P2,1(P1)	;[402]GET VALUE
	MOVEM	P2,LASVAL	;SAVE
	TRZE	T0,SILENT	;[402]FOUND - SILENCE?
	JRST	LOK1		;[402] Don't print
	PUSHJ	P,SPT		;NO - TYPE SYMBOL
LOK1:	MOVE	T4,TEM9		;[321] Length of table left to search
	MOVEM	T1,TEM13	;[402] Save T1	
	PUSHJ	P,LOOKPG	;LOOKUP FOR PROGRAM NAME
	JRST	[MOVE	T1,TEM13;[402] Restore it
		JRST	CPOPJ2]	;DOUBLE SKIP - SUCCESS
	MOVE	T1,TEM13	;[402] Restore it

LOOK4:	JUMPE	T5,CPOPJ1	;MULT DEF
	MOVEM	T2,LASYM	;UPDATE LAST SYMBOL
	MOVE	P2,1(T2)	;GET VALUE
	ADDI	P2,(T5)		;WITH OFFSET
	MOVEM	P2,LASVAL	;AS LAST VALUE
	MOVE	T2,SAVT2	;[402]Restore T2 from LOK2
	PUSHJ	P,LOOKPG	;GET PROGRAM NAME
	JRST	CPOPJ1		;2ND SKIP

RELOOK:	MOVE	T2,SAVT2	;[402]RESET (T2)
	MOVE	T4,TEM9		;[321] Reset the length of table
	PUSH	P,[CPOPJ]	;[314] Return
	TRZ	T0,ID		;ALLOW LOKSYM TO FIND IT
	JRST	LOK3		;HERE WE GO AGAIN


;ROUTINE TO LOOKUP FOR PROGRAM NAME
LOOKPG:	PUSH	P,T1		;[402] Save long name flag	
	PUSH	P,T4		;[321] Save these
	PUSH	P,T2		;[321]   registers
LOOKP2:	ADDI	T2,2		;[321] Bump the location
	SUBI	T4,2		;[321] Reduce the size
	JUMPLE	T4,LOOKP3	;[321] End of table
	MOVE	P2,(T2)		;GET NEXT ENTRY
	TLNE	P2,PNAME	;PROGRAM NAME?
	JRST	LOOKP2		;[321] No
	PUSH	P,T5		;[402] Save T5
	PUSHJ	P,LOOKLP	;[402] Look for long program name
	 JFCL			;[402]
	CLRFLG	PNAMSV		;[402]
	POP	P,T5		;[402] Restore T5
	TRNN	T1,LNAME	;[402] Did we get a Long Name?
	JRST	LOKP2A		;[402] NO
	MOVE	P2,T4		;[402] Yes, T4 = CNT+PTR
	SETFLG	PNAMSV		;[402]
LOKP2A:	MOVEM	P2,PNAMSV	;YES - SAVE IT
LOOKP3:	POP	P,T2		;[321] Restore the
	POP	P,T4		;[321] registers
	POP	P,T1		;[402] Restore long name flag
	POPJ	P,		;END ROUTINE
;[326] Search the symbol table for a value.
;[402] Modified for long symbols

;Calling sequence:
;	MOVE T5,Value for which we search
;	PUSHJ P,LOKSYM
;	  Return if not found
;	  Return if multi-def or offset
;	  Return if found
LOKSYM:	HRLOI	T2,377777	;[321] Really big number for
	MOVEM	T2,BESTVA	;[321]   false offset
	SETZM	LBESTV		;We haven't done a long symbol search yet
	SETZ	P1,		;[321] Nothing found yet
	MOVEM	T5,TEM8		;[321] Value for which we search
	TRNE	T1,TYPCMD	;[314] TYPEing?
	 SKIPN	T2,OPENLS	;[314] Yes - Is there an open module?
	  JRST	LOKSM		;[314] No - Search all tables

	MOVE	T4,OPENLZ	;[321] Size of table
	TRO	T1,LNAME	;[402] Look for long symbols only
	PUSHJ	P,LOK2		;[314] Search open module for long symbol
	 JRST	LOKSY2		;[314] Not found - Search for short symbol
	 JRST	CPOPJ1		;[314] Offset or multiple definition
	JRST	CPOPJ2		;[314] Found

LOKSY2:	MOVE	T2,OPENLS	;
	MOVE	T4,OPENLZ	; Size of table
	TRZ	T1,LNAME	; Look for short symbols only
	PUSHJ	P,LOK2		; Search open module
	 JRST	LOKSM		; Not found - Search all tables
	 JRST	CPOPJ1		; Offset or multiple definition
	JRST	CPOPJ2		; Found

;Search all symbol tables	[321] Rewritten

LOKSM:	TRO	T1,LNAME	; set flag to look for long symbols
	PUSHJ	P,SYMADR	;[327] Find symbol table
	 JRST	CPOPJ		;[327] No table, so symbol not found
	MOVE	T5,TEM8		;Value for which we search
	PUSHJ	P,LOK2		;Search that table
	 JRST	LOKSMS		; Not there
	 CAIA			;Multi-def or offset
	JRST	CPOPJ2		;Found

	;SAVE VALUES FROM LONG SYMBOL SEARCH

	MOVE	T5,BESTVA
	MOVEM	T5,LBESTV
	MOVE	T5,TEM9
	MOVEM	T5,LSAVT4
	MOVE	T5,SAVT2
	MOVEM	T5,LSAVT2
	MOVEM	P1,LSAVP1

	HRLOI	T2,377777	;Really big number for
	MOVEM	T2,BESTVA	;  false offset

LOKSMS:	TRZ	T1,LNAME	; clear flag to look for short symbols
	PUSHJ	P,SYMADR	;[327] Find symbol table
	 JRST	CPOPJ		;[327] No table, so symbol not found
	MOVE	T5,TEM8		;Value for which we search
	PUSHJ	P,LOK2		;Search that table
	 JRST	CPOPJ		;[327] Not there
	 CAIA			;Multi-def or offset
	JRST	CPOPJ2		;Found

	SKIPN	LBESTV		;Did we find anything in long symbol search
	JRST	LOKSM1		;No

	MOVE	T5,BESTVA	;Was best short symbol value better than
	CAMGE	T5,LBESTV	; best long symbol value?
	JRST	LOKSM1		;Yes
				;long symbol search was better so restore
	MOVE	T5,LBESTV	;things to the way they were before the
	MOVEM	T5,BESTVA	;short symbol search
	MOVE	T5,LSAVT4
	MOVEM	T5,TEM9
	MOVE	T5,LSAVT2
	MOVEM	T5,SAVT2
	MOVE	P1,LSAVP1

LOKSM1:	JUMPE	T5,CPOPJ1	;[327]Multi-defined

LOKSM2:	JUMPE	P1,CPOPJ	;Nothing found
	MOVE	T2,P1		;Best one found
	MOVE	T4,TEM9		;Number of unsearched words
	MOVE	T5,BESTVA	;Best offset
	JRST	CPOPJ1		;Return to call+2
;Search one module
;	MOVE	T2,Pointer into symbol table
;	MOVE	T4,Number of words to be searched
;	MOVE	T5,Value for which we search
;	PUSHJ	P,LOK2
;	 Return if not found
;	 Return if multi-def or offset
;	 Return if exact match

LOK2:	PUSHJ	P,FIXSYR	;FIX SYM TBL PTR IN (T2)
	JUMPLE	T4,LOK16	;[321] If end of table, not found
	TRNN	T1,LNAME	;[402] Looking for long symbols
	JRST	NONST		;[402] No - skip long symbol code	

; LOOK FOR LONG SYMBOL
	MOVEM	P1,TEM14	;[402] SAVE P1
	MOVEM	T3,TEM3		;[402]
	MOVE	T3,(T2)		;[402]
	TLZ	T3,LOCAL	;[402]Locals only
	CAME	T3,[SQUOZE 0,.SYMTB]	;[402] .SYMTB in RAD50
	JRST	LOK3		;[402] NOT .SYMTB so skip to next entry
	MOVE	P1,1(T2)	;[402]ptr to secondary symbol table
	PUSH	P,T4		;[402] save T4
	HRRZ	T4,(P1)		;[402]Number of symbols
	AOJ	P1,		;[402]First entry	
LOKLLP:	CAMN	T5,1(P1)	;[402]
	JRST	LOK2B		;[402]Match

	MOVE	P2,1(P1)	;[402]OK - GET VALUE
	MOVE	S2,T5		;[402]VALUE WE'RE LOOKING FOR
	XOR	T5,P2		;[402]SAME AS SIGN FOR SYMBOL?
	JUMPGE	T5,LOKSN	;[402]YES. EASY CASE
	TXC	S2,1B0		;[402]NO. MAKE SIGNS THE SAME
	SUB	S2,P2		;[402]SUBTRACT IS SAFE NOW
	TXCA	S2,1B0		;[402]FIX UP SIGN AGAIN
LOKSN:	SUB	S2,P2		;[402]GET OFFSET
	XOR	T5,P2		;[402]EITHER WAY, RESTORE T5
	JUMPL	S2,LOK2F	;[402]Ignore if wrong direction
	CAML	S2,BESTVA	;[402]NO, BUT BETTER VALUE?
	JRST	LOK2F		;[402]NO
;Better value than before
	PUSHJ	P,TRLVAR	;[402]VARIABLE ?
	JRST	[MOVE	P2,TRUFST;[402]
		 CAIN	P2,27	;[402]"M" LABEL?
		 JRST	LOK2F	;[402]YES IGNORE
		 JRST	.+1]	;[402]
	PUSH	P,T2		;[402]SAVE T2 AND T5
	PUSH	P,T5		;[402]
	SKIPN	T5,MATHSM	;[402]SPECIFIC SYMBOL??
	JRST	LOK4BL		;[402]NO
	MOVE	T2,P1		;[402]PTR TO CNT+PTR TO SYMBOL	
	PUSHJ	P,CMPSYM	;[402]COMPARE SYMBOLS pointed to by (T2),T5
	SKIPA			;[402]IS IT THE ONE WE ARE LOOKING FOR
	JRST	LOK4BL		;[402]YES
	POP	P,T5		;[402]NO -RESTORE T2 and T5
	POP	P,T2		;[402]
	JRST	LOK2F		;[402]IGNORE
LOK4BL:	POP	P,T5		;[402]RESTORE T2 and T5
	POP	P,T2		;[402]
LOK4AL:	MOVEM	S2,BESTVA	;[402]BETTER MATCH
	MOVEM	P1,TEM14	;[402]Save pointer into table 
	MOVEM	T2,SAVT2	;[402]Save T2
	MOVE	T3,(P)		;[402]item on stack = T4
	MOVEM	T3,TEM9		;[402]Save length of table

LOK2F:	SOJ	T4,		;[402]Reduce count of unsearched words
 	ADDI	P1,2		;[402]Step to next entry
	JUMPG	T4,LOKLLP	;[402]Loop unless done
	JRST	LOK2D		;[402]Failure

LOK2B:	POP	P,T4		;[402]Restore T4
	MOVE	T5,(P1)		;[402]
	JRST	LOK5A		;[402]MATCH
LOK2D:	POP	P,T4		;[402] Restore T4
LOK2C:	MOVE	P1,TEM14	;[402] Restore P1
	MOVE	T3,TEM3		;[402] Restore T3
	JRST	LOK3		;[402]Loop to get next secondary symbol table

; LOOK FOR SHORT SYMBOL
NONST:	MOVE	P2,(T2)		;GET NEXT SYM
	TLNE	P2,PNAME	;[326] Program name?
	 TLNE	P2,PNAME-<LOCAL!GLOBAL> ;[326] Anything except local/global?
	  JRST	LOK3		;[326] Yes--Ignore it
	MOVE	P2,1(T2)	;OK - GET VALUE
	MOVE	S2,T5		;[135] VALUE WE'RE LOOKING FOR

;IN ORDER TO PREVENT FORDDT FROM GETTING A FIXED-POINT OVERFLOW
;HERE, WE DO THE SIGN-BIT MAGIC TRICK. IF THE SIGNS OF THE 2 VALUES
;ARE DIFFERENT, WE JUST FLIP THE SIGN BIT OF ONE OF THEM, DO THE
;SUBTRACT, AND FLIP IT AGAIN. WE DON'T CARE ABOUT THE OVERFLOW
;CONDITION, SO IT IS JUST LOST TO POSTERITY.
;THIS PATCH COMPLIMENTS OF PHIL ALMQUIST, CARNEGIE-MELLON UNIV.

	XOR	T5,P2		;SAME AS SIGN FOR SYMBOL?
	JUMPGE	T5,LOKSSN	;YES. EASY CASE
	TXC	S2,1B0		;NO. MAKE SIGNS THE SAME
	SUB	S2,P2		;SUBTRACT IS SAFE NOW
	TXCA	S2,1B0		;FIX UP SIGN AGAIN
LOKSSN:	SUB	S2,P2		;[135] GET OFFSET
	XOR	T5,P2		;EITHER WAY, RESTORE T5
	JUMPL	S2,LOK3		;[314] Ignore if wrong direction
	JUMPE	S2,LOK5		;EXACT MATCH?
	CAMGE	S2,BESTVA	;NO, BUT BETTER VALUE?
	JRST	LOK4		;YES

LOK3:	ADDI	T2,2		;[321] Step to next entry
	SUBI	T4,2		;[321] Reduce number of words left
	JUMPG	T4,LOK2		;[321] Loop unless done
	JRST	LOK16		;[171] Finish up

;Better value than before
LOK4:	PUSHJ	P,TRUVAR	;VARIABLE ?
	JRST	[MOVE	P2,TRUFST
		 CAIN	P2,27	;"M" LABEL?
		 JRST	LOK3	;YES IGNORE
		 JRST	.+1]
	SKIPN	P2,MATHSM	;SPECIFIC SYMBOL??
	JRST	LOK4A		;NO
	PUSH	P,P1		;SAVE P1
	MOVE	P1,(T2)		;GET SYMBOL
	TLZ	P1,PNAME	;FIX UP A BIT
	CAMN	P1,P2		;IS IT THE ONE WE ARE LOOKING FOR
	JRST	LOK4B		;YES
LOK4C:	POP	P,P1		;NO -RESTORE
	JRST	LOK3		;IGNORE
LOK4B:	POP	P,P1		;
LOK4A:	MOVEM	S2,BESTVA	;BETTER MATCH
	MOVE	P1,T2		;[321] Save pointer into table
	MOVEM	T2,SAVT2	;[402]Save T2
	MOVEM	T4,TEM9		;[321] Save length of table
	JRST	LOK3		;KEEP GOING

;Exact match
LOK5:	PUSHJ	P,TRUVAR	;F10 SYMBOL?
	 JRST	[TRNE	T0,ID	;NO - LABEL - MATCH ALREADY?
		 JRST	LOK12	;     YES - CHECK HIERARCHY
		 JRST	LOK14]	;     NO - TAKE IT
	SKIPN	P2,MATHSM	;ACCEPT ONLY THIS SYMBOL IF SET
	JRST	LOK7

;Looking for a specific symbol
	PUSH	P,P1		;SAVE P1
	MOVE	P1,(T2)		;GET SYMBOL
	TLZ	P1,PNAME
	CAME	P1,P2
	JRST	LOK4C		;IGNORE IT IF NOT THE SAME
	POP	P,P1		;REMOVE POP
	MOVE	P1,T2
LOK5A:	MOVEM	T4,TEM9		;[321] Save size
	MOVE	P2,(T2)		;LETS TAKE IT AND RUN
	TLNE	P2,GLOBAL	;GLOBAL?
	JRST	LOK11		;YES DONE
	JRST	CPOPJ2		;ALSO DONE

;Looking for any symbol
LOK7:	TRON	T0,ID		;First time?
	 JRST	LOK9		;Yes--Fix it up
	TRO	T0,MDLCLF	;SECOND SYM FOUND - MULT. DEF.
	MOVE	P2,(T2)		;GET SECOND SYMBOL FOUND
	TLNN	P2,GLOBAL	;SEE IF IT IS A GLOBAL
	JRST	LOK8A		;OTHER LOCAL - GO SEE IF EQUIVALENT DEFINITION
	MOVE	P1,T2		;GLOBAL HAS HIGHER PRIORITY
	MOVEM	T4,TEM9		;[321] Save length of table
	JRST	LOK11		;DONE
LOK8A:	JUMPN	S2,CPOPJ1	;NOT EXACT MATCH
	MOVE	T5,(P1)		;GET PREVIOUS FOUND
	TLZ	T5,PNAME	;JUST RADIX-50 NAME
	TLZ	P2,PNAME	;ALSO FOR NEW FOUND
	CAME	P2,T5		;SAME NAME
	JRST	CPOPJ1		;NO
	JRST	LOK11		;YES - MAY BE COMMON BECAUSE
				; SAME NAME + SAME ADDRESS

;First match for this value
LOK9:	MOVE	P1,T2		;UPDATE PTR
	MOVEM	T4,TEM9		;[321] Save length of table
	MOVE	P2,(T2)		;GET SYM
	TLNE	P2,GLOBAL	;GLOBAL?
	JRST	LOK11		;YES - DONE
	SETZM	BESTVA		;BEST MATCH
	JRST	LOK3		;AND ON

LOK11:	MOVE	T5,1(P1)	;[314] The value
	JRST	CPOPJ2		;[314] Return

;It is label
LOK12:	MOVE	P2,LOKFST	;GET THE (LAST) CHAR
	EXCH	P2,TRUFST	;KEEP TRUFST UPDATED
	CAIE	P2,27		;"M"?
	CAMG	P2,TRUFST	;DOES THIS HAVE HIGHER PRIORITY?
	JRST	LOK3		;NO - IGNORE IT
	TRZ	T0,ID		;YES - USE IT
	JRST	LOK7		;

LOK14:	MOVE	P2,TRUFST	;GET THE LABEL TYPE
	CAIN	P2,27 		;"M" ?
	JRST	LOK3		;YES IGNORE
	MOVEM	P2,LOKFST	;SAVE IT
	JRST	LOK7		;AND USE THIS SYMBOL
				;[171] Restart search from beginning

;[314] Done
LOK16:	JUMPE	P1,CPOPJ	;[104] FAIL IF NONE FOUND
	CAMN	T5,1(P1)	;EXACT MATCH?
	JRST	CPOPJ2		;YES - SUCCEED
	MOVE	P2,1(P1)	;NO, SO GET BEST VALUE
	SUB	T5,P2		;GET OFFSET
	JRST	CPOPJ1		;EXIT FOR OFFSET

;Locate the symbol table	[327] New
;Calling sequence:
;	PUSHJ	P,SYMADR
;	 Return if no table
;	 Normal return with T2 pointing to table, T4 containing size
SYMADR:	PUSH	P,T1		;%SVCNV expects input here
	MOVE	T1,.JBSYM	;IOWD, global address or zero
	PUSHJ	P,%SVCNV##	;Use routine in FORLIB
	MOVE	T4,T2		;Size of table
	MOVE	T2,T1		;Global address of table
	POP	P,T1		;Restore this
	SKIPE	T4		;Anything found?
	 AOS	(P)		;Yes--Return to call+2
	POPJ	P,
;	ROUTINES TO TYPE A SYMBOL IN THE NON OPEN SECTION

SYMBOL:	PUSHJ	P,SAV2AC	;SAVE T5,P1
	TRNE	T0,MDLCLF	;SYMBOL ALREADY TYPED
	JRST	SYMBL2		;DISPLAY ALTERNATE NAME

SYMBL3:	MOVE	T5,(T2)		;GET THE OUTPUT STRING
	PJRST	SPT1		;TYPE IT AND RESTORE T5,P1

SYMBL2:	LINE
	TYPE(  equivalent to )
	JRST	SYMBL3		;NOW TYPE NAME



;	TYPE THE SECTION NAME (ADDRESS OF NAME IS IN T2 )

SECTON:	PUSHJ	P,SAV2AC	;SAVE T5,P1
	SKIPE	T5,(T2)		;[202] ANY SECTION NAME?
	CAMN	T5,SECSAV	;ALREADY TYPED?
	POPJ	P,		;[202] YES - MUST BE A RANGE, OR NO NAME
	MOVEM	T5,SECSAV	;SAVE THE NEW ONE BEING TYPED
	TRNE	T1,COMDAT	;[171] Field in COMMON?
	 JRST	SECT1		;[171] YES, special typeout
	TYPE( in )
	JRST	SYMBL3		;NOW TYPE NAME
SECT1:	TYPE( in (COMMON))	;[171] Let user know it's in COMMON
	POPJ	P,		;[171] DONE

;	PRESERVE REGISTERS T5 AND P1

SAV2AC:	EXCH	T5,(P)		;SAVE T5, AND GET RETURN
	MOVEM	T5,TRULST	;SAVE AS ESCAPE
	MOVE	T5,(P)		;RESTORE T5
	PUSH	P,P1		;SAVE P1
	XMOVEI	P1,SAVRET	;[300] INTERCEPT FOR FINAL POPJ
	PUSH	P,P1		;SAVE FOR RETURN
	MOVE	P1,-1(P)	;REINSTATE P1
	JRST	@TRULST		;PSEUDO POPJ BACK TO USER
SAVRET:	POP	P,P1		;RESTORE OLD P1
	POP	P,T5		;RESTORE OLD T5
	POPJ	P,		;FINALLY DO THE USERS POPJ
	SUBTTL OUTPUT ROUTINES

;OFFSET TYPES THE SYMBOL WHOSE VALUE IS IN AC T5.  SUBSCRIPTS ARE
;HANDLED.  THERE IS A SKIP RETURN ON SUCCESS, FAIL IF SYMBOL NOT FOUND.
OFFSET:	SKIPN	T5,T5		;[167]Are we looking for a real symbol?
	 POPJ	P,		;[167]NO
	MOVEM	T5,TEM5		;[167]Save current symbol value
	EXCH	T5,SAVLOC	;[202] UPDATE SAVLOC
	MOVEM	T5,TEM6		;[202] BUT SAVE OLD VALUE
	LDSYM	T5,MATHSM	;[402] Get symbol
	MOVEM	T5,TEM7		;[223] IN CASE A FORMAL
	TRNE	P3,C.		;[170]Character?
	 JRST	CHARAY		;[167]YES, different processing
	TRNE	T0,FORMAL	;[223] FORMAL FLAG ON?
	 PUSHJ	P,OFFFRM	;[223] YES, MAYBE TELL IT'S FORMAL
OFFS2:	PUSHJ	P,RAYNAM	;[223][167]Does symbol denote array?
	 JRST	OFF1		;[202][167]Doesn't look that way

;[223] HERE WHEN WE KNOW THE SYMBOL DENOTES AN ARRAY
OFF0:	MOVE	T5,TEM5		;[202] GET VALUE OF SYM
	TRO	T0,SILENT	;SILENCE
	SETZM	TEM7		;[223] CLEAR OFFSET SAVE
	PUSHJ	P,LOOK		;GET SYM PTR
	 JRST	E5		;
	 MOVEM	T5,TEM7		;[223] SAVE OFFSET
	TRNN	T1,LNAME	;[402] Short name?
	 MOVE	P1,T2		;Yes, GET PTR
	MOVE	P2,TEM7		;[223] GET OFFSET
	JRST	OFF2		;[202] GO PRINT

;[223]HERE WHEN WE SUSPECT THE SYMBOL IS NOT AN ARRAY OR IS NOT THE BASE
;[223]ADDRESS OF AN ARRAY. NOTE THAT WE CAN GET HERE FOR THE 2ND-NTH SUBSCRIPT
;[223]ON A RANGE TYPEOUT, SINCE THE SYMBOL PASSED TO OFFSET IN THIS CASE IS NOT
;[223]AN "EXACT MATCH." WE CAN ALSO GET HERE FOR MULTIPLY-DEFINED SYMBOLS AND
;[223]SCALARS.

OFF1:	MOVE	T5,TEM6		;[202][167]Restore input symbol[SAVLOC]
	JUMPE	T5,OFF1A	;[202] SAVLOC NOT AVAILABLE
	MOVEM	T5,SAVLOC	;[202][167]Put it back
	PUSHJ	P,RAYNAM	;[167]Now see if IT'S an array
				;[202]
	  JRST	OFF1A		;NOT AN ARRAY KNOWN
	TRNN	T0,FORMAL	;[223] FORMAL NOW?
	 JRST	OFF7		;[202] NO
	PUSHJ	P,OFFFRM	;[223] YES, TELL (UNLESS ALREADY TOLD),
	JRST	OFFS2		;[223] AND TRY AGAIN

CHARAY:	PUSHJ	P,RAYNAM	;[167]Is it an array?
	 JRST	SCLCHR		;[167]NO
OFFCHR:	MOVE	P1,CRYSYM	;[157]Load addr/RAD50 name
	MOVE	P2,CLMOFF	;[157]Load element offset
	JRST	OFF2		;[157]Go compute indices

SCLCHR:	MOVE	P1,CRYSYM	;[160]
	PUSHJ	P,SPT		;[160]
	JRST	OFF5A		;[160]

OFF7:	MOVE	T5,TEM5		;[110] RESTORE T5
	TRO	T0,SILENT	;WE DONT WANT TO TYPE THE SYMBOL
	PUSHJ	P,LOOK		;NOT ARRAY START
	  POPJ	P,		;[110] NOT FOUND
	 MOVE	P2,T5		;OFFSET - GET IT
	JRST	OFF2		;FOUND - GO PRINT
OFF1A:	MOVE	T5,TEM5		;TRY TO FIND THE REQUESTED SYMBOL
	TRO	T0,SILENT	;DONT PRINT NOW
	PUSHJ	P,LOOK
	  POPJ	P,		;[110] NOT FOUND
	  SKIPA	P2,T5		;MAY BE AN ARRAY
	JRST	[TRNN	T1,LNAME;[402] Long name?
		  MOVE	P1,T2	;No, WAS A SINGLE VAR - FOUND
		 PUSHJ	P,SPT	;TYPE NAME
		 JRST	OFF5A]	;TYPE LOC IF NOT CURRENT
	MOVEM	T2,TEM6		;KEEP SYMBOL NAME FOUND
	MOVEM	P2,TEM		;KEEP OFFSET
	MOVE	T5,TEM5		;GET BACK ORIGINAL ADDR
	SUB	T5,P2		;MINUS OFFSET SHOUD BE ARRAY START
	MOVEM	T5,SAVLOC	;MAY BE IT IS
	PUSHJ	P,RAYNAM	;TRY IT
	  JRST	ERR34		;NOT
	MOVE	P1,TEM6		;GET BACK SYMBOL NAME
	MOVE	P2,TEM		;AND OFFSET


;[223] HERE TO TYPE OUT SUBSCRIPT INFORMATION FOR A SYMBOL WE ARE
;[223] CERTAIN IS AN ARRAY.
OFF2:	MOVEM	P2,TEM		;SAVE OFFSET
	LDFLG	MATHSM		;[402] If long name then set long name flag
	PUSHJ	P,SPT		;PRINT SYMBOL
	openp
	PUSH	P,SAVLOC	;SAVE SAVLOC AROUND OFFSET PRINT
	PUSH	P,P4		;AR TOO
	MOVEM	P,DIMTOT	;AND FREEZE PD LIST
	SETZM	PUTTER
	SETZM	COUNT		;PREPARE
	MOVE	P1,TEM
	TRZE	T0,DOUBLE	;[112] DOUBLE WORD ARRAY?
	LSH	P1,-1		;YES - ONLY HALF OFFSET
	MOVEM	P1,TEM7		;SAVE P1
	MOVEI	T5,1
	MOVEM	T5,RP		;SET UP RANGE PRODUCT
OFF3:	PUSHJ	P,GETDIM	;GET DIMENSIONS TEM,TEM1
	PUSH	P,TEM		;SAVE LOWER VALUE
	PUSH	P,RP		;SAVE CURRENT RANGE PRODUCT
	MOVE	T5,TEM1
	SUB	T5,TEM
	AOJ	T5,		;FORM RANGE FOR THIS DIM
	IMULM	T5,RP
	AOS	COUNT		;INC COUNT OF # OF DIMS
	PUSHJ	P,MORDIM	;MORE?
	 CAIA
	JRST	OFF3		;YES
	MOVE	P4,COUNT	;NO
	MOVE	T4,P		;COPY PD LIST
	MOVE	P1,TEM7		;RESTORE P1

OFF4:	POP	T4,T3		;GET LAST RP
	POP	T4,T5		;LOWER SUBSCRIPT
	IDIV	P1,T3		;VALUE OF FIRST ELEMENT
	ADD	P1,T5		;[321] CORRECT FOR USERS OFFSET
	MOVEM	P1,1(T4)	;[321] SAVE FOR PRINTING
	EXCH	P1,P2		;GET OFFSET REMAINDER
	SOJG	P4,OFF4

	SKIPA	P4,COUNT	;RESET DIM CNT

OFF5:	jrst	[stype(</,/>)
		jrst	.+1]
	MOVE	T5,1(T4)	;[321] FIRST ELEMENT
	PUSHJ	P,TYP0		;TYPE IT DECIMAL
	ADDI	T4,2		;NEXT ELEMENT
	SOJG	P4,OFF5

	closep
	MOVE	P,DIMTOT	;RESET PD LIST
	POP	P,P4
	POP	P,SAVLOC	;RESTORE

OFF5A:	SKIPN	SSLOW		;[401] Do we have a substring?
	JRST	OFF6		;[401] No
	openp			;[401] type "("
	PUSH 	P,T5		;[401] save it
	MOVE	T5,SSLOW	;[401] T5 = lower bound
	PUSHJ 	P,TYP0		;[401] type decimal number in T5
	TYPE(:)			;[401] type ":"
	MOVE	T5,SSUP		;[401] T5 = upper bound
	PUSHJ 	P,TYP0		;[401] type decimal number in T5
	POP	P,T5		;[401] restore it
	closep			;[401] type ")"

OFF6:	PUSHJ	P,CMPPO		;[402] Compare PNAMSV and OPENED
	 SKIPA			;[402] NO MATCH
	JRST	CPOPJ1		;[402] MATCH
	MOVEI	T2,PNAMSV
	PUSHJ	P,SECTON	;NO - TYPE IT IF APPROPRIATE
				;[202]
	JRST	CPOPJ1

;[223]ROUTINE TO TELL USER IT'S A FORMAL. RETURNS IMMEDIATELY IF WE
;[223]HAVE ALREADY TOLD THIS. OTHERWISE PRINTS THE FORMAL NAME AND REVERTS
;[223]PROCESSING TO THE ACTUAL PASSED PARAMETER (I.E. WE FORGET IT'S A FORMAL).
OFFFRM:	SKIPE	MATHSM		;[223] ANY SYMBOL?
	SKIPN	FRMSAV		;[223] OR FORMAL?
	 POPJ	P,		;[223] NO, RETURN NOW
	TYPE	(Formal parameter ) ;[223] YES, TELL THE USER
	MOVEI	P1,TEM7		;[223] TYPE NAME OF FORMAL ARGUMENT
	PUSHJ	P,SPT		;[223] SO HE KNOWS
	LINE			;[223]
	SETZM	MATHSM		;[223]FORGET ABOUT SPECIFIC NAME
	MOVE 	T5,FRMSAV	;[223] SETUP SAVLOC WITH ACTUAL
	MOVEM	T5,SAVLOC	;[223]  PASSED PARAMETER
	SETZM	FRMSAV		;[223] FORGET WE ARE A FORMAL
	POPJ	P,		;[223] AND RETURN
;	SYMBOL OUTPUT SUBROUTINE

SPT:				;RADIX 50 SYMBOL PRINT
	TRNN	T1,LNAME	;[402] Long symbol?
	JRST	SPT0		;[402] No
	MOVE	T5,(P1)		;[402] Yes, GET SYMBOL
	JRST	SPT2		;[402]
SPT0:	LDB	T5,[POINT 32,0(P1),35]	;GET SYMBOL
	JRST	SPT2		;[201] NOT A POSSIBLE ROUTINE NAME
SPT1:	SYMSKN	PRGNAM		;[402] Long program name?
	JRST	SPT1B		;[402]
	PUSH	P,T2		;[402]
	MOVEI	T2,PRGNAM	;[402]
	TRNE	T1,LNAME	;[402] LONG SYMBOL?
	PUSHJ	P,CMPSYM	;[402] DO WE ALREADY KNOW ABOUT IT
	 JRST	SPT1A		;[402] NO
	POP	P,T2		;[402]
	JRST	SPT8		;[402]
SPT1A:	POP	P,T2		;[402]
SPT1B:	CAME	T5,PRGNAM	;COMPARE NAME WITH MAIN PROG NAME
	CAMN	T5,[SQUOZE 0,MAIN.]
	JRST	SPT8
SPT2:	TRNE	T1,LNAME	;[402] Long name?
	  JRST	LSPT		;[402] Yes, print long sixbit name
	PUSH	P,T5		;[201] SAVE T5 OVER THE NEXT FEW LINES
	MOVEI	P1,T5		;SET UP FOR TRULBL
	PUSHJ	P,TRULBL	;IS THIS A TRUE-LABEL
	 CAIA			;NO
	JRST	SPT5		;YES - SEE IF SOURCE LINE

SPT6:	POP	P,T5		;RESTORE T5 = SYMBOL
	XMOVEI	P1,SPT4		;[300] SPECIAL TREATMENT FOR LAST CHARACTER
	PUSH	P,P1		;SAVE ON STACK
SPT3:	TLZ	T5,PNAME	;RADIX 50 PART ONLY
	IDIVI	T5,50
	PUSH	P,P1		;[300]
	JUMPE	T5,[SETOM P1
		   JRST	.+2]
	PUSHJ	P,SPT3
	POP	P,T5		;[300]
	;[402] T5 IS A RAD50 CHARACTER - CONVERT TO ASCII
	CAMGE	T5,[SQUOZE 0,A]	;[402]less than rad50 'A'
	JRST	[ADDI	T5,57	;[402]We have a digit
		JRST	SPT3A]	;[402]
	CAMG	T5,[SQUOZE 0,Z]	;[402]greater than rad50 'Z'
	JRST	[ADDI	T5,66	;[402]We have a letter
		JRST	SPT3A]	;[402]
	;[402]Check for "."
	CAIN	T5,[SQUOZE 0,.]	;[402]
	JRST	[MOVEI	T5,"."	;[402]
		JRST	SPT3A]	;[402]
	;[402]We now have either "$" or "%" ("%" should be changed to "_")
	SUBI	T5,2		;[402] Convert "$" and "%" to ascii
	CAIN	T5,"%"		;[402]
	MOVEI	T5,"_"		;[402]
SPT3A:	JUMPL	P1,SPT7		;FIRST TIME ROUND IS SPECIAL
	EXCH	T5,SAVCHR	;SAVE AS LAST CHARACTER
	PJRST	TOUT		;DISPLAY CHARACTER

SPT8:	TYPE	(MAIN PROGRAM)
	POPJ	P,

SPT4:	MOVE	T5,SAVCHR	;GET BACK THE LAST CHARACTER
	JUMPN	P1,CPOPJ	;DO WE TYPE THE LAST CHARACTER
	PJRST	TOUT		;YES

SPT5:	SKIPGE	BP0FLG		;[145] ANOTHER SPECIAL BREAKPOINT-0 CASE
	  JRST	SPT50		;[145] IF BP0, GO DO SPECIAL CODE
	MOVEI	P1,26		;GET RADIX 50 'L'
	CAMN	P1,TRULST	;IS THIS A SOURCE LINE REFFERENCE
	jrst	[TYPE(L#)
		jrst	.+1]
	JRST	SPT6		;DISPLAY THE SOURCE LINE TAG

SPT50:	MOVE	P1,TRULST	;[145] GET LAST CHAR
	CAIE	P1,26		;[145] "L"?
	  JRST	[TYPE (statement ) ;[145] NO, "p"
		 JRST SPT6]	;[145]
	TYPE	(line )		;[145]
	JRST	SPT6		;[145]

SPT7:	CAIL	T5,"0"
	CAILE	T5,"9"
	TDZA	P1,P1		;ZERO IF FIRST CHAR NOT NUMERIC
	HRRZI	P1,-1		;.GT. ZERO IF FIRST CHAR IS NUMERIC
	MOVEM	T5,SAVCHR	;SAVE LAST CHARACTER
	POPJ	P,
;[402] Routine to print long sixbit name
;[402] T5 = flg+length+pointer

LSPT:	PUSH	P,T3		;Save T3, T4 and T5
	PUSH	P,T4
	PUSH	P,T5

	MOVE	T3,T5		;T3 = addr of long sixbit string name
	TLZ	T3,770000	;clear flag+length leaving 30 bit addr

	TLZ	T5,LFLG		;clear flag bits
	LSH	T5,-CNTSFT	;Number of words to print
	IMULI	T5,6		;Number of sixbit characters to print
	TLNE	T3,-1		;[405]Skip if local address
         JRST	[IOR	T3,[450000000000] ;[405]Global address, make OWGBP to name
	 	JRST .+2]	;[405]
	IOR	T3,[POINT 6,0] 	;Bytepointer to name
LSLP:	ILDB	T4,T3		;Get next character
	JUMPE	T4,LSPT2	;Don't print following blanks
	ADDI	T4,40		;Convert to ascii
 	putchr	(T4)		;Output character
	SOJG	T5,LSLP		;Decrement loop count and repeat

LSPT2:	POP	P,T5		;Restore T3, T4 and T5
	POP	P,T4		
	POP	P,T3
	POPJ	P,
	SUBTTL	GENERAL NUMBER INPUT ROUTINE

;	DELIMITERS ARE SPACES TABS OR , OR )   LAST CHAR IN T2

GETNUM:	TDZ	T0,[XWD OCTF!SIGN!FPF!MF!FEF,POWF]
	CLEARM	SYL
	CLEARM	DEN
	PUSHJ	P,GETSKB	;REMOVE USERS LEADING SPACES OR TABS
	PUSHJ	P,EITHR3	;PROCESS
EITHR4:	CAIE	T2,"."		;[116] POSSIBLY A LOGICAL SYMBOL?
	TRZ	T1,LGCLEG	;[116] NO, MAKE SURE EVERYONE KNOWS
	PUSHJ	P,GETNBL	;PROCESS NEXT CHARACTER
	JRST	.-1		;UNTIL DELIMITER
GETNBL:	XCT	GETCHR		;GET NEXT NON BLANK USER CHAR
	PUSHJ	P,GETSK2	;TEST FOR DELIMITERS

;	ENTRY POINT FROM 'EITHER'

EITHR3:	JUMPE	T2,POWER	;LAST CHAR WAS A DELIMITER
	MOVE	T5,[JRST GETOUT] ;[120] IN CASE WE GO TO LOGICL
	MOVEM	T5,DONE		;[120] THIS IS HOW WE'LL WANT TO RETURN
	CAIE	T2,","		;ALLOW , AS # DELIMITER
	CAIN	T2,")"		;ALLOW ALSO RIGHT PARENS
	JRST	POWER		; DELIMITER SEEN - CLEAN UP

	CAIE	T2,"/"		;BAR IS A DELIMITER IN DIMENSION DEFS
	CAIN	T2,"]"		;LEFT SQUARE BRKT ALSO
	JRST	POWER		;DELIMITER

	CAIE	T2,":"		;ACCEPT : FOR DIMENSIONS
	CAIN	T2,"="		;ACCEPT = AS DELIMITER
	JRST	POWER

	MOVE	T5,T2		;MORE USEFUL IN T5
	CAIN	T5,42		;IS IT " ?
	JRST	OCTAL		;YES - HOIST THE OCTAL FLAG

	CAIE	T5,"+"		;BOTH PLUS AND MINUS
	CAIN	T5,"-"		;   DISPATCH TO
	JRST	SGN		;	THE SAME PLACE

	CAIN	T5,"."		;PERIOD TYPED ?
	JRST	PERIOD		;THIS MEANS INPUT CANNOT BE OCTAL

	CAIE	T5,"D"+40	;[113]
	CAIN	T5,"D"		;[113] DOUBLE PRECISION NOT ALLOWED HERE
	JRST	ERR21		;[113]
	CAIE	T5,"E"+40	;[113]
	CAIN	T5,"E"		;EXPONENT REQUESTED?
	JRST	E		;FLOATING POINT VALUES ONLY RETURNED

	CAIL	T5,"0"		;NUMERALS ONLY
	CAILE	T5,"9"		;
	JRST	LOGICL		;[116] LET'S SEE IF WE HAVE A LOGICAL SYMBOL
	SUBI	T5,60		;FORM OCTAL REPRESENTATION
	JRST	NUM		;GO DEAL WITH NUMERIC INPUT

LOGICL:	TRZN	T1,LGCLEG	;[116] ARE LOGICAL SYMBOLS LEGAL?
	JRST	ERR7		;[116] NOPE, BAD STUFF
	TLZ	T0,FPF		;[116] TURN OFF FLOATING POINT FLAG
	TRZ	T0,POWF		;[116] AND POWER FLAG (SET WHEN "." SEEN)
	PUSHJ	P,EITHR5	;[116] LET'S GET THE WHOLE WORD
	CAIE	T2,"."		;[116] DOES IT END WITH PERIOD?
	JRST	ERR7		;[116] NO, CAN'T BE A LOGICAL SYMBOL
	CAME	T3,[SIXBIT /TRUE/] ;[116] IS IT .TRUE.?
	JRST	FALSE		;[116] NOPE, COULD BE .FALSE.
	SETO	T5,		;[116] IT'S .TRUE.! RETURN -1
	TRO	T1,ISLOGI	;[116] LET 'EM KNOW WE HAVE A LOGICAL
	PUSHJ	P,LOADCH	;[116] GET NEXT CHARACTER
	PUSHJ	P,GETSK2	;[116] TAKE CARE OF DELIMETERS
	XCT	DONE		;[120] WE ARE DONE!
FALSE:	CAME	T3,[SIXBIT /FALSE/] ;[116] IS IT .FALSE.?
	JRST	ERR7		;[116] NO, JUNK
	SETZ	T5,		;[116] IT'S .FALSE.! RETURN 0
	TRO	T1,ISLOGI	;[116] LET 'EM KNOW WE HAVE A LOGICAL
	PUSHJ	P,LOADCH	;[116] GET NEXT CHARACTER
	PUSHJ	P,GETSK2	;[116] TAKE CARE OF DELIMETERS
	XCT	DONE		;[120] LEAVE NOW
DONE:	BLOCK	1		;[120] RETURN STATEMENT FOR LOGICL

OCTAL:	SKIPN	SYL		;HAVE ANY SIGNIFICANT CHARACTERS BEEN SEEN
	TLOE	T0,OCTF		;STAMP THIS AS AN OCTAL NUMBER
	JRST	ERR7		;ERROR
	POPJ	P,
SGN:	SKIPE	SYL		;HAVE ANY SIGNIFICANT CHARACTERS BEEN SEEN?
	JRST	ERR7		;YES - TOO BAD
	TLOE	T0,SIGN		;HAS A SIGN BEEN SEEN BEFORE?
	JRST	ERR7		;YES - REJECT
	CAIE	T5,"+"		;NO SPECIAL ACTION FOR PLUS
	TLO	T0,MF		;SET THE MINUS FLAG
	POPJ	P,		;
NUM:	ANDI	T5,17		;T5 HOLDS CHARACTER
	TLNE	T0,FPF
	JRST	NM1
	MOVE	T4,SYL
	TLNE	T4,700000	;TEST FOR PENDING WORD OVERFLOW
	JRST	ERR7		;BAD VALUE
	LSH	T4,3
	ADD	T4,T5
	MOVEM	T4,SYL
	MOVE	T4,DEN
	IMULI	T4,12		;CONVERT TO DECIMAL
	ADD	T4,T5
	MOVEM	T4,DEN
	POPJ	P,

NM1:	MOVEI	P1,6		;FORM FLOATING POINT NUMBER
	AOS	NM1A
NM1A:	MOVEI	P2,0
	MOVSI	T2,201400
NM1A1:	TRZE	P2,1
	FMPR	T2,FT(P1)
	JUMPE	P2,NM1B
	LSH	P2,-1
	SOJG	P1,NM1A1
NM1B:	MOVSI	P1,211000(T5)
	FMPR	T2,P1		;COMPUTE VALUE OF NEW DIGIT
	FADRB	T2,FH		;ADD VALUE INTO FLOATING NO.
	MOVEM	T2,SYL
	TRO	T0,POWF		;INDICATE THAT ANSWER WILL BE FLOATED
	POPJ	P,

POWER:	TLNN	T0,FEF		;HAS E BEEN SEEN?
	JRST	POW3		; NO - MUST BE INTEGER OR OCT AL OR #.#
	MOVE	T5,SYL
	MOVE	P2,DEN
	CAILE	P2,^D38		;POWERS <38 ONLY
	JRST	ERR7
	MOVEI	P1,FT-1
	TLZE	T0,MF
	MOVEI	P1,FT01
	SKIPA	T5,FSV
POW2:	LSH	P2,-1
	TRZE	P2,1
	FMPR	T5,(P1)
	JUMPE	P2,GETOUT
	SOJA	P1,POW2
PERIOD:	TLNN	T0,OCTF		;DO WE HAVE AN OCTAL NO.
	TLOE	T0,FPF		;BOTH OCTAL AND FPF CANNOT EXIST TOGETHER
	JRST	ERR7

	MOVE	T5,DEN
	IDIVI	T5,400
	JUMPE	T5,.+2
	TLC	T5,243000
	TLC	P1,233000
	FAD	T5,[0]		;NORMALIZE T5 AND P1
	FAD	P1,[0]
	FADR	T5,P1
	MOVEM	T5,FH
	MOVEM	T5,SYL		;SAVE FLOATING ANSWER
	TRO	T0,POWF		;AND REMEMBER WE NOW HAVE REAL
	HLLZS	NM1A
	POPJ	P,

E:	TLON	T0,FEF		;HOIST THE FLOAT FLAG IF NOT UP
	TLNN	T0,FPF		;REJECT IF E REQUESTED AND NO FPF
	JRST	ERR7

	TRNN	T0,POWF		;USER MUST TYPE A DIGIT AFTER THE PERIOD
	JRST	ERR7

	TLZN	T0,MF
	SKIPA	P1,SYL
	MOVN	P1,SYL
	MOVEM	P1,FSV
	CLEARM	SYL
	CLEARM	DEN
	TLZ	T0,FPF!SIGN!MF
	POPJ	P,


POW3:				;ANSWER IN SYL IF #.# OR OCTAL OR INTEGER

	TLNN	T0,FPF!OCTF	;TEST FOR INTEGER
	TLO	T0,FPF		;MUST BE INTEGER
	TDNN	T0,[XWD OCTF,POWF]
	TLNN	T0,FPF		;DO WE HAVE INTEGER?
	SKIPA	T5,SYL		;NO - GET OCTAL
	MOVE	T5,DEN		;GET DECIMAL
	TLNE	T0,MF		;SHOULD WE  RETURN  NEGATIVE#
	MOVNS	T5,T5		; YES - DO SO
GETOUT:	MOVE	T2,LSTCHR	;SET USERS LAST CHARACTER
	POP	P,(P)
	POPJ	P,		;FINALLY OUT OF GETNUM
	SUBTTL	OUTPUT ROUTINES

;	FLOATING POINT OUTPUT

TFLOT:	MOVE	T2,T5
	JUMPGE	T2, TFLOT1
	MOVNS	T2
	MOVEI	T5,"-"
	PUSHJ	P,TOUT
	TLZE	T2,400000
	JRST	FP1A

TFLOT1:	TLNN	T2, 400
	PJRST	FP7		;DECIMAL PRINT

	MOVEI	T3,0
	CAMGE	T2,FT01
	JRST	FP4

	CAML	T2,FT8
	AOJA	T3,FP4
FP1A:	MOVEI	T4,0

FP3:	MULI	T2,400
	ASHC	T3,-243(T2)
	SETZM	TEM1		;INIT 8 DIGIT COUNTER
	SKIPE	T2,T3		;DON'T TYPE A LEADING 0
	PUSHJ	P,FP7		;PRINT INTEGER PART OF 8 DIGITS
	MOVEI	T5,"."		;GET A MINUS
	PUSHJ	P,TOUT		;AND DISPLAY IT
	MOVNI	T2,10
	ADD	T2,TEM1
	MOVE	P1,T4
FP3A:	MOVE	T5,P1
	MULI	T5,12
	PUSHJ	P,FP7B
	JUMPE	P1,CPOPJ
	AOJL	T2,FP3A
	POPJ	P,
FP4:	MOVNI	T4,6
	MOVEI	P2,0
FP4A:	ASH	P2,1
	XCT	FCP(T3)
	JRST	FP4B

	FMPR	T2,@FCP+1(T3)
	IORI	P2,1
FP4B:	AOJN	T4,FP4A
	PUSH	P,P2		;SAVE EXPONENT
	PUSH	P,FSGN(T3)	;SAVE "E+" OR "E-"
	PUSHJ	P,FP3		;PRINT OUT FFF.FFF PART OF NUMBER
	POP	P,P1		;GET "E+" OR "E-" BACK
	PUSHJ	P,TEXT
	POP	P,T2		;GET EXPONENT BACK
FP7:	IDIVI	T2,12		;DECIMAL OUTPUT SUBROUTINE
	AOS	TEM1
	PUSH	P,T3		;[303]
	JUMPE	T2,FP7A1
	PUSHJ	P,FP7

FP7A1:	POP	P,T5		;[303]
FP7B:	ADDI	T5,260
	JRST	TOUT

	353473426555	;1.0E32
	266434157116	;1.0E16
FT8:	233575360400	;1.0E8
	216470400000	;1.0E4
	207620000000	;1.0E2
	204500000000	;1.0E1
FT:	201400000000	;1.0E0
	026637304365	;1.0E-32
	113715126246	;1.0E-16
	146527461671	;1.0E-8
	163643334273	;1.0E-4
	172507534122	;1.0E-2
FT01:	175631463146	;1.0E-1
FT0=FT01+1

FCP:	CAMLE	T2, FT0(T4)
	CAMGE	T2, FT(T4)
	Z	FT0(T4)

FSGN:	ASCII	.E-.
	ASCII	.E+.
;	TTY HANDLERS

TEXT:	TLNN	P1,774000	;LEFT JUSTIFIED UNLESS LEFT CHAR IS NULL
	LSH	P1,35
TEXT2:	MOVEI	T5,0		;7 BIT ASCII TEXT OUTPUT SUBROUTINE
	LSHC	T5,7
	PUSHJ	P,TOUT
	JUMPN	P1,TEXT2
	POPJ	P,

TXT341:	MOVEI	P2,5		;FIVE CHARACTERS
	TYPE(")
	MOVE	P1,T5
TXT2:	SOSGE	P2
	JRST	TXT3		;END
	MOVEI	T5,0
	LSHC	T5,7
	PUSHJ	P,ASCOUT
	JRST	TXT2
TXT3:	TYPE(")
	POPJ	P,

SIXBP:	MOVEM	T5,LWT
	MOVNI	P2,6		;SIXBIT PRINTER
	MOVE	P1,LWT
SIXBP1:	MOVEI	T5,0
	ROTC	T5,6
	ADDI	T5,40
	PUSHJ	P,TOUT
	AOJL	P2,SIXBP1
	POPJ	P,

FTOC:	HRRZ	P1,S1		;NUMERIC OUTPUT SUBROUTINE
	CAIN	P1,10		;IS OUPUT RADIX NOT OCTAL
	jrst	[TYPE(")	;SHOW  CURRENT OUTPUT AS OCTAL
		jrst	.+1]
	HRRZ	P1,S1		;IS OUTPUT RADIX DECIMAL?
	CAIN	P1,12
	JRST	TOC4		;YES,TYPE SIGNED WITH PERIOD
TOC0:	LSHC	T5,-43
	LSH	P1,-1		;P1=T5+1
	DIVI	T5,@S1
	PUSH	P,P1		;[300] SAVE REMAINDER
	JUMPE	T5,.+2
	PUSHJ	P,TOC0
	POP	P,T5		;[300] RETRIEVE REMAINDER
	ADDI	T5,"0"
	PJRST	TOUT
TOC4:	JUMPGE	T5,TOC5		;TEST FOR NEGATIVE #
	TYPE(-)
TOC5:	MOVMS	T5,T5		;GET MAGNITUDE
	JRST	TOC0		;DO NORMAL RADIX PRINT
TOUT:	putchr	(T5)		;OUTPUT A CHARACTER
	POPJ	P,

ife tops20,<
LISTEN:	INCHRS	T5		;GET NEXT CHAR, NO IO WAIT
	POPJ	P,		;NO CHARACTER EXISTED, RETURN
	CLRBFI			;CLEAR OUT INPUTBUFFER
	JRST	CPOPJ1>		;CHAR WAS THERE, SKIP RETURN,end of conditional
ifn tops20,<
listen:	push	p,T1		;save T1
	push	p,T2		;save T2
	hrrzi	T1,.priou	;get terminal output designator
	rfmod%			;get terminal JFN word
	tlze	T2,(tt%osp)	;[114]clear ^o
	  sfmod%		;[114]set new terminal JFN word
	hrrzi	T1,.priin	;get terminal input designator
	sibe%			;check for pending input
	caia
	jrst	rpopj		;no pending input
	cfibf%			;clear input buffer
	aos	(p)		;set up for skip return
rpopj:	pop	p,T2		;restore T2
tfpopj:	pop	p,T1		;restore T1
	popj	p,>		;return, end of conditional
ife tops20,<
TTYCLR:	SKPINC			;CLEAR ^O, SKIP ON INPUT CHARS
	  POPJ	P,		;NO INPUT CHARS, OR EXEC MODE
	CLRBFI			;FLUSH ALL
	POPJ	P,>		;WAITING INPUT CHARACTERS, end of conditional
ifn tops20,<
ttyclr:	pushj	p,listen	;let listen do the work
	popj	p,		;no characters were pending
	popj	p,>		;pending chars flushed, end of conditional


OUT6:	MOVE	T5,T2		;PRINT (T2) AS A SIXBIT WORD
	PJRST	SIXBP		;PRINT IT


;	ROUTINE TO CLEAR OUT REST OF USERS LINE

CLRLIN:	PUSHJ P,SAV2AC		;SAVE T5 THRO. CLRLIN
	MOVE	T2,[PUSHJ P,LOADCH] ;[132] USE THIS ROUTINE TO GET CHARS.
	MOVEM	T2,GETCHR	;[132]

CLRLI2:
ife tops20,<
	SKPINL			;SKIP IF ANY CHARS THERE
	  POPJ	P,>		;LINE CLEAR, end of conditional
ifn tops20,<
	push	p,T1		;save T1
	movei	T1,.priin	;[121] get primary input device
	sibe%			;more to come?
	caia			;yes
	jrst	tfpopj		;no
	pop	p,T1>		;restore T1, end of conditional
	PUSHJ	P,GCHR		;GET THE NEXT CHAR
	SKIPL	TERMK		;NOW DONE?
	POPJ	P,		;YES
	CAIN	T2," "		;SPACE OR TAB?
	JRST	CLRLI2		;IGNORE IT
	SKIPE	DELCHR		;DELIMITER SAVED FROM ASCII ACCEPT?
	CAME	T2,DELCHR	;OR DELIMITER FOUND?
	JRST	CLRLI1		;NO, PROCEED AS USUAL
	SETZM	DELCHR		;CLEAR SAVED DELIMITER
	JRST	CLRLI2		;AND TRY AGAIN
CLRLI1:	SETZM	DELCHR		;MAKE SURE IT'S ZERO
	LINE
	TYPE	(<%FDTCHI Characters ignored: ">) ;WARN THE USER
	PUSHJ	P,OUTL1		;TYPE THE REST OF THE LINE
	TYPE	(")
	LINE
	POPJ	P,		;YES - LINE CLEARED

;	ROUTINE TO CLEAR OUT USER LINE AND DISPLAY REMAINING TEXT

ENDLIN:	SKIPL	TERMK		;END OF USER LINE?
	POPJ	P,		;YES
	putchr	(LSTCHR)	;DISPLAY USERS LAST CHAR IN ERROR
	PJRST	OUTLIN		;AND TYPE THE REST OF THE LINE

;PRINT ALL CHARACTERS REMAINING IN THE INPUT BUFFER

OUTLIN:	PUSHJ	P,GCHR		;GET THE NEXT CHAR
	SKIPL	TERMK		;DONE?
	POPJ	P,		;YES
OUTL1:	putchr	(T2)		;TYPE IT
	JRST	OUTLIN		;NEXT

GCHR:	XCT	GETCHR		;GET CHARACTER
	PUSHJ	P,GETSK2	;SET UP DELIMETER FLAGS
	JUMPN	T2,CPOPJ
	MOVEI	T2," "		;RECONVERT NULLS TO SPACES
	POPJ	P,

;[177]	HERE WHEN AN OTS CALL TAKES THE ERR= BRANCH FROM A DECODE CALL
;[177]	VIA BADSYN. THIS ROUTINE PRINTS OUT THE BAD NUMBER THE USER TRIED
;[177]	TO PASS TO FOROTS.

ERRLIN:	ATYPE	(NUMBUF)	;[177] TYPE THE BAD ARGUMENT IN NUMBER BUFFER
	SETZB	T3,TERMK	;[177] CLEAR DELIMETERS
	POPJ	P,		;[177] RETURN TO GCHR

TYP0:	MOVEI	S1,^D10		;PREPARE FOR DECIMAL PRINT
	PJRST	FTOC		;DO IT

TYP1:	TYPE(?FDTIAT Illegal argument type = )
	MOVEI	S1,10		;PRINT DEFAULTING ARG TYPE AS OCTAL
	HRRZ	T5,T3		;TOC PRINTS T5
	PJRST	FTOC		;DISPLAY ARGUMENT TYPE

TYP4:	MOVEI	S1,10		;PRINT OCTAL
	PJRST	FTOC		;PRINT

TYP5:	PJRST	TXT341		;SHOW AS ASCII

TYPCS:	SETZM	CLMRNG		;[162]Reset for TYPN
	DMOVE	T2,@(T4)	;[162]Get ptr & count
	JRST	DSPST1		;[164]Go display it
;	F10 ARGUMENT PROCESSING

GETARG:	SKIPN	T4,SAVACS+16	;[203] ANY USER ARGBLOCK?
	 JRST	CPOPJ		;[203] NOTHING
	HLL	T4,-1(T4)	;L.H. =-# OF ARGS ,,R.H. = ADDRESS
	JUMPGE	T4,CPOPJ	;APPEARS TO BE NO ARGS

	CAMGE	T4,[777700,,0]	;ARBITRARY LIMIT OF 64 ARGS
	POPJ	P,		;PREVENT RUN AWAY
	LINE
	TYPE(Arguments are:)
F10.2:	MOVEM	T4,SAVT3	;SAVE T4 DURING OUTPUT
	LINE
	LDB	T3,[POINT 4,(T4),12] ;GET ARGUMENT TYPE
	TYPE(	= )
	PUSHJ	P,FOROTS	;GET FOROTS TO TYPE ARGS
	MOVE	T4,SAVT3	;RE-INSTATE T4
	AOBJN	T4,F10.2	;MOVE TO NEXT ARG
	LINE
	POPJ	P,

	DEFINE T(A),<		;;[300]
	IFIW	A		;;[300]
>				;;[300]

	DEFINE TYPES,<
	T F10.6			;0 = UNDEFINED
	T F10.6			;1 = LOGICAL
	T F10.6			;2 = SINGLE  PRECISION INTEGER
	T TYP1			;3 = ILLIGAL
	T F10.6			;4 = SINGLE PRECISION REAL
	T TYP1			;5 = ILLEGAL
	T TYP4			;6 = OCTAL
	T F10.3			;7 = LABEL
	T F10.6			;10= DOUBLE PRECISION REAL (D-Floating)
	T F10.4			;11= DOUBLE PRECISION INTEGER
	T F10.5			;12= DOUBLE OCTAL
	T F10.6			;13= [137] DOUBLE PRECISION REAL (G-Floating)
	T F10.6			;14= COMPLEX
;	TYP1			;15= ILLEGAL
	T TYPCS			;15= [162]Character string
	T TYP1			;16= ILLEGAL
	T TYP5			;17= ASCII STRING
>				;[300]
TYP10:	XLIST			;[300]
	TYPES			;[300]
	LIST			;[300]

;	ROUTINE TO 'TYPE' AN ARGUMENT OF A SUBROUTINE CALLING LIST
;	ENTER WITH T5= VALUE OF 1ST. ARG
;	T3= ARG TYPE
;	T4=POINTER IN SUBROUTINE ARGBLOCK

FOROTS:	XMOVEI	T5,@(T4)	;[300] GET SECOND ARGUMENT ADDRESS
	MOVE	T5,1(T5)	;GET SECOND ARGUMENT
	MOVEM	T5,ARGVAL+1	;STORE SECOND ARG
	MOVE	T5,@(T4)	;GET FIRST ARGUMENT

;	ENTRY TO 'TYPE' A SINGLE VALUE IN T5 - ARG TYPE IN T3

FOROUT:	PUSHJ	P,CHKIWI	;[211] RECURSIVE IO IF WE CALL THE OTS?
	 JRST	ERRIWI		;[211] YES, TELL AND RETURN TO COMMAND LOOP.
	MOVEM	T5,ARGVAL	;SAVE FIRST ARGUMENT FOR TYPING
DPBTYP:	DPB	T3,[POINT 4,M2.,12] ;PLACE ARG TYPE
	JRST	@TYP10(T3)	;DISPATCH ACORDING TO ARGUMENT TYPE

F10.6:	XMOVEI	16,M1.		;[300] GET ADDRESS OF FORMAT BLOCK
	PUSHJ	P,OUT.##	;[143]
F10.8:	XMOVEI	16,M2.		;[300] GET THE IOLIST ARGBLOCK
	PUSHJ	P,IOLST.##	;[143] - AND LET FOROTS DO ITS THING
	PJRST	FORBUF		;MUST CLEAR TTY BUFF SO FOROTS
				; EDIT 661 DOESN'T OVERWRITE LINE
F10.3:	TYPE(	LABEL)
	POPJ	P,

F10.4:	PUSHJ	P,TYP0		;TYPE FIRST INTEGER ARG
	TAB
	MOVE	T5,ARGVAL+1	;GET SECOND ARG
	PJRST	TYP0		;TYPE SECOND ARG AS INTEGER AND EXIT

F10.5:	PUSHJ	P,TYP4		;TYPE FIRST ARG AS OCTAL
	TAB
	MOVE	T5,ARGVAL+1	;GET SECOND OCTAL ARG
	PJRST	TYP4		;TYPE NEXT OCTAL ARG AND EXIT
;	ENTRY TO READ UP TO TWO WORD ENTRIES - ARG TYPE IN T3

FORINP:	DPB	T3,[POINT 4,M2.,12] ;[300] PLACE ARG TYPE
	MOVEI	T4,1		;[127] SET UP COUNTER
	MOVE	T5,[POINT 7,NUMBUF] ;[127] AND POINTER TO NUMBER BUFFER
	SETOM	TERMK		;[127] SET UP TERMINTATOR FLAG
	MOVE	T3,LSTCHR	;[177] GET LAST CHARACTER READ
FORGET:	PUSHJ	P,GETSKB	;[177][127] GET A NON-BLANK CHARACTER
	CAIE	T2,"="		;[177] JUST READ AN EQUAL SIGN?
	 JRST	FORGOT		;[177] NO, CONTINUE PARSING
	CAIN	T2,(T3)		;[177] YES. WAS LAST CHAR AN EQ-SIGN?
	 JRST	BADSYN		;[177] YES, LET THIS FAIL RIGHT NOW
	MOVEM	T2,T3		;[177] NO, BUT IT IS NOW
	JRST	FORGET		;[177] GET NEXT NON-BLANK CHARACTER

FORGOT:	SKIPGE	TERMK		;[177][127] EOL?
	JRST	GOTCH		;[127] NO.
	JRST	BADSYN		;[200] YES, NO VALUE TYPED BY USER

GOTCH:	IDPB	T2,T5		;[127] STORE IT
	PUSHJ	P,LOADCH	;[127] GET NEXT CHAR.
	SETOM	TERMK		;[127]
	PUSHJ	P,GETSK2	;[127] CHECK IT OUT
	JUMPE	T2,FORIN2	;[127] VALID STUFF?
	CAIGE	T4,NMBFSZ*5-1	;[177] YES, SEE IF THERE'S ROOM LEFT IN BUFFER
	AOJA	T4,GOTCH	;[127] THERE'S ROOM, DUMP IT
	TYPE (<%FDTECI Buffer full excess characters ignored>)	;[127]
	LINE			;[127] ERROR, NOT ENOUGH ROOM
FORIN2:	SETZ	T2,		;[177] ENSURE NULL BYTE IN NUMBUF
	IDPB	T2,T5		;[177] SO ERR= CAN PRINT OUT ITS CONTENTS
	MOVE	T2,[PUSHJ P,ERRLIN] ;[177] USE THIS ROUTINE TO GET CHARS
	MOVEM	T2,GETCHR	;[177] IN CASE OF ERR= RETURN
	SETOM	TERMK		;[177] 
	MOVEM	T4,M4.		;[127] SET UP CHARACTER COUNT
	XMOVEI	16,M4.		;[300] USE FORMAT(G,G) FOR READING
	PUSHJ	P,DEC.##	;[143]
	PJRST	F10.8		;[111] ACTION


FORBUF:	XMOVEI	16,M3.		;ARG BLOCK
	PUSHJ	P,OUT.##	;CALL OUT.
	PJRST	FIN.##		;DO IT AND RETURN

;CHKIWI - Determine whether a pending FORDDT FOROTS call will result in
;	  an "I/O within I/O" error from the OTS.  This may occur if the
;	  user has an IOLST function call, puts a breakpoint in the function,
;	  and then attempts to have FORDDT do something useful, like TYPE,
;	  which will immediately get an IWI error since we are still processing
;	  the original IOLST call.  
;	
;	  This routine calls the FO$UDB FOROP routine which returns the
;	  contents of %UDBAD, which will be non-zero if IOLST processing is
;	  currently in progress.  
;
; Returns +1 if IOLST processing in progress, %UDBAD non-zero.
; Returns +2 if no IOLST in progress, %UDBAD zero.

;[211] Create this routine

CHKIWI:	PUSH	P,T1		;Save flags
	PUSH	P,T0		; and temporary flags
	SETZ	S2,		;Clear return argument
	MOVEI	T0,FO$UDB	;FOROP function code
	XMOVEI	T1,S2		;Return address
	PUSHJ	P,FOROP.##	;Get %UDBAD
	POP	P,T0		;Restore ACS
	POP	P,T1
	JUMPE	S2,CPOPJ1	;+2 return if no IWI condition
	POPJ	P,		;+1 if IWI threatens


;ERRIWI - Routine to print out a error when a  recursive IOLST call
;	  is pending.  Warn the user that the command he has just issued
;	  cannot be honored, and return to the main command loop.
;
;[211] Create this routine

ERRIWI:	LINE
	TYPE	(?FDTIWI IOLST call currently in progress:
  Cannot process ACCEPT or TYPE until current IOLST is completed.)
	PUSHJ	P,TTYCLR	;Clear any input
	JRST RET		;Return

;WRNIWI - Routine called at breakpoint processing (and CALL FORDDT entries)
;	  to warn that an IOLST call is in progress and ACCEPT and TYPE
;	  commands won't work.
; Returns +1 after issuing the warning.
;
;[211] Create this routine

WRNIWI:	TYPE	(%FDTIWI IOLST call in progress at this breakpoint:
  Will not be able to process ACCEPT or TYPE until IOLST is completed.)
	LINE			;Follow with a CRLF
	POPJ	P,		;Return


;ARG BLOCK FOR CALLS TO FOROTS

	-6,,0			;[300] SIX ARGUMENTS FOLLOW
M1.:	401100,,tty		;[300] OUTPUT TO TTY =-1
	404340,,end		;[300] END=
	405340,,err		;[300] ERR= RETURN (possibly should be 0,,RET)
	402340,,FORMAT		;[300] ASCII,,FORMAT
	403100,,fi2		;[300] TWO WORDS OF FORMAT INFO
	400100,,0

	-3,,0			;[300]
M2.:	401100,,ARGVAL		;[300] DATA 0-8/ARGTYP 9-12/ARGADDRESS 13-35

M2.I:	404100,,0		;[300] CALL FIN - MAY BE USED FOR COMPLEX

M2.F:	404100,,0		;[300] CALL FIN

ARGVAL:	BLOCK	2		;STORAGE FOR DOUBLE WORD ARGUMENTS
FORMAT:	ASCII /('+'G$,G$)/	;[144] SUPPRESS CR AFTER OUTPUT

	-5,,0
M3.:	401100,,tty		;[300] TTY =-1
	404100,,end		;[300] END=
	405100,,err		;[300] ERR= RETURN (possibly should be 0,,RET)
	402340,,FORM2		;[300]
	403100,,fi2		;[300]

FORM2:	ASCII	.(1H+$).

	-6,,0			;[127][111] 6 ARGS
M4.:	Z			;[127][111] NO. OF CHARS TO BE DECODED
	404100,,end		;[300] END=
	405100,,err		;[300] ERR= RETURN (possibly should be 0,,RET)
	402340,,FMREAD		;[300] FORMAT(G,G) FOR READ
	403000,,1		;[300] 1 WORD OF FORMAT
	412100,,NUMBUF		;[300] BUFFER LOCATION

FMREAD:	ASCII/(G,G)/		;[127][111] FORMAT FOR READING

tty:	-1		;[300] device
end:	0		;[300] end=
err:	JRST	BADSYN	;[312] err=
fi1:	1		;[300] 1 format word
fi2:	2		;[300] 2 format words
SUBTTL	GENERAL SUBROUTINES



;CHKADR CHECKS THE LOCATION IN THE RH(T5) FOR VALIDITY AS A USER
;ADDRESS.  RETURNS ARE:
;
;	PUSHJ	P,CHKADR	;WITH LOCATION IN T5
;	 <ILLEGAL ADDRESS>
;[300]	  <HISEG ADDRESS> or <EXTENDED ADDRESS>
;	   <LOSEG ADDRESS>

CHKADR:
IFN TOPS20,<
	SKIPE	EXTEND		;[300] ARE WE EXTENDED?
	  JRST	CPOPJ1		;[300] YES, JUST ASSUME ITS A HIGH-SEG ADDRESS
>
	PUSH	P,T5		;SAVE T5 FOLKS !
	MOVEI	S2,(T5)
	CAIGE	S2,.JBDA	;ABOVE .JBDA
	JRST	TPOPJ		;FAIL - ILLEGAL
	CAMG	S2,.JBREL	;BELOW HERE IS OK TOO
	JRST	TPOPJ2
	MOVE	T5,T2		;SAVE (T2)
	PUSHJ	P,GSTAH		;GET THE START ADDR OF THE HISEG
	EXCH	T5,T2
	CAIGE	S2,10(T5)	;
	JRST	TPOPJ
	HRRZ	T5,.JBHRL	;GET TOP OF HISEG
	CAILE	S2,(T5)		;
	JRST	TPOPJ
	JRST	TPOPJ1		;DONE

TPOPJ:	POP	P,T5		;RESTORE T5
	POPJ	P,		;AND RETURN

TPOPJ1:	POP	P,T5		;RESTORE T5
	JRST	CPOPJ1		;AND GIVE SKIP RETURN

TPOPJ2:	POP	P,T5		;RESTORE T5
	JRST	CPOPJ2		;AND GIVE DOUBLE SKIP RETURN

CKWRIT:	PUSHJ	P,CHKADR	;[163]Check address
	 JRST	[TYPE (<%Trying to write to illegal address; wrong mode???>)
		JRST	RET	];[163]Give user another chance
	 TRNA			;[300] SKIP AND CHECK IF EXTENDED
	POPJ	P,		;[163]Let user go ahead
CKWREX:
IFN TOPS20,<
	SKIPN	EXTEND		;[300] WAS THIS AN EXTENDED ADDRESS?
	 JRST	[
>
		TYPE (<%Trying to write in high segment; wrong mode???>)
		JRST	RET
IFN TOPS20,<
		]		;[300] NO, GIVE USER ANOTHER CHANCE
	PUSH	P,T1		;[300] SAVE REGS FOR JSYS
	PUSH	P,T2
	MOVE	T2,T5		;[300] GET ADDRESS INTO REG
	LSH	T2,-11		;[300] FORM PAGE NUMBER FROM ADDRESS
	HRRZI	T1,(T2)		;[300] PUT INTO T1
	HRLI	T1,.FHSLF	;[300] GET PROCESS HANDLE INTO LEFT HALF
	RPACS%			;[300] GET ACCESS BITS INTO T2
	TLNE	T2,(PA%PEX)	;[312] IF NO PAGE EXISTS, A WRITE CREATES IT
	TLNE	T2,(PA%WT!PA%CPY) ;[300] CAN WE WRITE TO THIS PAGE?
	  JRST	WREXDN		;[300] YES, ALL OK
	AND	T2,[PA%WT!PA%RD!PA%CPY!PA%EX]
				;[300] CLEAR OUT ANY UNNEEDED BITS
	TLO	T2,(PA%CPY)	;[300] GET COPY-ON-WRITE ACCESS FOR PAGE
	SPACS%
WREXDN:	POP	P,T2		;[300] RESTORE T2
	POP	P,T1		;[300] RESTORE FLAGS
	POPJ	P,		;[300] AND RETURN OK
>
CKREAD:	PUSHJ	P,CHKADR	;[163]Check address
	 JRST	[TYPE (<%Trying to read from illegal address; wrong mode???>)
		JRST	RET	];[163]Give user another chance
	  POPJ	P,		;[163]Let user try reading high segment
	POPJ	P,		;[163]Let user go ahead

CKBPTR:	DMOVE	P1,(T5)		;[163]Load presumptive descriptor
	 JUMPLE	P2,BSIZER	;[163]"%Null string length;wrong mode?"

	LDB	T5,[POINT 6,P1,05] ;[163]Bits left in word
	CAILE	T5,44		;[300] IS IT AN OWGBP?
	 JRST	[CAIL	T5,61	;[300] YES, IS IT WITHIN RANGE FOR ASCII?
		 CAILE	T5,66	;[300]
		  JRST	BPTRER	;[300] NO, GIVE ERROR
		 POPJ	P,]	;[300] ALL OK
	TLNE	P1,(1B13)	;[172]Error if indirect bit set
	 JRST	BPTRER		;[172]
	IBP	P1		;[163]Bump pointer
	LDB	T5,[POINT 6,P1,11] ;[163]Get byte size
	CAIE	T5,BYTSIZ	;[163]Does it look like a byte pointer?
	 JRST	BPTRER		;[163]NO
	LDB	T5,[POINT 6,P1,05] ;[163]Bits left in word
	IDIVI	T5,BYTSIZ	;[163]Put remainder in T3
				;[163] this destroys P1
	CAIE	T5+1,BYTEXT	;[163]Bytes properly aligned?
	 JRST	BPTRER		;[163]NO
	POPJ	P,		;[163]No obvious errors, return
	
BPTRER:	TYPE (<%Improper byte pointer; wrong mode?>)
	JRST	RET		;[163]Give user another chance
BSIZER:	TYPE	(<%Null character string; Wrong type???>)
	JRST	RET		;[163]Give user another chance

BYTSIZ==7		;[BL]Byte size
BYTPWD==36/BYTSIZ	;[BL]Bytes per word
;BYTEXT==36-(BYTSIZ*BYTPWD)	;[BL]Unused bits in word
BYTEXT==1
;REINOP - REINSTATE OPENED PROGRAM - THIS ROUTINE IS CALLED AFTER
;A GROUP REQUEST HAS BEEN EXHAUSTED TO RE-OPEN THE PROGRAM THAT WAS
;OPEN AT THE BEGINNING O THE REQUEST.


REINOP:	LDFLG	OLDOPN		;[402] Set long name flag if necessary
	SKIPN	T4,OLDOPN	;GET THE OLD NAME
	POPJ	P,		;NONE - OK
	SETZM	OLDOPN
	CAMN	T4,OPENED	;SAME AS THE CURRENT?
	POPJ	P,
	MOVEM	T4,SYM		;NO - SAVE IT
IMPOPN:	PUSHJ	P,SETNAM	;SET IT AND DONE
	MOVE	T5,OPENED	;WHAT IS THE CURRENTLY OPEN SECTION

	LINE
	stype(.[Implicit OPEN .)
	MOVE	T5,SYM		;GET SYMBOL
	PUSHJ	P,SPT1		;TYPE PROGRAM NAME
	type(])
	LINE
	POPJ	P,
;ROUTINE TO READ WORDS FROM ASCII STRING FROM TTY
;FILTERS OUT TAB & SPACE
;STOPS ON ANY NON-ALPHA NUMERIC, CALLER MUST CHECK FOR LEGAL BREAK
;SET FLAGS FOR LEGAL LINE TERMINATORS
;
;	CALL	PUSHJ	P,TTYIN
;RETURN WITH SIXBIT WORD IN T3 LEFT JUSTIFIED, BREAK IN T2
;
;CFLIU	=	CORE FILE IN USE FLAG
;OFCFL	=	OUTPUT FROM CORE FILE FLAG
;
;N.B.	CLEAR GETCHR FOR FIRST CORE FILE ACCESS
;	ALWAYS CLEAR CFLIU IMMEDIATELY AFTER LINE END

I2CFIL:	HRRZ	T2,CFLPTR	;CURRENT POSITION IN CORE FILE
	SUBI	T2,CFSIZ-1	;[132] REMOVE OFFSET
	SUB	T2,CFLST	;[132] PREVENT CORE FILE OVERFLOW
	JUMPL	T2,I2CFL2	;[132] IF WE'RE NOT IN LAST WORD GO AHEAD
	MOVE	T2,CFLPTR	;[132] GET CORE FILE POINTER
	TLZ	T2,LFLG		;[402] clear flag bits
	LSH	T2,-CNTSFT	;[402] GET OFFSET INTO WORD
	CAILE	T2,10		;[132] JUST ONE BYTE LEFT?
	JRST	I2CFL2		;[132] NO,  GO AHEAD
	MOVEI	T2,12		;[132] MAKE SURE <LF> IS LAST CHAR IN BUFFER
	IDPB	T2,CFLPTR	;[132]
	JRST	ERR12		;[132]
I2CFL2:	PUSHJ	P,LOADCH	;[132] GET USERS CHARACTER
	IDPB	T2,CFLPTR	;STORE IT IN CORE FILE FOR FUTURE ACCESS
	POPJ	P,		;

CFLST:	Z			;HOLDS START ADDRESS OF CORE FILE
CFLPTR:	Z
CFLBUF:	XWD	050000,0	;HOLDS CORE FILE FOR TYPE REQUEST
	BLOCK	CFSIZ-1
GETCHR:	Z			;EXCECUTED TO READ OR WRITE CHARACTERS


TTYIN:	MOVE	T5,[pushj p,loadch]
	TLNN	T0,CFLIU	;DO WE WISH TO USE A CORE FILE?
	JRST	XCTSET		;NO - JUST SET UP FOR NORMAL TTY INPUT
	SKIPE	GETCHR		;YES - FIRST CHAR OF LINE?
	JRST	TTYSET		;   NO - DO NOT TOUCH POINTERS
	MOVE	T5,[POINT 7,CFLBUF]
	MOVEM	T5,CFLPTR	;SET UP GENERAL CORE FILE POINTER
	HRRZM	T5,CFLST	;	HOLDS START OF CURRENT CORE FILE
	TLNN	T0,OFCFL	;OUTPUTTING TO CORE FILE?
	SKIPA	T5,[PUSHJ P,I2CFIL] ;YES
	MOVE	T5,[ILDB T2,CFLPTR]
XCTSET:	MOVEM	T5,GETCHR	;SET UP FOR FUTURE XCT

TTYSET:	SETOM	TERMK		;PREPARE TERMINATOR FLAG
	PUSHJ	P,GETSKB	;SKIP LEADING BLANKS & TABS
EITHR5:	TRZ	T1,LNAME	;[402] NO LONG SYM NAME
	MOVEI	T3,0		;SET WORD TO ZERO FOR RETURN
	MOVE	T4,[XWD 440600,T3] ;SET SIXBIT BYTE POINTER
;LOOP TO ACCUMULATE AFTER LEADING SPACES & TABS

GETWLP:	JUMPE	T2,CPOPJ	;EXIT IF TERMINATOR FOUND
	CAIL	T2,"0"		;LESS THAN 0 ?
	CAILE	T2,"9"		;LESS THAN OR EQUAL TO 9 ?
	JRST	GETWD2		;YES - SEE IF LETTER
	JRST	GETWD3		;NO - NUMBER,STORE

;	HERE IF NOT A NUMBER

GETWD2:	CAIN	T2,"_"		;[402] Underline?
	JRST	GETWD3		;[402] Yes
	CAIN	T2,"$"		;[402] Dollar sign?
	JRST	GETWD3		;[402] Yes
	CAILE	T2,"Z"+40	;ABOVE LOWER CASE RANGE ?
	PJRST	GETSK1		;YES - SET BREAK
	CAIL	T2,"A"+40	;LOWER CASE ?
	TRC	T2,40		;YES - CONVERT TO UPPER CASE
	CAIL	T2,"A"		;LESS THAN A ?
	CAILE	T2,"Z"		;LESS THAN OR EQUAL TO Z ?
	PJRST	GETSK2		;NON-ALPHA OR NUMERIC IS A DELIMITER
				;& RETURN TO CALLER

;	HERE IF A LETTER OR NUMBER - CONVERT TO SIXBIT & STORE

GETWD3:	SUBI	T2,40		;CONVER TO SIXBIT
	TRNE	T1,LNAME	;[402] WE HAVE A LONG SYMBOL NAME
	 JRST	GETWD5		;[402] STORE NEXT CHARACTER IN LONG NAME
	TLNN	T4,770000	;[402] OVERFLOWED T3 YET ?
	 JRST	GETWD4		;[402] YES
	IDPB	T2,T4		;NO STORE NEXT SIXBIT CHR.
	XCT	GETCHR		;GET NEXT CHARACTER
	JRST	GETWLP		;& CHECK IT

GETWD4:	TRO	T1,LNAME	;[402] WE HAVE A LONG SYMBOL NAME
	MOVEM	T3,LSYMBF	;[402] STORE FIRST WORD IN LSYMBF
	MOVE	P1,[XWD LSYMBF+1,LSYMBF+2] ;[402] CLEAR OUT REST OF LSYMBF
	CLEARM	LSYMBF+1	;[402]
	BLT	P1,LSYMBF+5	;[402]
	MOVE	P1,[XWD	440600,LSYMBF+1] ;[402] SET UP BP INTO LSYMBF
GETWD5:	IDPB	T2,P1		;[402] STORE SIXBIT CHR.
	XCT	GETCHR		;[402] GET NEXT CHARACTER
	JRST	GETWLP		;[402] & CHECK IT



;	ROUTINE TO SETUP FOR TRANSFER TO AN EXTERNAL TASK
;	GOLOC WILL CONTAIN THE DISPATCH ADDRESS IF SYMBOL FOUND
;	ENTER WITH RADIX50 SYMBOL IN T5
;	NON-SKIP EXIT IF UNKNOWN SYMBOL
;	SKIP EXIT IF OK

FINDST:	EXCH	T5,SYM		;SAVE FOR EVALUATION BY 'EVAL'
	MOVEM	T5,SYL		;SAVE SYM
	MOVSI	T5,GLOBAL	;ONLY GLOBALS
	MOVEM	T5,SYMASK
	PUSHJ	P,FINDG		;[321] Find the global
	   POPJ	P,		;NO SUCH SYMBOL
	MOVEM	T5,GOLOC	;[321] SAVE ADDRESS FOR DISPATCH IN GOLOC
	MOVE	T5,SYL		;GET THE OLD SYM
	MOVEM	T5,SYM		;RE-INSTATE SYM
	JRST	CPOPJ1		;GOOD RETURN

;	ROUTINE TO TRANSFER CONTROL TO AN EXTERNAL TASK
;	ASSUMES GOLOC HAS BEEN SET UP BY USE OF SKIPIF MACRO

EXTASK:	PUSHJ	P,INSRTB	;PUT IN PAUSE REQUESTS
	JSP	T5,RESTOR	;RESTORE USERS ACS
	JRST	@GOLOC		;OF YOU GO
;	REMOVE BLANKS & TABS

GETSKB:	XCT	GETCHR		;GET NEXT CHARACTER
GETSK1:	CAIE	T2," "		;SPACE ?
	CAIN	T2,11		;TAB ?
	JRST	GETSKB		;YES - GET NEXT CHR

GETSK2:	CAIN	T2,15		;NO - FOUND NON-BLANK
	JRST	GETSKB		;IGNORE CR.
	CAIE	T2,12		;TEST FOR LINE FEED
	CAIN	T2,14		;FORM HAS THE SAME ACTION
	JRST	TERMLF		;YES - ACTION
	CAIE	T2,13		;CONTRL K = EOL
	CAIN	T2,7		;BELL - WILL DELIMIT
	JRST	TERMLF		;        NO EXTRA LF
	CAIN	T2,33		;TEST FOR ALTMODE
	JRST	TERNAM		;YES - ACTION
	CAIE	T2,175
	CAIN	T2,176
	JRST	TERNAM
	CAIN	T2,32		;TEST FOR ^Z
	JRST	TERMCZ		;YES - ACTION
	CAIE	T2," "		;TEST - SPACE
	CAIN	T2,11		;ACCEPT TAB
	JRST	TERMSP		;YES - ACTION
	CAIN	T2,"!"		;DELIMITER FOR COMMENT
	JRST	CLRCOM		;YES

	MOVEM	T2,LSTCHR	;SAVE USERS LAST CHARACTER
	POPJ	P,		;NO - RETURN


;	SET END OF LINE CHR FLAGS

TERNAM:	LINE
	AOS	TERMK		;SET TERMINATOR FLAGS
TERMLF:	AOS	TERMK
TERMCZ:	AOS	TERMK
TERMSP:	SETZB	T2,LSTCHR	;ZERO CHR
	POPJ	P,		;RETURN


LSTCHR:	Z			;USERS LAST CHARACTER

;	ROUTINE TO SKIP OVER THE COMMENT
;	COMMENT FORMAT IS:	! COMMENT... TO END-OF-LINE
;			OR:	! COMMENT !

CLRCOM:	TRCE	T1,COMDEL	;FIRST !
	JRST	GETSKB		;NO - END COMMENT - GET NEXT CH
CLRCO1:	SETOM	TERMK		;PREPARE TEST FOR END OF COMMENT
	PUSHJ	P,GETSKB	;GET NEXT CH
	TRNN	T1,COMDEL	;DID WE FIND SECOND !
	POPJ	P,		;YES - WE GOT NEXT COMMAND CH
	JUMPN	T2,CLRCO1	;IF VALID CHAR IGNORE (PART OF COMMENT)
	SKIPGE	TERMK		;EOL FOUND
	JRST	CLRCO1		;NO CONTINUE
	TRZ	T1,COMDEL	;NOT IN COMMENT PROCESS ANYMORE
	POPJ	P,		;RETURN TO CALLER

ife tops20,<
loadch:	inchwl	T2
	popj	p,>
ifn tops20,<
loadch:	push	p,T1		;save T1
	pbin%			;read byte from terminal
	move	T2,T1		;put it where it belongs
	pop	p,T1		;restore T1
	popj	p,>		;return, end of conditional
ife tops20,<
readcm:	closeb
	closeb
	type( )
	pjrst ttyin>
ifn tops20,<
RDPROG:	MOVE	T5,[PERCSB,,TEMCSB] ;[133] BLT IN COMMAND STATE BLOCK
	BLT	T5,TEMCSB+.CMGJB	;[133]
	HRRZI	T5,RDPRG3	;[133] HACK A COUPLE WORDS IN THE BLOCK
	HRRZM	T5,TEMCSB	;[133]
	MOVE	T5,[POINT 7,[ASCIZ /Program name: /]] ;[133]
	MOVEM	T5,TEMCSB+2	;[133]
RDPRG2:	HRRZI	T1,TEMCSB	;[133] INITIALIZE LINE, PROMPT
	HRRZI	T2,FUNINI	;[133]
	COMND%			;[133]
RDPRG3:	HRRZI	T1,TEMCSB	;[133] READ IN PROGRAM NAME
	HRRZI	T2,FUNPRG	;[133]
	COMND%			;[133]
	  ERJMP	CMDER2		;[133] ERROR, GO SAY WHY
	TLNN	T1,(CM%EOC)	;[133]
	JRST	RDPRG3		;[133]
	HRROI	T1,PARBUF	;[133] DO RESCAN SO TTYIN CAN NOW
	RSCAN%			;[133]   READ BUFFER
	  HALTF%		;[133]
	SETZ	T1,		;[133]
	RSCAN%			;[133]
	  HALTF%			;[133]
	JRST	TTYIN		;[133]
CMDER2:	HRROI	T1,[ASCIZ /?FDTJSE /] ;[133] ERROR READING PROGRAM NAME
	PSOUT%			;[133]
	MOVEI	T1,.PRIOU	;[133]
	HRLOI	T2,.FHSLF	;[133]
	SETZ	3,		;[133]
	ERSTR%			;[133]
	  JFCL			;[133]
	  JFCL			;[133]
	JRST	RDPRG2		;[133]

readcm:	push	p,T1
	push	p,T2
kparse:	move	T5,[percsb,,temcsb]
	blt	T5,temcsb+.cmgjb
repars:	hrrzi	T1,temcsb
	hrrzi	T2,funini
	comnd%
lparse:	hrrzi	T1,temcsb
	hrrzi	T2,funkey
	comnd%
	  erjmp	cmderr		;[114] error, go say why
	tlne	T1,(cm%nop)
	  jrst	cmderr		;[114] error, go say why
	tlne	T1,(cm%eoc)
	jrst	cgo
	hrrzi	T1,lparse
	hrrzm	T1,temcsb
cloop:	hrrzi	T1,temcsb
	hrrzi	T2,fungar
	comnd%
	  erjmp	cmderr		;[114] error, go say why
	tlnn	T1,(cm%eoc)
	jrst cloop

				;[140]This routine removes the trailing
				;[140] space from a command line with no args
				;[140]TXTIN IS A POINTER TO PARBUF
				;[140]TXTOUT IS A POINTER TO NEWBUF
cgo:	PUSH	P,P1		;[140]USE P1 AS SCRATCH AC
	PUSH 	P,P2		;[140]USE P2 AS SCRATCH AC
	MOVE	P1,[POINT 7,PARBUF] ;[140]INITIALIZE BYTE POINTER TO PARBUF
	MOVEM	P1,TXTIN
	MOVE	P1,[POINT 7,NEWBUF] ;[140]INITIALIZE BYTE POINTER TO NEWBUF
	MOVEM	P1,TXTOUT
LOOKSP:	ILDB	P1,TXTIN	;[140]GET A CHAR FROM COMMAND LINE
	CAIN	P1,12		;[140]TEST FOR LINE FEED
	JRST	DORSCN		;[140]DO THE RSCAN WITH EXISTING BUFFER(PARBUF)
	CAIN	P1,14		;[140]TEST FOR FORM FEED
	JRST	DORSCN		;[140]DO THE RSCAN WITH EXISTING BUFFER(PARBUF)
	CAIN	P1," "		;[140]TEST FOR A SPACE
	JRST	SPFND		;[140]SPACE FOUND
	IDPB	P1,TXTOUT	;[140]NOT A SPACE, WRITE CHAR TO NEW BUFFER
	JRST	LOOKSP		;[140]CONTINUE TRANSFER OF CHARS
SPFND:	ILDB	P1,TXTIN	;[140]GET A CHARACTER
	CAIN	P1," "		;[140]TEST FOR A SPACE
	JRST	SPFND		;[140]SPACE FOUND, IGNORE
	CAIN	P1,11		;[140]TEST FOR A TAB
	JRST	SPFND		;[140]TAB FOUND, IGNORE
	CAIN	P1,15		;[140]TEST FOR CARRIAGE RETURN
	JRST	CLRSC3		;[140]FOUND, WRITE IT AND LF
	CAIN	P1,12		;[140]TEST FOR LINE FEED
	JRST	CLRSCN		;[140]FOUND, SET UP CALL TO RSCAN WITH NEWBUF
	CAIN	P1,14		;[140]TEST FOR FORM FEED
	JRST	CLRSCN		;[140]FOUND, SET UP CALL TO RSCAN WITH NEWBUF
	CAIN	P1,"!"		;[140]TEST FOR COMMENT DELIMITER
	JRST	FLUSHC		;[140]COMMENT FOUND-SKIP OVER IT

				;[140]IF WE'RE HERE, MUST HAVE A COMMAND ARG
				;[140]TRANSFER REMAINING PART OF LINE VERBATIM
	MOVEI	P2," "		;[140]BUT FIRST, WRITE A SPACE
	IDPB	P2,TXTOUT	;[140] TO SEPARATE COMMAND FROM ARG
TRANSF:	IDPB	P1,TXTOUT	;[140]NOW WRITE FIRST CHAR OF ARG OUT
	ILDB	P1,TXTIN	;[140]GET NEXT CHAR OF COMMAND LINE
	CAIN	P1,12		;[140]TEST FOR LINE FEED
	JRST	LFORFF		;[140]FOUND, STORE LF OR FF IN NEW BUFFER
	CAIE	P1,14		;[140]TEST FOR FORM FEED
	JRST	TRANSF		;[140]NOT FOUND, WRITE CHAR OUT
				;[140]CONTINUE TRANSFER UNTIL A LF/FF IS FOUND
LFORFF:	IDPB	P1,TXTOUT	;[140]STORE LF OR FF IN NEW BUFFER
	JRST	CLRSC2		;[140]SET UP CALL TO RSCAN WITH NEW BUFFER
FLUSHC:	ILDB	P1,TXTIN	;[140]GET FIRST CHAR OF COMMENT
	CAIN	P1,12		;[140]TEST FOR LINE FEED
	JRST	CLRSCN		;[140]FOUND,SET UP CALL TO RSCAN WITH NEWBUF
	CAIN	P1,14		;[140]TEST FOR FORM FEED
	JRST	CLRSCN		;[140]FOUND,SET UP CALL TO RSCAN WITH NEWBUF
	CAIN	P1,"!"		;[140]TEST FOR END OF COMMENT
	JRST	SPFND		;[140]FOUND, GET NEXT CHARACTER
	JRST	FLUSHC		;[140]CONTINUE SKIPPING OVER COMMENT
CLRSC3:	IDPB	P1,TXTOUT	;[140]WRITE OUT CR
	MOVEI	P1,12		;[140]GET SET TO WRITE OUT LF TO NEWBUF
CLRSCN:	IDPB	P1,TXTOUT	;[140]WRITE OUT LINE FEED TO NEWBUF(NEW BUFFER)
CLRSC2:	MOVEI	P1,0		;[140]WRITE OUT NULL BYTE TO NEW BUFFER
	IDPB	P1,TXTOUT
	MOVE	P1,[XWD NEWBUF,PARBUF]	;[140]TRANSFER (NEWBUF) TO (PARBUF)
	BLT	P1,PARBUF+^D19	;[140] FOR FORDDT'S PARSING MECHANISM
DORSCN:	HRROI	1,PARBUF	;[140]SET UP PTR TO DO RSCAN
	POP	P,P2		;[140]RESTORE P2
	POP	P,P1		;[140]RESTORE P1
	rscan%
	haltf%
	setz	T1,
	rscan%
	haltf%
	pop	p,T2
	pop	p,T1
	pjrst	ttyin

cmderr:	hrroi	1,[asciz /?FDTJSE /] ;[126] start with prefix message
	psout%			;[126] type it
	movei	1,.priou	;[114] send message to terminal
	hrloi	2,.fhslf	;[114] this fork,,last error
	setz	3,		;[114] no char limit
	erstr%			;[114] type error message
	  jfcl
	  jfcl
	jrst	repars		;[114] continue parsing
>
;	SUBROUTINE TO READ EITHER A SYMBOL OR A CONSTANT FROM USER
;	PUSHJ P,EITHER
;	RETURN WITH CONSTANT IN T5
;	RETURN SYMBOL VALUE IN T5
;	IN ALL CASES T2=USERS LAST CHARACTER
;
;	ADDITIONALY ENTER AT SIXIN TO ACCEPT LEFT JUSTIFIED SIXBIT
;	IF USERS LEADING CHARACTER IS ALPHA

SIXIN:	TRO	T1,ALPHA	;THIS MODIFIES EITHER
EITHER:	SETOM	TERMK
	CLEARM	SYL
	CLEARM	DEN
	TDZ	T0,[XWD FPF!FEF!MF!SIGN!OCTF,POWF] ;REMOVE THE UNWANTED FLAGS
EITHR2:	XCT	GETCHR		;READ USER INPUT
	CAIE	T2," "		;TILL NO BLANKS
	CAIN	T2,11		;OR TABS
	JRST	EITHR2

	PUSHJ	P,GETSK2	;TEST FOR DELIMITER
	JUMPE	T2,BADSYN
	CAIL	T2,"A"+40	;ACCEPT LOWER CASE
	CAILE	T2,"Z"+40	;CHARACTERS
	JRST	.+2		;IS NOT
	TRC	T2,40		;IS - CONVERT TO UPPER CASE
	CAIL	T2,"A"
	CAILE	T2,"Z"

                        ;**** NUMERIC INPUT ****
	JRST	[TRZ	T1,ALPHA ;NO LONGER NEEDED
		 XCT	GETNUM	;CLEAR FLAGS
		 PUSHJ P,EITHR3	;MUST BE A CONSTANT
		 JRST	EITHR4]	;NON SKIP RETURN
	TRZE	T1,ALPHA	;ARE WE TRAPPING ALPHA
	JRST	SIXIN2		;YES

		;**** SYMBOLIC INPUT ****
		;SIMULATE A CALL OF SYMIN

	RECURS <DIMTOT,T0,PUTTER,RP,SAVLOC,SYM,MATHSM,TEM,TEM1,DIMCNT,S4,FRMSAV>
	TRZ	T0,DOUBLE	;ONLY THE BASE ARRAY IS ALLOWED TO BE REAL*8
	PUSHJ	P,EITHR5	;SYMBOL
	PUSHJ	P,SYM2		;ALLOW FOR OFFSET
	   JRST	ERR6		;NOT DEFINED
	   JRST	BADSYN

	SRUCER			;POP BACK ALL SAVED LOCATIONS

	JRST	CPOPJ1		;SYMBOL VALUE SKIP RETURN

SIXIN2:	PUSHJ	P,EITHR5	;CONTINUE AS TTYIN
	JRST	CPOPJ1		;DO A SYMBOL RETURN
;ROUTINE TO CONVERT FROM RADIX 50 TO SIXBIT 	;[402] New
; Inputs addr of Radix50 in T5

R50SIX:	PUSH	P,T2
	PUSH	P,P1

	CAIE	T5,OPENED
	JRST	R50SX1
	MOVE	T2,[POINT 6,TMPOPN];SET UP BYTE POINTER FOR SIXBIT	
	XMOVEI	P1,TMPOPN
	SETZM	TMPOPN		;Clear for sixbit
	JRST	R50SX2

R50SX1:	MOVE	T2,[POINT 6,TMPNAM];SET UP BYTE POINTER FOR SIXBIT
	XMOVEI	P1,TMPNAM
	SETZM	TMPNAM		;Clear for sixbit

R50SX2:	PUSH	P,P1		;Save addr where sixbit will be put stored

	MOVE	T5,(T5)		;Get radix50 in T5

	TLZ	T5,PNAME	;Clear flags

	PUSHJ	P,R50S1		;Convert leaving sixbit in T3
	POP	P,T5		;Store address of sixbit name in T5
	TLO	T5,10000	;Set count to 1 word
	POP	P,P1
	POP	P,T2
	POPJ	P,

R50S1:	PUSH	P,T5		
R50S6:	POP	P,T5		;RESTORE T5 = SYMBOL
	XMOVEI	P1,R50S4		;SPECIAL TREATMENT FOR LAST CHARACTER
	PUSH	P,P1		;SAVE ON STACK
R50S3:	TLZ	T5,PNAME	;RADIX 50 PART ONLY
	IDIVI	T5,50
	PUSH	P,P1	
	JUMPE	T5,[SETOM P1
		   JRST	.+2]
	PUSHJ	P,R50S3
	POP	P,T5		;[300]

	;T5 IS A RAD50 CHARACTER - CONVERT TO SIXBIT

	CAMGE	T5,[SQUOZE 0,A]	;less than rad50 'A'
	JRST	[ADDI	T5,17	;We have a digit
		JRST	SIXB]	;
	CAMG	T5,[SQUOZE 0,Z]	;greater than rad50 'Z'
	JRST	[ADDI	T5,26	;We have a letter
		JRST	SIXB]	;
	;Check for "."
	CAIN	T5,[SQUOZE 0,.]	
	JRST	[MOVEI	T5,"."-" ";We have a dot
		JRST	SIXB]	;
	;We now have either "$" or "%" ("%" should be changed to "_")
	SUBI	T5,42		; Convert "$" and "%" to sixbit
	CAIN	T5,"%"-" "	;
	MOVEI	T5,"_"-" "	;We have an underline

SIXB:	JUMPL	P1,R50S7	;FIRST TIME ROUND IS SPECIAL
	EXCH	T5,SAVCHR	;SAVE AS LAST CHARACTER
	PJRST	SSIXB		;DISPLAY CHARACTER

R50S4:	MOVE	T5,SAVCHR	;GET BACK THE LAST CHARACTER
;	JUMPN	P1,CPOPJ	;DO WE TYPE THE LAST CHARACTER
	PJRST	SSIXB		;YES

R50S7:	CAIL	T5,"0"
	CAILE	T5,"9"
	TDZA	P1,P1		;ZERO IF FIRST CHAR NOT NUMERIC
	HRRZI	P1,-1		;.GT. ZERO IF FIRST CHAR IS NUMERIC
	MOVEM	T5,SAVCHR	;SAVE LAST CHARACTER
	POPJ	P,

SSIXB:	IDPB	T5,T2		;Store sixbit character 
	POPJ	P,		
	
;ROUTINE TO CONVERT FROM SIXBIT TO RADIX 50

;	CALL PUSHJ	P,SIX250	WITH 6BT IN T3
;	RETURNS		HERE		WITH RAD 50 IN T4
;	N.B.		USES: T2/T3/T4/T5/P1

SIX250:	MOVE	T2,[POINT	6,T3]	;SET UP BYTE POINTER FOR 6BT
	SETZI	T4,		;CLEAR FOR RAD 50
	MOVEI	P1,50		;SET UP TO FORM RADIX 50
SIXMOR:	ILDB	T5,T2		;GET NEXT 6BT BYTE
	JUMPE	T5,CPOPJ	;EXIT IF ZERO=LAST BYTE

	CAIL	T5,20		;ACCEPT NUMERALS
	CAILE	T5,31		;
	JRST	NOTNUM		;[402] NOT NUMERIC MAY BE ALPHA
	SUBI	T5,17		;CONVERT TO RAD 50
	JRST	R50CHR		;STORE

NOTNUM:	CAIGE	T5,41		;[402] IS IT ALPHA
	JRST	.+3		;[402] No to small
	CAIG	T5,72		;[402] 
	JRST	LETR		;[402] Yes it is a letter
	CAIN	T5,77		;[402] Is it "_"
	JRST	[MOVEI	T5,47	;[402] translate "_" to rad50 "%"
		JRST	R50CHR]	;[402]
	CAIE	T5,4		;[402] Is it "$"
	JRST	BADSYN		;CANT CONVERT
	MOVE	T5,[SQUOZE 0,$]	;[402] We have "$" - make it rad50
	JRST	R50CHR		;[402]
LETR:	SUBI	T5,41-13	;MAKE RAD 50
R50CHR:	IMULI	T4,(P1)		;MOVE UP LAST ENTRY
	ADDI	T4,(T5)		;UP DATE WITH NEW CHARACTER
	TLNE	T2,770000	;DONE 6 BYTES?
	JRST	SIXMOR		; NO
	POPJ	P,		; YES


;	ROUTINE TO CHECK THAT WE HAVE A LEGAL FORTRAN VARIABLE
;	AND CONVERTS FROM 6 BIT LEFT JUSTIFIED IN T3 TO RAD 50 IN T4


VALID:	MOVE	T2,[POINT 6,T3]	;GET FIRST CHARACTER
	ILDB	T4,T2		; IN T4
	CAIL	T4,41		;
	CAILE	T4,72		;ALPHA ONLY
	JRST	ERR5		; NOT F40
	PUSH	P,T2		;[402] save T2

	TRNE	T1,LNAME	;[402] Did we get a long name?
	 JRST	VALID1		;[402] Yes 

	SKIPN	SSTAB		;[402] Do we have a secondary symbol table?
	 JRST	VAL0		;[402] No - no long names
	HLRZ	T2,@SSTAB	;[402] Flag in left half of @SSTAB = 0 
				;[402]  if we have an incomplete symbol table
	SKIPE	T2		;[402] Do we have a complete symbol table
	JRST	VAL1		;[402] YES - LONG NAME

	;[402] WE HAVE SHORT SYMBOL

VAL0:	POP	P,T2		;[402] No, convert to rad 50
	JRST	SIX250		;[402]

VAL1:	;[402] CHANGE SHORT SYMBOL INTO LONG SYMBOL
	TRO	T1,LNAME	;[402] WE HAVE A LONG SYMBOL NAME
	MOVEM	T3,LSYMBF	;[402] STORE FIRST WORD IN LSYMBF
	MOVE	P1,[XWD LSYMBF+1,LSYMBF+2] ;[402] CLEAR OUT REST OF LSYMBF
	CLEARM	LSYMBF+1	;[402]
	BLT	P1,LSYMBF+5	;[402]
	MOVE	P1,[POINT 6,LSYMBF+1] ;[402] SET UP BP INTO LSYMBF

	;[402] WE HAVE LONG SYMBOL
VALID1:	MOVEI	T2,1		;[402]
FLLCNT:	SKIPE	LSYMBF(T2)	;[402]Count number of words in T2
	JRST	[AOJ	T2,	;[402]
		JRST	FLLCNT]	;[402]
	LSH	T2,CNTSFT	;[402]
	XMOVEI	T4,LSYMBF	;[402]ptr to name
	IOR	T4,T2		;[402]T4 = length+ptr
	POP	P,T2		;[402] restore t2
	POPJ	P,		;[402]
;	SUBROUTINE TO CHECK THAT ALL 6BIT CHARACTERS IN T3 ARE NUMERIC
;	CALL PUSHJ	P,ALLNUM
;	NOT ALL NUMERIC
;	ALL NUMERIC WITH P APPENDED IF A LABEL OR # IF SOURCE LINE

ALLNUM:	MOVE	T4,[POINT 6,T3]	;GET POINTER TO INPUT
ALLMOR:	ILDB	T2,T4		;GET NEXT 6BIT CHAR
	JUMPE	T2,ALLEX	;ALL DONE
	CAIL	T2,20		;TEST WITHIN RANGE
	CAILE	T2,31		;  OF NUMERALS 6BT
	JRST	ALLIN		;NO - SEE IF WE HAVE A SOURCE LINE

	TLNE	T4,770000	;ALL 6 CHARS NUMERIC??????
	JRST	ALLMOR		;  NO - SO DO MORE
	JRST	BADSYN		;  YES - OO NASTY

ALLIN:	TLZE	T0,LABEL	;ARE WE ALREADY PROCESSING LABEL INFO.
	JRST	BADSYN		;YES - ANOTHER # MUST BE REJECTED
	MOVEI	T2,"#"		;SEE IF THE USER IS TRYING TO GIVE LINE#
	CAME	T2,LSTCHR	;WAS A # HIS LAST CHARACTER
	JRST	CPOPJ		;NO USEFUL CHARACTERS TYPED - MAYBE GROUP#
	JRST	BADSYN		;YES - COMPLAIN ABOUT PRECEDING GARBAGE

ALLEX:	TLZN	T0,LABEL	;ARE WE PROCESSING SOURCE LINES
	JRST	ALLFRM		;NO - SEE IF A FORMAT
	MOVEI	T2,'L'		;YES - GET THE SOURCE LINE TAG
	DPB	T2,T4		;CONVERT TO THE FORM FORTRAN RECOGNISES
	JRST	CPOPJ1		;EXIT AS ALL NUMERIC FROM USER

ALLFRM:	MOVEI	T2,'P'		;SET UP FOR A LABEL
	DPB	T2,T4		;CONVERT TO THE STANDARD FORTRAN FORM
	JRST	CPOPJ1		;DO AN ALL NUMERIC EXIT
;	ROUTINE TO GET NEXT USER SYMBOL AND RETURN
;	THE RADIX 50 SYMBOL NAME IN SYM
;	SYMBOL = NAME[V1/V2,..](V3,..), . .
;	7 DELIMITERS ARE ALLOWED AFTER SYMBOL ] ) / . , - =
;	V1-V2    V1,    V1(V2)    V1(V2/V3)    V1[V2]    V1=    V1.LT.V2
;	  ^	   ^	     ^	       ^	    ^      ^      ^
;	CALL	PUSHJ P,SYMIN
;	RETURN  NOT FOUND
;		STATEMENT NO.
;		VARIABLE		T5=VALUE OF SYMBOL
;					T2=LAST CHARACTER
;				SUBFLG IS SET IF ARRAY NAME ONLY FOUND

SYMIN:	TLZ	T0,LABEL	;CLEAR LABEL PROCESSING FLAG
	SETZM	MATHSM		;CLEAR SYMBOL SAVE
	SETZM	CRYSYM		;[217] AND POSSIBLE CHARACTER ARRAY
	PUSHJ	P,TTYIN		;GET USER SYMBOL
	JUMPN	T3,SYM12	;NO CHARACTERS - MAYBE SOURCE LINE OR GROUP SPEC.
	CAIE	T2,"#"		;IS THE USER ATTEMPTING TO SPECIFY A SOURCE LINE
	JRST	SYM4		;NO! - WELL MAYBE A GROUP REQUEST

	TLO	T0,LABEL	;REMEMBER THIS IS A SOURCE LINE REQUEST
	PUSHJ	P,TTYIN		;GET USERS NEXT INFO.
	JUMPE	T3,BADSYN	;ZERO CHARACTERS HERE IS BAD

SYM12:	PUSHJ	P,ALLNUM	;SEE IF USER TYPED ALL NUMERIC
	  JRST	SYM2		;NO - MUST BE A VARIABLE
	MOVE	T2,LSTCHR	;REINSTATE USERS LAST CHAR
	CAIE	T2,","		;SEE IF A KNOWN DELIMITER FOLLOWS
	JUMPN	T2,BADSYN	;ANY OTHER CHARACTER IS ILLEGAL
	PUSHJ	P,SIX250	;CONVERT SYMBOL TO RADIX 50
	TLOA	T0,LABEL	;SET THE LABEL PROCESSING FLAG

;	MULTIPLY RECURSIVE CALLS ARE MADE TO HERE BY ROUTINE EITHER

SYM2:	PUSHJ	P,VALID		;TEST FOR A TRUE F40 VARIABLE FROM USER
	STSYM	T4,MATHSM	;[402]SAVE FOR LOOK
	MOVEM	T4,SYM		;EVAL NEEDS IT HERE
	TRZE	T1,DCEVAL	; ? CALL EVAL
	POPJ	P,		;NO DON'T
	PUSHJ	P,EVAL		;'EVAL'UATE THE SYMBOL NAME
	  POPJ	P,		;SYMBOL NOT FOUND
	SKIPN	CRYSYM		;[217] ALREADY HAVE A SAVE?
	MOVEM	P1,CRYSYM	;[217][157]No. Save addr/RAD50 name
	MOVEM	T5,SAVLOC	;SAVE THE VALUE OF THE SYMBOL
	TLNE	T0,LABEL	;DID WE HAVE A LABEL?
	JRST	SYM3		;YES - GO PROCESS

	CLEARM	SUBSCR		;ZERO THE OFFSET
	PUSH	P,T1		;[402]Save T1
	PUSHJ	P,RAYNAM	;DO WE KNOW ABOUT THIS ARRAY
	JRST	SYM2A		;NOT DEFINED
	POP	P,T1		;[402]
	TRO	T1,IMPRNG!ARRAY.;FLAG AS A POSSIBLE RANGE CONDITION
	CAIA			;[402]
SYM2A:	POP	P,T1		;[402]
	MOVE	T2,LSTCHR	;GET BACK LAST CHAR SEEN
SYM7:	JUMPE	T2,SYM3		;SEE IF WE HAD A LEGAL DELIMITER
	CAIE	T2,"["		;[ MEANS WE HAVE AN ARRAY DEFINITION TO FOLLOW
	JRST	SYM13		;OBVIOUSLY NOT AN ARRAY DEFINITION
	TLO	T0,LFTSQB	;FLAG A [ SEEN - ] MUST END DEFINITION
	PUSHJ	P,DIMIN		;GET NEW DEFINITION
	PUSHJ	P,GETSKB 	;MOVE ON TO NEXT CHARACTER
	JRST	SYM7		;GO BACK TO PROCESS MORE INPUT
SYM13:	CAIE	T2,"("	;THE ONLY OTHER ALLOWED CHARACTER IS (
	JRST	SYM6		;CHECK FOR OTHER DELIMITERS

	TRZ	T1,IMPRNG	;NO LONGER AN IMPLIED RANGE
	SETZM	DIMTOT		;CLEAR FOR TOTAL ELEMENT COUNT
	SETZM	PUTTER		;  AND VARIOUS WORDS IN CASE
;	SETZM	RANGE		;[157]Reset range stuff
;	SETZM	CLMRNG		;[157]
;	SETZM	RANLIM		;[157]
 	MOVEI	T5,1		;  WE GET AN ARRAY DEFINITION
	MOVEM	T5,RP
	PUSHJ	P,RAYNAM	;HAS THIS SYMBOL AN ARRAY REFERENCE?
	JRST 	SYM11		;[401] CHECK FOR SUBSTRING
	TRO	T0,SUBFLG	;YES - REMEMBER TO CHECK ITS SUBSCRIPTS

SYM10:	PUSHJ	P,EITHER	;GET EITHER SYMBOL OR # FROM USER
	  CAIA			;NUMERIC
	MOVE	T5,(T5)		;SYMBOL - GET VALUE
	TRNE	T0,SUBFLG	;DO WE CHECK SUBSCRIPTS FOR THIS ARRAY
	JRST	SYM8		;  PROCESS SUBSCRIPTS

	JUMPL	T5,.+2		;AUTO CORRECTION ON -VE #
	SUBI	T5,1		;CORRECT FOR A=A(1)

;	NO MORE SUBSCRIPTS - CHECK DELIMITERS

SYM9:	MOVEM	T5,SUBSCR	;SAVE THE NEW OFFSET, WATCH ILL MEM REFS
	CAIE	T2,")"		;RIGHT PARENS MUST DELIMIT THE NO.
	JRST	BADSYN		;   THIS WONT DO EITHER!
	TRZE	T0,SUBFLG	;ARE WE CHECKING SUBSCRIPTS?
	PUSHJ	P,SUBCHK	;YES - CHECK THERE ARE NO MORE TO FOLLOW
	XCT	GETCHR		;GET NEXT CHARACTER
	PUSHJ	P,GETSK2	;GET NEXT CHARACTER
	CAIE	T2,"("		;[401]	
	JRST	SYM6	

	;[401]	Get lower bound of substring

SYM11:	PUSHJ	P,EITHER	;[401]GET EITHER SYMBOL OR # FROM USER
	JRST [JUMPN T5,SYM11A	;[401]DID WE GET A CONSTANT?
	      MOVEI T5,1        ;[401]LOWER BOUND WAS NOT SPECIFIE
	      JRST  SYM11A]     ;[401]DEFAULT VALUE IS 1
	MOVE	T5,(T5)		;[401]SYMBOL - GET VALUE
SYM11A:	MOVEM	T5,SSLOW	;[401]Save for lower bound OFFSET

	MOVE	T2,LSTCHR	;[401] GET BACK LAST CHAR SEEN
	CAIE	T2,":"		;[401] SUBSTRING NEEDS ":" AFTER LOWER BOUND
	JRST	BADSYN		;[401]

	;[401] get upper bound

	PUSHJ	P,EITHER	;[401]GET EITHER SYMBOL OR # FROM USER
	JRST [MOVEM T4,TEM4	;[401] save T4	      
	      MOVE  T4,SAVLOC	;[401] base variable for substring
	      MOVE  T4,1(T4)	;[401] char count
	      JUMPN T5,SYM11B	;[401]DID WE GET A CONSTANT?
	      MOVE  T5,T4       ;[401]UPPER BOUND WAS NOT SPECIFIED
	      JRST  SYM11B]     ;[401]DEFAULT VALUE IS descripter length
	MOVE	T5,(T5)		;[401]SYMBOL - GET VALUE
	MOVEM	T4,TEM4		;[401] save T4
	MOVE 	T4,SAVLOC	;[401] base variable for substring
	MOVE 	T4,1(T4)	;[401] char count
SYM11B:	MOVEM	T5,SSUP		;[401]Save for upper bound OFFSET

	;[401] check for upper bound out of range

	CAMGE	T5,SSLOW	;[401] upper bound >= lower bound
	JRST	BADBND		;[401] upper bound too small
	CAMLE	T5,T4		;[401] check upper bound is not too big
	JRST	BADBND		;[401] upper bound too big

	;[401]	check for lower bound out of range

	SKIPG	SSLOW		;[403] lower bound > 0
	JRST	BADBND		;[403] No, lower bound too small

	MOVE	T4,TEM4		;[401] restore T4
	MOVE	T5,SAVLOC	;[401]

	MOVE	T2,LSTCHR	;[401]GET BACK LAST CHAR SEEN
	CAIE	T2,")"		;[401]RIGHT PARENS MUST DELIMIT THE NO.
	JRST	BADSYN		;[401]   THIS WONT DO EITHER!
	XCT	GETCHR		;[401]GET NEXT CHARACTER
	PUSHJ	P,GETSK2	;[401]GET NEXT CHARACTER
	SKIPE	SUBSCR		;[401]
	JRST	SYM6		;[401]
	JUMPE	T2,CPOPJ2	;[401]
	CAIE	T2,","		;[401]WE ALLOW COMMA OR DOT 
	CAIN	T2,"."		;[401]
	JRST	CPOPJ2		;[401]ACCEPT DELIMITER
	CAIN	T2,"="		;[401]
	JRST	CPOPJ2		;[401]ACCEPT DELIMITER
	CAIE	T2,"/"		;[401]
	CAIN	T2,":"		;[401]EQUIV TO "/"
	SKIPA			;[401]
	JRST	BADSYN		;[401]
				;[401]NO - THEN THE / SHOULD MEAN A PRINT MODIFIER
	TRZE	T1,ACCPT	;[401]UNLESS AN ACCEPT IS IN PROGRESS
	JRST	CPOPJ2		;[401]TEST FOR AN IMPLIED RANGE
	PUSHJ	P,OPTION	;[401]GET THE PRINT MODIFIERS
	  JRST	BADSYN		;[401]NUMERICS 
	JRST	CPOPJ2		;[401]


SYM6:	JUMPE	T2,SYM3		;DELIMITER IS GOOD

	CAIE	T2,","		;WE ALLOW COMMA OR MINUS AT THIS STAGE
	CAIN	T2,"-"		;
	JRST	SYM3		;ACCEPT DELIMITER
	CAIE	T2,"."		;DOT IS ALLOWED FOR .LT. IN IF'S
	CAIN	T2,"="		;= IS ALLOWED FOR ACCEPT (INLINE)
	JRST	SYM3
	CAIE	T2,"]"		;] IS A DELIMITER FOR [A(1)]
	CAIN	T2,")"		;) IS A DELIMITER FOR SUBSCRIPTS
	JRST	SYM3		;
	CAIE	T2,"/"		; / IS A DELIMITER FOR DIMENSIONS
	CAIN	T2,":"		; EQUIV TO "/"
	CAIA
	JRST	BADSYN		;ALL ELSE LOOSES
	TRNE	T0,SUBFLG!SURGFL ;IF HANDLING SUBSCRIPTS
	JRST	SYM3		;YES
				;NO - THEN THE / SHOULD MEAN A PRINT MODIFIER
	TRZE	T1,ACCPT	;UNLESS AN ACCEPT IS IN PROGRESS
	JRST	SYM3		;TEST FOR AN IMPLIED RANGE
	PUSHJ	P,OPTION	;GET THE PRINT MODIFIERS
	  JRST	BADSYN		;NUMERICS ????
	JRST	SYM3

;	TIDY UP BEFORE EXIT

SYM3:	MOVE	T5,SAVLOC	;GET THE SYMBOL VALUE
	TRZE	T0,FORMAL	;WAS THE BASE A FORMAL ARRAY PARAMETER
;[BL]	Character arrays will never be FORMALS /ahm/
	SKIPE	T5,FRMSAV	;YES - START AT THE FORMAL ADDRESS
	CAIA
	JRST	ERR38		;UNLESS IT'S ZERO
	MOVE	T2,LSTCHR	;RESTORE USERS LAST CHARACTER
	TLZE	T0,LABEL	;SKIP IF SYMBOL+SUBSCRIP TO PROCESS
	JRST	CPOPJ1		;STATEMENT EXIT
	ADD	T5,SUBSCR	;CORRECT SYMBOL VALUE TO WHAT USER ASKED FOR
	TRZE	T0,DOUBLE	;[112] IS THIS A DOUBLE WORD ARRAY
	ADD	T5,SUBSCR	;YES - SO GIVE HIM DOUBLE
	TRNN	T0,CHARS	;[157]Character string?
	 JRST	CPOPJ2		;[157]NO
	MOVE	T5,SAVLOC	;[157]T5 has been munged
	MOVE	T3,SUBSCR	;[157]Get offset
	MOVEM	T3,CLMOFF	;[157]Save for OFFSET
	JRST	CPOPJ2		;AND LET HIM HAVE IT!


;	HERE TO HANDLE ARRAY SUBSCRIPTS

SYM8:	MOVEM	T5,S1		;SAVE TEMPORARILY
	PUSHJ	P,GETDIM	;GET RANGE OF CURRENT DIMENSION
	MOVE	T5,S1		;PREPARE TO TEST UPPER SUBSCRIPT LIMIT
	SUB	T5,TEM1		;IF IN RANGE - SHOULD BE NEGATIVE
	JUMPG	T5,ERR23	;IF NOT COMPLAIN - SUBSCRIPT ERROR

	MOVE	T5,S1		;GET USERS SUBSCRIPT VALUE
	SUB	T5,TEM		;REMOVE OFFSET
	JUMPL	T5,ERR23	; SHOULD BE POSITIVE AFTER REMOVING OFFSET

	IMUL	T5,RP		;INCREASE BY CURRENT RANGE PRODUCT
	ADDB	T5,DIMTOT	;STORE TOTAL ELEMENT COUNT
	MOVE	T2,LSTCHR	;  AND LAST USER CHARACTER
	CAIE	T2,","		;MORE SUBSCRIPTS?
	JRST	SYM9		;NO - RETURN TO NORMAL PROCESSING

	MOVE	S1,TEM1		;PREPARE TO UPDATE
	SUB	S1,TEM		;  RANGE PRODUCT
	AOJ	S1,		;     WITH NEW RANGE
	IMULM	S1,RP		;	   LIKE SO
	JRST	SYM10		;LOOK FOR NEW SUBSCRIPT
;	ROUTINE OPTION
;	TO READ THE USERS PRINT MODIFIER SWITCH SETTINGS
;	CALL PUSHJ P,OPTION
;	RETURN1 NUMERIC FOUND = GROUP
;	RETURN2 	P3(RH)=PRINT OPTIONS    T2=USERS LAST CHAR.

OPTION:	TRO	P3,ANYMOD	;FLAG FIRST TIME THROUGH THIS SCAN
OPTN2:	PUSHJ	P,SIXIN		;ACCEPT SIXBIT
	  POPJ	P,		;NON SKIP RETURN WITH NUMERIC IN T5
	  JUMPE	T3,BADSYN	;NO CHARACTERS
	TRZE	P3,ANYMOD	;FIRST MODIFIER?
	HLLZ	P3,P3		;CLEAR FOR NEW MODIFIERS
	LDB	T3,[POINT 6,T3,5] ;GET THE FIRST CHARACTER OF THE SWITCH
	CAIN	T3,'A'		;ASCII?
	TRO	P3,A.!ANYMOD	;
	CAIN	T3,'O'		;OCTAL
	TRO	P3,O.!ANYMOD	;
	CAIN	T3,'R'		;RASCII
	TRO	P3,R.!ANYMOD	;
	CAIN	T3,'S'		;SOURCE LINE TRACE OPTION?
	TRO	P3,S.!ANYMOD		;
	CAIN	T3,'C'		;[157][164]Character string?
	TRO	P3,C.!ANYMOD	;[157][164]
	TRZ	P3,B.		;[120] IGNORE /BIG FOR THE REST
	CAIN	T3,'X'		;[157]COMPLEX?
	TRO	P3,X.!ANYMOD	;[157]
	CAIN	T3,'D'		;DOUBLE
	TRO	P3,D.!ANYMOD	;
	CAIN	T3,'F'		;FLOATING
	TRO	P3,F.!ANYMOD	;
	CAIN	T3,'I'		;INTEGER
	TRO	P3,I.!ANYMOD	;
	CAIN	T3,'L'		;[120] LOGICAL
	TRO	P3,L.!ANYMOD	;[120]
	CAIN	T3,'B'		;[120] 'BIG'  ?
	TRO	P3,B.!ANYMOD	;[120] 'BIG' OPTION
	CAIN	T3,'E'		;TRACE ENTRIES OPTION
	TRO	P3,E.!ANYMOD		;
	TRZN	P3,ANYMOD	;ANY MODIFIERS SEE - NO MEANS:
	JRST	BADSYN		;NO KNOWN MODIFIER
	JUMPE	T2,OPTN3	;END OF OPTIONS FLAGS IN T5
	CAIN	T2,","		;ALSO END OF OPTIONS DELIMITER
	JRST	OPTN3		;SKIP RETURN
	CAIE	T2,"/"		;MORE MODIFIERS ?
	JRST	BADSYN		;NO - NO OTHER MODIFIERS ALLOWED
	PJRST	OPTN2		;GET MORE

OPTN3:	TRNN	P3,C.!A.!X.!D.!F.!I.!O.!R.!L.
				;[120] [157][164]ANY PRINT MODIFIERS SET UP?
	TRO	P3,F.		;NO - SO SET UP FLOATING AS DEFUALT
	JRST	CPOPJ1		;GOOD RETURN
;	SUBROUTINE TO DETERMINE IF WE HAVE AN ACCEPTABLE LABEL
;	ENTER WITH THE ADDRESS OF RAD50 SYMBOL IN P1
;	CALL	PUSHJ P,TRULBL
;	RETURN	NOT GOOD
;	RETURN  ACCEPTABLE LABEL . . I.E. LABEL = ###X  WHERE X .EQ. P OR L
;	TRULST = LAST CHARACTER OF LABEL

TRULBL:	PUSHJ	P,SAV2AC	;SAVE AC T3   T5,P1
	TRZ	T1,GUDLBL	;CLEAR THE GOOD LABEL FLAG
	MOVE	T5,(P1)		;GET THE SYMBOL
	CAIG	T5,50		;SINGLE CHARACTER CAN NOT BE A LABEL
	POPJ	P,		;RESTORE T5,P1
	TLZ	T5,PNAME	;SYMBOL NAME ONLY
	IDIVI	T5,50		;GET LAST CHARACTER
	MOVEM	P1,TRULST	;SAVE FOR LATER
TRU3:	JUMPE	T5,TRU6		;ALL CHARACTERS SEPERATED IF T5=0
	IDIVI	T5,50		;GET NEXT CHAR.
	CAIL	P1,1		;IS THIS CHARACTER
	CAILE	P1,12		;     NUMERIC?
	POPJ	P,		; NO - LABEL NOT VALID
	JRST	TRU3		;YES - GET NEXT CHARACTER

TRU6:	TRO	T1,GUDLBL	;FLAG A GOOD LABEL SO FAR
	MOVE	P1,TRULST	;GET BACK LAST CHARACTER
	CAIE	P1,26		;WAS THE LAST CHARACTER AN 'L'
	CAIN	P1,32		;OR A 'P'
	AOS	-3(P)		;EITHER WILL BE ACCEPTABLE - SO SKIP
	POPJ	P,		;IF NEITHER THEN REJECT LABEL
;	SUBROUTINE TO DETERMINE IF THE SYMBOL JUST FOUND IS A TRUE
;	F10 VARIABLE
;	ENTER WITH THE ADDRESS OF RADIX 50 SYMBOL IN P1
;	CALL	PUSHJ	P,TRUVAR
;	RETURN1	NOT A GOOD VARIABLE
;	RETURN2	STANDARD F10 VARIABLE

TRUVAR:	PUSHJ	P,SAV2AC	;SAVE ACS P1,T5
	TRNE	T1,LNAME	;[402] Long symbol
	JRST	TLVAR		;[402] Yes
	MOVE	T5,(T2)		;GET THE SYMBOL
	TLZ	T5,PNAME	;SYMBOL NAME ONLY
	IDIVI	T5,50		;GET THE FIRST CHARACTER
	MOVEM	T5+1,TRUFST	;SAVE IT
	JRST	TRUV2

TRUV1:	JUMPE	T5,TRUV3	;LOOKED AT ALL CHARACTERS OF SYMBOL?
	IDIVI	T5,50		;NO - GET NEXT CHARACTER
TRUV2:	CAIGE	P1,1		;ENSURE WE HAVE ONLY NUMERIC OR
	CAMG	T5,[SQUOZE 0,$]	;[402] ALPH CHARS, percent or dollar sign
	JRST	TRUV1		;OK SO FAR
	POPJ	P,		;BAD CHARACTER FOR VARIABLE

TRUV3:	CAML	P1,[SQUOZE 0,A]	;CHECK THAT THIS FIRST CHARACTER OF
	AOS	-3(P)		;  THE SYMBOL IS ALPHA
	POPJ	P,		;OTHERWISE JUST NON SKIP RETURN

	MOVE	T5,(T2)		;GET THE SYMBOL
	TLZ	T5,PNAME	;SYMBOL NAME ONLY
	IDIVI	T5,50		;GET THE FIRST CHARACTER
	MOVEM	T5+1,TRUFST	;SAVE IT
	JRST	TRUV2

	;[402] Determine if long symbol just found is a true variable
TRLVAR:	PUSHJ	P,SAV2AC	;SAVE ACS P1,T5
	MOVE	T5,(P1)		;GET THE CNT+PTR to SYMBOL
	SKIPA
TLVAR:	MOVE	T5,(T2)		;GET THE CNT+PTR to SYMBOL
	PUSH	P,T3		;Save T3 and T4
	PUSH	P,T4	
	MOVE	T3,T5
	TLZ	T3,LFLG		;clear flag bits
	LSH	T3,-CNTSFT	;Get word count-1 in T3
	IMULI	T3,6		;character count

	MOVE	T4,[POINT 6,(T5)] ;Get Bytepointer to symbol
	ILDB	P1,T4		;Get first character
	MOVEM	P1,TRUFST	;Save it
	SOJ	T3,		;Decrement character count
	CAMGE	P1,41		;>= A
	JRST	TRULV4		;Non-alphabetic
	CAMLE	P1,72		;<= Z
	JRST	TRULV4		;Non-alphabetic
TRULV1:	ILDB	P1,T4		;Get next character
	SOJLE	P1,TRULV3	;DONE if end of last word
	JUMPE	P1,TRULV3	; or no more character in this word
	
TRULV2:	CAMGE	P1,20		; >= 0
	JRST	[CAIN	P1,4	;IS IT DOLLAR SIGN - OK SO FAR
		JRST	TRULV1	;YES
		JRST	TRULV4]	;NO - BAD CHARACTER FOR VARIABLE
	CAMG	P1,31		; <= 9
	JRST	TRULV1		;IT IS NUMERIC - OK SO FAR
	CAMGE	P1,41		; >= A
	JRST	TRULV4		;BAD CHARACTER FOR VARIABLE
	CAMG	P1,72		; <= Z
	JRST	TRULV1		;IT IS ALPHA - OK SO FAR
	CAIN	P1,77		;IS IT UNDERLINE?
	JRST	TRULV1		;YES - OK SO FAR
	JRST	TRULV4		;BAD CHARACTER FOR VARIABLE

TRULV3:	AOS	-5(P)		;GOOD SYMBOL
TRULV4:	POP	P,T4
	POP	P,T3
	POPJ	P,		;OTHERWISE JUST NON SKIP RETURN


;	ROUTINE TO DISPLAY ASCII TEXT AS '.....'
;	ENTER WITH EACH CHARACTER IN T5

ASCOUT:	JUMPE	T5,ASCNUL	;HAVE WE A NULL?
	CAIN	T5,177		;DELETE IS SPECIAL
	JRST	ASCDEL		;TYPE <DEL>
	CAIL	T5,173		;MAYBE AN ESCAPE CHARACTER
	JRST	ASCAPE		;YES
	CAIL	T5,40		;LESS THAN 40 = CONTROL CHARACTER
IFN TOPS20,<
	JRST	ASCASC		;NEVER FLAG IF RUNNING UNDER TOPS20
>;END IFN TOPS20
IFE TOPS20,<
	JRST	ASCUP		;PERHAPS LOWER CASE?
>;END IFE TOPS20
	type(^)
	ADDI	T5,100		;MAKE ASCII
ASCASC:	putchr	(T5)		;TYPE AS ASCII
	POPJ	P,		;DONE
IFE TOPS20,<
ASCUP:	SKIPE	TTYLC		;IF TTY LC IS ON, DON'T FLAG
	CAIG	T5,140		;LOWER CASE?
	JRST	ASCASC		;JUST GOOD OLD ASCII
	type(')
	JRST	ASCASC		;TYPE AS ASCII
>;END IFE TOPS20
ASCNUL:	type(<<NUL>>)
	POPJ	P,
ASCDEL:	type(<<DEL>>)
	POPJ	P,
ASCAPE:	openb
	PUSH	P,P1		;SAVE AROUND OCTAL PRINT
	PUSHJ	P,TYP4		;TYPE OCTAL
	POP	P,P1		;RESTORE REMAINDER OF OUTPUT
	closeb
	POPJ	P,


;	ROUTINE TO ACCEPT THE MAIN PROGRAM NAME FROM USER
;	UP TO 31 CHARACTERS 
;	CALL PUSHJ P,GETPRG
;	RETURN1 NEVER
;	RETURN2 RADIX 50 PROGRAM NAME IN T5 (name <= 6characters)
;		CNT,,PTR IN T5 (long names)

GETPRG:

IFE TOPS20,<			;[133]
	LINE
	TYPE(Program name: )
	PUSHJ	P,TTYIN>	;[133]GET THE INPUT

IFN TOPS20,<			;[133]
	PUSHJ	P,RDPROG>	;[133] GET THE PROGRAM NAME

	SKIPN	T3		;?IS THERE A SYMBOL
	JRST	BADPRG		;[133] NO - ERROR
	PUSHJ	P,VALID		;CHECK FOR BEGINNING LETTER AND CONVERT
				;TO RADIX 50
	MOVEM	T4,SYM		;Symbol to be found
	TRNE	T1,LNAME	;[402] Looking for long symbol name?
	JRST	[MOVSI	T2,LPNAME	;[321] Search for
		MOVEM	T2,SYMASK	;[321]  the
		PUSHJ 	P,FINDLG;[402] Yes
		  JRST	NFND	;[402] Not found
		JRST	FND]	;[402] 
	MOVSI	T2,GLOBAL	;[321] Search for
	MOVEM	T2,SYMASK	;[321]  the
	PUSHJ	P,FINDG		;[321]  global
NFND:	  JRST	[PUSHJ	P,DISP9	;NOT THERE
		PUSHJ	P,CLRLIN ;[133] GET RID OF ANY JUNK
		 JRST	GETPRG]	;TRY AGAIN
FND:	HLRZ	T2,(T5)		;WHERE IS THE USER ATTEMPTING TO START
	CAIE	T2,(JFCL)	; - ON A JFCL = F10 START
	JRST	ERR10		;YOU CANT START HERE
	JRST	CPOPJ1		;SKIP RETURN
	
SUBTTL	ERROR ROUTINES

;BAD SYNTAX GIVEN BY USER
;OUTPUTS MESSAGE & REPROMPTS ,ALSO CLEARS TYPE IN BUFFER
;CALL	PJRST BADSYN

BADSYN:	LINE
	TYPE(?FDTIAF Illegal argument format )
	PUSHJ	P,ENDLIN	;TYPE OUT REST OF USER LINE
	LINE
	TYPE(Type H for help)
	LINE
	JRST	RET

NOLONG:	LINE
	TYPE(?FDTNLS Long symbols truncated - Program not compiled with DEBUG switch ) ;[402]
	LINE			;[402]
	JRST	CPOPJ		;[402]

BADBND:	LINE			;[401]
	TYPE(?FDTIAF Substring bounds out of range )	;[401]
	PUSHJ	P,CLRLIN	;[401]clear any junk
	LINE			;[401]
	JRST	RET		;[401]

BADPRG:	TYPE(?FDTIPN Illegal program name)  ;[133]
	PUSHJ	P,CLRLIN	;[133] CLEAR ANY JUNK
	JRST	GETPRG		;[133] TRY AGAIN

ERR1:	LINE
	TYPE(?FDTMSN More subscripts needed)
	JRST	DIM1		;TYPE THE DIMENSIONS FOR ARRAY(SAVLOC)

ERR2:	TYPE(?FDTBOI Bad octal input )
	JRST	ERRR7		;SHOW REST OF BAD LINE

ERR3:	LINE
	TYPE	(<?FDTLGU >)
	PUSHJ	P,TYPRAY	;TYPE THE OFFENDING ARRAY NAME
	TYPE(< lower subscript .GE. upper>)
	JRST	RET

ERR4:	TYPE(<%FDTNST Not 'START'ed>)	;'START' INITS FORDDT AND RESETS THE OTS
	JRST	RET

ERR5:	TYPE	(<?FDTNFV >)
	MOVE	T2,T3		;GET USERS SYMBOL
	PUSHJ	P,OUT6		;DISPLAY
	TYPE	(< is not a FORTRAN variable>)
	LINE
	SKIPE	PRGNAM		;RETURN TO GETPRG IF NO PROGRAM NAME YET
	JRST	RET
	PUSHJ	P,CLRLIN
	JRST	GETPRG

ERR6:	PUSHJ	P,DISP9		;
	JRST	RET

DISP9:	TYPE	(<?FDTBDF >)
	MOVE	T5,SYM		;SET UP FOR RADIX 50 PRINT
	PUSHJ	P,SPT2		;[201] RADIX 50 PRINT
	TRNN	T0,MDLCLF	;MULTIPLY DEFINED?
	JRST	[type(< is undefined>)
		 JRST	dispx]
	TYPE(< is multiply defined>)
dispx:	POPJ	P,

ERR7:	TYPE(<?FDTINV Invalid value >)
ERRR7:	PUSHJ	P,ENDLIN	;TYPE REST OF USER LINE
	JRST	RET
ERR8:	TYPE(<?FDTNFS Cannot find FORTRAN start address for >)
	MOVE	T5,SYM
	PUSHJ	P,SPT1
	JRST	BEGIN2		;TRY AGAIN

ERR9:	TYPE(<?FDTPRO Too many PAUSE requests>)
	JRST	RET

ERR10:	TYPE(<?FDTCSH Cannot 'START' here>)
	PUSHJ	P,CLRLIN
	JRST	GETPRG		;TRY ANOTHER PROGRAM NAME

ERR11:	TYPE(<?FDTNDT DDT not loaded>)
	JRST	RET

ERR12:	TYPE(<?FDTCFO Core file overflow>)
	JRST	RET

ERR13:	TYPE(<?FDTFCX Format capacity exceeded >)
ER13:	TYPE(<please re-type>)
	JRST	RET

ERR14:	TYPE(<?FDTICC Compare of two constants is not allowed>)
	JRST	RET

ERR15:	TYPE(<?FDTIGN Invalid group number>)
	JRST	RET

ERR16:	TYPE	(<?FDTLNF >)
	MOVEI	P1,SYM
	PUSHJ	P,SPT
	TYPE	(< is not a format statement>)
	POPJ	P,

ERR17:	TYPE	(<?FDTNSP >)
	LDSYM	T5,PNAMSV	;[402]	
	PUSHJ	P,SPT1
	TYPE(< no such PAUSE>)
	JRST	RET
ERR18:	TYPE(<?FDTCCN Cannot continue>)
	JRST	RET

ERR19:	TYPE(<?FDTNPH Can't insert a PAUSE here>)
	JRST	RET

ERR20:	TYPE(<%FDTNSL No symbols loaded>)
	POPJ	P,
ERR21:	TYPE(?FDTDNA Double precision comparisons not allowed)	;[113]
	PUSHJ	P,CLRLIN	;[113]
	JRST	RET		;[113]
ERR22:	LINE
	TYPE(?FDTTMS Too many subscripts)
 	PUSHJ	P,CLRLIN	;[403]ZERO REMAINDER OR USER LINE
	JRST	RET		;[403]TYPE THE DIMENSIONS FOR THE (SAVLOC) ARRAY

ERR23:	LINE			;SUBSCRIPT OUT OF RANGE
	TYPE(?FDTSER Subscript error)
 	PUSHJ	P,CLRLIN	;ZERO REMAINDER OR USER LINE
	JRST	RET		;[403]DISPLAY ARRAY DIMENSIONS

ERR24:	TYPE(?FDTNAL Not allowed) ;ATTEMP TO MODIFY NON LOCAL VARIABLES
	JRST	RET		;OR START ON A FORMAT STATEMENT

ERR26:	TYPE	(?FDTNUD )
	MOVE	T5,SYM
	PUSHJ	P,SPT1
	TYPE( not a user defined array)
	JRST	RET

ERR27:	LINE
	TYPE	(<?FDTSTL >)
	PUSHJ	P,TYPRAY	;TYPE THE OFFENDING ARRAY NAME
	TYPE(< size too large>)
	JRST	RET

ERR28:	TYPE(<%FDTSCA Supersedes compiled array dimension>)
	JRST	PUTOK		;NOW PLACE THE NEW DEFINITION

ERR30:	TYPE(<?FDTNAR Not after a re-enter>)
	JRST	RET

ERR31:	LINE
	TYPE(<%FDTXPA Attempt to exceed program area with >)
	MOVE	T5,SYM		;DISPLAY BASE SYMBOL
	PUSHJ	P,SPT2		;[201] DISPLAY SYMBOL
	AOS	T5,SUBSCR	;SHOW USER WHAT SUBSRIPT HE ATTEMPTED TO USE
	TYPE(<[>)
	PUSHJ	P,TFLOT		;TYPE IT
	TYPE(])
	JRST	RET

ERR32:	type(?FDTPAR Parentheses required)
	JRST	ER13

ERR33:	LINE
	TYPE	(<?FDTFNR >)
	MOVE	T5,SYM		;GET THE ARRAY NAME
	PUSHJ	P,SPT2		;[201] TYPE IT
	TYPE(< is a formal and may not be re-defined>)
	PUSHJ	P,FLUSHA	;FLUSH THE LOT
	JRST	RET
ERR34:	TYPE	(<%FDTNAA >)	;[106]
	MOVEI	P1,SYM
	PUSHJ	P,SPT		;TYPE SYMBOL
	TYPE	(< is not an array>)
	JRST	RET

ERR35:	TYPE	(<%FDTSPO Variable is single precision only>)
	JRST	RET

ERR36:	TYPE	(<?FDTNGF Cannot GOTO a FORMAT statement>)
	JRST	RET

ERR37:	LINE
	TYPE	(?FDTITM Illegal TYPE modifier - S)
	JRST	RET

ERR38:	TYPE	(?FDTFNI Formal not initialized)
	JRST	RET

ERR39:	LINE
	TYPE	(?FDTRGR Recursive group reference)
	JRST	RET

ERR40:	LINE
	TYPE	(?FDTIRS Illegal range specification)
	JRST	RET

ERR41:	LINE
	TYPE	(?FDTMCD Compile program with the DEBUG switch to type a format statement)
	JRST	RET

ERR42:	LINE	;[401]
	TYPE	(?FDTACA ACCEPTing character variable with mode A or R) ;[401]
	JRST	RET 	;[401]

;  THIS PAGE HOLDS ERROR MESSAGES FOR INTERNAL ERRORS OF FORDDT.  KEEP
;SIMILAR MESSAGES ON THIS PAGE SO THAT THEY ARE EASY TO LOCATE.





E1:	TYPE	(?FDTIER Internal FORDDT error - 1)
	JRST	WT5


E2:	TYPE	(?FDTIER Internal FORDDT error - 2)
	JRST	BREAK4


;*E3:	TYPE	(?FDTIER Internal FORDDT error - 3)


;*E4:	TYPE	(?FDTIER Internal FORDDT error - 4)


E5:	TYPE	(?FDTIER Internal FORDDT error - 5)
	JRST	DMFLSH		;REMOVE RECENT ADDITIONS TO DIMTAB


E6:	TYPE	(?FDTIER Internal FORDDT error - 6)
	JRST	RE.L3


E7:	TAB
	TYPE	(?FDTIER Internal FORDDT error - 7)
	JRST	STEP6


E8:	LINE
	TYPE	(?FDTIER Internal FORDDT error - 8)
	JRST	RET


;[321] E9:	TYPE	(?FDTIER Internal FORDDT error - 9)
;[321]	JRST	RET
;COMMAND ERRORS

ERROR:	type(?FDTURC Unrecognized command )
	MOVE	T2,T3		;PREPARE TO TYPE USER COMMAND
	PUSHJ	P,OUT6		;TYPE IT
	line			;TIDY
	JRST	RET		;RESTORE ACS AND RETURN TO MAIN LOOP
NOTUNQ:	type(?FDTCNU The command )
	MOVE	T2,T3		;PREPARE TO TYPE USER COMMAND
	PUSHJ	P,OUT6		;TYPE IT
	type( is not unique)
	line			;TIDY UP
	JRST	RET		;RESTORE ACS & RETURN TO MAIN LOOP
SUBTTL	PROMPT MESSAGES

CRLF:	ASCIZ /
/

;[327] Removed BLDVEC
SUBTTL VARIABLE STORAGE

	NMBFSZ==^D13		;[177][127] BUFFER SIZE
NUMBUF:	BLOCK	NMBFSZ		;[127] STORAGE BUFFER FOR NUMBER TO BE DECODED
STKYFL:	TRLINE			;STICKY FLAGS REMAIN SET WHEN F IS CLEARED
FRMSAV:	BLOCK	1		;REFFERS TO THE FORMAL ARRAY BASE
RANGE:	BLOCK	1		;INDICATES RANGE OF VALUES A(1)-A(?)
SYMSAV:	BLOCK	1		;SAVE EVAL POINTER TO LAST SYMBOL
SYL:	BLOCK	1
LWT:	BLOCK	1
DEN:	BLOCK	1
DIMCNT:	BLOCK	1		;COUNT OF THE # OF DIMENSIONS FOR F10 ARRAY
ESCAPE:	-1			;NON ZERO MEANS NO ^C IN EFFECT SO ESCAPE ALLOWED
REENTR:	0			;NON-ZERO IF REENTER HAS BEEN DONE
STARTU: 0			;[316] User's start address

IFN TOPS20,<
EXTEND:	Z		;[300] FLAG TO INDICATE RUNNING IN A NON-ZERO SECTION
DDTVEC:	BLOCK	2	;[300] 2 WORD ENTRY VECTOR HOLDING LOCATION

;[300] ARGUMENT BLOCK FOR GET JSYS
GTBLK:	GT%BAS		;[300] .GFLAG
	Z		;[300] .GLOW
	Z		;[300] .GHIGH
	Z		;[300] .GBASE
>
				;[327] Removed FOSYM.,FNDVEC,FNDVSZ
JOBSA:	BLOCK	1		;THESE THREE LOCATIONS ARE USED TO PRESERVE
JOBSYM:	BLOCK	1		;    THE INITIAL STATE OF THE PROGRAM - SO THAT
				;	OVERLAYS CAN BE DETECTED
JOBNAM:	BLOCK	1		;SIXBIT NAME OF PROGRAM OR OVERLAY

IFE TOPS20,<
TTYLC:	BLOCK 1			;RETURNED BY .TOLCT TRMOP. LOWERCASE SET/UNSET
>;END IFE TOPS20

MODFLG:	F.			;HOLDS THE CURRENT TYPE OPTION FLAGS
JOBBRK:	BLOCK	1		;STORES THE CURRENT EXECUTION POINTER
PRGM:	BLOCK	1
SAVCHR:	BLOCK	1		;TEMP SAVE OF CHARACTER
TRUFST:	BLOCK	1		;SAVE FIRST CHARACTER OF A SYMBOL
LOKFST:	BLOCK	1		;DITTO EXCEPT USED BY LOOK
TRULST:	BLOCK	1		;SAVE LAST CHARACTER OF A SYMBOL
TROFFS:	BLOCK	1		;[215] TRACE OFFSET WHEN NO LOCALS
MATHSM:	BLOCK	SYMSPC		;[402]USED BY "LOOK" TO RESOLVE MULTIPLE DEF
LSYMBF:	BLOCK	7		;[402] HOLDS LONG NAME IN 6BIT +1 NULL WORD
SYM:	BLOCK	1
SYMASK:	BLOCK	1		;MASK FOR SYM TBL SYMBOL (FOR FINDG)
BESTVA:	BLOCK	1		;BEST VALUE FOUND FOR LOKSYM
LASYM:	BLOCK	1		;LAST SYMBOL FOUND BY LOKSYM
LASVAL:	BLOCK	1		;LAST VALUE CALLED TO LOKSYM
OJBSYM:	BLOCK	1		;'OUR JBSYM' USED FOR SYM TABLE ROUTINES
SAVT3:	BLOCK	1		;TEMPORARY SAVE OF T4
PRGNAM:	BLOCK	SYMSPC		;[402]SET TO NAME  OF CURRENT MAIN PROGRAM
				;CAIA APPEARS HERE
HELLO:	PUSH	17,0		;IDENTIFIES HELLO MACRO USEAGES
BASRAY:	BLOCK	1		;ARRAY BASE NAME(VALUE)
SAVLOC:	BLOCK	1		;GENERAL SAVE LOCATION
QLPNT:	BLOCK	1		;USED IN "QLIST" AS POINTER TO A SYMBOL
QLPNAM:	BLOCK	1		;[402] PTR TO LONG PROGRAM NAME IN "QLIST"
STPCNT:	BLOCK	1		;STEP COUNT - HOW MANY LINES TO TRACE
OPENED:	SQUOZE	0,MAIN.		;HOLDS CURRENTLEY OPENED PROGRAM NAME
	BLOCK	SYMSPC-1	;[402]
SSTAB:	BLOCK	1		;[402] PTR TO SECONDARY SYMBOL TABLE
OPENLS:	BLOCK	1		;HOLDS SUB-SET OF JBSYM FOR OPENED PROGRAM
OPENLZ:	BLOCK	1		;[321] Length of OPEN module symbol table
OLDOPN:	BLOCK	SYMSPC		;PROG THAT WAS OPEN BEFORE GROUP REQUEST
GOLOCF:	BLOCK	1		;[300] FLAG WORD OF DBL-WD PC
GOLOC:	BLOCK	1		;HOLDS E.T.V. TO EXTERNAL ROUTINES
SSLOW:	BLOCK	1		;[401] LOWER SUBSTRING BOUND
SSUP:	BLOCK	1		;[401] UPPER SUBSTRING BOUND
SUBSCR:	BLOCK	1		;HOLDS ARRAY SUBSCRIPT VALUE
COUNT:	BLOCK	1
JOBOPC:	BLOCK	1		;HOLDS .JBOPC IF WE ARE IN A RE-ENTER
PNAMSV:	BLOCK	SYMSPC		;STORES NAME OF SECTION OF NEAREST MATCH TO SYMBOL
RANLIM:	BLOCK	1		;HOLDS CURRENT PROGRESS IN A RANGE CONDITION
TABCNT:	BLOCK	1		;COUNTS THE # OF LABELS/LINE IN TRACE
COMAND:	BLOCK	1		;HOLDS USER COMMAND SIXBIT
PUTTER:	BLOCK	1		;STORES END OF CURRENT DIMENSION LIST
DIMTOT:	BLOCK	1		;STORES TOTAL ELEMENT COUNT
RP:	BLOCK	1		;HOLDS RANGE PRODUCT FOR ARRAY ELEMENT CALCULATION
SECSAV:	BLOCK	1		;HOLDS SECTION NAME
FSV:	BLOCK	1
FH:	BLOCK	1
SAVPI:	BLOCK	1

B0ADR:	BLOCK	3		;[313] FOR BREAKPOINT ZERO
B1ADR:	BLOCK	1
B1SKP:	BLOCK	1
B1CNT:	BLOCK	1
BPNCR2=.-B1ADR				;[300]
	BLOCK	NBP*BPNCR2-BPNCR2	;[300]

BNADR=.-3
AUTOPI:	BLOCK	1

;[157]**********DO NOT SEPARATE CLMPTR & CLMSIZ******************
ORIGLM:	BLOCK	1		;[157]Save first element ptr
ORIGOF:	BLOCK	1		;[157]Original element offset
CLMPTR:	BLOCK	1		;[157]Character array element BP
CLMSIZ:	BLOCK	1		;[157]Character element size
CLMOFF:	BLOCK	1		;[157]Char.elem...offset from array base
CLMRNG:	BLOCK	1		;[157]Char.elem...upper range offset
CRYSYM:	BLOCK	1		;[157]Addr Rad50 name of array
F10RP:	BLOCK	1		;[163]switch to indicate /debug dimension info
SAVACS:	BLOCK	20		;[325]User's ACs saved here 
SARS:	BLOCK	1
TEM:	BLOCK	1
TEM1:	BLOCK	1
TEM2:	BLOCK	1
TEM3:	BLOCK	1		;TEMP STORAGE
TEM4:	BLOCK	1		;TEMP STORAGE
TEM5:	BLOCK	1		;TEMP STORAGE
TEM6:	BLOCK	1		;TEMP STORAGE
TEM7:	BLOCK	1		;TEMP STORAGE
TEM8:	BLOCK	1		;[321] Search value for LOKSYM
TEM9:	BLOCK	1		;[321] Table length for LOKSYM
TEM10:	BLOCK	1		;[340] Temp in START and ACCEPT 
TEM11:	BLOCK	1		;[340] Temp in PAUSE and ACCEPT
TEM12:	BLOCK	1		;[402] Temp in LOOKLP
TEM13:	BLOCK	1		;[402] Temp in LOK2
TEM14:	BLOCK	1		;[402] Temp in LOK2
SAVT2:	BLOCK	1		;[402] Temp in LOK2 - holds value of T2
LSAVT2:	BLOCK	1		;[402] Temp in LOK2 - LONG eqv of SAVT2
LSAVT4:	BLOCK	1		;[402] Temp in LOK2 - LONG eqv of TEM9
LBESTV:	BLOCK	1		;[402] Temp in LOK2 - LONG eqv of BESTVA
LSAVP1:	BLOCK	1		;[402] Temp in LOK2 - LONG eqv of P1
TMPNAM:	BLOCK	1		;[402] Holds PNAMSV converted to 6bit from R50
TMPOPN:	BLOCK	1		;[402] Holds OPENED converted to 6bit from R50
TMPSAV:	BLOCK	2		;[313] TMP IN INSRTB
IFN TOPS20,<
TMPSV1:	BLOCK	1		;[313] TMP IN INSRTB
>
PAUFLG: BLOCK	1		;[331] ZERO IF NOT A PAUSE ON ERROR
				;[331] ELSE CONTAINS ADDR OF ERROR IN USER PGM
BP0FLG:	BLOCK	1		;[145] NON-ZERO = USER "CALL"ED FORDDT
				;[145]   - = BEFORE FIRST PROMPT,
				;[145]   + = AFTER FIRST PROMPT
STPVAL:	BLOCK	1		;HOLDS THE DEFAULT TRACE COUNT
PDL:	BLOCK	PDSIZ+1		;[327] Push-down list for initialization
TERMK:	BLOCK	1		;FLAG FOR LINE TERMINATOR
				;-1=SP 0=^Z 1=LF 2=ALTMODE
DELCHR:	0			;SAVED DELIMITER FOR ASCII ACCEPT AND CLRLIN
IFE TOPS20,<			;[115]
MRGACS:	BLOCK	20		;[115] ACS DURING MERGE UUO
>				;[115]
ifn tops20,<

percsb:	lparse			;[114]command state block (permanent)
	.priin,,.priou
	point 7,[byte(7)76,76,0]
	point 7,parbuf
	point 7,parbuf
	^d80
	^d80
	point 7,paratm
	^d80
	0
temcsb:	block 12		;command state block (temporary)
parbuf:	block 20		;parsing buffer
paratm:	block 20		;atom buffer
NEWBUF:	BLOCK 20		;[140]MODIFIED PARSING BUFFER
TXTOUT:	BLOCK  1		;[140]POINTER TO NEWBUF-USED IN COMMAND
				;[140]  SCANNING.
TXTIN:	BLOCK  1		;[140]POINTER TO PARBUF-ALSO USED IN
				;[140]  COMMAND SCANNING.
FUNPRG:	<.CMTXT>B8!CM%HPP!CM%SDH ;[133] BLOCK FOR READING PROGRAM NAME
	0
	POINT	7,[ASCIZ /Program name as specified in PROGRAM statement/]
	0
funini:	<.cmini>b8		;init block for parse
	0
	0
	0
funkey:	<.cmkey>b8		;keyword block for parse
	keytab
	0
	0
fungar:	<.cmtxt>b8!cm%hpp!cm%sdh ;rest of line block for parse
	0
	point 7,[asciz/command arguments/]
	0
keytab:	24,,24			;keyword table
	[asciz/ACCEPT/],,0
	[asciz/CHARACTER/],,0
	[asciz/CONTINUE/],,0
	[asciz/DDT/],,0
	[asciz/DIMENSION/],,0
	[asciz/DOUBLE/],,0
	[asciz/GOTO/],,0
	[asciz/GROUP/],,0
	[asciz/HELP/],,0
	[asciz/LOCATE/],,0
	[asciz/MODE/],,0
	[asciz/NEXT/],,0
	[asciz/OPEN/],,0
	[asciz/PAUSE/],,0
	[asciz/REMOVE/],,0
	[asciz/START/],,0
	[asciz/STOP/],,0
	[asciz/STRACE/],,0
	[asciz/TYPE/],,0
	[asciz/WHAT/],,0
>				;end of conditional



	XLIST			;LITERALS
	LIT
	LIST


	-1,,0				;[404] Argument list for ERRSET
ERRARG:	400300,,[377777777777]		;[404] Maximum number of error
					;[404] messages from ERRSET.

IFN	DEBUG	<
PATCH:	BLOCK	50		;PATCHING SPACE
		>

IF2,<
	PURGE	ERJMP,JRSTF,RESET,SAVE,XMOVEI
>

;IFE	DEBUG	<XPUNGE>		;DELETE SYMBOLS


IFE TOPS20,<
DDTEND:	END	SFDDT>		;Tops-10 doesn't have entry vectors

IFN TOPS20,<
DDTEND:	END	3,,ENTVEC>	;Tops-20 has entry vectors