Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - 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 ,7(176)
SUBTTL	P.E.T. HARDING/DBT/FLD/MD/JMT/MA/SJW/JNG/DCE/BPK/CKS/DCC/BAH/BL 11-Jan-83



;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1973, 1983
;
;
;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==176	;EDIT NO
VERSION==7	;MAJOR VERSION NO
VMINOR==0	;MINOR VERSION NO
VWHO==0		;WHO LAST EDITED


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

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

; 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 [SETMI]	;[147] define XMOVEI for -10
	>			;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
	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 Revision History *****

\;END OF COMMENT
SUBTTL	DEFINITIONS	


;DEFINE ACCUMULATORS

ENTRY FORDDT,FDDT.,.F10,%FDDT
EXTERN .JBREL,.JBHRL,.JBSYM,.JBHSM,.JBSA,.JBUSY,.JBOPC,.JBDA

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



;DEFINE SYMBOL TABLE SYMBOL TYPES

GLOBAL==040000		;GLOBAL SYMBOL
LOCAL==100000
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%CHR==15		;[157]  Character
FO$HSP==4		;[142] FOR RETURNING HISEG SYBOL TABLE PTR.
;	DEFINE SYSTEM PARAMETERS


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

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

IFNDEF PDSIZ,<PDSIZ==10*GPMAX+40>	;DEFINE PDL SIZE TO ALLOW ALL GROUPS TOGETHER
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 TWO WORD PAIRS
	USED TO HOLD ARRAY DIMENSION DATA

\
;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	;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
FPRNM== 000002	; FIND PROGRAM NAME (FOR FNDSYM)
FLCLNM==000001	; FIND LOCAL IN CURRENT OPEN PROGRAM (FOR FNDSYM)



;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 LOKSYM AND FNDSYM - 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

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 TF ***
;
;	TF 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


;	*** FLAG TMOD ***
;
;	DEFINE THE PRINT OPTION FLAGS USED IN LEFT & RIGHT OF TMOD
;	RIGHT HAND - DEFAULT USER SETTING
;	LEFT 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
;[157]C.==000100	;TYPE COMPLEX FORM
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 F - "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
;	? E9	INTERNAL INCONSISTENCY (FNDSYM)


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

	DEFINE	SETPDL		;SETUP PDL STACK
<	MOVE	P,[IOWD	PDSIZ,PDL]	>

	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,tf
	hrroi	tf,[asciz/x/]
	psout%
	pop	p,tf	>

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

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

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

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

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

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

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

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

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





	DEFINE SKIPIF(STRING)		;IS STRING LOADED? - SKIP IF IT IS
<	MOVE	T,[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	T,[SQUOZE 0,NAME]
	MOVEM	T,SYM
	TLO	F,FPRNM
	PUSHJ	P,FNDSYM	>
;	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 T
<	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]


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

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

	MOVEI	T,RE.ENT	;AND SET UP THE RE-ENTER ADDRESS
	MOVEM	T,.JBREN	;SO THAT FUTURE RE ENTERS WILL WORK

	JSP	16,RESET.##	;[143] INITIALISE THE FOROTS SYSTEM
	0,,0			;[142] DUMMY RESET ARG
FORDD1:	PUSHJ	P,GHSSYP	;[142] ANY HISEG SYMBOLS?
	 SKIPGE	.JBSYM		;NO, ANY LOSEG SYMBOLS?
	CAIA
	PUSHJ	P,ERR20		;NO - WARN USER
	PUSHJ	P,SETLST	;SETUP SYM TABLE LISTS
	HRRZ	T,.JBSA		;REMEMBER THE START ADDRESS
	MOVEM	T,JOBSA		; AND THE
	MOVE	T,.JBSYM	;  SYMBOL TABLE DETAILS AT THE-
	MOVEM	T,JOBSYM	;    TIME FORDDT IS ENTERED
ife tops20,<			;This hack doesn't work under TOPS20
	MOVE	T,[XWD -1,3]	;GET THE CURRENT JOB
	GETTAB	T,		;   NAME
	 CAIA			;DON'T PANIC IF NO JOB NAME
	MOVEM	T,JOBNAM	;AND SAVE,
				;THIS WILL SERVE TO DETECT OVERLAYS
	SETZM	TTYLC		;[151] DEFAULT TO DON'T FLAG LOWERCASE
	MOVNI	T6,1		;[151] GET CURRENT JOB'S CONTROLLING TERMINAL UDX
	TRMNO.	T6,		;[151]
	  JRST	FORDD2		;[151] ERROR. DEFAULT TO NO FLAGGING OF LOWERCASE
	MOVEI	T5,.TOLCT	;[151] TRMOP. FUNCTION TO READ LOWERCASE SETTING
	MOVE	T,[2,,T5]	;[151] SET UP TRMOP. CALL
	TRMOP.	T,		;[151]
	  JRST	FORDD2		;[151] ERROR. ASSUME LOWERCASE. DOESN'T FLAG LC
	MOVEM	T,TTYLC		;[151] STORE THE SETTING
FORDD2:				;[151]
> ;END OF IFE TOPS20
	HRRZI	T,[JRST RET]	;GUARD AGAINST CONTINUE AFTER CNTRL C
	HRRM	T,PROC0
	MOVEI	T,1		;RESET THE INITIAL TRACE VALUE
	MOVEM	T,STPVAL	;   TO ONE
	MOVE	T,STARTU
	HLLZM	T,STARTU	;RESET - SO 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:	SETPDL
	SKIPIF	(CEXIT.)	;
	   SETZM T		;NO CLUDGE CONECTIONS IN THIS PROG
	HRRM	T,HELLO		;SET UP FOR HELLO MACRO DETECTOR
	MOVE	F,STKYFL	;REINSTATE THE FLAG REGISTER
				;[137] This routine provides g-floating
				;[137]  capability to those programs
				;[137]  compiled with the /gfl switch.
	TRZ	F,GFLOAT	;[137] Default to d-floating mode.
	TRO	TF,FGLONL	;[137] Search for globals only in sym table
	MOVE	TT1,[SQUOZE 0,..GFL.]	;[137] Store "..GFL." in SYM for EVAL
	MOVEM	TT1,SYM
	PUSHJ	P,EVAL		;[137] Search symbol table for "..GFL."
	   JRST	FSET		;[137] Not found, mode is d-floating; done
	MOVE	F,STKYFL	;[137] Found, reinstate the flag reg(in case
				;[137]  F was modified by EVAL)
	TRO	F,GFLOAT	;[137] Set GFLOAT flag to get g-floating
	MOVEM	F,STKYFL	;[137] Update sticky flag store.
FSET:	MOVSI	T,(JFCL)	;RESET THE TRACE ENTRY
	MOVEM	T,FDDT.		;
	MOVE	T,M2.F		;GET THE FOROTS FIN CALL
	MOVEM	T,M2.I		;RE-INSTATE IN FORMAT - AFTER COMPLEX INPUT

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

MODRET:	HRRZI	T,F.		;SET UP TO TYPE FLOATING FORM
	MOVEM	T,MODFLG	;SAVE AS THE STANDARD DEFAULT
MODRT2:	HRRZ	T,STARTU	;[176]SEE IF ALREADY STARTED;
	JUMPN	T,RET		;YES LEAVE ANY OPENED SECTIONS ALONE
	SKIPE	PRGNAM		;HAS ANY SECTION BEEN OPENED?
	JRST	RET		;YES - SO NOT FIRST TIME THROUGH
	PROGIF	(MAIN.)		;SKIP IF MAIN. IS LOADED
BEGIN2:	   PUSHJ P,GETPRG	;NOT FOUND - GET THE MAIN PROGRAM NAME
	MOVE	T3,[SQUOZE 0,MAIN.]
	TLZ	T3,PNAME	;[155]strip bits in case it's a global
	MOVEM	T3,PRGNAM	;DEFAULT MAIN PROG NAME IS MAIN.
	MOVEM	T3,SYM		;SET SO SETNAM CAN OPEN THE MAIN PROGRAM
	PUSHJ	P,SETNAM	;'OPEN' THE MAIN PROGRAM
SUBTTL	USER INPUT

RET:	HRRZ	TMOD,MODFLG	;SET UP THE DEFAULT TYPING OPTIONS ONLY
	AND	F,[STIKYS]	;MAKE SURE WE SAVE THE GOOD FLAGS
	MOVEM	F,STKYFL	; IN THE STICKY STORE
	SETZI	TF,		;RESET THE TEMPORARY FLAGS
	SKIPGE	TERMK		;END OF LAST LINE SEEN?
	PUSHJ	P,CLRLIN	;CLEAR OUT THE REST OF USERS LINE
	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,tf		;save tf
	push	p,r		;save r
	hrrzi	tf,.priou	;get terminal output designator
	rfmod%			;get terminal JFN word
	tlz	r,(tt%osp)	;clear ^o effects
	hrrzi	tf,.priou	;get terminal output designator
	sfmod%			;set new JFN word
	pop	p,r		;restore r
	pop	p,tf>		;restore tf, end of conditional
	LINE
	PUSHJ	P,OVRLAY	;HAS AN OVERLAY OCCURED

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

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

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

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

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

	AOS	AR		;FLAG ANOTHER MATCH
	HRL	P3,T1		;MARK LAST INDEX
COMNEQ:	AOBJN	T1,COMLP	;TRIED ALL KNOWN COMMANDS?

	JUMPN	AR,.+2		;UNKNOWN?
	AOS	T1		;SET FOR NONE UNIQUE
	CAIN	AR,1		;WAS THE COMMAND UNIQUE?
	HLR	T1,P3		;YES - REMEMBER THIS INDEX
COMFND:	MOVE	T3,(T1)		;SAVE OFFICIAL COMMAND NAME
	SUBI	T1,(P4)		;INDEX DOWN DISPATCH
	ADDI	P3,(T1)		;INDEX INTO DISPATCH
	MOVE	T1,(P3)		;GET DISPATCH ADDRESS
	JRST	@T1		;     DISPATCH
	SUBTTL	COMMAND DECODER



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


COMTAB:	XLIST		;NAMES
	NAMES
	LIST

DISPL=.-COMTAB




	DEFINE C(A,B)
<	EXP	B	>


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:	HRRZ	T,STARTU	;USER MUST INITIALISE WITH START
	JUMPE	T,ERR4		;MUST TYPE START FIRST
	SKIPN	ESCAPE		;ARE WE ALLOWING ESCAPES
	JRST	ERR30		;NO TRACE
	MOVE	T,P		;SAVE FORDDT STACK PIONTER
	MOVE	T1,16		;SAVE FORDDT REG 16??
	MOVE	P,SAVACS+17	;[147] SET UP FORTRAN STACK
	MOVE	16,SAVACS+16	;[147] - AND REG 16
	PUSHJ	P,TRACE.##	;[143] DO A FORTRAN TRACE
	MOVE	P,T		;MUST RESTORE FORDDT STACK
	MOVE	16,T1		;AND 16
	JRST	RET		;END OF TRACE
;	START FUNCTION

START:	MOVSI	T,(JFCL)	;RESET THE TRACE ENTRY
	MOVEM	T,FDDT.		;
	PUSHJ	P,CLRLIN	;FLUSH OUT LINE BUFFER
START2:	MOVE	T,PRGNAM	;GET THE MAIN PROGRAM NAME
	MOVEM	T,SYM		;SAVE FOR EVAL
;[155]	TLO	F,FPRNM		;LOOK FOR PROGRAM NAMES
;	change to look for global symbol. HISEG now contains
;	character descriptors before executable code.
	TLO	F,FGLSNM	;[155]Look for the global
	MOVSI	T1,GLOBAL	;[157]Global prefix
	MOVEM	T1,SYMASK	;[157]Reset mask in case it's been munged
	PUSHJ	P,FNDSYM	;FIND THE START
	   JRST	ERR8		;NO START ADDRESS
	HRRM	T,STARTU	;SAVE FOR GO
	MOVEM	F,STKYFL	;MAKE THE FOROTS FLAG STICK
	PUSHJ	P,RE.NTR	;ALLOW RE-ENTERS AGAIN
	PUSHJ	P,INSRTB	;PUT IN BREAKPOINTS
	JSP	T,RESTORE
	SETZI	16,		;MAKE F40 STRACE WORK
STARTU:	JRST	.-.		;START USER PROGRAM


;	GOTO  STATEMENT LABEL OR SYMBOL CONTENTS

GOTO:	JUMPL	F,START4	;NO ARGUMENTS = START AT LAST GOTO
	PUSHJ	P,SYMIN		;GET USERS ARGUMENT
	  JRST	ERR6		;NONE SUCH
	  CAIA			;NUMERIC
	MOVE	T,(T)		;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:	HRRZ	T,STARTU	;GET START ADDRESS
	HRRZ	T1,STARTU	;SEE IF A START HAS BEEN DONE
	JUMPE	T1,ERR4		;NO, REFUSE STARTS AND GOTO'S

	MOVEM	T,GOLOC		;SET UP FOR EXTASK
;[170]	SETOI	T1,
	MOVE	T1,AC17		;[170]Get user P
	MOVSI	T,(POPJ P,)	;HAVE WE STOPPED AFTER A NEXT?
;[170]	CAMN	T,LEAV		;IF SO LEAV WILL BE A POPJ P,
;[170]	SUBM	T1,AC17		;SOBJN!!!!
	CAMN	T,@LEAV		;[170]Have we stopped after NEXT?
	 POP	T1,T		;[170]YES, POP the user return addr
	MOVEM	T1,AC17		;[170]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 (T)
	  JRST	ERR24		;NOT ALLOWED
	PUSHJ	P,RE.NTR	;ALLOW RE-ENTERS AGAIN
	MOVSI	T,(JFCL)	;RESET THE TRACE ENTRY
	MOVEM	T,FDDT.		;
	PUSHJ	P,EXTASK	;TRANSFER TO EXTERNAL TASK
;	OPEN

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

OPEN2:	MOVE	T3,PRGNAM	;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
	HRRZM	T,GOLOC		;SAVE ADDRESS
	JRST	EXTASK		;TRANSFER TO EXTERNAL TASK

MAPDDT:	MOVE	T,[.PAGCA,,700]	;[115] CHECK FOR PAGE 700
	PAGE.	T,		;[115] IS IT THERE?
	  JRST	ERR11		;[115] NO PAGE UUO, NO VMDDT
	TLNN	T,(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	T,['SYS   '	;[115] SET UP TO GET DDT
		   'VMDDT '
		    EXP 0,0,0,0]
	MERGE.	T,		;[115] GET IT
	  JRST	[MOVSI 17,MRGACS ;[115] CAN'T, TOUGH
		 BLT 17,17
		 JRST ERR11]
	MOVE	T,[775777,,700000] ;[122] SET .JBDDT
	SETDDT	T,		;[122]
	MOVSI	17,MRGACS	;[115] PUT ACS BACK
	BLT	17,17

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

IFN TOPS20,<

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

MAPDDT:	MOVEI	1,.FHSLF	;[114] GET ENTRY VECTOR LOC
	GEVEC%
	PUSH	P,2		;[114] SAVE SINCE GET WRECKS IT
	MOVX	1,GJ%SHT+GJ%OLD	;[114] SHORT FORM, FILE MUST EXIST
	HRROI	2,[ASCIZ /SYS:UDDT.EXE/] ;[114] DDT
	GTJFN%			;[114] FIND IT
	  ERJMP ERR11		;[114] NOT THERE, CAN'T HELP
	HRLI	1,.FHSLF	;[114] MAP INTO THIS FORK
	GET%			;[114] READ IN DDT
	  ERJMP	ERR11		;[114] CAN'T
	DMOVE	1,116		;[114] GET SYMBOL TABLE POINTERS
	MOVEM	1,@770001	;[114] STORE FOR DDT
	MOVEM	2,@770002
	POP	P,2		;[114] GET ENTRY VECTOR BACK
	MOVEI	1,.FHSLF	;[114] THIS FORK
	SEVEC%			;[114] RESTORE ENTRY VECTOR

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

>;[114] END IFN TOPS20

;	EXIT FUNCTION

EX.:	JUMPGE	F,EX.R		;IS THE USER REQUESTING A MONITOR RETURN
	HRRZ	T,STARTU	;NO - SEE IF A START HAS BEEN DONE
	JUMPN	T,.+2
	jrst	ex.a		;JUST A NORMAL EXIT
	MOVE	T,STARTU	;REMOVE START ADDRESS SO-
	HLLZM	T,STARTU	;NO CONTINUES OR RE-ENTERS
	SETZM	TEM		;SET UP ARG BLOCK
	SETZM	TEM1		;  TO EXIT FOROTS
	PUSHJ	P,INSRTB	;REPLACE PAUSES
	JSP	T,RESTORE	;RESTORE USERS ACS
	MOVEI	16,TEM		;GET EXIT ARGBLOCK
	PUSHJ	P,EXIT.##	;[143] DO A FOROTS EXIT

EX.R:	PUSHJ	P,TTYIN		;GET NEXT INPUT
	JUMPN	T2,BADSYN	;LOOKING FOR / - NOCHARACTERS ALLOWED
	JUMPE	T1,BADSYN	;BETTER BE /
	CAIE	T1,"/"
	JRST	BADSYN		;SORRY
	PUSHJ	P,TTYIN		;LOOK FOR RETURN
	JUMPN	T1,BADSYN	;NO MORE CHARACTERS ALLOWED
	JUMPE	T2,BADSYN	;NO CHARACTERS IN INPUT????
	LSHC	T1,6		;GET FIRST CHARACTER
	CAIE	T1,'  R'	;LOOK FOR 'RETURN' - IMPLIED BY R
	JRST	BADSYN		;WE DONT UNDERSTAND ANY OTHER CHARACTER
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

OVRLAY:	MOVE	T,.JBSYM	;GET THE SYMBOL TABLE PARAMETERS
	EXCH	T,JOBSYM	;SAVE NEW SYMBOL POINTERS
	JUMPE	T,OVRL4		;OLD VALUE COULD BE ZERO IF NOT INITED
	CAME	T,JOBSYM	;COMPARE WITH LAST KNOWN VALUE
	JRST	OVRL2		;SOMETHING CHANGED!!

OVRL4:	HRRZ	T,.JBSA		;GET THE START ADDRESS
	EXCH	T,JOBSA		;SAVE NEW - AND FIND OLD START ADDRESS
	JUMPE	T,CPOPJ		;EXIT IF OLD START NOT SET-UP
	CAMN	T,JOBSA		;HAS THIS CHANGED
	POPJ	P,		;ALL IS WELL

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

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

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

RE.ENT:	SKIPE	REENTR		;ARE WE ALREADY REENTERED?
	 JRST	ER.ENT		;YES. REPORT
	MOVEM	P,SAVLOC	;FREE UP A SPARE REG
	HRRZ	P,.JBOPC	;GET THE BREAK P.C.
	SKIPE	ESCAPE		;RE-ENTERS ALLOWED ONCE(SEE ER.ENT)
	JRST	RE.BRK		;DONT DESTROY USER PROFILE

	MOVE	P,SAVLOC	;RE-INSTATE THE OLD REG
	JSR	SAVE		;SAVE THE EXTERNAL PROG STATUS
	PUSHJ	P,REMOVB	;AND REMOVE THE PAUSES
	MOVE	T,.JBOPC	;GET THE PROG P.C.
	MOVEM	T,JOBOPC	;STORE AND FLAG THAT WE ARE HANDLING RE-ENTER
	MOVEM	T,JOBBRK	;SAVE THE JOB BREAK LOCATION
	HRRM	T,STARTU	;ALLOW CONTINUES TO WORK
	SETOM	REENTR		;SET FLAG THAT WE HAVE REENTERED
	SKIPE	PRGM		;HAS ANY SECTION BEEN OPENED
	JRST	RE.LOC		;YES

	PROGIF(MAIN.)		;NO - SO OPEN MAIN PROG
	  CAIA			;NO SECTION CALLED MAIN.
	PUSHJ	P,SETNAM	;OPEN MAIN PROG IF FOUND

;	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,tf
	hrrzi	tf,.priou
	cfobf%
	pop	p,tf	>
	TYPE([ Program suspended )
	HRRZ	T,JOBBRK	;SET UP THE ACTUAL SUSPEND POINT
	PUSHJ	P,WHERE		;TELL USER WHERE HE IS SUSSPENDED
	TYPE(Open section: )
	MOVE	T,OPENED	;WHAT IS THE CURRENTLY OPEN SECTION
	PUSHJ	P,SPT1		;TYPE THAT
	TYPE	( ])
	MOVE	F,STKYFL	;RESET THE FLAG REGISTER
	JRST	RET		;RETURN TO NORMAL WORKING

ER.ENT:	SETPDL			;RESET THE PDL
	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:	SETPDL			;RESTORE THE STACK
	HRRZ	T,STARTU	;HAS A START BEEN DONE
	JUMPE	T,RE.RET	;NO - JUST RETURN TO FORDDT USER MODE

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


;	ROUTINE TO DISPLAY WHERE THE PROGRAM IS SUSPENDED

WHERE:	SKIPN	.JBHRL		;SKIP IF WE HAVE A HIGH SEG.
	JRST	RE.L2

	CAMLE	T,.JBREL	;ARE WE SUSPENDED OVER THE LOW SEG.
	JRST	[TYPE(in high segment)
		JRST	RE.L2]
	TYPE(in low segment)
RE.L2:	TYPE( at )
	TLO	F,FGLSNM	;GLOBALS ARE OK
	PUSHJ	P,LOOK		;DO A SYSMBOL 'LOOK'-UP
	  JRST	E6		;
	  CAIA			;NOTHING TYPED
	JRST	RE.L3A		;FOUND AND TYPED
	MOVEM	T,TEM		;REMEMBER NEAREST REFERENCE
	PUSHJ	P,SPT		;TYPE THE SYMBOL
	TYPE( + )
	MOVE	T,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 )
	MOVE	T,PNAMSV	;GET THE SECTION NAME
	PUSHJ	P,SPT1		;DISPLAY THAT
RE.L3:	LINE			;
	POPJ	P,		;
;	PAUSE LOGIC

PAUSE:	JUMPL	F,PSEALL	;DISPLAY ALL PAUSES IF NO ARGUMENTS
	TRO	TF,FGLONL	;FIND GLOBAL SYMBOL ONLY
	PUSHJ	P,SYMIN		;GET THE NEXT SYMBOL IN SYM
	   JRST	ERR6		;NONE SUCH!
	   CAIA			;STATEMENT # FROM USER
	JRST	PAUS10		;SYMBOL - MEANS STOP AT ROUTINE

PAUS11:	HRRZM	T,TEM1		;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	T1,BADSYN	;DO WE HAVE A LEGAL DELIMITER
	JUMPE	T2,PAUS5	;[136] DID WE REALLY GET ANYTHING?
	CAMN	T2,[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	T2,[SIXBIT/AFTER/]	;FORCE USER TO TYPE WHOLE WORD
	JRST	PAUS4		;AFTER REQUESTED
	CAME	T2,[SIXBIT/IF/]	;WAS IT 'IF'?
	JRST	BADSYN		;ANYTHING ELSE MEANS TROUBLE
	TLZ	F,CONS		;CLEAR CONSTANT SEEN FLAG
	TRO	TF,LGCLEG	;[116] LET EITHER KNOW WE MAY GET LOGICALS
	PUSHJ	P,EITHER	;NUMBER OR SYMBOL SHOULD FOLLOW
	  PUSHJ	P,NUMB		;CONSTANT SEEN
	  MOVEM	T,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	TF,ISLOGI	;[116] IS IT A LOGICAL CONSTANT
	JRST	[SETZ	T,		;[116] YES, SET FLAG IN COND0
		TLO	T,LFTLOG	;[116]
		MOVEM	T,COND0		;[116]
		JRST	.+1]		;[116]
	JUMPN	T1,.+2		;DELIMITER?
	PUSHJ	P,GETSKB	;NEXT CHARACTER
	CAIE	T1,"."		;MUST BE . OF .EQ. ETC
	JRST	BADSYN
	PUSHJ	P,TTYIN		;GET SIXBIT STRING
	CAIE	T1,"."		;MUST AGAIN BE TERMINATED BY .
	JRST	BADSYN
	HLRZS	T2,T2		;MORE USEFUL IN RIGHT HALF
	CAIN	T2,'LT '
	JRST	TEST1
	CAIN	T2,'LE '
	JRST	TEST2
	CAIN	T2,'EQ '
	JRST	TEST3
	CAIN	T2,'NE '
	JRST	TEST4
	CAIN	T2,'GT '
	JRST	TEST5
	CAIN	T2,'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	TF,LGCLEG	;[116] LET EITHER KNOW LOGICALS ARE LEGAL
	PUSHJ	P,EITHER
	  PUSHJ	P,NUMB		;SAVE AS A NUMBER
	  MOVEM	T,COND2		;SAVE THE LOCATION
	TRZE	TF,ISLOGI	;[116] DID WE GET A LOGICAL CONSTANT?
	JRST	[SETZ	T,		;[116] YUP, SET COND0 FLAG
		TLO	T,RHTLOG	;[116]
		ORM	T,COND0		;[116]
		JRST	.+1]		;[116]
	MOVE	T,[JSR	COND]
	MOVEM	T,TEM		;FORM THE (CONDITIONAL TEST) LOCATION LINK
PAUS5:	SKIPA	T,[Z 1]		;PROCEDE COUNT=1
PAUS4:	PUSHJ	P,EITHER	;GET USERS PROCEDE COUNT IN T
	   CAIA			;CONSTANT GIVEN
	   MOVE T,(T)		;SYMBOL - GET CONTENTS
	JUMPL	T,BADSYN	;DO NOT ALLOW NEGATIVE PROCEDE COUNTS
	EXCH	T,TEM1		;GET BACK BREAKPOINT ADDRESS
	SKIPL	TERMK		;WAS THAT ALL
	JRST	PAUS6		; YES

	MOVEM	T,SAVLOC	;SAVE PAUSE ADDRESS TEPORARILY
	PUSHJ	P,TTYIN		;GET SIXBIT USER INPUT
	JUMPN	T1,BADSYN
	MOVE	T,SAVLOC	;[136] RESTORE PAUSE ADDR., IN CASE WE'RE DONE
	JUMPE	T2,PAUS6	;[136] WAS THERE REALLY ANYTHING THERE?
	CAME	T2,[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	T,PAUS3		;ASSUME ZERO MEANS NO INPUT

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

PAUS3:	CAIL	T,1		;MAKE SURE HE GETS
	CAILE	T,GPMAX		;  ONLY A VALID GROUP #
	JRST	ERR15		;COMPLAIN ABOUT GROUP #
	HRL	T,T		;SET UP FOR AUTO TYPE
	HRR	T,SAVLOC	;GET BACK PAUSE ADDRESS
	TLO	F,AUTO		;SET THE AUTO PROCEDE FLAG

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

PAUS10:	MOVE	T1,@SYMSAV	;GET SYMBOL
	TLNE	T1,700000	;IS THIS A PROGRAM NAME OR GLOBAL
	JRST	ERR19		;NO SO DONT ALLOW

	SKIPE	SUBSCR		;NOR MUST THERE BE AN OFFSET
	JRST	ERR19
	MOVE	T1,1(T)		;DOES THIS ROUTINE INVOKE THE 'HELLO' MACRO?
	CAMN	T1,HELLO	;YES IT DOES - STOP 2 ON
	ADDI	T,2		;
	JRST	PAUS11

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	F,CONS			;SET CONSTANT SEEN FLAG IF NOT ALREADY SET
	JRST	ERR14
	MOVEM	T,COND3		;SAVE VALUE OF CONSTANT
	MOVEI	T,COND3		;SAVE ADDRESS OF CONSTANT
	POPJ	P,


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

ONFORM:	LDB	W1,[POINT 7,(T),6]	;
	CAIN	W1,"("		;TRUE IF FIRST CHAR IS AN OPEN PAREN
	POPJ	P,
	JRST	CPOPJ1		;FOUND A FORMAT STATEMENT REFFERENCE
;	CONTINUE LOGIC


CONTIN:	MOVSI	T,(JFCL)	;RESET THE TRACE ENTRY
	MOVEM	T,FDDT.		;
	HRRZ	T,STARTU	;HAS START BEEN SEEN
	JUMPE	T,ERR4		;NO - PLEASE TYPE START
	SKIPE	T,JOBOPC	;ARE WE IN A RE-ENTER CONDITION
	JRST	CONT2		;YES - DEAL WITH IT

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

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

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

;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	AC1,[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,AC0		;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	AC1,^D264	;ALLOCATE ENOUGH FOR TWO 128 WORD BUFFERS
	MOVEM	AC1,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	AC0		;A POSITIVE VALUE?
	JRST	ALCFAL		;NO, ALLOCATION FAILED
	MOVEM	AC0,ALCBLK+1	;SAVE ADDR FOR DECOR

;Set up the buffer header blocks.

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

;Try to find the help file.

	SETZB	AC2,AC5		;SET UP A COUNTER AND ZERO AC2

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

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

	MOVE	AC1,[SIXBIT/FORDDT/] ;FILE NAME
	MOVSI	AC2,'HLP'	;EXTENSION
	SETZB	AC3,AC4		;ZERO NEXT TWO
	LOOKUP	DSK,AC1		;LOOKUP FORDDT.HLP
	  TLZA	AC2,-1		;CLEAR JUNK, WE BLEW IT
	JRST	NXTBUF		;GOOD--GO READ FILE
	CAIE	AC2,ERSNF%	;SFD NOT FOUND?
	CAIN	AC2,ERSLE%	;SEARCH LIST EMPTY?
	JRST	NXTSTR		;ONE OF THE ABOVE
	CAILE	AC2,ERIPP%	;INCORRECT PPN OR FILE NOT FOUND?
	JRST	HLPNHF		;HORRIBLE DISK ERROR
NXTSTR:	SETZM	AC2		;CLEAR PHYSICAL BIT
	AOS	AC5		;TRY NEXT CASE
	TRNE	AC5,1		;SEE IF ODD
	TXO	AC2,UU.PHS	;YES--TRY PHYSICAL ONLY
	JRST	@[GETHLP	;TRY HLP: AGAIN
		  GETSYS	;THEN LOGICAL SYS:
		  GETSYS	;THEN PHYSICAL SYS:
		  HLPNHF]-1(AC5) ;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	AC1,HLPCTB+1	;POINT TO 1ST DATA LOC IN BUFFER
	AOS	AC1		;         ''
	OUTSTR	@AC1		;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,AC0		;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,AC0		;SAVE THE FLAGS

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

	MOVEI	AC1,^D128	;ALLOCATE ONE BLOCK FOR THE FILE
	MOVEM	AC1,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	AC0		;A POSITIVE VALUE?
	JRST	ALCFAL		;NO, ALLOCATION FAILED
	MOVEM	AC0,ALCBLK+1	;SAVE ADDR FOR DECOR

	MOVEI	AC3,4		;NUMBER OF ATTEMPTS AT FINDING FILE
GETHLP:	MOVE	AC4,[POINT 7,[ASCIZ/HLP:/]] ;GET THE HLP: POINTER
	MOVEM	AC4,GTJBLK+2	;PUT IT IN THE GTJFN BLOCK
	JRST	GETIT
GETSYS:	MOVE	AC4,[POINT 7,[ASCIZ/SYS:/]] ;GET THE SYS: POINTER
	MOVEM	AC4,GTJBLK+2	;PUT IT IN THE GTJFN BLOCK
GETIT:	HRROI	AC2,FILENM	;GET POINTER TO 'FORDDT'
	MOVEI	AC1,GTJBLK	;LONG FORM GTJFN BLOCK
	GTJFN%			;GET FORDDT.HLP
	  JRST	NXTSTR		;LOSE TEMPORARILY
	HRRM	AC1,JFN		;SAVE THE JFN
	MOVE	AC2,[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	AC1,JFN		;GET JFN
	HRROI	AC2,@ALCBLK+1	;POINTER FOR TEXT BUFFER
	MOVEI	AC3,^D639	;HELP TEXT BUFFER SIZE IN CHARS (128*5-1)
	SIN%			;FILL THE BUFFER
	  ERJMP	HLPDON		;DON'T CARE ABOUT THIS ERROR
	SETZ	AC1,		;NEED A ZERO BYTE
	IDPB	AC1,AC2		;MAKE SURE ZERO THE LAST BYTE
	HRROI	AC1,@ALCBLK+1	;POINT TO BUFFER
	PSOUT%			;OUTPUT ASCIZ STRING
	JRST	PRINT		;IF THERE'S MORE, GO GET IT

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

HLPDON:	SETZ	AC1,		;NEED A ZERO BYTE
	IDPB	AC1,AC2		;MAKE SURE ZERO THE LAST BYTE
	HRROI	AC1,@ALCBLK+1	;POINT TO BUFFER
	PSOUT%			;OUTPUT ASCIZ STRING
	HRROI	AC1,CRLF	;OUTPUT CRLF
	PSOUT%
	MOVE	AC1,JFN
	CLOSF%			;GET RID OF THE JFN
	  JFCL			;NOT LIKELY
	JRST	HLPRET		;AND RETURN

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

HLPRET:	MOVEI	L,ALCBLK	;NEED TO DEALLOCATE BUFFER SPACE
	PUSHJ	P,DECOR.##	;DO IT
	POP	P,AC0		;RESTORE FLAGS
	JRST	RET		;ALL DONE

ALCFAL:	HRROI	AC1,[ASCIZ/%FDTCAB Cannot allocate buffer for help file/]
	PSOUT%
	HRROI	AC1,CRLF
	PSOUT%
	POP	P,AC0		;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
	>			;end IFN TOPS20 (internal -20 help code)

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

	>			;end IFE EXTHLP (internal help code)

;	REMOVE LOGIC

RESET:	JUMPL	F,RESET5	;'RESET' - RESET ALL PAUSES
	TRO	TF,FGLONL	;FIND GLOBAL ONLY IF NOT LABEL
	PUSHJ	P,SYMIN		; NO - MUST BE ANOTHER SYMBOL TO FOLLOW
	  JRST	ERR6		;SOME ONE SLIPPED UP
	  JFCL			;STATEMENT #
RESET6:	MOVEI	R,B1ADR		;LOOK THRO PAUSE POINTS FOR THE RIGHT ONE
RESET3:	HRRZ	W,(R)		;GET THE PAUSE CONTENTS
	CAIN	W,(T)		;IS THIS IT?
	JRST	RESET2		; YES - REMOVE IT!

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

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

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

RESET5:	CAME	T2,[SIXBIT/REMOVE/] ;DO NOT ALLOW ABREVIATIONS OF REMOVE
	JRST	BADSYN		;THIS ANNOYS MANY USERS
	PJRST	BPS		;RESET ALL PAUSES
;	ACCEPT LOGIC	= ACCEPT NAME/X #

ACCEPT:	JUMPL	F,BADSYN	;ACCEPT ALONE IS MEANINGLESS!
	SETZM	ARGVAL+1	;CLEAR IN CASE LONG INPUT
	SKIPN	ESCAPE		;ESCAPE TO FOROTS?
	JRST	ERR30		;SORRY
	TRO	TF,ACCPT	;ACCEPT IN PROGRESS
	PUSHJ	P,SYMIN		;GET USERS SYMBOL
	  JRST	ERR6		;SORRY - WE DONT HAVE IT!
	  JRST	ACC2		;STATEMENT # = FORMAT
	MOVEM	T,TEM2		;STORE FOR UPDATE
;[157]***For character, T/TEM2=descriptor of array base=SAVLOC
	TRNE	TF,IMPRNG	;IS THIS AN IMPLIED RANGE?
	PUSHJ	P,DISP14	;YES SETUP RANLIM/RANGE IN CASE OF A RANGE
	PUSHJ	P,EVAL		;SETUP SYMSAV TO POINT TO RAD50 SYMBOL
	 JFCL			;CAN'T HAPPEN!!?
	MOVE	T,SYMSAV	;GET THE SYMBOL POINTER
	HLRZ	T,(T)		;GET RADIX 50 FORM AND FLAGS
	TRNN	T,LOCAL		;ALLOW ONLY LOCAL VARIABLS TO CHANGE
	JRST	ERR24		;YOU LOOSE
	MOVE	T1,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	T1,ACCF		;SPACE DELIMITER ASSUMES REAL TO FOLLOW
	CAIN	T1,"="		;ALLOW = AS DELIMITER
	JRST	ACCF
	CAIN	T1,"-"		;A - MEANS A RANGE OF VALUES TO SET
	JRST	ACC23		;
	CAIE	T1,"/"		; WE EXPECT ONLY / FROM NOW ON
	JRST	BADSYN		;ANYTHING ELSE LOOSES
ACC22:	PUSHJ	P,TTYIN		;READ ARGUMENT TYPE REQUIRED BY USER
	JUMPE	T2,BADSYN	;NO CHARACTERS - BAD
	LDB	T,[POINT 6,T2,5];GET 1ST. CHARACTER TO IDENTIFT ARG TYPE
	CAIN	T,'B'		;[120] BIG SWITCH ?
	TLOA	TMOD,B.		;[120] YES - SET IT AND LOOK FOR ANOTHER SWITCH
	MOVEM	T,TEM		;[120] NOT 'BIG', SAVE SWITCH IN CASE B FOLLOWS
	JUMPE	T1,ACC21	;NOTHING FOLLOWS
	CAIN	T1,"="		; ALLOW = AS DELIMITER
	JRST	ACC21		;PROCESS FORMAT
	CAIE	T1,"/"		;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:	MOVE	T,TEM		;GET THE CURRENT FORMAT REQUEST
	SKIPE	RANGE		;[156]looking for a range?
	 JRST	ACC21A		;[156]YES
	SETZM	CLMRNG		;[163]In case character
	JRST	ACC21B		;[163]Go get input
ACC21A:	TLNE	TMOD,B.		;[156]/BIG?
	 TLNN	F,DOUBLE	;[156]and double precision?
	  JRST	ACC21B		;[156]NO
	CAIE	T,'A'		;[156]ASCII?
	 CAIN	T,'R'		;[156]or RASCII?
	  AOS	RANGE		;[156]YES. Don't lose second word

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

;	ACCEPT A RANGE PROCESSING	= ACCEPT NAME(X)-

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

ACCF:	TLO	TMOD,F.		;DISPLAY TO USER AS FLOATING
	MOVEI	T2,4		;ARG TYPE REAL FOR FOROTS
	PUSHJ	P,FORINP	;YES - ASK FOROTS FOR INPUT

;	HERE TO PLACE ALL ACCEPTED VALUES

ACC10:	MOVE	T,ARGVAL	;LETS SEE WHAT FOROTS HAS BEEN UP TO
ACC13:	EXCH	T,TEM2		;[163]Save input value
	PUSHJ	P,CKWRIT	;[163]Validity check
	EXCH	T,TEM2		;[163]Regain value	
	MOVEM	T,@TEM2		;PLACE VALUE WHERE USER REQUESTED
	MOVEM	T,ARGVAL	;SOME PRINT OPTIONS NEED THIS
	AOS	T1,TEM2		;NEXT ARRAY LOCATION
	TLNN	TMOD,X.!B.!D.	;[120] [157]IF EITHER COMPLEX REAL*8 OR BIG OR -
	TRNE	F,DOUBLE	;[112] WE HAVE A DOUBLE WORD ARRAY?
	CAIA			;THEN WE PLACE TWO ARGUMENTS
	JRST	ACC14		;IF NOT THEN CHECK THE RANGE CONDITION
	TRO	F,SILENT	;QUIET
	PUSH	P,MATHSM	;SAVE CURRENT SYMBOL
	MOVE	T,[SQUOZE 0,.VEND]	;END OF VARIABLE AREA
	MOVEM	T,MATHSM	;ONLY ACCEPTABLE SYMBOL
	MOVE	T,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
	  CAIA			;OFFSET - OK
;	 JRST	ACC37		;  NONE - OK
;	 JRST	ACC37		;  OFFSET - OK
;	MOVE	T,(W1)		;GET SYMBOL
;	TLZ	T,PNAME		;NO BITS
;	CAMN	T,[SQUOZE 0,.VEND]	;END OF VARIABLE AREA?
	JRST	ERR35		;YES - ERROR

;ACC37:	
	POP	P,T
	MOVEM	T,MATHSM	;RESTORE CURRENT SYMBOL
	MOVE	T,ARGVAL+1	;GET THE 2ND WORD
	MOVEM	T,@TEM2		; - AND PLACE IN NEXT LOCATION
	AOS	T1,TEM2		;YES - SO NEXT DOUBLE WORD
ACC14:	SKIPN	RANGE		;ACCEPT A RANGE ?
	JRST	ACCPUT		;NO - UNLESS IMPLIED
	TLNE	TMOD,A.		;SPECIAL TREATMENT FOR ASCII ARRAYS
	JRST	[CAMG	T1,RANGE	;END OF ARRAY?
		 JRST	ACC12		;GET SOME MORE
		 JRST	RET	]	;QUIT
	CAMG	T1,RANGE	;ALL DONE ?
	JRST	ACC10		;NO - KEEP GOING
	JRST	RET		;ALL OVER

;	VARIABLE 'ACCEPT'ED - NOW CONFIRM TO USER

ACCPUT:	SOS	T,TEM2		;REMOVE OFFSET FROM ACC13
ACPUT1:	SETZM	TERMK		;PREPARE FOR -
	SETZM	RANGE		;  INPUT CONFIRMATION
	TRZN	F,DOUBLE	;CHECK FOR ANY -
	TLNE	TMOD,X.!B.!D.	;[120] [157] DOUBLE WORD WORKING
	SOS	T,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:	TLO	TMOD,D.		;DISPLAY TO USER AS REAL*8
	MOVEI	T2,TP%DPR	;[137]Set up for default D-float arg type=10
	TRNE	F,GFLOAT	;[137]If D-float, skip to FOROTS call.
	MOVEI	T2,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:	TLO	TMOD,I.		;DISPLAY TO USER AS INTEGER
	MOVEI	T2,2		;GET ARG TYPE INTEGER FOR FOROTS
	PUSHJ	P,FORINP	;GO TO FOROTS
	JRST	ACC10		;PLACE ARG FOR USER

;	*** COMPLEX INPUT ***

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

;	*** SYMBOLIC INPUT ***

ACCS:	TLNE	TMOD,B.		;[120] IF 'BIG' SET THEN
	TLOA	TMOD,X.		;[157]DISPLAY TO USER AS TWO REAL*4
	TLO	TMOD,F.		;ELSE DISPLAY JUST ONE REAL*4
	PUSH	P,MATHSM	;SAVE MATHSM
	PUSH	P,SAVLOC	;SAVE SAVLOC AROUND CALL
	PUSHJ	P,SYMIN		;GET A USER SYMBOL
	  JRST	ERR6		;CAN'T FIND IT!
	  JRST	BADSYN		;DONT GIVE ME STATEMENT #
	POP	P,SAVLOC	;RESTORE SAVLOC
	POP	P,MATHSM	;RESTORE
	MOVE	T1,(T)		;I'LL ACCEPT THAT ONE
	MOVEM	T1,ARGVAL	;SAVE THE FIRST WORD VALUE
	TLNN	TMOD,B.		;[120] DOUBLE WORD WORKING?
	JRST	ACC10		;NO JUST PLACE SINGLE VALUE
	MOVE	T,1(T)		;GET SECOND VALUE
	MOVEM	T,ARGVAL+1	;STORE THAT
	JRST	ACC10		;   AND EVEN STORE IT
;	*** ASCII INPUT RIGHT JUSTIFIED ***

RASCII:	TLO	TMOD,R.		;DISPLAY TO USER AS RASCII
	JRST	ACC1		;DO ASCII INPUT TO T


;[120]	** LOGICAL INPUT **

ACCL:	TLO	TMOD,L.		;[120] DISPLAY TO USER AS LOGICAL
	MOVE	T1,[POPJ P,]	;[120] HOW WE WANT TO RETURN FROM LOGICL
	MOVEM	T1,DONE		;[120]
	TRO	TF,LGCLEG	;[120] LET 'EM WE'RE EXPECTING A LOGICAL
	PUSHJ	P,GETSKB	;[120] GET NEXT CHAR.
	CAIE	T1,"."		;[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:	TLO	TMOD,A.		;DISPLAY TO USER AS ASCII
	MOVE	T,[ASCII .     .]	;BLANK SECOND WORD FOR POSSIBLE
	MOVEM	T,ARGVAL+1		;LONG OR DOUBLE
	SKIPN	RANGE		;[120] IGNORE /BIG IF ACCEPTING LONG ASCII
	JRST	ACC1		;OK IF NOT A RANGE
	TLZ	TMOD,B.		;[120] CLEAR /B FLAG
	TRZ	F,DOUBLE	;CLEAR DOUBLE
ACC1:	PUSHJ	P,GETSKB	;GETA SIGNIFICANT USER CHARACTER
	SKIPL	TERMK		;EOL?
	JRST	BADSYN		;YES - SYNTAX ERROR
	MOVEI	T5,(T1)		;SAVE IN T2
ACC12:	SETZM	ARGVAL		;CLEAR FOR DOUBLE LENGTH ASCII
	TRZE	TF,ADELIM	; IF SET WE CLEAR THE REST OF THE ARRAY
	JRST	ACCA2		;
ACC24:	MOVE	T,[ASCII .     .]	;T BUILDS ASCII INPUT
	TLNE	TMOD,R.		;BUILD WITH ZERO IF RASCII
	SETZI	T,
	MOVE	T6,[POINT 7,T]	;STORES BYTES IN T
ACC15:	pushj	p,loadch	;NEXT ASCII CHARACTER
	CAIN	T1,(T5)		;TEXT DELIMITER FOUND?
	JRST	ACC18		;YES - CHECK FOR A SECOND
	TRZE	TF,ADELIM	;WAS THE LAST CHARACTER OUR DELIMITER
	JRST	[PUSH P,T1		;YES
		 MOVE T1,[pushj p,loadch];FOR GETSKB
		 MOVEM	T1,GETCHR
		 POP	P,T1
		 PUSHJ	P,GETSK2	;CHECK FOR COMMENT
		 PUSHJ P,CLRLIN	; WIND UP
		 JRST	ACC17]
ACC19:	IDPB	T1,T6		;SAVE USERS TEXT
	TLNE	T6,760000	;FILLED T?
	JRST	ACC15		;NO - TAKE MORE

	CAIA			;DONT CONFUSE THE INDEFINATE ACCEPT
ACC17:	TRO	TF,ADELIM	;SET TO CLEAR REST OF ARRAY IF IN A RANGE
	TRNE	F,DOUBLE	;TEST FOR ANY DOUBLE WORD -
	JRST	ACC2WD		;  WORKING -
	TLNN	TMOD,B.		;[120] IMPLIED BY REAL*8 OR B.
	JRST	ACC20		;STORE FINAL SINGLE VALUE IN T
;	DOUBLE WORD WORKING

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

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

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


;	FINISHED TEXT INPUT

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

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

ACCC:				;[157]
	TLO	TMOD,C.		;[157]Display to user properly
	PUSHJ	P,GETSKB	;[157]Look for quote
	SKIPL	TERMK		;[157]EOL?
	 JRST	BADSYN		;[157]YES. Syntax error
ACCC1:	CAIE	T1,"'"		;[157]Single quote?
	 JRST	[TYPE (<%Character string must begin with single quote>)
		JRST	RET]	;[157]Try again
	DMOVE	T1,@SAVLOC	;[157]Get descriptor
	MOVE	T3,T2		;[163]Save length for descriptor check & loop
	IMUL	T2,CLMOFF	;[157]Compute for ADJBP
	ADJBP	T2,T1		;[157]Get BP to element
	MOVEM	T2,ORIGLM	;[157]Save starting address
	MOVEI	T,T2		;[163]T=location of descriptor to validate
	PUSHJ	P,CKBPTR	;[163]Validate descriptor; return if OK
	MOVE	T,T2		;[163]T=address to validate
	PUSHJ	P,CKWRIT	;[163]Check destination; return if OK
INSTRL:	PUSHJ	P,LOADCH	;[157]Get next character
	CAIE	T1,"'"		;[157]Quote?
	 JRST	PUTBYT		;[157]NO. Store it.
	PUSHJ	P,LOADCH	;[157]YES. see if there is another
	CAIN	T1,"'"		;[157]Another quote?
	 JRST	PUTBYT		;[157]YES. Store one only!
	DMOVEM	T2,TEM4		;[157]Save pointer & count
	MOVE	T4,[PUSHJ P,LOADCH]	;[157]for GETSKB
	MOVEM	T4,GETCHR	;[157]Tell GETCHR how to get input
	PUSHJ	P,GETSK1	;[157]Check for comment
	PUSHJ	P,CLRLIN	;[157]Clear extraneous input
	DMOVE	T2,TEM4		;[157]Restore pointer & count
	 JRST	ENDSTR		;[157]End of this string


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

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

ENDSTR:	MOVEI	T4," "		;[157]Fill character
FILSTR:	SOJL	T3,NDSTR1	;[157]Jump if string full
	IDPB	T4,T2		;[157]Store a space
	JRST	FILSTR		;[157]Loop till full
NDSTR1:	MOVE	T3,CLMRNG	;[157]Relative location of last element
	SUB	T3,CLMOFF	;[157]Elements to fill
	JUMPLE	T3,ENDCK	;[157]NONE.....
	MOVE	T4,SAVLOC	;[157]Addr/descriptor
	MOVE	T4,1(T4)	;[157]Get count
	IMULI	T4,(T3)		;[157]Total bytes to move
	MOVE	T3,ORIGLM	;[157]Get source addr
RNGLUP:	ILDB	T5,T3		;[157]Load byte
	IDPB	T5,T2		;[157]Store it
	SOJG	T4,RNGLUP	;[157]
ENDCK:	MOVE T4,[pushj p,loadch];FOR GETSKB
	MOVEM	T4,GETCHR
	PUSHJ	P,GETSK1	;[157]CHECK FOR COMMENT
	SKIPL	TERMK		;[157]Line terminator?
	 JRST	ENDCK2		;[157]YES. Go check for range
	PUSHJ	P,CLRLIN	;[157]Show user error
	JRST	RET		;[157] and return
ENDCK2:	MOVE	T,SAVLOC	;[157]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:	TLO	TMOD,O.		;DISPLAY TO USER AS OCTAL
	SETZI	T,		;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	W1,W2		;CLEAR BUILD AREA
	MOVEI	T,^D12		;INITIALIZE COUNT
	TLNE	TMOD,B.		;[120] CHECK BIG
	MOVEI	T,^D24		;[120] DOUBLE IT FOR BIG
	CAIA

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

ACC16:	SUBI	T1,60		;OCTALISE
	JUMPL	T1,ERR2		;CHARACTER MUST OF COURSE -
	CAIL	T1,10		;   BE OCTAL
	JRST	ERR2		;NOT OCTAL - COMPLAIN
	LSHC	W1,3		;BUILD OCTAL VALUE IN T
	IOR	W2,T1		;
	SOJE	T,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:	TLNN	TMOD,B.		;[120] BIG WORKING?
	JRST	ACC30		;AS YOU WERE - STORE OCTAL
	MOVEM	W1,ARGVAL	;STORE LONG OCTAL
	MOVEM	W2,ARGVAL+1
	JRST	ACC32
ACC30:	MOVEM	W2,ARGVAL	;STORE SINGLE OCTAL

;	HERE AT END OF INPUT

ACC32:	PUSHJ	P,CLRLIN	;CLEAR THE LINE
	TLZN	F,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:	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	W1,T3		;FORMAT START
	MOVE	W2,T1		;FORMAT END

;	HERE WITH A RECOGNISED FORMAT REFFERENCE SET UP


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

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

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

ACC5:	pushj	p,loadch	;ACCEPT ANOTHER USER CHARACTER
	CAIN	T1,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
	SETZM	CURGRP		;CLEAR CURRENT GROUP STACK FLAGS
	TRO	TF,TYPCMD	;[171] Remember it's a TYPE command
	TLO	F,CFLIU!GRPFL	;SET CORE FILE IN USE - ALLOW GROUPS
	CLEARM	GETCHR		;THIS IS THE FIRST ACCESS TO CORE FILE THIS LINE
	TLNE	F,EOL		;USER GAVE ANY ARGUMENTS?
	TLOA	F,OFCFL		;NO - GET THEM FROM CORE FILE
	TLZ	F,OFCFL		;YES - PUT THEM INTO CORE FILE
	PUSHJ	P,DISP4		;DISPLAY ROUTINE
	TLZ	F,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]
	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	T2,[POINT 7,(T3)]
	MOVEI	W1,SYM		;SET UP FOR SYMBOL PRINT
	PUSHJ	P,SPT		;PRINT SYMBOL=STATEMENT #
	TYPE(	FORMAT)
DISP6:	ILDB	T,T2		;GET A CHARACTER FROM THE FORMAT TEXT
	HRRM	T2,.+1		;GET NO OF WORDS DONE
	CAIG	T1,(T3)		;ALL DONE?
	JRST	DISP5		;DONE WITH FORMAT
	putchr	(T)		;TYPE IT
	JRST	DISP6		;MORE TO DO - BACK FOR MORE
;	SET UP ACCESS TO A FORMAT STATEMENT  T3=START  T1=END
;	SKIP ON SUCCESS.

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

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

;	IMPLIED RANGE   I.E. TYPE ARRAY

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

DISP11:	PUSHJ	P,DISP14	;SET UP RANGE WITH UPPER LIMIT
	TLOA	F,GRPFL		;PERMIT GROUP LOGIC AGAIN
DISP0:	HRL	TMOD,TMOD	;UNFUDDLES THE MODIFIERS FOR A RANGE


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

DISP10:

	MOVEM	T,LWT		;SAVE SYMBOL VALUE
	MOVE	T,(T)		;GET CONTENTS OF SYMBOLIC ADDRESS
	EXCH	T,LWT		;SAVE CONTENTS AND GET SYMBOL VALUE
				;SAVE SYMBOL VALUE IN CASE WE DO A RANGE
	MOVEM	T,RANLIM	;SAVE FOR RANGE NAME ID SUPRESSION
	TLNE	TMOD,-1		;[173]ANY LOCAL MODIFIERS?
	MOVS	TMOD,TMOD	;[173]YES - USE THEM
	TRO	TMOD,ANYMOD	;[173]FLAG FIRST PRINT ON LINE
	PUSHJ	P,OFFSET	;TYPE USERS SYMBOL
	 JRST	DISP9
	SETZM	FRMSAV		;[167]Reset formal
	EXCH	T,SYM		;GET BACK SYMBOL CONTENTS
;[173]	TLNE	TMOD,-1		;ANY LOCAL MODIFIERS?
;[173]	MOVS	TMOD,TMOD	;YES - USE THEM
;[173]	TRO	TMOD,ANYMOD	;FLAG FIRST PRINT ON LINE

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

;	*** TYPE CHARACTER ***
	DMOVE	T1,@SAVLOC	;[157]Load ptr & length
	MOVE	T3,T2		;[163]Save string length
	IMUL	T3,CLMOFF	;[157]Compute for ADJBP
	JUMPE	T3,CHKPTR	;[157]All set up if first element(CLMOFF=0)
	ADJBP	T3,T1		;[157]Create BP to element
	MOVE	T1,T3		;[157]Get the adjusted pointer
CHKPTR:	MOVEI	T,T1		;[163]T=Location of descriptor to validate
	PUSHJ	P,CKBPTR	;[163]Validate; return if OK
	MOVE	T,T1		;[163]T=address to validate
	PUSHJ	P,CKREAD	;[163]Validate;return if OK
CKBIG:	TRNE	TMOD,B.		;[157]Display whole string?
	 JRST	TYPEC		;[157]YES. skip size check
	CAILE	T2,^D256	;[157]Large string?
;***	flag
	 MOVEI	T2,^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	T1		;[163]Destination address
	MOVE	T,T1		;[163]T=location of address to validate
	LDB	T3,[POINT 6,T1,05] ;[163]Get byte position within word
	CAIN	T3,BYT2T5	;[163]First byte in this word?
	PUSHJ	P,CKREAD	;[163]YES. Validate source; return here if OK
	LDB	T,T1		;[163]Store byte
	CAIN	T,"'"		;[157]Single quote?
	 PUSHJ	P,ASCOUT	;[157]YES. double it
	PUSHJ	P,ASCOUT	;[157]Display it
	SOJG	T2,BYTLUP	;[157]Loop til thru
	TYPE	(')		;[157]Concluding quote
	POPJ	P,
;***	check for truncated string?

;	*** TYPE FLOATING ***

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

;	*** TYPE DOUBLE REAL ***

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

;	*** TYPE COMPLEX ***

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

;	** TYPE INTEGER ***

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

;	*** TYPE OCTAL ***

TYPO:	TRNN	TMOD,O.		;TYPE AS OCTAL?
	JRST	TYPA		;NO - TRY ASCII
	JUSTIFY
	MOVEI	ODF,10		;PREPARE FOR OCTAL PRINT
	PUSHJ	P,FTOC		;PRINT IN OCTAL
	TRNN	TMOD,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	TMOD,A.		;TYPE AS ASCII?
	JRST	TYPR		;NO - SEE IF RIGH JUSTIFIED ASCII
	JUSTIFY
	PUSHJ	P,TXT341	;THROW UP ASCII
	TRNN	TMOD,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	TMOD,R.		;TYPE AS ASCII RIGHT JUSTIFY
	JRST	TYPL		;[120] NO - TRY OCTAL
	JUSTIFY
	TYPE(R)			;RASCII IDENTIFIER
	LSH	T,1		;MAKE LEFT JUSTIFIED ASCII
	PUSHJ	P,TXT341	;TYPE AS USUAL
	TRNN	TMOD,B.		;[120] DOUBLE RASCII?
	JRST	TYPL		;[120] NO
	PUSHJ	P,VAL2		;GET NEXT VALUE
	LSH	T,1		;FAKE ASCII
	PUSHJ	P,TXT341	;TYPE AS ASCII

TYPL:	TRNN	TMOD,L.		;[120] TYPE AS LOGICAL?
	JRST	TYPS		;[120] NO - SEE IF IN RANGE
	JUSTIFY			;[120]
	JUMPGE	T,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	TMOD,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	TMOD,C.		;[157]Character string?
	 JRST	TYPC		;[157]YES.
	AOS	T,RANLIM	; YES INCREMENT VARIABLE
	TRNE	F,DOUBLE	;[112] IS THIS A DOUBLE WORD ARRAY RANGE
	AOS	T,RANLIM	;DOUBLE WORD ARRAYS GO UP BY TWO
	CAMG	T,RANGE		;TO LIMIT OF RANGE
	 JRST	DISP0		;AND TYPE ALL REQUIRED
	JRST	DISP5		;[157]DONE. Go clean up
TYPC:	MOVE	T,RANLIM	;[157]Restore base
	AOS	T1,CLMOFF	;[157]Count this element
	CAMG	T1,CLMRNG	;[157]Was that the last?
	 JRST	DISP0		;[157]NO. Go type next element

DISP5:	TLNE	TMOD,-1		;LOCAL MODIFIERS?
	HLRZ	TMOD,TMOD	;YES - REMOVE THEM
	SKIPGE	TERMK		;END OF USER INPUT LINE YET?
	JRST	DISP4		; NO - KEEP GOING
	POPJ	P,		; YES - END OF TYPE COMMAND

JUSTFY:	TRZN	TMOD,ANYMOD	;SEE IF FIRST OUTPUT THIS VARIABLE
	jrst	[LINE
		jrst	.+1]
	TYPE(	=  )
	MOVE	T,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	T,RANGE		;REMEMBER START OF RANGE

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

	CAML	T,RANGE		;SORT OUT SYMBOL ORDER
	EXCH	T,RANGE		;CHANGE THEIR ORDER
	CAIN	T1,"-"		;"-" IS A DELIMITER BUT IS BAD HERE
	JRST	BADSYN
	TLO	F,GRPFL		;O.K. FOR GROUPS AGAIN
;[170]	TLNN	TMOD,C.		;[157]Character?
	TRNN	TMOD,C.		;[170]character?
	 JRST	DISP10		;NOW TYPE RANGE
;	clmrng=first offset given
;	clmoff=offset just received
	MOVE	T1,CLMOFF	;[157]Get the lower offset
	CAMLE	T1,CLMRNG	;[157]Is lower .le. upper?
	 EXCH	T1,CLMRNG	;[157]NO. Make it so
	MOVEM	T1,CLMOFF	;[157]Restore lower offset
	JRST	DISP10		;[157]Go type for the user
SYM4:	TLNE	F,GRPFL		;ARE WE ALLOWING CORE STRINGS
	CAIE	T1,"/"		;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
	SKIPL	TERMK		;EOL?
	JRST	BADSYN		;CAN'T HAVE THAT!
	PJRST	SYMIN		;RESUME SYMIN ACTIVITIES

;	HANDLE GROUP REQUESTS

SYM14:	CAIL	T,1
	CAILE	T,GPMAX		;WHICH MUST BE IN RANGE
	JRST	ERR15		;NO GOOD
	CAIE	T1,","		;ALLOW COMMA AS DELIMITER
	JUMPN	T1,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	F,GRPFL		;IS GROUP LOGIC IN ACTION
	JRST	RET		;ASSUME NUL INPUT GO BACK TO USER

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


;	ROUTINE TO DETERMINE THE LENGTH OF AN IMPLIED RANGE

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

SYM5:	TRZE	TF,DCOPFG	;DON'T OPEN PROG?
	JRST	SYM16		;NO - DON'T
	SKIPN	T3,GRP2(T)	;GET GROUP'S PROG
	JRST	SYM16		;NULL - IGNORE IT
	CAMN	T3,OPENED	;IS IT CURRENT?
	JRST	SYM16		;YES
	MOVEM	T3,SYM		;NO - SAVE IT
	MOVE	T3,OPENED
	MOVEM	T3,OLDOPN	;AND SAVE OLD OPENED
	PUSH	P,T		;SAVE (T)
	PUSHJ	P,IMPOPN	;DO THE OPEN AND MESSAGE
	POP	P,T		;RESTORE (T)

SYM16:	
;	CHECK FOR GROUP RECURSION

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

	IMULI	T,CFSIZ		;GET RELEVANT GROUP SECTION
	ADD	T,[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	T,CFLPTR	;SET UP NEW POINTER
	HRRZM	T,CFLST		;DEFINE NEW STRING LIMIT
	MOVE	T,[ILDB T1,CFLPTR]	;GET POINTER TO NEW INFORMATION
	MOVEM	T,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,T		;GET NUMBER BACK
	MOVEI	T3,1
	LSH	T3,(T)	;SET UP MASK
	TDC	T3,CURGRP	;CLEAR THIS GROUP FLAG
	MOVEM	T3,CURGRP	;SAVE IT

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

DISP3:	PJRST	DISP9		;CANNOT FIND SYMBOL
;OPEN LOGIC

SETNAM:	TLO	F,FPRNM		; FIND PROGRAM NAME
	PUSHJ	P,FNDSYM	;
	 JRST	ERR6		; NO SUCH NAME
	HLRE	T,(R)		; GET (XWD -LEN,...)
	HRLM	T,OPENLS
	ADDI	T,1(R)		; POINT TO BEG OF PROGS SYMBOLS
	HRRM	T,OPENLS	;
	MOVE	T,SYM
	MOVEM	T,OPENED	; PROGRAM NAME OPENED
	POPJ	P,		;
;	DIMENSION LOGIC



	DEFINE	PAIRS(K)
<	K=K+2
	XWD	0,K		;START OF STRING,NEXT IN STRING
	XWD	0,0		;PARAMETER WORD>



K=DIMTAB

DIMTAB:	XLIST			;DEFINE TABLE OF TWO WORD PAIRS
	REPEAT	DIMSIZ-1,<PAIRS(K)>

	XWD	0,0		;END OF LIST IS SPECIAL
	XWD	0,0
	LIST



NUMPRS=DIMFRE-DIMTAB		;THE NUMBER OF AVAILABLE WORDS
NUMPRS=NUMPRS/2			;DEFINES THE # OF 'PAIRS' AVAILABLE

DIMFRE:	XWD	K,DIMTAB	;END, AND START OF FREE SPACE

DIMNAM:	XWD	0,0		;END, AND START OF LIST OF ARRAY NAMES
;	ROUTINE TO OBTAIN A FREE TWO WORD PAIR
;	CALL PUSHJ	P,GET2WD
;	     RETURN - ADDRESS OF 'PAIR' IN T

GET2WD:	HRRZ	T,DIMFRE	;GET THE START OF THE FREE LIST
	HRRZ	T1,(T)		;FIND THE LOCATION OF THE NEXT 'PAIR'
	JUMPE	T1,GETNON	;END OF LIST REACHED
	HRRM	T1,DIMFRE	;REMOVE THIS 'PAIR' FROM THE LIST
	POPJ	P,		;RETURN WITH GOOD 'PAIR' ADDRESS IN T

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 'PAIR' TO THE FREE LIST
;	CALL PUSHJ P,PUT2WD
;	     ENTER WITH ADDRESS OF 'PAIR' IN T
;	     RETURN

PUT2WD:	HLRZ	T1,DIMFRE	;GET THE ADDRESS OF THE END OF THE LIST
	HRRM	T,(T1)		;APPEND THE NEW 'PAIR'
	SETZM	(T)		;NEW 'PAIR' BECOMES END OF LIST
	HRLM	T,DIMFRE	;RECORD THE 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 . . . T=ADDRESS OF ARRAY,  T2=LAST ARRAY
;				   F10RAY IN TF IS SET IF F10 DEFINED

RAYNAM:	TRZ	F,FORMAL!F10RAY	;[105] ASSUME NEITHER HOLDS
	SETZM	FRMSAV		;[167]Reset formal value
	HRRZI	T2,DIMNAM	;SET UP FOR FIRST ARRAY
	HRRZ	T,DIMNAM	;IS THERE AN ENTRY AT ALL?
RAY:	JUMPE	T,RAY3		;T2 WILL POINT TO THE END OF THE LIST
	HRRZ	T1,1(T)		;THIS IS AN ARRAY BLOCK - GET THE NAME(VALUE)
	CAMN	T1,SAVLOC	;ARE WE REDEFINING CURRENT NAME?
	JRST	RAY2		; YES - REMOVE THE ENTRY FIRST

	MOVE	T2,T		;T2 WILL POINT TO THE CURRENT GOOD ENTRY
	HRRZ	T,(T)		;FIND THE NEXT 'PAIR' ADDRESS
	JRST	RAY

RAY2:
	
	SKIPL	T3,1(T)		;[157]IS THE DOUBLE PRECISION BIT ON = 400000,,0
	TRZA	F,DOUBLE	;NO  - MAKE SURE 'DOUBLE' IS OFF
	TRO	F,DOUBLE	;YES - SET THE DOUBLE FLAG
	TLNE	T3,200000	;[157]Character array?
	TRO	F,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,T		;SAVE BOTH T AND-
	PUSH	P,T2		;  T2 AROUND EVAL
	MOVE	T,SAVLOC
	TRO	F,SILENT	;DON'T PRINT SYMBOL
	PUSHJ	P,LOOK		;SETS UP W1 FROM T
	  JRST	RAYPOP		;
	  JRST	RAYPOP		;DOSENT EXIST
	POP	P,T2		;RETURN T2
	POP	P,T		; AND T
	MOVE	RAY.,W1		;GET THE ARRAY SYMBOL
	MOVE	T1,(RAY.)	; AND SEE IF WE HAVE AN F10 ARRAY -
	TLZ	T1,PNAME	;    DEFINITION -
	IOR	T1,[XWD 500000,0];      THIS IS THE SAME SYMBOL
	CAME	T1,2(RAY.)	;        WITH FLAGS 50 SET
	POPJ	P,		;NO - NOT AN F10 DEFINITION
	TRO	F,F10RAY	;YES - FLAG THIS AS AN F10 ARRAY
	MOVE	RAY.,3(RAY.)	;SET POINTER TO ARRAY TABLE INFORMATION
	LDB	T1,[POINT 4,1(RAY.),12]
	TRZ	F,DOUBLE	;[162]MAKE SURE DOUBLE IS OFF
	CAIE	T1,TP%DPR	;[112] [161]Double word array?
	 CAIN	T1,TP%DPX	;[162]NO. G-Floating double array?
	  TROA	F,DOUBLE	;[162]YES FLAG IT & reset character flag
	CAIE	T1,TP%CHR	;[161]Character array?
	 TRZA	F,CHARS		;[161]NO
	TRO	F,CHARS		;[161]YES
;[161]	LDB	T1,[POINT 9,1(RAY.),8]
	LDB	T1,[POINT 7,1(RAY.),8]	;[161]
	MOVEM	T1,DIMCNT	;SET UP THE NUMBER OF DIMENSIONS
	LDB	T1,[POINT 1,1(RAY.),13]
	JUMPN	T1,RAY4		;PASSING FORMAL ARRAY ARGUMENTS?
RAY5:	HRRZI	RAY.,3(RAY.)	;SET TO POINT TO THE FIRST DIMENSION
	JRST	CPOPJ1


RAYPOP:	POP	P,T1		;MUST RESET T2-
	POP	P,T		; AND T BEFORE
	POPJ	P,		; GIVING A NO FOUND EXIT


RAY4:	TRO	F,FORMAL	;FLAG FORMAL WORKING
	HRRZI	T,@1(RAY.)	;GET THE ACTUAL ARRAY BASE
	MOVEM	T,FRMSAV	;SAVE THE FORMAL REFFERENCE
	JRST	RAY5		;
;	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,F		;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	F,FORMAL	;ATTEMPT TO RE-DIMENSION A FORMAL PARAMETER
	JRST	ERR33		;NO YOU DON'T
	TRNN	F,F10RAY	;F10 DEFINED ARRAY?
	JRST	PUTCHK		;RESET ALL
	JRST	ERR28		;WARN OF F10 REDEFINITION

PUTOK:	POP	P,F		;RESTORE FLAGS FROM ABOVE
	PUSHJ	P,GET2WD	;GET A 'PAIR' - END OF NAMES = T2
	MOVEM	T,T3		;SAVE FOR NAME DEFINITION - T3
	PUSHJ	P,GET2WD	;GET A 'PAIR' FOR DIMENSION DEFINITION
				;ENSURE WE HAVE 2 'PAIRS' FREE NOW
				;SAVE PAIN IN 'FLUSHING' LATER
	HRRM	T3,(T2)		;SAY HELLO TO NEW MEMBER
	SETZM	(T3)		;NEW MEMBER BECOMES END OF CHAIN
	MOVE	T1,SAVLOC	;GET THE NEW MEMBERS NAME
	TRNE	F,DOUBLE	;IS THIS A DOUBLE WORD ARRAY
	TLO	T1,400000	;YES - SAVE THE FACT
	TRNE	F,CHARS		;[157]Character array?
	TLO	T1,200000	;[157]YES.
	MOVEM	T1,1(T3)	;ACCEPT THE NEW MEMBER TO THE FAMILY
	HRLM	T,(T3)		;NEW MEMBERS ARE GIVEN A DIMENSION LIST
	PUSHJ	P,PUTSUB	;STORE THE SUBSCRIPTS
	JRST	CPOPJ1		;JUMP OVER POSSIBLE PUTDIM ENTRY

PUTSUB:	MOVE	T1,TEM1		;GET THE UPPER SUBSCRIPT
	SUB	T1,TEM		;FORM THE DIMENSION RANGE < 256K
	HRLZM	T1,(T)		;SAVE IN LINK LOCATION OF PAIR
				;   AND DENOTE END OF PRESENT DIMENSION LIST
	MOVE	T1,TEM		;GET THE LOWER SUBSCRIPT
	MOVEM	T1,1(T)		;SAVE FOR FUTURE REFERENCE
	MOVEM	T,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,GET2WD	;GET A FREE 'PAIR'
	MOVE	T1,PUTTER	;FIND WHERE THE LAST DIMENSION WAS STORED
	HRRM	T,(T1)		;LINK NEW 'PAIR' TO OLD 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	T,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	F,F10RAY	;F10 DEFINED?
	JRST	GET3		;YES
	HLRZ	T,(T)		;GET THE START OF DIMENSION LIST
	JRST	GET5		;FIRST TIME IS SPECIAL
GET4:	TRNE	F,F10RAY	;F10 ARRAY DEFINITION?
	JRST	GET3		;YES
	HRRZ	T,(T)		;GET NEXT DIMENSION IF ANY
GET5:	JUMPE	T,ERR22		;END OF LIST - TOO MANY DIMENSIONS EXPECTED
	MOVEM	T,PUTTER	;SAVE LINK TO NEXT DIMENSION
	MOVE	T2,1(T)		;GET THE LOWER SUBSCRIPT
	MOVEM	T2,TEM		;SAVE THE LOWER SUBSCRIPT
	HLRZ	T2,(T)		;GET THE RANGE OF THIS DIMENSION
	ADD	T2,TEM		;FORM THE UPPER SUBSCRIPT
	MOVEM	T2,TEM1		;SAVE AS THE UPPER SUBSCRIPT
	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	T,@(RAY.)	;GET THE LOWER BOUND
	MOVEM	T,TEM		;SAVE LOWER
	MOVE	T,@1(RAY.)	;GET THE UPPER BOUND
	MOVEM	T,TEM1		;SAVE LOWER
	HRRZI	RAY.,3(RAY.)	;RAY. 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	T3,SAVLOC	;GET THE NEW ARRAY NAME(VALUE)
	EXCH	T3,BASRAY	;SAVE AND START AT BASE-ARRAY NAME
	PUSHJ	P,RAYNAM	;SET UP POINTERS TO BASE-ARRAY
	  POPJ	P,		;   ????
	MOVEM	T3,BASRAY	;RESET BASE ARRAY AND CURRENT NAME
	TRNE	F,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	T,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	F,F10RAY	;IS THIS AN F10 DEFINED ARRAY
	SKIPA	T3,[EXP SAVLOC-1]  ;IF SO FOOL TYPDIM
	MOVE	T3,T		;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	F,FLSHAL	;SET UP TO FLUSH ALL FROM BASE-ARRAY
	MOVE	T,BASRAY	;GET THE BASE ARRAY VALUE
	MOVEM	T,SAVLOC	;AND SET UP FOR RAYNAM
	PUSHJ	P,RAYNAM	;RESET F10RAY FLAG TO NEW BASRAY SETTING
	  POPJ	P,		;?????

FLUSH:	TRNN	F,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
				;T2=POINTS TO LAST ARRAY NAME BLOCK
				;T= CURRENT ARRAY NAME BLOCK
FLUSH2:	HLRZ	T3,(T)		;GET DIMENSION LIST ADDRESS
	HRRZ	T1,(T)		;GET NEXT MEMBER ADDRESS
	HRRM	T1,(T2)		;LOOP OUT THE OFFENDING ARRAY NAME ENTRY
	PUSHJ	P,PUT2WD	;RETURN A PAIR
	PUSHJ	P,DELIST	;DELETE THE LIST STARTING AT C(T3)
	TRNN	F,FLSHAL	;HARD FLUSH?
	POPJ	P,		;JUST ONE ARRAY FOR NOW
	HRRZ	T,(T2)		;GET NEXT ARRAY REFERENCE IF ANY
	JUMPE	T,CPOPJ		;EXIT IF END OF LIST
	JRST	FLUSH2		;MORE TO DO

;ROUTINE TO DELETE A LIST - STARTING IN T3

DELIST:	SKIPN	T,T3		;TEST FOR END OF LIST - RETURN PAIR IN T
	  POPJ	P,		;END OF LIST
	HRRZ	T3,(T3)		;GET NEXT PAIR ADDRESS
	PUSHJ	P,PUT2WD	;RETURN THE OLD PAIR
	PJRST	DELIST		;FOLLOW THROUGH TO END OF LIST

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

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

DIM:	JUMPL	F,DIM5		;OUTPUT ALL DIMENSION SPECS
	PUSHJ	P,TTYIN		;GET NEXT USER STRING
	JUMPE	T2,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
	MOVEM	T3,MATHSM	;THATS WHAT USER TYPED
	MOVEM	T3,SYM		;SAVE FOR 'EVAL'UATION
	PUSHJ	P,EVAL		;EVALUATE SYMBOL
	  JRST	ERR6		;WE DON'T HAVE IT
	MOVEM	T,SAVLOC	;SAVE ARRAY NAME VALUE
	MOVE	T1,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	T1,"("		; [ DENOTES START OF DIMENSION DEFINITION
	JRST	DIM14		;COMMAND - WILL NOW BE NON ZERO

	CAIE	T1,"["		; ( IS AN ALTERNATIVE TO [
	JRST	DIM7
	TLO	F,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	T1,"/"		;A / IS ACCEPTABLE TO REMOVE ARRAYS
	JRST	BADSYN		;ANYTHING ELSE WONT DO
	PUSHJ	P,TTYIN		;GET NEXT INPUT
	JUMPN	T1,BADSYN	;MUST BE LINE END NOW
	JUMPE	T2,BADSYN	;NO CHARACTERS??
	LSHC	T1,6		;GET THE FIRST SWITCH CHARACTER
	CAIE	T1,'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	F,BASENM	;HAS A BASE NAME BEEN ACCEPTED
	JRST	DIM0		;YES - DON'T FLUSH YET
	SETZM	F10RP		;[163]Reset
	PUSH	P,F		;PROTECT THE DOUBLE FLAG AWHILE
	PUSHJ	P,RAYNAM	;HAVE WE HAD THIS BASE ARRAY BEFORE
	 JRST	DIMBAS		;[163]No references to this array
	TRNE	F,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	F,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	T,DIMTOT	;[163]Load the range product
	MOVEM	T,F10RP		;[163]Save it
;	where & when should f10rp be reset????
	SETZM	DIMTOT		;[163]Clear
bpw==5
DIMBAS:	MOVE	T,SAVLOC	;GET THE ARRAY VALUE
	MOVEM	T,BASRAY	;MARK THIS AS OUR BASE ARRAY
	POP	P,F		;RE-INSTATE THE DOUBLE FLAG IF THERE

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

	CAIE	T1,":"		;A : IS AS GOOD AS A BAR=/
	CAIN	T1,"/"		;BAR IS THE SUBSCRIPT SEPARATOR
	JRST	DIMBAR		;PROCESS A BAR
	TLNN	F,LFTSQB	;SKIP IF WE HAD A [ TO START
	ADDI	T1,"]"-")"	;ACCEPTABLE DELIMITER IF )
	CAIN	T1,"]"		;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	F,DIMEND	;FLAG THAT THIS IS THE END OF THE LIST
DIMCOM:	TLZE	F,BAR		;HAVE HAD TWO SUBSCRIPTS?
	JRST	DIM2		;YES - CHECK THE ORDER
	MOVEI	T,1		;ADJUST LOWER SUBSCRIPT TO BE 1
	MOVEM	T,TEM		;LOWER SCR IN TEM
DIM2:	MOVE	T,TEM1		;GET THE SECOND SUBSCRIPT
	CAMGE	T,TEM		;ENSURE THAT IT IS GREATER THAN THE FIRST
	JRST	ERR3		;TELL USER ABAOUT THE ERROR
	SUB	T,TEM		;FIND THE RANGE
	CAIG	T,777777	;CANT HAVE ARRAYS OWNING WHOLE OF CORE
	JRST	DIM3		;SUBSCRIPTS OK
	JRST	ERR27		;BAD SUBSCRIPTS

DIM3:	SKIPN	DIMTOT		;IS THIS THE FIRST SETTING FOR THIS ARRAY
	PUSHJ	P,PUTNAM	;YES - USE PUTNAM
	PUSHJ	P,PUTDIM	;N0  - ADD ANOTHER DIMENSION
	MOVE	T,TEM1		;GET UPPER SUBSCRIPT
	SUB	T,TEM		;FORM RANGE
	AOJ	T,		;MUST HAVE AT LEAST ONE
	SKIPN	DIMTOT		;IS THIS THE FIRST DIMENSION
	AOS	DIMTOT		;YES - MAKE FIRST RANGE DEFAULT = ONE
	IMULM	T,DIMTOT	;FORM TOTAL SUBSCRIPT COUNT IN DIMTOT
	TLNN	F,DIMEND	;WAS A LEFT SQUARE BRACKET SEEN LAST?
	JRST	DIM0		;NO - BACK FOR MORE
	MOVE	T,DIMTOT	;[163]Get our computed range product
	TRNE	F,DOUBLE	;[163]Double-word array?
	 ADDB	T,DIMTOT	;[163]YES!
	MOVE	T,SAVLOC	;GET THE ARRAY VALUE
NOTCH:	SKIPN	T,F10RP		;[163]Was there a compiler definition?
	 POPJ	P,		;[163]NO! test impossible
	CAML	T,DIMTOT	;[163]Compiler have less than user wants?
	 POPJ	P,		;[163]NO! 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	T,SAVLOC	;GET THE OFFENDING ARRAY NAME
	TRZ	F,SILENT	;SPEAK-UP
	PUSHJ	P,LOOK		;SHOW THE USER
	  JFCL
	  JFCL
	POPJ	P,
DIMBAR:	TLOE	F,BAR		;FLAG A BAR IF NOT ALREADY SET
	JRST	BADSYN
	MOVE	T,TEM1		;MOVE FIRST SUBSCRIPT TO APPROPRIATE PALCE
	MOVEM	T,TEM		; IN TEM
	JRST	DIM0		;LOOK FOR SECOND SUBSCRIPT

NXTCHR:	SKIPL	TERMK		;END OF LINE?
	JRST	BADSYN		;YES - SHOULD'T BE
	JUMPN	T1,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,tf		;save tf
	push	p,r		;save r
	hrrzi	tf,.priou	;get terminal output designator
	rfmod%			;get terminal JFN word
	tlz	r,(tt%osp)	;clear ^o effects
	hrrzi	tf,.priou	;get terminal output designator
	sfmod%			;set new JFN word
	pop	p,r		;restore r
	pop	p,tf>		;restore tf, end of conditional
	LINE
	SKIPN	T3,DIMNAM	;START AT HEAD OF ARRAY NAMES
	jrst	[TYPE(No )
		jrst	.+1]
	TYPE(Array specifications)
	LINE
	JUMPE	T3,CPOPJ	;EXIT IF NOTHING TO PRINT
	LINE
;[163]	TYPE(USED	MAX	ARRAY	DIMENSIONS)
	TYPE(USED		ARRAY	DIMENSIONS)
	LINE
	HRRZI	T3,DIMNAM	;START AT HEAD OF ARRAY NAMES
TYPNXT:	HRRZ	T3,(T3)		;FIND NEXT ARRAY REFERENCE
	JUMPE	T3,CPOPJ	;ALL PROCESSED?

	PUSHJ	P,TYPDIM	;NO - TYPE DIMENSIONS
	JRST	TYPNXT		;LOOK FOR MORE
;	TYPE THE DIMENSION LIST FOR THE ARRAY 'PAIR' IN T3

TYPDIM:	PUSH	P,T3		;SAVE T3 ROUND LOOK-UP
	LINE
	HRRZ	T,1(T3)		;GET THE ARRAY NAME VALUE
	MOVEM	T,SAVLOC	;SAVE THE ARRAY REFERENCE
	PUSHJ	P,GET.RP	;GET THE RANGE PRODUCT = DIMTOT
	MOVE	T,DIMTOT	;GET TOTAL ELEMENT COUNT
	TRNN	F,CHARS		;[163]Character array?
	 JRST	TYPLO		;[163]NO
	MOVE	T1,SAVLOC	;[163]Address/array descriptor
	IMUL	T,1(T1)		;[163]Length of array in bytes
TYPLO:	PUSHJ	P,TYP0		;AND DISPLAY IT
	TAB
;	TYPE([)
	MOVE	T,SAVLOC	;GET THE USER ARRAY NAME
	TRO	F,SILENT!NEARST	;DO NOT PRINT IF EXACT MATCH & FIND NEAREST SYMBOL
	PUSHJ	P,LOOK		;SEE IF THE ARRAY EXISTS
	  JRST	E5		;CANNOT FIND IT!
	  JFCL			;NOT EXACT
				;EXACT MATCH RETURN
;[bl]	SUB	T,SAVLOC	;REMOVE BASE ARRAY OFFSET
;[bl]	PUSHJ	P,TYP0		;DISPLAY
;[bl]	type(])
	tab
	SETZM	PUTTER		;RESET FOR RESCAN OF ARRAY'S DIMENSIONS
	MOVE	T,SAVLOC	;GET THE ARRAY NAME VALUE
	TRZ	F,SILENT!NEARST	;TURN ON PRINT SUPPRESS SWITCH & NEAREST
	PUSHJ	P,LOOK		;DO A LOOK UP ON C(T)
	  JFCL			;NOT FOUND
	  JRST	E5		;  OR NOT EXACT??
	TAB
	TYPE([)
DIM10:	PUSHJ	P,GETDIM	;GET THE SUBSCRIPTS FOR THE NEXT DIMENSION IN TEM,TEM1
	MOVE	T,TEM		;GET THE LOWER SUBSCRIPT
	PUSHJ	P,TYP0		;AND TYPE IT
	stype(":")
	MOVE	T,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,T3		;GET BACK ARRAY REFERENCE
	TRNE	F,F10RAY	;F10 ORIGINATED?
	jrst	[TYPE( - F10 ORIGINATED)
		jrst	.+1]
	TRNE	F,DOUBLE	;REAL*8
	jrst	[TYPE(  DP)
		jrst	.+1]
	TRNE	F,CHARS		;[157]Character?
	JRST	[TYPE(  CH)
		JRST	FRMLCK]	;[157]
	TRNN	F,DOUBLE	;REAL*4
	jrst	[TYPE(  SP)
		jrst	.+1]
FRMLCK:	TRNE	F,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	F,F10RAY	;F10 DEFINED ARRAY?
	JRST	MORD2		;YES
	SKIPN	T,PUTTER	;EXIT IF PUTTER = 0
	POPJ	P,		;NO MORE TO COME
	HRRZ	T,(T)		;NO MORE IF NEXT IN LINE = 0
	JUMPE	T,CPOPJ		;T 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	T,TEM1		;GET THE UPPER SUBSCRIPT SU
	SUB	T,TEM		;FORM SU-SL
	AOJ	T,		;FORM SU-SL+1
	SKIPN	DIMTOT		;FIRST TIME IS SPECIAL
	AOS	DIMTOT
	IMULM	T,DIMTOT	;FORM TOTAL SPACE DECLARED FOR THIS ARRAY
	PUSHJ	P,MORDIM	;SEE IF THERE ARE ANY MORE DIMENSIONS
	SKIPA	T,DIMTOT	; NO - ALL DONE
	JRST	DIM11		;YES - BACK FOR MORE

	TRNE	F,DOUBLE	;[112] IS THIS ARRAY DOUBLE WORD
	ADDM	T,DIMTOT	;YES - DOUBLE UP THE RANGE ACCESSED
	POPJ	P,		;WE NOW HAVE THE TRUE SCOPE OF THE ARRAY
;	GROUP LOGIC

GROUP:	JUMPL	F,GRPALL	;DISPLAY ALL GROUPS
	PUSHJ	P,GETNUM	;WHICH GROUP IS THE USER SETTING?
	JUMPLE	T,ERR15		;NOT VALID
	CAILE	T,GPMAX		;GPMAX IS THE MOST HE SHOULD ASK FOR
	JRST	ERR15
	MOVE	T1,OPENED
	MOVEM	T1,GRP2(T)	;THIS GROUP BELONGS TO THIS SECTION
	IMULI	T,CFSIZ		;END OF GROUP AREA
	SKIPL	TERMK
	JRST	[PUSHJ P,GRTYP	;FORGETFULL USER WANTS TO SEE GROUP CONTENTS
		 JRST RET]
	ADD	T,[POINT 7,GRP1-CFSIZ]
	MOVEM	T,CFLPTR	;WHERE TO STORE NEW STRING
	HRRZM	T,CFLST		;GUARD AGAINST OVERFLOW
	MOVE	T,[PUSHJ P,I2CFIL]
	MOVEM	T,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	T1,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 T

GRTYP:	HRRZM	T,T2		;
	ADD	T,[POINT 7,GRP1-CFSIZ,6]  ;[132]
	MOVE	T1,[ILDB T1,T]
	MOVEM	T1,GETCHR	; INPUT FROM GROUP FILE
GRPNXT:	SETOM	TERMK		;SET UP FOR DELIMETER TEST
	LDB	T1,T		;[132] GET NEXT CHAR FROM STRING
	PUSHJ	P,GETSK2	;END OF STRING?
	JUMPN	T1,.+2
	MOVEI	T1, " "		;SPACE IS SPECIAL
	SKIPL	TERMK
	POPJ	P,		;YES - IF TERMINAL CHARACTER TERMK +VE
	putchr	(T1)		;SHOW CHARACTER
	IBP	T		;[132] POSITION FOR NEXT BYTE
	HRRZM	T,T3
	CAIE	T3,GRP1(T2)	;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
CURGRP:	BLOCK	1		;BITS  TO FLAG CURRENT GROUP STACK
				;IN ORDER TO CATCH RECURSION
;	WHAT LOGIC

WHAT:	LINE
	TYPE(Open section: )
	MOVE	T,OPENED
	PUSHJ	P,SPT1		;TYPE NAME OF OPEN SECTION
	LINE
	SKIPA	T,[0]		;FLAG DISPLAY OF EVERYTHING
PSEALL:	SETO	T,		;FLAG DISPLAY OF PAUSES ONLY
	PUSH	P,T		;SAVE FLAG
	MOVEI	T,^D10
	MOVEM	T,ODF		;SET RADIX 10 AS STANDARD IN 'WHAT'
	MOVEI	T,B1ADR		;START OF PAUSES
WT10:	SKIPE	(T)
	JRST	WT9		;THERE IS AT LEAST ONE PAUSE SET
	ADDI	T,1		;NO PAUSES SEEN SO FAR
	CAIG	T,BNADR		;ALL PAUSES EXAMINED?
	JRST	WT10		;NO

	LINE
	TYPE(No pause requests)
	JRST	WT11

WT9:	LINE
	TYPE(GROUP	AFTER	PAUSE	LOCATED IN)
	LINE
	MOVEI	AR,B1ADR		;GET START OF PAUSES
WT6:	HRRZ	T,(AR)		;GET THE PAUSE ADDRESS
	JUMPE	T,WT5		;OMIT IF NO PAUSE SETTING

;	TYPING OPTION = GROUP

	HLRZ	T,(AR)		;GET THE 'TYPING' OPTION
	JUMPE	T,WT12		;WAS TYPING REQUESTED?
	HLRZ	T,(AR)		;YES - GET GROUP #
	PUSHJ	P,FTOC		;DISPLAY GROUP #

;	PROCEDE SETTING

WT12:	TAB
	MOVE	T,1(AR)		;GET CONDITIONAL SETTING
	JUMPE	T,WT2		;NO CONDITIONALS
	stype("N/A")		;NOT APLICABLE DUE TO CONDITIONAL
	JRST	WT13		;DISPLAY GROUP
WT2:	MOVE	T,2(AR)		;GET PROCEDE COUNT
	PUSHJ	P,FTOC		;TYPE THE PROCEDE COUNT
;	PAUSE IDENTIFICATION

WT13:	TAB
	HRRZ	T,(AR)		;GET PAUSE ADDRESS
	JUMPE	T,WT5		;NO PAUSE SET UP HERE
	TLO	F,FGLSNM	;GLOBALS OK
	PUSHJ	P,LOOK		;LOOKUP SYMBOL
	  JRST	E1		;NOT THERE??
	  PUSHJ	P,SPT		;TYPE SUBROUTINE NAME
	TAB			;ADD PROGRAM NAME WHERE PAUSE IS
	SKIPE	T,PNAMSV	;WAS A PG NAME FOUND?
	PUSHJ	P,SPT1		;YES TYPE IT

;	ANY CONDITIONALS?

	SKIPE	1(AR)		;IS THIS A CONDITIONAL PAUSE?
	JRST	WT14		; YES

WT5:	SKIPE	(AR)
	jrst	[LINE
		jrst	.+1]
	ADDI	AR,3		;MOVE ON TO NEXT PAUSE
	CAIG	AR,BNADR	;DONE ALL PAUSES?
	JRST	WT6		;NO - BACK FOR MORE
	JRST	WT11		;FINISHED PAUSE DISPLAY - DO GROUPS


;	TYPE PARAMETERS OF CONDITIONAL PAUSE

WT14:	TAB
	TYPE(IF )
	HRRZ	T1,AR		;GET CURRENT PAUSE ADDRESS
	SUBI	T1,B1ADR	;REMOVE OFFSETT
	IDIVI	T1,3		;FORM PAUSE#
	LSH	T1,2		;FORM INDEX TO TESTAB
	MOVEM	T1,WT16		;SAVE T1 TEMPORARILY
	MOVE	T,TESTAB(T1)	;[116] GET LOGICAL FLAGS
	TLNE	T,LFTLOG	;[116] IS ARG. LOGICAL?
	JRST	WTLLOG		;[116] YES, TAKE CARE OF IT
	MOVE	T,TESTAB+1(T1)	;GET FIRST ARG ADDRESS
	CAIN	T,TESTAB+3(T1)	;IS IT A CONSTANT?
	JRST	[MOVE  T,(T)	;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	T1,WT16		;RE-INSTATE T1
	MOVE	T,TESTAB(T1)	;GET CONDITIONAL TYPE
	TYPE( .)
	atype(TYPTST(T))	;TYPE THE CONDITION
	TLNE	T,RHTLOG	;[116] IS THIS ARG. LOGICAL?
	JRST	WTRLOG		;[116] YES, TAKE CARE OF IT
	MOVE	T,TESTAB+2(T1)	;GET SECOND ARG ADDRESS
	CAIN	T,TESTAB+3(T1)	;IS THIS A CONSTANT?
	JRST	[MOVE  T,(T)	;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	T,@TESTAB+1(T1)	;[124][116] GET VALUE
	JUMPL	T,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	T,@TESTAB+2(T1)	;[124][116] GET VALUE
	JUMPL	T,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,T		;GET DISPLAY FLAG BACK
	JUMPL	T,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	AR,GPMAX	;CHECK IF ANY ARE USED

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

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

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

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

NEXT:	JUMPL	F,STEP2		;NO ARGUMENTS USES DEFAULTS
	PUSHJ	P,EITHER	;ACCEPT EITHER A NUMERIC OR VARIABLE
	  CAIA			;NUMERIC
	MOVE	T,(T)		;GET VARIABLE CONTENTS
	JUMPE	T,.+2		;ZERO = LAST VALUE SUPPLIED
	MOVEM	T,STPVAL	;STORE THE NEW STEP VALUE
	CAIE	T1,"/"		;TRACE OPTION FOLLOWS?
	JRST	STEP2		;NO SWITCHES
	PUSHJ	P,OPTION	;FIND WHICH
	JRST	BADSYN		;NO GROUP REQUESTS HERE
	TRNN	TMOD,L.!S.!E.	;ANY TRACE OPTIONS SELECTED?
	JRST	STEP2		;NO JUST 'NEXT'
	TRZ	F,TRLABL!TRLINE	;FIRST RESET THE TRACE FLAGS
	TRZE	TMOD,L.		;DO WE TRACE LINES?
	TRO	F,TRLINE	;YES
	TRZE	TMOD,S.		;DO WE TRACE LABELS?
	TRO	F,TRLABL	;YES
STEP2:	MOVEM	F,STKYFL	;RECORD THE STICKY FLAGS
	MOVE	T,STPVAL	;GET THE STEP VALUE
	MOVEM	T,STPCNT	;AND SET UP THE STEP COUNT
	MOVE	T,[PUSHJ P,STEP4]	;PREPARE TO SET UP THE TRACE FEATURE
	MOVEM	T,FDDT.		;LIKE-SO
	HRRZ	T,STARTU	;HAS A 'START' BEEN DONE
	JUMPE	T,START2	;SIMULATE A START WITH TRACE ON
	SKIPE	T,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
	HRRZ	T,AC17		;GET THE FORTRAN PDL POINTER TO FIND THE PUSHJ
	HRRZ	T,(T)		;FIND WHERE WE ARE TRACING
	SOJ	T,		;P.C. = STOPS ONE ON
	MOVEM	T,BCOM		;SET UP FOR RE.BRK
	SETZM	SYM		;ACCEPT FIRST SYMBOL FOUND IN 'LOOK'UP
	SETOM	ESCAPE		;ALLOW ESCAPES
	TRO	F,SILENT	;RIG FOR SILENT RUNNING
	TLO	F,FGLSNM	;GLOBALS ARE OK
	PUSHJ	P,LOOK		;'LOOK'-UP THE INTERCEPT
	  JRST	E7		;JUST HAS TO BE THERE
	  JRST	E7		;     AN OFFSET IS EVEN WORSE
	PUSHJ	P,STEP11	;OPEN AND NAME SECTION IF NEW
	TRNN	F,TRLINE!TRLABL	;REQUESTED TO TRACE ENTRIES ONLY?
	JRST	STEP7		;YES
STEP13:	MOVEM	W1,W2		;SAVE THE NOW RECOGNISED SYMBOL(LINE)
	MOVE	T,TRUFST	;GET THE LAST CHARACTER OF THE LABEL
	CAIN	T,32		;"P"?
	TRNN	F,TRLABL	;AND TRACING LABELS?
	CAIA
	JRST	STEP5		;YES - OK
	TRNN	F,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	T,10	;SET FOR 8 LABELS/LINE
		 MOVEM	T,TABCNT	;RECORD IN TABCNT
		 JRST	.+1]

	TAB
	MOVE	W1,W2		;GET BACK THE NEW FOUND SOURCE LINE
	PUSHJ	P,SPT		;AND PROUDLY DISPLAY IT
	SKIPL	STPCNT		;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	T,RESTORE	;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:	MOVEI	T,[POPJ	P,]	;MAKE SURE WE DO A POPJ RETURN
	MOVEM	T,LEAV		;PLACE IT IN THE LEAVE LOCATION
	HRRM	T,PROC0		;TO MAKE SURE WE DO A POPJ RETURN TO FORTRAN
	JRST	RET		;NORMAL WORKING
;	XCT REFFERENCE FOUND BUT NOT 'P' OR 'L'

STEP12:	TRZN	TF,GUDLBL	;DID WE FIND A GOOD NUMERIC LABEL?
	JRST	STEP7		;NO  - THEN IT MUST BE A SUBROUTINE
	MOVE	T,BCOM		;WHAT ARE WE 'LOOK'ING FOR
	TRO	F,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 T & W1
	PUSHJ	P,OVRLAY	;LOOK FOR AND TELL WHERE & IF AN OVERLAY HAPPENED
	MOVE	T,PNAMSV	;WHAT WAS THE SECTION IN WHICH IT WAS FOUND
	CAMN	T,OPENED	;DO WE ALREADY NOW ABOUT IT
	POPJ	P,		;YES JUST EXIT - AND RESET T,W1
	MOVEM	T,SYM		;SET UP FOR SETNAM
	PUSHJ	P,SETNAM	;AND OPEN THIS SECTION FOR EFFICIENT SEARCHES
	LINE
	type([)
	PUSHJ	P,SPT1		;DISPLAY THE SECTION NAME
	type(])
	tab
	TRNN	F,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 T,W1
;	Q LOGIC

Q:	LINE
	JUMPL	F,BADSYN	;MUST HAVE AN ARGUMENT
	TRO	TF,DCEVAL	;DON'T CALL EVAL
	PUSHJ	P,SYMIN		;GET A SYMBOL REFERENCE
	 TRZ	F,ID		;SYMBOL FOUND FLAG
	SKIPGE	R,.JBSYM	;FIRST CHECK LOSEG TABLE
	JRST	QLIST1
QLIST0:	PUSHJ	P,GHSSYP	;NOW TRY HISEG TBL
	  JRST	QLIST9		;DONE
	MOVE	R,TT		;GET LIST
QLIST1:	SETZM	QLPNT		;ZERO FLAG SHOWING REFERENCE

QLIST2:	PUSHJ	P,FIXSYR	;UPDATE PTR
	JUMPGE	R,QLIST4	;[104] GIVE UP IF OFF END OF TABLE
	MOVE	T,(R)		;PICK UP SYMBOL
	JUMPE	T,QLIST3
	TLZN	T,PNAME		;A PROGRAM NAME?
	JRST	QLIST6		;YES
	CAMN	T,SYM		;NO, IS AN OCCURANCE FOUND?
	HRRZM	R,QLPNT		;YES, REMEMBER WHERE

QLIST3:	ADD	R,[XWD 2,2]	;POINT TO NEXT ENTRY
	JUMPL	R,QLIST2	;AND GO IF MORE
QLIST4:	TRNN	R,1B18		;[104] TABLE EXHAUSTED - LOSEG?
	JRST	QLIST0		;YES - TRY HISEG
QLIST9:	TRZE	F,ID		;ANY FOUND
	JRST	RET		;DONE
	JRST	ERR6		;NO - ERROR

QLIST6:	SKIPN	QLPNT		;FOUND THE SYMBOL?
	JRST	QLIST3		;NO
	TRO	F,ID
	PUSHJ	P,SPT1		;YES, PRINT THE PROGRAM NAME
	MOVE	T,@QLPNT	;GET THE SYMBOL BACK AND
	TLNE	T,GLOBAL	; TEST FOR A GLOBAL SYMBOL
	JRST	QLIST8		; THIS IS A GLOBAL SYMBOL
QLIST7:	TYPE(	)
	SETZM	QLPNT		;RESET FLAG
	JRST	QLIST3		; AND SEARCH THE NEXT SET OF SYMBOLS

QLIST8:	type( )
	openp
	MOVE	T,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	F,MODRET	;'MODE' ALONE - MEANS RESUME STANDARD SETTING
	SETZI	W1,		;NO  - PREPARE FOR A MODE CHANGE
MODNXT:	PUSHJ	P,TTYIN		;GET AN ARGUMENT FROM USER
	JUMPE	T2,BADSYN
	LDB	T2,[POINT 6,T2,5]	;GET FIRST CHARACTER OF USERS ARGUMENT
	CAIN	T2,'F'
	JRST	[TRO	W1,F.
		 JRST	MODMOR]
	CAIN	T2,'D'
	JRST	[TRO	W1,D.
		 JRST	MODMOR]
	CAIN	T2,'I'
	JRST	[TRO	W1,I.
		 JRST	MODMOR]
	CAIN	T2,'O'
	JRST	[TRO	W1,O.
		 JRST	MODMOR]
	CAIN	T2,'R'
	JRST	[TRO	W1,R.
		 JRST	MODMOR]
	CAIN	T2,'X'		;[157]Complex?
	JRST	[TRO	W1,X.	;[157]
		 JRST	MODMOR]
	CAIN	T2,'C'	;[157]Character string?
	 JRST	[TRO	W1,C.	;[157],[164]
		JRST	MODMOR]	;[157]
	CAIN	T2,'L'		;[120]
	JRST	[TRO	W1,L.	;[120]
		JRST	MODMOR]	;[120]
	CAIE	T2,'A'
	JRST	BADSYN
	TRO	W1,A.

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

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

MODSET:	MOVEM	W1,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:	MOVEI	R,SYM		;CHECK SYM
	PUSHJ	P,TRUVAR	;LABEL OR STATEMENT #?
	  TROA	TF,SYMLAB	;YES
	TRZ	TF,SYMLAB
	TRZE	TF,FGLONL	;LOOKING FOR GLOBALS ONLY?
	TRNE	TF,SYMLAB	;AND THIS IS NOT A LABEL?
	CAIA
	JRST	EVAL1		;YES
	TLO	F,FLCLNM	; FIND LOCAL NAME
	PUSHJ	P,FNDSYM	;
	 CAIA
	JRST	EVAL2		; FOUND
	TRNE	TF,SYMLAB	;IS IT A LABEL?
	 POPJ	P,		;YES - FAIL
	MOVSI	R,LOCAL		;YES, LOOK FOR OUTSIDE LOCALS
EVAL0:	TLO	F,FGLSNM	;THROUGH THE WHOLE TABLE
	MOVEM	R,SYMASK	;
	PUSHJ	P,FNDSYM
	 POPJ	P,		; FAIL

EVAL2:	HRRZM	R,SYMSAV	;ALWAYS SAVE POINTER
	MOVE	W1,R		;
;[BL]	WHAT GOOD IS THIS?????
	MOVE	W2,1(R)
	SKIPA	T,1(R)		;GET VALUE OF SYMBOL
CPOPJ2:	AOS	(P)		;SKIP TWICE
CPOPJ1:	AOS	(P)		;FOUND SYMBOL, SKIP
	TLZ	F,FGLSNM	;KILL FLAG
CPOPJ:	POPJ	P,


EVAL1:	MOVSI	R,GLOBAL!DELO	;[141] GLOBALS ONLY(ALSO DELETED GLOBALS)
	JRST	EVAL0		;GO
;  GHSSYP LOOKS TO SEE IF THERE IS A HISEG FOR THIS CORE IMAGE;  IF
;SO, IT GETS THE POINTER TO THE HISEG SYMBOL TABLE IN T.  THERE IS
;A SKIP RETURN ON SUCCESS.
;
; AC'S USED:  R, T



GHSSYP:	PUSH	P,1		;[142] SAVE FLAGS
	PUSH	P,0		;[146] Save AC0
	MOVEI	0,FO$HSP	;[146] Function code in AC0
	XMOVEI	1,TT		;[146] Address in AC1
	PUSHJ	P,FOROP.##	;[143] GET HI-SEG SYMBOL TABLE POINTER
	POP	P,0		;[146] Restore AC0
	POP	P,1		;[142] RESTORE FLAGS
	JUMPE	TT,CPOPJ	;FAIL IF NO TBL
	JRST	CPOPJ1		;OK


;	GET HISEG START ADDRESS IN (R)

ife tops20,<
GSTAH:	MOVE	R,[XWD -1,.GTSGN]
	GETTAB	R,		; GET HISEG INDEX
	 HALT	.		; *****
	HRLZI	R, (R)		; GET INDEX
	HRRI	R,.GTUPM
	GETTAB	R,		; GET HISEG START
	 HRLZI	R,400000	;PRE-507 MONITOR - FUDGE VALUE
	HLRZ	R,R
	POPJ	P,>		;End of conditional
ifn tops20,<
gstah:	skipn	r,.jbhso	;[123]get page of high segment
	  movei	r,400		;[123]not set, guess 400
	lsh	r,11		;get address of high segment
	popj	p,>		;return,end of conditional
;THIS ROUTINE SETS UP IGNORE LISTS FOR SYMBOL TABLE LOOKUPS.

SETLST:	MOVEI	AR,0		;COUNT
	SKIPN	R,.JBSYM	;LOSEG FIRST
	CAIA
	PUSHJ	P,SETL		;SET UP THAT PART
	PUSHJ	P,GHSSYP	;NOW THE HISEG TABLE
	 POPJ	P,		;NONE

SETL:	MOVE	W2,(R)		;GET NEXT ENTRY
	TLNN	W2,PNAME	;PRIG NAME?
	JRST	SETL1		;YES
SETL0:	ADD	R,[2,,2]	;NO
	JUMPL	R,SETL		;CHECK NEXT
	POPJ	P,		;DONE

SETL1:	CAME	W2,[SQUOZE 0,UDDT]	;IGNORE THESE PROGRAMS
	CAMN	W2,[SQUOZE 0,FORDDT]
	JRST	SETL2
	CAME	W2,[SQUOZE 0,JOBDAT]
	JRST	SETL0		;NO

SETL2:	HLRE	T2,1(R)		;GET THE -LENGTH
	ADDI	T2,2(R)		;BEG OF SYMBOLS FOR PROGRAM
	HRRZM	T2,SYMLST(AR)	;
	HLRE	T2,1(R)
	MOVM	T2,T2		;GET LENGTH
	HRLM	T2,SYMLST(AR)	;SAVE THAT TOO
	AOJA	AR,SETL0	;NEXT


;FIX (R) AS PTR TO SYMBOL TABLE.

FIXSYR:	MOVEI	W2,(R)		;GET ADDR POINTED TO
	MOVEI	TT,PSYLST-1	;GET # OF IGNORED PROGRAMS

FIXS1:	HRRZ	T3,SYMLST(TT)	;NEXT LOCATION
	CAIN	T3,(W2)		;PART OF AN IGNORED PROG?
	JRST	FIXS2
	SOJGE	TT,FIXS1	;NO - TRY NEXT
	POPJ	P,		;NONE - LET IT GO

FIXS2:	HLRZ	T3,SYMLST(TT)	;GET LENGTH OF IGNORED SYMBOLS
	HLL	T3,SYMLST(TT)	;LENGTH,,LENGTH
	ADD	R,T3		;UPDATE PTR
	POPJ	P,		;DONE


SYMLST:	BLOCK	5		;# OF POSSIBLE PROGRAMS TO IGNORE (CONSERVATIVE)
PSYLST==.-SYMLST		;LENGTH
;FNDSYM:  FIND A SYMBOL IN THE SYMBOL TABLE.  ACCORDING TO THE FOLLOWING
;BITS:		FPRNM - FIND PROGRAM NAME
;		FLCLNM - FIND LOCAL NAME
;		FGLSNM - FIND GLOBAL (ANYWHERE IN TABLE)  (SYMASK CONTROLS
;			    THE TYPES OF SYMBOLS ALLOWED)
;
;  THE SYMBOL (IN RADIX50) IS GIVEN IN SYM, AC R IS LEFT POINTING TO
;THE ENTRY THAT MATCHED.


FNDSYM:	SETZI	W1,
	TLZN	F,FPRNM		;LOOK FOR PROGRAM NAME?
	JRST	FNDS3		;NO
	MOVE	R,.JBSYM	; CHECK LOSEG TABLE FIRST
	MOVEM	R,OJBSYM
	PUSHJ	P,FINDS		; TRY
	 CAIA			; NO GOOD
	JRST	CPOPJ1
	PUSHJ	P,GHSSYP	;GET HISEG SYM TBL PTR
	 POPJ	P,		;FAIL
	MOVEM	TT,OJBSYM
	JRST	FINDS		;TRY

FNDS3:	TLZN	F,FLCLNM	;LOOKING FOR A LOCAL?
	JRST	FNDS5		;NO
	SKIPN	R,OPENLS	; YES - GET PROG SYM LIST
	 POPJ	P,		;NO PROGRAM OPENED, OR NO SYMS FOR PROG

FNDS4:	MOVE	W,(R)		;GET NEXT SYM
	TLNN	W,PNAME		;PROGRAM NAME?
;[171]	JRST	FNDS45		;YES - IGNORE
	JRST	FNDS46		;[171] YES - IGNORE
	TLZ	W,LOCAL		;LOCALS ONLY
	CAMN	W,SYM		;FOUND?
	JRST	FNDS9		;YES
FNDS45:	ADD	R,[XWD 2,2]	; NO, UPDATE PTR
	JUMPL	R,FNDS4
	POPJ	P,		;NOT FOUND

FNDS46:	TRNE	TF,TYPCMD	;[171] 'TYPE'?
	 POPJ	P,		;[171] YES, return no match
	JRST	FNDS45		;[171] Continue search
FNDS5:	TLZN	F,FGLSNM	;LOOKING FOR A GLOBAL?
	 JRST	E9		;ERROR - NO SPEC
	MOVE	R,.JBSYM
	JUMPE	R,FNDS6
	PUSHJ	P,FNDS7		;LOOK FOR SYM IN LOSEG SYM TABLE
	 CAIA			;N.G.
	JRST	FNDS9		;FOUND IT - SET T
FNDS6:	PUSHJ	P,GHSSYP	;GET HISEG SYM TABLE PTR
	 POPJ	P,		;
	JUMPE	TT,CPOPJ	;
	MOVE	R,TT
FNDS7:	PUSHJ	P,FIXSYR	;FIX PTR IN (R)
	JUMPGE	R,FNDS13	;[104] GET OUT IF OFF END OF TABLE
	MOVE	W,(R)		;GET NEXT SYM
	TLNN	W,PNAME		;PROGRAM NAME?
	JRST	FNDS8		;YES - IGNORE

;[BL]	watch for resetting of this mask!!!!!!!
	TDZ	W,SYMASK	;CLEAR LEGAL BITS
	CAMN	W,SYM		;MATCH?
	JRST	FNDS11		;YES
FNDS8:	ADD	R,[XWD 2,2]
	JUMPL	R,FNDS7		;TRY NEXT
FNDS13:	JUMPE	W1,CPOPJ	;[104] FAIL IF NOTHING FOUND
	SKIPA	R,W1		;USE LOC OF MATCH

FNDS10:	SKIPA	T,(R)		;GET VALUE (FOR FINDS)
FNDS9:	MOVE	T,1(R)		;GET VALUE OF SYMBOL
	JRST	CPOPJ1		;SUCCESS

FNDS11:	MOVE	W,(R)		;GET SYMBOL
	TLNE	W,GLOBAL	;GLOBAL?
	JRST	FNDS9		;YES - USE IT
	JUMPN	W1,FNDS12	;MATCH ALREADY?
	MOVE	W1,R		;NO - MARK THIS ONE
	MOVE	S,1(W1)		;[171] Save value
	JRST	FNDS8		;GO AHEAD
FNDS12:	TRO	F,MDLCLF	;MULT. DEF.
	 TRNN	TF,TYPCMD	;[171]Exit if not 'TYPE'
	  POPJ	P,		;FAIL
	MOVE	W,1(R)		;[171] Find value of symbol
	CAME	W,S		;[171] Match previous symbol?
	 JRST	FNDS8		;[171] No, keep looking
	TRO	TF,COMDAT	;[171] YES remember it's in COMMON
	MOVE	R,W1		;[171] Restore first match address
	JRST	FNDS9		;[171] DONE

;  THIS ROUTINE SEARCHES THE SYMBOL TABLE IN A BACKWARDS DIRECTION
;LOOKING ONLY FOR PROGRAM NAMES.

FINDS:	HLRE	R,OJBSYM	; GET -# OF ENTRIES
	JUMPE	R,CPOPJ		;IGNORE IF TABLE EMPTY
	MOVM	R,R
	ADD	R,OJBSYM	;POINTER TO END OF TABLE
	MOVEI	R,-1(R)

FNDS1:	MOVE	W,-1(R)		;GET NEXT PROG NAME
	CAMN	W,SYM		;IS THIS IT?
	JRST	FNDS10		;YES
	HLRE	W,(R)		; NO, GET LEN OF SYMBOLS
	JUMPGE	W,CPOPJ		;[102] IF TABLE ZEROED, GET OUT
	ADD	R,W		;POINT TO PREVIOUS PROG
	HRRZ	W,OJBSYM
	CAILE	W,(R)		;[107] DONE?
	POPJ	P,		;YES - NO FOUND
	JRST	FNDS1		; NO - TRY NEXT
SUBTTL	ENTER AND LEAVE FORDDT LOGIC

;	SAVE THE ACS AND PI SYSTEM

SAVE:	0			;SAVE THE ACS AND PI SYSTEM
	SKIPN	SARS
	JRST	SAV1
	AOS	SAVE
	JRST	SAV5
SAV1:	MOVEM	17,AC17
	HRRZI	17,SAVACS	;[147] 
	BLT	17,SAVACS+16	;[147] 
	MOVE	T, SAVE
	HLLM	T, SAVPI
	SETPDL

SAV5:	MOVE	F,STKYFL	;INIT THE FLAG REGISTER
	SETOM	SARS		;FLAG PROTECTING SAVED REGISTERS
	SETPDL
	JRST	@SAVE


;	RESTORE ACS AND PI SYSTEM

RESTOR:	HRRM	T,SAVE
	MOVE	T,SAVPI
	TLZ	T,010037	;DON'T TRY TO RESTORE USER MODE FLAG
	HLLM	T, SAVE
	HRLZI	17,SAVACS	;[147] 
	BLT	17,17
	SETZM	SARS
	JRST	2,@SAVE
;	PAUSE LOGIC


BP0:	0			;[145] USERS PC FROM FAKED JSR
	JSA	T,BCOM		;[145] SAVE T AND GO TO BCOM
	TRN			;[145] BREAKPOINT INSTRUCTION

BP1:	XLIST			;TABLE FOR ENTRY FROM BREAKPOINTS
	REPEAT	NBP,<	0	;JSR TO HERE FOR A PAUSE
	JSA	T, BCOM
	0		;HOLDS INSTRUCTION WHILE PAUSE IS IN PLACE>
	LIST


B1INS=BP1+2
BPN=.-3




;	CONDITIONAL LOGIC

TESTAB:	XLIST
	REPEAT	NBP,<	0	;NUMBER OF TEST
	0	;ADDRESS OF ARG1
	0	;ADDRESS OF ARG2
	0	;CONSTANT VALUE>
	LIST
COMPAR:	CAML	T2,T3
	CAMLE	T2,T3
	CAME	T2,T3
	CAMN	T2,T3
	CAMG	T2,T3
	CAMGE	T2,T3
COND:	0
	JSR	CONSAV		;SAVE RELEVANT REGS
	AOS	COND		;PREPARE FOR SKIP RETURNS
	HRRZ	T,BCOM3
	SUBI	T,B1ADR+1
	IDIVI	T,3
	LSH	T,2
	MOVE	T1,TESTAB(T)
	MOVE	T2,@TESTAB+1(T)
	MOVE	T3,@TESTAB+2(T)
	XCT	COMPAR(T1)
	AOS	COND
	JSR	CONSAV		;REINSTATE USERS ACS
	JRST	@COND

CONSAV:	0
	EXCH	T,CONSV0
	EXCH	T1,CONSV1
	EXCH	T2,CONSV2
	EXCH	T3,CONSV3
	JRST	@CONSAV

CONSV0:	Z
CONSV1:	Z
CONSV2:	Z
CONSV3:	Z
BCOM:	0
	POP	T,LEAV		;MOVE INSTRUCTION TO LEAV
	MOVEI	T,B1SKP-B1INS+1(T)
	HRRM	T,BCOM3		;CONDITIONAL BREAK SETUP
	MOVEI	T,B1CNT-B1SKP(T)
	HRRM	T,BCOM2		;PROCEDE COUNTER SETUP
	MOVE	T,BP1-B1CNT(T)	;GET PC WORD
	HLLM	T,LEAV1		;SAVE FLAGS FOR RESTORING
	EXCH	T,BCOM		; ALSO SAVE PC WORD IN BCOM

BCOM3:	SKIPE	B1SKP		;ADDR MOD TO LOOK AT COND. INST.
	XCT	@.-1
BCOM2:	SOSG	B1CNT		;ADDR MOD TO LOOK AT PROCEED COUNTER
	JRST	BREAK

	MOVEM	T,SAVACS+T	;[147] 
	HRRZ	T,BCOM3		;ADDRESS OF CONDITIONAL
	HLRZ	T,-1(T)		;SEE IF A 'TYPING' REQUESTED
	JUMPN	T,BCOM1		;'TYPING' REQUESTED
	LDB	T,[POINT 9,LEAV,8]	;GET INSTRUCTION
	CAIL	T,264		;JSR
	CAILE	T,266		;JSA,JSP
	TRNN	T,700		;UUO
	JRST	PROC1		;MUST BE INTERPRETED
	CAIE	T,260		;PUSHJ
	CAIN	T,256		;XCT
	JRST	PROC1		;MUST BE INTERPRETED
	MOVE	T,SAVACS+T	;[147] 
	JRST	2,@LEAV1	;RESTORE FLAGS, GO TO LEAV

LEAV1:	XWD	0,LEAV

BCOM1:	MOVE	T,SAVACS+T	;[147] RESTORE T
	JSR	SAVE		;SAVE ACS
	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	F,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,FORBUF	;[145] LET FOROTS CLEAR ITS BUFFER
	SOS	T,BCOM3
	HRRZS	T		;GET ADR OF CONDITIONAL BREAK INST
	SUBI	T,B1ADR-3	;CHANGE TO ADDRESS OF $0B
	IDIVI	T,3		;QUOTIENT IS BREAK POINT NUMBER
	HRRM	T,BREAK2	;SAVE BREAK POINT #
;NOW DISPLAY BREAK INFORMATION

	SETZI	TF,		;
	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
BRKAT:	MOVE	T,BCOM		;[145]
	HLLM	T, SAVPI	;SAVE PROCESSOR FLAGS
	MOVEI	T,-1(T)
	ANDI	T,-1		;ADDRESS PORTION ONLY THANK YOU
	TRO	F,SILENT	;SILENCE
	TLO	F,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	T,TEM		;[145] REMEMBER NEAREST REFERENCE
	PUSHJ	P,SPT		;[145] TYPE SYMBOL
	TYPE	( + )		;[145]
	MOVE	T,TEM		;[145] TYPE OFFSET
	PUSHJ	P,TYP4		;[145] IN OCTAL
	JRST	BPSEC		;[145]

BPOK:	MOVE	T,(R)		;[145] GET SYMBOL
	TLNE	T,GLOBAL	;GLOBAL?
	JRST	BREAK6		;YES - THIS IMPLIES A ROUTINE
	PUSHJ	P,SPT1		;NO, SO PRINT IT
BPSEC:	TYPE( in )		;[145]
	MOVE	T,PNAMSV	;GET NAME OF SYMBOL'S SECTION
	MOVEM	T,SYM		;SAVE IT
	PUSHJ	P,SPT1		;AND TYPE IT
	MOVE	T,PNAMSV
	CAME	T,OPENED	;THIS PROGRAM OPENED?
	JRST	BREAK7		;NO - DO IT
	SKIPGE	BP0FLG		;[145] IF FROM BREAKPOINT 0,
	  JRST	BP0RET		;[145] DONE

BREAK4:	LINE
	HRRZ	T,@BCOM3
	HRRM	T,PROC0		;SETUP ADDRESS OF BREAK
	HLRZ	T,@BCOM3
	JUMPE	T,BREAK1	;TEST FOR REGISTER TO EXAMINE
	MOVE	TMOD,MODFLG	;REMEMBER TO SET UP THE PRINT FLAGS
	TLO	F,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	F,GRPFL!CFLIU!OFCFL	;REMOVE FLAG, IT MAY CAUSE TROUBLE

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

BP0E2:	SKIPN	BP0FLG		;[145] IN BREAKPOINT 0?
	  JRST	E2		;[145] NO, ERROR
	MOVEI	T,@BCOM		;[145] TYPE IT IN OCTAL
	SUBI	T1,1		;[145] 
	PUSHJ	P,TYP4		;[145] 
BP0RET:	LINE			;[145] 
	MOVNS	BP0FLG		;[145] MAKE IT POSITIVE NOW
	JRST	RET		;[145] INITIALIZE SOME FLAGS ETC.

BREAK6:	MOVEM	R,SAVLOC	;NAME OR ROUTINE
	TYPE	(routine )
	PUSHJ	P,SPT		;TYPE ROUTINE NAME
	PUSHJ	P,GETARG	;DISPLAY ANY ARGS
	SKIPGE	BP0FLG		;[145] DONE IF FROM BREAKPOINT 0
	  JRST	BP0RET		;[145]
	MOVE	T,PNAMSV	;GET PROGRAM NAME
BREAK7:	MOVEM	T,SYM		;SAVE IT
	PUSHJ	P,IMPOPN	;AND OPEN IT
	SKIPGE	BP0FLG		;[145] IF FROM BREAKPOINT 0,
	  JRST	BP0RET		;[145] DONE
	JRST	BREAK4
PROCED:	MOVEI	T,1		;SET UP FOR PROCEDE OF 1
	SKIPG	@BCOM2		;DO NOT CHANGE VALUE IF ALREADY SET
PROCDX:	MOVEM	T,@BCOM2	;STORE IN B#CNT
	HRRZ	R,BCOM3
	SETZM	TEM		;DO NOT RE-INSERT 'CONDITIONAL' INFO.
	HLRZ	S,(R)
	JUMPE	S,.+2		;SET THE AUTO PROCEDE FLAG
	TLO	F,AUTO		;IF THIS IS A 'TYPING' REQUEST
	PUSHJ	P,AUTOP
PROCD1:	LINE

PROC0:	HRRZI	R,[JRST RET]	;MODIFIED 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	T,LEAV
PROC00:	CLEARM	BP0FLG		;[145] WON'T NEED THIS ANYMORE
	PUSHJ	P,INSRTB
	JRST	PROC2

PROC1:	MOVE	T,SAVACS+T	;[147] 
	JSR	SAVE
	JFCL
	MOVE	T,BCOM		;STORE FLAGS WHERE "RESTORE"
	HLLM	T,SAVPI		;  CAN FIND THEM
PROC2:	MOVEI	W,100
	MOVEM	W,TEM1		;SETUP MAX LOOP COUNT
	JRST	IXCT5

IXCT4:	SUBI	T,041		;IS UUO "INIT"?
	JUMPE	T,BPLUP
	AOJGE	T,IXCT6		;DONT PROCEDE FOR INIT
				;DONT INTERPRET FOR SYSTEM UUOS
	MOVEM	R,40		;INTERPRET FOR NON-SYSTEM UUOS
	MOVEI	R,41
IXCT:	SOSL	TEM1
	PUSHJ	P,FETCH
	JRST	BPLUP		;BREAKPOINT LOOPING OR FETCH FAILED
	MOVEM	T,LEAV
IXCT5:;	SETZM	ESCAPE		;NO ESCAPES FROM FORDDT
	LDB	T,[POINT 9,LEAV,8]	;GET INSTRUCTION
	CAIN	T,254		;DON'T DO ANYTHING TO JRST
	JRST	IXCT6
	HRLZI	17,SAVACS	;[147] 
	BLT	17,17
	MOVEI	T,@LEAV
	DPB	T,[POINT 23,LEAV,35]	;STORE EFFECTIVE ADDRESS
	LDB	W1,[POINT 4,LEAV,12]	;PICK UP AC FIELD
	LDB	T,[POINT 9,LEAV,8]	;PICK UP INSTRUCTION FIELD
	SETPDL
	CAIN	T,260
	JRST	IPUSHJ		;INTERPRET PUSHJ

	CAIN	T,264
	JRST	IJSR		;INTERPRET JSR
	CAIN	T,265
	JRST	IJSP		;INTERPRET JSP
	CAIN	T,266
	JRST	IJSA		;INTERPRET JSA
	MOVE	R,LEAV
	TRNN	T,700
	JRST	IXCT4		;INTERPRET UUO
	CAIN	T,256
	JRST	IXCT		;INTERPRET XCT

IXCT6:	JSP	T,RESTORE
LEAV:	0			;INSTRUCTION MODIFIED
	JRST	@BCOM
	AOS	BCOM
	JRST	@BCOM

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

IPUSHJ:	DPB	W1,[POINT 4,CPUSHP,12]	;STORE AC FIELD INTO A PUSH
	HLL	T,SAVPI		;PICK UP FLAGS
	HLLM	T,BCOM		;SET UP THE OLD PC WORD
	MOVSI	T,(1B4)		;TURN OFF BIS FLAG IN NEW PC WORD
	ANDCAM	T,SAVPI
	JSP	T,RESTORE	;RESTORE THE MACHINE STATE
CPUSHP:	PUSH	.-.,BCOM	;GETS MODIFIED IN AC FIELD
	JRST	@LEAV		;JUMP TO "E" OF THE PUSHJ

IJSA:	MOVE	T,BCOM		;INTERPRET JSA
	HRL	T,LEAV
	EXCH	T,SAVACS(W1)	;[147] 
	JRST	IJSR2

IJSR:	MOVE	T,BCOM		;INTERPRET JSR
	HLL	T,SAVPI		;SET UP THE OLD PC WORD
	MOVSI	W,(1B4)		;TURN OFF BIS IN NEW PC WORD
	ANDCAM	W,SAVPI
IJSR2:	MOVE	R,LEAV
	PUSHJ	P,DEPMEM
	 JRST	BPLUP		;ERROR, CAN'T STORE
	AOSA	T,LEAV
IJSR3:	MOVE	T,LEAV
	JRST	RESTORE

IJSP:	MOVE	W,BCOM		;INTERPRET JSP
	HLL	W,SAVPI		;PICK UP PC WORD FLAGS
	MOVEM	W,SAVACS(W1)	;[147] INSERT OLD PC WORD INTO AC
	MOVSI	T,(1B4)		;TURN OFF BIS FLAG IN NEW PC WORD
	ANDCAM	T,SAVPI
	JRST	IJSR3
;	INSERT PAUSES REQUESTS

INSRTB:	MOVE	S,[JSR BP1]
INSRT1:	SKIPE	R,B1ADR-BP1(S)
	PUSHJ	P,FETCH
	JRST	INSRT3

	MOVEM	T,B1INS-BP1(S)
	MOVE	T,S
	PUSHJ	P,DEPMEM
	 JFCL			;HERE ONLY IF CAN'T WRITE IN HIGH SEG

INSRT3:	ADDI	S,3
	CAMG	S,[JSR BPN]
	JRST	INSRT1
	POPJ	P,

;REMOVE PAUSE REQUESTS

REMOVB:	MOVEI	S,BNADR
REMOV1:	MOVE	T,B1INS-B1ADR(S)
	SKIPE	R,(S)
	PUSHJ	P,DEPMEM
	 JFCL			;HERE ONLY IF NO WRITE IN HIGH SEG
	SUBI	S,3
	CAIL	S,B1ADR
	JRST	REMOV1
	POPJ	P,		;
;	HERE TO SET PAUSE BREAKS



BPS:	MOVE	T,[XWD B1ADR,B1ADR+1]	; CLEAR ALL PAUSES
	CLEARM	B1ADR
	BLT	T,AUTOPI	;CLEAR OUT ALL PAUSES AND AUTO PROCEDE REGESTER
	JRST	RET

BPS1:	MOVE	R,T
	PUSHJ	P,FETCH		;CAN PAUSE BE INSERTED HERE?
	 JRST	ERR19		;NO
	PUSHJ	P,DMEMER	; AGAIN NO
	MOVE	T,R		;PUT THE PAUSE ADR BACK IN T
	SETZM	SAVLOC		;STORES AVAILABLE PAUSE SLOT
	MOVEI	R,B1ADR		;START OF PAUSE ARGUMENTS
BPS4:	HRRZ	W,(R)		;GET ADDRESS OF PAUSE IF ALREADY SET
	CAIN	W,(T)		;SEE IF ALREADY SET
	JRST	BPS5		;YES - USE THIS

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

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

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

;DEPOSIT INTO MEMORY SUBROUTINE

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

DEPAC:	MOVEM	T,SAVACS(R)	;[147] DEPOSIT IN AC
	JRST	CPOPJ1		;SKIP RETURN


ife tops20,<
DEP4:	EXCH	R,T
	MOVEI	TT1,0
	SETUWP	TT1,		;IS HI SEGMENT PROTECTED? TURN OFF
	POPJ	P,		;PROTECTED, NO SKIP RETURN
	MOVEM	T,(R)		;STORE WORD IN HI SEGMENT
	TRNE	TT1,1		;WAS WRITE PROTECT ON?
	SETUWP	TT1,		;YES, TURN IT BACK ON
	JFCL
	JRST	CPOPJ1>		;skip return, end of conditional
ifn tops20,<
dep4:	exch	r,t		;restore r and t
	push	p,tf		;save regs for JSYS
	push	p,r
	lsh	r,-11		;form page number from address
	hrrzi	tf,(r)		;put into AC1
	hrli	tf,400000	;get process handle into left half
	push	p,tf		;save this argument, just in case!
	rpacs%			;get access bits into AC2
	tlne	tf,(pa%wt)	;can we write to this page?
	jrst	dep5		;yes, go do it
	move	tf,(p)		;no, get saved argument
	and	r,[pa%wt!pa%rd!pa%cpy!pa%ex]
				;clear unneeded bits
	tlo	r,(pa%cpy)	;get cw access for page
	spacs%
	hrroi	tf,[asciz/
%FDTWSP	Writing to shared page
/]				;prepare to warn him once
	aosn	pagwrn		;skip if he has already been warned
	psout%			;send warning
dep5:	pop	p,r		;flush extra stack level
	pop	p,r		;restore r
	pop	p,tf		;restore flags
	movem	t,(r)		;save away t
	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	R,T		;CHECK (T)
	PUSHJ	P,CHKADR	;LEGAL ADDRESS?
	 POPJ	P,		;NO
	 JFCL			;HIGH OR LOW OK FOR FETCH
	EXCH	R,T
	TRNN	R,777760	;ACCUMULATOR?
	SKIPA	T,SAVACS(R)	;[147] YES
	MOVE	T,(R)		;NO
	JRST	CPOPJ1		;SKIP RETURN ONLY FOR LEGAL ADDRESS
SUBTTL BINARY TO SYMBOLIC CONVERSION

;	PUSHJ	P,LOOK		;AC T 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 T
;	  RETURN 3		;EXACT MATCH FOUND AND PRINTED IF R=0
;				;R=SYMBOL VALUE IF SILENT FLAG ON
;				;T = SYMBOL VALUE BEING 'LOOKED' UP
;				;W1 = ADDRESS OF BEST SYMBOL SO FAR
;				;TRULST=LAST CHARACTER IF LABEL FOUND

LOOK:	SETZM	PNAMSV		;RESET PROGRAM NAME OF SYMBOL
	TRZ	F,MDLCLF!ID	;[157]Clear flags
	MOVEI	R,377777
	TRNE	F,NEARST	;
	MOVNI	R,377777
	MOVEM	R,BESTVA	;SETUP FALSE OFFSET
	PUSHJ	P,LOKSYM	;CHECK IT
LOOK0:	 POPJ	P,		;NOTHING FOUND
	 JRST	LOOK4		;MULT. DEF. OR OFFSET
	MOVE	R,W1		;PTR TO SYMBOL
	MOVEM	R,LASYM		;SAVE THIS SYMBOL
	MOVE	W2,1(R)		;GET VALUE
	MOVEM	W2,LASVAL	;SAVE
	TRZN	F,SILENT	;FOUND - SILENCE?
	PUSHJ	P,SPT		;NO - TYPE SYMBOL
	PUSHJ	P,LOOKPG	;LOOKUP FOR PROGRAM NAME
	JRST	CPOPJ2		;DOUBLE SKIP - SUCCESS


LOOK4:	JUMPE	T,CPOPJ1	;MULT DEF
	MOVEM	R,LASYM		;UPDATE LAST SYMBOL
	MOVE	W2,1(R)		;GET VALUE
	ADDI	W2,(T)		;WITH OFFSET
	MOVEM	W2,LASVAL	;AS LAST VALUE
	PUSHJ	P,LOOKPG	;GET PROGRAM NAME
	JRST	CPOPJ1		;2ND SKIP

RELOOK:	MOVE	R,W1		;RESET (R)
	PUSH	P,[LOOK0]	;RETURN
	TRZ	F,ID		;ALLOW LOKSYM TO FIND IT
	JRST	LOK3		;HERE WE GO AGAIN


;ROUTINE TO LOOKUP FOR PROGRAM NAME
LOOKPG:
	PUSH	P,R		; SAVE R
LOOK2:	ADD	R,[2,,2]
	JUMPGE	R,LOOK3		;END OF TABLE
	MOVE	W2,(R)		;GET NEXT ENTRY
	TLNE	W2,PNAME	;PROGRAM NAME?
	JRST	LOOK2		;NO
	MOVEM	W2,PNAMSV	;YES - SAVE IT
LOOK3:	POP	P,R		;RESTORE R
	POPJ	P,		;END ROUTINE
;THIS ROUTINE SEARCHES THE SYMBOL TABLE SPECIFIED BY FLAG FGLSNM FOR
;THE VALUE SUPPLIED IN AC T.  THERE IS A FAIL RETURN FOR SYMBOL NOT
;FOUND OR MULT. DEF. LOCAL.

LOKSYM:	SETZB	W1,TEM3
	MOVEM	T,TEM8		;STORE VALUE
	MOVE	R,.JBSYM	;USE LOSEG TBL
	TRNN	TF,TYPCMD	;[171] TYPEing?
	 JRST	LOKSM		;[171] NO search all of lowseg
	SKIPE	R,OPENLS	;[171] YES, search from current module
	 TLO	F,FLCLNM	;[171] Flag locals only
LOKSM:				;[171]
	PUSHJ	P,LOK2		;
	 JRST	LOK1		;NOT FOUND
	 CAIA			;OFFSET OR MULT DEF.
	JRST	CPOPJ2		;FOUND
	TRNE	F,MDLCLF	;MULT. DEF.?
	JRST	CPOPJ1		;FAIL - 2ND SKIP
	MOVEM	T,TEM3		;OFFSET - SAVE IT
	MOVEM	W1,TEM4		;SAVE PTR
LOK1:	PUSHJ	P,GHSSYP	;GET HISEG SYM TBL PTR
	 JRST	[SKIPN	TEM3	;OFFSET FOUND?
		 JRST	CPOPJ	;NO - FAIL
		 JRST	LOK15]	;YES - USE IT
	MOVE	T,TEM8		;RESTORE VALUE
	MOVEI	R,(TT)		;
	PUSHJ	P,LOK2
	 JRST	CPOPJ		;NOTHING FOUND
	 CAIA
	JRST	CPOPJ2		;EXACT MATCH
	JUMPE	T,CPOPJ1	;2ND SKIP ON MULT DEF
	TRNN	F,NEARST	;LOOKING FOR THE NEAREST ABOVE?
	JRST	LOK13		;NO
	CAML	T,TEM3		;YES - NEW VALUE CLOSER?
	JRST	CPOPJ1		;YES
	JRST	LOK15		;NO - USE THE OLD VALUE

LOK13:	SKIPE	TEM3		;OFFSET FOUND FOR LOSEG TBL?
	CAMG	T,TEM3		;YES - A BETTER ONE?
	JRST	CPOPJ1		;NO
LOK15:	MOVE	T,TEM3		;YES - UPDATE VALUES
	MOVE	W1,TEM4
	MOVE	R,TEM4
	JRST	CPOPJ1		;2ND SKIP
LOK2:	PUSHJ	P,FIXSYR	;FIX SYM TBL PTR IN (R)
	JUMPGE	R,LOK16		;[104] IF OFF END OF TABLE, GET OUT
	MOVE	W2,(R)		;GET NEXT SYM
	TLNN	W2,PNAME	;IGNORE PROG NAMES
;[171]	JRST	LOK3
	 JRST	LOK3A		;[171] Jump over this entry
	TLNE	W2,GLOBAL	;GLOBAL?
	TLNE	F,FGLSNM	;GLOBALS OK?
	TLZA	W2,LOCAL!GLOBAL	;YES - ZERO BITS
	JRST	LOK3		;NO - PASS IT
	TLNE	W2,PNAME	;SHOULD BE CLEAR NOW
	JRST	LOK3
	MOVE	W2,1(R)		;OK - GET VALUE
	MOVE	TT,T		;[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	T,W2		;SAME AS SIGN FOR SYMBOL?
	JUMPGE	T,LOKSSN	;YES. EASY CASE
	TXC	TT,1B0		;NO. MAKE SIGNS THE SAME
	SUB	TT,W2		;SUBTRACT IS SAFE NOW
	TXCA	TT,1B0		;FIX UP SIGN AGAIN
LOKSSN:	SUB	TT,W2		;[135] GET OFFSET
	XOR	T,W2		;EITHER WAY, RESTORE T

	JUMPL	TT,LOK6		;IGNORE IF WRONG DIRECTION
	JUMPE	TT,LOK5		;EXACT MATCH?
	CAMGE	TT,BESTVA	;NO, BUT BETTER VALUE?
	JRST	LOK4		;YES

LOK3:	ADD	R,[2,,2]	;TRY NEXT ENTRY
	JUMPL	R,LOK2		;
	JRST	LOK16		;[171] Finish up
LOK3A:	TRNE	TF,TYPCMD	;[171] 'TYPE'?
	 TLZN	F,FLCLNM	;[171] And looking for local symbol?	
	  JRST	LOK3		;[171] NO keep looking
	MOVE	R,.JBSYM	;[171] IF 'TYPE' we're finished searching
	JRST	LOK2		;[171] Open module but no match,
				;[171] Restart search from beginning
LOK16:	JUMPE	W1,CPOPJ	;[104] FAIL IF NONE FOUND
	TRNE	F,NEARST	;FOR NEAREST?
	JRST	LOK10		;YES
	CAMN	T,1(W1)		;EXACT MATCH?
	JRST	CPOPJ2		;YES - SUCCEED
	MOVE	W2,1(W1)	;NO, SO GET BEST VALUE
	SUB	T,W2		;GET OFFSET
	JRST	CPOPJ1		;EXIT FOR OFFSET

LOK4:	TRNE	F,NEARST	;NEAREST?
	JRST	LOK3		;YES - THIS ISN'T IT
	PUSHJ	P,TRUVAR	;VARIABLE ?
	JRST	[MOVE	W2,TRUFST
		 CAIN	W2,27		;"M" LABEL?
		 JRST	LOK3		;YES IGNORE
		 JRST	.+1]
	SKIPN	W2,MATHSM	;SPECIFIC SYMBOL??
	JRST	LOK4A		;NO
	PUSH	P,W1		;SAVE W1
	MOVE	W1,(R)		;GET SYMBOL
	TLZ	W1,PNAME	;FIX UP A BIT
	CAMN	W1,W2		;IS IT THE ONE WE ARE LOOKING FOR
	JRST	LOK4B		;YES
LOK4C:	POP	P,W1		;NO -RESTORE
	JRST	LOK3		;IGNORE
LOK4B:	POP	P,W1
LOK4A:	MOVEM	TT,BESTVA	;BETTER MATCH
	MOVE	W1,R
	JRST	LOK3		;KEEP GOING
LOK5:	TRNE	F,NEARST	;NEAREST ONLY?
	JRST	LOK3		;YES - PASS IT BY
	PUSHJ	P,TRUVAR	;YES - F10 SYMBOL?
	 JRST	[TRNE	F,ID	;NO - LABEL - MATCH ALREADY?
		 JRST	LOK12	;     YES - CHECK HIERARCHY
		 JRST	LOK14]	;     NO - TAKE IT
	SKIPN	W2,MATHSM	;ACCEPT ONLY THIS SYMBOL IF SET
	JRST	LOK7
	PUSH	P,W1		;SAVE W1
	MOVE	W1,(R)		;GET SYMBOL
	TLZ	W1,PNAME
	CAME	W1,W2
	JRST	LOK4C		;IGNORE IT IF NOT THE SAME
	POP	P,W1		;REMOVE POP
	MOVE	W1,R
	MOVE	W2,(R)		;LETS TAKE IT AND RUN
	TLNE	W2,GLOBAL	;GLOBAL?
	JRST	LOK11		;YES DONE
	JRST	CPOPJ2		;ALSO DONE
LOK7:	TRON	F,ID		;USE THIS SYMBOL
	JRST	LOK9		;FIX UP
LOK8:	TRO	F,MDLCLF	;SECOND SYM FOUND - MULT. DEF.
	MOVE	W2,(R)		;GET SECOND SYMBOL FOUND
	TLNN	W2,GLOBAL	;SEE IF IT IS A GLOBAL
	JRST	LOK8A		;OTHER LOCAL - GO SEE IF EQUIVALENT DEFINITION
	MOVE	W1,R		;GLOBAL HAS HIGHER PRIORITY
	JRST	LOK11		;DONE
LOK8A:	JUMPN	TT,CPOPJ1	;NOT EXACT MATCH
	MOVE	T,(W1)		;GET PREVIOUS FOUND
	TLZ	T,PNAME		;JUST RADIX-50 NAME
	TLZ	W2,PNAME	;ALSO FOR NEW FOUND
	CAME	W2,T		;SAME NAME
	JRST	CPOPJ1		;NO
	JRST	LOK11		;YES - MAY BE COMMON BECAUSE
				; SAME NAME + SAME ADDRESS

LOK9:	MOVE	W1,R		;UPDATE PTR
	MOVE	W2,(R)		;GET SYM
	TLNE	W2,GLOBAL	;GLOBAL?
	JRST	LOK11		;YES - DONE
	SETZM	BESTVA		;BEST MATCH
	JRST	LOK3		;AND ON

LOK6:	TRNN	F,NEARST	;LOOKING FOR NEAREST?
	JRST	LOK3		;NO - IGNORE
	CAMG	TT,BESTVA	;CLOSER MATCH?
	JRST	LOK3
	MOVEM	TT,BESTVA	;YES - UPDATE BEST VALUE
	MOVE	W1,R		;SAVE PTR
	JRST	LOK3		;AND GO ON

LOK11:	SKIPA	T,1(W1)
LOK10:	SKIPA	T,1(W1)		;GET VALUE
	AOS	(P)		;DOUBLE SKIP HERE
	JRST	CPOPJ1		;ALL THATS NEEDED

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

LOK14:	MOVE	W2,TRUFST	;GET THE LABEL TYPE
	CAIN	W2,27 		;"M" ?
	JRST	LOK3		;YES IGNORE
	MOVEM	W2,LOKFST	;SAVE IT
	JRST	LOK7		;AND USE THIS SYMBOL
;	ROUTINES TO TYPE A SYMBOL IN THE NON OPEN SECTION

SYMBOL:	PUSHJ	P,SAV2AC	;SAVE T,W1
	TRNE	F,MDLCLF	;SYMBOL ALREADY TYPED
	JRST	SYMBL2		;DISPLAY ALTERNATE NAME

SYMBL3:	MOVE	T,(R)		;GET THE OUTPUT STRING
	PJRST	SPT1		;TYPE IT AND RESTORE T,W1

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



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

SECTON:	PUSHJ	P,SAV2AC	;SAVE T,W1
	MOVE	T,(R)		;GET NAME OF SECTION
	CAMN	T,SECSAV	;ALREADY TYPED?
	POPJ	P,		;YES - MUST BE A RANGE
	MOVEM	T,SECSAV	;SAVE THE NEW ONE BEING TYPED
	TRNE	TF,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 T AND W1

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

;OFFSET TYPES THE SYMBOL WHOSE VALUE IS IN AC T.  SUBSCRIPTS ARE
;HANDLED.  THERE IS A SKIP RETURN ON SUCCESS, FAIL IF SYMBOL NOT FOUND.
OFFSET:	SKIPN	T,T		;[167]Are we looking for a real symbol?
	 POPJ	P,		;[167]NO
	MOVEM	T,TEM5		;[167]Save current symbol value
	CAMN	T,FRMSAV	;[167]Are we looking for a formal?
	 JRST	OFF1		;[167]YES
	EXCH	T,SAVLOC	;[167]T=input symbol, SAVLOC=suspected array
	MOVEM	T,TEM6		;[167]Save SAVLOC
;[170]	TLNE	TMOD,C.		;[167]Character?
	TRNE	TMOD,C.		;[170]Character?
	 JRST	CHARAY		;[167]YES, different processing
	PUSHJ	P,RAYNAM	;[167]Does symbol denote array?
	 JRST	OFF1A		;[167]Doesn't look that way

;OFFSET:	MOVEM	T,TEM5
;	EXCH	T,SAVLOC	;UPDATE SAVLOC
;	MOVEM	T,TEM6		;BUT SAVE OLD VALUE
;	PUSHJ	P,RAYNAM	;IS (SAVLOC) AN ARRAY START ADDRESS?
;	  JRST	OFF1		;NO
;	TLNE	TMOD,C.		;[160]Character string?
;	 JRST	OFFCHR		;[160]YES.
	MOVE	T,TEM5		;GET VALUE OF SYM
	TRO	F,SILENT	;SILENCE
	PUSHJ	P,LOOK		;GET SYM PTR
	 JRST	E5		;
	 JFCL
	MOVE	W1,R		;GET PTR
	MOVEI	W2,0		;YES, OFFSET IS ONE
	JRST	OFF2		;GO




;OFF1:	TLNE	TMOD,C.		;[160]Character string?
;	 JRST	SCLCHR		;[160]YES.
;	MOVE	T,TEM6
;	JUMPE	T,OFF1A		;SAVLOC NOT AVAILABLE
;[BL]	means that call came from conditional pause

OFF1:	;MOVE	T,TEM6		;[167]Restore input symbol[SAVLOC]
;	MOVEM	T,SAVLOC	;[167]Put it back
	PUSHJ	P,RAYNAM	;[167]Now see if IT'S an array
	
;	 MOVEM	T,SAVLOC	;RESTORE SAVLOC
;	PUSHJ	P,RAYNAM	;SET UP DOUBLE IF APPROPRIATE
;	  JRST	OFF1A		;NOT AN ARRAY KNOWN
	TRNE	F,FORMAL	;[110] A FORMAL ARRAY?
	JRST	OFF6		;[110] YES, GO TYPE SPECIALLY

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

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

OFF7:	MOVE	T,TEM5		;[110] RESTORE T
	TRO	F,SILENT	;WE DONT WANT TO TYPE THE SYMBOL
	PUSHJ	P,LOOK		;NOT ARRAY START
	  POPJ	P,		;[110] NOT FOUND
	 MOVE	W2,T		;OFFSET - GET IT
	JRST	OFF2		;FOUND - GO PRINT
OFF1A:	MOVE	T,TEM5		;TRY TO FIND THE REQUESTED SYMBOL
	TRO	F,SILENT	;DONT PRINT NOW
	PUSHJ	P,LOOK
	  POPJ	P,		;[110] NOT FOUND
	  SKIPA	W2,T		;MAY BE AN ARRAY
	JRST	[MOVE	W1,R	;WAS A SINGLE VAR - FOUND
		 PUSHJ	P,SPT	;TYPE NAME
		 JRST	OFF5A]	;TYPE LOC IF NOT CURRENT
	MOVEM	R,TEM6		;KEEP SYMBOL NAME FOUND
	MOVEM	W2,TEM		;KEEP OFFSET
	MOVE	T,TEM5		;GET BACK ORIGINAL ADDR
	SUB	T,W2		;MINUS OFFSET SHOUD BE ARRAY START
	MOVEM	T,SAVLOC	;MAY BE IT IS
	PUSHJ	P,RAYNAM	;TRY IT
	  JRST	ERR34		;NOT
	MOVE	W1,TEM6		;GET BACK SYMBOL NAME
	MOVE	W2,TEM		;AND OFFSET
;;;;	JRST	OFF2		;GO PRINT IT

OFF2:	MOVEM	W2,TEM		;SAVE OFFSET
	PUSHJ	P,SPT		;PRINT SYMBOL
	openp
	PUSH	P,SAVLOC	;SAVE SAVLOC AROUND OFFSET PRINT
	PUSH	P,AR		;AR TOO
	MOVEM	P,DIMTOT	;AND FREEZE PD LIST
	SETZM	PUTTER
	SETZM	COUNT		;PREPARE
	MOVE	W1,TEM
	TRZE	F,DOUBLE	;[112] DOUBLE WORD ARRAY?
	LSH	W1,-1		;YES - ONLY HALF OFFSET
	MOVEM	W1,TEM7		;SAVE W1
	MOVEI	T,1
	MOVEM	T,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	T,TEM1
	SUB	T,TEM
	AOJ	T,		;FORM RANGE FOR THIS DIM
	IMULM	T,RP
	AOS	COUNT		;INC COUNT OF # OF DIMS
	PUSHJ	P,MORDIM	;MORE?
	 CAIA
	JRST	OFF3		;YES
	MOVE	AR,COUNT	;NO
	MOVE	T3,P		;COPY PD LIST
	MOVE	W1,TEM7		;RESTORE W1

OFF4:	POP	T3,T2		;GET LAST RP
	POP	T3,T		;LOWER SUBSCRIPT
	IDIV	W1,T2		;VALUE OF FIRST ELEMENT
	ADDI	W1,(T)		;CORRECT FOR USERS OFFSET
	HRRZM	W1,1(T3)	;SAVE FOR PRINTING
	EXCH	W1,W2		;GET OFFSET REMAINDER
	SOJG	AR,OFF4

	SKIPA	AR,COUNT	;RESET DIM CNT

OFF5:	jrst	[stype(</,/>)
		jrst	.+1]
	HRRE	T,1(T3)		;FIRST ELEMENT
	PUSHJ	P,TYP0		;TYPE IT DECIMAL
	ADDI	T3,2		;NEXT ELEMENT
	SOJG	AR,OFF5

	closep
	MOVE	P,DIMTOT	;RESET PD LIST
	POP	P,AR
	POP	P,SAVLOC	;RESTORE
OFF5A:	MOVE	T,PNAMSV	;GET SECTION NAME OF SYM
	CAMN	T,OPENED	;IS IT CURRENT?
	JRST	CPOPJ1
	MOVEI	R,PNAMSV
	PUSHJ	P,SECTON	;NO - TYPE IT IF APPROPRIATE
	SETZM	FRMSAV		;[167]Reset formal
	JRST	CPOPJ1

OFF6:	SKIPE	MATHSM		;[110] ANY NAME TO TYPE?
	SKIPN	FRMSAV		;IS THERE A FORMAL NAME
	 JRST	OFF7		;[110] NO, NOT FOUND
	TYPE	(Formal parameter ) ;TELL THE USER
	MOVEI	W1,MATHSM	;TYPE NAME OF FORMAL ARGUMENT
	PUSHJ	P,SPT		;SO HE KNOWS
	LINE
	SETZM	MATHSM		;FORGET ABOUT SPECIFIC NAME
	MOVE	T,FRMSAV	;GET ADDRESS OF ACTUAL PAR.
	TRO	F,SILENT	;[110] NO SYMBOL TYPEOUT
	PUSHJ	P,LOOK		;TRY IT
	 JRST	OFF7		;[110] NOT FOUND
	 SKIPA	W2,T		;OFFSET - GET IT
	JRST	[MOVE	W1,R	;EXACT ADDR FOUND - TYPE NAME
		 PUSHJ	P,SPT	;
		 JRST	OFF5A]	;IF REQUIRED TYPE NAME OF SECTION
	JRST	OFF2		;CONTINUE
;	SYMBOL OUTPUT SUBROUTINE

SPT:				;RADIX 50 SYMBOL PRINT
	LDB	T,[POINT 32,0(W1),35]	;GET SYMBOL
SPT1:	CAME	T,PRGNAM	;COMPARE NAME WITH MAIN PROG NAME
	CAMN	T,[SQUOZE 0,MAIN.]
	JRST	SPT8
	PUSH	P,T		;SAVE T OVER THE NEXT FEW LINES
	MOVEI	W1,T		;SET UP FOR TRULBL
	PUSHJ	P,TRULBL	;IS THIS A TRUE-LABEL
	 CAIA			;NO
	JRST	SPT5		;YES - SEE IF SOURCE LINE

SPT6:	POP	P,T		;RESTORE T = SYMBOL
	MOVEI	W1,SPT4		;SPECIAL TREATMENT FOR LAST CHARACTER
	PUSH	P,W1		;SAVE ON STACK
SPT3:	TLZ	T,PNAME		;RADIX 50 PART ONLY
	IDIVI	T,50
	HRLM	W1,0(P)
	JUMPE	T,[SETOM W1
		   JRST	.+2]
	PUSHJ	P,SPT3
	HLRZ	T,(P)
	ADDI	T,260-1
	CAILE	T,271
	ADDI	T,301-272
	CAILE	T,332
	SUBI	T,334-244
	CAIN	T,243
	MOVEI	T,256
	ANDI	T,177		;USE 7 BIT CODE
	JUMPL	W1,SPT7		;FIRST TIME ROUND IS SPECIAL
	EXCH	T,SAVCHR	;SAVE AS LAST CHARACTER
	PJRST	TOUT		;DISPLAY CHARACTER

SPT8:	TYPE	(MAIN PROGRAM)
	POPJ	P,

SPT4:	MOVE	T,SAVCHR	;GET BACK THE LAST CHARACTER
	JUMPN	W1,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	W1,26		;GET RADIX 50 'L'
	CAMN	W1,TRULST	;IS THIS A SOURCE LINE REFFERENCE
	jrst	[TYPE(L#)
		jrst	.+1]
	JRST	SPT6		;DISPLAY THE SOURCE LINE TAG

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

SPT7:	CAIL	T,"0"
	CAILE	T,"9"
	TDZA	W1,W1		;ZERO IF FIRST CHAR NOT NUMERIC
	HRRZI	W1,-1		;.GT. ZERO IF FIRST CHAR IS NUMERIC
	MOVEM	T,SAVCHR	;SAVE LAST CHARACTER
	POPJ	P,
	SUBTTL	GENERAL NUMBER INPUT ROUTINE

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

GETNUM:	TDZ	F,[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	T1,"."		;[116] POSSIBLY A LOGICAL SYMBOL?
	TRZ	TF,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	T1,POWER	;LAST CHAR WAS A DELIMITER
	MOVE	T,[JRST GETOUT]	;[120] IN CASE WE GO TO LOGICL
	MOVEM	T,DONE		;[120] THIS IS HOW WE'LL WANT TO RETURN
	CAIE	T1,","		;ALLOW , AS # DELIMITER
	CAIN	T1,")"		;ALLOW ALSO RIGHT PARENS
	JRST	POWER		; DELIMITER SEEN - CLEAN UP

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

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

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

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

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

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

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

LOGICL:	TRZN	TF,LGCLEG	;[116] ARE LOGICAL SYMBOLS LEGAL?
	JRST	ERR7		;[116] NOPE, BAD STUFF
	TLZ	F,FPF		;[116] TURN OFF FLOATING POINT FLAG
	TRZ	F,POWF		;[116] AND POWER FLAG (SET WHEN "." SEEN)
	PUSHJ	P,EITHR5	;[116] LET'S GET THE WHOLE WORD
	CAIE	T1,"."		;[116] DOES IT END WITH PERIOD?
	JRST	ERR7		;[116] NO, CAN'T BE A LOGICAL SYMBOL
	CAME	T2,[SIXBIT /TRUE/]	;[116] IS IT .TRUE.?
	JRST	FALSE		;[116] NOPE, COULD BE .FALSE.
	SETO	T,		;[116] IT'S .TRUE.! RETURN -1
	TRO	TF,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	T2,[SIXBIT /FALSE/]	;[116] IS IT .FALSE.?
	JRST	ERR7		;[116] NO, JUNK
	SETZ	T,		;[116] IT'S .FALSE.! RETURN 0
	TRO	TF,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	F,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	F,SIGN		;HAS A SIGN BEEN SEEN BEFORE?
	JRST	ERR7		;YES - REJECT
	CAIE	T,"+"		;NO SPECIAL ACTION FOR PLUS
	TLO	F,MF		;SET THE MINUS FLAG
	POPJ	P,		;
NUM:	ANDI	T,17		;T HOLDS CHARACTER
	TLNE	F,FPF
	JRST	NM1
	MOVE	W,SYL
	TLNE	W,700000	;TEST FOR PENDING WORD OVERFLOW
	JRST	ERR7		;BAD VALUE
	LSH	W,3
	ADD	W,T
	MOVEM	W,SYL
	MOVE	W,DEN
	IMULI	W,12		;CONVERT TO DECIMAL
	ADD	W,T
	MOVEM	W,DEN
	POPJ	P,

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

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

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

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

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

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


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

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

;	FLOATING POINT OUTPUT

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

TFLOT1:	TLNN	A, 400
	PJRST	FP7		;DECIMAL PRINT

	MOVEI	B,0
	CAMGE	A,FT01
	JRST	FP4

	CAML	A,FT8
	AOJA	B,FP4
FP1A:	MOVEI	C,0

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

	FMPR	A,@FCP+1(B)
	IORI	W2,1
FP4B:	AOJN	C,FP4A
	PUSH	P,W2		;SAVE EXPONENT
	PUSH	P,FSGN(B)	;SAVE "E+" OR "E-"
	PUSHJ	P,FP3		;PRINT OUT FFF.FFF PART OF NUMBER
	POP	P,W1		;GET "E+" OR "E-" BACK
	PUSHJ	P,TEXT
	POP	P,A		;GET EXPONENT BACK
FP7:	IDIVI	A,12		;DECIMAL OUTPUT SUBROUTINE
	AOS	TEM1
	HRLM	B,(P)
	JUMPE	A,FP7A1
	PUSHJ	P,FP7

FP7A1:	HLRZ	T,(P)
FP7B:	ADDI	T,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	A, FT0(C)
	CAMGE	A, FT(C)
	Z	FT0(C)

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

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

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

SIXBP:	MOVEM	T,LWT
	MOVNI	W2,6		;SIXBIT PRINTER
	MOVE	W1,LWT
SIXBP1:	MOVEI	T,0
	ROTC	T,6
	ADDI	T,40
	PUSHJ	P,TOUT
	AOJL	W2,SIXBP1
	POPJ	P,

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

ife tops20,<
LISTEN:	INCHRS	T		;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,tf		;save tf
	push	p,r		;save r
	hrrzi	tf,.priou	;get terminal output designator
	rfmod%			;get terminal JFN word
	tlze	r,(tt%osp)	;[114]clear ^o
	  sfmod%		;[114]set new terminal JFN word
	hrrzi	tf,.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,r		;restore r
tfpopj:	pop	p,tf		;restore tf
	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	T,T1		;PRINT (T1) AS A SIXBIT WORD
	PJRST	SIXBP		;PRINT IT


;	ROUTINE TO CLEAR OUT REST OF USERS LINE

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

CLRLI2:
ife tops20,<
	SKPINL			;SKIP IF ANY CHARS THERE
	  POPJ	P,>		;LINE CLEAR, end of conditional
ifn tops20,<
	push	p,tf		;save tf
	movei	tf,.priin	;[121] get primary input device
	sibe%			;more to come?
	caia			;yes
	jrst	tfpopj		;no
	pop	p,tf>		;restore tf, end of conditional
	PUSHJ	P,GCHR		;GET THE NEXT CHAR
	SKIPL	TERMK		;NOW DONE?
	POPJ	P,		;YES
	CAIN	T1," "		;SPACE OR TAB?
	JRST	CLRLI2		;IGNORE IT
	SKIPE	DELCHR		;DELIMITER SAVED FROM ASCII ACCEPT?
	CAME	T1,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	(T1)		;TYPE IT
	JRST	OUTLIN		;NEXT

GCHR:	XCT	GETCHR		;GET CHARACTER
	PUSHJ	P,GETSK2	;SET UP DELIMETER FLAGS
	JUMPN	T1,CPOPJ
	MOVEI	T1," "		;RECONVERT NULLS TO SPACES
	POPJ	P,
TYP0:	MOVEI	ODF,^D10	;PREPARE FOR DECIMAL PRINT
	PJRST	FTOC		;DO IT

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

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

TYP5:	PJRST	TXT341		;SHOW AS ASCII

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

GETARG:	HRR	T3,SAVACS+16	;[147] GET USERS AC 16 I.E. ARG BLOCK?
	HLL	T3,-1(T3)	;L.H. =-# OF ARGS ,,R.H. = ADDRESS
	JUMPGE	T3,CPOPJ	;APPEARS TO BE NO ARGS

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



TYP10:	F10.6			;0 = UNDEFINED
	F10.6			;1 = LOGICAL
	F10.6			;2 = SINGLE  PRECISION INTEGER
	TYP1			;3 = ILLIGAL
	F10.6			;4 = SINGLE PRECISION REAL
	TYP1			;5 = ILLEGAL
	TYP4			;6 = OCTAL
	F10.3			;7 = LABEL
	F10.6			;10= DOUBLE PRECISION REAL (D-Floating)
	F10.4			;11= DOUBLE PRECISION INTEGER
	F10.5			;12= DOUBLE OCTAL
	F10.6			;13= [137] DOUBLE PRECISION REAL (G-Floating)
	F10.6			;14= COMPLEX
;	TYP1			;15= ILLEGAL
	TYPCS			;15= [162]Character string
	TYP1			;16= ILLEGAL
	TYP5			;17= ASCII STRING
;	ROUTINE TO 'TYPE' AN ARGUMENT OF A SUBROUTINE CALLING LIST
;	ENTER WITH T= VALUE OF 1ST. ARG
;	T2= ARG TYPE
;	T3=POINTER IN SUBROUTINE ARGBLOCK
;[BL]EXTENDED ADDRESSING?
FOROTS:	MOVEI	T,@(T3)		;GET SECOND ARGUMENT ADDRESS
	MOVE	T,1(T)		;GET SECOND ARGUMENT
	MOVEM	T,ARGVAL+1	;STORE SECOND ARG
	MOVE	T,@(T3)		;GET FIRST ARGUMENT

;	ENTRY TO 'TYPE' A SINGLE VALUE IN T - ARG TYPE IN T2

FOROUT:	MOVEM	T,ARGVAL	;SAVE FIRST ARGUMENT FOR TYPING
DPBTYP:	DPB	T2,[POINT 4,M2.,12]	;PLACE ARG TYPE
	JRST	@TYP10(T2)	;DISPATCH ACORDING TO ARGUMENT TYPE

F10.6:	MOVEI	16,M1.		;[143] GET ADDRESS OF FORMAT BLOCK
	PUSHJ	P,OUT.##	;[143]
F10.8:	MOVEI	16,M2.		;[143] 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	T,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	T,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 T2

FORINP:	XCT	DPBTYP		;PLACE ARGUMENT TYPE FOR INPUT
	MOVEI	T3,1		;[127] SET UP COUNTER
	MOVE	T,[POINT 7,NUMBUF]	;[127] AND POINTER TO NUMBER BUFFER
	SETOM	TERMK		;[127] SET UP TERMINTATOR FLAG
	PUSHJ	P,GETSKB	;[127] GET A NON-BLANK CHARACTER
	SKIPGE	TERMK		;[127] EOL?
	JRST	GOTCH		;[127] NO.
	SETZM	ARGVAL		;[127] YES, NO NEED FOR FOROTS
	SETZM	ARGVAL+1	;[127] JUST SET VALUE TO ZERO
	POPJ	P,		;[127] AND RETURN
GOTCH:	IDPB	T1,T		;[127] STORE IT
	PUSHJ	P,LOADCH	;[127] GET NEXT CHAR.
	SETOM	TERMK		;[127]
	PUSHJ	P,GETSK2	;[127] CHECK IT OUT
	JUMPE	T1,FORIN2	;[127] VALID STUFF?
	CAIGE	T3,NMBFSZ*5	;[127] YES, SEE IF THERE'S ROOM LEFT IN BUFFER
	AOJA	T3,GOTCH	;[127] THERE'S ROOM, DUMP IT
	TYPE (<%FDTECI Buffer full excess characters ignored>)	;[127]
	LINE			;[127] ERROR, NOT ENOUGH ROOM
FORIN2:	MOVEM	T3,M4.		;[127] SET UP CHARACTER COUNT
	MOVEI	16,M4.		;[111] USE FORMAT(G,G) FOR READING
	PUSHJ	P,DEC.##	;[143]
	PJRST	F10.8		;[111] ACTION


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


;ARG BLOCK FOR CALLS TO FOROTS

	777773,,0		;FIVE ARGUMENTS FOLLOW
M1.:	0,,-1			;OUTPUT TO TTY =-1
	0,,0			;END=
	0,,0			;ERR=   POSSIBLY SHOULD BE 0,,RET
	340,,FORMAT		;ASCII,,FORMAT
	0,,2			;TWO WORDS OF FORMAT INFO
	0,,0			; ?
M2.:	1200,,ARGVAL		;DATA 0-8/ARGTYP 9-12/ARGADDRESS 13-35
M2.I:	4000,,0			;CALL FIN - MAY BE USED FOR COMPLEX
M2.F:	4000,,0			;CALL FIN
ARGVAL:	BLOCK	2		;STORAGE FOR DOUBLE WORD ARGUMENTS
FORMAT:	ASCII /('+'G$,G$)/	;[144] SUPPRESS CR AFTER OUTPUT

	-5,,0
M3.:	0,,-1
	0
	0
	340,,FORM2
	0,,2
FORM2:	ASCII	.(1H+$).

	-6,,0			;[127][111] 6 ARGS
M4.:	Z			;[127][111] NO. OF CHARS TO BE DECODED
	0,,0			;[111] END=
	0,,0			;[111] ERR=
	340,,FMREAD		;[111] FORMAT(G,G) FOR READ
	0,,1			;[127][111] 1 WORD OF FORMAT
	100,,NUMBUF		;[127] BUFFER LOCATION
FMREAD:	ASCII/(G,G)/		;[127][111] FORMAT FOR READING
SUBTTL	GENERAL SUBROUTINES



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



CHKADR:	PUSH	P,T		;SAVE T FOLKS !
	MOVEI	TT,(T)
	CAIGE	TT,.JBDA	;ABOVE .JBDA
	JRST	TPOPJ		;FAIL - ILLEGAL
	CAMG	TT,.JBREL	;BELOW HERE IS OK TOO
	JRST	TPOPJ2
	MOVE	T4,R		;SAVE (R)
	PUSHJ	P,GSTAH		;GET THE START ADDR OF THE HISEG
	EXCH	T4,R
	CAIGE	TT,10(T4)	;
	JRST	TPOPJ
	HRRZ	T4,.JBHRL	;GET TOP OF HISEG
	CAILE	TT,(T4)		;
	JRST	TPOPJ
	JRST	TPOPJ1		;DONE

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

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

TPOPJ2:	POP	P,T		;RESTORE T
	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
	  JRST	[TYPE (<%Trying to write in high segment; wrong mode???>)
		JRST	RET	];[163]Give user another chance
	POPJ	P,		;[163]Let user go ahead

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	T5,(T)		;[163]Load presumptive descriptor
	 JUMPLE	T6,BSIZER	;[163]"%Null string length;wrong mode?"
;[166]	TRNE	T5,1B13		;[165]Error if indirect bit set
;[166]	 JRST	BPTRER		;[163]
	TLNE	T5,(1B13)	;[172]Error if indirect bit set
	 JRST	BPTRER		;[172]

	IBP	T5		;[163]Bump pointer
	LDB	T,[POINT 6,T5,11] ;[163]Get byte size
	CAIE	T,BYTSIZ	;[163]Does it look like a byte pointer?
	 JRST	BPTRER		;[163]NO
	LDB	T,[POINT 6,T5,05] ;[163]Bits left in word
	IDIVI	T,BYTSIZ	;[163]Put remainder in T2
				;[163]Since T=T4, this destroys T5
	CAIE	T+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:	SKIPN	T3,OLDOPN	;GET THE OLD NAME
	POPJ	P,		;NONE - OK
	SETZM	OLDOPN
	CAMN	T3,OPENED	;SAME AS THE CURRENT?
	POPJ	P,
	MOVEM	T3,SYM		;NO - SAVE IT
IMPOPN:	LINE
	stype(.[Implicit OPEN .)
	MOVE	T,SYM		;GET SYMBOL
	PUSHJ	P,SPT1		;TYPE PROGRAM NAME
	type(])
	LINE
	PJRST	SETNAM		;SET IT AND DONE
;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 T2 LEFT JUSTIFIED, BREAK IN T1
;
;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	T1,CFLPTR	;CURRENT POSITION IN CORE FILE
	SUBI	T1,CFSIZ-1	;[132] REMOVE OFFSET
	SUB	T1,CFLST	;[132] PREVENT CORE FILE OVERFLOW
	JUMPL	T1,I2CFL2	;[132] IF WE'RE NOT IN LAST WORD GO AHEAD
	MOVE	T1,CFLPTR	;[132] GET CORE FILE POINTER
	LSH	T1,^D-30	;[132] GET OFFSET INTO WORD
	CAILE	T1,10		;[132] JUST ONE BYTE LEFT?
	JRST	I2CFL2		;[132] NO,  GO AHEAD
	MOVEI	T1,12		;[132] MAKE SURE <LF> IS LAST CHAR IN BUFFER
	IDPB	T1,CFLPTR	;[132]
	JRST	ERR12		;[132]
I2CFL2:	PUSHJ	P,LOADCH	;[132] GET USERS CHARACTER
	IDPB	T1,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	T,[pushj p,loadch]
	TLNN	F,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	T,[POINT 7,CFLBUF]
	MOVEM	T,CFLPTR	;SET UP GENERAL CORE FILE POINTER
	HRRZM	T,CFLST		;	HOLDS START OF CURRENT CORE FILE
	TLNN	F,OFCFL		;OUTPUTTING TO CORE FILE?
	SKIPA	T,[PUSHJ P,I2CFIL]	;YES
	MOVE	T,[ILDB T1,CFLPTR]
XCTSET:	MOVEM	T,GETCHR	;SET UP FOR FUTURE XCT

TTYSET:	SETOM	TERMK			;PREPARE TERMINATOR FLAG
	PUSHJ	P,GETSKB		;SKIP LEADING BLANKS & TABS
EITHR5:	MOVEI	T2,0			;SET WORD TO ZERO FOR RETURN
	MOVE	T3,[XWD 440600,T2]	;SET SIXBIT BYTE POINTER
;LOOP TO ACCUMULATE AFTER LEADING SPACES & TABS

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

;	HERE IF NOT A NUMBER

GETWD2:	CAILE	T1,"Z"+40	;ABOVE LOWER CASE RANGE ?
	PJRST	GETSK1		;YES - SET BREAK
	CAIL	T1,"A"+40	;LOWER CASE ?
	TRC	T1,40		;YES - CONVERT TO UPPER CASE
	CAIL	T1,"A"		;LESS THAN A ?
	CAILE	T1,"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	T1,40		;CONVER TO SIXBIT
	TLNE	T3,770000	;OVERFLOWED T2 YET ?
	IDPB	T1,T3		;NO STORE NEXT SIXBIT CHR.
	XCT	GETCHR		;GET NEXT CHARACTER
	JRST	GETWLP		;& 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 T
;	NON-SKIP EXIT IF UNKNOWN SYMBOL
;	SKIP EXIT IF OK

FINDST:	EXCH	T,SYM		;SAVE FOR EVALUATION BY 'EVAL'
	MOVEM	T,SYL		;SAVE SYM
	TLO	F,FGLSNM	;FIND GLOBAL SYMBOL
	MOVSI	T,GLOBAL	;ONLY GLOBALS
	MOVEM	T,SYMASK
	PUSHJ	P,FNDSYM	;FIND THE ASSOCIATED ADDRESS
	   POPJ	P,		;NO SUCH SYMBOL
	HRRM	T,GOLOC		;SAVE  ADDRESS FOR DISPATCH IN GOLOC
	MOVE	T,SYL		;GET THE OLD SYM
	MOVEM	T,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	T,RESTORE	;RESTORE USERS ACS
	JRST	@GOLOC		;OF YOU GO
;	REMOVE BLANKS & TABS

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

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

	MOVEM	T1,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	T1,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	TF,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	TF,COMDEL	;DID WE FIND SECOND !
	POPJ	P,		;YES - WE GOT NEXT COMMAND CH
	JUMPN	T1,CLRCO1	;IF VALID CHAR IGNORE (PART OF COMMENT)
	SKIPGE	TERMK		;EOL FOUND
	JRST	CLRCO1		;NO CONTINUE
	TRZ	TF,COMDEL	;NOT IN COMMENT PROCESS ANYMORE
	POPJ	P,		;RETURN TO CALLER

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

readcm:	push	p,tf
	push	p,r
kparse:	move	t,[percsb,,temcsb]
	blt	t,temcsb+.cmgjb
repars:	hrrzi	tf,temcsb
	hrrzi	r,funini
	comnd%
lparse:	hrrzi	tf,temcsb
	hrrzi	r,funkey
	comnd%
	  erjmp	cmderr		;[114] error, go say why
	tlne	tf,(cm%nop)
	  jrst	cmderr		;[114] error, go say why
	tlne	tf,(cm%eoc)
	jrst	cgo
	hrrzi	tf,lparse
	hrrzm	tf,temcsb
cloop:	hrrzi	tf,temcsb
	hrrzi	r,fungar
	comnd%
	  erjmp	cmderr		;[114] error, go say why
	tlnn	tf,(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,W1		;[140]USE W1 AS SCRATCH AC
	PUSH 	P,W2		;[140]USE W2 AS SCRATCH AC
	MOVE	W1,[POINT 7,PARBUF]	;[140]INITIALIZE BYTE POINTER TO PARBUF
	MOVEM	W1,TXTIN
	MOVE	W1,[POINT 7,NEWBUF]	;[140]INITIALIZE BYTE POINTER TO NEWBUF
	MOVEM	W1,TXTOUT
LOOKSP:	ILDB	W1,TXTIN	;[140]GET A CHAR FROM COMMAND LINE
	CAIN	W1,12		;[140]TEST FOR LINE FEED
	JRST	DORSCN		;[140]DO THE RSCAN WITH EXISTING BUFFER(PARBUF)
	CAIN	W1,14		;[140]TEST FOR FORM FEED
	JRST	DORSCN		;[140]DO THE RSCAN WITH EXISTING BUFFER(PARBUF)
	CAIN	W1," "		;[140]TEST FOR A SPACE
	JRST	SPFND		;[140]SPACE FOUND
	IDPB	W1,TXTOUT	;[140]NOT A SPACE, WRITE CHAR TO NEW BUFFER
	JRST	LOOKSP		;[140]CONTINUE TRANSFER OF CHARS
SPFND:	ILDB	W1,TXTIN	;[140]GET A CHARACTER
	CAIN	W1," "		;[140]TEST FOR A SPACE
	JRST	SPFND		;[140]SPACE FOUND, IGNORE
	CAIN	W1,11		;[140]TEST FOR A TAB
	JRST	SPFND		;[140]TAB FOUND, IGNORE
	CAIN	W1,15		;[140]TEST FOR CARRIAGE RETURN
	JRST	CLRSC3		;[140]FOUND, WRITE IT AND LF
	CAIN	W1,12		;[140]TEST FOR LINE FEED
	JRST	CLRSCN		;[140]FOUND, SET UP CALL TO RSCAN WITH NEWBUF
	CAIN	W1,14		;[140]TEST FOR FORM FEED
	JRST	CLRSCN		;[140]FOUND, SET UP CALL TO RSCAN WITH NEWBUF
	CAIN	W1,"!"		;[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	W2," "		;[140]BUT FIRST, WRITE A SPACE
	IDPB	W2,TXTOUT	;[140] TO SEPARATE COMMAND FROM ARG
TRANSF:	IDPB	W1,TXTOUT	;[140]NOW WRITE FIRST CHAR OF ARG OUT
	ILDB	W1,TXTIN	;[140]GET NEXT CHAR OF COMMAND LINE
	CAIN	W1,12		;[140]TEST FOR LINE FEED
	JRST	LFORFF		;[140]FOUND, STORE LF OR FF IN NEW BUFFER
	CAIE	W1,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	W1,TXTOUT	;[140]STORE LF OR FF IN NEW BUFFER
	JRST	CLRSC2		;[140]SET UP CALL TO RSCAN WITH NEW BUFFER
FLUSHC:	ILDB	W1,TXTIN	;[140]GET FIRST CHAR OF COMMENT
	CAIN	W1,12		;[140]TEST FOR LINE FEED
	JRST	CLRSCN		;[140]FOUND,SET UP CALL TO RSCAN WITH NEWBUF
	CAIN	W1,14		;[140]TEST FOR FORM FEED
	JRST	CLRSCN		;[140]FOUND,SET UP CALL TO RSCAN WITH NEWBUF
	CAIN	W1,"!"		;[140]TEST FOR END OF COMMENT
	JRST	SPFND		;[140]FOUND, GET NEXT CHARACTER
	JRST	FLUSHC		;[140]CONTINUE SKIPPING OVER COMMENT
CLRSC3:	IDPB	W1,TXTOUT	;[140]WRITE OUT CR
	MOVEI	W1,12		;[140]GET SET TO WRITE OUT LF TO NEWBUF
CLRSCN:	IDPB	W1,TXTOUT	;[140]WRITE OUT LINE FEED TO NEWBUF(NEW BUFFER)
CLRSC2:	MOVEI	W1,0		;[140]WRITE OUT NULL BYTE TO NEW BUFFER
	IDPB	W1,TXTOUT
	MOVE	W1,[XWD NEWBUF,PARBUF]	;[140]TRANSFER (NEWBUF) TO (PARBUF)
	BLT	W1,PARBUF+^D19	;[140] FOR FORDDT'S PARSING MECHANISM
DORSCN:	HRROI	1,PARBUF	;[140]SET UP PTR TO DO RSCAN
	POP	P,W2		;[140]RESTORE W2
	POP	P,W1		;[140]RESTORE W1
	rscan%
	haltf%
	setz	tf,
	rscan%
	haltf%
	pop	p,r
	pop	p,tf
	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 T
;	RETURN SYMBOL VALUE IN T
;	IN ALL CASES T1=USERS LAST CHARACTER
;
;	ADDITIONALY ENTER AT SIXIN TO ACCEPT LEFT JUSTIFIED SIXBIT
;	IF USERS LEADING CHARACTER IS ALPHA

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

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

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

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

	RECURS <DIMTOT,F,PUTTER,RP,SAVLOC,SYM,MATHSM,TEM,TEM1,DIMCNT,RAY.,FRMSAV>
	TRZ	F,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 SIXBIT TO RADIX 50

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

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

	CAIL	T4,20		;ACCEPT NUMERALS
	CAILE	T4,31		;
	JRST	LETR		;NOT NUMERIC MAY BE ALPHA
	SUBI	T4,17		;CONVERT TO RAD 50
	JRST	R50CHR		;STORE

LETR:	CAIL	T4,41		;IS IT ALPHA
	CAILE	T4,72		;
	JRST	BADSYN		;CANT CONVERT
	SUBI	T4,41-13	;MAKE RAD 50
R50CHR:	IMULI	T3,(T5)		;MOVE UP LAST ENTRY
	ADDI	T3,(T4)		;UP DATE WITH NEW CHARACTER
	TLNE	T1,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 T2 TO RAD 50 IN T3


VALID:	MOVE	T1,[POINT 6,T2]	;GET FIRST CHARACTER
	ILDB	T3,T1		; IN T3
	CAIL	T3,41		;
	CAILE	T3,72		;ALPHA ONLY
	JRST	ERR5		; NOT F40
	PJRST	SIX250
;	SUBROUTINE TO CHECK THAT ALL 6BIT CHARACTERS IN T2 ARE NUMERIC
;	CALL PUSHJ	P,ALLNUM
;	NOT ALL NUMERIC
;	ALL NUMERIC WITH P APPENDED IF A LABEL OR # IF SOURCE LINE

ALLNUM:	MOVE	T3,[POINT 6,T2]	;GET POINTER TO INPUT
ALLMOR:	ILDB	T1,T3		;GET NEXT 6BIT CHAR
	JUMPE	T1,ALLEX	;ALL DONE
	CAIL	T1,20		;TEST WITHIN RANGE
	CAILE	T1,31		;  OF NUMERALS 6BT
	JRST	ALLIN		;NO - SEE IF WE HAVE A SOURCE LINE

	TLNE	T3,770000	;ALL 6 CHARS NUMERIC??????
	JRST	ALLMOR		;  NO - SO DO MORE
	JRST	BADSYN		;  YES - OO NASTY

ALLIN:	TLZE	F,LABEL		;ARE WE ALREADY PROCESSING LABEL INFO.
	JRST	BADSYN		;YES - ANOTHER # MUST BE REJECTED
	MOVEI	T1,"#"		;SEE IF THE USER IS TRYING TO GIVE LINE#
	CAME	T1,LSTCHR	;WAS A # HIS LAST CHARACTER
	JRST	CPOPJ		;NO USEFUL CHARACTERS TYPED - MAYBE GROUP#
	JRST	BADSYN		;YES - COMPLAIN ABOUT PRECEDING GARBAGE

ALLEX:	TLZN	F,LABEL		;ARE WE PROCESSING SOURCE LINES
	JRST	ALLFRM		;NO - SEE IF A FORMAT
	MOVEI	T1,'L'		;YES - GET THE SOURCE LINE TAG
	DPB	T1,T3		;CONVERT TO THE FORM FORTRAN RECOGNISES
	JRST	CPOPJ1		;EXIT AS ALL NUMERIC FROM USER

ALLFRM:	MOVEI	T1,'P'		;SET UP FOR A LABEL
	DPB	T1,T3		;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		T=VALUE OF SYMBOL
;					T1=LAST CHARACTER
;				SUBFLG IS SET IF ARRAY NAME ONLY FOUND

SYMIN:	TLZ	F,LABEL		;CLEAR LABEL PROCESSING FLAG
	SETZM	MATHSM		;CLEAR SYMBOL SAVE
	PUSHJ	P,TTYIN		;GET USER SYMBOL
	JUMPN	T2,SYM12	;NO CHARACTERS - MAYBE SOURCE LINE OR GROUP SPEC.
	CAIE	T1,"#"		;IS THE USER ATTEMPTING TO SPECIFY A SOURCE LINE
	JRST	SYM4		;NO! - WELL MAYBE A GROUP REQUEST

	TLO	F,LABEL		;REMEMBER THIS IS A SOURCE LINE REQUEST
	PUSHJ	P,TTYIN		;GET USERS NEXT INFO.
	JUMPE	T2,BADSYN	;ZERO CHARACTERS HERE IS BAD

SYM12:	PUSHJ	P,ALLNUM	;SEE IF USER TYPED ALL NUMERIC
	  JRST	SYM2		;NO - MUST BE A VARIABLE
	MOVE	T1,LSTCHR	;REINSTATE USERS LAST CHAR
	CAIE	T1,","		;SEE IF A KNOWN DELIMITER FOLLOWS
	JUMPN	T1,BADSYN	;ANY OTHER CHARACTER IS ILLEGAL
	PUSHJ	P,SIX250	;CONVERT SYMBOL TO RADIX 50
	TLOA	F,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
	MOVEM	T3,SYM		;EVAL NEEDS IT HERE
	MOVEM	T3,MATHSM	;SAVE FOR LOOK
	TRZE	TF,DCEVAL	; ? CALL EVAL
	POPJ	P,		;NO DON'T
	PUSHJ	P,EVAL		;'EVAL'UATE THE SYMBOL NAME
	  POPJ	P,		;SYMBOL NOT FOUND
	MOVEM	W1,CRYSYM	;[157]Save addr/RAD50 name
	MOVEM	T,SAVLOC	;SAVE THE VALUE OF THE SYMBOL
	TLNE	F,LABEL		;DID WE HAVE A LABEL?
	JRST	SYM3		;YES - GO PROCESS

	CLEARM	SUBSCR		;ZERO THE OFFSET
	PUSHJ	P,RAYNAM	;DO WE KNOW ABOUT THIS ARRAY
	  CAIA			;NOT DEFINED
	TRO	TF,IMPRNG!ARRAY.;FLAG AS A POSSIBLE RANGE CONDITION
	MOVE	T1,LSTCHR	;GET BACK LAST CHAR SEEN
SYM7:	JUMPE	T1,SYM3		;SEE IF WE HAD A LEGAL DELIMITER
	CAIE	T1,"["		;[ MEANS WE HAVE AN ARRAY DEFINITION TO FOLLOW
	JRST	SYM13		;OBVIOUSLY NOT AN ARRAY DEFINITION
	TLO	F,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	T1,"("		;THE ONLY OTHER ALLOWED CHARACTER IS (
	JRST	SYM6		;CHECK FOR OTHER DELIMITERS

	TRZ	TF,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	T,1		;  WE GET AN ARRAY DEFINITION
	MOVEM	T,RP
	PUSHJ	P,RAYNAM	;HAS THIS SYMBOL AN ARRAY REFERENCE?
	TRZA	F,SUBFLG	;CLEAR THE SUBSCRIPT FLAG
	TRO	F,SUBFLG	;YES - REMEMBER TO CHECK ITS SUBSCRIPTS

SYM10:	PUSHJ	P,EITHER	;GET EITHER SYMBOL OR # FROM USER
	  CAIA			;NUMERIC
	MOVE	T,(T)		;SYMBOL - GET VALUE
	TRNE	F,SUBFLG	;DO WE CHECK SUBSCRIPTS FOR THIS ARRAY
	JRST	SYM8		;  PROCESS SUBSCRIPTS

	JUMPL	T,.+2		;AUTO CORRECTION ON -VE #
	SUBI	T,1		;CORRECT FOR A=A(1)

;	NO MORE SUBSCRIPTS - CHECK DELIMITERS

SYM9:	MOVEM	T,SUBSCR	;SAVE THE NEW OFFSET, WATCH ILL MEM REFS
	CAIE	T1,")"		;RIGHT PARENS MUST DELIMIT THE NO.
	JRST	BADSYN		;   THIS WONT DO EITHER!
	TRZE	F,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
SYM6:	JUMPE	T1,SYM3		;DELIMITER IS GOOD

	CAIE	T1,","		;WE ALLOW COMMA OR MINUS AT THIS STAGE
	CAIN	T1,"-"		;
	JRST	SYM3		;ACCEPT DELIMITER
	CAIE	T1,"."		;DOT IS ALLOWED FOR .LT. IN IF'S
	CAIN	T1,"="		;= IS ALLOWED FOR ACCEPT (INLINE)
	JRST	SYM3
	CAIE	T1,"]"		;] IS A DELIMITER FOR [A(1)]
	CAIN	T1,")"		;) IS A DELIMITER FOR SUBSCRIPTS
	JRST	SYM3		;
	CAIE	T1,"/"		; / IS A DELIMITER FOR DIMENSIONS
	CAIN	T1,":"		; EQUIV TO "/"
	CAIA
	JRST	BADSYN		;ALL ELSE LOOSES
	TRNE	F,SUBFLG!SURGFL	;IF HANDLING SUBSCRIPTS
	JRST	SYM3		;YES
				;NO - THEN THE / SHOULD MEAN A PRINT MODIFIER
	TRZE	TF,ACCPT	;UNLESS AN ACCEPT IS IN PROGRESS
	JRST	SYM3		;TEST FOR AN IMPLIED RANGE
	MOVS	TMOD,TMOD	;PREPARE TO RECIEVE FLAGS IN RH
	PUSHJ	P,OPTION	;GET THE PRINT MODIFIERS
	  JRST	BADSYN		;NUMERICS ????
	MOVS	TMOD,TMOD	;RESET AS LOCALS,,DEFAULT
	JRST	SYM3		;

;	TIDY UP BEFORE EXIT

SYM3:	MOVE	T,SAVLOC	;GET THE SYMBOL VALUE
	TRZE	F,FORMAL	;WAS THE BASE A FORMAL ARRAY PARAMETER
;[BL]	Character arrays will never be FORMALS /ahm/
	SKIPE	T,FRMSAV	;YES - START AT THE FORMAL ADDRESS
	CAIA
	JRST	ERR38		;UNLESS IT'S ZERO
	MOVE	T1,LSTCHR	;RESTORE USERS LAST CHARACTER
	TLZE	F,LABEL		;SKIP IF SYMBOL+SUBSCRIP TO PROCESS
	JRST	CPOPJ1		;STATEMENT EXIT
	ADD	T,SUBSCR	;CORRECT SYMBOL VALUE TO WHAT USER ASKED FOR
	TRZE	F,DOUBLE	;[112] IS THIS A DOUBLE WORD ARRAY
	ADD	T,SUBSCR	;YES - SO GIVE HIM DOUBLE
	TRNN	F,CHARS		;[157]Character string?
	 JRST	CPOPJ2		;[157]NO
	MOVE	T,SAVLOC	;[157]T has been munged
	MOVE	T2,SUBSCR	;[157]Get offset
	MOVEM	T2,CLMOFF	;[157]Save for OFFSET
	JRST	CPOPJ2		;AND LET HIM HAVE IT!


;	HERE TO HANDLE ARRAY SUBSCRIPTS

SYM8:	MOVEM	T,ODF		;SAVE TEMPORARILY
	PUSHJ	P,GETDIM	;GET RANGE OF CURRENT DIMENSION
	MOVE	T,ODF		;PREPARE TO TEST UPPER SUBSCRIPT LIMIT
	SUB	T,TEM1		;IF IN RANGE - SHOULD BE NEGATIVE
	JUMPG	T,ERR23		;IF NOT COMPLAIN - SUBSCRIPT ERROR

	MOVE	T,ODF		;GET USERS SUBSCRIPT VALUE
	SUB	T,TEM		;REMOVE OFFSET
	JUMPL	T,ERR23		; SHOULD BE POSITIVE AFTER REMOVING OFFSET

	IMUL	T,RP		;INCREASE BY CURRENT RANGE PRODUCT
	ADDB	T,DIMTOT	;STORE TOTAL ELEMENT COUNT
	MOVE	T1,LSTCHR	;  AND LAST USER CHARACTER
	CAIE	T1,","		;MORE SUBSCRIPTS?
	JRST	SYM9		;NO - RETURN TO NORMAL PROCESSING

	MOVE	ODF,TEM1	;PREPARE TO UPDATE
	SUB	ODF,TEM		;  RANGE PRODUCT
	AOJ	ODF,		;     WITH NEW RANGE
	IMULM	ODF,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 	TMOD(RH)=PRINT OPTIONS    T1=USERS LAST CHAR.

OPTION:	TRO	TMOD,ANYMOD	;FLAG FIRST TIME THROUGH THIS SCAN
OPTN2:	PUSHJ	P,SIXIN		;ACCEPT SIXBIT
	  POPJ	P,		;NON SKIP RETURN WITH NUMERIC IN T
	  JUMPE	T2,BADSYN	;NO CHARACTERS
	TRZE	TMOD,ANYMOD	;FIRST MODIFIER?
	HLLZ	TMOD,TMOD	;CLEAR FOR NEW MODIFIERS
	LDB	T2,[POINT 6,T2,5] ;GET THE FIRST CHARACTER OF THE SWITCH
	CAIN	T2,'A'		;ASCII?
	TRO	TMOD,A.!ANYMOD	;
	CAIN	T2,'O'		;OCTAL
	TRO	TMOD,O.!ANYMOD	;
	CAIN	T2,'R'		;RASCII
	TRO	TMOD,R.!ANYMOD	;
	CAIN	T2,'S'		;SOURCE LINE TRACE OPTION?
	TRO	TMOD,S.!ANYMOD		;
	CAIN	T2,'C'		;[157][164]Character string?
	TRO	TMOD,C.!ANYMOD	;[157][164]
	TRZ	TMOD,B.		;[120] IGNORE /BIG FOR THE REST
	CAIN	T2,'X'		;[157]COMPLEX?
	TRO	TMOD,X.!ANYMOD	;[157]
	CAIN	T2,'D'		;DOUBLE
	TRO	TMOD,D.!ANYMOD	;
	CAIN	T2,'F'		;FLOATING
	TRO	TMOD,F.!ANYMOD	;
	CAIN	T2,'I'		;INTEGER
	TRO	TMOD,I.!ANYMOD	;
	CAIN	T2,'L'		;[120] LOGICAL
	TRO	TMOD,L.!ANYMOD	;[120]
	CAIN	T2,'B'		;[120] 'BIG'  ?
	TRO	TMOD,B.!ANYMOD	;[120] 'BIG' OPTION
	CAIN	T2,'E'		;TRACE ENTRIES OPTION
	TRO	TMOD,E.!ANYMOD		;
	TRZN	TMOD,ANYMOD	;ANY MODIFIERS SEE - NO MEANS:
	JRST	BADSYN		;NO KNOWN MODIFIER
	JUMPE	T1,OPTN3	;END OF OPTIONS FLAGS IN T
	CAIN	T1,","		;ALSO END OF OPTIONS DELIMITER
	JRST	OPTN3		;SKIP RETURN
	CAIE	T1,"/"		;MORE MODIFIERS ?
	JRST	BADSYN		;NO - NO OTHER MODIFIERS ALLOWED
	PJRST	OPTN2		;GET MORE

OPTN3:	TRNN	TMOD,C.!A.!X.!D.!F.!I.!O.!R.!L.
				;[120] [157][164]ANY PRINT MODIFIERS SET UP?
	TRO	TMOD,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 W1
;	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 S   T,W1
	TRZ	TF,GUDLBL	;CLEAR THE GOOD LABEL FLAG
	MOVE	T,(W1)		;GET THE SYMBOL
	CAIG	T,50		;SINGLE CHARACTER CAN NOT BE A LABEL
	POPJ	P,		;RESTORE T,W1
	TLZ	T,PNAME		;SYMBOL NAME ONLY
	IDIVI	T,50		;GET LAST CHARACTER
	MOVEM	W1,TRULST	;SAVE FOR LATER
TRU3:	JUMPE	T,TRU6		;ALL CHARACTERS SEPERATED IF T=0
	IDIVI	T,50		;GET NEXT CHAR.
	CAIL	W1,1		;IS THIS CHARACTER
	CAILE	W1,12		;     NUMERIC?
	POPJ	P,		; NO - LABEL NOT VALID
	JRST	TRU3		;YES - GET NEXT CHARACTER

TRU6:	TRO	TF,GUDLBL	;FLAG A GOOD LABEL SO FAR
	MOVE	W1,TRULST	;GET BACK LAST CHARACTER
	CAIE	W1,26		;WAS THE LAST CHARACTER AN 'L'
	CAIN	W1,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 W1
;	CALL	PUSHJ	P,TRUVAR
;	RETURN1	NOT A GOOD VARIABLE
;	RETURN2	STANDARD F10 VARIABLE

TRUVAR:	PUSHJ	P,SAV2AC	;SAVE ACS W1,T
	MOVE	T,(R)		;GET THE SYMBOL
	TLZ	T,PNAME		;SYMBOL NAME ONLY
	IDIVI	T,50		;GET THE FIRST CHARACTER
	MOVEM	T+1,TRUFST	;SAVE IT
	JRST	TRUV2

TRUV1:	JUMPE	T,TRUV3		;LOOKED AT ALL CHARACTERS OF SYMBOL?
	IDIVI	T,50		;NO - GET NEXT CHARACTER
TRUV2:	CAIGE	W1,1		;ENSURE WE HAVE ONLY NUMERIC OR
	CAIG	T,44		;     ALPH CHARS
	JRST	TRUV1		;OK SO FAR
	POPJ	P,		;BAD CHARACTER FOR VARIABLE

TRUV3:	CAIL	W1,13		;CHECK THAT THIS FIRST CHARACTER OF
	AOS	-3(P)		;  THE SYMBOL IS ALPHA
	POPJ	P,		;OTHERWISE JUST NON SKIP RETURN
;	ROUTINE TO DISPLAY ASCII TEXT AS '.....'
;	ENTER WITH EACH CHARACTER IN T

ASCOUT:	JUMPE	T,ASCNUL	;HAVE WE A NULL?
	CAIN	T,177		;DELETE IS SPECIAL
	JRST	ASCDEL		;TYPE <DEL>
	CAIL	T,173		;MAYBE AN ESCAPE CHARACTER
	JRST	ASCAPE		;YES
	CAIL	T,40		;LESS THAN 40 = CONTROL CHARACTER
IFN TOPS20,<			;[151]
	JRST	ASCASC		;[151] NEVER FLAG IF RUNNING UNDER TOPS20
>;END IFN TOPS20		;[151]
IFE TOPS20,<			;[151]
	JRST	ASCUP		;PERHAPS LOWER CASE?
>;END IFE TOPS20		;[151]
	type(^)
	ADDI	T,100		;MAKE ASCII
ASCASC:	putchr	(T)		;TYPE AS ASCII
	POPJ	P,		;DONE
IFE TOPS20,<			;[151]
ASCUP:	SKIPE	TTYLC		;[151] IF TTY LC IS ON, DON'T FLAG
	CAIG	T,140		;LOWER CASE?
	JRST	ASCASC		;JUST GOOD OLD ASCII
	type(')
	JRST	ASCASC		;TYPE AS ASCII
>;END IFE TOPS20		;[151]
ASCNUL:	type(<<NUL>>)
	POPJ	P,
ASCDEL:	type(<<DEL>>)
	POPJ	P,
ASCAPE:	openb
	PUSH	P,W1		;SAVE AROUND OCTAL PRINT
	PUSHJ	P,TYP4		;TYPE OCTAL
	POP	P,W1		;RESTORE REMAINDER OF OUTPUT
	closeb
	POPJ	P,


;	ROUTINE TO ACCEPT THE MAIN PROGRAM NAME FROM USER
;	SIX CHARACTERS ONLY
;	CALL PUSHJ P,GETPRG
;	RETURN1 NEVER
;	RETURN2 RADIX 50 PROGRAM NAME IN T

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	T2		;?IS THERE A SYMBOL
	JRST	BADPRG		;[133] NO - ERROR
	PUSHJ	P,VALID		;CHECK FOR BEGINNING LETTER AND CONVERT
				;TO RADIX 50
	MOVEM	T3,SYM		;FOR FNDSYM
;[155]	TLO	F,FPRNM		;FIND PROGRAM NAME
	TLO	F,FGLSNM	;[155]FIND GLOBAL SYMBOL
	PUSHJ	P,FNDSYM
	  JRST	[PUSHJ	P,DISP9		;NOT THERE
		PUSHJ	P,CLRLIN	;[133] GET RID OF ANY JUNK
		 JRST	GETPRG]		;TRY AGAIN
	HLRZ	T1,(T)		;WHERE IS THE USER ATTEMPTING TO START
	CAIE	T1,(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

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	T1,T2		;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	T,SYM		;SET UP FOR RADIX 50 PRINT
	PUSHJ	P,SPT1		;RADIX 50 PRINT
	TRNN	F,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	T,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	W1,SYM
	PUSHJ	P,SPT
	TYPE	(< is not a format statement>)
	POPJ	P,

ERR17:	TYPE	(<?FDTNSP >)
	MOVE	T,SYM
	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)
	JRST	DIM1		;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	DIM1		;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	T,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	T,SYM		;DISPLAY BASE SYMBOL
	PUSHJ	P,SPT1		;DISPLAY SYMBOL
	AOS	T,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	T,SYM		;GET THE ARRAY NAME
	PUSHJ	P,SPT1		;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	W1,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
;  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


E9:	TYPE	(?FDTIER Internal FORDDT error - 9)
	JRST	RET
;COMMAND ERRORS

ERROR:	type(?FDTURC Unrecognized command )
	MOVE	T1,T2		;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	T1,T2		;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 /
/

SUBTTL VARIABLE STORAGE

	NMBFSZ==^D12		;[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
SAVHSM:	BLOCK	1		;C(.JBHSM), USED BY EVAL, LOOK
ESCAPE:	-1			;NON ZERO MEANS NO ^C IN EFFECT SO ESCAPE ALLOWED
REENTR:	0			;NON-ZERO IF REENTER HAS BEEN DONE
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,<			;[151]
TTYLC:	BLOCK 1			;[151] RETURNED BY .TOLCT TRMOP. LOWERCASE SET/UNSET
>;END IFE TOPS20		;[151]

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
MATHSM:	BLOCK	1	;USED BY "LOOK" TO RESOLVE MULTIPLE DEF
SYM:	BLOCK	1
SYMASK:	BLOCK	1		;MASK FOR SYM TBL SYMBOL (FOR FNDSYM, WITH FGLSNM)
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 T3
PRGNAM:	BLOCK	2		;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
STPCNT:	BLOCK	1		;STEP COUNT - HOW MANY LINES TO TRACE
OPENED:	SQUOZE	0,MAIN.		;HOLDS CURRENTLEY OPENED PROGRAM NAME
OPENLS:	BLOCK	1		;HOLDS SUB-SET OF JBSYM FOR OPENED PROGRAM
OLDOPN:	BLOCK	1		;PROG THAT WAS OPEN BEFORE GROUP REQUEST
GOLOC:	BLOCK	1		;HOLDS E.T.V. TO EXTERNAL ROUTINES
SUBSCR:	BLOCK	1		;HOLDS ARRAY SUBSCRIPT VALUE
COUNT:	BLOCK	1
JOBOPC:	BLOCK	1		;HOLDS .JBOPC IF WE ARE IN A RE-ENTER
PNAMSV:	BLOCK	1		;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

	BLOCK	3		;[145] FOR BREAKPOINT ZERO
B1ADR:	BLOCK	1
B1SKP:	BLOCK	1
B1CNT:	BLOCK	1
	BLOCK	NBP*3-3

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	17		;[147] 
AC17:	BLOCK	1
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		;TEMP STORAGE FOR VALUE IN LOKSYM
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		;PUSH DOWN LIST
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,<
pagwrn:	-1			;flag for page warning message in dep4
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


IFN	DEBUG	<
PATCH:	BLOCK	50		;PATCHING SPACE
		>

IF2,<
	PURGE	ERJMP,JRSTF,RESET,SAVE,XMOVEI
>

;IFE	DEBUG	<XPUNGE>		;DELETE SYMBOLS



DDTEND:	END	SFDDT