;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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.
;
;
SUBTTL MAIN ASSIGNMENTS

; THIS FILE MUST BE COMPILED BEFORE ALL OTHER ALGOL FILES

	SALL

	MAJVNO==1		; MAJOR VERSION NUMBER
	MINVNO==2		; MINOR VERSION NUMBER
	EDTNO==310		; EDIT NUMBER
	VERNO==<MAJVNO>B11+<MINVNO>B17+EDTNO


	DEFINE %TEXT(F,VMA,VMI,VED)
<	DEFINE %'F(A,B)
<F A - B, VMA'.'VMI'('VED'), EUROPEAN SOFTWARE ENGINEERING, SEP-74
>>

	%TEXT(UNIVERSAL,\MAJVNO,\MINVNO,\EDTNO)
	%TEXT(TITLE,\MAJVNO,\MINVNO,\EDTNO)
	%TEXT(SUBTTL,\MAJVNO,\MINVNO,\EDTNO)

%UNIVERSAL(ALGPRM,ALGOL PARAMETER FILE)

	IFNDEF FTDDT, <FTDDT==-1>
	IFNDEF	FTSYM,<FTSYM==1>	; 1 to make compiler produce 1044 blocks by default.
	IFE FTDDT,<FTSYM==0>		; Lets not be stupid, folks !
	IFNDEF FTSTATS, <FTSTATS==0> ; 1 TO PRODUCE COMPILER STATS.

	.JBREN==124		; THESE ASSIGNMENTS WILL GIVE
	.JBOPS==135		; LOADING ERRORS IF JOBDAT CHANGES
	.JBVER==137
	.JBHDA=10
SUBTTL	REVISION HISTORY

;EDIT	SPR	COMMENTS
;171	26346	ADD WARNING COUNT AND VERSION NUMBER, START EDIT HISTORY
;
;172	-----	ADD VERSION NUMBER IN ALGOTS
;
;173	26563	FIX BY-NAME PARAMETER PASSING (ALGOTS).
;
;174	26963	FIX REDIRECTED DUMP OUTPUT TO NOT DOUBLE LAST CHARACTER AT
;		BRKBYT CALL (ALGOTS).
;
;175	-----	APPLICABLE TO ALGOL-10 ONLY.
;
;176	27013	TRACING OF LABELS IN ALGDDT CAN CLOBBER AX (ALGOTS).
;
;177	27052	DO NOT CLOBBER SYMBOL TABLE IF A SYMBOL IN AN ENCLOSING
;		BLOCK NEEDS TO BE EXTENDED (ERRONEOUS PROGRAM) (ALGCON).
;
;200	27046	REMEMBER THAT A CALL TO STRASS USES AC0 AND AC1
;		(.CGASS IN ALGCOD).
;
;201	27238	DELOCATE SP ON CONTROL-C TRAP (ALGOTS).
;
;202	-----	IF PARAMETER MISMATCH DURING PARAMETER EVALUATION IN PARAM
;		(ALGOTS), PUT DL BACK TO CALLER'S LEVEL SO THAT A GOOD
;		CONTEXT IS AVAILABLE TO THE DEBUGGER.
;
;203	-----	ROUTINE "DEC" (ALGCON) PRINTS ONE TOO MANY CHARACTERS IF
;		ASKED TO PRINT A ZERO IN THE LISTING FILE.
;
;204	-----	PRODUCE CORRECT WORD ALIGNMENT OF LISTING IF /CREF
;		(ALGCON).
;
;205	-----	-10 ONLY.
;
;206	-----	PUT TRAP BACK IN THE LIBRARY (ALGSTB, ALGLIB).
;
;207	27801	MORE OF EDIT 177 FOR SYMBOLS IN ERRONEOUS
;		PROGRAMS (ALGCON).
;
;210	27837	ALLOW SIX CHARACTER FILE NAME IN OPENFILE (ALGLIB).
;
;211	-----	DO NOT TRAP OVERFLOWS CAUSED BY DDT (ALGOTS).
;
;212	28048	CHECK TRAP LABEL OUT OF SCOPE MORE CAREFULLY (ALGOTS).
;
;213	28097	PIM MODE AND BYTE MODE ARE CHARACTER MODES, NOT BINARY MODES
;		(ALGOTS).
;
;214	-----	DO A DUMMY UUO AFTER SETTING .JBINT TO FORCE PA1050 TO NOTICE
;		CONTROL-C TRAPPING HAS BEEN SET UP (ALGOTS).
;
;215	28340	ALLOW BLANKS EVERYWHERE IN LONG REAL CONSTANTS (ALGCON).
;
;216	28426	FIX ALGOTS INBLK TO NOT DELOCATE THE CHANNEL NUMBER MORE THAN
;		ONCE IF NULL SKIPPING CAUSES ANOTHER IN TO BE DONE (ALGOTS).
;
;217	-----	-10 ONLY EDIT.
;
;220	-----	FIX EMBEDDED ASSIGNMENTS INVOLVING DOUBLE PRECISION OR STRING
;		VARIABLES WHERE SOMETHING HAS BEEN STACKED.  THIS WAS OLD EDIT
;		776, WHICH WAS WITHDRAWN BECAUSE IT BROKE /CHECKON, BUT THE
;		SAMPLE PROGRAM WHICH BROKE NOW COMPILES (ALGCOD).
;
;221	28629	CHECK PROPERLY FOR FLOATING OVERFLOW DURING DOUBLE PRECISION
;		CONSTANT FOLDING FOR MULTIPLY AND DIVIDE (ALGCOD).
;
;222	28695	ALGDDT WILL ILL MEM REF IF A BREAK POINT IS SET ON AN
;		IMMEDIATE MODE INSTRUCTION, THE BREAKPOINT IS REACHED, AND THE
;		PROGRAM THEN CONTINUED (ALGDDT).
;
;223	28682	LISTOFF/LISTON CAUSES EXTRA CHARACTERS IN LISTING
;		DUE TO BYTE ALIGNMENT PROBLEMS (ALGCON).
;
;224	29190	FIX INDIRECT REFERENCE TO STRING IN AC2 (ALGOTS).  AC2 WAS
;		POINTING TO A0, NOT @ A0 AS IT SHOULD HAVE BEEN. [JBS 4/1/80]
;
;225	29014	FIX CODE IN ALGFUN WHICH ASSUMED A2 CONTAINED A POINTER
;		TO A0 (THIS ASSUMPTION WAS FALSE).  [JBS 5/6/80]
;
;226	29460	FIX DOUBLE-PRECISION CONSTANT AT LLN8 IN ALGLIB.  [JBS 4/11/80]
;
;227	29298	DO MEMORY MANAGEMENT MATH IN RIGHTHALF OF AC TO AVOID
;		ARITHMETIC OVERFLOWS WHEN WORKING WITH NON-SHARED HISEG
;		(OVERFLOW OCCURS IF > 131071 WORDS RETURN TO THE HEAP).
;		(ALGOTS) [JBS 5/20/80]
;
;230	29456	MAKE 10^( < -63) RETURN A ZERO RESULT RATHER THAN A FLOATING
;		OVERFLOW.  (ALGLIB)  [JBS 5/22/80]
;
;231	29458	MAKE LONG REAL NUMBERS < 1 WITH MANTISSAS NEAR 1 PRINT
;		CORRECTLY.  (ALGOTS)  [JBS 5/29/80]
;
;232	RAW	REMOVE LRLOAD AND SIMILAR MACROS (KA10 DMOVE, ETC.) FROM
;		ALGDDT.  [JBS 6/4/80]
;
;233	RAW	ADD "DDT" COMMAND TO HELP FILE.  (ALGDDT.HLP)  [JBS 6/5/80]
;
;234	RAW	ADD PORTALS IN ALGSYS SO ALGOTS CAN BE EXECUTE-ONLY.
;		[JBS 6/6/80]
;
;235	RAW	FIX ALGOTS SO "REENTER" WORKS AFTER FATAL BOMB-OUT ON
;		A PTY (CONTROLLED JOB).  [JBS 6/6/80]
;
;236	RAW	MAKE 10&&^( < -63) RETURN A ZERO RESULT RATHER THAN A FLOATING
;		OVERFLOW.  (ALGLIB)  [JBS 6/19/80]
;
;237	RAW	FIX ILL. MEM. REF. PROBLEM WITH "WRITE(TIME)" STATEMENT, ETC.
;		(ALGLIB)  [JBS 6/21/80]
;
;240	29459	FIX INACCURATE ANSWERS FROM LEXP (DOUBLE PRECISION LOG).
;		MAJOR REWRITE TO LEXP IN ALGLIB.  [JBS 6/25/80]
;
;241	29672	DON'T LET ALGDDT START IF JACCT BIT IS ON! [JBS 7/10/80](ALGDDT)
;
;242	29457	FIX OCCASIONAL WRONG LINE # INFORMATION FROM ALGDDT AFTER
;		PROGRAM BOMBS.  THIS ONLY HAPPENED WHEN A "SYSER" UUO WITHOUT
;		AN ADDRESS ARG. WAS EXECUTED. JBS  7/28/80]  (ALGOTS)
;
;243	29865	FIX ALGOTS AND ALGDDT SO THEY PROPERLY DETERMINE WHETHER
;		OR NOT THEY ARE BEING RUN UNDER BATCH.  ALL THEY DID WAS
;		SEE IF THEY WERE CONTROLLED (I.E., ON A PTY INSTEAD OF REAL
;		BATCH).  [JBS 7/30/80]  (ALGOTS,ALGDDT)
;
;244	29945	FIX GFIELD TO WORK WITH STRINGS.  THE STRING HEADER ITSELF,
;		RATHER THAN THE STRING, WAS THE TARGET FOR AN "LDB".
;		[JBS 8/20/80]  (ALGLIB)
;
;245	RAW	ADD LOTS OF CODE TO GFIELD AND SFIELD TO HANDLE STRINGS.
;		PREVIOUSLY, ALL BYTE MANIPULATION WAS BEING DONE IN THE
;		STRING HEADER, RATHER THAN IN THE STRING PROPER.  DEPENDS
;		ON EDIT 244.  [JBS 9/8/80]  (ALGLIB)
;
;246	RAW	FIX HEAP TABLE SCANNING - AREAS WHICH WERE IN USE WERE BEING
;		USED ANYWAY.  [JBS 1-OCT-80]  (ALGOTS)
;
;247	30062	FIX INFINITE COMPILER LOOP IN ROUTINE "GET".  [JBS 7-OCT-80]
;		(ALGCON)
;
;************************************
;REFORMAT EDIT HISTORY
;EDIT	MODULE	DATE	SPR NUMBER	WHO
;		COMMENTS
;************************************
;
;250	ALGLIB	17-FEB-81	SPR 10-30625	JBS
;		LONG REAL TO INTEGER CONVERSION INSIDE A PROCEDURE FAILS
;		IF THE INTEGER ACTUAL PARAMETER IS AN ARRAY.  LIBRARY
;		PROCEDURE FOR LONG REAL TO INTEGER CONVERSION WAS STEPPING
;		ON A2 - ALL OTHER CONVERSION ROUTINES USED ONLY A0 AND A1.
;
;251	ALGLIB	23-APR-81	SPR 10-30813	JBS
;		FIX "READ" PROCEDURE IN ALGLIB.  IT WAS RETURNING SPACE TO THE
;		HEAP BEFORE READING INTO THE STRING.  THIS DOES NOT WORK IF
;		EOF HAPPENS AND "TRAP(38)" HAS BEEN USED TO CATCH THE EOF.  THE
;		OLD STRING IS STILL INTACT BUT IT'S SPACE WAS DEALLOCATED.
;		SUBSEQUENT MEMORY MANAGEMENT RETURNED THE STRING SPACE TWICE,
;		OVERLAPPING HEAP AREAS AND CAUSING DATA FROM DIFFERENT PARTS
;		OF THE PROGRAM TO WRITE IN THE SAME AREA.  ALSO, ANY EXPANDABLE
;		HEAP SPACE OBTAINED BY THE ROUTINE WAS LOST, SO THE TRAP
;		HANDLER WAS CHANGED TO CHECK A SEMAPHORE AND RELEASE ANY "LOST"
;		SPACE.
;
;252	ALGCON	7-MAY-81	QAR 10-6411	JBS
;		MAKE ERROR MESSAGE "ERROR ON A PREVIOUS LINE" HAVE AN ENTRY
;		IN THE MESSAGE DISPATCH TABLE.  OTHERWISE ANY TIME THE MESSAGE
;		IS OUTSTR'ED, THE UUO DIES.
;
;253	ALGCON	21-MAY-81	SPR 10-31117	JBS
;		FIX EDIT 204 SO CREF LISTINGS WON'T GET "ILLEGAL ADDRESS IN
;		UUO" ERROR.   LOCATION FIVEC WAS NOT BEING TREATED PROPERLY
;		AND THE LISTING OUTPUT BUFFERS WERE DAMAGED.  EDIT 204 MUST BE
;		INSTALLED FIRST.
;
;254	ALGOTS	23-JUN-81	QAR 10-6262	JBS
;		REINSTALL EDIT 772 FROM AUGUST 1977.
;
;255	ALGOTS	23-JUN-81	QAR 10-6261	JBS
;		REINSTALL EDIT 771 FROM AUGUST 1977.
;
;256	ALGLIB	28-JUL-81	SPR 10-31070	JBS
;		DELETE TRANSIENT STRING SPACE IN PROCEDURES WRITE, LENGTH,
;		AND SIZE; MAKE DELETE RETURN STRING SPACE TO THE HEAP AFTER
;		DELETING A STRING.
;
;257	ALGCON	5-AUG-81	QAR 10-6398	JBS
;		FIX CREF GENERATION PROBLEM.  WAS GETTING ILL. ADDR. IN UUO
;		DUE TO EDIT 204.  EDIT 204 IS REMOVED BY THIS EDIT.  EDIT
;		253 SHOULD BE INSTALLED FIRST (THIS SIMPLY REMOVES ANOTHER
;		PART OF EDIT 204).
;
;260	ALGOTS	9-AUG-81	QAR 10-6401	JBS
;		MAKE LONG REAL ZERO PRINT AS 0, NOT 0&&-39.
;
;261	ALGLIB	9-AUG-81	QAR 10-6399	JBS
;		PRINT <CR><FF> IN LIBRARY PROCEDURE "PAGE", NOT <CR><LF><FF>.
;
;262	ALGCOD	11-AUG-81	QAR 10-6405	JBS
;		EDIT 220 BROKE /CHECKOFF WITH LONG REAL ARRAYS.
;
;263	ALGOTS	14-AUG-81	QAR 20-1719	JBS
;		GIVE HEAP INTEGRITY CHECKER MORE INTEGRITY.  IT WOULD LOOP
;		FOREVER IF A NULL ENTRY WERE FOUND, WHICH CAN HAPPEN IF
;		AN ARRAY GOES OUT-OF-BOUNDS WITH /CHECKOFF SPECIFIED.
;
;264	ALGDDT	17-AUG-81	QAR 10-6408	JBS
;		MAKE ^R ECHO ALGDDT PROMPT AS WELL AS USER TYPEIN, FIX THE
;		WAY ALGDDT DETERMINES IF THERE ARE MORE THAN 6 CHRS. IN A
;		MODULE NAME.
;
;265	ALGLIB	19-AUG-81	QAR 10-6402	JBS
;		TYPE GETSEG ERROR CODE IF GETSEG FAILS.
;
;266	ALGCON,	20-AUG-81	QAR 20-1553	JBS
;	ALGSER	TYPE OUT NAME OF MISSING LABEL OR PROCEDURE IF THERE IS
;		NO MATCH FOR A FORWARD STATEMENT.
;
;267	ALGSTM	20-AUG-81	QAR 10-6409	JBS
;		DON'T FORGET TO UNSTACK AFTER UNLABELED GOTO STATEMENTS.
;		COMPLICATED "COMPUTED GOTO'S" CAUSE STACK MISALIGNMENT.
;
;270	ALGDDT	26-AUG-81	QAR 10-6407	JBS
;		FAIL BETTER IF THERE IS NOT ENOUGH CORE TO START ALGDDT AFTER
;		THE USER PROGRAM RUNS OUT OF CORE.
;
;271	ALGDDT	27-AUG-81	SPR 20-16711	JBS
;		DON'T ASSUME INVALID BOOLEAN INPUT TO BE OCTAL #, DON'T
;		BREAK ON ":=" (EDIT 264 BROKE THIS).
;
;272	ALGLIB	30-AUG-81	SPR 20-16709	JBS
;		MAKE COS(0.0) YIELD 1, NOT 1.00000001.  THIS IS NECESSARY
;		FOR ARCCOS FUNCTIONS.
;
;273	ALGCON	30-SEP-81	SPR 20-16710	JBS
;		CATCH USE OF SINGLE-QUOTE (I.E., RESERVED WORD DELIMITER)
;		AFTER 'COMMENT' WHEN USING RESERVED WORD MODE, MAKE ROUTINE
;		LMSGZ PRINT ERROR MESSAGES CORRECTLY DURING "PASS 1".
;
;274	ALGDDT,	30-SEP-81	QAR 20-1689	JBS
;	ALGOTS,	MISC. EDITS TO PRINT CORRECT LISTING HEADERS, ECHO ^C
;	ALGCON	FROM ALGDDT, BREAKOUTPUT WHEN ENTERING ALGDDT.
;
;275	ALGLIB	29-OCT-81	QAR 10-6512	JBS
;		GET PROGRAM INFORMATION FROM GETTAB'S, NOT STARTUP AC'S, AND
;		USE A PATH BLOCK IF IN AN SFD.  MONITORS AFTER 7.01 DO NOT
;		SUPPORT STARTUP AC'S.
;
;276	ALGCOD	12-OCT-81	QAR 20-1683	JBS
;		FIX EDIT 262 TO USE CORRECT, NON-CONFLICTING AC'S FOR LOP
;		AND SYM.  THIS GENERATES CORRECT CODE FOR PLANTING RESULTS OF
;		STRING AND LONG REAL CALCULATIONS.
;
;277	ALGOTS,	13-OCT-81	QAR 20-1704	JBS
;	ALGPRM	ACCOUNT FOR SKIP RETURN AFTER BREAKOUTPUT IN ERROR UUO HANDLER
;		(REVISION OF EDIT 274), USE ANOTHER LOCATION TO SAVE A1 INSTEAD
;		OF %SYS17 IN ERROR UUO HANDLER (STACK OVERFLOW IN THIS ROUTINE
;		ALSO USED %SYS17), REVISE ALGOTS ROUTINE INITIA.
;
;300	ALGCON	23-0CT-81	QAR 10-6626	JBS
;		PRINT NUMBER OF WARNINGS ON TTY WHEN CCL ENTRY IS USED, PUT
;		"%" AND "?" BEFORE WARNING AND ERROR MESSAGES.
;
;301	ALGCON	21-OCT-81	QAR 20-1697	JBS
;		PREVENT COMPILER HANG ON BAD USER SYNTAX.
;
;302	ALGCON	31-OCT-81	QAR 20-1707	JBS
;		FIX ADDRESS CHECK WHEN DELETING BAD .REL FILE.  BUFFER HEADER
;		WAS GETTING STEPPED ON AFTER T15GET MISMANAGED BUFFER PTRS.
;
;303	ALGOTS,	26-OCT-81	QAR 10-6403	JBS
;	ALGDDT,	MAKE THE OTS WORK EXECUTE-ONLY AS MUCH AS POSSIBLE.  EXTENSION
;	ALGSER,	OF EDIT 234.
;	ALGUTL
;
;304	ALGOTS,	4-NOV-81	QAR 20-1684	JBS
;	ALGCON	"GOTO" STATEMENT PROCESSOR FORGOT THAT CALLING GETOWN COULD
;		CAUSE STACK SHIFTS, AND ACCORDINGLY DID NOT USE DELOCATED
;		VALUES IN CALCULATIONS.  ALSO, ADD A QUESTION MARK TO THE
;		ERROR MESSAGE "UNDEFINED LABEL" IN ALGCON (TOPS-20 ONLY).
;
;305	ALGCON	5-NOV-81	QAR 10-6674	JBS
;		FIX UNDEFINED SYMBOL TABLE SEARCH AT ZLAB (TOPS-10 ONLY).
;
;306	ALGCON	5-NOV-81	QAR 20-1706	JBS
;		CHANGE COMPILER ERROR MESSAGE TO "NO VALUE ASSIGNED TO
;		TYPED PROCEDURE, OR PROCEDURE NAME CONFLICTS WITH ANOTHER
;		DEFINITION".
;
;307	ALGOTS	8-DEC-81	QAR 10-6745	JBS
;		REMOVE EDIT 224 - BROKE "PRINT(LENGTH(VDATE))", ETC.
;
;310	ALGOTS	18-DEC-81	QAR 20-1732	JBS
;		FIX ALGDDT "PROFILE" COMMAND BROKEN BY EDIT 303.
;
;END OF REVISION HISTORY

SUBTTL PATCH MACRO FOR DEVELOPMENT CHANGES

	DEFINE	PATCH (A),<
	IFG	<10-A>,<
	PAT00'A=.
	>
	IFG	<100-A>,<
	IFLE	<10-A>,<
	PAT0'A=.
	>>
	IFLE	<100-A>,<
	PAT'A=.
	>
	>



SUBTTL EDIT MACRO FOR BUG-FIXES

	DEFINE	EDIT (A),<
	EDT'A=.
	%E.'A=:0
	>
SUBTTL ALGOL UUOS, OPDEFS AND MAGIC NUMBERS

; ALGOL UUOS:

	OPDEF	PJRST	[JRST]	; PUSHJ POPJ COMBINATION

	OPDEF	DUMPR [001B8]	; DUMP UUO
	OPDEF	SYSER1 [002B8]	; SYSTEM ERROR UUO #1
	OPDEF	SYSER2 [003B8]	; SYSTEM ERROR UUO #2
	OPDEF	IOERR [004B8]	; INPUT/OUTPUT ERROR UUO
	OPDEF	LIBERR [005B8]	; LIBRARY ERROR UUO
	OPDEF	CCORE [006B8]	; CHANGE CORE UUO
	OPDEF	CCORE1 [007B8]	; SHIFT THE STACK
	OPDEF	BREAK [010B8]	; BREAKPOINT.
	OPDEF	DDTERR [011B8]	; ALGDDT ERROR.

; ALGOL OPDEFS:

	OPDEF	JFOVO [JFCL	11,]
				; SPECIAL UNDERFLOW TREATMENT


	$A==000040		; FLAG FOR DETECTING XCTA

; DEFAULT (& MINIMUM) HEAP SIZE

	DELTA1==^D521


; KEN'S 'RANDOM' NUMBER:

	RANDOM==647327
SUBTTL ACCUMULATOR ASSIGNMENTS

	A0=0			;[251] MUST BE 0 FOR SBYTE!
	A1=1			;[251]
	A2=2			;[251]
	A3=3			;[251]
	A4=4			;[251]
	A5=5			;[251]
	A6=6			;[251]
	A7=7			;[251]
	A10=10			;[251]
	A11=11			;[251]
	A12=12			;[251]
	A13=13			;[251]
	DB=14			;[251] DATA BASE
	DL=15			;[251] DYNAMIC LEVEL
	AX=16			;[251] AUXILIARY ADDRESS
	SP=17			;[251] DYNAMIC STACK POINTER


SUBTTL PROCEDURE CALL PARAMETER CODES

; PARAMETER CODES (FORMAL AND ACTUAL PARAMETER DESCRIPTORS):

; BIT 0: STATIC/DYNAMIC

	$D==400000		; DYNAMIC

; BITS 1-2: KIND:

	$KIND==300000

	$VAR==000000		; VARIABLE
	$EXP==100000		; EXPRESSION
	$ARR==200000		; ARRAY
	$PRO==300000		; PROCEDURE

; BITS 3-8: TYPE:

	$TYPE==077000

	$I==007000		; INTEGER
	$R==016000		; REAL
	$LR==025000		; LONG REAL
	$C==031000		; COMPLEX
	$LC==032000		; LONG COMPLEX
	$B==043000		; BOOLEAN
	$S==070000		; STRING
	$L==052000		; LABEL
	$N==062000		; NON-TYPE

; BITS 9-11: STATUS:

	$STAT==000700
	$STATUS==$STAT

	$SIM==000000		; SIMPLE
	$REG==000100		; REGULAR
	$OWN==000200		; OWN
	$EXT==000300		; EXTERNAL
	$FOW==000400		; FORWARD
	$FON==000500		; FORMAL-BY-NAME
	$FOV==000600		; FORMAL-BY-VALUE
	$STMT==000700		; STATEMENT

; BITS 12 - 17: P ADDRESS (ACTUALS)

	$P==000077
	$DEC==000040		; DECLARED

; BITS 18 - 35: Q ADDRESS (ACTUALS)

; BITS 18 - 35: FORMAL PARAMETER ADDRESS (FORMALS)
; "WILD CARD" TYPES:

	$WV==000000		; WILD VARIABLE
	$AB==001000		; ARITHMETIC/BOOLEAN
	$ABN==002000		; ARITHMETIC/BOOLEAN/NON-TYPE
	$IB==003000		; INTEGER/BOOLEAN
	$WF==004000		; WILD FLOATING (REAL, LONG REAL)
	$WA==040000		; WILD ARITHMETIC (INTEGER, REAL, LONG REAL)

; COMPOUND TYPE BITS:

	$ARC==040000		; NOT ARITHMETIC
	$IRLR==004000		; INTEGER, REAL OR LONG REAL
	$IR==060000		; NOT (INTEGER OR REAL)
	$CLC==044000		; NOT (COMPLEX OR LONG COMPLEX)
	$VAR1==020000		; NOT VARIABLE OF ONE WORD
	$VAR2==002000		; NOT VARIABLE OF TWO WORDS
	$VAL==000200		; VALUE

; PROCEDURE INFORMATION (RELATIVE TO DL):

	LINKDL==-7		; DL CHAIN
	LINKPC==-6		; CONTEXT PC
	PRGLNK==-5		; PROGRAM LINK
	PMBPTR==-4		; POST-MORTEM BLOCK POINTER
	CONDL==-3		; CONTEXT DL
	BLKPTR==-2		; BLOCK POINTER
	PLBLKL==-1		; PROCEDURE LEVEL, BLOCK LEVEL

	PRMMAX==12		; MAXIMUM NUMBER OF PARAMETERS
				; IN MIN, MAX ETC.



	; BITS IN DB LEFT HALF

	TRLVEL==4000		; 0 - NO TRACE STATEMENTS
				; 1 - PROGRAM CONTAINS TRACE STATEMENTS
	INDDT==2000		; 1 - IN DEBUGGING SYSTEM
	STMTST==1000		; 1 - USER HAS INTERRUPTED (^C)
	TMPFL1==400	; TEMPORARY FLAGS - USED ONLY IN GETOWN
	TMPFL2==200	; USED ONLY IN GETOWN
	TMPFL3==100	; USED ONLY IN FUNCT., AND IN ERRM30/DEBUGGER INTERFACE.

	; BITS 13-17 ARE RESERVED !!!


SUBTTL MAIN ASSIGNMENTS

; DUMP ROUTINE NOT LOADED: DUMP=0
; DUMP ROUTINE LOADED: DUMP=1

	IFNDEF DUMP, <
	DUMP=0>			; DEFAULT: DUMP ROUTINE NOT LOADED
SUBTTL DATA BASE STRUCTURE

	%DBL==0
DEFINE %DBMAC(NAME,L<1>) <
	NAME==%DBL
	%DBL==%DBL+L
>

; ADDRESSES ARE RELATIVE TO THE DATA BASE (DB)

	%DBMAC(%UUO,2)		; UUO ENTRY
	%DBMAC(%CONC,4)		; CONTROL-C TRAP
	%DBMAC(%CHAN)		; CURRENTLY SELECTED I/O CHANNELS
	%DBMAC(%TTYCH)		; CURRENT CH #'S OPEN FOR TTY
	%DBMAC(%RAND)		; RANDOM NUMBER
	%DBMAC(%ESP)		; EMERGENCY STACK POINTER
	%DBMAC(%ACCS,20)	; DUMP FOR USER ACCUMULATORS
	%DBMAC(%SYS0)		; PARAMETER BLOCK ADDRESS
	%DBMAC(%SYS1)		; INITIAL CORE SIZE
	%DBMAC(%SYS2)		; INACTIVE HEAP CHAIN
	%DBMAC(%SYS3)		; DATE OF STARTING PROGRAM
	%DBMAC(%SYS4)		; TIME OF DAY AT START OF PROGRAM
	%DBMAC(%SYS5)		; RUN TIME AT START OF PROGRAM
	%DBMAC(%SYS6)		; DUMP COUNT
	%DBMAC(%SYS7)		; GENERAL ACCUMULATOR SAVE
	%DBMAC(%SYS10)		; GENERAL ACCUMULATOR SAVE
	%DBMAC(%SYS11)		; GENERAL ACCUMULATOR SAVE
	%DBMAC(%SYS12)		; GENERAL ACCUMULATOR SAVE
	%DBMAC(%SYS13)		; GENERAL ACCUMULATOR SAVE
	%DBMAC(%SYS14)		; USED IN APR ERROR HANDLER
	%DBMAC(%SYS15)		; USED IN APR ERROR HANDLER
	%DBMAC(%SYS16)		; USED IN APR ERROR HANDLER
	%DBMAC(%SYS17)		; USED IN APR ERROR HANDLER
	%DBMAC(%SYS20)		; COUNT OF STACK-SHIFTS
	%DBMAC(%SYS21)		; SAVE INITIAL HEAP ORIGIN
	%DBMAC(%SYS22)		; POINTER TO TRACE VECTOR
	%DBMAC(%SYS23)		; COMPILER VERSION WORD
	%DBMAC(%SYS24)		; MAX # USED WORDS IN HEAP-TABLE
	%DBMAC(%IFDAT,3)	; FOR OVERLAY LOADER
	%DBMAC(%SYSOV)		; FUNCT. PRIVATE HEAP-CHAIN BASE
	%DBMAC(%%TTY)		; I/O DIRECTORY WORD FOR TTY (-1)
	%DBMAC(%IODR,40)	; I/O DIRECTORY
	%DBMAC(%TRAPS,100)	; [206] TRAP VECTOR
	%DBMAC(%TRPTR)		; POINTER TO CURRENT TRACE ENTRY
	%DBMAC(%TRLNTH)		; LENGTH OF TRACE TABLE
	%DBMAC(%TRLV)		; DYNAMIC BLOCK POINTER
	%DBMAC(%TTY,6)		; CHANNEL -1 TTY (%TTCALL)
	%DBMAC(%IBUFF,21)	; CHANNEL -1 INPUT BUFFER
	%DBMAC(%OBUFF,21)	; CHANNEL -1 OUTPUT BUFFER
	%DBMAC(%ES,22)		; EMERGENCY STACK
	%DBMAC(%SFILE,12)	; SYMBOL FILE-NAME ETC.
	%DBMAC(%DDTST)		; AOBJN POINTER TO SYMBOL TABLE
	%DBMAC(%DDTBK)		; AOBJN POINTER TO BREAKPOINT TABLE
	%DBMAC(%DDTAL)		; XWD ADDR OF CURRENT BREAKPOINT CONTROL BLOCK OR 0,
				;   PTR TO AUTOLIST TABLE OR 0 (FIXED 26. WORDS LONG)
	%DBMAC(%DDTBI)		; AOBJN POINTER TO BLOCK INDEX
	%DBMAC(%DDTBE)		; POINTER TO CURRENT BLKIDX ENTRY
	%DBMAC(%DDTTY)		; SAVE OLD %CHAN DURING DDT.
	%DBMAC(%DDTPT)		; XWD ADDR OF FAILING MODULE'S LOADER S.T. ENTRY,
				;  ADDR OF STN-ITEM OF ERROR OR PAUSE.
	%DBMAC(%DDTIP)		; I/P POINTER, OR POINTER TO IT IF DDALST IS SET.
	%DBMAC(%DDTER)		; L.H. = REDIRECT CHANNEL #,
				; R.H. = ADDR OF LAST ERR MSG (FOR EXPERT/NOVICE)
	%DBMAC(%DDTFL)		; SAVE FOR FLAG REGISTER.
	%DBMAC(%DDTPC)		; XWD DL OF CONTEXT ESTABLISHED BY FNDADR,
				;   ADDR OF ERROR OR PAUSE. SAVED BY ERRMON OR PAUSE CODE.
	%DBMAC(%DDTUW)		; FOR UNWIND COMMAND. XWD ADDR OF
				; ORIGINAL ("PROPER") CONTEXT, HIGHEST (I.E.
				; ("PROPER") DYNAMIC PROCEDURE LEVEL.
	%DBMAC(%DDTPL)		; DYNAMIC PROCEDURE LEVEL
	%DBMAC(%DDTDL)		; TRUE TOP-LEVEL DL (IN CASE OF THUNKS)
EDIT(043); ADD SOME LOCATIONS FOR CUSTOMERS
	%DBMAC(%CUST1)		; [E043] TWO LOCATIONS FOR CUSTOMERS TO USE
	%DBMAC(%CUST2)		; [E043] ..
	%DBMAC(%DDTGO)		; ADDRESS OF "GOTO" BLOCK
	%DBMAC(%DDTCB,33)	; ALGDDT COMMAND BUFFER
	%DBMAC(%DDTFB,33)	; WHOLE-FIELD BUFFER
	%DBMAC(%DDTIB,16)	; IDENTIFIER BUFFER
	%DBMAC(%DDTNL)		; 'NEXT' DL,,'NEXT' B.P. ADDRESS
	%DBMAC(%DDTCC)		; CONTROL-C STATUS WORD
	%DBMAC(%UWCON)		; CONTEXT FOR UNWIND
	%DBMAC(%UWTOP)		; MAXIMUM ALLOWED UNWIND
	%DBMAC(%DDUWB)		; [E127] LH - CURRENT UNWOUND BLOCK LEVEL
				; [E127] RH - MAX. BLOCK LVL AT THIS PROC LVL
	%DBMAC(%DDERD)		; [E1000] ERROR DETECTED FLAG
	%DBMAC(A01TMP,2)	; [231] TEMP. STORAGE FOR A0, A1 DURING "PRINT"
	%DBMAC(A56TMP,2)	; [231] TEMP. STORAGE FOR A5, A6
	%DBMAC(A13TMP)		; [231] TEMP. STORAGE FOR A13

	%DBMAC(GETTMP,1)	; [251] "HEAP SPACE IN USE" SEMAPHORE
	%DBMAC(%UUOTM)		; [277] USED IN UUO HANDLER AT ERRMNX
	%DBL==%DBL		; LENGTH OF DATA-BASE
SUBTTL ENTRY FLAGS

; SET UP IN THE LH OF AX BY ALGOBJ IN ALGLIB:

	REEN=400000		; REENTER


SUBTTL IO CONTROL BITS

; STATUS BITS (IN LH OF IO DIRECTORY ENTRY)

	PLDEV=400000		; PHYSICAL/LOGICAL DEVICE (MUST BE BIT 0)
	DIRDEV=200000		; DIRECTORY DEVICE
	TTYDEV=100000		; TTY TYPE DEVICE
	ABMODE=040000		; ASCII/BINARY MODE
	SPOPRN=020000		; SPECIAL OPERATIONS PERMITTED
	PLTDEV=010000		; PLOTTER
	TTYTTC=004000		; TTY ON TTCALL
	SPLDEV=002000		; SPOOLED DEVICE

	INDEV=001000		; DEVICE CAN DO INPUT
	ININT=000400		; DEVICE INITED FOR INPUT
	INFIL=000200		; FILE OPEN FOR INPUT
	INEOF=000100		; INPUT EOF STATUS
	INOK=000040		; INPUT OK STATUS

	OUTDEV=000020		; DEVICE CAN DO OUTPUT
	OUTINT=000010		; DEVICE INITED FOR OUTPUT
	OUTFIL=000004		; FILE OPEN FOR OUTPUT
	OUTEOF=000002		; OUTPUT EOF STATUS
	OUTOK=000001		; OUTPUT OK STATUS

; MISCELLANEOUS SPECIAL BYTE VALUES:

	LF==012			; LINE FEED
	FF==014			; FORM FEED
	CR==015			; CARRIAGE RETURN
	CONZ==032		; CONTROL-Z
SUBTTL STRING ACCESS FLAGS

	STR1=0			; FIRST WORD
	STR2=1			; SECOND WORD

; FLAGS (USED IN LH OF SECOND WORD):

	STRDYN=200000		; DYNAMIC
	STRPRC=100000		; RESULT OF STRING PROCEDURE
	STRSPB=070000		; SPARE

	STRBS=007700		; BYTE SIZE
	STRBSC=770077		; STRBS COMPLEMENT
	STRBC=000077		; BYTE COUNT (CONTINUED IN RH)
	STRBCC=777700		; STRBC COMPLEMENT

;Flags for controlling Object Code dump formats (in L.H. of AC)

	ZERFLG==400000
	OBJOCT==200000
	OBJASC==100000
	OBJSIX==040000
	OBJSYM==020000
	OBJINT==010000
	OBJREA==004000
	OBJLR==0002000
	OBJERR==001000

	OBJDEF==OBJOCT!OBJSYM		;Default


; ERROR UUO FLAGS (LH OF M TABLES):

	FATAL==400000		; MUST BE BIT 0
	ERRDEV==200000		; INCLUDE DEVICE-NAME IN IOERR MSG
	ERRFIL==100000		; INCLUDE FILE.EXT IN IOERR MSG
	ERR2PT==40000		; MORE TO COME IN IOERR MSG

	TRAPNO=000077

SUBTTL APR TRAP AND PC FLAGS

; APR TRAP FLAGS

	APRO=000010		; ARITHMETIC OVERFLOW
	APRFPO=000100		; FLOATING POINT OVERFLOW
	APRNXM=010000		; NONEXISTENT MEMORY
	APRMPV=020000		; MEMORY PROTECT VIOLATION
	APRPLO=200000		; PUSHDOWN LIST OVERFLOW
	APRLOK=400000		; TRAP LOCK

	APRFLG=APRO!APRFPO!APRNXM!APRMPV!APRPLO!APRLOK

; PC FLAGS

	PCNDIV=000040		; NO DIVIDE
	PCFPU=000100		; FLOATING POINT UNDERFLOW
	PCFPO=040000		; FLOATING POINT OVERFLOW
	PCO=400000		; ARITHMETIC OVERFLOW

	PCOVL=PCNDIV!PCFPO!PCO

; CONTROL-C TRAP FLAG

	CONCF=2
	ILLUUO=100		; ILLEGAL UUO, ETC.
	DQUOTA=20		; EXCEEDING DISC QUOTA.

;PRINT FORMAT CONTROL FLAGS (LH OF A2):

	NUMRNG=400000		; NUMBER RANGE (EXPONENT SIGN - MUST BE BIT 0)
	NUMSGN=200000		; SIGN FLAG
	INTOVL=100000		; INTEGER OVERFLOW
	LNGEXP=040000		; LONG EXPONENT
	LNGMAN=020000		; LONG MANTISSA
	DIGEXH=010000		; DIGITS EXHAUSTED
	NOSIGN=004000		; PRINT - OR NOTHING (NOT SPACE FOR +)

; MAXIMUM SIGNIFICANCE:

	INTDIG=^D11
	SRDIG=^D9

SUBTTL MISC JOBDAT WORDS

	JBTPRG=3

	END