%$L-,C-,D-,T-,V:001200000214B\
program pascmp;
 include 'pasprm.pas';   (* set up tops10 and tops20 *)
  %*********************************************************
   *							   *
   *							   *
   *	 STEP-WISE DEVELOPMENT OF A PASCAL COMPILER	   *
   *	 ******************************************	   *
   *							   *
   *							   *
   *	 STEP 5:   SYNTAX ANALYSIS INCLUDING ERROR	   *
   *		   HANDLING; CHECKS BASED ON DECLARA-	   *
   *	 15/3/73   TIONS; ADDRESS AND CODE GENERATION	   *
   *		   FOR A HYPOTHETICAL STACK COMPUTER	   *
   *							   *
   *							   *
   *	 AUTHOR:   URS AMMANN				   *
   *		   FACHGRUPPE COMPUTERWISSENSCHAFTEN	   *
   *		   EIDG. TECHNISCHE HOCHSCHULE		   *
   *	   CH-8006 ZUERICH				   *
   *							   *
   *	 CODE GENERATION FOR DECSYSTEM 10 BY		   *
   *	 C.-O. GROSSE-LINDEMANN, F.-W. LORENZ,		   *
   *	 H.-H. NAGEL, P.J. STIRL			   *
   *							   *
   *	 MODIFICATIONS TO GENERATE RELOCATABLE OBJECT CODE *
   *	 BY E. KISICKI (DEC 74) 			   *
   *							   *
   *	 DEBUG SYSTEM BY P. PUTFARKEN (DEC 74)		   *
   *							   *
   *	 INSTITUT FUER INFORMATIK, D-2 HAMBURG 13,	   *
   *	 SCHLUETERSTRASSE 70 / GERMANY			   *
   *							   *
   *							   *
   *********************************************************\



  %	  HOW  TO  GENERATE  A	NEW  PASCAL  COMPILER

   SOURCES:
   A) ASCII:	  PASREL.PAS
		  RUNTIM.MAC
		  DEBSUP.MAC
		  DEBUG .PAS
   B) BINARY:	  PASREL.SHR
		  PASREL.LOW
		  PASLIB.REL (CHECK INITPROCEDURE "SEARCH LIBRARIES")

   !              IF THE NEW COMPILER SHOULD NOT BE MADE AVAILABLE FOR GENERAL USE ON SYS,
   !		  ENTER THE APPROPIATE DIRECTORY SPECIFICATIONS IN INITPROCEDURE "SEARCH LIBRARIES"


  STEP			  ACTION

  0	  SAVE ALL SOURCE FILES ON DECTAPES!!
  1	  .COPY PASLBN.REL=PASLIB.REL
  2	  IF THERE ARE NO CHANGES TO RUNTIM.MAC, DEBSUP.MAC, OR DEBUG.PAS
	  THEN GOTO STEP 9
  3	  UPDATE RUNTIM.MAC
  4	  ASSEMBLE   "		  -->	  RUNTIM.REL
  5	  UPDATE DEBSUP.MAC
  6	  ASSEMBLE   "		  -->	  DEBSUP.REL
  7	  UPDATE DEBUG.PAS
	  .RUN PASREL
	  *DEBUG.PAS		  -->	  DEBUG.REL
  8	  .R FUDGE2
	  *PASLBN.REL=PASLBN.REL<RUNSP>,RUNTIM.REL<RUNSP>(R)$
	  *PASLBN.REL=PASLBN.REL<DEBSP>,DEBSUP.REL<DEBSP>(R)$
	  *PASLBN.REL=PASLBN.REL<DEBUG>,DEBUG.REL<DEBUG>(R)$
	  *^C
				  -->	  PASLBN.REL
  9	  UPDATE PASREL.PAS
	  UPDATE "HEADER" IN PASREL.PAS
	  IF THERE ARE NEW ENTRIES TO RUNSP OR DEBSP
	  CHECK
	  INITPROCEDURE "RUNTIME-, DEBUG-SUPPORTS", "SUPPORTS"
	    AND
	  PROCEDURE "SUPPORT"
  10		.RUN PASREL
	      	*PASREL.PAS	      -->     PASREL.REL
  11      	.LOAD PASREL,/SEARCH PASLBN.REL
      		.SSAVE PASREL 36      -->     PASREL.SHR
      					      PASREL.LOW

			      36 K CORE ONLY IF NO RUNTIMECHECK (C-) AND NO DEBUG OPTION (D-) , OTHERWISE MORE !

  12      	.RENAME PAS1.PAS=PASREL.PAS
  13      	.RUN PASREL
      		*PAS1.PAS 	      -->     PAS1.REL
  14      	.LOAD PAS1,/SEARCH PASLBN.REL
      		.SSAVE PAS1 36	      -->     PAS1.SHR
      					      PAS1.LOW
  14.1    	.RENAME PAS2.PAS=PAS1.PAS
  14.2    	.RUN PAS1
      		*PAS2.PAS 	      -->      PAS2.REL
  14.3    	.LOAD PAS2,/SEARCH PASLBN.REL
      		.SSAVE PAS2 36	      -->      PAS2.SHR
      				      -->      PAS2.LOW
  15      	.R FILCOM
      		*TTY:=PAS2.LOW,PAS1.LOW
      		NO DIFFERENCES ENCOUNTERED
      		*TTY:=PAS2.SHR,PAS1.SHR
      		FILE 1) DSK:PAS2.SHR  CREATED: XXX
      		FILE 2) DSK:PAS1.SHR  CREATED: XXX
      		400005  604163 XXXXXX   604163 XXXXXX	     XXXXXX
      		%FILES ARE DIFFERENT

  16      	.DELETE PASREL.*,PAS1.*,PAS2.REL,PASLIB.REL
       		.PRINT PAS2.LST
       		.RENAME PASREL.*=PAS2.*
		.RENAME PASLIB.REL=PASLBN.REL


  *******************************************************************\

       %HINTS FOR INTERPRETING ABBREVIATED IDENTIFIERS
       BRACK  : BRACKET "[ ]"	       IX  : INDEX
       C  : CURRENT		       L  : LOCAL
       C  : COUNTER		       L  : LEFT
       CST  : CONSTANT		       PARENT  : "( )"
       CTP  : IDENTIFIER POINTER       P/PTR  : POINTER
       EL  : ELEMENT		       P/PROC  : PROCEDURE
       F  : FORMAL		       R  : RIGHT
       F  : FIRST		       S  : STRING
       F  : FILE		       SY  : SYMBOL
       F/FUNC  : FUNCTION	       V  : VARIABLE
       G  : GLOBAL		       V  : VALUE
       ID  : IDENTIFIER
       REL  : RELATIVE		       REL  : RELOCATION\

(*LOCAL CHANGE HISTORY
	1	CLEAN UP COMMENT SCANNING AND ALLOW /* */ BRACKETS.
		NOTE THAT THIS \ WOULD HAVE TERMINATED THIS COMMENT
		PRIOR TO FIX.
	2	INCREASE STACKANDHEAP, GET CORE IF NEEDED ON PROGRAM
		ENTRY, FIX PARAMETER PASSING BUG, LOAD PASREL FROM
		SYS: INSTEAD OF DSK:, GENERATE FLOAT AND FIX INLINE.
		(FROM HEDRICK)
	NB:	RUNTIM has now been modified to pass all characters,
		including control characters as well as lower case.
		It no longer turns tabs into spaces.  Thus it was
		necessary to put this file through a program that
		expanded tabs into spaces when they were in strings.
		Thus FILCOM with the old version should specify /S
		or lots of irrelevant differences will be found.
	3	MAP LOWER CASE TO UPPER EXCEPT IN STRINGS.  (DOESN'T
		SOLVE THE PROBLEM ABOUT SETS, THOUGH.)  HEDRICK.
	4	use SCAN for file spec's, and fix to be called by
		COMPIL.  Hedrick.
	5	add /CREF switch.  Hedrick.
	6	allow PROGRAM statement.  Syntax check but ignore it.
		fix bug that caused lower case char. after a string to put compiler in loop
		allow <> for #
		allow LABEL declaration.  Syntax check bug ignore it.
		with /CREF/OBJ put only 3 instructions per line (4
		  overflow a LPT line)
		use standard PACK and UNPACK
		catch illegal characters
	7	add /HEAP switch for size of stack and heap
		treat lower case as upper in sets
	10	Add STRSET and STRWRITE - equivalent to RESET and
		REWRITE, but sets I/O into string
		also GETINDEX, CLOSE, ROUND, CALLI
		ALSO REDID RESET/REWRITE TO TAKE GOOD FILE NAMES
	11	Modify compiler to use new RESET/REWRITE.
	12	Make PASCAL programs self-expanding
	13	ADD DDT SYMBOL NAMES FOR ROUTINES(BLOCK-STRUCTURED)
		use PROGRAM name as module and entry name
		allow strset/write on non-TEXT files
		add opt. 4th arg to strset/write: limit
	14	allow read of string - gets rest of line
				add rename,dismiss,update,dumpin/out,useti/o, and xblock arg to
		reset and friends
	15	a few more arg's to some runtimes
	16	detect unexpected EOF
	17	DECUS VERSION - CHANGE DDT SYMBOLS TO BE OK FOR DEC DDT
	20	CMU patch: do packed struct. correctly. Did not adopt:
		(1) replace CAMG, etc., for text (their fix did unnecessary work for
		  the most common cases, and didn't get all of the obscure ones)
		(2) use Knuth's defn of MOD (the one here is so much faster, who care about
		  negative numbers?)
		(3) clean up variants in NEW (they say it is unnecessary)
		Also: fix ill mem ref if undef var first after READ
	21	allow PROGRAM <name>; (i.e. no file list)
		allow null field list in record (for null variant, mainly)
		fix MOD.  Much cleaner fix than CMUs.  Usually adds just one instruction
		fix compare of PACKED ARRAY OF CHAR.  Get it all (I hope)
		keep new from storing tag if no id (CMU's fix)
		implement +,*,- as set operators
	22	restore MOD to be REM (Cyber does it that way)
		fix all my added file things to use GETFN to scan
		  file name, so we properly handle external files, etc.
		fix callnonstandard to pass external files
		fix writewriteln so doesn't ill mem ref on undef file
	23	change enterbody to always zero locals.  Needed to ensure
		  that certain comparisons work, but a good thing anyway.
		if typechecking is on, check for following nil or 0 pointer
	24	do not allow comparisons except those in manual.
		 means we don't have to zero locals on proc entry, ever.
		add LOC(<proc>) that returns address of proc or ftn
		add S:<integer> and H:<integer> comments, to set starting
		  addr of stack and heap respectively
		change starting code to not disturb %rndev, etc. on restart
	25	add /ZERO (and $z) to control whether locals initialized
		  to zero.  Useful mostly to help find uninit.'ed pointers.
	26	allow record as extended lookup block
		add error message's for ext. lookup block
		don't check file pointers as if they were pointers!
		use getfn instead of getfilename in break,breakin,
		  and close, to allow non-ascii files
	27	add NEWZ that does what NEW used to (zeros what it gets)
	30	fix NEW with : syntax, per Nagel.
	31	FIX ILL MEM REF IN READREADLN
		ADD ERR MSG FOR ASSIGN TO FTN NAME OUTSIDE BODY
	32	add APPEND
	33	full implementation of PROGRAM statement
		version numbering of output files and program
		allow proc and func as parameters
		remove LOC (subsumed by above)
		add $V directive for version number
	34	allow list of entry points in PROGRAM statement
	35	fix error recovery in BLOCK, especially for /NOMAIN
	36	ALLOW DEBUGGING MULTIPLE FILES
		remove T- option
		NB: I have not removed the variables for T-, and also
		  supports exist for indeb. and exdeb., though they
		  are no longer used in PASCMP.
	37	fix bug in static link for level one proc's
	40	use RESDEV as external name for DISMISS
		by default put request for PASLIB before FORLIB
		improve format of /OBJECT listing
		fix arg's to predefined functions
		fix comparison of unpacked strings
	41	make it restartable
		change kludge for file OUTPUT
	42	allow variable records for GET,PUT,and DUMPx
		Currently DUMPx implemented in kludgey way.
	43	add 5 locations to file block for new runtimes
		add PUTX
		add optional arg to useti
		allow 12 digit octal number
	44	Add SETPOS and CURPOS to compiler
	45	Add NEXTBLOCK to compiler and make check for
		AC overlap with APPEND,UPDATE
	46	Repair CALLI to use 1 for true, and accept all
		 possible argument formats.
	47	Add some more functions
		Repair calculations for NEW with packed arrays
	50	Generate correct code for 400000,,0
		Reinitialize file ctl blocks at start
		Don't open INPUT or OUTPUT unless asked
	51	Allow mismatch of byte size for SETSTRING
		Fix GETLINENR
	52	Fixes from CMU:
		To CALLNONSTANDARD: when depositing directly into
		  display, moved 2 ac's for all arg's of size 2,
		  without checking to see if VAR.  Assumed AC was
		  unchanged by BLT.
		To SIMPLEEXPRESSION: optimization sometimes negated
		  a real constant.  If had been declared by CONST,
		  future ref's were to the negated quantity!
	53	Problems with dynamic memory expansion:
		Arbitrarily asked for 40b more locations above
		  end of stack (for runtimes).  But some odd
		  procedure calls use more.  Need to figure out
		  how much memory is used.
		CORERR just allocated memory up to (P).  Should
		  be 40(P), or however much is really needed.
		So add STKOFFMAX, to keep track of how much
		  really needed.  CORALLOC is addr of the test for
		  sufficient memory, fixed up.
	54	More dynamic memory: Need to accumulate offsets
		  above top of stack, in case of
		  x(1,2,3,4,5,f(1,2,3,4,5,6)), etc., though an
		  actual problem seems a bit unlikely.
	55	Add require source file feature
	56	Clean up syntax for require file
	57	add tops20 version
	60	make tops20 strings work more like tops10
	61	add jsys pseudo-runtime
		add tops20 runtimes and restrict runtimes that work only on one system
		add +*@ after file name to control gtfjn in tops20
	62	make sure there is never data above the stack pointer
	63	convert time, runtime, setuwp for tops20
	64	input:/ for tops-20
		empty entry in record
		non-local goto's
		fix procedure param's if not in ac's
	65	allow extra semicolon in case
		remove references to exit labels
	66	speed up non-local goto's
	67	fix external proc's as proc param's
	70	fix ill mem ref if certain errors in type decl
	71	make file name in fcb be 7 bit for tops20
	72	make two fixup chains for 2 word constants, to
		prevent giving LINK an ill mem ref
	73	make new use getfn for file names, to get EXTERN files
	74	allow new init. so tops10 version can work with emulator
	75	fix non-loc goto's - typo made goto chain bad
	76	allow a set in reset/rewrite to specify bits.
		allow break char set in read/readln
	77	fix jsys and reset set arguments
	100	fix ac usage in readreadln from strings
        101	fix fltr and fix code generation
	102	Add klcpu - put improved packed array code under it
	103	Fix pointer to global symbol table in case that level
		has already been output by some inner procedure
	104	Check stack overflow
		Check to be sure structures aren't too big
		Range check subranges in for loop and value parameters
	105	Use tables instead of -40B to convert from lower case
	106	Make subranges of reals illegal
	107	Abort creation of .REL file on all errors
	110	Allow [x..y] set construct
	111	Allow STRING and POINTER parameters to EXTERN proc's
	112	Clrbfi when error detected.  Bounds check sets [a..b]
	113	Make real number reader handle exact things exactly
		Don't demand foward type ref's resolved at end of require file
	114	Write local fixups even if only non-loc gotos
		Make CREF not say .FIELDID. for local gotos
		maxint = 377777777777B
	115	Make tops10=false, kl=false work (tenex)
	116	IDRECSIZE entries for param, labelt type
		Make NEXT NIL instead of 0 when not used, for COPYCTP
	117	Fix enumerated type in record
	120	Make initialization routine use JSP, for T20/Tenex so
		don't have ill mem ref if emulator present
	121	Initialize CODEARRAY: fix bollixed INITPROC's
	122	KA's.  This includes fixing COPYSTP so it doesn't
		 try to follow NIL pointers.  Harmless if 377777 is a
		 legal address, but it isn't for KA's.
	123	Do POPF when can't find included file, so close gets done.
	124	Limit initprocedures to top level.
		Initialize CREF off
	125	Do POPF when expected eof inside included file.
	126	Detect procedures not beginning with BEGIN
	127	INit CREF to FALSE, fix [const..var] set construct
	130	Fix KA bug wherein random word in core image is garbage
	131	Move cixmax to pasprm.pas so tops20 can use big value
	132	Replace KA10 with KACPU for op codes and NOVM for old
		memory allocation.
	133	Fix JSYS to allow functions within it.  Garbaged stack.
	134	Allow DELETE in Tops-10, too.
	135	Fix LOG2 for big numbers.  Prevent ill mem ref's in
		PACK and UNPACK with syntax errors.
	136	Add header line at top of each page with pg. number
	137	Reset line no. to 1 at start of page.
		Fix bug in set constructors for CHAR
	140	Chnage order of SETMAP to closer to ASCII collating seq.
	141	Fix problem where REGC gets messed up by array subscript
		 calculations when ONFIXEDREGC is in effect.
		Detect overflow in number scanning with JFCL.
	142	Make real number scanner scan anything legitimate
	143	Redo I/O to string in Tops-10 for new runtimes and fix
		 onfixedregc code for packed arrays
	144	Allow :/ in program and :@ in reset for Tops-10
	145	Change external name of GET to GET. for Wharton
	146	Reinit count in putrelcode to avoid garbage in .REL file
	147	Lines start with 2 on new pages.
	150	Fix bug in forward type references,
		error recovery in fieldlist if garbage case type
		symbol table in forward proc's for debugger
	151	Fix reversed args in I,J:INTEGER in procedure decl.
	152	Add DISPOSE
	153	Fix some reg usage problems with DISPOSE
	154	More reg usage problems with DISPOSE
	155	Source file name in DEBUG block
	156	Detect FTNNAME^.field := value.  Only bare ftn name
		allowed on LHS of assignment.
	157	Add $A- to turn off arith check
	160	Add compiler switch /ARITHCHECK
	161	fix STRINg and POINTER
	162	fix REGSIZE
	163	fix TIME for Tops-20
	164	use Polish fixups in CASE
	165	in type decl, make sure ^THING gets local defn of THING,
		even if it happens later and there is a higher level defn.
		(This requires treating ^THING as forward always.)
	166	make assignment to func id from inner func work
		initialize frecvar in fieldlist, to prevent ill mem ref
		  with null record decl.
	167	improvements to edit 165
	170	more improvements to 165 (this time to error handling)
	171	allow read into packed objects
		allow read and write of binary files
		make sure default file names don't use user-declared INPUT,
		   and OUTPUT
		fix NEW of pointer that is part of packed array
	172	option string as third arg of RESET, etc.
		evaluate upper bound of FOR statement only once
	173	allow files in any context; internal files
	174	fix to initprocedures from Hisgen
	175	make getfn take a param telling runtime validity check
		needed.  SETSTRING, etc., do not
	176	better unterminated-comment error messages
	177	fix AC allocation in GETFILENAME
	200	fix addressing problem in loading file pointers
	201	make most manipulation of zero size objects be no-op.
		Previously one might stomp on the next variable.
	202	insufficient initialization before RESET(TTY), etc.
		fix POINTER passed by ref
	203	fix glitch in edit 202
	204	don't validity check the FCB for CLOSE, RCLOSE, and DISMISS
	205	fix AC in RENAME
	206	allow constants in WRITE statements for FILE OF INTEGER, etc.
	207	fix AC in GETFILENAME (again...)
	210	Allow 9 digit HEX numbers
	211	Fix output of string constants in .REL file
	212	Better error message if INPUT or OUTPUT redefined
	213	Fix procedure exit code if there is local variable
	214	Make debugger see locals of forward declared proc's
*)

    CONST
      HEADER = 'PASCAL %12(214)';

      DISPLIMIT = 20; MAXLEVEL = 8;
      STRGLGTH = 120; BITMAX = 36;
(* 43 - longer file block for new runtimes *)
      SIZEOFFILEBLOCK=43B ;  {plus size of component}
      OFFSET=40B;	%FUER SETVERARBEITUNG DER ASCIICHARACTER\
      CHCNTMAX = 132;	%MAXIMUM OF CHARACTERS IN ONE LINE\
      LEFT = 2;RIGHT = 1;BOTH = 3;NO = 0;

      %KONSTANTEN VON BODY: \
      %*********************\

(* move cixmax to param file *)
      HWCSTMAX = 377777B;		  LABMAX = 20;
(* 2 - increase default stack space *)
(* 7 - stackandheap now set by switch *)
(* 137 - fix set constructor for CHAR *)
      MAXERR = 4;		  BASEMAX = 71;		CHARMAX = 177B;

      %ADDRESSES:
       **********\

      HAC=0;		%HILFSREGISTER\
      TAC=1;		%HILFSREGISTER AUCH FUER BYTEPOINTER\
      REGIN=1;		%INITIALISE REGC\
      PARREGCMAX=6;	%HIGHEST REGISTER USED FOR PARAMETERS\
      WITHIN=12;	%FIRST REGISTER FOR WITHSTACK\
      NEWREG=13;	%LAST PLACE OF NEW-STACK\
      BASIS=14; 	%BASIS ADDRESS STACK\
      TOPP=15;		%FIRST FREE PLACE IN DATASTACK\
      PROGRST = 145B;	%LOC 140B..144B RESERVED FOR DEBUG-PROGR.\
      HIGHSTART=400000B;
      MAXADDR=777777B;





    TYPE
      %DESCRIBING:\
      %***********\


      %BASIC SYMBOLS\
      %*************\

      SYMBOL = (IDENT,INTCONST,REALCONST,STRINGCONST,NOTSY,MULOP,ADDOP,RELOP,
		LPARENT,RPARENT,LBRACK,RBRACK,COMMA,SEMICOLON,PERIOD,ARROW,
		COLON,BECOMES,LABELSY,CONSTSY,TYPESY,VARSY,VALUESY,FUNCTIONSY,
(* 6 - add PROGRAM statement *)
(* 56 - ADD INCLUDE *)
		PROCEDURESY,SETSY,PACKEDSY,ARRAYSY,RECORDSY,FILESY,FORWARDSY,PROGRAMSY,INCLUDESY,
		BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY,LOOPSY,
		GOTOSY,EXITSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY,
		EXTERNSY,PASCALSY,FORTRANSY,ALGOLSY,COBOLSY,
		THENSY,OTHERSY,INITPROCSY,OTHERSSY);

      OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,GEOP,GTOP,
		  NEOP,EQOP,INOP,NOOP);

      SETOFSYS = SET OF SYMBOL;

(* 23 - check for bad pointer *)
(* 24 - ONLY CLEAR NEW WHEN TYPECHECKING *)
(* 104 - new tops10 stackoverflow *)
(* 152 - DISPOSE *)
      SUPPORTS = (FIRSTSUPPORT,STACKOVERFLOW,DEBSTACK,BADPOINT,ALLOCATE,CLEARALLOC,DEALLOCATE,
(* 173 - internal files *)
		  WITHFILEDEALLOCATE,
(* 43 - add PUTX *)
(* 64 - non-loc goto *)
		  EXITGOTO,EXITPROGRAM,GETLINE,GETFILE,PUTLINE,PUTFILE,PUTXFILE,
(* 57 - Add strset and strwrite external routines *)
		  RESETFILE,REWRITEFILE,RESETSTRING,REWRITESTRING,GETCHARACTER,PUTPAGE,ERRORINASSIGNMENT,
(* 173 - internal files *)
		  FILEUNINITIALIZED,INITFILEBLOCK,
		  WRITEPACKEDSTRING,WRITESTRING,WRITEBOOLEAN,READCHARACTER,READINTEGER,READREAL,
(* 171 - RECORD READ/WRITE *)
(* 206 - extend for constants *)
		  READRECORD,WRITERECORD,WRITESCALAR,
		  BREAKOUTPUT,OPENTTY,INITIALIZEDEBUG,ENTERDEBUG,INDEXERROR,WRITEOCTAL,WRITEINTEGER,WRITEREAL,
(* 10 add CLOSE *)
		  WRITEHEXADECIMAL,WRITECHARACTER,CONVERTINTEGERTOREAL,
(* 14 and lots more *)
(* 33 - PROGRAM statement *)
		  CONVERTREALTOINTEGER,CLOSEFILE,READSTRING,READPACKEDSTRING,READFILENAME,
		  NAMEFILE,DISFILE,UPFILE,APFILE,READDUMP,WRITEDUMP,SETIN,SETOUT,BREAKINPUT,
(* 74 - tops20 routines *)
		  SETPOSF,CURPOSF,NEXTBLOCKF,SPACELEFTF,GETXF,DELFILE,RELFILE,INITMEM,INITFILES,
(* 163 - tops20 TIME function *)
		  GETDAYTIME,LASTSUPPORT);

      %CONSTANTS\
      %*********\

      CSTCLASS = (INT,REEL,PSET,STRD,STRG);
      CSP = ^ CONSTNT;
(* 55 - add require files *)
      STRGARR = PACKED ARRAY[1..STRGLGTH] OF CHAR;
      CONSTNT = RECORD
		  SELFCSP: CSP; NOCODE: BOOLEAN;
		  CASE CCLASS: CSTCLASS OF
		       INT : (INTVAL: INTEGER; INTVAL1:INTEGER %TO ACCESS SECOND WORD OF PVAL\ );
		       REEL: (RVAL: REAL);
		       PSET: (PVAL: SET OF 0..71);
		       STRD,
		       STRG: (SLGTH: 0..STRGLGTH;
			      SVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR)
		END;

      VALU = RECORD
	       CASE BOOLEAN OF
		    TRUE:   (IVAL: INTEGER);
		    FALSE:  (VALP: CSP)
	     END;

      %DATA STRUCTURES\
      %***************\

      LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR; INSTRANGE = 0..677B ;
      RADIXRANGE = 0..37777777777B; FLAGRANGE = 0..17B;
      BITRANGE = 0..BITMAX; ACRANGE = 0..15; IBRANGE = 0..1; CODERANGE = 0..CIXMAX ;
(* 173 - internal files *)
      BITS5 = 0..37B; BITS6 = 0..77B;  BITS7 = 0..177B;
      STRUCTFORM = (SCALAR,SUBRANGE,POINTER,POWER,ARRAYS,RECORDS,FILES,TAGFWITHID,TAGFWITHOUTID,VARIANT);
      DECLKIND = (STANDARD,DECLARED);
      STP = ^ STRUCTURE; CTP = ^ IDENTIFIER; BTP = ^BYTEPOINT;
      FTP = ^FILBLCK;
      GTP = ^GLOBPTR ;

      STRUCTURE = PACKED RECORD
			   SELFSTP: STP; SIZE: ADDRRANGE;
			   NOCODE: BOOLEAN; BITSIZE: BITRANGE;
(* 173 - internal files *)
			   HASFILE: BOOLEAN;
			   CASE FORM: STRUCTFORM OF
				SCALAR:   (CASE SCALKIND: DECLKIND OF
						DECLARED: (DB0: BITS5; FCONST: CTP));
				SUBRANGE: (DB1: BITS6; RANGETYPE: STP; MIN,MAX: VALU);
				POINTER:  (DB2: BITS6; ELTYPE: STP);
				POWER:	  (DB3: BITS6; ELSET: STP);
				ARRAYS:   (ARRAYPF: BOOLEAN; DB4: BITS5; ARRAYBPADDR: ADDRRANGE;
					   AELTYPE,INXTYPE: STP);
				RECORDS:  (RECORDPF: BOOLEAN; DB5: BITS5;
					   FSTFLD: CTP; RECVAR: STP);
				FILES:	  (DB6: BITS5; FILEPF: BOOLEAN;FILTYPE: STP);
				TAGFWITHID,
				TAGFWITHOUTID: (DB7: BITS6; FSTVAR: STP;
						CASE BOOLEAN OF
						TRUE : (TAGFIELDP: CTP);
						FALSE  : (TAGFIELDTYPE: STP));
				VARIANT:  (DB9: BITS6; NXTVAR,SUBVAR: STP; FIRSTFIELD: CTP; VARVAL: VALU; QXLYPRTWRR: BOOLEAN)
			 END;

      BPOINTER = PACKED RECORD
			  SBITS,PBITS: BITRANGE;
			  IBIT,DUMMYBIT: IBRANGE;
			  IREG: ACRANGE;
			  RELADDR: ADDRRANGE
			END;

      BPKIND = (RECORDD,ARRAYY);

      BYTEPOINT = PACKED RECORD
			   BYTE: BPOINTER;
			   LAST   :BTP;
			   CASE BKIND:BPKIND OF
				RECORDD: (FIELDCP: CTP);
				ARRAYY : (ARRAYSP: STP)
			 END;
      GLOBPTR = RECORD
		  NEXTGLOBPTR: GTP ;
		  FIRSTGLOB,
		  LASTGLOB   : ADDRRANGE ;
		  FCIX	     : CODERANGE
		END ;

      FILBLCK = PACKED RECORD
			 NEXTFTP : FTP ;
			 FILEIDENT : CTP
		       END ;

      %NAMES\
      %*****\

(* 64 - non-loc goto *)
(* 111 - STRING, POINTER *)
	(* PARAMS is a special kind of TYPES.  It is used only for
	   predeclared identifiers describing kludgey types that are
	   valid only in procedure parameter lists. *)
      IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC,LABELT,PARAMS);
      SETOFIDS = SET OF IDCLASS;
      IDKIND = (ACTUAL,FORMAL);
      PACKKIND = (NOTPACK,PACKK,HWORDR,HWORDL);
      CHARWORD = PACKED ARRAY [1..5] OF CHAR;
      %ALFA = PACKED ARRAY [1..ALFALENG] OF CHAR;\

      IDENTIFIER = PACKED RECORD
			    NAME: ALFA;
			    LLINK, RLINK: CTP;
			    IDTYPE: STP; NEXT: CTP;
			    SELFCTP: CTP; NOCODE: BOOLEAN;
			    CASE KLASS: IDCLASS OF
				 KONST: (VALUES: VALU);
				 VARS:	(VKIND: IDKIND; VLEV: LEVRANGE;
					 CHANNEL: ACRANGE; VDUMMY: 0..31; VADDR: ADDRRANGE);
				 FIELD: (PACKF: PACKKIND; FDUMMY: 0..7777B;
					 FLDADDR: ADDRRANGE);
				 %IF PACKF=PACKK THEN FLDADDR CONTAINS THE
				  ABSOLUTE ADDRESS OF THE CORRESPONDING BYTEPOINTER
				  -----> ENTERBODY\
				 PROC,
				 FUNC:	(PFCHAIN: CTP; CASE PFDECKIND: DECLKIND OF
							    STANDARD: (KEY: 1..44);
							    DECLARED: (PFLEV: LEVRANGE; PFADDR: ADDRRANGE;
								       CASE PFKIND: IDKIND OF
									    ACTUAL: (FORWDECL: BOOLEAN; TESTFWDPTR: CTP;
										     EXTERNDECL: BOOLEAN; LANGUAGE: SYMBOL;
										     EXTERNALNAME: ALFA;
										     LINKCHAIN: PACKED ARRAY[LEVRANGE] OF ADDRRANGE;
(* 62 - clean of stack offsets *)
										     POFFSET:ADDRRANGE)));
(* 66 - non-local goto's *)
			         LABELT: (SCOPE:LEVRANGE;NONLOCGOTO:BOOLEAN;
					  GOTOCHAIN:ADDRRANGE;LABELADDRESS:ADDRRANGE)
			  END;


      DISPRANGE = 0..DISPLIMIT;
      WHERE = (BLCK,CREC);
(* 61 - new type to separate tops10 and tops20 ftns *)
      machine = (okname,t10name,t20name);

      %RELOCATION\
      %**********\

      RELBYTE = 0..3B %(NO,RIGHT,LEFT,BOTH)\;

      RELWORD = PACKED ARRAY[0..17] OF RELBYTE;

      %EXPRESSIONS\
      %***********\

      ATTRKIND = (CST,VARBL,EXPR);

      ATTR = RECORD
	       TYPTR: STP;
	       CASE KIND: ATTRKIND OF
		    CST:   (CVAL: VALU);
		    VARBL: (PACKFG: PACKKIND; INDEXR: ACRANGE; INDBIT: IBRANGE;
			    VLEVEL: LEVRANGE; BPADDR,DPLMT: ADDRRANGE; VRELBYTE: RELBYTE; SUBKIND: STP);
		    EXPR:  (REG:ACRANGE)
	     END;

      TESTP = ^ TESTPOINTER;
      TESTPOINTER = PACKED RECORD
			     ELT1,ELT2: STP;
			     LASTTESTP: TESTP
			   END;

(* 65 - remove exit labels *)

      %TYPES FROM BODY \
      %****************\

(* 13 - ADD WRITEBLOCK FOR DDT SYMBOLS *)
      WRITEFORM = (WRITEENTRY,WRITENAME,WRITEHISEG,WRITEGLOBALS,WRITECODE,WRITEINTERNALS,
(* 164 - add Polish fixups *)
		   WRITEPOLISH,WRITELIBRARY,
(* 173 - remove writefileblock *)
		   WRITESYMBOLS,WRITEBLK,WRITESTART,WRITEEND);

      UPDATEFORM = (C,D);
      ETP = ^ ERRORUPDATE;
      ERRORUPDATE = PACKED RECORD
			     NUMBER: INTEGER;
			     NEXT: ETP;
			     CASE FORM: UPDATEFORM OF
				  C:  (STRING: ALFA);
				  D: (INTVAL: INTEGER)
			   END;

      KSP = ^ KONSTREC;
      KONSTREC = PACKED RECORD
(* 72 - two fixup chains for 2 word consts *)
			  ADDR, ADDR1, KADDR: ADDRRANGE;
			  CONSTPTR: CSP;
			  NEXTKONST: KSP
			END;
(* 164 - Polish fixups for CASE *)
      POLPT = ^ POLREC;
{This record indicates a Polish fixup to be done at address WHERE in
 the code.  The RH of WHERE is to get the BASE (assumed relocatable),
 adjusted by OFFSET (a constant).  This is needed because the loader
 assumes that any address < 400000B is in the lowseg.  So to get the
 virtual start of the CASE statement branch table we need to use
 this to adjust the physical start of the table by the first case
 index}
      POLREC = PACKED RECORD
			  WHERE: ADDRRANGE;
			  BASE:  ADDRRANGE;
			  OFFSET: INTEGER;
			  NEXTPOL: POLPT
			END;

      PDP10INSTR = PACKED RECORD
			    INSTR   : INSTRANGE ;
			    AC	    : ACRANGE;
			    INDBIT  : IBRANGE;
			    INXREG  : ACRANGE;
			    ADDRESS : ADDRRANGE
			  END ;

      HALFS = PACKED RECORD
		       LEFTHALF: ADDRRANGE;
		       RIGHTHALF: ADDRRANGE
		     END;

      PAGEELEM = PACKED RECORD
			  WORD1: PDP10INSTR;
			  LHALF: ADDRRANGE; RHALF: ADDRRANGE
			END;
      DEBENTRY = RECORD
(* 36 - ALLOW MULTIPLE MODULES *)
		   NEXTDEB: INTEGER;  %WILL BE PTR TO NEXT ENTRY\
		   LASTPAGEELEM: PAGEELEM;
(* 103 - fix global id tree *)
		   GLOBALIDTREE: CTP;
		   STANDARDIDTREE: CTP;
		   INTPOINT:  STP;
		   REALPOINT: STP;
		   CHARPOINT: STP;
		   MODNAME: ALFA;
(* 155 - add source information *)
		   SOURCE: PACKED ARRAY[1..167]OF CHAR;
		 END;

(* 4 - add data structure for SCAN to return *)
(* 11 - modify structure and add type for the REL file *)
INTFILE = FILE OF INTEGER;
RPGDATA = RECORD
(* 7 - add /HEAP switch *)
	RELNAME:ALFA;
(* 24 - allow user to set first loc of stack and heap *)
	STACKVAL:INTEGER;
	HEAPVAL:INTEGER;
(* 33 - version no. *)
	VERVAL:INTEGER;
(* 25 - add /ZERO *)
(* 160 - add /ARITHCHECK *)
	ASW,ZSW,LSW,TSW,MSW,CSW,DSW,CRSW,RPGSW:BOOLEAN
	END;
RPGPT = ^ RPGDATA;
(* 33 - PROGRAM statement *)
(* 61 - allow +* in tops20 *)
PROGFILE = PACKED RECORD
	FILID:ALFA;
	NEXT:^PROGFILE;
(* 64 - INPUT:/ *)
	wild,newgen,oldfile,interact,seeeol:Boolean
	END;
(* 157 - See if we need INITTTY *)
PROGFILEPT = ^ PROGFILE;

      %------------------------------------------------------------------------------\


    VAR
      %RETURNED BY SOURCE PROGRAM SCANNER INSYMBOL:\
      %********************************************\

      SY: SYMBOL;		      %LAST SYMBOL\
      OP: OPERATOR;		      %CLASSIFICATION OF LAST SYMBOL\
      VAL: VALU;		      %VALUE OF LAST CONSTANT\
      LGTH: INTEGER;		      %LENGTH OF LAST STRING CONSTANT\
      ID: ALFA; 		      %LAST IDENTIFIER (POSSIBLY TRUNCATED)\
      CH: CHAR; 		      %LAST CHARACTER\


      %COUNTERS:\
      %*********\

      RTIME,
      I: INTEGER;
      SUPPORTIX: SUPPORTS;
      LANGUAGEIX: SYMBOL;
      CHCNT: 0..132;		      %CHARACTER COUNTER\
      CODEEND,			      %FIRST LOCATION NOT USED FOR INSTRUCTIONS\
      LCMAIN,
(* 5 - some new variables for CREF *)
      LC,IC,BEGLC,BEGIC: ADDRRANGE; 	      %DATA LOCATION AND INSTRUCTION COUNTER\
(* 176 - new vars for unterminated comment *)
      comment_page, comment_line: integer;

      %SWITCHES:\
      %*********\

(* 25 - ADD /ZERO *)
      ZERO,				%ON TO INITIALIZE LOCAL VAR'S\
(* 4 - variable for COMPIL linkage *)
      RPGENTRY,				%ON IF CALLED CALLED BY COMPIL\
(* 5 - new variables for CREF *)
      CREF,				%ON IF CREF LISTING BEING MADE\
      DP,BEGDP,			      %DECLARATION PART\
      RESETFLAG,		      %TO IGNORE SWITCHES WHICH MUST NOT BE RESET\
      PRTERR,			      %TO ALLOW FORWARD REFERENCES IN POINTER TYPE
				       DECLARATION BY SUPPRESSING ERROR MESSAGE\
      MAIN,			      %IF FALSE COMPILER PRODUCES EXTERNAL PROCEDURE OR FUNCTION\
      doinitTTY,		      %TTYOPEN needed\
      TTYINUSE, 		      %no longer used ?\
      TTYSEEEOL,		      %TTY:# in program state\
      DEBUG,			      %ENABLE DEBUGGING\
      DEBUGSWITCH,		      %INSERT DEBUGINFORMATION\
      LISTCODE, 		      %LIST MACRO CODE\
      INITGLOBALS,		      %INITIALIZE GLOBAL VARIABLES\
      LOADNOPTR,		      %TRUE IF NO POINTERVARIABLE SHALL BE LOADED\
(* 157 - separate control for arith overflow *)
      ARITHCHECK,		      %SWITCH FOR DETECTING ARITH ERRORS\
      RUNTMCHECK: BOOLEAN;	      %SWITCH FOR RUNTIME-TESTS\
(* 24 - ALLOW USER TO SET FIRST LOC OF STACK AND HEAP *)
      STACK,HEAP: ADDRRANGE;		%FIRST ADDR OF STACK AND HEAP\
(* 12 - stackandheap no longer needed *)
(* 33 - VERSION NO. *)
      version:packed record			%version no. for output\
	case boolean of
	  true:(word:integer);
	  false:(who:0..7B;major:0..777B;minor:0..77B;edit:0..777777B)
	end;


      %POINTERS:\
      %*********\

      LOCALPFPTR, EXTERNPFPTR: CTP;   %PTRS TO LOCAL/EXTERNAL PROC/FUNC-CHAIN\
(* 111 - STRING, POINTER *)
(* 202 - POINTER by ref *)
      INTPTR,REALPTR,CHARPTR,ANYFILEPTR,STRINGPTR,POINTERPTR,POINTERREF,
      BOOLPTR,NILPTR,TEXTPTR: STP;    %POINTERS TO ENTRIES OF STANDARD IDS\
(* 135 - ill mem ref in PACK, UNPACK *)
      UARRTYP:STP;
      UTYPPTR,UCSTPTR,UVARPTR,
      UFLDPTR,UPRCPTR,UFCTPTR,	      %POINTERS TO ENTRIES FOR UNDECLARED IDS\
(* 64 - non-loc goto *)
      ulblptr,
      FWPTR: CTP;		      %HEAD OF CHAIN OF FORW DECL TYPE IDS\
      ERRMPTR,ERRMPTR1: ETP;	      %TO CHAIN ERROR-UPDATES\
(* 65 - remove exit labels *)
      LASTBTP: BTP;		      %HEAD OF BYTEPOINTERTABLE\
      SFILEPTR,
      FILEPTR: FTP;
      FIRSTKONST: KSP;
(* 164 - Polish fixups for CASE *)
      FIRSTPOL: POLPT;
      ALFAPTR, DATEPTR: STP;
      FGLOBPTR,CGLOBPTR : GTP ;       %POINTER TO FIRST AND CURRENT GLOBAL INITIALISATION RECORD\
      GLOBTESTP : TESTP ;	      %POINTER TO LAST PAIR OF POINTERTYPES\
(* 4 - Here is the main structure for the SCAN linkage *)
      SCANDATA : RPGPT ;		%DATA FROM SCAN OF FILE NAMES\
(* 33 - PROGRAM STATEMENT *)
      NPROGFILE,			%NEW FILE NAME\
      LPROGFILE,			%LAST FILE NAME IN LIST\
      FPROGFILE:PROGFILEPT;		%FIRST FILE NAME IN LIST\
(* 64 - non-loc goto *)
      lastlabel:ctp;
(* 171 - treat file names as special *)
      infile,outfile,ttyfile,ttyoutfile:ctp;    {Pointers to ID's for 
	INPUT, OUTPUT, TTY,    TTYOUT}

      %BOOKKEEPING OF DECLARATION LEVELS:\
      %**********************************\

(* 5 - new variable for CREF *)
      LEVEL,BEGLEVEL: LEVRANGE;		      %CURRENT STATIC LEVEL\
      DISX,			      %LEVEL OF LAST ID SEARCHED BY SEARCHID\
      TOP: DISPRANGE;		      %TOP OF DISPLAY\

      DISPLAY:				    %WHERE:   MEANS:\
      ARRAY[DISPRANGE] OF
      PACKED RECORD
	       %=BLCK:	 ID IS VARIABLE ID\
(* 5 - new variable for CREF *)
	       BLKNAME: ALFA;		    %NAME OF BLOCK\
	       FNAME: CTP;		    %=CREC:   ID IS FIELD ID IN RECORD WITH\
	       CASE OCCUR: WHERE OF	    %	      CONSTANT ADDRESS\
		    CREC: (CLEV: LEVRANGE;  %=VREC:   ID IS FIELD ID IN RECORD WITH\
			   CINDR: ACRANGE;  %	      VARIABLE ADDRESS\
			   CINDB: IBRANGE;
			   CRELBYTE: RELBYTE;
			   CDSPL,
			   CLC	: ADDRRANGE)
	     END;


      %ERROR MESSAGES:\
      %***************\

      ERRORFLAG: BOOLEAN;	      %TRUE IF SYNTACTIC ERRORS DETECTED\
      ERRINX: 0..MAXERR ;	      %NR OF ERRORS IN CURRENT SOURCE LINE\
      ERRLIST:
      ARRAY [1..MAXERR] OF
      PACKED RECORD
	       ARW : 1..4;
	       POS: 1..CHCNTMAX;
	       NMR: 1..600;
	       TIC: CHAR
	     END;

      ERRMESS15 : ARRAY [1..24] OF PACKED ARRAY [1..15] OF CHAR;
(* 6 - add error msg for illegal character *)
      ERRMESS20 : ARRAY [1..16] OF PACKED ARRAY [1..20] OF CHAR;
(* 104 - error message for too much data for address space *)
      ERRMESS25 : ARRAY [1..16] OF PACKED ARRAY [1..25] OF CHAR;
      ERRMESS30 : ARRAY [1..17] OF PACKED ARRAY [1..30] OF CHAR;
(* 156 - ftnname^ := *)
      ERRMESS35 : ARRAY [1..18] OF PACKED ARRAY [1..35] OF CHAR;
(* 31 - ADD MESSAGE  FOR BAD ASSIGN TO FTN. NAME *)
      ERRMESS40 : ARRAY [1..13] OF PACKED ARRAY [1..40] OF CHAR;
(* 24 - NEW ERROR MSG FOR LOC *)
      ERRMESS45 : ARRAY [1..16] OF PACKED ARRAY [1..45] OF CHAR;
(* 33 - PROGRAM STATEMENT *)
      ERRMESS50 : ARRAY [1.. 9] OF PACKED ARRAY [1..50] OF CHAR;
(* 124 - bad initprocedure *)
      ERRMESS55 : ARRAY [1.. 7] OF PACKED ARRAY [1..55] OF CHAR;
      ERRORINLINE,
      FOLLOWERROR : BOOLEAN;
      ERRLINE,
      BUFFER: ARRAY [1..CHCNTMAX] OF CHAR;
(* 136 - listing format *)
      PAGECNT,SUBPAGE,CURLINE,
      LINECNT: INTEGER;
      LINENR: PACKED ARRAY [1..5] OF CHAR;




      %EXPRESSION COMPILATION:\
      %***********************\

      GATTR: ATTR;		      %DESCRIBES THE EXPR CURRENTLY COMPILED\
(* 105 - character mapping from lower case *)
      charmap,setmap:array[0..177B]of integer;	%fast mapping to upper case\
      setmapchain:addrrange;		%for external reference to runtime version of setmap\


      %COUNTERS FOR TESTS:\
      %*******************\



      %DEBUG-SYSTEM:\
      %*************\

      LASTSTOP: ADDRRANGE;	      %LAST BREAKPOINT\
      LASTLINE, 		      %LINENUMBER FOR BREAKPOINTS\
      LINEDIFF, 		      %DIFFERENCE BETWEEN ^ AND LINECNT\
      LASTPAGE:INTEGER; 	      %LAST PAGE THAT CONTAINS A STOP\
      PAGEHEADADR,		      %OVERGIVE TO DEBUG.PAS\
      LASTPAGER: ADDRRANGE;	      %POINTS AT LAST PAGERECORD\
      PAGER: PAGEELEM;		      %ACTUAL PAGERECORD\
      DEBUGENTRY: DEBENTRY;
      IDRECSIZE: ARRAY[IDCLASS] OF INTEGER;
      STRECSIZE: ARRAY[STRUCTFORM] OF INTEGER;



      %STRUCTURED CONSTANTS:\
      %*********************\

      LETTERSORDIGITS,LETTERS,DIGITS,LETTERSDIGITSORLEFTARROW,HEXADIGITS: SET OF CHAR;
      CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS,
      LANGUAGESYS,STATBEGSYS,TYPEDELS: SETOFSYS;
(* 6 - add PROGRAM statement *)
(* 56 - ADD INCLUDE *)
      RW:  ARRAY [1..45%NR. OF RES. WORDS\] OF ALFA;
      FRW: ARRAY [1..11%ALFALENG+1\] OF 1..46%NR. OF RES. WORDS + 1\;
      RSY: ARRAY [1..45%NR. OF RES. WORDS\] OF SYMBOL;
      SSY: ARRAY [' '..'_'] OF SYMBOL;
      ROP: ARRAY [1..45%NR. OF RES. WORDS\] OF OPERATOR;
      SOP: ARRAY [' '..'_'] OF OPERATOR;
(* 10 make room for 12 more proc's, 8 more ftn's *)
      NA:  ARRAY [1..81] OF ALFA;
(* 61 - new array to declare which are tops10 and tops20 *)
      machna: array[1..81] of machine;
      othermachine: machine;
      EXTNA: ARRAY[39..53] OF ALFA;
      EXTLANGUAGE: ARRAY[39..53] OF SYMBOL;
      MNEMONICS : ARRAY[1..45] OF PACKED ARRAY[1..60] OF CHAR ;


      %VARIABLES FROM BODY\
      %*******************\


(* 173 - internal files *)
{Chantab is very strange.  It is used as a kludge because we need
 two global request chains for each of INPUT, OUTPUT, TTY, and TTYOUTPUT.
 So the second one is stored here.  From an identifier record, you can
 look at CHANNEL to find which of these corresponds to that one.}
      CHANTAB:ARRAY[1..4] OF ADDRRANGE;
      FILEINBLOCK:ARRAY[LEVRANGE]OF BOOLEAN;   {True is there is a local file}
(* 12 - VAR'S FOR GLOBAL REF TO RUNTIMES. FOR DYNAMIC ALLOC *)
      LSTNEW,NEWBND: ADDRRANGE;	%references to these global variables\
(* 13 - ADD DATA FOR DDT SYMBOLS *)
      PFPOINT,PFDISP:ADDRRANGE;	%ADDRESS OF FIRST CODE IN PROCEDURE\
      RELBLOCK: PACKED RECORD
			 CASE BOOLEAN OF
			      TRUE: (COMPONENT: ARRAY[1..20] OF INTEGER);
			      FALSE: (ITEM: ADDRRANGE; COUNT: ADDRRANGE;
				      RELOCATOR: RELWORD;
				      CODE: ARRAY[0..17] OF INTEGER)
		       END;

      RNTS: RECORD
	      NAME: ARRAY[SUPPORTS] OF ALFA;
	      LINK: PACKED ARRAY[SUPPORTS] OF ADDRRANGE
	    END;

      CODE: PACKED RECORD
		     RELOCATION:  PACKED ARRAY[CODERANGE] OF RELBYTE;
		     INFORMATION: PACKED ARRAY[CODERANGE] OF CHAR;
		     CASE INTEGER OF
			  1: (INSTRUCTION: PACKED ARRAY[CODERANGE] OF PDP10INSTR);
			  2: (WORD:	   PACKED ARRAY[CODERANGE] OF INTEGER);
			  3: (HALFWORD:    PACKED ARRAY[CODERANGE] OF HALFS)
		   END;

      LABELS: ARRAY [1:LABMAX] OF
      RECORD
	LABSVAL,LABSADDR: INTEGER
      END;
      GOTOS: ARRAY [1:LABMAX] OF
      RECORD
	GOTOVAL,GOTOADDR: INTEGER
      END;

      REGC,				%TOP OF REGISTERSTACK\
      REGCMAX: ACRANGE; 		%MAXIMUM OF REGISTERS FOR EXPRESSION STACK\
      LIX,JIX,CIX,
      INSERTSIZE,			%TOO INSERT LCMAX IN ENTRYCODE\
      PFSTART: INTEGER; 		%START OF NORMAL ENTRYCODE OF EACH FUNC. OR PROC.\
      IX: INTEGER;
(* 54 - var's needed to keep track of stack space needed *)
      STKOFF, STKOFFMAX, CORALLOC: INTEGER;	%STACK SPACE NEEDED ABOVE LOCALS\
      LCMAX: ADDRRANGE; LCP: CTP;
      OUTPUTREL: FILE OF INTEGER;	%RELOCATABLE BINARY OUTPUT\
      WITHIX,				%TOP OF WITH-REG STACK\
      HIGHESTCODE,			%MAXIMUM OF HIGH SEGMENTS ADDRESS\
      MAINSTART,			%FIRST CODE OF BODY OF MAIN\
(* 16 - add CCLSW set by entry with offset=1 *)
      CCLSW,
(* 66 - nonloc goto's *)
      globtopp,globbasis,
      STARTADDR: INTEGER;		%STARTADDRESSE\

(* 33 - VERSION NO. *)
      LOOKBLOCK: ARRAY[0..6] OF INTEGER;
      LST,REL: PACKED ARRAY[1..3] OF CHAR ;
(* 34 - entry no longer needed *)
      FILENAME: ALFA;
      DAY: PACKED ARRAY[1..9] OF CHAR;
(* 125 - moved to global so insymbol can see it *)
      REQFILE,ENTRYDONE: BOOLEAN;
(* 171 - read/write of records *)
      THISFILE: STP;
      GOTARG: BOOLEAN;

      LIBIX: INTEGER;
      LIBORDER: PACKED ARRAY[1..4] OF SYMBOL;
      LIBRARY: ARRAY[PASCALSY..COBOLSY] OF RECORD
					     INORDER, CALLED: BOOLEAN;
					     NAME: ALFA;
					     PROJNR: ADDRRANGE;
					     PROGNR: ADDRRANGE;
					     DEVICE: ALFA
					   END;

      %------------------------------------------------------------------------------\

      INITPROCEDURE ;
       BEGIN

(* 33 - VERSION NO. *)
(* 34 - using filename instead of entry *)
	LST:= 'LST'  ;	REL:= 'REL'  ;	FILENAME:= '          '  ;  LOOKBLOCK[0] := 6;

	MNEMONICS[ 1] := '***001***002***003***004***005***006***007***010***011***012' ;
	MNEMONICS[ 2] := '***013***014***015***016***017***020***021***022***023***024' ;
	MNEMONICS[ 3] := '***025***026***027***030***031***032***033***034***035***036' ;
	MNEMONICS[ 4] := '***037CALL  INIT  ***042***043***044***045***046CALLI OPEN  ' ;
	MNEMONICS[ 5] := 'TTCALL***052***053***054RENAMEIN    OUT   SETSTSSTATO STATUS' ;
	MNEMONICS[ 6] := 'STATZ INBUF OUTBUFINPUT OUTPUTCLOSE RELEASMTAPE UGETF USETI ' ;
(* 133 - add mnemonics for ADJSP and JSYS *)
	MNEMONICS[ 7] := 'USETO LOOKUPENTER UJEN  ***101***102***103JSYS  ADJSP ***106' ;
	MNEMONICS[ 8] := '***107***110***111***112***113***114***115***116***117***120' ;
(* 2 - add mnemonics for KI-10, since we are using some of them *)
	MNEMONICS[ 9] := '***121FIX   ***123***124***125FIXR  FLTR  UFA   DFN   FSC   ' ;
	MNEMONICS[10] := 'IBP   ILDB  LDB   IDPB  DPB   FAD   FADL  FADM  FADB  FADR  ' ;
	MNEMONICS[11] := 'FADRI FADRM FADRB FSB   FSBL  FSBM  FSBB  FSBR  FSBRI FSBRM ' ;
	MNEMONICS[12] := 'FSBRB FMP   FMPL  FMPM  FMPB  FMPR  FMPRI FMPRM FMPRB FDV   ' ;
	MNEMONICS[13] := 'FDVL  FDVM  FDVB  FDVR  FDVRI FDVRM FDVRB MOVE  MOVEI MOVEM ' ;
	MNEMONICS[14] := 'MOVES MOVS  MOVSI MOVSM MOVSS MOVN  MOVNI MOVNM MOVNS MOVM  ' ;
	MNEMONICS[15] := 'MOVMI MOVMM MOVMS IMUL  IMULI IMULM IMULB MUL   MULI  MULM  ' ;
	MNEMONICS[16] := 'MULB  IDIV  IDIVI IDIVM IDIVB DIV   DIVI  DIVM  DIVB  ASH   ' ;
	MNEMONICS[17] := 'ROT   LSH   JFFO  ASHC  ROTC  LSHC  ***247EXCH  BLT   AOBJP ' ;
	MNEMONICS[18] := 'AOBJN JRST  JFCL  XCT   ***257PUSHJ PUSH  POP   POPJ  JSR   ' ;
	MNEMONICS[19] := 'JSP   JSA   JRA   ADD   ADDI  ADDM  ADDB  SUB   SUBI  SUBM  ' ;
	MNEMONICS[20] := 'SUBB  CAI   CAIL  CAIE  CAILE CAIA  CAIGE CAIN  CAIG  CAM   ' ;
	MNEMONICS[21] := 'CAML  CAME  CAMLE CAMA  CAMGE CAMN  CAMG  JUMP  JUMPL JUMPE ' ;
	MNEMONICS[22] := 'JUMPLEJUMPA JUMPGEJUMPN JUMPG SKIP  SKIPL SKIPE SKIPLESKIPA ' ;
	MNEMONICS[23] := 'SKIPGESKIPN SKIPG AOJ   AOJL  AOJE  AOJLE AOJA  AOJGE AOJN  ' ;
	MNEMONICS[24] := 'AOJG  AOS   AOSL  AOSE  AOSLE AOSA  AOSGE AOSN  AOSG  SOJ   ' ;
	MNEMONICS[25] := 'SOJL  SOJE  SOJLE SOJA  SOJGE SOJN  SOJG  SOS   SOSL  SOSE  ' ;
	MNEMONICS[26] := 'SOSLE SOSA  SOSGE SOSN  SOSG  SETZ  SETZI SETZM SETZB AND   ' ;
	MNEMONICS[27] := 'ANDI  ANDM  ANDB  ANDCA ANDCAIANDCAMANDCABSETM  SETMI SETMM ' ;
	MNEMONICS[28] := 'SETMB ANDCM ANDCMIANDCMMANDCMBSETA  SETAI SETAM SETAB XOR   ' ;
	MNEMONICS[29] := 'XORI  XORM  XORB  IOR   IORI  IORM  IORB  ANDCB ANDCBIANDCBM' ;
	MNEMONICS[30] := 'ANDCBBEQV   EQVI  EQVM  EQVB  SETCA SETCAISETCAMSETCABORCA  ' ;
	MNEMONICS[31] := 'ORCAI ORCAM ORCAB SETCM SETCMISETCMMSETCMBORCM  ORCMI ORCMM ' ;
	MNEMONICS[32] := 'ORCMB ORCB  ORCBI ORCBM ORCBB SETO  SETOI SETOM SETOB HLL   ' ;
	MNEMONICS[33] := 'HLLI  HLLM  HLLS  HRL   HRLI  HRLM  HRLS  HLLZ  HLLZI HLLZM ' ;
	MNEMONICS[34] := 'HLLZS HRLZ  HRLZI HRLZM HRLZS HLLO  HLLOI HLLOM HLLOS HRLO  ' ;
	MNEMONICS[35] := 'HRLOI HRLOM HRLOS HLLE  HLLEI HLLEM HLLES HRLE  HRLEI HRLEM ' ;
	MNEMONICS[36] := 'HRLES HRR   HRRI  HRRM  HRRS  HLR   HLRI  HLRM  HLRS  HRRZ  ' ;
	MNEMONICS[37] := 'HRRZI HRRZM HRRZS HLRZ  HLRZI HLRZM HLRZS HRRO  HRROI HRROM ' ;
	MNEMONICS[38] := 'HRROS HLRO  HLROI HLROM HLROS HRRE  HRREI HRREM HRRES HLRE  ' ;
	MNEMONICS[39] := 'HLREI HLREM HLRES TRN   TLN   TRNE  TLNE  TRNA  TLNA  TRNN  ' ;
	MNEMONICS[40] := 'TLNN  TDN   TSN   TDNE  TSNE  TDNA  TSNA  TDNN  TSNN  TRZ   ' ;
	MNEMONICS[41] := 'TLZ   TRZE  TLZE  TRZA  TLZA  TRZN  TLZN  TDZ   TSZ   TDZE  ' ;
	MNEMONICS[42] := 'TSZE  TDZA  TSZA  TDZN  TSZN  TRC   TLC   TRCE  TLZE  TRCA  ' ;
	MNEMONICS[43] := 'TLCA  TRCN  TLCN  TDC   TSC   TDCE  TSCE  TDCA  TSCA  TDCN  ' ;
	MNEMONICS[44] := 'TSCN  TRO   TLO   TROE  TLOE  TROA  TLOA  TRON  TLON  TDO   ' ;
	MNEMONICS[45] := 'TSO   TDOE  TSOE  TDOA  TSOA  TDON  TSON  ***700            ' ;
       END;

      INITPROCEDURE %SEARCH LIBRARIES\ ;
       BEGIN
	LIBRARY[PASCALSY].INORDER   := FALSE;
	LIBRARY[FORTRANSY].INORDER  := FALSE;
	LIBRARY[ALGOLSY].INORDER    := FALSE;
	LIBRARY[COBOLSY].INORDER    := FALSE;
	LIBRARY[PASCALSY].CALLED    := FALSE;
	LIBRARY[FORTRANSY].CALLED   := FALSE;
	LIBRARY[ALGOLSY].CALLED     := FALSE;
	LIBRARY[COBOLSY].CALLED     := FALSE;
(* 57 - Make library a parameter *)
	LIBRARY[PASCALSY].NAME	    := PASLIB;
	LIBRARY[FORTRANSY].NAME     := 'FORLIB    ';
	LIBRARY[ALGOLSY].NAME	    := 'ALGLIB    ';
	LIBRARY[COBOLSY].NAME	    := 'LIBOL     ';
(* 2 - library now on SYS: *)
(* 57 *)
	LIBRARY[PASCALSY].DEVICE    := PASDEV;
	LIBRARY[FORTRANSY].DEVICE   := 'SYS       ';
	LIBRARY[ALGOLSY].DEVICE     := 'SYS       ';
	LIBRARY[COBOLSY].DEVICE     := 'SYS       ';
(* 57 *)
	LIBRARY[PASCALSY].PROJNR    := PASPROJ;
	LIBRARY[FORTRANSY].PROJNR   := 0;
	LIBRARY[ALGOLSY].PROJNR     := 0;
	LIBRARY[COBOLSY].PROJNR     := 0;
(* 57 *)
	LIBRARY[PASCALSY].PROGNR    := PASPROG;
	LIBRARY[FORTRANSY].PROGNR   := 0;
	LIBRARY[ALGOLSY].PROGNR     := 0;
	LIBRARY[COBOLSY].PROGNR     := 0;
       END %SEARCH LIBRARIES\ ;

      INITPROCEDURE %STANDARDNAMES\ ;
       BEGIN
	NA[ 1] := 'FALSE     '; NA[ 2] := 'TRUE      '; NA[ 3] := 'INPUT     ';
	NA[ 4] := 'OUTPUT    '; NA[ 5] := 'TTY       '; NA[ 6] := 'TTYOUTPUT ';
	NA[ 7] := 'GET       '; NA[ 8] := 'GETLN     '; NA[ 9] := 'PUT       ';
	NA[10] := 'PUTLN     '; NA[11] := 'RESET     '; NA[12] := 'REWRITE   ';
	NA[13] := 'READ      '; NA[14] := 'READLN    '; NA[15] := 'BREAK     ';
	NA[16] := 'WRITE     '; NA[17] := 'WRITELN   '; NA[18] := 'PACK      ';
	NA[19] := 'UNPACK    '; NA[20] := 'NEW       '; NA[21] := 'MARK      ';
	NA[22] := 'RELEASE   '; NA[23] := 'GETLINENR '; NA[24] := 'PUT8BITSTO';
	NA[25] := 'PAGE      '; NA[26] := 'DATE      '; NA[27] := 'RUNTIME   ';
	NA[28] := 'TIME      '; NA[29] := 'ABS       '; NA[30] := 'SQR       ';
	NA[31] := 'TRUNC     '; NA[32] := 'ODD       '; NA[33] := 'ORD       ';
	NA[34] := 'CHR       '; NA[35] := 'PRED      '; NA[36] := 'SUCC      ';
	NA[37] := 'EOF       '; NA[38] := 'EOLN      '; NA[39] := 'SIN       ';
	NA[40] := 'COS       '; NA[41] := 'EXP       '; NA[42] := 'SQRT      ';
	NA[43] := 'LN        '; NA[44] := 'ARCTAN    '; NA[45] := 'LOG       ';
	NA[46] := 'SIND      '; NA[47] := 'COSD      '; NA[48] := 'SINH      ';
	NA[49] := 'COSH      '; NA[50] := 'TANH      '; NA[51] := 'ARCSIN    ';
	NA[52] := 'ARCCOS    '; NA[53] := 'RANDOM    ';
(* 10 make room for 12 more proc's, 8 more ftn's *)
	NA[54] := 'STRSET    '; NA[55] := 'STRWRITE  ';
	NA[56] := 'GETINDEX  '; NA[57] := 'CLOSE     ';
	NA[58] := 'CALLI     '; NA[59] := 'RENAME    ';
	NA[60] := 'DISMISS   '; NA[61] := 'UPDATE    ';
	NA[62] := 'DUMPIN    '; NA[63] := 'DUMPOUT   ';
	NA[64] := 'USETI     '; NA[65] := 'USETO     ';
(* 27 - add NEWZ *)
	NA[66] := 'BREAKIN   '; NA[67] := 'NEWZ      ';
	NA[68] := 'APPEND    '; NA[69] := 'PUTX      ';
(* 44 - SETPOS,CURPOS, SKIP *)
	NA[70] := 'SETPOS    '; NA[71] := 'NEXTBLOCK ';
(* 61 - tops20 system version *)
	na[72] := 'GETX      '; na[73] := 'DELETE    ';
	na[74] := 'RCLOSE    '; na[75] := 'JSYS      ';
(* 152 - add DISPOSE *)
	na[76] := 'DISPOSE   '; na[77] := 'NEXTFILE  ';
	na[78] := 'CURPOS    '; na[79] := 'SPACELEFT ';
	na[80] := 'ROUND     '; na[81] := 'RECSIZE   ';
	machna[24] := t10name; machna[58] := t10name;
	machna[62] := t10name; machna[63] := t10name;
	machna[64] := t10name; machna[65] := t10name;
(* 134 - remove t20name entry for DELETE *)
	machna[71] := t10name; 
	machna[74] := t20name; machna[75] := t20name;
	machna[77] := t20name; machna[79] := t10name;
       END %STANDARDNAMES\ ;

      INITPROCEDURE %EXTERNAL NAMES\;
       BEGIN
	EXTNA[39] := 'SIN       '; EXTLANGUAGE[39] := FORTRANSY;
	EXTNA[40] := 'COS       '; EXTLANGUAGE[40] := FORTRANSY;
	EXTNA[41] := 'EXP       '; EXTLANGUAGE[41] := FORTRANSY;
	EXTNA[42] := 'SQRT      '; EXTLANGUAGE[42] := FORTRANSY;
	EXTNA[43] := 'ALOG      '; EXTLANGUAGE[43] := FORTRANSY;
	EXTNA[44] := 'ATAN      '; EXTLANGUAGE[44] := FORTRANSY;
	EXTNA[45] := 'ALOG10    '; EXTLANGUAGE[45] := FORTRANSY;
	EXTNA[46] := 'SIND      '; EXTLANGUAGE[46] := FORTRANSY;
	EXTNA[47] := 'COSD      '; EXTLANGUAGE[47] := FORTRANSY;
	EXTNA[48] := 'SINH      '; EXTLANGUAGE[48] := FORTRANSY;
	EXTNA[49] := 'COSH      '; EXTLANGUAGE[49] := FORTRANSY;
	EXTNA[50] := 'TANH      '; EXTLANGUAGE[50] := FORTRANSY;
	EXTNA[51] := 'ASIN      '; EXTLANGUAGE[51] := FORTRANSY;
	EXTNA[52] := 'ACOS      '; EXTLANGUAGE[52] := FORTRANSY;
	EXTNA[53] := 'RAN       '; EXTLANGUAGE[53] := FORTRANSY;

       END %EXTERNAL NAMES\;

      INITPROCEDURE %RUNTIME-, DEBUG-SUPPORTS\ ;
       BEGIN

	RNTS.NAME[STACKOVERFLOW]	     := 'CORERR    ';
(* 104 - new tops10 stackoverflow for better checking *)
	RNTS.NAME[DEBSTACK]		     := 'DCORER    ';
(* 23 - check for bad pointer *)
        RNTS.NAME[BADPOINT]		     := 'PTRER.    ';
	RNTS.NAME[ALLOCATE]		     := 'NEW       ';
	RNTS.NAME[CLEARALLOC]		     := 'NEWCL.    ';
(* 152 - DISPOSE *)
	RNTS.NAME[DEALLOCATE]		     := 'DISPOS    ';
(* 173 - internal file *)
	RNTS.NAME[WITHFILEDEALLOCATE]	     := 'DISPF.    ';
(* 64 - non-loc goto *)
	rnts.name[exitgoto]		     := 'GOTOC.    ';
	RNTS.NAME[EXITPROGRAM]		     := 'END       ';
	RNTS.NAME[GETLINE]		     := 'GETLN     ';
	RNTS.NAME[GETFILE]		     := 'GET.      ';
	RNTS.NAME[PUTLINE]		     := 'PUTLN     ';
	RNTS.NAME[PUTFILE]		     := 'PUT       ';
(* 43 - add PUTX *)
	RNTS.NAME[PUTXFILE]		     := 'PUTX      ';
	RNTS.NAME[RESETFILE]		     := 'RESETF    ';
	RNTS.NAME[REWRITEFILE]		     := 'REWRIT    ';
(* 57 - do strset and strwrite at runtime *)
	RNTS.NAME[RESETSTRING]		     := 'STSET.    ';
	RNTS.NAME[REWRITESTRING]	     := 'STWR.     ';
	RNTS.NAME[WRITEOCTAL]		     := 'WRTOCT    ';
	RNTS.NAME[WRITEHEXADECIMAL]	     := 'WRTHEX    ';
	RNTS.NAME[WRITEINTEGER] 	     := 'WRTINT    ';
	RNTS.NAME[WRITECHARACTER]	     := 'WRITEC    ';
	RNTS.NAME[WRITEREAL]		     := 'WRTREA    ';
	RNTS.NAME[WRITEBOOLEAN] 	     := 'WRTBOL    ';
	RNTS.NAME[WRITESTRING]		     := 'WRTUST    ';
	RNTS.NAME[WRITEPACKEDSTRING]	     := 'WRTPST    ';
        RNTS.NAME[WRITERECORD]   	     := '.WRREC    ';
	RNTS.NAME[WRITESCALAR]		     := '.WRSCA    ';
	RNTS.NAME[READINTEGER]		     := '.READI    ';
	RNTS.NAME[READCHARACTER]	     := '.READC    ';
	RNTS.NAME[READREAL]		     := '.READR    ';
        RNTS.NAME[READRECORD]		     := '.READD    ';
	RNTS.NAME[CONVERTINTEGERTOREAL]      := 'INTREA    ';
	RNTS.NAME[CONVERTREALTOINTEGER]      := 'TRUNC     ';
	RNTS.NAME[BREAKOUTPUT]		     := 'BREAK     ';
	RNTS.NAME[OPENTTY]		     := 'TTYPR.    ';
	RNTS.NAME[INITIALIZEDEBUG]	     := 'INDEB.    ';
	RNTS.NAME[ENTERDEBUG]		     := 'EXDEB.    ';
	RNTS.NAME[GETCHARACTER] 	     := 'GETCH     ';
	RNTS.NAME[PUTPAGE]		     := 'PUTPG     ';
	RNTS.NAME[INDEXERROR]		     := 'INXERR    ';
	RNTS.NAME[ERRORINASSIGNMENT]	     := 'SRERR     ';
	RNTS.NAME[FILEUNINITIALIZED]	     := 'ILFIL.    ';
	RNTS.NAME[INITFILEBLOCK]	     := 'INITB.    ';
(* 10 ADD CLOSE *)
	RNTS.NAME[CLOSEFILE]		     := 'CLOFIL    ';
(* 14 AND STRING READERS *)
	RNTS.NAME[READSTRING]		     := 'READUS    ';
	RNTS.NAME[READPACKEDSTRING]	     := 'READPS    ';
	RNTS.NAME[READFILENAME]		     := 'GETFN.    ';
	RNTS.NAME[NAMEFILE]		     := 'RENAME    ';
(* 40 - change name so won't conflict with FORTRAN *)
	RNTS.NAME[DISFILE]		     := 'RESDEV    ';
	RNTS.NAME[UPFILE]		     := 'UPDATE    ';
	RNTS.NAME[APFILE]		     := 'APPEND    ';
	RNTS.NAME[READDUMP]		     := 'DUMPIN    ';
	RNTS.NAME[WRITEDUMP]		     := 'DUMPOU    ';
	RNTS.NAME[SETIN]		     := 'USETIN    ';
	RNTS.NAME[SETOUT]		     := 'USETOU    ';
	RNTS.NAME[BREAKINPUT]		     := 'BREAKI    ';
	RNTS.NAME[SETPOSF]		     := 'SETPOS    ';
	RNTS.NAME[CURPOSF]		     := 'CURPOS    ';
	RNTS.NAME[NEXTBLOCKF]		     := 'NEXTBL    ';
	rnts.name[spaceleftf]		     := 'SPCLF.    ';
	rnts.name[getxf]		     := 'GETX.     ';
(* 74 - Tops20 runtimes *)
	rnts.name[delfile]		     := 'DELF.     ';
	rnts.name[relfile]		     := 'RELF.     ';
	rnts.name[initmem]		     := 'PASIM.    ';
(* 120 - New calling convention, so changed name *)
	rnts.name[initfiles]		     := 'PASIF.    ';
	rnts.name[getdaytime]		     := 'DAYTM.    ';

       END %RUNTIME-, DEBUG-SUPPORTS\ ;

      INITPROCEDURE %INITSCALARS\ ;
       BEGIN
	CHANTAB[1] := 0; CHANTAB[2] := 0; CHANTAB[3] := 0; CHANTAB[4] := 0;
(* 65 - remove exit labels *)
	FWPTR := NIL; LASTBTP := NIL;  FGLOBPTR := NIL ; FILEPTR := NIL ;
	LOCALPFPTR:=NIL; EXTERNPFPTR:= NIL; GLOBTESTP := NIL; ERRMPTR := NIL;
(* 24 - INITIALZE HEAP AND STACK *)
	HEAP := 0; STACK := 0;

	LISTCODE := FALSE; LOADNOPTR := TRUE; INITGLOBALS := FALSE ; RUNTMCHECK := TRUE;
(* 157 - separate control for arith error *)
	ARITHCHECK := TRUE;
	TTYINUSE := TRUE; FOLLOWERROR := FALSE; ERRORINLINE := FALSE; RESETFLAG := TRUE;
(* 172 *)
	TTYSEEEOL := FALSE;
	DP := TRUE; PRTERR := TRUE; ERRORFLAG := FALSE ; MAIN := TRUE;
	ENTRYDONE := FALSE; DEBUG := FALSE; DEBUGSWITCH := FALSE; 
(* 176 *)
	comment_page := 0;
(* 33 - PROGRAM *)
	FPROGFILE := NIL; LPROGFILE := NIL;
(* 64 - non-loc goto *)
	lastlabel := nil;

	IC := HIGHSTART;     %START OF HIGHSEGMENT\
	LC := PROGRST;	     %START OF LOWSEGMENT AVAILABLE TO PROGRAM\
(* 136 - listing format *)
	CHCNT := 0; LINECNT := 1; PAGECNT := 1; SUBPAGE := 0; 
	LASTLINE := -1; LASTPAGE := 0;
(* 12 - initialize new variables for dynamic core *)
	LIBIX := 0; ERRINX := 0; LSTNEW := 0; NEWBND := 0;
       END %INITSCALARS\ ;

      INITPROCEDURE %INITSETS\ ;
       BEGIN
	DIGITS := ['0'..'9'];
	LETTERS := ['A'..'Z'];
	HEXADIGITS := ['0'..'9','A'..'F'];
	LETTERSORDIGITS := [ '0'..'9','A'..'Z'];
	LETTERSDIGITSORLEFTARROW := ['0'..'9','A'..'Z','_'];
	LANGUAGESYS := [FORTRANSY,ALGOLSY,COBOLSY,PASCALSY];
	CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT];
	SIMPTYPEBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT] ;
	TYPEBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY] ;
	TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];
(* 56 - add require files *)
	BLOCKBEGSYS := [INCLUDESY,LABELSY,CONSTSY,TYPESY,VARSY,INITPROCSY,PROCEDURESY,FUNCTIONSY,BEGINSY];
	SELECTSYS := [ARROW,PERIOD,LBRACK];
	FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY];
	STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,LOOPSY,FORSY,WITHSY,CASESY]
       END %INITSETS\ ;

      INITPROCEDURE %RESWORDS\ ;
       BEGIN
	RW[ 1] := 'IF        '; RW[ 2] := 'DO        '; RW[ 3] := 'OF        ';
	RW[ 4] := 'TO        '; RW[ 5] := 'IN        '; RW[ 6] := 'OR        ';
	RW[ 7] := 'END       '; RW[ 8] := 'FOR       '; RW[ 9] := 'VAR       ';
	RW[10] := 'DIV       '; RW[11] := 'MOD       '; RW[12] := 'SET       ';
	RW[13] := 'AND       '; RW[14] := 'NOT       '; RW[15] := 'THEN      ';
	RW[16] := 'ELSE      '; RW[17] := 'WITH      '; RW[18] := 'GOTO      ';
	RW[19] := 'LOOP      '; RW[20] := 'CASE      '; RW[21] := 'TYPE      ';
	RW[22] := 'FILE      '; RW[23] := 'EXIT      '; RW[24] := 'BEGIN     ';
	RW[25] := 'UNTIL     '; RW[26] := 'WHILE     '; RW[27] := 'ARRAY     ';
	RW[28] := 'CONST     '; RW[29] := 'LABEL     '; RW[30] := 'ALGOL     ';
	RW[31] := 'COBOL     '; RW[32] := 'EXTERN    '; RW[33] := 'PASCAL    ';
	RW[34] := 'RECORD    '; RW[35] := 'DOWNTO    '; RW[36] := 'PACKED    ';
	RW[37] := 'OTHERS    '; RW[38] := 'REPEAT    '; RW[39] := 'FORTRAN   ';
(* 6 - add PROGRAM statement *)
(* 56 - ADD INCLUDE *)
	RW[40] := 'FORWARD   '; RW[41] := 'PROGRAM   '; RW[42] := 'INCLUDE   ';
        RW[43] := 'FUNCTION  '; RW[44] := 'PROCEDURE ';
	RW[45] := 'INITPROCED';
	FRW[1] :=  1; FRW[2] :=  1; FRW[3] :=  7; FRW[4] := 15; FRW[5] := 24;
	FRW[6] := 32; FRW[7] := 39; FRW[8] := 43; FRW[9] := 44; FRW[10] := 45;
	FRW[11] := 46;
       END %RESWORDS\ ;

      INITPROCEDURE %SYMBOLS\ ;
       BEGIN
	RSY[1] := IFSY; RSY[2] := DOSY; RSY[3] := OFSY; RSY[4] := TOSY;
	RSY[5] := RELOP; RSY[6] := ADDOP; RSY[7] := ENDSY; RSY[8] := FORSY;
	RSY[9] := VARSY; RSY[10] := MULOP; RSY[11] := MULOP; RSY[12] := SETSY;
	RSY[13] := MULOP; RSY[14] := NOTSY; RSY[15] := THENSY;
	RSY[16] := ELSESY; RSY[17] := WITHSY; RSY[18] := GOTOSY;
	RSY[19] := LOOPSY; RSY[20] := CASESY; RSY[21] := TYPESY;
	RSY[22] := FILESY; RSY[23] := EXITSY; RSY[24] := BEGINSY;
	RSY[25] := UNTILSY; RSY[26] := WHILESY; RSY[27] := ARRAYSY;
	RSY[28] := CONSTSY; RSY[29] := LABELSY;
	RSY[30] := ALGOLSY; RSY[31] := COBOLSY;
	RSY[32] := EXTERNSY; RSY[33] := PASCALSY; RSY[34] := FORTRANSY;
	RSY[34] := RECORDSY; RSY[35]:= DOWNTOSY; RSY[36] := PACKEDSY;
	RSY[37] := OTHERSSY; RSY[38]:= REPEATSY; RSY[39] := FORTRANSY;
(* 6 - add PROGRAM statement *)
(* 56 - ADD INCLUDE *)
	RSY[40] := FORWARDSY; RSY[41] := PROGRAMSY; RSY[42] := INCLUDESY; RSY[43] := FUNCTIONSY;
	RSY[44] := PROCEDURESY; RSY[45] := INITPROCSY;

	SSY['A'] := OTHERSY; SSY['B'] := OTHERSY; SSY['C'] := OTHERSY;
	SSY['D'] := OTHERSY; SSY['E'] := OTHERSY; SSY['F'] := OTHERSY;
	SSY['G'] := OTHERSY; SSY['H'] := OTHERSY; SSY['I'] := OTHERSY;
	SSY['J'] := OTHERSY; SSY['K'] := OTHERSY; SSY['L'] := OTHERSY;
	SSY['M'] := OTHERSY; SSY['N'] := OTHERSY; SSY['O'] := OTHERSY;
	SSY['P'] := OTHERSY; SSY['Q'] := OTHERSY; SSY['R'] := OTHERSY;
	SSY['S'] := OTHERSY; SSY['T'] := OTHERSY; SSY['U'] := OTHERSY;
	SSY['V'] := OTHERSY; SSY['W'] := OTHERSY; SSY['X'] := OTHERSY;
	SSY['Y'] := OTHERSY; SSY['Z'] := OTHERSY; SSY['0'] := OTHERSY;
	SSY['1'] := OTHERSY; SSY['2'] := OTHERSY; SSY['3'] := OTHERSY;
	SSY['4'] := OTHERSY; SSY['5'] := OTHERSY; SSY['6'] := OTHERSY;
	SSY['7'] := OTHERSY; SSY['8'] := OTHERSY; SSY['9'] := OTHERSY;
	SSY['_'] := OTHERSY;
	SSY['+'] := ADDOP;   SSY['-'] := ADDOP;   SSY['*'] := MULOP;
	SSY['/'] := MULOP;   SSY['('] := LPARENT; SSY[')'] := RPARENT;
	SSY['$'] := OTHERSY; SSY['='] := RELOP;   SSY[' '] := OTHERSY;
	SSY[','] := COMMA;   SSY['.'] := PERIOD;  SSY[''''] := OTHERSY;
	SSY['['] := LBRACK;  SSY[']'] := RBRACK;  SSY[':'] := COLON;
	SSY['#'] := RELOP;   SSY['%'] := OTHERSY; SSY['!'] := ADDOP;
	SSY['&'] := MULOP;   SSY['^'] := ARROW;   SSY['\'] := OTHERSY;
	SSY['<'] := RELOP;   SSY['>'] := RELOP;   SSY['@'] := RELOP;
	SSY['"'] := RELOP;   SSY['?'] := NOTSY;   SSY[';'] := SEMICOLON;
       END %SYMBOLS\ ;

      INITPROCEDURE %OPERATORS\ ;
       BEGIN
	ROP[ 1] := NOOP; ROP[ 2] := NOOP; ROP[ 3] := NOOP; ROP[ 4] := NOOP;
	ROP[ 5] := INOP; ROP[ 6] := OROP; ROP[ 7] := NOOP; ROP[ 8] := NOOP;
	ROP[ 9] := NOOP; ROP[10] := IDIV; ROP[11] := IMOD; ROP[12] := NOOP;
	ROP[13] :=ANDOP; ROP[14] := NOOP; ROP[15] := NOOP; ROP[16] := NOOP;
	ROP[17] := NOOP; ROP[18] := NOOP; ROP[19] := NOOP; ROP[20] := NOOP;
	ROP[21] := NOOP; ROP[22] := NOOP; ROP[23] := NOOP; ROP[24] := NOOP;
	ROP[25] := NOOP; ROP[26] := NOOP; ROP[27] := NOOP; ROP[28] := NOOP;
	ROP[29] := NOOP; ROP[30] := NOOP; ROP[31] := NOOP; ROP[32] := NOOP;
	ROP[33] := NOOP; ROP[34] := NOOP; ROP[35] := NOOP; ROP[36] := NOOP;
	ROP[37] := NOOP; ROP[38] := NOOP; ROP[39] := NOOP; ROP[40] := NOOP;
(* 6 - add PROGRAM statement *)
(* 56 - ADD INCLUDE *)
	ROP[41] := NOOP; ROP[42] := NOOP; ROP[43] := NOOP; ROP[44] := NOOP; ROP[45] := NOOP;

	SOP['+'] := PLUS; SOP['-'] := MINUS; SOP['*'] := MUL;  SOP['/'] := RDIV;
	SOP['='] := EQOP; SOP['#'] := NEOP;  SOP['!'] := OROP; SOP['&'] := ANDOP;
	SOP['<'] := LTOP; SOP['>'] := GTOP;  SOP['@'] := LEOP; SOP['"'] := GEOP;
	SOP[' '] := NOOP; SOP['$'] := NOOP; SOP['%'] := NOOP; SOP['('] := NOOP;
	SOP[')'] := NOOP; SOP[','] := NOOP; SOP['.'] := NOOP; SOP['0'] := NOOP;
	SOP['1'] := NOOP; SOP['2'] := NOOP; SOP['3'] := NOOP; SOP['4'] := NOOP;
	SOP['5'] := NOOP; SOP['6'] := NOOP; SOP['7'] := NOOP; SOP['8'] := NOOP;
	SOP['9'] := NOOP; SOP[':'] := NOOP; SOP[';'] := NOOP; SOP['?'] := NOOP;
	SOP['A'] := NOOP; SOP['B'] := NOOP; SOP['C'] := NOOP; SOP['D'] := NOOP;
	SOP['E'] := NOOP; SOP['F'] := NOOP; SOP['G'] := NOOP; SOP['H'] := NOOP;
	SOP['I'] := NOOP; SOP['J'] := NOOP; SOP['K'] := NOOP; SOP['L'] := NOOP;
	SOP['M'] := NOOP; SOP['N'] := NOOP; SOP['O'] := NOOP; SOP['P'] := NOOP;
	SOP['Q'] := NOOP; SOP['R'] := NOOP; SOP['S'] := NOOP; SOP['T'] := NOOP;
	SOP['U'] := NOOP; SOP['V'] := NOOP; SOP['W'] := NOOP; SOP['X'] := NOOP;
	SOP['Y'] := NOOP; SOP['Z'] := NOOP; SOP['['] := NOOP; SOP['\'] := NOOP;
	SOP[']'] := NOOP; SOP['^'] := NOOP; SOP['_'] := NOOP; SOP[''''] := NOOP;
       END %OPERATORS\ ;

      INITPROCEDURE %RECORDSIZES\;
       BEGIN
	IDRECSIZE[TYPES]  := 5;
	IDRECSIZE[KONST]  := 6;
	IDRECSIZE[VARS]   := 6;
	IDRECSIZE[FIELD]  := 6;
	IDRECSIZE[PROC]   := 5;
	IDRECSIZE[FUNC]   := 8;
(* 116 - define size of the new types for copyctp *)
	IDRECSIZE[PARAMS] := 5;
	IDRECSIZE[LABELT] := 6;
	STRECSIZE[SCALAR] := 2;
	STRECSIZE[SUBRANGE]:=4;
	STRECSIZE[POINTER]:= 2;
	STRECSIZE[POWER]  := 2;
	STRECSIZE[ARRAYS] := 3;
	STRECSIZE[RECORDS]:= 3;
	STRECSIZE[FILES]  := 2;
	STRECSIZE[TAGFWITHID]:=3;
	STRECSIZE[TAGFWITHOUTID] := 3;
	STRECSIZE[VARIANT] :=4
       END;

      INITPROCEDURE %ERRORMESSAGES\ ;
       BEGIN
	ERRMESS15[ 1] := '":" expected   ';
	ERRMESS15[ 2] := '")" expected   ';
	ERRMESS15[ 3] := '"(" expected   ';
	ERRMESS15[ 4] := '"[" expected   ';
	ERRMESS15[ 5] := '"]" expected   ';
	ERRMESS15[ 6] := '";" expected   ';
	ERRMESS15[ 7] := '"=" expected   ';
	ERRMESS15[ 8] := '"," expected   ';
	ERRMESS15[ 9] := '":=" expected  ';
	ERRMESS15[10] := '"OF" expected  ';
	ERRMESS15[11] := '"DO" expected  ';
	ERRMESS15[12] := '"IF" expected  ';
	ERRMESS15[13] := '"END" expected ';
	ERRMESS15[14] := '"THEN" expected';
	ERRMESS15[15] := '"EXIT" expected';
	ERRMESS15[16] := 'Illegal symbol ';
	ERRMESS15[17] := 'No sign allowed';
	ERRMESS15[18] := 'Number expected';
	ERRMESS15[19] := 'Not implemented';
	ERRMESS15[20] := 'Error in type  ';
(* 35 - new error - no longer need old one, so we replaced*)
	ERRMESS15[21] := 'Compiler error ';
	ERRMESS15[22] := '"." expected   ';
	ERRMESS15[23] := 'Error in factor';
	ERRMESS15[24] := 'Too many digits';

	ERRMESS20[ 1] := '"BEGIN" expected    ';
	ERRMESS20[ 2] := '"UNTIL" expected    ';
	ERRMESS20[ 3] := 'Error in options    ';
	ERRMESS20[ 4] := 'Constant too large  ';
	ERRMESS20[ 5] := 'Digit must follow   ';
	ERRMESS20[ 6] := 'Exponent too large  ';
	ERRMESS20[ 7] := 'Constant expected   ';
	ERRMESS20[ 8] := 'Simple type expected';
	ERRMESS20[ 9] := 'Identifier expected ';
	ERRMESS20[10] := 'Realtype not allowed';
	ERRMESS20[11] := 'Multidefined label  ';
	ERRMESS20[12] := 'Filename expected   ';
	ERRMESS20[13] := 'Set type expected   ';
	ERRMESS20[14] := 'Undeclared exitlabel';
	ERRMESS20[15] := 'Undeclared label    ';
(* 6 - add error msg for illegal character *)
	ERRMESS20[16] := 'Illegal character   ';

	ERRMESS25[ 1] := '"TO"/"DOWNTO" expected   ';
	ERRMESS25[ 2] := '8 OR 9 in octal number   ';
	ERRMESS25[ 3] := 'Identifier not declared  ';
	ERRMESS25[ 4] := 'File not allowed here    ';
	ERRMESS25[ 5] := 'Integer constant expected';
	ERRMESS25[ 6] := 'Error in parameterlist   ';
	ERRMESS25[ 7] := 'Already forward declared ';
	ERRMESS25[ 8] := 'This format for real only';
	ERRMESS25[ 9] := 'Varianttype must be array';
	ERRMESS25[10] := 'Type conflict of operands';
	ERRMESS25[11] := 'Multidefined case label  ';
	ERRMESS25[12] := 'Octal for integer only   ';
	ERRMESS25[13] := 'Array index out of bounds';
(* 26 - two new error messages for reset/rewrite/update *)
	ERRMESS25[14] := 'Must be array or record  ';
	ERRMESS25[15] := 'Must be at least 5 words ';
(* 104 - error message for too much data for address space *)
	ERRMESS25[16] := 'Data won''t fit in memory ';

	ERRMESS30[ 1] := 'String constant is too long   ';
	ERRMESS30[ 2] := 'Identifier already declared   ';
	ERRMESS30[ 3] := 'Subrange bounds must be scalar';
	ERRMESS30[ 4] := 'Incompatible subrange types   ';
	ERRMESS30[ 5] := 'Incompatible with tagfieldtype';
	ERRMESS30[ 6] := 'Index type may not be integer ';
	ERRMESS30[ 7] := 'Type of variable is not array ';
	ERRMESS30[ 8] := 'Type of variable is not record';
	ERRMESS30[ 9] := 'No such field in this record  ';
	ERRMESS30[10] := 'Expression too complicated    ';
	ERRMESS30[11] := 'Illegal type of operand(s)    ';
	ERRMESS30[12] := 'Tests on equality allowed only';
	ERRMESS30[13] := 'Strict inclusion not allowed  ';
(* 24 - CAN'T COMPARE RECORDS OR ARRAYS NOW *)
	ERRMESS30[14] := 'Structure comparison illegal  ';
	ERRMESS30[15] := 'Illegal type of expression    ';
	ERRMESS30[16] := 'Value of case label too large ';
	ERRMESS30[17] := 'Too many nested withstatements';

	ERRMESS35[ 1] := 'String constant contains "<CR><LF>"';
	ERRMESS35[ 2] := 'Basetype requires more than 72 bits';
	ERRMESS35[ 3] := 'Basetype must be scalar or subrange';
	ERRMESS35[ 4] := 'More than 12 files declared by user';
	ERRMESS35[ 5] := 'File as value parameter not allowed';
	ERRMESS35[ 6] := 'Procedure too long (too much code) ';
	ERRMESS35[ 7] := 'No packed structure allowed here   ';
	ERRMESS35[ 8] := 'Variant must belong to tagfieldtype';
	ERRMESS35[ 9] := 'Type of operand(s) must be boolean ';
	ERRMESS35[10] := 'Set element types not compatible   ';
	ERRMESS35[11] := 'Assignment to files not allowed    ';
	ERRMESS35[12] := 'Too many labels in this procedure  ';
	ERRMESS35[13] := 'Too many cases in case statement   ';
	ERRMESS35[14] := 'Control variable may not be formal ';
	ERRMESS35[15] := 'Illegal type of for-controlvariable';
	ERRMESS35[16] := 'Type of filecomponent must be char ';
	ERRMESS35[17] := 'Constant not in bounds of subrange ';
(* 156 ftn^ := *)
	ERRMESS35[18] := 'Illegal when assigning to function ';

	ERRMESS40[ 1] := 'Identifier is not of appropriate class  ';
	ERRMESS40[ 2] := 'Tagfield type must be scalar or subrange';
	ERRMESS40[ 3] := 'Index type must be scalar or subrange   ';
	ERRMESS40[ 4] := 'Too many nested scopes of identifiers   ';
	ERRMESS40[ 5] := 'Pointer forward reference unsatisfied   ';
	ERRMESS40[ 6] := 'Previous declaration was not forward    ';
	ERRMESS40[ 7] := 'Type of variable must be file or pointer';
	ERRMESS40[ 8] := 'Missing corresponding variantdeclaration';
	ERRMESS40[ 9] := 'Too many variants in call of NEW (max 6)';
	ERRMESS40[10] := 'More than four errors in this sourceline';
	ERRMESS40[11] := 'No initialisation on records or files   ';
(* 31 - new message *)
	ERRMESS40[12] := 'Assignment to func. must be in its body ';
	ERRMESS40[13] := 'Too many parameters (must fit in AC''s)  ';

	ERRMESS45[ 1] := 'Low bound may not be greater than high bound ';
	ERRMESS45[ 2] := 'Identifier or "CASE" expected in fieldlist   ';
	ERRMESS45[ 3] := 'Too many nested procedures and/or functions  ';
	ERRMESS45[ 4] := 'File declaration in procedures not allowed   ';
	ERRMESS45[ 5] := 'Missing result type in function declaration  ';
	ERRMESS45[ 6] := 'Assignment to formal function is not allowed ';
	ERRMESS45[ 7] := 'Index type is not compatible with declaration';
	ERRMESS45[ 8] := 'Error in type of standard procedure parameter';
	ERRMESS45[ 9] := 'Error in type of standard function parameter ';
	ERRMESS45[10] := 'Real and string tagfields not implemented    ';
	ERRMESS45[11] := 'Set element type must be scalar or subrange  ';
	ERRMESS45[12] := 'In initprocedure only assignments possible   ';
	ERRMESS45[13] := 'No constant or expression for VAR argument   ';
	ERRMESS45[14] := 'EXTERN declaration not allowed in procedures ';
	ERRMESS45[15] := 'Body of forward declared procedure missing   ';
(* 24 - NEW ERROR MSG FOR LOC *)
	ERRMESS45[16] := 'Must be user-declared PASCAL proc. or func.  ';

	ERRMESS50[ 1] := 'Too many forward references of procedure entries  ';
	ERRMESS50[ 2] := 'Assignment to standard function is not allowed    ';
	ERRMESS50[ 3] := 'Parameter type does not agree with declaration    ';
	ERRMESS50[ 4] := 'Initialisation only by assignment of constants    ';
	ERRMESS50[ 5] := 'Label type incompatible with selecting expression ';
	ERRMESS50[ 6] := 'Statement must end with ";","END","ELSE"or"UNTIL" ';
	ERRMESS50[ 7] := 'Not allowed in initprocedures (packed structure?) ';
(* 33 - PROGRAM *)
        ERRMESS50[ 8] := 'File mentioned in PROGRAM statement not declared  ';
(* 211 - better err msg *)
	ERRMESS50[ 9] := 'Variable mentioned in PROGRAM statement not a file';

	ERRMESS55[ 1] := 'Function result type must be scalar,subrange or pointer';
	ERRMESS55[ 2] := 'Forward decl. func:repetition of resulttype not allowed';
	ERRMESS55[ 3] := 'Forward decl.: repetition of parameter list not allowed';
	ERRMESS55[ 4] := 'Number of parameters does not agree with declaration   ';
	ERRMESS55[ 5] := 'Resulttype of parameter func. does not agree with decl.';
	ERRMESS55[ 6] := 'Selected expression must have type of control variable ';
(* 124 - detect bad initproc *)
	ERRMESS55[ 7] := 'INITPROCEDURE can''t be within a procedure or function  ';
       END %ERROR MESSAGES\ ;

(* 105 - new mapping from lower case *)
     initprocedure  %character mapping tables\ ;
	begin
	charmap[0B] := 0B;	charmap[1B] := 1B;	charmap[2B] := 2B;	charmap[3B] := 3B;
	charmap[4B] := 4B;	charmap[5B] := 5B;	charmap[6B] := 6B;	charmap[7B] := 7B;
	charmap[10B] := 10B;	charmap[11B] := 11B;	charmap[12B] := 12B;	charmap[13B] := 13B;
	charmap[14B] := 14B;	charmap[15B] := 15B;	charmap[16B] := 16B;	charmap[17B] := 17B;
	charmap[20B] := 20B;	charmap[21B] := 21B;	charmap[22B] := 22B;	charmap[23B] := 23B;
	charmap[24B] := 24B;	charmap[25B] := 25B;	charmap[26B] := 26B;	charmap[27B] := 27B;
	charmap[30B] := 30B;	charmap[31B] := 31B;	charmap[32B] := 32B;	charmap[33B] := 33B;
	charmap[34B] := 34B;	charmap[35B] := 35B;	charmap[36B] := 36B;	charmap[37B] := 37B;
	charmap[40B] := 40B;	charmap[41B] := 41B;	charmap[42B] := 42B;	charmap[43B] := 43B;
	charmap[44B] := 44B;	charmap[45B] := 45B;	charmap[46B] := 46B;	charmap[47B] := 47B;
	charmap[50B] := 50B;	charmap[51B] := 51B;	charmap[52B] := 52B;	charmap[53B] := 53B;
	charmap[54B] := 54B;	charmap[55B] := 55B;	charmap[56B] := 56B;	charmap[57B] := 57B;
	charmap[60B] := 60B;	charmap[61B] := 61B;	charmap[62B] := 62B;	charmap[63B] := 63B;
	charmap[64B] := 64B;	charmap[65B] := 65B;	charmap[66B] := 66B;	charmap[67B] := 67B;
	charmap[70B] := 70B;	charmap[71B] := 71B;	charmap[72B] := 72B;	charmap[73B] := 73B;
	charmap[74B] := 74B;	charmap[75B] := 75B;	charmap[76B] := 76B;	charmap[77B] := 77B;
	charmap[100B] := 100B;	charmap[101B] := 101B;	charmap[102B] := 102B;	charmap[103B] := 103B;
	charmap[104B] := 104B;	charmap[105B] := 105B;	charmap[106B] := 106B;	charmap[107B] := 107B;
	charmap[110B] := 110B;	charmap[111B] := 111B;	charmap[112B] := 112B;	charmap[113B] := 113B;
	charmap[114B] := 114B;	charmap[115B] := 115B;	charmap[116B] := 116B;	charmap[117B] := 117B;
	charmap[120B] := 120B;	charmap[121B] := 121B;	charmap[122B] := 122B;	charmap[123B] := 123B;
	charmap[124B] := 124B;	charmap[125B] := 125B;	charmap[126B] := 126B;	charmap[127B] := 127B;
	charmap[130B] := 130B;	charmap[131B] := 131B;	charmap[132B] := 132B;	charmap[133B] := 133B;
	charmap[134B] := 134B;	charmap[135B] := 135B;	charmap[136B] := 136B;	charmap[137B] := 137B;
	charmap[140B] := 140B;	charmap[141B] := 101B;	charmap[142B] := 102B;	charmap[143B] := 103B;
	charmap[144B] := 104B;	charmap[145B] := 105B;	charmap[146B] := 106B;	charmap[147B] := 107B;
	charmap[150B] := 110B;	charmap[151B] := 111B;	charmap[152B] := 112B;	charmap[153B] := 113B;
	charmap[154B] := 114B;	charmap[155B] := 115B;	charmap[156B] := 116B;	charmap[157B] := 117B;
	charmap[160B] := 120B;	charmap[161B] := 121B;	charmap[162B] := 122B;	charmap[163B] := 123B;
	charmap[164B] := 124B;	charmap[165B] := 125B;	charmap[166B] := 126B;	charmap[167B] := 127B;
	charmap[170B] := 130B;	charmap[171B] := 131B;	charmap[172B] := 132B;	charmap[173B] := 173B;
	charmap[174B] := 174B;	charmap[175B] := 175B;	charmap[176B] := 176B;	charmap[177B] := 177B;
(* 140 - redid numbers to make it come in the same order as ASCII *)
	setmap[0B] := 0B;	setmap[1B] := 0B;	setmap[2B] := 0B;	setmap[3B] := 0B;
	setmap[4B] := 0B;	setmap[5B] := 0B;	setmap[6B] := 0B;	setmap[7B] := 0B;
	setmap[10B] := 0B;	setmap[11B] := 1B;	setmap[12B] := 0B;	setmap[13B] := 0B;
	setmap[14B] := 0B;	setmap[15B] := 0B;	setmap[16B] := 0B;	setmap[17B] := 0B;
	setmap[20B] := 0B;	setmap[21B] := 0B;	setmap[22B] := 0B;	setmap[23B] := 0B;
	setmap[24B] := 0B;	setmap[25B] := 0B;	setmap[26B] := 0B;	setmap[27B] := 0B;
	setmap[30B] := 0B;	setmap[31B] := 0B;	setmap[32B] := 0B;	setmap[33B] := 0B;
	setmap[34B] := 0B;	setmap[35B] := 0B;	setmap[36B] := 0B;	setmap[37B] := 0B;
	setmap[40B] := 2B;	setmap[41B] := 3B;	setmap[42B] := 4B;	setmap[43B] := 5B;
	setmap[44B] := 6B;	setmap[45B] := 7B;	setmap[46B] := 10B;	setmap[47B] := 11B;
	setmap[50B] := 12B;	setmap[51B] := 13B;	setmap[52B] := 14B;	setmap[53B] := 15B;
	setmap[54B] := 16B;	setmap[55B] := 17B;	setmap[56B] := 20B;	setmap[57B] := 21B;
	setmap[60B] := 22B;	setmap[61B] := 23B;	setmap[62B] := 24B;	setmap[63B] := 25B;
	setmap[64B] := 26B;	setmap[65B] := 27B;	setmap[66B] := 30B;	setmap[67B] := 31B;
	setmap[70B] := 32B;	setmap[71B] := 33B;	setmap[72B] := 34B;	setmap[73B] := 35B;
	setmap[74B] := 36B;	setmap[75B] := 37B;	setmap[76B] := 40B;	setmap[77B] := 41B;
	setmap[100B] := 42B;	setmap[101B] := 43B;	setmap[102B] := 44B;	setmap[103B] := 45B;
	setmap[104B] := 46B;	setmap[105B] := 47B;	setmap[106B] := 50B;	setmap[107B] := 51B;
	setmap[110B] := 52B;	setmap[111B] := 53B;	setmap[112B] := 54B;	setmap[113B] := 55B;
	setmap[114B] := 56B;	setmap[115B] := 57B;	setmap[116B] := 60B;	setmap[117B] := 61B;
	setmap[120B] := 62B;	setmap[121B] := 63B;	setmap[122B] := 64B;	setmap[123B] := 65B;
	setmap[124B] := 66B;	setmap[125B] := 67B;	setmap[126B] := 70B;	setmap[127B] := 71B;
	setmap[130B] := 72B;	setmap[131B] := 73B;	setmap[132B] := 74B;	setmap[133B] := 75B;
	setmap[134B] := 76B;	setmap[135B] := 77B;	setmap[136B] := 100B;	setmap[137B] := 101B;
	setmap[140B] := 102B;	setmap[141B] := 43B;	setmap[142B] := 44B;	setmap[143B] := 45B;
	setmap[144B] := 46B;	setmap[145B] := 47B;	setmap[146B] := 50B;	setmap[147B] := 51B;
	setmap[150B] := 52B;	setmap[151B] := 53B;	setmap[152B] := 54B;	setmap[153B] := 55B;
	setmap[154B] := 56B;	setmap[155B] := 57B;	setmap[156B] := 60B;	setmap[157B] := 61B;
	setmap[160B] := 62B;	setmap[161B] := 63B;	setmap[162B] := 64B;	setmap[163B] := 65B;
	setmap[164B] := 66B;	setmap[165B] := 67B;	setmap[166B] := 70B;	setmap[167B] := 71B;
	setmap[170B] := 72B;	setmap[171B] := 73B;	setmap[172B] := 74B;	setmap[173B] := 103B;
	setmap[174B] := 104B;	setmap[175B] := 105B;	setmap[176B] := 106B;	setmap[177B] := 107B;
	end; %character mapping tables\

      %-------------------------------------------------------------------------------\

(* 40 - make it restartable *)
      procedure reinit;
	begin
	CHANTAB[1] := 0; CHANTAB[2] := 0; CHANTAB[3] := 0; CHANTAB[4] := 0;
(* 65 - remove exit labels *)
	FWPTR := NIL; LASTBTP := NIL;  FGLOBPTR := NIL ; FILEPTR := NIL ;
	LOCALPFPTR:=NIL; EXTERNPFPTR:= NIL; GLOBTESTP := NIL; ERRMPTR := NIL;
(* 24 - INITIALZE HEAP AND STACK *)
	HEAP := 0; STACK := 0;
(* 124 - initialize CREF *)
(* 125 - and REQFILE *)
	CREF := false;  reqfile := false;

	LISTCODE := FALSE; LOADNOPTR := TRUE; INITGLOBALS := FALSE ; RUNTMCHECK := TRUE;
(* 157 - separate check for arith error *)
	ARITHCHECK := TRUE;
	TTYINUSE := TRUE; FOLLOWERROR := FALSE; ERRORINLINE := FALSE; RESETFLAG := TRUE;
(* 172 - end of line *)
	TTYSEEEOL := FALSE;
	DP := TRUE; PRTERR := TRUE; ERRORFLAG := FALSE ; MAIN := TRUE;
	ENTRYDONE := FALSE; DEBUG := FALSE; DEBUGSWITCH := FALSE;
(* 176 *)
        comment_page := 0;
(* 33 - PROGRAM *)
	FPROGFILE := NIL; LPROGFILE := NIL;

	IC := HIGHSTART;     %START OF HIGHSEGMENT\
	LC := PROGRST;	     %START OF LOWSEGMENT AVAILABLE TO PROGRAM\
(* 136 - listing format *)
	CHCNT := 0; LINECNT := 1; PAGECNT := 1; SUBPAGE := 0; CURLINE := 1;
	LASTLINE := -1; LASTPAGE := 0;
(* 12 - initialize new variables for dynamic core *)
	LIBIX := 0; ERRINX := 0; LSTNEW := 0; NEWBND := 0;
	with pager.word1 do
	  begin instr:=0;ac:=0;indbit:=0;inxreg:=0;address:=0 end;
	pager.lhalf := 0; pager.rhalf := 0;
	debugentry.lastpageelem := pager;
	laststop := 0; lastpager := 0;
(* 103 - changed type for idtree's *)
	debugentry.standardidtree := nil;
	debugentry.globalidtree := nil;
	filename := '          ';
	LIBRARY[PASCALSY].INORDER   := FALSE;
	LIBRARY[FORTRANSY].INORDER  := FALSE;
	LIBRARY[ALGOLSY].INORDER    := FALSE;
	LIBRARY[COBOLSY].INORDER    := FALSE;
	LIBRARY[PASCALSY].CALLED    := FALSE;
	LIBRARY[FORTRANSY].CALLED   := FALSE;
	LIBRARY[ALGOLSY].CALLED     := FALSE;
	LIBRARY[COBOLSY].CALLED     := FALSE;
(* 105 - map lower case better *)
	setmapchain := 0;
	end;

(* 136 - new listing format *)

      procedure pagehead;
	  begin
	  page;
	  write(header,'  ',day,'     ',scandata^.relname);
	  if reqfile
	    then write('  ****Included file****');
	  write('     Page ',pagecnt:0);
	  if subpage > 0
	    then write('-',subpage:0);
	  writeln;
	  writeln;
	  curline := 1;
	  end;

      procedure newline;
	begin
	writeln;	
	curline := curline+1;
	if curline > 53
	  then begin
	  subpage := subpage + 1;
	  pagehead;
	  end
	end;

      PROCEDURE NEWPAGER;
       BEGIN
	WITH PAGER, WORD1 DO
	 BEGIN
	  AC := PAGECNT DIV 16;
	  INXREG := PAGECNT MOD 16; ADDRESS := LASTPAGER;
	  LHALF := LASTLINE; RHALF := LASTSTOP;
	  LASTLINE := -1
	 END
       END;

(* 5 - reorganized printing somewhat for CREF *)
(* The FILCOM is a bit misleading here, as global changes have been made *)
      PROCEDURE BEGOFLINE;
	BEGIN
	IF CREF THEN WRITE(CHR(177B),'A');
	IF CHCNT > CHCNTMAX THEN CHCNT := CHCNTMAX;
	 IF LISTCODE
	 THEN
	   BEGIN
(* 5 - more of the CREF change *)
	     IF BEGDP
	     THEN
	       BEGIN
		WRITE(BEGLC:6:O);
		 IF (BEGLC < PROGRST) OR (BEGLEVEL > 1)
		 THEN WRITE(' ')
		 ELSE WRITE('''')
	       END
	     ELSE WRITE(BEGIC:6:O,'''');
	    WRITE(' ':2)
	   END;
	 IF LINENR='-----'
	 THEN  WRITE(LINECNT:5)
	 ELSE  WRITE(LINENR) ;
	WRITE(' ':3);
        END;

      PROCEDURE WRITEBUFFER;
       BEGIN
	 IF LISTCODE
	 THEN
	   BEGIN
(* 5 - more CREF *)
	   IF CREF THEN WRITE(CHR(177B),'B'); BEGOFLINE;
(* 136 - listing format *)
	    WRITE(BUFFER:CHCNT); FOR CHCNT := 1 TO 17 DO BUFFER[CHCNT] := ' '; CHCNT := 17;
	   newline;
	   END
       END;

      PROCEDURE GETNEXTLINE;
       BEGIN
	 LOOP
	  GETLINENR(LINENR);
         EXIT IF INPUT^ # CHR(14B);    %TEST END OF PAGE\
	   IF DEBUG AND (LASTLINE > -1)
	   THEN NEWPAGER;
(* 136 - listing format *)
	  PAGECNT := PAGECNT + 1; SUBPAGE := 0;
	  pagehead;
(* 137 - reset line to 1 on each page *)
	  linecnt := 1;
	  READLN;  %TO OVERREAD SECOND CARRIAGE RETURN IN PAGE MARK\
	 END;
	 IF CREF
	   THEN WRITE(CHR(177B),'B');
	 BEGIC:=IC;BEGLC:=LC;BEGDP:=DP;BEGLEVEL:=LEVEL;
       END;

(* 56 - needed for file switch *)
      PROCEDURE BEGSTUFF;
	BEGIN
	IF CREF
	  THEN WRITE(CHR(177B),'B');
	BEGIC:=IC;BEGLC:=LC;BEGDP:=DP;BEGLEVEL:=LEVEL;
	CHCNT:=0
	END;

(* 16 - DETECT UNEXPECTED EOF *)
(* 41 - make restartable *)
     PROCEDURE PASXIT(VAR A,B,C:FILE); EXTERN;
(* 55 - ADD PROC'S FOR REQUIRE FILES *)
     PROCEDURE PUSHF(VAR F:FILE;S:STRGARR;L:INTEGER); EXTERN;
     PROCEDURE POPF(VAR F:FILE); EXTERN;
(* 107 - moved declaration of analys so can be used several places *)
     procedure analys(var f:file); extern;
(* 112 - clrbfi when error detected *)
     procedure clribf; extern;
(* 141 - better detection of number overflow *)
     function overflow:Boolean; extern;
(* 155 - source file name *)
     procedure curname(var f:file;var s:string); extern;

(* 56 - SEPARATE OUT STUFF NEEDED FOR FILE SWITCH *)
      PROCEDURE ENDSTUFF;
      VAR
	I,K: INTEGER;
       BEGIN
(* 5 - more CREF *)
	BEGOFLINE;
(* 136 - listing format *)
	WRITE(BUFFER:CHCNT); NEWLINE;
	 IF ERRORINLINE
	 THEN  %OUTPUT ERROR MESSAGES\
	   BEGIN
	     IF LISTCODE
	     THEN K := 11
	     ELSE K := 2;
	    WRITE(' ':K,'***** '); LISTCODE := FALSE;
	     IF LINENR = '-----'
	     THEN WRITE(TTY,LINECNT:5)
	     ELSE WRITE(TTY,LINENR);
	    WRITELN(TTY,' ':3,BUFFER:CHCNT); WRITE(TTY,'P*',PAGECNT:3,'** ');
(* 5 - more CREF *)
	    FOR K:=1 TO CHCNT DO
	     IF BUFFER[K] = CHR(11B)
	      THEN ERRLINE[K] := CHR(11B);
(* 136 - LISTING FORMAT *)
	    WRITE(ERRLINE :  CHCNT); WRITELN(TTY,ERRLINE : CHCNT); NEWLINE;
	    FOR K := 1 TO ERRINX DO
	    WITH ERRLIST[K] DO
	     BEGIN
	      WRITE(' ':15,ARW:1,'.',TIC,':  '); WRITE(TTY,ARW:1,'.',TIC,':  ');
	       IF ERRMPTR # NIL
	       THEN
		 BEGIN
		  ERRMPTR1 := ERRMPTR;
		  WHILE ERRMPTR1 # NIL DO
		  WITH ERRMPTR1^ DO
		   BEGIN
		     IF NMR = NUMBER
		     THEN
		       BEGIN
			 CASE FORM OF
			  C:
			     BEGIN
			      WRITE(STRING:10,' --> ');WRITE(TTY,STRING:10,' --> ')
			     END;
			  D:
			     BEGIN
			      WRITE(INTVAL:5,' --> ');WRITE(TTY,INTVAL:5,' --> ')
			     END
			 END;
			NUMBER := 0; ERRMPTR1 := NIL
		       END
		     ELSE ERRMPTR1 := NEXT
		   END
		 END;
	      I := NMR MOD 50;
	       CASE NMR DIV 50 OF
		3:
		   BEGIN
		    WRITE(ERRMESS15[I]); WRITE(TTY,ERRMESS15[I])
		   END;
		4:
		   BEGIN
		    WRITE(ERRMESS20[I]); WRITE(TTY,ERRMESS20[I])
		   END;
		5:
		   BEGIN
		    WRITE(ERRMESS25[I]); WRITE(TTY,ERRMESS25[I])
		   END;
		6:
		   BEGIN
		    WRITE(ERRMESS30[I]); WRITE(TTY,ERRMESS30[I])
		   END;
		7:
		   BEGIN
		    WRITE(ERRMESS35[I]); WRITE(TTY,ERRMESS35[I])
		   END;
		8:
		   BEGIN
		    WRITE(ERRMESS40[I]); WRITE(TTY,ERRMESS40[I])
		   END;
		9:
		   BEGIN
		    WRITE(ERRMESS45[I]); WRITE(TTY,ERRMESS45[I])
		   END;
		10:
		    BEGIN
		     WRITE(ERRMESS50[I]); WRITE(TTY,ERRMESS50[I])
		    END;
		11:
		    BEGIN
		     WRITE(ERRMESS55[I]); WRITE(TTY,ERRMESS55[I])
		    END
	       END;
(* 136 - LISTING FORMAT *)
	      newline; WRITELN(TTY)
	     END;
(* 26 - break not needed for TTY *)
	    ERRINX := 0; ERRORINLINE := FALSE;
	    FOR I := 1 TO CHCNT DO ERRLINE [I] := ' ';
	    ERRMPTR := NIL
	   END;
(* 56 -SEPARATE OUT STUFF NEEDED FOR FILE SWITCH *)
        END;

      PROCEDURE ENDOFLINE(OKEOF:BOOLEAN);
	BEGIN
	ENDSTUFF;
(* 16 - DETECT UNEXPECTED EOF *)
        IF EOF(INPUT) AND NOT OKEOF
	  THEN BEGIN
(* 136 - LISTING FORMAT *)
	  WRITE('Unexpected end of file'); NEWLINE;
	  WRITELN(TTY,'?  Unexpected end of file');
(* 176 - error for unexpected EOF in a comment *)
          if comment_page <> 0 then	(* we're in a comment *)
                 begin
                    write('Unterminated Comment at ',comment_page:0,
			  '/',comment_line:0); NEWLINE;
                    writeln(tty,'?  Unterminated Comment at ',comment_page:0,
			    '/',comment_line:0)
		 end;
(* 41 - make restartable *)
(* 107 - abort creation of rel file on error *)
	  rewrite(outputrel);
(* 112 - clrbfi when error *)
	  clribf;
(* 125 - popf to be sure we get main file closed in reqfile *)
	  if reqfile
	    then begin
	    close(input);
	    popf(input)
	    end;
	  PASXIT(INPUT,OUTPUT,OUTPUTREL)
	  END;
	READLN;
(* 147 - move incr linecnt here so first line of new page is 1 *)
	LINECNT := LINECNT + 1;
	 IF NOT EOF(INPUT)
	 THEN GETNEXTLINE;
(* 136 - listing format *)
        CHCNT := 0
       END  %ENDOFLINE\ ;

      PROCEDURE ERROR(FERRNR: INTEGER);
      VAR
	LPOS,LARW : INTEGER;
       BEGIN
	 IF NOT FOLLOWERROR
	 THEN
	   BEGIN
	    ERRORFLAG := TRUE ;
	     IF ERRINX >= MAXERR
	     THEN
	       BEGIN
		ERRLIST[MAXERR].NMR := 410; ERRINX := MAXERR
	       END
	     ELSE
	       BEGIN
		ERRINX := ERRINX + 1;
	        WITH ERRLIST[ERRINX] DO BEGIN NMR := FERRNR; TIC := '^' END
	       END;
	    FOLLOWERROR := TRUE; ERRORINLINE := TRUE;
	    IF (FERRNR # 215)
	    AND (FERRNR # 356)
	    AND (FERRNR # 405)
	    AND (FERRNR # 464)
	    THEN
	     IF EOLN(INPUT)
	     THEN ERRLINE [CHCNT] := '^'
	     ELSE ERRLINE [CHCNT-1] := '^'
	    ELSE ERRLIST[ERRINX].TIC := ' ';
	     IF ERRINX > 1
	     THEN
	      WITH ERRLIST [ ERRINX-1] DO
	       BEGIN
		LPOS := POS; LARW := ARW
	       END;
	    WITH ERRLIST [ERRINX] DO
	     BEGIN
	      POS := CHCNT;
	       IF ERRINX = 1
	       THEN ARW := 1
	       ELSE
		 IF LPOS = CHCNT
		 THEN ARW := LARW
		 ELSE ARW := LARW + 1
	     END;
	   END;
       END %ERROR\ ;

      PROCEDURE ERRORWITHTEXT ( FERRNR: INTEGER; FTEXT: ALFA ) ;
       BEGIN
	ERROR(FERRNR); NEWZ(ERRMPTR1,C);
	WITH ERRMPTR1^ DO
	 BEGIN
	  NUMBER := FERRNR; STRING := FTEXT;
	  NEXT := ERRMPTR
	 END;
	ERRMPTR := ERRMPTR1
       END %ERROR WITH TEXT\ ;

      PROCEDURE INSYMBOL;
	%READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS
	 DESCRIPTION IN THE GLOBAL VARIABLES SY, OP, ID, VAL AND LGTH\
(* 114 - prevent recursive comment scanning *)
      LABEL 2;
      CONST
(* 210 - allow 9 digit hex numbers *)
	hexmax = 9;
	DIGMAX = 12; MAX8 =  37777777777B;
	TEST8 =  40000000000B;
	MIN8 = 400000000000B;
(* 142 - better real number scanning *)
	MAX10 = 3435973836; {maximum number, sans last digit}
	MAX16 = 17777777777B;
	MAXEXP = 35;
      type
(* 43 - allow 12 digit octal no. *)
	numconv=record case Boolean of
		true:(oct:packed array[1:digmax]of 0..7);
		false:(int:integer)
		       end;
(* 210 - allow 9 digit hex numbers *)
	hexconv=record case Boolean of
		true:(hex:packed array[1..hexmax] of 0..15);
		false:(int:integer)
		       end;
      VAR
(* 133 - make real numbers be read exactly *)
	I,K,ASCALE,SCALE,EXP,IVAL: INTEGER;
	RVAL,R,FAC: REAL; STRINGTOOLONG,SIGN: BOOLEAN;
	DIGIT: ARRAY [1..DIGMAX] OF 0..9;
	STRING: ARRAY [1..STRGLGTH] OF CHAR;
	LVP: CSP;
(* 43 - allow 12 digit octal no. *)
	nc:numconv;
(* 210 - allow 9 digit hex numbers *)
	hc:hexconv;

	PROCEDURE NEXTCH;
	 BEGIN
	   IF EOLN(INPUT)
	   THEN CH := ' '
	   ELSE
	     BEGIN
	      %READ(CH);\  CH := INPUT^; GET(INPUT); %THIS CHANGE SAVES 3 INSTRUCTIONS AT RUN-TIME\
	      CHCNT := CHCNT + 1;
	       IF CHCNT <= CHCNTMAX
	       THEN BUFFER[CHCNT] := CH
(* 3 - map lower case to upper.  Need separate NEXTCH for strings now,
       since we don't do mapping there. *)
	     END;
(* 105 - improve lower case mapping *)
	   ch := chr(charmap[ord(ch)]);
	 END;

	PROCEDURE NEXTSTRCH;
	 BEGIN
	   IF EOLN(INPUT)
	   THEN CH := ' '
	   ELSE
	     BEGIN
	      CH := INPUT^; GET(INPUT);
	      CHCNT := CHCNT + 1;
	       IF CHCNT <= CHCNTMAX
	       THEN BUFFER[CHCNT] := CH
	     END
	 END;

	PROCEDURE OPTIONS;
	VAR
	  LCH : CHAR; LSWITCH : BOOLEAN;
	 BEGIN
	   REPEAT
	    NEXTCH; LCH := CH;
	     IF NOT (CH IN ['\','*'])
	     THEN NEXTCH;
	     IF NOT (CH IN ['+','-'])
(* 24 - S AND H FOR STACK AND HEAP *)
(* 33 - version *)
	     THEN IF (LCH IN ['H','S','V']) AND (CH = ':')
		THEN BEGIN
		     NEXTCH;
		     INSYMBOL;
		     IF SY # INTCONST
			THEN ERROR(203)
(* 24 - S AND H FOR STACK AND HEAP *)
			ELSE BEGIN
(* 33 - version *)
			IF LCH IN ['H','S']
			  THEN BEGIN
			  IF (VAL.IVAL MOD 1000B) = 0
			    THEN VAL.IVAL := VAL.IVAL -1;
			  VAL.IVAL := (VAL.IVAL DIV 1000B)*1000B + 777B;
			  END;
		          IF LCH = 'S'
		            THEN STACK := VAL.IVAL
(* 33 - version *)
			  ELSE IF LCH = 'H'
			    THEN HEAP := VAL.IVAL
			  ELSE VERSION.WORD := VAL.IVAL
			  END
		     END
		ELSE ERROR(203)
	     ELSE
	       BEGIN
		LSWITCH := CH = '+';
(* 157 - use CASE instead of IF nest *)
		CASE LCH OF
		  'L':  LISTCODE := LSWITCH;
		  'T':  IF RESETFLAG THEN TTYINUSE := LSWITCH;
		  'M':  IF RESETFLAG THEN MAIN := LSWITCH;
		  'C':  BEGIN RUNTMCHECK := LSWITCH; ARITHCHECK := LSWITCH END;
		  'A':  ARITHCHECK := LSWITCH;
		  'Z':  ZERO := LSWITCH;
		  'D':  BEGIN
			    DEBUGSWITCH := LSWITCH;
(* 36 - allow us to reset debug at beginning *)
			    if resetflag
			      then debug := lswitch
			      else IF LSWITCH
			        THEN DEBUG := TRUE
			END
		  END
	       END;
	     IF EOLN(INPUT)
(* 16 - EOF *)
	     THEN ENDOFLINE(FALSE);
	     IF NOT ((CH IN ['\','*']) OR (LCH = 'H'))
	     THEN NEXTCH
	   UNTIL CH # ','
	 END   %OPTIONS\ ;

(* 1 - reorganized a bit here, mainly to improve comment scanning *)
	PROCEDURE NEWCH;
	BEGIN
(* 16 - EOF *)
	  IF EOLN(INPUT) THEN ENDOFLINE(FALSE);
	  NEXTCH
	END;

	PROCEDURE SCANCOMMENT(STOPCH:CHAR);
	BEGIN
(* 176 - error for unexpected EOF in a comment *)
	  comment_page := pagecnt; { pagecnt had better not be 0 }
	  comment_line := linecnt;
	  NEWCH;
	  IF CH='$' THEN OPTIONS;
(* 105 - curly brackets are now comments *)
	  if (stopch = '\') or (stopch = '}')
	    then while ch # stopch do newch
	  ELSE REPEAT WHILE CH#'*' DO NEWCH; NEXTCH UNTIL CH=STOPCH;
(* 176 - error for unexpected EOF in a comment *)
	  comment_page := 0;
(* 114 - prevent deep recursion in comment scanning *)
	  NEWCH;
	END;

       BEGIN    2:
	%INSYMBOL\
          WHILE (CH = ' ') OR (ORD(CH) = 11B) DO
	   BEGIN
	     IF EOLN(INPUT)
(* 16 - EOF *)
	     THEN ENDOFLINE(FALSE);
	    NEXTCH;
	   END;
(* 1 - code removed here for comments.  Handled better elsewhere *)
	 CASE CH OF
	  'A','B','C','D','E','F','G','H','I',
	  'J','K','L','M','N','O','P','Q','R',
	  'S','T','U','V','W','X','Y','Z':
					   BEGIN
					    K := 0 ; ID := '          ';
					     REPEAT
					       IF K < ALFALENG
					       THEN
						 BEGIN
						  K := K + 1; ID[K] := CH
						 END ;
					      NEXTCH
					     UNTIL  NOT (CH IN LETTERSDIGITSORLEFTARROW);
					    FOR I := FRW[K] TO FRW[K+1] - 1 DO
					     IF RW[I] = ID
					     THEN
					       BEGIN
						SY := RSY[I]; OP := ROP[I]; GOTO 1
					       END;
					    SY := IDENT; OP := NOOP;
1:
					   END;
	  '0','1','2','3','4','5','6','7','8','9':
						   BEGIN
(* 141 - better way to check overflow *)
						    if overflow then; {clear old errors}
						    SY := INTCONST; OP := NOOP;
(* 64 - non-loc goto *)
						    id := '          ';
						    I := 0;
						     REPEAT
						      I := I + 1;
						      if i <= alfaleng
							then id[i] := ch;
						       IF I <= DIGMAX
(* 142 - better real scanning *)
						       THEN DIGIT[I] := ORD(CH) - ORD('0');
						      NEXTCH
						     UNTIL  NOT (CH IN DIGITS);
						    IVAL := 0;
						     IF CH = 'B'
						     THEN
						       BEGIN
(* 43 - allow 12 digit octal no. *)
(* 142 - better real number scanning *)
							if i > digmax
							  then begin
							  error(174);
							  i := digmax
							  end;
							nc.int:=0;
							FOR K := 1 TO I DO
							     IF DIGIT[K] IN [8,9]
							     THEN ERROR(252)
							     else nc.oct[k+digmax-i]:=digit[k];
							val.ival := nc.int;
							NEXTCH
						       END
						     ELSE
						       BEGIN
(* 142 - better real number scanning *)
						       scale := 0;
							FOR K := 1 TO I DO
							  if scale > 0
							    then scale := scale + 1
							  else if ival < max10
							    then ival := 10*ival + digit[k]
							  else if (ival = max10) and (digit[k] <= 7)
							    then ival := 10*ival + digit[k]
							  else scale := scale + 1;
							 IF CH = '.'
							 THEN
							   BEGIN
							    NEXTCH;
							     IF CH = '.'
							     THEN CH := ':'
							     ELSE
							       BEGIN
(* 142 - better real scanning *)
								 SY := REALCONST;
								 IF  NOT (CH IN DIGITS)
								 THEN ERROR(205)
								 ELSE
								   REPEAT
							           if scale > 0
							             then scale := scale + 1
							           else if ival < max10
							             then ival := 10*ival + (ord(ch)-ord('0'))
							           else if (ival = max10) and (ch <= '7')
							             then ival := 10*ival + (ord(ch)-ord('0'))
							           else scale := scale + 1;
								    SCALE := SCALE - 1; NEXTCH
								   UNTIL  NOT (CH IN DIGITS);
							       END
							   END;
							 IF CH = 'E'
							 THEN
							   BEGIN
(* 142 - better real scan *)
							    sy := realconst;
							    NEXTCH;
							    SIGN := CH='-';
							     IF (CH='+') OR (CH='-')
							     THEN NEXTCH;
							    EXP := 0;
							     IF  NOT (CH IN DIGITS)
							     THEN ERROR(205)
							     ELSE
							       REPEAT
								EXP := 10*EXP + (ORD(CH) - ORD('0'));
								NEXTCH
							       UNTIL  NOT (CH IN DIGITS);
							     IF SIGN
							     THEN SCALE := SCALE - EXP
							     ELSE SCALE := SCALE + EXP;
							   END;
(* 142 - better real scan *)
							 if sy = realconst
							 then begin
							 rval := ival;
							 IF SCALE # 0
							 THEN
							   BEGIN
(* 113 - reorganized to handle exact fractions exactly *)
							    FAC := 10.0;
							    ASCALE := ABS(SCALE);
(* 141 - prevent overflow for exp > 32 *)
							     LOOP
							       IF ODD(ASCALE)
							       THEN if scale > 0
								 then rval := rval*FAC
								 else rval := rval/fac;
							      ASCALE := ASCALE DIV 2;
							     EXIT IF ASCALE=0;
							      FAC := SQR(FAC);
							     END;
(* 141 - better overflow error handling *)
							   IF OVERFLOW
							     THEN BEGIN
							     ERROR(206);
							     RVAL := 0.0
							     END;
							   END;
(* 142 - better real scanning *)
							 newz(lvp,reel);
							 lvp^.rval := rval;
							 val.valp := lvp
							 end {real}
							else {integer}
							 if scale = 0
							   then VAL.IVAL := IVAL
							   else begin
							     error(204);
							     val.ival := 0
							     end;
						       END
						   END;
	  '"':
	       BEGIN
		SY := INTCONST; OP := NOOP; IVAL := 0; I := 0; hc.int := 0;
		NEXTCH;
		WHILE CH IN HEXADIGITS DO
		 BEGIN
		     i := i + 1;
		     if i <= hexmax then
			 IF CH IN DIGITS
			     THEN  digit[i] := 16*IVAL + ORD(CH) - ORD('0')
			     ELSE  digit[i] := 16*IVAL + ORD(CH) - 67B;
		     NEXTCH
		 END;
		if i > hexmax then
		    begin
			error(174);
			i := hexmax
		    end;
		for k := 1 to i do
		    hc.hex[k+hexmax-i] := digit[k];
		VAL.IVAL := hc.int;
	       END;
	  '''':
		BEGIN
		 LGTH := 0; SY := STRINGCONST;	OP := NOOP;STRINGTOOLONG := FALSE;
		  REPEAT
		    REPEAT
(* 3 - different NEXTCH so don't map lower case, etc. *)
		     NEXTSTRCH;
		      IF LGTH < STRGLGTH
		      THEN
			BEGIN
			 LGTH := LGTH + 1; STRING[LGTH] := CH
			END
		      ELSE STRINGTOOLONG := TRUE
		    UNTIL (EOLN(INPUT)) OR (CH = '''');
		    IF STRINGTOOLONG
		    THEN ERROR(301);
		    IF EOLN(INPUT)  AND  (CH#'''')
		    THEN ERROR(351)
(* 3 - different NEXTCH so don't map lower case, etc. *)
(* 6 - don't use nextstrch for char after end of string[caused loop] *)
		    ELSE NEXTCH  %this is embedded ' or char after string\
		  UNTIL CH # '''';
		 LGTH := LGTH - 1;   %NOW LGTH = NR OF CHARS IN STRING\
		  IF LGTH = 1
		  THEN VAL.IVAL := ORD(STRING[1])
		  ELSE
		    BEGIN
		     NEWZ(LVP,STRG:LGTH);
		     WITH LVP^ DO
		      BEGIN
		       SLGTH := LGTH;
		       FOR I := 1 TO LGTH DO SVAL[I] := STRING[I]
		      END;
		     VAL.VALP := LVP
		    END
		END;
	  ':':
	       BEGIN
		OP := NOOP; NEXTCH;
		 IF CH = '='
		 THEN
		   BEGIN
		    SY := BECOMES; NEXTCH
		   END
		 ELSE SY := COLON
	       END;
	  '.':
	       BEGIN
		OP := NOOP; NEXTCH;
		 IF CH = '.'
		 THEN
		   BEGIN
		    SY := COLON; NEXTCH
		   END
		 ELSE SY := PERIOD
	       END;
	  '?','*','&','+','-','!','\',
(* 1 - / now handled elsewhere *)
	  '@','#','=',
	  ')','[',']',',',';','^','_','$':
					   BEGIN
					    SY := SSY[CH]; OP := SOP[CH];
					    NEXTCH
					   END;

	  '(':
	       BEGIN
		NEXTCH;
(* 1 - improved comment scanning *)
		IF CH='*' THEN BEGIN SCANCOMMENT(')'); GOTO 2 END
		ELSE BEGIN SY := LPARENT; OP := NOOP END
	       END;


	  '{':
	        BEGIN SCANCOMMENT('}'); GOTO 2 END;
	  '%':
		BEGIN SCANCOMMENT('\'); GOTO 2 END;

	  '/':
		BEGIN
		  NEXTCH;
		  IF CH='*' THEN BEGIN SCANCOMMENT('/'); GOTO 2 END
		  ELSE BEGIN SY := MULOP; OP := RDIV END
		END;


	  '<','>':
		   BEGIN
		    SY := SSY[CH]; OP := SOP[CH]; NEXTCH;
		     IF CH = '='
		     THEN
		       BEGIN
			 IF OP = LTOP
			 THEN OP := LEOP
			 ELSE OP := GEOP;
			NEXTCH
		       END
(* 6 - allow <> for not equals *)
		     ELSE IF (CH = '>') AND (OP = LTOP)
		       THEN
			BEGIN
			OP := NEOP;
			NEXTCH
			END
		   END;
(* 6 - add error msg in case of illegal character *)
	  OTHERS:
		BEGIN
		ERROR(216);
		NEWCH;
		INSYMBOL
		END
	 END %CASE\
       END %INSYMBOL\ ;

      PROCEDURE ENTERID(FCP: CTP);
	%ENTER ID POINTED AT BY FCP INTO THE NAME-TABLE,
	 WHICH ON EACH DECLARATION LEVEL IS ORGANISED AS
	 AN UNBALANCED BINARY TREE\
      VAR
	NAM: ALFA; LCP, LCP1: CTP; LLEFT: BOOLEAN;
       BEGIN
	NAM := FCP^.NAME;
(* 5 - CREF *)
        IF CREF
	  THEN WRITE(CHR(1B),CHR(21),NAM,' ',DISPLAY[TOP].BLKNAME,CHR(2B));
	LCP := DISPLAY[TOP].FNAME;
	 IF LCP = NIL
	 THEN
	  DISPLAY[TOP].FNAME := FCP
	 ELSE
	   BEGIN
	     REPEAT
	      LCP1 := LCP;
	       IF LCP^.NAME <= NAM
	       THEN
		 BEGIN
		   IF LCP^.NAME = NAM
		   THEN ERROR(302) %NAME CONFLICT\;
		  LCP := LCP^.RLINK; LLEFT := FALSE
		 END
	       ELSE
		 BEGIN
		  LCP := LCP^.LLINK; LLEFT := TRUE
		 END
	     UNTIL LCP = NIL;
	     IF LLEFT
	     THEN LCP1^.LLINK := FCP
	     ELSE LCP1^.RLINK := FCP
	   END;
	WITH FCP^ DO
	 BEGIN
	  LLINK := NIL; RLINK := NIL; SELFCTP := NIL
	 END
       END %ENTERID\ ;

      PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP);
	%TO FIND RECORD FIELDS AND FORWARD DECLARED PROCEDURE ID'S
	 --> PROCEDURE PROCEDUREDECLARATION
	 --> PROCEDURE SELECTOR\
       BEGIN
	WHILE FCP # NIL DO
	WITH FCP^ DO
	 BEGIN
	   IF NAME = ID
	   THEN GOTO 1;
	   IF NAME < ID
	   THEN FCP := RLINK
	   ELSE FCP := LLINK
	 END;
1:
	FCP1 := FCP
       END %SEARCHSECTION\ ;

      PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP);
      VAR
	LCP: CTP;
       BEGIN
	FOR DISX := TOP DOWNTO 0 DO
	 BEGIN
	  LCP := DISPLAY[DISX].FNAME;
	  WHILE LCP # NIL DO
	  WITH LCP^ DO
	   IF NAME = ID
	   THEN
	     IF KLASS IN FIDCLS
	     THEN GOTO 1
	     ELSE
	       BEGIN
		 IF PRTERR
		 THEN ERROR(401);
(* 170 - fix error handling for forwards *)
		GOTO 2
	       END
	   ELSE
	     IF NAME < ID
	     THEN
	      LCP := RLINK
	     ELSE LCP := LLINK
	 END;
2:	 LCP := NIL;  {Use NIL if don't find something better below}
(* 5 - save some info for so CREF will know the block name *)
	 DISX := TOP; %IF FORWARD, WILL BE IN THIS BLOCK\
(* 114 - use only real block names *)
(* 116 - more elegant way to do this *)
         WHILE DISPLAY[DISX].OCCUR <> BLCK DO
	   DISX := DISX - 1;
	%SEARCH NOT SUCCSESSFUL; SUPPRESS ERROR MESSAGE IN CASE
	 OF FORWARD REFERENCED TYPE ID IN POINTER TYPE DEFINITION
	 --> PROCEDURE SIMPLETYPE\
	 IF PRTERR
	 THEN
	   BEGIN
	    ERROR(253);
	    %TO AVOID RETURNING NIL, REFERENCE AN ENTRY
	     FOR AN UNDECLARED ID OF APPROPRIATE CLASS
	     --> PROCEDURE ENTERUNDECL\
	     IF TYPES IN FIDCLS
	     THEN LCP := UTYPPTR
	     ELSE
	       IF VARS IN FIDCLS
	       THEN LCP := UVARPTR
	       ELSE
		 IF FIELD IN FIDCLS
		 THEN LCP := UFLDPTR
		 ELSE
		   IF KONST IN FIDCLS
		   THEN LCP := UCSTPTR
		   ELSE
		     IF PROC IN FIDCLS
		     THEN LCP := UPRCPTR
(* 64 - non-loc gotos *)
		     ELSE IF FUNC IN FIDCLS
			THEN LCP := UFCTPTR
			ELSE LCP := ULBLPTR;
	   END;
1:
(* 5 - CREF *)
	IF CREF
	  THEN WRITE(CHR(1B),CHR(21),ID,' ',DISPLAY[DISX].BLKNAME);
	FCP := LCP
       END %SEARCHID\ ;

      PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: INTEGER);
	%GET INTERNAL BOUNDS OF SUBRANGE OR SCALAR TYPE\
	%ASSUME (FSP # NIL) AND (FSP^.FORM <= SUBRANGE) AND (FSP # INTPTR)
	 AND  NOT COMPTYPES(REALPTR,FSP)\
       BEGIN
	WITH FSP^ DO
	 IF FORM = SUBRANGE
	 THEN
	   BEGIN
	    FMIN := MIN.IVAL; FMAX := MAX.IVAL
	   END
	 ELSE
	   BEGIN
	    FMIN := 0;
	     IF FSP = CHARPTR
	     THEN FMAX := 177B
	     ELSE
	       IF FCONST # NIL
	       THEN
		FMAX := FCONST^.VALUES.IVAL
	       ELSE FMAX := 0
	   END
       END %GETBOUNDS\ ;

(* 6 - move error stuff outside BLOCK so PROGSTAT can use it *)
	PROCEDURE SKIPIFERR(FSYINSYS:SETOFSYS; FERRNR:INTEGER; FSKIPSYS: SETOFSYS);
	VAR
	  I,OLDCHCNT,OLDLINECNT : INTEGER;
	 BEGIN
	   IF NOT (SY IN FSYINSYS)
	   THEN
	     BEGIN
	      ERROR(FERRNR);
	      OLDLINECNT := LINECNT; OLDCHCNT := CHCNT;
	      WHILE NOT (SY IN FSKIPSYS OR FSYINSYS) DO
	       BEGIN
		 IF OLDLINECNT # LINECNT
		 THEN OLDCHCNT := 1;
		FOR I := OLDCHCNT TO CHCNT-1 DO
		 IF I <= CHCNTMAX
		 THEN ERRLINE [I] := '*';
		OLDCHCNT := CHCNT; OLDLINECNT := LINECNT; ERRORINLINE := TRUE;
		INSYMBOL
	       END;
	      %SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND\
	     END;
	  FOLLOWERROR := FALSE
	 END;

	PROCEDURE IFERRSKIP(FERRNR: INTEGER; FSYS: SETOFSYS);
	 BEGIN
	  SKIPIFERR(FSYS,FERRNR,FSYS)
	 END;

	PROCEDURE ERRANDSKIP(FERRNR: INTEGER; FSYS: SETOFSYS);
	 BEGIN
	  SKIPIFERR([ ],FERRNR,FSYS)
	 END;

(* 6 - add PROGRAM statement *)
      PROCEDURE PROGSTAT;
(* 34 - allow list of entry point names *)
	  VAR STSYM,ENDSYM:SYMBOL;
        BEGIN
	IF SY=PROGRAMSY
	  THEN
	    BEGIN
(* 34 - allow entry point names *)
	    IF MAIN
	      THEN BEGIN STSYM:=LPARENT; ENDSYM := RPARENT END
	      ELSE BEGIN STSYM:=COMMA; ENDSYM := SEMICOLON END;
	    INSYMBOL;
	    IF SY # IDENT THEN ERROR(209);
(* 33 NO LONGER NEED ENTRY *)
	    FILENAME := ID;
	    INSYMBOL;
(* 34 - DIFFERENT SYNTAX FOR ENTRY POINTS *)
	    IF SY = STSYM
	     THEN BEGIN
	      REPEAT
	      INSYMBOL;
	      IF NOT (SY = IDENT)
		THEN ERROR(209);
(* 33 - USE FILE NAMES *)
	      NEWZ(NPROGFILE);
	      NPROGFILE^.FILID := ID;
	      NPROGFILE^.NEXT := NIL;
	      IF FPROGFILE = NIL
		THEN BEGIN
		FPROGFILE := NPROGFILE;
		LPROGFILE := NPROGFILE
		END
	       ELSE BEGIN
		LPROGFILE^.NEXT := NPROGFILE;
		LPROGFILE := NPROGFILE
		END;
	      INSYMBOL;
(* 61 - allow +* in tops20 *)
(* 144 - allow this stuff in tops10, too *)
	      if (sy=colon) and main
		then begin
		insymbol;
		while sy in [addop,mulop,relop] do
		  begin
		  if (op = mul) and (not tops10)
		    then nprogfile^.wild := true
		  else if op = plus
		    then nprogfile^.newgen := true
		  else if op = minus
		    then nprogfile^.oldfile := true
(* 64 - input:/ *)
		  else if op = rdiv
		    then nprogfile^.interact := true
(* 172 - new EOLN treatment *)
		  else if op = neop
		    then nprogfile^.seeeol := true
		  else error(158);
		  insymbol
		  end;
		end;
(* 34 - DIFFERENT SYNTAX FOR ENTRY POINTS *)
	      IFERRSKIP(158,[ENDSYM,COMMA])
	      UNTIL SY=ENDSYM;
	     IF MAIN THEN INSYMBOL
	     END;
(* 21 - Allow null file list in prog. statement *)
	    IFERRSKIP(156,[SEMICOLON]);
	    INSYMBOL
	    END
	END;

      PROCEDURE BLOCK(FPROCP: CTP; FSYS,LEAVEBLOCKSYS: SETOFSYS);
      VAR
(* 56 - add reqfile for require files *)
(* 125 - reqfile moved *)
(* 65 - remove exit labels *)
	LSY: SYMBOL;
(* 136 - listing format *)
	ORIGLINENR:PACKED ARRAY[1:5]OF CHAR;
	ORIGPAGECNT,ORIGSUBPAGE,ORIGLINECNT:INTEGER; 
	ORIGPAGE:PAGEELEM; ORIGCH:CHAR;
(* 24 - testpacked no longer needed *)
	LCPAR: ADDRRANGE;%SAVES LOCATION FROM WHERE
			  LOCAL AREAS ARE SET TO ZERO\
	HEAPMARK,GLOBMARK: INTEGER;
	FORWPTR : CTP;		 %TEST FOR FORWORD DECLARED PROCEDURES\


	PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU);
	VAR
	  LSP,LSP1: STP; LCP: CTP; SIGN: (NONE,POS,NEG);
	 BEGIN
	  LSP := NIL; FVALU.IVAL := 0;
	  SKIPIFERR(CONSTBEGSYS,207,FSYS);
	   IF SY IN CONSTBEGSYS
	   THEN
	     BEGIN
	       IF SY = STRINGCONST
	       THEN
		 BEGIN
		   IF LGTH = 1
		   THEN LSP := CHARPTR
		   ELSE
		     IF LGTH = ALFALENG
		     THEN LSP := ALFAPTR
		     ELSE
		       BEGIN
			NEWZ(LSP,ARRAYS); NEWZ(LSP1,SUBRANGE);
			WITH LSP^ DO
			 BEGIN
			  AELTYPE := CHARPTR; INXTYPE := LSP1;
			  SIZE := (LGTH+4) DIV 5; ARRAYPF := TRUE;
(* 211 - make PASDDT able to see this *)
			  BITSIZE := BITMAX; SELFSTP := NIL
			 END;
			WITH LSP1^ DO
			 BEGIN
			  SIZE := 1; BITSIZE := BITMAX;
			  MIN.IVAL := 1; MAX.IVAL := LGTH; RANGETYPE  := NIL
			 END
		       END;
		  FVALU := VAL; INSYMBOL
		 END
	       ELSE
		 BEGIN
		  SIGN := NONE;
		   IF (SY = ADDOP) AND (OP IN [PLUS,MINUS])
		   THEN
		     BEGIN
		       IF OP = PLUS
		       THEN SIGN := POS
		       ELSE SIGN := NEG;
		      INSYMBOL
		     END;
		   IF SY = IDENT
		   THEN
		     BEGIN
		      SEARCHID([KONST],LCP);
		      WITH LCP^ DO
		       BEGIN
			LSP := IDTYPE; FVALU := VALUES
		       END;
		       IF SIGN # NONE
		       THEN
			 IF LSP = INTPTR
			 THEN
			   BEGIN
			     IF SIGN = NEG
			     THEN FVALU.IVAL := -FVALU.IVAL
			   END
			 ELSE
			   IF LSP = REALPTR
			   THEN
			     BEGIN
			       IF SIGN = NEG
			       THEN
				FVALU.VALP^.RVAL := -FVALU.VALP^.RVAL
			     END
			   ELSE ERROR(167);
		      INSYMBOL;
		     END
		   ELSE
		     IF SY = INTCONST
		     THEN
		       BEGIN
			 IF SIGN = NEG
			 THEN VAL.IVAL := -VAL.IVAL;
			LSP := INTPTR; FVALU := VAL; INSYMBOL
		       END
		     ELSE
		       IF SY = REALCONST
		       THEN
			 BEGIN
			   IF SIGN = NEG
			   THEN VAL.VALP^.RVAL := -VAL.VALP^.RVAL;
			  LSP := REALPTR; FVALU := VAL; INSYMBOL
			 END
		       ELSE ERRANDSKIP(168,FSYS)
		 END;
	      IFERRSKIP(166,FSYS);
	     END;
	  FSP := LSP
	 END %CONSTANT\ ;

	FUNCTION COMPTYPES(FSP1,FSP2: STP) : BOOLEAN;
	  %DECIDE WHETHER STRUCTURES POINTED AT BY FSP1 AND FSP2 ARE COMPATIBLE\
	VAR
	  NXT1,NXT2: CTP; COMP: BOOLEAN; LMIN,LMAX,I: INTEGER;
	  LTESTP1,LTESTP2: TESTP;
	 BEGIN
	   IF FSP1 = FSP2
	   THEN COMPTYPES := TRUE
	   ELSE
	     IF (FSP1 # NIL) AND (FSP2 # NIL)
	     THEN
	       IF FSP1^.FORM = FSP2^.FORM
	       THEN
		 CASE FSP1^.FORM OF
		  SCALAR:
			 COMPTYPES := FALSE;
			 % IDENTICAL SCALARS DECLARED ON DIFFERENT LEVELS ARE
			  NOT RECOGNIZED TO BE COMPATIBLE\
		  SUBRANGE:
			   COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2^.RANGETYPE);
		  POINTER:
			   BEGIN
			    COMP := FALSE; LTESTP1 := GLOBTESTP; LTESTP2 := GLOBTESTP;
			    WHILE LTESTP1 # NIL DO
			    WITH LTESTP1^ DO
			     BEGIN
			       IF (ELT1 = FSP1^.ELTYPE) AND (ELT2 = FSP2^.ELTYPE)
			       THEN COMP := TRUE;
			      LTESTP1 := LASTTESTP
			     END;
			     IF NOT COMP
			     THEN
			       BEGIN
				NEWZ(LTESTP1);
				WITH LTESTP1^ DO
				 BEGIN
				  ELT1 := FSP1^.ELTYPE;
				  ELT2 := FSP2^.ELTYPE;
				  LASTTESTP := GLOBTESTP
				 END;
				GLOBTESTP := LTESTP1; COMP := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE)
			       END;
			    COMPTYPES := COMP; GLOBTESTP := LTESTP2
			   END;
		  POWER:
			COMPTYPES := COMPTYPES(FSP1^.ELSET,FSP2^.ELSET);
		  ARRAYS:
			  BEGIN
			   GETBOUNDS (FSP1^.INXTYPE,LMIN,LMAX);
			   I := LMAX-LMIN;
			   GETBOUNDS (FSP2^.INXTYPE,LMIN,LMAX);
			   COMPTYPES := COMPTYPES(FSP1^.AELTYPE,FSP2^.AELTYPE)
			   AND (FSP1^.ARRAYPF = FSP2^.ARRAYPF) AND ( I = LMAX - LMIN ) ;
			  END;
			 %ALTERNATIVES: -- ADD A THIRD BOOLEAN TERM: INDEXTYPE MUST
			  BE COMPATIBLE. MAY GIVE TROUBLE FOR ASSIGNMENT OF STRINGCONSTANTS
			  -- ADD A FOURTH BOOLEAN TERM: LOWBOUNDS MUST
			  BE THE SAME\
		  RECORDS:
			   BEGIN
			    NXT1 := FSP1^.FSTFLD; NXT2 := FSP2^.FSTFLD; COMP := TRUE;
			    WHILE (NXT1 # NIL) AND (NXT2 # NIL) DO
			     BEGIN
			      COMP := COMPTYPES(NXT1^.IDTYPE,NXT2^.IDTYPE) AND COMP;
			      NXT1 := NXT1^.NEXT; NXT2 := NXT2^.NEXT
			     END;
			    COMPTYPES := COMP AND (NXT1 = NIL) AND (NXT2 = NIL)
			    AND (FSP1^.RECVAR = NIL) AND (FSP2^.RECVAR = NIL)
			   END;
			  %IDENTICAL RECORDS ARE RECOGNIZED TO BE COMPATIBLE
			   IFF NO VARIANTS OCCUR\
		  FILES:
			COMPTYPES := COMPTYPES(FSP1^.FILTYPE,FSP2^.FILTYPE)
		 END %CASE\
	       ELSE %FSP1^.FORM # FSP2^.FORM\
		 IF FSP1^.FORM = SUBRANGE
		 THEN
		  COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2)
		 ELSE
		   IF FSP2^.FORM = SUBRANGE
		   THEN
		    COMPTYPES := COMPTYPES(FSP1,FSP2^.RANGETYPE)
		   ELSE COMPTYPES := FALSE
	     ELSE COMPTYPES := TRUE
	 END %COMPTYPES\ ;

	FUNCTION STRING(FSP: STP) : BOOLEAN;
	 BEGIN
	  STRING := FALSE;
	   IF FSP # NIL
	   THEN
	     IF FSP^.FORM = ARRAYS
	     THEN
	       IF COMPTYPES(FSP^.AELTYPE,CHARPTR)
	       THEN STRING := TRUE
	 END %STRING\ ;

	PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: STP; VAR FSIZE: ADDRRANGE;
		      VAR FBITSIZE: BITRANGE);
	VAR
(* 173 - internal files *)
	  FHASFILE,LHASFILE:BOOLEAN;
	  LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP;
	  LSIZE,DISPL: ADDRRANGE; I,LMIN,LMAX: INTEGER;
	  PACKFLAG: BOOLEAN; LBITSIZE: BITRANGE;
	  LBTP: BTP; BITCOUNT:INTEGER;

(* 104 - check structure sizes *)
	  function checksize(i:addrrange):addrrange;
	    begin
	    if abs(i) <= 377777B
	      then checksize := i
	      else begin
	      error(266);
	      checksize := 0
	      end
	    end;

	  FUNCTION LOG2(FVAL: INTEGER): BITRANGE;
	  VAR
	    E: BITRANGE; H: INTEGER;
	   BEGIN
	    E :=0;
	    H := 1;
(* 135 - numbers > 200 000 000 000B didn't work. *)
	      {There are two complicating issues here:
		1 - 200 000 000 000 is the highest power of 2, so the
		  loop below goes forever for them
		2 - the caller has often added 1, thus making 377 777 777 777
		  into 400 000 000 000, which is negative!!
		In both of these cases we want to return 35}
	    IF (FVAL-1) >= 200000000000B 
	      THEN E := 35
	      ELSE REPEAT
	        E := E + 1; H := H * 2
	       UNTIL FVAL <= H;
	    LOG2 := E
	   END %LOG2\;

	  PROCEDURE SIMPLETYPE(FSYS: SETOFSYS; VAR FSP: STP; VAR FSIZE: ADDRRANGE;
			       VAR FBITSIZE: BITRANGE);
	  VAR
	    LSP,LSP1: STP; LCP,LCP1: CTP; TTOP: DISPRANGE;
	    LCNT: INTEGER; LVALU: VALU; LBITSIZE: BITRANGE;
	   BEGIN
	    FSIZE := 1;
	    SKIPIFERR(SIMPTYPEBEGSYS,208,FSYS);
	     IF SY IN SIMPTYPEBEGSYS
	     THEN
	       BEGIN
		 IF SY = LPARENT
		 THEN
		   BEGIN
		    TTOP := TOP;   %DECL. CONSTS LOCAL TO INNERMOST BLOCK\
		    WHILE DISPLAY[TOP].OCCUR # BLCK DO TOP := TOP - 1;
		    NEWZ(LSP,SCALAR,DECLARED);
		    LSP^.SIZE := 1;
		    LCP1 := NIL; LCNT := 0;
		     REPEAT
		      INSYMBOL;
		       IF SY = IDENT
		       THEN
			 BEGIN
			  NEWZ(LCP,KONST);
			  WITH LCP^ DO
			   BEGIN
			    NAME := ID; IDTYPE := LSP; NEXT := LCP1;
			    VALUES.IVAL := LCNT;
			   END;
			  ENTERID(LCP);
			  LCNT := LCNT + 1;
			  LCP1 := LCP; INSYMBOL
			 END
		       ELSE ERROR(209);
		      IFERRSKIP(166,FSYS OR [COMMA,RPARENT])
		     UNTIL SY # COMMA;
		    TOP := TTOP;
		    WITH LSP^ DO
		     BEGIN
		      SELFSTP := NIL; FCONST := LCP1; BITSIZE := LOG2(LCNT)
		     END;
		     IF SY = RPARENT
		     THEN INSYMBOL
		     ELSE ERROR(152)
		   END
		 ELSE
		   BEGIN
		     IF SY = IDENT
		     THEN
		       BEGIN
			SEARCHID([TYPES,KONST],LCP);
			INSYMBOL;
			 IF LCP^.KLASS = KONST
			 THEN
			   BEGIN
			    NEWZ(LSP,SUBRANGE);
			    WITH LSP^, LCP^ DO
			     BEGIN
			      SELFSTP := NIL; RANGETYPE := IDTYPE;
			       IF STRING(RANGETYPE)
			       THEN
				 BEGIN
				  ERROR(303); RANGETYPE := NIL
				 END;
			      MIN := VALUES; SIZE := 1
			     END;
			     IF SY = COLON
			     THEN INSYMBOL
			     ELSE ERROR(151);
			    CONSTANT(FSYS,LSP1,LVALU);
			    WITH LSP^ DO
			     BEGIN
			      MAX := LVALU;
			       IF MIN.IVAL<0
			       THEN BITSIZE := BITMAX
			       ELSE BITSIZE := LOG2(MAX.IVAL + 1);
			       IF RANGETYPE # LSP1
			       THEN ERROR(304)
			     END;
			   END
			 ELSE
			   BEGIN
			    LSP := LCP^.IDTYPE;
			     IF LSP # NIL
			     THEN FSIZE := LSP^.SIZE;
			   END
		       END %SY = IDENT\
		     ELSE
		       BEGIN
			NEWZ(LSP,SUBRANGE);
			CONSTANT(FSYS OR [COLON],LSP1,LVALU);
			 IF STRING(LSP1)
			 THEN
			   BEGIN
			    ERROR(303); LSP1 := NIL
			   END;
			WITH LSP^ DO
			 BEGIN
			  RANGETYPE := LSP1; MIN := LVALU; SIZE := 1
			 END;
			 IF SY = COLON
			 THEN INSYMBOL
			 ELSE ERROR(151);
			CONSTANT(FSYS,LSP1,LVALU);
			WITH LSP^ DO
			 BEGIN
			  SELFSTP := NIL; MAX := LVALU;
			   IF MIN.IVAL<0
			   THEN BITSIZE := BITMAX
			   ELSE BITSIZE := LOG2(MAX.IVAL + 1);
			   IF RANGETYPE # LSP1
			   THEN ERROR(304)
			 END
		       END;
		     IF LSP # NIL
		     THEN
		      WITH LSP^ DO
		       IF FORM = SUBRANGE
		       THEN
			 IF RANGETYPE # NIL
			 THEN
			   IF RANGETYPE = REALPTR
			   THEN
(* 106 - make subranges of real illegal *)
			     error(210)
			   ELSE
			     IF MIN.IVAL > MAX.IVAL
			     THEN ERROR(451)
		   END;
		FSP := LSP;
		 IF LSP#NIL
		 THEN FBITSIZE := LSP^.BITSIZE
		 ELSE FBITSIZE := 0;
		IFERRSKIP(166,FSYS)
	       END
	     ELSE
	       BEGIN
		FSP := NIL; FBITSIZE := 0
	       END
	   END %SIMPLETYPE\ ;

(* 173 - internal files *)
	  PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FRECVAR: STP; VAR FFIRSTFIELD: CTP; VAR FHASFILE:BOOLEAN);
	  VAR
	    LHASFILE:BOOLEAN;
	    LCP,LCP1,NXT,NXT1: CTP; LSP,LSP1,LSP2,LSP3,LSP4,TAGSP: STP;
	    MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU;
	    LBITSIZE: BITRANGE;
	    LBTP: BTP; MINBITCOUNT:INTEGER;
	    LID : ALFA ;

	    PROCEDURE RECSECTION( VAR FCP: CTP; FSP: STP );
	     BEGIN
	       IF NOT PACKFLAG OR (LSIZE > 1)  OR  (LBITSIZE = 36)
	       THEN
		 BEGIN
		   IF BITCOUNT > 0
		   THEN
		     BEGIN
		      DISPL := DISPL + 1; BITCOUNT := 0
		     END;
		  WITH FCP^ DO
		   BEGIN
		    IDTYPE := FSP; FLDADDR := DISPL;
		    PACKF := NOTPACK; FCP := NEXT;
		    DISPL := DISPL + LSIZE
		   END
		 END
	       ELSE %PACK RECORD-SECTION\

		 BEGIN
		  BITCOUNT := BITCOUNT + LBITSIZE;
		   IF BITCOUNT>BITMAX
		   THEN
		     BEGIN
		      DISPL := DISPL + 1;
		      BITCOUNT := LBITSIZE
		     END;
		   IF (LBITSIZE = 18)  AND  (BITCOUNT IN [18,36])
		   THEN
		     BEGIN
		      WITH FCP^ DO
		       BEGIN
			IDTYPE := FSP;
			FLDADDR := DISPL;
			 IF BITCOUNT = 18
			 THEN PACKF := HWORDL
			 ELSE PACKF := HWORDR;
			FCP := NEXT
		       END
		     END
		   ELSE
		     BEGIN
		      NEWZ(LBTP,RECORDD);
		      WITH LBTP^.BYTE DO
		       BEGIN
			SBITS := LBITSIZE;
			PBITS := BITMAX - BITCOUNT;
			RELADDR := DISPL;
			DUMMYBIT := 0;
			IBIT := 0;
			IREG := TAC
		       END;
		      WITH LBTP^ DO
		       BEGIN
			LAST := LASTBTP; FIELDCP := FCP
		       END;
		      LASTBTP := LBTP;
		      WITH FCP^ DO
		       BEGIN
			IDTYPE := FSP;
			PACKF := PACKK;
			FCP := NEXT
		       END
		     END
		 END
	     END % RECSECTION \ ;
	   BEGIN
(* 173 - internal files *)
(* 166 - In case of null record declaration, FRECVAR was getting junk.
	I don't understand the logic of this routine, but initializing
	it to NIL seems safe enough *)
	    NXT1 := NIL; LSP := NIL; FRECVAR := NIL; FHASFILE := FALSE;
(* 21 - Allow null fieldlist (added FSYS OR to next statement) *)
(* 65 - allow extra semicolons *)
	    while sy=semicolon do
		insymbol;
	    SKIPIFERR(FSYS OR [IDENT,CASESY],452,FSYS);
	    WHILE SY = IDENT DO
	     BEGIN
	      NXT := NXT1;
	       LOOP
		 IF SY = IDENT
		 THEN
		   BEGIN
		    NEWZ(LCP,FIELD);
		    WITH LCP^ DO
		     BEGIN
		      NAME := ID; IDTYPE := NIL; NEXT := NXT
		     END;
		    NXT := LCP;
		    ENTERID(LCP);
		    INSYMBOL
		   END
		 ELSE ERROR(209);
		SKIPIFERR([COMMA,COLON],166,FSYS OR [SEMICOLON,CASESY]);
	       EXIT IF SY # COMMA;
		INSYMBOL
	       END;
	       IF SY = COLON
	       THEN INSYMBOL
	       ELSE ERROR(151);
	      TYP(FSYS OR [CASESY,SEMICOLON],LSP,LSIZE,LBITSIZE);
	       IF LSP # NIL
	       THEN
(* internal files *)
		 IF (LSP^.FORM = FILES) OR LSP^.HASFILE
		 THEN FHASFILE := TRUE;
	      WHILE NXT # NXT1 DO    RECSECTION(NXT,LSP); %RESERVES SPACE FOR ONE RECORDSECTION \
	      NXT1 := LCP;
(* 64 - allow null entry *)
	       WHILE SY = SEMICOLON DO
		 BEGIN
		  INSYMBOL;
		  SKIPIFERR(FSYS OR [IDENT,CASESY,SEMICOLON],452,FSYS)
		 END
	     END %WHILE\;
	    NXT := NIL;
	    WHILE NXT1 # NIL DO
	    WITH NXT1^ DO
	     BEGIN
	      LCP := NEXT; NEXT := NXT; NXT := NXT1; NXT1 := LCP
	     END;
	    FFIRSTFIELD := NXT;
	     IF SY = CASESY
	     THEN
	       BEGIN
		LCP:=NIL;  %POSSIBILITY OF NO TAGFIELDIDENTIFIER\
		INSYMBOL;
		 IF SY = IDENT
		 THEN
		   BEGIN
		    LID := ID ;
		    INSYMBOL ;
		     IF (SY#COLON) AND (SY#OFSY)
		     THEN
		       BEGIN
			ERROR(151) ;
			ERRANDSKIP(160,FSYS OR [LPARENT])
		       END
		     ELSE
		       BEGIN
			 IF SY = COLON
			 THEN
			   BEGIN
			    NEWZ(LSP,TAGFWITHID);
			    NEWZ(LCP,FIELD) ;
			    WITH LCP^ DO
			     BEGIN
			      NAME := LID ; IDTYPE := NIL ; NEXT := NIL
			     END ;
			    ENTERID(LCP) ;
			    INSYMBOL ;
			     IF SY # IDENT
			     THEN
			       BEGIN
				ERRANDSKIP(209,FSYS OR [LPARENT]) ; GOTO 1
			       END
			     ELSE
			       BEGIN
				LID := ID ;
				INSYMBOL ;
				 IF SY # OFSY
				 THEN
				   BEGIN
				    ERRANDSKIP(160,FSYS OR [LPARENT]) ; GOTO 1
				   END
			       END
			   END
			 ELSE NEWZ(LSP,TAGFWITHOUTID) ;
			WITH LSP^ DO
			 BEGIN
			  SIZE:= 0 ; SELFSTP := NIL ;
			  FSTVAR := NIL;
			   IF FORM=TAGFWITHID
			   THEN TAGFIELDP:=NIL
			   ELSE TAGFIELDTYPE := NIL
			 END;
			FRECVAR := LSP;
			ID := LID ;
			SEARCHID([TYPES],LCP1) ;
			TAGSP := LCP1^.IDTYPE;
			 IF TAGSP # NIL
			 THEN
			   IF (TAGSP^.FORM <= SUBRANGE) OR STRING(TAGSP)
			   THEN
			     BEGIN
			       IF COMPTYPES(REALPTR,TAGSP)
			       THEN ERROR(210)
			       ELSE
				 IF STRING(TAGSP)
				 THEN ERROR(169);
			      WITH LSP^ DO
			       BEGIN
				BITSIZE := TAGSP^.BITSIZE;
				 IF FORM = TAGFWITHID
				 THEN TAGFIELDP := LCP
				 ELSE TAGFIELDTYPE := TAGSP;
			       END;
			       IF LCP # NIL
			       THEN
				 BEGIN
				  LBITSIZE :=TAGSP^.BITSIZE;
				  LSIZE := TAGSP^.SIZE;
				  RECSECTION(LCP,TAGSP); %RESERVES SPACE FOR THE TAGFIELD \
				   IF BITCOUNT > 0
(* 104 - check structure sizes *)
				   THEN LSP^.SIZE:=CHECKSIZE(DISPL + 1)
				   ELSE LSP^.SIZE:= CHECKSIZE(DISPL);
				 END
			     END
			   ELSE ERROR(402);

			INSYMBOL;
		       END
		   END
(* 150 - fix ill mem ref trying to follow tagsp if not set *)
		 ELSE BEGIN TAGSP := NIL; ERRANDSKIP(209,FSYS OR [LPARENT]) END ;
1:
		LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL; MINBITCOUNT:=BITCOUNT;
(* 65 - allow extra semicolons *)
		while sy=semicolon do
		 insymbol;
		 LOOP
		  LSP2 := NIL;
		   LOOP
		    CONSTANT(FSYS OR [COMMA,COLON,LPARENT],LSP3,LVALU);
		     IF  NOT COMPTYPES(TAGSP,LSP3)
		     THEN ERROR(305);
		    NEWZ(LSP3,VARIANT);
		    WITH LSP3^ DO
		     BEGIN
		      NXTVAR := LSP1; SUBVAR := LSP2; VARVAL := LVALU;
		      BITSIZE := LSP^.BITSIZE; SELFSTP := NIL
		     END;
		    LSP1 := LSP3; LSP2 := LSP3;
		   EXIT IF SY # COMMA;
		    INSYMBOL;
		   END;
		   IF SY = COLON
		   THEN INSYMBOL
		   ELSE ERROR(151);
		   IF SY = LPARENT
		   THEN INSYMBOL
		   ELSE ERROR(153);
(* 173 - internal files *)
		  FIELDLIST(FSYS OR [RPARENT,SEMICOLON],LSP2,LCP,LHASFILE);
		  FHASFILE := FHASFILE OR LHASFILE;
		   IF DISPL > MAXSIZE
		   THEN MAXSIZE := DISPL;
		  WHILE LSP3 # NIL DO
		   BEGIN
		    LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2; LSP3^.FIRSTFIELD := LCP;
(* 20 - deleted if bitcount>0 use displ+1 - done in fieldlist *)
(* 104 - check structure sizes *)
		     LSP3^.SIZE := CHECKSIZE(DISPL) ;
		    LSP3 := LSP4
		   END;
		   IF SY = RPARENT
		   THEN
		     BEGIN
		      INSYMBOL;
		      IFERRSKIP(166,FSYS OR [SEMICOLON])
		     END
		   ELSE ERROR(152);
(* 65 - allow extra semicolons *)
		  while sy=semicolon
		   do insymbol;
		 exit if sy in fsys;
		  DISPL := MINSIZE;
		  BITCOUNT:=MINBITCOUNT; %RESTAURATION \
		 END;
		DISPL := MAXSIZE;
		LSP^.FSTVAR := LSP1;
	       END  %IF SY = CASESY\
	     ELSE
	       IF LSP # NIL
	       THEN
		 IF LSP^.FORM = ARRAYS
		 THEN FRECVAR := LSP
		 ELSE FRECVAR := NIL;
(* 20 - fix packed records - from CMU *)
	   IF BITCOUNT > 0 THEN
	     BEGIN DISPL:=DISPL+1; BITCOUNT := 0 END
	   END %FIELDLIST\ ;

	 BEGIN
	  %TYP\
(* 173 - internal files *)
	  FHASFILE := FALSE;
	  SKIPIFERR(TYPEBEGSYS,170,FSYS);
	  PACKFLAG := FALSE;
	   IF SY IN TYPEBEGSYS
	   THEN
	     BEGIN
	       IF SY IN SIMPTYPEBEGSYS
	       THEN SIMPLETYPE(FSYS,FSP,FSIZE,FBITSIZE)
	       ELSE
		%^\
		 IF SY = ARROW
		 THEN
		   BEGIN
		    NEWZ(LSP,POINTER); FSP := LSP;
		    LBITSIZE := 18;
		    WITH LSP^ DO
		     BEGIN
		      SELFSTP := NIL;  ELTYPE := NIL; SIZE := 1; BITSIZE := LBITSIZE
		     END;
		    INSYMBOL;
		     IF SY = IDENT
		     THEN
		       BEGIN
(* 165 - fix scoping problem with pointer ref's *)
{All declarations of the form ^THING must be treated as forward references.
 The problem is that we want to use the local declaration of THING if there
 is any.  So we have to wait til we have seen all type declarations before
 we can look up pointer references.}
			NEWZ(LCP,TYPES);
			WITH LCP^ DO
			  BEGIN
			   NAME := ID; IDTYPE := LSP;
			   NEXT := FWPTR
			  END;
			FWPTR := LCP;
			INSYMBOL;
			FBITSIZE:=18
		       END
		     ELSE ERROR(209);
		   END
		 ELSE
		   BEGIN
		     IF SY = PACKEDSY
		     THEN
		       BEGIN
			INSYMBOL;
			SKIPIFERR(TYPEDELS,170,FSYS);
			PACKFLAG := TRUE
		       END;
		      %ARRAY\
		     IF SY = ARRAYSY
		     THEN
		       BEGIN
			INSYMBOL;
			 IF SY = LBRACK
			 THEN INSYMBOL
			 ELSE ERROR(154);
			LSP1 := NIL;
			 LOOP
			  NEWZ(LSP,ARRAYS);
			  WITH LSP^ DO
			   BEGIN
			    AELTYPE := LSP1; INXTYPE := NIL; SELFSTP := NIL;
			    ARRAYPF := PACKFLAG; SIZE := 1
			   END;
			  LSP1 := LSP;
			  SIMPLETYPE(FSYS OR [COMMA,RBRACK,OFSY],LSP2,LSIZE,LBITSIZE);
			   IF LSP2 # NIL
			   THEN
			     IF LSP2^.FORM <= SUBRANGE
			     THEN
			       BEGIN
				 IF LSP2 = REALPTR
				 THEN
				   BEGIN
				    ERROR(210); LSP2 := NIL
				   END
				 ELSE
				   IF LSP2 = INTPTR
				   THEN
				     BEGIN
				      ERROR(306); LSP2 := NIL
				     END;
				LSP^.INXTYPE := LSP2
			       END
			     ELSE
			       BEGIN
				ERROR(403); LSP2 := NIL
			       END;
			 EXIT IF SY # COMMA;
			  INSYMBOL
			 END;
			 IF SY = RBRACK
			 THEN INSYMBOL
			 ELSE ERROR(155);
			 IF SY = OFSY
			 THEN INSYMBOL
			 ELSE ERROR(160);
			TYP(FSYS,LSP,LSIZE,LBITSIZE);
			 IF  LSP # NIL
			 THEN
(* 173 - internal files *)
			   IF  (LSP^.FORM = FILES) OR (LSP^.HASFILE)
			   THEN  FHASFILE := TRUE;
			 REPEAT
			  WITH LSP1^ DO
			   BEGIN
			    LSP2 := AELTYPE; AELTYPE := LSP;
			     IF INXTYPE # NIL
			     THEN
			       BEGIN
				GETBOUNDS(INXTYPE,LMIN,LMAX);
(* 104 - check structure sizes *)
				lmin := checksize(lmin);
				lmax := checksize(lmax);
				I := LMAX - LMIN + 1;
				 IF ARRAYPF AND (LBITSIZE<=18)
				 THEN
				   BEGIN
				    NEWZ(LBTP,ARRAYY);
				    WITH LBTP^,BYTE DO
				     BEGIN
				      SBITS := LBITSIZE;
				      PBITS := BITMAX; DUMMYBIT := 0;
				      IBIT := 0; IREG := TAC; RELADDR := 0;
				      LAST := LASTBTP; LASTBTP := LBTP;
				      ARRAYSP := LSP1;
				     END;
				    LSIZE := (I+(BITMAX DIV LBITSIZE)-1) DIV (BITMAX DIV LBITSIZE);
				   END
				 ELSE
				   BEGIN
				    LSIZE := LSIZE * I;
				    ARRAYPF := FALSE
				   END;
				LBITSIZE := BITMAX;
				BITSIZE := LBITSIZE;
(* 104 - check structure sizes *)
				SIZE := CHECKSIZE(LSIZE);
			       END
			   END;
			  LSP := LSP1; LSP1 := LSP2
			 UNTIL LSP1 = NIL
		       END
		     ELSE
		      %RECORD\
		       IF SY = RECORDSY
		       THEN
			 BEGIN
			  INSYMBOL;
			  OLDTOP := TOP;
			   IF TOP < DISPLIMIT
			   THEN
			     BEGIN
(* 5 - save block name for CREF *)
			      TOP := TOP + 1; DISPLAY[TOP].FNAME := NIL;
			     DISPLAY[TOP].BLKNAME := '.FIELDID. ';
(* 117 - fix enumerated types in record *)
			     DISPLAY[TOP].OCCUR := CREC
			     END
			   ELSE ERROR(404);
			  DISPL := 0;
			  BITCOUNT:=0;
(* 173 - internal files *)
			  FIELDLIST(FSYS-[SEMICOLON] OR [ENDSY],LSP1,LCP,LHASFILE);
			  FHASFILE := FHASFILE OR LHASFILE;
			  
			  LBITSIZE := BITMAX;
			  NEWZ(LSP,RECORDS);
			  WITH LSP^ DO
			   BEGIN
			    SELFSTP := NIL;
			    FSTFLD := %LCP;\ DISPLAY[TOP].FNAME;
			    RECVAR := LSP1;
(* 20 - FIX PACKED RECORDS - FROM CMU - DELETED CODE NOW IN FIELDLIST *)
(* 104 - check structure sizes *)
			     SIZE := CHECKSIZE(DISPL);
			    BITSIZE := LBITSIZE; RECORDPF := PACKFLAG;
			   END;
			  TOP := OLDTOP;
			   IF SY = ENDSY
			   THEN INSYMBOL
			   ELSE ERROR(163)
			 END
		       ELSE
			%SET\
			 IF SY = SETSY
			 THEN
			   BEGIN
			    INSYMBOL;
			     IF SY = OFSY
			     THEN INSYMBOL
			     ELSE ERROR(160);
			    SIMPLETYPE(FSYS,LSP1,LSIZE,LBITSIZE);
			     IF LSP1 # NIL
			     THEN
			      WITH LSP1^ DO
			       CASE FORM OF
				SCALAR:
					IF (LSP1=REALPTR) OR (LSP1=INTPTR)
					THEN ERROR(352)
					ELSE
					  IF SCALKIND =DECLARED
					  THEN
					    IF FCONST^.VALUES.IVAL > BASEMAX
					    THEN ERROR(352);
				SUBRANGE:
					  IF ( RANGETYPE = REALPTR )
					   OR ( ( RANGETYPE # CHARPTR ) AND ((MAX.IVAL > BASEMAX) OR (MIN.IVAL < 0) ) )
					  THEN ERROR(352);
				OTHERS:
					BEGIN
					 ERROR(353); LSP1 := NIL
					END
			       END;
			    LBITSIZE := BITMAX;
			    NEWZ(LSP,POWER);
			    WITH LSP^ DO
			     BEGIN
			      SELFSTP := NIL; ELSET := LSP1; SIZE:=2; BITSIZE := LBITSIZE
			     END;
			   END
			 ELSE
			  %FILE\
			   IF SY = FILESY
			   THEN
			     BEGIN
			      FHASFILE := TRUE;
			      INSYMBOL;
			       IF SY = OFSY
			       THEN INSYMBOL
			       ELSE ERROR(160);
			      TYP(FSYS,LSP1,LSIZE,LBITSIZE);
			      NEWZ(LSP,FILES);
			      LBITSIZE := BITMAX;
			      WITH LSP^ DO
			       BEGIN
				SELFSTP := NIL;
(* 104 - check structure sizes *)
				FILTYPE := LSP1; 
(* 173 - internal files *)
				SIZE := CHECKSIZE(LSIZE) + SIZEOFFILEBLOCK;
				FILEPF := PACKFLAG; BITSIZE := LBITSIZE
			       END;
			       IF LSP1 # NIL
			       THEN
				 IF (LSP1^.FORM = FILES) OR (LSP1^.HASFILE)
				 THEN
				   BEGIN
				    ERROR(254); LSP^.FILTYPE := NIL
				   END;
(* 70 - fix ill mem ref if type error *)
			     END
			   ELSE LSP := NIL;
		    FSP := LSP; FBITSIZE := LBITSIZE
		   END;
	      IFERRSKIP(166,FSYS)
	     END
	   ELSE FSP := NIL;
	   IF FSP = NIL
	   THEN
	     BEGIN
	      FSIZE := 1;FBITSIZE := 0
	     END
(* 173 - internal files *)
	   ELSE BEGIN
	   FSIZE := FSP^.SIZE;
	   FSP^.HASFILE := FHASFILE
	   END
	 END %TYP\ ;

	PROCEDURE LABELDECLARATION;
	VAR
(* 64 - NON-LOCAL GOTOS *)
	  lcp:ctp;
	 BEGIN
(* 6 - remove error message. Allow LABEL declaration but ignore it *)
	   LOOP
	     IF SY = INTCONST
	     THEN
	       BEGIN
		newz(lcp,labelt);
		with lcp^ do
		  begin
		  scope := level; name := id; idtype := nil;
		  next := lastlabel; lastlabel := lcp;
		  gotochain := 0; labeladdress := 0
		  end;
		enterid(lcp);
1:
		INSYMBOL
	       END
	     ELSE ERROR(255);
	    IFERRSKIP(166,FSYS OR [COMMA,SEMICOLON]);
	   EXIT IF SY # COMMA;
	    INSYMBOL
	   END;
	   IF SY = SEMICOLON
	   THEN INSYMBOL
	   ELSE ERROR(156)
	 END %LABELDECLARATION\ ;

	PROCEDURE CONSTANTDECLARATION;
	VAR
	  LCP: CTP; LSP: STP; LVALU: VALU;
	 BEGIN
	  SKIPIFERR([IDENT],209,FSYS);
	  WHILE SY = IDENT DO
	   BEGIN
	    NEWZ(LCP,KONST);
	    WITH LCP^ DO
	     BEGIN
	      NAME := ID; IDTYPE := NIL; NEXT := NIL
	     END;
	    INSYMBOL;
	     IF (SY = RELOP) AND (OP = EQOP)
	     THEN INSYMBOL
	     ELSE ERROR(157);
(* 56 - REQ FILE SYNTAX *)
	    CONSTANT(FSYS OR [SEMICOLON,PERIOD],LSP,LVALU);
	    ENTERID(LCP);
	    LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU;
	     IF SY = SEMICOLON
	     THEN
	       BEGIN
		INSYMBOL;
		IFERRSKIP(166,FSYS OR [IDENT])
	       END
(* 56 - REQ FILE SYNTAX *)
	     ELSE IF NOT ((SY=PERIOD) AND REQFILE)
	       THEN ERROR(156)
	   END
	 END %CONSTANTDECLARATION\ ;

	PROCEDURE TYPEDECLARATION;
	VAR
	  LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE;
	  LBITSIZE: BITRANGE;
	 BEGIN
	  SKIPIFERR([IDENT],209,FSYS);
	  WHILE SY = IDENT DO
	   BEGIN
	    NEWZ(LCP,TYPES);
	    WITH LCP^ DO
	     BEGIN
(* 116 - be sure NEXT is NIL when unused, for COPYCTP *)
	      NAME := ID; IDTYPE := NIL; NEXT := NIL;
	     END;
	    INSYMBOL;
	     IF (SY = RELOP) AND (OP = EQOP)
	     THEN INSYMBOL
	     ELSE ERROR(157);
(* 56 - REQ FILE SYNTAX *)
	    TYP(FSYS OR [SEMICOLON,PERIOD],LSP,LSIZE,LBITSIZE);
	    ENTERID(LCP);
	    WITH LCP^ DO
	     BEGIN
	      IDTYPE := LSP;
(* 165 - fix scoping for pointer ref's *)
	     END;
	     IF SY = SEMICOLON
	     THEN
	       BEGIN
		INSYMBOL;
		IFERRSKIP(166,FSYS OR [IDENT]);
	       END
(* 56 - REQ FILE SYNTAX *)
	     ELSE IF NOT ((SY=PERIOD) AND REQFILE)
	       THEN ERROR(156)
	   END;
(* 113 - don't check for forw. ref's satisfied in req. file *)
	 END %TYPEDECLARATION\ ;

(* 166 - must resolve forwards separately, in case of TYPE section
         in required file but none in main *)
	PROCEDURE FWDRESOLVE;
	  BEGIN
{For each forward request, look up the variable requested.  If
 you find the request, use it.  Note that all declarations of
 the form ^THING produce forward requests.  This is to force
 THING to be looked up after all type declarations have been
 processed, so we get the local definition if there is one.}
	  WHILE FWPTR # NIL DO
 	    BEGIN
(* 165 - fix scoping problem with pointers *)
	     ID := FWPTR^.NAME;
	     PRTERR := FALSE;   %NO ERROR IF SEARCH NOT SUCCESSFUL\
	     SEARCHID([TYPES],LCP); PRTERR := TRUE;
	     IF LCP <> NIL
	       THEN IF LCP^.IDTYPE # NIL
		      THEN IF LCP^.IDTYPE^.FORM = FILES
			     THEN ERROR(254)
			     ELSE FWPTR^.IDTYPE^.ELTYPE := LCP^.IDTYPE
		      ELSE
	       ELSE ERRORWITHTEXT(405,FWPTR^.NAME);
	     FWPTR := FWPTR^.NEXT
	    END
	 END %FWDRESOLVE\ ;

	PROCEDURE VARIABLEDECLARATION;
	VAR
	  LCP,NXT: CTP; LSP: STP; LSIZE: ADDRRANGE;
	  LBITSIZE: BITRANGE; II: INTEGER;
(* 173 - removed lfileptr *)
	 BEGIN
	  NXT := NIL;
	   REPEAT
	     LOOP
	       IF SY = IDENT
	       THEN
		 BEGIN
		  NEWZ(LCP,VARS);
		  WITH LCP^ DO
		   BEGIN
		    NAME := ID; NEXT := NXT;
		    IDTYPE := NIL; VKIND := ACTUAL; VLEV := LEVEL
		   END;
		  ENTERID(LCP);
		  NXT := LCP;
		  INSYMBOL;
		 END
	       ELSE ERROR(209);
	      SKIPIFERR(FSYS OR [COMMA,COLON] OR TYPEDELS,166,[SEMICOLON]);
	     EXIT IF SY # COMMA;
	      INSYMBOL
	     END;
	     IF SY = COLON
	     THEN INSYMBOL
	     ELSE ERROR(151);
	    TYP(FSYS OR [SEMICOLON] OR TYPEDELS,LSP,LSIZE,LBITSIZE);
(* 24 - testpacked no longer needed *)
(* 173 - internal files *)
	    IF LSP <> NIL
	      THEN IF (LSP^.FORM = FILES) OR LSP^.HASFILE
		THEN FILEINBLOCK[LEVEL] := TRUE;
	    WHILE NXT # NIL DO
	    WITH  NXT^ DO
	     BEGIN
	      IDTYPE := LSP; VADDR := LC;
	      LC := LC + LSIZE ;
(* 173 - internal files - removed file code here *)
	      NXT := NEXT ;
	     END;
	     IF SY = SEMICOLON
	     THEN
	       BEGIN
		INSYMBOL;
		IFERRSKIP(166,FSYS OR [IDENT])
	       END
	     ELSE ERROR(156)
	   UNTIL (SY # IDENT) AND  NOT (SY IN TYPEDELS);
(* 167 - code removed from here.  It is now part of FWDRESOLVE,
	which is called right after this procedure *)
	 END %VARIABLEDECLARATION\ ;

	PROCEDURE PROCEDUREDECLARATION(FSY: SYMBOL);
	VAR
	  OLDLEV: 0..MAXLEVEL; LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP;
	  FORW: BOOLEAN; OLDTOP: DISPRANGE; LNXT: CTP;
(* 62 - clean up stack offsets *)
	  LLC,LCM: ADDRRANGE;  TOPPOFFSET: ADDRRANGE;

	  PROCEDURE PARAMETERLIST(FSY: SETOFSYS; VAR FPAR: CTP; VAR TOPPOFFSET: ADDRRANGE);
	  VAR
	    LCP,LCP1,LCP2,LCP3: CTP; LSP: STP; LKIND: IDKIND;
(* 62 - clean up stack offset *)
	    REGC:INTEGER;
	   BEGIN
	    LCP1 := NIL; REGC := REGIN+1;
	    SKIPIFERR(FSY OR [LPARENT],256,FSYS);
	     IF SY = LPARENT
	     THEN
	       BEGIN
		 IF FORW
		 THEN ERROR(553);
		INSYMBOL;
		SKIPIFERR([IDENT,VARSY,PROCEDURESY,FUNCTIONSY],256,FSYS OR [RPARENT]);
		WHILE SY IN [IDENT,VARSY,PROCEDURESY,FUNCTIONSY] DO
		 BEGIN
		   IF SY = PROCEDURESY
		   THEN
		     BEGIN
(* 33 - PROC PARAM.S *)
		       REPEAT
			INSYMBOL;
			 IF SY = IDENT
			 THEN
			   BEGIN
			    NEWZ(LCP,PROC,DECLARED,FORMAL);
			    WITH LCP^ DO
			     BEGIN
			      NAME := ID; IDTYPE := NIL; NEXT := LCP1;
			      PFLEV := LEVEL; PFADDR := LC
			     END;
			    ENTERID(LCP);
(* 62 - clean up stack offset *)
			    LCP1 := LCP; LC := LC + 1; REGC := REGC+1;
			    INSYMBOL
			   END
			 ELSE ERROR(209);
			IFERRSKIP(256,FSYS OR [COMMA,SEMICOLON,RPARENT])
		       UNTIL SY # COMMA
		     END
		   ELSE
		     IF SY = FUNCTIONSY
		     THEN
		       BEGIN
(* 33 - PROC PARAM.S *)
			LCP2 := NIL;
			 REPEAT
			  INSYMBOL;
			   IF SY = IDENT
			   THEN
			     BEGIN
			      NEWZ(LCP,FUNC,DECLARED,FORMAL);
			      WITH LCP^ DO
			       BEGIN
				NAME := ID; IDTYPE := NIL; NEXT := LCP2;
				PFLEV := LEVEL; PFADDR := LC
			       END;
			      ENTERID(LCP);
(* 62 - clean up stack offset *)
			      LCP2 := LCP; LC := LC + 1; REGC := REGC+1;
			      INSYMBOL;
			     END;
			   IF  NOT (SY IN [COMMA,COLON] OR FSYS)
			   THEN
			    ERRANDSKIP(256,FSYS OR [COMMA,SEMICOLON,RPARENT])
			 UNTIL SY # COMMA;
			 IF SY = COLON
			 THEN
			   BEGIN
			    INSYMBOL;
			     IF SY = IDENT
			     THEN
			       BEGIN
				SEARCHID([TYPES],LCP);
				LSP := LCP^.IDTYPE;
				 IF LSP # NIL
				 THEN
				   IF  NOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER])
				   THEN
				     BEGIN
				      ERROR(551); LSP := NIL
				     END;
				LCP3 := LCP2;
				WHILE LCP2 # NIL DO
				 BEGIN
				  LCP2^.IDTYPE := LSP; LCP := LCP2;
				  LCP2 := LCP2^.NEXT
				 END;
				LCP^.NEXT := LCP1; LCP1 := LCP3;
				INSYMBOL
			       END
			     ELSE ERROR(209);
			    IFERRSKIP(256,FSYS OR [SEMICOLON,RPARENT])
			   END
			 ELSE ERROR(151)
		       END
		     ELSE
		       BEGIN
			 IF SY = VARSY
			 THEN
			   BEGIN
			    LKIND := FORMAL; INSYMBOL
			   END
			 ELSE LKIND := ACTUAL;
			LCP2 := NIL;
			 LOOP
			   IF SY = IDENT
			   THEN
			     BEGIN
			      NEWZ(LCP,VARS);
			      WITH LCP^ DO
			       BEGIN
				NAME := ID; IDTYPE := NIL;
				VKIND := LKIND; NEXT := LCP2; VLEV := LEVEL;
			       END;
			      ENTERID(LCP);
			      LCP2 := LCP;
			      INSYMBOL;
			     END
			   ELSE ERROR(256);
			   IF  NOT (SY IN [COMMA,COLON] OR FSYS)
			   THEN
			    ERRANDSKIP(256,FSYS OR [COMMA,SEMICOLON,RPARENT])
			 EXIT IF SY # COMMA;
			  INSYMBOL
			 END;
			 IF SY = COLON
			 THEN
			   BEGIN
			    INSYMBOL;
(* 15 - ALLOW :FILE AS KLUDGEY THING THAT MATCHES ALL FILES *)
			     IF SY IN [IDENT,FILESY]
			     THEN
			       BEGIN
				IF SY=IDENT
				THEN BEGIN
(* 111 - STRING, POINTER *)
				SEARCHID([TYPES,PARAMS],LCP);
				  (* PARAMS IS A PREDECLARED IDENTIFIER DESCRIBING
				     A CLASS OF PARAMETERS WITH REDUCED TYPE CHECKING,
				     E.G. STRING OR POINTER *)
				LSP := LCP^.IDTYPE;
				END
				 ELSE LSP:=ANYFILEPTR;
				 IF LSP # NIL
				 THEN
				   IF (LKIND = ACTUAL) AND (LSP^.FORM = FILES)
				   THEN
				    ERROR(355);
(* 151 - fix reversed args in case I,J:INTEGER *)
{LCP2 is reversed at the moment.  Put it forwards so memory alloc is right}
				LCP3 := NIL;
				WHILE LCP2 # NIL DO
				 BEGIN
				 LCP := LCP2;
				 LCP2 := LCP2^.NEXT;
				 LCP^.NEXT := LCP3;
				 LCP3 := LCP;
				 END;
				WHILE LCP3 # NIL DO
				 BEGIN
				  WITH LCP3^ DO
				   BEGIN
				    IDTYPE := LSP;
				    VADDR := LC;
(* 161 - fix POINTER and STRING *)
(* 202 - pointer by ref *)
{POINTER and STRING are passed by a kludgey mechanism.  Since it uses 2 AC's
 we choose to call this thing call by value, with a size of 2.  STRING
 works the same for value and ref anyway.  POINTER doesn't, so we
 use pointerref instead of pointerptr to distinguish. If we call these
 things 2-word quantities passed by value, then mostly the right thing
 happens automatically.   The only other place special code is required
 is in CALLNONSTANDARD where by use a special routine in place of LOAD,
 to do the actually funny passing.}
 				    if (lsp = stringptr) or (lsp = pointerptr)
				      then if (lsp = pointerptr) and
					      (vkind = formal)
{If it is POINTER called by ref, use a special tag, POINTERREF }
				             then begin 
				              idtype := pointerref;
				              vkind := actual
				              end
{In any case, consider it actual so the size = 2 works }
					     else vkind := actual;
				     IF VKIND = FORMAL
				     THEN LC := LC + 1
				     ELSE
				       IF IDTYPE # NIL
				       THEN LC := LC + IDTYPE^.SIZE;
(* 62 - clean up stack offset *)
				    IF IDTYPE = NIL
				      THEN REGC := REGC+1
				      ELSE IF (VKIND = ACTUAL) AND (IDTYPE^.SIZE = 2)
					THEN REGC := REGC+2
					ELSE REGC := REGC+1
				   END;
				  LCP := LCP3;
				  LCP3 := LCP3^.NEXT;
(* 151 - CONS the new thing on individually instead of APPENDing the whole
   string, in order to avoid getting I and J reversed in I,J:INTEGER *)
{Note that we are here reversing the order again.  This is because the
 whole thing gets reversed below.}
				  LCP^.NEXT := LCP1;
				  LCP1 := LCP;
				 END;
				INSYMBOL
			       END
			     ELSE ERROR(209);
			    IFERRSKIP(256,FSYS OR [SEMICOLON,RPARENT])
			   END
			 ELSE ERROR(151);
		       END;
		   IF SY = SEMICOLON
		   THEN
		     BEGIN
		      INSYMBOL;
		      SKIPIFERR(FSYS OR [IDENT,VARSY,PROCEDURESY,FUNCTIONSY],256,[RPARENT])
		     END
		 END %WHILE\ ;
		 IF SY = RPARENT
		 THEN
		   BEGIN
		    INSYMBOL;
		    IFERRSKIP(166,FSY OR FSYS)
		   END
		 ELSE ERROR(152);
		LCP3 := NIL;
		%REVERSE POINTERS\
		WHILE LCP1 # NIL DO
		WITH LCP1^ DO
		 BEGIN
		  LCP2 := NEXT; NEXT := LCP3;
		  LCP3 := LCP1; LCP1 := LCP2
		 END;
		FPAR := LCP3
	       END
	     ELSE FPAR := NIL;
(* 62 - clean up stack offset *)
	   IF (REGC - 1) > PARREGCMAX
	     THEN TOPPOFFSET := LC - 1
	     ELSE TOPPOFFSET := 0;
	   END %PARAMETERLIST\ ;

	 BEGIN
	  %PROCEDUREDECLARATION\
	  LLC := LC;
	   IF FSY = PROCEDURESY
	   THEN LC := 1
	   ELSE LC := 2;
	   IF SY = IDENT
	   THEN
	     BEGIN
(* 5 - CREF *)
	      IF CREF
	        THEN WRITE(CHR(15B),CHR(10),ID);
	      SEARCHSECTION(DISPLAY[TOP].FNAME,LCP);   %DECIDE WHETHER FORW.\
	       IF LCP # NIL
	       THEN
		WITH LCP^ DO
		 BEGIN
		   IF KLASS = PROC
		   THEN
		    FORW := FORWDECL AND (FSY = PROCEDURESY) AND (PFKIND = ACTUAL)
		   ELSE
		     IF KLASS = FUNC
		     THEN
		      FORW := FORWDECL AND (FSY = FUNCTIONSY) AND (PFKIND = ACTUAL)
		     ELSE FORW := FALSE;
		   IF  NOT FORW
		   THEN ERROR(406)
		 END
	       ELSE FORW := FALSE;
	       IF  NOT FORW
	       THEN
		 BEGIN
		   IF FSY = PROCEDURESY
		   THEN NEWZ(LCP,PROC,DECLARED,ACTUAL)
		   ELSE NEWZ(LCP,FUNC,DECLARED,ACTUAL);
		  WITH LCP^ DO
		   BEGIN
(* 116 - be sure NEXT is NIL when unused, for COPYCTP *)
		    NAME := ID; IDTYPE := NIL; TESTFWDPTR := NIL; NEXT := NIL;
		    FORWDECL := FALSE; EXTERNDECL := FALSE; LANGUAGE := PASCALSY;
		    PFLEV := LEVEL; PFADDR := 0; FOR I := 0 TO MAXLEVEL DO LINKCHAIN[I] := 0
		   END;
		  ENTERID(LCP)
		 END
	       ELSE
		 BEGIN
		  LCP1 := LCP^.NEXT;
		  WHILE LCP1 # NIL DO
		   BEGIN
		    WITH LCP1^ DO
		     IF KLASS = VARS
		     THEN
		       IF IDTYPE # NIL
		       THEN
			 BEGIN
			  LCM := VADDR + IDTYPE^.SIZE;
			   IF LCM > LC
			   THEN LC := LCM
			 END;
		    LCP1 := LCP1^.NEXT
		   END
		 END;
	      INSYMBOL
	     END
	   ELSE
	     BEGIN
	      ERROR(209);
	       IF FSY = PROCEDURESY
	       THEN LCP := UPRCPTR
	       ELSE LCP := UFCTPTR
	     END;
	  OLDLEV := LEVEL; OLDTOP := TOP;
	   IF LEVEL < MAXLEVEL
	   THEN LEVEL := LEVEL + 1
	   ELSE ERROR(453);
	   IF TOP < DISPLIMIT
	   THEN
	     BEGIN
	      TOP := TOP + 1;
	      WITH DISPLAY[TOP] DO
	       BEGIN
(* 5 - save block name for CREF *)
		FNAME := NIL; OCCUR := BLCK; BLKNAME := LCP^.NAME;
		 IF DEBUG THEN BEGIN
(* 214 - use ULBLPTR because UPRCPTR will not have NEXT treated
	properly *)
{This is a dummy entry in the symbol table strictly for the debugger.
 The debugger looks at its NEXT field to find the procedure name}
				NEWZ(LCP1); LCP1^ := ULBLPTR^;
				LCP1^.NEXT := LCP;
				ENTERID(LCP1);
				IF FORW AND (LCP^.NEXT # NIL)
				THEN BEGIN
(* 150 - removed lcp1^.llink := lcp^.next.  LCP^.NEXT is a tree containing
         the parameters.  It needs to be put into the symbol table.  Since
         all legal symbols > blanks, just put it in Rlink.  Previously got
         all symbols twice in debugger! *)
				  LCP1^.RLINK := LCP^.NEXT
				  END
			       END
			  ELSE IF FORW THEN FNAME := LCP^.NEXT
		END %WITH DISPLAY[TOP]\
	     END
	   ELSE ERROR(404);
	   IF FSY = PROCEDURESY
	   THEN
	     BEGIN
(* 62 - clean up stack offset *)
	      PARAMETERLIST([SEMICOLON],LCP1,TOPPOFFSET);
	       IF  NOT FORW
		THEN WITH LCP^ DO
		  BEGIN NEXT := LCP1; POFFSET := TOPPOFFSET END
	     END
	   ELSE
	     BEGIN
(* 62 - clean up stack offset *)
	      PARAMETERLIST([SEMICOLON,COLON],LCP1,TOPPOFFSET);
	       IF  NOT FORW
		THEN WITH LCP^ DO
		  BEGIN NEXT := LCP1; POFFSET := TOPPOFFSET END;
	       IF SY = COLON
	       THEN
		 BEGIN
		  INSYMBOL;
		   IF SY = IDENT
		   THEN
		     BEGIN
		       IF FORW
		       THEN ERROR(552);
		      SEARCHID([TYPES],LCP1);
		      LSP := LCP1^.IDTYPE;
		      LCP^.IDTYPE := LSP;
		       IF LSP # NIL
		       THEN
			 IF  NOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER])
			 THEN
			   BEGIN
			    ERROR(551); LCP^.IDTYPE := NIL
			   END;
		      INSYMBOL
		     END
		   ELSE ERRANDSKIP(209,FSYS OR [SEMICOLON])
		 END
	       ELSE
		 IF  NOT FORW
		 THEN ERROR(455)
	     END;
	   IF SY = SEMICOLON
	   THEN INSYMBOL
	   ELSE ERROR(156);
	   IF SY = FORWARDSY
	   THEN
	     BEGIN
	       IF FORW
	       THEN ERROR(257)
	       ELSE
		WITH LCP^ DO
		 BEGIN
		  TESTFWDPTR := FORWPTR; FORWPTR := LCP; FORWDECL := TRUE
		 END;
	      INSYMBOL;
	       IF SY = SEMICOLON
	       THEN INSYMBOL
	       ELSE ERROR(156);
	      IFERRSKIP(166,FSYS)
	     END % SY = FORWARDSY \
	   ELSE
	    WITH LCP^ DO
	     BEGIN
	       IF SY = EXTERNSY
	       THEN
		 BEGIN
		   IF FORW
		   THEN ERROR(257)
		   ELSE EXTERNDECL := TRUE;
		  INSYMBOL;
		   IF LEVEL # 2
		   THEN ERROR(464);
		   IF SY IN LANGUAGESYS
		   THEN
		     BEGIN
		      LANGUAGE := SY;
		      INSYMBOL
		     END;
		   IF (LIBIX = 0) OR (NOT LIBRARY[LANGUAGE].INORDER)
		   THEN
		     BEGIN
		      LIBIX:= LIBIX+1;
		      LIBORDER[LIBIX]:= LANGUAGE;
		      LIBRARY[LANGUAGE].INORDER:= TRUE
		     END;
		  PFLEV := 1; PFCHAIN := EXTERNPFPTR; EXTERNPFPTR := LCP;
		   IF SY = SEMICOLON
(* 56 - ACCEPT SYNTAX OF REQUIRE FILE *)
		     THEN BEGIN
		     INSYMBOL;
		     IFERRSKIP(166,FSYS)
		     END
		    ELSE IF NOT((SY=PERIOD) AND REQFILE)
		     THEN ERROR(166)
		 END % SY = EXTERNSY \
	       ELSE
		 BEGIN
(* 55 - ONLY EXTERN DECL'S ALLOWED IN REQUIRE FILE *)
		  IF REQFILE
		    THEN ERROR(169);
		  PFCHAIN := LOCALPFPTR; LOCALPFPTR := LCP; FORWDECL := FALSE;
		  BLOCK(LCP,FSYS,[BEGINSY,FUNCTIONSY,PROCEDURESY,PERIOD,SEMICOLON]);
		   IF SY = SEMICOLON
		   THEN
		     BEGIN
		      INSYMBOL;
		      SKIPIFERR([BEGINSY,PROCEDURESY,FUNCTIONSY],166,FSYS)
		     END
		   ELSE
		     IF MAIN OR (LEVEL > 2) OR (SY # PERIOD)
		     THEN ERROR(156)
		 END % SY # EXTERNSY \
	     END % SY # FORWARDSY \ ;
	  LEVEL := OLDLEV; TOP := OLDTOP; LC := LLC;
(* 5 - CREF *)
	  IF CREF
	    THEN WRITE(CHR(16B),CHR(10),LCP^.NAME)
	 END %PROCEDUREDECLARATION\ ;

	PROCEDURE BODY(FSYS: SETOFSYS);
	CONST
(* 173 - rework for internal files *)
	  FILEOF = 1B; FILEOL = 2B; FILSTA = 11B;  FILTST=40B;
	  FILBFH =26B; FILLNR = 31B;
(* 43 - new stuff for blocked files *)
(* 50 - new labels for reinit *)
	  FILCMP =43B; filbll=36b; 
(* 61 - tops20 *)
	  filjfn =4b;
	VAR
	  LASTFILE: CTP;
	  IDTREE: ADDRRANGE; %POINTER(IN THE USER'S CODE) TO THE IDENTIFIER-TREE\

	  PROCEDURE FULLWORD(FRELBYTE: RELBYTE; FLEFTH: ADDRRANGE; FRIGHTH: ADDRRANGE);
	   BEGIN
	    %FULLWORD\
	    CIX := CIX + 1;
	     IF CIX > CIXMAX
	     THEN
	       BEGIN
		IF FPROCP = NIL THEN ERRORWITHTEXT(356,'MAIN      ')
				ELSE ERRORWITHTEXT(356, FPROCP^.NAME);
		CIX := 0
	       END;
	    WITH CODE, HALFWORD[CIX] DO
	     BEGIN
	      LEFTHALF := FLEFTH;
	      RIGHTHALF := FRIGHTH;
	      INFORMATION[CIX] := 'W'; RELOCATION[CIX] := FRELBYTE
	     END;
	    IC := IC + 1
	   END %FULLWORD\ ;

(* 164 - routine to allow Polish fixup in case ADDR can't be done by compiler *)

	procedure insertpolish(place,original:addrrange;adjust:integer);
	    var pol:polpt;
{This routine requests the loader to fix up the right half of PLACE, by
 putting in ORIGINAL (assumed relocatable) + ADJUST (assumed absolute).
 A POLREC is created, and the actual request is put in the file by
 WRITEMC(WRITEPOLISH).}
	  begin
	  if abs(adjust) > 377777B
	    then error(266)
	    else begin
	    new(pol);
	    with pol^ do
	      begin
	      where := place;
	      base := original;
	      offset := adjust;
	      nextpol := firstpol  {Link into chain of requests - FIRSTPOL}
	      end;
	    firstpol := pol
	    end;
	  end;

	  PROCEDURE INSERTADDR(FRELBYTE: RELBYTE; FCIX:CODERANGE;FIC:ADDRRANGE);
	   BEGIN
	     IF NOT ERRORFLAG
	     THEN
	      WITH CODE DO
	       BEGIN
		INSTRUCTION[FCIX].ADDRESS := FIC;
		RELOCATION[FCIX] := FRELBYTE
	       END
	   END;

	  PROCEDURE INCREMENTREGC;
	   BEGIN
	    REGC := REGC + 1 ;
	     IF REGC > REGCMAX
	     THEN
	       BEGIN
		ERROR(310) ; REGC := REGIN
	       END
	   END ;

	  PROCEDURE DEPCST(KONSTTYP:CSTCLASS; FATTR:ATTR);
	  VAR
	    II:INTEGER; LKSP,LLKSP: KSP; LCSP: CSP;
	    NEUEKONSTANTE,GLEICH:BOOLEAN; LCIX: CODERANGE;
	   BEGIN
	    I:=1;
	    NEUEKONSTANTE:=TRUE; LKSP := FIRSTKONST;
	    WHILE (LKSP#NIL) AND NEUEKONSTANTE DO
	    WITH LKSP^,CONSTPTR^ DO
	     BEGIN
	       IF CCLASS = KONSTTYP
	       THEN
		 CASE KONSTTYP OF
		  REEL:
			IF RVAL = FATTR.CVAL.VALP^.RVAL
			THEN
			 NEUEKONSTANTE := FALSE;
		  INT:
		       IF INTVAL = FATTR.CVAL.IVAL
		       THEN
			NEUEKONSTANTE := FALSE;
		  PSET:
			IF PVAL = FATTR.CVAL.VALP^.PVAL
			THEN
			 NEUEKONSTANTE := FALSE;
		  STRD,
		  STRG:
			IF FATTR.CVAL.VALP^.SLGTH = SLGTH
			THEN
			  BEGIN
			   GLEICH := TRUE;
			   II := 1;
			    REPEAT
			      IF FATTR.CVAL.VALP^.SVAL[II] # SVAL[II]
			      THEN
			       GLEICH := FALSE;
			     II:=II+1
			    UNTIL (II>SLGTH) OR NOT GLEICH;
			    IF GLEICH
			    THEN NEUEKONSTANTE := FALSE
			  END
		 END %CASE\;
	      LLKSP := LKSP; LKSP := NEXTKONST
	     END %WHILE\;
	     IF NOT NEUEKONSTANTE
	     THEN
	      WITH LLKSP^ DO
	       BEGIN
		INSERTADDR(RIGHT,CIX,ADDR); CODE.INFORMATION[CIX]:= 'C';
		 IF KONSTTYP IN [PSET,STRD]
		 THEN
		   BEGIN
		    INSERTADDR(RIGHT,CIX-1,ADDR1); CODE.INFORMATION[CIX-1]:= 'C'; ADDR1 := IC-2;
		   END;
		ADDR:= IC-1
	       END
	     ELSE
	       BEGIN
		 IF KONSTTYP = INT
		 THEN
		   BEGIN
		    NEWZ(LCSP,INT); LCSP^.INTVAL := FATTR.CVAL.IVAL
		   END
		 ELSE
		  LCSP := FATTR.CVAL.VALP;
		CODE.INFORMATION[CIX] := 'C';
		 IF KONSTTYP IN [PSET,STRD]
		 THEN CODE.INFORMATION[CIX-1] := 'C';
		NEWZ(LKSP);
		WITH LKSP^ DO
		 BEGIN
		  ADDR := IC-1;
(* 72 - two fixup chains for 2 word consts *)
		  if konsttyp in [strd,pset]
		    then addr1 := ic-2;
		  CONSTPTR := LCSP; NEXTKONST := NIL
		 END;
		 IF FIRSTKONST = NIL
		 THEN FIRSTKONST := LKSP
		 ELSE LLKSP^.NEXTKONST := LKSP
	       END
	   END %DEPCST\;

	  PROCEDURE MACRO(FRELBYTE : RELBYTE;
			  FINSTR   : INSTRANGE;
			  FAC	   : ACRANGE;
			  FINDBIT  : IBRANGE;
			  FINXREG  : ACRANGE;
			  FADDRESS : INTEGER);
	   BEGIN
	     IF NOT INITGLOBALS
	     THEN
	       BEGIN
		CIX := CIX + 1;
		 IF CIX > CIXMAX
		 THEN
		   BEGIN
		     IF FPROCP = NIL
		     THEN ERRORWITHTEXT(356,'MAIN      ')
		     ELSE ERRORWITHTEXT(356, FPROCP^.NAME);
		    CIX := 0
		   END;
		WITH CODE, INSTRUCTION[CIX] DO
		 BEGIN
		  INSTR    :=FINSTR;
		  AC	   :=FAC;
		  INDBIT   :=FINDBIT;
		  INXREG   :=FINXREG;
		  ADDRESS  :=FADDRESS;
		  INFORMATION[CIX]:= ' '; RELOCATION[CIX] := FRELBYTE
		 END;
		IC := IC + 1
	       END
	     ELSE ERROR(507)
	   END %MACRO\;

	  PROCEDURE MACRO5(FRELBYTE: RELBYTE; FINSTR : INSTRANGE; FAC,FINXREG : ACRANGE; FADDRESS : INTEGER);
	   BEGIN
	    MACRO(FRELBYTE,FINSTR,FAC,0,FINXREG,FADDRESS)
	   END;

	  PROCEDURE MACRO4(FINSTR: INSTRANGE;FAC, FINXREG: ACRANGE;FADDRESS: INTEGER);
	   BEGIN
	    MACRO(NO,FINSTR,FAC,0,FINXREG,FADDRESS)
	   END;

	  PROCEDURE MACRO3(FINSTR : INSTRANGE; FAC:ACRANGE; FADDRESS: INTEGER);
	   BEGIN
	    MACRO(NO,FINSTR,FAC,0,0,FADDRESS)
	   END;

	  PROCEDURE MACRO4R(FINSTR : INSTRANGE; FAC,FINXREG : ACRANGE; FADDRESS : INTEGER);
	   BEGIN
	    MACRO(RIGHT,FINSTR,FAC,0,FINXREG,FADDRESS)
	   END;

	  PROCEDURE MACRO3R(FINSTR : INSTRANGE; FAC:ACRANGE; FADDRESS: INTEGER);
	   BEGIN
	    MACRO(RIGHT,FINSTR,FAC,0,0,FADDRESS)
	   END;

	  PROCEDURE PUTPAGER;
	   BEGIN
	    WITH PAGER DO
	     BEGIN
	      LASTPAGER := IC;
	      WITH WORD1 DO MACRO4R(304B%CAIA\,AC,INXREG,ADDRESS);
	      FULLWORD(RIGHT,LHALF,RHALF);
	      LASTPAGE := PAGECNT
	     END
	   END;

	  PROCEDURE PUTLINER;
	   BEGIN
	     IF PAGECNT # LASTPAGE
	     THEN PUTPAGER;
	     IF LINECNT # LASTLINE
	     THEN %BREAKPOINT\
	       BEGIN
		 IF LINENR # '-----'
		 THEN
		   BEGIN
		    LINECNT := 0;
		    FOR I := 1 TO 5 DO	LINECNT := 10*LINECNT + ORD(LINENR[I]) - ORD('0')
		   END;
		LINEDIFF := LINECNT - LASTLINE;
		 IF LINEDIFF > 255
		 THEN
		   BEGIN
		    MACRO3R(334B%SKIPA\,0,LASTSTOP);
		    LASTSTOP := IC-1;
		    MACRO3(320B%JUMP\,0,LASTLINE)
		   END
		 ELSE
		   BEGIN
		    MACRO4R(320B%JUMP\,LINEDIFF MOD 16,LINEDIFF DIV 16, LASTSTOP); %NOOP\
		    LASTSTOP := IC - 1
		   END;
		LASTLINE := LINECNT
	       END
	   END;

	  PROCEDURE SUPPORT(FSUPPORT: SUPPORTS);
	   BEGIN
	     CASE FSUPPORT OF
(* 23 - check for bad pointer *)
	      BADPOINT,
	      ERRORINASSIGNMENT,
	      INDEXERROR    : MACRO3R(265B%JSA\,HAC,RNTS.LINK[FSUPPORT]);
(* 12 - NOW STACKOVERFLOW IS NOT AN ERROR - GETS MORE MEMORY *)
(* 74 - add initmem for 10 version under emulator *)
(* 104 - debstack for tops-10 debugging stack check *)
(* 120 - new calling method for INITFILES, for T20/Tenex *)
	      INITFILES,INITMEM,STACKOVERFLOW,DEBSTACK: MACRO3R(265B%JSP\,TAC,RNTS.LINK[FSUPPORT]);
(* 64 - non-local gotos *)
	      EXITPROGRAM   : MACRO3R(254B%JRST\,0,RNTS.LINK[FSUPPORT]);
	      OTHERS	    : MACRO3R(260B%PUSHJ\,TOPP,RNTS.LINK[FSUPPORT])
	     END;
	    CODE.INFORMATION[CIX]:= 'E';
	    RNTS.LINK[FSUPPORT]:= IC-1
	   END;

	  PROCEDURE ENTERBODY;
	  VAR
	    I: INTEGER; LCP : CTP;
(* 66 - NON-LOC GOTO *)
	    LBTP: BTP; NONLOC,INLEVEL: BOOLEAN;
	   BEGIN
	    LBTP := LASTBTP;
(* 13 - ADD DATA FOR DDT SYMBOLS *)
	    PFPOINT := IC;
	    WHILE LBTP # NIL DO
	     BEGIN
	      WITH LBTP^ DO
	       CASE BKIND OF
		RECORDD: FIELDCP^.FLDADDR := IC;
		ARRAYY : ARRAYSP^.ARRAYBPADDR := IC
	       END;
	      LBTP := LBTP^.LAST;
	      IC := IC + 1
	     END;
(* 66 - NON-LOC GOTO *)
	     LCP:=LASTLABEL;
	     INLEVEL:=TRUE; NONLOC:=FALSE;
	     WHILE(LCP#NIL) AND INLEVEL DO
		WITH LCP^ DO
		  IF SCOPE=LEVEL
		    THEN BEGIN
		    NONLOC := NONLOC OR NONLOCGOTO;
		    LCP := NEXT
		    END
		   ELSE INLEVEL := FALSE;
	     IF FPROCP # NIL
	     THEN
	       BEGIN
		FULLWORD(NO,0,377777B); IDTREE := CIX; %IF DEBUG, INSERT TREEPOINTER HERE\
(* 13 - SAVE START ADDRESS FOR DDT SYMBOL *)
		PFDISP := IC;
		WITH FPROCP^ DO
		 IF PFLEV > 1
		 THEN
		  FOR I := MAXLEVEL DOWNTO PFLEV+1 DO
		  MACRO4(540B%HRR\,BASIS,BASIS,-1);
		PFSTART := IC;
(* 62 - clean up stack offset *)
	        if fprocp^.poffset # 0
		  then macro4(262B%pop\,topp,topp,-fprocp^.poffset-1);
(* 37 - fix static link for level one procedures *)
		if fprocp^.pflev = 1
		  then macro4(512b%hllzm\,basis,topp,-fprocp^.poffset-1)
		  ELSE MACRO4(202B%MOVEM\,BASIS,TOPP,-FPROCP^.POFFSET-1);
		if fprocp^.poffset # 0
		  then begin
		  macro4(201B%movei\,basis,topp,-fprocp^.poffset);
(* 104 - several changes below to allow detection stack overflow *)
		  macro3(504B%hrl\,basis,basis);
		  end
		 ELSE MACRO3(507B%HRLS\,BASIS,TOPP);
(* 115 - tenex *)
		IF KLCPU AND NOT TOPS10
		  THEN MACRO3(105B%ADJSP\,TOPP,0)
		  ELSE MACRO4(541B%HRRI\,TOPP,TOPP,0);
		INSERTSIZE := CIX;
(* 66 - NONLOC GOTO *)
		IF NONLOC
		  THEN MACRO4(506B%HRLM\,TOPP,BASIS,0);
(* If anyone has done a non-local goto into this block, save the
   stack pointer here where the goto can recover it. *)
(* 53 - figure out later how many loc's above stack we need *)
(* 57 - LIMIT CORE ALLOCATION TO TOPS-10 VERSION *)
		IF TOPS10 THEN BEGIN
		IF RUNTMCHECK
		  THEN BEGIN
		  MACRO4(201B%MOVEI\,HAC,TOPP,0); CORALLOC := CIX;
		   %Will be fixed up - get highest core needed \
		  MACRO4(301B%CAIL\,HAC,BASIS,0); %check wraparound > 777777\
		  MACRO4(303B%CAILE\,HAC,NEWREG,0); %see if need more\
		  SUPPORT(DEBSTACK)
		  END
		 ELSE BEGIN %NOT DEBUG\
		  MACRO4(307B%CAIG\,NEWREG,TOPP,0); CORALLOC := CIX;
		    %will be fixed up - fails if wrap around 777777\
		  SUPPORT(STACKOVERFLOW);
		  END
		END;
(* 24 - NOW ZERO ONLY IF RUNTIME CHECKING ON *)
(* 25 - SEPARATE SWITCH /ZERO FOR THIS NOW *)
		IF ZERO
		THEN BEGIN
		IF LCPAR < LC  %ANY VARIABLES?\
		  THEN MACRO4(402B%SETZM\,0,BASIS,LCPAR);
		IF LCPAR < (LC-1) %MORE THAN ONE?\
		  THEN BEGIN
		  MACRO4(505B%HRLI\,TAC,BASIS,LCPAR);
		  MACRO4(541B%HRRI\,TAC,BASIS,LCPAR+1);
		  MACRO4(251B%BLT\,TAC,BASIS,LC-1)
		  END
		END;
		REGC := REGIN+1;
		LCP := FPROCP^.NEXT;
		WHILE LCP # NIL DO
		WITH LCP^ DO
		 BEGIN
(* 33 - proc param.'s*)
		   IF KLASS # VARS
		   THEN
		     BEGIN
		     IF REGC <= PARREGCMAX
			THEN BEGIN
			MACRO4(202B%MOVEM\,REGC,BASIS,PFADDR);
			REGC := REGC+1
			END
		     END
		   ELSE
		     IF IDTYPE # NIL
		     THEN
		       IF (VKIND=FORMAL) OR (IDTYPE^.SIZE=1)
		       THEN   %COPY PARAMETERS FROM REGISTERS INTO LOCAL CELLS\
			 BEGIN
			   IF REGC <= PARREGCMAX
			   THEN
			     BEGIN
			      MACRO4(202B%MOVEM\,REGC,BASIS,VADDR); REGC := REGC + 1
			     END
			 END
		       ELSE
			 IF IDTYPE^.SIZE=2
			 THEN
			   BEGIN
			     IF REGC < PARREGCMAX
			     THEN
			       BEGIN
				MACRO4(202B%MOVEM\,REGC,BASIS,VADDR);
				MACRO4(202B%MOVEM\,REGC+1,BASIS,VADDR+1);
				REGC:=REGC+2
			       END
(* 2 - bug fix for parameter passing *)
			     ELSE REGC:=PARREGCMAX+1
			   END
(* 201 - zero size things *)
			 ELSE IF IDTYPE^.SIZE > 0
			   THEN BEGIN
			     IF REGC <= PARREGCMAX
			     THEN  %COPY MULTIPLE VALUES INTO LOCAL CELLS\
			       BEGIN
				MACRO3(504B%HRL\,TAC,REGC); REGC := REGC + 1
			       END
			     ELSE
			      MACRO4(504B%HRL\,TAC,BASIS,VADDR);
			    MACRO4(541B%HRRI\,TAC,BASIS,VADDR);
			    MACRO4(251B%BLT\,TAC,BASIS,VADDR+IDTYPE^.SIZE-1)
			   END
(* 201 - zero size things *)
			 ELSE {zero size}
			  REGC := REGC + 1;
		  LCP := LCP^.NEXT;
		 END
	       END
	     ELSE  MAINSTART := IC
	   END %ENTERBODY\;

	  PROCEDURE LEAVEBODY;
	  VAR
	    J,K : ADDRRANGE ;
	    LFILEPTR: FTP; LKSP: KSP ;
(* 33 - PROGRAM *)
	    LCP : CTP; OLDID : ALFA;
	   PROCEDURE ALFACONSTANT(FSTRING:ALFA);
	   VAR LCSP:CSP;
	     BEGIN
	     NEW(LCSP,STRG);
	     WITH LCSP^ DO
	       BEGIN
	       SLGTH := 10; FOR I := 1 TO 10 DO SVAL[I] := FSTRING[I]
	       END;
	     WITH GATTR DO
	       BEGIN
	       TYPTR := ALFAPTR;
	       KIND := CST; CVAL.VALP := LCSP
	       END
	     END;
	   BEGIN
	     IF DEBUG
	     THEN PUTLINER;
	     IF  FPROCP # NIL
	     THEN
(* 173 - internal files - close them *)
	      if fileinblock[level]
	       then begin
{We have to close any files in this block before we can change TOPP,
 or we might be playing with locals above the stack!  So this is
 coded like a non-local goto - new basis in regc, new topp in regc+1}
		regc := regin+1;
(* 213 - forgot to subtract 1 from TOPP to simulate POPJ *)
		  {simulate HRLS TOPP,BASIS.  But have to subtract 1
		   since there would have been a POPJ TOPP, later.
		   Because of this, things that would be -1(TOPP) are
		   now (TOPP)}
		macro4(505B%hrli\,regc+1,basis,-1);
		macro3(544B%hlr\,regc+1,regc+1);
		  {simulate HLRS BASIS,-1(TOPP), but note that -1 has
		   already been done}
		macro4(544B%hlr\,regc,regc+1,0);
		macro3(504B%hrl\,regc,regc);
		  {now get return address from where POPJ TOPP, would
		   get it, i.e. (TOPP).  However note that -1 has been
		   done}
		macro4(550B%hrrz\,regc+2,regc+1,1);
		support(exitgoto)
		end
	      else
	       BEGIN
(* 104 - keep LH=RH in topp for tops20 adjsp *)
		MACRO3(507B%HRLS\,TOPP,BASIS);
		MACRO4(547B%HLRS\,BASIS,TOPP,-1);
		MACRO3(263B%POPJ\,TOPP,0);
	       END
	     ELSE
	       BEGIN
		 IF MAIN
		 THEN
		   BEGIN
		    SUPPORT(EXITPROGRAM);
		    STARTADDR := IC;
(* 2 - get some core by default if none there *)
(* 12 - REDO INITIALIZATION FOR DYNAMIC EXPANDING CORE *)
(* 16 - change entry code in case execute-only or entry at +1 *)
(* 24 - CHANGE AGAIN TO ALLOW ST. ADDR OF HEAP AND STACK SPECIFIED *)
		MACRO3R(254B%JRST\,1,IC+2); %PORTAL - IN CASE EXEC-ONLY\
		MACRO3R(254B%JRST\,1,IC+2); %IN CASE OFFSET =1\
		MACRO3(634B%TDZA\,1,1); %NORMAL ENTRY - ZERO AND SKIP\
		MACRO3(201B%MOVEI\,1,1); %CCL ENTRY - SET TO ONE\
		MACRO3R(202B%MOVEM\,1,CCLSW); %STORE CCL VALUE\
		MACRO3R(200B%MOVE\,1,CCLSW+4); %SEE IF INIT DONE\
		MACRO3R(326B%JUMPN\,1,IC+5); %YES - DON'T RESAVE AC'S\
		MACRO3R(202B%MOVEM\,0,CCLSW+1); %RUNNAME\
		MACRO3R(202B%MOVEM\,7B,CCLSW+2); %RUNPPN\
		MACRO3R(202B%MOVEM\,11B,CCLSW+3); %RUNDEV\
		MACRO3R(476B%SETOM\,0,CCLSW+4); %SAY WE HAVE DONE IT\
(* 132 - separate KA10 into NOVM and KACPU *)
		IF (HEAP = 0) AND (NOT NOVM)
		  THEN HEAP := 377777B;
		MACRO3(201B%MOVEI\,BASIS,HEAP); %LSTNEW_377777\
		MACRO3R(202B%MOVEM\,BASIS,LSTNEW); %WILL GET GLOBAL FIXUP\
		LSTNEW := IC-1;
		MACRO3(201B%MOVEI\,BASIS,HEAP+1); %NEWBND_400000\
		MACRO3R(202B%MOVEM\,BASIS,NEWBND); %GLOBAL FIXUP\
		NEWBND := IC-1;
		IF STACK#0
		  THEN MACRO3(201B%MOVEI\,BASIS,STACK)
		  ELSE MACRO3(550B%HRRZ\,BASIS,115B); %BASIS_.JBHRL\
		MACRO3(306B%CAIN\,BASIS,0); %IF NO HISEG\
		MACRO3(201B%MOVEI\,BASIS,377777B); %START STACK 400000\
		MACRO3(200B%MOVE\,NEWREG,BASIS); %NEWREG=HIGHEST ALLOC\
		MACRO3(271B%ADDI\,BASIS,1); %BASIS=NEXT TO USE\
		    MACRO4(505B%HRLI\,BASIS,BASIS,0);
		    MACRO4(541B%HRRI\,TOPP,BASIS,0); %GETS FIXED UP\
		    INSERTSIZE:= CIX;
(* 104 - KEEP LH=RH FOR TOPS20 ADJSP *)
		    MACRO3(504B%HRL\,TOPP,TOPP);
(* 66 - nonloc goto's *)
		    macro3r(202B%movem\,basis,globbasis);
		    macro3r(202B%movem\,topp,globtopp);
(* 17 - LEAVE .JBFF ALONE, SINCE BUFFER HEADERS POINT INTO FREE AREA *)
(* 57 - LIMIT UUO'S AND CORE ALLOC TO TOPS-10 VERSION *)
		IF TOPS10 THEN BEGIN
(* 122 - seem not to need to save .jbff any more *)
	  {	    MACRO3(550B%HRRZ\,1,121B); %.JBFF\
		    MACRO3(506B%HRLM\,1,120B); %TO LH(.JBSA)\
	  }	    MACRO3(047B,0,0%RESET-UUO\); %.JBFF=.JBSA\
(* 74 - new init stuff for tops10 under emulator *)
		    support(initmem);
(* 53 - figure out later how many loc's above stack we need *)
(* 130 - leave in dummy CAI in KA version so there is some place for the CORALLOC fixup to go *)
		  MACRO4(300B%CAI\,NEWREG,TOPP,0); CORALLOC := CIX;  %Will be fixed up later\
(* 122 - already get core in initmem for KA *)
(* 132 - separate KA10 into novm and kacpu *)
		  if not novm 
		    THEN SUPPORT(STACKOVERFLOW);	% GET CORE FOR STACK\
(* 34 - TRAP ARITH EXCEPTIONS WHEN CHECKING *)
		IF ARITHCHECK
		  THEN BEGIN
		  MACRO3(201B%MOVEI\,1,110B); %TRAP ALL ARITH. EXCEPTIONS\
		  MACRO3(047B%CALLI\,1,16B); %APRENB - TURN ON APR SYS\
		  END;
(* 57 - INIT ALL IN RUNTIMES FOR NON-TOPS10 *)
		END
		 ELSE MACRO3(201B%MOVEI\,2,ORD(ARITHCHECK));
(* 50 - reinit file ctl. blocks *)
		support(initfiles);
		doinitTTY := false;
		    LFILEPTR := SFILEPTR ;
		    REGC := REGIN + 1 ;
(* 33 - PROGRAM *)
(* 50 - changed logic to only open INPUT and OUTPUT if in pgm state *)
		    LPROGFILE := FPROGFILE;
		    WHILE LPROGFILE # NIL DO
		      BEGIN
		      PRTERR := FALSE; OLDID := ID; ID := LPROGFILE^.FILID;
		      SEARCHID([VARS],LCP);
		      PRTERR := TRUE; ID := OLDID;
		      IF LCP = NIL
			THEN ERRORWITHTEXT(508,LPROGFILE^.FILID)
			ELSE
			  WITH LCP^ DO
			  BEGIN
			  IF IDTYPE#NIL THEN IF IDTYPE^.FORM#FILES
			    THEN ERRORWITHTEXT(509,LPROGFILE^.FILID);
			  MACRO3R(201B%MOVEI\,REGC,VADDR);
			  IF (VLEV = 0) AND (NOT MAIN)
			    THEN BEGIN
			    VADDR := IC -1;
			    CODE.INFORMATION[CIX] := 'E'
			    END;
		          ALFACONSTANT(LPROGFILE^.FILID);
			  MACRO3(551B%HRRZI\,REGC+1,0);DEPCST(STRG,GATTR);
(* 61 - set up flags for gtjfn *)
			  i := 60023b; %mandatory flags for gtjfn\
			  if lprogfile^.wild
			    then i := i + 100B;
			  if lprogfile^.newgen
			    then i := i + 400000B;
			  if lprogfile^.oldfile
			    then i := i + 100000B;
			  macro3(505B%hrli\,regc+1,i);
(* 172 - end of line proc *)
			  if lcp = ttyfile
			    then ttyseeeol := lprogfile^.seeeol;
			  if not ((lcp = ttyfile) or (lcp = ttyoutfile))
			    then SUPPORT(READFILENAME)
			  END;
(* 171 - handle input and output as special - many changes to lcp = in/outfile *)
		      if (lcp = infile)
			and not lprogfile^.interact
			  then doinitTTY := true;
		      if (lcp = infile) or (lcp = outfile)
			then begin
			macro3(201B%movei\,regc-1,0);  {AC1=0 for text file}
			macro3(403B%setzb\,regc+1,regc+2);
			macro3(403B%setzb\,regc+3,regc+4);
(* 64 - input:/ *)
(* 157 - always open INPUT interactive - do GET below *)
			if lcp = infile
			  then macro3(201B%movei\,regc+3,1);
			macro3(403B%setzb\,regc+5,regc+6);
(* 172 - new eoln handling *)
			if (lcp = infile) and lprogfile^.seeeol
			  then if tops10
				 then macro3(201B%movei\,regc+5,40000B)
				 else macro3(201B%movei\,regc+6,20B);
			if lcp = infile
			  then support(resetfile)
			  else support(rewritefile)
			end;
		      LPROGFILE := LPROGFILE^.NEXT
		      END;
(* 15 - ZERO ALL ARGS TO OPEN *)
		    TTYINUSE := TTYINUSE OR DEBUG;
		    WHILE LFILEPTR # NIL DO
		    WITH LFILEPTR^ , FILEIDENT^ DO
(* 50 - only open TTY here, as INPUT and OUTPUT done above *)
		    begin
		    if (fileident = ttyfile) or (fileident = ttyoutfile)
			then
		     BEGIN
		      MACRO3R(201B%MOVEI\,REGC,VADDR) ;
		      macro3(201B%movei\,regc-1,0);  {0=text file}
(* 202 - fix illegal option *)
		      macro3(403B%setzb\,regc+1,regc+2);
		      macro3(403B%setzb\,regc+3,regc+4);
(* 172 - new EOL *)
		      macro3(403B%setzb\,regc+5,regc+6);
		      if (fileident = ttyfile) and ttyseeeol
			  then if tops10
				 then macro3(201B%movei\,regc+5,40000B)
				 else macro3(201B%movei\,regc+6,20B);
(* 36 - allow debugging non-main modules *)
		       IF fileident = ttyfile
		       THEN
			SUPPORT(RESETFILE)
		       ELSE
			  SUPPORT(REWRITEFILE) ;
		     end;
(* 3 - Removed OPENTTY because of RUNTIM changes *)
		      LFILEPTR := NEXTFTP ;
		    END ;
		    if doinitTTY
		      then support(opentty);
		    macro3(200b%move\,tac,74b);  %get .jbddt\
		    macro3(602b%trne\,tac,777777b);  %if zero RH\
		    macro3(603b%tlne\,tac,777777b);  %or non-0 LH\
		    macro3r(254b%jrst\,0,mainstart); %isn't PASDDT\
		    macro4(260b%pushj\,topp,tac,-2); %init pt. is start-2\
		    MACRO3R(254B%JRST\,0,MAINSTART);
		   END;
	       END;
	    CODEEND := IC;
	    LKSP:= FIRSTKONST;
	    WHILE LKSP # NIL DO
	    WITH LKSP^,CONSTPTR^ DO
	     BEGIN
	      KADDR:= IC;
	       CASE  CCLASS OF
		INT,
		REEL: IC := IC + 1 ;
		PSET: IC := IC + 2 ;
		STRD,
		STRG: IC := IC + (SLGTH+4) DIV 5
	       END ;
	      %CASE\
	      LKSP := NEXTKONST
	     END  %WITH , WHILE\;
	     IF DEBUGSWITCH
	     THEN
	       BEGIN
		 IF (LEVEL > 1) AND ( DISPLAY[TOP].FNAME # NIL )
		 THEN INSERTADDR(RIGHT,IDTREE,IC)
	       END
	     ELSE
	       IF LEVEL = 1
	       THEN HIGHESTCODE := IC
	   END%LEAVEBODY\;

	  PROCEDURE FETCHBASIS(VAR FATTR: ATTR);
	  VAR
	    P,Q: INTEGER;
	   BEGIN
	    WITH FATTR DO
	     IF VLEVEL>1
	     THEN
	       BEGIN
		P := LEVEL - VLEVEL;
		 IF P=0
		 THEN
		   IF INDEXR=0
		   THEN INDEXR := BASIS
		   ELSE MACRO3(270B%ADD\,INDEXR,BASIS)
		 ELSE
		   BEGIN
		    MACRO4(540B%HRR\,TAC,BASIS,-1);
		    FOR Q := P DOWNTO 2 DO
		    MACRO4(540B%HRR\,TAC,TAC,-1);
		     IF INDEXR=0
		     THEN INDEXR := TAC
		     ELSE MACRO3(270B%ADD\,INDEXR,TAC)
		   END;
		VLEVEL:=1	%DA IN WITHSTATEMENT DIE MOEGLICHKEIT BESTEHT,
				 DASS ES 2-MAL DURCH FETCHBASIS LAEUFT\
	       END
	   END;
	  %FETCHBASIS\

	  PROCEDURE GETPARADDR;
	   BEGIN
	    FETCHBASIS(GATTR);
	    WITH GATTR DO
	     BEGIN
	      INCREMENTREGC;
	      MACRO5(VRELBYTE,200B%MOVE\,REGC,INDEXR,DPLMT);
	      INDEXR := REGC; VRELBYTE:= NO;
	      INDBIT := 0; VLEVEL := 1; DPLMT := 0;
	     END
	   END;

{Warning to future modifiers: At the end of EXPRESSION, there is code that
 second-guesses the register allocation in this procedure.  If you change
 the register allocation here, please look at that code.}
	  PROCEDURE MAKECODE(FINSTR: INSTRANGE; FAC: ACRANGE; VAR FATTR: ATTR);
	  VAR
	    LINSTR: INSTRANGE; LREGC: ACRANGE;
	   BEGIN
	    WITH FATTR DO
	     IF TYPTR#NIL
	     THEN
	       BEGIN
		 CASE KIND OF
		  CST:
		       IF TYPTR=REALPTR
		       THEN
			 BEGIN
			  MACRO3(FINSTR,FAC,0); DEPCST(REEL,FATTR)
			 END
		       ELSE
			 IF TYPTR^.FORM=SCALAR
			 THEN
			  WITH CVAL DO
			   IF ((IVAL >= 0) AND (IVAL <= MAXADDR))
			    OR
(* 50 - correct code for 400000,,0 *)
			    ((ABS(IVAL) <= HWCSTMAX+1) AND (IVAL # 400000000000B)
			     AND
			     ((FINSTR = 200B%MOVE\) OR (IVAL >= 0)))
			   THEN
			     BEGIN
			       IF FINSTR=200B%MOVE\
			       THEN
				 IF IVAL < 0
				 THEN FINSTR := 571B%HRREI\
				 ELSE FINSTR := 551B%HRRZI\
			       ELSE
				 IF (FINSTR>=311B) AND (FINSTR <= 317B)
				 THEN FINSTR := FINSTR - 10B %E.G. CAML --> CAIL\
				 ELSE FINSTR := FINSTR+1;
			      MACRO3(FINSTR,FAC,IVAL);
			     END
			   ELSE
			     BEGIN
			      MACRO3(FINSTR,FAC,0); DEPCST(INT,FATTR)
			     END
			 ELSE
			   IF TYPTR=NILPTR
			   THEN
			     BEGIN
			       IF FINSTR=200B%MOVE\
			       THEN FINSTR := 571B%HRREI\
			       ELSE
				 IF (FINSTR>=311B) AND (FINSTR<=317B)
				 THEN FINSTR := FINSTR-10B
				 ELSE FINSTR := FINSTR+1;
			      MACRO3(FINSTR,FAC,377777B);
			     END
			   ELSE
			     IF TYPTR^.FORM=POWER
			     THEN
			       BEGIN
				MACRO3(FINSTR,FAC,0); MACRO3(FINSTR,FAC-1,0); DEPCST(PSET,FATTR);
			       END
			     ELSE
			       IF TYPTR^.FORM=ARRAYS
			       THEN
				 IF TYPTR^.SIZE = 1
				 THEN
				   BEGIN
				    MACRO3(FINSTR,FAC,0); DEPCST(STRG,FATTR)
				   END
				 ELSE
				   IF TYPTR^.SIZE = 2
				   THEN
				     BEGIN
				      FATTR.CVAL.VALP^.CCLASS := STRD;
				      MACRO3(FINSTR,FAC,0); MACRO3(FINSTR,FAC-1,0); DEPCST(STRD,FATTR);
				     END;
		  VARBL:
			 BEGIN
			  FETCHBASIS(FATTR); LREGC := FAC;
			   IF (INDEXR>REGIN) AND (INDEXR<=REGCMAX) AND ((PACKFG#NOTPACK) OR (FINSTR=200B%MOVE\))
			   THEN
			     IF (TYPTR^.SIZE = 2) AND LOADNOPTR
			     THEN LREGC := INDEXR+1
			     ELSE LREGC := INDEXR
			   ELSE
			     IF (PACKFG#NOTPACK) AND (FINSTR#200B%MOVE\)
			     THEN
			       BEGIN
				INCREMENTREGC; LREGC := REGC
			       END;
			   CASE PACKFG OF
			    NOTPACK:
				     BEGIN
				       IF (TYPTR^.SIZE = 2) AND LOADNOPTR
				       THEN
(* 141 - protect against obscure case where INDEXR = LREGC *)
					IF LREGC <> INDEXR
					 THEN BEGIN
					  MACRO5(VRELBYTE,FINSTR,LREGC,INDEXR,DPLMT+1);
					  MACRO5(VRELBYTE,FINSTR,LREGC-1,INDEXR,DPLMT)
					  END
					 ELSE BEGIN
					  MACRO5(VRELBYTE,FINSTR,LREGC-1,INDEXR,DPLMT);
					  MACRO5(VRELBYTE,FINSTR,LREGC,INDEXR,DPLMT+1)
					  END
				       ELSE MACRO(VRELBYTE,FINSTR,LREGC,INDBIT,INDEXR,DPLMT);
				     END;
			    PACKK:
				   BEGIN
				    MACRO5(VRELBYTE,201B%MOVEI\,TAC,INDEXR,DPLMT);
				     IF (BPADDR>REGIN) AND (BPADDR<=REGCMAX)
				     THEN
				       IF (INDEXR<=REGIN) OR (BPADDR<INDEXR)
				       THEN LREGC := BPADDR
				       ELSE LREGC := INDEXR;
				    MACRO3R(135B%LDB\,LREGC,BPADDR);
				   END;
			    HWORDL:  MACRO5(VRELBYTE,554B%HLRZ\,LREGC,INDEXR,DPLMT);
			    HWORDR:  MACRO5(VRELBYTE,550B%HRRZ\,LREGC,INDEXR,DPLMT)
			   END %CASE\;
			   IF (FINSTR#200B%MOVE\) AND (PACKFG#NOTPACK)
			   THEN
			    MACRO3(FINSTR,FAC,LREGC)
			   ELSE FAC := LREGC
			 END;
		  EXPR:
			IF FINSTR#200B%MOVE\
			THEN
			  IF TYPTR^.SIZE = 2
			  THEN
			    BEGIN
			     MACRO3(FINSTR,FAC,REG); MACRO3(FINSTR,FAC-1,REG-1)
			    END
			  ELSE MACRO3(FINSTR,FAC,REG)
		 END %CASE\;
		KIND := EXPR; REG := FAC;
	       END;
	   END;

	  PROCEDURE LOAD(VAR FATTR: ATTR);
	   BEGIN
	    WITH FATTR DO
	     IF TYPTR#NIL
	     THEN
	       IF KIND#EXPR
	       THEN
		 BEGIN
		  INCREMENTREGC ;
		   IF (TYPTR^.SIZE = 2) AND LOADNOPTR
		   THEN INCREMENTREGC ;
		  MAKECODE(200B%MOVE\,REGC,FATTR);REGC := REG
		 END;
	   END;
	  %LOAD\

(* 104 - common procedure for improved range check on subranges *)
	  procedure loadsubrange(var gattr:attr;lsp:stp);
	    var slattr:attr; srmin,srmax:integer;
	    begin
            GETBOUNDS(LSP,SRMIN,SRMAX);
	    IF (GATTR.KIND=CST)
	    THEN
	      IF (GATTR.CVAL.IVAL >= SRMIN) AND (GATTR.CVAL.IVAL <=SRMAX)
	      THEN LOAD (GATTR)
	      ELSE ERROR (367)
	    ELSE
	      BEGIN
	        IF RUNTMCHECK AND (( GATTR.KIND#VARBL) OR (GATTR.SUBKIND # LSP))
	        THEN
	          BEGIN
	           LOAD (GATTR);
	           WITH SLATTR DO
			BEGIN
			 TYPTR:=INTPTR;
			 KIND :=CST;
			 CVAL.IVAL:=SRMAX
			END;
	           MAKECODE(317B%CAMG\,REGC,SLATTR);
	           SLATTR.KIND:=CST;
	           SLATTR.CVAL.IVAL:=SRMIN;
	           MAKECODE(315B%CAMGE\,REGC,SLATTR);
	           SUPPORT(ERRORINASSIGNMENT)
	          END
	        ELSE LOAD (GATTR);
	      END
	    end;

	  PROCEDURE STORE(FAC: ACRANGE; VAR FATTR: ATTR);
	  VAR
	    LATTR: ATTR;
	   BEGIN
	    LATTR := FATTR;
	    WITH LATTR DO
	     IF TYPTR # NIL
	     THEN
	       BEGIN
		FETCHBASIS(LATTR);
		 CASE PACKFG OF
		  NOTPACK:
			   BEGIN
			     IF TYPTR^.SIZE = 2
			     THEN
			       BEGIN
				MACRO5(VRELBYTE,202B%MOVEM\,FAC,INDEXR,DPLMT+1); FAC := FAC-1
			       END;
			    MACRO(VRELBYTE,202B%MOVEM\,FAC,INDBIT,INDEXR,DPLMT)
			   END;
		  PACKK:
			 BEGIN
			  MACRO5(VRELBYTE,201B%MOVEI\,TAC,INDEXR,DPLMT);
			  MACRO3R(137B%DPB\,FAC,BPADDR);
			 END;
		  HWORDL:  MACRO5(VRELBYTE,506B%HRLM\,FAC,INDEXR,DPLMT);
		  HWORDR:  MACRO5(VRELBYTE,542B%HRRM\,FAC,INDEXR,DPLMT)
		 END  %CASE\ ;
	       END %WITH\ ;
	   END %STORE\ ;

{Warning to future modifiers: At the end of EXPRESSION, there is code that
 second-guesses the register allocation in this procedure.  If you change
 the register allocation here, please look at that code.}
	  PROCEDURE LOADADDRESS;
	   BEGIN
	    INCREMENTREGC ;
	     BEGIN
	      WITH GATTR DO
	       IF TYPTR # NIL
	       THEN
		 BEGIN
		   CASE KIND OF
		    CST:
			 IF STRING(TYPTR)
			 THEN
			   BEGIN
			    MACRO3(201B%MOVEI\,REGC,0);
			    DEPCST(STRG,GATTR)
			   END
			 ELSE ERROR(171);
		    VARBL:
			   BEGIN
			     IF (INDEXR>REGIN)	AND  (INDEXR <= REGCMAX)
			     THEN REGC := INDEXR;
			    FETCHBASIS(GATTR);
			     CASE PACKFG OF
			      NOTPACK: MACRO(VRELBYTE,201B%MOVEI\,REGC,INDBIT,INDEXR,DPLMT);
			      PACKK,HWORDL,HWORDR: ERROR(357)
			     END;
			   END;
		    EXPR:  ERROR(171)
		   END;
		  KIND := VARBL;  DPLMT := 0; INDEXR:=REGC; INDBIT:=0; VRELBYTE := NO
		 END
	     END
	   END %LOADADDRESS\ ;

	  PROCEDURE WRITEMC(WRITEFLAG:WRITEFORM);
	  CONST
(* 155 *)
	    MAXSIZE %OF CONSTANT-, STRUCTURE-, AND ID.-RECORD\ = 44 %WORDS\ ;
	  TYPE
	    WANDELFORM=(KONSTANTE,PDP10CODE,REALCST,STRCST,SIXBITCST,HALFWD,PDP10BP,RADIX) ;
	    RECORDFORM=(NONE,CONSTNTREC,STRUCTUREREC,IDENTIFREC,DEBUGREC);
	    BIGALFA = PACKED ARRAY[1..15] OF CHAR ;
	  VAR
	    I,J,L  : INTEGER; LLISTCODE: BOOLEAN; CHECKER: CTP;
	    LIC  : ADDRRANGE; LFIRSTKONST: KSP; LRELBYTE: RELBYTE;
	    STRING: ARRAY[1..6] OF CHAR; LFILEPTR: FTP; SWITCHFLAG: FLAGRANGE;
	    FILBLOCKADR : ADDRRANGE ; CODEARRAY: BOOLEAN; LICMOD4: ADDRRANGE;
	    LSIZE: 1..MAXSIZE; RUN1: BOOLEAN; SAVELISTCODE: BOOLEAN;
	    CSP0: CSP; %INSTEAD OF NIL\
	    RELARRAY, RELEMPTY: ARRAY[1..MAXSIZE] OF RELBYTE;
	    WANDLUNG : PACKED RECORD
				CASE WANDELFORM  OF
				     KONSTANTE:(WKONST :INTEGER);
				     PDP10CODE:(WINSTR :PDP10INSTR);
				     REALCST  :(WREAL: REAL);
				     STRCST   :(WSTRING:CHARWORD);
				     SIXBITCST:(WSIXBIT:PACKED ARRAY[1..6] OF 0..77B);
				     HALFWD   :(WLEFTHALF:ADDRRANGE ; WRIGHTHALF : ADDRRANGE);
				     PDP10BP  :(WBYTE: BPOINTER);
				     RADIX    :(FLAG: FLAGRANGE; SYMBOL: RADIXRANGE)

			      END;
	    ICWANDEL: PACKED RECORD
			       CASE VARIANTE:INTEGER OF
				    1:(ICVAL: ADDRRANGE);
				    2:(ICCSP: CSP);
				    3:(ICCTP: CTP);
				    4:(ICSTP: STP)
			     END;
	    RECORDWANDEL: PACKED RECORD
				   CASE RECORDFORM OF
					NONE:  (WORD:ARRAY[1..MAXSIZE] OF INTEGER);
					CONSTNTREC:(CONSTREC: CONSTNT);
					STRUCTUREREC:(STRUCTREC: STRUCTURE);
					IDENTIFREC:(IDENTREC: IDENTIFIER);
					DEBUGREC:(DEBUGREC: DEBENTRY)
				 END;

	    PROCEDURE NEUEZEILE;
	     BEGIN
(* 6 - if CREFing, less stuff fits on a line *)
	      IF CREF
		THEN LICMOD4 := LIC MOD 3
		ELSE LICMOD4 := LIC MOD 4;
	       IF (LICMOD4 = 0) AND LISTCODE AND (LIC > 0)
	       THEN
		 BEGIN
(* 136 - LISTING FORMAT *)
		  newline ;
		   IF RELBLOCK.ITEM = 1
		   THEN
		     BEGIN
		      WRITE(LIC:6:O);
		       IF LIC >= PROGRST
		       THEN WRITE('''')
		       ELSE WRITE(' ')
		     END
		   ELSE WRITE(' ':7)
		 END
	     END %NEUEZEILE\ ;

	    PROCEDURE PUTRELCODE;
	    VAR
	      I: INTEGER;

	     BEGIN
	      WITH RELBLOCK DO
(* 146 - Move count := 0 outside the test, since we must zero count in
   the case where COUNT = 1 and ITEM = 1. *)
	       BEGIN
	       IF ((COUNT > 1) OR (ITEM # 1)) AND (COUNT > 0)
	       THEN
		 BEGIN
		  FOR I:= COUNT+1 TO 18 DO RELOCATOR[I-1] := NO;
		  FOR I:= 1 TO COUNT+2 DO
		   BEGIN
		    OUTPUTREL^:= COMPONENT[I];
		    PUT(OUTPUTREL)
		   END;
		 END;
(* 146 *)
	       COUNT := 0;
	       END;
	     END;

	    PROCEDURE SHOWRELOCATION(FSIDE: RELBYTE; FRELBYTE: RELBYTE);
	     BEGIN
	       IF (FRELBYTE = FSIDE) OR (FRELBYTE = BOTH)
	       THEN WRITE('''')
	       ELSE WRITE(' ')
	     END;

	    PROCEDURE WRITEBLOCKST( FITEM: ADDRRANGE);
	    VAR
	      WANDLUNG: PACKED RECORD
				 CASE BOOLEAN OF
				      TRUE: (WKONST: INTEGER);
				      FALSE: (WLEFTHALF: ADDRRANGE;WRIGHTHALF: ADDRRANGE)
			       END;
	     BEGIN
	      WITH RELBLOCK , WANDLUNG DO
	       BEGIN
		 IF COUNT # 0
		 THEN PUTRELCODE;
		ITEM:= FITEM;
		 IF ITEM = 1
		 THEN
		   BEGIN
		    WLEFTHALF:= 0;
		    WRIGHTHALF:= LIC;
		    CODE[0]:= WKONST;
		     IF WRIGHTHALF < PROGRST
		     THEN RELOCATOR[0] := NO
		     ELSE RELOCATOR[0] := RIGHT;
		    COUNT:= 1
		   END
	       END
	     END;

	    PROCEDURE WRITEWORD(FRELBYTE: RELBYTE; FWORD: INTEGER);
	    VAR
	      WANDLUNG: PACKED RECORD
				 CASE BOOLEAN OF
				      TRUE: (WKONST: INTEGER);
				      FALSE: (WLEFTHALF: ADDRRANGE; WRIGHTHALF: ADDRRANGE)
			       END;
	     BEGIN
	      WITH WANDLUNG DO
	       BEGIN
		WKONST := FWORD;
		WITH RELBLOCK DO
		 BEGIN
		   IF COUNT = 0
		   THEN WRITEBLOCKST(ITEM);
		  CODE[COUNT]:= FWORD;
		   IF FRELBYTE IN [LEFT,BOTH]
		   THEN
		     IF (WLEFTHALF < PROGRST) OR (WLEFTHALF = 377777B)
		     THEN FRELBYTE := FRELBYTE - LEFT;
		   IF FRELBYTE IN [RIGHT,BOTH]
		   THEN
		     IF (WRIGHTHALF < PROGRST) OR (WRIGHTHALF = 377777B)
		     THEN FRELBYTE := FRELBYTE - RIGHT;
		  RELOCATOR[COUNT]:= FRELBYTE; LRELBYTE := FRELBYTE;
		  COUNT := COUNT+1;
		   IF COUNT = 18
		   THEN PUTRELCODE
		 END;
		 IF LLISTCODE
		 THEN
		   BEGIN
		    NEUEZEILE;
		     IF LIC > 0
		     THEN WRITE(' ':13);
(* 173 - remove writefileblocks *)
		     IF WRITEFLAG > WRITELIBRARY
		     THEN WRITE(' ':7)
		     ELSE
		       BEGIN
			WRITE(WLEFTHALF:6:O); SHOWRELOCATION(LEFT,FRELBYTE)
		       END;
		    WRITE(WRIGHTHALF:6:O); SHOWRELOCATION(RIGHT,FRELBYTE); WRITE(' ':3)
		   END;
		 IF NOT CODEARRAY
		 THEN LIC := LIC + 1
	       END
	     END;

	    FUNCTION RADIX50( FNAME: ALFA): RADIXRANGE;
	    VAR
	      I: INTEGER; OCTALCODE, RADIXVALUE: RADIXRANGE;

	     BEGIN
	      RADIXVALUE:= 0;
	      I:=1;
	      WHILE (FNAME[I] # ' ') AND (I <= 6) DO
	       BEGIN
		 IF FNAME[I] IN DIGITS
		 THEN OCTALCODE:= ORD(FNAME[I])-ORD('0')+1
		 ELSE
		   IF FNAME[I] IN LETTERS
		   THEN OCTALCODE:= ORD(FNAME[I])-ORD('A')+11
		   ELSE
		     CASE FNAME[I] OF
		      '.': OCTALCODE:= 37;
		      '$': OCTALCODE:= 38;
		      '%': OCTALCODE:= 39
		     END;
		RADIXVALUE:= RADIXVALUE*50B; RADIXVALUE:= RADIXVALUE+OCTALCODE; I:=I+1
	       END;
	      RADIX50:= RADIXVALUE
	     END;

	    PROCEDURE WRITEPAIR( FRELBYTE: RELBYTE; FADDR1, FADDR2: ADDRRANGE);
	     BEGIN
	      WITH WANDLUNG DO
	       BEGIN
		WLEFTHALF:= FADDR1;
		WRIGHTHALF:= FADDR2;
		WRITEWORD(FRELBYTE,WKONST)
	       END
	     END;

	    PROCEDURE WRITEIDENTIFIER( FFLAG: FLAGRANGE; FSYMBOL: ALFA);
	     BEGIN
	      LLISTCODE := FALSE;
	      WITH WANDLUNG DO
	       BEGIN
		 IF LISTCODE AND (WRITEFLAG > WRITEHISEG)
		 THEN
		   BEGIN
(* 40 - if CREFing, less stuff fits on a line *)
		     IF ((NOT CREF) AND (LIC MOD 4 = 0) OR
			 CREF AND (LIC MOD 3 = 0)) AND (LIC > 0)
		     THEN
		       BEGIN
(* 136 - LISTING FORMAT *)
			NEWLINE;
			WRITE(' ':7)
		       END;
		     IF LIC > 0
		     THEN WRITE(' ':13); WRITE(FSYMBOL:6,' ':11)
		   END;
(* 40 - print format *)
		 if listcode and cref then lic := lic+1;
		 IF FFLAG # 6B
		 THEN
		   BEGIN
		    FLAG:= FFLAG; SYMBOL:= RADIX50(FSYMBOL)
		   END;
		WRITEWORD(NO,WKONST); LLISTCODE := LISTCODE
	       END
	     END;

	    PROCEDURE WRITEFIRSTLINE ;
	     BEGIN
	       IF LISTCODE
	       THEN
		 BEGIN
(* 136 - LISTING FORMAT *)
		  NEWLINE;
(* 6 - if CREFing, less stuff fits on a line *)
		  IF CREF
		    THEN LICMOD4 := LIC MOD 3
		    ELSE LICMOD4 := LIC MOD 4;
		   IF LICMOD4 > 0
		   THEN
		     BEGIN
		      WRITE(LIC-LICMOD4:6:O);
		       IF LIC >= PROGRST
		       THEN WRITE('''')
		       ELSE WRITE(' ');
		      WRITE(' ':LICMOD4*30);
		       IF (WRITEFLAG = WRITECODE) AND CODEARRAY
		       THEN WRITE(' ':2)
		     END
		 END
	     END ;

	    PROCEDURE WRITEHEADER(FTEXT: BIGALFA);
	     BEGIN
	      LIC := 0;
	       IF LISTCODE
	       THEN
		 BEGIN
(* 136 - LISTING FORMAT *)
		  NEWLINE;
		  WRITE(FTEXT:15,':',' ':4)
		 END
	     END;

(*173 - remove writefileblocks *)

	    PROCEDURE MCGLOBALS;
	     BEGIN
	      %MCGLOBALS\
	       IF LISTCODE AND (FGLOBPTR # NIL)
	       THEN WRITEBUFFER;
	      WHILE FGLOBPTR # NIL DO
	      WITH FGLOBPTR^ DO
	       BEGIN
		LIC := FIRSTGLOB ; WRITEFIRSTLINE ;
		J := FCIX ;
		WRITEBLOCKST(1);
		FOR I := FIRSTGLOB TO LASTGLOB DO
		 BEGIN
		  WANDLUNG.WINSTR := CODE.INSTRUCTION[J] ; J := J + 1 ;
		  WRITEWORD(NO,WANDLUNG.WKONST) ;
		 END ;
		FGLOBPTR := NEXTGLOBPTR
	       END;
	     END %MCGLOBALS\;

	    PROCEDURE MCCODE;

	      PROCEDURE WRITERECORD;
	       BEGIN
		FOR I := 1 TO LSIZE DO WRITEWORD(RELARRAY[I], RECORDWANDEL.WORD[I] )
	       END;

(* 211 - MAKE CONSTANTS WORK IN THE DEBUGGER *)
	      FUNCTION CONSTRECSIZE(FCSP: CSP): INTEGER;
	       BEGIN
		WITH FCSP^ DO
		 CASE CCLASS OF
		  INT,PSET: CONSTRECSIZE := 5;
		  REEL	  : CONSTRECSIZE := 4;
		  STRD,STRG:CONSTRECSIZE := 4 + (SLGTH+4) DIV 5
		 END
	       END;

	      PROCEDURE COPYCSP(FCSP:CSP);
	       BEGIN
		 IF FCSP # NIL
		 THEN  WITH FCSP^ DO
		   IF RUN1
		   THEN
		     BEGIN
		       IF SELFCSP = CSP0%NIL\
		       THEN WITH ICWANDEL DO
			 BEGIN
			  ICVAL := IC; SELFCSP := ICCSP;
			  NOCODE := TRUE;
			  IC := IC + CONSTRECSIZE(FCSP)
			 END
		     END
		   ELSE
		     IF NOCODE
		     THEN
		       BEGIN
			RECORDWANDEL.CONSTREC := FCSP^;
			LSIZE := CONSTRECSIZE(FCSP);
			RELARRAY := RELEMPTY;
			WRITERECORD; NOCODE := FALSE
		       END
	       END %COPYCSP\;

	      PROCEDURE COPYSTP(FSP:STP); FORWARD;

	      PROCEDURE COPYCTP(FCP:CTP);
	       BEGIN
		 IF FCP # NIL
		 THEN WITH FCP^ DO
		   IF RUN1 AND (SELFCTP=NIL) OR NOT RUN1 AND NOCODE
		   THEN
		     BEGIN
		       IF RUN1
		       THEN
			WITH ICWANDEL DO
			 BEGIN
			  ICVAL := IC;
			  SELFCTP := ICCTP; NOCODE := TRUE;
			  IC := IC + IDRECSIZE[KLASS]
			 END %WITH\
		       ELSE %NOW RUN 2\
			WITH RECORDWANDEL DO
			 BEGIN
			  RELARRAY := RELEMPTY;
			  IDENTREC := FCP^;
			  WITH IDENTREC DO
			   BEGIN
			     IF LLINK#NIL
			     THEN
			       BEGIN
				LLINK:=LLINK^.SELFCTP; RELARRAY[3] := 1
			       END;
			     IF RLINK#NIL
			     THEN
			       BEGIN
				RLINK:=RLINK^.SELFCTP; RELARRAY[3] := RELARRAY[3] + 2
			       END;
			     IF NEXT #NIL
			     THEN
			       BEGIN
				NEXT := NEXT^.SELFCTP; RELARRAY[4] := 1B
			       END;
			     IF IDTYPE # NIL
			     THEN
			       BEGIN
				 IF KLASS = KONST
				 THEN
				   IF IDTYPE^.FORM > POINTER
				   THEN
(* 211 - FIX CONSTANT PRINTING *)
				     BEGIN
				     VALUES.VALP := VALUES.VALP^.SELFCSP;
				     RELARRAY[6] := 1B
				     END
				   ELSE
				     IF IDTYPE = REALPTR
				     THEN
				       BEGIN
					WANDLUNG.WREAL := VALUES.VALP^.RVAL;
					VALUES.IVAL := WANDLUNG.WKONST
				       END;
				 IF KLASS=VARS
				 THEN
				   IF VLEV<2
				   THEN RELARRAY[6] := 2;
				 IF KLASS = FIELD
				 THEN
				   IF PACKF = PACKK
				   THEN RELARRAY[6] := 2;
				IDTYPE:=IDTYPE^.SELFSTP; RELARRAY[4] := RELARRAY[4] + 2
			       END
			   END;
			  LSIZE := IDRECSIZE[KLASS]; WRITERECORD;
			  NOCODE := FALSE
			 END %WITH RECORDWANDEL\;
		      COPYCTP(LLINK);
		      COPYCTP(RLINK);
		      COPYSTP(IDTYPE);
(* 214 - fix debugger problem with foward declared proc's *)
{The following is somewhat of a kludge. We don't want to do COPYCTP
 on the NEXT field of a procedure.  If we did, the following could
 happen:
	procedure foo(x:integer); forward;
	...
	  foo(1);
	...
	procedure foo;
	  var i,j;
 When the final declaration of FOO is supplied, the symbol table is
 initialized from symboltable(FOO)^.NEXT, which contains the parameters,
 as supplied in the forward decl.  Then I and J are added to the symbol
 table.  The result is that X points to I and J in the symbol table
 tree.  This is all fine.  The problem comes when the identifier
 record for FOO is put into the .REL file before the final declaration.
 If COPYCTP traces the NEXT field, then the identifier records for all
 the parameters are also put out.  Since a given identifier is put out
 only once, this means that X is put into the .REL file before pointers
 to I and J are added to it.  The effect is that the debugger can't
 see I and J.
    It turns out that the  debugger never uses the NEXT field of a
 procedure entry.  Thus it is not crucial to have a correctly mapped
 value when the identifier record for the procedure is put out.
 If we don't call COPYCTP on NEXT, then the NEXT field put into the
 .REL file will be junk, but at least records for the parameters won't
 be put out prematurely.  They will get put out eventually even without
 tracing NEXT, since they will show up in the symbol table for the
 procedure when it is finally declared.  That should suffice.}

		      IF NOT (KLASS IN [PROC,FUNC])
		        THEN COPYCTP(NEXT);
		       IF (KLASS = KONST)  AND (IDTYPE # NIL)
		       THEN
			 IF IDTYPE^.FORM > POINTER
			 THEN COPYCSP(VALUES.VALP)
		     END %WITH FCP^\
	       END %COPYCTP\;

	      PROCEDURE COPYSTP;
	       BEGIN
		 IF FSP # NIL
		 THEN WITH FSP^ DO
		   IF RUN1 AND (SELFSTP = NIL)	OR  NOT RUN1 AND NOCODE
		   THEN
		     BEGIN
		       IF RUN1
		       THEN
			WITH ICWANDEL DO
			 BEGIN
			  NOCODE:=TRUE;
			  ICVAL := IC; SELFSTP := ICSTP;
			  IC := IC + STRECSIZE[FORM]
			 END
		       ELSE %NOW RUN 2\
			 IF NOCODE
			 THEN WITH RECORDWANDEL DO
			   BEGIN
			    RELARRAY := RELEMPTY; RELARRAY[2] := 1;
			    STRUCTREC := FSP^;
			    WITH STRUCTREC DO
			     CASE FORM OF
			      SCALAR:
				      IF SCALKIND = DECLARED
				      THEN
					IF FCONST#NIL
					THEN FCONST:=FCONST^.SELFCTP;
			      SUBRANGE:
					BEGIN
					 RANGETYPE:=RANGETYPE^.SELFSTP; RELARRAY[2]:=1
					END;
			      POINTER:
				       IF ELTYPE # NIL
				       THEN ELTYPE := ELTYPE^.SELFSTP;
			      POWER:	ELSET := ELSET^.SELFSTP;
			      ARRAYS:
				      BEGIN
(* 122 - DON'T FOLLOW NILS ON FUDGED TYPES *)
				      IF AELTYPE#NIL
				        THEN AELTYPE := AELTYPE^.SELFSTP;
				      IF INXTYPE#NIL
					THEN INXTYPE := INXTYPE^.SELFSTP; 
				      RELARRAY[3] := 3
				      END;
			      RECORDS:
				       BEGIN
					 IF FSTFLD # NIL
					 THEN FSTFLD := FSTFLD^.SELFCTP;
					 IF RECVAR # NIL
					 THEN
					   BEGIN
					    RECVAR := RECVAR^.SELFSTP; RELARRAY[3] := 2
					   END
				       END;
			      FILES:	IF FILTYPE # NIL 
					  THEN FILTYPE := FILTYPE^.SELFSTP;
			      TAGFWITHID,
			      TAGFWITHOUTID:
					     BEGIN
					      FSTVAR := FSTVAR^.SELFSTP;
					       IF FORM = TAGFWITHID
					       THEN TAGFIELDP := TAGFIELDP^.SELFCTP
					       ELSE TAGFIELDTYPE := TAGFIELDTYPE^.SELFSTP;
					      RELARRAY[3] := 2
					     END;
			      VARIANT:
				       BEGIN
					 IF SUBVAR # NIL
					 THEN SUBVAR := SUBVAR^.SELFSTP;
					 IF FIRSTFIELD # NIL
					 THEN
					   BEGIN
					    FIRSTFIELD := FIRSTFIELD^.SELFCTP; RELARRAY[3]:=1
					   END;
					 IF NXTVAR # NIL
					 THEN
					   BEGIN
					    NXTVAR := NXTVAR^.SELFSTP; RELARRAY[3] :=RELARRAY[3] + 2
					   END;
				       END
			     END %CASE\;
			    LSIZE := STRECSIZE[FORM]; WRITERECORD;
			    NOCODE := FALSE
			   END %RUN 2\;
		       CASE FORM OF
			SCALAR:
				IF SCALKIND = DECLARED
				THEN COPYCTP(FCONST);
			SUBRANGE:COPYSTP(RANGETYPE);
			POINTER: COPYSTP(ELTYPE);
			POWER:	 COPYSTP(ELSET);
			ARRAYS:
				BEGIN
				 COPYSTP(AELTYPE);
				 COPYSTP(INXTYPE)
				END;
			RECORDS:
				 BEGIN
				  COPYCTP(FSTFLD);
				  COPYSTP(RECVAR)
				 END;
			FILES:	 COPYSTP(FILTYPE);
			TAGFWITHID,
			TAGFWITHOUTID:
				       BEGIN
					COPYSTP(FSTVAR);
					 IF FORM = TAGFWITHID
					 THEN COPYCTP(TAGFIELDP)
					 ELSE COPYSTP(TAGFIELDTYPE)
				       END;
			VARIANT:
				 BEGIN
				  COPYSTP(NXTVAR);
				  COPYSTP(SUBVAR);
				  COPYCTP(FIRSTFIELD)
				 END
		       END %CASE\
		     END %WITH\
	       END %COPYSTP\;

	     BEGIN
	      %MCCODE\
	      CODEARRAY := FALSE; LLISTCODE:= FALSE;
	       IF LISTCODE
	       THEN WRITEBUFFER;
	       IF LASTBTP # NIL
	       THEN
		WITH LASTBTP^ DO
		 CASE BKIND OF
		  RECORDD:  LIC := FIELDCP^.FLDADDR ;
		  ARRAYY :  LIC := ARRAYSP^.ARRAYBPADDR
		 END ;
	      WRITEFIRSTLINE ; WRITEBLOCKST(1);
	      WHILE LASTBTP # NIL DO
	       BEGIN
		WITH  LASTBTP^,BYTE  DO
		 BEGIN
		   IF LISTCODE
		   THEN
		     BEGIN
		      NEUEZEILE;
		       IF LICMOD4 = 0
		       THEN WRITE(' ':7)
		       ELSE WRITE(' ':5);
		      WRITE(' POINT  ',SBITS:2,',') ;
		       IF IBIT = 0
		       THEN WRITE('  ')
		       ELSE WRITE(' @') ;
		      WRITE(RELADDR:5:O,'(',IREG:2:O,'),',35-PBITS:2) ;
		     END;
		  WITH WANDLUNG DO
		   BEGIN
		    WBYTE := BYTE;
		    WRITEWORD(NO,WKONST)
		   END;
		  LASTBTP := LAST
		 END
	       END % WHILE\ ;
	      LIC := CODEEND - CIX - 1 ; CODEARRAY := TRUE;
	      WRITEBLOCKST(1); WRITEFIRSTLINE;
	      FOR  I := 0 TO  CIX  DO
	      WITH CODE, INSTRUCTION[I], HALFWORD[I] DO
	       BEGIN
		LRELBYTE := RELOCATION[I]; WRITEWORD(LRELBYTE,WORD[I]);
		 IF LISTCODE
		 THEN
		   BEGIN
		    NEUEZEILE;
		     IF LICMOD4 = 0
		     THEN WRITE(' ':7)
		     ELSE WRITE(' ':5);
		     CASE INFORMATION[I] OF
		      'W':
			   BEGIN
			    WRITE(' ':6,LEFTHALF :6:O); SHOWRELOCATION(LEFT,LRELBYTE);
			    WRITE(RIGHTHALF:6:O); SHOWRELOCATION(RIGHT,LRELBYTE);
			    WRITE(' ':5)
			   END;
			  %'B': WITH WANDLUNG.WBYTE DO
			   BEGIN
			   WANDLUNG.WKONST := WORD[I];
			   WRITE(' POINT  ',SBITS:2,',');
			   IF IBIT = 0 THEN WRITE('  ') ELSE WRITE(' @');
			   WRITE(RELADDR:5:O,'(',IREG:2:O,'),',35-PBITS:2)
			   END;\
		      OTHERS:
			      BEGIN
(* 6 - UNPACK CAN'T DO THIS NOW *)
			       %UNPACK(MNEMONICS[(INSTR+9) DIV 10],((INSTR+9) MOD 10)*6+1,STRING,6);\
			       FOR J := 1 TO 6 DO
				STRING[J] := MNEMONICS[(INSTR+9) DIV 10, ((INSTR+9) MOD 10)*6 + J];
			       WRITE(' ',STRING:6, ' ',AC:2:O,', ');
				IF INDBIT = 0
				THEN WRITE(' ')
				ELSE WRITE('@');
			       WRITE(ADDRESS:6:O); SHOWRELOCATION(RIGHT,LRELBYTE);
				IF INXREG > 0
				THEN WRITE('(',INXREG:2:O,')',INFORMATION[I]:1)
				ELSE WRITE(' ':4,INFORMATION[I]:1)
			      END
		     END
		   END;
		LIC := LIC + 1
	       END  %FOR \ ;
	      CODEARRAY := FALSE; LLISTCODE := LISTCODE;
	       IF FIRSTKONST # NIL
	       THEN
		 BEGIN
		  LFIRSTKONST := FIRSTKONST; WRITEFIRSTLINE; WRITEBLOCKST(1);
		  WHILE LFIRSTKONST # NIL DO
		   BEGIN
		    WITH LFIRSTKONST^.CONSTPTR^ DO
		     CASE  CCLASS  OF
		      INT,
		      REEL: WRITEWORD(NO,INTVAL) ;
		      PSET:
			    BEGIN
			     % THE SET IS PICKED UP
			      AND WRITTEN OUT AS TWO OCTAL NUMBERS \
			     WRITEWORD(NO,INTVAL) ;
			     WRITEWORD(NO,INTVAL1) ;
			    END ;
		      STRD,
		      STRG: WITH WANDLUNG DO
			    BEGIN
			     J :=0; WKONST := 0;
			     FOR I := 1 TO SLGTH DO
			      BEGIN
			       J := J+1;
			       WSTRING[J] := SVAL[I];
				IF J=5
				THEN
				  BEGIN
				   J := 0;
				   WRITEWORD(NO,WKONST);
				   WKONST := 0
				  END
			      END;
			      IF J#0
			      THEN
			       WRITEWORD(NO,WKONST)
			    END
		     END;
		    LFIRSTKONST := LFIRSTKONST^.NEXTKONST
		   END	%WHILE\
		 END;
	       IF DEBUG
	       THEN
		 BEGIN
		   IF DEBUGSWITCH
		   THEN
		     BEGIN
(* 103 - globalidtree moved below *)
		      WRITEFIRSTLINE;
		      FOR RUN1 := TRUE DOWNTO FALSE DO COPYCTP(DISPLAY[TOP].FNAME);
		       IF LEVEL = 1
		       THEN
			 BEGIN
(* 103 - new way to set globalidtree and standardidtree *)
			  FOR RUN1 := TRUE DOWNTO FALSE DO COPYCTP(DISPLAY[0].FNAME);
			  if display[top].fname = nil
			    then debugentry.globalidtree := nil
			    else debugentry.globalidtree := display[top].fname^.selfctp;
			  debugentry.standardidtree := display[0].fname^.selfctp;
			 END;
		     END %DEBUGSWITCH\;
		   IF LEVEL = 1
		   THEN
		     BEGIN
		      WITH DEBUGENTRY DO
		       BEGIN
			NEWPAGER; LASTPAGEELEM := PAGER;
			INTPOINT  := INTPTR^. SELFSTP;
			REALPOINT := REALPTR^.SELFSTP;
			CHARPOINT := CHARPTR^.SELFSTP;
(* 36 - ALLOW MULTIPLE MODULES *)
			NEXTDEB := 0; %LINK WILL MAKE THIS PTR TO SIMILAR ENTRY IN NEXT MODULE\
			MODNAME := FILENAME;
		       CURNAME(INPUT,SOURCE);
		       END;
		      PAGEHEADADR := IC;
		      LSIZE := 44; %LENGTH OF DEBUGENTRY-RECORD\
		      RELARRAY[1] := 0;
		      FOR I:=2 TO 8 DO RELARRAY[I] := 1;
		      FOR I:= 9 TO LSIZE DO RELARRAY[I] := 0;
		      RECORDWANDEL.DEBUGREC := DEBUGENTRY;
		      IC := IC + LSIZE;
		      WRITERECORD;
		      HIGHESTCODE := IC;
(* 40 - fix printing format *)
(* 136 - LISTING FORMAT *)
		      if listcode then NEWLINE;
		      WRITEHEADER('LINK IN CHAIN 1');
		      LLISTCODE := FALSE;
		      WRITEBLOCKST(12B); %LINK BLOCK\
		      WRITEPAIR(NO,0,1); %LINK NUMBER 1\
		      LLISTCODE := LISTCODE;
		      WRITEPAIR(RIGHT,0,PAGEHEADADR); %NEXTDEB FIELD\
(* NB: LOCATION 141/2 ARE NOW HANDLED BY DEBSUP. 143 GETS .LNKEND FOR THE
      LINK SET UP ABOVE *)
		     END;
(* 5 - CREF *)
		 END;
(* 136 - LISTING FORMAT *)
	     IF LISTCODE THEN NEWLINE;
	     END %MCCODE\;

	    PROCEDURE MCVARIOUS;
	    VAR
(* 17 - MAKE SYMBOLS ACCEPTABLE TO DEC DDT *)
	      INLEVEL: BOOLEAN; PNAME:ALFA;
	     BEGIN
	      %MCVARIOUS\
	       CASE WRITEFLAG OF

(* 13 - ADD WRITEBLOCK FOR DDT SYMBOLS *)
(* 16 - MAKE ACCEPTABLE TO DEC DDT *)
		WRITEBLK:
				BEGIN
				PNAME := DISPLAY[TOP].BLKNAME;
(* 40 - fix print format *)
			        WRITEHEADER('LOCAL SYMBOLS  ');
				WRITEBLOCKST(2);
				WRITEIDENTIFIER(2B,PNAME);
				WRITEPAIR(RIGHT,0,PFSTART);
				I:=5;
				WHILE PNAME[I]=' ' DO I:=I-1;
				IF PFDISP#PFSTART
				 THEN BEGIN
				 PNAME[I+1]:='.';
				 WRITEIDENTIFIER(2B,PNAME);
				 WRITEPAIR(RIGHT,0,PFDISP)
				 END;
				IF PFPOINT#PFDISP
				 THEN BEGIN
				 PNAME[I+1]:='%';
				 WRITEIDENTIFIER(2B,PNAME);
				 WRITEPAIR(RIGHT,0,PFPOINT)
				 END
				END;
(* 164 - add Polish fixups *)
		WRITEPOLISH:
				BEGIN
				WRITEHEADER('POLISH FIXUPS  ');
				WHILE FIRSTPOL <> NIL DO
				  WITH FIRSTPOL^ DO
				    BEGIN
{A Polish fixup block looks like this:
   type 11
   operator,,0		0 means next half word is operand
   operand1,,0
   operand2,,-1		-1 means put in RH of result addr
   place to put result,,0
}
				    WRITEBLOCKST(11B);
				    IF OFFSET < 0
				      THEN WRITEPAIR(NO,4,0)  {4 - SUB}
				      ELSE WRITEPAIR(NO,3,0); {3 - ADD}
				    WRITEPAIR(LEFT,BASE,0);
				    WRITEPAIR(NO,ABS(OFFSET),777777B);
				    WRITEPAIR(LEFT,WHERE,0);
				    PUTRELCODE;
				    FIRSTPOL := NEXTPOL;  {CDR down list}
				    END;
				if cref and listcode then NEWLINE;
				END;
				    
		WRITEINTERNALS:
				BEGIN
				 WRITEHEADER('LOCAL REQUESTS '); INLEVEL := TRUE;
				 WRITEBLOCKST(8); CHECKER := LOCALPFPTR;
				 WHILE (CHECKER # NIL) AND INLEVEL DO
				 WITH CHECKER^ DO
				  IF PFLEV = LEVEL
				  THEN
				    BEGIN
				      IF PFADDR # 0
				      THEN
				       FOR I := 0 TO MAXLEVEL DO
					IF LINKCHAIN[I] # 0
					THEN WRITEPAIR(BOTH,LINKCHAIN[I],PFADDR-I);
				     CHECKER:= PFCHAIN
				    END
				  ELSE INLEVEL := FALSE;
				  IF LEVEL > 1
				  THEN LOCALPFPTR := CHECKER;
				 WHILE FIRSTKONST # NIL DO
				 WITH FIRSTKONST^, CONSTPTR^ DO
				  BEGIN
				   WRITEPAIR(BOTH,ADDR,KADDR);
(* 72 - two fixup chains for 2 word consts *)
				    IF (CCLASS IN [PSET,STRD]) AND (ADDR1 <> 0)
				    THEN WRITEPAIR(BOTH,ADDR1,KADDR+1);
				   FIRSTKONST:= NEXTKONST
				  END;
(* 64 - non-local gotos *)
				inlevel := true;
				while (lastlabel # nil) and inlevel do
				  with lastlabel^ do
				    if scope = level
				      then begin
				      if gotochain # 0
					then if labeladdress = 0
					  then errorwithtext(215,name)
					  else writepair(both,gotochain,labeladdress);
				      lastlabel := next
				      end
				     else inlevel := false;
(* 40 - print format *)
(* 136 - LISTING FORMAT *)
				if cref and listcode then NEWLINE;
				END;
		WRITEEND:
			  BEGIN
			   WRITEHEADER('HIGHSEG-BREAK  ');
			   WRITEBLOCKST(5);
			   WRITEPAIR(RIGHT,0,HIGHESTCODE);
			   WRITEHEADER('LOWSEG-BREAK   ');
			   WRITEPAIR(RIGHT,0,LCMAIN); PUTRELCODE
			  END;

		WRITESTART:
			    IF MAIN
			    THEN
			      BEGIN
(* 33 - VERSION NO. *)
				WRITEHEADER('VERSION NUMBER ');
				LIC := 137B;
(* 40 - fix print format *)
				WRITEBLOCKST(1);
			  	if listcode then with version do
				  write('    ',who:1:o,'  ',major:3:o,'  ',minor:2:o,'  ',edit:6:o);
				llistcode := false;
				WRITEWORD(NO,VERSION.WORD);
				llistcode := listcode;
			       WRITEHEADER('STARTADDRESS   ');
			       WRITEBLOCKST(7);
			       WRITEPAIR(RIGHT,0,STARTADDR)
			      END;

		WRITEENTRY:
			    BEGIN
			     WRITEBLOCKST(4);
(* 34 - USE LIST OF ENTRIES IN PROGRAM IF APPROPRIATE *)
			     IF MAIN OR (FPROGFILE = NIL)
			       THEN WRITEIDENTIFIER(0,FILENAME)
			       ELSE
				 BEGIN
				 NPROGFILE := FPROGFILE;
				 WHILE NPROGFILE # NIL DO
				   BEGIN
				   WRITEIDENTIFIER(0,NPROGFILE^.FILID);
				   NPROGFILE := NPROGFILE^.NEXT
				   END
				 END
			    END;

		WRITENAME:
			   BEGIN
			    WRITEBLOCKST(6);
			    WRITEIDENTIFIER(0,FILENAME)
			   END;

		WRITEHISEG:
			    BEGIN
			     LLISTCODE := FALSE;
			     WRITEBLOCKST(3);
			     WRITEPAIR(NO,400000B,400000B);
			    END
	       END %CASE\
	     END %MCVARIOUS\ ;

	    PROCEDURE MCSYMBOLS;
	    VAR
	      ENTRYFOUND: BOOLEAN; POLHEADERDONE:Boolean; chan:integer;
	     BEGIN
	      %MCSYMBOLS\
	      WRITEHEADER('ENTRYPOINT(S)  ');
	      WRITEBLOCKST(2);
	      SAVELISTCODE := LISTCODE;
	      LISTCODE := FALSE;
	      FOR SWITCHFLAG := 1B TO 2B DO
	       BEGIN
		 IF MAIN
		 THEN
		   BEGIN
		    WRITEIDENTIFIER(SWITCHFLAG,FILENAME);
		    WRITEPAIR(RIGHT,0,STARTADDR)
		   END
		 ELSE
		   BEGIN
(* 34 - LOOK FOR FTN=FILENAME ONLY IF NOT SPEC. IN PROGRAM STATE. *)
		    CHECKER := LOCALPFPTR;
		    IF FPROGFILE=NIL
		      THEN ENTRYFOUND := FALSE
		      ELSE ENTRYFOUND := TRUE;
		    WHILE CHECKER # NIL DO
		    WITH CHECKER^ DO
		     BEGIN
		       IF PFADDR # 0
		       THEN
			 BEGIN
			   IF NOT ENTRYFOUND
(* 34 - USING FILENAME FOR ENTRY NOW *)
			   THEN ENTRYFOUND := FILENAME = NAME;
			  WRITEIDENTIFIER(SWITCHFLAG,NAME);
			  WRITEPAIR(RIGHT,0,PFADDR);
			   IF PFCHAIN = NIL
			   THEN
			     IF NOT ENTRYFOUND
			     THEN
			       BEGIN
(* 34 - USING FILENAME FOR ENTRY NOW *)
				WRITEIDENTIFIER(SWITCHFLAG,FILENAME);
				WRITEPAIR(RIGHT,0,PFADDR)
			       END
			 END;
		      CHECKER:= PFCHAIN
		     END
		   END;
		LISTCODE := SAVELISTCODE; LIC := 0
	       END;
	       IF MAIN
	       THEN
		 BEGIN
		  SWITCHFLAG:= 1B; WRITEHEADER('GLOBAL SYMBOLS ');
(* 16 - ADD CCL SWITCH *)
		  WRITEIDENTIFIER(SWITCHFLAG,'%CCLSW    ');
		  WRITEPAIR(RIGHT,0,CCLSW);
		  WRITEIDENTIFIER(SWITCHFLAG,'%RNNAM    ');
		  WRITEPAIR(RIGHT,0,CCLSW+1);
		  WRITEIDENTIFIER(SWITCHFLAG,'%RNPPN    ');
		  WRITEPAIR(RIGHT,0,CCLSW+2);
		  WRITEIDENTIFIER(SWITCHFLAG,'%RNDEV    ');
		  WRITEPAIR(RIGHT,0,CCLSW+3);
		 END
	       ELSE
		 BEGIN
		  SWITCHFLAG:= 14B; WRITEHEADER('GLOBAL REQUESTS')
		 END;
	      FILEPTR := SFILEPTR;
	      WHILE FILEPTR # NIL DO
	      WITH FILEPTR^, FILEIDENT^ DO
	       BEGIN
		 IF VADDR # 0
		 THEN
		   BEGIN
		    WRITEIDENTIFIER(SWITCHFLAG,NAME);
		    WRITEPAIR(RIGHT,0,VADDR)
		   END;
		FILEPTR:= NEXTFTP
	       END;
	       IF MAIN
	       THEN WRITEHEADER('GLOBAL REQUESTS');
	      CHECKER:= EXTERNPFPTR;
	      WHILE CHECKER # NIL DO
	      WITH CHECKER^ DO
	       BEGIN
		 IF LINKCHAIN[0] # 0
		 THEN
		   BEGIN
		     IF PFLEV = 0
		     THEN WRITEIDENTIFIER(14B,EXTERNALNAME)
		     ELSE WRITEIDENTIFIER(14B,NAME);
		    WRITEPAIR(RIGHT,0,LINKCHAIN[0])
		   END;
		CHECKER:= PFCHAIN
	       END;
(* 12 - ADD EXTERNAL REF TO RUNTIMES FOR DYNAMIC CORE ALLOC *)
	      IF LSTNEW # 0
	       THEN BEGIN
	       WRITEIDENTIFIER(14B,'LSTNEW    ');
	       WRITEPAIR(RIGHT,0,LSTNEW); % GLOBAL FIXUP TO INIT. CODE\
	       END;
	      IF NEWBND # 0
	       THEN BEGIN
	       WRITEIDENTIFIER(14B,'NEWBND    ');
	       WRITEPAIR(RIGHT,0,NEWBND); % DITTO \
	       END;
(* 105 - improve lower case mapping in sets *)
	      if setmapchain # 0
		then begin
		writeidentifier (14B,'.STCHM    ');
		writepair (right,0,setmapchain)
		end;
	      FOR SUPPORTIX:= SUCC(FIRSTSUPPORT) TO PRED(LASTSUPPORT) DO
	       IF RNTS.LINK[SUPPORTIX] # 0
	       THEN
		 BEGIN
		  WRITEIDENTIFIER(14B,RNTS.NAME[SUPPORTIX]);
		  WRITEPAIR(RIGHT,0,RNTS.LINK[SUPPORTIX])
		 END;
(* 36 - 141 is now set up elsewhere *)
{In non-main modules, if there are references to TTY^, etc., a
 Polish fixup may be needed to resolve them.}
	      polheaderdone := false;
	      FILEPTR := SFILEPTR;
	      IF NOT MAIN THEN WHILE FILEPTR # NIL DO
	      WITH FILEPTR^, FILEIDENT^ DO
	       begin
	       if chantab[channel] <> 0
		then begin
		if not polheaderdone
		  then begin
		  writeheader('SYMBOLIC POLISH');
		  polheaderdone := true;
		  end;
{A Polish fixup block looks like this:
   type 11
   operator,,2		2 means next word is global req - that is operand
   operand1
   0,,operand2		0 means next half word is operand
   -1,,place to put	-1 means put in RH of result addr
}
		writeblockst(11B);
		writepair(no,3,2);  {add}
		writeidentifier(0,name);
		writepair(no,0,filcmp);
		writepair(right,777777B,chantab[channel]);
		putrelcode;
		end;
		FILEPTR:= NEXTFTP
	       END;
	     if polheaderdone and cref and listcode then NEWLINE;
	     END %MCSYMBOLS\ ;

	    PROCEDURE MCLIBRARY;
	     BEGIN
	      %MCLIBRARY\
	      WRITEHEADER('LINK LIBRARIES ');
	      WRITEBLOCKST(15);
	      FOR L := 1 TO 2 DO
	       BEGIN
		FOR I := 1 TO LIBIX DO
		WITH LIBRARY[LIBORDER[I]] DO
		 IF CALLED
		 THEN WITH WANDLUNG DO
		   BEGIN
		    FOR J := 1 TO 6 DO WSIXBIT[J] := ORD(NAME[J]) - 40B;
		    WRITEIDENTIFIER(6B,NAME);
		    WRITEPAIR(NO,PROJNR,PROGNR);
		    FOR J := 1 TO 6 DO WSIXBIT[J] := ORD(DEVICE[J]) - 40B;
		    WRITEIDENTIFIER(6B,DEVICE); LIC := LIC + 1
		   END;
		I := 1;
(* 40 - load PASLIB first *)
		for languageix := pascalsy to fortransy do
		WITH LIBRARY[LANGUAGEIX] DO
		 BEGIN
		  CALLED := (NOT INORDER AND CALLED) OR (LANGUAGEIX = PASCALSY);
		  LIBORDER[I] := LANGUAGEIX; I := I + 1
		 END;
		LIBIX := 2
	       END;
	     END %MCLIBRARY\;

	   BEGIN
	    %WRITEMC\
(* 121 - missing initialization - fix bollixed INITPROC's *)
	     CODEARRAY := FALSE;
	     IF NOT ERRORFLAG
	     THEN
	       BEGIN
(* 5 - CREF *)
		IF CREF AND LISTCODE
		  THEN WRITE(CHR(177B),'F');
		FOR I:=1 TO MAXSIZE DO RELEMPTY[I] := 0;
		WITH ICWANDEL DO
		 BEGIN
		  ICVAL := 0;
		  CSP0 := ICCSP
		 END;
		LLISTCODE := LISTCODE;
		 CASE WRITEFLAG OF
		  WRITEGLOBALS	 : MCGLOBALS;	 %LINK-ITEM 01B\
		  WRITECODE	 : MCCODE;	 %LINK-ITEM 01B\
		  WRITESYMBOLS	 : MCSYMBOLS;	 %LINK-ITEM 02B\
		  WRITEBLK,			 %LINK-ITEM 02B\
		  WRITEINTERNALS,		 %LINK-ITEM 10B\
(* 164 - Polish fixups *)
		  WRITEPOLISH,			 %LINK-ITEM 11B\
		  WRITEENTRY,			 %LINK-ITEM 04B\
		  WRITEEND,			 %LINK-ITEM 05B\
		  WRITESTART,			 %LINK-ITEM 07B\
		  WRITEHISEG,			 %LINK-ITEM 03B\
		  WRITENAME	 : MCVARIOUS;	 %LINK-ITEM 06B\
		  WRITELIBRARY	 : MCLIBRARY	 %LINK-ITEM 17B\
		 END %CASE\;
		 IF LISTCODE AND (WRITEFLAG > WRITEHISEG)
(* 5 - CREF *)
(* 136 - LISTING FORMAT *)
		 THEN NEWLINE;
	       IF CREF AND LISTCODE
	         THEN WRITE(CHR(177B),'B')
	       END %IF ERRORFLAG\
	     ELSE
	       IF WRITEFLAG = WRITECODE
	       THEN LASTBTP := NIL
	   END %WRITEMC\;

	  PROCEDURE STATEMENT(FSYS,STATENDS: SETOFSYS);
	  TYPE
	    VALUEKIND = (ONREGC,ONFIXEDREGC,TRUEJMP,FALSEJMP);
	  VAR
	    LCP: CTP;	  IX,J: INTEGER;

	    PROCEDURE EXPRESSION(FSYS: SETOFSYS; FVALUE:VALUEKIND); FORWARD;

	    PROCEDURE MAKEREAL(VAR FATTR: ATTR);
	     BEGIN
	       IF FATTR.TYPTR=INTPTR
	       THEN
		 BEGIN
		  LOAD(FATTR);
(* 2 - hard code FLOAT using KI-10 op code *)
(* 101 - fix code generation for fltr *)
(* 122 - add back KA-10 code *)
(* 132 - separate KA10 into NOVM and KACPU *)
		  if kacpu
		    then begin
		    macro3(201B%movei\,tac,fattr.reg);
		    support(convertintegertoreal);
		    end
		   ELSE WITH CODE.INSTRUCTION[CIX] DO
		    IF (INSTR = 200B%MOVE\) AND (AC = FATTR.REG)
		      THEN INSTR := 127B%FLTR\
		      ELSE MACRO3(127B%FLTR\,FATTR.REG,FATTR.REG);
		  FATTR.TYPTR := REALPTR
		 END;
	       IF GATTR.TYPTR=INTPTR
	       THEN MAKEREAL(GATTR)
	     END;

	    PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP);
	    VAR
	      LATTR: ATTR; LCP: CTP; LSP: STP;
	      LMIN,LMAX,INDEXVALUE,INDEXOFFSET: INTEGER;
	      OLDIC: ACRANGE;

	      PROCEDURE SUBLOWBOUND;
	       BEGIN
		 IF LMIN > 0
		 THEN MACRO3(275B%SUBI\,REGC,LMIN)
		 ELSE
		   IF LMIN < 0
		   THEN MACRO3(271B%ADDI\,REGC,-LMIN);
		 IF RUNTMCHECK
		 THEN
		   BEGIN
		    MACRO3(301B%CAIL\,REGC,0);
		    MACRO3(303B%CAILE\,REGC,LMAX-LMIN);
		    SUPPORT(INDEXERROR)
		   END
	       END;

	     BEGIN
	      WITH FCP^, GATTR DO
	       BEGIN
		TYPTR := IDTYPE; KIND := VARBL; PACKFG := NOTPACK;
		 CASE KLASS OF
		  VARS:
			BEGIN
			 VLEVEL := VLEV;  DPLMT := VADDR; INDEXR := 0;
			  IF VLEV > 1
			  THEN VRELBYTE:= NO
			  ELSE VRELBYTE:= RIGHT;
			  IF IDTYPE^.FORM = FILES
			  THEN LASTFILE:= FCP
			  ELSE LASTFILE:= NIL;
			  IF VKIND=ACTUAL
			  THEN INDBIT:=0
			  ELSE INDBIT:=1
			END;
		  FIELD:
			WITH DISPLAY[DISX] DO
			 IF OCCUR = CREC
			 THEN
			   BEGIN
			    VLEVEL := CLEV; PACKFG := PACKF; VRELBYTE:= CRELBYTE;
			     IF PACKFG = PACKK
			     THEN
			       BEGIN
				BPADDR := FLDADDR;
				DPLMT := CDSPL
			       END
			     ELSE DPLMT := CDSPL+FLDADDR;
			    INDEXR := CINDR; INDBIT:=CINDB
			   END
			 ELSE
			  ERROR(171);
		  FUNC:
			IF PFDECKIND = STANDARD
			THEN ERROR(502)
			ELSE
			  IF PFLEV = 0
			  THEN ERROR(502)   %EXTERNAL FCT\
			  ELSE
			    IF PFKIND = FORMAL
			    THEN ERROR(456)
(* 31 - BE SURE WE'RE IN THE BODY OF THE FTN *)
			    ELSE IF (LEVEL <= PFLEV) OR (DISPLAY[PFLEV+1].BLKNAME # NAME)
				THEN ERROR(412)
			    ELSE
			      BEGIN
(* 166 - use pflev+1 for vlevel, to allow assignment from inner function *)
			       VLEVEL := PFLEV + 1; VRELBYTE := NO;
			       DPLMT := 1;   %IMPL. RELAT. ADDR. OF FCT. RESULT\
			       INDEXR :=0; INDBIT :=0
			      END
		 END;
		%CASE\
	       END %WITH\;
	      IFERRSKIP(166,SELECTSYS OR FSYS);
	      WHILE SY IN SELECTSYS DO
	       BEGIN
(* 156 - error for selector on ftn name *)
	       IF FCP^.KLASS = FUNC
		 THEN ERROR(368);
		%[\
		 IF SY = LBRACK
		 THEN
		   BEGIN
		     IF GATTR.INDBIT = 1
		     THEN GETPARADDR;
		    OLDIC := GATTR.INDEXR;
		    INDEXOFFSET := 0 ;
		     LOOP
		      LATTR := GATTR; INDEXVALUE := 0 ;
		      WITH LATTR DO
		       IF TYPTR # NIL
		       THEN
			 BEGIN
			   IF TYPTR^.FORM # ARRAYS
			   THEN
			     BEGIN
			      ERROR(307); TYPTR := NIL
			     END;
			  LSP := TYPTR
			 END;
		      INSYMBOL;
		      EXPRESSION(FSYS OR [COMMA,RBRACK],ONREGC);
		       IF  GATTR.KIND#CST
		       THEN  LOAD(GATTR)
		       ELSE  INDEXVALUE := GATTR.CVAL.IVAL ;
		       IF GATTR.TYPTR # NIL
		       THEN
			 IF GATTR.TYPTR^.FORM # SCALAR
			 THEN ERROR(403);
		       IF LATTR.TYPTR # NIL
		       THEN
			WITH LATTR,TYPTR^ DO
			 BEGIN
			   IF COMPTYPES(INXTYPE,GATTR.TYPTR)
			   THEN
			     BEGIN
			       IF INXTYPE # NIL
			       THEN
				 BEGIN
				  GETBOUNDS(INXTYPE,LMIN,LMAX);
				   IF GATTR.KIND = CST
				   THEN
				     IF (INDEXVALUE < LMIN) OR (INDEXVALUE > LMAX)
				     THEN ERROR(263)
				 END
			     END
			   ELSE ERROR(457);
			  TYPTR := AELTYPE ;
			 END ;
		     EXIT IF SY # COMMA;
		      WITH LATTR DO
		       IF TYPTR#NIL
		       THEN
			 IF  GATTR.KIND = CST
			 THEN DPLMT := DPLMT +( INDEXVALUE - LMIN ) * TYPTR^.SIZE
			 ELSE
			   BEGIN
			    SUBLOWBOUND;
			     IF TYPTR^.SIZE > 1
			     THEN MACRO3(221B%IMULI\,REGC,TYPTR^.SIZE);
			     IF OLDIC = 0
			     THEN OLDIC := REGC
			     ELSE
			       IF OLDIC > REGCMAX
			       THEN
				 BEGIN
				  MACRO3(270B%ADD\,REGC,OLDIC);
				  OLDIC := REGC
				 END
			       ELSE
				 BEGIN
				  MACRO3(270B%ADD\,OLDIC,REGC) ;
				  REGC := REGC - 1
				 END;
			    INDEXR := OLDIC
			   END ;
		      GATTR := LATTR ;
		     END;
		    %LOOP\
		    WITH LATTR DO
		     IF  TYPTR # NIL
		     THEN
		       BEGIN
			 IF GATTR.KIND = CST
			 THEN INDEXOFFSET :=  ( INDEXVALUE - LMIN ) * TYPTR^.SIZE
			 ELSE
			   BEGIN
			     IF (TYPTR^.SIZE > 1) OR RUNTMCHECK
			     THEN SUBLOWBOUND
			     ELSE INDEXOFFSET := -LMIN;
			     IF TYPTR^.SIZE > 1
			     THEN MACRO3(221B%IMULI\,REGC,TYPTR^.SIZE);
			    INDEXR := REGC ;
			   END ;
			 IF LSP^.ARRAYPF
			 THEN
			   BEGIN
(* 102 - kl array code *)
			     if not klcpu
			       THEN INCREMENTREGC;
			     IF INDEXR=OLDIC
			     THEN
			       BEGIN
				INCREMENTREGC; INDEXR := 0
			       END;
(* 102 - kl adjbp code *)
			    if not klcpu then begin
			    MACRO4(571B%HRREI\,REGC,INDEXR,INDEXOFFSET);
			    INCREMENTREGC;   %TEST FOR IDIVI-INSTRUCTION\
			    REGC := REGC-1; INDEXOFFSET := 0;
			    MACRO3R(200B%MOVE\,REGC-1,LSP^.ARRAYBPADDR);
			    MACRO3(231B%IDIVI\,REGC,BITMAX DIV LSP^.AELTYPE^.BITSIZE);
			    MACRO3(133B%IBP\,0,REGC-1);
			    MACRO3R(365B%SOJGE\,REGC+1,IC-1);
			    BPADDR := REGC-1;  PACKFG := PACKK; INDEXR := REGC;
(* 102 - kl adjbp code *)
			    end
			     else begin (* kl code*)
			     macro4(571B%hrrei\,regc,indexr,indexoffset+1);
			     macro3r(133B%adjbp\,regc,lsp^.arraybpaddr);
			     bpaddr := regc; packfg := packk; indexr := 0;
			     indexoffset := 0;
			     end;
			   END;
			DPLMT := DPLMT + INDEXOFFSET ;
			KIND := VARBL ;
			 IF ( OLDIC # INDEXR )	AND  ( OLDIC # 0 )
			 THEN
			   BEGIN
(* 102 - new packed array code *)
			   if indexr = 0
			     then indexr := oldic
			     ELSE IF OLDIC > REGCMAX
			     THEN  MACRO3(270B%ADD\,INDEXR,OLDIC)
			     ELSE
			       BEGIN
				MACRO3(270B%ADD\,OLDIC,INDEXR);
				REGC := REGC - 1;
				INDEXR := OLDIC
			       END
			   END
		       END %WITH.. IF TYPTR # NIL\ ;
		    GATTR := LATTR ;
		     IF SY = RBRACK
		     THEN INSYMBOL
		     ELSE ERROR(155)
		   END %IF SY = LBRACK\
		 ELSE
		  %.\
		   IF SY = PERIOD
		   THEN
		     BEGIN
		      WITH GATTR DO
		       BEGIN
			 IF TYPTR # NIL
			 THEN
			   IF TYPTR^.FORM # RECORDS
			   THEN
			     BEGIN
			      ERROR(308); TYPTR := NIL
			     END;
			 IF INDBIT=1
			 THEN GETPARADDR;
			INSYMBOL;
			 IF SY = IDENT
			 THEN
			   BEGIN
			     IF TYPTR # NIL
			     THEN
			       BEGIN
				SEARCHSECTION(TYPTR^.FSTFLD,LCP);
(* 5 - CREF *)
				IF CREF
			          THEN WRITE(CHR(1B),CHR(21),ID,' .FIELDID. ');
				 IF LCP = NIL
				 THEN
				   BEGIN
				    ERROR(309); TYPTR := NIL
				   END
				 ELSE
				  WITH LCP^ DO
				   BEGIN
				    TYPTR := IDTYPE;PACKFG := PACKF;
				     IF PACKFG = PACKK
				     THEN
				      BPADDR := FLDADDR
				     ELSE
				      DPLMT := DPLMT + FLDADDR;
				   END
			       END;
			    INSYMBOL
			   END %SY = IDENT\
			 ELSE ERROR(209)
		       END %WITH GATTR\
		     END %IF SY = PERIOD\
		   ELSE
		    %^\
		     BEGIN
		       IF GATTR.TYPTR # NIL
		       THEN
			WITH GATTR,TYPTR^ DO
(* 173 - changes for internal files, since we can't assume FILPTR is set up *)
			 IF FORM = FILES
			   THEN BEGIN
			    TYPTR := FILTYPE;
{What we are trying to do here is to generate code like
	MOVEI 2,INPUT+FILCMP
 In the usual case, we just do a loadaddress on the file, after add
 filcmp to the displacement.  There are two cases where this won't
 work:
   - when the address is an external reference, since it then
	becomes an address in a fixup chain, and can't have FILCMP
	added to it at compile time.  Thus we have a separate
	fixup chain stored in CHANTAB which the loader will add
	FILCMP to after fixing up.
   - when the thing is indirect, since we have to add the displacemtn
	after doing the indirection.  The only solution there is 
	an ADDI, as far as I can see.
 Hamburg used to just do a LOAD, which works because at INPUT there
 is a pointer to INPUT+FILCMP.  I can't do that because if the
 FCB isn't initialized that will be garbage, and I need the real
 address to do the validity check}
			    WITH FCP^ DO
			     IF (VLEV = 0) AND (NOT MAIN)
			      THEN BEGIN
			      INCREMENTREGC;
			      MACRO3R(201B%MOVEI\,REGC,CHANTAB[CHANNEL]);
			      CHANTAB[CHANNEL] := IC-1;
			      CODE.INFORMATION[CIX] := 'E';
		  	      WITH GATTR DO
				BEGIN
				KIND := VARBL;  DPLMT := 0; INDEXR:=REGC;
				INDBIT:=0; VRELBYTE := NO
				END
			      END
(* 200 - fix addressing *)
			     ELSE IF INDBIT = 0
			      THEN BEGIN
			      DPLMT := DPLMT + FILCMP;
			      LOADADDRESS;
			      END
			     ELSE BEGIN
			     LOADADDRESS;
			     MACRO3(271B%ADDI\,REGC,FILCMP)
			     END;
			    IF RUNTMCHECK
			      THEN BEGIN
{See if the file is open.  A magic value of 314157 is left in FILTST if so }
			      MACRO4(200B%MOVE\,HAC,REGC,FILTST-FILCMP);
			      MACRO3(302B%CAIE\,HAC,314157B);
			      SUPPORT(FILEUNINITIALIZED)
			      END
			   END
			 ELSE IF FORM = POINTER
			  THEN
			   BEGIN
			    TYPTR := ELTYPE;
			     IF TYPTR # NIL
			     THEN WITH GATTR DO
			       BEGIN
				LOADNOPTR := FALSE;
				LOAD(GATTR); LOADNOPTR := TRUE;
(* 23 - check for bad pointer *)
(* 26 - but not for file *)
				IF RUNTMCHECK
				  THEN BEGIN
				  MACRO3(302B%CAIE\,REG,0);
				  MACRO3(306B%CAIN\,REG,377777B);
				  SUPPORT(BADPOINT)
				  END;
				INDEXR := REG; DPLMT := 0; INDBIT:=0; 
				PACKFG := NOTPACK; KIND := VARBL; 
				VRELBYTE:= NO
			       END
			   END
			 ELSE ERROR(407);
		      INSYMBOL
		     END;
		IFERRSKIP(166,FSYS OR SELECTSYS)
	       END;
	      %WHILE\
	      WITH GATTR DO
	       IF TYPTR#NIL
	       THEN
		 IF TYPTR^.SIZE = 2
		 THEN
		   BEGIN
		     IF INDBIT = 1
		     THEN GETPARADDR;
		     IF (INDEXR>REGIN) AND (INDEXR<=REGCMAX)
		     THEN INCREMENTREGC
		   END
	     END %SELECTOR\ ;

	    PROCEDURE CALL(FSYS: SETOFSYS; FCP: CTP);
	    VAR
(* 10 - ALLOW MORE RUNTIMES *)
	      LKEY: 1..44;
	      LFOLLOWERROR, NORIGHTPARENT : BOOLEAN;

(* 33 - allow use with non-TEXT files *)
(* 171 - allow read/write of records *)
(* 173 - completely new getfilename *)
(* 204 - don't check validty of file to be closed *)
	      PROCEDURE GETFILENAME(DEFAULTFILE:CTP;TEXTPROC:BOOLEAN;
			VAR FILETYPE:STP;VAR GOTARG:BOOLEAN;CHECK:BOOLEAN);
	      VAR
(* 177 - fix AC *)
		GOTFILE : BOOLEAN;  FILEREGC: ACRANGE;
{When we are finished we will have loaded a file into REGC, and parsed
 the next parameter if there is one, using EXPRESSION with REGC incremented}
	       BEGIN
		INCREMENTREGC;  {by default we will load into 3}
		FILEREGC := REGC;  {but file goes into 2, which this still is}
    {REGC = 2}
		GOTARG := FALSE; NORIGHTPARENT := TRUE; GOTFILE := FALSE;
		IF SY = LPARENT
		 THEN BEGIN
		 NORIGHTPARENT := FALSE;
		 INSYMBOL;
		 EXPRESSION(FSYS OR [COMMA,RPARENT,COLON],ONFIXEDREGC);
   {REGC = 3 if expression (file can't be), 2 otherwise}
		 GOTFILE := FALSE;
{We have an expression, see if it is a legal file.  If so, load it into
 REGC (note: no incrementregc first) and do a few tests.  We have to do
 our own loading mostly to avoid the INCREMENTREGC done by LOADADDRESS}
		 WITH GATTR DO
		  IF TYPTR <> NIL
		   THEN WITH TYPTR^ DO
		    IF FORM = FILES
		     THEN BEGIN
		     IF TEXTPROC
		      THEN IF NOT (COMPTYPES(FILTYPE,CHARPTR))
		      	     THEN ERROR(366);
{Yes, it is a legal file.  Now load it}
{If TTY that is supposed to be mapped to TTYOUTPUT, handle that}
		     IF (LASTFILE = TTYFILE) AND (DEFAULTFILE = OUTFILE)
		       THEN BEGIN
		       LASTFILE := TTYOUTFILE;
		       MACRO3R(201B%MOVEI\,REGC,TTYOUTFILE^.VADDR);
		       END
		      ELSE BEGIN
		       FETCHBASIS(GATTR);
		       MACRO(VRELBYTE,201B%MOVEI\,REGC,INDBIT,INDEXR,DPLMT);
		       END;
		     KIND := VARBL;  DPLMT := 0; INDEXR:=REGC; 
		     INDBIT:=0; VRELBYTE := NO;
		     WITH LASTFILE^ DO
		      IF (VLEV=0) AND (NOT MAIN)
		       THEN BEGIN VADDR:=IC-1; CODE.INFORMATION[CIX]:='E' END;
		     GOTFILE := TRUE;
		     FILETYPE := TYPTR;
{Runtime checks if appropriate}
(* 204 - don't check for CLOSE *)
		     if runtmcheck and check
		      then begin
		      macro4(200B%MOVE\,hac,regc,filtst);  {File test word}
		      macro3(302B%CAIE\,hac,314157B);  {True if file is open}
		      support(fileuninitialized);   {Not open}
		      end;
{Now see if there is an arg}
		     IF SY <> RPARENT
		      THEN BEGIN
		      IF SY = COMMA
		       THEN INSYMBOL
		       ELSE ERROR(158);
    {Note that this is guaranteed not to change REGC unless it sees an
     expression, in which case it advances to 3.  We can't have two
     advances (i.e. due to the EXPRESSION above and this one), since
     this is done only if the one above saw a file, which can't have
     advanced REGC}
		      EXPRESSION(FSYS OR [COMMA,RPARENT,COLON],ONFIXEDREGC);
		      GOTARG := TRUE
		      END
		     END;
{Now we are done processing a file arg}
		 IF NOT GOTFILE  {If expression wasn't a file, use it as arg}
		  THEN GOTARG := TRUE
		 END;
{End of IF RPARENT}
   {At this point REGC = 2 unless what we saw was an expr (which a file
	can't be), in which case REGC = 3 and it is loaded}
		IF NOT GOTFILE
		 THEN WITH DEFAULTFILE^ DO
{If we didn't get a file above, here is the code to do it}
		  BEGIN
(* 177 - fix AC *)
		  MACRO3R(201B%MOVEI\,FILEREGC,VADDR);
		  IF NOT GOTARG
		   THEN WITH GATTR DO
		    BEGIN
		    KIND := VARBL;  DPLMT := 0; INDEXR:=REGC; 
		    INDBIT:=0; VRELBYTE := NO;
		    END;
		  IF (VLEV=0) AND (NOT MAIN)
		   THEN BEGIN VADDR:=IC-1; CODE.INFORMATION[CIX]:='E' END;
		  FILETYPE := IDTYPE;
(* 204 - don't check for CLOSE *)
		  if runtmcheck and check
		   then begin
(* 207 - more bad AC's *)
		    macro4(200B%MOVE\,hac,fileregc,filtst);  {File test word}
		    macro3(302B%CAIE\,hac,314157B);  {True if file is open}
		    support(fileuninitialized);   {Not open}
		    end;
		  END;		 
  {If we saw an arg, REGC is exactly like it would have been with a
   simple   INCREMENTREGC;  EXPRESSION;  which is the whole point.
   That is,it is 2 unless an expression was seen, in which case the
   expression is loaded into 3.  If we didn't see an expression, then
   REGC is guaranteed to be 2.  Very shady...}
	       END %GETFILENAME\ ;

	      PROCEDURE VARIABLE(FSYS: SETOFSYS);
	      VAR
		LCP: CTP;
	       BEGIN
		 IF SY = IDENT
		 THEN
		   BEGIN
		    SEARCHID([VARS,FIELD],LCP); INSYMBOL
		   END
		 ELSE
		   BEGIN
		    ERROR(209); LCP := UVARPTR
		   END;
		SELECTOR(FSYS,LCP)
	       END %VARIABLE\ ;
(* 22 - add GETFN - common non-defaulting file name scanner *)
(* 73 - add ,COLON since used in NEW *)
(* 175 - internal files *)
	      PROCEDURE GETFN(TEST:BOOLEAN);
	        BEGIN
		VARIABLE(FSYS OR [RPARENT,COLON,COMMA]);
		LOADADDRESS;
		IF GATTR.TYPTR#NIL
		  THEN IF GATTR.TYPTR^.FORM#FILES
		    THEN ERROR(212)
		    ELSE WITH LASTFILE^ DO
		      IF (VLEV=0) AND (NOT MAIN)
			THEN BEGIN VADDR:=IC-1; CODE.INFORMATION[CIX]:='E' END;
(* 175 - internal files *)
		if test and runtmcheck
		  then begin
		  macro4(200B%MOVE\,hac,regc,filtst);  {File test word}
		  macro3(302B%CAIE\,hac,314157B);  {Magic value if it is open}
		  support(fileuninitialized);   {Not open}
		  end;
		END;

(* 14 - SEVERAL CHANGES IN THIS PROC TO ADD NEW RUNTIMES AND ADD OPTIONAL XBLOCK ARG *)
	      PROCEDURE GETPUTRESETREWRITE;
	      VAR
(* 172 - new options string *)
		LMAX,LMIN: INTEGER;
(* 173 - internal files *)
		LATTR: ATTR;
		ADR : SUPPORTS ; 
		DEFAULT : ARRAY [1..6] OF BOOLEAN;
		I,J : INTEGER;

		PROCEDURE GETSTRINGADDRESS ;

		 VAR LMAX,LMIN: INTEGER;
(* 61 - allow flags for gtjfn in tops20 *)
		    flagbits: packed record case Boolean of
			true: (dum:0..777777B;usetty:Boolean;wildok:Boolean);
			false: (dum2:0..777777B; rh:0..777777B)
			end;
		 BEGIN
		   IF SY=COMMA
		   THEN
		     BEGIN
		      INSYMBOL;
		      EXPRESSION(FSYS OR [COMMA,RPARENT,COLON],ONFIXEDREGC);
		      WITH GATTR DO
		       IF TYPTR#NIL
		       THEN
			WITH TYPTR^ DO
			 IF(FORM=ARRAYS) AND ARRAYPF
			 THEN
			   IF COMPTYPES(AELTYPE,CHARPTR)
			   THEN
			     BEGIN
(* 15 - CHANGE DUE TO SLIGHTLY DIFFERENT LOGIC IN MAIN PROC *)
			      DEFAULT[I] := FALSE;
			      I:=I+1;DEFAULT[I]:=FALSE;
			      LOADADDRESS;
				GETBOUNDS(INXTYPE,LMIN,LMAX);
				LMAX := LMAX-LMIN+1;
				INCREMENTREGC;
				MACRO3(201B%MOVEI\,REGC,LMAX);
			     END
			   ELSE ERROR(212)
			 ELSE ERROR(212);
(* 61 - implement extra syntax for tops20 *)
(* 144 - allow it for tops10, too *)
		     if (sy=colon)
		      then begin
		      insymbol;
		      flagbits.rh := 0;
		      while sy in [relop,addop,mulop] do
			begin
			if op = leop (* @ *)
			  then flagbits.usetty := true
			else if (op = mul) and (not tops10)
			  then flagbits.wildok := true
			else error(158);
			insymbol
			end;
		      macro3(505b%hrli\,regc-1,flagbits.rh);
		      end;
		     END;
		 END ;

	       BEGIN
		VARIABLE( FSYS OR [RPARENT,COMMA] ) ;
		LOADADDRESS ;
(* 173 - internal files *)
		LATTR := GATTR;
		 IF GATTR.TYPTR # NIL
		 THEN
		   IF GATTR.TYPTR^.FORM # FILES
		   THEN ERRANDSKIP(458,FSYS OR [RPARENT])
		   ELSE
		     BEGIN
		      WITH LASTFILE^ DO
		       IF (VLEV = 0) AND (NOT MAIN)
		       THEN
			 BEGIN
			  VADDR:= IC-1; CODE.INFORMATION[CIX] := 'E'
			 END;
		       IF (LKEY>=5) AND (LKEY#28)
		       THEN
			 BEGIN
			  FOR I := 1 TO 6 DO DEFAULT[I] := TRUE;
			  I := 1;
			  GETSTRINGADDRESS % OF FILENAME \ ;
(* 15 - ADD NEW PARAMETERS AND ALLOW OMITTING BLOCK *)
			  WHILE NOT DEFAULT[I] AND (SY=COMMA) DO
			   BEGIN
			    I := I+1;
			    INSYMBOL;
(* 172 - ADD OPTION STRING AS 3RD ARG *)
			    IF I = 3
			      THEN BEGIN
			      EXPRESSION(FSYS OR [COMMA,RPARENT],ONFIXEDREGC);
		      	      WITH GATTR DO
		       	       IF TYPTR#NIL
				THEN WITH TYPTR^ DO
			 	IF(FORM=ARRAYS) AND ARRAYPF
			 	 THEN IF COMPTYPES(AELTYPE,CHARPTR)
			   	  THEN BEGIN
			          DEFAULT[I] := FALSE;
			          LOADADDRESS;
				  GETBOUNDS(INXTYPE,LMIN,LMAX);
				  LMAX := LMAX-LMIN+1;
				  MACRO3(505B%HRLI\,REGC,LMAX);
				  END
				  ELSE ERROR(212)  {not CHAR array}
				 ELSE BEGIN  {not packed array}
				 LOAD(GATTR); DEFAULT[I] := FALSE
				 END
			      END {I=3}
(* 57 - ONLY TOPS10 HAS XBLOCK ARG *)
			    ELSE IF (NOT TOPS10) OR (I # 4) OR ((SY=INTCONST)AND(VAL.IVAL=0))
			      THEN BEGIN
			      EXPRESSION(FSYS OR [COMMA,RPARENT],ONFIXEDREGC);
			       IF GATTR.TYPTR#NIL
			       THEN
			       BEGIN
				LOAD(GATTR); DEFAULT[I] := FALSE;
(* 77 - allow sets, since they are elegant for specifying bits *)
				if gattr.typtr^.form = power
				  then regc := regc-1;
			       END
			      END
			     ELSE BEGIN
			     VARIABLE(FSYS OR[COMMA,RPARENT]);
			     IF GATTR.TYPTR # NIL
(* 26 - allow record as lookup block *)
				THEN IF NOT (GATTR.TYPTR^.FORM IN [ARRAYS,RECORDS])
				  THEN ERROR(264)
				  ELSE IF GATTR.TYPTR^.SIZE<5
				    THEN ERROR(265)
				    ELSE BEGIN LOADADDRESS; DEFAULT[I]:=FALSE END
				ELSE ERROR(458)
			     END;
			   END;
			  FOR I := 1 TO 6 DO
			   IF DEFAULT[I]
			   THEN
			     BEGIN
			      INCREMENTREGC;
			      IF I=6
				THEN MACRO3(474B%SETO\,REGC,0)
			        ELSE MACRO3(201B%MOVEI\,REGC,0)
			     END;
			 END;
(* 173 - internal files *)
		       if lkey in [5,6,29,36]  {openning}
			 then begin
			 if lattr.typtr <> nil
			   then if lattr.typtr^.form = files
			     then if comptypes(lattr.typtr^.filtype,charptr)
{In AC1, put size of component, or 0 if text file}
			       then macro3(201B%movei\,tac,0)
			       else macro3(201B%movei\,tac,
{Normally we would have to type filtype^ for nil, but if it is nil, the
 comptypes above will succeed, and this code will never happen.}
					   lattr.typtr^.filtype^.size)
			 end
(* 204 - don't validty check for DISMISS *)
(* 205 - fix AC for RENAME *)
			else if runtmcheck and (lkey <> 28)
			 then begin
		         macro4(200B%MOVE\,hac,regin+1,filtst);{File test word}
		         macro3(302B%CAIE\,hac,314157B); {Magic value if open}
		         support(fileuninitialized);   {Not open}
		         end;
		       CASE LKEY OF
			2: ADR:= GETLINE ;
			4: ADR:= PUTLINE ;
			5: ADR:= RESETFILE ;
			6: ADR:= REWRITEFILE;
			27:ADR:=NAMEFILE;
			28:ADR:=DISFILE;
			29:ADR:=UPFILE;
			36:ADR:=APFILE
		       END ;
		      SUPPORT(ADR) ;
		     END ;
	       END;

(* 10 - ADD SETSTRING, TO ALLOW I/O TO STRINGS *)
(* 13 - CODE MODIFIED TO ALLOW 4TH ARG, LIMIT *)
(* 51 - allow any file type, any packed array *)
	      PROCEDURE SETSTRING;
	      VAR
		LREGC:ACRANGE;
		LMIN,LMAX:ADDRRANGE;
		ARRAY1,OFFSET,FILEP,LIMIT:ATTR;
		NOOFF,NOLIM: BOOLEAN;

		BEGIN
		LREGC := REGC;  NOOFF := FALSE;  NOLIM:=FALSE;
(* 175 - if not inited, do it *)
	        GETFN(FALSE);
{If the file block is not legal yet, call routine to make it so}
		macro4(200B%MOVE\,hac,regc,filtst);  {File test word}
		macro3(302B%CAIE\,hac,314157B);  {Magic value if it is open}
		support(initfileblock);
		FILEP := GATTR;
		IF SY = COMMA
		  THEN INSYMBOL
		  ELSE ERROR(158);
		VARIABLE(FSYS OR [RPARENT,COMMA]);
		LOADADDRESS;
		WITH GATTR DO
		  BEGIN
		  KIND := EXPR; REG := INDEXR;
		  IF TYPTR # NIL
		    THEN WITH TYPTR^ DO
		      IF FORM # ARRAYS
			THEN ERROR(458)
			ELSE IF FILEP.TYPTR#NIL
			  THEN IF NOT ARRAYPF
			    THEN ERROR(458)
		  END;
		ARRAY1 := GATTR;
		IF SY = RPARENT
		  THEN NOOFF := TRUE
		ELSE IF SY = COMMA
		  THEN BEGIN
		  INSYMBOL;
		  EXPRESSION(FSYS OR [RPARENT,COMMA],ONREGC);
		  IF GATTR.TYPTR # NIL
		    THEN IF GATTR.TYPTR^.FORM # SCALAR
		      THEN ERROR(458)
		      ELSE IF NOT COMPTYPES(ARRAY1.TYPTR^.INXTYPE,GATTR.TYPTR)
			THEN ERROR(458);
		  OFFSET := GATTR;
		  IF OFFSET.KIND = EXPR
		    THEN INCREMENTREGC
		  END
		ELSE ERROR(158);
		IF SY = RPARENT
		  THEN NOLIM := TRUE
		ELSE IF SY = COMMA
		  THEN BEGIN
		  INSYMBOL;
		  EXPRESSION(FSYS OR [RPARENT],ONREGC);
		  IF GATTR.TYPTR # NIL
		    THEN IF GATTR.TYPTR^.FORM # SCALAR
		      THEN ERROR(458)
		      ELSE IF NOT COMPTYPES(ARRAY1.TYPTR^.INXTYPE,GATTR.TYPTR)
			THEN ERROR(458);
		  LIMIT := GATTR;
		  IF LIMIT.KIND = EXPR
		    THEN INCREMENTREGC
		  END
		ELSE ERROR(158);
		IF NOT ERRORFLAG
		  THEN BEGIN
		  GETBOUNDS(ARRAY1.TYPTR^.INXTYPE,LMIN,LMAX);
		  LMAX := LMAX - LMIN;
		  IF NOT NOLIM
		    THEN BEGIN
		    IF LIMIT.KIND # EXPR
		      THEN BEGIN LOAD(LIMIT); INCREMENTREGC END;
		    WITH LIMIT DO
		      BEGIN
		      IF LMIN > 0
			THEN MACRO3(275B%SUBI\,REG,LMIN)
		      ELSE IF LMIN < 0
			THEN MACRO3(271B%ADDI\,REG,-LMIN);
		      IF RUNTMCHECK
			THEN BEGIN
			MACRO3(307B%CAIG\,REG,LMAX);
			MACRO3(305B%CAIGE\,REG,0);
			SUPPORT(INDEXERROR)
			END;
		      END;
		    END;
		  IF NOT NOOFF
		    THEN BEGIN
		    IF OFFSET.KIND # EXPR
		      THEN BEGIN LOAD(OFFSET); INCREMENTREGC END;
		    WITH OFFSET DO
		      BEGIN
		      IF LMIN > 0
			THEN MACRO3(275B%SUBI\,REG,LMIN)
		      ELSE IF LMIN < 0
			THEN MACRO3(271B%ADDI\,REG,-LMIN);
		      IF RUNTMCHECK
			THEN BEGIN
			MACRO3(301B%CAIL\,REG,0);
			MACRO3(303B%CAILE\,REG,LMAX+1);
			SUPPORT(INDEXERROR)
			END;
		      END;
		    INCREMENTREGC;
		    IF NOLIM
		      THEN MACRO4(211B%MOVNI\,REGC,OFFSET.REG,-LMAX-1)
		      ELSE BEGIN
		      MACRO4(201B%MOVEI\,REGC,LIMIT.REG,1);
		      MACRO4(275B%SUBI\,REGC,OFFSET.REG,0);
		      IF RUNTMCHECK
			THEN BEGIN
			MACRO3(305B%CAIGE\,REGC,0);
			SUPPORT(INDEXERROR)
			END
		      END;
		    MACRO4(552B%HRRZM\,REGC,FILEP.INDEXR,FILBFH+2);
		    MACRO3R(200B%MOVE\,REGC,ARRAY1.TYPTR^.ARRAYBPADDR);
		    MACRO3(621B%TLZ\,REGC,17B);
		    MACRO3(231B%IDIVI\,OFFSET.REG,BITMAX DIV ARRAY1.TYPTR^.AELTYPE^.BITSIZE);
		    MACRO3(270B%ADD\,ARRAY1.REG,OFFSET.REG);
		    MACRO3(540B%HRR\,REGC,ARRAY1.REG);
		    MACRO3(303B%CAILE\,OFFSET.REG+1,0);
		    MACRO3(133B%IBP\,0,REGC);
		    MACRO3R(367B%SOJG\,OFFSET.REG+1,IC-1);
		    MACRO4(202B%MOVEM\,REGC,FILEP.INDEXR,FILBFH+1)
		    END
		   ELSE BEGIN
		    INCREMENTREGC;
		    IF NOLIM
		      THEN MACRO3(201B%MOVEI\,REGC,LMAX+1)
		      ELSE MACRO4(201B%MOVEI\,REGC,LIMIT.REG,1);
		    MACRO4(202B%MOVEM\,REGC,FILEP.INDEXR,FILBFH+2);
		    MACRO3R(200B%MOVE\,REGC,ARRAY1.TYPTR^.ARRAYBPADDR);
		    MACRO3(621B%TLZ\,REGC,17B);
		    MACRO3(540B%HRR\,REGC,ARRAY1.REG);
		    MACRO4(202B%MOVEM\,REGC,FILEP.INDEXR,FILBFH+1)
		    END;
		  IF NOLIM
		    THEN MACRO3(505B%HRLI\,REGC,LMIN+LMAX+400001B)
		    ELSE MACRO4(505B%HRLI\,REGC,LIMIT.REG,LMIN+400001B);
(* 60 - DON'T PUT IN LH(0) FOR TOPS-20.  "FILBFH" IS FREE *)
(* 143 - Tops10 now like Tops20 *)
		  IF TOPS10
		    THEN MACRO4(556B%HLRZM\,REGC,FILEP.INDEXR,FILBLL)
		    ELSE MACRO4(556B%HLRZM\,REGC,FILEP.INDEXR,FILBFH);
(* 43 - setzm to avoid blocked or dump mode I/O *)
(* 60 - kludge needed only for tops10 *)
(* 143 - tops10 now like tops20 *)
		  CASE LKEY OF
(* 60 - TOPS20 USES RUNTIME TO INIT *)
(* 143 - so does Tops10 *)
		    22: SUPPORT(RESETSTRING);
		    23: SUPPORT(REWRITESTRING)
		    END;
		  END;
		REGC := LREGC
		END;

(* 57 - ADD SET20STRING FOR 20 STRSET,STRWRITE *)
(* 60 - on further thought, use normal one *)

	      PROCEDURE GETINDEX;
		  VAR LREGC:ACRANGE;
		      FILEP:ATTR;
		BEGIN
		LREGC := REGC;
(* 175 *)
		GETFN(TRUE);
		FILEP := GATTR;
		IF SY = COMMA
		  THEN INSYMBOL
		  ELSE ERROR(158);
		VARIABLE(FSYS OR [RPARENT]);
		LOADADDRESS;
		WITH GATTR DO
		  BEGIN
		  IF TYPTR # NIL
		    THEN WITH TYPTR^ DO
		      IF (FORM # SCALAR) AND (FORM # SUBRANGE)
			THEN ERROR(458)
		  END;
		IF NOT ERRORFLAG
		  THEN BEGIN
		  INCREMENTREGC;
		  WITH FILEP DO
		    BEGIN
(* 60 - TOPS20 HAS MAGIC NO. IN DIFFERENT PLACE *)
(* 143 - tops10 now the same *)
		    IF TOPS10
		      THEN MACRO4(200B%MOVE\,REGC,INDEXR,FILBLL)
		      ELSE MACRO4(200B%MOVE\,REGC,INDEXR,FILBFH);
		    MACRO3(620B%TRZ\,REGC,400000B);
		    MACRO4(274B%SUB\,REGC,INDEXR,FILBFH+2);
		    MACRO4(202B%MOVEM\,REGC,GATTR.INDEXR,0);
		    END
		  END;
		REGC := LREGC
		END;

	      PROCEDURE READREADLN;
	      VAR
(* 14 ADD READING OF STRING *)
(* 171 read into packed objects, ALLOW READ OF RECORDS *)
		LADDR : SUPPORTS;  LMIN,LMAX:INTEGER; LATTR:ATTR;
		READREC: BOOLEAN; LREGC: ACRANGE;
{This procedure is complicated by a number of special cases.  The first is
 the question of whether the file is text or binary.  The code for a binary
 file is more or less completely different.  (Note also that only READLN
 is not legal for a binary file.)  The second question is whether the
 address is passed to the runtimes or whether they return a value.  For
 binary files we must pass the address of the variable to be filled, since
 it can be arbitrarily big.  Similarly for strings.  For simple values,
 the runtimes return the value in AC 3, and we must do a store.  This is
 to allow for storing into packed objects (what kind of address could be
 pass for that?)  We do LOADADDRESS for binary files and strings, and
 for simple objects we do STORE afterwards.}
	       BEGIN
(* 33 - ALLOW GETFILENAME WITH NON-TEXT FILES *)
(* 171 - PREDECL FILES ARE GLOBAL, ALSO ALLOW READ OF RECORD *)
		IF LKEY = 7  {read?}
		  THEN GETFILENAME(INFILE,FALSE,THISFILE,GOTARG,TRUE)  {might be binary}
		  ELSE GETFILENAME(INFILE,TRUE,THISFILE,GOTARG,TRUE);  {must be text}
		IF (LKEY = 7) AND NOT GOTARG
		  THEN ERROR(554);   {READ must have args}
		READREC := FALSE;   {now see if a binary file}
	        IF LKEY = 7
		  THEN IF NOT COMPTYPES(CHARPTR,THISFILE^.FILTYPE)
		    THEN READREC := TRUE;
	        LREGC := REGC;
		 IF GOTARG
		 THEN
		   LOOP
(* 14 ADD READING OF STRING *)
(* 171 read into packed objects *)
		    LATTR := GATTR;
(* 31 - INITIALIZE LADDR IN CASE OF ERROR - PREVENT ILL MEM REF *)
		    IF READREC
		      THEN BEGIN {separate code for binary files}
		      LADDR := READRECORD;
		      IF GATTR.TYPTR#NIL
		        THEN IF NOT COMPTYPES(THISFILE^.FILTYPE,GATTR.TYPTR)
			  THEN ERROR(260);
		      LOADADDRESS
		      END
		    ELSE BEGIN  {Here is the code for TEXT files}
		    LADDR := READCHARACTER;
		     IF GATTR.TYPTR#NIL
		     THEN
		       IF GATTR.TYPTR^.FORM<=SUBRANGE
		       THEN
			 IF COMPTYPES(INTPTR,GATTR.TYPTR)
			 THEN
			  LADDR := READINTEGER
			 ELSE
			   IF COMPTYPES(REALPTR,GATTR.TYPTR)
			   THEN
			    LADDR := READREAL
			   ELSE
			     IF COMPTYPES(CHARPTR,GATTR.TYPTR)
			     THEN
			      LADDR := READCHARACTER
			     ELSE ERROR(169)
		       ELSE WITH GATTR.TYPTR^ DO
			  IF FORM = ARRAYS
			    THEN IF COMPTYPES(CHARPTR,AELTYPE)
			      THEN
				BEGIN
(* 171 - read into packed objects *)
				LOADADDRESS;  {of array}
				GETBOUNDS(INXTYPE,LMIN,LMAX);
				INCREMENTREGC;
				MACRO3(201B%MOVEI\,REGC,LMAX-LMIN+1);
				IF ARRAYPF
				  THEN LADDR := READPACKEDSTRING
				  ELSE LADDR := READSTRING;
				IF SY = COLON
				 THEN BEGIN
				  INSYMBOL;
(* 76 - allow set of break characters *)
				  VARIABLE(FSYS OR [COMMA,RPARENT,COLON]);
				  LOADADDRESS;
				  IF NOT COMPTYPES(INTPTR,GATTR.TYPTR)
				    THEN ERROR(458);
				  END
				 else begin
				  incrementregc;
				  MACRO3(201B%MOVEI\,REGC,0);
				  end;
				if sy = colon
				  then begin
				  insymbol;
				  expression(fsys or [comma,rparent],onfixedregc);
				  if gattr.typtr#nil
				    then if (gattr.typtr^.form = power)
				     then if comptypes(gattr.typtr^.elset, charptr)
				      then begin
				      load(gattr);
				      regc := regc-2;
				      end
				     else error(458)
				    else error(458)
				   end
				  else macro3(403B%SETZB\,regc+1,regc+2);
				END
			      ELSE ERROR(458)
			    ELSE ERROR(458);
		    END; {of TEXT file case}
(* 171 - read into packed objects *)
		    REGC := LREGC;
		    if not (readrec or (laddr in [readstring,readpackedstring]))
		      then begin
  {This is for reading single words, which may go into packed structures.
   Note that we have to redo the ac allocation because the read routine
   will return a value in AC 3, which quite likely is used as INDEXR or
   BPADDR.  Since we are pushing the active AC's anyway, we might as well
   pop them back into a different place.}
		      incrementregc;  {place that read will return the value}
		      if (lattr.indexr > regin) and (lattr.indexr <= 10B)
		        then begin
			macro3(261B%PUSH\,topp,lattr.indexr);
			incrementregc;
			lattr.indexr := regc;  {Place to put this value afterwards}
			end;
		      if (lattr.packfg = packk) and (lattr.bpaddr > regin)
					        and (lattr.bpaddr <= 10B)
			then begin
		        macro3(261B%PUSH\,topp,lattr.bpaddr);
			incrementregc;
			lattr.bpaddr := regc;
			end;
		      regc := lregc;  {restore regc}
		      support(laddr);
		      if (lattr.packfg = packk) and (lattr.bpaddr > regin) 
				          	and (lattr.bpaddr <= 10B)
		        then macro3(262B%POP\,topp,lattr.bpaddr);
		      if (lattr.indexr > regin) and (lattr.indexr <= 10B)
		        then macro3(262B%POP\,topp,lattr.indexr);
		      fetchbasis(lattr);   {Now do the store}
		      store(regc+1,lattr)
		      end
		     else SUPPORT(LADDR);
		   EXIT IF SY # COMMA;
		    INSYMBOL;
		   VARIABLE(FSYS OR [COMMA,COLON,RPARENT]); 
		   END;
		 IF LKEY = 8
		 THEN SUPPORT(GETLINE)
	       END %READREADLN\ ;

(* 42 - move breakin to close *)
(* 43 - add putx *)
	      procedure putx;
		begin
(* 175 *)
		getfn(true);
(* 61 - add delete *)
		case lkey of
		  37: support(putxfile);
		  41: support(delfile)
		  end;
		end;

	      PROCEDURE BREAK;
	       BEGIN
(* 26 - allow non-text files *)
(* 171 - PREDECL FILES ARE SPECIAL *)
		GETFILENAME(OUTFILE,FALSE,THISFILE,GOTARG,TRUE);
		IF GOTARG THEN ERROR(554);
		SUPPORT(BREAKOUTPUT) ;
	       END ;

(* 10 - ADD CLOSE *)
(* 15 - AND ALLOW OPT. PARAM FOR CLOSE BITS *)
(* 42 - move breakin here, to allow param to suppress get *)
	      PROCEDURE CLOSE;
	       BEGIN
(* 26 - allow non-text files *)
(* 61 - rclose for tops20 *)
		if (lkey = 25) or (lkey = 42)
(* 171 - PREDECL FILES ARE SPECIAL *)
(* 204 - don't validity check CLOSE and RCLOSE *)
		  THEN GETFILENAME(OUTFILE,FALSE,THISFILE,GOTARG,FALSE)
		  else getfilename(INFILE,false,THISFILE,GOTARG,FALSE);
		IF GOTARG
		 THEN LOAD(GATTR)
		 ELSE BEGIN
		  INCREMENTREGC;
		  MACRO3(201B%MOVEI\,REGC,0)
		  END;
(* 45 - add NEXTBLOCK *)
(* 61 - add RCLOSE *)
		case lkey of
		  25: support(closefile);
		  34: support(breakinput);
		  39: support(nextblockf);
		  42: support(relfile)
		  end;
	       END;

(* 14 - ADD DUMP MODE STUFF *)
(* 42 - allow variable size *)
	     PROCEDURE DUMP;
		VAR FILEP:ATTR; s:integer;
	      BEGIN
(* 175 *)
	      GETFN(TRUE);
	      FILEP:=GATTR;
	      IF SY=COMMA
	        THEN INSYMBOL
		ELSE ERROR(158);
	      EXPRESSION(FSYS OR[COMMA,RPARENT],ONFIXEDREGC);
	      LOADADDRESS;
	      if gattr.typtr#nil
	       then s:=gattr.typtr^.size;
	      if sy=comma
	       then
		begin
		insymbol;
		expression(fsys or [rparent],onfixedregc);
		if comptypes(intptr,gattr.typtr)
		 then load(gattr)
		 else error(458);
		if runtmcheck
		 then begin
		 macro3(303b%caile\,regc,s);
		 support(indexerror)
		 end
		end
               else
		begin
	        INCREMENTREGC;
		MACRO3(201B%MOVEI\,REGC,GATTR.TYPTR^.SIZE)
	        end;
	      IF LKEY=30
		THEN SUPPORT(READDUMP)
		ELSE SUPPORT(WRITEDUMP)
	      END;

	    PROCEDURE USET;
		VAR FILEP:ATTR;
	      BEGIN
(* 175 *)
	      GETFN(TRUE);
	      FILEP:=GATTR;
	      IF SY = COMMA
		THEN INSYMBOL
		ELSE ERROR(158);
(* 43 - new optional arg for useti *)
	      EXPRESSION(FSYS OR [COMMA,RPARENT],ONFIXEDREGC);
	      LOAD(GATTR);
	      IF GATTR.TYPTR=NIL
		THEN ERROR(458)
		ELSE IF GATTR.TYPTR#INTPTR
		  THEN ERROR(458);
(* 44 - add SETPOS and SKIP *)
	      IF LKEY # 33
(* 43 - new optional arg for useti *)
		then begin
		  if sy=comma
		    then begin
		    insymbol;
		    expression(fsys or [rparent],onfixedregc);
		    load(gattr);
		    end
		  else begin
		    incrementregc;
		    macro3(201b%movei\,regc,0)
		    end;
		  case lkey of
			32:support(setin);
			38:support(setposf)
			end
		  end
		ELSE SUPPORT(SETOUT)
	      END;

	      PROCEDURE WRITEWRITELN;
	      VAR
		LSP: STP; DEFAULT,REALFORMAT,WRITEOCT: BOOLEAN; LSIZE,LMIN,LMAX: INTEGER; LADDR: SUPPORTS;
(* 171 - write records *)
		writerec: Boolean;
	       BEGIN
(* 171 - PREDECL FILES ARE GLOBAL, ALSO ALLOW READ OF RECORD *)
{First scan file name and see if binary file}
		IF LKEY = 10   {WRITE?}
		  THEN GETFILENAME(OUTFILE,FALSE,THISFILE,GOTARG,TRUE)  {Yes, might be binary}
		  ELSE GETFILENAME(OUTFILE,TRUE,THISFILE,GOTARG,TRUE);  {No, WRITELN not legal for binary files}
		IF (LKEY = 10) AND NOT GOTARG
		  THEN ERROR(554);
		WRITEREC := FALSE;
	        IF LKEY = 10   {Now see if it was a binary file}
		  THEN IF NOT COMPTYPES(CHARPTR,THISFILE^.FILTYPE)
		    THEN WRITEREC := TRUE;
		 IF GOTARG
		 THEN
		   LOOP
(* 22 - INITIALIZE LADDR IN CASE OF ERRORS.  PREVENTS ILL MEM REF *)
(* 206 - moved initialization below *)
		    LSP := GATTR.TYPTR; LSIZE := LGTH; WRITEOCT := FALSE;
		     IF LSP # NIL
		     THEN
(* 206 - make non-text files work for constants *)
{Note that the values of LADDR set here are used only for binary files.
 LADDR is reset below for text files.  Only in case of error will these
 values remain for a text file, and in that case having them prevents
 an ill mem ref}
		       IF LSP^.FORM <= POWER
		       THEN BEGIN LOAD(GATTR); LADDR := WRITESCALAR END
		       ELSE
			 BEGIN
			   IF (GATTR.KIND = VARBL)
			    AND
			    (GATTR.INDEXR = TOPP)
			   THEN ERROR(458);
			  LOADADDRESS;
			  LADDR := WRITERECORD;
			 END;
(* 206 - make non-text files work for constants *)
		     IF WRITEREC
		       THEN BEGIN {For binary files, make sure of type match}
		       IF GATTR.TYPTR#NIL
		         THEN IF NOT COMPTYPES(THISFILE^.FILTYPE,GATTR.TYPTR)
			   THEN ERROR(260);
		       END  {end binary}
		     ELSE BEGIN
		     IF SY = COLON
		     THEN
		       BEGIN
			INSYMBOL; EXPRESSION(FSYS OR [COMMA,COLON,RPARENT],ONFIXEDREGC);
			 IF GATTR.TYPTR # NIL
			 THEN
			   IF GATTR.TYPTR # INTPTR
			   THEN ERROR(458);
			LOAD(GATTR); DEFAULT := FALSE;
		       END
		     ELSE
		       BEGIN
			DEFAULT := TRUE; INCREMENTREGC %RESERVE REGISTER FOR DEFAULT VALUE\
		       END ;
		     IF LSP = INTPTR
		     THEN
		       BEGIN
			LADDR := WRITEINTEGER ; LSIZE := 12
		       END;
		     IF SY = COLON
		     THEN
		       BEGIN
			INSYMBOL;
			 IF (SY = IDENT) AND ((ID='O         ') OR (ID='H         '))
			 THEN
			   BEGIN
			     IF NOT COMPTYPES(LSP,INTPTR)
			     THEN ERROR(262);
			     IF ID = 'O         '
			     THEN LADDR := WRITEOCTAL
			     ELSE
			       BEGIN
				LADDR := WRITEHEXADECIMAL; LSIZE := 11
			       END;
			    INSYMBOL
			   END
			 ELSE
			   BEGIN
			    EXPRESSION(FSYS OR [COMMA,RPARENT],ONFIXEDREGC);
			     IF GATTR.TYPTR # NIL
			     THEN
			       IF GATTR.TYPTR # INTPTR
			       THEN ERROR(458);
			     IF LSP # REALPTR
			     THEN ERROR(258);
			    LOAD(GATTR); REALFORMAT := FALSE
			   END
		       END
		     ELSE REALFORMAT := TRUE;
		     IF LSP = INTPTR
		     THEN GOTO 1;
		     IF LSP = CHARPTR
		     THEN
		       BEGIN
			LSIZE := 1; LADDR := WRITECHARACTER
		       END
		     ELSE
		       IF LSP = REALPTR
		       THEN
			 BEGIN
			  LSIZE := 16; LADDR := WRITEREAL;
			   IF REALFORMAT
			   THEN MACRO3(201B%MOVEI\,REGIN+4,123456B);
			 END
		       ELSE
			 IF LSP = BOOLPTR
			 THEN
			   BEGIN
			    LSIZE := 6; LADDR := WRITEBOOLEAN
			   END
			 ELSE
			   IF LSP # NIL
			   THEN
			     BEGIN
			       IF LSP^.FORM = SCALAR
			       THEN ERROR(169)
			       ELSE
				 IF STRING(LSP)
				 THEN
				   BEGIN
				     IF LSP^.INXTYPE#NIL
				     THEN
				       BEGIN
					GETBOUNDS(LSP^.INXTYPE,LMIN,LMAX);
					LSIZE := LMAX-LMIN+1;
				       END;
				    MACRO3(201B%MOVEI\,REGIN+4,LSIZE);
				     IF LSP^.ARRAYPF
				     THEN LADDR := WRITEPACKEDSTRING
				     ELSE LADDR := WRITESTRING ;
				   END
				 ELSE ERROR(458)
			     END;
1:
		     IF DEFAULT
		     THEN MACRO3(201B%MOVEI\,REGIN+3,LSIZE);
		    END;  {of IF WRITEREC}
		    SUPPORT(LADDR);
		    REGC :=REGIN + 1;
		   EXIT IF SY # COMMA;
		    INSYMBOL;
(* 206 - allow constants for records *)
		    EXPRESSION(FSYS OR [COMMA,COLON,RPARENT],ONFIXEDREGC);
		   END;
		 IF LKEY = 11
		 THEN SUPPORT(PUTLINE) ;
	       END %WRITE\ ;

(* 6 - PACK and UNPACK have been rewritten to be as described in Jensen and Wirth *)
	      PROCEDURE PACK;

		% PACK(A,I,Z) MEANS:
		 FOR L := LMIN(Z) TO LMAX(Z) DO Z[L] := A[L-LMIN(Z)+I] \

	      VAR
		ARRAY1,OFFSET1,ARRAY2,OFFSET2: ATTR;
		LADDR,START,STOP,LMIN1,LMAX1,LMIN2,LMAX2: ADDRRANGE;
		LREGC: ACRANGE;

	       BEGIN
		LREGC := REGC; START := 0;
		VARIABLE(FSYS OR [COMMA,RPARENT]);
		LOADADDRESS;
		WITH GATTR DO
		 BEGIN
		  KIND := EXPR; REG := INDEXR;
(* 135 prevent ill mem ref if not a variable *)
		   IF TYPTR = NIL
		   THEN TYPTR := UARRTYP
		   ELSE WITH TYPTR^ DO
		     IF FORM # ARRAYS
		     THEN ERROR(458)
		     ELSE
		       IF ARRAYPF
		       THEN ERROR(458)
		 END;
		ARRAY1 := GATTR;
		 IF SY = COMMA
		 THEN INSYMBOL
		 ELSE ERROR(158);
		EXPRESSION(FSYS OR [COMMA,RPARENT],ONREGC);
		 IF GATTR.TYPTR # NIL
		 THEN
		   IF GATTR.TYPTR^.FORM # SCALAR
		   THEN ERROR(458)
		   ELSE
		     IF NOT COMPTYPES(ARRAY1.TYPTR^.INXTYPE,GATTR.TYPTR)
		     THEN ERROR(458);
		OFFSET1 := GATTR;
		 IF SY = COMMA
		 THEN INSYMBOL
		 ELSE ERROR(158);
		VARIABLE(FSYS OR [RPARENT]);
		LOADADDRESS;
		WITH GATTR DO
		 BEGIN
		  KIND := EXPR; REG := INDEXR;
		   IF TYPTR # NIL
		   THEN WITH TYPTR^ DO
		     IF FORM # ARRAYS
		     THEN ERROR(458)
		     ELSE
		       IF NOT ARRAYPF
			OR
			NOT (COMPTYPES(AELTYPE,ARRAY1.TYPTR^.AELTYPE)
			     AND
			     COMPTYPES(INXTYPE,ARRAY1.TYPTR^.INXTYPE))
		       THEN ERROR(458)
		 END;
		ARRAY2 := GATTR;

		 IF NOT ERRORFLAG
		 THEN
		   BEGIN
		    GETBOUNDS(ARRAY1.TYPTR^.INXTYPE,LMIN1,LMAX1); LMAX1 := LMAX1 - LMIN1;
		    GETBOUNDS(ARRAY2.TYPTR^.INXTYPE,LMIN2,LMAX2); LMAX2 := LMAX2 - LMIN2;
		    WITH OFFSET2 DO  %MAKE OFFSET2 A CONST = LMAX2+1 \
			BEGIN
			TYPTR := INTPTR;
			KIND := CST;
			CVAL.IVAL := LMAX2 + 1
			END;
		     IF (OFFSET1.KIND = CST)
		     THEN
		       BEGIN
			STOP := OFFSET2.CVAL.IVAL;
			START := OFFSET1.CVAL.IVAL - LMIN1;
			 IF (START < 0) OR (START > (LMAX1+1-STOP))
			 THEN ERROR(263);
			MACRO3(505B%HRLI\,ARRAY1.REG,-STOP);
		       END
		     ELSE
		       BEGIN
			LOAD(OFFSET2);
			WITH OFFSET2 DO
			  MACRO3(210B%MOVN\,REG,REG);
			LOAD(OFFSET1);
			WITH OFFSET1 DO
			 BEGIN
			   IF LMIN1 > 0
			   THEN MACRO3(275B%SUBI\,REG,LMIN1)
			   ELSE
			     IF LMIN1 < 0
			     THEN MACRO3(271B%ADDI\,REG,-LMIN1);
			   IF RUNTMCHECK
			   THEN
			     BEGIN
			      MACRO3(301B%CAIL\,REG,0);
			      MACRO4(303B%CAILE\,REG,OFFSET2.REG,LMAX1+1);
			      SUPPORT(INDEXERROR)
			     END;
			  MACRO3(270B%ADD\,ARRAY1.REG,REG);
			  MACRO4(505B%HRLI\,ARRAY1.REG,OFFSET2.REG,0)
			 END
		       END;
		    INCREMENTREGC;
		    MACRO3(540B%HRR\,TAC,ARRAY2.REG);
		    MACRO3R(200B%MOVE\,REGC,ARRAY2.TYPTR^.ARRAYBPADDR);
		    LADDR := IC;
		    MACRO4(200B%MOVE\,HAC,ARRAY1.REG,START);
		    MACRO3(136B%IDPB\,HAC,REGC);
		    MACRO3R(253B%AOBJN\,ARRAY1.REG,LADDR)
		   END;
		REGC := LREGC
	       END;

	      PROCEDURE UNPACK;

		% UNPACK(Z,A,I) MEANS:
		 FOR L := LMIN(Z) TO LMAX(Z) DO A[L-LMIN(Z)+I] := Z[L] \

	      VAR
		ARRAY1,OFFSET1,ARRAY2,OFFSET2: ATTR;
		LADDR,START,STOP,LMIN1,LMAX1,LMIN2,LMAX2: ADDRRANGE;
		LREGC: ACRANGE;

	       BEGIN
		LREGC := REGC; START := 0;
		VARIABLE(FSYS OR [COMMA,RPARENT]);
		LOADADDRESS;
		WITH GATTR DO
		 BEGIN
		  KIND := EXPR; REG := INDEXR;
(* 135 - prevent ill mem ref if not a variable *)
		   IF TYPTR = NIL
		   THEN TYPTR := UARRTYP
		   ELSE WITH TYPTR^ DO
		     IF FORM # ARRAYS
		     THEN ERROR(458)
		     ELSE
		       IF NOT ARRAYPF
		       THEN ERROR(458)
		 END;
		ARRAY1 := GATTR;
		 IF SY = COMMA
		 THEN INSYMBOL
		 ELSE ERROR(158);
		VARIABLE(FSYS OR [COMMA,RPARENT]);
		LOADADDRESS;
		WITH GATTR DO
		 BEGIN
		  KIND := EXPR; REG := INDEXR;
(* 135 - prevent ill mem ref if not a variable *)
		   IF TYPTR = NIL
		   THEN TYPTR := UARRTYP
		   ELSE WITH TYPTR^ DO
		     IF FORM # ARRAYS
		     THEN ERROR(458)
		     ELSE
		       IF ARRAYPF
			OR
			NOT (COMPTYPES(AELTYPE,ARRAY1.TYPTR^.AELTYPE)
			     AND
			     COMPTYPES(INXTYPE,ARRAY1.TYPTR^.INXTYPE))
		       THEN ERROR(458)
		 END;
		ARRAY2 := GATTR;
		 IF SY = COMMA
		 THEN INSYMBOL
		 ELSE ERROR(158);
		EXPRESSION(FSYS OR [RPARENT],ONREGC);
		 IF GATTR.TYPTR # NIL
		 THEN
		   IF GATTR.TYPTR^.FORM # SCALAR
		   THEN ERROR(458)
		   ELSE
		     IF NOT COMPTYPES(ARRAY2.TYPTR^.INXTYPE,GATTR.TYPTR)
		     THEN ERROR(458);
		OFFSET2 := GATTR;

		 IF NOT ERRORFLAG
		 THEN
		   BEGIN
		    GETBOUNDS(ARRAY1.TYPTR^.INXTYPE,LMIN1,LMAX1); LMAX1 := LMAX1 - LMIN1;
		    GETBOUNDS(ARRAY2.TYPTR^.INXTYPE,LMIN2,LMAX2); LMAX2 := LMAX2 - LMIN2;
		    WITH OFFSET1 DO  %MAKE OFFSET1 A CONST = LMAX1+1 \
			BEGIN
			TYPTR := INTPTR;
			KIND := CST;
			CVAL.IVAL := LMAX1 + 1
			END;
		     IF (OFFSET2.KIND = CST)
		     THEN
		       BEGIN
			STOP := OFFSET1.CVAL.IVAL;
			START := OFFSET2.CVAL.IVAL - LMIN2;
			 IF (START < 0) OR (START > (LMAX2+1-STOP))
			 THEN ERROR(263);
			MACRO3(505B%HRLI\,ARRAY2.REG,-STOP);
		       END
		     ELSE
		       BEGIN
			LOAD(OFFSET1);
			WITH OFFSET1 DO
			  MACRO3(210B%MOVN\,REG,REG);
			LOAD(OFFSET2);
			WITH OFFSET2 DO
			 BEGIN
			   IF LMIN2 > 0
			   THEN MACRO3(275B%SUBI\,REG,LMIN2)
			   ELSE
			     IF LMIN2 < 0
			     THEN MACRO3(271B%ADDI\,REG,-LMIN2);
			   IF RUNTMCHECK
			   THEN
			     BEGIN
			      MACRO3(301B%CAIL\,REG,0);
			      MACRO4(303B%CAILE\,REG,OFFSET1.REG,LMAX2+1);
			      SUPPORT(INDEXERROR)
			     END;
			  MACRO3(270B%ADD\,ARRAY2.REG,REG);
			  MACRO4(505B%HRLI\,ARRAY2.REG,OFFSET1.REG,0)
			 END
		       END;
		    INCREMENTREGC;
		    MACRO3(540B%HRR\,TAC,ARRAY1.REG);
		    MACRO3R(200B%MOVE\,REGC,ARRAY1.TYPTR^.ARRAYBPADDR);
		    LADDR := IC;
		    MACRO3(134B%ILDB\,HAC,REGC);
		    MACRO4(202B%MOVEM\,HAC,ARRAY2.REG,START);
		    MACRO3R(253B%AOBJN\,ARRAY2.REG,LADDR)
		   END;
		REGC := LREGC
	       END;


	      PROCEDURE NEW;
	      CONST
		TAGFMAX=5;
	      VAR
(* 42 - move GET and PUT here *)
(* 47 - add GETX and RECSIZE - no other comments in body *)
		adr:supports; sizereg:acrange;
		LSP,LSP1: STP; VARTS,LMIN,LMAX: INTEGER;
		FIRSTLOAD:BOOLEAN;
		LSIZE,LSZ: ADDRRANGE; LVAL: VALU;
		LATTR: ATTR; I,TAGFC: INTEGER;
		TAGFSAV: ARRAY[0..TAGFMAX] OF RECORD
						TAGFVAL: INTEGER;
						TAGFADDR: ADDRRANGE;
						LPACKKIND:PACKKIND;
(* 21 - KEEP FROM STORING TAG VALUE IF NO PLACE TO PUT IT *)
						TAGWITHID:BOOLEAN
					      END;
	       BEGIN
		FOR I:=0 TO TAGFMAX DO TAGFSAV[I].TAGWITHID := FALSE;
(* 42 - move GET and PUT in here *)
(* 73 - restructure to use GETFN for file names, to allow extern files *)
(* 152 - DISPOSE *)
(* 153 - repair AC usage in DISPOSE *)
		if lkey = 44 {dispose}
		  then begin
		       incrementregc; incrementregc;
		       sizereg := regc;
		       variable(fsys or [comma,colon,rparent]);
		       lattr := gattr;  {We have to use a local copy so that
					 if AC1 is loaded here, that fact is
					 not saved for the store later.}
		       fetchbasis(lattr);
		       with lattr do  {modelled after loadaddress}
			 macro(vrelbyte,200B%MOVE\,sizereg-1,indbit,indexr,dplmt);
		       end
(* 162 - fix RECSIZE *)
		else if lkey in [14,35]
		  then begin   (* all except file names *)
		       incrementregc; sizereg := regc ;
		       VARIABLE(FSYS OR [COMMA,COLON,RPARENT]);
		       end
(* 175 - validate files for get and put stuff, but not for RECSIZE,
	which seems OK even if the file isn't open yet *)
		else begin getfn(lkey in [1,3,40]); sizereg := regin+2 end;
		LSP := NIL; VARTS := 0; LSIZE := 0; TAGFC := -1;
		LATTR := GATTR;
		 IF GATTR.TYPTR # NIL
		 THEN
		  WITH GATTR.TYPTR^ DO
(* 42 - move GET and PUT in here *)
(* 152 - dispose *)
(* 162 - fix RECSIZE *)
		   if (lkey in [14,35,44]) and (form=pointer) or
		      (lkey in [1,3,15,40]) and (form=files)
		   THEN
		     BEGIN  %WARNING: This code depends upon fact that ELTYPE and FILTYPE are in the same place\
		       IF ELTYPE # NIL
		       THEN
			 BEGIN
			  LSIZE := ELTYPE^.SIZE;
			   IF ELTYPE^.FORM = RECORDS
			   THEN
			     BEGIN
			      LSP := ELTYPE^.RECVAR;
			     END
			   ELSE
			     IF ELTYPE^.FORM = ARRAYS
			     THEN LSP := ELTYPE
			 END
		     END
		   ELSE ERROR(458);
		WHILE SY = COMMA DO
		 BEGIN
		  INSYMBOL; CONSTANT(FSYS OR [COMMA,COLON,RPARENT],LSP1,LVAL);
		  VARTS := VARTS + 1;
		  %CHECK TO INSERTADDR HERE: IS CONSTANT IN TAGFIELDTYPE RANGE\
		   IF LSP = NIL
		   THEN ERROR(408)
		   ELSE
		     IF STRING(LSP1) OR (LSP1=REALPTR)
		     THEN ERROR(460)
		     ELSE
		       BEGIN
			TAGFC := TAGFC + 1;
			 IF TAGFC > TAGFMAX
			 THEN
			   BEGIN
			    ERROR(409);TAGFC := TAGFMAX; GOTO 1
			   END;
			 IF LSP^.FORM = TAGFWITHID
			 THEN
			   BEGIN
			     IF LSP^.TAGFIELDP # NIL
			     THEN
			       IF COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP1)
			       THEN
				WITH TAGFSAV[TAGFC],LSP^.TAGFIELDP^ DO
				 BEGIN
				  TAGFVAL := LVAL.IVAL;
				  TAGFADDR:= FLDADDR;
				  LPACKKIND:= PACKF;
(* 21 - KEEP FROM STORING TAG VALUE INTO NON-EXISTENT FIELD *)
				  TAGWITHID:=TRUE
				 END
			       ELSE
				 BEGIN
				  ERROR(458);GOTO 1
				 END
			   END
			 ELSE
			   IF LSP^.FORM=TAGFWITHOUTID
			   THEN
			     BEGIN
			       IF NOT COMPTYPES(LSP^.TAGFIELDTYPE,LSP1)
			       THEN
				 BEGIN
				  ERROR(458); GOTO 1
				 END
			     END
			   ELSE
			     BEGIN
			      ERROR(358);GOTO 1
			     END;
			LSP1 := LSP^.FSTVAR;
			WHILE LSP1 # NIL DO
			WITH LSP1^ DO
			 IF VARVAL.IVAL = LVAL.IVAL
			 THEN
			   BEGIN
			    LSIZE :=SIZE; LSP := SUBVAR; GOTO 1
			   END
			 ELSE LSP1:=NXTVAR;
			LSIZE := LSP^.SIZE; LSP := NIL
		       END;
1:
		 END %WHILE\ ;
		 IF SY = COLON
		 THEN
		   BEGIN
		    INSYMBOL;
		    EXPRESSION(FSYS OR [RPARENT],ONREGC);
		     IF LSP = NIL
		     THEN ERROR(408)
		     ELSE
		       IF LSP^.FORM # ARRAYS
		       THEN ERROR(259)
		       ELSE
			 BEGIN
			   IF  NOT COMPTYPES(GATTR.TYPTR,LSP^.INXTYPE)
			   THEN
			    ERROR(458);
			  LSZ := 1; LMIN := 1;
			   IF LSP^.INXTYPE # NIL
			   THEN
			    GETBOUNDS(LSP^.INXTYPE,LMIN,LMAX);
			   IF LSP^.AELTYPE # NIL
			   THEN LSZ := LSP^.AELTYPE^.SIZE;
			  LOAD(GATTR);
(* 47 - add bounds checking *)
			  if runtmcheck
			    then begin
			    macro3(301B%cail\,regc,lmin);
			    macro3(303B%caile\,regc,lmax);
			    support(indexerror)
			    end;
			   IF LSZ # 1
			   THEN
			    MACRO3(221B%IMULI\,REGC,LSZ);
			   IF LSP^.ARRAYPF
			   THEN
			     BEGIN
(* 30 - added BITMAX DIV, per Nagel's instructions *)
(* 47 - repair calculation, and adjust for LMIN *)
			      lsz := bitmax div lsp^.aeltype^.bitsize-1-(lmin-1);
			      if lsz > 0
				then macro3(271B%addi\,regc,lsz)
			      else if lsz < 0
				then macro3(275B%subi\,regc,-lsz);
			      INCREMENTREGC; REGC := REGC - 1;
			      %FOR TESTING BECAUSE IDIV WORKS ON AC+1 TOO\
			      MACRO3(231B%IDIVI\,REGC,BITMAX DIV LSP^.AELTYPE^.BITSIZE);
			      LSZ := LSIZE - LSP^.SIZE;
			     END
			   ELSE
			    LSZ := LSIZE - LSP^.SIZE - LSZ*(LMIN - 1);
(* 42 - change for GET and PUT *)
			    MACRO4(201B%MOVEI\,SIZEREG,REGC,LSZ);
			 END
		   END
		 ELSE MACRO3(201B%MOVEI\,SIZEREG,LSIZE);
(* 24 - DON'T ZERO CORE UNLESS CHECKING *)
(* 25 - USE /ZERO NOW INSTEAD *)
(* 27 - add NEWZ *)
(* 42 - move get and put in here *)
		if lattr.typtr # nil
		  then begin
		  case lkey of
		    1:if comptypes(lattr.typtr^.filtype,charptr)
		        then adr := getcharacter
			else adr := getfile;
		    3:adr := putfile;
		    14:if zero
			then adr := clearalloc
			else adr := allocate;
		    15:with gattr do
			begin typtr:=intptr; reg:=sizereg;kind:=expr;regc:=sizereg end;
		    35:adr := clearallocate;
		    40:if comptypes(lattr.typtr^.filtype,charptr)
			then error(458)
			else adr:=getxf;
(* 173 - internal files *)
		    44:if lattr.typtr^.eltype <> nil
			 then if lattr.typtr^.eltype^.hasfile
			        then adr := withfiledeallocate
			        else adr := deallocate
			 else adr := deallocate
		    end;
{Perhaps this is premature optimization, but NEW and DISPOSE do not save any
 ac's.  Hence any that are active here have to be saved by the caller.  Since
 only ac's 1 to 6 are used by the NEW and DISPOSE, we save only things <= 6:
   any WITH ac's <= 6  (a fairly rare case)
   lattr.indexr, if it is <= 6.  This is used in cases such as
	new(a^.b^.c)
     to save information needed to get to C again after the call.
   ac 1 sometimes contains the display pointer for a higher-level block.
     However by gerrymandering LATTR, we force this to be recomputed after
     the call by FETCHBASIS, so it is not saved.
}
(* 154 - don't clobber With AC's *)
		  if (lkey in [14,35,44]) and (regcmax < 6)
		    then for i := 0 to withix do
		      with display[top-i] do
		        if (cindr#0) and (cindr <= 6)
			  then macro4(202B%MOVEM\,cindr,basis,clc);
(* 153 - save AC's *)
(* 154 - don't need to save WITH acs *)
(* 171 - more AC saving *)
		  if (lkey in [14,35,44])
		   then begin
		   if (lattr.indexr > regin) and (lattr.indexr <= 6)
		     then macro3(261B%PUSH\,topp,lattr.indexr);
		   if (lattr.packfg = packk) and (lattr.bpaddr > regin)
					     and (lattr.bpaddr <= 6)
		     then macro3(261B%PUSH\,topp,lattr.bpaddr);
		   support(adr);
		   if (lattr.packfg = packk) and (lattr.bpaddr > regin)
					     and (lattr.bpaddr <= 6)
		     then macro3(262B%POP\,topp,lattr.bpaddr);
		   if (lattr.indexr > regin) and (lattr.indexr <= 6)
		     then macro3(262B%POP\,topp,lattr.indexr);
		   end
		  else if lkey#15
		   then support(adr);
(* 154 - restore WITH ac's *)
		  if (lkey in [14,35,44]) and (regcmax < 6)
		    then for i := 0 to withix do
		      with display[top-i] do
		        if (cindr#0) and (cindr <= 6)
			  then macro4(200B%MOVE\,cindr,basis,clc);
		  end;
		if (lkey=14)or(lkey=35)
		then begin
		REGC := REGIN+1;
		FIRSTLOAD := TRUE;
		FOR I := 0 TO TAGFC DO
		WITH TAGFSAV[I] DO
(* 21 - KEEP FROM STORING TAG VALUE INTO NON-EXISTENT FIELD *)
		IF TAGWITHID THEN
		 BEGIN
		  MACRO3(201B%MOVEI\,HAC,TAGFVAL);
		   CASE LPACKKIND OF
		    NOTPACK:  MACRO4(202B%MOVEM\,HAC,REGC,TAGFADDR);
		    HWORDR:MACRO4(542B%HRRM\,HAC,REGC,TAGFADDR);
		    HWORDL:MACRO4(506B%HRLM\,HAC,REGC,TAGFADDR);
		    PACKK :
			    BEGIN
			      IF FIRSTLOAD
			      THEN
				BEGIN
				 MACRO3(200B%MOVE\,TAC,REGC);
				 FIRSTLOAD := FALSE
				END;
			     MACRO3R(137B%DPB\,HAC,TAGFADDR)
			    END
		   END%CASE\
		 END;
		STORE(REGC,LATTR)
(* 42 - move GET and PUT in here *)
		end
(* 152 - DISPOSE *)
(* 153 - make reg usage safer *)
	       else if lkey=44
		then begin
	        incrementregc;
	        macro3(201B%MOVEI\,regc,377777B%nil\);
		store(regc,lattr)
	        end
	       END %NEW\ ;

(* 46 - major reorganization to handle all arg formats *)
	      PROCEDURE CALLI;
		type argform=(bareac,xwd,twowords,oneword);
		VAR LSP:STP; LVAL,acval:VALU;
		    LH,RH,BOOL,RESUL:ATTR;
		    arg:argform;
		BEGIN
		arg := xwd;  %default format\
		CONSTANT(FSYS OR [RPARENT,COMMA],LSP,LVAL);
		IF NOT(COMPTYPES(INTPTR,LSP))
		  THEN ERROR(458);
		IF SY = COMMA
		  THEN INSYMBOL
		  ELSE ERROR(158);
		if sy=comma %,,word\
		  then begin
		  insymbol;
		  arg := oneword;
		  expression(fsys or [rparent,comma],onregc);
		  load(gattr);
		  lh := gattr
		  end
		else if sy=colon  %:ac\
		  then begin
		  arg := bareac;
		  insymbol;
		  constant(fsys or [rparent,comma],lsp,acval);
		  if not(comptypes(intptr,lsp))
		    then error(458)
		  end
		else begin  %lh,rh   or w1:w2\
		EXPRESSION(FSYS OR [RPARENT,COMMA,COLON],ONREGC);
		LOAD(GATTR);
		LH := GATTR;
		IF SY = COMMA
		  THEN INSYMBOL
		else if sy=colon
		  then begin arg:=twowords; insymbol end
		else error(158);
		  EXPRESSION(FSYS OR [RPARENT,COMMA],ONREGC);
		  IF GATTR.TYPTR # NIL
		    THEN IF (GATTR.TYPTR^.FORM <= POWER) or (arg=twowords)
		      THEN LOAD(GATTR)
		      ELSE BEGIN
		      LOADADDRESS;
		      GATTR.KIND:=EXPR;
		      GATTR.REG:=GATTR.INDEXR
		      END;
		  RH := GATTR;
		  end  %of lh,rh and w1:w2\;
		IF SY = COMMA
		  THEN INSYMBOL
		  ELSE ERROR(158);
		VARIABLE(FSYS OR [RPARENT,COMMA]);
		IF GATTR.TYPTR = NIL
		  THEN ERROR(458)
		  ELSE IF NOT(GATTR.TYPTR^.FORM IN [SUBRANGE,SCALAR])
		    THEN ERROR(458)
		    ELSE LOADADDRESS;
		RESUL:=GATTR;
		IF SY = COMMA
		  THEN INSYMBOL
		  ELSE ERROR(158);
		VARIABLE(FSYS OR [RPARENT]);
		IF NOT COMPTYPES(BOOLPTR,GATTR.TYPTR)
		  THEN ERROR(158)
		  ELSE LOADADDRESS;
		BOOL := GATTR;
		IF NOT ERRORFLAG
		  THEN BEGIN
		  case arg of
		    bareac: regc := acval.ival;
		    xwd: begin regc := rh.reg; macro3(504B%hrl\,rh.reg,lh.reg) end;
		    oneword: regc := lh.reg;
		    twowords: begin
			      regc := lh.reg;
			      if (regc+1) # rh.reg
			        then macro3(200B%move\,regc+1,rh.reg)
			      end
		  end %case\;
		  macro3(201B%movei\,tac,1);
		  macro4(202B%movem\,tac,bool.indexr,0);
		  MACRO3(047B%CALLI\,REGC,LVAL.IVAL);
		  MACRO4(402B%SETZM\,0,BOOL.INDEXR,0);
		  MACRO4(202B%MOVEM\,REGC,RESUL.INDEXR,0)
		  END
		END;

(* 61 - tops20 system version *)
	      procedure jsys;
		var
		lval:valu; lsp:stp; jsysnum,numrets,i:integer;
		retsave:attr; saveret,ercal,done1: Boolean;
		realregc:acrange;
(* 133 - add variable to allow saving stuff in display *)
		savelc:addrrange;
	       procedure loadarg;
		(* Handles input args for jsys:
		    simple vars - use their values
		    sets - use LH word only
		    files - use jfn word
		    packed arrays - make byte ptr to it
		    other - make pointer to it
		*)
		 begin
		 expression (fsys or [rparent,comma,semicolon,colon],onfixedregc);
		 if gattr.typtr # nil
		  then if (gattr.typtr^.form < power)
			then load(gattr)
		       else if (gattr.typtr^.form = power)
			then begin
(* 77 - can't treat as integer. have to load both words and throw away 2nd *)
			load(gattr);
			regc := regc-1;
			end
		       else if (gattr.typtr^.form = files)
			then begin
			loadaddress;
			with lastfile^ do
			 if (vlev = 0) and (not main)
			  then begin vaddr := ic-1; code.information[cix] := 'E' end;
			macro4(200b%move\,regc,regc,filjfn)
			end
		       else if (gattr.typtr^.form = arrays) and gattr.typtr^.arraypf
			then begin
			loadaddress;
			macro3r(500b%hll\,regc,gattr.typtr^.arraybpaddr);
			macro3(621b%tlz\,regc,17b)
			end
		       else loadaddress
		 end;
	       procedure storearg;
		(* stores results of jsys.  As above, but error for
		   anything bigger than a word *)
		 begin
		 variable(fsys or [rparent,comma]);
		 if gattr.typtr # nil
		  then if (gattr.typtr^.form < power)
			then store(realregc,gattr)
		       else if (gattr.typtr^.form = power)
			then begin
			gattr.typtr := intptr;
			store(realregc,gattr)
			end
		       else if (gattr.typtr^.form = files)
			then begin
			loadaddress;  {addr of file now in REGC}
			with lastfile^ do
			 if (vlev = 0) and (not main)
			  then begin vaddr:=ic-1; code.information[cix] := 'E' end;
(* 173 - internal files *)
{We have to compile code to see if the file is initialized.  If not,
 call INITB. to do so.  INITB. needs the file in AC 2.  Note that
 the AC use here is such that REGC is always above 2, so the only
 reason for 2 not to be free is that realregc is using it.  This is
 certainly not the best possible code, but at this point I am going
 for the last code in the compiler to implement it.}
			macro3(250b%exch\,2,regc);
			macro4(200b%move\,0,2,filtst);
			macro3(302b%caie\,0,314157B);
			support(initfileblock);
			if realregc = 2
			  then macro4(202b%movem\,regc,2,filjfn)
			  else macro4(202b%movem\,realregc,2,filjfn)
			end
		       else error(458)
		 end;
		begin (* jsys *)
		ercal := false; saveret := false; numrets := 0; done1 := false;
		constant(fsys or [rparent,comma,semicolon],lsp,lval);
		jsysnum := lval.ival;
		if not comptypes (intptr, lsp)
		  then error(458);
		if sy = comma
		  then begin (* return spec *)
		  insymbol;
		  constant(fsys or [rparent,comma,semicolon],lsp,lval);
		  if lval.ival < 0
		    then ercal := true;
		  numrets := abs(lval.ival);
		  if not comptypes (intptr, lsp)
		    then error(458);
		  if sy = comma
		    then begin (* return var *)
		    insymbol;
		    variable(fsys or [rparent,semicolon]);
		    if comptypes (intptr,gattr.typtr)
		      then begin saveret := true; retsave := gattr end
		      else error (459)
		    end
		  end; (* return spec *)
		if sy = semicolon
		  then begin (* prolog *)
		  insymbol;
		  regc := 1;
		  if sy # semicolon
		    then loop (* non-empty prolog *)
		    loadarg;
		    if sy = colon
		      then begin
		      insymbol;
		      realregc := regc;
		      loadarg;
		      macro3(504b%hrl\,realregc,realregc);
		      macro3(540b%hrr\,realregc,regc);
		      regc := realregc
		      end;
		    if not done1
		      then begin
(* 133 - save in display instead of PUSH P, *)
		      {Here we prepared a place on the display to store the value}
		      savelc := lc;
		      lc := lc+1;
		      if lc > lcmax
			then lcmax := lc;
		      macro4(202B%movem\,2,basis,savelc);
		      done1 := true;
		      regc := 1
		      end;
		    exit if sy # comma;
		    insymbol
		    end (* non-empty prolog *)
		  end; (* prolog *)
		(* main call *)
		if done1
(* 133 - save in display instead of POP P, *)
		  then begin
		  macro4(200B%move\,1,basis,savelc);
		  lc := savelc
		  end;
		if saveret
		  then macro3(201b%movei\,0,numrets+1);
		macro3(104b%jsys\,0,jsysnum);
		if ercal
		  then begin
		  macro3r(320b%jump\,16b,ic+numrets);
		  numrets := numrets -1
		  end;
		for i := 1 to numrets do
		  if saveret then
		    macro3(275b%subi\,0,1)
		    else macro3(255b%jfcl\,0,0);
		if sy = semicolon (* if epilog, save reg a over store *)
		  then begin
(* 133 - use display instead of stack to save *)
		  {find a place in the display to save ac 2}
		  savelc := lc;
		  lc := lc + 1;
		  if lc > lcmax
		    then lcmax := lc;
		  macro4(202B%movem\,2,basis,savelc);
		  macro3(200b%move\,2,1);
		  done1 := true
		  end
		 else done1 := false;
		if saveret
		  then store(0,retsave);
		if sy = semicolon
		  then begin (* epilog *)
		  realregc := 1;
		  repeat
		    insymbol;
		    regc := 4; (* so temp ac's start at 5 *)
		    realregc := realregc + 1;
		    if realregc > 4
		      then error(458);
		    storearg;
		    if done1
		      then begin
(* 133 - use display instead of stack to store ac 2 *)
		      macro4(200B%move\,2,basis,savelc);
		      lc := savelc;
		      realregc := 1;
		      done1 := false
		      end
		   until sy # comma
		  end (* epilog *)
		end; (* jsys *)

	      PROCEDURE MARK;
	       BEGIN
		VARIABLE(FSYS OR [RPARENT]);
		 IF COMPTYPES(INTPTR,GATTR.TYPTR)
		 THEN
(* 12 - REWRITE FOR NEW DYNAMIC MEMORY *)
(* 122 - retrofit KA code *)
(* 132 - separate KA10 into NOVM and KACPU *)
		 if novm
		   then begin
		   loadaddress;
		   macro4(202B%movem\,newreg,gattr.indexr,0)
		   end
		  else
		   BEGIN
		   LOADADDRESS;
		   INCREMENTREGC;
	 	   MACRO3R(200B%MOVE\,REGC,LSTNEW);
		   LSTNEW:=IC-1;  %GLOBAL FIXUP\
		   MACRO4(202B%MOVEM\,REGC,GATTR.INDEXR,0)
		   END
		 ELSE ERROR(459)
	       END %MARK\ ;

	      PROCEDURE RELEASE;
	       BEGIN
		EXPRESSION(FSYS OR [RPARENT],ONREGC);
		 IF GATTR.TYPTR = INTPTR
		 THEN
		   BEGIN
(* 12 - RECODE FOR NEW DYNAMIC MEMORY *)
		   LOAD(GATTR);
(* 122 - retrofit for KA *)
(* 132 - separate KA10 into NOVM and KACPU *)
		   if novm
		     then macro3(200B%move\,newreg,regc)
		     ELSE BEGIN
		     MACRO3R(202B%MOVEM\,REGC,LSTNEW);
		     LSTNEW := IC-1;  % GLOBAL FIXUP \
		     end
		   END
		 ELSE ERROR(458)
	       END %RELEASE\ ;

	      PROCEDURE GETLINENR;
	       BEGIN
(* 33 - ALLOW GETFILENAME WITH NON-TEXT *)
(* 171 - PREDECL FILES ARE SPECIAL *)
		GETFILENAME(INFILE,TRUE,THISFILE,GOTARG,TRUE);
		IF NOT GOTARG
		  THEN ERROR(554);
		IF GATTR.KIND <> VARBL
		 THEN ERROR(458)
		 ELSE IF  GATTR.TYPTR # NIL
		 THEN
		   IF COMPTYPES(CHARPTR,GATTR.TYPTR^.AELTYPE) AND (GATTR.TYPTR^.FORM = ARRAYS)
		   THEN
		     BEGIN
		      MACRO4(200B%MOVE\,REGC,REGC,FILLNR); STORE(REGC,GATTR)
		     END
		   ELSE ERROR(458);
	       END;

	      PROCEDURE GETINTEGERFILENAME(DEFAULTNAME : ALFA);
	      VAR
		LCP : CTP; LID : ALFA;
	       BEGIN
		LID := ID;
		ID := DEFAULTNAME; SEARCHID([VARS],LCP);
		SELECTOR(FSYS OR FACBEGSYS OR [COMMA], LCP); LOADADDRESS;
		WITH LCP^, IDTYPE^ DO
		 IF (FORM = FILES) AND (VLEV = 0) AND (NOT MAIN)
		 THEN
		   BEGIN
		    VADDR:= IC-1; CODE.INFORMATION[CIX] := 'E'
		   END;
		ID := LID
	       END;

	      PROCEDURE PUT8BITSTOTTY;
	       BEGIN
		EXPRESSION(FSYS OR [RPARENT],ONREGC) ;
		LOAD(GATTR);
		MACRO3(051B%TTCALL\,15B%IONEOU\,GATTR.REG)
	       END %PUT8BITSTOTTY\ ;

	      PROCEDURE PAGE;
	       BEGIN
(* 33 - ALLOW GETFILENAME WITH NON-TEXT *)
(* 171 - PREDECL FILES ARE SPECIAL *)
		GETFILENAME(OUTFILE,TRUE,THISFILE,GOTARG,TRUE);
		IF GOTARG
		  THEN ERROR(554);
		SUPPORT(PUTPAGE)
	       END;
(* 63 - support for tops-20 time and runtime *)
	      procedure jsysf(jsysnum,hireg:integer);
		var i:integer;
		begin
		if hireg > regc
		  then hireg := regc;
		for i := 2 to hireg do
		  macro3(261B%push\,topp,i);
		if jsysnum = 15B
		  then macro3(211B%movni\,1,5);
		macro3(104B%jsys\,0,jsysnum);
		with gattr do
		  begin
		  incrementregc; typtr := intptr; reg := regc; kind := expr;
		  macro3(200B%move\,regc,1)
		  end;
		for i := hireg downto 2 do
		  macro3(262B%pop\,topp,i)
		end;


	      PROCEDURE RUNTIME;
	       BEGIN
(* 63 - TOPS20 *)
	       IF TOPS10
		THEN WITH GATTR DO
		 BEGIN
		  INCREMENTREGC; TYPTR := INTPTR; REG := REGC; KIND := EXPR;
		  MACRO3(047B,REGC,30B%PJOB-UUO\);
		  MACRO3(047B,REGC,27B%RUNTIM-UUO\)
		 END
	        ELSE JSYSF(15B%RUNTM\,3)
	       END;

	      PROCEDURE ABS;
	       BEGIN
		WITH GATTR DO
		 IF (TYPTR = INTPTR) OR (TYPTR = REALPTR)
		 THEN
		  WITH CODE.INSTRUCTION[CIX] DO
		   IF INSTR = 200B%MOVE\
		   THEN INSTR := 214B%MOVM\
		   ELSE MACRO3(214B%MOVM\,REG,REG)
		 ELSE
		   BEGIN
		    ERROR(459); TYPTR:= INTPTR
		   END
	       END %ABS\ ;

	      PROCEDURE TIME;
	       BEGIN
(* 63 - TOPS20 *)
		WITH GATTR DO
		 BEGIN
		  INCREMENTREGC; TYPTR := INTPTR; REG := REGC; KIND := EXPR;
		  if tops10
		    then MACRO3(047B,REGC,23B%MSTIME-UUO\)
		   else begin
		   support(getdaytime);
		   macro3(262B%POP\,17B,regc)
		   end
		 END
	       END;

	      PROCEDURE SQR;
	       BEGIN
		WITH GATTR DO
		 IF TYPTR = INTPTR
		 THEN MACRO3(220B%IMUL\,REG,REG)
		 ELSE
		   IF TYPTR = REALPTR
		   THEN MACRO3(164B%FMPR\,REG,REG)
		   ELSE
		     BEGIN
		      ERROR(459); TYPTR := INTPTR
		     END
	       END %SQR\ ;

	      PROCEDURE TRUNC;
		VAR INSTRUC:1..777;
	       BEGIN
		IF LKEY = 5
		  THEN INSTRUC := 122B%FIX\
		  ELSE INSTRUC := 126B%FIXR\;
		 IF GATTR.TYPTR # REALPTR
		 THEN ERROR(459)
		 ELSE
(* 2 - hard code TRUNC using KI-10 op code *)
(* 10 - ADD ROUND *)
(* 101 - fix bad code generation for fix and fixr *)
(* 122 - put back KA code *)	 
(* 132 - separate KA10 into NOVM and KACPU *)
		 if kacpu
		   then begin
		   if lkey=5
		     then macro3(551B%hrrzi\,tac,gattr.reg)
		     else macro3(561B%hrroi\,tac,gattr.reg);
		   support(convertrealtointeger);
		   end
		  ELSE WITH CODE.INSTRUCTION[CIX] DO
		    IF (INSTR = 200B%MOVE\) AND (AC = GATTR.REG)
		      THEN INSTR := INSTRUC
		      ELSE MACRO3(INSTRUC,GATTR.REG,GATTR.REG);
		GATTR.TYPTR := INTPTR
	       END %TRUNC\ ;

	      PROCEDURE ODD;
	       BEGIN
		WITH GATTR DO
		 BEGIN
		   IF TYPTR # INTPTR
		   THEN ERROR(459);
		  MACRO3(405B%ANDI\,REG,1);
		  TYPTR := BOOLPTR
		 END
	       END %ODD\ ;

	      PROCEDURE ORD;
	       BEGIN
		 IF GATTR.TYPTR # NIL
		 THEN
		   IF GATTR.TYPTR^.FORM >= POWER
		   THEN ERROR(459);
		GATTR.TYPTR := INTPTR
	       END %ORD\ ;

	      PROCEDURE CHR;
	       BEGIN
		 IF GATTR.TYPTR # INTPTR
		 THEN ERROR(459);
		GATTR.TYPTR := CHARPTR
	       END %CHR\ ;

	      PROCEDURE PREDSUCC;
	      VAR
		LSTRPTR:STP; LATTR: ATTR;
	       BEGIN
		 IF GATTR.TYPTR # NIL
		 THEN
		   IF (GATTR.TYPTR^.FORM>SUBRANGE) OR (GATTR.TYPTR=REALPTR)
		   THEN ERROR(459)
		   ELSE
		     IF RUNTMCHECK
		     THEN
		       BEGIN
			LSTRPTR:=GATTR.TYPTR;
			 IF (LSTRPTR^.FORM=SUBRANGE) AND (LSTRPTR^.RANGETYPE #NIL)
			 THEN LSTRPTR:=LSTRPTR^.RANGETYPE;
			 IF LKEY=9
			 THEN
			   BEGIN
			     IF LSTRPTR=INTPTR
			     THEN
			       BEGIN
				MACRO3R(255B%JFCL\,10B,IC+1);
				MACRO3(275B%SUBI\,REGC,1  );
				MACRO3R(255B%JFCL\,10B,IC+2);
				MACRO3(334B%SKIPA\,0,0	  );
				SUPPORT(ERRORINASSIGNMENT)
			       END
			     ELSE%  CHAR OR DECLARED \
			       BEGIN
				MACRO3R(365B%SOJGE\,REGC,IC+2);
				SUPPORT(ERRORINASSIGNMENT)
			       END
			   END % LKEY = 9 \
			 ELSE % LKEY = 10 \
			   BEGIN
			     IF LSTRPTR=INTPTR
			     THEN
			       BEGIN
				MACRO3R(255B%JFCL \,10B,IC+1);
				MACRO3(271B%ADDI \,REGC,1  );
				MACRO3R(255B%JFCL \,10B,IC+2);
				MACRO3(334B%SKIPA\,0,0	   );
				SUPPORT(ERRORINASSIGNMENT)
			       END
			     ELSE %CHAR OR DECLARED\
			       BEGIN
				WITH LATTR DO
				 BEGIN
				  TYPTR := LSTRPTR; KIND := CST; CVAL.IVAL := 0;
				   IF LSTRPTR=CHARPTR
				   THEN CVAL.IVAL := 177B
				   ELSE
				     IF LSTRPTR^.FCONST # NIL
				     THEN CVAL.IVAL:=LSTRPTR^.FCONST^.VALUES.IVAL;
				  MAKECODE(311B%CAML\,REGC,LATTR);
				  SUPPORT(ERRORINASSIGNMENT);
				  MACRO3(271B%ADDI \,REGC,1 );
				 END
			       END
			   END % LKEY = 10 \;
		       END % RUNTMCHECK \
		     ELSE
		       IF LKEY = 9
		       THEN MACRO3(275B%SUBI\,REGC,1)
		       ELSE MACRO3(271B%ADDI\,REGC,1)
	       END %PREDSUCC\ ;

	      PROCEDURE EOFEOLN;
	       BEGIN
(* 33 - USE GETFILENAME, SO DEFAULTS TO INPUT *)
(* 171 - PREDECL FILES ARE SPECIAL *)
	       GETFILENAME(INFILE,FALSE,THISFILE,GOTARG,TRUE);
	       IF GOTARG
		 THEN ERROR(554);
		WITH GATTR DO
		 BEGIN
		  KIND := EXPR; REG := INDEXR;
		   IF LKEY=11
		   THEN
		     BEGIN
		      MACRO4(332B%SKIPE\,REG,REG,FILEOF) ;
		      MACRO3(201B%MOVEI\,REG,1) ;
		     END
		   ELSE MACRO4(200B%MOVE\,REG,REG,FILEOL);
		  TYPTR := BOOLPTR
		 END
	       END %EOF\ ;

	      PROCEDURE PROTECTION;
		(* FOR DETAILS SEE  DEC-SYSTEM-10 MONITOR CALLS MANUAL, 3.2.4 *)
	       BEGIN
		EXPRESSION ( FSYS OR [RPARENT], ONREGC );
		 IF GATTR.TYPTR = BOOLPTR
(* 63 - TOPS20 *)
		 THEN IF TOPS10
		  THEN
		   BEGIN
		    LOAD(GATTR);
		    MACRO3(047B%CALLI\,REGC,36B%SETUWP\);
		    MACRO3(254B%HALT\,4,0)
		   END
		  ELSE
		 ELSE ERROR(458)
	       END;

	      PROCEDURE CALLNONSTANDARD;
	      VAR
		NXT,LNXT,LCP: CTP;
		LSP: STP;
(* 33 - PROC PARAM.S*)
		PKIND,LKIND: IDKIND;	LB: BOOLEAN;
		SAVECOUNT,P,I,NOFPAR: INTEGER;
		TOPPOFFSET,OFFSET,PARLIST,ACTUALPAR,FIRSTPAR,LLC: ADDRRANGE;
		LREGC: ACRANGE;

(* 111 - STRING, POINTER *)
		procedure paramfudge;
		  var lmin,lmax:integer;
		(* This is used to handle special parameter types with
		   reduced type checking, such as STRING, POINTER.  They
		   are always one of STRINGPTR, POINTERPTR, or POINTERREF.
		   STRINGPTR is for STRING, the other two for POINTER.
		   POINTERREF is for call by ref *)
		begin
		with gattr.typtr^ do
		  if lsp=stringptr
		    then if (form=arrays) and arraypf
		      then if comptypes(aeltype,charptr)
			then begin  (* STRING *)
			getbounds (gattr.typtr^.inxtype, lmin, lmax);
			loadaddress;
			incrementregc;
			macro3(201B%movei\,regc,lmax-lmin+1);
			end
		       else error(503)
		      else error(503)
		    else if form=pointer  {pointerptr or pointerref}
		      then if eltype <> nil
			then begin (* POINTER *)
(* 202 - fix up pointer by ref *)
			if lsp = pointerptr
			  then load(gattr)
			  else loadaddress;
			incrementregc;
			macro3(201B%movei\,regc,eltype^.size)
			end
		       else  (* bad type decl - already have error *)
		      else error(503);
		gattr.typtr := lsp  (* so comptypes later succeeds *)
		end;

	       BEGIN
		NOFPAR:= 0; TOPPOFFSET := 0; PARLIST := 0; ACTUALPAR := 0;
		WITH FCP^ DO
		 BEGIN
		  NXT := NEXT; LKIND := PFKIND;
		   IF KLASS = FUNC
		   THEN FIRSTPAR := 2
		   ELSE FIRSTPAR := 1;
(* 33 - PROC PARAM.S *)
		   IF LKIND = ACTUAL
		   THEN IF EXTERNDECL
		   THEN LIBRARY[LANGUAGE].CALLED:= TRUE;
		  SAVECOUNT := REGC - REGIN;
		   IF  SAVECOUNT > 0
		   THEN
		     BEGIN
		      LLC := LC ;
		      LC := LC + SAVECOUNT ;
		       IF LC > LCMAX
		       THEN  LCMAX := LC ;
		       IF SAVECOUNT > 3
		       THEN
			 BEGIN
			  MACRO3(505B%HRLI\,TAC,2);
			  MACRO4(541B%HRRI\,TAC,BASIS,LLC);
			  MACRO4(251B%BLT\,TAC,BASIS,LLC+SAVECOUNT-1)
			 END
		       ELSE FOR  I := 1 TO SAVECOUNT DO  MACRO4(202B%MOVEM\,REGIN+I,BASIS,LLC+I-1)
		     END;
		  LREGC:= REGC;
		  IF LKIND = FORMAL
		    THEN REGC := REGIN
		  ELSE IF LANGUAGE # PASCALSY
		    THEN REGC:= PARREGCMAX
		  ELSE REGC:= REGIN
		 END;
		 IF SY = LPARENT
		 THEN
		   BEGIN
		     REPEAT
		      LB := FALSE;  %DECIDE WHETHER PROC/FUNC MUST BE PASSED\
		       IF LKIND = ACTUAL
		       THEN
			 BEGIN
			   IF NXT = NIL
			   THEN ERROR(554)
			   ELSE LB := NXT^.KLASS IN [PROC,FUNC]
			 END
(* 33 - PROC PARAM.S *)
		       ELSE LB := FALSE;
			%FOR FORMAL PROC/FUNC LB IS FALSE AND EXPRESSION
			 WILL BE CALLED, WHICH WILL ALLWAYS INTERPRET A PROC/FUNC ID
			 AT ITS BEGINNING AS A CALL RATHER THAN A PARAMETER PASSING.
			 IN THIS IMPLEMENTATION, PARAMETER PROCEDURES/FUNCTIONS
			 ARE THEREFORE NOT ALLOWED TO HAVE PROCEDURE/FUNCTION
			 PARAMETERS\
		      INSYMBOL;
		       IF LB
		       THEN   %PASS FUNCTION OR PROCEDURE\
			 BEGIN
			   IF SY # IDENT
			   THEN
			    ERRANDSKIP(209,FSYS OR [COMMA,RPARENT])
			   ELSE
			     BEGIN
			       IF NXT^.KLASS = PROC
			       THEN SEARCHID([PROC],LCP)
			       ELSE
				 BEGIN
				  SEARCHID([FUNC],LCP);
				   IF  NOT COMPTYPES(LCP^.IDTYPE,NXT^.IDTYPE)
				   THEN
				    ERROR(555)
				 END;
			      INSYMBOL;
			      IFERRSKIP(166,FSYS OR [COMMA,RPARENT])
			     END;
(* 33 - PROC PARAM.S *)
			 WITH LCP^ DO
			  IF (PFDECKIND = STANDARD) OR (PFKIND = ACTUAL) AND (LANGUAGE # PASCALSY)
			    THEN ERROR (466)
			    ELSE BEGIN
			    INCREMENTREGC;
(* 67 - fix proc param's *)
			   if pflev > 1
			     then p := level - pflev
			     else p := 0;
			    IF PFKIND = ACTUAL
			      THEN BEGIN
			      IF P = 0
				THEN MACRO3(514B%HRLZ\,REGC,BASIS)
			      ELSE IF P=1
				THEN MACRO4(514B%HRLZ\,REGC,BASIS,-1)
			      ELSE %P>1\
				BEGIN
				MACRO4(550B%HRRZ\,REGC,BASIS,-1);
				FOR I := 3 TO P DO MACRO4(550B%HRRZ\,REGC,REGC,-1);
				MACRO4(514B%HRLZ\,REGC,REGC,-1)
				END;
			    IF PFADDR = 0
			      THEN BEGIN
(* 67 - fix typo: R in macro3r omitted *)
			      MACRO3R(541B%HRRI\,REGC,LINKCHAIN[P]);
			      LINKCHAIN[P] := IC - 1;
			      IF EXTERNDECL
				THEN CODE.INFORMATION[CIX] := 'E'
				ELSE CODE.INFORMATION[CIX] := 'F'
			      END
			     ELSE MACRO3R(541B%HRRI\,REGC,PFADDR);
			    END %OF PFKIND = ACTUAL \
			    ELSE %PFKIND = FORMAL \
			      IF P = 0
				THEN MACRO4(200B%MOVE\,REGC,BASIS,PFADDR)
				ELSE
				  BEGIN
				  MACRO4(200B%MOVE\,REGC,BASIS,-1);
				  FOR I := 2 TO P DO MACRO4(200B%MOVE\,REGC,REGC,-1);
				  MACRO4(200B%MOVE\,REGC,REGC,PFADDR)
				  END
			    END;
			 END %IF LB\
		       ELSE
			 BEGIN
			  EXPRESSION(FSYS OR [COMMA,RPARENT],ONFIXEDREGC);
			   IF GATTR.TYPTR # NIL
			   THEN
(* 33 - PROC PARAM.S *)
			       BEGIN
%NOTE : WE TREAT ALL PARAM'S OF A FORMAL PROC AS ACTUAL\
				 IF (NXT # NIL) OR (LKIND = FORMAL)
				 THEN
				   BEGIN
(*33 - PROC PARAM.S *)
				    IF LKIND = FORMAL
				      THEN BEGIN LSP := GATTR.TYPTR; PKIND := ACTUAL END
				      ELSE BEGIN LSP := NXT^.IDTYPE; PKIND := NXT^.VKIND END;
				     IF LSP # NIL
				     THEN
				       BEGIN
(* 33 - PROC PARAM.S *)
(* 161 - fix STRING,POINTER *)
					IF  (PKIND = ACTUAL)
					 THEN
					   IF LSP^.SIZE <= 2
					   THEN
					     BEGIN
(* 104 - more range checking for subrange things *)
(* 202 - pointer by ref *)
					       if (lsp = stringptr) or
						  (lsp = pointerptr) or
						  (lsp = pointerref)
						     then paramfudge
					       else if lsp^.form = subrange
						then loadsubrange(gattr,lsp)
					       else load(gattr);
					       IF COMPTYPES(REALPTR,LSP)
						AND (GATTR.TYPTR = INTPTR)
					       THEN MAKEREAL(GATTR)
					     END
					   ELSE
					     BEGIN
					      LOADADDRESS;
(* 33 - PROC PARAM.S *)
					       IF (LKIND = ACTUAL) AND (FCP^.LANGUAGE # PASCALSY)
					       THEN CODE.INSTRUCTION[CIX].INSTR := 505B%HRLI\
					     END
					 ELSE
					   IF GATTR.KIND = VARBL
					   THEN LOADADDRESS
					   ELSE ERROR(463) ;
(* 22 - ALLOW EXTERNAL FILE REFERENCES *)
					 IF GATTR.TYPTR#NIL
					  THEN IF GATTR.TYPTR^.FORM=FILES
					    THEN WITH LASTFILE^ DO
					     IF (VLEV=0) AND (NOT MAIN)
					      THEN BEGIN VADDR:=IC-1;CODE.INFORMATION[CIX]:='E' END;
(* 64 - fix proc param's that don't fit in ac's *)
					 IF  NOT COMPTYPES(LSP,GATTR.TYPTR)
					 THEN ERROR(503)
				       END
				   END
			       END
(* 33 - PROC PARAM.S *)
			 END;
			 IF REGC>PARREGCMAX
			 THEN
(* 33 - PROC PARAM.S *)
(* NOTE: CURRENTLY WE PUNT IF ARG'S DON'T FIT IN AC'S IN FORMAL PROC*)
			  IF LKIND=FORMAL
			   THEN ERROR(413)
			   ELSE BEGIN
			     IF TOPPOFFSET = 0
			     THEN
			       BEGIN
				LNXT := FCP^.NEXT ;
				 IF FCP^.LANGUAGE = PASCALSY
(* 62 - clean up offset *)
				 then toppoffset := fcp^.poffset + 1
				 ELSE
				   BEGIN
				    TOPPOFFSET := 1 + FIRSTPAR;
				     REPEAT
				      WITH LNXT^ DO
				       BEGIN
					NOFPAR := NOFPAR +1;
					TOPPOFFSET := TOPPOFFSET + 1;
					 IF VKIND = ACTUAL
					 THEN TOPPOFFSET := TOPPOFFSET + IDTYPE^.SIZE;
					 IF LKIND = ACTUAL
					 THEN LNXT := NEXT
				       END;
				     UNTIL LNXT = NIL;
				    PARLIST := 1 + FIRSTPAR;
				    ACTUALPAR := PARLIST + NOFPAR
				   END;
(* 104 - TOPS20 DETECTION OF STACK OVERFLOW *)
(* 115 - TENEX *)
				IF KLCPU AND NOT TOPS10
				  THEN MACRO3(105B%ADJSP\,TOPP,TOPPOFFSET)
				  ELSE MACRO3(271B%ADDI\,TOPP,TOPPOFFSET);
(* 54 - keep track of how many loc's above stack are used *)
				stkoff := stkoff + toppoffset;
				if stkoff > stkoffmax
				  then stkoffmax := stkoff
			       END ;
			    WITH NXT^ DO
			     BEGIN
			       IF FCP^.LANGUAGE = PASCALSY
			       THEN
(* 64 - fix parameter proc's that don't fit in ac's *)
			       if klass # vars
				 then macro4(202b%movem\,regc,topp,pfaddr+1-toppoffset)
				 ELSE BEGIN
(* 52 - if VAR, size is always 1 *)
				   IF (VKIND=ACTUAL) AND (IDTYPE^.SIZE=2)
				   THEN
				     BEGIN
				      MACRO4(202B%MOVEM\,REGC,TOPP,VADDR+2-TOPPOFFSET);
				      REGC := REGC - 1
				     END;
(* 201 - zero size things *)
				  IF (IDTYPE^.SIZE > 0) OR (VKIND <> ACTUAL)
				    THEN MACRO4(202B%MOVEM\,REGC,TOPP,VADDR+1-TOPPOFFSET)
				 END
			       ELSE
(* 64 - proc param's that don't fit in ac's *)
				if klass # vars
				 then error(466)
				 ELSE BEGIN
				   IF VKIND = ACTUAL
				   THEN
				     BEGIN
				       IF IDTYPE^.SIZE <= 2
				       THEN
					 BEGIN
					   IF IDTYPE^.SIZE = 2
					   THEN
					     BEGIN
					      MACRO4(202B%MOVEM\,REGC,TOPP,ACTUALPAR+1-TOPPOFFSET);
					      REGC := REGC - 1
					     END;
(* 201 - zero size objects *)
					  IF IDTYPE^.SIZE > 0
					    THEN MACRO4(202B%MOVEM\,REGC,TOPP,ACTUALPAR-TOPPOFFSET);
					  MACRO4(541B%HRRI\,REGC,TOPP,ACTUALPAR-TOPPOFFSET)
					 END
				       ELSE
					 BEGIN
					  MACRO4(541B%HRRI\,REGC,TOPP,ACTUALPAR-TOPPOFFSET);
					  MACRO4(251B%BLT\,REGC,TOPP,ACTUALPAR+IDTYPE^.SIZE-1-TOPPOFFSET);
(* 52 - BLT may change REGC, so reset it since used below *)
					  MACRO4(541B%HRRI\,REGC,TOPP,ACTUALPAR-TOPPOFFSET)
					 END;
				      ACTUALPAR := ACTUALPAR + IDTYPE^.SIZE
				     END;
				  MACRO4(552B%HRRZM\,REGC,TOPP,PARLIST-TOPPOFFSET);
				  PARLIST := PARLIST + 1
				 END;
			      REGC := PARREGCMAX
			     END
			   END;
		       IF (LKIND = ACTUAL) AND (NXT # NIL)
		       THEN NXT := NXT^.NEXT
		     UNTIL SY # COMMA;
		     IF SY = RPARENT
		     THEN INSYMBOL
		     ELSE ERROR(152)
		   END %IF LPARENT\;
		FOR I := 0 TO WITHIX DO
		WITH DISPLAY[TOP-I] DO
		 IF (CINDR#0)  AND  (CINDR#BASIS)
		 THEN
		  MACRO4(202B%MOVEM\,CINDR,BASIS,CLC);
		WITH FCP^ DO
		 BEGIN
(* 33 - PROC. PARAM.S *)
		   IF LKIND = FORMAL
		     THEN BEGIN END %TOPOFFSET=0 ALWAYS AT THE MOMENT\
		   ELSE IF  (LANGUAGE = PASCALSY) AND (TOPPOFFSET # 0)
(* 54 - keep track of offsets above top of stack *)
(* 62 - clean up offset *)
		     THEN STKOFF := STKOFF - TOPPOFFSET
		   ELSE IF (LANGUAGE # PASCALSY) AND (TOPPOFFSET = 0)
		     THEN
		     BEGIN
		      TOPPOFFSET:= FIRSTPAR+2;
(* 104 - TOPS20 ADJSP *)
(* 115 - TENEX *)
		      IF KLCPU AND NOT TOPS10
			THEN MACRO3(105B%ADJSP\,TOPP,TOPPOFFSET)
		        ELSE MACRO3(271B%ADDI\,TOPP,TOPPOFFSET);
(* 54 - keep track of how many loc's above stack are used *)
		      STKOFF := STKOFF + TOPPOFFSET;
		      IF STKOFF > STKOFFMAX
		        THEN STKOFFMAX := STKOFF
		     END;
		   IF PFLEV > 1
		   THEN P := LEVEL - PFLEV
		   ELSE P:= 0;
		   IF LKIND = ACTUAL
		   THEN
		     BEGIN
		       IF NXT # NIL
		       THEN ERROR(554);
		       IF LANGUAGE # PASCALSY
		       THEN
			 BEGIN
			  MACRO3(515B%HRLZI\,HAC,-NOFPAR);
			  MACRO4(202B%MOVEM\,HAC,TOPP,FIRSTPAR-TOPPOFFSET);
			  MACRO4(202B%MOVEM\,BASIS,TOPP,-TOPPOFFSET);
			  MACRO4(201B%MOVEI\,BASIS,TOPP,FIRSTPAR-TOPPOFFSET+1);
			   IF NOFPAR = 0
			   THEN MACRO4(402B%SETZM\,0,TOPP,FIRSTPAR-TOPPOFFSET+1)
			 END;
		       IF PFADDR = 0
		       THEN
			 BEGIN
			  MACRO3R(260B%PUSHJ\,TOPP,LINKCHAIN[P]); LINKCHAIN[P]:= IC-1;
			   IF EXTERNDECL
			   THEN CODE.INFORMATION[CIX] := 'E'
			   ELSE CODE.INFORMATION[CIX] := 'F'
			 END
		       ELSE MACRO3R(260B%PUSHJ\,TOPP,PFADDR-P);
(* 33 - PROC PARAM.S *)
		   IF LANGUAGE # PASCALSY
		   THEN
		     BEGIN
(* 104 - TOPS20 ADJSP *)
		      IF KLCPU AND NOT TOPS10
			THEN MACRO3(105B%ADJSP\,TOPP,-TOPPOFFSET)
		        ELSE MACRO3(275B%SUBI\,TOPP,TOPPOFFSET);
(* 54 - keep track of how many loc's above stack are used *)
		      STKOFF := STKOFF - TOPPOFFSET;
		       IF KLASS = FUNC
		       THEN
			 BEGIN
			  MACRO4(202B%MOVEM\,HAC,TOPP,2);
			   IF IDTYPE^.SIZE = 2
			   THEN MACRO4(202B%MOVEM\,TAC,TOPP,3)
			 END;
		      MACRO4(200B%MOVE\,BASIS,TOPP,0)
		     END
(* 33 - PROC PARAM.S *)
		     END  (* OF LKIND = ACTUAL *)
		   ELSE
		     BEGIN
		     IF P = 0
		      THEN BEGIN
		       MACRO4(550B%HRRZ\,TAC,BASIS,PFADDR);
		       MACRO4(544B%HLR\,BASIS,BASIS,PFADDR)
		       END
		      ELSE BEGIN
		       MACRO4(550B%HRRZ\,TAC,BASIS,-1);
		       FOR I := 2 TO P DO MACRO4(550B%HRRZ\,TAC,TAC,-1);
		       MACRO4(544B%HLR\,BASIS,TAC,PFADDR);
		       MACRO4(550B%HRRZ\,TAC,TAC,PFADDR)
		       END;
		     MACRO4(260B%PUSHJ\,TOPP,TAC,0)
		     END
		 END;
		FOR I := 0 TO WITHIX DO
		WITH DISPLAY[TOP-I] DO
		 IF (CINDR#0)  AND  (CINDR#BASIS)
		 THEN MACRO4(200B%MOVE\,CINDR,BASIS,CLC) ;
		 IF  SAVECOUNT > 0
		 THEN
		   BEGIN
		     IF SAVECOUNT > 3
		     THEN
		       BEGIN
			MACRO4(505B%HRLI\,TAC,BASIS,LLC);
			MACRO3(541B%HRRI\,TAC,2);
			MACRO3(251B%BLT\,TAC,SAVECOUNT+1)
		       END
		     ELSE FOR  I := 1 TO SAVECOUNT  DO	MACRO4(200B%MOVE\,REGIN+I,BASIS,LLC+I-1) ;
		    LC := LLC
		   END ;
		GATTR.TYPTR := FCP^.IDTYPE; REGC := LREGC
	       END %CALLNONSTANDARD\ ;

	     BEGIN
	      %CALL\
	       IF FCP^.PFDECKIND = STANDARD
	       THEN
		 BEGIN
		  LKEY := FCP^.KEY;
		   IF FCP^.KLASS = PROC
		   THEN
		     BEGIN
(* 26 - allow non-text files *)
(* 61 - rclose *)
		       IF NOT (LKEY IN [7,8,9,10,11,17,19,25,34,39,42] )
		       THEN
			 IF SY = LPARENT
			 THEN INSYMBOL
			 ELSE ERROR(153);
(* 45 - APPEND, UPDATE, RENAME, use REG5 and REG6 *)
		       IF (LKEY IN [5,6,7,8,10,11,27,29,36]) AND (REGCMAX <= 8)
		       THEN ERROR(317);
			%REGISTER USED BY RUNTIME SUPPORT FREE OR NOT  \
		       CASE LKEY OF
(* 42 - move GET and PUT to NEW *)
			2,4,
(* 14 - NEW DUMP MODE I/O *)
			5,6,27,28,29,36:  GETPUTRESETREWRITE;
			7,
			8:
			   BEGIN
			    READREADLN;
			     IF NORIGHTPARENT
			     THEN GOTO 9
			   END;
			9:
			   BEGIN
			    BREAK;
			     IF NORIGHTPARENT
			     THEN GOTO 9
			   END;
			10,
			11:
			    BEGIN
			     WRITEWRITELN;
			      IF NORIGHTPARENT
			      THEN GOTO 9
			    END;
			12:    PACK;
			13:    UNPACK;
(* 27 - add NEWZ *)
(* 42 - move GET and PUT to NEW *)
(* 152 - add DISPOSE *)
			1,3,14,35,40,44:    NEW;
			15:    MARK;
			16:    RELEASE;
			17:    GETLINENR;
			18:    PUT8BITSTOTTY;
			19:
			    BEGIN
			     PAGE;
			      IF NORIGHTPARENT
			      THEN GOTO 9
			    END;
			21:    PROTECTION;
(* 10 - ADD SETSTRING *)
			22,23:  SETSTRING;
			24:	GETINDEX;
(* 26 - allow non-text files *)
(* 42 - move breakin to close *)
(* 61 - rclose *)
			25,34,39,42:	BEGIN CLOSE;IF NORIGHTPARENT THEN GOTO 9 END;
			26:CALLI;
(* 14 - NEW DUMP MODE I/O *)
			30,31:DUMP;
			32,33,38:USET;
(* 61 - delete *)
			37,41:PUTX;
(* 61 - tops20 system version *)
		        43:JSYS
		       END
		     END
		   ELSE
		     BEGIN
		       IF NOT (LKEY IN [1,2,11,12])
		       THEN
			 BEGIN
			   IF SY = LPARENT
			   THEN INSYMBOL
			   ELSE ERROR(153);
			  if lkey#15
			    then EXPRESSION(FSYS OR [RPARENT],ONREGC);
			   IF NOT (LKEY IN [7,8,11,12,15])
			   THEN LOAD(GATTR)
			 END;
		       CASE LKEY OF
			1:    RUNTIME;
			2:    TIME;
			3:    ABS;
			4:    SQR;
			5,14:    TRUNC;
			6:    ODD;
			7:    ORD;
			8:    CHR;
			9,10:  PREDSUCC;
			11,12: BEGIN EOFEOLN; IF NORIGHTPARENT THEN GOTO 9 END;
			15: NEW
		       END;
		       IF LKEY < 3
		       THEN GOTO 9
		     END;
		   IF SY = RPARENT
		   THEN INSYMBOL
		   ELSE ERROR(152);
9:
		 END %STANDARD PROCEDURES AND FUNCTIONS\
	       ELSE CALLNONSTANDARD
	     END %CALL\ ;

	    PROCEDURE EXPRESSION;
	    VAR
	      LATTR: ATTR; LOP: OPERATOR; LSIZE: ADDRRANGE; LOFFSET: INTEGER; DEFAULT,NEEDSHIFT: BOOLEAN;
	      BOOLREGC,TESTREGC:ACRANGE; LINSTR,LINSTR1: INSTRANGE; LREGC1,LREGC2: ACRANGE;
	      SETINCLUSION : BOOLEAN; JMPADRIFALLEQUAL : INTEGER;

	      PROCEDURE CHANGEBOOL(VAR FINSTR: INSTRANGE);
	       BEGIN
		 IF (FINSTR>=311B) AND (FINSTR<=313B)
		 THEN FINSTR := FINSTR+4  %CAML,CAME,CAMLE --> CAMGE,CAMN,CAMG\
		 ELSE
		   IF (FINSTR>=315B) AND (FINSTR<=317B)
		   THEN FINSTR := FINSTR-4  %SAME IN THE OTHER WAY\;
	       END;

	      PROCEDURE SEARCHCODE(FINSTR:INSTRANGE; FATTR: ATTR);
		PROCEDURE CHANGEOPERANDS(VAR FINSTR:INSTRANGE);
		 BEGIN
		   IF FINSTR=311B%CAML\
		   THEN FINSTR := 317B%CAMG\
		   ELSE
		     IF FINSTR = 313B%CAMLE\
		     THEN FINSTR := 315B%CAMGE\
		     ELSE
		       IF FINSTR=315B%CAMGE\
		       THEN FINSTR := 313B%CAMLE\
		       ELSE
			 IF FINSTR = 317B%CAMG\
			 THEN FINSTR := 311B%CAML\
			 ELSE
			   IF FINSTR = 420B%ANDCM\
			   THEN FINSTR := 410B%ANDCA\
			   ELSE
			     IF FINSTR = 410B%ANDCA\
			     THEN FINSTR := 420B%ANDCM\;
		 END;

	       BEGIN
		WITH GATTR DO
		 IF FATTR.KIND = EXPR
		 THEN
		   BEGIN
		    MAKECODE(FINSTR,FATTR.REG,GATTR); REG := FATTR.REG
		   END
		 ELSE
		   IF KIND = EXPR
		   THEN
		     BEGIN
		      CHANGEOPERANDS(FINSTR); MAKECODE(FINSTR,REG,FATTR)
		     END
		   ELSE
		     IF (KIND=VARBL) AND ((PACKFG#NOTPACK)
					  OR (INDEXR>REGIN) AND (INDEXR<=REGCMAX) AND
					  ((FATTR.INDEXR<=REGIN) OR (FATTR.INDEXR>REGCMAX)))
		     THEN
		       BEGIN
			LOAD(GATTR); CHANGEOPERANDS(FINSTR); MAKECODE(FINSTR,REG,FATTR)
		       END
		     ELSE
		       BEGIN
			LOAD(FATTR); MAKECODE(FINSTR,FATTR.REG,GATTR); REG := FATTR.REG
		       END;
	       END;

	      PROCEDURE SIMPLEEXPRESSION(FSYS: SETOFSYS);
	      VAR
		LATTR: ATTR; LOP: OPERATOR; SIGNED : BOOLEAN;
(* 52 - new var needed to prevent clobbering CONST decl. *)
		NEWREALCSP: CSP;

		PROCEDURE TERM(FSYS: SETOFSYS);
		VAR
		  LATTR: ATTR; LOP: OPERATOR;

		  PROCEDURE FACTOR(FSYS: SETOFSYS);
		  VAR
		    LCP: CTP; LVP: CSP; VARPART: BOOLEAN;
		    CSTPART: SET OF 0..71; LSP: STP;
		    RANGEPART: BOOLEAN;LRMIN: INTEGER;
		   BEGIN
		     IF NOT (SY IN FACBEGSYS)
		     THEN
		       BEGIN
			ERRANDSKIP(173,FSYS OR FACBEGSYS);
			GATTR.TYPTR := NIL
		       END;
		     IF SY IN FACBEGSYS
		     THEN
		       BEGIN
			 CASE SY OF
			  %ID\	  IDENT:
					 BEGIN
					  SEARCHID([KONST,VARS,FIELD,FUNC],LCP);
					  INSYMBOL;
					   IF LCP^.KLASS = FUNC
					   THEN
					     BEGIN
					      CALL(FSYS,LCP);
					       IF LCP^.PFDECKIND=DECLARED
					       THEN
						 BEGIN
						  WITH LCP^,GATTR DO
						   BEGIN
						    TYPTR :=IDTYPE; KIND :=VARBL; PACKFG :=NOTPACK;
						    VRELBYTE := NO;
						    VLEVEL :=1; DPLMT :=2;
						    INDEXR := TOPP; INDBIT :=0;
						     IF TYPTR # NIL
						     THEN
						       IF TYPTR^.SIZE = 1
						       THEN LOAD(GATTR)
						   END
						 END
					     END
					   ELSE
					     IF LCP^.KLASS = KONST
					     THEN
					      WITH GATTR, LCP^ DO
					       BEGIN
						TYPTR := IDTYPE; KIND := CST;
						CVAL := VALUES
					       END
					     ELSE
					      SELECTOR(FSYS,LCP);
					   IF GATTR.TYPTR # NIL
					   THEN       %ELIM. SUBR. TYPES TO\
					    WITH GATTR, TYPTR^ DO	  %SIMPLIFY LATER TESTS\
					     IF FORM = SUBRANGE
					     THEN  TYPTR := RANGETYPE
					 END;
			  %CST\   INTCONST:
					    BEGIN
					     WITH GATTR DO
					      BEGIN
					       TYPTR := INTPTR; KIND := CST;
					       CVAL := VAL;
					      END;
					     INSYMBOL
					    END;
			  REALCONST:
				     BEGIN
				      WITH GATTR DO
				       BEGIN
					TYPTR := REALPTR; KIND := CST;
					CVAL := VAL
				       END;
				      INSYMBOL
				     END;
			  STRINGCONST:
				       BEGIN
					WITH GATTR DO
					 BEGIN
					  CONSTANT(FSYS,TYPTR,CVAL) ; KIND := CST ;
					 END;
				       END;
			  %(\	  LPARENT:
					   BEGIN
					    INSYMBOL; EXPRESSION(FSYS OR [RPARENT],ONREGC);
					     IF SY = RPARENT
					     THEN INSYMBOL
					     ELSE ERROR(152)
					   END;
			  % NOT \ NOTSY:
					 BEGIN
					  INSYMBOL; FACTOR(FSYS);
					   IF GATTR.TYPTR = BOOLPTR
					   THEN
					     BEGIN
					      LOAD(GATTR); MACRO3(411B%ANDCAI\,REGC,1)
					     END
					   ELSE
					     BEGIN
					      ERROR(359); GATTR.TYPTR := NIL
					     END;
					 END;
			  %[\	  LBRACK:
					  BEGIN
					   INSYMBOL; CSTPART := [ ]; VARPART := FALSE;
(* 110 - MOVED RANGEPART INITIALIZATION INSIDE LOOP *)
					   NEWZ(LSP,POWER);
					   WITH LSP^ DO
					    BEGIN
					     ELSET:=NIL; SIZE:= 2
					    END;
					    IF SY = RBRACK
					    THEN
					      BEGIN
					       WITH GATTR DO
						BEGIN
						 TYPTR:=LSP; KIND:=CST;
						 NEWZ(LVP,PSET); LVP^.PVAL := CSTPART; CVAL.VALP := LVP
						END;
					       INSYMBOL
					      END
					    ELSE
					      BEGIN
(* 110 - THIS ROUTINE LARGELY RECODED *)
(* AC usage in the following is documented at the end.  In order to provide
   any sanity at all, REGC has to be kept the same whatever the expression
   types found.  Since an expression will advance REGC in most cases, we
   have to be sure it gets advanced in others.  This means incrementregc
   for constants and LOAD otherwise.  We don't LOAD constants because if
   the other half of the range is also constant we will just remember it
   as constant and not do a load at all. *)
						LOOP
		(* RANGEPART IS FLAG: 1ST EXPRESSION IS VARIABLE *)
						 RANGEPART := FALSE;
						 INCREMENTREGC; INCREMENTREGC;  (* FIRST EXPR *)
						 EXPRESSION(FSYS OR [COMMA,RBRACK,COLON],ONFIXEDREGC);
						  IF GATTR.TYPTR # NIL
						  THEN
						    IF GATTR.TYPTR^.FORM # SCALAR
						    THEN
						      BEGIN
						       ERROR(461); GATTR.TYPTR := NIL
						      END
						    ELSE
						      IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR)
						      THEN
							BEGIN (* LOAD IF VAR, SAVE IN LRMIN IF CONST *)
							  IF GATTR.KIND = CST
							  THEN
							    BEGIN (* FIRST EXPR IS CONST *)
(* 127 - fix reversed AC's *)
							    INCREMENTREGC;
(* 137 - CHAR needs different test *)
							    IF (GATTR.CVAL.IVAL<0)
							      OR (GATTR.CVAL.IVAL>BASEMAX) AND (GATTR.TYPTR<>CHARPTR)
							      OR (GATTR.CVAL.IVAL>CHARMAX) AND (GATTR.TYPTR=CHARPTR)
							     THEN BEGIN ERROR(352) ; GATTR.CVAL.IVAL := 0 END;
							    IF GATTR.TYPTR=CHARPTR
							      THEN
(* 7 - TREAT LOWER CASE AS UPPER IN SETS *)
(* 105 - improve lower case mapping in sets *)
								GATTR.CVAL.IVAL := SETMAP[GATTR.CVAL.IVAL];
							    LRMIN := GATTR.CVAL.IVAL;
							    END
							  ELSE
							    BEGIN (* FIRST EXPR IS NOT A CONSTANT *)
							    RANGEPART := TRUE; (* SIGNAL VARIABLE *)
							    LOAD(GATTR);
(* 112 - range check sets *)
							    if runtmcheck
							      then begin
(* 137 - different range check for char *)
							      if gattr.typtr = charptr
								then macro3(307B%caig\,regc,charmax)
							        else macro3(307B%caig\,regc,basemax);
							      macro3(305B%caige\,regc,0);
							      support(errorinassignment)
							      end;
							    IF GATTR.TYPTR = CHARPTR
							       THEN BEGIN
(* 105 - improve lower case mapping in sets *)
								    macro4r(200B%MOVE\,regc,regc,setmapchain);
								    code.information[cix] := 'E';
								    setmapchain := ic-1;
								    END;
							     END;
							  IF SY <> COLON
							   THEN (* ONLY ONE EXPR *)
							    IF NOT RANGEPART
							     THEN (* CONSTANT *)
							      BEGIN
							      CSTPART := CSTPART OR [LRMIN];
(* 127 - fixed reversed AC's *)
							      REGC := REGC - 3;
							      END
							     ELSE (* ONE VARIABLE *)
							      BEGIN
							      IF GATTR.TYPTR = CHARPTR
								THEN CODE.INSTRUCTION[CIX].INSTR := 210B%MOVN\
							        ELSE MACRO3(210B%MOVN\,REGC,REGC);
							      REGC := REGC - 1;
							      MACRO3(515B%HRLZI\,REGC-1,400000B);
							      MACRO3(400B%SETZ\,REGC,0);
(* 105 - more improvements for lower case mapping *)
							      MACRO4(246B%LSHC\,REGC-1,REGC+1,0);
							      IF VARPART
							      THEN
								BEGIN
								 MACRO3(434B%IOR\,REGC-3,REGC-1);
								 MACRO3(434B%IOR\,REGC-2,REGC);
								 REGC := REGC-2;
								END
							      ELSE VARPART := TRUE;
							      GATTR.KIND := EXPR; GATTR.REG := REGC
							      END
							   ELSE (* RANGE *)
							    BEGIN
							    INSYMBOL;
							    EXPRESSION(FSYS OR [COMMA,RBRACK],ONFIXEDREGC);
							    IF GATTR.TYPTR <> NIL (* 2ND EXPR *)
							     THEN
							      IF GATTR.TYPTR^.FORM <> SCALAR
							       THEN BEGIN
							       ERROR(461);
							       GATTR.TYPTR := NIL
							       END
							       ELSE
								IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR)
								THEN
								 BEGIN
								 IF GATTR.KIND = CST
								   THEN BEGIN
(* 137 - different test for CHAR, fix AC mess *)
								   INCREMENTREGC;
								   IF (GATTR.CVAL.IVAL < 0)
								      OR (GATTR.CVAL.IVAL > BASEMAX) AND (GATTR.TYPTR<>CHARPTR)
								      OR (GATTR.CVAL.IVAL > CHARMAX) AND (GATTR.TYPTR=CHARPTR)
								     THEN BEGIN ERROR(352); GATTR.CVAL.IVAL := 0 END;
								   IF GATTR.TYPTR = CHARPTR
								     THEN GATTR.CVAL.IVAL := SETMAP[GATTR.CVAL.IVAL]
								   END
(* 137 - more AC confusion *)
								  ELSE LOAD(GATTR);
								 IF (GATTR.KIND = CST) AND (NOT RANGEPART)
								  THEN (* CONSTANT RANGE *)
								   BEGIN
								   WHILE(LRMIN <= GATTR.CVAL.IVAL) DO
								    BEGIN
								    CSTPART := CSTPART OR [LRMIN];
								    LRMIN := LRMIN+1
								    END;
(* 127 - fix reversed AC's *)
(* 137 - once again *)
								   REGC := REGC - 4
								   END
								  ELSE
								   BEGIN (* VARIABLE LIMITS ON RANGE *)
								   IF NOT RANGEPART (* FIRST PART IS CONSTANT *)
								    THEN
								     BEGIN (* SO NOT IN AC YET *)
(* 127 - fix reversed AC's *)
(* 137 - once again *)
								     MACRO3(201B%MOVEI\,REGC-1,LRMIN)
								     END;
								   if gattr.kind = cst  (* same for second *)
								     then macro3(201B%movei\,regc,gattr.cval.ival);
(* 112 - range check sets *)
(* 137 - different test needed for CHAR *)
								   if (gattr.kind <> cst) and runtmcheck
									then begin
									if gattr.typtr = charptr
									  then macro3(307B%caig\,regc,charmax)
									  else macro3(307B%caig\,regc,basemax);
									macro3(305B%caige\,regc,0);
									support(errorinassignment);
									end;
							           IF (GATTR.TYPTR=CHARPTR) AND (GATTR.KIND <> CST)
							            THEN BEGIN
(* 105 - improve lower case mapping in sets *)
								    macro4r(200B%MOVE\,regc,regc,setmapchain);
								    code.information[cix] := 'E';
								    setmapchain := ic-1;
								    END;
		(* HERE IS WHAT IS IN THE AC'S:
			REGC    - RH LIMIT
			REGC-1	- LH LIMIT
			REGC-2  - DOUBLE WORD OF BITS
			REGC-3         "
		*)
								   MACRO3(477B%SETOB\,REGC-3,REGC-2);
								   MACRO4(246B%LSHC\,REGC-3,REGC-1,0);
								   MACRO3(275B%SUBI\,REGC,71);
								   MACRO3(210B%MOVN\,REGC,REGC);
								   MACRO3(270B%ADD\,REGC-1,REGC);
								   MACRO3(210B%MOVN\,REGC-1,REGC-1);
								   MACRO4(246B%LSHC\,REGC-3,REGC-1,0);
								   MACRO4(246B%LSHC\,REGC-3,REGC,0);
								   REGC := REGC -2;
							           IF VARPART
							            THEN
								     BEGIN
								     MACRO3(434B%IOR\,REGC-3,REGC-1);
								     MACRO3(434B%IOR\,REGC-2,REGC);
								     REGC := REGC-2;
								     END
							            ELSE VARPART := TRUE;
							           GATTR.KIND := EXPR; GATTR.REG := REGC
							           END
								 END
							    END;
							 LSP^.ELSET := GATTR.TYPTR;
							 GATTR.TYPTR :=LSP
							END
						      ELSE ERROR(360);
						EXIT IF NOT(SY IN [COMMA]);
						 INSYMBOL
						END;
						IF SY = RBRACK
						THEN INSYMBOL
						ELSE ERROR(155);
						IF VARPART
						THEN
						  BEGIN
						    IF CSTPART # [ ]
						    THEN
						      BEGIN
(* 34 - BUG FIX FROM HAMBURG - NEEDED FOR PROGSTAT *)
							NEW(LVP,PSET);LVP^.PVAL := CSTPART;
							GATTR.KIND:=CST; GATTR.CVAL.VALP := LVP;
							MAKECODE(434B%IOR\,REGC,GATTR)
						      END
						  END
						ELSE
						  BEGIN
						   NEWZ(LVP,PSET); LVP^.PVAL := CSTPART; GATTR.CVAL.VALP := LVP
						  END
					      END;
					  END
			 END %CASE\ ;
			IFERRSKIP(166,FSYS)
		       END;
		      %IF SY IN FACBEGSYS\
		   END %FACTOR\ ;

		 BEGIN
		  %TERM\
		  FACTOR(FSYS OR [MULOP]);
		  WHILE SY = MULOP DO
		   BEGIN
		     IF OP IN [RDIV,IDIV,IMOD]
		     THEN LOAD(GATTR);	%BECAUSE OPERANDS ARE NOT
					 ALLOWED TO BE CHOSEN\
		    LATTR := GATTR; LOP := OP;
		    INSYMBOL; FACTOR(FSYS OR [MULOP]);
		     IF (LATTR.TYPTR # NIL) AND (GATTR.TYPTR # NIL)
		     THEN
		       CASE LOP OF
			%*\	  MUL:
				       IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR)
				       THEN SEARCHCODE(220B%IMUL\,LATTR)
(* 21 - * with sets is and *)
				       ELSE IF (LATTR.TYPTR^.FORM=POWER) AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
					 THEN SEARCHCODE(404B%AND\,LATTR)
				       ELSE
					 BEGIN
					  MAKEREAL(LATTR);
					   IF (LATTR.TYPTR = REALPTR)
					    AND (GATTR.TYPTR = REALPTR)
					   THEN SEARCHCODE(164B%FMPR\,LATTR)
					   ELSE
					     BEGIN
					      ERROR(311); GATTR.TYPTR := NIL
					     END
					 END;
			%/\	  RDIV:
					BEGIN
					 MAKEREAL(LATTR);
					  IF (LATTR.TYPTR = REALPTR)
					   AND (GATTR.TYPTR = REALPTR)
					  THEN SEARCHCODE(174B%FDVR\,LATTR)
					  ELSE
					    BEGIN
					     ERROR(311); GATTR.TYPTR := NIL
					    END
					END;
			%DIV\	  IDIV:
					IF (LATTR.TYPTR = INTPTR)
					 AND (GATTR.TYPTR = INTPTR)
					THEN SEARCHCODE(230B%IDIV\,LATTR)
					ELSE
					  BEGIN
					   ERROR(311); GATTR.TYPTR := NIL
					  END;
			%MOD\	  IMOD:
					IF (LATTR.TYPTR = INTPTR)
					 AND (GATTR.TYPTR = INTPTR)
					THEN
					  BEGIN
					   SEARCHCODE(230B%IDIV\,LATTR);GATTR.REG := GATTR.REG+1
					  END
					ELSE
					  BEGIN
					   ERROR(311); GATTR.TYPTR := NIL
					  END;
			% AND \  ANDOP:
					IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
					 AND ( (LATTR.TYPTR^.FORM = POWER) OR (GATTR.TYPTR = BOOLPTR) )
					THEN SEARCHCODE(404B%AND\,LATTR)
					ELSE
					  BEGIN
					   ERROR(311); GATTR.TYPTR := NIL
					  END
		       END %CASE\
		     ELSE GATTR.TYPTR := NIL;
		    REGC:=GATTR.REG
		   END %WHILE\
		 END %TERM\ ;

	       BEGIN
		%SIMPLEEXPRESSION\
		SIGNED := FALSE;
		 IF (SY = ADDOP) AND (OP IN [PLUS,MINUS])
		 THEN
		   BEGIN
		    SIGNED := OP = MINUS; INSYMBOL
		   END;
		TERM(FSYS OR [ADDOP]);
		 IF SIGNED
		 THEN WITH GATTR DO
		   IF TYPTR # NIL
		   THEN
		     IF (TYPTR = INTPTR) OR (TYPTR = REALPTR)
		     THEN
		       IF KIND = CST
		       THEN
			 IF TYPTR = INTPTR
			 THEN CVAL.IVAL := - CVAL.IVAL
(* 52 - have to put negated value in new place, since old one might be a CONST declaration used elsewhere *)
			 ELSE
			   BEGIN
			   NEW(NEWREALCSP);
			   NEWREALCSP^.CCLASS := REEL;
			   NEWREALCSP^.RVAL := -CVAL.VALP^.RVAL;
			   CVAL.VALP := NEWREALCSP
			   END
		       ELSE
			 BEGIN
			  LOAD(GATTR) ;
			  WITH CODE, INSTRUCTION[CIX] DO
			   IF INSTR=200B%MOVE\
			   THEN INSTR := 210B%MOVN\
			   ELSE MACRO3(210B%MOVN\,GATTR.REG,GATTR.REG)
			 END
		     ELSE
		       BEGIN
			ERROR(311) ; GATTR.TYPTR := NIL
		       END ;
		WHILE SY = ADDOP DO
		 BEGIN
		   IF OP=MINUS
		   THEN LOAD(GATTR); %BECAUSE OPD MAY NOT BE CHOSEN\
		  LATTR := GATTR; LOP := OP;
		  INSYMBOL; TERM(FSYS OR [ADDOP]);
		   IF (LATTR.TYPTR # NIL) AND (GATTR.TYPTR # NIL)
		   THEN
		     CASE LOP OF
		      %+\	PLUS:
				      IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR)
				      THEN
				       SEARCHCODE(270B%ADD\,LATTR)
(* 21 - ALLOW + AS SET UNION *)
				      ELSE IF(LATTR.TYPTR^.FORM=POWER) AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
					THEN SEARCHCODE(434B%IOR\,LATTR)
				      ELSE
					BEGIN
					 MAKEREAL(LATTR);
					  IF (LATTR.TYPTR = REALPTR) AND (GATTR.TYPTR = REALPTR)
					  THEN SEARCHCODE(144B%FADR\,LATTR)
					  ELSE
					    BEGIN
					     ERROR(311); GATTR.TYPTR := NIL
					    END
					END;
		      %-\	MINUS:
				       IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR)
				       THEN
					SEARCHCODE(274B%SUB\,LATTR)
(* 21 - ALLOW - AS SET DIFFERENCE *)
				       ELSE IF (LATTR.TYPTR^.FORM = POWER) AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
					 THEN SEARCHCODE(420B%ANDCM\,LATTR)
				       ELSE
					 BEGIN
					  MAKEREAL(LATTR);
					   IF (LATTR.TYPTR = REALPTR) AND (GATTR.TYPTR = REALPTR)
					   THEN SEARCHCODE(154B%FSBR\,LATTR)
					   ELSE
					     IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
					      AND (LATTR.TYPTR^.FORM = POWER)
					     THEN SEARCHCODE(420B%ANDCM\,LATTR)
					     ELSE
					       BEGIN
						ERROR(311); GATTR.TYPTR := NIL
					       END
					 END;
		      % OR \	OROP:
				      IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
				       AND ( (GATTR.TYPTR = BOOLPTR) OR (LATTR.TYPTR^.FORM = POWER) )
				      THEN SEARCHCODE(434B%IOR\,LATTR)
				      ELSE
					BEGIN
					 ERROR(311); GATTR.TYPTR := NIL
					END
		     END %CASE\
		   ELSE GATTR.TYPTR := NIL;
		  REGC:=GATTR.REG
		 END %WHILE\
	       END %SIMPLEEXPRESSION\ ;

	     BEGIN
	      %EXPRESSION\
	      TESTREGC := REGC+1;
	      SIMPLEEXPRESSION(FSYS OR [RELOP]);
	       IF SY = RELOP
	       THEN
		 BEGIN
		   IF FVALUE IN [ONREGC,ONFIXEDREGC]
		   THEN
		     BEGIN
		      INCREMENTREGC; MACRO3(201B%MOVEI\,REGC,1); BOOLREGC := REGC
		     END;
		   IF GATTR.TYPTR # NIL
		   THEN
(* 24 - STRING IS ONLY STRUCTURE ALLOWED *)
		     IF STRING(GATTR.TYPTR)
		     THEN LOADADDRESS; LREGC1 := REGC;
		  LATTR := GATTR; LOP := OP;
		   IF (FVALUE IN [ONREGC,ONFIXEDREGC]) AND (REGC < BOOLREGC)
		   THEN REGC := BOOLREGC;
		  INSYMBOL; SIMPLEEXPRESSION(FSYS);
		   IF GATTR.TYPTR # NIL
		   THEN
(* 24 - STRING IS ONLY STRUCTURE ALLOWED *)
		     IF STRING(GATTR.TYPTR)
		     THEN LOADADDRESS; LREGC2 := REGC;
		   IF (LATTR.TYPTR # NIL) AND (GATTR.TYPTR # NIL)
		   THEN
		     BEGIN
		       IF LOP = INOP
		       THEN
			 IF GATTR.TYPTR^.FORM = POWER
			 THEN
			   IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR^.ELSET)
			   THEN
			     BEGIN
			      LOAD(LATTR);
			       IF (FVALUE IN [ONREGC,ONFIXEDREGC]) AND (REGC < BOOLREGC)
			       THEN REGC := BOOLREGC;
			      LOAD(GATTR); REGC := GATTR.REG - 1;
			       IF LATTR.TYPTR=CHARPTR
			       THEN
(* 7 - TREAT LOWER CASE AS UPPER IN SETS *)
				BEGIN
(* 105 - improve lower case mapping in sets *)
				macro4r(200B%move\,lattr.reg,lattr.reg,setmapchain);
				code.information[cix] := 'E';
				setmapchain := ic-1;
				END;
			      MACRO4(246B%LSHC\,REGC,LATTR.REG,0);
			       IF FVALUE = TRUEJMP
			       THEN LINSTR := 305B%CAIGE\
			       ELSE LINSTR := 301B%CAIL\;
			      MACRO3(LINSTR,REGC,0);
			     END
			   ELSE
			     BEGIN
			      ERROR(260); GATTR.TYPTR := NIL
			     END
			 ELSE
			   BEGIN
			    ERROR(213); GATTR.TYPTR := NIL
			   END
		       ELSE
			 BEGIN
			   IF LATTR.TYPTR # GATTR.TYPTR
			   THEN
			    MAKEREAL(LATTR);
			   IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
			   THEN
			     BEGIN
			      LSIZE := LATTR.TYPTR^.SIZE;
			       CASE LATTR.TYPTR^.FORM OF
				POINTER:
					 IF LOP IN [LTOP,LEOP,GTOP,GEOP]
					 THEN ERROR (312);
				POWER:
				       IF LOP IN [LTOP,GTOP]
				       THEN ERROR(313);
				ARRAYS:
					IF  NOT STRING(LATTR.TYPTR)
(* 24 - STRING IS ONLY STRUCT. ALLOWED *)
					THEN ERROR(312);
				RECORDS,
				FILES:
				      ERROR(314)
			       END;
			      WITH LATTR.TYPTR^ DO
			       BEGIN
				    DEFAULT := TRUE; LOFFSET := 3; SETINCLUSION := FALSE;
				     CASE LOP OF
				      LTOP:
					    BEGIN
					     LINSTR := 311B%CAML\; LINSTR1 := 313B
					    END;
				      LEOP:
					    IF FORM = POWER
					    THEN
					      BEGIN
					       SEARCHCODE(420B%ANDCM\,LATTR);
					       SETINCLUSION := TRUE
					      END
					    ELSE
					      BEGIN
					       LINSTR := 313B%CAMLE\; LINSTR1 := 313B
					      END;
				      GTOP:
					    BEGIN
					     LINSTR := 317B%CAMG\; LINSTR1 := 315B
					    END;
				      GEOP:
					    IF FORM = POWER
					    THEN
					      BEGIN
					       SEARCHCODE(410B%ANDCA\,LATTR);
					       SETINCLUSION := TRUE
					      END
					    ELSE
					      BEGIN
					       LINSTR := 315B%CAMGE\; LINSTR1 := 315B
					      END;
				      NEOP:
					    BEGIN
					     LINSTR := 316B%CAMN\;DEFAULT := FALSE
					    END;
				      EQOP:
					    BEGIN
					     LINSTR := 312B%CAME\; DEFAULT := FALSE; LOFFSET := 2
					    END
				     END;
				     IF FVALUE = TRUEJMP
				     THEN CHANGEBOOL(LINSTR);
(* 24 - STRING IS ONLY STRUCTURE *)
				   IF FORM#ARRAYS THEN BEGIN
				     IF SIZE = 1
				     THEN SEARCHCODE(LINSTR,LATTR)
				     ELSE
				       IF SETINCLUSION
				       THEN
					 BEGIN
					  MACRO3(336B%SKIPN\,0,GATTR.REG);
					  MACRO3(332B%SKIPE\,0,GATTR.REG-1);
					   IF FVALUE = TRUEJMP
					   THEN
					    MACRO3R(254B%JRST\,0,IC+2)
					 END
				       ELSE
					 BEGIN
					  LOAD(LATTR);
					   IF (FVALUE IN [ONREGC,ONFIXEDREGC]) AND (REGC<BOOLREGC)
					   THEN
					    REGC := BOOLREGC;
					  LOAD(GATTR);
					   IF DEFAULT
					   THEN
					     BEGIN
					      MACRO3(LINSTR1,LATTR.REG-1,GATTR.REG-1);
					      MACRO3R(254B%JRST\,0,IC+4)	  %FALSE\
					     END;
					  MACRO3(312B%CAME\,LATTR.REG-1,GATTR.REG-1);
					  MACRO3R(254B%JRST\,0,IC+LOFFSET);
					  MACRO3(LINSTR,LATTR.REG,GATTR.REG)
					 END
				   END
				 ELSE
(* 24 - THIS CODE IS NOW ONLY FOR STRINGS *)
				   BEGIN (*STRING*)
				   GETBOUNDS(INXTYPE,LOFFSET,LSIZE);
				   LSIZE:=LSIZE-LOFFSET+1;
(* 40 - fix this code for unpacked strings, too *)
				 if arraypf
				  then begin
				   LOFFSET:=(LSIZE MOD 5)*700B;
				   LSIZE:=LSIZE DIV 5;
				   end
				  else loffset:=0;
				   IF (LSIZE=0) AND (LOFFSET=0)
				     THEN MACRO3(403B%SETZB\,TAC,HAC)
				   ELSE IF (LSIZE=0)
				     THEN BEGIN
				     MACRO3(505B%HRLI\,LREGC1,LOFFSET+440000B);
				     MACRO3(505B%HRLI\,LREGC2,LOFFSET+440000B);
				     MACRO3(134B%ILDB\,TAC,LREGC1);
				     MACRO3(134B%ILDB\,HAC,LREGC2)
				     END
				   ELSE
				     BEGIN
(* 40 - fix for nonpacked arrays *)
				   if arraypf
				    then begin
				     MACRO3(505B%HRLI\,LREGC1,444300B);
				     MACRO3(505B%HRLI\,LREGC2,444300B);
				     end
				    else begin
				     macro3(505b%hrli\,lregc1,444400b);
				     macro3(505b%hrli\,lregc2,444400b)
				     end;
				     INCREMENTREGC;
				     IF LSIZE > 1
					THEN MACRO3(201B%MOVEI\,REGC,LSIZE);
				     MACRO3(134B%ILDB\,TAC,LREGC1);
				     MACRO3(134B%ILDB\,HAC,LREGC2);
				     IF (LOFFSET=0)
				       THEN BEGIN
				       IF LSIZE>1
					 THEN BEGIN
					 MACRO3(316B%CAMN\,TAC,HAC);
					 MACRO3R(367B%SOJG\,REGC,IC-3)
					 END
				       END
				      ELSE %OFFSET NOT 0\ BEGIN
				       MACRO3(312B%CAME\,TAC,HAC);
				       IF LSIZE>1
					 THEN BEGIN
					 MACRO3R(254B%JRST\,0,IC+6);
					 MACRO3R(367B%SOJG\,REGC,IC-4)
					 END
				        ELSE MACRO3R(254B%JRST\,0,IC+5);
				       MACRO3(505B%HRLI\,LREGC1,LOFFSET);
				       MACRO3(505B%HRLI\,LREGC2,LOFFSET);
				       MACRO3(134B%ILDB\,TAC,LREGC1);
				       MACRO3(134B%ILDB\,HAC,LREGC2)
				       END;
				     REGC:=REGC-1
				     END;
				   MACRO3(LINSTR,TAC,HAC);
				    REGC:=REGC-2
				   END
			       END
			     END
			   ELSE ERROR(260)
			 END;
		       IF FVALUE IN [ONREGC,ONFIXEDREGC]
		       THEN
			 BEGIN
			  MACRO3(400B%SETZ\,BOOLREGC,0); REGC := BOOLREGC
			 END
		       ELSE MACRO3(254B%JRST\,0,0);
		     END;
		    %(IF LATTR.TYPTR#NIL) AND (GATTR.TYPTR#NIL) THEN \
		  GATTR.TYPTR := BOOLPTR; GATTR.KIND := EXPR; GATTR.REG := REGC
		 END %SY = RELOP\
	       ELSE
		 IF FVALUE IN [TRUEJMP,FALSEJMP]
		 THEN
		   BEGIN
		    LOAD(GATTR);
		     IF GATTR.TYPTR#BOOLPTR
		     THEN ERROR (359);
		     IF FVALUE = TRUEJMP
		     THEN LINSTR := 326B%JUMPN\
		     ELSE LINSTR := 322B%JUMPE\;
		    MACRO3(LINSTR,GATTR.REG,0)
		   END
		 ELSE
		   IF GATTR.KIND=EXPR
		   THEN REGC := GATTR.REG;
	       IF GATTR.TYPTR # NIL
	       THEN
		WITH GATTR,TYPTR^ DO
(* 141 - fix bollixed AC allocation in complex array calculations *)
(* 143 - fixed code below for Tops-10 packed arrays *)
{Warning to modifiers:  the following code depends upon the register
 allocation in MAKECODE for the case where opcode=MOVE, and in
 LOADADDRESS.  Please be sure to keep them consistent!}
{Onfixedregc means we are in a context where the result has to go in
 a particular AC.  So if we had a complex calculation that ended up
 with it in a higher AC, we have to move it down.  That is for
 KIND=EXPR.  For KIND=CST or VARBL (the only other cases), we have
 to make sure REGC was not changed, as the caller will expect that.
 It could be changed by an array with a complex subscript calculation.
 Note that we in the case KIND=VARBL we may leave AC's set up with
 info needed to access arrays (in the fieldS INDEXR and/or BPADDR).
 So in that case this amounts to second-guessing LOAD and MAKECODE
 to make sure that whichever place the result will be loaded
 (usually INDEXR or BPADDR) is pointing to the fixed AC.}

		 IF FVALUE = ONFIXEDREGC
		 THEN
		   BEGIN
		     IF KIND=EXPR
		       THEN BEGIN
		       IF SIZE = 2
		         THEN TESTREGC := TESTREGC + 1;
		       IF TESTREGC # REGC
		         THEN BEGIN
		         IF SIZE = 2
			   THEN MACRO3(200B%MOVE\,TESTREGC-1,REGC-1);
		         MACRO3(200B%MOVE\,TESTREGC,REGC);
		         REG := TESTREGC; REGC := TESTREGC;
		         END
		       END
		     ELSE IF KIND=VARBL
		       THEN BEGIN
		       IF (PACKFG = PACKK) AND (BPADDR>REGIN) AND (BPADDR<=REGCMAX)
			 THEN IF (INDEXR <= REGIN) OR (BPADDR<INDEXR)
				THEN IF BPADDR<> TESTREGC
				       THEN BEGIN
				       MACRO3(200B%MOVE\,TESTREGC,BPADDR);
				       BPADDR := TESTREGC
				       END
				      ELSE
				ELSE IF INDEXR<>TESTREGC
				       THEN BEGIN
				       MACRO3(200B%MOVE\,TESTREGC,INDEXR);
				       INDEXR := TESTREGC
				       END
				      ELSE
		       ELSE IF (INDEXR>REGIN) AND (INDEXR<=REGCMAX) AND (INDEXR<>TESTREGC)
			 THEN BEGIN
			 MACRO3(200B%MOVE\,TESTREGC,INDEXR);
			 INDEXR := TESTREGC
			 END;
		       REGC := TESTREGC - 1;
		       END
		     ELSE REGC := TESTREGC-1
		   END
	     END %EXPRESSION\ ;

	    PROCEDURE ASSIGNMENT(FCP: CTP);
	    VAR
	      LATTR,SLATTR: ATTR;
	      SRMIN,SRMAX: INTEGER;

	      PROCEDURE STOREGLOBALS ;
	      TYPE
		WANDELFORM = (PTRW,INTW,REELW,PSETW,STRGW,INSTW) ;
	      VAR
		WANDEL : RECORD
			   CASE KW : WANDELFORM OF
				PTRW: (WPTR :GTP %TO ALLOW NIL\) ;
				INTW: (WINT : INTEGER ; WINT1 : INTEGER %TO PICK UP SECOND WORD OF SET\) ;
				REELW: (WREEL: REAL) ;
				PSETW: (WSET : SET OF 0..71) ;
				STRGW: (WSTRG: CHARWORD) ;
				INSTW: (WINST: PDP10INSTR)
			 END ;
		I,J : INTEGER ;
		PROCEDURE STOREWORD ;
		 BEGIN
		  CIX := CIX + 1 ;
		   IF CIX > CIXMAX
		   THEN
		     BEGIN
		      CIX := 0 ; ERRORWITHTEXT(356,'INITPROCD.')
		     END ;
		  WITH CGLOBPTR^ DO
		   BEGIN
		    CODE.INSTRUCTION[CIX] := WANDEL.WINST ;
		    LASTGLOB := LASTGLOB + 1 ;
		   END ;
		 END ;
		PROCEDURE GETNEWGLOBPTR ;
		VAR
		  LGLOBPTR : GTP ;
		 BEGIN
		  NEWZ(LGLOBPTR) ;
		  WITH LGLOBPTR^ DO
		   BEGIN
		    NEXTGLOBPTR := NIL ;
		    FIRSTGLOB	:= 0 ;
		   END ;
		   IF CGLOBPTR # NIL
		   THEN CGLOBPTR^.NEXTGLOBPTR := LGLOBPTR ;
		  CGLOBPTR := LGLOBPTR ;
		 END;
	       BEGIN
		%STOREGLOBALS\
		 IF FGLOBPTR = NIL
		 THEN
		   BEGIN
		    GETNEWGLOBPTR ;
		    FGLOBPTR := CGLOBPTR ;

		   END
		 ELSE
		   IF LATTR.DPLMT # CGLOBPTR^.LASTGLOB + 1
		   THEN GETNEWGLOBPTR ;
		WITH WANDEL,CGLOBPTR^,GATTR,CVAL DO
		 BEGIN
		   IF FIRSTGLOB = 0
		   THEN
		     BEGIN
		      FIRSTGLOB := LATTR.DPLMT ;
		      LASTGLOB := FIRSTGLOB - 1 ;
		      FCIX := CIX + 1 ;
		     END ;
		   CASE TYPTR^.FORM OF
		    SCALAR,
		    SUBRANGE:
		      BEGIN
(* 174 30-Sep-80 Andy Hisgen, CMU,  Problems with xreal:=xinteger, 
   				    and with subranges.
The lines below used to read --
	        IF TYPTR = REALPTR
		THEN
		  IF LATTR.TYPTR=INTPTR
		  THEN WREEL := IVAL
		  ELSE WREEL := VALP^.RVAL
		ELSE WINT  := IVAL ;
Unfortunately, that was testing to see if the RightHandSide (GATTR) was
a real, and if so doing weird things.  For example, that let the
assignment "x:=2", where x is a real, go thru, but without doing
any conversion, thus x contained the bit pattern for the integer 2.
The problem here seems to have been that the roles of LATTR and
GATTR got reversed in the coder's mind.  Below, we have reversed
them back.
    A second unrelated problem was that subrange checking was not
being done.  In the code below, we now handle this.
*)
				IF lattr.typtr = realptr
				THEN
				  IF gattr.typtr = intptr
				  THEN WREEL := IVAL
				  ELSE WREEL := VALP^.RVAL
				ELSE BEGIN (*left isn't real*)
				      IF lattr.typtr^.form = subrange
				      THEN
					BEGIN (*left is subrange*)
					 getBounds(lattr.typtr,srmin,srmax);
					 IF NOT( (srmin <= ival) AND
					         (ival <= srmax) )
					 THEN error(367);
					END; (*left is subrange*)
				      WINT := IVAL;
				     END; (*left isn't real*)
(*30-Sep-80 end of changes for xreal:=integer and for subranges*)

			       STOREWORD ;
			      END ;
		    POINTER:
			     BEGIN
			      WPTR := NIL ; STOREWORD
			     END ;
		    POWER   :
			      BEGIN
			       WSET := VALP^.PVAL ; STOREWORD ;
			       WINT := WINT1 %GET SECOND WORD OF SET\ ;
			       STOREWORD ;
			      END ;
		    ARRAYS   : WITH VALP^,WANDEL DO
			       BEGIN
				J := 0; WINT := 0;
				FOR I := 1 TO SLGTH DO
				 BEGIN
				  J := J + 1;
				  WSTRG[J] := SVAL[I];
				   IF J=5
				   THEN
				     BEGIN
				      J := 0;
				      STOREWORD; WINT := 0
				     END
				 END;
				 IF J#0
				 THEN STOREWORD
			       END;

		    RECORDS,
		    FILES    :	ERROR(411)
		   END %CASE\ ;
		 END % WITH \ ;
	       END % STOREGLOBALS \ ;

	     BEGIN
	      %ASSIGNMENT\
	      SELECTOR(FSYS OR [BECOMES],FCP);
	       IF SY = BECOMES
	       THEN
		 BEGIN
		  LATTR := GATTR;
		  INSYMBOL;
		  EXPRESSION(FSYS,ONREGC);
		   IF (LATTR.TYPTR # NIL) AND (GATTR.TYPTR # NIL)
		   THEN
		     IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) OR
		      (REALPTR=LATTR.TYPTR) AND (GATTR.TYPTR=INTPTR)
		     THEN
		       IF INITGLOBALS
		       THEN
			 IF GATTR.KIND = CST
			 THEN STOREGLOBALS
			 ELSE ERROR(504)
		       ELSE
			 IF (GATTR.KIND=CST) AND (GATTR.CVAL.IVAL=0)
			  AND (LATTR.PACKFG=NOTPACK)
			 THEN
			   BEGIN
			    FETCHBASIS(LATTR);
			    WITH LATTR DO
			     BEGIN
(* 104 - check subranges *)
			      if lattr.typtr^.form = subrange
				then begin
				getbounds(lattr.typtr,srmin,srmax);
				if (0 < srmin) or (0 > srmax)
				  then error(367)
				end;
			      MACRO(VRELBYTE,402B%SETZM\,0,INDBIT,INDEXR,DPLMT)
			     END
			   END
			 ELSE
			   CASE LATTR.TYPTR^.FORM OF
			    SCALAR,
			    POINTER,
			    POWER:
				   BEGIN
				    LOAD(GATTR);
				     IF COMPTYPES(REALPTR,LATTR.TYPTR) AND (GATTR.TYPTR=INTPTR)
				     THEN
				      MAKEREAL(GATTR);
				    STORE(GATTR.REG,LATTR)
				   END;
			    SUBRANGE:
				      BEGIN
(* 104 - moved code into procedure for use elsewhere *)
				       loadsubrange(gattr,lattr.typtr);
				       STORE(GATTR.REG,LATTR)
				      END;

			    ARRAYS,
			    RECORDS:
(* 201 - zero size objects *)
				     IF GATTR.TYPTR^.SIZE = 0
				      THEN
				     ELSE IF GATTR.TYPTR^.SIZE = 1
				      THEN
				       BEGIN
					LOAD(GATTR) ; STORE(GATTR.REG,LATTR)
				       END
				     ELSE WITH LATTR DO
				       BEGIN
					LOADADDRESS ;
					CODE.INSTRUCTION[CIX].INSTR := 505B%HRLI\ ;
					FETCHBASIS(LATTR);
					MACRO(VRELBYTE,541B%HRRI\,REGC,INDBIT,INDEXR,DPLMT) ;
					 IF INDBIT=0
					 THEN MACRO5(VRELBYTE,251B%BLT \,REGC,INDEXR,DPLMT+TYPTR^.SIZE-1)
					 ELSE
					   BEGIN
					    INCREMENTREGC ;
					    MACRO3(200B%MOVE\,REGC,REGC-1);
					    MACRO4(251B%BLT \,REGC,REGC-1,TYPTR^.SIZE-1)
					   END;
				       END;
			    FILES: ERROR(361)
			   END
		     ELSE ERROR(260)
		 END %SY = BECOMES\
	       ELSE ERROR(159);
	     END %ASSIGNMENT\ ;

	    PROCEDURE GOTOSTATEMENT;
	    VAR
(* 64 - non-local gotos *)
(* 65 - remove exit labels *)
	      I,J,JJ:INTEGER; lcp:ctp;
	     BEGIN
		 IF SY = INTCONST
		 THEN
		   BEGIN
		    prterr := false;
		    searchid([labelt],lcp);
		    prterr := true;
		    if lcp # nil
		      then with lcp^ do
(* See if the goto is out of the current block.  If so, handle
 specially, since we have to restore the basis and topp.  Except
 for the global level, we recover the basis by tracing the static
 links.  Then we arranged for topp's RH to be stored in the LH
 of word 0 of the display.  Global labels are odd because the
 static link will be 0.  So the global topp and basis are stored
 in special variables. *)
(* 173 - As of this edit, we have to call GOTOC. in order to
 close files in the blocks exited.  In order to prevent problems
 if we are interrupted while this is happening, we can't really
 change BASIS or TOPP until after the files are closed, else we
 might be trying to close a file whose control block is above TOPP.
 So we REGC is the new BASIS and REGC+1 is the new TOPP *)
		        if scope # level
			  then begin
			  incrementregc;
			  if scope = 1
			    then begin
			    macro3r(200B%move\,regc,globbasis);
			    macro3r(200B%move\,regc+1,globtopp)
			    end
			   else begin
			    macro4(504B%hrl\,regc,basis,-1);
			    macro3(544B%hlr\,regc,regc);
			    for i := scope to level - 2 do
			      macro4(507B%hrls\,regc,regc,-1);
			    macro4(544B%hlr\,regc+1,regc,0);
			    macro3(504B%hrl\,regc+1,regc+1);
			    end;
(* 75 - following was macro3 due to typo *)
			  macro3r(201B%movei\,regc+2,gotochain);
			  gotochain := ic-1;
			  code.information[cix] := 'F';
			  nonlocgoto := true;
			  support(exitgoto);
			  goto 2
			  end;
		    FOR I:=1 TO LIX DO
		     BEGIN
		      WITH LABELS[I] DO
		       IF LABSVAL = VAL.IVAL
		       THEN
			 BEGIN
			  MACRO3R(254B%JRST\,0,LABSADDR);
			  GOTO 2
			 END
		     END;
		    MACRO3(254B%JRST\,0,0);
		    FOR I:=1 TO JIX DO
		     BEGIN
		      WITH GOTOS[I] DO
		       IF GOTOVAL = VAL.IVAL
		       THEN
			 BEGIN
			  J:= CODE.INSTRUCTION[GOTOADDR].ADDRESS;
			  JJ:= GOTOADDR;
			  WHILE J#0 DO
			   BEGIN
			    JJ:=J;
			    J:= CODE.INSTRUCTION[J].ADDRESS
			   END;
			  INSERTADDR(NO,JJ,CIX);
			  GOTO 2
			 END
		     END;
		    FOR I:=1 TO JIX DO
		     BEGIN
		      WITH GOTOS[I] DO
		       IF GOTOVAL = -1
		       THEN
			 BEGIN
			  GOTOVAL:=VAL.IVAL;
			  GOTOADDR:=CIX;
			  GOTO 2
			 END
		     END;
		    JIX :=JIX+1;
		     IF JIX > LABMAX
		     THEN
		       BEGIN
			ERROR(362);
			JIX := LABMAX
		       END;
		    WITH GOTOS[JIX] DO
		     BEGIN
		      GOTOVAL := VAL.IVAL;
		      GOTOADDR:=CIX
		     END;
2:
		    INSYMBOL
		   END
		 ELSE ERROR(255)
	     END %GOTOSTATEMENT\ ;

	    PROCEDURE COMPOUNDSTATEMENT;
	     BEGIN
	       LOOP
		 REPEAT
		  STATEMENT(FSYS,STATENDS)
		 UNTIL	NOT (SY IN STATBEGSYS);
	       EXIT IF SY # SEMICOLON;
		INSYMBOL
	       END;
	       IF SY = ENDSY
	       THEN INSYMBOL
	       ELSE ERROR(163)
	     END %COMPOUNDSTATEMENET\ ;

	    PROCEDURE IFSTATEMENT;
	    VAR
	      LCIX1,LCIX2: CODERANGE;
	     BEGIN
	      EXPRESSION(FSYS OR [THENSY],FALSEJMP);
	      LCIX1 := CIX;
	       IF SY = THENSY
	       THEN INSYMBOL
	       ELSE ERROR(164);
	      STATEMENT(FSYS OR [ELSESY],STATENDS OR [ELSESY]);
	       IF SY = ELSESY
	       THEN
		 BEGIN
		  MACRO3(254B%JRST\,0,0); LCIX2 := CIX;
		  INSERTADDR(RIGHT,LCIX1,IC);
		  INSYMBOL; STATEMENT(FSYS,STATENDS);
		  INSERTADDR(RIGHT,LCIX2,IC)
		 END
	       ELSE INSERTADDR(RIGHT,LCIX1,IC)
	     END %IFSTATEMENT\ ;

	    PROCEDURE CASESTATEMENT;
	    TYPE
	      CIP = ^CASEINFO;
	      CASEINFO = PACKED
	      RECORD
		NEXT: CIP;
		CSSTART: ADDRRANGE;
		CSEND: CODERANGE;
		CSLAB: INTEGER
	      END;
	    VAR
	      LSP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3,OTHERSPTR: CIP; LVAL: VALU;
	      LIC,LADDR,JUMPADDR: ADDRRANGE; LCIX: CODERANGE; LMIN,LMAX: INTEGER;

	      PROCEDURE INSERTBOUND(FCIX:CODERANGE;FIC: ADDRRANGE;BOUND:INTEGER);
	      VAR
		LCIX1:CODERANGE; LIC1: ADDRRANGE;
		LATTR:ATTR;
	       BEGIN
		 IF BOUND>=0
		 THEN INSERTADDR(NO,FCIX,BOUND)
		 ELSE
		   BEGIN
		    LCIX1:=CIX; LIC1 := IC;
		    CIX:=FCIX; IC := FIC;
		    WITH LATTR DO
		     BEGIN
		      KIND:=CST;
		      CVAL.IVAL:=BOUND;
		      TYPTR:=NIL
		     END;
		    DEPCST(INT,LATTR);
		    CIX:=LCIX1; IC:= LIC1;
		    WITH CODE.INSTRUCTION[FCIX] DO
		    INSTR:=INSTR+10B  %CAILE-->CAMLE, CAIL-->CAML\
		   END
	       END;

	     BEGIN
	      OTHERSPTR:=NIL;
	      EXPRESSION(FSYS OR [OFSY,COMMA,COLON],ONREGC);
	      LOAD(GATTR);
	      MACRO3(301B%CAIL\,REGC,0);%<<<---------- LMIN IS INSERTED HERE\
	      MACRO3(303B%CAILE\,REGC,0);%<<<--------- LMAX IS INSERTED HERE\
	      MACRO3(254B%JRST\,0,0);%<<<------------- START OF "OTHERS" IS INSERTED HERE\
	      MACRO(NO,254B%JRST\,0,1,REGC,0);%<<<---- START OF JUMP TABLE IS INSERTED HERE\
	      LCIX := CIX; LIC := IC;
	      LSP := GATTR.TYPTR;
	       IF LSP # NIL
	       THEN
		 IF (LSP^.FORM # SCALAR) OR (LSP = REALPTR)
		 THEN
		   BEGIN
		    ERROR(315); LSP := NIL
		   END;
	       IF SY = OFSY
	       THEN INSYMBOL
	       ELSE ERROR(160);
(* 65 - allow extra semicolon *)
	      while sy=semicolon do
		insymbol;
	      FSTPTR := NIL; LPT3 := NIL;
	       LOOP
		 LOOP
		  CONSTANT(FSYS OR [COMMA,COLON],LSP1,LVAL);
		   IF LSP # NIL
		   THEN
		     IF COMPTYPES(LSP,LSP1)
		     THEN
		       BEGIN
			LPT1 := FSTPTR; LPT2 := NIL;
			 IF ABS(LVAL.IVAL) > HWCSTMAX
			 THEN ERROR(316);
			WHILE LPT1 # NIL DO
			WITH LPT1^ DO
			 BEGIN
			   IF CSLAB <= LVAL.IVAL
			   THEN
			     BEGIN
			       IF CSLAB = LVAL.IVAL
			       THEN ERROR(261);
			      GOTO 1
			     END;
			  LPT2 := LPT1; LPT1 := NEXT
			 END;
1:
			NEWZ(LPT3);
			WITH LPT3^ DO
			 BEGIN
			  NEXT := LPT1; CSLAB := LVAL.IVAL;
			  CSSTART := IC; CSEND := 0
			 END;
			 IF LPT2 = NIL
			 THEN FSTPTR := LPT3
			 ELSE LPT2^.NEXT := LPT3
		       END
		     ELSE ERROR(505);
		 EXIT IF SY # COMMA;
		  INSYMBOL
		 END;
		 IF SY = COLON
		 THEN INSYMBOL
		 ELSE ERROR(151);
		 REPEAT
		  STATEMENT(FSYS,STATENDS)
		 UNTIL	NOT (SY IN STATBEGSYS);
		 IF LPT3 # NIL
		 THEN
		   BEGIN
		    MACRO3(254B%JRST\,0,0); LPT3^.CSEND := CIX
		   END;
(* 65 - allow extra semicolons *)
		while sy = semicolon
		  do insymbol;
	       exit if sy in (fsys or statends);
		 IF SY=OTHERSSY
		 THEN
		   BEGIN
		    INSYMBOL;
		     IF SY=COLON
		     THEN INSYMBOL
		     ELSE ERROR(151);
		    NEWZ(OTHERSPTR);
		    WITH OTHERSPTR^ DO
		     BEGIN
		      CSSTART:=IC;
		       REPEAT
			STATEMENT(FSYS,STATENDS)
		       UNTIL NOT(SY IN STATBEGSYS);
		      MACRO3(254B %JRST\,0,0);
		      CSEND:=CIX;
(* 65 - allow extra semicolons *)
		      while sy=semicolon do
			insymbol;
		      GOTO 2
		     END
		   END
	       END;
2:
	       IF FSTPTR # NIL
	       THEN
		 BEGIN
		  LMAX := FSTPTR^.CSLAB;
		  %REVERSE POINTERS\
		  LPT1 := FSTPTR; FSTPTR := NIL;
		   REPEAT
		    LPT2 := LPT1^.NEXT; LPT1^.NEXT := FSTPTR;
		    FSTPTR := LPT1; LPT1 := LPT2
		   UNTIL LPT1 = NIL;
		  LMIN := FSTPTR^.CSLAB;
		  INSERTBOUND(LCIX-2,LIC-2,LMAX);
		  INSERTBOUND(LCIX-3,LIC-3,LMIN);
(* 164 - Polish fixups to avoid problem with LOADER *)
		  INSERTPOLISH(LIC-1,IC,-LMIN);  {put IC-LMIN at LIC-1}
		   IF LMAX - LMIN < CIXMAX-CIX
		   THEN
		     BEGIN
		      LADDR := IC + LMAX - LMIN + 1;
		       IF OTHERSPTR=NIL
		       THEN JUMPADDR:=LADDR
		       ELSE
			 BEGIN
			  INSERTADDR(RIGHT,OTHERSPTR^.CSEND,LADDR);
			  JUMPADDR:=OTHERSPTR^.CSSTART
			 END;
		      INSERTADDR(RIGHT,LCIX-1,JUMPADDR);
		       REPEAT
			WITH FSTPTR^ DO
			 BEGIN
			  WHILE CSLAB > LMIN DO
			   BEGIN
			    FULLWORD(RIGHT,0,JUMPADDR); LMIN := LMIN + 1
			   END;
			  FULLWORD(RIGHT,0,CSSTART);
			   IF CSEND # 0
			   THEN INSERTADDR(RIGHT,CSEND,LADDR);
			  FSTPTR := NEXT; LMIN := LMIN + 1
			 END
		       UNTIL FSTPTR = NIL
		     END
		   ELSE ERROR(363)
		 END;
	       IF SY = ENDSY
	       THEN INSYMBOL
	       ELSE ERROR(163)
	     END %CASESTATEMENT\ ;

	    PROCEDURE REPEATSTATEMENT;
	    VAR
	      LADDR: ADDRRANGE;
	     BEGIN
	      LADDR := IC;
	       LOOP
		 REPEAT
		  STATEMENT(FSYS OR [UNTILSY],STATENDS OR [UNTILSY])
		 UNTIL	NOT (SY IN STATBEGSYS);
	       EXIT IF SY # SEMICOLON;
		INSYMBOL
	       END;
	       IF SY = UNTILSY
	       THEN
		 BEGIN
		  INSYMBOL; EXPRESSION(FSYS,FALSEJMP); INSERTADDR(RIGHT,CIX,LADDR);
		 END
	       ELSE ERROR(202)
	     END %REPEATSTATEMENT\ ;

	    PROCEDURE WHILESTATEMENT;
	    VAR
	      LADDR: ADDRRANGE; LCIX: CODERANGE;
	     BEGIN
	      LADDR := IC;
	      EXPRESSION(FSYS OR [DOSY],FALSEJMP);
	      LCIX := CIX;
	       IF SY = DOSY
	       THEN INSYMBOL
	       ELSE ERROR(161);
	      STATEMENT(FSYS,STATENDS);
	      MACRO3R(254B%JRST\,0,LADDR);
	      INSERTADDR(RIGHT,LCIX,IC)
	     END %WHILESTATEMENT\ ;

	    PROCEDURE FORSTATEMENT;
	    VAR
(* 104 - check subranges *)
	      LATTR,SATTR: ATTR; LSP: STP; LSY: SYMBOL;
	      LCIX: CODERANGE; LADDR,LDPLMT: ADDRRANGE; LINSTR: INSTRANGE;
	      LREGC,LINDREG: ACRANGE; LINDBIT: IBRANGE; LRELBYTE: RELBYTE;
	      ADDTOLC: INTEGER;
	     BEGIN
	       IF SY = IDENT
	       THEN
		 BEGIN
		  SEARCHID([VARS],LCP);
		  WITH LCP^, LATTR DO
		   BEGIN
		    TYPTR := IDTYPE; KIND := VARBL;
		     IF VKIND = ACTUAL
		     THEN
		       BEGIN
			VLEVEL := VLEV;
			 IF VLEV > 1
			 THEN VRELBYTE := NO
			 ELSE VRELBYTE := RIGHT;
			DPLMT := VADDR; INDEXR :=0; PACKFG := NOTPACK;
			INDBIT:=0
		       END
		     ELSE
		       BEGIN
			ERROR(364); TYPTR := NIL
		       END
		   END;
		   IF LATTR.TYPTR # NIL
		   THEN
		     IF COMPTYPES(REALPTR,LATTR.TYPTR) OR (LATTR.TYPTR^.FORM > SUBRANGE)
		     THEN
		       BEGIN
			ERROR(365); LATTR.TYPTR := NIL
		       END;
		  INSYMBOL
		 END
	       ELSE
		BEGIN
		 ERRANDSKIP(209,FSYS OR [BECOMES,TOSY,DOWNTOSY,DOSY]);
		 LATTR.TYPTR := NIL
		END;
	       IF SY = BECOMES
	       THEN
		 BEGIN
		  INSYMBOL; EXPRESSION(FSYS OR [TOSY,DOWNTOSY,DOSY],ONREGC);
		   IF GATTR.TYPTR # NIL
		   THEN
		     IF GATTR.TYPTR^.FORM # SCALAR
		     THEN ERROR(315)
		     ELSE
		       IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
(* 104 - range check subranges *)
		       then begin
		       if lattr.typtr # nil
		       then if lattr.typtr^.form = subrange
			    then loadsubrange(gattr,lattr.typtr)
			    else load(gattr)
		       end
		       ELSE ERROR(556);
		  LREGC := GATTR.REG
		 END
	       ELSE ERRANDSKIP(159,FSYS OR [TOSY,DOWNTOSY,DOSY]);
	       IF SY IN [TOSY,DOWNTOSY]
	       THEN
		 BEGIN
		  LSY := SY; INSYMBOL; EXPRESSION(FSYS OR [DOSY],ONREGC);
		   IF GATTR.TYPTR # NIL
		   THEN
		     IF GATTR.TYPTR^.FORM # SCALAR
		     THEN ERROR(315)
		     ELSE
		       IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
		       THEN
			 BEGIN
			  ADDTOLC := 0 ;
			  WITH GATTR DO
{This test checks for forms of upper bound that must be copied into a local
 variable. Originally, they tried to use variables in place instead of
 copying, to save the MOVE, MOVEM.  The problem is that if the user changes
 the variable inside the loop, you have the wrong upper bound.  We
 interpret the language spec as requiring the bound to be evaluated only
 once, at the start.  The following test, commented out, was the original
 test, to see whether the object could be used in place for a CAMGE, or
 needed to be copied.  Now we copy all variables, as just discussed.}
{IF ( (KIND = VARBL) AND ( (VLEVEL > 1) AND (VLEVEL < LEVEL) OR
 (PACKFG # NOTPACK) OR (INDEXR > 0) AND (INDEXR <=   REGCMAX) ) ) OR
 (KIND = EXPR) }
			  IF (KIND = VARBL) OR (KIND = EXPR)
			   THEN
			     BEGIN
(* 104 - add range checking for subrange types *)
			      if lattr.typtr # nil
			      then if lattr.typtr^.form = subrange
				   then loadsubrange(gattr,lattr.typtr)
				   else load(gattr);
			      MACRO4(202B%MOVEM\,REGC,BASIS,LC); ADDTOLC := 1;
			      KIND := VARBL ; INDBIT := 0  ; INDEXR := BASIS ; VLEVEL := 1;
			      DPLMT := LC ; PACKFG := NOTPACK ; VRELBYTE := NO
			     END
			  else if lattr.typtr # nil
			       then if (lattr.typtr^.form = subrange) and runtmcheck
				    then begin
				     (* must copy, since otherwise at end of loop
				        makecode will think it is in an AC *)
				    sattr := gattr;
				    loadsubrange(sattr,lattr.typtr)
				    end;
			  FETCHBASIS(LATTR);
			  WITH LATTR DO
			   BEGIN
			     IF (INDEXR>0) AND (INDEXR<=REGCMAX)
			     THEN
			       BEGIN
				MACRO(NO,201B%MOVEI\,INDEXR,INDBIT,INDEXR,DPLMT);
				LINDBIT := 1; LDPLMT := LC+ADDTOLC; LINDREG := BASIS ;
				MACRO4(202B%MOVEM\,INDEXR,BASIS,LDPLMT);
				ADDTOLC := ADDTOLC + 1 ;
			       END
			     ELSE
			       BEGIN
				LINDBIT := INDBIT; LINDREG := INDEXR; LDPLMT := DPLMT
			       END;
			    LRELBYTE:= VRELBYTE
			   END;
			  MACRO(LRELBYTE,202B%MOVEM\,LREGC,LINDBIT,LINDREG,LDPLMT);
			   IF LSY = TOSY
			   THEN LINSTR := 313B%CAMLE\
			   ELSE LINSTR := 315B%CAMGE\;
			  LADDR := IC;
			  MAKECODE(LINSTR,LREGC,GATTR) ;
			 END
		       ELSE ERROR(556)
		 END
	       ELSE ERRANDSKIP(251,FSYS OR [DOSY]);
	      MACRO3(254B%JRST\,0,0); LCIX :=CIX;
	       IF SY = DOSY
	       THEN INSYMBOL
	       ELSE ERROR(161);
	      LC := LC + ADDTOLC;
	       IF LC > LCMAX
	       THEN LCMAX:=LC;
	      STATEMENT(FSYS,STATENDS);
	      LC := LC - ADDTOLC;
	       IF LSY = TOSY
	       THEN LINSTR  := 350B%AOS\
	       ELSE LINSTR := 370B%SOS\;
	      MACRO(LRELBYTE,LINSTR,LREGC,LINDBIT,LINDREG,LDPLMT);
	      MACRO3R(254B%JRST\,0,LADDR); INSERTADDR(RIGHT,LCIX,IC)
	     END %FORSTATEMENT\ ;

	    PROCEDURE LOOPSTATEMENT;
	    VAR
	      LADDR: ADDRRANGE; LCIX: CODERANGE;
	     BEGIN
	      LADDR := IC;
	       LOOP
		 REPEAT
		  STATEMENT(FSYS OR [EXITSY],STATENDS OR [EXITSY])
		 UNTIL	NOT (SY IN STATBEGSYS);
	       EXIT IF SY # SEMICOLON;
		INSYMBOL
	       END;
	       IF SY = EXITSY
	       THEN
		 BEGIN
		  INSYMBOL;
		   IF SY = IFSY
		   THEN
		     BEGIN
		      INSYMBOL; EXPRESSION(FSYS OR [SEMICOLON,ENDSY],TRUEJMP);
		     END
		   ELSE ERRANDSKIP(162,FSYS OR [SEMICOLON,ENDSY]);
		  LCIX := CIX;
		   LOOP
		     REPEAT
		      STATEMENT(FSYS,STATENDS)
		     UNTIL  NOT (SY IN STATBEGSYS);
		   EXIT IF SY # SEMICOLON;
		    INSYMBOL
		   END;
		  MACRO3R(254B%JRST\,0,LADDR); INSERTADDR(RIGHT,LCIX,IC)
		 END
	       ELSE ERROR(165);
	       IF SY = ENDSY
	       THEN INSYMBOL
	       ELSE ERROR(163)
	     END %LOOPSTATEMENT\ ;

	    PROCEDURE WITHSTATEMENT;
	    VAR
	      LCP: CTP; OLDLC: ADDRRANGE; LCNT1: DISPRANGE; OLDREGC: ACRANGE;
	     BEGIN
	      LCNT1 := 0; OLDREGC := REGCMAX; OLDLC := LC;
	       LOOP
		 IF SY = IDENT
		 THEN
		   BEGIN
		    SEARCHID([VARS,FIELD],LCP); INSYMBOL
		   END
		 ELSE
		   BEGIN
		    ERROR(209); LCP := UVARPTR
		   END;
		SELECTOR(FSYS OR [COMMA,DOSY],LCP);
		 IF GATTR.TYPTR # NIL
		 THEN
		   IF GATTR.TYPTR^.FORM = RECORDS
		   THEN
		     IF TOP < DISPLIMIT
		     THEN
		       BEGIN
			TOP := TOP + 1; LCNT1 := LCNT1 + 1; WITHIX := WITHIX + 1;
			DISPLAY[TOP].FNAME := GATTR.TYPTR^.FSTFLD;
			WITH DISPLAY[TOP],GATTR DO
			 BEGIN
			  OCCUR := CREC;
(* 5 - create block name for CREF *)
			  BLKNAME := '.FIELDID. ';
			   IF INDBIT = 1
			   THEN GETPARADDR;
			  FETCHBASIS(GATTR);
			   IF (INDEXR#0) AND (INDEXR # BASIS)
			   THEN
			     BEGIN
			      MACRO3(200B%MOVE\,REGCMAX,INDEXR);
			      INDEXR := REGCMAX;
			      REGCMAX := REGCMAX-1;
			       IF REGCMAX<REGC
			       THEN
				 BEGIN
				  ERROR(317);
				  REGC := REGCMAX
				 END
			     END;
			  CLEV := VLEVEL; CRELBYTE := VRELBYTE;
			  CINDR := INDEXR; CINDB:=INDBIT;
			  CDSPL := DPLMT;
			  CLC := LC;
			   IF (CINDR#0)  AND  (CINDR#BASIS)
			   THEN
			     BEGIN
			      LC := LC + 1;
			       IF LC>LCMAX
			       THEN LCMAX := LC;
			     END
			 END
		       END
		     ELSE ERROR(404)
		   ELSE ERROR(308);
	       EXIT IF SY # COMMA;
		INSYMBOL
	       END;
	       IF SY = DOSY
	       THEN INSYMBOL
	       ELSE ERROR(161);
	      STATEMENT(FSYS,STATENDS);
	      REGCMAX:=OLDREGC;
	      TOP := TOP - LCNT1; LC := OLDLC; WITHIX := WITHIX - LCNT1;
	     END %WITHSTATEMENT\ ;

	   BEGIN
	    %STATEMENT\
	     IF SY = INTCONST
	     THEN %LABEL\
	       BEGIN
(* 64 - non-loc gotos *)
		prterr := false;
		searchid([labelt],lcp);
		prterr := true;
		if lcp # nil
		  then with lcp^ do
		    if scope = level
		      then labeladdress := ic;
		FOR IX:=1 TO LIX DO
		 BEGIN
		  WITH LABELS[IX] DO
		   IF LABSVAL = VAL.IVAL
		   THEN
		     BEGIN
		      ERROR(211);
		      GOTO 1
		     END
		 END;
		LIX := LIX+1;
		 IF LIX > LABMAX
		 THEN
		   BEGIN
		    ERROR(362);
		    LIX:=LABMAX
		   END;
		WITH LABELS[LIX] DO
		 BEGIN
		  LABSVAL:=VAL.IVAL;
		  LABSADDR:=IC
		 END;
		FOR IX:=1 TO JIX DO
		 BEGIN
		  WITH GOTOS[IX] DO
		   IF GOTOVAL = VAL.IVAL
		   THEN
		     BEGIN
		      J:=CODE.INSTRUCTION[GOTOADDR].ADDRESS;
		      INSERTADDR(RIGHT,GOTOADDR,IC);
		      WHILE J#0 DO
		       BEGIN
			GOTOADDR:=J;
			J:=CODE.INSTRUCTION[GOTOADDR].ADDRESS;
			INSERTADDR(RIGHT,GOTOADDR,IC)
		       END;
		      GOTOVAL:=-1;
		      GOTO 1
		     END
		 END;
1:
		INSYMBOL;
		 IF SY = COLON
		 THEN INSYMBOL
		 ELSE ERROR(151)
	       END;
	     IF DEBUG AND NOT INITGLOBALS
	     THEN PUTLINER;
	     IF  NOT (SY IN FSYS OR [IDENT])
	     THEN ERRANDSKIP(166,FSYS);
	     IF SY IN STATBEGSYS OR [IDENT]
	     THEN
	       BEGIN
		REGC:=REGIN ;
		 IF INITGLOBALS AND (SY # IDENT)
		 THEN ERROR(462)
		 ELSE
		   CASE SY OF
		    IDENT:
			   BEGIN
			    SEARCHID([VARS,FIELD,FUNC,PROC],LCP); INSYMBOL;
			     IF LCP^.KLASS = PROC
			     THEN
			       IF INITGLOBALS
			       THEN ERROR(462)
			       ELSE CALL(FSYS,LCP)
			     ELSE ASSIGNMENT(LCP)
			   END;
		    BEGINSY:
			     BEGIN
			      INSYMBOL; COMPOUNDSTATEMENT
			     END;
		    GOTOSY:
			    BEGIN
			     INSYMBOL; GOTOSTATEMENT
			    END;
		    IFSY:
			  BEGIN
			   INSYMBOL; IFSTATEMENT
			  END;
		    CASESY:
			    BEGIN
			     INSYMBOL; CASESTATEMENT
			    END;
		    WHILESY:
			     BEGIN
			      INSYMBOL; WHILESTATEMENT
			     END;
		    REPEATSY:
			      BEGIN
			       INSYMBOL; REPEATSTATEMENT
			      END;
		    LOOPSY:
			    BEGIN
			     INSYMBOL; LOOPSTATEMENT
			    END;
		    FORSY:
			   BEGIN
			    INSYMBOL; FORSTATEMENT
			   END;
		    WITHSY:
			    BEGIN
			     INSYMBOL; WITHSTATEMENT
			    END
		   END;
		SKIPIFERR(STATENDS,506,FSYS)
	       END;
	    REGC := REGIN  %RE-INITIALIZE REGISTER COUNTER TO AVOID OVERFLOW DURING SUBSEQUENT
			    EXPRESSION EVALUATIONS IN REPEATSTATEMENT OR LOOPSTATEMENT \  ;
	   END %STATEMENT\ ;

	 BEGIN
	  %BODY\
	  LIX:=0;JIX:=0;REGCMAX:=WITHIN;WITHIX := -1; FIRSTKONST := NIL;
(* 164 - Polish fixups for CASE *)
	  FIRSTPOL := NIL;
	   IF NOT ENTRYDONE
	   THEN
	     BEGIN
	      ENTRYDONE:= TRUE;
	      WRITEMC(WRITEENTRY);
	      WRITEMC(WRITENAME);
	      WRITEMC(WRITEHISEG)
	     END;
	  CIX := -1 ;
	   IF INITGLOBALS
	   THEN
	     BEGIN
	      CGLOBPTR := NIL ;
	       LOOP
		 IF SY # ENDSY
		 THEN STATEMENT([SEMICOLON,ENDSY],[SEMICOLON,ENDSY]) ;
	       EXIT IF	SY # SEMICOLON ;
		INSYMBOL
	       END ;
	       IF SY = ENDSY
	       THEN INSYMBOL
	       ELSE ERROR(163) ;
	      WRITEMC(WRITEGLOBALS)
	     END
	   ELSE
	     BEGIN
	      %BODY PROPER\
	      ENTERBODY;
	       IF FPROCP # NIL
(* 40 - fix print format *)
	       THEN FPROCP^.PFADDR:= PFSTART
	       ELSE LC:= 1;
	      LCMAX:=LC;
(* 54 - keep track of how many loc's above stack are used *)
	      STKOFFMAX := 0;
	      STKOFF := 0;
	       IF MAIN OR (LEVEL > 1)
	       THEN
		 BEGIN
		   LOOP
		     REPEAT
		      STATEMENT(FSYS OR [SEMICOLON,ENDSY],[SEMICOLON,ENDSY])
		     UNTIL  NOT (SY IN STATBEGSYS);
		   EXIT IF SY # SEMICOLON;
		    INSYMBOL
		   END;
		   IF SY = ENDSY
		   THEN INSYMBOL
		   ELSE ERROR(163);
		  FOR IX:=1 TO JIX DO %TEST ON UNDEFINED LABELS\
		   BEGIN
		    WITH GOTOS[IX] DO
		     IF GOTOVAL # -1
		     THEN
		       BEGIN
			ERROR(215);
			NEWZ(ERRMPTR1,D);
			WITH ERRMPTR1^ DO
			 BEGIN
			  NUMBER := 215; INTVAL := GOTOVAL; NEXT := ERRMPTR
			 END;
			ERRMPTR := ERRMPTR1;
		       END
		   END

		    %	 WHILE FSTEXP # FEXP DO %TEST ON UNDEFINED EXIT LABELS\

		 END;

	      LEAVEBODY;
	       IF MAIN OR (LEVEL > 1)
(* 53 - allocate core for loc's above stack *)
	       then
		 begin
(* 104 - check for overflow of address space *)
		 if lcmax > 377777B (* else adjsp will see it negative *)
		   then error(266);
(* 62 - clean up stack offsets *)
		 if fprocp # nil
		   then insertaddr(no,insertsize,lcmax-fprocp^.poffset)
		   else insertaddr(no,insertsize,lcmax);  %below the stack\
(* 57 - coralloc only needed for tops10 *)
		 if tops10
		   then insertaddr(no,coralloc,stkoffmax+40B); %above the stack\
		 end;
	      WRITEMC(WRITECODE);
(* 40 - fix print format *)
	      if fprocp # nil
	        then writemc(writeblk);
(* 64 - Polish fixups for CASE *)
	      if firstpol # NIL
		then writemc(writepolish);
	       IF FIRSTKONST # NIL
	       THEN WRITEMC(WRITEINTERNALS)
	       ELSE
		 IF LOCALPFPTR # NIL
		 THEN
		   IF LOCALPFPTR^.PFLEV = LEVEL
		   THEN WRITEMC(WRITEINTERNALS)
(* 114 - ALWAYS WRITE INTERNALS IF REF TO NON-LOC GOTO *)
		   ELSE IF LASTLABEL # NIL
		     THEN IF LASTLABEL^.SCOPE = LEVEL
			THEN WRITEMC(WRITEINTERNALS)
			ELSE
		     ELSE
	 	 ELSE  IF LASTLABEL # NIL
		   THEN IF LASTLABEL^.SCOPE = LEVEL
		     THEN WRITEMC(WRITEINTERNALS);
	       IF LEVEL = 1
	       THEN
		 BEGIN
		  WRITEMC(WRITESYMBOLS);
		  WRITEMC(WRITELIBRARY);
		  WRITEMC(WRITESTART);
		  WRITEMC(WRITEEND)
		 END
	     END % BODY PROPER\
	 END %BODY\ ;

(* 56 - PROCEDURES FOR FILE SWITCHING *)
	PROCEDURE OPENALT;
	  BEGIN
	  REQFILE := TRUE;
(* 136 - listing format *)
	  ORIGPAGECNT := PAGECNT; ORIGSUBPAGE := SUBPAGE; ORIGLINENR := LINENR;
	  ORIGPAGE := PAGER; ORIGLINECNT := LINECNT; ORIGCH := CH;
	  ENDSTUFF;
	  PUSHF(INPUT,VAL.VALP^.SVAL,VAL.VALP^.SLGTH);
(* 107 - error check openning of subfile *)
	  if eof
	    then begin (* nb: on the 20, analys does not show the file name in most cases *)
(* 136 - LISTING FORMAT *)
	    write('Failure to open INCLUDEd file: ',val.valp^.sval:val.valp^.slgth);
	    NEWLINE;
	    writeln(tty,'Failure to open INCLUDEd file: ',val.valp^.sval:val.valp^.slgth);
	    analys(input); writeln(tty);
	    rewrite(outputrel);
(* 112 - clrbfi when error *)
	    clribf;
(* 123 - restore input so close gets done by pasxit *)
	    close(input);
	    popf(input);
	    pasxit(input,output,outputrel)
	    end;
(* 136 - listing format *)
	  PAGECNT := 1; SUBPAGE := 0; LINECNT := 1; CH := ' ';
	  READLN;  {because pushf does an interactive open}
	  GETLINENR(LINENR);
	  pagehead;
	  WRITE(VAL.VALP^.SVAL:VAL.VALP^.SLGTH);
	  newline; newline;
	  BEGSTUFF
	  END;

	PROCEDURE CLOSEALT;
	  BEGIN
	  ENDSTUFF;
	  POPF(INPUT);
(* 136 - listing format *)
	  PAGECNT := ORIGPAGECNT; SUBPAGE := ORIGSUBPAGE + 1;
	  pagehead;
	  write('Main file continued'); newline; newline;
	  LINENR := ORIGLINENR; CH := ORIGCH;
	  PAGER := ORIGPAGE; LINECNT := ORIGLINECNT;
	  BEGSTUFF
	  END;

	PROCEDURE INCLUSION;
	  BEGIN
	  IF NOT (SY = STRINGCONST)
	    THEN BEGIN ERROR(212); REQFILE := FALSE END
	    ELSE BEGIN
	      OPENALT;
	      INSYMBOL
	      END
	  END;


       BEGIN
	%BLOCK\
	MARK(HEAPMARK);
(* 24 - testpacked no longer needed *)
(* 55 - ALL 55 PATCHES ARE FOR REQUIRE FILES - INITIALIZE REQFILE *)
(* 65 - remove exit labels *)
(* 125 - reqfile init moved *)
(* 173 - internal files *)
	FILEINBLOCK[LEVEL] := FALSE;
	DP := TRUE; FORWPTR := NIL; 
	 REPEAT
(* 23 - be sure LCPAR is set even when no VAR part *)
	  LCPAR := LC;
(* 56 - INCLUDE SYNTAX *)
(* 126 - turn while into repeat for better to force check for BEGIN *)
	  REPEAT
(* 56 - SCAN REQUIRE FILE SYNTAX *)
	   IF (SY=INCLUDESY) OR REQFILE
	     THEN BEGIN
	     INSYMBOL;
	     INCLUSION;
	     END;
(* 55 - LABELS NOT LEGAL IN REQUIRE FILE *)
	     IF (SY = LABELSY) AND NOT REQFILE
	     THEN
	       BEGIN
		INSYMBOL; LABELDECLARATION
	       END;
	     IF SY = CONSTSY
	     THEN
	       BEGIN
		INSYMBOL; CONSTANTDECLARATION
	       END;
	     IF SY = TYPESY
	     THEN
	       BEGIN
		INSYMBOL; TYPEDECLARATION
	       END;
(* 55 - NO VARIABLES OR INITPROC'S IN REQUIRE FILE *)
	    IF NOT REQFILE THEN BEGIN
	    LCPAR := LC;
	     IF SY = VARSY
	     THEN
	       BEGIN
		INSYMBOL; VARIABLEDECLARATION
	       END;
(* 167 - resolve fwd type ref's *)
{Note that FWDRESOLVE must be called after the VAR section because
 ^FOO in the VAR section is treated as a forward reference to FOO.
 We can't resolve this until after the end of the var section, 
 since otherwise we might accept ^FOO where FOO is a type in an
 outer block, but a local variable in the current block.  This seems
 to be illegal}
	    FWDRESOLVE;
(* 124 - detect initproc's when not at level 1 *)
	     WHILE SY = INITPROCSY DO
		 BEGIN
		  IF LEVEL # 1
		    THEN ERROR(557);
		  INSYMBOL ;
		   IF SY # SEMICOLON
		   THEN ERRANDSKIP(156,[BEGINSY])
		   ELSE INSYMBOL ;
		   IF SY = BEGINSY
		   THEN
		     BEGIN
		      MARK(GLOBMARK) ; INITGLOBALS := TRUE ;
		      INSYMBOL ; BODY(FSYS OR [SEMICOLON,ENDSY]) ;
		       IF SY = SEMICOLON
		       THEN INSYMBOL
		       ELSE ERROR(166) ;
		      INITGLOBALS := FALSE ; RELEASE(GLOBMARK) ;
		     END
		   ELSE ERROR(201) ;
		 END ;
	     IF LEVEL=1
	     THEN
		LCMAIN := LC;
	    END;
	    WHILE SY IN [PROCEDURESY,FUNCTIONSY] DO
	     BEGIN
	      LSY := SY; INSYMBOL; PROCEDUREDECLARATION(LSY)
	     END;
	    WHILE FORWPTR # NIL DO
	    WITH FORWPTR^ DO
	     BEGIN
	       IF FORWDECL
	       THEN ERRORWITHTEXT(465,NAME);
	      FORWPTR := TESTFWDPTR
	     END;
(* 56 - REQ FILE ENDS IN PERIOD *)
	     IF (MAIN OR (LEVEL > 1)) AND NOT REQFILE
(* 126 - TWEAK ERROR RECOVER AGAIN *)
	     THEN BEGIN IF SY # BEGINSY THEN ERROR(201) END
(* 35 - fix error recovery, especially for /NOMAIN *)
		%This else is top level of /NOMAIN.  If anything is here
		 other than a period we have to turn on /MAIN, since otherwise
		 BODY will refuse to scan anything.\
	     ELSE IF SY # PERIOD
	       THEN BEGIN
	       ERROR(172);
(* 56 - DON'T SET MAIN TO TRUE IN REQ FILE *)
	        IF NOT REQFILE
		  THEN MAIN := TRUE
	       END;
(* 55 - CLOSE REQFILE *)
	   IF REQFILE
	     THEN BEGIN
(* 136 - listing format *)
	     REQFILE := FALSE;
	     CLOSEALT;
	     INSYMBOL;
	     IF SY = SEMICOLON
	       THEN INSYMBOL
	     ELSE IF SY = COMMA
	       THEN REQFILE := TRUE
	     ELSE
	       ERROR(166);
	     END;
(* 126 - make it an UNTIL to force always check for BEGIN, etc. *)
	   UNTIL NOT ( (SY IN BLOCKBEGSYS - [BEGINSY]) OR REQFILE);
	  DP := FALSE;
	     IF SY = BEGINSY
	     THEN INSYMBOL;
		%ELSE ERROR(201) REDUNDANT HERE - MSG PRINTED ABOVE\
	  BODY(FSYS OR [CASESY]);
	  SKIPIFERR(LEAVEBLOCKSYS,166,FSYS)
	 UNTIL SY IN LEAVEBLOCKSYS;
	RELEASE(HEAPMARK);
       END %BLOCK\ ;



      PROCEDURE ENTERSTDTYPES;
      VAR
	LBTP: BTP; LSP: STP;
       BEGIN
	%TYPE UNDERLIEING:\
	%*****************\

	NEWZ(INTPTR,SCALAR,STANDARD);	  %INTEGER\
	WITH INTPTR^ DO
	 BEGIN
	  SIZE := 1;BITSIZE := BITMAX; SELFSTP := NIL
	 END;
	NEWZ(REALPTR,SCALAR,STANDARD);	  %REAL\
	WITH REALPTR^ DO
	 BEGIN
	  SIZE := 1;BITSIZE := BITMAX; SELFSTP := NIL
	 END;
	NEWZ(CHARPTR,SCALAR,STANDARD);	  %CHAR\
	WITH CHARPTR^ DO
	 BEGIN
	  SIZE := 1;BITSIZE := 7; SELFSTP := NIL
	 END;
	NEWZ(BOOLPTR,SCALAR,DECLARED);	  %BOOLEAN\
	WITH BOOLPTR^ DO
	 BEGIN
	  SIZE := 1;BITSIZE := 1; SELFSTP := NIL
	 END;
	NEWZ(NILPTR,POINTER);		  %NIL\
	WITH NILPTR^ DO
	 BEGIN
	  ELTYPE := NIL; SIZE := 1; BITSIZE := 18; SELFSTP := NIL
	 END;
	NEWZ(TEXTPTR,FILES);					  %TEXT\
	WITH TEXTPTR^ DO
	 BEGIN
	  FILTYPE := CHARPTR; SIZE := SIZEOFFILEBLOCK + 1; BITSIZE := BITMAX;
	  FILEPF := FALSE; SELFSTP := NIL; HASFILE := TRUE;
	 END;
(* 15 - ALLOW "FILE" AS TYPE IN PROC DECL - ANY TYPE OF FILE *)
       NEWZ(ANYFILEPTR,FILES);
      WITH ANYFILEPTR^ DO
	BEGIN
	 FILTYPE := NIL; SIZE := SIZEOFFILEBLOCK + 1; BITSIZE := BITMAX;
	 FILEPF := FALSE; SELFSTP := NIL; HASFILE := TRUE;
	END;
	NEWZ(LSP,SUBRANGE);
	WITH LSP^ DO
	 BEGIN
	  RANGETYPE := INTPTR; MIN.IVAL := 1; MAX.IVAL := 9; SELFSTP := NIL
	 END;
	NEWZ(DATEPTR,ARRAYS);
	WITH DATEPTR^ DO
	 BEGIN
	  ARRAYPF := TRUE; ARRAYBPADDR := 0;
	  SELFSTP := NIL; AELTYPE := CHARPTR; INXTYPE := LSP;
	  SIZE := 2; BITSIZE := 36
	 END;
	NEWZ(LBTP,ARRAYY);
	WITH LBTP^, BYTE DO
	 BEGIN
	  SBITS := 7; PBITS := BITMAX; DUMMYBIT := 0;
	  IBIT := 0; IREG := TAC; RELADDR := 0;
	  LAST := LASTBTP; LASTBTP := LBTP; ARRAYSP := DATEPTR
	 END;
	NEWZ(LSP,SUBRANGE);
	WITH LSP^ DO
	 BEGIN
	  RANGETYPE := INTPTR; MIN.IVAL := 1; MAX.IVAL := ALFALENG; SELFSTP := NIL
	 END;
	NEWZ(ALFAPTR,ARRAYS);
	WITH ALFAPTR^ DO
	 BEGIN
	  ARRAYPF := TRUE; ARRAYBPADDR := 0;
	  SELFSTP := NIL; AELTYPE := CHARPTR; INXTYPE := LSP;
	  SIZE := 2; BITSIZE := 36
	 END;
(* 111 - STRING, POINTER *)
	NEWZ(STRINGPTR,ARRAYS);
	WITH STRINGPTR^ DO
	  BEGIN
	  ARRAYPF := TRUE; SELFSTP := NIL; AELTYPE := CHARPTR;
(* 161 - fix string and pointer *)
	  INXTYPE := NIL; SIZE := 2; BITSIZE := 36
	  END;
	NEWZ(POINTERPTR,POINTER);
	WITH POINTERPTR^ DO
	  BEGIN
(* 161 - fix string and pointer *)
	  ELTYPE := NIL; SIZE := 2; BITSIZE := 36; SELFSTP := NIL
	  END;
(* 202 - fix VAR POINTER *)
	NEWZ(POINTERREF,POINTER);
(* 203 - had done pointerref^ := pointerptr^ - This copied too much *)
	WITH POINTERREF^ DO
	  BEGIN
(* 161 - fix string and pointer *)
	  ELTYPE := NIL; SIZE := 2; BITSIZE := 36; SELFSTP := NIL
	  END;
	NEWZ(LBTP,ARRAYY);
	WITH LBTP^, BYTE DO
	 BEGIN
	  SBITS := 7; PBITS := BITMAX; DUMMYBIT := 0;
	  IBIT := 0; IREG := TAC; RELADDR := 0;
	  LAST := LASTBTP; LASTBTP := LBTP; ARRAYSP := ALFAPTR
	 END;
       END %ENTERSTDTYPES\ ;

      PROCEDURE ENTERSTDNAMES;
      VAR
	CP,CP1: CTP; I,J: INTEGER; LFILEPTR :FTP ;
       BEGIN
	%NAME:\
	%*****\

	NEWZ(CP,TYPES);						  %INTEGER\
	WITH CP^ DO
	 BEGIN
(* 116 - here and following: add next := nil for copyctp *)
	  NAME := 'INTEGER   '; IDTYPE := INTPTR; NEXT := NIL;
	 END;
	ENTERID(CP);
	NEWZ(CP,TYPES);						  %REAL\
	WITH CP^ DO
	 BEGIN
	  NAME := 'REAL      ';IDTYPE := REALPTR; NEXT := NIL;
	 END;
	ENTERID(CP);
	NEWZ(CP, TYPES); 					   %CHAR\
	WITH CP^ DO
	 BEGIN
	  NAME := 'CHAR      '; IDTYPE := CHARPTR; NEXT := NIL;
	 END;
	ENTERID(CP);
	NEWZ(CP,TYPES);						  %BOOLEAN\
	WITH CP^ DO
	 BEGIN
	  NAME := 'BOOLEAN   '; IDTYPE := BOOLPTR; NEXT := NIL;
	 END;
	ENTERID(CP);
	NEWZ(CP,TYPES);						  %TEXT\
	WITH CP^ DO
	 BEGIN
	  NAME := 'TEXT      '; IDTYPE := TEXTPTR; NEXT := NIL;
	 END;
	ENTERID(CP);
	NEWZ(CP,TYPES);
	WITH CP^ DO
	 BEGIN
	  NAME := 'ALFA      '; IDTYPE := ALFAPTR; NEXT := NIL;
	 END;
	ENTERID(CP);
(* 111 - STRING, POINTER *)
	NEWZ(CP,PARAMS);
	WITH CP^ DO
	  BEGIN
	  NAME := 'STRING    ';  IDTYPE := STRINGPTR; NEXT := NIL;
	  END;
	ENTERID(CP);
	NEWZ(CP,PARAMS);
	WITH CP^ DO
	  BEGIN
	  NAME := 'POINTER   ';  IDTYPE := POINTERPTR; NEXT := NIL;
	  END;
	ENTERID(CP);
	NEWZ(CP,KONST);						  %NIL\
	WITH CP^ DO
	 BEGIN
	  NAME := 'NIL       '; IDTYPE := NILPTR;
	  NEXT := NIL; VALUES.IVAL := 377777B;
	 END;
	ENTERID(CP);
	NEWZ(CP,KONST);						  %ALFALENG\
	WITH CP^ DO
	 BEGIN
	  NAME := 'ALFALENG  ';  IDTYPE := INTPTR;
	  NEXT := NIL; VALUES.IVAL := 10;
	 END;
	ENTERID(CP);
(* 112 - maxint *)
	newz(cp,konst);
	with cp^ do
	  begin
	  name := 'MAXINT    '; idtype := intptr;
	  next := nil; values.ival := 377777777777B;
	  end;
	enterid(cp);
	CP1 := NIL;
	FOR I := 1 TO 2 DO
	 BEGIN
	  NEWZ(CP,KONST);				    %FALSE,TRUE\
	  WITH CP^ DO
	   BEGIN
	    NAME := NA[I]; IDTYPE := BOOLPTR;
	    NEXT := CP1; VALUES.IVAL := I - 1;
	   END;
	  ENTERID(CP); CP1 := CP
	 END;
	BOOLPTR^.FCONST := CP;
	FOR I := 3 TO 6 DO
	 BEGIN
	  NEWZ(CP,VARS); 	    %INPUT,OUTPUT,TTY,TTYOUTPUT\
(* 171 - treat files as special *)
          case i of
	  3:infile := cp; 4:outfile := cp; 5:ttyfile := cp; 6:ttyoutfile := cp
	  end;
	  WITH CP^ DO
	   BEGIN
(* 173 - no channels any more *)
	    NAME := NA[I]; IDTYPE := TEXTPTR; CHANNEL := I-2;
	    VKIND := ACTUAL; NEXT := NIL; VLEV := 0;
	    VADDR:= LC;
	    LC := LC + 1 %BUFFERSIZE FOR TYPE CHAR\ + SIZEOFFILEBLOCK;
	    NEWZ(LFILEPTR) ;
	    WITH LFILEPTR^ DO
	     BEGIN
	      NEXTFTP := FILEPTR ;
	      FILEIDENT := CP ;
	     END ;
	    FILEPTR := LFILEPTR ;
	   END;
	  ENTERID(CP)
	 END;
	SFILEPTR := FILEPTR;	   %REMEMBER TOP OF STANDARD FILES\
(* 16 - ADD DATA AT ENTRY *)
	CCLSW := LC; LC := LC+5;
(* 66 - nonloc gotos *)
	globtopp := lc; lc:=lc+1; globbasis := lc; lc:=lc+1;
(* 61 - allow us to distinguish tops10 and tops20 specific ftns *)
	if tops10
	  then othermachine := t20name
	  else othermachine := t10name;

	% GET,GETLN,PUT,PUTLN,RESET,REWRITE,READ,READLN,
	 WRITE,WRITELN,PACK,UNPACK,NEW,MARK,RELEASE,GETLINR,
	 PUT8BITSTOTTY,PAGE\

	FOR I := 7 TO 25 DO
(* 61 - restrict tops10 and tops20 specific *)
	 if machna[i] # othermachine then
	 BEGIN
	  NEWZ(CP,PROC,STANDARD);
	  WITH CP^ DO
	   BEGIN
	    NAME := NA[I]; IDTYPE := NIL;
	    NEXT := NIL; KEY := I - 6;
	   END;

	  ENTERID(CP)
	 END;
(* 10 - ADD SETSTRING *)
(* 14 - AND OTHERS *)

(* 27 - add NEWZ *)
(* 61 - restrict tops10 and tops20 defn's *)
(* 152 - DISPOSE *)
	FOR I := 54 TO 76 DO
	 if machna[i] # othermachine then
	 BEGIN
	  NEWZ(CP,PROC,STANDARD);
	  WITH CP^ DO
	   BEGIN
	    NAME := NA[I]; IDTYPE := NIL;
	    NEXT := NIL; KEY := I - 32;
	   END;

	 ENTERID(CP)
	END;

(* 44 - add curpos and its arg *)
        (* arg for CURPOS *)
	newz(cp1,vars);
	with cp1^ do
	  begin
	  name:='          ';idtype:=anyfileptr;
	  vkind:=formal;next:=nil;vlev:=1;vaddr:=2
	  end;

	(* CURPOS *)
(* 47 - more of this kind now *)
(* 61 - tops10 and tops20 specific functions *)
	FOR I:=77 TO 79 DO
	if machna[i] # othermachine then
	begin
	newz(cp,func,declared,actual);
	with cp^ do
	  begin
	  name := na[i]; idtype:=intptr; next:=cp1; forwdecl:=false;
	  externdecl := true; pflev:=0; pfaddr:=0; pfchain:=externpfptr;
	  externpfptr:=cp; for j:=0 to maxlevel do linkchain[j]:=0; externalname:=na[i];
	  language:=pascalsy
	  end;
	enterid(cp);
	end;

	NEWZ(CP,FUNC,DECLARED,ACTUAL);
	WITH CP^ DO
	 BEGIN
	  NAME := NA[26]; IDTYPE := DATEPTR; NEXT := NIL; FORWDECL := FALSE;
	  EXTERNDECL := TRUE; PFLEV := 0; PFADDR := 0; PFCHAIN := EXTERNPFPTR;
	  EXTERNPFPTR := CP; FOR I := 0 TO MAXLEVEL DO LINKCHAIN[I] := 0; EXTERNALNAME := NA[26];
	  LANGUAGE := FORTRANSY
	 END;
	ENTERID(CP);

	% RUNTIME,TIME,ABS,SQR,TRUNC,ODD,ORD,CHR,PRED,SUCC,EOF,EOLN \

	FOR I := 27 TO 38 DO
	 BEGIN
	  NEWZ(CP,FUNC,STANDARD);
	  WITH CP^ DO
	   BEGIN
	    NAME := NA[I]; IDTYPE := NIL;
	    NEXT := NIL; KEY := I - 26;
	   END;
	  ENTERID(CP)
	 END;

	FOR I := 80 TO 81 DO
	 BEGIN
	  NEWZ(CP,FUNC,STANDARD);
	  WITH CP^ DO
	   BEGIN
	    NAME := NA[I]; IDTYPE := NIL;
	    NEXT := NIL; KEY := I - 66;
	   END;
	  ENTERID(CP)
	 END;
	NEWZ(CP,VARS); %PARAMETER OF PREDECLARED FUNCTIONS\
	WITH CP^ DO
	 BEGIN
	  NAME := '          '; IDTYPE := REALPTR;
	  VKIND := ACTUAL; NEXT := NIL; VLEV := 1; VADDR := 2
	 END;

	% SIN,COS,EXP,SQRT,ALOG,ATAN,ALOG10,
	 SIND,COSD,SINH,COSH,TANH,ASIN,ACOS,RAN \

	FOR I := 39 TO 53 DO
	 BEGIN
	  NEWZ(CP1,FUNC,DECLARED,ACTUAL);
	  WITH CP1^ DO
	   BEGIN
	    NAME := NA[I]; IDTYPE := REALPTR; NEXT := CP;
	    FORWDECL := FALSE; EXTERNDECL := TRUE; PFLEV := 0; PFADDR := 0;
	    PFCHAIN:= EXTERNPFPTR; EXTERNPFPTR:= CP1; EXTERNALNAME := EXTNA[I];
	    FOR J := 0 TO MAXLEVEL DO LINKCHAIN[J] := 0; LANGUAGE := EXTLANGUAGE[I]
	   END;
	  ENTERID(CP1)
	 END;
	LCMAIN := LC;
       END %ENTERSTDNAMES\ ;

      PROCEDURE ENTERUNDECL;
      VAR
	I: INTEGER;
       BEGIN
	NEWZ(UTYPPTR,TYPES);
	WITH UTYPPTR^ DO
	 BEGIN
	  NAME := '          '; IDTYPE := NIL; NEXT := NIL;
	 END;
	NEWZ(UCSTPTR,KONST);
	WITH UCSTPTR^ DO
	 BEGIN
	  NAME := '          '; IDTYPE := NIL; NEXT := NIL;
	  VALUES.IVAL := 0
	 END;
	NEWZ(UVARPTR,VARS);
	WITH UVARPTR^ DO
	 BEGIN
	  NAME := '          '; IDTYPE := NIL; VKIND := ACTUAL;
	  NEXT := NIL; VLEV := 0; VADDR := 0
	 END;
(* 135 - UARRPTR is needed as dummy to prevent ill mem ref in PACK/UNPACK *)
	NEWZ(UARRTYP,ARRAYS);
	WITH UARRTYP^ DO
	  BEGIN
	  ARRAYPF := FALSE; SELFSTP := NIL; AELTYPE := NIL;
	  INXTYPE := NIL; SIZE := 777777B; BITSIZE := 36
	  END;
	NEWZ(UFLDPTR,FIELD);
	WITH UFLDPTR^ DO
	 BEGIN
	  NAME := '          '; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0;
	  PACKF := NOTPACK
	 END;
	NEWZ(UPRCPTR,PROC,DECLARED,ACTUAL);
	WITH UPRCPTR^ DO
	 BEGIN
	  NAME := '          '; IDTYPE := NIL; FORWDECL := FALSE;
	  FOR I := 0 TO MAXLEVEL DO LINKCHAIN[I] := 0;
	  NEXT := NIL; EXTERNDECL := FALSE; PFLEV := 0; PFADDR := 0
	 END;
	NEWZ(UFCTPTR,FUNC,DECLARED,ACTUAL);
	WITH UFCTPTR^ DO
	 BEGIN
	  NAME := '          '; IDTYPE := NIL; NEXT := NIL;
	  FOR I := 0 TO MAXLEVEL DO LINKCHAIN[I] := 0;
	  FORWDECL := FALSE; EXTERNDECL := FALSE; PFLEV := 0; PFADDR := 0
	 END;
(* 64 - non-loc gotos *)
	newz(ulblptr,labelt);
	with ulblptr^ do
	  begin
	  name := '          '; idtype := nil; next := nil;
	  scope := 0; gotochain := 0; labeladdress := 0;
	  end;
       END %ENTERUNDECL\ ;

      PROCEDURE ENTERDEBNAMES;
      VAR
	CP:CTP;
       BEGIN
	NEWZ(CP,PROC,STANDARD);
	WITH CP^ DO
	 BEGIN
	  NAME := 'PROTECTION';
	  IDTYPE := NIL; NEXT := NIL; KEY:= 21
	 END;
	ENTERID(CP);
       END;

(* 4 - replace file name scanner with call to SCAN *)
(* 11 - new definition of PASPRM *)
     FUNCTION PASPRM(VAR I,O:TEXT;VAR R:INTFILE):RPGPT; EXTERN;

(* 104 - improved error detection in tops10 *)
(* 107 - moved declaration of analys earlier *)

     BEGIN
      %ENTER STANDARD NAMES AND STANDARD TYPES:\
      %****************************************\

(* 41 - make restartable *)
      reinit;

      RTIME := RUNTIME; DAY := DATE;
      LEVEL := 0; TOP := 0;
      WITH DISPLAY[0] DO
       BEGIN
(* 5 - create block name for CREF *)
	FNAME := NIL; OCCUR := BLCK; BLKNAME := '.PREDEFIN.';
       END;
      ENTERSTDTYPES; ENTERSTDNAMES; ENTERUNDECL; ENTERDEBNAMES;

      TOP := 1; LEVEL := 1;
      WITH DISPLAY[1] DO
       BEGIN
(* 5 - create block name for CREF *)
	FNAME := NIL; OCCUR := BLCK; BLKNAME := '.GLOBAL.  ';
       END;

      %OPEN COMPILER FILES\
      %*******************\

(* 4 - here we open the files that SCAN gave us *)
      REWRITE(TTYOUTPUT);
      SCANDATA := PASPRM(INPUT,OUTPUT,OUTPUTREL);
      WITH SCANDATA ^ DO
       BEGIN
(* 33 - VERSION NO *)
       VERSION.WORD := VERVAL;
(* I haven't figured out what to do about lookup blocks.  Commented out for now *)
(* 104 - fix error detection on tops10 *)
       if tops10 
         then reset(input%,'',true,lookblock,40000B,4000B\)  {tag for SOS}
 	 else reset(input,'',0,0,0,20B);  {see EOL char's}
       %if eof		{tag for SOS}
	 then begin
	 analys(input);
	 pasxit(input,output,outputrel);
	 end;
       get(input);\		     {tag for SOS}
       IF VERSION.WORD = 0 THEN VERSION.WORD := LOOKBLOCK[6];
       LOOKBLOCK[6] := VERSION.WORD;
       FOR I := 1 TO 5 DO LOOKBLOCK[I] := 0;
       REWRITE(OUTPUT%,'',0,LOOKBLOCK\);  {tag for SOS}
       FOR I := 1 TO 5 DO LOOKBLOCK[I] := 0;
       REWRITE(OUTPUTREL%,'',0,LOOKBLOCK\);  {tag for SOS}
       FILENAME := RELNAME;
(* 34 - DON'T NEED ENTRY NOW *)
       IF FILENAME = '          '
         THEN FILENAME := '.NONAM    '; %A BLANK ENTRY NAME IS BAD NEWS\
       LISTCODE := LSW;
       TTYINUSE := TSW;
       MAIN := MSW;
       RUNTMCHECK := CSW;
(* 160 - compiler switch /ARITHCHECK *)
       ARITHCHECK := ASW;
       DEBUGSWITCH := DSW;
       CREF:=CRSW;
       DEBUG := DSW;
       RPGENTRY := RPGSW;
(* 7 - ADD /HEAP SWITCH *)
(* 12 - /heap no longer needed *)
(* 24 - /HEAP AND /STACK NOW USED FOR START ADDR *)
	
       HEAP := HEAPVAL;
       STACK := STACKVAL;
(* 25 - /ZERO *)
       ZERO := ZSW
       END;

      %WRITE HEADER\
      %************\

(* 136 - listing format *)
      pagehead;
      %NEW LINE FOR ERROR MESSAGES OR PROCEDURENAMES\
      GETNEXTLINE;     %GETS FIRST LINENUMBER IF ANY\
      CH := ' '; INSYMBOL; RESETFLAG := FALSE;
       IF NOT MAIN
       THEN
	 BEGIN
	  LC := PROGRST; LCMAIN := LC;
	  WHILE SFILEPTR # NIL DO
	  WITH SFILEPTR^, FILEIDENT^ DO
	   BEGIN
	    VADDR:= 0; SFILEPTR:= NEXTFTP
	   END;
	  SFILEPTR := FILEPTR;
	 END;

	%COMPILE:\
	%********\

(* 5 - CREF *)
      IF CREF
        THEN WRITE(CHR(15B),CHR(10),'.GLOBAL.  ');

      FOR I := 1 TO CHCNTMAX DO ERRLINE[I] := ' '; RELBLOCK.COUNT:= 0;
      FOR SUPPORTIX := FIRSTSUPPORT TO LASTSUPPORT DO RNTS.LINK[SUPPORTIX] := 0;

(* 6 - allow PROGRAM statement *)
      PROGSTAT;
(* 13 - PRINT HEADER NOW THAT HAD PROG STATEMENT SCANNED *)
      IF RPGENTRY
       THEN WRITELN(TTY,'PASCAL:',CHR(11B),FILENAME:6);
(* 41 - Don't print header *)
(* 26 - break not needed for TTY *)
      BLOCK(NIL,BLOCKBEGSYS OR STATBEGSYS-[CASESY],[PERIOD]);

(* 104 - detect programs that don't fit in address space *)
      if (highestcode > 777777B) or (lcmain > 377777B)
	then error(266);

(* 5 - CREF *)
      IF CREF
        THEN WRITE(CHR(16B),CHR(10),'.GLOBAL.  ');

(* 16 - EOF *)
      ENDOFLINE(TRUE);
(* 5 - CREF *)
      if cref and not eof(input)
	then write(chr(177B),'A'); %balances <ro>B from ENDOFLINE\
(* 136 - LISTING FORMAT *)
      NEWLINE ; NEWLINE ;
       IF NOT ERRORFLAG
       THEN
	 BEGIN
(* 4 - Make us look normal if called by COMPIL *)
	  WRITE('No ') ; IF NOT RPGENTRY THEN WRITE(TTY,'No ')
	 END
       ELSE WRITE(TTY,'?');
(* 136 - LISTING FORMAT *)
      WRITE('error detected') ; NEWLINE;
      IF (NOT RPGENTRY) OR ERRORFLAG 
        THEN
(* 26 - break not needed for TTY *)
          WRITELN(TTY,'error detected');
       IF ERRORFLAG
(* 112 - clrbfi when error *)
	THEN BEGIN
	REWRITE(OUTPUTREL);
        clribf;
        end
       ELSE IF NOT RPGENTRY THEN
	 BEGIN
(* 136 - LISTING FORMAT *)
	  WRITELN(TTY); NEWLINE;
	  I := (HIGHESTCODE - 400000B + 1023) DIV 1024;
	  WRITELN(TTY,'Highseg: ',I:3,'K'); WRITELN('Highseg: ',I:3,'K');
	  I := (LCMAIN + 1023) DIV 1024;
	  WRITELN(TTY,'Lowseg : ',I:3,'K'); WRITELN('Lowseg : ',I:3,'K');
	 END;
(* 4 - Make us look normal if called by COMPIL *)
      IF  NOT RPGENTRY THEN BEGIN
      RTIME := RUNTIME - RTIME;
      WRITE(TTY,'Runtime: ',(RTIME DIV 60000):3,':');
      RTIME := RTIME MOD 60000;
      WRITE(TTY,(RTIME DIV 1000):2,'.');
      RTIME := RTIME MOD 1000;
      WRITELN(TTY,RTIME:3)
(* 4 - get back to SCAN if appropriate *)
      END;
     PASXIT(INPUT,OUTPUT,OUTPUTREL)
     END.