algol.alg

@TRSTS/E Algol compiler V6.7.003 (11-Oct-1980)
%     P D P - 1 1    A L G O L	 C O M P I L E R
%
%		B A R R Y	J A M E S	F O L S O M
%
%			    11 / 9 / 7 3
%
%	
%  R E V I S E D   -   G R E G O R Y   D .   H O S L E R
%
%  VERSION 6.3 - ARRAY LINKS, TABS, OCTAL OUTPUT
%
%		1 5 - A U G - 7 4
%
%
%  VERSION 6.4 - COMMAND STRING DECODER IN COMPILER.
%		NEW IMPROVED SYMBOL TABLE.
%
%		2 7 - A U G - 7 4
%
%
%  VERSION 6.5 - READ BECOMES OPTIONAL BOOLEAN FUNCTION
%		  RETURNING EOF INFORMATION.
%		STRINGS TO BECOME 2 CHARACTERS/WORD.
%		CASE & THRU STATEMENTS IMPLEMENTED.
%		DIV & / OPERATORS FULLY IMPLEMENTED.
%		ARRAYS TO BE DYNAMICALLY ALLOCATED WITH
%		  RE-MAPPING ALLOWED WHEN PASSED TO A
%		  PROCEDURE.
%		POINTERS AND TRUTHSETS IMPLEMENTED.
%		TOGETHER WITH SCAN AND REPLACE STMTS.
%		FIRSTONE, ONES OPERATORS IMPLEMENTED.
%		FOR STMT IMPLEMENTED AS SHOULD BE.
%		FUNCTION REFS ALLOWED WITHOUT STORE.
%		BOOLEAN ARRAYS SCANNED PROPERLY.
%		VARIABLE REFS OF LOWER LEVELS ALLOWED.
%		SEVERAL FILE ATTRIBUTES IMPLEMENTED.
%		DEFINES CHANGED FOR THE BETTER
%		DEFINES MAY NOW BE ARBITRARILY LONG.
%		ALSO MAY HAVE DEFINES WITH UP TO 10
%		  PARAMETERS.
%		LITERAL STRINGS NOT LIMITED TO 72 CHARS.
%		INTEGER CONSTANTS CAN NOW BE QUOTED.
%		CONCATENATION ADDED TO ARITHMETIC AND
%		  BOOLEAN EXPRESSIONS.
%		FILE DECLARATIONS CHANGED FOR THE BETTER.
%		  (SEE FILEDEC).
%		CONTEXT SENSITIVE RESERVED WORDS ADDED.
%		ALL IN ALL ONE BIG MOTHER CHANGE FOR THE BETTER.
%
%		0 5 - S E P - 7 4
%
%
%  VERSION: 6.6 - GENERAL CLEANUP
%
%	REVISED: 2-SEP-77	BY: T. GRIEB
%		MAKE IT WORK UNDER V6B
%		CLEAN UP RTS
%		CLEAN UP ALL ELSE
%		MAKE IT SOME SORT OF STANDARD
%
%
%  VERSION: 6.7 - IMPROVED REASONABLENESS
%
%	REVISED: 31-JUL-80	BY: PAUL KONING
%		MAKE IT RESEMBLE THE REST OF THE WORLD MORE
%		(AT THE EXPENSE OF BURROUGHS ALGOL COMPATIBILITY)
%		ADD CROSS-REFERENCE, IMPROVE LISTING FORMAT
BEGIN
  DEFINE REVNO="67"#,
	 UPDATE="003"#;
@OMIT
		C O M P I L E R   U P D A T E S

6.5.001 	ALGOL BASE COMPILER.
6.5.002 	OMITTED LISTING FIXED.
6.5.003 	INCLUDE AND CHAIN CONTROL CARDS FIXED.
6.5.004 	PATCH TO LIST ERROR MESSAGES ON KB IF NO LIST FILE.
6.5.005 	PATCH INVALID INDEX IN GETATTRIBUTE.
6.5.006 	PATCH TO AVOID STRING TO INTEGER CONVERT ERROR
		  IN GETNEXT FOR INTEGER CONSTANTS.
		PATCH TO PRINT OUT DOUBLE CHARACTER TOKENS IN ERROR.
6.5.007 	OPTION SCANNER ADDED TO COMMAND STRING INTERPRETER.
6.5.008 	PATCH TO GUARD AGAINST UPLEVEL ATTACHES TO POINTER
		  PARAMETERS BY VALUE.
		PATCH TO FIX INVALID INDEX IN CASESTMT.
6.5.009 	PATCH (AGAIN) TO FIX INVALID INDEX IN GETATTRIBUTE.
6.5.010 	CHANGE DEFAULT ARRAY PARAMETERS TO INTEGER.
		MAKE COMMAND STRING INTERPRETER BETTER AND SMALLER.
6.5.011 	PATCH COMPOUNDTAIL SO THAT GO TO EOJ IF FINAL END
		NOT FOLLOWED BY A PERIOD.
6.5.012 	OPTIMIZE PURGEIT A LITTLE, TAKE 'CLOSE' OUT OF CLASS 3
		RESERVED WORD LIST.
6.5.013 	MNEMONIC FILE ATTRIBUTES IMPLEMENTED PROPERLY.
6.5.014 	MAKE FORMS FROM INPUT FILE PRINT IN NICE PLACES IN
		  THE OUTPUT FILE.
6.5.015 	MAKE THE SCANNER FASTER.
6.5.016 	COMPOUND TAIL - FORCE EOF IF NOT ENOUGH ENDS.
		  (EVEN WITH A '.')
6.5.017 	DEFAULT FILE TITLE TO BE THE INTERNAL FILE NAME.
6.5.018 	BUILD DECLARATIONS OF NESTED BLOCKS NOT IN PROCEDURES
		  IN THE STACK.
6.5.019 	SWITCHES OUT OF PRIMARY AND STMT.
		ALLOW PARTIAL WORDS OF BUILD-IN FUNCTIONS.
6.5.020 	A FEW CHANGES FOR RUNNING UNDER RSTS.
6.5.021 	MORE CHANGES FOR RSTS.
6.5.022 	CHANGE GETSPACE TO OUTPUT ADDITIONAL INFO.
6.5.023 	CHANGE FILLSTMT AND PRODEC SEGMENT INFO OUTPUT.

6.7.001		Change word count to byte count in I/O statements
6.7.002		Add cross reference
6.7.003		Change code file recordsize to 512
  A L G O L   E R R O R   M E S S A G E S

   1	Declaration not followed by semicolon.
   2	Identifier declared twice in same block.
   3	Specification part identifier not in formal parameter part.
   4	Nonidentifier in identifier list of declaration.
   5	Procedure identifier not followed by '(' or ';'.
   6	Formal parameter list not followed by ')'.
   7	Formal parameter list not followed by ';'.
   8	Value part contains identifier not in formal parameter list.
   9	Value part not ended by ';'.
  10	Missing or illegal specification part.
  11	Illegal use of 'OWN'.
  12	Illegal use of 'SAVE'.
  13	Same external variables do not agree in type.
  14	Illegal use of 'OWN','SAVE' or 'EXTERNAL'.
  15	Array identifier not followed by '['.
  16	Lower bound in array declaration not followed by ']'.
  17	Bound pair in array declaration not followed by ']'.
  18	Illegal lower bound designator in array specification.
  19	Declarator illegally preceded by 'OWN','SAVE' or 'EXTERNAL'.
  20	Not proper value for this file attribute.
  21	Illegal re-use of initialization attribute.
  22	Missing ')' in file declaration.
  23	Number of nested blocks > 31.
  24	Must be Boolean or integer identifier.
  25	Number of parameters inconsistent with forward declaration.
  26	Parameter type does not agree with forward declaration.
  27	Value part inconsistent with forward declaration.
  28	Undeclared identifier.
  29	'BEGIN' expected in CASE statement.
  30	Primary may not begin with this type quantity.
  31	Missing '('.
  32	Missing ')'.
  33	Primary may not start with declarators.
  34	Not Boolean exression.
  35	No expression may begin with this type quantity.
  36	Missing ':'.
  37	Missing ','.
  38	Missing or illegal constant.
  39	Missing 'THEN'.
  40	Missing '['.
  41	Missing ']'.
  42	Missing ';' or 'END'.
  43	Missing 'END'.
  44	Actual and formal parameters not same type.
  45	Actual and formal arrays differ in number of dimensions.
  46	Actual and formal parameters do not agree in number.
  47	Missing 'UNTIL'.
  48	Missing 'DO'.
  49	Missing ':' after label.
  50	Label not declared in this block.
  51	Label has already occurred.
  52	Equivalence operator expected.
  53	Final 'END' not followed by period.
  54	Function reference cannot occur on the left of an assignment.
  55	Statement may not start with this type quanity.
  56	Statement may not start with a declarator.
  57	More than 1024 program reference cells required.
  58	More than 2048 stack cells required for this procedure.
  59	Improper index variable in 'FOR' statement.
  60	Missing ':=' following index variable.
  61	Missing 'UNTIL' or 'WHILE' in 'STEP' element.
  62	Missing 'DO' in 'FOR' clause.
  63	Missing 'ELSE'.
  64	Declared label did not occur.
  65	Declared forward procedure did not occur.
  66	Segment too large (>2047 words).
  67	Missing ':='.
  68	Missing label.
  69	Identifier following 'FILL' operator not array identifier.
  70	Missing 'WITH' in 'FILL' statement.
  71	Improper row designator.
  72	Missing '(' in I/O statement.
  73	Missing file identifier in I/O statement.
  74	Missing ']' in file index part.
  75	Missing '[' in array row designator.
  76	Missing '*' in array row designator.
  77	Missing ']' in array row designator.
  78	Illegal character - ignored.
  79	Constant table overflow - insert dummy 'GO TO' statement.
  80	Too many characters in string.
  81	Missing string identifier.
  82	Recursive defines nested more than 7 deep.
  83	Formal parameter not in specification part - defaulted to integer.
  84	Missing or illegal based variable.
  85	Missing 'BASED' in field declaration.
  86	Missing or illegal reference in 'SAVE' funstion.
  87	Missing or illegal reference in 'ADDR' function.
  88	Missing or illegal reference in 'RELEASE' function.
  89	Missing or illegal arrays in 'SWAP' statement.
  90	Missing or illegal string in 'CHAIN' statement.
  91	Symbol table overflow - that's it.
  92	Too many parameters in procedure declaration.
  93	Too many errors - compilation terminated.
  94	No external procedures in separately compiled procedures.
  95	Too many cases in case body.
  96	Not proper file attribute.
  97	Missing 'OF' in case expression or case statement.
  98	Illegal use of 'LONG'.
  99	Identifier expected.
 100	Number of parameters define not same as in define declaration.
 101	Define table overflow - compilation terminated.
 102	Not pointer expression.
 103	'BY' expected in REPLACE statement.
 104	'DIGIT' or 'DIGITS' expected in arithmetic conversion.
 105	'IN' or relational operator expected.
 106	Truthset identifier expected.
 107	'WHILE' or 'UNTIL' expected.
 108	Pointer identifier expected.
 109	Array not dimensioned same as in forward declaration.
 110	Array not typed same as in forward declaration.
 111	This construct is not implemented yet.
 112	Label or switch not declared in same block or same procedure.
 113	Not membership primary.
 114	Relational operator expected.
 115	'FOR' expected.
 116	Must be arithmetic identifier or '(arithmetic expression)'
 117	Must be pointer or string.
 118	String expected.
 119	'.TITLE' expected.
 120	Cannot include from incude file.  Include ignored.
 121	Unexpected end of input.  Compilation terminated.
 122	Not enough contiguous diskspace.  Compilation terminated.
 123	Illegal file mnemonic.
@OMIT
DEFINE	STACKSIZE=10239#,   % SYMTAB CAN'T BE > 32768
	MAXDEFINELEVEL=10#; % MAX LEVEL OF DEFINES TO BE EXPANDED IS
			    % ARBITRARY BUT FINITE (<=2**15-1)
INTEGER
	ADDRESS,	% ADDRESS OF DECLARED IDENTIFIER
			% SET BY GETNEXT
	ADDRESSF,	% ADDRESS OF VARIABLE THAT IS BEING ENTERED
			% INTO THE SYMBOL TABLE BY ENTRY
	ADRS,		% USED TO KEEP TRACK OF EACH BLOCKS PRT CELL
	AMTLEFT,	% AMOUNT OF DEFINE LEFT TO EXPAND
	BEGINCTR,	% KEEPS TRACK OF BEGIN END PAIRS
	C,		% COUNT OF THE NUMBER OF ENTRIES INTO THE
			% A ARRAY WHICH CONTAINS THE SCANNED SYMBOL
			% IN SYMBOL TABLE FORMAT
	CLASS,		% THIS VARIABLE CONTAINS THE CLASS NUMBER OF
			% THE INFORMATION CURRENTLY UNDER SCRUTINY.
	CLASSF, 	% CLASS TYPE OF VARIABLE THAT IS BEING ENTERED
			% INTO THE SYMBOL TABLE BY ENTRY
	CLEAN,		% A POINTER INTO THE ARRAY CONST WHICH HOLDS
			% CONSTANTS AND STRING CONSTANTS
	DA,		% KEEPS TRACK OF FAR INTO THE CODE FILE WE
			% HAVE WRITTEN
	DEFINDEX,	% POINTER INTO ELBAT (DEFINE TABLE) OR SYMTABLE
			% DEPENDING WHERE DEFINE IS AT,
	DEFLEVEL,	% LEVEL OF NESTED DEFINES THAT WE ARE
			% CURRENTLY AT
	EI,		% KEEPS TRACK OF HOW MUCH HAS ACTUALLY
			% BEEN PLACED IN THE EXTERNAL SYMBOL TABLE
	ELBATI, 	% POINTER INTO THE DEFINE EXPANSION TABLE
	ERRORCOUNT,	% KEEPS TRACK OF THE NUMBER OF ERRORS
			% ENCOUNTERED IN THE PROGRAM
	I,		% POINTER TO LAST WORD USED IN THE ARRAY
			% STACK - CARE SHOULD BE USED BECAUSE I
			% IS USED AS LOCAL IN SOME PROCEDURES
	INF,		% INF POINTS TO THE INFORMATION JUST
			% ENTERED BY ENTRY INTO STACK
	INFO,		% A POINTER INTO STACK OF ANY ADDITIONAL
			% INFORMATION CONCERNING THIS VARIABLE.
	INREAL, 	% CONTAINS THE VALUE OF THE INTEGER CONSTANT
			% JUST CONVERTED BY CONVERT.
	INSYM,		% POINTER TO LAST SYMBOL SCANNED BY GETNEXT
			% THIS POINTS AT THE CHARACTERS OF THE SYMBOL
			% NOT THE INFO WORDS
	J,		% TEMP VARIABLE - CAN BE USED BY ANYONE
			% BE CAREFUL
	L,		% A POINTER INTO THE EDOC OR CODE ARRAY TO
			% KEEP TRACK OF CODE EMITTED.
	LASTCOL,	% COL # OF LAST IDENTIFIER SCANNED
	LENGTH, 	% LENGTH OF QUOTED STRING JUST PARSED BY QUOTE
	LEVEL,		% LEVEL KEEPS TRACK OF WHAT LEVEL WE ARE
			% CURRENTLY COMPILING CODE FOR
	LINECOUNT,	% COUNTS THE NUMBER OF LINES SCANNED
	LINSTR, 	% CONTAINS THE NUMBER OF CHARACTERS MOVED INTO
			% THE STRING INSTR BY THE SCAN PROCEDURE.
	LNCT,		% KEEPS TRACK OF THE NUMBER OF LINES WRITTEN
			% ON THE OUTPUT FILE SO WE CAN PAGE IT
	MAXDATA,	% KEEPS COUNT OF HOW MUCH ARRAY (OVERLAYABLE)
			% HAS BEEN DECLARED  THIS IS
			% THE MAXIMUM OF ALL DECLARATIONS
			% IT IS USED TO FIGURE CORE REQUIREMENTS
	MAXI,		% THE MAXIMUM INDEX INTO THE SYMBOL TABLE
			% DURING THE COMPILATION
			% SO WE CAN FOUND HOW HOW MUCH SYMBOL TABLE WAS
			% ACTUALLY NEEDED FOR THE COMPILATION
	MAXSEG, 	% USED TO OBTAIN THE MAX SEGMENT EMITTED
			% THIS IS USED TO FIQURE CORE REQUIREMENT
	PGCT,		% HOLDS THE PAGE COUNT FOR PAGE HEADINGS
	PINF,		% POINTER TO LAST DECLARED PROCEDURE INFO
			% USED TO COMMUNICATE BETWEEN BLOCK AND
			% PRODEC
	PLL,		% PROGRAM LOW LINK - POINTS TO THE FIRST WORD OF
			% THE PROGRAM DESCRIPTOR OF THE FIRST PROGRAM
			% SEGMENT TO GET COMPILED.  THE SECOND WORD OF
			% THAT DESCRIPTOR THEN POINTS TO THE NEXT
			% PROGRAM DESCRIPTOR IN A LINKED FASHION.
	PROADDRESS,	% THE ADDRESS OF THE PROCEDURE CURENNTLY BEGIN
			% COMPILED
	PRTMAX, 	% CONTAINS THE NUMBER OF PRT CELLS THAT WERE
			% ASSIGNED BY THE COMPILER
	SAVEIT, 	% THIS CONTAINS THE AMOUNT OF SAVE STORAGE
			% THAT THE COMPILED PROGRAM NEEDS.  THIS IS
			% USED IN FIQURING CORE REQUIREMENT.
	SRCLINE,	% CURRENT SOURCE LINE NUMBER WITHIN PAGE
	SGNO,		% THE NUMBER OF THE SEGMENT WE ARE CURRENTLY
			% COMPILING
	SGAVL,		% THE NEXT AVAILABEL SEGMENT NUMBER THAT
			% CAN BE USED
	SKAN,		% CONTAINS TYPE OF TOKEN JUST SCANNED BY SCANNER
	STACKCTR,	% CONTAINS THE CURRENT STACK ASSIGNMENT CELL
			% NUMBER
	TIME1,		% TIME IN MINUTES (CLOCK TIME) AT THE
			% START OF COMPILATION
	TOTSEG, 	% TOTAL AMOUNT OF OBJECT CODE PRODUCED
			% BY THE COMPILER
	VM,		% CALULATES THE TOTAL MEMORY
			% REQUIREMENT FOR A PROGRAM IF IT WOULD
			% FIT INTO CORE AS A WHOLE
	WCL,		% PC OF WORKING CELL ALLOCATOR
	WORKCELLCOUNT;	% CONTAINS THE # OF WORK CELLS NEEDED IN A
			% PARTICULAR BLOCK
BOOLEAN
	ACTIONTOG,	% SET TO TRUE BY WRITESTMT WHEN PASSING AN
			% ACTION LABEL TO GOSTMT
	ASTRISK,	% SET TO TRUE FOR ':=*' TO SCAN THE '*'
			% IN PRIMARY AND BOOPRIM
	BOOLREADTOG,	% WHEN TRUE INDICATES READ TO RETURN A BOOLEAN
			% RESULT
	DEBUGTOG,	% IF SET TO TRUE PRODUCES A DEBUGGING LISTING
			% ON THE OUTPUT TO HELP IN DEBUGGING
	EIGHTYCOL,	% SET TO TRUE IF ONLY EIGHTY COLUMN LISTING
			% IS DESIRED.  I.E. COLS 81 AND GREATER ARE
			% TRUNCATED.  (TABS COUNT AS SHOULD)
	EPROC,		% TRUE IF EXTERNAL PROCEDURES NEEDED
	EOPTION,	% IF SET TO TRUE MEANS THAT ONLY ERRORS ARE
			% PRINTED ON THE OUTPUT
	ERRORTOG,	% USED BY THE ERROR ROUTINES TO SUPPRESS
			% EXTRA ERROR MESSAGES. SET TO TRUE TO ALLOW
			% ERROR MESSAGES.
	EXPANDIT,	% WHEN SET TO TRUE WE ARE ABOUT TO EXPAND A
			% DEFINE
	EXTENSION,	% USED TO SIGNAL IF A FILE NAME HAS AN EXTENSION
	EXTERNALTOG,	% WHEN SET TO TRUE WE ARE SCANNING AN EXTERNAL
			% DECLARATION WHICH IS HANDLED ALMOST
			% IDENTICALLY TO A REGULAR DECLARATION
			% EXTERNALS ARE HANDLED SUCH THAT THE SAME
			% EXTRNAL DECLARATION IN TWO DISJOINT PROCEDURS
			% ARE THE SAME - WE DO THIS BY MOVING ALL
			% EXTERNAL DECLARATIONS OUT TO LEVEL 1 AND ENTRY
			% TABKES CARE TO SEE THAT A LOCAL EXTERNAL
			% VARIABLE IS THE SAME AS OTHER EXTERNALS WITH
			% SAME NAME - THIS CHECK ALSO PREVENTS FROM
			% ENTERING THE SAME SYMBOL ONTO THE SYMBOL
			% TWICE
	FORMOPTION,	% PASS FORM FEEDS TO OUTPUT FILE
	FUNCTION,	% INDICATES WE ARE PARSING FUNCTION AS OPPOSED
			% TO A MAIN PROGRAM
	INCLUDETOG,	% IF TRUE READ FROM INCLUDE FILE
	INSYMTABLE,	% IF SET TO TRUE THEN CURRENT DEFINE IS IN THE
			% SYMBOLTABLE (STACK) ELSE IN THE DEFINETABLE
			% (ELBAT)
	LASTWASAGOGO,	% SET TO TRUE IF LAST STMT SCANNED WAS A GOTO
	LONGTOG,	% WHEN SET TO TRUE WE ARE SCANNING A LONG
			% DECLARATION. ONLY ONE DIMENSIONAL ARRAYS
			% MAY BE DECLARED LONG. IF LONG THEN THEY ARE
			% NOT SEGMENTED OTHERWISE THEY ARE SEGMENTED
			% IN GROUPS OF 256 WORDS
	LOCAL,		% IF TRUE MEANS WERE ARE COMPILING DECLARATIONS
			% THAT ARE LOCAL TO A PROCEDURE
	NEWCARD,	% IF TRUE WE HAVE A NEW CARD IMAGE IN 'CARD'
	NOHEADING,	% IF TRUE MEANS THAT THE HEADING HAS NOT BEEN
			% WRITTEN YET
	NOLISTFILE,	% INDICATES THAT THERE IS NO LIST FILE IF
			% SET TO TRUE
	NOCODEFILE,	% INDICATES THAT THERE IS NO CODE FILE TO BE
			% GENERATED IF SET TO TRUE
	OMITTOG,	% TRUE TO INHIBIT SOURCE FROM BEING COMPILED
	OWNTOG, 	% WHEN SET TO TRUE WE ARE SCANNING AN OWN
			% DECLARATION
	PARAMTOG,	% IF SET TO TRUE. WE ARE SCANNING PARAMETERS
			% IN ACTUALPARAPART
	PRTTOG, 	% WHEN SET TO TRUE GIVES ALL PRT, SAT AND AIT
			% ENTRIES THAT ARE MADE
	PTRPRIM,	% SET IN VARIABLE PRIOR TO CALL TO PEXP.
			% WHEN SET TO TRUE INDICATES THAT WE HAVE JUST
			% SCANNED A POINTER PRIMARY.  FALSE INDICATES
			% THAT WE JUST SCANNED A POINTER EXPRESSION.
	QUOTING,	% SET TO TRUE IF SCANNING A QUOTED STRING
	RESERVED,	% TRUE IF ID SCANNED IS A RESERVED WORD
			% FALSE OTHERWISE
	SAVETOG,	% WHEN SET TO TRUE WE ARE SCANNING A SAVE
			% DECLARATION. ARRAYS, STRING, AND PROCEDURES
			% CAN BE DECLARED SAVED,
			% THUS SPEEDING UP RUNNING
			% OF SOME PROGRAMS.  ONLY ONE-DIMENSONAL ARRAYS
			% MAY BE SAVED, AND SAVED PROCEDURES ARE
			% LOCKED INTO CORE BY CODE EMITTED IN
			% THE OUTER BLOCK
	STOPDEFINE,	% WHEN SET TO TRUE STOPS THE EXPANSION OF
			% DEFINES
	STARTDEFINE,	% WHEN SET TO TRUE INDICATES THAT WE ARE ABOUT
			% TO START EXPANDING A DEFINE
	SWITCHDECTOG,	% SET TO TRUE WHEN IN SWITCHDEC, FALSE OTHERWISE
	TOBEWRITTEN,	% SET TO TRUE WHEN WE ARE TO WRITE OUT THE NEXT
			% CARD
	WRITEAFORM,	% USED TO PRINT FORMS FROM INPUT IN NICE PLACES
			% ON OUTPUT.
	XREFOPT;	% TRUE IF CROSS REFERENCE OPTION (/C) SELECTED
INTEGER ARRAY
	A[0:15],	% HOLDS THE LAST SCANNED IDENTIFIER IN SYMBOL
			% TABLE FORMAT - THIS IS USED TO SPEED UP
			% SYMBOL TABLE SEARCHES
	ADRSR[0:63],	% HOLDS THE RETURN ADDRESS FOR BLOCK EXITS
			% SUCH THAT A NON-LOCAL BRANCH FROM BLOCK
			% TO ANOTHER WILL WORK
	ATTRIBUTEDHASH[0:110],	% THIS HASH TABLE HOLDS THE CLASS 3,F
				% RESERVED WORDS OF ALGOL
	CARD[0:36],	% THIS IS THE STRING USED BY THE SCANNER.
			% THE INPUT MECHANISM UNPACKS AND PUTS ONE
			% LINE AT A TIME IN THIS STRING
	CARDEF[0:MAXDEFINELEVEL,0:51],	% HOLDS CARD IMAGES
			% & PERTINATE INFO AS WE SCAN DEFINES
	CONST[0:2047],	% THIS ARRAY HOLDS ALL CONSTANTS EXCEPT THOSE A
			% LITERAL CALL CAN HANDLE. THE FIRST WORD
			% ENTRY IS THE LOCATION OF THE CALL, THE SECOND
			% WORD IS THE NUMBER OF CONSTANTS ENTERED,
			% FOLLOWED BY THE CONSTANTS.
	CSI[0:39],	% USED BY COMPILER FOR THE COMMAND STRING
	CTIME[0:5],	% TIME VALUES AT START OF COMPILE
	DATE[0:5],	% HOLDS TODAYS DATE IN DD-MMM-YYYY FORM
	EDOC[0:2047],	% CODE IS EMITTED INTO THIS ARRAY BY THE
			% EMIT ROUTINES
	ELBAT[0:STACKSIZE],% HOLDS PARAMETERS OF DEFINES DURING
			   % EXPANSION
	ESTACK[0:1000], % THE EXTERNAL SYMBOL TABLE - NOTE THAT
			% THIS WON'T GET ALLOCATED UNTIL IT IS USED
	HEADING[0:6],	% HOLDS THE COMPILERS HEADING
	INSTR[0:31],	% EVERY ITEM SCANNED, I.E. SPECIAL CHARACTER,
			% NUMBER,OR IDENTIFIER IS PLACED IN THIS STRING
			% LEFT-JUSTIFIED WITH THE VALUE OF LINSTR SET
			% TO THE NUMBER OF ITEMS MOVED INTO INSTR.
	LEVELS[0:31],	% PRT ADDRESS OF EACH LEVEL AS USED FOR
			% NESTED LEVELS AND MARK-STACK CONTROL WORDS
	LINEOUT[0:67],	% OUTPUT STRING FOR THE LINE PRINTER (132 CHARS)
	OP[0:131],	% THIS STRING IS FILLED WITH THE MNEMONIC OP
			% CODES DURING DEBUGGING
	PERMDEC[0:7],	% USED IN EVALUATING MEMBERSHIP EXPRESSIONS
			% BY MEMBERSHIPEXP,MEMBERSHIPPRIMARY,
			% AND TRUTHSETDEC
	PRTA[0:1023];	% THIS ARRAY IS FILLED WITH ALL DESCRIPTORS
			% POINTING TO ARRAYS AND PROGRAM SEGMENTS
			% SPACE IS ALSO RESERVED FOR GLOBAL VARIABLES
SAVE INTEGER ARRAY
	SAUSAGE[0:63],	% THIS ARRAY IS THE HASH TABLE FOR THE
			% RESERVED WORDS TO HELP SPEED UP THE
			% SYMBOL TABLE LOOKUP SCHEME
	SCRAMBLEDEGGS[0:63],% THIS ARRAY IS THE HASH TABLE TO POINT INTO
			% THE STACK ARRAY.
	SPECIAL[0:36];	% THIS ARRAY IS USED TO HOLD THE CLASS
			% NUMBER OF ALL THE SPECIAL CHARATERS
INTEGER ARRAY
	SEGNO[0:31],	% CONTAINS CURRENT SEGMENT NUMBER FOR EACH LEVEL
	SPACEOUT[0:32], % USED BY GETSPACE FOR OUTPUTTING PRT INFO
	STACK[0:STACKSIZE],% THIS ARRAY CONTAINS LINK LISTS WHICH MAKE
			% UP THE COMPILIER'S SYMBOL TABLE USING HASHING.
	STR[0:39],	% USED BY ERROR TO CONTAIN ERROR MESSAGE
			% READ IN FROM DISK TO PRINTED ON
			% OUTPUT LISTING.
	TTIME[0:5],	% TIME IN FORMAT HH:MM:SS ?M
	TITLE2[0:31],	% SUBTITLE FIELD (CURRENT PROCEDURE NAME)
	TITLE1[0:39],	% TITLE FIELD FROM PAGE HEADER
	XREFTYPES[0:2];	% TYPES SELECTED FOR CROSS-REFERENCE
LABEL EOJ;
DEFINE
	CONSTANTCLEAN=IF CLEAN NEQ 0 THEN CLEANIT#,
	SEGSIZE=3"17777"#,
	LOCALSPACE=3"30004"#,
	BUMPL=L:=L+2#,
	JUNK=6#,
	FP	=0#,
	FS	=1#,
	O3(X)	= X FOR 3 OCTAL DIGITS#,
	O4(X)	= X FOR 4 OCTAL DIGITS#,
	O6(X)	= X FOR 6 OCTAL DIGITS#,
	SWAB(X)	= (SHR(X,8)+SHL(X,8))#,
	ZS(X,Y) = X FOR Y ZEROSUPPRESSED DIGITS#,
	CODERECSIZE = 512#,			% CODE RECSIZE IN BYTES
	CODERECWORDS = 256#,			% CODE RECSIZE IN WORDS
	CODERECWORDS1 = 255#;			% SAME, MINUS ONE
%
% THESE DEFINES ARE THE MNEMONICS FOR THE INTERPRETER OPERATORS.
%
DEFINE
	ADD =0#,	% ADD
	AOC =1#,	% ARRAY OPERAND CALL
	ASD =2#,	% ARRAY STORE DESTRUCTIVE
	ASN =3#,	% ARRAY STORE NON-DESTRUCTIVE
	BRUN=4#,	% BRANCH UNCONDITIONAL
	BRTR=5#,	% BRANCH TRUE
	BRFL=6#,	% BRANCH FALSE
	ENTR=7#,	% ENTER
	CHS =8#,	% CHANGE SIGN
	COM =9#,	% COMMUNICATE
	DEL =10#,	% DELETE TOP OF STACK
	DIVR=11#,	% DIVIDE
	DUP =12#,	% DUPLICATE
	NE  =13#,	% B NOT EQL TO A
	EQ  =14#,	% B EQUAL TO A
	GE  =15#,	% B GREATER THAN OR EQUAL TO A
	LS  =16#,	% B LESS THAN A
	GT  =17#,	% B GREATER THEN A
	LE  =18#,	% B LESS THAN OR EQUAL TO A
	LOD =19#,	% LOAD
	LOR =20#,	% LOGICAL OR
	LND =21#,	% LOGICAL AND
	MKS =22#,	% MARK THE STACK
	REP =23#,	% MOVE
	MUL =24#,	% MULTIPLY
	LNG =25#,	% LOGICAL NEGATE
	REL =26#,	% RELEASE
	RTN =27#,	% RETURN FROM SUBROUTINE
	SAV =28#,	% SAVE
	SBR =29#,	% SUBROUTINE CALL
	SHLL=30#,	% SHIFT LEFT
	SHRR=31#,	% SHIFT RIGHT
	STD =32#,	% STORE DESTRUCTIVE
	STN =33#,	% STORE NON-DESTRUCTIVE
	SUB =34#,	% SUBTRACT
	XCH =35#,	% EXCHANGE A AND B
	SCN =36#,	% MOVE CHARACTER
	MD  =37#,	% MOD A AND B
	ADC =38#,	% ARRAY DESCRIPTOR CALL
	FDI =39#,	% FIELD ISOLATE
	BPS =40#,	% BUMP STACK POINTER
	SWP =41#,	% SWAP TWO ARRAYS
	EXP =42#,	% EXPONENT-INTEGERS ONLY
	FID =43#,	% FIELD ISOLATE DYNAMIC
	RSDN=44#,	% ROTATE STACK DOWN (IE TOS DOWN TO 4(SP))
	RSUP=45#,	% ROTATE STACK UP (IE 4(SP) UP TO TOS)
	INOP=46#,	% IN OPERATOR TESTS FOR IN-NESS OF TRUTHSET
	OCX =47#,	% OCCURS INDEX (FOR CASE INDEXING)
	LODB=48#,	% LOAD BYTE OPERATOR TO BE IMPLEMENTED
			% WITH POINTERS
	DIVT=49#,	% DIVIDE TRUNCATED TO INTEGER
	FISO=50#,	% FIELD INSERT
	FISD=51#,	% FIELD INSERT DYNAMIC
	FIND=52#,	% FIND ADDRESS NOT ON SAME LEVEL OR IN PRT
	ONESS=53#,	% ONES OPERATOR, RETURNS THE # OF BITS THAT
			% ARE ON
	FONES=54#,	% RETURNS THE LEFT MOST BIT # OF BIT THAT IS ON
	B1D =55#,	% BUILD 1 DIMENSIONAL ARRAY DESCRIPTOR
	B2D =56#,	% BUILD 2 DIMENSIONAL ARRAY DESCRIPTOR
	DPL =57#,	% DUPLICATE ARRAY ON TOS & LOAD
	BLD =58#,	% BUILD ARRAY DESCRIPTOR
	PLOD=59#,	% POINTER LOAD VALUE
	PART=60#,	% OBTAIN PARTIAL WORD PART
	PSTN=61#,	% POINTER STORE NON-DESTRUCT
	PSTD=62#,	% POINTER STORE DESTRUCT
	CMP= 63#,	% POINTER COMPARE
	PLNK=64#;	% POINTER LINK
%
% THESE DEFINES ARE THE SCANNER'S TOKEN CLASSES.
%
DEFINE
%	UNKNOWNID	= 0#,
	PROCID		= 1#,
	BOOPROCID	= 2#,
%	REALPROCID	= 3#,
	INTPROCID	= 4#,
	BOOID		= 5#,
	REALID		= 6#,
	INTID		= 7#,
	ARRAYID 	= 8#,
%			  9
	STRINGID	=10#,
	ICONSTANT	=11#,
%	RCONSTANT	=12#,
	QUOTEOP 	=13#,
	ATSIGN		=14#,
	TRUTH		=15#,
	FALSEV		=16#,
	LFTPAREN	=17#,
	ENDV		=18#,
	SEMICOLON	=19#,
	ELSEV		=20#,
	UNTILV		=21#,
	BEGINV		=22#,
	BOOLEANV	=23#,
	REALV		=24#,
	INTEGERV	=25#,
	OWNV		=26#,
	LONGV		=26#,
	SAVEV		=26#,
	EXTERNALV	=26#,
	LABELV		=27#,
	SWITCHV 	=28#,
	ARRAYV		=29#,
	DEFINEV 	=30#,
	FILEV		=31#,
	PROCEDUREV	=32#,
	POINTERV	=33#,
	TRUTHSETV	=34#,
	READV		=35#,
	WRITEV		=36#,
	FORV		=37#,
	WHILEV		=38#,
	DOV		=39#,
	IFV		=40#,
	GOV		=41#,
	FILLV		=42#,
	CASEV		=43#,
	REPLACEV	=44#,
	SCANV		=45#,
	THRUV		=46#,
	LABELID 	=47#,
%			 48
	INV		=49#,
	OUTV		=50#,
	IOV		=51#,
	MODV		=52#,
	DIVV		=53#,
%			 54
	STEPV		=55#,
	TOV		=56#,
	THENV		=57#,
	ANDV		=58#,
	ORV		=59#,
	NOTV		=60#,
	FACTOP		=61#,
	NEQOP		=62#,
	EQLOP		=63#,
	GEQOP		=64#,
	LSSOP		=65#,
	GTROP		=66#,
	LEQOP		=67#,
	LFTBRKT 	=68#,
	RTBRKT		=69#,
	COMMA		=70#,
	COLON		=71#,
	ADDOP		=72#,
	SUBOP		=73#,
	MULOP		=74#,
	DIVOP		=75#,
	AMPER		=76#,
	POUND		=77#,
%			 78
	MAXSIZEV	=79#,
	DEFINEID	=80#,
	FORWARDV	=81#,
	WITHV		=82#,
	DOTOP		=83#,
	ASSIGNOP	=84#,
	RTPAREN 	=85#,
	VALUEV		=86#,
	COMMENTV	=87#,
	SWITCHID	=88#,
	FILEID		=89#,
	FIELDV		=90#,
	FIELDID 	=91#,
	BOOFIELDID	=92#,
	EXPOP		=93#,
	ATPOUNDV	=95#,
	FORMATV 	=96#,	% SHOULD BE MOVED UP TO AFTER TRUTHSETV
	LISTV		=97#,	% AFTER IMPLEMENTATION. DECLARATION AND
				% STMT SHOULD BE CHANGED APPROPRIATELY.
	OFV		=98#,
	TRUTHID 	=99#,
	BINV		=100#,
	DISKV		=101#,
	TTYV		=102#,
	TEMPV		=103#,
	LPV		=104#,
	KINDV		=105#,
	TITLEV		=106#,
	OPENV		=107#,
	PRESENTV	=108#,
	PURGEV		=109#,
	MYUSEV		=110#,
	SIZEV		=111#,
	MAXRECV 	=112#,
	CURRECV 	=113#,
%
%	THESE THAT FOLLOW ARE THE REDEFINEABLE RESERVED WORDS
%
	POLISHV 	=114#,
	SIGNV		=115#,
	ONESV		=116#,
	TIMEV		=117#,
	DELTAV		=118#,
	SHLV		=119#,
	SHRV		=120#,
	SHIFTV		=121#,
	ABSV		=122#,
	MAXV		=123#,
	MINV		=124#,
	ADDRV		=125#,
	FONEV		=126#,
	COMPILTIMEV	=127#,
	LOCKV		=128#,
	RELEASEV	=129#,
	SWAPV		=130#,
	CHAINV		=131#,
	CLOSEV		=132#,
	BYV		=133#,
	BINARYV 	=134#,
	OCTALV		=135#,
	HEXV		=136#,
	DECIMALV	=137#,
	WORDV		=138#,
	WORDSV		=139#,
	DIGITV		=140#,
	DIGITSV 	=141#,
%			 142
%			 143
	ZEROSUPV	=144#,
	REDEFINABLE	=114#,
	CLASSMAX	=145#;
POINTER P,		% USED TO POINT INTO THE CARD ARRAY
	Q,		% TEMPORARY POINTER. POINTS INTO CSI.
	PS:=POINTER(SPACEOUT); % USED TO PASS SYMBOL NAMES
			% TO GETSPACE FOR PRINTING PRT INFO
%
%
TRUTHSET
	OPS(FACTOP OR DIVOP OR MULOP OR DIVV OR MODV),	% FOR TERM
	SPACES("	" OR " "),	% TABS OR SPACES TO BE IGNORED
	TERMINATORS("%" OR 0);  % NULLS OR "%" TERMINATE A CARD
%
% ***********   F I L E   D E C L A R A T I O N S   ***********
%
FILE	CARDIN(KIND=DISK,MAXRECSIZE=80),
	CODE(KIND=BINARY,MAXRECSIZE=CODERECSIZE),
	CREF(KIND=BINARY,MAXRECSIZE=32,TITLE="CREF.DAT"),
	LINE,
	INCLUDE(KIND=DISK,MAXRECSIZE=80),
	ERRORF(KIND=BINARY,MAXRECSIZE=64,TITLE="SY:[1,211]ALGOL.ERR"),
	TTY(KIND=TTY,MAXRECSIZE=80);	% FILE FOR THE COMMAND STRING
%
% F O R W A R D   D E C L A R A T I O N S
%
PROCEDURE CASEORIF(X);INTEGER X; FORWARD;
PROCEDURE AEXP; FORWARD;
PROCEDURE BEXP; FORWARD;
PROCEDURE PEXP; FORWARD;
PROCEDURE TERM(B); VALUE B; BOOLEAN B; FORWARD;
PROCEDURE ARITHSEC; FORWARD;
PROCEDURE PRIMARY; FORWARD;
INTEGER PROCEDURE BOOSEC; FORWARD;
INTEGER PROCEDURE BOOPRIM; FORWARD;
PROCEDURE BOOPTRPRIM(B); VALUE B; BOOLEAN B; FORWARD;
PROCEDURE MEMBERSHIPEXP; FORWARD;
PROCEDURE BLOK(FROM); VALUE FROM; INTEGER FROM; FORWARD;
PROCEDURE DECLARATION; FORWARD;
PROCEDURE ENTRY; FORWARD;
PROCEDURE ERROR (X); VALUE X; INTEGER X; FORWARD;
INTEGER PROCEDURE EXPRESS; FORWARD;
PROCEDURE FLAG(X); VALUE X; INTEGER X; FORWARD;
PROCEDURE MOVECODE; FORWARD;
PROCEDURE GOSTMT; FORWARD;
PROCEDURE WRITESTMT; FORWARD;
PROCEDURE SKIPSPACES; FORWARD;
INTEGER PROCEDURE NEXTCHAR; FORWARD;
PROCEDURE STMT; FORWARD;
BOOLEAN PROCEDURE FILENAMESCAN; FORWARD;
%
%	RELATIVE ADDRESSING SCHEME:
%
%	  DECIMAL	   OCTAL	WHERE
%	-----------	-----------	-----
%	    0- 8191	00000-17777	 PRT
%	 8192-12287	20000-27777	 IPC
%	12288-14335	30000-33777	 F+
%	14336-16383	34000-37777	 F-
%
%
%
%	THIS PROCEEDURE WRITE A LISTING LINE ADVANCING TO
%	TOP OF PAGE IF NEEDED.
%

SAVE PROCEDURE WRITEALINE(X);
	VALUE X;
	INTEGER X;
	BEGIN
	  INTEGER I;
	  LABEL EXIT;
	  IF EOPTION OR NOLISTFILE THEN GO EXIT;
	  IF NOT LNCT=100 THEN WRITE(LINE,X,LINEOUT);
	  IF LNCT:=LNCT+1 GTR 56 THEN
	  BEGIN
	    REPLACE LINEOUT BY 3"14",3"00";
	    WRITE(LINE[0],2,LINEOUT);
	    I:=REAL(PGCT:=*+1>9)+REAL(PGCT>99)+1;
	    IF EIGHTYCOL THEN
	    BEGIN REPLACE LINEOUT BY TITLE1 FOR 31-I,"  ",HEADING FOR 14,
	      "  ",DATE FOR 11,"  ",TTIME FOR 11,"  Page ",ZS(PGCT,I);
	      WRITE(LINE,80,LINEOUT)
	    END ELSE
	    BEGIN REPLACE LINEOUT BY TITLE1 FOR 72,"    ",HEADING FOR 14,
	      "    ",DATE FOR 11,"    ",TTIME FOR 11,
	      " " FOR 7-I,"Page ",ZS(PGCT,I);
	      WRITE(LINE,132,LINEOUT);
	      REPLACE POINTER(LINEOUT)+80 BY " " FOR 52
	    END;
	    WRITE(LINE,64,TITLE2);
	    WRITE(LINE,0,LINEOUT);
	    WRITEAFORM:=BOOLEAN(SRCLINE:=LNCT:=0)
	  END;
EXIT:	END;
%
%
%	THIS PROC RETURNS A DATE IN A NICE FORM
%
%

PROCEDURE CODETHEDAY(DA,MO,YR,HR,MN,P,O);
	VALUE	DA,MO,YR,HR,MN,O;
	INTEGER DA,MO,YR,HR,MN,O;
	POINTER P;
	BEGIN
	  INTEGER I:=YR-1900,J:=MO-2,DAY;
	  ARRAY X[0:20];
	  POINTER PX;
	  BOOLEAN PM:=HR>12;
	  IF MO LSS 3
	  THEN BEGIN
	    J:=MO+10;
	    I:=*-1
	  END;
	  REPLACE P BY " " FOR 80;
	  DAY:=((J*26-2) DIV 10 + DA + I + I DIV 4) MOD 7;
	  IF HR>12 THEN HR:=*-12 ELSE IF HR=0 THEN HR:=12;
	  REPLACE X BY " " FOR 42;
	  REPLACE PX:X BY CASE DAY OF (
	    "Mon","Tues","Wednes","Thurs","Fri","Satur","Sun"),
	    "day ",CASE MO-1 OF(
	    "January","February","March","April","May","June",
	    "July","August","September","October","November",
	    "December"),ZS(DA,3-REAL(DA<10)),",",ZS(YR,5)," at",
	    ZS(HR,3-REAL(HR<10)),":",MN FOR 2 DIGITS,
	    IF PM THEN " P" ELSE " A","M.";
	  REPLACE P+((I:=(80-O-DELTA(X,PX))/2)+O) BY X FOR 42;
	  P:=*+I
	END OF CODETHEDAY;
%
%
%
%
%
%

PROCEDURE DAYTIME;
	BEGIN
	  INTEGER DA,MO,YR,HR,MN,SC;
	  POINTER P;
	  LINE.PRESENT:=FALSE;		% PURGE OLD LISTING
	  IF XREFOPT THEN CREF.PRESENT:=FALSE;	% AND OLD CREF IF APPLICABLE
	  REPLACE LINEOUT BY " " FOR 21,
	      "RSTS/E ALGOL compiler, version ",REVNO FOR 1,
	      ".",SHR(REVNO,8) FOR 1,"." UPDATE " ";
	  REPLACE HEADING BY "ALGOL V",POINTER(LINEOUT)+52 FOR 7;
	  WRITEALINE(60);
	  P:=POINTER(LINEOUT);
	  CODETHEDAY(DA:=CTIME[3],MO:=CTIME[4],YR:=CTIME[5],
		     HR:=CTIME[2],MN:=CTIME[1],P,0);
	  SC:=CTIME[0];
	  WRITEALINE(0);
	  WRITEALINE(80);
	  WRITEALINE(0);
	  REPLACE DATE BY ZS(DA,2),"-",CASE MO OF (
		  "Jan","Feb","Mar","Apr","May","Jun",
		  "Jul","Aug","Sep","Oct","Nov","Dec"),"-19",
		  YR FOR 2 DIGITS;
	  DA:=HR MOD 12; IF DA=0 THEN DA:=12;
	  REPLACE TTIME BY ZS(DA,2),":",MN FOR 2 DIGITS,":",
		  SC FOR 2 DIGITS," ",IF HR LEQ 11 THEN 8"A" ELSE
		  IF HR=12 AND MN=0 AND SC=0 THEN 8" " ELSE 8"P" FOR 1,"M";
	  REPLACE TITLE1 BY " " FOR 80;
	  REPLACE TITLE2 BY " " FOR 64;
	  P:=POINTER(LINEOUT);
	  CODETHEDAY(COMPILETIME(3),COMPILETIME(4),COMPILETIME(5),
		     COMPILETIME(2),COMPILETIME(1),P,18);
	  REPLACE P BY "Compiler compiled";
	  WRITEALINE(80);
	  WRITEALINE(0);
	  WRITEALINE(0);
	  NOHEADING:=FALSE;
	  LNCT:=6
	END OF DAYTIME;
%
%
%	THIS PROC SETS TOGGLES - THOSE STATEMENTS THAT BEGIN WITH
%	THE @ SIGN ( @OMIT, @DEBUG)
%

PROCEDURE SETTOGGLES;
	BEGIN
	  INTEGER T:=REAL(P+1,1);
	  IF T = "O" THEN OMITTOG:=NOT OMITTOG ELSE
	  IF T = "P" THEN PRTTOG:=NOT PRTTOG ELSE
	  IF T = "D" THEN DEBUGTOG:=NOT DEBUGTOG ELSE
	  IF T = "I" THEN
	  BEGIN
	    IF NOT INCLUDETOG THEN
	    BEGIN
	      INCLUDETOG:=TRUE;
	      REPLACE INCLUDE.TITLE BY P+2
	    END ELSE
	    FLAG(120)
	  END ELSE
	  IF T = "F" AND LNCT NEQ 0 THEN
	  BEGIN
	    LNCT:=100;
	    WRITEALINE(1)
	  END ELSE
	  IF T = "E" THEN IF NOT EOPTION:=NOT EOPTION THEN
	    IF NOHEADING THEN DAYTIME ELSE ELSE ELSE
	  IF T = "T" THEN
	  BEGIN
	    REPLACE TITLE1 BY " " FOR 80;
	    REPLACE TITLE1 BY P+2 WHILE NEQ 0
	  END ELSE
	  IF T = "C" THEN IF INCLUDETOG THEN
	  BEGIN
	    INCLUDE.OPEN:=FALSE;
	    REPLACE INCLUDE.TITLE BY P+2
	  END ELSE
	  BEGIN
	    CARDIN.OPEN:=FALSE;
	    REPLACE CARDIN.TITLE BY P+2
	  END
	END OF SETTOGGLES;
% THIS PROCEDURE CROSS-REFERENCES THINGS

SAVE PROCEDURE CREFIT(T,B,F);
    VALUE T,B,F;
    INTEGER T,B,F;
    BEGIN
      INTEGER S; INTEGER ARRAY X[0:15];
      SCAN XREFTYPES FOR 6 UNTIL EQL T;
      IF NOT TOGGLE THEN			% IF OPTION SELECTED
      BEGIN REPLACE X BY " " FOR 16;
	REPLACE X BY T FOR 1, INSTR FOR 15 WHILE NEQ 0;
	S:=SEGNO[B];
	X[8]:=SWAB(S);
	X[9]:=SWAB(PGCT);
	X[10]:=SWAB(SRCLINE);
	X[11]:=B;
	X[12]:=F;
	WRITE(CREF,32,X)		% WRITE CREF FILE RECORD
      END
   END OF CREFIT;
%
%
%
%
%
%

SAVE PROCEDURE WRITECARD;
	BEGIN
	  INTEGER I,J,K,X;
	  OWN INTEGER PBC;
	  POINTER Q;
	  IF WRITEAFORM
	  THEN BEGIN
	    WRITEAFORM:=BOOLEAN(LNCT:=100);
	    WRITEALINE(1)
	  END;
	  IF OMITTOG THEN REPLACE Q:LINEOUT BY "   Omitted "
	  ELSE  REPLACE Q:LINEOUT BY ZS(SRCLINE:=*+1,2),
			" ",O3(SGNO),":",O4(L);
	  IF PBC EQL BEGINCTR THEN REPLACE Q:Q BY "  "
	    ELSE REPLACE Q:Q BY ZS(PBC:=BEGINCTR,2);
	  IF ERRORCOUNT EQL 0 THEN REPLACE Q:Q BY "   "
	    ELSE REPLACE Q:Q BY ZS(ERRORCOUNT,2), " ";
	  REPLACE Q BY POINTER(CARD) FOR 72;
	  IF EIGHTYCOL		% SHORT FORM?
	  THEN BEGIN		% YES
	    K:=-1;
	    DO BEGIN
	      IF X:=REAL(POINTER(LINEOUT)+K:=*+1,1) EQL 3"11"
	      THEN I:=I DIV 8 * 8 + 8
	      ELSE I:=*+1;
	      J:=*+1
	    END
	    UNTIL I GEQ 80 OR X EQL 0
	  END
	  ELSE J:=132;		% FOR LONG PRINTERS
	  WRITEALINE(J);
	  TOBEWRITTEN:=FALSE
	END OF WRITECARD;
%
%
%
%
%
%

SAVE PROCEDURE READCARD;
	BEGIN
	  INTEGER I,N,P1;
	  OWN INTEGER PREVBEGINCTR,EOF;
	  LABEL L1,L2;
	  IF DEFLEVEL = 0 THEN		% GET NEXT CARD IMAGE
	  BEGIN
	    L1: IF INCLUDETOG THEN	% READ FROM INCLUDE FILE
	      IF READ(INCLUDE,72,CARD) THEN
	    BEGIN
	      INCLUDE.OPEN:=INCLUDETOG:=FALSE;
	      GO L1
	    END ELSE ELSE
	    IF READ(CARDIN,72,CARD) THEN  % CHECK FOR EOF
	    BEGIN
	      IF EOF:=*+1 EQL 2 THEN ERROR(121);
	      CARD[0]:=1	     % TO FAKE OUT THE SCANNER
	    END;
	    LINECOUNT:=*+1;	% ANOTHER LINE READ
	    IF REAL(P:=CARD,1) EQL 3"14" THEN
	    BEGIN
	      IF WRITEAFORM THEN
	      BEGIN
	        LNCT:=100;
	        WRITEALINE(1)
	      END;
	      WRITEAFORM:=FORMOPTION AND LNCT NEQ 0;
	      GO TO L1	% IN EITHER CASE, FORMS GET IGNORED
	    END;
	    IF P EQL "@" AND NOT QUOTING THEN	% CONTROL CARD
	    BEGIN
	      SETTOGGLES;	% SCAN IT
	      WRITECARD;	% PRINT OUT THE CARD
	      GO L1		% GET NEXT CARD
	    END;
	    IF OMITTOG THEN	% CARDS BEING OMITTED DON'T GET COMPILED
	    BEGIN
	      WRITECARD;	% WRITE IT OUT ANYWAY
	      GO L1		% GET NEXT CARD
	    END ELSE
	    TOBEWRITTEN:=TRUE
	  END ELSE		% READ CARD FROM DEFINES
	  IF AMTLEFT EQL 0 THEN  % ALL DONE SCANNING THIS DEFINE
	  BEGIN 	% SO CLEAN UP AFTER IT AND GET PREVIOUS
	    REPLACE P:=CARD BY POINTER(CARDEF[DEFLEVEL:=*-1,*])
	      FOR 72,0;
	    AMTLEFT:=CARDEF[DEFLEVEL,39];  % AMOUNT LEFT TO EXPAND
	    IF EXPANDIT THEN ELBATI:=CARDEF[DEFLEVEL,51];
	    EXPANDIT:=BOOLEAN(CARDEF[DEFLEVEL,40]);
	    DEFINDEX:=CARDEF[DEFLEVEL,38];  % WHERE NEXT DEFINE IS
	    P:=*+CARDEF[DEFLEVEL,36];
	    SKIPSPACES	% CLEAN UP AFTER OLD DEFINE
	  END ELSE
	  BEGIN 	% CONTINUE TO SCAN EXISTING DEFINE
	    IF AMTLEFT LSS 0 THEN AMTLEFT:=
	      IF EXPANDIT THEN ELBAT[DEFINDEX] ELSE STACK[DEFINDEX];
	    IF I:=AMTLEFT GTR 72 THEN I:=72;  % USE ONLY ONE CARD
	    REPLACE P:=CARD BY IF EXPANDIT THEN POINTER(ELBAT[
	      DEFINDEX+1]) ELSE POINTER(STACK[DEFINDEX+1]) FOR I,
	      4"0020"	FOR 2;	% SPACE THEN NULL
	    DEFINDEX:=*+I DIV 2;
	    AMTLEFT:=AMTLEFT-I
	  END;
	  NEWCARD:=TRUE
	END OF READCARD;
%
%
%
%
%

SAVE PROCEDURE SKIPSPACES;
	BEGIN
	  LABEL AGAIN;
AGAIN:	  SCAN P:P WHILE IN SPACES;
	  IF P IN TERMINATORS
	  THEN BEGIN
	    IF TOBEWRITTEN
	    THEN WRITECARD;
	    READCARD;
	    GO AGAIN
	  END
	END;


%
%
%
%
%

SAVE INTEGER PROCEDURE SCANNER;
	BEGIN
	  POINTER Q;
	  BOOLEAN B;
	  INTEGER T;
	  OWN BOOLEAN FIRSTTIME:=TRUE;
	  LABEL IDENT,NUM,CHECK;
	  IF FIRSTTIME OR STARTDEFINE
	  THEN BEGIN
	    SKIPSPACES;
	    FIRSTTIME:=STARTDEFINE:=FALSE
	  END;
	  LASTCOL:=DELTA(CARD,P);
	  IF NEWCARD
	  THEN BEGIN
	    NEWCARD:=FALSE;
	    REPLACE STR BY CARD FOR 72	% IN CASE OF AN ERROR
	  END;			% AND SCAN AHEAD READS A NEW CARD
	  IF TOBEWRITTEN	% BECAUSE OF LOOK AHEAD
	  THEN WRITECARD;
	  Q:=POINTER(INSTR);
	  T:=63;		% MAXLENGTH
	  IF P IN ALPHAONLY
	  THEN BEGIN
	    IDENT:  REPLACE Q:Q BY P:P FOR T:T WHILE IN ALPHANUMERIC;
	    B:=TOGGLE;
	    IF REAL(P,1) EQL 0	% HIT END OF CARD 
	    THEN BEGIN		% SO GET NEXT CARD
	      IF TOBEWRITTEN
	      THEN WRITECARD;
	      READCARD;
	      GO IDENT
	    END;
	    REPLACE Q BY 0 FOR 1;	% END OF SYMBOL INDICATOR
	    REPLACE POINTER(A) BY 8"0"+LINSTR:=63-T FOR 1,
			POINTER(INSTR) UNTIL EQL 0,
			0 FOR REAL(NOT BOOLEAN(LINSTR) AND TRUE);
	    C:=SHR(LINSTR+2,1);
	    SCANNER:=SKAN:=1;
	    CHECK:
	    IF B
	    THEN BEGIN
	      LABEL AGAIN;
	      AGAIN: SCAN P:P WHILE IN ALPHA;
	      IF REAL(P,1) EQL 0
	      THEN BEGIN
		IF TOBEWRITTEN
		THEN WRITECARD;
		READCARD;
		GO AGAIN
		END
	    END
	  END
	  ELSE
	    IF P IN NUMERIC	% NUMBER 
	    THEN BEGIN
	      NUM: REPLACE Q:Q BY P:P FOR T:T WHILE IN NUMERIC;
	      B:=TOGGLE;
	      IF REAL(P,1) EQL 0	% ON ANOTHER CARD 
	      THEN BEGIN
		IF TOBEWRITTEN
		THEN WRITECARD;
		READCARD;
		GO NUM
		END;
	      LINSTR:=63-T;	% LENGTH OF NUMBER
	      SCANNER:=SKAN:=2;
	      GO CHECK
	    END
	    ELSE BEGIN		% SPECIAL CHAR
	      INSTR[0]:=REAL(P,1);
	      P:=*+LINSTR:=1;
	      SCANNER:=SKAN:=3
	    END;
	  IF INSTR[0] NEQ """
	  THEN SKIPSPACES
	END OF SCANNER;
%		T H E	S Y M B O L   T A B L E
%		=====	===========   =========
%
%
%	HASHING FUNCTION   -   (2*VALUE OF 1ST CHAR OF IDENTIFIER
%				PLUS LENGTH) MOD 64
%
%	THERE TWO HASH TABLES.
%	THE 1ST IS FOR THOSE WHO WANT SAUSAGE AND THE 2ND
%	    IS FOR THOSE WHO WANT SCRAMBLED EGGS.
%
%	THE 1ST TABLE (SAUSAGE) IS USED TO SEE IF THE IDENTIFIER IS A
%	RESERVED WORD. THIS IS USED TO SPEED UP TABLE SEARCH.
%	THE 2ND TABLE (SCRAMBLEDEGGS) IS USED FOR LOOKING UP ANY IDENTIFIERS
%	NOT FOUND IN THE RESERVED WORD TABLE.
%
%	FIRST WE APPLY THE HASHING FUNCTION TO OUR IDENTIFIER.
%	THE VALUE RETURNED (HASH VALUE) IS AN INDEX INTO EITHER SCRAMBLEDEGGS
%	OR SAUSAGE. (IF SEARCH THRU SCRAMBLEDEGGS FAILS THEN USE SAUSAGE).
%	THE VALUE RETURNED FROM INDEXING (HASH POINTER) POINTS
%	(IF NOT ZERO) TO A RESERVED WORD OR IDENTIFIER BLOCK.
%
%	THE 1ST WORD OF THE IDENTIFIER BLOCK IS A LINK (OR 0) TO NEXT
%	    IDENTIFIER OR RESERVED WORD THAT HAD SAME HASH VALUE.
%	THE 2ND WORD OF IN EACH IDENTIFIER BLOCK IS THE TOKEN VALUE (CLASS)
%	    OR POINTER TO A DATA BLOCK OF THE MOST RECENT DECLARATION
%	    OF THAT IDENTIFIER (OR RESERVED WORD).
%	THE 3RD-4+(LENGTH OF IDENTIFIER DIV 2)TH WORDS OF THE IDENTIFIER
%	BLOCK IS THE IDENTIFIER IN SYMBOL TABLE FORMAT.
%
%	SYMBOL TABLE FORMAT IS DEFINED TO BE THE <CHARACTER-LENGTH>
%	       PRECONCATED TO THE IDENTIFIER.
%
%	THE <CHARACTER-LENGTH> FOR IDENTIFIERS OF LENGTH LESS THAN 10
%	    IS THE CHARACTER ASSOCIATED WITH THAT NUMBER.
%	    I.E. "1" FOR LENGTH OF 1, "9" FOR LENGTH OF NINE.
%	    FOR IDENTIFIERS OF LENGTH LONGER THAN 9 THE <CHARACTER-LENGTH>
%	    ASSOCIATED WITH THAT LENGTH IS 60(OCTAL) [OR "0"] PLUS
%	    THE NUMERIC VALUE OF THE LENGTH.
%	    I.E. FOR LENGTH 10 YOU GET ":", FOR LENGTH 17 YOU GET "A".
%
%
%	EXAMPLE OF IDENTIFIER BLOCK FOR THE RESERVED WORD 'BEGIN'
%
%			(LINK OR 0)
%			BEGINV		[TOKEN VALUE OR CLASS]
%			"5B" = "5"+256*"B"
%			"EG" = "E"+256*"G"
%			"IN" = "I"+256*"N"
%
%	***NOTE*** THAT STRINGS ARE STORED FROM BOTTOM OF WORD TO TOP OF WORD
%		   VERY CONVIENT FOR PDP-11 AUTO INDEXING MODE.
%
%
%	IF THE TOKEN VALUE IN THE IDENTIFIER BLOCK IS A POINTER
%	   (GREATER THAN MAXIMUM TOKEN VALUE [CLASSMAX])
%	    THEN IT IS A POINTER TO A DATA BLOCK ON THAT IDENTIFIER
%
%	THE 1ST WORD OF A DATA BLOCK IS THE CLASS TYPE OF THE MOST
%	    RECENT DECLARATION OF THAT VARIABLE.
%	THE 2ND WORD OF A DATA BLOCK IS THE ADDRESS OF THAT PARTICULAR
%	    DECLARATION.
%	THE 3RD WORD OF THAT BLOCK IS THE LEVEL OF THAT DECLARATION.
%	THE 4TH WORD IS A POINTER TO THE NEXT MOST RECENT DECLARATION
%	    IN A PREVIOUS (OUTER) BLOCK.
%
%	IN THIS WAY, IT IS NOT NECESSARY TO MAKE MULTIPLE COPIES OF THE
%	   IDENTIFIER FOR DIFFERENT DECLARATIONS OF THE SAME IDENTIFIER.
%
%
%	EXAMPLE OF IDENTIFIER AND DATA BLOCKS FOR VALIABLE "I".
%		DECLARED IN LEVEL 3 AS A BOOLEAN
%		AND THEN REDECLARED IN A LEVEL 5 BLOCK AS A INTEGER
%
%	HASH VALUE IS 2*VALUE(I)+1 = 2*9+1 = 19.
%
%	SYMBOL TABLE FORMAT IS "1I".
%
%
%		SAUSAGE[19]		--->  --+
%						
%						V
%						
%		[LINK OR POINTER]   	<--- <--+
%		[POINTER]		--->  --+
%		   "1I" 			
%		     .				
%		     .				V
%		     .				
%		INTEGERV		<--- <--+
%		ADDRESS FOR THIS DECLARATION
%		LEVEL (I.E. 5)
%		[POINTER]		--->  --+
%						
%						V
%						
%		BOOLEANV		<--- <--+
%		ADDRESS FOR THIS DECLARATION
%		LEVEL (I.E. 3)
%		[0] - GROUND
%
%
%		FOR LABELS, WORD 4 IS USED TO LINK INTO THE EDOC
%		ARRAY TO THE LAST BRANCH UNCONDITIONAL TO THAT LABEL.
%		THAT WORD THEN POINTS TO THE NEXT MOST RECENT BRANCH
%		UNTIL THE FIRST REFERENCE OF THAT LABEL, WHICH POINTS
%		TO 0. WHEN THE LABEL IS DECLARED, THE LINKS ARE UNDONE
%		AND BRUN'S ARE PUT IN THEIR PLACE. THIS WORD IS THEN
%		CLEARED TO INDICATE THAT THERE ARE NO OPEN BRANCHES.
%		THE 5TH WORD IS USED TO POINT INTO THE PRT.
%		IF A BRANCH OCCURS FROM AN INNER BLOCK TO AN OUTER
%		BLOCK AND AT COMPILATION OF THE BRANCH, WE DON'T
%		KNOW WHERE WE ARE GOING, THEN WHEN WE DO FIND OUT
%		WE PUT THE ANSWER INTO THE PRT. THIS WORD IS THE
%		INDEX INTO THE PRT THAT WE PUT THE ANSWER.
%
%		FOR SWITCHES: WORD 4 CONTAINS THE NUMBER OF SWITCHES
%		IE. THE MAX INDEX 
%		WORD 5 CONTAINS THE ADDRESS OF WHERE THE 1ST BRANCH
%		OF OUR SWITCH TABLE IS. EVERY BRANCH IS 2 WORDS (4 BYTES)
%		LONG.
%
%		FOR ARRAYS: WORD 4 CONTAINS THE # OF DIMENSIONS
%		IF BIT #0 IS 0 THEN THE ARRAY IS 1-DIM. ELSE IT IS 2-DIM.
%		IF THE ARRAY IS A PARAMETER TO A PROCEDURE,
%		THEN IF BIT #1 IS ON THEN THE DOPE VECTOR (OF A 2-DIM ARRAY)
%		     OR THE ARRAY ROW (OF 1 DIM ARRAYS) IS RE-MAPPED.
%		     IF BIT #2 IS ON THEN THE ARRAY ROWS OF A 2-DIM
%		     ARRAY ARE RE-MAPPED.
%		ELSE BITS #1 AND #2 WILL BE 0
%		WORD 5 CONTAINS THE TYPE OF ARRAY (IE INTID OR BOOLID)
%		IF THE ARRAY IS A PARAMETER, THEN WORD 6 WILL CONTAIN
%		THE LOWER BOUND OF THE ARRAY ROW (DOPE VECTOR OF
%			A 2-DIM ARRAY) IF IT IS RE-MAPPED AND
%		WORD 7 WILL CONTAIN THE LOWER BOUND OF THE ARRAY ROW
%			OF A 2-DIM ARRAY IF IT IS RE-MAPPED
%
%		FOR TRUTHSETS: WORDS 4-11 CONTAIN THE TRUTHSET
%		THIS IS SO THAT WE CAN AND AND OR THE TRUTHSETS TOGETHER
%		AT COMPILATION TIME
%
%		FOR PROCS: THIS GETS COMPILCATED.
%		3 CASES
%		CASE 1	- WE ARE INSIDE OF THE PROC BEING COMPILED
%			WORD 4 POINTS TO THE 9TH ENTRY (WORD 8)
%			OF THE 1ST PARAMETER.
%			WORD 0 OF THAT ENTRY IS A REGULAR IDENTIFIER ENTRY
%			WORD 8 IS 0 OR POINTS TO THE NEXT ENTRY.
%
%		CASE 2	- WE ARE OUTSIDE OF THE PROCEDURE.
%			EACH PARAMETER WAS INTEGER AND BY VALUE.
%			THIS WORD CONTAINS THE # OF SUCH PARAMS.
%
%		CASE 3	- WE ARE OUTSIDE OF THE PROCEDURE BUT NOT EACH
%			PARAM WAS INTEGER AND VALUE.
%			THEN THIS WORD (WORD 4) POINTS TO A -1
%			THE WORD AFTER THAT IS CODED AS FOLLOWS
%			BIT #15, IF ON, INDICATES THAT THIS PARAM (THE 1ST)
%			IS BY NAME. BITS #13:14 IS THE CLASS OF THE PARAM.
%			THE NEXT WORD IS FOR PARAM # 2.
%			ECT. UNTIL A 0 WORD IS REACHED.
%
%		IF THERE ARE NO PARAMS THEN WORD 4 WILL CONTAIN A ZERO.
%		WORD #5 CONTIANS THE OFFSET USED BY ALL OF THE
%		PARAMETERS PUT TOGETHER IN THEIR PASSING.
%		IE. 2 PARAMS, ONE BY NAME AND ONE BY VALUE WILL USE
%		THREE WORDS. (TWO FOR THE ONE BY VALUE)
%		SO WORD 5 WOULD CONTAIN A 3
%
%
%	THIS GUY GETS THE NEXT TOKEN FROM THE INPUT
%
%

SAVE PROCEDURE GETNEXT;
	BEGIN
	INTEGER I,X,T,S,PNO;
	BOOLEAN B;
	LABEL START,L1,L2,L3,L4,IDENT,ROSE,EXIT,DEF;
	RESERVED:=FALSE;		% RESET RESERVED WORD INDICATOR
START:	IF T:=SCANNER	= 1 THEN
	BEGIN
	IF B:=T:=
	SAUSAGE[S:=REAL(BOOLEAN(LINSTR+(T:=REAL(POINTER(INSTR),1))+T)
		AND BOOLEAN(63))] NEQ 0
	THEN GO IDENT;
L1:	IF T:=SCRAMBLEDEGGS[S] = 0
	THEN BEGIN CLASS:=0; GO EXIT;	END;
IDENT:	IF POINTER(STACK[T+2]) NEQ POINTER(A) FOR C*2
	THEN GO ROSE;
	RESERVED:=B;			% SET RESERVED TOG TO WHAT IT
					% SHOULD BE
	IF CLASS:=STACK[T+1] < CLASSMAX THEN
	BEGIN
	IF CLASS NEQ COMMENTV
	THEN GO EXIT;
	WHILE NEXTCHAR NEQ ";" DO;
	SKIPSPACES;
	GO TO START;
	END;
	% EXTERNAL TOG IN UPPER BYTE  (FROM PROCDEC)
	CLASS:=REAL(BOOLEAN(STACK[INFO:=CLASS]) AND BOOLEAN(3"377"));
	IF XREFOPT THEN
	BEGIN X:=0;
	  IF CLASS=LABELID THEN X:="L" ELSE
	  IF CLASS GEQ PROCID AND CLASS LEQ INTPROCID THEN X:="P" ELSE
	  IF CLASS GEQ BOOID AND CLASS LEQ STRINGID OR
	     CLASS=FIELDID OR CLASS=TRUTHID THEN X:="V" ELSE
	  IF CLASS=FILEID THEN X:="F";
	  IF X NEQ 0 THEN CREFIT(X,STACK[INFO+2],0)
	END;
	IF CLASS = DEFINEID THEN
	IF NOT STOPDEFINE THEN
	BEGIN
	  IF XREFOPT THEN CREFIT("D",STACK[INFO+2],0);
	  CARDEF[DEFLEVEL,40]:=REAL(EXPANDIT);	% SAVE WHERE CURNT 1 IS
	  CARDEF[DEFLEVEL,38]:=DEFINDEX;% WHERE TO EXPAND THIS ONE FROM
	  DEFINDEX:=INFO+4;		% POINT TO LENGTH OF DEFINE
	  IF PNO:=STACK[INFO+1] NEQ 0	% # OF PARAMS IN DECLARATION
	  THEN BEGIN
	    INTEGER ARRAY NESTS[0:25];	% FOR NESTING PARENS & THINGS
	    BOOLEAN DONE,INQUOTE,LASTWASASPACE;
	    INTEGER B,COUNT,QCOUNT,NESTLEVEL,I,PARAMNO,TEMPI;
	    CARDEF[DEFLEVEL,51]:=ELBATI;  % SO WE KNOW WHERE TO CUT BACK TO
	    I:=SCANNER; 	% SEE WHAT WE GOTS
	    IF INSTR[0] NEQ "(" 	% SEE IF WE GOT A '('
	    THEN BEGIN
	      ERROR(100);		% # OF PARAMS DONT MATCH THE DEF
	      GO START
	    END;
	    DO BEGIN
	      CARDEF[DEFLEVEL,41+PARAMNO]:=TEMPI:=ELBATI;
	      DONE:=BOOLEAN(COUNT:=0);	% INITIALIZE EACH TIME THRU LOOP
	      WHILE NOT DONE
	      DO BEGIN		% SCAN THE PARAMETERS
		I:=NEXTCHAR;	% GET NEXT CHARACTER
		IF INQUOTE	% IF IN NESTED QUOTES
		THEN
		  IF QCOUNT:=QCOUNT+1 GEQ 2 AND I EQL """
		  THEN INQUOTE:=FALSE
		  ELSE
		ELSE BEGIN
		  IF LASTWASASPACE
		  THEN
		    WHILE I EQL " "
		    DO I:=NEXTCHAR;		% SCAN OUT MULTIPLE SPACES
		  LASTWASASPACE:=I EQL " ";	% SET INDICATOR FOR NEXT TIME
		  IF I EQL """
		  THEN BEGIN
		    INQUOTE:=TRUE;
		    QCOUNT:=0
		  END;
		  IF (I EQL "," OR I EQL ")") AND NESTLEVEL EQL 0
		  THEN DONE:=TRUE	% NON-NESTED ',' OR ')'
		  ELSE
		    IF I EQL "[" OR I EQL "("
		    THEN NESTS[NESTLEVEL:=*+1]:=I  % UN-NESTED THING
		    ELSE
		      IF NESTLEVEL NEQ 0	% WE ARE NESTED
		      THEN NESTLEVEL:=*-REAL(	% SO SEE IF WE CAN
			I EQL "]" AND NESTS[NESTLEVEL] EQL "[" OR
			I EQL ")" AND NESTS[NESTLEVEL] EQL "(")
		END;
		IF NOT DONE	% SEE IF TO ADD TO THE DEFINE TABLE
		THEN
		  IF BOOLEAN(COUNT:=COUNT+1)
		  THEN B:=I	% NOT YET, SAVE
		  ELSE
		    IF ELBATI+1 LEQ STACKSIZE
		    THEN ELBAT[ELBATI:=ELBATI+1]:=B+256*I
		    ELSE ERROR(101);	% DEFINE TABLE OVERFLOW
		END;
	      IF BOOLEAN(COUNT) 	% SEE IF A LEFT OVER
	      THEN
		IF ELBATI+1 LEQ STACKSIZE
		THEN ELBAT[ELBATI:=ELBATI+1]:=B
		ELSE ERROR(101);
	      ELBAT[TEMPI]:=COUNT;		   % # OF CHARS OF DEFINE
	      ELBATI:=ELBATI+1		   % UPDATE POINTER FOR NEXT DEFINE
	    END
	    UNTIL I EQL ")" OR PARAMNO:=PARAMNO+1 EQL PNO;
	    IF PNO NEQ PARAMNO		% SAME NUMBER AS IN DEFINE ?
	    THEN BEGIN
	      ERROR(100);
	      GO START
	    END;
	    IF I NEQ ")"
	    THEN BEGIN
	      ERROR(32);
	      GO START
	    END
	  END;
	  EXPANDIT:=FALSE;		% FROM THE SYMTABLE (STACK)
DEF:	  REPLACE CARDEF[DEFLEVEL,*] BY POINTER(CARD) FOR 72;
	  CARDEF[DEFLEVEL,36]:=DELTA(CARD,P);
	  CARDEF[DEFLEVEL,39]:=AMTLEFT; % HOW MUCH LEFT OF THIS DEFINE
	  IF DEFLEVEL:=DEFLEVEL+1 GTR MAXDEFINELEVEL
	  THEN ERROR(82);
	  STARTDEFINE:=BOOLEAN(AMTLEFT:=-1);
	  P:=CARD+72;		% FAKE THE SCANNER TO READ A NEW CARD
	  GO START
	END;
	ADDRESS:=STACK[INFO+1];
	INSYM:=T;
	GO EXIT;
ROSE:	IF T:=STACK[T] NEQ 0 THEN GO IDENT;
	IF B THEN BEGIN B:=FALSE; GO TO L1; END;
	CLASS:=0; GO EXIT;
	END;
	IF T = 3
	THEN BEGIN
	  L3: X:=REAL(P,1);
	  CLASS:=0;
	  IF T:=REAL(POINTER(INSTR),1) EQL 3"177"
	  THEN BEGIN
	    CARDEF[DEFLEVEL,40]:=REAL(EXPANDIT);
	    EXPANDIT:=TRUE;		% THIS IS FROM THE DEFINE TABLE
	    CARDEF[DEFLEVEL,38]:=DEFINDEX;
	    DEFINDEX:=CARDEF[DEFLEVEL-1,41+X-"0"];
	    P:=*+1;
	    GO DEF
	  END;
	  IF X = "="
	  THEN
	    IF T = ":"
	    THEN CLASS:=ASSIGNOP
	     ELSE
		IF T = ">"
		THEN CLASS:=GEQOP
		ELSE
		  IF T = "<"
		  THEN CLASS:=LEQOP
		  ELSE
		    IF T = "^"
		    THEN CLASS:=NEQOP;
	  IF T = "!" AND X = "!"
	  THEN CLASS:=AMPER
	  ELSE
	    IF T = "*" AND X = "*"
	    THEN CLASS:=EXPOP
	    ELSE
	      IF T EQL "@"
	      THEN
		IF X EQL "#"
		THEN CLASS:=ATPOUNDV
		ELSE BEGIN
		  CLASS:=ATSIGN;
		  GO EXIT
		END;
	  IF T EQL "<" AND X EQL ">"
	  THEN CLASS:=NEQOP;
	  IF CLASS = 0
	  THEN GO TO L4;
	  P:=*+1;
	  SKIPSPACES;
	  REPLACE INSTR+1 BY X FOR 1;
	  LINSTR:=2;
	  GO EXIT;
L4:	  IF T:=REAL(BOOLEAN(T) AND BOOLEAN(63))-27 < 0 OR T > 36
	  THEN BEGIN
	    FLAG(78);
	    GO START
	  END;
	  CLASS:=SPECIAL[T];
	  GO EXIT
	END;
L2:	CLASS:=ICONSTANT;
	INREAL:=0;			% INITIALIZE VALUE OF INTEGER CONS
	IF P EQL """ AND LINSTR LEQ 2
	   AND (IF POINTER(INSTR) EQL "0"
		THEN FALSE	% AVOID /0
		ELSE 8 MOD (I:=REAL(POINTER(INSTR),1)-"0") EQL 0 OR I EQL 3)
	   AND (IF LINSTR EQL 2
		THEN REAL(POINTER(INSTR)+1,1) EQL "0"
		ELSE TRUE)
	THEN BEGIN			% QUOTED STRING CONSTANT
	  INTEGER MAX,TEMP:=LINSTR;	% FORCE NEW SEGMENT 
	  LABEL IERR;
	  NEXTCHAR;			% SCAN THE '"'
	  S:=-1;
	  IF TEMP EQL 2
	  THEN BEGIN			% LEFT JUSTIFY
	    S:=15+I+2*REAL(I EQL 3);	% WHERE TO PUT THE FIRST BUNCH
					% OF BITS
	    WHILE X:=NEXTCHAR NEQ """ AND S:=S-I GEQ I-1
	    DO
	      IF I LEQ 3
	      THEN
		IF X GEQ "0" AND X LEQ "0"+SHL(1,I)-1
		THEN
		  IF S EQL 17
		  THEN INREAL.[15:1]:=X
		  ELSE INREAL.[S:I]:=X
		ELSE
		  IERR: BEGIN
		    FLAG(38);
		    GO EXIT
		  END
	      ELSE
		IF I EQL 4
		THEN
		  IF X GEQ "0" AND X LEQ "9"
		  THEN INREAL.[S:4]:=X
		  ELSE
		    IF X LEQ "F" AND X GEQ "A"
		    THEN INREAL.[S:4]:=9+X.[2:3]
		    ELSE GO IERR
		ELSE INREAL.[S:8]:=X
	  END
	  ELSE BEGIN
	    MAX:=15+REAL(I EQL 3)*2;	% OCTAL INTO 18 BIT WORD
	    WHILE S:=S+I LEQ MAX AND X:=NEXTCHAR NEQ """
	    DO
	      IF I LEQ 3
	      THEN
		IF X GEQ "0" AND X LEQ "0"+SHL(1,I)-1
		THEN INREAL:=X & INREAL [15:16-I]
		ELSE GO IERR
	      ELSE
		IF I EQL 4
		THEN
		  IF X GEQ "0" AND X LEQ "9"
		  THEN INREAL:=X & INREAL[15:12]
		  ELSE
		    IF X GEQ "A" AND X LEQ "F"
		    THEN INREAL:=(9+X.[2:3]) & INREAL [15:12]
		    ELSE GO IERR
		ELSE INREAL:=X & INREAL [15:8]
	  END;
	  IF X NEQ """
	  THEN FLAG(38)
	  ELSE SKIPSPACES;			% GET TO START OF NEXT TOKEN
	END
	ELSE
	  IF LINSTR>6 OR LINSTR=6 AND POINTER(INSTR)>"65535"
	  THEN FLAG(38)
	  ELSE INREAL:=INTEGER(INSTR,LINSTR);
EXIT:	STOPDEFINE:=FALSE;
	END;
%
%
%
%
%

PROCEDURE GETATTRIBUTE;
	BEGIN
	  INTEGER I;
	  BOOLEAN DONE;
	  GETNEXT;		% GET NEXT TOKEN
	  IF RESERVED OR SKAN NEQ 1	% SEE IF COULD BE ATTRIBUTE
	  THEN			% NO,
	  ELSE			% YES
	    DO
	      IF DONE:=POINTER(ATTRIBUTEDHASH[I+2]) EQL A FOR MIN(C,105-I)*2
	      THEN CLASS:=ATTRIBUTEDHASH[I+1]	% GET REAL CLASS
	    UNTIL I:=ATTRIBUTEDHASH[I] EQL 0 OR DONE
	END OF GETTING CONTEXT SENSITIVE RESERVED WORDS (CLASS 3,F);
%
%	THIS PROC FLAGS ERRORS ON THE LISTING FILE
%
%

PROCEDURE FLAG(X);
	VALUE X;
	INTEGER X;
	BEGIN
	  BOOLEAN T,B;
	  INTEGER I,J1,K;
	  POINTER Q,R;
	  INTEGER ARRAY AB[0:35];
	  IF ERRORTOG
	  THEN BEGIN
	    IF ERRORCOUNT:=ERRORCOUNT+1>99
	    THEN X:=93;
	    T:=EOPTION;
	    EOPTION:=FALSE;
	    IF B:=NOLISTFILE
	    THEN BEGIN
	      NOLISTFILE:=FALSE;
	      IF NOT LINE.OPEN
	      THEN LINE.KIND:=VALUE(KB)
	    END;
	    IF NOHEADING
	    THEN DAYTIME;
	    IF T OR DEFLEVEL NEQ 0
	    THEN BEGIN
	      IF J1:=DEFLEVEL = 0
	      THEN	 % CLEAN CARD - NO DEFINES IN IT
		REPLACE LINEOUT BY O4(L),"    ",POINTER(CARD) FOR 72
	      ELSE
		WHILE J1 GTR 0
		DO BEGIN
		  REPLACE LINEOUT BY "Defined to be ";
		  WRITEALINE(14);
		  REPLACE R:LINEOUT BY " " FOR 8;
		  Q:=POINTER(CARDEF[J1-1,*]);
		  THRU 72
		  DO BEGIN
		    IF REAL(Q,1) EQL 3"177"
		    THEN REPLACE R:R BY "?"
		    ELSE REPLACE R:R BY Q FOR 1;
		    Q:=*+1
		  END;
		IF J1:=J1-1 GTR 0
		THEN WRITEALINE(80)
		END;
	      WRITEALINE(80)
	    END;
	    IF B
	    THEN BEGIN
	      REPLACE LINEOUT BY O4(L),"    ",STR FOR 72;
	      WRITEALINE(80)
	    END;
	    R:=STR;
	    THRU LASTCOL
	    DO I:=
	      IF R:R EQL "	"
	      THEN I DIV 8 * 8 + 8
	      ELSE I+1;
	    REPLACE LINEOUT BY " " FOR I+8,INSTR FOR LINSTR," ";
	    WRITEALINE((I+9+LINSTR));
	    READ(ERRORF[X-1],64,AB);
	    REPLACE LINEOUT BY "*" FOR 8,POINTER(AB) FOR 64;
	    WRITEALINE(72);
	    EOPTION:=T;
	    NOLISTFILE:=B
	  END;
	  IF X = 93 OR X = 91 OR X = 101 OR X = 82 OR X = 121 OR X EQL 122
	  THEN GO EOJ
	END;


%
%	THIS PROC FLAGS REALS ERRORS ON THE LISTING
%	AS OPPOSED TO WARNINGS. IT USES FLAG.
%
%

PROCEDURE ERROR(X);
	VALUE X;
	INTEGER X;
	BEGIN
	  LABEL NOTYET;
	  FLAG(X);
	  ERRORTOG:=FALSE;
NOTYET:   IF CLASS = BEGINV THEN STMT;
	  IF CLASS NEQ ENDV AND CLASS NEQ SEMICOLON
	  THEN BEGIN
	    STOPDEFINE:=TRUE;
	    GETNEXT;
	    GO NOTYET
	  END
	END ERROR;
%
%	THIS SECTION CONTAINS THE EMITTERS
%
%	THEY PRODUCE CODE AND DEBUGGING OUTPUT
%


SAVE PROCEDURE EMITC (COD);
	VALUE COD;
	INTEGER COD;
	  IF L LSS 2048
	  THEN BEGIN		% SEG NOT TOO BIG YET 
	    IF ERRORCOUNT = 0
	    THEN EDOC[L]:=COD;
	    L:=L + 1
	  END
	  ELSE BEGIN
	    FLAG (66);		% SEG TOO BIG
	    L:=0
	  END;

SAVE PROCEDURE EMITL (LITERAL);
	VALUE LITERAL;
	INTEGER LITERAL;
	BEGIN
	  EMITC(J:=SHL(LITERAL,2));
	  IF DEBUGTOG
	  THEN BEGIN
	    REPLACE LINEOUT BY " " FOR 18,O6(L-1),"  LITC  ",O6(LITERAL),
		    "  ",O6(J);
	    WRITEALINE(46)
	  END
	END OF EMITL;

SAVE PROCEDURE EMIT(OPERATOR);
	VALUE OPERATOR;
	INTEGER OPERATOR;
	BEGIN
	  EMITC(J:=SHL(OPERATOR,2)+3"2401");	% 3"2401" IS BASE FOR OPS
	  IF DEBUGTOG
	  THEN BEGIN
	    REPLACE LINEOUT BY " " FOR 18,O6(L-1),"  ",
		    POINTER(OP[OPERATOR*2]) FOR 4,"  " FOR 10,O6(J);
	    WRITEALINE(46)
	  END
	END OF EMIT;

PROCEDURE EMITO(ADDRESS);
	VALUE ADDRESS;
	INTEGER ADDRESS;
	BEGIN
	  EMITC(J:=SHL(ADDRESS,2)+2);
	  IF DEBUGTOG
	  THEN BEGIN
	    REPLACE LINEOUT BY " " FOR 18,O6(L-1),"  VALC  ",
		    O6(ADDRESS),"  ",O6(J);
	    WRITEALINE(46)
	  END
	END OF EMITO;

PROCEDURE EMITD(ADDRESS);
	VALUE ADDRESS;
	INTEGER ADDRESS;
	BEGIN
	  EMITC(J:=SHL(ADDRESS,2)+3);
	  IF DEBUGTOG
	  THEN BEGIN
	    REPLACE LINEOUT BY " " FOR 18,O6(L-1),"  NAMC  ",
		    O6(ADDRESS),"  ",O6(J);
	    WRITEALINE(46)
	  END
	END;

SAVE PROCEDURE EMITB(BRANCH,FROM,TOO);
	VALUE BRANCH,FROM,TOO;
	INTEGER BRANCH,FROM,TOO;
	BEGIN
	  INTEGER TL:=L;
	  L:=FROM - 2;
	  EMITL(TOO*2+2);
	  EMIT(BRANCH);
	  L:=TL;
	END OF EMITB;
PROCEDURE EMITNUM(X);
	VALUE X;
	INTEGER X;
	IF X GEQ 0 AND X LSS 16384
	THEN EMITL(X)
	ELSE
	  IF CLEAN GEQ 2040
	  THEN BEGIN
	    FLAG(79);
	  END
	  ELSE BEGIN
	    CONST[CLEAN:=CLEAN+1]:=L;
	    CONST[CLEAN:=CLEAN+1]:=0;
	    CONST[CLEAN:=CLEAN+1]:=X;
	    L:=L + 1
	  END;

SAVE PROCEDURE EMITPAIR(LITERAL,OPERATOR);
	VALUE LITERAL,OPERATOR;
	INTEGER LITERAL,OPERATOR;
	BEGIN
	  EMITNUM(LITERAL);
	  EMIT(OPERATOR);
	END OF EMITPAIR;

BOOLEAN PROCEDURE INLEVEL(INFO,ACTUALLEVEL);	% GET LEVEL OF PROC OF DECLARATION
	VALUE INFO;
	INTEGER INFO,ACTUALLEVEL;
	BEGIN
	  INTEGER I:=LEVEL-1,J:=STACK[INFO+2]-1;
	  INLEVEL:=TRUE;
	  IF ACTUALLEVEL:=J+1 NEQ LEVEL AND STACK[INFO+1] GTR 3"4000"
	  THEN BEGIN		% MAY NOT BE IN SAME BLOCK
	    DO			% SEE IF IN SAME PROC
	      IF ADRSR[2*I:=I-1] EQL 0	% IF GOING THRU PROC BLOCK
	      THEN INLEVEL:=* AND ADRS NEQ PROADDRESS AND I EQL J
	    UNTIL I EQL J;
	    INLEVEL:=* AND ADRS NEQ PROADDRESS
	  END
	END;

PROCEDURE EMITPROCAORV(INFO,AORV);	% EMIT ADDRESS OR VALUE OF PROC ID
	VALUE INFO,AORV;
	INTEGER INFO;
	BOOLEAN AORV;
	BEGIN
	  INTEGER J,NEWLEVEL:=STACK[INFO+2]+1,OFFSET:=STACK[INFO+5],
		  K:=STACK[INFO+1];
	  STACK[INFO+1]:=3"34000";	% FUDGE FOR INLEVEL 
	  IF LEVEL LSS NEWLEVEL 	% REF TO FUNCTION IN BLOCK OF DECLARATION
	  THEN FLAG(54);		% AS DECLARED AT. NOT ALLOWED.
	  STACK[INFO+2]:=NEWLEVEL;	% RAISE PROC TO LEVEL OF ITS PARAMS
	  IF INLEVEL(INFO,J)		% FUNCTION IN THIS BLOCK?
	  THEN
	    IF AORV			% SEE IF WANT ADDRESS OR VALUE
	    THEN EMITD(3"34004"+OFFSET) % WANT ADDRESS
	    ELSE EMITO(3"34004"+OFFSET) % WANT VALUE
	  ELSE BEGIN		% NOT ON SAME LEVEL SO SEARCH RCW'S UNTIL
	    EMITNUM(2*OFFSET+8);% OFFSET TO FUNCTION FROM RCW
	    EMITL(J);		% LEVEL OF RCW
	    EMIT(FIND); 	% DO A STACK SEARCH TO FIND IT
	    IF NOT AORV 	% SEE IF REALLY WANT THE VALUE
	    THEN EMIT(LOD)	% YES SO LOAD VALUE
	  END;
	  STACK[INFO+2]:=NEWLEVEL-1;	% PUT PROC BACK TO IT'S LEVEL
	  STACK[INFO+1]:=K		% GET ORIGIONAL ADDRESS BACK 
	END OF GETTING THE ADDRESS OR VALUE OF A PROC;
SAVE PROCEDURE EMITADDRESS(INDEX,OFFSET);
	VALUE INDEX,OFFSET;
	INTEGER INDEX,OFFSET;
	BEGIN
	  INTEGER I1:=STACK[INDEX+1],I2:=STACK[INDEX+2],I3:=STACK[INDEX+3];
	  LABEL L1;
	  J:=I1+(IF I1 LSS 3"4000" OR I1 GEQ 3"34000"
		 THEN OFFSET ELSE -OFFSET);
	  IF I2 EQL 1 OR I2 EQL LEVEL
	  THEN
	    L1: IF I3 GEQ 0		% NOT A PROC NAME PARAM
	    THEN
	      IF DEBUGTOG	% DOES HE HAVE CODE SET ?
	      THEN EMITD(J)	% YES. LET EMITD HANDLE IT
	      ELSE EMITC(SHL(J,2)+3)	% OTHERWISE WE CAN HANDLE IT
	    ELSE		% PROC NAME PARAM
	      IF DEBUGTOG
	      THEN EMITO(J)	% FOR CODE THAT'S SET
	      ELSE EMITC(SHL(J,2)+2)
	  ELSE BEGIN
	    IF INLEVEL(INDEX,I2)	% SEE IF IN PROC DECLARATION WAS IN
	    THEN GO L1;
	    EMITNUM((4*I1.[11:1]-2)*I1.[10:11]);	% OFFSET FROM RCW
	    EMITL(I2);		% LEVEL RCW FOUND AT
	    EMIT(FIND); 		% FIND ADDRESS
	    IF I3 LSS 0 		% NAME TOG
	    THEN EMIT(LOD);
	    IF OFFSET NEQ 0		% OFFSET FROM HERE?
	    THEN EMITPAIR(2*OFFSET,ADD) % YES
	  END
	END OF EMITADDRESS;

PROCEDURE EMITVALUE(INDEX,OFFSET);
	VALUE INDEX,OFFSET;
	INTEGER INDEX,OFFSET;
	BEGIN
	  INTEGER I1:=STACK[INDEX+1],I2:=STACK[INDEX+2],I3:=STACK[INDEX+3];
	  LABEL L1;
	  J:=I1+(IF I1 LSS 3"4000" OR I1 GEQ 3"34000"
		 THEN OFFSET ELSE -OFFSET);
	  IF I2 EQL 1 OR I2 EQL LEVEL		% IN SAME PROC DECLARED IN
	  THEN BEGIN
	    L1: IF DEBUGTOG
	    THEN EMITO(J)
	    ELSE EMITC(SHL(J,2)+2);
	    IF STACK[INDEX] NEQ ARRAYID AND I3 LSS 0
	    THEN EMIT(LOD)		% LB'S OF ARRAYS PASSED BY VALUE 
	  END
	  ELSE BEGIN
	    IF INLEVEL(INDEX,I2)	% IN SAME PROC AS DECLARATION ?
	    THEN GO L1;
	    EMITADDRESS(INDEX,OFFSET);
	    EMIT(LOD)			% LOAD VALUE
	  END
	END;
INTEGER PROCEDURE GETSPACE(X);
	VALUE X;
	INTEGER X;
	BEGIN
	  INTEGER T,C,I;
	% LENGTH TO ALLOCATE
	% 8 FOR TRUTHSETS
	% 5 FOR FILE DESCRIPTORS
	% 4 FOR PROGRAM SEGMENTS OR ARRAY ID'S
	% 3 FOR POINTERS
	% 2 FOR REALS
	% 1 FOR BOOLEANS OR INTEGERS
	  I:=REAL(CLASSF=ARRAYID OR
		  CLASSF GEQ PROCID AND CLASSF LEQ INTPROCID)*3
		  + REAL(CLASSF EQL REALID)
		  + REAL(CLASSF EQL STRINGID)*2
		  + REAL(CLASSF EQL FILEID)*4
		  + REAL(CLASSF EQL TRUTHID)*7+1;
	  IF BOOLEAN(X) OR EXTERNALTOG
	  THEN
	    IF C:=PRTMAX:=PRTMAX + 1 > 1024-I
	    THEN FLAG(PRTMAX:=C:=57)
	    ELSE
	  ELSE
	    IF C:=STACKCTR:=STACKCTR+I GEQ 14330
	    THEN FLAG(STACKCTR:=C:=58);
	  IF PRTTOG THEN
	  BEGIN
	    T:=IF EXTERNALTOG AND FUNCTION THEN "X" ELSE
	      IF BOOLEAN(X) THEN "P" ELSE "S";
	    REPLACE LINEOUT BY "   ",O6(C),"-",T FOR 1,
	      " = ",PS FOR 33 WORDS;
	    WRITEALINE(80);
	  END;
	  GETSPACE:=C;		% RETURN VALUE
	  IF BOOLEAN(X) OR EXTERNALTOG	% IN PRT ?
	  THEN PRTMAX:=PRTMAX+I-1	% GET TRUE LENGTH OF PRT THEN 
	END;

PROCEDURE CLEANIT;
	BEGIN
	  INTEGER T,C,LOLD,B;
	  T:=1;
@O	% UNTIL WE GET A BINDER
	  B:=L;
	  L:=L+2;
@O
	  IF ERRORCOUNT = 0
	  THEN
	    WHILE T LEQ CLEAN
	    DO BEGIN
	      LOLD:=L;
	      L:=CONST[T];
	      IF C:=CONST[T:=T+1] NEQ 0
	      THEN EMITD(LOLD-L+3"17777")
	      ELSE EMITO(LOLD-L+3"17777");
	      L:=LOLD;
	      C:=T + C+ REAL(C EQL 0);
	      WHILE T:=T+1 LEQ C
	      DO BEGIN
		EMITC(CONST[T]);
		IF DEBUGTOG
		THEN BEGIN
		  REPLACE LINEOUT BY " " FOR 18,O6(L-1),"  " FOR 16,
			  O6(CONST[T]);
		  WRITEALINE(46)
		END
		END
	    END;
@O			% NO BINDER YET SO SAVE THE CODE
	  LOLD:=L;
	  L:=B;
	EMITD(-1);	% MARK CONSTANT FOR BINDER
	EMITL(LOLD-L);	% (NUMBER OF CONSTANTS+1)*4
	  L:=LOLD;
@O
	  CLEAN:=0
	END;
PROCEDURE SATBLDR(ADDRESS,DA);
	VALUE ADDRESS,DA;
	INTEGER ADDRESS,DA;
	BEGIN
	  OWN INTEGER PLLB;
	  PRTA[PLLB+1]:=PLLB:=ADDRESS;
	  IF PLL = 0
	  THEN PLL:=ADDRESS;
	  PRTA[ADDRESS]:=L;
	  PRTA[ADDRESS+2]:=DA;
	  PRTA[ADDRESS+3]:=SGNO;
	  IF DEBUGTOG
	  THEN BEGIN
	    REPLACE LINEOUT BY "  " FOR 17,O6(ADDRESS),"  ",O6(L),
		    "  ",O6(DA),"  ",O6(SGNO);
	    WRITEALINE(47)
	  END
	END;

INTEGER PROCEDURE NEXTCHAR;
	BEGIN
	  IF QUOTING:=REAL(P,1) EQL 0
	  THEN BEGIN
	    IF TOBEWRITTEN
	    THEN WRITECARD;
	    READCARD;		% GET NEXT CARD
	    REPLACE STR BY CARD FOR REAL(NEWCARD:=BOOLEAN(72));
	    WRITECARD		% AND WRITE IT OUT
	  END;
	  INSTR[REAL(QUOTING:=FALSE)]:=NEXTCHAR:=REAL(P,LINSTR:=1);
	  LASTCOL:=DELTA(CARD,P);
	  P:=*+1
	END;

PROCEDURE QUOTE;
	BEGIN
	LABEL EXIT,L1;
	INTEGER J,T;
	CONST[CLEAN:=CLEAN+1]:=L;
	T:=CLEAN:=CLEAN+LENGTH:=1;
	CONST[CLEAN:=CLEAN+1]:=NEXTCHAR;
	WHILE J:=NEXTCHAR NEQ	"""
	DO BEGIN
	  L1: IF BOOLEAN(LENGTH)
	  THEN CONST[CLEAN].[15:8]:=J
	  ELSE
	    IF CLEAN:=CLEAN +	1 GTR 2040
	    THEN BEGIN
	      CLEAN:=0;
	      ERROR(79);
	      GO EXIT
	    END
	    ELSE CONST[CLEAN]:=J;
	  LENGTH:=LENGTH+1
	END;
	SKIPSPACES;	% CHECK FOR "STRING" "STRING"
	GETNEXT;	% IN CASE OF DEFINES
	IF CLASS EQL QUOTEOP
	THEN BEGIN	% THAT'S WHAT WE HAVE
	  J:=NEXTCHAR;	% SCAN TO THE CHAR AFTER
	  GO L1
	END;
	CONST[T]:=SHR(LENGTH+1,1);
	L:=L +1;
EXIT: END;
PROCEDURE GETROW(MUSTBEFACTOP); 	% LOOKS AT SUBSCRIPTED ARRAY NAME
	VALUE MUSTBEFACTOP;		% AND GENERATES THE CODE TO ALLOCATE
	BOOLEAN MUSTBEFACTOP;		% THE DOPE VECTORS IF NEED BE LEAVING
					% A ARRAY ROW DESCRIPTOR ON TOS
	BEGIN
	  LABEL EXIT;
	  BOOLEAN INDEXED,B;
	  INTEGER I,RC,T;
	  IF CLASS NEQ ARRAYID	% IF NOT ARRAY ID THEN ERROR
	  THEN BEGIN
	    FLAG(71);		% IMPROPER ROW DESIGNATOR
	    GO EXIT
	  END;
	  RC:=STACK[4+I:=INFO]; % GET ROW COUNT AND INFO BOTH
	  GETNEXT;		% SCAN THE ARRAY NAME
	  IF CLASS NEQ LFTBRKT AND BOOLEAN(RC)	% SHOULD BE A '['
	  THEN BEGIN
	    FLAG(75);		% MISSING '[' IN ROW DESIGNATOR
	    GO EXIT
	  END;
	  IF INDEXED:=CLASS EQL LFTBRKT   % HAVE A '['
	  THEN GETNEXT; % AND WANT TO SKIP OVER IT
	  IF BOOLEAN(RC)		% NOW FOR SOME TRICKORY
	  THEN BEGIN		% AND KLUDGING
	    AEXP;
	    IF STACK[I+3] LSS 0 % IS ARRAY A PARAMETER?
	    THEN BEGIN		% YES.
	      IF BOOLEAN(SHR(RC,1))	% IS DV RE-MAPPED?
	      THEN			% YES
		IF T:=STACK[I+6] NEQ 0	% CAN WE OPTIMIZE
		THEN EMITPAIR(T,SUB)	% NO
		ELSE			% YES
	      ELSE BEGIN		% GET LOWER BOUND FROM PARAM LIST
		EMITVALUE(I,1); 	% GET IT
		EMIT(SUB)		% SUBTRACT FROM INDEX
		END;
	      EMITADDRESS(I,0); 	% GET ACTUAL LB FROM DESCRIPTOR
	      EMITPAIR(6,ADD);		% HERE'S THE ADDRESS
	      EMIT(LOD);		% AND HERE'S THE VALUE
	      EMIT(ADD);		% ADD TO INDEX
	      EMITADDRESS(I,0); 	% GET ADDRESS OF DESCRIPTOR
	      EMITPAIR(2,ADD);		% GET ADDRESS OF ADDRESS OF DV
	      EMIT(LOD) 	% LOAD ADDRESS OF DV
	    END
	    ELSE EMITVALUE(I,1);	% OTHERWISE GET ADDRESS FROM DESCRIPTOR
	    EMITPAIR(8,ADD);	% POINT TO IT
	    EMIT(LOD);		% LOAD VALUE
	    EMITL(0);		% FUDGE FOR ADC
	    EMITADDRESS(I,0);
	    EMIT(ADC);		% CHECK INDEXING
	    EMIT(XCH);		% GET OUR FUDGE FACTOR ON TOS
	    EMIT(DEL);		% DELETE IT
	    EMITPAIR(2,SUB);
	    EMIT(LOD);		% GET ADDRESS OF ARRAY DESCRIPTOR
	    IF CLASS NEQ COMMA	% COMMA BETWEEN INDICIES
	    THEN FLAG(37)	% ',' EXPECTED
	    ELSE GETNEXT
	  END
	  ELSE BEGIN		% FOR 1 DIM ARRAYS
	    EMITADDRESS(I,0);	% ADDRESS OF ARRAY DESCRIPTOR
	    IF NOT MUSTBEFACTOP
	    THEN
	      IF NOT INDEXED	% JUST ARRAY NAME
	      THEN EMITL(0)	% SO COMPLETE POINTER WITH NULL INDEX
	  END;
	  IF INDEXED		% WE HAD A '['
	  THEN BEGIN
	    IF CLASS EQL FACTOP % * AS COL DESIGNATOR MEANS
	    THEN BEGIN		% SEE IF WE ARE CREATING A POINTER
	      IF MUSTBEFACTOP
	      THEN		% YES. SO OK
	      ELSE EMITL(0);
	      GETNEXT		% SCAN FOR A ']'
	    END
	    ELSE		% SEE IF CALCULATIND POINTER INDEX
	      IF B:=MUSTBEFACTOP
	      THEN ERROR(76)	% NOT PROPER ROW DESIGNATOR
	      ELSE BEGIN
		IF STACK[I+3] LSS 0	% ARRAY A PARAMETER?
		THEN BEGIN		% YES
		  AEXP; 		% GET INDEX
		  IF BOOLEAN(SHR(RC,1+T:=REAL(BOOLEAN(RC) AND TRUE)))
		  THEN			% RE-MAPPED
		    IF T:=STACK[I+6+T] NEQ 0	% CAN WE OPTIMIZE?
		    THEN EMITPAIR(T,SUB)	% NO
		    ELSE
		  ELSE BEGIN		% NOT RE-MAPPED
		    EMITVALUE(I,T+1);	% GET LB FROM PARAM LIST
		    EMIT(SUB)
		  END
		END
		ELSE BEGIN		% NOT A PARAM
		  EMIT(DUP);		% DUP ADDRESS OF ARRAY DESCRIPTOR
		  EMITPAIR(6,ADD);	% GET ADDRESS OF LB
		  EMIT(LOD);		% LOAD LB
		  AEXP; 		% GET INDEX
		  EMIT(SUB);		% WANT TO SUBTRACT LB FROM INDEX
		  EMIT(CHS)		% SO CHANGE SIGHN OF RESULT
		END;
		IF STACK[I+5] EQL REALID% THIS ISN'T FOR REAL, IS IT?
		THEN EMITPAIR(2,SHLL)	% YES. MULTIPLY OFFSET BY 4
		ELSE BEGIN
		  EMIT(DUP);		% ELSE MULTIPLY BY 2
		  EMIT(ADD)
		END
		END;
	    IF CLASS NEQ RTBRKT
	    THEN FLAG(77)
	    ELSE GETNEXT
	  END;
EXIT:	END OF GET ROW;
PROCEDURE ACTUALPARAPART(BOOL);
	VALUE BOOL;
	BOOLEAN BOOL;
	BEGIN
	  INTEGER A,C,T,P,AT;
	  BOOLEAN B,N;
	  LABEL EXIT;
	  T:=STACK[4+AT:=INFO]; % POINTER TO PARAM LIST
	  EMIT(MKS);
	  IF BOOL
	  THEN GETNEXT; 	% POSSIBLE GETNEXT DONE BY VARIABLE
	  IF T NEQ 0		% WE HAVE PARAMS
	  THEN BEGIN
	    IF CLASS NEQ LFTPAREN
	    THEN BEGIN		% NO '('
	      ERROR(31);
	      GO EXIT
	    END;
	    IF T < CLASSMAX		% ALL INTEGER BY VALUE
	    THEN BEGIN
	      GETNEXT;		% SCAN THE '(' OR THE ','
	      AEXP;		% GET VALUE
	      WHILE T:=T - 1 >	0
	      DO BEGIN
		IF CLASS NEQ COMMA	% NOT FOLLOWED BY A COMMA
		THEN BEGIN
		  ERROR(46);
		  GO EXIT
		END;
		GETNEXT;		% SCAN THE ','
		AEXP;
		END
	    END
	    ELSE BEGIN	% PARAMETER LIST
	      IF B:=STACK[T] = -1	% LIST IS PACKED
	      THEN T:=T+1;
	      DO BEGIN
		GETNEXT;		% GET TO START OF NEXT PARAM
		IF B
		THEN BEGIN		% PACKED LIST
		  C:=STACK[T].[13:14];% CLASS	OF NEXT PARAM
		  N:=STACK[T]	< 0 ;	% NAME
		END
		ELSE BEGIN		% POINTER FROM DECLARATION TO LIST
		  C:=STACK[T-8];	% CLASS
		  N:=STACK[T-5] < 0;	% NAME
		END;
		IF N
		THEN		% CALL BY NAME
		  IF C NEQ CLASS
		  THEN FLAG(IF CLASS=0 THEN 28 ELSE 44)
		  ELSE
		    IF C EQL ARRAYID	% GET LOWER LIMITS FOR ARRAYS
		    THEN BEGIN
		      INTEGER T1:=STACK[INFO+4],A1:=INFO,T2;
		      BOOLEAN B1;
		      IF B		% PACKED LIST
		      THEN BEGIN
			IF SHR(P:=STACK[T:=T+1],8) NEQ STACK[INFO+5]
			THEN FLAG(44);	% DIFFER IN ARRAY CLASS
			IF BOOLEAN(P) AND NOT BOOLEAN(T1)
			THEN FLAG(45)	% DIFFER IN # OF DIMS (1 INTO 2)
			END
		      ELSE BEGIN	% NON-PACKED LIST
			IF STACK[T-3] NEQ STACK[INFO+5]
			THEN FLAG(44);	% DIFFER IN ARRAY CLASS
			IF BOOLEAN(P:=STACK[T-4]) AND NOT BOOLEAN(T1)
			THEN FLAG(45)	% # OF DIMS DIFFER (1 INTO 2)
			END;
		      IF BOOLEAN(P)		% 2-DIM
		      THEN			% YES. GO TURN ON THE LIGHTS
			IF STACK[A1+3] LSS 0	% ARRAY A PARAM?
			THEN			% YES
			  IF BOOLEAN(SHR(T1,2)) % ROW RE-MAPPED?
			  THEN EMITNUM(STACK[A1+7])	% YES, GET LB FROM DECL
			  ELSE EMITVALUE(A1,2)	% ELSE GET LB FROM PARAM LIST
			ELSE BEGIN		% GET LB FROM DESCRIPTOR
			  EMITVALUE(A1,1);	% GET ADDRESS OF ADDRESS OF DV
			  EMITPAIR(8,ADD);	% GET TO ADDRESS OF LB
			  EMIT(LOD)		% LOAD LOWER BOUND
			END
		      ELSE GETROW(TRUE);	% GET ARRAY ROW DESCRIPOR
		      T2:=REAL(BOOLEAN(T1) AND NOT BOOLEAN(P) AND TRUE); % 2 INTO 1 TOG
		      IF STACK[A1+3] LSS 0	% ARRAY A PARAMETER?
		      THEN BEGIN		% YES
			IF BOOLEAN(SHR(T1,1))	% ROW (OR DV) RE-MAPPED?
			THEN EMITNUM(STACK[A1+6+T2])	% YES. GET LB FROM DECL
			ELSE EMITVALUE(A1,1+T2);	% GET LB FROM PARAM LIST
			IF BOOLEAN(P)		% 2-DIM?
			THEN			% YES
			ELSE EMIT(XCH)		% OTHER WISE PUT STACK IN PROPER ORDER
			END
		      ELSE			% NOT A PARAM
			IF BOOLEAN(P)		% 2-DIM?
			THEN EMITVALUE(A1,3)	% LOWER BOUND OF DV
			ELSE BEGIN		% 1-DIM. ARRAY DESCRIPTOR ON TOS
			  EMIT(DUP);		% DUP ADDRESS OF DESCRIPTOR
			  IF BOOLEAN(T1)	% COMING FROM 2-DIM?
			  THEN BEGIN
			    EMITPAIR(2,ADD);
			    EMIT(LOD);
			    EMITPAIR(8,ADD)
			  END
			  ELSE EMITPAIR(6,ADD); % GET ADDRESS OF LB
			  EMIT(LOD);		% LOAD LB
			  EMIT(XCH)		% PUT STACK IN PROPER ORDER
			END;
		      IF BOOLEAN(P)		% ARRAY GOING INTO 2-DIM
		      THEN BEGIN
			GETNEXT;		% SEE IF FOLLOWED BY '['
			T1:=0;
			IF CLASS EQL LFTBRKT	% YES
			THEN BEGIN
			  DO BEGIN
			    GETNEXT;	% SCAN THE '[' OR ','
			    IF B1:=CLASS NEQ FACTOP	% TO GET A '*'
			    THEN FLAG(76)% '*' EXPECTED
			    ELSE BEGIN
			      GETNEXT;	% SCAN THE '*'
			      IF B1:=CLASS NEQ
				 IF BOOLEAN(T1)
				 THEN RTBRKT	% CHECK FOR ']'
				 ELSE COMMA	% OR ','
			      THEN FLAG(	% ERROR
				 IF BOOLEAN(T1)
				 THEN 77	% ']' EXPECTED
				 ELSE 37)	% ',' EXPECTED
			    END
			  END
			  UNTIL B1 OR T1:=T1+1 EQL 2;
			  IF B1 % THERE WAS AN ERROR
			  THEN GO EXIT
			  ELSE GETNEXT
			END;
			EMITADDRESS(A1,0)
			END
		    END
		    ELSE BEGIN		% NOT ARRAY
		      IF CLASS GEQ PROCID AND CLASS LEQ INTPROCID
		      THEN		% TYPE IS PROC
			IF STACK[INFO+4] NEQ 0	% > 1 PARAM. NO GO IN THE SNOW
			THEN FLAG(44);
		      EMITADDRESS(INFO,0);  % PUT OUT THE ADDRESS
		      GETNEXT		% SCAN THE ID
		    END
		ELSE			% VALUE
		  IF C EQL BOOID	% BOOLEAN VALUE
		  THEN BEXP
		  ELSE
		    IF C EQL INTID	% INTEGER VALUE
		    THEN AEXP
		    ELSE BEGIN		% POINTER VALUE
		      EMITL(0); 	% FOR POINTER LINK
					% FILLED IN BY PROC ENTRY 
		      PEXP;		% GET EXPRESSION
		      EMIT(XCH) 	% REVERSE FOR PROPER ORDER
		    END
		END
	      UNTIL P:=IF B
		       THEN STACK[T:=T+1]
		       ELSE T:=STACK[T]
		EQL 0 OR CLASS NEQ COMMA;
	      IF P NEQ 0
	      THEN BEGIN
		ERROR(46);
		GO EXIT
		END
	    END;
	    IF CLASS NEQ RTPAREN	% NOT FOLLOWED BY ')'
	    THEN BEGIN
	      ERROR(32);
	      GO EXIT
	    END;
	    GETNEXT
	  END
	  ELSE
	    IF STACK[AT+2] EQL 0	% MUST BE TOGGLE
	    THEN BEGIN
	      L:=*-2;			% GET RID OF MKS & LITC 0
	      EMITO(STACK[AT+1]);	% GET IT'S ADDRESS
	      GO EXIT
	    END;
	  IF T:=STACK[AT+1] LSS 0	% MAKE ADDRESS POS IF FORWARD REF
	  THEN STACK[AT+1]:=-T;
	  EMITADDRESS(AT,0);	% ADDRESS OF PROCEDURE DESCRIPTOR MAY BE
				% IN STACK (IN PARAM LIST)
	  STACK[AT+1]:=T;	% PUT BACK TO WHAT IT SHOULD BE
	  EMIT(SBR);		% SUBROUTINE ENTRANCE
EXIT:	END;
PROCEDURE POLISHIT;;
PROCEDURE VARIABLE(FROM);
	VALUE FROM;
	INTEGER FROM;
	BEGIN
	BOOLEAN BOOL,B;
	INTEGER A,C,T,PT,T2;
	LABEL EXIT,L1,L2;
	A:=ADDRESS; PT:=INFO;
	IF CLASS EQL POLISHV OR B:=T:=CLASS EQL BOOPROCID OR T EQL INTPROCID
	THEN BEGIN
	  DEFINE RUNFASTER=#;
	  IF NOT B	% POLISH
	  THEN BEGIN
	    GETNEXT;
	    IF CLASS EQL ASSIGNOP
	    THEN BEGIN
	      GETNEXT;		% SCAN THE ':='
	      AEXP
	    END
	    ELSE
	      IF FROM EQL FS
	      THEN
		IF CLASS EQL LFTPAREN
		THEN POLISHIT
		ELSE FLAG(67);	% ":=" EXPECTED
	    GO EXIT
	  END;
	  GETNEXT;		% FIND OUT WHAT TO DO
	  IF CLASS EQL ASSIGNOP OR CLASS EQL DOTOP	% ASSIGNMENT
	  THEN BEGIN
	    INFO:=PT;
	    IF T EQL BOOPROCID
	    THEN T:=BOOID
	    ELSE T:=INTID;
	    BOOL:=TRUE
	  END
	  ELSE BEGIN
	    INFO:=PT;
	    ADDRESS:=A;
	    EMITL(0);
	    ACTUALPARAPART(FALSE);
	    IF FROM EQL FS
	    THEN EMIT(DEL);
	    GO EXIT
	  END
	END;
@O	% FIELDS NOT SUPPORTED IN THIS VERSION
	IF T = FIELDID OR T = BOOFIELDID THEN
	BEGIN
	  INTEGER SEGMENT;
	  GETNEXT;
	  IF C:=STACK[A] = ARRAYID THEN
	  BEGIN
	    IF CLASS = LFTPAREN THEN
	    BEGIN
	      GETNEXT;
	      AEXP;
	      IF CLASS = COMMA THEN
	      BEGIN
		GETNEXT;
		AEXP;
		EMIT(ADD)
		END;
	      IF STACK[PT+4] NEQ 0 THEN
		IF STACK[PT+4] > 0 THEN EMITPAIR(STACK[PT+4],ADD)
		ELSE EMITPAIR(-STACK[PT+4],SUB);
	      IF CLASS NEQ RTPAREN THEN FLAG(32) ELSE GETNEXT;
	    END
	    ELSE EMITL(STACK[PT+4]);
	  END;
	  IF CLASS = ASSIGNOP THEN
	  BEGIN
	    GETNEXT;
	    IF T = BOOFIELDID THEN BEXP ELSE AEXP;
	    IF STACK[A+3]<0 THEN EMITO(STACK[A+1]) ELSE EMITD(STACK[A+1]);
	    IF C = ARRAYID THEN EMIT(ADC);
	    IF C:=STACK[PT+5] NEQ 16 THEN	% FIELD INSERT
	    BEGIN
	      EMITNUM(2**C.[8:8]-1);	% MASK
	      EMITPAIR(16-(C.[0:8]+C.[8:8]),FDI);
	      IF FROM NEQ FP THEN EMIT(DEL);
	    END ELSE
	    IF FROM = FP THEN EMIT(STN) ELSE EMIT(STD);
	  END ELSE
	  IF FROM = FP THEN
	  BEGIN
	    IF C = ARRAYID THEN
	    BEGIN
	      IF STACK[A+3]<0  THEN EMITO(STACK[A+1]) ELSE EMITD(STACK[A+1]);
	      EMIT(AOC);
	    END ELSE
	    BEGIN
	      EMITO(STACK[A+1]);
	      IF STACK[A+3]<0 THEN EMIT(LOD);
	    END;
	    IF C:=STACK[PT+5] NEQ 16 THEN
	    BEGIN
	      IF T:=C.[0:8]+C.[8:8] NEQ 16 THEN EMITPAIR(16-T,SHRR);
	      IF C.[0:8] NEQ 0 THEN
	      BEGIN
		EMITNUM(2**C.[8:8]-1);
		EMIT(LND);
		END;
	    END;
	  END
	  ELSE ERROR(67);
	  GO TO EXIT;
	END;
@O
	IF CLASS = ARRAYID	% FOR ARRAYS HAVE TO GET INDEXING
	THEN BEGIN
	  DEFINE SEGMENT=#;
	  C:=STACK[INFO+4];	% GET CODE WORD
	  GETNEXT;		% GET '['
	  IF CLASS NEQ LFTBRKT
	  THEN BEGIN
	    ERROR(40);	% '[' EXPECTED
	    GO EXIT	% FORGET THIS ONE
	  END;
	  GETNEXT;	% SCAN THE '['
	  AEXP; 	% GET 1ST INDEX
	  IF STACK[PT+3] LSS 0		% ARRAY IS A PARAM
	  THEN BEGIN
	    IF BOOLEAN(SHR(C,1))	% RE-MAP
	    THEN
	      IF T2:=STACK[PT+6] NEQ 0	% OPTIMIZE IF WE CAN
	      THEN EMITPAIR(T2,SUB)
	      ELSE
	    ELSE BEGIN			% GET LB FROM PARAM LIST
	      EMITVALUE(PT,1);		% GET LB
	      EMIT(SUB) 		% SUBTRACT FROM INDEX
	    END;
	    EMITADDRESS(PT,0);		% NOW GET TRUE LB
	    EMITPAIR(6,ADD);		% FROM ARRAY DESCRIPTOR WORD #4
	    EMIT(LOD);			% LIKE SO
	    EMIT(ADD)			% AND ADD TO INDEX
	  END;
	  IF BOOLEAN(C) 		% LOWER BIT => 2 DIM
	  THEN BEGIN
	    IF CLASS NEQ COMMA		% COMMA BETWEEN DIMENSIONS
	    THEN BEGIN ERROR(37); GO EXIT; END;
	    GETNEXT;	% SCAN THE ','
	    AEXP;		% 2ND DIM
	    IF STACK[PT+3] LSS 0		% A PARAMETER
	    THEN BEGIN
	      IF BOOLEAN(SHR(C,2))	% RE-MAP JOBBIE?
	      THEN
		IF T2:=STACK[PT+7] NEQ 0	% OPTIMIZE IF WE CAN
		THEN EMITPAIR(T2,SUB)
		ELSE			% SUBTRACT OFF DECLARED LOWER BOUND
	      ELSE BEGIN
		EMITVALUE(PT,2);		% OTHER WISE GET LB FROM PARAM LIST
		EMIT(SUB)
		END;
	      EMITADDRESS(PT,0);		% GET ACTUAL LB FROM DESCRIPTOR
	      EMITPAIR(2,ADD);		% GET ADDRESS OF DV
	      EMIT(LOD);		% LOAD IT
	      EMITPAIR(8,ADD);		% GET ADDRESS OF ROW LB
	      EMIT(LOD);		% LOAD IT
	      EMIT(ADD) 		% ADD TO INDEX
	    END
	  END;
	  IF CLASS NEQ RTBRKT	% SEE IF FOLLOWED BY A ']'
	  THEN BEGIN
	    ERROR(41);		% MISSING ']'
	    GO EXIT
	  END
	END;
L1:	IF NOT BOOL
	THEN GETNEXT;	% DELAY GETNEXT IF TYPED-PROC ID
	IF CLASS = DOTOP AND FROM = FS AND T NEQ STRINGID
	THEN BEGIN		% PARTIAL WORD ASSIGNMENT
	  DEFINE SEG=#; 	% FORCE A SEG CAUSE NOT OFTEN USED
	  GETNEXT;
	  IF CLASS NEQ LFTBRKT	% SEE IF A '['
	  THEN BEGIN
	    ERROR(40);		% NO
	    GO EXIT		% GIVE UP
	  END;
	  GETNEXT;		% SCAN IT
	  AEXP; 		% GET LEFT-BIT-TO
	  IF T = ARRAYID		% FOR ARRAYS, SHOVE LEFT-BIT-TO UNDER INDICIES
	  THEN EMIT(IF BOOLEAN(C) THEN RSDN ELSE XCH);
	  IF CLASS NEQ COLON	% FOLLOWED BY A ':'?
	  THEN BEGIN
	    ERROR(36);		% NO
	    GO EXIT		% NO HOPE FOR THIS GUY
	  END;
	  GETNEXT;		% SCAN THE ':'
	  AEXP; 		% GET # OF BITS
	  IF T EQL ARRAYID	% FOR ARRAYS MOVE # OF BITS UNDER INDICIES
	  THEN EMIT(IF BOOLEAN(C) THEN RSDN ELSE XCH);
	  IF CLASS NEQ RTBRKT	% FOLLOWED BY A ']'
	  THEN BEGIN
	    ERROR(41);		% NO
	    GO EXIT
	  END;
	  GETNEXT;		% SCAN THE ']'
	  IF CLASS NEQ ASSIGNOP % FOLLOWED BY AN ASSIGNMENT?
	  THEN BEGIN		% BETTER BE
	    ERROR(67);		% ERROR
	    GO EXIT
	  END;
	  GETNEXT;		% SCAN IT
	  IF T EQL BOOID OR (T EQL ARRAYID AND STACK[PT+5] EQL BOOID)
	  THEN BEXP
	  ELSE AEXP;
	  IF BOOL				% SEE IF OPERATING ON FUNCTION
	  THEN EMITPROCAORV(PT,TRUE)	% GET ADDRESS OF PROC
	  ELSE EMITADDRESS(PT,0);	% OTHERWISE PUT OUT JUST THE ADDR
	  IF T = ARRAYID		% FOR ARRAYS DO ARRAY DESCRIPTOR CALL
	  THEN EMIT(ADC);		% TO FIGURE WHERE WE GOING
	  EMIT(FID);
	  EMIT(DEL);
	  GO EXIT;
	END;
	IF CLASS EQL ASSIGNOP		% AN ASSIGNMENT
	THEN BEGIN
	  IF ASTRISK:=REAL(P,1) EQL "*" % CHECK FOR ':=*'
	  THEN BEGIN
	    DEFINE NEWSEGMENT=#;
	    P:=*+1;		% UPDATE POINTER 
	    SKIPSPACES; 	% SCAN OUT ANY SPACES FOLLOWING IT
	    CLASS:=FACTOP;		% RESET INFO TO ANYTHING FOR *****
	    IF T EQL ARRAYID
	    THEN BEGIN
	      EMITADDRESS(PT,0);	% FUNCTION REFS.
	      EMIT(DPL) 		% DUP & LOAD ARRAY VALUE
	    END
	    ELSE BEGIN
	      IF BOOL
	      THEN EMITPROCAORV(PT,FALSE)	% GET VALUE
	      ELSE BEGIN			% SEE IF WE CAN OPTIMIZE
		IF NOT B:=FROM EQL FS AND T EQL STRINGID% NO
		THEN EMITVALUE(PT,0);
		IF T EQL STRINGID		% NEED INDEX FOR STRINGS
		THEN
		  IF STACK[PT+3] LSS 0		% A PARAM BY NAME 
		  THEN BEGIN
		    EMITADDRESS(PT,0);		% GET ITS ADDRESS
		    EMITPAIR(2,ADD);		% GET ADDRESS OF 2ND WORD
		    EMIT(LOD)
		  END
		  ELSE EMITVALUE(PT,1)		% GET FROM POINTER 
		END
	    END
	  END
	  ELSE GETNEXT; 	% ELSE GET NEXT TOKEN
	  IF T EQL BOOID OR (T EQL ARRAYID AND STACK[PT+5] EQL BOOID)
	  THEN BEXP
	  ELSE
	    IF PTRPRIM:=T EQL STRINGID
	    THEN BEGIN
	      IF NOT B		% ALREADY OPTIMIZED
	      THEN
		IF ASTRISK
		THEN GO L2
		ELSE
		  IF ASTRISK:=STACK[INFO+1] EQL STACK[PT+1]	% ADDRESS THE SAME
		     AND STACK[INFO+2] EQL STACK[PT+2]	% LEVEL THE SAME
		     AND CLASS EQL STRINGID	% AND A POINTER
		     AND REAL(P,1) NEQ ":"	% NOT ASSIGNMENT
		     AND FROM EQL FS		% FROM STATEMENT
		  THEN BEGIN			% VALC AND DO STD INSTEAD OF PSTD
		    B:=TRUE;			% DON'T WANT TO CHANG VALUE OF B ABOVE
		    CLASS:=FACTOP;
		    IF STACK[PT+3] LSS 0		% BY NAME ?
		    THEN BEGIN			% YES
		      EMITADDRESS(PT,0);	% GET ADDRESS OF POINTER
		      EMITPAIR(2,ADD);		% GET ADDRESS OF WORD 2
		      EMIT(LOD) 		% LOAD VALUE
		    END
		    ELSE EMITVALUE(PT,1)		% ONLY CHANGING THE INDEX
		  END;
L2:	      PEXP;		% POINTER EXPRESSION (PRIMARY SET)
	      PTRPRIM:=FALSE	% THEN RESET
	    END
	    ELSE AEXP;
	  IF BOOL
	  THEN EMITPROCAORV(PT,TRUE)	% GET ADDRESS OF PROC NAME
	  ELSE
	    IF STACK[PT+3] LSS 0		% BY NAME ?
	    THEN BEGIN
	      EMITADDRESS(PT,0);	% GET ADDRESS OF 1ST WORD
	      IF B AND T EQL STRINGID	% WANT 2ND WORD ?
	      THEN EMITPAIR(2,ADD)	% IF SO THEN THIS WILL DO IT
	    END
	    ELSE EMITADDRESS(PT,REAL(B AND T EQL STRINGID));% FOR POINTER OPTIMIZATION
	  BOOL:=FROM EQL FP;	% FROM PRIMARY
	  IF T EQL ARRAYID	% FIGURE OUT THE KIND OF STORE WE WANT
	  THEN EMIT(IF BOOL THEN ASN ELSE ASD)
	  ELSE
	    IF T EQL STRINGID AND NOT B   % POINTER STORES
	    THEN EMIT(IF BOOL THEN PSTN ELSE PSTD)
	    ELSE EMIT(IF BOOL THEN STN ELSE STD)	% A GROCERY STORE
	END
	ELSE
	  IF FROM EQL FP	% FROM PRIMARY
	  THEN BEGIN
	    IF T EQL ARRAYID	% NEED ADDRESS FOR ARRAY'S
	    THEN BEGIN
	      EMITADDRESS(PT,0);	% GET ADDRESS
	      EMIT(AOC) 	% AND GET VALUE
	    END
	    ELSE BEGIN
	      IF BOOL		% PROC VALUE ?
	      THEN EMITPROCAORV(PT,FALSE)  % GET VALUE
	      ELSE EMITVALUE(PT,0);	  % FROM ONE OR THE OTHER
	      IF PTRPRIM:=T EQL STRINGID
	      THEN
		IF STACK[PT+3] LSS 0	% BY NAME ?
		THEN BEGIN		% YES
		  EMITADDRESS(PT,0);	% GET ADDRESS OF WORD 1
		  EMITPAIR(2,ADD);	% GET ADDRESS OF WORD 2
		  EMIT(LOD)
		END
		ELSE EMITVALUE(PT,1)	% ELSE GET INDEX FROM POINTER
	    END
	  END
	  ELSE ERROR(67);	% ASSIGNMENT OP EXPECTED
EXIT:	END OF VARIABLE;
PROCEDURE CONCAT(X);	% HANDLES CONCATANATIONS
	VALUE X;
	BOOLEAN X;
	BEGIN
	  INTEGER I;
	  LABEL EXIT;
	  DO BEGIN	% AS LONG AS WE'RE CONCATING
	    GETNEXT;	% SCAN THE '&'
	    IF CLASS EQL LFTPAREN	% '(AE)'
	    THEN			% SEE WHO HANDLES THIS ONE
	      IF X			% BOOPRIM
	      THEN I:=BOOPRIM
	      ELSE PRIMARY		% OR PRIMARY
	    ELSE
	      IF X		% WAS A BOOLEAN CONCAT
	      THEN BEGIN	% ONLY CAN BE '(<BE>)'
		ERROR(31);	% '(' EXPECTED
		GO EXIT
		END
	      ELSE		% PRIMARILY FROM PRIMARY
		IF CLASS EQL INTID OR CLASS EQL INTPROCID OR
		   CLASS EQL ARRAYID AND STACK[INFO+5] EQL INTID
		THEN VARIABLE(FP)		% FROM PRIMARY
		ELSE BEGIN	% ERROR
		  FLAG(116);	% MUST BE ID OR '(AE)'
		  GO EXIT
		END;
	    IF CLASS NEQ LFTBRKT% CONCAT WITH LEFT BRAKET
	    THEN FLAG(40)	% '[' EXPECTED
	    ELSE BEGIN
	      GETNEXT;		% SCAN THE '['
	      AEXP;		% GET LEFT-MOST BIT TO #
	      IF CLASS NEQ COLON% SHOULD BE FOLLOWED BY A ':'
	      THEN FLAG(36)	% ':' EXPECTED
	      ELSE BEGIN
		GETNEXT;	% SCAN THE ':'
		AEXP;		% GET # OF BITS OR FROM-BIT #
		IF CLASS EQL RTBRKT	% # OF BITS
		THEN BEGIN
		  EMIT(FISD);	% FIELD ISOLATE DYNAMIC
		  GETNEXT	% SCAN THE ']'
		END
		ELSE
		  IF CLASS NEQ COLON	% ':' THERE?
		  THEN FLAG(41) % NO. ']' EXPECTED
		  ELSE BEGIN
		    GETNEXT;	% SCAN IT
		    AEXP;	% GET # OF BITS
		    IF CLASS NEQ RTBRKT % FOLLOWED BY A ']' ?
		    THEN FLAG(41)% NO. ']' EXPECTED
		    ELSE GETNEXT;% SCAN IT
		    EMIT(FISO)	% FIELD ISOLATE
		  END
		END
	    END
	  END
	  UNTIL CLASS NEQ AMPER;	% SCAN ALL THE CONCATS AT ONCE
EXIT:	END OF CONCATENATION;


PROCEDURE DOT;
	BEGIN
	LABEL EXIT;
	GETNEXT;			% SEE IF OPEN BRACKET
	IF CLASS NEQ LFTBRKT THEN
		 BEGIN ERROR(40); GO EXIT; END;
		 GETNEXT;		% SCAN IT 
	AEXP;				% GET LEFT BIT FROM
	IF CLASS NEQ COLON THEN BEGIN ERROR(36); GO EXIT END; GETNEXT;
	AEXP;				% GET NUMBER OF BITS
	EMIT(PART);			% GET PARTIAL VALUE
	IF CLASS NEQ RTBRKT THEN ERROR(41) ELSE GETNEXT;
EXIT: END;
BOOLEAN PROCEDURE EACHCASE(X);
%	X =-1	    DESIGNATIONAL EXPRESSION (GO TO)
%	    0	    QUOTED STRING EXPRESSION
%	    1	    ARITHMETIC EXPRESSION
%	    2	    POINTER EXPRESSION
%	    3	    BOOLEAN EXPRESSION
%	    4	    POINTER, STRING, OR ARITHMETIC (REPLACE STMT)
%	    5	    POINTER OR ARITHMETIC	   (PRIMARY - REAL FUNCTION)
%	    6	    POINTER,ARITHMETIC OR BOOLEAN  (BOOPRIM - BOOLEAN())
%	    7	    POINTER OR QUOTED STRING	   (BOOPTRPRIM)
	INTEGER X;
	BEGIN
	  LABEL L1,L2;
	  BOOLEAN B;
	  INTEGER I:=ERRORCOUNT;	% USED TO SEE IF ANY ARROWS
	  IF X LEQ 3		% ALREADY KNOW WHAT TO DO
	  THEN
	    CASE X+1 OF
	    BEGIN
	      BEGIN		% DESIGNATIONAL EXPRESSION
		ACTIONTOG:=TRUE;
		GOSTMT
		END;
	      BEGIN		% STRING EXPRESSION
		IF CLASS NEQ QUOTEOP
		THEN FLAG(118)	% STRING EXPECTED
		ELSE BEGIN
		  QUOTE;	% GET STRING
		  EMITL(LENGTH) % AND IT'S LENGTH
		END
		END;
	      AEXP;		% ARITHMETIC EXPECTED
	      PEXP;		% POINTER
	      BEXP		% BOOLEAN
	    END
	  ELSE
	    IF CLASS EQL IFV OR B:=CLASS EQL CASEV
	    THEN BEGIN			% LET CASEORIF HANDLE IT
	      CASEORIF(X);
	      IF B THEN GO L1
	    END
	    ELSE			% JUST A REGULAR CASE.
	      IF CLASS EQL LFTPAREN	% '('
	      THEN BEGIN
		GETNEXT;		% STRIP THE ')'
		EACHCASE:=EACHCASE(X);	% NOW SEE WHAT IT IS
		IF CLASS NEQ RTPAREN	% NOT FOLLOWED BY A ')'
		THEN FLAG(32)
		ELSE GETNEXT;
L1:		IF X GEQ 1 AND X LEQ 3
		THEN			% MAKE EXPRESSIONS 
		  CASE X OF
		  BEGIN
		    1:IF CLASS EQL DOTOP% ARITHMETIC
		      THEN DOT;
		      IF CLASS EQL AMPER
		      THEN CONCAT(FALSE);
		      IF CLASS EQL EXPOP
		      THEN BEGIN
			GETNEXT;
			PRIMARY;
			EMIT(EXP)
			END;
		      TERM(FALSE);
		      ARITHSEC;
		      IF CLASS EQL INV	% CHANGE TO BOOLEAN
		      THEN BEGIN
			IF CLASS NEQ TRUTHID
			THEN FLAG(106)
			ELSE BEGIN
			  EMITADDRESS(INFO,0);
			  EMIT(INOP);
			  GETNEXT
			END;
			X:=3;
			GO L2
			END
		      ELSE
			IF J:=CLASS GEQ NEQOP AND J LEQ LEQOP
			THEN BEGIN
			  GETNEXT;
			  AEXP;
			  EMIT(J-NEQOP+NE);
			  X:=3; 	% CHANGE TO BOOLEAN
			  GO L2
			END;
		    2:IF CLASS EQL ADDOP OR B:=CLASS EQL SUBOP
		      THEN BEGIN
			GETNEXT;
			PRIMARY;
			EMIT(IF B THEN SUB ELSE ADD)
			END;
		    3:IF CLASS EQL DOTOP
		      THEN DOT;
L2:		      IF CLASS EQL AMPER
		      THEN CONCAT(TRUE);
		      WHILE CLASS EQL ANDV
		      DO BEGIN
			GETNEXT;
			IF BOOLEAN(BOOPRIM)
			THEN EMIT(LND)
			ELSE ERROR(34)
			END;
		      WHILE CLASS EQL ORV
		      DO BEGIN
			GETNEXT;
			IF BOOLEAN(BOOSEC)
			THEN EMIT(LOR)
			ELSE ERROR(35)
			END
		  END
		END
	      ELSE
		IF CLASS EQL STRINGID OR CLASS EQL POINTERV	% POINTER CASE
		   OR CLASS EQL ARRAYID AND REAL(P,1) NEQ "["
		   OR CLASS NEQ QUOTEOP AND X EQL 7	% 7 IS SE OR PE
		THEN BEGIN		% SO TRY A POINTER EXPRESSION
		  X:=2; 	% SET TO POINTER;
		  PEXP;
		  IF CLASS GEQ NEQOP AND CLASS LEQ LEQOP OR CLASS EQL INV
		  THEN BEGIN		% WOOPS REALLY	A BOOLEAN
		    BOOPTRPRIM(FALSE);	% POINTER ALREADY SCANNED
		    X:=3		% INDICATE BOOLEAN
		  END
		END
		ELSE
		  IF CLASS EQL QUOTEOP AND X EQL 4  % QUOTED STRING
		  THEN BEGIN
		    X:=0;			% SET TO STRING EXPRESSION
		    QUOTE;
		    EMITL(LENGTH)
		  END
		  ELSE
		    IF BOOLEAN(X:=REAL(X NEQ 6))	% MUST BE AE
		    THEN AEXP
		    ELSE X:=EXPRESS*2+1;	% AE OR BE
	  EACHCASE:=I NEQ ERRORCOUNT;
	END OF EACH CASE;
PROCEDURE CASEORIF(X);
	INTEGER X;
	BEGIN
	  INTEGER ARRAY CASES[0:255];
	  INTEGER TL,EL,CC,T,I;
	  BOOLEAN N;
	  LABEL EXIT;
	  IF CLASS EQL IFV	% IF EXPRESSION
	  THEN BEGIN		% LETTUCE PARCELY IT
	    GETNEXT;		% SCAN THE 'IF'
	    BEXP;		% BOOLEAN EXPRESSION
	    IF CLASS NEQ THENV	% FOLLOWED BY A 'THEN'?
	    THEN BEGIN
	      FLAG(39); 	% 'THEN' EXPECTED
	      GO EXIT
	    END;
	    IF X GEQ 0		% NOT DESIGNATIONAL
	    THEN GETNEXT;	% SO SCAN THE THEN (ELSE GOSTMT DOES)
	    IF N:=EDOC[L-1] EQL 3"2401"+4*LNG AND EDOC[L] GEQ 0  % OPTIMIZE OUT NOT'S
	    THEN L:=L-1;
	    TL:=BUMPL;		% SAVE THE 'THEN' L
	    IF EACHCASE(X)	% SEE WHAT WE GOTS.
	    THEN GO EXIT;
	    IF CLASS NEQ ELSEV	% FOLLOWED BY A 'ELSE'?
	    THEN BEGIN
	      FLAG(63); 	% 'ELSE' EXPECTED
	      GO EXIT
	    END;
	    IF X GEQ 0		% NOT DESIGNATIONAL
	    THEN GETNEXT;	% OTHERWISE GOSTMT WILL SCAN IT
	    EL:=BUMPL;		% BRANCH OUT OF THIS CASE
	    CONSTANTCLEAN;	% DUMP FLOATING POOL ARRAYS
	    EMITB(IF N THEN BRTR ELSE BRFL,TL,L);
	    IF EACHCASE(X)	% GET NEXT CASE
	    THEN GO EXIT;
	    EMITB(BRUN,EL,L)	% BRANCH AROUND THE ELSE CASE
	  END
	  ELSE BEGIN		% CASE'S
	    DEFINE ABC = #;	% SEG THIS SEGMENT
	    GETNEXT;		% SCAN THE 'CASE'
	    TL:=BUMPL;		% LEAVE ROOM FOR THE STACK BUILDING CODE
	    AEXP;		% GET CASE INDEX
	    EMIT(OCX);		% DO OCCURS INDEX INTO CASE BODY
	    EL:=L;		% WHERE 1ST INDICIE IS AT
	    IF CLASS NEQ OFV	% MISSING 'OF'
	    THEN BEGIN
	      FLAG(97); 	% TELL HIM
	      GO EXIT
	    END;
	    GETNEXT;		% SCAN THE 'OF'
	    IF CLASS NEQ LFTPAREN	% MISSING '('
	    THEN BEGIN
	      FLAG(31); 	% TELL HIM
	      GO EXIT
	    END;
	    IF X GEQ 0		% IF NOT DESIGNATIONAL EXPRESSION
	    THEN GETNEXT;	% ELSE GOSTMT WILL SCAN IT
	    CC:=-1;		% INIT THE CASE COUNT
	    DO BEGIN		% SCAN THE CASE BODY
	      CASES[CC:=CC+1]:=L;% SAVE START OF EACH EXPRESSION
	      IF EACHCASE(X)	% SEE IF A VALID CASE
	      THEN GO EXIT;	% NO
	      CASES[CC:=CC+1]:=BUMPL;	% WHERE TO LEAVE FROM
	      CONSTANTCLEAN;	% DUMP FLOATING POOL ARRAYS
	      IF CLASS EQL COMMA OR N:=CLASS EQL RTPAREN
	      THEN
		IF X GEQ 0 OR N % IF CALLING GOSTMT
		THEN GETNEXT	% THEN LET HIM SCAN IT
		ELSE
	      ELSE BEGIN	% MISSING ')'
		FLAG(32);
		GO EXIT
		END
	    END
	    UNTIL N;
	    EMITD(3"17777"+(T:=L)-(L:=TL-2));	% GO BACK TO FILL IN THE
				% STACK BUILDING CODE
	    EMITL(CC DIV 2);	% NUMBER OF CASES
	    L:=T;		% BACK TO BUILD THE TABLE
	    T:=0;
	    DO BEGIN
	      I:=CASES[T]*2+2;	% OFFSET TO THE OCCURS INDEX
	      IF DEBUGTOG	% CODE SET?
	      THEN BEGIN	% YES. (DARN)
		REPLACE LINEOUT BY " " FOR 18,O6(L)," " FOR 16,O6(I);
		WRITEALINE(46)
		END;
	      EMITC(I)		% PUT OUT THE CODE
	    END
	    UNTIL T:=T+2 GTR CC;% STOP WHEN OUT OF BOUNDS
	    T:=T-1;
	    DO EMITB(BRUN,CASES[T],L)	% BRANCH OUT
	    UNTIL T:=T-2 LSS 0		% ALL DONE
	  END;
	  IF EDOC[L]:=-1 GEQ 0	% FAKE IT OUT FOR GOOD CASES
	  THEN		% THE ABOVE ASSIGNMENT DONE TO HELP OPTIMIZATION
EXIT:	    X:=4;		% RESET INDICATOR TO SAY A FAILURE
	END OF CASE OR IF EXPRESSIONS;
PROCEDURE IMPFUN;		% IMPLEMENTED FUNCTIONS
	BEGIN
	  BOOLEAN B,C;
	  INTEGER I:=CLASS;
	  DEFINE CHECKIT(A,B)=IF CLASS NEQ A THEN FLAG(B) ELSE GETNEXT#;
	  GETNEXT;		% SCAN THE FUNCTION NAME
	  CHECKIT(LFTPAREN,31);
	  CASE I-SIGNV OF
	  BEGIN
	0:			% SIGN( <AE> )
	      AEXP;
	      EMIT(DUP);
	      EMITPAIR(0,LS);
	      EMITPAIR((L+7)*2,BRFL);
	      EMIT(DEL);
	      EMITNUM(-1);
	      EMITPAIR((L+5)*2,BRUN);
	      EMITPAIR(0,NE);
	1:			% ONES
	      AEXP;
	      EMIT(ONESS);
	2:			% TIME
	      AEXP;
	      EMITPAIR(10,COM);
	3:			% DELTA
	      PEXP;		% GET 1ST POINTER EXPRESSION
	      CHECKIT(COMMA,37);	% CHECK FOR A COMMA
	      PEXP;		% GET 2ND POINTER EXPRESSION
	      EMIT(RSDN);	% GET ARRAY DESCRIPTOR
	      EMIT(DEL);	% SKIP IT
	      EMIT(SUB);	% SUBTRACT THE TWO INDEXES
	      EMIT(XCH);	% GET 1ST ARRAY DESCRIPTOR
	      EMIT(DEL);	% SKIP THAT ONE ALSO
	4-5:			% SHL AND SHR
	      B:=I EQL SHRV;	% CHECK FOR SHR.
	      AEXP;
	      CHECKIT(COMMA,37);
	      AEXP;
	      EMIT(IF B THEN SHRR ELSE SHLL);
	6:			% SHIFT
	      AEXP;
	      CHECKIT(COMMA,37);
	      AEXP;
	      EMIT(DUP);
	      EMITPAIR(0,LS);
	      EMITPAIR((L+7)*2,BRFL);
	      EMIT(CHS);
	      EMIT(SHRR);
	      EMITPAIR((L+4)*2,BRUN);
	      EMIT(SHLL);
	7:			% ABS
	      AEXP;
	      EMIT(DUP);	% DUP A COPY
	      EMITPAIR(0,LS);	% SEE IF LESS THAN ZERO
	      EMITPAIR((L+4)*2,BRFL);	% IF SO THEN CHANGE THE SIGN
	      EMIT(CHS);	% LIKE SO
	8-9:			% MAX AND MIN
	      B:=I EQL MAXV;
	      AEXP;
	      IF CLASS EQL COMMA
	      THEN
		DO BEGIN
		  GETNEXT;	% SCAN THE COMMA
		  EMIT(DUP);	% COPY TOS
		  AEXP; 	% GET NEXT THING TO COMPARE WITH
		  EMIT(DUP);	% DUP THAT ALSO
		  EMIT(RSDN);	% MAKE STACK A,B,A,B
		  EMIT(IF B THEN GT ELSE LS);	% DO A COMPARISON
		  EMITPAIR((L+4)*2,BRTR);	% A WAS BEST 
		  EMIT(XCH);	% MAKE STACK B,A
		  EMIT(DEL);	% POP THE BAD ELEMENT
		END
		UNTIL CLASS NEQ COMMA;
	10:			% ADDR FUNCTION
	      IF CLASS EQL INTID OR CLASS EQL BOOID
	      THEN BEGIN
		EMITADDRESS(INFO,0);
		GETNEXT 	% SCAN IT 
		END
	      ELSE
		IF CLASS EQL ARRAYID
		THEN BEGIN
		  IF STACK[INFO+3] LSS 0 OR BOOLEAN(STACK[INFO+4]) OR
		     REAL(P,1) EQL "["	% ARRAY ELEMENT OR PARAM
		  THEN BEGIN
		    EMITL(0);		% FUDGE FOR ADC
		    GETROW(FALSE);	% COULD BE INDEXED
		    IF J:=EDOC[L-1] EQL 3"2401"+4*ADD OR J EQL 3"2401"+4*SHLL
		    THEN L:=*-2;	% TAKE OUT CODE FOR DOUBLING INDEX
		    EMIT(XCH);		% GET ARRAY DESCRIPTOR
		    EMIT(DUP);		% DUP A COPY TO WORK WITH
		    EMIT(RSDN); 	% PUT UNDER INDEX
		    EMITPAIR(6,ADD);	% GET ADDRESS OF LB
		    EMIT(LOD);		% LOAD LB
		    EMIT(ADD);		% ADD TO INDEX
		    EMIT(RSDN)		% PUT INDEX AS 3RD ELEMENT IN STACK
		  END
		  ELSE BEGIN
		    EMITVALUE(INFO,3);	% GET LB
		    EMITL(0);		% FUDGE FOR ADC
		    EMITADDRESS(INFO,0);% ADDRESS OF ARRAY DESCRIPTOR
		    GETNEXT		% SCAN IT 
		  END;
		  EMIT(ADC);		% GET ADDRESS
		  EMIT(DEL);		% POP OFF THE 0
		END
		ELSE ERROR(87); 	% NOT PROPER ARG FOR ADDR FN
	11:				% FIRSTONES
	      AEXP;		% GET THE #
	      EMIT(FONES);
	12:				% COMPILETIME
	      IF CLASS NEQ ICONSTANT OR INREAL LSS 0 OR INREAL GTR 5
	      THEN FLAG(38)
	      ELSE BEGIN
		EMITL(TIME(INREAL));
		GETNEXT
		END
	  END OF CASES;
	  CHECKIT(RTPAREN,32)		% ')' SHOULD FOLLOW INTRINSICS
	END;
	BOOLEAN PROCEDURE FILEATTRIBUTES(FROM,EXPRESSIONKIND);
	VALUE FROM,EXPRESSIONKIND;
	INTEGER FROM;
	BOOLEAN EXPRESSIONKIND;
	BEGIN
	  INTEGER I,J;
	  BOOLEAN B1;
	  LABEL L1;
	  I:=INFO;
	  GETATTRIBUTE;
	  IF CLASS NEQ DOTOP
	  THEN FLAG(96) 	% NOT PROPER FILE ATTRIBUTE
	  ELSE BEGIN
	    GETATTRIBUTE;
	    IF EXPRESSIONKIND
	    THEN
	      IF J:=REAL(CLASS EQL PRESENTV)+2*REAL
		(CLASS EQL OPENV) EQL 0
	      THEN GO L1
	      ELSE BEGIN
		FILEATTRIBUTES:=TRUE;
		GETNEXT;
		IF STACK[I+3] GEQ 0
		THEN EMITADDRESS(I,REAL(J EQL 2 AND CLASS NEQ ASSIGNOP))
		ELSE BEGIN	% FILE IS A PARAM 
		  EMITADDRESS(I,0);	% GET ADDRESS OF FILE DESCRIPTOR
		  IF J EQL 2 AND CLASS NEQ ASSIGNOP
		  THEN EMITPAIR(2,ADD)	% GET TO ADDRESS OF FIB POINTER
		END;
		IF B1:=CLASS EQL ASSIGNOP
		THEN BEGIN		% FILE.OPEN,FILE.PRESENT:=BEXP
		  GETNEXT;
		  BEXP;
		  EMITL(REAL(FROM EQL FS));
		  EMITL(J-1);
		  EMITPAIR(6,COM)
		END
		ELSE
		  IF J EQL 2
		  THEN BEGIN		% FILE.OPEN
		    EMIT(LOD);
		    EMITPAIR(2,ADD);
		    EMIT(LOD);
		    EMITPAIR(15,SHRR)
		  END
		  ELSE BEGIN		% FILE.PRESENT ?
		    EMITL(2);
		    EMITPAIR(6,COM)
		  END
		END
	      ELSE L1:
		IF J:=REAL(CLASS EQL KINDV)+2*REAL(CLASS EQL MAXRECV)+
		  3*REAL(CLASS EQL CURRECV)+4*REAL(CLASS EQL MYUSEV)+
		  5*REAL(CLASS EQL MAXSIZEV)
		  EQL 0
		THEN FLAG (96)
		ELSE BEGIN
		  GETNEXT;
		  IF CLASS EQL ASSIGNOP
		  THEN BEGIN
		    EMITADDRESS(I,0);		% ADDRESS OF FILE DESC
		    GETNEXT;		% GET TO START OF ARITHMETIC EXPRESSION
		    AEXP;		% PARSE IT 
		    EMITL(REAL(FROM EQL FS));	% STD,STN TOG
		    EMITL(J-1); 	% WHAT TO CHANGE
		    EMITPAIR(7,COM)		% CHANGE IT
		  END
		  ELSE
		    IF CLASS NEQ ASSIGNOP AND FROM EQL FS
		    THEN FLAG(67)
		    ELSE BEGIN
		      IF STACK[I+3] GEQ 0
		      THEN EMITADDRESS(I,IF J LEQ 2 THEN 0 ELSE
					 J-2+REAL(J EQL 5))
		      ELSE BEGIN   % FILE IS A PARAMETER
			EMITADDRESS(I,0);	% GET ADDRESS OF FD
			IF J GTR 2
			THEN EMITPAIR(2*(J-2+REAL(J EQL 5)),ADD)
			END;
		      CASE J OF
		      BEGIN
		      1: BEGIN		% KIND
			  EMIT(LOD);
			  EMITPAIR(7,LND)
			END;
		      2: BEGIN		% MAXRECSIZE
			  EMIT(LOD);
			  EMITPAIR(3,SHRR)
			END;
		      3: BEGIN		% CURRENTRECNO
			  EMIT(LOD);
			  EMITPAIR(2,ADD);
			  EMIT(LOD);
			  EMITPAIR(3"77777",LND)
			END;
		      4: 5: EMIT(LOD)	% MYUSE, MAXRECNO
			END
		   END
		END
	  END
	END;
PROCEDURE PRIMARY;
	BEGIN
	INTEGER J,T;
	LABEL LE,LDOT,EXIT,LB,L2,L9;
	BOOLEAN B;
	IF CLASS EQL FACTOP AND ASTRISK %:=*
	THEN BEGIN
	  ASTRISK:=FALSE;
	  GETNEXT;		% SCAN TO THE NEXT TOKEN TO MAKE EVERYBODY HAPPY
	  GO LDOT		% FOLLOWED BY MAYBE A DOT
	END;
	ASTRISK:=FALSE;
	IF CLASS EQL ATPOUNDV
	THEN GO L9;		% CHECK FOR @# (BYTE POINTER)
	IF CLASS EQL POLISHV
	THEN GO L2
	ELSE
	  IF CLASS EQL FILEID
	  THEN BEGIN
	    B:=FILEATTRIBUTES(FP,FALSE);
	    GO LDOT END;
	IF BOOLEAN(J:=REAL(CLASS EQL CASEV))	% CASE EXPRESSION
	THEN BEGIN
	  CASEORIF(J);		% 1 IS ARITHMETIC
	  GO LDOT
	END;
	IF CLASS EQL VALUEV	% VALUE ( <FILE-MNEMONIC> )
	THEN BEGIN
	  LABEL ALT;		% MAKE NEW SEGMENT
	  GETNEXT;		% SEE IF A '('
	  IF CLASS NEQ LFTPAREN
	  THEN FLAG(31) 	% NOPE. TOO BAD
	  ELSE BEGIN
	    GETATTRIBUTE;	% OTHERWISE GET MNEMONIC-FILE ATTRIBUTE
	    IF CLASS GEQ BINV AND CLASS LEQ LPV  % 'KIND'-MNEMONIC
	    THEN BEGIN
	      EMITL(CLASS-BINV);
	      GO ALT
	    END
	    ELSE
	      IF CLASS GEQ INV AND CLASS LEQ IOV	% 'MYUSE'-MNEMONIC
	      THEN BEGIN
		EMITL(CLASS-INV+1);
ALT:		GETNEXT 	% SCAN THE MNEMONIC
		END
	      ELSE FLAG(123);	% ILLEGAL FILE-MNEMONIC.
	    IF CLASS NEQ RTPAREN% FOLLOWED BY A ')' ?
	    THEN FLAG(32)	% NOPE. TOO BAD
	    ELSE GETNEXT	% SCAN IT
	  END;
	  GO LDOT		% FINISH OFF THE PRIMARY
	END;
	IF CLASS GEQ SIGNV AND CLASS LEQ COMPILTIMEV
	THEN BEGIN
	  IMPFUN;		% IT'S AN ALGOL IMPLEMENTED FUNCTION 
	  GO LDOT		% FINISH OFF THE PRIMARY
	END
	ELSE
	  IF CLASS GTR TRUTHSETV
	  THEN GO LE
	  ELSE
	    IF CLASS GTR INTEGERV
	    THEN GO LB;
	CASE CLASS OF
	BEGIN		% COMMENT TO FAKE SCANNER
0:	  ERROR(28);	% UNDEFINED ID
	  GO EXIT;
1:2:5:15:16:18-21:
LE:	  ERROR(30);	% PRIMARY MAY NOT BEGIN WITH THIS TYPE QUANTITY
	  GO EXIT;
3:4:6:7:10:
L2:	  VARIABLE(FP); % CALL VARIABLE FROM PRIMARY
8:	  IF STACK[INFO+5] EQL BOOID
	  THEN GO LE
	  ELSE GO L2;	% ARRAY IDS
11:	  EMITNUM(INREAL);	% INTEGER CONSTANTS
	  GETNEXT;	% SCAN IT
	  GO EXIT;	% CAN'T HAVE PARTIAL WORD PARTS
13:	  J:=NEXTCHAR;	% ASCII QUOTED STRING
	  IF T:=NEXTCHAR NEQ """
	  THEN BEGIN
	    J:=J+256*T;
	    T:=NEXTCHAR
	  END;
	  EMITNUM(J);
	  IF T NEQ """	% MAX LENGTH OF QUOTED INTEGER STRINGS IS 2
	  THEN ERROR(80)% STRING TO LONG
	  ELSE BEGIN
	    SKIPSPACES; % SKIP ANY SPACES FOLLOWING THE 2ND '"'
	    GETNEXT	% SCAN TO NEXT TOKEN
	  END;
14:
L9:	  B:=CLASS EQL ATPOUNDV;
	  GETNEXT;	% SCAN THE '@' OR '@#'
	  PRIMARY;
	  EMIT(IF B THEN LODB ELSE LOD);
17:	  GETNEXT;	% '('
	  AEXP;
	  IF CLASS NEQ RTPAREN
	  THEN ERROR(32)% ')' EXPECTED
	  ELSE GETNEXT; % SCAN IT
22:	  FLAG(33);	% 'BEGIN' PRIMARY MAYN'T STRT WITH DECLS
	  STMT;
	  GO EXIT;
23:
LB:	  FLAG(33);	% DITTO
	  BLOK(0);	% FAKE A NEW BLOCK
	  GO EXIT;
24:	  BEGIN
	    DEFINE SEGMENT = #;
	    GETNEXT;
	    IF CLASS = LFTPAREN
	    THEN BEGIN
	      GETNEXT;
	      J:=6;	% COULD BE POINTER,REAL OR BOOLEAN
	      IF NOT EACHCASE(J)% SEE WHICH
	      THEN
		IF J EQL 2	% POINTER
		THEN
		  IF CLASS NEQ COMMA	% FOLLOWED BY ',' ?
		  THEN FLAG(37)
		  ELSE BEGIN
		    GETNEXT;	% REAL(<PE>,<AE>)
		    AEXP;
		    EMIT(PLOD)	% LOAD POINTER VALUE
		  END;
	      IF CLASS NEQ RTPAREN
	      THEN ERROR(32)
	      ELSE GETNEXT;
	      GO LDOT;
	    END;
	    GO LB;
	  END;
25:	  BEGIN
	    DEFINE SEGMENT=#;
	    GETNEXT;		% SCAN THE 'INTEGER'
	    IF CLASS EQL LFTPAREN
	    THEN BEGIN
	      GETNEXT;		% SCAN THE '('
	      J:=5;		% COULD BE REAL OR POINTER
	      IF NOT EACHCASE(J)% NO ERRORS
	      THEN BEGIN
		IF J EQL 2	% POINTER
		THEN BEGIN
		  IF CLASS NEQ COMMA
		  THEN FLAG(37) % COMMA EXPECTED
		  ELSE BEGIN
		    GETNEXT;	% SCAN THE ','
		    AEXP;	% GET LENGTH
		    EMITPAIR(3"13",COM)% CONVERT
		  END
		END;
		IF CLASS NEQ RTPAREN
		THEN FLAG(32)	% ')' EXPECTED
		ELSE GETNEXT
		END
	    END
	    ELSE GO LB
	  END
	END OF CASE;
LDOT:	IF CLASS = DOTOP THEN DOT;
EXIT:	IF CLASS EQL EXPOP
	THEN BEGIN
	  GETNEXT;
	  PRIMARY;
	  EMIT(EXP)
	END;
	IF CLASS EQL AMPER		% CONCAT 
	THEN CONCAT(FALSE);		% FROM PRIMARY
	END OF PRIMARY;
PROCEDURE TERM(B);
	VALUE B;
	BOOLEAN B;
	BEGIN
	  INTEGER TIMES;
	  IF B
	  THEN PRIMARY;
	  WHILE CLASS IN OPS
	  DO BEGIN
	    TIMES:=REAL(CLASS EQL MULOP OR CLASS EQL FACTOP) +
		2*REAL(CLASS EQL MODV)+3*REAL(CLASS EQL DIVV);
	    GETNEXT;
	    PRIMARY;
	    EMIT(CASE TIMES OF (DIVR,MUL,MD,DIVT))
	  END
	END OF TERM;
PROCEDURE ARITHSEC;
	BEGIN
	  BOOLEAN B;
	  WHILE CLASS EQL ADDOP OR B:=CLASS EQL SUBOP
	  DO BEGIN		% SCAN WHILE ADDING OR SUBTRACTING
	    GETNEXT;
	    TERM(TRUE);
	    EMIT(IF B THEN SUB ELSE ADD)	% SUB IT OR ADD IT
	  END
	END OF ARITHSEC;
PROCEDURE AEXP;
	BEGIN
	  BOOLEAN B;
	  INTEGER I;
	  IF BOOLEAN(I:=REAL(CLASS EQL IFV))	% IF EXPRESSION
	  THEN CASEORIF(I)
	  ELSE BEGIN
	    IF CLASS EQL ADDOP OR B:=CLASS EQL SUBOP
	    THEN GETNEXT;
	    TERM(TRUE);
	    IF B		% WAS A MINUS SIGHN
	    THEN EMIT(CHS);	% SO CHANGE IT
	    ARITHSEC
	  END
	END OF AEXP;
PROCEDURE BOOPTRPRIM(X);	% PARSES BOOLEAN POINTER PRIMARYS
	VALUE X;
	BOOLEAN X;
	BEGIN
	  BOOLEAN P1UP,P2UP,B,F,SPECIALCASE,S;
	  INTEGER T,ROPV;
	  IF X			% SEE IF WE ARE TO SCAN THE 1ST POINTER
	  THEN BEGIN		% OR IF IT WAS SCANNED FOR US (IF X TRUE)
	    IF B:=CLASS EQL STRINGID AND REAL(P,1) EQL ":"
	    THEN BEGIN
	      T:=INFO;
	      GETNEXT;		% SEE IF : OR:=
	      IF P1UP:=CLASS EQL COLON	% UPDATE OF 1ST POINTER
	      THEN EMITADDRESS(T,0);	% PUT IT'S ADDRESS OUT THERE
	      GETNEXT		% SCAN THE ':' OR ':='
	    END;
	    PEXP;			% NOW A POINTER EXPRESSION
	    IF B AND NOT P1UP	% OTHER WAS AN ASSIGNMENT
	    THEN BEGIN
	      EMITADDRESS(T,0); % ADDRESS OF POINTER IN QUESTION
	      EMIT(PSTN)		% STORE AND LEAVE
	    END
	  END;
	  IF ROPV:=CLASS LSS NEQOP OR CLASS GTR LEQOP	% RELATIONAL OP ?
	  THEN			% SEE IF 'IN' OR ERROR
	    IF CLASS EQL INV AND NOT P1UP  % IN
	    THEN BEGIN
	      GETNEXT;		% SCAN IT
	      IF CLASS NEQ TRUTHID	% SHOULD BE FOLLOWED BY A TRUTHSET ID
	      THEN FLAG(106)	% TELL THE GUY
	      ELSE BEGIN
		EMITL(1);	% LENGTH OF POINTER VALUE IS 1
		EMIT(PLOD);	% LOAD POINTER VALUE
		EMITADDRESS(INFO,0);	% ADDRESS OF TRUTHSET
		EMIT(INOP);	% SEE IF IN 
		GETNEXT 	% SCAN THE TRUTHID
		END
	    END
	    ELSE FLAG(114)
	  ELSE BEGIN
	    GETNEXT;		% SCAN IT
	    IF B:=CLASS EQL STRINGID AND REAL(P,1) EQL ":"
	    THEN BEGIN		% COULD BE ANOTHER UPDATE
	      T:=INFO;		% SAVE POINTER TO THIS ID
	      GETNEXT;		% SEE IF ":" OR ":="
	      IF P2UP:=CLASS EQL COLON	% ":". IE. AN UPDATE
	      THEN BEGIN
		EMITADDRESS(T,0);% ADDRESS OF POINTER
		EMIT(RSDN)	% ROTATE STACK DOWN (POINTER ADDRESS PRIOR TO
		END;		% POINTER EXPRESSION ON TOS
	      GETNEXT		% SCAN THE THINGIE
	    END;
	    IF B OR CLASS NEQ IFV AND CLASS NEQ CASEV
	    THEN
	      IF S:=F:=CLASS EQL QUOTEOP AND NOT B
	      THEN QUOTE	% RELATED TO A QUOTED STRING
	      ELSE PEXP 	% RELATED TO A POINTER EXPRESSION
	    ELSE BEGIN		% FOR CASE OF IFS
	      S:=SPECIALCASE:=BOOLEAN(T:=7);
	      IF P2UP		% 2ND POINTER IS UPDATED
	      THEN T:=2;	% SO CASE OR IF MUST RETURN A POINTER
	      CASEORIF(T);	% MUST BE SE OR PE
	      F:=T EQL 0	% SE (LENGTH ON TOS)
	    END;
	    IF B AND NOT P2UP	% POINTER ASSIGNMENT
	    THEN BEGIN
	      EMITADDRESS(T,0); % ADDRESS OF POINTER
	      EMIT(PSTN)	% STORE IT
	    END;
	    IF CLASS EQL FORV	% 'FOR'
	    THEN BEGIN		% WOW
	      IF F		% SE PREVIOUSLY
	      THEN		% IN CASE OR IF?
		IF SPECIALCASE	% YES
		THEN EMIT(DEL); % REMOVE OLD LENGTH
	      F:=TRUE;		% SET COMPARE OPERATOR
	      GETNEXT;		% GET TO START OF ARITHMETIC EXPRESSION
	      AEXP		% GET LENGTH OF COMPARISON
	    END
	    ELSE		% IF STRING
	      IF F		% YES
	      THEN EMITL(LENGTH);% PUT OUT THE LENGTH
	    IF F		% COMPARISON OPERATOR
	    THEN BEGIN
	      EMITL(SHL(ROPV-NEQOP+2,8)+REAL(S AND TRUE) +
			(REAL(P2UP)+REAL(P1UP)*2)*2);	% CODE FOR
	      EMIT(CMP) 	% COMPARE OPERATOR
	    END
	    ELSE		% SEE IF POINTER EQUALITY BEING TESTED
	      IF P1UP OR P2UP OR ROPV NEQ EQLOP AND ROPV NEQ NEQOP
	      THEN FLAG(115)
	      ELSE BEGIN
		EMIT(RSUP);	% GET BOTH INDEXES ON TOS
		EMIT(T:=ROPV-NEQOP+NE); % TYPE OF EQUALITY TEST
		EMIT(RSDN);	% SAVE IT
		EMIT(T);	% COMPARE THE ARRAY POINTERS
		EMIT(IF ROPV EQL EQLOP THEN LND ELSE LOR)  % SEE THAT BOTH
		END		% ARE GOOD 
	  END
	END;
INTEGER PROCEDURE BOOPRIM;
	BEGIN
	INTEGER T;
	BOOLEAN NOTTOG;
	LABEL LR,LE,L1,L2,L3,L4,L5,RP,L6,L7,L9,BXIT,EXIT,LB;
	LABEL START,BDOT,CHECK;
	SWITCH SW:=LE,L4,L2,L2,L4,L2,L2,L1,L2,L2,L2,L2,L2,L2,L9,
		L9,L5,LE,LE,LE,LE,L6,L7,L2;
START:	IF CLASS EQL FACTOP AND ASTRISK
	THEN BEGIN		% CODE ALREADY GENERATED BY VARIABLE
	  ASTRISK:=FALSE;
	  GETNEXT;		% SKAN TO THE NEXT TOKEN TO MAKE US HAPPY
	  GO BXIT
	END;
	ASTRISK:=FALSE;
	IF CLASS EQL READV OR CLASS EQL WRITEV	% I/O FUNCTION CALL
	THEN BEGIN
	  BOOLREADTOG:=TRUE;		% SET TOGGLE
	  WRITESTMT;			% LET WRITE STATEMENT HANDLE IT
	  GO BDOT END
	ELSE
	  IF CLASS EQL FILEID
	  THEN
	    IF FILEATTRIBUTES(FP,TRUE)
	    THEN GO BDOT
	    ELSE GO CHECK;
	IF CLASS EQL STRINGID OR CLASS EQL POINTERV
	THEN BEGIN
	  BOOPTRPRIM(TRUE);
	  GO BXIT
	END;
	IF CLASS EQL CASEV	% BOOLEAN CASE EXPRESSION
	THEN BEGIN			% BOOLEAN CASE EXPRESSION
	  T:=6; 		% COULD BE POINTER OR BOOLEAN OR ARITHEMETIC
	  CASEORIF(T);		% SEE WHAT WE GOTS
	  IF T EQL 2			% IT WAS POINTER 
	  THEN BOOPTRPRIM(FALSE);	% POINTER ALREADY SCANNED
	  IF T EQL 1			% <ARITHMETIC>
	  THEN GO CHECK
	  ELSE GO BDOT			% COULD BE BOOLEAN PARTIAL WORD
	END;
	GO SW[CLASS];
	IF CLASS GEQ POLISHV AND CLASS LEQ COMPILTIMEV OR CLASS EQL VALUEV
	THEN BEGIN
	  AEXP;
	  GO L3
	END;
	IF CLASS = NOTV
	THEN BEGIN
	  NOTTOG:=NOT NOTTOG;
	  GETNEXT;
	  GO START
	END
	ELSE
	  IF CLASS = ADDOP OR CLASS = SUBOP
	  THEN GO L2
	  ELSE
@O		% FIELDS DE-IMPLEMENTED
	IF CLASS = BOOFIELDID THEN GO TO L4 ELSE
	IF CLASS = FIELDID THEN GO L2 ELSE
@O
	  LR:IF CLASS LEQ TRUTHSETV
	  THEN BEGIN
	    LB: FLAG(33);
	    BLOK(0)
	  END
	  ELSE LE: ERROR(34);
	GO EXIT;
L1:	IF STACK[INFO+5] EQL BOOID	% BOOLEAN ARRAY ID
	THEN GO L4;			% SO OK
L2:	AEXP;
L3:	IF CLASS EQL INV	% <AE> IN <TRUTHSET>
	THEN BEGIN
	  GETNEXT;		% SEE WHICH TRUTHSET
	  IF CLASS NEQ TRUTHID	% CHEATER 
	  THEN ERROR(106)
	  ELSE BEGIN
	    EMITADDRESS(INFO,0);  % GET ADDRESS OF TRUTHSET
	    EMIT(INOP); 	% SEE IF IN
	    GETNEXT		% SCAN THE TRUTHSET ID
	  END;
	  GO BXIT		% FINISHED
	END;
	IF T:=CLASS LSS NEQOP OR CLASS GTR LEQOP THEN GO EXIT;
	GETNEXT; AEXP; EMIT(T-NEQOP+NE); GO BXIT;
L4:	VARIABLE(FP); GO BDOT;
L5:	GETNEXT; T:=EXPRESS;
RP:	IF CLASS NEQ RTPAREN THEN BEGIN ERROR(32); GO EXIT; END;
	GETNEXT;
	IF T=0 THEN
	BEGIN
	CHECK:IF CLASS = DOTOP THEN DOT;
	IF CLASS EQL AMPER
	THEN CONCAT(FALSE);
	IF CLASS = EXPOP THEN BEGIN GETNEXT; PRIMARY; EMIT(EXP) END;
	IF CLASS GEQ MULOP AND CLASS LEQ DIVOP
		OR CLASS EQL MODV OR CLASS EQL DIVV
	THEN TERM(FALSE);
	IF CLASS GEQ ADDOP AND CLASS LEQ SUBOP THEN ARITHSEC;
	GO TO L3;
	END;
BDOT:	IF CLASS EQL DOTOP	% BOOLEAN PARTIAL WORD DESIGNATOR 
	THEN DOT;
	GO BXIT;
L6:	FLAG(34); STMT; GO EXIT;
L7:	GETNEXT;
	IF CLASS NEQ LFTPAREN THEN GO LB;
	GETNEXT; AEXP; T:=1; GO RP;
L9:	EMITL(REAL(CLASS EQL TRUTH));GETNEXT;	% TRUE OR FALSE
BXIT:	BOOPRIM:=1;
	IF CLASS EQL AMPER	% BOOLEAN CONCATENATION
	THEN CONCAT(TRUE);
	IF NOTTOG		% WE HAD A NOT
	THEN EMIT(LNG); 	% NOT BAD 
EXIT:	END;
%
INTEGER PROCEDURE BOOSEC;
	BEGIN
	  LABEL EXIT,XIT;
	  IF BOOLEAN(BOOPRIM)
	  THEN
	  ELSE GO XIT;
	  WHILE CLASS EQL ANDV
	  DO BEGIN
	    GETNEXT;
	    IF NOT BOOLEAN(BOOPRIM)
	    THEN ERROR(34);
	    EMIT(LND)
	  END;
EXIT:	  BOOSEC:=1;
XIT:	END;

INTEGER PROCEDURE EXPRESS;
	BEGIN
	  INTEGER T;
	  IF CLASS = IFV	% IF EXPRESSION. BUT WHICH TYPE?
	  THEN BEGIN
	    T:=6;	% COULD BE POINTER, BOOLEAN OR ARITHMETIC
	    CASEORIF(T);% SEE WHICH
	    IF T EQL 2	% POINTER. MAKE BOOLEAN 
	    THEN BOOPTRPRIM(FALSE);
	    T:=REAL(T GEQ 2)	% SEE IF BOOLEAN (POINTER OR BOOLEAN) OR REAL
	  END
	  ELSE
	    IF BOOLEAN(T:=BOOSEC)
	    THEN
	      WHILE CLASS EQL ORV
	      DO BEGIN
		GETNEXT;	% SCAN THE 'OR'
		IF NOT BOOLEAN(T:=BOOSEC)
		THEN ERROR(35)	% BOOLEAN EXPRESSION EXPECTED
		ELSE EMIT(LOR)
		END;
	  EXPRESS:=T
	END OF EXPRESS;


PROCEDURE BEXP;
	IF NOT BOOLEAN(EXPRESS)
	THEN ERROR(34);
@O
<PEXP>::=<SIMPLE	PE> | <CONDITIONAL PE>
<SIMPLE PE>::=<POINTER PRIMARY><SKIP>	|
		<POINTER ASSIGNMENT>	|
		<ARRAY PART>
<CONDITIONAL PE>::=IF <BEXP> THEN <PEXP> ELSE <PEXP>
<POINTER PRIMARY>::=<POINTER ID>	|
			( <PEXP> )	|
			<POINTER CASE EXPRESSION>  |
			POINTER ( <ARRAY PART> )
<POINTER ASSIGNMENT>::=<POINTER ID>:=<PEXP>
<SKIP>::=<ADDING	OP><PRIMARY>
<ADDING OP>::=+ | -
<ARRAY PART>::=<ARRAY ROW DESIGNATOR>	|
		<INDEXED ARRAY ROW DESIGNATOR>
@O
PROCEDURE PEXP; 		% PARSES POINTER EXPRESSIONS
	BEGIN
	  INTEGER TTL,TEL,I,RC;
	  BOOLEAN NNOT,PVF,OPT;
	  LABEL EXIT;
	  IF CLASS EQL FACTOP AND ASTRISK
	  THEN BEGIN
	    GETNEXT;		% SCAN THE ASTRISK
	    ASTRISK:=FALSE	% RE-SET TOG
	  END
	  ELSE BEGIN
	    ASTRISK:=FALSE;
	    IF CLASS EQL CASEV OR PVF:=CLASS EQL IFV	% CASE OR IF EXPRESSIONS
	    THEN BEGIN
	      I:=2;		% MUST BE POINTER PRIMARY
	      CASEORIF(I);	% GET IT 
	      IF PVF		% IF EXPRESSIONS ARE FINISHED AT THIS POINT
	      THEN GO EXIT	% BUT CASES CAN CONTINUE
	    END
	    ELSE
	      IF CLASS EQL STRINGID	% POINTER
	      THEN BEGIN
		VARIABLE(FP);		% FROM PRIMARY 
		IF NOT PTRPRIM		% IF NOT A POINTER PRIMARY
		THEN GO EXIT		% THEN WE ARE DONE
		END
	      ELSE
		IF CLASS EQL LFTPAREN	% (<PEXP>)
		THEN BEGIN
		  GETNEXT;		% SCAN THE '('
		  PEXP; 	%('<PEXP>'
		  IF CLASS NEQ RTPAREN%(<PEXP>')'
		  THEN FLAG(32) % ')' EXPECTED
		  ELSE GETNEXT;
		END
		ELSE BEGIN		% [POINTER(]ROW-DESIGNATOR[)]
		  IF PVF:=CLASS EQL POINTERV	% POINTER VALUED FUNCTION
		  THEN BEGIN
		    GETNEXT;		% SCAN THE 'POINTER'
		    IF CLASS NEQ LFTPAREN	% POINTER '('
		    THEN FLAG(31)	% '(' EXPECTED
		    ELSE GETNEXT
		  END;
		  GETROW(FALSE);	% GET ARRAY ROW AND INDEX
		  IF PVF		% POINTER VALUED FUNCTION
		  THEN		% I.E. POINTER(ROW-DESIGNATOR)
		    IF CLASS NEQ RTPAREN	% CHECK FOR THE ')'
		    THEN FLAG(32)	% ')' EXPECTED
		    ELSE GETNEXT
		END
	  END;
	  IF CLASS EQL ADDOP OR NNOT:=CLASS EQL SUBOP	% ADDING OP
	  THEN BEGIN
	    GETNEXT;		% SCAN IT
	    L:=L-REAL(OPT:=EDOC[L] GEQ 0 AND EDOC[L-1] EQL 0 AND NOT NNOT);
	    PRIMARY;		% DO A PRIMARY
	    IF NOT OPT
	    THEN EMIT(IF NNOT THEN SUB ELSE ADD)	% ADD OR SUB IT FROM INDEX
	  END;
EXIT:	END;
%
%	S T A T E M E N T---S C A N N E R S
%
PROCEDURE COMPOUNDTAIL;
	BEGIN
	  LABEL START;
	  BOOLEAN XREFSAV;
	  BEGINCTR:=BEGINCTR +	1;
START:	  ERRORTOG:=TRUE;
	  STMT;
	  IF CLASS EQL SEMICOLON
	  THEN BEGIN
	    GETNEXT;		% SCAN THE ';'
	    GO START		% GET NEXT STATEMENT
	  END;
	  IF CLASS NEQ ENDV	% NOT A ';'. IS IT AN 'END' ?
	  THEN BEGIN		% NO.
	    ERROR(42);		% ERROR
	    GO START
	  END;
	  XREFSAV:=XREFOPT;
	  XREFOPT:=FALSE;	% TURN XREF OFF FOR A MOMENT
	  DO BEGIN
	    STOPDEFINE:=TRUE;	% STOP EXPANSION OF DEFINES
	    GETNEXT		% GET NEXT THING
	  END
	  UNTIL CLASS GEQ ENDV AND CLASS LEQ UNTILV OR CLASS = DOTOP;
	  XREFOPT:=XREFSAV;	% RESTORE XREF FLAG
	  IF BEGINCTR:=*-1 EQL 0
	  THEN
	    IF CLASS NEQ DOTOP
	    THEN ERROR(53)	% FINAL END NOT FOLLOWED BY '.'
	END OF COMPOUND TAIL;
PROCEDURE IFSTMT;
	BEGIN
	  INTEGER THENL,ELSEL;
	  BOOLEAN NOTTOG,THENTOG,B;
	  GETNEXT;
	  BEXP; 			% GET BOOLEAN EXPRESSION
	  IF NOTTOG:=EDOC[L] GEQ 0 AND EDOC[L-1] EQL 3"2401"+4*LNG
	  THEN L:=L-1;			% OPTIMIZE OUT THE NOT'S
	  THENL:=BUMPL;
	  IF CLASS EQL THENV		% SEE IF 'THEN' FOLLOWING BE
	  THEN GETNEXT
	  ELSE FLAG(39);
	  STMT; 			% GET THEN STATEMENT
	  IF B:=THENTOG:=LASTWASAGOGO	% SEE IF LAST STMT WAS A GOTO
	  THEN				% DON'T EMIT A BRUN
	  ELSE
	    IF THENTOG:=L EQL THENL	% NULL STATEMENT, DON'T EMIT A BRUN
	    THEN NOTTOG:=NOT NOTTOG;	% EMIT BRANCH OTHER CONDITION
	  ELSEL:=L;			% SAVE CURRENT PC IF NEED A JMP
	  IF CLASS EQL ELSEV		% SEE IF AN ELSE PART
	  THEN BEGIN
	    GETNEXT;			% SCAN THE 'ELSE'
	    IF NOT THENTOG		% SEE IF WE SHOULD EMIT A BRUN
	    THEN ELSEL:=BUMPL;		% YEP
	    STMT;			% GET ELSE STATEMENT
	    IF L EQL ELSEL AND NOT THENTOG % SEE IF A NULL STATEMENT
					% BUT ELSE-STMT NOT NULL
	    THEN BEGIN			% YEP SO OPTIMIZE
	      L:=L-2;			% FORGET THE BRUN
	      THENTOG:=TRUE		% AND INDICATE SUCH
	    END
	  END
	  ELSE THENTOG:=TRUE;		% NO ELSE PART
	  EMITB(IF NOTTOG
		THEN BRTR
		ELSE BRFL,THENL,IF THENTOG AND NOT B
				THEN L
				ELSE ELSEL);
	  IF THENTOG
	  THEN
	    IF THENL EQL L
	    THEN BEGIN
	      L:=L-2;
	      IF EDOC[L-1] EQL 4*STN+3"2401"
	      THEN BEGIN
		L:=L-1;
		EMIT(STD)
		END
	      ELSE EMIT(DEL)
	    END
	    ELSE
	  ELSE EMITB(BRUN,ELSEL,L);
	END OF IF STATEMENT;
PROCEDURE LABELER;
	BEGIN
	  INTEGER T,F;
	  IF STACK[INFO+2] NEQ LEVEL
	  THEN FLAG(50) 	% LABEL NOT DECLARED IN THIS BLOCK
	  ELSE
	    IF ADDRESS LSS 10000	% LABEL ALREADY OCCURED
	    THEN FLAG(51)
	    ELSE BEGIN
	      IF ERRORCOUNT EQL 0 AND T:=STACK[INFO+4] NEQ 0
	      THEN
		DO BEGIN
		  F:=EDOC[T];		% FORWARD POINTER
		  EMITB(BRUN,T+2,L)	% BRANCH UNCONDITIONAL
		END
		UNTIL T:=F EQL 0;	% CLEAR OUT
	      STACK[INFO+1]:=L; 	% STORE PC
	      STACK[INFO+4]:=0; 	% NO MORE LINKED UP BRANCHES
	      IF T:=STACK[INFO+5] NEQ 0 % NEED ADDRESS IN PRT?
	      THEN PRTA[T]:=(L+1)*2	% YES. STORE AS A BRANCH RETURN
	    END;
	  GETNEXT;			% SCAN PAST THE LABEL
	  IF CLASS NEQ COLON		% NOT FOLLOWED BY A ':'
	  THEN FLAG(49) 		% MISSING ':'
	  ELSE GETNEXT			% SCAN IT
	END OF LABELING;
PROCEDURE GOSTMT;
	BEGIN
	INTEGER T,TL,A,TINFO;
	BOOLEAN B,C;
	LABEL EXIT;
	IF NOT PARAMTOG
	THEN GETNEXT;
	LASTWASAGOGO:=TRUE;		% SET GO STMT TOG
	IF ACTIONTOG			% SEE IF WE SHOULD BE LOOKING
	THEN ACTIONTOG:=FALSE		% FOR A 'TO'
	ELSE				% OTHERWISE COULD BE A 'TO'
	  IF CLASS = TOV
	  THEN GETNEXT;
	IF CLASS EQL CASEV OR CLASS EQL IFV
	THEN BEGIN
	  T:=-1;
	  CASEORIF(T)		% GET DESIGNATIONAL EXPRESSION
	END
	ELSE BEGIN
	  IF TL:=T:=STACK[(TINFO:=INFO)+2] NEQ LEVEL % SEE IF SAME LEVEL
	  THEN
	    IF ADRSR[(T-1)*2] NEQ 0	% NOT TO A PROC
	    THEN			% TO A BLOCK WITHIN A PROC
	      IF NOT INLEVEL(INFO,TL)	% SEE IF WITHIN THIS PROC
	      THEN BEGIN		% NO. BAD BONGOS CHARLIE
		ERROR(112);	% WE CANNOT DO THIS AWFUL THING 
		GO EXIT
		END;
	  IF CLASS = SWITCHID AND NOT SWITCHDECTOG	% SWITCH GO TO
	  THEN BEGIN		% DISALLOW SWITCHING TO OTHER SWITCHES
	    IF T NEQ LEVEL	% SWITCHES LIMITED TO LEVEL DECLARED IN
	    THEN BEGIN
	      ERROR(50);		% NO CAN DO THIS EITHER
	      GO EXIT
	    END;
	    LASTWASAGOGO:=FALSE;	% NOT GAURANTEED A GOOD GO TO
	    GETNEXT;
	    IF CLASS NEQ LFTBRKT THEN BEGIN ERROR(40);GO EXIT;END;
	    GETNEXT; AEXP;
	    IF CLASS NEQ RTBRKT THEN BEGIN ERROR(41); GO EXIT END;
	    GETNEXT;
	    EMIT(DUP); EMIT(DUP); EMITPAIR(1,GE); EMIT(XCH);
	    EMITPAIR(STACK[TINFO+4],LE); EMIT(LND); EMITPAIR((L+8)*2,BRFL);
	    EMITPAIR(2,SHLL);	% TIMES 4 (4 BYTES/BRANCH INSTRUCTION)
	    EMITL(STACK[TINFO+5]);
	    EMIT(ADD);				% ADD TO TABLE START
	    EMIT(BRUN);
	    EMIT(DEL)			% POP INDEX INTO GOTO TABLE
	END
	ELSE
	  IF CLASS = LABELID		% GO TO LABEL
	  THEN BEGIN
	    IF T < LEVEL		% GO TO LESSER LEVEL
%		  OR ADDRESS < 0	% IF ADDRESS < 0 THEN GOTO LABEL PASSED THRU
					% PASSED THRU AS A PARAMETER
	    THEN BEGIN
	      IF B:=ADRSR[T*2] NEQ 0	% CHANGING BLOCK BUT NOT PROC
	      THEN BEGIN
		EMITO(LEVELS[T]);	% POINT AT CORRECT MKS
		EMITD(0);	% R+0
		EMIT(STD);
		EMITO(ADRSR[T*2+1]);
		EMITD(LEVELS[T]); EMIT(STD);
		END;
@O			% NOT IMPLEMENTED YET
	      IF ADDRESS LSS 0		% PARAMETER
	      THEN BEGIN		% JUST CHANGE RETURN ADDRESS
		EMITO(-ADDRESS);	% NEW RETURN ADDRESS
		EMITD(3"34002");	% WHERE RETURN ADDRESS IS KEPT
		EMIT(STD)		% BANG IT AGAINST THE WALL 
		END
	      ELSE
@O
	      BEGIN
		IF ADDRESS < 10000	% ALREADY OCCURED
		THEN EMITL((ADDRESS+1)*2)	% EMITTING RETURN ADDRESS
		ELSE BEGIN		% LABEL DIDN'T OCCUR YET SO PUT ADDRESS
		  CLASSF:=0;		% FOR SAFTEY (FOR GETSPACE)
		  IF STACK[INFO+5]=0 THEN
		  BEGIN
		    REPLACE PS BY "GO TO SOLVER WORK CELL"," " FOR 44;
		    STACK[INFO+5]:=GETSPACE(1)
		  END;
		  EMITO(STACK[INFO+5])
		END;
		IF B		% EXITTING BLOCK BUT NOT PROC?
		THEN BEGIN	% YES
		  EMITD(ADRSR[T*2]); % ADDRESS OF PROC LOOKING FOR IN PRT
		  EMITL(0)	% INDICATE SUCH AN EXIT TO GO TO SOLVER
				% HE WILL CONTRIEVE AN RCW TO THAT BLOCK
		END		% WITHIN THIS BLOCK
				% EXITTING A PROC. PUT NEW LEVEL ON STACK
		ELSE EMITL(STACK[INFO+2]+1-REAL(ADDRESS LSS 0));
		EMITPAIR(9,COM)
		END;
	      EMIT(RTN);	% RETURN THUS CLEARING THE STACK AND
	      GETNEXT		% BRINGING PROC BLOCK (OR NESTED BLOCK) IN
	    END
	    ELSE
	      IF ADDRESS < 10000		% ADDRESS DECLARED YET ?
	      THEN BEGIN
		EMITB(BRUN,BUMPL,ADDRESS);	% MUST BE BEHIND US
		CONSTANTCLEAN;	% YOU CAN'T GET HERE FROM THERE 
		GETNEXT
		END
	      ELSE BEGIN		% LABEL NOT DECLARED YET
		EDOC[L]:=STACK[T:=INFO+4];	% LINK THIS PLACE UP TO OTHERS
		STACK[T]:=L; BUMPL;
		CONSTANTCLEAN;	% YOU CAN'T GET HERE FROM THERE EITHER
		GETNEXT
		END
	    END
	    ELSE ERROR(68)
	  END;
EXIT: END;
@O
<SCANSTMT>::=SCAN <SOURCE><SCAN PART>
<SOURCE>::=<UPDATE	POINTER><PEXP>
<UPDATE POINTER>::=<EMPTY>	| <POINTER ID> :
<SCAN PART>::=<CONDITION> |
		FOR <COUNT PART> <CONDITION>
<CONDITION>::=UNTIL IN <TRUTHSET DESIGNATOR>	|
		WHILE IN <TRUTHSET DESIGNATOR>	|
		UNTIL <ROP> <AEXP>  |
		WHILE <ROP> <AEXP>
<COUNT PART>::=<RESIDUAL COUNT><AEXP>
<RESIDUAL COUNT>::=<EMPTY>	| <SIMPLE ARITHMETIC ID> :
@O
PROCEDURE SCANSTMT;	% HANDELS THE SCAN STATEMENT
	BEGIN
	  BOOLEAN PUPDATE,IUPDATE,ROP,CONDITIONAL,B,F,ID,W;
	  INTEGER T,ROPV;
	  GETNEXT;	% SCAN THE 'SCAN'
	  IF B:=CLASS EQL STRINGID AND REAL(P,1) EQL ":"
	  THEN BEGIN	% COULD BE UPDATE OR ASSIGNMENT
	    T:=INFO;	% SAVE FOR ADDRESS LATER ON
	    GETNEXT;	% SEE WHAT IT WAS
	    IF PUPDATE:=CLASS EQL COLON % UPDATE
	    THEN EMITADDRESS(T,0);  % PUT ADDRESS ON TOS
	    GETNEXT	% SCAN TO BEGINING OF POINTER EXPRESSION
	  END;
	  PEXP; 	% GET POINTER EXPRESSION
	  IF B AND NOT PUPDATE	% THING
	  THEN BEGIN		% WAS
	    EMITADDRESS(T,0);	% ONLY
	    EMIT(PSTN)		% AN
	  END;		% ASSIGNMENT
	  IF F:=CLASS EQL FORV	% MAX LENGTH OF SCAN(OPTIONAL)
	  THEN BEGIN
	    GETNEXT;		% GET START OF MAX COUNT
	    IF B:=(CLASS EQL INTID OR ID:=CLASS EQL INTPROCID)
		AND REAL(P,1) EQL ":"
	    THEN BEGIN		% COULD BE UPDATE OR ASSIGNMENT
	      T:=INFO;		% SAVE FOR LATER USE
	      GETNEXT;		% SEE WHAT IT WAS
	      IF IUPDATE:=CLASS EQL COLON	% UPDATE
	      THEN BEGIN	% 1ST GET ADDRESS
		IF ID		% PROC?
		THEN EMITPROCAORV(T,TRUE)	% PROC ADDRESS
		ELSE EMITADDRESS(T,0);	% INTEGER ID
		EMIT(RSDN)		% PUT PRIOR TO POINTER EXPRESSION
		END;
	      GETNEXT		% SCAN THE THING
	    END;
	    AEXP;		% GET MAXLENGTH
	    IF B AND NOT IUPDATE	% THING
	    THEN BEGIN			% WAS
	      IF ID			% ONLY
	      THEN EMITPROCAORV(T,TRUE) % AN
	      ELSE EMITADDRESS(T,0);	% ASSIGNMENT
	      EMIT(STN) 		% SAVE VALUE
	    END
	  END;
	  IF CONDITIONAL:=CLASS EQL UNTILV OR W:=CLASS EQL WHILEV
	  THEN BEGIN	% CONDITIONAL SCAN
	    GETNEXT;	% SCAN THE TYPE OF CONDITION (WHILE OR UNTIL)
	    IF ROP:=ROPV:=CLASS-NEQOP GEQ 0 AND ROPV LEQ 5
	    THEN BEGIN	% SCAN DURING RELATIONAL
	      GETNEXT;	% GET TO AE
	      AEXP
	    END
	    ELSE	% SHOULD BE AN 'IN'
	      IF CLASS NEQ INV	% IS IT THERE?
	      THEN FLAG(105)	% NOPE
	      ELSE BEGIN
		GETNEXT;	% SEE WHAT WE GOTS
		IF CLASS NEQ TRUTHID	% FOLLOWED BY TRUTHSET ID?
		THEN FLAG(106)		% NO
		ELSE BEGIN
		  EMITADDRESS(INFO,0);	% PUT OUT IT'S ADDRESS
		  GETNEXT		% SCAN IT
		END
		END
	  END
	  ELSE		% SOMETHING AFTER THE SCAN PART?
	    IF NOT F	% NO. ERROR
	    THEN FLAG(107);
	  EMITNUM((((((SHL(ROPV+2,3)+REAL(ROP))*2+REAL(W))*2+REAL(PUPDATE))*2
		    +REAL(IUPDATE))*2+REAL(F))*2+REAL(CONDITIONAL));
	  EMIT(SCN);	% SCAN IT
	END OF SCAN STATEMENT;
@O
<REPLACESTMT>::= REPLACE <DESTINATION>	BY <SOURCE LIST>
<DESTINATION>::= <SOURCE>
<SOURCE LIST>::= <SOURCE PART>	| <SOURCE PART>,<SOURCE LIST>
<SOURCE PART>::= <SOURCE><TRANSFER PART> |
		  <AEXP><OPTIONAL UNIT COUNT>	|
		  <CONVERT PART>  |
		  <POINTER-VALUED ATTRIBUTE>  |
		  <STRING><OPTIONAL UNIT COUNT>
<TRANSFER PART>::=<UNIT COUNT><SCAN PART>
<UNIT COUNT>::=  FOR <AEXP> <UNITS>
<UNITS>::=  WORD | WORDS
<OPTIONAL UNIT COUNT>::= <EMPTY> | <UNIT COUNT>
<CONVERT PART>::=<AEXP> FOR <BASE><ZSOPTION><LENGTH PART>
<BASE>::=  BINARY | OCTAL | HEX | DECIMAL | <EMPTY>
<ZSOPTION>::=  <EMPTY> | ZEROSUPPRESSED
<LENGTH PART>::= DIGIT	| DIGITS
<POINTER-VALUED ATTRIBUTE>::=<FILE DESIGNATOR>.TITLE

% SEE <SCANSTMT> FOR <SOURCE> AND <SCAN PART>

<REPLACE FILE STMT>::=REPLACE	<POINTER-VALUED ATTRIBUTE> BY <SIMPLE SOURCE>
<SIMPLE SOURCE>::= <PEXP> | <STRING>


@O
PROCEDURE REPLACESTMT;
	BEGIN
	  INTEGER T,SEAEPE,CODEWORD,ROPV,TC,SE;
	  BOOLEAN TRN,SRC,RES,B,B1,B2,W,D,C,T1,U,ROP,F,ZS;
	  LABEL EXIT,AGAIN,NEXT,SIMPLEAE,OTHERERR;
	  GETNEXT;		% SCAN THE 'REPLACE'
	  IF CLASS EQL FILEID	% REPLACE FILE.TITLE BY SIMPLE STRING
	  THEN BEGIN
	    BOOLEAN B;		% TRYING TO KEEP SEGMENTS SMALL
	    EMITADDRESS(INFO,0);% ADDRESS OF FILE DESCRIPTOR
	    GETNEXT;		% SCAN THE FILE ID
	    IF B:=CLASS NEQ DOTOP	% NO '.' 
	    THEN		% THEN DO NOTHING
	    ELSE BEGIN
	      GETATTRIBUTE;	% SCAN IT
	      IF B:=CLASS NEQ TITLEV % FOLLOWED BY 'TITLE' ?
	      THEN
	      ELSE GETNEXT	% SCAN IT
	    END;
	    IF B		% THERE WAS AN ERROR
	    THEN BEGIN
	      ERROR(119);	% '.TITLE' EXPECTED
	      GO EXIT
	    END;
	    IF CLASS NEQ BYV	% NO BY
	    THEN BEGIN
	      ERROR(103);	% SO PUT OUT THE ERROR MESSAGE
	      GO EXIT		% AND GO BY-BYE 
	    END;
	    GETNEXT;		% BYE THE BY
	    IF CLASS EQL QUOTEOP% SIMPLE STRING EXPRESSION
	    THEN BEGIN
	      QUOTE;		% GET STRING
	      IF BOOLEAN(LENGTH)% LENGTH WAS ODD
	      THEN		% SO OK
	      ELSE BEGIN	% ADD NULL CHAR TO STRING
		CONST[CLEAN-LENGTH DIV 2]:=(LENGTH+2) DIV 2;
		CONST[CLEAN:=CLEAN+1]:=0		% ADD NUL CHAR 
		END;
	      EMITL(LENGTH+1)		% LENGTH OF FILE NAME
	    END
	    ELSE BEGIN		% SIPME POINTER EXPRESSION
	      PEXP;		% GET POINTER EXPRESSION
	      EMIT(XCH);	% GET ADDRESS OF ARRAY ROW ON TOS
	      EMIT(DUP);	% DUP IT
	      EMITPAIR(6,ADD);	% GET TO LOWER LIMIT FIELD OF ROW
	      EMIT(LOD);	% LOAD VALUE
	      EMIT(RSDN);	% PUT INDEX UNDER THE ROW DESCRIPTOR
	      EMIT(ADC);	% GET ADDRESS OF 1ST ELEMENT IN ROW
	      EMIT(ADD);	% ADD ON THE INDEX FROM POINTER EXPRESSION
	      EMITL(3"40")	% MAX LENGTH OF FILE NAME IS 3"40"
	    END;
	    EMITPAIR(8,COM);	% CHANGE NAME
	    GO EXIT		% DONE 
	  END;
	  IF B:=CLASS EQL STRINGID AND REAL(P,1) EQL ":"
	  THEN BEGIN
	    T:=INFO;		% SAVE IN CASE WE NEED
	    GETNEXT;		% SEE WHAT IT REALLY IS
	    IF TRN:=CLASS EQL COLON	% UPDATE
	    THEN EMITADDRESS(T,0);	% PUT OUT ADDRESS
	    GETNEXT
	  END;
	  PEXP; 		% GET A POINTER EXPRESSION
	  IF B AND NOT TRN	% REALLY WAS AN ASSIGNMENT
	  THEN BEGIN
	    EMITADDRESS(T,0);	% GET THING
	    EMIT(PSTN)		% STORE
	  END;
	  IF CLASS NEQ BYV		% SEE IF FOLLOWED
	  THEN BEGIN			% BY A 'BY'
	    ERROR(103); 		% NO => ERROR
	    GO EXIT
	  END;
AGAIN:	  GETNEXT;		% SCAN THE 'BY' (OR A COMMA)
	  SEAEPE:=4;			% RESET TO NOT DEFINED
	  W:=U:=T1:=ZS:=F:=RES:=SRC:=C:=ROP:=BOOLEAN(ROPV:=SE:=0);
	  IF CLASS EQL FILEID		% REPLACE BY FILE NAME 
	  THEN BEGIN
	    DEFINE NEWSEG=#;
	    EMITVALUE(INFO,1);		% GET POINTER TO ALGOL FIB
	    EMITPAIR(6,ADD);		% GET TO START OF NAME
	    EMITL(40);			% MAX LENGTH OF NAME
	    EMITL(0);			% DO A REPLACE WHILE NEQ NULL
	    T1:=ROP:=U:=BOOLEAN(SE:=1);
	    GETNEXT;			% SEE IF SYNTAX IS OK
	    IF B:=CLASS NEQ DOTOP
	    THEN
	    ELSE BEGIN			% '.' WAS THERE. GOOD
	      GETATTRIBUTE;		% SEE IF 'TITLE' THERE TO.
	      IF B:=CLASS NEQ TITLEV	% NOPE. YOU LOSE.
	      THEN
	      ELSE GETNEXT		% SCAN IT
	    END;
	    IF B			% ERROR?
	    THEN BEGIN			% YES.
	      ERROR(119);		% TELL THE GUY WHAT WE MISSED
	      GO EXIT
	    END;
	    GO NEXT			% DONE THIS SCAN
	  END;
	  IF CLASS EQL QUOTEOP		% SRC A STRING?
	  THEN BEGIN		% YES
	    SEAEPE:=0;		% STRING
	    QUOTE;		% PUT OUT ADDRESS OF STRING
	    EMITL(LENGTH)	% AND ITS LENGTH
	  END
	  ELSE
	    IF CLASS EQL POINTERV OR CLASS EQL STRINGID OR
		(CLASS EQL ARRAYID AND REAL(P,1) NEQ "[")
	    THEN BEGIN
	      SEAEPE:=2;	% POINTER EXPRESSION
	      IF B:=CLASS EQL STRINGID AND REAL(P,1) EQL ":"
	      THEN BEGIN	% COULD BE AN UPDATE
		T:=INFO;	% SAVE IN CASE IT'S NOT
		GETNEXT;	% SEE WHAT IT REALLY WAS
		IF SRC:=CLASS EQL COLON % AN UPDATE
		THEN BEGIN
		  EMITADDRESS(T,0);	% WE WANT ADDRESS UNDER POINTER
		  EMIT(RSDN)		% EXPRESSION SO ROTATE STACK UP
		END;
		GETNEXT 	% SCAN THE : OR:=
		END;
	      PEXP;		% SEE WHAT KIND OF POINTER EXPRESSION WE HAVE
	      IF B AND NOT SRC	% NEED A STORE
	      THEN BEGIN
		EMITADDRESS(T,0);	% ADDRESS OF POINTER DOING STORE ON
		EMIT(PSTN)		% POINTER STORE NON-DESTRUCT
		END
	    END
	    ELSE BEGIN
	      IF SRC		% UPDATE THE SOURCE?
	      THEN SEAEPE:=2;	% YES --> MUST BE A POINTER
	      IF CLASS EQL CASEV OR CLASS EQL IFV
	      THEN CASEORIF(SEAEPE)
	      ELSE
		IF EACHCASE(SEAEPE)
		THEN SEAEPE:=4
	    END;
	  IF SEAEPE EQL 4
	  THEN BEGIN	% NOT A GOOD POINTER EXPRESSION
	    ERROR(102);
	    GO EXIT
	  END;
	  IF F:=CLASS EQL FORV OR BOOLEAN(SEAEPE) AND TRUE	% FOR <AE>
	  THEN BEGIN
	    IF CLASS NEQ FORV	% NO FOR
	    THEN BEGIN
	      EMITL(2); 	% THEN LENGTH IS 2
	      F:=TRUE;
	      GO SIMPLEAE
	    END
	    ELSE BEGIN
	      GETNEXT;		% SCAN THE 'FOR'
	      IF B:=(CLASS EQL INTID OR B1:=CLASS EQL INTPROCID) AND
		  REAL(P,1) EQL ":" AND SEAEPE EQL 2
	      THEN BEGIN		% COULD BE AN UPDATE
		T:=INFO;		% SAVE POINTER
		GETNEXT;		% SEE WHAT IT IS
		IF RES:=CLASS EQL COLON % UPDATE
		THEN BEGIN
		  EMITD(JUNK);	% SAVE TOP POINTER
		  EMIT(IF SEAEPE EQL 2 THEN PSTD ELSE STD);  % SAVE THERE
		  IF B1 	% PROC ID
		  THEN EMITPROCAORV(T,TRUE)	% GET ADDRESS
		  ELSE EMITADDRESS(T,0);
		  EMIT(RSDN);	% PUT ADDRESS UNDER OTHER POINTER
		  EMITO(JUNK);
		  IF SEAEPE EQL 2	% NEED TO GET REST OF
		  THEN EMITO(JUNK+1)% POINTER FROM TEMP STORE
		END;
		GETNEXT 	% SCAN THE ASSIGNMENT
		END;
	      AEXP;		% GET FOR COUNT
	      IF B AND NOT RES	% WAS AN ASSIGNMENT
	      THEN BEGIN
		IF B1		% PROC ID
		THEN EMITPROCAORV(T,TRUE)	% GET ADDRESS
		ELSE EMITADDRESS(T,0);
		EMIT(STN)		% STORE IT
		END
	    END;
	    IF BOOLEAN(SEAEPE)	% <AE>
	    THEN BEGIN
	      IF W:=CLASS EQL WORDSV OR CLASS EQL WORDV AND EDOC[L-1] EQL 4
	      THEN GETNEXT
	      ELSE BEGIN
		IF ZS:=CLASS EQL ZEROSUPV
		THEN GETNEXT;
		IF C:=TC:=CLASS-BINARYV GEQ 0 AND TC LEQ 3
		THEN BEGIN	% CONVERT
		  GETNEXT;	% SCAN IT
		  IF EDOC[L-1] EQL 4 AND CLASS EQL DIGITV OR CLASS EQL DIGITSV
		  THEN GETNEXT
		  ELSE BEGIN
		    OTHERERR: ERROR(104);
		    GO EXIT
		  END
		END
		ELSE		% SEE IF A DECIMAL CONVERT
		  IF C:=CLASS EQL DIGITV AND EDOC[L-1] EQL 4 OR CLASS EQL DIGITSV
		  THEN BEGIN	% YEZ 
		    TC:=3;	% DEFAULT IS DECIMAL CONVERT
		    GETNEXT	% SCAN THE 'DIGIT'
		  END
		  ELSE
		    IF ZS	% SHOULD IT HAVE BEEN A CONVERT?
		    THEN GO OTHERERR	% YES
		END;
	      IF C		% CONVERT
	      THEN BEGIN	% YES
		EMIT(XCH);	% PUT # TO BE CONVERTED ABOVE LENGTH OF CONVERSION
		ROPV:=TC-2;	% WHERE REP OPERATOR WANTS THE BASE
		GO NEXT
		END
	      ELSE BEGIN	% MAKE AE A STRING
SIMPLEAE:	EMITD(2);	% AT PRT+2
		EMIT(RSDN);	% PUT ADDRESS UP
		EMITL(2);	% IT'S LENGTH WILL BE 2
		EMIT(RSDN);	% PUT THAT IN THE STACK ALSO
		EMIT(XCH);	% CHANGE <AE> VALUE AND LENGTH
		SE:=1;
		GO NEXT
		END
	    END
	  END;
	  IF W:=CLASS EQL WORDSV OR CLASS EQL WORDV AND EDOC[L-1] EQL 4
	  THEN BEGIN
	    GETNEXT;		% WORD TRANSFER
	    GO NEXT		% DONE HERE
	  END;
	  IF SEAEPE EQL 2	% POINTER EXPRESSION
	  THEN			% SEE IF CONDITIONAL TRANSFER
	    IF T1:=CLASS EQL UNTILV OR U:=CLASS EQL WHILEV
	    THEN BEGIN		% SET UNTIL/WHILE TOG (U)
	      GETNEXT;		% SCAN TYPE OF TRANSFER
	      IF ROP:=CLASS GEQ NEQOP AND CLASS LEQ LEQOP % RELATIONAL OP
	      THEN ROPV:=CLASS-NEQOP	% TYPE OF RELATIONAL OP
	      ELSE		% BETTER BE 'IN TRUTHSET'
		IF CLASS NEQ INV
		THEN BEGIN
		  ERROR(105);	% 'IN' OR '<ROP>' EXPECTED
		  GO EXIT
		END;
	      GETNEXT;		% SCAN WHATS WE GOTS
	      IF ROP		% RELATIONAL OP REQUIRES
	      THEN AEXP 	% ARITHMETIC EXPRESSION
	      ELSE
		IF CLASS NEQ TRUTHID	% NOT A TRUTHSET ID
		THEN ERROR(106) 	% TRUTHSET ID EXPECTED
		ELSE BEGIN
		  EMITADDRESS(INFO,0);	% ADDRESS OF TRUTHSET
		  GETNEXT		% SCAN THE TRUTHSET ID
		END
	    END
	    ELSE		% MAYBE AN ERROR
	      IF NOT F
	      THEN BEGIN	% NO FOR. NO CONDITION. NO CONVERT.
		ERROR(107);	% SO AN ERROR
		GO EXIT
		END;
NEXT:	  IF SEAEPE EQL 0 AND NOT F	% IF QUOTED STRING
	  THEN BEGIN			% AND NO MAX LENGTH
	    EMIT(DUP);			% MAKE LENGTH THE LENGTH OF STRING
	    F:=TRUE
	  END;
	  CODEWORD:=
		(((((((((((REAL(ZS OR SEAEPE EQL 0 OR BOOLEAN(SE))*2+
			   REAL(B:=CLASS NEQ COMMA))*2+REAL(ROP))*2+
			   REAL(U))*2+REAL(TRN AND B))*2+
			   REAL(SRC))*2+REAL(RES))*2+REAL(T1))*2+
			   REAL(C))*2+REAL(W))*2+
			   REAL(BOOLEAN(SE) OR SEAEPE NEQ 1))*2+
			   REAL(F))*2+REAL(T1 OR C OR BOOLEAN(SE))+
			   SHL(ROPV+2,13);
	  EMITNUM(CODEWORD);	% PUSH CODE WORD
	  EMIT(REP);		% EMIT REPLACE OPERATOR
	  IF CLASS EQL COMMA	% MORE ?
	  THEN GO AGAIN; 	% YES 
EXIT:	END OF REPLACE STATEMENT;
PROCEDURE WHILESTMT;
	BEGIN
	INTEGER FRONT,BACK;
	BOOLEAN B;
	LABEL EXIT;
	GETNEXT;
	BACK:=L;
	BEXP;		% SCAN THE BOOLEAN EXPRESSION
	IF B:=EDOC[L-1] EQL 3"2401"+LNG*4 AND EDOC[L] GEQ 0  % OPTIMIZE
	THEN L:=L-1;
	FRONT:=BUMPL;
	IF CLASS NEQ DOV THEN BEGIN ERROR(48); GO EXIT END; GETNEXT;
	STMT;		% STATEMENT TO DO OVER AND AGAIN
	EMITB(BRUN,BUMPL,BACK); CONSTANTCLEAN;
	EMITB(IF B THEN BRTR ELSE BRFL,FRONT,L);
EXIT: END OF WHILESTMT;
PROCEDURE DOSTMT;
	BEGIN
	INTEGER F;
	BOOLEAN B;
	LABEL EXIT;
	GETNEXT; F:=L;	STMT;
	IF CLASS NEQ UNTILV AND B:=CLASS NEQ WHILEV THEN
		BEGIN ERROR (47); GO EXIT END;
	GETNEXT; BEXP;
	IF NOT B
	THEN EMIT(LNG);
	IF EDOC[L-1] EQL 3"2401"+4*LNG AND EDOC[L] GEQ 0	% OPTIMIZE
	THEN EMITB(BRTR,L:=L+1,F)
	ELSE EMITB(BRFL,BUMPL,F);
EXIT: END;
COMMENT

<THRUSTMT>::=THRU <AE> DO <STMT>

SEMANTICS	-	<AE> IS EVALUATED ONLY UPON 1ST ENCOUNTERANCE OF IT
			AS LONG AS IT IS GTR 0 <STMT> IS EXECUTED ONCE
			AND THE VALUE OF THE ORIGIONAL <AE> IS DECREMENTED BY 1
			IF INITIAL VALUE IS 0 OR NEGATIVE, <STMT> IS NOT EXECUTED

PRAGMANTICS	-	A STACK CELL IS ALLOCATED FOR THE INITIAL VALUE
			OF THE <AE>. THIS IS THE VALUE THAT IS DECREMENTED
			UNTIL 0;
PROCEDURE THRUSTMT;		% NEW STMT, LIMITATIONS -- CANNOT DO
				%	MORE THAN 32767. THRU LOOPS
				% CAUSE INTEGERS >=-32768&<=32767
	BEGIN
	  INTEGER LOOPBEGIN,LOOPOUT,TEMPSTORE;
	  WORKCELLCOUNT:=WORKCELLCOUNT+1;
	  GETNEXT;		% GET TO START OF LOOP COUNT
	  AEXP; 		% GET LOOP COUNT
	  LOOPBEGIN:=L; 	% SAVE ADDRESS OF WHERE TO JUMP BACK TO
	  REPLACE PS BY "THRU CLAUSE WORK CELL"," " FOR 45;
	  EMITD(TEMPSTORE:=GETSPACE(CLASSF:=0)); % GET ADDRESS OF WORK-CELL
	  EMIT(STN);
	  EMITL(0);		% TO SEE IF IT IS GREATER THAN 0
	  EMIT(GT);
	  LOOPOUT:=BUMPL;	% IF SO THEN CONTINUE TO EXECUTE THE
	  IF CLASS NEQ DOV
	  THEN FLAG(48)
	  ELSE BEGIN
	    GETNEXT;
	    STMT;			% NEXT STATEMENT
	    EMITO(TEMPSTORE);		% GET WORK CELL COUNT
	    EMITL(1);			% DECREMENT COUNTER ON STACK
	    EMIT(SUB);
	    EMITB(BRUN,BUMPL,LOOPBEGIN);	% BRANCH BACK TO LOOP BEGINING
	    EMITB(BRFL,LOOPOUT,L);	% BRANCH OUT IF TOS <= 0
	  END
	END OF THRUSTMT;
	PROCEDURE CASESTMT;
	BEGIN
	  INTEGER ARRAY STMTNOS[0:100],STMTENDS[0:100];
	  INTEGER ENDL,STMTL,MAXSTMTNO,PRENUM,ENDCNT,I,POLISH,TEMP,
		  OCXL,TEMPL,TMPDATA;
	  BOOLEAN NUMBEREDSTMTS;
	  LABEL F1,L1;
	  GETNEXT;		% GET TO START OF A.E.
	  STMTL:=(BUMPL)-2;	% ALLOW FOR STACK BUILDING CODE
	  AEXP; 		% GET INDEX INTO CASE BODY
	ENDCNT:=MAXSTMTNO:=-1;
	  IF CLASS NEQ OFV	% SEE IF AE FOLLOWED BY 'OF'
	  THEN FLAG(97) 	% NOPE. ERROR
	  ELSE GETNEXT;
	  IF CLASS NEQ BEGINV
	  THEN FLAG(29) 	% AFTER AE MUST BE A BEGIN
	  ELSE BEGIN
	    BEGINCTR:=*+1;	% 1 MORE BEGIN LEVEL
	    OCXL:=L;		% SAVE WHERE WE PUT THE OCCURS INDEX
	    EMIT(OCX);		% DO OCCURS INDEX INTO CASE BODY
	    GETNEXT;		% SCAN THE BEGIN
	    NUMBEREDSTMTS:=CLASS EQL ICONSTANT; % SEE IF #-ED CASE STMTS
	    WHILE CLASS NEQ ENDV
	    DO BEGIN		% SCAN THE CASE BODY
	      PRENUM:=-1;
	      IF NUMBEREDSTMTS	% SEE IF SUPPOSED TO BE IN #-ED STMTS
	      THEN
		WHILE CLASS EQL ICONSTANT	% ALLOW 1:2:43:ECT.
		DO BEGIN
		  IF INREAL GTR 100	% MAX # IS 100
		  THEN F1:FLAG(38)	% ILLEGAL CONSTANT
		  ELSE
		    IF STMTNOS[INREAL]<>0
		    THEN GO F1		% ALREADY DEFINED
		    ELSE BEGIN
		      STMTNOS[INREAL]:=PRENUM;	% LINK LIST OF LABLES
		      IF PRENUM:=INREAL GTR MAXSTMTNO	% FOR MULTIPLY
		      THEN MAXSTMTNO:=INREAL	% LABELED STMTS
		    END;
		  GETNEXT;	% SCAN PAST LABEL
		  IF CLASS EQL SUBOP	% LABEL1-LABEL2
		  THEN BEGIN
		    GETNEXT;		% GET TO 2ND #
		    IF CLASS NEQ ICONSTANT OR INREAL LSS PRENUM
		       OR INREAL GTR 100
		    THEN GO F1
		    ELSE BEGIN
		      WHILE PRENUM:=PRENUM+1 LEQ INREAL
		      DO
			IF STMTNOS[PRENUM]<>0
			THEN FLAG(38)
			ELSE STMTNOS[PRENUM]:=PRENUM-1;
		      IF PRENUM:=INREAL GTR MAXSTMTNO
		      THEN MAXSTMTNO:=INREAL
		    END;
		    GETNEXT		% SCAN TO THE ':'
		  END;
		  IF CLASS NEQ COLON	% AND SEE IF A ":"
		  THEN FLAG(49)
		  ELSE GETNEXT;
		END
	      ELSE
		IF MAXSTMTNO:=MAXSTMTNO+1 GTR 100	% CHECK FOR TOO
		THEN BEGIN	% MANY STMTS IN CASE BODY
		  FLAG(95);	% OUTPUT ERROR MESSAGE
		  MAXSTMTNO:=0; % RESET MAX COUNT
		END
		ELSE STMTNOS[PRENUM:=MAXSTMTNO]:=-1;	% SET GROUND TO -1
	      TEMPL:=L;    % SAVE WHERE STMT BEGINS TO TEST FOR NULLS
L1:	      STMT;		% GET THE NEXT STATEMENT
	      IF CLASS EQL SEMICOLON	% SEE IF FOLLOWED BY ;
	      THEN GETNEXT	% (SCAN IT)
	      ELSE
		IF CLASS NEQ ENDV		% 	 OR A 'END'
		THEN FLAG(42);
	      IF NUMBEREDSTMTS AND CLASS NEQ ENDV AND CLASS NEQ ICONSTANT
	      THEN GO L1;
	      IF L EQL TEMPL		% WAS IT NULL ???
	      THEN TEMPL:=-1		% YES
	      ELSE BEGIN
		STMTENDS[ENDCNT:=ENDCNT+1]:=BUMPL;	% FOR A BRUN
		CONSTANTCLEAN		% DUMP POOL ARRAY 
		END;
			% STORE END OF THIS GUY
	      WHILE PRENUM NEQ -1
	      DO BEGIN
		POLISH:=STMTNOS[PRENUM];	% TIME TO DO SOME SWAPPING
		STMTNOS[PRENUM]:=TEMPL; 	% SWAP LINK FOR
		PRENUM:=POLISH			% PC OF START OF STMT
		END
	    END;
	    BEGINCTR:=*-1;		% 1 LESS BEGIN LEVEL
	    DO BEGIN			% SCAN OUT END
	      STOPDEFINE:=TRUE; 	% STOP EXPANSION OF DEFINES
	      GETNEXT
	    END
	    UNTIL CLASS GEQ ENDV AND CLASS LEQ UNTILV;
	  ENDL:=L+MAXSTMTNO+1;		% L - ADDRESS OF TABLE
	    POLISH:=L;			% SAVE PC TEMPORARILY
	    L:=STMTL;			% MAXSTMTNO+1 - LENGTH OF TABLE
	    EMITD(3"17777"+POLISH-L);		% THIS IS STACK BUILDING CODE
	    EMITL(MAXSTMTNO);		% FOR THE INTERPRETER
	    I:=-1;
	    L:=POLISH;			% GET IT BACK
	    WHILE I:=I+1 LEQ MAXSTMTNO
	    DO BEGIN
	      IF TEMP:=STMTNOS[I] EQL 0
	      THEN TEMP:=-1
	      ELSE BEGIN
		IF TEMP LSS 0
		THEN TEMP:=ENDL;		% NULL STMT GOES OUT
		TEMP:=TEMP*2+2			% TO GET RIGHT ADDRESS FOR BRUN
		END;
	      IF DEBUGTOG
	      THEN BEGIN
		REPLACE LINEOUT BY " " FOR 18,O6(L),"  ",
			IF TEMP LSS 0 THEN "NVLD" ELSE "    ",
			" " FOR 10,O6(TEMPL);
		WRITEALINE(46)
		END;
	      EMITC(TEMP)
	    END;
	    I:=-1;
	    WHILE I:=I+1 LEQ ENDCNT
	    DO EMITB(BRUN,STMTENDS[I],L);
	  END
	END OF CASESTMT;
COMMENT
<FORSTMT>	::=FOR	<VARIABLE>:=<FOR LIST> DO <STMT>
<FOR LIST>	::=<FOR LIST ELEMENT> | <FOR LIST>,<FOR LIST ELEMENT>
<FOR LIST ELEMENT>::=<INITIAL PART><ITERATION PART>
<INITIAL PART>	::=<ARITHMETIC	EXPRESSION>
<ITERATION PART>::=<EMPTY> |
		    STEP <ARITHMETIC EXPRESSION> UNTIL <ARITHEMETIC EXP> |
		    STEP <ARITHMETIC EXPRESSION> WHILE <BOOLEAN EXPRESS> |
		    UNTIL <ARITHMETIC EXPRESSION> |
		    WHILE <BOOLEAN EXPRESSION>;
PROCEDURE FORSTMT;
	BEGIN
	  INTEGER ARRAY STMTCASES[0:60],STMTCONNECTS[0:201];
	  INTEGER INDEXVARIABLE,WORKCELL,TEMPL,FORINDEXPLACE,
		  TMP,LSC:=-1,LCOUNT:=-1;
	  BOOLEAN STEPTOG;
	  EMITL(0);			% INITIAL CASE INTO FOR CASES
	  REPLACE PS BY "FOR CLAUSE WORK CELL"," " FOR 46;
	  WORKCELLCOUNT:=WORKCELLCOUNT+1;
	  EMITD(WORKCELL:=GETSPACE(CLASSF:=0));
	  EMIT(STD);			% STORE IN OUR WORK CELL
	  FORINDEXPLACE:=(BUMPL)-2;	% REMEMBER WHERE TO PUT STACK
	  EMITO(WORKCELL);		% GET INDEX INTO FOR CASES
	  EMIT(OCX);			% STACK BUILDING CODE FOR CASES
	  GETNEXT;			% SCAN THE 'FOR'
	  IF CLASS NEQ INTID		% SHOULD BE INTEGER ID FOR
	  THEN ERROR(IF CLASS EQL 0 THEN 28 ELSE 59)% OUR INDEX VARIABLE
	  ELSE BEGIN
	    INDEXVARIABLE:=INFO;	% STORE THE INFO
	    GETNEXT;			% AND SEE IF
	    IF CLASS NEQ ASSIGNOP	% FOLLOWED BY A ':='
	    THEN ERROR(60)		% IF NOT THEN ERROR ALSO
	    ELSE BEGIN
	      DEFINE XYZ=#;		% FORCE A NEW SEGMENT
	      DO BEGIN
		GETNEXT;		% SCAN TO START OF INITIAL PART
		STMTCASES[LCOUNT:=LCOUNT+1]:=L; % STORE START OF THIS CASE
		AEXP;		% GET <INITIAL PART>
		IF CLASS EQL UNTILV OR STEPTOG:=CLASS EQL STEPV
		THEN BEGIN
		  IF STEPTOG
		  THEN GETNEXT; 	% SCAN 'STEP'
		  EMITL(LCOUNT+1);	% NEXT TIME THRU LOOP GO TO
		  EMITD(WORKCELL);	% THE NEXT CASE OF FOR CASES
		  EMIT(STD);
		  EMITL(0);		% TO INDICATE THE 1ST TIME THRU
		  TEMPL:=STMTCASES[LCOUNT:=LCOUNT+1]:=BUMPL;
		  EMITVALUE(INDEXVARIABLE,0);	% IN STEP PART START
		  			% WITH OLD VALUE OF INDEX VAR.
		  EMITL(1);		% TO INDICATE NOT 1ST TIME THRU
		  EMITB(BRUN,TEMPL,L);	% WHICH GETS SKIPPED ON 1ST TIME
		  IF NOT STEPTOG
		  THEN EMITL(1) 	% AUTO INDEX BY 1 FOR UNTIL
					% (NO STEP)
		  ELSE AEXP;		% OTHERWISE GET STEPSIZE
		  EMIT(RSDN);		% GET 1ST TIME CONDITION ON TOS
		  TEMPL:=BUMPL; 	% TO DO A BRTR
		  IF CLASS EQL UNTILV
		  THEN BEGIN
		    EMIT(XCH);		% GET STEP
		    EMIT(DUP);		% DUP A COPY
		    EMIT(RSDN)		% GET INDEX VALUE
		  END;
		  EMIT(ADD);
		  EMITB(BRFL,TEMPL,L);	% SKIP THAT IF NOT 1ST TIME
		  EMITADDRESS(INDEXVARIABLE,0); % AND
		  IF CLASS EQL WHILEV
		  THEN EMIT(STD)	% STORE
		  ELSE EMIT(STN);	% IN INDEX VARIABLE
		  STEPTOG:=FALSE;
		  IF CLASS EQL UNTILV
		  THEN BEGIN
		    GETNEXT;		% SCAN THE 'UNTIL'
		    AEXP;		% GET THE UNTIL VALUE
		    EMIT(SUB);
		    EMIT(MUL);		% TIMES SIGN OF STEP
		    EMITPAIR(0,GT);	% SEE IF INDEX > MAXVALUE
					% (OR INDEX < MINVALUE)
		    STEPTOG:=TRUE;
		    STMTCONNECTS[LSC:=LSC+1]:=BUMPL;
		    STMTCONNECTS[LSC:=LSC+1]:=BRFL
		  END
		  ELSE
		    IF CLASS NEQ WHILEV % SHOULD BE STEP WHILE
					% OR STEP UNTIL
		    THEN ERROR(61);	% OR ERROR
		END
		ELSE BEGIN
		  EMITADDRESS(INDEXVARIABLE,0);
		  EMIT(STD)
		END;
		IF NOT STEPTOG		% FOR 'WHILE'
		THEN
		  IF CLASS EQL WHILEV
		  THEN BEGIN
		    GETNEXT;		% SCAN THE 'WHILE'
		    BEXP;		% FIND OUT WHILE WHAT
		    STEPTOG:=TRUE;
		    STMTCONNECTS[LSC:=LSC+1]:=BUMPL;
		    STMTCONNECTS[LSC:=LSC+1]:=BRTR
		  END;
		EMITL(LCOUNT+1);	% TIME TO GO TO NEXT CASE NOW
		IF STEPTOG
		THEN EMITB(BRUN,BUMPL,FORINDEXPLACE-2)
		ELSE BEGIN
		  EMITD(WORKCELL);	% TIME TO GO TO NEXT CASE AFTER
					% THIS STMT
		  EMIT(STD);
		  STMTCONNECTS[LSC:=LSC+1]:=BUMPL;
		  STMTCONNECTS[LSC:=LSC+1]:=BRUN
		END
		END
	      UNTIL CLASS NEQ COMMA;
	    END;
	    IF CLASS NEQ DOV		% CHECK FOR 'DO'
	    THEN ERROR(61)		% IF NOT THEN AN ERROR
	    ELSE BEGIN
	      GETNEXT;			% SCAN IT
	      STMTCASES[LCOUNT:=LCOUNT+1]:=L;
	      TEMPL:=BUMPL;		% LAST CASE
	      WHILE LSC GTR -1		% FILL IN THE LINKS FOR BRANCHS
	      DO BEGIN			% TO THE STATEMENT
		EMITB(STMTCONNECTS[LSC],STMTCONNECTS[LSC:=LSC-1],L);
		LSC:=LSC-1
		END;
	      STMT;			% DO THE STMT
	      EMITB(BRUN,BUMPL,FORINDEXPLACE);	% BRANCH BACK TO FOR
						% INDEX PLACE
	      EMITB(BRUN,TEMPL,L+LCOUNT+1);	% LAST CASE JUMPS OUT
	      TEMPL:=L; 	% STORE PC
	      L:=FORINDEXPLACE; % SO WE CAN PUT IN STACK BUILDING CODE
	      EMITD(3"17777"+TEMPL-L);	% FOR FOR-CASES CASE STMT 
	      EMITL(LCOUNT);		% HOW MANY THERE ARE
	      L:=TEMPL; 	% GET BACK TO WHERE WE SHOULD BE
	      TEMPL:=-1;	% GET READY TO OUTPUT THE CASE TABLE
	      WHILE TEMPL:=TEMPL+1 LEQ LCOUNT
	      DO BEGIN
		TMP:=STMTCASES[TEMPL]*2+2;
		IF DEBUGTOG		% SEE IF CODE IS SET
		THEN BEGIN		% YEP
		  REPLACE LINEOUT BY " " FOR 18,O6(L)," " FOR 16,O6(TMP);
		  WRITEALINE(46)
		END;
		EMITC(TMP)
		END
	    END
	  END
	END OF FOR STATEMENT;
PROCEDURE WRITESTMT;
	BEGIN
	INTEGER W,A,T,P,C,T1PC,T2PC;
	LABEL EXIT;
	T1PC:=L;
	EMITL(REAL(BOOLREADTOG));
	EMITD(16);
	EMIT(STD);
	W:=REAL(CLASS	= WRITEV);
	GETNEXT;
	IF CLASS NEQ LFTPAREN THEN BEGIN ERROR(72); GO EXIT END;
	GETNEXT;
	IF CLASS NEQ FILEID THEN BEGIN ERROR(73); GO EXIT END;
	A:=INFO;			% SAVE POINTER TO FILE DESCRIPTOR
	GETNEXT;
	IF CLASS = LFTBRKT THEN
	BEGIN
	GETNEXT; AEXP;
	IF CLASS NEQ RTBRKT THEN BEGIN ERROR(74); GO EXIT END;
	GETNEXT;
	END
	ELSE EMITPAIR(1,CHS);
	IF CLASS NEQ COMMA THEN BEGIN ERROR(37); GO EXIT END; GETNEXT;
	AEXP;
	IF CLASS NEQ COMMA THEN BEGIN ERROR(37); GO EXIT END; GETNEXT;
	GETROW(TRUE);	% MUST BE NON-INDEXED ROW DESCRIPTOR
	IF CLASS NEQ RTPAREN THEN BEGIN ERROR(32);GO EXIT;END;
	GETNEXT;
	EMITL(W);
	EMITADDRESS(A,0);		% PUT OUT ADDRESS OF FILE DESC.
	EMITPAIR(3,COM);
	IF BOOLREADTOG			% SEE IF FROM BOOLEAN PRIMARY
	THEN BEGIN			% GUESS SO
	  EMITO(16);			% GET RESULT OF I/O
	  BOOLREADTOG:=FALSE		% RESET TOG
	END
	ELSE
	  IF CLASS EQL LFTBRKT		% CHECK FOR ACTION LABELS
	  THEN BEGIN			% YEP
	    ACTIONTOG:=TRUE;		% SET TOG
	    EMITO(16);			% GET RESULT OF I/O
	    T2PC:=BUMPL;
	    GOSTMT;			% GET WHERE TO GO TO
	    EMITB(BRFL,T2PC,L); 	% CONDITIONAL BRANCH FALSE AROUND
					% ACTION LABLE GO TO
	    T2PC:=L;			% SAVE CURRENT PC
	    L:=T1PC;			% GET OLD L
	    EMITL(1);			% TO EMIT A TRUE (1)
	    L:=T2PC;			% GET OLD NEW PC
	    IF CLASS NEQ RTBRKT 	% CHECK IF LABLE FOLLOWED BY ']'
	    THEN FLAG(77)		% NO SO ERROR
	    ELSE GETNEXT;		% YES SO SCAN PAST IT
	  END;
EXIT: END;	
PROCEDURE FILLSTMT;	
	BEGIN	
	  INTEGER J,B,T,DC,ODA,LSAV,SGNOSAV;	
	  BOOLEAN M;
	  INTEGER ARRAY TEDOC[0:1023];
	  LABEL EXIT,XIT,L1;	
	  GETNEXT;			% SCAN THE 'FILL'
	  IF CLASS NEQ ARRAYID		% CAN ONLY FILL ARRAYS
	  THEN BEGIN
	    ERROR(69);			% ARRAY ROW DESIGNATOR EXPECTED
	    GO XIT
	  END;
	  REPLACE LINEOUT BY " " FOR 52,"Data is segment ",
	    O3(SGAVL)," <<<<<<<<";
	  WRITEALINE(80);	% NEW SEGMENT FOR EACH FILL
	  GETROW(TRUE); 	% MUST BE ROW DESIGNATOR. NO SUBSCRIPT
	  ODA:=DA;		% SAVE WHERE THIS SEGMENT GOES
	  SWAP(TEDOC,EDOC);	% SWAP FILLER ARRAY WITH CODE ARRAY
	  IF CLASS NEQ WITHV	% NO 'WITH'
	  THEN BEGIN
	    ERROR(70);		% ERROR
	    GO EXIT
	  END;
	  LSAV:=L;
	  SGNOSAV:=SGNO;	% SAVE SEGMENT NUMBER
	  SGNO:=SGAVL;		% SET TO SEGMENT NUMBER OF FILL DATA
	  L:=-1;
	  DO BEGIN		% SCAN ALL OF FILLER
	    GETNEXT;		% SCAN THE LAST THING 
	    IF CLASS EQL QUOTEOP% FILL WITH QUOTED STRING
	    THEN BEGIN
	      T:=0;		% TOG FOR PACKING 2 CHARS PER WORD
L1:	      J:=NEXTCHAR;	% GET NEXT CHAR
	      DO BEGIN
		IF BOOLEAN(T:=T+1)	% 1ST CHAR/WORD
		THEN BEGIN
		  IF L:=*+1 EQL 1024	% EDOC FULL
		  THEN BEGIN		% SO MOVE IT OUT
		    MOVECODE;		% THIS WILL DO IT
		    DC:=DC+1024;	% KEEP TRACK OF TOTAL AMOUNT TO FILL
		    L:=0		% RESET TO START OF EDOC
		  END;
		  EDOC[L]:=B:=J 	% PUT CHAR IN LOWER PORTION OF WORD
		END
		ELSE EDOC[L]:=J*256+B	% PUT IN 2ND CHAR (SAVE AN INDEX)
		END
	      UNTIL J:=NEXTCHAR = """;
	      SKIPSPACES;		% SCAN OUT THE SPACES
	      GETNEXT;			% SCAN TO NEXT THING (IN CASE OF DEFINES)
	      IF CLASS EQL QUOTEOP	% TO BE CONTINUED ?
	      THEN GO L1		% YES
	    END
	    ELSE BEGIN	% BETTER BE INTEGER CONSTANT
	      IF CLASS EQL ADDOP OR M:=CLASS EQL SUBOP	% PRECEDED BY '+' OR '-'
	      THEN GETNEXT;		% SO SCAN THEM
	      IF CLASS EQL ICONSTANT	% WE GOT WHAT WE WANTED
	      THEN BEGIN
		IF L:=*+1 EQL 1024	% EDOC FULL SO
		THEN BEGIN		% SO EMPTY IT
		  MOVECODE;
		  DC:=DC+1024;	% KEEP TRACK OF TOTAL AMOUNT OF FILLER FOUND
		  L:=0		% RESET FILLER POINTER
		END;
		EDOC[L]:=IF M THEN - INREAL ELSE INREAL;  % STORE IN EDOC
		GETNEXT
		END
	      ELSE BEGIN
		ERROR(38);	% NOT INTEGER CONSTANT
		GO EXIT
		END
	    END
	  END
	  UNTIL CLASS NEQ COMMA;  % LOOP BACK IF WE GOT A COMMA
EXIT:	  MOVECODE;		% MOVE WHAT WE GOTS LEFT OVER OUT
	  SGNO:=SGNOSAV;	% RESTORE SEGMENT NUMBER
	  T:=L+1+DC;		% TOTAL LENGTH
	  L:=LSAV; 		% WHERE WE WERE IN ORIGINAL CODE
	  SWAP(TEDOC,EDOC);	% GET OLD CODE BACK
	  EMITL(T);		% # OF WORDS TO FILL
@O
	THE FOLLOWING LINES WERE TAKEN OUT TEMPORARILY DUE TO THE FACT
	THAT THERE IS NO BINDER AND HENCE DOES NOT MAKE ANY SENSE TO
	HAVE ANY EXTERNAL IDS LET ALONE CODE GENERATED FOR THE BINDER
	WHEN ONE IS WRITTEN, HOWEVER, WE CAN EASILY RE-GENERATE THIS CODE
	  EMITB(BRUN,BUMPL,L+2);% JUMP OVER MARK FOR BINDER
	  EMITD(3"37776");	% MARK FOR BINDER
@O
	  EMITL(ODA);	% DISK ADDRESS OF START OF FILL
	  EMITPAIR(4,COM);	% COMMUNICATE TO FILL IT
	  REPLACE LINEOUT BY " " FOR 48,"Data (",O3(SGAVL),") is ",
	    O4(T)," long <<<<<<<<";
	  WRITEALINE(132);
	  SGAVL:=SGAVL + 1;		% UPDATE NEXT AVAILABLE SEGMENT #
XIT:	END OF FILL STATEMENT;	
PROCEDURE USTMT;
	BEGIN
	  BOOLEAN B;
	  INTEGER P1,P2:=CLASS;
	  DEFINE CHECKIT(I,J)=IF CLASS NEQ I THEN FLAG(J) ELSE GETNEXT#;
	  GETNEXT;		% SCAN THE STMT ID
	  CASE P2-LOCKV OF
	  BEGIN
	    BEGIN		% LOCK STATEMENT
	      CHECKIT(LFTPAREN,31);
	      IF CLASS EQL ARRAYID OR
		 B:=CLASS GEQ PROCID AND CLASS LEQ INTPROCID
	      THEN BEGIN	% WE CAN LOCK ARRAY ROWS OR PROCS ONLY
		IF B
		THEN EMITADDRESS(INFO,0)
		ELSE GETROW(TRUE);
		IF NOT B	% TELL SAVE FUN WHAT WE'RE SAVING
		THEN EMITL(0);
		EMIT(SAV);
		GETNEXT
		END
	      ELSE ERROR(86);
	      CHECKIT(RTPAREN,32)
	    END;
	    BEGIN		% RELEASE STMT
	      CHECKIT(LFTPAREN,31);
	      IF CLASS GEQ PROCID AND CLASS LEQ INTPROCID OR
		 B:=CLASS EQL ARRAYID
	      THEN BEGIN
		IF B
		THEN GETROW(TRUE)
		ELSE EMITADDRESS(INFO,0);
		EMIT(REL);
		GETNEXT;
		END
	      ELSE ERROR(88);
	      CHECKIT(RTPAREN,32)
	    END;
	    BEGIN		% SWAP STMT (FOR SWAPING ARRAYS)
	      IF CLASS NEQ LFTPAREN	% NOT FOLLOWED BY '('
	      THEN FLAG(31)
	      ELSE GETNEXT;		% SCAN IT
	      IF CLASS	NEQ ARRAYID	% WE CAN ONLY SWAP ARRAYS
	      THEN ERROR(89);
	      P1:=INFO; 	% SAVE POINTER TO 1ST ARRAY
	      GETNEXT;
	      IF CLASS NEQ COMMA% ARRAY NAMES MUST BE SEPARATED BY ','
	      THEN FLAG(37)
	      ELSE GETNEXT;
	      IF CLASS NEQ ARRAYID	% NOT ARRAY'S
		 OR REAL(BOOLEAN(STACK[4+P2:=INFO]) AND TRUE) NEQ
		    REAL(BOOLEAN(STACK[P1]) AND TRUE)	% NOT DIMENSIONED SAME
	      THEN ERROR(89);
	      EMITADDRESS(P1,0);	% ADDRESS OF 1ST ARRAY
	      EMITADDRESS(P2,0);	% ADDRESS OF 2ND ARRAY
	      EMIT(SWP);		% SWAP 'EM
	      GETNEXT;
	      IF CLASS NEQ RTPAREN	% ')' THERE ?
	      THEN FLAG(32)
	      ELSE GETNEXT
	    END;
	    BEGIN		% CHAIN STMT
@O
	      CHECKIT(LFTPAREN,31);
		IF CLASS NEQ  ARRAYID	% CAN ONLY CHAIN FROM AN ARRAY
		THEN ERROR(90)
		ELSE BEGIN
		  EMITADDRESS(INFO,0);	% ADDRESS OF STRING OR ARRAY
		  GETNEXT;	% SCAN THE ID
		  IF CLASS EQL COMMA	% CONDITIONAL YET 
		  THEN BEGIN
		    GETNEXT;		% GET TO BOOLEAN EXPRESSION
		    BEXP
		  END
		  ELSE EMITL(1);	% UNCONDITIONAL TRUE
		  IF CLASS NEQ RTPAREN	% FOLLOWED BY ')' ?
		  THEN FLAG(32) 	% NO
		  ELSE GETNEXT;
		  EMITPAIR(3"14",COM)
		END
@O
		END;
	    BEGIN		% CLOSE
	      CHECKIT(LFTPAREN,31);
	      IF CLASS NEQ FILEID
	      THEN FLAG(73)
	      ELSE BEGIN
		EMITADDRESS(INFO,0);   % ADDRESS OF FILE ID
		EMITL(0);		   % FALSE FOR .OPEN
		EMITL(1);		   % TRUE FOR STD
		GETNEXT;
		IF CLASS EQL COMMA
		THEN BEGIN		% PURGE OPTION
		  GETNEXT;
		  IF CLASS NEQ PURGEV
		  THEN BEGIN	% CONDITIONAL PURGE
		    BEXP;
		    EMIT(LNG);
		    EMITPAIR(1,LND)
		  END
		  ELSE BEGIN
		    EMITL(0);	% .PRESENT
		    GETNEXT
		  END
		END
		ELSE EMITL(0);
		EMITPAIR(6,COM);	% DO IT
		CHECKIT(RTPAREN,32)
		END
	    END
	  END OF CASE
	END OF UNLABELED STATEMENTS;
PROCEDURE STMT;
	BEGIN
	INTEGER P,J;
	BOOLEAN B;
	LABEL AGAIN,L2,LE,EXIT;
	LASTWASAGOGO:=FALSE;
AGAIN:	IF CLASS EQL FILEID
	THEN B:=FILEATTRIBUTES(FS,TRUE)
	ELSE
	  IF CLASS EQL POLISHV
	  THEN GO L2
	  ELSE
	    IF CLASS GEQ LOCKV AND CLASS LEQ CLOSEV
	    THEN USTMT
	    ELSE
	  IF CLASS GTR LABELID
	  THEN GO LE
	  ELSE
	    IF CLASS GEQ ENDV AND CLASS LEQ UNTILV
	    THEN
	    ELSE
	CASE CLASS OF
	BEGIN		% TO FAKE THE SCANNER
0:11-17:
LE:	  ERROR(28+REAL(CLASS NEQ 0)*27);
1:	  ACTUALPARAPART(TRUE);
2-10:
L2:	  VARIABLE(FS);
22:	  BEGINCTR:=BEGINCTR+1;   % FOR THE BENIFIT OF THE LISTING
	  GETNEXT;
	  BEGINCTR:=BEGINCTR-1;   % BACK DOWN CAUSE COMPOUND TAIL KNOCKS UP
	  IF CLASS>=BOOLEANV AND CLASS<=TRUTHSETV OR CLASS=FIELDV
	  THEN BLOK(0)
	  ELSE COMPOUNDTAIL;
23-34:	  FLAG(56); DECLARATION; GO AGAIN;
35-36:	  WRITESTMT;
37:	  FORSTMT;
38:	  WHILESTMT;
39:	  DOSTMT;
40:	  IFSTMT;
41:	  GOSTMT; GO EXIT;
42:	  FILLSTMT;
43:	  CASESTMT;
44:	  REPLACESTMT;
45:	  SCANSTMT;
46:	  THRUSTMT;
47:	  LABELER; GO AGAIN;
	END OF CASE;
	LASTWASAGOGO:=FALSE;
EXIT:	END;
INTEGER PROCEDURE MKATOM;	
	BEGIN	
	  INTEGER SCRAM,J;	
	  SCRAM:=REAL(BOOLEAN(REAL(POINTER(INSTR),1)*2+LINSTR) AND
		 BOOLEAN(63));	% HASH FUNCTION
	  IF I+C+10 >= STACKSIZE
	  THEN ERROR(91);
	  MKATOM:=I:=I + 1;
	  STACK[I]:=SCRAMBLEDEGGS[SCRAM];	
	  SCRAMBLEDEGGS[SCRAM]:=I;	
	  REPLACE STACK[I+2] BY POINTER(A) FOR C WORDS;
	  I:=*+1+C
	END;	


PROCEDURE ENTRY;	
	BEGIN
	LABEL EXIT;
	INTEGER T;
	INF:=INFO;
	IF CLASS GTR 0
	THEN
	  IF RESERVED OR SKAN NEQ 1
	  THEN BEGIN
	    FLAG(4);		% NON-ID IN ID LIST
	    CLASS:=0		% RE-ENTER AS ID
	  END
	  ELSE	
	    IF CLASS LEQ CLASSMAX AND SKAN EQL 1 % A REDEFINABLE 
	    THEN CLASS:=0		% RE-ENTER AS ID 
	    ELSE
	      IF STACK[INFO+2] = LEVEL
	      THEN FLAG(2)		% RE-DEFINED
	      ELSE
		IF EXTERNALTOG
		THEN BEGIN
		  T:=INFO;
		  DO BEGIN
		    IF T:=STACK[T+3] GEQ 16000
		    THEN BEGIN	% ALREADY DECLARED EXTERNAL
		      IF CLASS NEQ CLASSF
		      THEN FLAG(13); % NOT COMPATIBLE
		      CLASS:=0;
		      INSTR[0].[7:8]:="@";A[0].[7:8]:="@";
		    END;
		    IF T < 0
		    THEN T:=REAL(NOT BOOLEAN(T));
		END UNTIL T = 0;
		END;
	T:=IF	CLASS = 0 THEN MKATOM ELSE INSYM;	
	STACK[T+1]:=I:=INF:=I + 1;	
	STACK[I]:=CLASSF; % CLASS NUMBER	
	STACK[I+1]:=ADDRESSF; % ADDRESS FIELD	
	STACK[I+2]:=LEVEL ; % CURRENT LEVEL	
	STACK[I:=I+3]:=IF CLASS = 0 THEN 0 ELSE INFO; % LINK	
	IF EXTERNALTOG THEN STACK[I]:=STACK[I]+16000;
EXIT:	GETNEXT;
	END;
%	
%	ENTER	APPLIES ENTRY TO LIST OF IDENTIFIERS	
%	CALLED ONLY FOR LABELS, AND BOOLEAN/REAL/INTEGER IDENTIFIERS
PROCEDURE ENTER;
	BEGIN	
	  BOOLEAN B;
	  INTEGER ICNT;
	  LABEL START;	
	  B:=NOT LOCAL OR OWNTOG OR EXTERNALTOG;
START:	  IF CLASSF NEQ LABELID THEN
	  BEGIN
	    REPLACE PS BY INSTR FOR LINSTR," " FOR 66-LINSTR;
	    ADDRESSF:=GETSPACE(REAL(B))
	  END;
	  ENTRY;		% PUT INTO THE SYMTABLE
	  IF CLASSF NEQ LABELID
	  THEN
	    IF CLASS = ASSIGNOP
	    THEN BEGIN
	      IF NOT B AND ICNT NEQ 0
	      THEN
		IF EDOC[L-1+REAL(L EQL 0)] EQL BPS*4+3"2401" AND L NEQ 0
		THEN BEGIN
		  EMITL(EDOC[L:=L-2] DIV 4 + ICNT);
		  L:=*+1
		END
		ELSE
		  IF ICNT EQL 1
		  THEN EMITL(0)
		  ELSE EMITPAIR(ICNT-1,BPS);
	      ICNT:=0;
	      GETNEXT;
	      IF OWNTOG OR EXTERNALTOG
	      THEN BEGIN
		IF CLASSF=BOOID
		THEN BEGIN
		  IF CLASS NEQ TRUTH AND CLASS NEQ FALSEV
		  THEN FLAG(38);
		  INREAL:=REAL(CLASS=TRUTH)
		END
		ELSE
		  IF CLASS NEQ ICONSTANT
		  THEN FLAG(38);
		PRTA[ADDRESSF]:=INREAL;
		GETNEXT
		END
	      ELSE BEGIN
		IF CLASSF EQL BOOID
		THEN BEXP
		ELSE AEXP;
		IF NOT LOCAL
		THEN BEGIN
		  EMITD(ADDRESSF);
		  EMIT(STD)
		END
		END
	    END
	    ELSE
	      IF CLASS EQL EQLOP AND (CLASSF EQL INTID OR CLASSF EQL BOOID)
	      THEN BEGIN		% EQUIVALENCE
		GETNEXT;		% SCAN THE '='
		IF CLASS EQL INTID OR CLASS EQL BOOID
		THEN BEGIN		% LEGAL
		  STACK[INF+1]:=STACK[INFO+1];	% ADDRESS FIELD
		  STACK[INF+2]:=STACK[INFO+2];	% LEVEL
		  IF B			% TAKE OUT OF PRT OR STACK
		  THEN PRTMAX:=PRTMAX-1
		  ELSE STACKCTR:=STACKCTR-1;
		  GETNEXT		% SCAN IT
		END
		ELSE FLAG(24)
		END
	      ELSE ICNT:=* + 1	+ REAL(CLASSF EQL REALID)
	  ELSE STACK[I+1]:=STACK[I:=I+2]:=0;	% FOR LABELS
	  IF CLASS EQL COMMA	% MORE 
	  THEN BEGIN
	    STOPDEFINE:=TRUE;	% GET NEXT ID
	    GETNEXT;		% GET IT 
	    GO START
	  END;
	  IF NOT B AND ICNT NEQ 0
	  THEN
	    IF EDOC[L-1+REAL(L EQL 0)] EQL BPS*4+3"2401" AND L NEQ 0
	    THEN BEGIN
	      EMITL(EDOC[L:=*-2] DIV 4 + ICNT);
	      L:=L+1
	    END
	    ELSE
	      IF ICNT EQL 1
	      THEN EMITL(0)
	      ELSE EMITPAIR(ICNT-1,BPS);
	END OF ENTER; 
PROCEDURE SWITCHDEC;
	BEGIN
	  OWN INTEGER TL,PL;
	  INTEGER T,P;
	  BOOLEAN B;
	  INTEGER ARRAY A[0:250];
	  LABEL EXIT;
	  TL:=IF IF TL EQL 0 OR PL NEQ LEVEL	% WANT TO AVOID INVALID INDEX
		 THEN FALSE
		 ELSE EDOC[TL-2] EQL (L*2+2)*4	% OPTIMIZE FOR CASE OF
	      THEN TL				% SWITCHDEC FOLLOWING SWITCHDEC
	      ELSE BUMPL;
	  PL:=LEVEL;
	  IF EXTERNALTOG OR SAVETOG OR OWNTOG THEN FLAG(14);
	  STOPDEFINE:=SWITCHDECTOG:=TRUE;	% GET SWITCH NAME
	  GETNEXT;	
	  CLASSF:=LABELID; ADDRESSF:=0; 
	  ENTRY; STACK[P:=INF]:=SWITCHID;
	  I:=I+2;	% MAKE ROOM FOR # OF SWITCHES AND BASE ADDRESS
	  IF CLASS NEQ ASSIGNOP THEN BEGIN ERROR(67);GO EXIT END;	
	  DO BEGIN
	    A[T:=T+1]:=L;	% WHERE EACH DESIGNATIONAL EXPRESSION STARTS
	    ACTIONTOG:=TRUE;	% LET GO-STMT HANDLE THEM
	    GOSTMT;
	    B:=B OR L-A[T] GTR 2	% B INDICATES IF ANY NON-LOCAL BLOCK
	  END 		% CHANGES (MORE CODE) OR EXPRESSIONS
	  UNTIL CLASS NEQ COMMA;	% END OF SWITCH LIST 
	  STACK[P+4]:=T;		% # OF SWITCHES
	  STACK[P+5]:=(IF B THEN L ELSE A[1])*2-2;	% WHICH TABLE TO INDEX INTO
	  P:=1;
	  IF B		% SHOULD WE BUILD A BRANCH TABLE?
	  THEN		% YES
	    DO EMITB(BRUN,BUMPL,A[P])	% BUILD IT HERE
	    UNTIL P:=P+1 GTR T;
	  EMITB(BRUN,TL,L);		% BRANCH AROUND THE BRANCHES WE CREATED
	  SWITCHDECTOG:=FALSE;
EXIT:	END OF SWITCH DEC;
%
%	ARRAYDEC	HANDLER ARRAY DECLARATIONS
%
PROCEDURE ARRAYDEC;
	BEGIN
	  INTEGER OLDCLASS:=IF CLASSF EQL 0 THEN INTID ELSE CLASSF,
		  P,T;		% DEFAULT ARRAY TYPE IS INTEGER
	  BOOLEAN TWODIM,THEREWASACOMMA,B;
	  LABEL EXIT;
	  CLASSF:=ARRAYID;		% SET CLASS OF DECLARATION TO BE
					% ARRAY DECLARATION
	  B:=NOT LOCAL OR EXTERNALTOG OR OWNTOG;  % SET BLOCK 0 TOGGLE
	  DO BEGIN
	    P:=REAL(THEREWASACOMMA:=TWODIM:=FALSE);  % RESET SWITCHES
	    DO BEGIN
	      STOPDEFINE:=TRUE; % DONT EXPAND DEFINES
	      GETNEXT;			% GET IDENTIFIER
	      CREFIT("V",LEVEL,1);	% CREF DEFINITION
	      IF B			% IN THE PRT
	      THEN PRTMAX:=*+1; % FOR ARRAY LINKAGE
	      REPLACE PS BY INSTR FOR LINSTR," " FOR 66-LINSTR;
	      ADDRESSF:=GETSPACE(REAL(B));
	      ENTRY;			% ENTER IN THE SYMBOLTABLE
	      I:=I+2;			% LEAVE ROOM FOR DIM,SAVE,TYPES
	      STACK[I]:=P;		% LINK THE LIST
	      P:=INF;			% RE-INIT THE LINK
	      IF B			% IN THE PRT
	      THEN
	      ELSE STACKCTR:=STACKCTR+1;	% MAKE ROOM FOR LINK
	      IF CLASS EQL COMMA	% CHECK FOR MULTIPLY DEFINED DECS
	      THEN THEREWASACOMMA:=TRUE
	    END
	    UNTIL NOT CLASS EQL COMMA;	% CONTINE TO SCAN UNTIL NO ,'S
	    IF CLASS NEQ LFTBRKT	% SHOULD BE FOLLOWED BY '['
	    THEN BEGIN
	      ERROR(15);		% NOT GOOD 
	      GO EXIT
	    END;
	    GETNEXT;			% SCAN PAST THE '['
	    AEXP;			% GET LOWER LIMIT
	    IF CLASS NEQ COLON		% FOLLOWED BY ':'
	    THEN BEGIN
	      ERROR(16);
	      GO EXIT
	    END;
	    GETNEXT;			% GET TO BEGINING OF AEXP
	    AEXP;			% GET UPPER LIMIT
	    IF TWODIM:=CLASS EQL COMMA	% CHECK FOv(2,DAM
	    THEN BEGIN			% SOME PEOPLE JUST WANT TO BE
					% DIFFICULT
	      IF LONGTOG
	      THEN FLAG(98);		% TWO DIM CONNOT BE LONG
	      GETNEXT;			% SCAN THE COMMA
	      AEXP;			% GET LOWER LIMIT OF 2ND DIM
	      IF CLASS NEQ COLON	% SHOULD BE FOLLOWED BY A ':'
	      THEN BEGIN
		ERROR(16);		% ':' EXPECTED
		GO EXIT
		END;
	      GETNEXT;			% SCAN THE ':'
	      AEXP;			% GET THE UPPER BOUND
	      EMITNUM(REAL(OLDCLASS EQL REALID)); %TWO DIM
	      EMIT(B2D) 	% BUILD TEMP 2-DIM ARRAY DESCRIPTOR
	    END
	    ELSE BEGIN
	      EMITNUM((IF LONGTOG THEN 0 ELSE 3"40000")+REAL(OLDCLASS
			EQL REALID));
	      EMIT(B1D);		% BUILD TEMP 1-DIM ARRAY DESCRIPTOR
	    END;
	    DO BEGIN		% FOLLOW LIST OF LINKS FROM ID,ID[*....
	      IF NOT B		% HAVE TO BUILD A PLACE FOR IT 1ST
	      THEN EMITPAIR(4,BPS);
	      EMITL(REAL(OWNTOG));	% FOR THE BUILDER
	      EMITD(STACK[P+1]+(IF B THEN 3 ELSE -3));	% POINT TO LAST WORD
	      EMIT(BLD);
	      T:=STACK[P+5];		% GET NEXT LINK
	      STACK[P+5]:=OLDCLASS;	% SAVE THE ARRAY TYPE
	      STACK[P+4]:=REAL(TWODIM); 	% NUMBER OF DIMENSIONS
	      IF SAVETOG		% IS THE ARRAY SAVED?
	      THEN
		IF TWODIM
		THEN FLAG(12)
		ELSE BEGIN
		  EMITD(STACK[P+1]);	% GET ADDRESS
		  EMITL(0);		% TO TELL SAVE FUNCT WE'RE SAVING ARRAY
		  EMIT(SAV)		% SAVE ARRAY
		END
	    END
	    UNTIL P:=T EQL 0;
	    IF CLASS NEQ RTBRKT 	% CHECK FOR A ']'
	    THEN ERROR(17)
	    ELSE GETNEXT
	  END
	  UNTIL CLASS NEQ COMMA;
EXIT:	END;
PROCEDURE MEMBERSHIPPRIMARY;
	BEGIN
	  INTEGER I,J;
	  BOOLEAN B,B1;
	  IF B:=CLASS EQL NOTV		% SCAN OUT NOT'S
	  THEN GETNEXT;
	  IF CLASS EQL LFTPAREN 	% '('
	  THEN BEGIN
	    GETNEXT;			% SCAN IT
	    MEMBERSHIPEXP;		% GET MEMBERSHIP EXPRESSION
	    IF B1:=CLASS NEQ RTPAREN	% FOLLOWED BY A ')'?
	    THEN FLAG(32)		% NO
	  END
	  ELSE
	    IF CLASS EQL TRUTHID AND STACK[INFO+3] GEQ 0% TRUTHID
	    THEN REPLACE PERMDEC BY POINTER(STACK[INFO+4]) FOR 8 WORDS
	    ELSE
	      IF CLASS EQL QUOTEOP	% QUOTED STRING
	      THEN BEGIN
		REPLACE PERMDEC BY 0 FOR 8 WORDS;
		I:=NEXTCHAR;		% IN CASE 1ST CHAR IS A """
		DO BEGIN
		  J:=REAL(BOOLEAN(I) AND BOOLEAN(15));	% I MOD 16
		  PERMDEC[I:=SHR(I,4)]:=REAL(BOOLEAN(PERMDEC[I]) OR
			 BOOLEAN(SHL(1,J)))
		END			% OR IN THIS CHARACTER INTO TRUTHSET
		UNTIL I:=NEXTCHAR EQL """;
		SKIPSPACES
		END
	      ELSE
		IF CLASS EQL ICONSTANT	% CONSTANTS ALLOWED ALSO
		THEN BEGIN
		  REPLACE PERMDEC BY 0 FOR 8 WORDS;
		  PERMDEC[SHR(I:=REAL(BOOLEAN(INREAL) AND BOOLEAN(127)),4)]
		 :=SHL(1,REAL(BOOLEAN(I) AND BOOLEAN(15)))
		END
		ELSE ERROR(REAL(B1:=BOOLEAN(113)));	% BAD BONGO'S CHARLIE
	  IF NOT B1		% NO ERROR
	  THEN GETNEXT; 	% SO SCAN THE TOKEN
	  IF B		% NOT TOG
	  THEN BEGIN	% RESET THE TEMPORARY DECLARATION
	    I:=0;
	    DO PERMDEC[I]:=REAL(NOT BOOLEAN(PERMDEC[I]))
	    UNTIL I:=I+1 EQL 8
	  END
	END OF MEMBERSHIP PRIMARIES;

PROCEDURE MEMBERSHIPEXP;	% PARSES MEMBERSHIP EXPRESSIONS
	BEGIN
	  INTEGER ARRAY TEMPDEC[0:7];	% FOR RECURSIVE PURPOSES
	  BOOLEAN LAND;
	  INTEGER I;
	  MEMBERSHIPPRIMARY;	% GET PRIMARY EXPRESSION
	  WHILE CLASS EQL ORV OR LAND:=CLASS EQL ANDV
	  DO BEGIN		% AND & OR IN LEFT TO RIGHT ORDER
	    SWAP(TEMPDEC,PERMDEC);	% SWAP THE NEW ARRAY OUT & OLD ONE IN
	    GETNEXT;		% SCAN THE LOGICAL OPERATOR
	    MEMBERSHIPPRIMARY;	% SHOULD BE FOLLOWED BY ANOTHER PRIMARY
	    SWAP(TEMPDEC,PERMDEC);	% SWAP ARRAYS BACK TO ORIGIONAL ORDER
	    I:=0;		% CLEAR I
	    DO PERMDEC[I]:=% AND OR OR THE	OLD VALUES IN
	      IF LAND		% AND THEM
	      THEN REAL(BOOLEAN(PERMDEC[I]) AND BOOLEAN(TEMPDEC[I]))
	      ELSE REAL(BOOLEAN(PERMDEC[I]) OR	BOOLEAN(TEMPDEC[I]))
	    UNTIL I:=I+1 EQL 8
	  END
	END OF MEMBERSHIP EXPRESSIONS;

PROCEDURE TRUTHSETDEC;		% FINALLY, THE ONE YOU ALL BEEN WAITING FOR
	BEGIN
	  INTEGER TINFO,X,J;
	  BOOLEAN B:=NOT LOCAL OR EXTERNALTOG OR OWNTOG;
	  CLASSF:=TRUTHID;	% SET CLASS AS TRUTHSET ID
	  DO BEGIN		% SCAN THE ID LIST
	    STOPDEFINE:=TRUE;	% STOP EXPANSION OF DEFINES IN ID LIST
	    GETNEXT;		% GET ID
	    CREFIT("V",LEVEL,1);	% CREF DEFINITION
	    REPLACE PS BY INSTR FOR LINSTR," " FOR 66-LINSTR;
	    J:=(ADDRESSF:=GETSPACE(REAL(B)))-1;
	    ENTRY;		% PUT IN THE SYMBOL TABLE
	    I:=(TINFO:=I)+X:=8; % INIT VARIABLES
	    IF CLASS EQL LFTPAREN	% OK
	    THEN BEGIN
	      MEMBERSHIPPRIMARY;    % SCAN THE TRUTHSET DEC
	      DO BEGIN
		STACK[TINFO+X]:=PERMDEC[X:=X-1];  % PUT IN SYMBOL TABLE
		IF B		% PUT IN THE PRT
		THEN PRTA[J:=J+1]:=PERMDEC[7-X]     % GET FROM TEMP DEC
		ELSE EMITNUM(PERMDEC[X])	% ELSE PUSH INTO THE STACK
		END
	      UNTIL X EQL 0
	    END
	    ELSE ERROR(31)
	  END
	  UNTIL CLASS NEQ COMMA
	END OF TRUTH SET DECLARATIONS;
PROCEDURE POINTERDEC;
	BEGIN
	  BOOLEAN B:=NOT LOCAL OR EXTERNALTOG OR OWNTOG;
	  LABEL OWNPTR;
	  CLASSF:=STRINGID;
	  DO BEGIN		% SCAN POINTER-IDENTIFIER LIST
	    STOPDEFINE:=TRUE;	% STOP EXPANSION OF DEFINES
	    GETNEXT;		% GET NEXT IDENTIFIER IN LIST
	    CREFIT("V",LEVEL,1);	% CREF DEFINITION
	    REPLACE PS BY INSTR FOR LINSTR," " FOR 66-LINSTR;
	    ADDRESSF:=GETSPACE(REAL(B));  % GET ADDRESS FOR ID
	    ENTRY;		% PUT IN THE SYMBOL TABLE
	    IF OWNTOG
	    THEN GO OWNPTR;
	    IF CLASS EQL EQLOP	% SEE IF EQUIVALANCE
	    THEN BEGIN
	      GETNEXT;		% YES. SEE IF EQUIVALANCED TO A POINTER
	      IF CLASS NEQ STRINGID
	      THEN FLAG(108)	% POINTER IDENTIFIER EXPECTED
	      ELSE BEGIN
		STACK[INF+1]:=STACK[INFO+1];	% COPY ADDRESS
		STACK[INF+2]:=STACK[INFO+2];	% AND LEVEL OF OTHER DECLARATION
		IF B		% UNALLOCATE AREA WHERE WE WERE GOING TO
				% PUT THIS
		THEN PRTMAX:=PRTMAX-3
		ELSE STACKCTR:=STACKCTR-3;
		GETNEXT 	% SCAN THE ID
		END
	    END
	    ELSE BEGIN		% NOT EQUIVALANCED
	      IF NOT B		% IN STACK
	      THEN EMITL(0);	% FOR LINKAGE
	      IF CLASS EQL ASSIGNOP	% BUILD ONE NOW ?
	      THEN BEGIN
		GETNEXT;	% SCAN THE ':='
		PEXP;		% EXPECTING A POINTER EXPRESSION
		IF B		% IN PRT ?
		THEN BEGIN	% YES
		  EMITADDRESS(INF,0);	% STORE THERE
		  EMIT(PSTD)
		END
		ELSE EMIT(XCH)	% PUT IN PROPER ORDER FOR POINTER
		END
	      ELSE
		IF NOT	B	% IN THE STACK?
		THEN BEGIN	% YES
		  EMITL(0);	% OTHER WISE BUILD A VIRGIN POINTER
		  EMITL(0)
		END;
OWNPTR:       EMITL(REAL(OWNTOG));		% FOR THE BUILDER
	      EMITD(ADDRESSF-2+4*REAL(B AND TRUE));	% WHERE TO LINK TO
	      EMIT(PLNK)	% AND LINK UP THE POINTERS.
	    END
	  END
	  UNTIL CLASS NEQ COMMA;
	END OF POINTER DEFINITIONS;
PROCEDURE DEFINEDEC;		% DECLARES DEFINES (INCLUDING
	BEGIN			% THOSE WITH PARAMETERS)
	  INTEGER ARRAY ELBAT[0:180];	% OUR OWN SYMBOLTABLE FOR FASTNESS
	  INTEGER LINK,TCOUNT,COUNT,INP,PARAMNO,X,TX,TEMP,B,NESTLEVEL;
	  BOOLEAN DONE,FOUND,WEMAYNEEDASPACE;
	  LABEL XIT;
	  CLASSF:=DEFINEID;	ADDRESSF:=0;
	  DO BEGIN
	    GETNEXT;		% GET ID (NAME OF DEFINE)
	    CREFIT("D",LEVEL,1);	% CREF DEFINITION
	    ENTRY;		% PUT IN THE SYMBOL TABLE
	    INP:=INF+1; 	% WHERE TO PUT PARAMETER COUNT
	    I:=I+1;		% WHERE TO PUT LENGTH OF DEFINE (IN WORDS)
	    NESTLEVEL:=COUNT:=PARAMNO:=LINK:=
			      REAL(DONE:=WEMAYNEEDASPACE:=FALSE);
	    IF CLASS EQL LFTPAREN	% PARAMETERS YET WELL WE CAN
	    THEN BEGIN			% DIG IT 
	      DO BEGIN
		STOPDEFINE:=TRUE;	% STOP EXPANSION OF DEFINES
		GETNEXT;		% GET NEXT PARAMETER NAME
		IF RESERVED OR SKAN NEQ 1	% MAKE SURE IT'S AN ID
		THEN BEGIN			% WHATS THIS GARBAGE ?
		  ERROR(99);
		  GO XIT
		END;
		REPLACE ELBAT[LINK+1] BY POINTER(A) FOR C WORDS;
		ELBAT[LINK]:=LINK:=*+C+1;
		PARAMNO:=PARAMNO+1;	% KEEP TRACT HOW MANY WE GOTS
		GETNEXT 		% GET NEXT THING
		END
	      UNTIL PARAMNO EQL 10 OR CLASS NEQ COMMA;
	      IF CLASS NEQ RTPAREN	% EITHER ',' EXPECTED
	      THEN BEGIN		% OR TO MANY PARAMS ( ')' EXPT)
		ERROR(32+5*REAL(PARAMNO EQL 10));
		GO XIT
		END;
	      GETNEXT			% SCAN TO WHAT SHOULD BE A '='
	    END;
	    IF CLASS NEQ EQLOP		% SEE IF IT IS
	    THEN BEGIN
	      ERROR(52);		% TELL HIM ABOUT OUR COMPLAINT
	      GO XIT
	    END;
	    DO BEGIN			% TIME TO CRUNCH THE DEFINE
	      X:=SCANNER;		% INTO THE SYMBOLTABLE
	      IF INSTR[0] EQL "#"	% SEE IF DONE YET
	      THEN DONE:=NESTLEVEL:=NESTLEVEL-1 LSS 0 % AN UNMATCHED '#'
	      ELSE			% NOT YET
		IF INSTR[0] EQL """	% SEE IF QUOTED STRING
		THEN BEGIN		% YEP
		  TCOUNT:=0;		% # OF CHAR SCANNED (INCLUDING
		  X:=""";		% THE DOUBLE QUOTES
		  WHILE TCOUNT:=TCOUNT+1 LSS 3 OR X NEQ """
		  DO BEGIN
		    IF TCOUNT NEQ 1	% FUDGE 1ST TIME
		    THEN X:=NEXTCHAR;
		    IF BOOLEAN(COUNT:=COUNT+1)	% SEE WHAT TO DO
		    THEN B:=X			% SAVE CHAR
		    ELSE			% ADD TO DEFINED
		      IF I+1 GTR STACKSIZE
		      THEN ERROR(91)		% SYMTBL OVRFLOW
		      ELSE STACK[I:=I+1]:=B+256*X
		  END
		END
		ELSE BEGIN
		  IF SKAN EQL 1 AND PARAMNO NEQ 0% SHOULD WE LOOK FOR
		  THEN BEGIN			 % IF PARAMETER? YES
		    X:=C*2;
		    LINK:=TCOUNT:=0;
		    DO TCOUNT:=*+1
		    UNTIL (FOUND:=POINTER(A) EQL POINTER(ELBAT[LINK+1]) FOR X)
			  OR LINK:=ELBAT[LINK] EQL 0;
		    IF FOUND		% FIND IT?
		    THEN BEGIN		% YEP. CHANGE THE ID
		      INSTR[0]:=3"177"+256*("/"+TCOUNT);
		      LINSTR:=2 	% TO MEET OUR NEEDS
		    END
		  END;
		  IF SKAN LEQ 2 	% AN ID
		  THEN BEGIN
		    NESTLEVEL:=NESTLEVEL+REAL(	% IF ID WAS 'DEFINE'
				POINTER(STACK[163]) EQL POINTER(A) FOR 8);
		    IF WEMAYNEEDASPACE
		    THEN BEGIN
		      TX:=LINSTR;
		      LINSTR:=*+1;
		      WHILE TX GTR 0 DO % TRANSFER STRING UP 1 CHAR
		      REPLACE POINTER(INSTR)+TX BY POINTER(INSTR)+TX:=*-1
			      FOR 1;
		      INSTR[0].[7:8]:=" ";	% PUT SPACE IN FRONT
		    END
		  END;
		  X:=-1;		% TIME TO ADD SCANNED THINGIE
		  WHILE X:=X+1 LSS LINSTR	% TO DEFINE
		  DO
		    IF BOOLEAN(COUNT:=COUNT+1)	% SEE WHERE TO PUT CHAR
		    THEN B:=REAL(POINTER(INSTR)+X,1)
		    ELSE			% INTO THE TABLE
		      IF I+1 GTR STACKSIZE	% SEE IF STACK OVERFLOW
		      THEN ERROR(91)
		      ELSE STACK[I:=I+1]:=B+256*REAL(POINTER(INSTR)+X,1);
		  WEMAYNEEDASPACE:=SKAN EQL 1
		END
	    END
	    UNTIL DONE; 	% END OF CRUNCHER
	    IF BOOLEAN(COUNT)	% SEE WHAT TO DO WITH LAST CHAR
	    THEN		% IF IT EXISTS
	      IF I+1 GTR STACKSIZE	% CHECK FOR SYMTBL OFLOW
	      THEN ERROR(91)
	      ELSE STACK[I:=I+1]:=B;	% STORE IT
	    STACK[INP]:=PARAMNO;	% STORE THE # OF PARAMETERS
	    STACK[INP+3]:=COUNT;	% STORE # OF CHARS LONG
	    GETNEXT		% GET PAST THE '#'
	  END
	  UNTIL CLASS NEQ COMMA;	% IF FOLLOWED BY A COMMA THEN MORE
XIT:	END OF DEFINEDEC;
PROCEDURE FILEDEC;	% FOR DECLARING FILES
	BEGIN
	  LABEL E1,E2;
	  BOOLEAN U,M,K,T,B,E,MR;
	  INTEGER USE,MAX,KND,MAXSIZ;
	  ARRAY NAME[0:33];	% FOR DEFAULT EXTERNAL FILE NAME
	  POINTER Q;
	  DEFINE BL=BOOLEAN(LINSTR)#;
	  B:=NOT LOCAL OR EXTERNALTOG OR OWNTOG;
	  CLASSF:=FILEID;
	  DO BEGIN	% SCAN THE LIST
	    STOPDEFINE:=TRUE;	% STOP EXPANSION OF DEFINES
	    GETNEXT;		% GET FILE NAME
	    CREFIT("F",LEVEL,1);	% CREF DEFINITION
	    REPLACE PS BY INSTR FOR LINSTR," " FOR 66-LINSTR;
	    ADDRESSF:=GETSPACE(REAL(B));	% GET SPACE FOR IT SOMEWHERE
	    REPLACE NAME BY INSTR FOR LINSTR,	% GET DEFAULT NAME
			" " FOR 1-REAL(BL AND TRUE),""..";
	    ENTRY;		% PUT INTO THE SYMBOL TABLE
	    MR:=U:=M:=K:=T:=E:=BOOLEAN(USE:=0);% INITIALIZATION
	    MAX:=36;		% DEFAULT MAXRECSIZE
	    MAXSIZ:=100;	% DEFAULT SIZE
	    KND:=7;
	    IF B		% THIS ONE GOES INTO THE PRT
	    THEN
	    ELSE EMITPAIR(4,BPS);	% MAKE SPACE FOR FILE
	    EMITD(ADDRESSF);		% GET ADDRESS OF FILE DESCRIPTOR
	    IF CLASS EQL LFTPAREN	% INITIAL ATTRIBUTE LIST 
	    THEN BEGIN
	      DO BEGIN			% SCAN THE ENTIRE LIST
		GETATTRIBUTE;		% SEE WHAT ATTRIBUTE IS
		IF CLASS EQL MYUSEV
		THEN			% MYUSE =
		  IF U:=NOT U		% DEFINED BEFORE ?
		  THEN BEGIN		% NO SO OK
		    GETNEXT;		% SEE WHAT FOLLOWS
		    IF CLASS NEQ EQLOP	% FOLLOWED BY AN EQUIVALENCE OP ?
		    THEN
		      E1:BEGIN
			E:=TRUE;
			FLAG(52)
			END
		    ELSE BEGIN
		      GETATTRIBUTE;		% SCAN THE '='
		      IF CLASS GEQ INV AND CLASS LEQ IOV
		      THEN USE:=CLASS-INV+1
		      ELSE		% IN,OUT,IO
			IF CLASS NEQ ICONSTANT
			THEN FLAG(20)
			ELSE USE:=INREAL;
		      IF NOT E
		      THEN GETNEXT	% SCAN THE INITIAL VALUE
		    END
		  END
		  ELSE E2: FLAG(REAL(E:=BOOLEAN(21)))
		ELSE			% NOT MYUSE
		  IF CLASS EQL TITLEV	% INITIAL TITLE
		  THEN
		    IF T:=NOT T 	% RE DEFINED?
		    THEN BEGIN
		      GETNEXT;		% SCAN IT
		      IF CLASS NEQ EQLOP
		      THEN GO E1;	% ERROR
		      GETNEXT;		% SCAN THE '='
		      IF E:=CLASS NEQ QUOTEOP	% FOLLOWED BY A '"'
		      THEN FLAG(118)	% STRING EXPECTED
		      ELSE BEGIN
			QUOTE;
			IF BOOLEAN(LENGTH)	% LENGTH WAS ODD
			THEN			% SO OK
			ELSE BEGIN
			  CONST[CLEAN-LENGTH DIV 2]:=(LENGTH+2)DIV 2;
			  CONST[CLEAN:=CLEAN+1]:=0
			END;
			EMITL(LENGTH)
			END
		    END
		    ELSE GO E2		% WAS RE-DEFINED 
		  ELSE			% NOT TITLE
		    IF CLASS EQL MAXRECV
		    THEN
		      IF M:=NOT M	% RE-DEFINED?
		      THEN BEGIN	% NO
			GETNEXT;	% SCAN IT
			IF CLASS NEQ EQLOP
			THEN GO E1;
			GETNEXT;	% SCAN IT TOO
			IF E:=CLASS NEQ ICONSTANT	% NOT INTEGER CONSTANT
			THEN FLAG(38)	% ICONSTANT EXPECTED
			ELSE BEGIN
			  MAX:=INREAL;	% GET VALUE
			  GETNEXT
			END
			END
		      ELSE GO E2	% RE-DEFINED
		    ELSE		% NOT EITHER
		      IF CLASS NEQ KINDV	% NOT EVEN KIND AND THAT'S NOT NICE
		      THEN
			IF E:=CLASS NEQ MAXSIZEV
			THEN FLAG(96)	% NOT PROPER FILE ATTRIBUTE
			ELSE
			  IF MR:=NOT MR % RE-DEFINED?
			  THEN BEGIN	% NO. GOOD.
			    GETNEXT;	% SCAN IT
			    IF CLASS NEQ EQLOP
			    THEN GO E1;
			    GETNEXT;
			    MAXSIZ:=INREAL;  % GET MAX FILE SIZE
			    IF E:=CLASS NEQ ICONSTANT
			    THEN FLAG(38)% I-CONST MISSING
			    ELSE GETNEXT
			  END
			  ELSE GO E2
		      ELSE
			IF K:=NOT K	% RE-DEFINED
			THEN BEGIN
			  GETNEXT;	% NO GET NEXT THING
			  IF CLASS NEQ EQLOP
			  THEN GO E1;
			  GETATTRIBUTE; % SCAN IT
			  IF CLASS GEQ BINV AND CLASS LEQ LPV
			  THEN BEGIN
			    IF CLASS EQL LPV	% FOR PRINTER
			    THEN BEGIN
			      IF NOT M		% DEFAULT MAXRECSIZE
			      THEN MAX:=
				IF EIGHTYCOL	% IS 80 FOR 80 COL PRINTER
				THEN 80
				ELSE 132;	% AND 132 FOR 132 COL PRINTER
			      IF NOT U		% AND DEFAULT MYUSE
			      THEN USE:=2	% IS OUT
			    END
			    ELSE
			      IF CLASS EQL BINV AND NOT M
			      THEN MAX:=512;	% DEFAULT RECORD SIZE FOR BIN FILES
			    KND:=CLASS-BINV;
			    GETNEXT
			  END
			  ELSE
			    IF E:=CLASS NEQ ICONSTANT OR INREAL GTR 7
				      OR KND:=INREAL LSS 0
			    THEN FLAG(38)
			    ELSE GETNEXT
			END
			ELSE GO E2
		END
	      UNTIL CLASS EQL RTPAREN OR E;
	      IF CLASS NEQ RTPAREN	% SEE IF LIST ENDED WITH A ')'
	      THEN FLAG(22)
	      ELSE GETNEXT		% AND SCAN IT
	    END;
	    IF NOT T		% NO TITLE
	    THEN BEGIN
	      Q:=P;		% SAVE POINTER INTO 'CARD'
	      P:=NAME;		% THIS IS WHERE THE DEFAULT EXTERNAL NAME IS
	      POLISH:=REAL(NEWCARD);	% SAVE THIS BOOLEAN ALSO
	      NEWCARD:=FALSE;
	      POLISH:=CLASS;	% SAVE 'CAUSE QUOTE WILL DESTROY IT
	      QUOTE;		% GET IT OUT.
	      CLASS:=POLISH;	% RE-STORE OLD CLASS
	      NEWCARD:=BOOLEAN(POLISH); % OLD NEW-CARD VALUE
	      EMITL(LENGTH);	% AND ITS LENGTH
	      P:=Q		% GET BACK OLD POINTER INTO 'CARD'
	    END;
	    EMITL(KND); 	% FILE KIND
	    EMITL(MAX); 	% MAX REC SIZE
	    EMITL(MAXSIZ);	% MAXRECNO
	    EMITL(USE); 	% MYUSE
	    EMITL(REAL(OWNTOG));% ALLOW FOR OWN FILES
	    EMITPAIR(2,COM);	% BUILD A DESCRIPTOR
	    SAVEIT:=*+26	% 8 FOR SYSTEM FIB; 16 FOR ALGOL FIB
	  END
	  UNTIL CLASS NEQ COMMA
	END OF FILE DECLARATIONS;
@O
PROCEDURE FIELDDEC(X);
	VALUE X;
	BOOLEAN X;
	BEGIN
	  INTEGER P,T;
	  BOOLEAN B;
	  LABEL L;
	  IF EXTERNALTOG OR SAVETOG OR OWNTOG THEN FLAG(14);
L:	  STOPDEFINE:=TRUE;
	  GETNEXT;
	  CREFIT("V",LEVEL,1);	% CREF DEFINITION
	  CLASSF:=FIELDID + REAL(X); ADDRESSF:=0;
	  ENTRY;
	  P:=INF; I:=I+2; STACK[P+4]:=0; STACK[P+5]:=16;
	  IF CLASS = LFTPAREN THEN
	  BEGIN
	    GETNEXT;
	    IF B:=CLASS = SUBOP THEN GETNEXT;
	    IF CLASS NEQ ICONSTANT THEN FLAG(38) ELSE
	    STACK[P+4]:=IF B THEN - INREAL ELSE INREAL;
	    GETNEXT;
	    IF CLASS NEQ RTPAREN THEN FLAG(32) ELSE GETNEXT
	  END;
	  IF CLASS = LFTBRKT THEN
	  BEGIN
	    GETNEXT;
	    IF CLASS NEQ ICONSTANT OR INREAL >015 THEN FLAG(38) ELSE
	    T:=INREAL;
	    GETNEXT;
	    IF CLASS NEQ COLON THEN FLAG(36) ELSE GETNEXT;
	    IF CLASS NEQ ICONSTANT ! INREAL>16 ! INREAL = 0 THEN FLAG(38) ELSE
	    STACK[P+5]:=T*256+INREAL;
	    GETNEXT;
	    IF CLASS NEQ RTBRKT THEN FLAG(41) ELSE GETNEXT
	  END;
	  IF LINSTR = 5 & INSTR(0)="B" & INSTR(4) = "D" THEN % BASED
	  BEGIN
	    GETNEXT;
	    IF CLASS NEQ LFTPAREN THEN FLAG(31) ELSE GETNEXT;
	    IF (CLASS=ARRAYID AND STACK[INFO+4]=1) ! CLASS = INTID
		! CLASS = BOOID THEN
	    STACK[P+1]:=INFO ELSE FLAG(IF CLASS = 0 THEN 28 ELSE 84);
	    GETNEXT;
	    IF CLASS NEQ RTPAREN THEN FLAG(32) ELSE GETNEXT
	  END ELSE
	  FLAG(85);
	  IF CLASS = COMMA THEN GO TO L
	END;
@O
PROCEDURE PURGEIT;
	BEGIN	
	BOOLEAN B;
	INTEGER T,P,R,A,I,C,N,J,S,OCOL,K,PT;
	DO
	IF T:=SCRAMBLEDEGGS[J] NEQ 0 THEN
	DO
	  IF R:=STACK[T+1] > CLASSMAX
	  THEN
	    IF STACK[R+2] = LEVEL
	    THEN BEGIN
	IF (B:=C:=REAL(BOOLEAN(STACK[R]) AND BOOLEAN(255)) GEQ PROCID
	       AND C LEQ INTPROCID AND A:=STACK[R+1]<0) OR (C EQL LABELID
	       AND A EQL 10000 AND REAL(BOOLEAN(STACK[R+4])
	       OR BOOLEAN(STACK[R+5])) NEQ 0)
	THEN BEGIN	
	  LINSTR:=REAL(BOOLEAN(STACK[A:=T+2]) AND BOOLEAN(255))-"0";
	  REPLACE INSTR BY POINTER(STACK[A])+1 FOR LINSTR;
	  OCOL:=LASTCOL; LASTCOL:=10;
	  FLAG(IF B THEN 65 ELSE 64);
	  LASTCOL:=OCOL;
	END;	
	IF P:=STACK[R+3] LSS 0 THEN P:=REAL(NOT BOOLEAN(P))
	ELSE %				BY NAME 
@O	% EXTERNALS NOT IMPLEMENTED IN THIS RELEASE
	IF P GEQ 16000		% EXTERNAL
	THEN BEGIN
% IT MAY BE NECESSARY TO MAKE A FEW CHANGES DEPENDING UPON WHAT THE
% EXTERNAL SYMBOL TABLE IS TO LOOK LIKE. IN PARTICULAR IN REFERANCE
% TO ARRAYS AND STRINGID (WHICH HAVE BEEN CHANGED TO POINTERS)
% AND MAYBE TRUTHSETS WHICH WERE ADDED
	  INTEGER N,I;
	  P:=P-16000;		% MAKE NOT EXTERNAL ADDRESS
	  N:=(STACK[T+2].[15:8]-"0") DIV 2+2;
	  FOR I:=2 STEP 1 UNTIL N DO
		ESTACK[EI:=EI+1]:=STACK[T+I]; % MOVE SYMBOL
	  N:=STACK[T+1];
	  I:=(ESTACK[EI:=EI+1]:=STACK[N]).[7:8];
	  ESTACK[EI:=EI+1]:=STACK[N+1];
	  IF I=STRINGID OR I=ARRAYID THEN ESTACK[EI:=EI+1]:=STACK[N+4] ELSE
	  IF I>=PROCID AND I<=INTPROCID THEN
	  IF STACK[N+4]<100 CLASSMAX
	  THEN ESTACK[EI:=EI+1]:=STACK[N+4]
	  ELSE BEGIN
	    ESTACK[EI:=EI+1]:=STACK[I:=STACK[N+4]];
	    DO ESTACK[EI:=EI+1]:=STACK[I:=I+1] UNTIL  STACK[I]=0;
	  END;
	END;
@O	% END OF EXTERNALS
	;
	IF STACK[T+1]:=P EQL 0	% DELINK NESTED INFO BLOCKS. ANY MORE?
	THEN		% NO => TAKE OUT OF HASH TABLE
	  IF SCRAMBLEDEGGS[J] = T
	  THEN SCRAMBLEDEGGS[J]:=STACK[T]
	  ELSE STACK[PT]:=STACK[T]
	END UNTIL T:=STACK[PT:=T] = 0
	UNTIL J:=*+1 GTR 63
	END;
PROCEDURE PROCDEC(X);	
	VALUE X;
	INTEGER X;
	BEGIN	
	BOOLEAN LOCALO,F,ETOG:=EXTERNALTOG;	
	LABEL L1,L2,L3; 
	INTEGER T,PINFO,PLIST,P,J,STACKCT,TPC;
	LOCALO:=LOCAL; LOCAL:=FALSE; STACKCT:=STACKCTR;
	STACKCTR:=LOCALSPACE;	
	IF FUNCTION AND LEVEL=1 THEN X:=-X; % SEPARATLEY COMPILED
	IF OWNTOG THEN FLAG(11);
	IF EXTERNALTOG AND FUNCTION THEN
		BEGIN FLAG(94); EXTERNALTOG:=FALSE END;
	STOPDEFINE:=TRUE;	% ALLOW NAME OF PROC NOT TO GET EXPANDED
	GETNEXT;		% GET NAME
	CREFIT("P",LEVEL,1);	% CREF DEFINITION
	REPLACE PS BY INSTR FOR LINSTR," " FOR 66-LINSTR;
	REPLACE TITLE2 BY PS FOR 64;
	IF CLASS GEQ PROCID AND % SEE IF FORWARD DECLARATION
		NOT EXTERNALTOG AND	% NOT GLOBAL
		STACK[INFO+2] = LEVEL AND % IN THIS LEVEL
		 CLASS LEQ INTPROCID AND ADDRESS < 0 THEN	
	BEGIN		% YES. DONT ENTER INTO THE SYMBOL TABLE
	  STACK[(PINF:=INFO)+1]:=- ADDRESS;% FIX ADDRESS (- ADDRESS ==> FORWARD DEC)
	  GETNEXT;		% SCAN THE NAME BECAUSE ENTRY WOULD DO IT
	  F:=TRUE;		% SET FORWARD TOG TO TRUE
	END
	ELSE BEGIN		% REGULAR DEC.
	  IF X < 0 THEN EXTERNALTOG:=TRUE;
	  CLASSF:=ABS(X);	% GET RIGHT CLASS
	  IF EXTERNALTOG THEN
	  CLASSF.[15:8]:=2 + REAL(X LSS 0);	% SET EXTERNAL TOG IN THE SYMBOL TABLE
	  X:=REAL(BOOLEAN(CLASSF) AND BOOLEAN(255));% GET OLD CLASS
	  ADDRESSF:=GETSPACE(1);	% GET PLACE FOR DESCRIPTOR IN PRT
	  ENTRY; PINF:=INF; I:=I + 2;% PUT IN THE SYMBOL TABLE
	END;
	T:=I;PROADDRESS:=STACK[PINF+1]; % SAVE	SYMOBOL TABLE POINTER AND PROC ADDRESS
	EXTERNALTOG:=FALSE;		% RESET EXTERNAL TOG
	J:=0;			% # OF PARAMS ENCOUNTERED THUS FAR
	PINFO:=PINF; % SAVE VALUE IN CASE OF RECURSION
	IF CLASS = LFTPAREN THEN	  % WE HAVE PARAMS
	BEGIN	
	  INTEGER C,D,SP,OLDCLASS,D1,DIMCODE,LBDIM1,LBDIM2;
	  BOOLEAN A,B,MINUS;
	  LABEL L1,L2,L3,EXIT;
	  LABEL S0,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,L6,S12A;
	  SWITCH SW:=S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12A;
	  LEVEL:=LEVEL + 1;		% ENTER PARAMS IN THE NEXT LEVEL
	  PLIST:=STACK[P:=PINF+4];	% POINT TO POINTER IN DATA BLOCK OF PROC NAME
	  CLASSF :=ADDRESSF:=0;
	  DO BEGIN	% ENTER NAME OF EACH PARAM INTO THE SYMBOL TABLE
	    STOPDEFINE:=TRUE;	% STOP EXPANSION OF NAMES
	    GETNEXT;		% GET ID
	    ENTRY;		% ADD TO SYMTABLE
	    STACK[STACK[P]:=P:=I:=I+5]:=0;	% LINK UP TO PREVIOUS PARAMETER
	    J:=J+1		% # OF PARAMS
	  END
	  UNTIL CLASS NEQ  COMMA OR J >= CLASSMAX;
	  LEVEL:=LEVEL - 1;		% DROP LEVEL BACK TO OUR LEVEL
	  TPC:=J;	% TRUE PARAMETER COUNT:=J FOR	STARTERS
			% ARRAY PARAMETERS WILL BUMP THIS
	  IF J >= CLASSMAX THEN ERROR(92) ELSE	% TOO MANY PARAMS
	  IF CLASS NEQ RTPAREN THEN FLAG(6) ELSE GETNEXT;	% NO ')'
	  IF CLASS NEQ SEMICOLON THEN FLAG(7) ELSE % NO ';' AFTER PARAM LIST
	  GETNEXT;		% SCAN THE ';'
	  IF CLASS = VALUEV	% VALUE DECLARATIONS?
	  THEN BEGIN		% YES
	    DO BEGIN		% SCAN THE ENTIRE VALUE LIST
	      GETNEXT;		% GET ID
	      IF CLASS NEQ 0 OR STACK[INFO+2] NEQ LEVEL+1  % IN PARAM LIST?
	      THEN FLAG(8)	% NO. ERROR
	      ELSE		% SET VALUE TOG.
		IF P:=STACK[INFO+3] GEQ 0	% SET YET ?
		THEN STACK[INFO+3]:=REAL(NOT BOOLEAN(P));  % SET IT
	      GETNEXT;		% SEE IF FOLLOWED BY A ','
	    END
	    UNTIL CLASS NEQ COMMA;
	    IF CLASS NEQ SEMICOLON
	    THEN ERROR(9)
	    ELSE
	      L1: GETNEXT;
	  END;
	  B:=FALSE;		% RESET NAME TOG
	  GO TO SW[CLASS-BEGINV];	% SEE WHAT KIND OF DECLARATIIN WE GOTS
	  GO TO L2;		% DONE 
S1:	  C:=BOOID; 	GO TO S0;
S2:	  C:=REALID;	GO TO S0;
S3:	  C:=INTID;
S0:	  GETNEXT;	% SEE IF PROC DECLARATION OR ARRAY DECLARATION
	  IF CLASS = PROCEDUREV 	% TYPED PROCEDURE PASSED THRU
	  THEN BEGIN
	    C:=PROCID+C-INTPROCID;
	    GO TO S12
	  END
	  ELSE		% NOW SEE IF TYPED ARRAY
	    IF CLASS EQL ARRAYV % YES
	    THEN BEGIN
	      OLDCLASS:=C;
	      C:=ARRAYID;
	      GO TO S12 	% MUST BE NAME
	    END;
	  A:=A OR C NEQ INTID;		% A INDICATED ALL PARAMS INTEGER
	  GO TO L6;
S4:	  IF INSTR[0] = "EX" THEN GO TO L2;	% EXTERNAL FOR PROC NOT PARMS => DONE HERE
	  FLAG(IF INSTR[0] = "OW" THEN 11 ELSE 12); % PARAMS CANNOT BE SAVE OR OWN
	  GO TO L1;		% TRY AGAIN
S5:	  % LABELS. NOT IMPLEMENTED YET%  C:=LABELID;	GO TO S13;
	  % LABELS CAN BE NAME OR VALUE
S6:	  % SWITCHES NOT IMPLEMENTED YET EITHER % C:=SWITCHID;GO S12;
	  % MUST BE NAME
S7:	  C:=ARRAYID;	% ARRAY'S
	  OLDCLASS:=INTID;	% DE-FALUT CLASS OF ARRAYS IS INTEGER
%%%%%%%   OLDCLASS:=REALID;	% DE-FAULT CLASS OF ARRAYS IS REAL
	  GO TO S12;	% MUST BE NAME ALSO
S8:	  GO TO L2;	% PARAMS CANNOT BE DEFINES => DONE
S9:	  C:=FILEID;	% FILES
	  GO TO S12;	% MUST BE NAME ALSO
S10:	  C:=PROCID;	% SO MUST PROC IDS
	  GO S12;
S12A:	  C:=TRUTHID;	% TRUTHSET PASSED IN
			% BETTER BE BY NAME
S12:	  B:=A:=TRUE;	% SET NAME TOG. RE-SET ALL VALUE INTEGER TOG.
	  GO L3;	% SCAN THE SPECIFICATION LIST
S11:	  C:=STRINGID;	% POINTERS CAN BE EITHER
S13:	  A:=TRUE;	% RE-SET INTEGER-VALUE TOG
L3:	  P:=0; 	% USED OCCATIONALLY FOR A LINK POINTER
	  DO BEGIN	% SCAN THE IDENTIFIER LIST
	    GETNEXT;	% GET IDENTIFIER IN SPECIFICATION LIST
L6:	    IF CLASS NEQ 0 OR STACK[INFO+2] NEQ LEVEL+1
	    % EITHER NOT FORMAL PARAMETER OR REDEFINED
	    THEN FLAG(3)
	    ELSE STACK[INFO]:=C;	% STORE SPECIFYCATION TYPE IN ID BLOCK
	    IF C=ARRAYID
	    THEN BEGIN
	      STACK[INFO+4]:=P; TPC:=TPC+1; P:=INFO;	% LINK THEM UP
	    END
	    ELSE
	      IF C GEQ PROCID AND C LEQ INTPROCID
	      THEN STACK[INFO+4]:=STACK[INFO+5]:=0;% NO PARAMS ON PROCS PASSED THRU
	    IF B AND STACK[INFO+3] < 0	% VALUED AND MUST BE NAME
	    THEN BEGIN	% UN-VALUE THEM
	      FLAG(10); STACK[INFO+3]:=-STACK[INFO+3]-1END;
	    SP:=SP+(IF STACK[INFO+3] < 0	% IF VALUE THEN REALS
		% GET 2 WORDS, POINTERS GET 3 (1 FOR LINK)
		    THEN REAL(C EQL REALID)+REAL(C EQL STRINGID)*2
		    ELSE 0) + 1;	% OTHER CALL BY VALUE GET 1
	    GETNEXT
	  END
	  UNTIL CLASS NEQ COMMA;
	  IF BOOLEAN(D1:=REAL(C EQL ARRAYID))	% UNLINK THE ARRAY ID'S
	  THEN BEGIN
	    LABEL L5;
	    IF CLASS NEQ LFTBRKT	% SHOULD BE A '['
	    THEN BEGIN
	      ERROR(15);		% '[' EXPECTED
	      GO L5
	    END
	    ELSE GETNEXT;
	    DIMCODE:=0;
	    IF CLASS NEQ FACTOP 	% BOTTOM NOT RE-DEFINED ?
	    THEN BEGIN
	      IF MINUS:=CLASS EQL SUBOP % NEGATIVE BOTTOM LIMIT
	      THEN GETNEXT;
	      IF CLASS NEQ ICONSTANT	% SHOULD BE INTEGER CONSTANT
	      THEN FLAG(38);
	      DIMCODE:=2;	% 1ST DIM RE-MAPPED
	      LBDIM1:=IF MINUS THEN -INREAL ELSE INREAL  % LOWER BOUND
	    END;
	    GETNEXT;		% SCAN TO NEXT THINGIE
	    IF CLASS EQL COMMA	% 2-DIM.
	    THEN BEGIN
	      D1:=2;		% SET 2 DIM INDICATOR
	      DIMCODE:=DIMCODE+1;% SET 2-DIM BIT
	      GETNEXT;		% SCAN THE COMMA
	      IF CLASS EQL FACTOP	% NO RE-MAP OF ROWS
	      THEN
	      ELSE BEGIN
		IF MINUS:=CLASS EQL SUBOP	% NEGATIVE LL
		THEN GETNEXT;
		IF CLASS NEQ ICONSTANT	% LOWER LIMIT NOT A CONSTANT
		THEN FLAG(38);
		DIMCODE:=DIMCODE+4;	% SET RE-MAP 2ND DIM BIT
		LBDIM2:=IF MINUS THEN -INREAL ELSE INREAL
		END;
	      GETNEXT			% SCAN THE 2ND DIM LB
	    END;
L5:	    DO BEGIN
	      STACK[P+7]:=LBDIM2;	% LOWER BOUND 2
	      STACK[P+6]:=LBDIM1;	% LOWER BOUND OF 1ST DIM
	      STACK[P+5]:=OLDCLASS;	% TYPE OF ARRAY
	      P:=STACK[4+D:=P]; 	% GET LINK
	      STACK[D+4]:=DIMCODE;	% STORE OUR CODE THERE
	      SP:=SP+D1 		% UPDATE STACK SPACE COUNTER
	    END			% 1 WORD FOR EACH DIMENSION
	    UNTIL P EQL 0;	% LOOP UNTIL DONE LINK LIST
	    IF CLASS NEQ RTBRKT THEN ERROR(17) ELSE GETNEXT;
	    IF CLASS = COMMA THEN GO TO L3;
	  END;
	  IF CLASS = SEMICOLON THEN GO TO L1;
	  ERROR(1);
L2:	  D:=SP+1; C:=0;% MAX ADDRESS OFFSET (PLUS 1)
	  IF F THEN	% CHECK PARAMETER COUNT
	    IF PLIST LSS CLASSMAX AND PLIST NEQ J OR
		PLIST GTR CLASSMAX AND STACK[PLIST+TPC+1] NEQ 0
	    THEN BEGIN
	      FLAG(25); % FORWARD REF DESAGREES WITH ACTUAL DECLARATION
	      F:=FALSE
	    END;
	  STACK[1+P:=PINF+4]:=SP;% # OF WORDS FOR PROC PARAMS
	  DO BEGIN		% ASSIGN ADDRESKIES TO EACH PARAM
	    STACK[(SP:=STACK[P]-8)+1]:=3"34002"+D:=D-1; % SET ADDRESS
	    IF D1:=STACK[SP] = 0  % ID NOT IN SPECIFYCATION LIST
	    THEN BEGIN
	      FLAG(83);
	      STACK[SP]:=INTID; % DEFAULT TO INTEGER
	    END
	    ELSE
	      IF STACK[SP+3] LSS 0	% VALUE
	      THEN			% SEE IF MULTI WORD PARAMS
		IF D1 EQL REALID OR B:=D1 EQL STRINGID
		THEN STACK[SP+1]:=3"34002"+D:=D-1-REAL(B)% FIX UP ADDRESS
		ELSE			% SEE IF ARRAYS
	      ELSE
		IF D1 EQL ARRAYID	% FIX ADDRESS AND LEAV ROOM
		THEN STACK[SP+1]:=3"34002"+D:=
			D-REAL(BOOLEAN(STACK[SP+4]) AND TRUE) - 1;
	% INVERT TOGGLE FROM VALUE TO NAME
	    IF STACK[SP+3]:=REAL(NOT BOOLEAN(STACK[SP+3])) < 0
	    THEN A:=TRUE;		% RESET ALL-VALUE TOG
	    IF F
	    THEN BEGIN		% CHECK SPECIFICATIONS WITH FORWARD
	      IF PLIST < CLASSMAX
	      THEN BEGIN	% INTEGER CALL BY VALUE
		IF STACK[SP] NEQ INTID
		THEN FLAG(26);		% SPECIFYCALION DISAGREES IN CLASS
		IF STACK[SP+3] < 0
		THEN FLAG(27);		% SPECIFYCATION DISAGREES IN REFERENCE
		END
	      ELSE BEGIN
		IF STACK[SP] NEQ STACK[PLIST+C:=C+1].[13:14]
		THEN FLAG(26);		% NOT BOTH SAME TYPE OF CALL
		IF STACK[SP+3].[15:1] NEQ STACK[PLIST+C].[15:1]
		THEN FLAG(27);		% DIFFERENT CLASS TYPES
		IF STACK[PLIST+C].[13:14] EQL ARRAYID
		THEN BEGIN
		  IF REAL(BOOLEAN(D1:=STACK[PLIST+C:=C+1]) AND BOOLEAN(255))
			NEQ STACK[SP+4] 	% DIFFERENT DECLARATIONS
		  THEN FLAG(110);	% # OF DIMS OR ROW DESIGNATION DIFFERENT
		  IF SHR(D1,8) NEQ STACK[SP+5]	% DIFFERENT TYPES OF ARRAYS
		  THEN FLAG(109);
		END;
		END;
	    END
	  END
	  UNTIL STACK[P:=STACK[P]] EQL 0;    % LOOP UNTIL LAST POINTER IS 0
	  IF NOT A		% IF ALL INTEGER AND VALUE THEN
	  THEN STACK[PINF+4]:=J;	% SUPER PACK LIST
EXIT:	END
	ELSE BEGIN
	  STACK[PINF+4]:=STACK[PINF+5]:=0;	% NO PARAMS
	  IF CLASS NEQ SEMICOLON
	  THEN FLAG(5); 
	  GETNEXT
	END;
@O	% EXTERNALS HAVE BEEN DEIMPLEMENTED FOR A WHILE.
	IF CLASS = EXTERNALV
	THEN BEGIN
	  INTEGER P1,P2;
	  STACK[PINF].[15:8]:=1;
	  EPROC:=TRUE;
	  IF ETOG THEN FLAG(14) ELSE
	  IF STACK[PINF+3] < 16000 THEN
	  STACK[PINF+3]:=STACK[PINF+3]+16000;
	  IF PRTTOG
	  THEN BEGIN
	    REPLACE LINEOUT BY "  ",O6(STACK[PINF+1]),"-X";
	    WRITEALINE(10)
	  END;
	  GETNEXT;
	  GO L3
	END;
@O
	IF CLASS = FORWARDV
	THEN BEGIN
	  STACK[PINF+1]:=- STACK[PINF+1];	% TOG ADDRESS => FORWARD DEC
	  GETNEXT;		% SEE IF FOLLOWED BY SEMI-COLON
L3:	  IF J = 0 THEN GO TO L2;	% NO PARAMS => DONT HAVE TO PURGE SYMTABLE
	  LEVEL:=LEVEL+1;		% LEVEL PARAMS ENTERED AT
	  PURGEIT; LEVEL:=LEVEL-1;	% BRING US BACK TO OUR OWN LEVEL
	  GO TO L2;	% DON'T CALL BLOK CAUSE NO BODY
	END;
	IF CLASS = BEGINV
	THEN BEGIN
	  BEGINCTR:=1+P:=BEGINCTR;	% FOR THE BENIFIT OF THE LISTING
	  GETNEXT;		% SCAN THE 'BEGIN'
	  BEGINCTR:=P;
	  BLOK(REAL(LOCAL:=TRUE))	% PROC WITH BLOCK
	END
	ELSE BLOK(2);		% PROC WITH STATEMENT
L2:	IF CLASS NEQ SEMICOLON
	THEN ERROR(42)	% ';' EXPECTED
	ELSE GETNEXT;	% SCAN THE ';'
	% RESTORE ALL THE ORIGIONAL UN-NESTED THINGS
	I:=T; LOCAL:=LOCALO; STACKCTR:=STACKCT;
	% COLASPE PLIST TABLE
	IF P:=STACK[PINFO+4] > CLASSMAX
	THEN BEGIN		% WE HAVE TABLE
	  T:=STACK[PINFO+4]:=I:=I+1;		% WHERE TO MARK TOP OF LIST
						% FOR ACTUALPARAPART
	  DO BEGIN
	    STACK[I:=I+1]:=(J:=STACK[P-8])+3"100000"*	% SAVE CLASS
		    REAL(STACK[P-5] <0);		% AND NAME TOG
	    IF J EQL ARRAYID		% SAVE INFO ON ARRAYS
	    % SAVE TYPE AND DIM INFO
	    THEN STACK[I:=I+1]:=SHL(STACK[P-3],8)+STACK[P-4];
	  END
	  UNTIL P:=STACK[P] = 0;
	  STACK[T]:=-1; 	% MARK TOP OF LIST
	  STACK[I:=I+1]:=0	% END OF LIST
	END
	END OF PROCEDURE DECLARATIONS;
%
% *** DECLARATION	HANDLES DECLARATIONS	
%	
PROCEDURE DECLARATION;	
	BEGIN	
	LABEL START,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,LF,LLS,EXIT; 
	LABEL LE,LSW COMMENT,LFD;;
	SWITCH SW:=L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12;	
START:	ERRORTOG:=TRUE;
	CLASSF:=REAL(EXTERNALTOG:=OWNTOG:=SAVETOG:=LONGTOG:=FALSE);
LSW:	GO TO SW [CLASS - BEGINV];	
@O
	IF CLASS = FIELDV THEN GO LFD;
@O
	GO EXIT;
L1:	CLASSF:=BOOID;	GO LF;
L2:	%	CLASSF:=REALID; GO LF;	% REALS TREATED AS INTEGERS FOR A WHILE
L3:	CLASSF:=INTID;	GO LF;	
L4:	IF LINSTR=8 THEN EXTERNALTOG:=TRUE ELSE 
	IF LINSTR EQL 3
	THEN OWNTOG:=TRUE
	ELSE
	  IF INSTR[0] EQL "SA"
	  THEN SAVETOG:=TRUE
	  ELSE LONGTOG:=TRUE;
	IF OWNTOG AND EXTERNALTOG THEN FLAG(14);
	GETNEXT;
	IF CLASS LSS BOOLEANV OR CLASS GTR TRUTHSETV THEN
		BEGIN ERROR(14); GO LLS; END;
	GO LSW;
L5:	CLASSF:=LABELID; STOPDEFINE:=TRUE; GETNEXT;	
	ADDRESSF:=10000; GO LE; 
L6:	SWITCHDEC;	GO LLS; 
L7:	ARRAYDEC;	GO LLS; 
L8:	DEFINEDEC;	GO LLS; 
L9:	FILEDEC;	GO LLS; 
L10:	PROCDEC(PROCID); GO START;
L11:	POINTERDEC;	GO LLS;
L12:	TRUTHSETDEC;	GO LLS;
@O
LFD:	FIELDDEC(CLASSF=BOOID); GO LLS;
@O
LF:	STOPDEFINE:=TRUE;
	GETNEXT;
	IF CLASS=PROCEDUREV
	THEN BEGIN
	  PROCDEC(CLASSF-3);
	  GO TO START;
	END;
	IF CLASS = ARRAYV THEN GO TO L7;
@O
	IF CLASS = FIELDV THEN GO TO LFD;
@O
LE:	ENTER;
%$ PROCEDUREV=32 REALPROCID=3
LLS:	IF CLASS NEQ SEMICOLON
	THEN ERROR(1)
	ELSE GETNEXT;			% SCAN THE ';'
	GO START;	
EXIT:	END;


PROCEDURE MOVECODE;	
BEGIN
	INTEGER FOO,BMTIB; LONG INTEGER ARRAY SIGH[0:255];
	IF ERRORCOUNT = 0 THEN
	BEGIN
	IF NOT NOCODEFILE
	THEN
%%%	IF WRITE(CODE[DA],REAL(BOOLEAN(L+CODERECWORDS1)
%%%			  AND NOT BOOLEAN(CODERECWORDS1))*2,EDOC)
%%%	THEN ERROR(122);
%%%	DA:=DA+(L+CODERECWORDS1)/CODERECWORDS
	BEGIN				%%%%% BMTIB
		FOO:=0;
		WHILE FOO LEQ L DO BEGIN
		FOR BMTIB:=0 STEP 1 UNTIL 255 DO SIGH[BMTIB]:=EDOC[FOO+BMTIB];
		FOO:=FOO+256;
		WRITE(CODE[DA],512,SIGH);
		DA:=*+1
		END
	END
	END
END;	
PROCEDURE BLOK(X);
	VALUE X;
	INTEGER X;
	BEGIN	
	LABEL L1,L2;
	INTEGER ARRAY SPC[0:32],TEDOC[0:2047];
	BOOLEAN B,SAVET,LOCALO;
	INTEGER STACKCT,LOLD,T,J,PRO,SGNOO,ADRSO,P,C,THISL:=WCL,
		THISWC:=WORKCELLCOUNT,POLISH,Z;
	OWN INTEGER BLOCKCTR;
	LOCALO:=LOCAL; ADRSO:=ADRS;
	ADRSR[LEVEL*2]:=IF X = 0 THEN ADRS ELSE 0;
	BEGINCTR:=BEGINCTR+REAL(X NEQ 2);
	CLASSF:=0;
	LOCAL:=LEVEL NEQ 0;		% BUILD DECLARATIONS IN THE STACK
	IF X>0 THEN
	  REPLACE SPC BY SPACEOUT FOR 33 WORDS ELSE
	  REPLACE SPC BY "B.",((BLOCKCTR:=*+1)-1) FOR
	    4 DECIMAL DIGITS," " FOR 60;
	SCAN SPC FOR Z:66 UNTIL EQL " ";
	IF B:=X GEQ 1 OR LEVEL = 0 THEN
	  ADRS:=PROADDRESS
	ELSE BEGIN
@O		% THIS IS A MISTAKE...?
	  LOLD:=L;		% SAVE CURRENT L
	  L:=WCL;		% TO GO BACK TO BUILD THE WORK-CELLS
	  IF WORKCELLCOUNT EQL 0  % NONE 
	  THEN EMITB(BRUN,L+2,L+2)
	  ELSE EMITPAIR(WORKCELLCOUNT-1,BPS);
	  L:=LOLD;		% BACK TO WHERE WE WERE
	  THISWC:=0;		% RE-INITIALIZE
@O
	  EMIT(MKS);
	  IF LEVELS[LEVEL] EQL 0
	  THEN BEGIN
	    REPLACE PS BY "MARKSTACK DESCRIPTOR FOR LEVEL",
		ZS(LEVEL,3-REAL(LEVEL<10))," " FOR 33+REAL(LEVEL<10);
	    LEVELS[LEVEL]:=GETSPACE(1)
	  END;
	  EMITO(LEVELS[LEVEL]);
	  EMITO(0);
	  EMITD(LEVELS[LEVEL]); EMIT(STD);
	  REPLACE PS BY SPC FOR 33 WORDS;
	  CLASSF:=PROCID;		% GET SPACE FOR A PROC
	  EMITD(ADRS:=GETSPACE(1));
	  EMIT(ENTR);
	  PROADDRESS:=0
	END;
	ERRORTOG:=TRUE; 
	IF SAVET:=SAVETOG
	THEN BEGIN
	  EMITD(ADRS);
	  EMIT(SAV)
	END;
	IF CLEAN NEQ 0 THEN	
	BEGIN LOLD:=BUMPL; CLEANIT; EMITB(BRUN,LOLD,L) END;	
	IF LEVEL:=LEVEL + 1 >	31 THEN FLAG(23);
	STACKCT:=STACKCTR; LOLD:=L;	SGNOO:=SGNO;	
	L:=0;	T:=I;	
	REPLACE LINEOUT BY " " FOR 56," is segment ",
	  O3(SGAVL)," <<<<<<<<";
	REPLACE LINEOUT BY " " FOR MAX(0,Z-10),
	  SPC FOR MIN(66-Z,56);
	WRITEALINE(80); 
	SGNO:=SEGNO[LEVEL]:=SGAVL; SGAVL:=SGAVL+1;	
	SWAP(TEDOC,EDOC);
	IF B
	THEN BEGIN
	  EMITL(LEVEL); 		% LEVEL OF PROCEDURE DECLARATION
	  IF LEVEL NEQ 1		% NOT MAIN BLOCK 
	  THEN
	    IF J:=STACK[PINF+4] GTR CLASSMAX	% PARAMS TOO 
	    THEN
	      DO			% SEE IF ANY ARE POINTER BY VALUE
		IF STACK[J-8] EQL STRINGID AND	% POINTER
		   STACK[J-5] GEQ 0		% BY VALUE
		THEN BEGIN
		  EMITL(0);		% OWNTOG IS FALSE
		  EMITD(STACK[J-7]+2);	% ADDRESS OF POINTER LINK
		  EMIT(PLNK)		% LINK 'EM UP
		END
	      UNTIL J:=STACK[J] EQL 0	% UNTIL LAST PARAMETER 
	END
	ELSE ADRSR[LEVEL*2-1]:=STACKCTR:=STACKCTR+2;
	WCL:=L; 	% SAVE WORK-CELL ALLOCATOR SPACE
	BUMPL;
	WORKCELLCOUNT:=0;
	IF X NEQ 2		% NOT A BLOCK
	THEN BEGIN
	  PRO:=PROADDRESS;	% SAVE PROGRAM ADDRESS FOR RECURSION
	  DECLARATION;		% SCAN THE DECLARATIONS
	  PROADDRESS:=PRO;	% UN RE-CURSE OURSELVES
	  BEGINCTR:=BEGINCTR-1; % BEGIN COUNTER WAS RAISED PRIOR TO OUR CALL
	  COMPOUNDTAIL		% COMPOUND TAIL WILL UP THE BEGIN COUNT
	END
	ELSE STMT;
	POLISH:=L;		% SAVE CURRENT PC
	L:=WCL; 		% GO BACK TO BUILD THE WORK-CELLS
	IF WORKCELLCOUNT EQL 0	% NONE 
	THEN EMITB(BRUN,L+2,L+2)
	ELSE EMITPAIR(WORKCELLCOUNT-1,BPS);
	WORKCELLCOUNT:=THISWC;	% UN STACK FROM PREVIOUS LEVEL
	WCL:=THISL;		% BOTH OF THESE
	L:=POLISH;		% BACK TO WHERE WE WERE
	IF LEVEL EQL 1		% MAIN BLOCK
	THEN EMITPAIR(5,COM)	% SYSTEM EXIT
	ELSE BEGIN
	  IF X EQL 0		% NOT A PROC
	  THEN BEGIN
	    EMITO(STACKCT+2);	% GET OLD MARK STACK FOR THIS LEVEL
	    EMITD(LEVELS[LEVEL-1]);	% AND RESET MARK STACK CONTROL WORD
	    EMIT(STD);
	    EMITL((LOLD+1)*2);	% ADDRESS GOING TO IN NEXT BLOCK
	    EMITD(ADRSO);	% ADDRESS OF LAST SEGMENT (OUTER BLOCK)
	    EMITL(0);		% INDICATE SUCH TO GO-TO-SOLVER
	    EMITPAIR(9,COM)	% RE-SET THE STACK
	  END;
	  EMIT(RTN)		% RETURN TO OUTER BLOCK
	END;
	CONSTANTCLEAN;		% CLEAN OUT ANY CONSTANTS
	PURGEIT;
	SATBLDR(ADRS,DA);	% PUT INFO FOR THIS BLOCK IN THE PRT TABLE
	MOVECODE;	
	REPLACE LINEOUT BY " " FOR 53,"(",O3(SGNO),") is ",
	  O4(L)," long <<<<<<<<";
	REPLACE LINEOUT BY " " FOR MAX(0,Z-13),
	  SPC FOR MIN(66-Z,53);
	WRITEALINE(80);
	SWAP(TEDOC,EDOC);
	IF L GTR MAXSEG THEN MAXSEG:=L;
	TOTSEG:=TOTSEG+L;
	VM:=VM+L;
	IF SAVETOG:=SAVET THEN SAVEIT:=SAVEIT+L;
	STACKCTR:=STACKCT; SGNO:=SGNOO; L:=LOLD;
	LOCAL:=LOCALO; ADRS:=ADRSO;
	IF SHR(MAXI,1) LSS SHR(I,1)
	THEN MAXI:=I;			% MAXIMUM DEPTH OF SYMTABLE
	I:=T;	% RESET STACK POINTER	
	LEVEL:=LEVEL - REAL(LEVEL GTR 0);
	END;	
BOOLEAN PROCEDURE FILENAMESCAN;
	BEGIN
	  TRUTHSET SEPARATORS("[,<=/" OR 0),
		   STOPPERS(",<=" OR 0),
		   PERIODS("." OR 0),
		   RIGHTBRACKETS("]" OR 0);
	  LABEL L1;
	  Q:=POINTER(STR);
L1:	  REPLACE Q:Q BY P:P UNTIL IN SEPARATORS;
	  IF P EQL "["
	  THEN BEGIN
	    REPLACE Q:Q BY P:P UNTIL IN RIGHTBRACKETS;
	    GO L1
	  END;
	  REPLACE Q BY 0 FOR 1;
	  IF P EQL "/"
	  THEN SCAN P:P+1 UNTIL IN STOPPERS;	% SCAN OUT OPTIONS 
	  IF FILENAMESCAN:=DELTA(STR,Q) <> 0
	  THEN BEGIN		% CHECK OUT THE EXTENSION PART
	    SCAN Q:STR UNTIL IN PERIODS;
	    EXTENSION:=Q EQL "."
	  END
	END;


INTEGER PROCEDURE OPTION;
	BEGIN
	  TRUTHSET STOPPERS(",:/<=" OR 0),
		   SLASHES("/" OR 0);
	  SCAN P:P UNTIL IN SLASHES;
	  IF P EQL "/"		% WE FOUND AN OPTION 
	  THEN BEGIN
	    OPTION:=REAL(P+1,1);% GET IT'S VALUE
	    SCAN P:P+1 UNTIL IN STOPPERS
	  END
	END;
%
%
%	ME THINKS THAT THIS IS WHERE IT ALL BEGINS......
%
%
%
%

	TRUTHSET SPACING(SPACES OR 0),
		 LEGALXREFTYPES("PVDLF");
	LABEL WRAPUP,MP,NADZ,TRYAGAIN,L1,L2,L3,GETTIME;
	BOOLEAN BMP,TOG;
	INTEGER T,R;
	REPLACE CSI BY "RSTS/E Algol Compiler - V",REVNO FOR 1,
	  ".",SHR(REVNO,8) FOR 1,"." UPDATE;
	WRITE(TTY[1],32,CSI);
TRYAGAIN:
	REPLACE CSI BY 3"12" FOR 1,"*";
	WRITE(TTY[0],2,CSI);
	IF READ(TTY,78,CSI) THEN GO NADZ;
	P:=Q:=POINTER(CSI);
	DO BEGIN	% TAKE SPACES AND TABS OUT OF COMMAND STRING
	  REPLACE P:P BY Q:Q UNTIL IN SPACING;
	  SCAN Q:Q+1 WHILE IN SPACES
	END
	UNTIL REAL(Q,1) EQL 0;
	REPLACE P BY 0 FOR 1;		% TO TERMINATE THE FILE-NAME SCANNER
					% SCAN FOR SWITCHES
	FORMOPTION:=NOT
		EIGHTYCOL:=PRTTOG:=EOPTION:=
		DEBUGTOG:=XREFOPT:=FALSE; % INIT THINGS
	P:=POINTER(CSI);	% SCAN OUT SWITCHES
	WHILE T:=OPTION > 0 DO
	BEGIN
	  INTEGER I;
	  LABEL SCREW, EXIT;
	  IF T<67 OR T>80 THEN GO SCREW;
	  CASE T-67 OF BEGIN
	    4-8: 10-12: GO SCREW;	% G-K, M-O
	    0: BEGIN XREFOPT:=TRUE;	% C
		 IF P NEQ ":" THEN REPLACE XREFTYPES BY "PL", 0 FOR 4 ELSE
		 BEGIN
		   I:=0;
		   DO BEGIN
		     P:=*+1; IF P IN LEGALXREFTYPES THEN
		     BEGIN IF I>6 THEN GO SCREW;
		       REPLACE POINTER(XREFTYPES)+I BY P FOR 1;
		       I:=*+1
		     END ELSE GO SCREW;
		     P:=*+1
		   END UNTIL P NEQ ":"
		 END
	       END;
	    1: DEBUGTOG:=PRTTOG:=TRUE;	% D
	    2: EOPTION:=TRUE;		% E
	    3: FORMOPTION:=FALSE;	% F
	    9: EIGHTYCOL:=TRUE;		% L
	   13: PRTTOG:=TRUE;		% P
	END;
	  GO EXIT;
	SCREW:
	  REPLACE STR BY "?Illegal switch";
	  WRITE(TTY,15,STR);
	  GO TRYAGAIN;
	EXIT:
	END;
	P:=POINTER(CSI);
	IF FILENAMESCAN
	THEN BEGIN
	  IF NOT EXTENSION		% ADD ON THE DEFAULT EXTENSION
	  THEN REPLACE Q BY ".ALC",0 FOR 1;
	  REPLACE CODE.TITLE BY POINTER(STR);
	  NOCODEFILE:=CODE.PRESENT:=FALSE	% ASSIGN TO NOCODEFILE IN CASE 2ND TIME AROUND
	END
	ELSE NOCODEFILE:=TRUE;
	IF P EQL ","
	THEN BEGIN
	  P:=*+1;
	  IF FILENAMESCAN
	  THEN BEGIN
	    IF NOT EXTENSION		% ADD ON DEFAULT EXTENSION OF ".LST"
	    THEN REPLACE Q BY ".LST",0 FOR 1;
	    REPLACE LINE.TITLE BY POINTER(STR);
	    NOLISTFILE:=FALSE;		% IN CASE HE BLEW CSI 1ST TIME
	    LINE.KIND:=VALUE(ASCII)
	  END
	  ELSE GO L1
	END
	ELSE BEGIN
	  L1: NOLISTFILE:=TRUE;
	  LINE.KIND:=VALUE(KB)
	END;
	IF P EQL "<" OR P EQL "="
	THEN BEGIN
	  P:=*+1;
	  IF FILENAMESCAN
	  THEN BEGIN
	    IF NOT EXTENSION
	    THEN BEGIN
	      REPLACE Q BY ".ALG",0 FOR 1;
	      REPLACE CARDIN.TITLE BY STR;
	      IF NOT CARDIN.PRESENT
	      THEN BEGIN
		REPLACE Q BY 0 FOR 1;
		GO L3
		END
	    END
	    ELSE BEGIN
	      L3: REPLACE CARDIN.TITLE BY STR;	% GET NAME
	      IF NOT CARDIN.PRESENT		% SEE IF ON DISK.
	      THEN BEGIN
		REPLACE STR BY "?Input file not found";
		WRITE(TTY,21,STR);
		GO TRYAGAIN
		END
	    END
	  END
	  ELSE GO L2
	END
	ELSE BEGIN
	  L2: REPLACE STR BY "?No input file";
	  WRITE(TTY,14,STR);
	  GO TRYAGAIN
	END;
GETTIME: FOR J:=0 STEP 1 UNTIL 5
	DO CTIME[J]:=TIME(J);
	IF TIME(0) NEQ CTIME[0] THEN GO GETTIME;
	IF EIGHTYCOL THEN LINE.MAXRECSIZE:=80
	  ELSE LINE.MAXRECSIZE:=132;
	IF EOPTION THEN NOHEADING:=TRUE ELSE DAYTIME;
	P:=CARD+72;
	PGCT:=SRCLINE:=1;
	FILL STACK[*] WITH 0,
	000,	IFV	, "2IF" 	, %  1
	167,	GOV	, "2GO" 	, %  5
	000,	WHILEV	, "5WHILE"	, %  9
	000,	DOV	, "2DO" 	, % 14
	000,	FORV	, "3FOR"	, % 18
	009,	WRITEV	, "5WRITE"	, % 22	(REDEFINABLE)
	126,	READV	, "4READ"	, % 27	(REDEFINABLE)
	161,	ELSEV	, "4ELSE"	, % 32
	000,	PURGEV	, "5PURGE"	, % 37	(REDEFINABLE)
	197,	HEXV	, "3HEX"	, % 42	(REDEFINABLE)
	000,	OCTALV	, "5OCTAL"	, % 46	(REDEFINABLE)
	218,	STEPV	, "4STEP"	, % 51
	051,	TOV	, "2TO" 	, % 56	(REDEFINABLE)
	144,	THENV	, "4THEN"	, % 60
	000,	ANDV	, "3AND"	, % 65	(REDEFINABLE)
	252,	ORV	, "2OR" 	, % 69	(REDEFINABLE)
	000,	NOTV	, "3NOT"	, % 73	(REDEFINABLE)
	106,	EQLOP	, "3EQL"	, % 77	(REDEFINABLE)
	073,	NEQOP	, "3NEQ"	, % 81	(REDEFINABLE)
	089,	LSSOP	, "3LSS"	, % 85	(REDEFINABLE)
	000,	LEQOP	, "3LEQ"	, % 89	(REDEFINABLE)
	097,	GEQOP	, "3GEQ"	, % 93	(REDEFINABLE)
	539,	GTROP	, "3GTR"	, % 97	(REDEFINABLE)
	000,	BEGINV	, "5BEGIN"	, %101
	227,	ENDV	, "3END"	, %106
	000,	UNTILV	, "5UNTIL"	, %110
	000,	LABELV	, "5LABEL"	, %115
	000,	BOOLEANV, "7BOOLEAN"	, %120
	000,	REALV	, "4REAL"	, %126
	000,	INTEGERV, "7INTEGER"	, %131
	000,	EXTERNALV,"8EXTERNAL"	, %137
	179,	SWITCHV , "6SWITCH"	, %144
	000,	ARRAYV	, "5ARRAY"	, %150
	018,	DECIMALV, "7DECIMAL"	, %155	(REDEFINABLE)
	000,	DEFINEV , "6DEFINE"	, %161
	000,	FILEV	, "4FILE"	, %167
	000,	PROCEDUREV,"9PROCEDURE" , %172
	000,	TRUTH	, "4TRUE"	, %179
	233,	FALSEV	, "5FALSE"	, %184
	369, 	INV	, "2IN" 	, %189	(REDEFINABLE)
	338,	BYV	, "2BY" 	, %193	(REDEFINABLE)
	000,	FORWARDV, "7FORWARD"	, %197
	005,	FILLV	, "4FILL"	, %203	(REDEFINABLE)
	000,	WITHV	, "4WITH"	, %208	(REDEFINABLE)
	000,	VALUEV	, "5VALUE"	, %213
	000,	SAVEV	, "4SAVE"	, %218
	000,	OWNV	, "3OWN"	, %223
	000,	COMMENTV, "7COMMENT"	, %227
	000,	FIELDV	, "5FIELD"	, %233
	523,	CASEV	, "4CASE"	, %238	(REDEFINABLE)
	247,	DIVV	, "3DIV"	, %243	(REDEFINABLE)
	120,	CLOSEV	, "5CLOSE"	, %247	(REDEFINABLE)
	000,	OFV	, "2OF" 	, %252	(REDEFINABLE)
	312,	LISTV	, "4LIST"	, %256
	256,	LOCKV	, "4LOCK"	, %261	(REDEFINABLE)
	060,	THRUV	, "4THRU"	, %266	(REDEFINABLE)
	000,	POINTERV, "7POINTER"	, %271
	000,	REPLACEV, "7REPLACE"	, %277	(REDEFINABLE)
	329,	RELEASEV, "7RELEASE"	, %283	(REDEFINABLE)
	293,	SHLV	, "3SHL"	, %289	(REDEFINABLE)
	172,	SHRV	, "3SHR"	, %293	(REDEFINABLE)
	266,	TIMEV	, "4TIME"	, %297	(REDEFINABLE)
	307,	SCANV	, "4SCAN"	, %302	(REDEFINABLE)
	056,	SIZEV	, "4SIZE"	, %307	(REDEFINABLE)
	000,	LONGV	, "4LONG"	, %312
	321,	MAXV	, "3MAX"	, %317	(REDEFINABLE)
	325,	MODV	, "3MOD"	, %321	(REDEFINABLE)
	115,	MINV	, "3MIN"	, %325	(REDEFINABLE)
	277,	SHIFTV	, "5SHIFT"	, %329	(REDEFINABLE)
	065,	ABSV	, "3ABS"	, %334	(REDEFINABLE)
	000,	ADDRV	, "4ADDR"	, %338	(REDEFINABLE)
	077,	DELTAV	, "5DELTA"	, %343	(REDEFINABLE)
	000,	POLISHV , "6POLISH"	, %348	(REDEFINABLE)
	376,	SIGNV	, "4SIGN"	, %354	(REDEFINABLE)
	243,	CHAINV	, "5CHAIN"	, %359	(REDEFINABLE)
	000,	ONESV	, "4ONES"	, %364	(REDEFINABLE)
	001,	FONEV	, "8FIRSTONE"	, %369	(REDEFINABLE)
	302,	SWAPV	, "4SWAP"	, %376	(REDEFINABLE)
	000,	TRUTHSETV,"8TRUTHSET"	, %381
	208,	WORDV	, "4WORD"	, %388	(REDEFINABLE)
	022,	WORDSV	, "5WORDS"	, %393	(REDEFINABLE)
	343,	DIGITV	, "5DIGIT"	, %398	(REDEFINABLE)
	439,	DIGITSV , "6DIGITS"	, %403	(REDEFINABLE)
	150,	487	, "5ALPHA"	, %409	(PRE-DEFINED TRUTHSET)	A-Z,0-9
	046,	475	, "7NUMERIC"	, %414	(PRE-DEFINED TRUTHSET)	0-9
	000,	511	, "7SPECIAL"	, %420	(PRE-DEFINED TRUTHSET)
	359,	463	, "9ALPHAONLY"	, %426	(PRE-DEFINED TRUTHSET)	A-Z
	271,	459	, "7PRTBASE"	, %433	(PRE-DEFINED INTEGER ID)
	032,	499	, "<ALPHANUMERIC",%439	(PRE-DEFINED TRUTHSET)	A-Z,0-9
	000,	454	, "6TOGGLE"	, %448	(PRE-DEFINED BOOLEAN ID)

		BOOPROCID,17,0,0,0	, %454	(DEFINITION OF TOGGLE)
		INTID,0,0,0		, %459	(DEFINITION OF PRTBASE)
		TRUTHID,18,0,0		, %463	ALPHAONLY
		    0,0,0,0		, %467
		    3"177776",3"3777"	, %471	(UPPER CASE)
		    3"177776",3"3777"	, %473	(LOWER CASE)
		TRUTHID,26,0,0		, %475	NUMERIC
		    0,0,0,3"1777",0,0,0,0,%479	(NUMBERS)
		TRUTHID,34,0,0		, %487	ALPHA
		    0,0,0,3"1777"	, %491	(NUMBERS)
		    3"177776",3"3777"	, %495	(UPPER CASE)
		    3"177776",3"3777"	, %497	(LOWER CASE)
		TRUTHID,34,0,0		, %499	ALPHANUMERIC
		    0,0,0,3"1777"	, %503	    DITTO AS ABOVE
		    3"177776",3"3777"	, %507
		    3"177776",3"3777"	, %509
		TRUTHID,42,0,0		, %511	SPECIAL
		    0,0,3"177776",3"176000",%515
		    1,3"174000",1,3"174000",%519
	014,	BINARYV , "6BINARY"	, %523	(REDEFINABLE)
	000,	ZEROSUPV, ">ZEROSUPPRESSED",%529(REDEFINABLE)
	184,	COMPILTIMEV,";COMPILETIME"; %539(REDEFINABLE)
		I:=546; 	% SYMBOL TABLE STACK POINTER
	FILL ATTRIBUTEDHASH[*] WITH	% CLASS (3,F) RESERVED WORDS
					% (CONTEXT SENSITIVE).
	004,	IOV	, "2IO" 	, %000
	008,	INV	, "2IN" 	, %004
	012,	OUTV	, "3OUT"	, %008
	017,	DISKV	, "4DISK"	, %012
	023,	TTYV	, "6REMOTE"	, %017
	028,	DISKV	, "5ASCII"	, %023
	034,	BINV	, "6BINARY"	, %028
	039,	KINDV	, "4KIND"	, %034
	046,	TEMPV	, "9TEMPORARY"	, %039
	052,	LPV	, "7PRINTER"	, %046
	056,	LPV	, "2LP" 	, %052
	062,	PRESENTV, "7PRESENT"	, %056
	067,	OPENV	, "4OPEN"	, %062
	072,	MYUSEV	, "5MYUSE"	, %067
	077,	TITLEV	, "5TITLE"	, %072
	084,	MAXSIZEV, "8MAXRECNO"	, %077
	093,	CURRECV , "<CURRENTRECNO",%084
	101,	MAXRECV , ":MAXRECSIZE" , %093
	105,	TTYV	, "3TTY"	, %101
	000,	TTYV	, "2KB" 	; %105
	% POINTER TO RESERVED WORDS FOR SPEEDER LOOK UP
	FILL SAUSAGE[*] WITH		% HASHING TABLE FOR RESERVED WORDS
	000,000,000,000,000,000,000,150,000,101,014,247,000,106,032,
	018,005,184,137,197,001,000,000,000,000,131,312,000,256,115,
	000,000,000,000,000,000,000,000,000,271,126,172,051,000,060,
	000,000,110,381,213,000,009,000,000,000,000,000,000,000,000,
	000,000,000,000;

	FILL SCRAMBLEDEGGS[*] WITH	% HASHING TABLE FOR REDEFINEABLES AND IDENTIFIERS
	000,000,529,000,000,334,193,409,000,101,238,426,000,398,403,
	155,203,093,137,042,189,000,000,000,000,131,312,085,261,317,
	000,081,069,223,364,414,000,037,348,433,027,289,354,283,297,
	420,448,110,381,213,388,393,000,000,000,000,000,000,000,000,
	000,000,000,000;

	FILL SPECIAL[*] WITH		% HASHING TABLE FOR SPECIAL CHARACTERS
	LFTBRKT, MULOP, RTBRKT, NOTV, ASSIGNOP, 0, ORV, QUOTEOP, POUND,
	0, 0, AMPER, 0, LFTPAREN, RTPAREN, FACTOP, ADDOP, COMMA, SUBOP,
	DOTOP, DIVOP, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,	
	COLON, SEMICOLON, LSSOP, EQLOP, GTROP, NOTV;
	FILL OP WITH
	"ADD AOC ASD ASN BRUNBRTRBRFLENTRCHSNCOMMDEL DIV DUP "
	"NEQ EQL GEQ LSS GTR LEQ LOADLOR AND MKS REP MUL NEG "
	"REL RTN SAVESBR SHL SHR STODSTONSUB XCH SCANMOD ADC "
	"FDI BSP SWAPEXP FID RSDNRSUP IN OCX LODBDIVTISOLISOD"
	"FINDONESFONEBL1DBL2DDUPLBLDAPLODPARTPSTNPSTDCMP PLNK";
	% MAKE IT SUCH THAT IF COMPILER FAILS USER
	% STILL CAN NOT EXECUTE CODE FILE
	FILL PRTA[*] WITH
	    0,0,1,0,0,0,-1,0,0,0,0,0,0,0,0,0,
	    0,		% I/O TOG
	    0,		% TOGGLE
	    0,0,0,0,3"177776",3"3777",3"177776",3"3777" , % ALPHAONLY
	    0,0,0,3"1777",0,0,0,0			, % NUMERIC
	    0,0,0,3"1777",3"177776",3"3777",3"177776",3"3777", % ALPHANUMERIC
	    0,0,3"177776",3"176000",1,3"174000",1,3"174000"	; % SPECIAL
	IF NOT NOCODEFILE
	THEN WRITE(CODE[0],14,PRTA[*]);
	PROADDRESS:=12; PRTMAX:=49; DA:=1;	SGAVL:=2;	
	STACKCTR:=LOCALSPACE;
	GETNEXT;
@O		% EXTERNALS NOT SUPPORTED IN THIS VERSION
	IF CLASS ^= BEGINV THEN
	BEGIN
	  LEVEL:=1;
	  ERRORTOG:=FUNCTION:=TRUE;
	  DECLARATION;
	  PURGEIT;	% FLUSH EXTERNALS
	END ELSE
@O
	BEGIN
	  SGAVL:=1;
	  WHILE CLASS NEQ BEGINV DO GETNEXT;
	  BEGINCTR:=1;	% FOR THE LISTING
	  GETNEXT;
	  BEGINCTR:=0;
	  BLOK(0);
	END;
	IF ERRORCOUNT NEQ 0 OR NOCODEFILE THEN
	BEGIN
	  J:=DA+ (PRTMAX:=PRTMAX+1) DIV CODERECWORDS;
	  GO WRAPUP;	% THIS ALSO FIXES CONSTANTCLEAN PROB
	END;
	T:=PRTMAX:=PRTMAX+1;
	WRITE(CODE[J:=DA],T*2,PRTA[*]);
	J:=J+(T+CODERECWORDS1) DIV CODERECWORDS;
	PRTA[0]:=DA; PRTA[1]:=PRTMAX;
	PRTA[7]:=PLL; PRTA[8]:=SGAVL-1;
@O		% EXTERNALS NOT SUPPORTED IN THIS VERSION
	IF EI>0 AND (FUNCTION ! EPROC) THEN % EXTERNAL TABLE
	BEGIN
	  PRTA[4]:=J+1; PRTA[5]:=T:=EI:=EI+1; R:=0;
	  WRITE(CODE[J:=J+1],CODERECSIZE,ESTACK[*]);
	  WHILE T > CODERECWORDS DO
	  BEGIN
	    R:=R + CODERECWORDS;
	    FOR I:=0 STEP 1 UNTIL CODERECWORDS1 DO ESTACK[I]:=ESTACK[I+R];
	    WRITE(CODE[J:=J+1],CODERECSIZE,ESTACK[*]);
	    T:=T - CODERECWORDS;
	  END;
	END;
@O
WRAPUP:
EOJ:
	PRTA[2]:=ERRORCOUNT; PRTA[3]:=REAL(LEVEL=1);
	PRTA[6]:=-1;
	IF NOT(EOPTION AND ERRORCOUNT EQL 0)
	THEN BEGIN		% FINISH UP NOW 
	  BOOLEAN B;
	  LABEL L;
	  EOPTION:=FALSE;
	  REPLACE LINEOUT BY ZS(ERRORCOUNT,1+REAL(ERRORCOUNT>9)+
	    REAL(ERRORCOUNT>99))," errors" FOR 6+REAL(ERRORCOUNT
	    NEQ 1)," detected.  ";
	  WRITE(TTY,19,LINEOUT);
	  IF LNCT>35 THEN LNCT:=100 ELSE WRITEALINE(0);
	  WRITEALINE(0);
	  WRITEALINE(19);
	  REPLACE LINEOUT BY "Number of segments =",ZS(SGAVL-1,4),
		". Disk size =",ZS((J+1) DIV 2,4)," blocks.";
	  WRITEALINE(49);
	  REPLACE LINEOUT BY "Symbol table required ",ZS(MAXI,5)," words."
		" PRT size = ",ZS(PRTMAX,4)," words.";
	  WRITEALINE(57);
	  % CALCULATE ELAPSED TIME
	  J:=TIME(2)*60+TIME(1);
	  TIME1:=CTIME[2]*60+CTIME[1];
	  IF J < TIME1
	  THEN J:=J+24*60;
	  IF J:=J-TIME1 LSS 10
	  THEN J:=(LINECOUNT*60)/(J*60+TIME(0)-CTIME[0])
	  ELSE J:=LINECOUNT/J;
	  REPLACE LINEOUT BY "Card images scanned =",ZS(LINECOUNT,5),
		" at",ZS(J,4)," cards/minute.";
	  WRITEALINE(47);
	  CTIME[2]:=TIME(2)-CTIME[2];
	  IF CTIME[2] LSS 0 THEN CTIME[2]:=*+24;
	  CTIME[1]:=TIME(1)-CTIME[1];
	  IF CTIME[1] LSS 0 THEN
	  BEGIN
	    CTIME[1]:=*+60;
	    CTIME[2]:=*-1
	  END;
	  CTIME[0]:=TIME(0)-CTIME[0];
	  IF CTIME[0] LSS 0 THEN
	  BEGIN
	    CTIME[0]:=*+60;
	    CTIME[1]:=*-1
	  END;
	  REPLACE LINEOUT BY "Elapsed time = ",ZS(CTIME[2],2), ":",
		CTIME[1] FOR 2 DIGITS, ":", CTIME[0] FOR 2 DIGITS, ".";
	  WRITEALINE(24);
	  REPLACE LINEOUT BY "Code segment size = ",ZS(TOTSEG,5)," words."
		" Largest segment size = ",ZS(MAXSEG,5)," words.";
	  WRITEALINE(68);
	  REPLACE LINEOUT BY "Virtual memory requirement =",ZS(VM,7),
		" words.";
	  WRITEALINE(42);
	  REPLACE LINEOUT BY "Estimated working set =",ZS(PRTA[9]:=
		((SGAVL-1) DIV 4*(TOTSEG DIV (SGAVL-1))+5\MAXDATA+
		SAVEIT+3"3000"+500+PRTMAX) DIV 1000,4),
		"K words.";
	  LNCT:=0;
	  WRITEALINE(35);
	  WRITEALINE(0);
	  REPLACE LINEOUT BY " " FOR 80;
	  REPLACE LINEOUT BY CSI UNTIL EQL 0;
	  WRITEALINE(80)
	END;
	PRTA[9]:=REVNO;
	IF NOT NOCODEFILE
	THEN WRITE(CODE[0],22,PRTA[*]);
NADZ:
END.