  %$W-,X+\
  %$R-\


  %*********************************************************
   *                                                       *
   *                                                       *
   *     STEP-WISE DEVELOPMENT OF A PASCAL COMPILER        *
   *     ******************************************        *
   *                                                       *
   *                                                       *
   *     STEP 5:   SYNTAX ANALYSIS INCLUDING ERROR         *
   *               HANDLING; CHECKS BASED ON DECLARATIONS  *
   *                                                       *
   *     AUTHOR:   URS AMMANN                              *
   *               FACHGRUPPE COMPUTERWISSENSCHAFTEN       *
   *               EIDG. TECHNISCHE HOCHSCHULE             *
   *               CH-8006 ZUERICH                         *
   *                                                       *
   *               ADAPTED TO GENERATE CODE FOR A          *
   *               PDP 11 BY:                              *
   *               W. DE VRIES                             *
   *               UNDER GUIDANCE OF DRS C. BRON           *
   *               VAKGROEP  INFORMATICA                   *
   *               TECHNISCHE HOGESCHOOL TWENTE ENSCHEDE   *
   *               APRIL '75                               *
   *                                                       *
   *               CHANGED TO RUN UNDER RSX-11M BY:        *
   *               SEVED TORSTENDAHL                       *
   *               TELEFONAKTIEBOLAGET LM ERICSSON         *
   *               S-126 25  STOCKHOLM                     *
   *							   *
   *	 MODIFIED: BY GERRY PELLETIER			   *
   *		   TRANSPORT CANADA			   *
   *		   TRANSPORT CANADA BUILDING		   *
   *		   PLACE DE VILLE			   *
   *		   OTTAWA, ONTARIO, CANADA		   *
   *                                                       *
   *********************************************************\

CONST
  CVERSION = ' 5.312    ';
  DISPLIMIT = 20;  MAXADDR = 32767;
  MAXSTRGUB = 77;           %MAXIMUM STRINGLENGTH = 78\
  STARTADDR = 00000B;
  CIXMAX = 32767;   CODEMAX = 32767;
  ALFALENG = 10;
  OPTIONCONSTR = '$' ;
  SRCNESTMAX = 3   % MAX 3 LEVELS OF SROURCE CODE NESTING \;

  MAXFILES = 5 ;
  TEXTBUFFSIZE = 132 % BYTES \ ;
  FILESIZECORR = 104 % BYTES \ ;
  FDBSIZE = 96 % BYTES \ ;
  % RECORD \
  % FDB: FILE DESCR BLOCK \
  EOLNSTATUS = -8; % EOLN: BOOLEAN \
  EOFSTATUS = -6; % EOF: BOOLEAN \
  IORESULT = -4  % IORESULT:INTEGER \ ;
  % FILTYP: SET OF [RANDOM,UPDATE,APPEND,TEMPORARY,INSERT,SHARED,SPOOL] \


  %ADDRESSES OF  'PREDECLARED' VARIABLES \
  %WHICH BY THEIR ADDRESS HAVE THE STATUS OF \
  %PARAMETERS TO THE MAIN PROGRAM.\

  DAPADDR = 8; MARKADDR = 6;  LINEADDR = 2;


  %NAMES OF THE PDP11-INSTRUCTIONS THAT MAY \
  %APPEAR IN THE INLINE CODE \


  %NAMES OF THE PDP11 REGISTERS \

  AR = 0; R = 1; AD = 2; GP = 3; MP = 4; SP = 5; HP = 6; PC = 7;

  %NAMES REPRESENTING THE PDP11 ADDRESSING- \
  % MODES \
  REG = 0;  REGDEF = 8;  AUTINC = 16;  AUTDEC = 32;
  AUTINCDEF = 24;  AUTDECDEF = 40;  INDEX = 48;  INDEXDEF = 56;

  OBJECTRECSIZE = 25 ;   GBLDFMAX = 30 ;
  PSECTDEFFLAGS = 2450B ; GLOBALDEFFLAGS = 2150B ;
  GLOBALREFFLAGS = 2100B ;
  RELOCFCN = 6 ; % GLOBAL ADDITIVE DISPLACED RELOCATION\

TYPE
  %DESCRIBING:\
  %***********\

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

  INSTRRANGE = (CLRB,MOVB,CMPB,CLR,DEC,INC,NEG,TST,COM,ASL,ASR,HALT,
		JMP,JSR,SOB,XOR,MULT,DIVV,TRAP,EMT,MOV,ADD,SUB,CMP,
		BIS,BIT,BIC,BR,BEQ,BNE,BGE,BGT,BLE,BLT,BPL,BMI,RTI,RTS) ;
  SYMBOL = (IDENT,INTCONST,REALCONST,STRINGCONST,NOTSY,MULOP,ADDOP,RELOP,
	    LPARENT,RPARENT,LBRACK,RBRACK,COMMA,SEMICOLON,PERIOD,ARROW,
	    COLON,BECOMES,LABELSY,CONSTSY,TYPESY,VARSY,LOCALSY,FUNCTIONSY,
	    PROCEDURESY,SETSY,PACKEDSY,ARRAYSY,RECORDSY,FILESY,FORWARDSY,
	    BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY,LOOPSY,
	    GOTOSY,EXITSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY,
	    THENSY,OTHERSY,DEFAULTSY,EXTERNALSY);
  OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,GEOP,GTOP,
	      NEOP,EQOP,INOP,NOOP);
  SETOFSYS = SET OF SYMBOL;
  BOOLARR = PACKED ARRAY ['A'..'Z'] OF BOOLEAN;

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

  CSTCLASS = (REEL,PSET,STRG);
  CSP = ^ CONSTANT;
  CONSTANT = RECORD
	       SELFCSP: INTEGER;   NOCODE: INTEGER;
	       CASE CSTCLASS OF  %CCLASS NEVER SET NORE TESTED\
		    REEL: (HEAD,TAIL: INTEGER; RVAL: REAL);
		    PSET: (PVAL: SET OF 0..63);
		    STRG: (SLGTH: 0..MAXSTRGUB;
			   SVAL: ARRAY [0..MAXSTRGUB]  OF CHAR)
	     END;

  VALU = RECORD
	   CASE BOOLEAN OF  %INTVAL NEVER SET NORE TESTED\
		TRUE:  (IVAL: INTEGER);
		FALSE: (VALP: CSP)
	 END;

  %DATA STRUCTURES\
  %***************\
  LEVRANGE = 0..MAXADDR; ADDRRANGE = -MAXADDR..MAXADDR;
  STRUCTFORM = (SCALAR,SUBRANGE,POINTER,POWER,ARRAYS,RECORDS,FILES,
		BOUNDLESS,TAGFWITHID,TAGFWITHOUTID,VARIANT,STRINGPARM);
  DECLKIND = (STANDARD,DECLARED);
  STP = ^ STRUCTURE; CTP = ^ IDENTIFIER;
  INTP = ^ INTEGER;

  STRUCTURE = PACKED RECORD
		       SELFSTP: INTEGER;   NOCODE: BOOLEAN;
		       SIZE: ADDRRANGE;
		       CASE FORM: STRUCTFORM OF
			    SCALAR:   (CASE SCALKIND: DECLKIND OF
					    DECLARED: (FCONST: CTP));
			    SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU);
			    POINTER:  (ELTYPE: STP);
			    POWER:    (ELSET: STP);
			    ARRAYS:   (AELTYPE,INXTYPE: STP;
				       ADDRCORR: INTEGER;  PACKOPT: BOOLEAN);
			    RECORDS:  (FSTFLD: CTP; RECVAR: STP; PACKSTRUCT: BOOLEAN);
			    FILES:    (FILTYPE: STP);
			    BOUNDLESS:(SUBSTRUCT,INDEXTYPE: STP;
				       UNSPECLEVEL: INTEGER);
			    TAGFWITHID,
			    TAGFWITHOUTID:(FSTVAR: STP;
					   CASE  BOOLEAN OF
					   TRUE:  (TAGFIELDP: CTP);
					   FALSE: (TAGFIELDTYPE: STP));
			    VARIANT:  (NXTVAR,SUBVAR: STP; VARVAL: VALU)
		     END;

  %NAMES\
  %*****\

  IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC);
  SETOFIDS = SET OF IDCLASS;
  IDKIND = (ACTUAL,FORMAL);
  ALFA = PACKED ARRAY [1..ALFALENG] OF CHAR;
  FORWARDOREXT = (INTERNAL,FORWDECL,FORWFOUND,EXTRNL,
		  EXTERNALTX,EXTERNFORTRAN) ;
  CODERANGE = 0 .. CODEMAX ;
  ALFAP = ^ ALFA ;

  IDENTIFIER = PACKED RECORD
			SELFCTP: INTEGER;   NOCODE: BOOLEAN;
			NAME: ALFA; LLINK, RLINK: CTP;
			IDTYPE: STP; NEXT: CTP;
			CASE KLASS: IDCLASS OF
			     KONST: (VALUES: VALU; KADDR: CODERANGE);
			     VARS:  (VKIND: IDKIND; VLEV: LEVRANGE; VADDR: ADDRRANGE);
			     FIELD: (FLDADDR: ADDRRANGE);
			     PROC,
			     FUNC:  (CASE PFDECKIND: DECLKIND OF
					  STANDARD: (KEY: 1..25);
					  DECLARED: (PFLEV: LEVRANGE;
						     PFADDR, PARLISTSIZE: ADDRRANGE;
						     CASE PFKIND: IDKIND OF
							  ACTUAL: (DECLPLACE: FORWARDOREXT;
								   EXTNAME: ALFAP);
							  FORMAL: (PARMLIST: CTP)))
		      END;


  DISPRANGE = 0..DISPLIMIT;
  WHERE = (BLCK,CREC,VREC);



  %NAMES OF THE RUNTIMEROUTINES \

  RUNTIMEROUTS = (ERRN,
		  EQUR,NEQR,LESR,LEQR,GRTR,GEQR,ADR,SBR,
		  SQRR,MPR,DVR,FLO,FLT,TRC,RND,EXITP,
		  GRTM,GRTM2,LESM,LESM2,GEQM,GEQM2,LEQM,LEQM2,
		  EQUM,EQUM2,EQUS4,NEQM,NEQM2,NEQS4,
		  EQU,NEQ,GRT,GEQ,LES,LEQ,
		  DVI,MODI,SQI,MPI,
		  MOVM,MOVM2,
		  WRCHA,INN,SGSIN,INITS,UNI4,INT4,DIF4,
		  EXPST,EXPSN,REDST,REDSN,
		  IXB,STPB,LPB,CLRAREA,CLRSTK,
		  RDC,RDI,RDR,RDREC,WRREC,RDSTR,
		  WRC,WRS,WRI,WRR,
		  MARKP,RELEASEP,OVFLCHK,SUBRCHK,
		  LEQS1,LEQS4,GEQS1,GEQS4,
		  TRACK,FREQV,DDTINIT,
		  GETCH,GETLINE,INITA,WRIOCT,RESETF,REWRITEF,
		  PUTCH,PUTLINE,
		  BRK,FORMFD,RUNTM,TIME1,DATE1,WRB,WRBFX,
		  GETR,PUTR,DUMP,WRFIX,FORTR,TTPAR,MOVTS,
		  MOVFS,MOVMR,TWPOW,SPLTRL,RSIN,RCOS,
		  RARCTAN,REXP,RLOG,RSQRT,SUBSTRCHECK,
		  STRINGINDEX,DUMRTR);


  %EXPRESSIONS\
  %***********\
  ATTRKIND = (CST,VARBL,EXPR);
  VACCESS = (DRCT, INDRCT, PACKD);

  ATTR = RECORD
	   TYPTR: STP;
	   CASE KIND: ATTRKIND OF
		CST:   (CVAL: VALU);
		VARBL: (CASE ACCESS: VACCESS OF
			     DRCT: (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE);
			     INDRCT: (IDPLMT: ADDRRANGE))
	 END;

  %LABELS\
  %******\
  REFLINKP = ^ REFLINK ;
  REFLINK = RECORD
	      NEXTREF: REFLINKP; REFADDR: ADDRRANGE
	    END;
  LBP = ^ LABL;
  LABL = RECORD
	   NEXTLAB: LBP;
	   LABVAL: INTEGER;
	   DECLARED: BOOLEAN;
	   CASE DEFINED: BOOLEAN OF
		TRUE: (LABADDR: ADDRRANGE);
		FALSE: (LABCHAIN: REFLINKP)
	 END;

  % CODE GENERATION \
  %*****************\

  TEXT = FILE OF CHAR;
  INTFILE = FILE OF INTEGER;
  GBLDFRANGE = 0 .. GBLDFMAX ;
  OBJECTRECORD = RECORD
		   LEN: 1..OBJECTRECSIZE ;
		   VALUE: ARRAY [1..OBJECTRECSIZE] OF INTEGER
		 END;

  TEXTFDB = ARRAY [-19..0] OF INTEGER;
  LINEBUFF = PACKED ARRAY [1..80] OF CHAR;
  STR20 = PACKED ARRAY [0..20] OF CHAR;
  SRCDESCR = RECORD
		FDB: TEXTFDB;
		FNAME: STR20;
		LINNR: INTEGER
	     END;

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)\
  KK: 1..ALFALENG;                %NR OF CHARS IN LAST IDENTIFIER\
  CH: CHAR;                       %LAST CHARACTER\


  % OBJECT CODE GENERATION \
  %************************\


  GSD,CODE,RLD: OBJECTRECORD ;    % EGSD,EM \
  PSECT,OBJIDENT: ALFA ;          % CURRENT PSECTION NAME \
  GLOBALENTRY: ARRAY [GBLDFRANGE] OF
  RECORD
    R50P1,R50P2,EPADDR:INTEGER
  END;
  GLOBALINDEX: GBLDFRANGE ; % POINTER IN GLOBALENTRY\
  NOTCALLED: PACKED ARRAY [ RUNTIMEROUTS] OF BOOLEAN ;

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

  RTR: RUNTIMEROUTS;              %RUNTIMEROUTINECOUNTER\
  CIXX: INTEGER;
  DATASIZE,
  I, RTIME: INTEGER;              %RUNTIME COUNT/CONTRL VAR\
  CHCNT: INTEGER;                 %CHARACTER COUNTER\
  CIX: INTEGER;                   %COMPILER-INSTRUCTIONCOUNTER\
  LC: INTEGER;                    %DATA LOCATION\
  PDPWORD, CHECKSUM: INTEGER;
  OLDLINENO,LINEWIDTH,POINTERCNT,
  LINENO,PAGENO,LINECNT,PAGEWIDTH: INTEGER;

  EPMAIN: CODERANGE;              %STARTADDRESS OF MAIN PROGRAM\
  SELECTOR,			  %RUNTIME ERROR BEHAVIOUR SELECTION\
  DEFLEVEL: INTEGER;		  % DEFAULT DECLARATION LEVEL \

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

  INTPROC,                        %INTERRUPT PROCEDURES\
  ERRDETECTED,                    %DETECTION OF ERRORS\
  DP,                             %DECLARATION PART\
  PRTERR,                         %TO ALLOW FORWARD REFERENCES IN POINTER TYPE
				   DECLARATION BY SUPPRESSING ERROR MESSAGE\
  PAGEEJECT,			  %PREMATURE PAGE EJECT\
  LIST,PRCODE,
  MAIN,                           %MAIN PROGRAM OR PROCEDUREONLY\
  TRACE,			  % TUNTIME TRACE OF EXECUTED STATEMENTS\
  DEBUG,			  % DEBUG SELECTOR \
  FREQUENCE,			  % MEASUREMENT OF STATEMENT EXECUTION FREQUENCIES\
  CONDCOMP,                       % CONDITIONAL COMPILATION \
  WARNINGS,                       % WARNING MESSAGES \
  HEAPCHECK,                      %RUNTIME CHECK OF HEAP VS STACK\
  CXPOPENED,                      %BOOKKEEPING OF CEX STATUS\
  RUNTMCHECK,                     %OUTPUT OPTIONS FOR
				   -- SOURCE PROGRAM LISTING
				   -- PRINTING SYMBOLIC CODE
				   -- RUNTIME CHECKING
				   --> PROCEDURE OPTION\
  PSECTGEN,                       %   -- PSECTION GENERATION\
  FIRSTMODULE,                    % TO GENERATE MODULE ID \

  EXTSET, FPPUNIT,               % OPTIONS FOR CODEGENERATION:
				  --EXTENDED PDP11 INSTRUCTIONSET
				  --FLOATING POINT PROCESSOR\
  FLTSET           : BOOLEAN;     % FLOATING POINT INSTRUCTION SET \
  ONSWITCH,OFFSWITCH: BOOLARR;


  %POINTERS:\
  %*********\
  INTPTR,REALPTR,CHARPTR,IOSPECPTR,
  BOOLPTR,NILPTR,TEXTPTR: STP;    %POINTERS TO ENTRIES OF STANDARD IDS\
  INPUTPTR,OUTPUTPTR,
  TTYINPTR,TTYOUTPTR,             %POINTERS TO STANDARD FILES\
  UTYPPTR,UCSTPTR,UVARPTR,
  UFLDPTR,UPRCPTR,UFCTPTR,        %POINTERS TO ENTRIES FOR UNDECLARED IDS\
  FWPTR: CTP;                     %HEAD OF CHAIN OF FORW DECL TYPE IDS\
  FSTLABP: LBP;                   %HEAD OF LABEL CHAIN\


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

  LEVEL: 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\
	   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\
		       CDSPL: ADDRRANGE);%         VARIABLE ADDRESS\
		VREC: (VDSPL: ADDRRANGE)
	 END;                      % --> PROCEDURE WITHSTATEMENT\


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

  ERRINX: 0..10;                  %NR OF ERRORS IN CURRENT SOURCE LINE\
  ERRLIST:
  ARRAY [1..10] OF
  PACKED RECORD
	   POS: INTEGER;
	   NMR: 1..999
	 END;


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

  GATTR: ATTR;                    %DESCRIBES THE EXPR CURRENTLY COMPILED\


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

  LETTERS,DIGITS: SET OF CHAR;
  CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS,
  STATBEGSYS,TYPEDELS: SETOFSYS;
  RW:  ARRAY [1..38%NR. OF RES. WORDS\] OF ALFA;
  FRW: ARRAY [1..11%ALFALENG+1\] OF 1..39%NR. OF RES. WORDS + 1\;
  RSY: ARRAY [1..38%NR. OF RES. WORDS\] OF SYMBOL;
  SSY: ARRAY [' '..'_'] OF SYMBOL;
  ROP: ARRAY [1..38%NR. OF RES. WORDS\] OF OPERATOR;
  SOP: ARRAY [' '..'_'] OF OPERATOR;
  INSTRVAL: ARRAY[INSTRRANGE] OF INTEGER ;
  RNA: ARRAY[RUNTIMEROUTS] OF PACKED ARRAY[0..4] OF CHAR; %RUNTIME NAMES\
  (*$Z+*)
  REGNAMES: ARRAY [0..7] OF PACKED ARRAY[0..1] OF CHAR;
  MN: ARRAY[INSTRRANGE] OF PACKED ARRAY[0..2] OF CHAR;     %DISSEMBLER\
  (*$Z-*)

  ARRT : ARRAY [LTOP..EQOP,BOOLEAN,BOOLEAN] OF RUNTIMEROUTS;
  SCALRT : ARRAY [LTOP..EQOP,BOOLEAN] OF RUNTIMEROUTS;
  VERSION, TIMESTR, DATESTR:  ALFA;

  PDP11OBJ: TEXT ;                %OBJECT CODE FILE FOR PDP-11 COMPILER\
  (*$Z+*)
  OUTPUTHGH: FILE OF INTEGER;     %CODE FILE IN BIN. FORMAT\
  CEX: FILE OF CHAR ;             %CODE EXPANSION LIST FILE \
  (*$Z-*)
  FILENAME: STR20;                %NAME OF INPUT FILE\
  MCRLINE: LINEBUFF;
  MCRLEN: INTEGER;
  SRCLEVEL: -1..SRCNESTMAX;
  SRCNEST: ARRAY [1..SRCNESTMAX] OF SRCDESCR;
 
 
  % DEBUG \
  %*******\
 
  LASTLINE: RECORD
		LLADDR: ADDRRANGE;
		LLPSECT: ALFA
	    END;
  DCIX: INTEGER   % POINTER IN PSECT $DDTDF \;
  IDRECSIZE: ARRAY [ IDCLASS ] OF INTEGER;
  STRECSIZE: ARRAY [ STRUCTFORM ] OF INTEGER;

  PROCEDURE SWITCHINIT( VAR I1,I2,I3: INTEGER;  VAR B1,B2,B3,B4,B5,
			B6,B7,B8,B9,B10,B11,B12,B13,B14: BOOLEAN );   EXTERN;
 

  PROCEDURE INITTABLES  ;
   BEGIN

    % INITPROCEDURE \  %RUNTIMEROUTINEMNEMONICS\
     BEGIN
      RNA[ERRN] := 'ERRN ';
      RNA[EQUR] := 'EQUR '; RNA[NEQR] := 'NEQR '; RNA[LESR] := 'LESR ';
      RNA[LEQR] := 'LEQR '; RNA[GRTR] := 'GRTR '; RNA[GEQR] := 'GEQR ';
      RNA[ADR] := 'ADDR '; RNA[SBR] := 'SUBR ';
      RNA[SQRR] := 'SQRR '; RNA[MPR] := 'MULR '; RNA[DVR] := 'DIVR ';
      RNA[FLO] := 'FLO  '; RNA[FLT] := 'FLT  '; RNA[TRC] := 'TRC  ';
      RNA[RND] := 'RND  '; RNA[EXITP] := 'EXITP';
      RNA[GRTM] := 'GRTM '; RNA[GRTM2] := 'GRTM2'; RNA[LESM] := 'LESM ';
      RNA[LESM2] := 'LESM2'; RNA[GEQM] := 'GEQM '; RNA[GEQM2] := 'GEQM2';
      RNA[LEQM] := 'LEQM '; RNA[LEQM2] := 'LEQM2'; RNA[EQUM] := 'EQUM ';
      RNA[EQUM2] := 'EQUM2'; RNA[EQUS4] := 'EQUS4'; RNA[NEQM] := 'NEQM ';
      RNA[NEQM2] := 'NEQM2'; RNA[NEQS4] := 'NEQS4';
      RNA[EQU] := 'EQU  '; RNA[NEQ] := 'NEQ  '; RNA[GRT] := 'GRT  ';
      RNA[GEQ] := 'GEQ  '; RNA[LES] := 'LES  '; RNA[LEQ] := 'LEQ  ';
      RNA[DVI] := 'DIVI '; RNA[MODI] := 'MODI '; RNA[SQI] := 'SQI  ';
      RNA[MPI] := 'MULI ';
      RNA[MOVM] := 'MOVM '; RNA[MOVM2] := 'MOVM2';
      RNA[WRCHA] := 'WRCHA'; RNA[INN] := 'INN  '; RNA[SGSIN] := 'SGSIN';
      RNA[INITS] := 'INITS'; RNA[UNI4] := 'UNI4 '; RNA[INT4] := 'INT4 ';
      RNA[DIF4] := 'DIF4 ';
      RNA[EXPST] := 'EXPST'; RNA[EXPSN] := 'EXPSN'; RNA[REDST] := 'REDST';
      RNA[REDSN] := 'REDSN';
      RNA[IXB] := 'IXB  '; RNA[STPB] := 'STPB '; RNA[LPB] := 'LPB  ';
      RNA[CLRAREA] := 'CLRAR'; RNA[CLRSTK] := 'CLRST';
      RNA[RDC] := 'RDC  '; RNA[RDI] := 'RDI  '; RNA[RDR] := 'RDR  ';
      RNA[RDREC] := 'RDREC'; RNA[WRREC] := 'WRREC'; RNA[RDSTR] := 'RDSTR';
      RNA[WRC] := 'WRC  '; RNA[WRS] := 'WRS  '; RNA[WRI] := 'WRI  ';
      RNA[WRR] := 'WRR  ';
      RNA[MARKP] := 'MARKP'; RNA[RELEASEP] := 'RELEA'; RNA[OVFLCHK] := 'OVFLC';
      RNA[SUBRCHK] := 'SUBRC';
      RNA[LEQS1] := 'LEQS1'; RNA[LEQS4] := 'LEQS4';
      RNA[GEQS1] := 'GEQS1'; RNA[GEQS4] := 'GEQS4';
      RNA[TRACK] := 'P.TRC';  RNA[FREQV] := 'P.FRQ';  RNA[DDTINIT] := 'P.DDT';
      RNA[GETCH] := 'GET  '; RNA[GETLINE] := 'GETLN'; RNA[INITA] := 'INITA';
      RNA[WRIOCT] := 'WROCT'; RNA[RESETF] := 'RESET'; RNA[REWRITEF] := 'REWRI';
      RNA[PUTCH] := 'PUT  '; RNA[PUTLINE] := 'PUTLN';
      RNA[BRK] := 'BRK  '; RNA[FORMFD] := 'PAGE '; RNA[RUNTM] := 'RUNTM';
      RNA[TIME1] := 'TIME '; RNA[DATE1] := 'DATE '; RNA[WRB] := 'WRB  ';
      RNA[WRBFX] := 'WRBFX'; RNA[GETR] := 'GETRM'; RNA[PUTR] := 'PUTRM';
      RNA[DUMP] := 'DUMP '; RNA[WRFIX] := 'WRFIX'; RNA[FORTR] := 'FORTR';
      RNA[TTPAR] := 'TTPAR'; RNA[MOVTS] := 'MOVTS'; RNA[MOVFS] := 'MOVFS';
      RNA[MOVMR] := 'MOVMR'; RNA[TWPOW] := 'TWPOW'; RNA[SPLTRL] := 'SPTRL';
      RNA[RSIN] := 'RSIN '; RNA[RCOS] := 'RCOS '; RNA[RARCTAN] := 'ARCTN';
      RNA[REXP] := 'REXP '; RNA[RLOG] := 'RLOG '; RNA[RSQRT] := 'RSQRT';
      RNA[SUBSTRCHECK] := 'STRCH'; RNA[STRINGINDEX] := 'STIND';
     END;
    %RTRMNEMONICS\

    (*$Z+*)
    % INITPROCEDURE \  %INSTRMNEMONICS\
     BEGIN
      REGNAMES[0] := 'AR'; REGNAMES[1] := 'R ';
      REGNAMES[2] := 'AD'; REGNAMES[3] := 'GP';
      REGNAMES[4] := 'MP'; REGNAMES[5] := 'SP';
      REGNAMES[6] := 'HP'; REGNAMES[7] := 'PC';
      MN[CLRB] := 'CLR'; MN[MOVB] := 'MOV'; MN[CMPB] := 'CMP';
      MN[CLR] := 'CLR'; MN[DEC] := 'DEC'; MN[INC] := 'INC';
      MN[TST] := 'TST'; MN[COM] := 'COM'; MN[ASL] := 'ASL'; MN[ASR] := 'ASR';
      MN[JMP] := 'JMP'; MN[JSR] := 'JSR'; MN[SOB] := 'SOB'; MN[MULT] :='MUL';
      MN[DIVV] := 'DIV'; MN[XOR] := 'XOR'; MN[BR] := 'BR '; MN[BEQ] := 'BEQ';
      MN[BNE] := 'BNE'; MN[BGE] := 'BGE'; MN[BGT] := 'BGT'; MN[BLE] := 'BLE';
      MN[BLT] := 'BLT'; MN[BPL] := 'BPL'; MN[BMI] := 'BMI'; MN[MOV] := 'MOV';
      MN[ADD] := 'ADD'; MN[SUB] := 'SUB'; MN[CMP] := 'CMP'; MN[BIS] := 'BIS';
      MN[BIT] := 'BIT'; MN[BIC] := 'BIC'; MN[RTS] := 'RTS';
      MN[NEG] := 'NEG'; MN[HALT] := 'HLT'; MN[TRAP] := 'TRP';
      MN[EMT] := 'EMT'; MN[RTI] := 'RTI'
     END %INSTRMNEMONICS\
    (*$Z-*)
   END;   % INITTABLES \

  PROCEDURE INITTB;   (*$Y+ SEPERATE MODULE *)
   BEGIN
    % INITPROCEDURE \ %INITSCALARS\
     BEGIN
      FWPTR := NIL ;   FSTLABP := NIL ;
      ERRDETECTED := FALSE;   SRCLEVEL := 0;

      FOR CH:='A' TO 'Z' DO BEGIN ONSWITCH[CH]:=FALSE; OFFSWITCH[CH]:=FALSE END;
      SWITCHINIT( DEFLEVEL,PAGEWIDTH,LINEWIDTH,EXTSET,FLTSET,FPPUNIT,LIST,
		  PRCODE,CONDCOMP,WARNINGS,RUNTMCHECK,HEAPCHECK,MAIN,PSECTGEN,
		  TRACE,DEBUG,FREQUENCE);
      IDRECSIZE[TYPES] := 12;   IDRECSIZE[KONST] := 14;   IDRECSIZE[VARS] := 15;
      IDRECSIZE[FIELD] := 13;   IDRECSIZE[PROC] := 19;   IDRECSIZE[FUNC] := 19;
      STRECSIZE[SCALAR] := 6;   STRECSIZE[SUBRANGE] := 7;   STRECSIZE[POINTER] := 5;
      STRECSIZE[POWER] := 5;   STRECSIZE[ARRAYS] := 8;   STRECSIZE[RECORDS] := 7;
      STRECSIZE[FILES] := 5;   STRECSIZE[BOUNDLESS] := 7;   STRECSIZE[VARIANT] := 7;
      STRECSIZE[TAGFWITHID] := 6;   STRECSIZE[TAGFWITHOUTID] := 7;
      PAGEEJECT := FALSE;   POINTERCNT := 0;
      CIX := -1 ;    GLOBALINDEX := 0 ;    DCIX := -1;
      PSECT := '.MAIN.    ';   OBJIDENT := '          ';
      CXPOPENED := 100000B<0 %TRUE FOR PDP 11\ ;  FIRSTMODULE := TRUE;
      DP := TRUE; PRTERR := TRUE; ERRINX := 0;
      KK := ALFALENG; CH := ' '; LC := -2; CHCNT := 0;
      LINENO := 1;  PAGENO := 0;  LINECNT := 1;
      VERSION := CVERSION
     END %INITSCALARS\ ;

    % INITPROCEDURE \  %INITSETS\
     BEGIN
      DIGITS := ['0','1','2','3','4','5','6','7','8','9'];
      LETTERS := ['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'];
      CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT];
      SIMPTYPEBEGSYS := [ LPARENT , ADDOP , INTCONST , REALCONST , STRINGCONST , IDENT ] ;
      TYPEBEGSYS := [ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY,LPARENT,ADDOP,
		     INTCONST,REALCONST,STRINGCONST,IDENT];
      TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];
      BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,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,LOCALSY];
     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] := 'LABEL     '; RW[29] := 'CONST     '; RW[30] := 'OTHERS    ';
      RW[31] := 'REPEAT    '; RW[32] := 'RECORD    '; RW[33] := 'DOWNTO    ';
      RW[34] := 'PACKED    '; RW[35] := 'EXTERN    '; RW[36] := 'FORWARD   ';
      RW[37] := 'FUNCTION  '; RW[38] := 'PROCEDURE ';
      FRW[1] :=  1; FRW[2] :=  1; FRW[3] :=  7; FRW[4] := 15; FRW[5] := 24;
      FRW[6] := 30; FRW[7] := 36; FRW[8] := 37; FRW[9] := 38; FRW[10] := 39;
      FRW[11] := 39;
     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] := LABELSY; RSY[29] := CONSTSY; RSY[30] := DEFAULTSY;
      RSY[31] := REPEATSY; RSY[32] := RECORDSY; RSY[33] := DOWNTOSY;
      RSY[34] := PACKEDSY; RSY[35] := EXTERNALSY; RSY[36] := FORWARDSY;
      RSY[37] := FUNCTIONSY; RSY[38] := PROCEDURESY;

      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\

   END;  % INITTB \

  PROCEDURE INIT2 (*$Y+*) ;
   BEGIN

    % 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;

      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['E'] := NOOP; SOP['F'] := NOOP; SOP['G'] := NOOP; SOP['H'] := NOOP;
      SOP['A'] := NOOP; SOP['B'] := NOOP; SOP['C'] := NOOP; SOP['D'] := 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\
     END;

    % INITPROCEDURE \   %INSTRUCTIONVALUES\
     BEGIN
      INSTRVAL[MOVB]:=110000B; INSTRVAL[CLRB]:=105000B; INSTRVAL[CMPB]:=120000B;
      INSTRVAL[CLR]:=005000B; INSTRVAL[DEC]:=005300B; INSTRVAL[INC]:=005200B;
      INSTRVAL[NEG]:=005400B; INSTRVAL[TST]:=005700B; INSTRVAL[COM]:=005100B;
      INSTRVAL[ASL]:=006300B; INSTRVAL[ASR]:=006200B; INSTRVAL[JMP]:=000100B;
      INSTRVAL[JSR]:=004000B; INSTRVAL[SOB]:=077000B; INSTRVAL[XOR]:=074000B;
      INSTRVAL[MULT]:=070000B; INSTRVAL[TRAP]:=104400B; INSTRVAL[EMT]:=104000B;
      INSTRVAL[BR]:= 000400B; INSTRVAL[BEQ]:=001400B; INSTRVAL[BNE]:=001000B;
      INSTRVAL[BGE]:=002000B; INSTRVAL[BGT]:=003000B; INSTRVAL[BLE]:=003400B;
      INSTRVAL[BLT]:=002400B; INSTRVAL[BPL]:=100000B; INSTRVAL[BMI]:=100400B;
      INSTRVAL[MOV]:=010000B; INSTRVAL[ADD]:=060000B; INSTRVAL[SUB]:=160000B;
      INSTRVAL[CMP]:=020000B; INSTRVAL[BIS]:=050000B; INSTRVAL[BIT]:=030000B;
      INSTRVAL[BIC]:=040000B; INSTRVAL[RTS]:=000200B; INSTRVAL[RTI]:=000002B;
     END  % INSTUCTIONVALUES \ ;
    TIMESTR := '          ';  DATESTR := '18-OCT-76 ';
    FOR RTR := ERRN TO DUMRTR DO
    NOTCALLED[RTR] := TRUE;
    % INITPROCEDURE \ %ARRAYS FOR EXPRESSION: CALLS OF RUNTIMEROUTINES\
     BEGIN
      SCALRT[LEOP,FALSE] := LEQ; SCALRT[LEOP,TRUE] := LEQR;
      SCALRT[GEOP,FALSE] := GEQ; SCALRT[GEOP,TRUE] := GEQR;
      SCALRT[GTOP,FALSE] := GRT; SCALRT[GTOP,TRUE] := GRTR;
      SCALRT[LTOP,FALSE] := LES; SCALRT[LTOP,TRUE] := LESR;
      SCALRT[EQOP,FALSE] := EQU; SCALRT[EQOP,TRUE] := EQUR;
      SCALRT[NEOP,FALSE] := NEQ; SCALRT[NEOP,TRUE] := NEQR;
      ARRT[LTOP,FALSE,FALSE] := ERRN ; ARRT[LTOP,FALSE,TRUE] := ERRN ;
      ARRT[LTOP,TRUE ,FALSE] := LESM ; ARRT[LTOP,TRUE ,TRUE] := LESM2;
      ARRT[LEOP,FALSE,FALSE] := ERRN ; ARRT[LEOP,FALSE,TRUE] := ERRN ;
      ARRT[LEOP,TRUE ,FALSE] := LEQM ; ARRT[LEOP,TRUE ,TRUE] := LEQM2;
      ARRT[GEOP,FALSE,FALSE] := ERRN ; ARRT[GEOP,FALSE,TRUE] := ERRN ;
      ARRT[GEOP,TRUE ,FALSE] := GEQM ; ARRT[GEOP,TRUE ,TRUE] := GEQM2;
      ARRT[GTOP,FALSE,FALSE] := ERRN ; ARRT[GTOP,FALSE,TRUE] := ERRN ;
      ARRT[GTOP,TRUE,FALSE] := GRTM ; ARRT[GTOP,TRUE ,TRUE] := GRTM2;
      ARRT[NEOP,FALSE,FALSE] := NEQM;  ARRT[NEOP,FALSE,TRUE] := NEQM2;
      ARRT[NEOP,TRUE ,FALSE] := NEQM;  ARRT[NEOP,TRUE ,TRUE] := NEQM2;
      ARRT[EQOP,FALSE,FALSE] := EQUM;  ARRT[EQOP,FALSE,TRUE] := EQUM2;
      ARRT[EQOP,TRUE ,FALSE] := EQUM;  ARRT[EQOP,TRUE ,TRUE] := EQUM2;
     END;
    % INITPROCEDURE \   % OBJECTRECORDS \
     BEGIN
      GSD.VALUE[1] := 1 ;   GSD.LEN := 1 ;
      RLD.VALUE[1] := 4 ;   RLD.LEN := 1 ;
      CODE.VALUE[1] := 3 ;   CODE.LEN := 1 ;
     END  % OBJECTRECORDS \ ;
   END  % INIT2 \ ;

  PROCEDURE WRITOFILE ( VAR REC: OBJECTRECORD ;
		       VAR PDPOBJ: TEXT  (*$Z+*) ;
		       VAR OUTPUTHGH: INTFILE (*$Z-*) );
  EXTERN;



  PROCEDURE READFILEIDENTIFIER( VAR FDL,FPW,PLW: INTEGER;  VAR SWL,SWC: BOOLARR;
	       VAR CML: LINEBUFF;   VAR CMLLEN: INTEGER;
	       VAR FILENAME: STR20 ;
	       VAR PDPOBJ:TEXT ; (*$Z+*) VAR OUTPUTHGH: INTFILE; (*$Z-*)
	       VAR INPUT: TEXT;  VAR OUTPUT: TEXT (*$Z+*) ;  VAR CODE: TEXT (*$Z-*) );
  EXTERN;


(*$Y+ SPLIT MODULES *)

  PROCEDURE NEWPAGE;
   BEGIN
    PAGENO := PAGENO + 1;
    PAGE(OUTPUT);
    WRITELN( 'PASCAL  PDP-11  VERSION ',VERSION,DATESTR:12,' ':6,TIMESTR:8,' ':10,' PAGE ',PAGENO:3);
    WRITELN( FILENAME, ' ':4, OBJIDENT, ' ':4, PSECT );
    WRITELN;    PAGEEJECT := FALSE;
    LINECNT := 0;
   END  % NEWPAGE \ ;

  PROCEDURE WTTERR( N: INTEGER );   EXTERN;

  PROCEDURE WTTINT( N: INTEGER );   EXTERN;

  PROCEDURE WTTEOL;   EXTERN;

  PROCEDURE WTTSTAT( E: BOOLEAN; P,D,DD,T: INTEGER );   EXTERN;

  PROCEDURE WTTHEAD( VAR HDR,DAY,TIM: ALFA );   EXTERN;
 
  PROCEDURE COPYSTP ( SP: STP );   EXTERN;
 
  PROCEDURE COPYCTP ( CP: CTP );   EXTERN;
 
  PROCEDURE SAVEFDB ( VAR FDB: TEXTFDB; VAR F: TEXT;  VAR FN : STR20 );   EXTERN;
 
  PROCEDURE UNSAVEFDB ( VAR F: TEXT;  VAR FDB: TEXTFDB );   EXTERN;
 
  PROCEDURE ERRMES ( N: INTEGER );   EXTERN;
 
  PROCEDURE HEAPMARK( VAR M: INTP );   EXTERN;
 
  PROCEDURE HEAPRELEASE(  M: INTP );   EXTERN;
 
 
 
  PROCEDURE ENDOFLINE; (*$Y- SAME MODULE *)
  VAR
    LASTPOS,FREEPOS,CURRPOS,CURRNMR,F,K: INTEGER;
   BEGIN
    IF ERRINX > 0
    THEN   %OUTPUT ERROR MESSAGES\
     BEGIN
      WTTERR( LINENO );
      FOR K := 1 TO ERRINX DO  BEGIN WTTINT(ERRLIST[K].NMR);
        IF ERRLIST[K].NMR<900 THEN ERRDETECTED := TRUE END;
      WTTEOL;
      IF LIST
      THEN
       BEGIN
        WRITELN; WRITE('*****  ');
        IF PRCODE THEN WRITE(' ':9);
	LASTPOS := 0; FREEPOS := 1;
	FOR K := 1 TO ERRINX DO
	 BEGIN
	  WITH ERRLIST[K] DO
	   BEGIN
	    CURRPOS := POS; CURRNMR := NMR
	   END;
	  IF CURRPOS = LASTPOS
	  THEN WRITE(',')
	  ELSE
	   BEGIN
	    WHILE FREEPOS < CURRPOS DO
	     BEGIN
	      WRITE(' '); FREEPOS := FREEPOS + 1
	     END;
	    WRITE('^');
	    LASTPOS := CURRPOS
	   END;
	  IF CURRNMR < 10
	  THEN F := 1
	  ELSE
	   IF CURRNMR < 100
	   THEN F := 2
	   ELSE F := 3;
	  WRITE(CURRNMR:F);
	  FREEPOS := FREEPOS + F + 1 ;
	 END;
	WRITELN;
	LINECNT := LINECNT + 2;
       END  % IF LIST \ ;
      ERRINX := 0;
     END;
    IF LIST
    THEN
     BEGIN
      WRITELN;
      IF (LINECNT > PAGEWIDTH) OR PAGEEJECT  THEN NEWPAGE;
      LINECNT := LINECNT + 1;
      IF PRCODE THEN
      IF DP
      THEN  WRITE('-',-LC:6:O,'  ')
      ELSE  WRITE(2 * CIX + 2:6:O,'   ');
     END;
    CHCNT := 0;
  IF SRCLEVEL >= 0 THEN
    IF EOLN(INPUT) THEN
     BEGIN
      LOOP   READLN;
      EXIT IF NOT EOF(INPUT);
	IF SRCLEVEL > 0 THEN
	WITH SRCNEST[SRCLEVEL] DO
	 BEGIN   UNSAVEFDB ( INPUT,FDB );
	  FILENAME := FNAME;  SRCLEVEL := SRCLEVEL - 1;
	  LINENO := LINNR;   NEWPAGE
	 END
	ELSE
	 BEGIN   WRITELN('*****   EOF   *****');
	  ERRMES ( 4 % AND EXIT \ );
	 END
      END;
     LINENO := LINENO + 1;
      IF LIST THEN WRITE( LINENO:5,'   ');
     END
    ELSE IF LIST THEN
     BEGIN   WRITE(' ':20);  CHCNT := CHCNT + 12;
     END;
   END  %ENDOFLINE\ ;
 
 
 
  PROCEDURE ERROR(FERRNR: INTEGER);  (*$Y-  SAME MODULE *)
   BEGIN

    IF WARNINGS OR (FERRNR < 900)
    THEN
     BEGIN
      IF ERRINX  >=   9
      THEN
       BEGIN
	ERRLIST[10].NMR := 255; ERRINX := 10
       END
      ELSE
       BEGIN
	ERRINX := ERRINX + 1;
	ERRLIST[ERRINX].NMR := FERRNR
       END;
      ERRLIST[ERRINX].POS := CHCNT
     END  % WARNINGS \
   END %ERROR\ ;

  PROCEDURE INSYMBOL;
    %READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS
     DESCRIPTION IN THE GLOBAL VARIABLES SY, OP, ID, VAL AND LGTH\
  LABEL   1,2;
  CONST
    DIGMAX = 9;
  VAR
    I,J,K,SCALE,EXP,IVAL: INTEGER;
    MANT,RVAL,R,FAC: REAL; CASECONV,STAR,SIGN,OLDLIST: BOOLEAN;
    DIGIT: ARRAY [1..DIGMAX] OF 0..9;
    STRING: ARRAY [0..MAXSTRGUB] OF CHAR;
    LVP: CSP;
    BINEXP, SGN: INTEGER;

    PROCEDURE NEXTCH;  (*$Y-  SAME MODULE AS ERROR *)
    VAR
      ORDCH: 0..255;
     BEGIN
      IF EOLN(INPUT)
      THEN CH :=' '
      ELSE
       BEGIN
	READ(CH);  ORDCH := ORD(CH) ;
	IF ORDCH > 127
	THEN
	 BEGIN
	  ORDCH := ORDCH - 128; CH := CHR(ORDCH)
	 END;
	IF ORDCH < 32  THEN CH := ' ';
	IF LIST
	THEN
	 BEGIN
	  IF ORDCH = 12 %FORM FEED\ THEN PAGEEJECT := TRUE;
          IF ORDCH = 9 %TAB\ THEN
           BEGIN    ORDCH := 7-CHCNT MOD 8;
            WRITE('        ':ORDCH);
            CHCNT := CHCNT + ORDCH;
           END;
	  WRITE(CH); CHCNT := CHCNT+1
	 END;
	IF (ORDCH > 95) AND CASECONV
	THEN
	  BEGIN
	  IF ORDCH = 173B (* LEFT BRACE *) THEN CH := '%'
	  ELSE IF ORDCH = 175B (* RIGHT BRACE *) THEN CH := '\'
	  ELSE  CH := CHR( ORDCH-32 )
	  END
       END  (* ELSE *)
     END;



    PROCEDURE OPTIONS;  (*$Y+ NEW MODULE *)
    VAR
      LCH: CHAR;  B: BOOLEAN;
     BEGIN
       REPEAT
	NEXTCH;     LCH := CH;   NEXTCH;
	IF NOT (CH IN ['+','-'])
	THEN ERROR(902)
	ELSE
	 BEGIN
          IF LCH IN ['A'..'Z']
	  THEN B := (CH = '+') AND NOT OFFSWITCH[LCH] OR ONSWITCH[LCH]
          ELSE B := FALSE;
	   CASE  LCH  OF
	    'C':
		 BEGIN
		  PRCODE := B;       
		  (*$Z+*)
		  IF PRCODE
		  THEN
		   IF CXPOPENED
		   THEN
		     BEGIN
		      WRITELN(CEX); WRITELN(CEX,';************'); WRITELN(CEX)
		     END
		   ELSE
		     BEGIN
		      CXPOPENED := TRUE; REWRITE(CEX,FILENAME)
		     END
		      (*$Z-*)
		 END;
      'E','F',
        'G','M': IF B THEN ONSWITCH[LCH]:=TRUE ELSE OFFSWITCH[LCH]:=TRUE;
            'P': PAGEEJECT := B;
	    'T': HEAPCHECK := B;
	    'L': LIST := B;
	    'V': BEGIN   I := 1;   NEXTCH;
		  WHILE (CH IN LETTERS OR DIGITS) AND (I < 7) DO
		   BEGIN   OBJIDENT[I] := CH;   I := I + 1;   NEXTCH
		   END
		 END;
	    'W': WARNINGS := B;
	    'S': TRACE := B;
	    'Q': FREQUENCE := B;
	    'D': DEBUG := B;
	    'H': BEGIN  SELECTOR := 0;  NEXTCH;  ONSWITCH['H'] := TRUE;
		  WHILE CH IN DIGITS DO
		   BEGIN  SELECTOR := SELECTOR*10 + ORD(CH) - ORD('0');
		    NEXTCH;
		   END
		 END;
	    'X': CONDCOMP := B;
	    'I': IF SRCLEVEL = SRCNESTMAX THEN ERROR ( 940 )
		 ELSE
		  BEGIN   SRCLEVEL := SRCLEVEL + 1;
		   WITH SRCNEST[SRCLEVEL] DO
		    BEGIN     FNAME := FILENAME;   LINNR := LINENO;
		     SAVEFDB ( FDB, INPUT, FILENAME );
		     IF FDB[-19] = 0 THEN
		      BEGIN   FILENAME := FNAME;   SRCLEVEL := SRCLEVEL - 1;
		      END
		     ELSE
		      BEGIN   PAGEEJECT := TRUE;   LINENO := 0;
		      END
		    END
		  END;
	    'Y': PSECTGEN := B ;
	    'Z':
		IF B AND NOT CONDCOMP
		THEN
		 BEGIN
		  OLDLIST := LIST;
		  LIST := FALSE;
		   REPEAT
		    WHILE CH <> OPTIONCONSTR DO
		      IF EOLN(INPUT)  THEN ENDOFLINE
				      ELSE NEXTCH;
		    NEXTCH;
		    IF CH = 'Z'
		    THEN
		     BEGIN
		      NEXTCH;
		      CONDCOMP := CH = '-'
		     END;
		   UNTIL CONDCOMP;
		  CONDCOMP := FALSE;
		  LIST := OLDLIST
		 END;
	    'R': RUNTMCHECK := B
	   END;
	 END;
	IF  EOLN(INPUT)
	THEN  ENDOFLINE;
	IF NOT ( CH IN ['\','*'] )
	THEN NEXTCH;
       UNTIL CH <> ','
     END %OPTIONS\ ;


   (*$Y+  NEW MODULE *)
 
   BEGIN %INSYMBOL\
    CASECONV := TRUE ;
1:  IF CHCNT > LINEWIDTH THEN ENDOFLINE;
     LOOP
      WHILE  CH = ' ' DO
       BEGIN
	IF EOLN(INPUT) OR (CHCNT > LINEWIDTH)
	THEN  ENDOFLINE;
	NEXTCH
       END
     EXIT  IF CH <> '%';
      NEXTCH;
      IF CH = OPTIONCONSTR
      THEN OPTIONS;
       LOOP
	IF EOLN(INPUT) OR (CHCNT > LINEWIDTH)
	THEN ENDOFLINE;
       EXIT  IF CH = '\';
	NEXTCH
       END;
      NEXTCH
     END;
     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;
					 REPEAT
					  IF K < ALFALENG
					  THEN
					   BEGIN
					    K := K + 1; ID[K] := CH
					   END ;
					  NEXTCH
					 UNTIL  NOT (CH IN LETTERS OR  DIGITS);
					IF K  >=   KK
					THEN KK := K
					ELSE
					 REPEAT
					  ID[KK] := ' '; KK := KK - 1
					 UNTIL KK = K;
					FOR I := FRW[K] TO FRW[K+1] - 1 DO
					IF RW[I] = ID
					THEN
					 BEGIN
					  SY := RSY[I]; OP := ROP[I]; GOTO 2
					 END;
					SY := IDENT; OP := NOOP;
2:
				       END;
      '0','1','2','3',
      '4','5','6',
      '7','8','9':
		   BEGIN
		    SY := INTCONST; OP := NOOP;
		    I := 0;
		     REPEAT
		      I := I + 1;
		      IF  I <= DIGMAX
		      THEN DIGIT[I] := ORD(CH) - ORD('0');
		      NEXTCH
		     UNTIL  NOT (CH IN DIGITS);
		    IF I > DIGMAX
		    THEN
		     BEGIN
		      ERROR(203);  I:= DIGMAX
		     END;
		    IVAL := 0;  RVAL := 0;
		    IF CH = 'B'
		    THEN
		     BEGIN
		      IF (I>6) OR ((I=6) AND (DIGIT[1]>1))
		      THEN
		       BEGIN
			ERROR(203);  IVAL := 0
		       END
		      ELSE
		      FOR K := 1 TO I DO
		       BEGIN
			IF DIGIT[K] > 7
			THEN ERROR(204);
			IVAL := 8*IVAL + DIGIT[K];
		       END;
		      VAL.IVAL := IVAL;
		      NEXTCH
		     END
		    ELSE
		     BEGIN
		      SCALE := 0;
		      IF CH = '.'
		      THEN
		       BEGIN
			NEXTCH;
			IF CH = '.'
			THEN CH := ':'
			ELSE
			 IF CH = ')'
			 THEN CH := ']'
			 ELSE
			   BEGIN
			    FOR K := 1 TO I DO RVAL := RVAL*10E0+DIGIT[K];
			    SY := REALCONST;
			    IF  NOT (CH IN DIGITS)
			    THEN ERROR(201)
			    ELSE
			     REPEAT
			      RVAL := 10E0*RVAL + (ORD(CH) - ORD('0'));
			      SCALE := SCALE - 1; NEXTCH
			     UNTIL  NOT (CH IN DIGITS)
			   END
		       END;
		      IF CH = 'E'
		      THEN
		       BEGIN
			IF SCALE = 0
			THEN
			 BEGIN
			  FOR K := 1 TO I DO RVAL := RVAL * 10E0 + DIGIT[K];
			  SY := REALCONST
			 END;
			SIGN := FALSE; NEXTCH;
			IF CH = '+'
			THEN NEXTCH
			ELSE
			 IF CH = '-'
			 THEN
			   BEGIN
			    SIGN := TRUE; NEXTCH
			   END;
			EXP := 0;
			IF  NOT (CH IN DIGITS)
			THEN ERROR(201)
			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;
		      IF SCALE <> 0  THEN
		        BEGIN
			IF SCALE < 0  THEN
			  BEGIN
			  SCALE := -SCALE;
			  SIGN := TRUE
			  END
			ELSE
			  SIGN := FALSE;
			FAC := 10E0 ;
			R := 1E0 ;  % OVERFLOW OR UNDERFLOW CAN OCCUR HERE \
			REPEAT
			  IF ODD(SCALE)  THEN  R := R*FAC ;
			  FAC := SQR(FAC); SCALE := SCALE DIV 2
			UNTIL SCALE = 0;   %NOW R = 10^SCALE\
			IF SIGN THEN  RVAL := RVAL/R
				ELSE  RVAL := RVAL*R ;
		        END;
		      IF SY = INTCONST
		      THEN
		       BEGIN
			IF I > 4
			THEN J := 4
			ELSE J := I;
			FOR K := 1 TO J DO IVAL := 10 * IVAL + DIGIT[K];
			IF (I<5) OR (((I=5) AND (IVAL<3276)) OR
				     ((I=5) AND (IVAL=3276) AND (DIGIT[5]<8)))
			THEN
			 BEGIN
			  IF I = 5
			  THEN IVAL := 10*IVAL + DIGIT[5];
			  VAL.IVAL := IVAL
			 END
			ELSE
			 BEGIN
			  ERROR(203);  IVAL := 0
			 END
		       END
		      ELSE
		       BEGIN
			NEW(LVP,REEL); VAL.VALP := LVP;
			LVP^.RVAL := RVAL;
			BINEXP := 0;
			IF RVAL < 0E0
			THEN
			 BEGIN
			  SGN := 100000B; RVAL := -RVAL
			 END
			ELSE SGN := 0;
			IF RVAL = 0E0
			THEN MANT := 0E0
			ELSE
			 BEGIN
			  WHILE RVAL < 8388608E0 DO
			   BEGIN
			    RVAL := RVAL * 2E0; BINEXP := BINEXP - 1
			   END;
			  WHILE RVAL > 16777216E0 DO
			   BEGIN
			    RVAL := RVAL/2E0; BINEXP := BINEXP + 1
			   END;
			  BINEXP := BINEXP + 24;
                          MANT := RVAL;
			 END;
			IF (BINEXP < -128) OR (BINEXP > 127)
			THEN
			 BEGIN
			  ERROR(205);  MANT := 0E0
			 END;
			WITH LVP^ DO
			 BEGIN
			  IF MANT = 0E0
			  THEN
			   BEGIN
			    HEAD := 0; TAIL := 0
			   END
			  ELSE
			   BEGIN
			    TAIL := TRUNC(MANT-TRUNC(MANT/32768E0)*32768E0);
			    HEAD := TRUNC((MANT-8388608E0)/65536E0)
			    + 128 * (BINEXP + 128) + SGN ;
			    IF ODD(TRUNC(MANT/32768E0))
			    THEN TAIL := TAIL + 100000B
			   END;
			 END
		       END
		     END
		   END;
      '''':
	    BEGIN
             CASECONV := FALSE ;
	     LGTH := 0; SY := STRINGCONST;  OP := NOOP;
	      REPEAT
		REPEAT
		 NEXTCH;  STRING[LGTH] := CH;  LGTH := LGTH + 1
		UNTIL  EOLN(INPUT)  OR  (CH = '''');
	       IF  EOLN(INPUT) AND (CH <> '''')
	       THEN  ERROR(202)
	       ELSE NEXTCH
	      UNTIL CH <> '''';
	     LGTH := LGTH - 1;   %NOW LGTH = NR OF CHARS IN STRING\
	     IF LGTH = 1
	     THEN VAL.IVAL := ORD(STRING[0])
	     ELSE
	      BEGIN
	       NEW(LVP,STRG:LGTH-1);
	       WITH LVP^ DO
		BEGIN
		 SLGTH := LGTH-1;
		 FOR I := 0 TO SLGTH 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
	     IF CH = ')'
	     THEN
	       BEGIN
		SY:=RBRACK; NEXTCH
	       END
	     ELSE SY := PERIOD
	   END;
      '(':
	   BEGIN
	    NEXTCH;
	    IF CH = '*'
	    THEN
	     BEGIN
	      NEXTCH;
	      IF CH = OPTIONCONSTR
	      THEN OPTIONS;
	       LOOP
		IF EOLN(INPUT) OR (CHCNT > LINEWIDTH)
		THEN ENDOFLINE;
		STAR := CH = '*';
		WHILE CH = '*' DO NEXTCH;
	       EXIT IF STAR AND ( CH = ')' ) ;
		NEXTCH;
	       END;
	      NEXTCH;  GOTO 1;
	     END
	    ELSE
	     BEGIN
	      IF CH = '.'
	      THEN
	       BEGIN
		SY:= LBRACK; OP := NOOP; NEXTCH
	       END
	      ELSE
	       BEGIN
		SY := LPARENT; OP := NOOP
	       END
	     END;
	   END;
      '?','*','/','&','+','-','\',
      '@','"','#','=','!',
      ')','[',']',',',';','^','_','$':
				       BEGIN
					SY := SSY[CH]; OP := SOP[CH];
					NEXTCH
				       END;
      '<','>':
	       BEGIN
		SY := SSY[CH];  OP := SOP[CH]; NEXTCH;
		IF  CH = '='
		THEN
		 BEGIN
		  IF  OP = LTOP
		  THEN  OP := LEOP
		  ELSE  OP := GEOP;
		  NEXTCH
		 END
		ELSE
		 IF ( CH = '>' ) AND ( OP = LTOP )
		 THEN
		   BEGIN
		    OP := NEOP ;   NEXTCH
		   END
	       END
     END %CASE\
   END %INSYMBOL\ ;
 
 
  PROCEDURE ENTERID (FCP: CTP);  (*$Y-  SAME MODULE *)
    %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;   FCP^.SELFCTP := 0;
    LCP := DISPLAY[TOP].FNAME;
    IF LCP = NIL
    THEN
    DISPLAY[TOP].FNAME := FCP
    ELSE
     BEGIN
       REPEAT
	LCP1 := LCP;
	IF LCP^.NAME = NAM
	THEN   %NAME CONFLICT, FOLLOW RIGHT LINK\
	 BEGIN
	  ERROR(101); LCP := LCP^.RLINK; LLEFT := FALSE
	 END
	ELSE
	 IF LCP^.NAME < NAM
	 THEN
	   BEGIN
	    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;
    FCP^.LLINK := NIL; FCP^.RLINK := NIL
   END %ENTERID\ ;

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

  PROCEDURE SEARCHID (FIDCLS: SETOFIDS; VAR FCP: CTP);  (*$Y- SAME MODULE *)
    LABEL   1;
  VAR
    LCP: CTP;
   BEGIN
    FOR DISX := TOP DOWNTO 0 DO
     BEGIN
      LCP := DISPLAY[DISX].FNAME;
      WHILE LCP <> NIL DO
      IF LCP^.NAME = ID
      THEN
       IF LCP^.KLASS IN FIDCLS
       THEN GOTO 1
       ELSE
	 BEGIN
	  IF PRTERR
	  THEN ERROR(103);
	  LCP := LCP^.RLINK
	 END
      ELSE
       IF LCP^.NAME < ID
       THEN
	LCP := LCP^.RLINK
       ELSE LCP := LCP^.LLINK
     END;
    %SEARCH NOT SUCCSESSFUL; SUPPRESS ERROR MESSAGE IN CASE
     OF FORWARD REFERENCED TYPE ID IN POINTER TYPE DEFINITION
     --> PROCEDURE SIMPLETYPE\
    IF PRTERR
    THEN
     BEGIN
      ERROR(104);
      %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
	     ELSE LCP := UFCTPTR;
     END;
1:
    FCP := LCP
   END %SEARCHID\ ;

  PROCEDURE GETBOUNDS (FSP: STP; VAR FMIN,FMAX: INTEGER);  (*$Y-*)
    %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
       BEGIN
	FMIN := 0; FMAX := 377B
       END
      ELSE
       IF FSP = INTPTR
       THEN FMAX := 0
       ELSE
	 IF FSP^.FCONST <> NIL
	 THEN
	  FMAX := FSP^.FCONST^.VALUES.IVAL
	 ELSE FMAX := 0
     END
   END %GETBOUNDS\ ;


(*$Y+ SPLIT MODULES *)
 
 
  PROCEDURE BLOCK (FSYS: SETOFSYS; FSY: SYMBOL; FPROCP: CTP);
  VAR
    LSY: SYMBOL; FLABP: LBP;
    TESTPACKED: BOOLEAN;       %TEST FOR PACKED STRUCTURES\
    HEAPM: INTP;
    OLDCIX: INTEGER ;
    OLDPSECT: ALFA ;
    OLDGLOBALINDEX: GBLDFRANGE ;

    PROCEDURE SKIP(FSYS: SETOFSYS);
      %SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND\
     BEGIN
      WHILE  NOT (SY IN FSYS) DO INSYMBOL
     END %SKIP\ ;

    (*$Y- DONT SPLIT MODULES *)
 
    PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU);
    VAR
      LSP,LSP1: STP; LCP: CTP;  SIGN: (NONE,POS,NEG);
      STEST: REAL;
     BEGIN
      LSP := NIL; FVALU.IVAL := 0;
      IF  NOT (SY IN CONSTBEGSYS)
      THEN
       BEGIN
	ERROR(50); SKIP(FSYS OR  CONSTBEGSYS)
       END;
      IF SY IN CONSTBEGSYS
      THEN
       BEGIN
	IF SY = STRINGCONSTSY
	THEN
	 BEGIN
	  IF LGTH = 1
	  THEN LSP := CHARPTR
	  ELSE
	   BEGIN
	    NEW(LSP,ARRAYS);
	    NEW(LSP1,SUBRANGE);
	    WITH LSP^ DO
	     BEGIN
	      AELTYPE := CHARPTR;  INXTYPE := LSP1;
	      PACKOPT := FALSE; ADDRCORR := 0;
	      SIZE := 2 * ((LGTH + 1) DIV 2);
	     END ;
	    WITH  LSP1^ DO
	     BEGIN
	      SIZE := 2;  RANGETYPE := INTPTR;
	      MIN.IVAL := 0; MAX.IVAL := LGTH-1;
	     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
		  WITH FVALU.VALP^ DO
		   BEGIN
		    RVAL := -RVAL;
		    STEST := HEAD;
		    IF (STEST>=32768.0 %CROSS COMPILOR\)
		    OR (STEST<0 %PDP-11 COMPILOR\)
		    THEN
		    HEAD := HEAD - 100000B
		    ELSE HEAD := HEAD + 100000B
		   END;
		 END
	       ELSE ERROR(105);
	    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
		WITH VAL.VALP^ DO
		 BEGIN
		  RVAL := -RVAL; HEAD := HEAD + 100000B
		 END;
		LSP := REALPTR; FVALU := VAL; INSYMBOL
	       END
	     ELSE
	       BEGIN
		ERROR(106); SKIP(FSYS)
	       END
	 END;
	IF  NOT (SY IN FSYS)
	THEN
	 BEGIN
	  ERROR(6); SKIP(FSYS)
	 END
       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;
     BEGIN
      IF FSP1 = FSP2
      THEN
       COMPTYPES :=  FSP1^.FORM <> BOUNDLESS
      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:
                 IF POINTERCNT = 10 THEN COMPTYPES := FALSE
                 ELSE
                  BEGIN   POINTERCNT := SUCC(POINTERCNT);
		    COMPTYPES := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE);
                    POINTERCNT := PRED(POINTERCNT);
                  END;
	    POWER:
		  COMPTYPES := COMPTYPES(FSP1^.ELSET,FSP2^.ELSET);
	    ARRAYS:
		    BEGIN
		     COMP := COMPTYPES(FSP1^.AELTYPE,FSP2^.AELTYPE)
		     AND  (FSP1^.SIZE = FSP2^.SIZE);
		     IF  FSP1^.PACKOPT OR FSP2^.PACKOPT
		     THEN
		      BEGIN
		       GETBOUNDS(FSP1^.INXTYPE,LMIN,LMAX);
		       I := LMAX - LMIN;
		       GETBOUNDS(FSP2^.INXTYPE,LMIN,LMAX);
		       COMP := COMP  AND  (I = LMAX - LMIN)
		      END   %COMPATIBILITY OF PACKED STRUCTURES\ ;
		     COMPTYPES := COMP
		    END;
		   %ALTERNATIVES: -- ADD A THIRD BOOLEAN TERM: INDEXTYPE MUST
		    BE COMPATIBLE.
		    -- 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 := COMP AND COMPTYPES(NXT1^.IDTYPE,NXT2^.IDTYPE);
			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);
	    BOUNDLESS:  COMPTYPES := FALSE;
	    STRINGPARM: COMPTYPES := TRUE
	   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
	       BEGIN
		COMPTYPES := FALSE;
		IF FSP1^.FORM = STRINGPARM
		THEN
		 BEGIN
		  IF FSP2^.FORM = ARRAYS
		  THEN COMPTYPES := FSP2^.AELTYPE = CHARPTR
		 END
		ELSE
		 IF FSP2^.FORM = STRINGPARM
		 THEN
		   IF FSP1^.FORM = ARRAYS
		   THEN
		    COMPTYPES :=  FSP1^.AELTYPE = CHARPTR
	       END
       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) (*$Y+*) ;
    VAR
      LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP;
      LSIZE,DISPL: ADDRRANGE; LMIN,LMAX: INTEGER;
      PSIZE, CORRECTION: INTEGER;  PACKFLAG: BOOLEAN;

      PROCEDURE SIMPLETYPE(FSYS: SETOFSYS; VAR FSP: STP; VAR FSIZE: ADDRRANGE);
      VAR
	LSP,LSP1: STP; LCP,LCP1: CTP; TTOP: DISPRANGE;
	LCNT: INTEGER; LVALU: VALU;
       BEGIN
	FSIZE := 2;
	IF  NOT (SY IN SIMPTYPEBEGSYS)
	THEN
	 BEGIN
	  ERROR(1); SKIP(FSYS OR  SIMPTYPEBEGSYS)
	 END;
	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;
	    NEW(LSP,SCALAR,DECLARED);
	    LSP^.SIZE := 2;   LSP^.SELFSTP := 0;
	    LCP1 := NIL; LCNT := 0;
	     REPEAT
	      INSYMBOL;
	      IF SY = IDENT
	      THEN
	       BEGIN
		NEW(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(2);
	      IF  NOT (SY IN FSYS OR  [COMMA,RPARENT])
	      THEN
	       BEGIN
		ERROR(6); SKIP(FSYS OR  [COMMA,RPARENT])
	       END
	     UNTIL SY <> COMMA;
	    LSP^.FCONST := LCP1; TOP := TTOP;
	    IF SY = RPARENT
	    THEN INSYMBOL
	    ELSE ERROR(4)
	   END
	  ELSE
	   BEGIN
	    IF SY = IDENT
	    THEN
	     BEGIN
	      SEARCHID([TYPES,KONST],LCP);
	      INSYMBOL;
	      IF LCP^.KLASS = KONST
	      THEN
	       BEGIN
		NEW(LSP,SUBRANGE);
		WITH LSP^, LCP^ DO
		 BEGIN
		  RANGETYPE := IDTYPE;   SELFSTP := 0;
		  IF STRING(RANGETYPE)
		  THEN
		   BEGIN
		    ERROR(148); RANGETYPE := NIL
		   END;
		  IF RANGETYPE <> NIL
		  THEN  SIZE := RANGETYPE^.SIZE;
		  MIN := VALUES
		 END;
		IF SY = COLON
		THEN INSYMBOL
		ELSE ERROR(5);
		CONSTANT(FSYS,LSP1,LVALU);
		LSP^.MAX := LVALU;
		IF LSP^.RANGETYPE <> LSP1
		THEN ERROR(107)
	       END
	      ELSE  LSP := LCP^.IDTYPE
	     END %SY = IDENT\
	    ELSE
	     BEGIN
	      NEW(LSP,SUBRANGE);
	      CONSTANT(FSYS OR  [COLON],LSP1,LVALU);
	      IF STRING(LSP1)
	      THEN
	       BEGIN
		ERROR(148); LSP1 := NIL
	       END;
	      WITH LSP^ DO
	       BEGIN
		RANGETYPE := LSP1; MIN := LVALU;
		IF RANGETYPE <> NIL
		THEN  SIZE := RANGETYPE^.SIZE
	       END;
	      IF SY = COLON
	      THEN INSYMBOL
	      ELSE ERROR(5);
	      CONSTANT(FSYS,LSP1,LVALU);
	      LSP^.MAX := LVALU;   LSP^.SELFSTP := 0;
	      IF LSP^.RANGETYPE <> LSP1
	      THEN ERROR(107)
	     END;
	    IF LSP <> NIL
	    THEN
	    WITH LSP^ DO
	    IF FORM = SUBRANGE
	    THEN
	     IF RANGETYPE <> NIL
	     THEN
	       IF RANGETYPE = REALPTR
	       THEN
		 BEGIN
		  IF MIN.VALP^.RVAL > MAX.VALP^.RVAL
		  THEN ERROR(102)
		 END
	       ELSE
		 IF MIN.IVAL > MAX.IVAL
		 THEN ERROR(102)
	   END;
	  FSP := LSP;
	  IF  NOT (SY IN FSYS)
	  THEN
	   BEGIN
	    ERROR(6); SKIP(FSYS)
	   END
	 END
	ELSE  FSP := NIL;
	IF FSP = NIL
	THEN FSIZE := 2
	ELSE FSIZE := FSP^.SIZE
       END %SIMPLETYPE\ ;

      (*$Y- DONT SPLIT THESE MODULES *)
 
      PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FRECVAR: STP);
      LABEL   1;
      VAR
	LCP,LCP1,NXT,NXT1: CTP; LSP,LSP1,LSP2,LSP3,LSP4: STP;
	MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU;
	LID: ALFA;

       BEGIN
	NXT1 := NIL; LSP := NIL;
	IF  NOT (SY IN [IDENT,CASESY])
	THEN
	 BEGIN
	  ERROR(19); SKIP(FSYS OR  [IDENT,CASESY])
	 END;
	WHILE SY = IDENT DO
	 BEGIN
	  NXT := NXT1;
	   LOOP
	    IF SY = IDENT
	    THEN
	     BEGIN
	      NEW(LCP,FIELD);
	      WITH LCP^ DO
	       BEGIN
		NAME := ID; IDTYPE := NIL; NEXT := NXT
	       END;
	      NXT := LCP;
	      ENTERID(LCP);
	      INSYMBOL
	     END
	    ELSE ERROR(2);
	    IF  NOT (SY IN [COMMA,COLON])
	    THEN
	     BEGIN
	      ERROR(6); SKIP(FSYS OR  [COMMA,COLON,SEMICOLON,CASESY])
	     END;
	   EXIT IF SY <> COMMA;
	    INSYMBOL
	   END;
	  IF SY = COLON
	  THEN INSYMBOL
	  ELSE ERROR(5);
	  TYP(FSYS OR  [CASESY,SEMICOLON],LSP,LSIZE);
	  WHILE NXT <> NXT1 DO
	  WITH NXT^ DO
	   BEGIN
	    IDTYPE := LSP; FLDADDR := DISPL;
	    IF LSP <> NIL
	    THEN
	     IF LSP^.FORM = ARRAYS
	     THEN
	       BEGIN
		FLDADDR := FLDADDR - LSP^.ADDRCORR;
		IF NOT  PACKFLAG
		THEN    %PACKFLAG INDICATES PACKED ARR\
		 BEGIN
		  LSP1 := LSP;
		  WHILE  LSP1^.AELTYPE^.FORM = ARRAYS  DO
		  LSP1 := LSP1^.AELTYPE;
		  PACKFLAG := LSP^.PACKOPT
		 END
	       END;
	    NXT := NEXT; DISPL := DISPL + LSIZE
	   END;
	  NXT1 := LCP;
	  IF SY = SEMICOLON
	  THEN
	   BEGIN
	    INSYMBOL;
	    IF  NOT (SY IN [IDENT,CASESY])
	    THEN
	     BEGIN
	      ERROR(19); SKIP(FSYS OR  [IDENT,CASESY])
	     END
	   END
	 END %WHILE\;
	NXT := NIL;
	WHILE NXT1 <> NIL DO
	WITH NXT1^ DO
	 BEGIN
	  LCP := NEXT; NEXT := NXT; NXT := NXT1; NXT1 := LCP
	 END;
	IF SY = CASESY
	THEN
	 BEGIN
	  LCP := NIL ;        %POSSIBLY NO TAGFIELDIDENTIFIER\
	  INSYMBOL;
	  IF SY = IDENT
	  THEN
	   BEGIN
	    LID := ID;   INSYMBOL;
	    IF (SY <> COLON) AND (SY <> OFSY)
	    THEN
	     BEGIN
	      ERROR(169);   SKIP(FSYS OR [LPARENT])
	     END
	    ELSE
	     BEGIN
	      IF SY = COLON
	      THEN
	       BEGIN
		NEW(LSP,TAGFWITHID);
		NEW(LCP,FIELD);
		WITH LCP^ DO
		 BEGIN
		  NAME := LID;   IDTYPE := NIL;  NEXT := NIL;
		  FLDADDR := DISPL
		 END;
		ENTERID(LCP);
		INSYMBOL;
		IF SY <> IDENT
		THEN
		 BEGIN
		  ERROR(2);   SKIP(FSYS OR [LPARENT]);   GOTO 1
		 END
		ELSE
		 BEGIN
		  LID := ID;
		  INSYMBOL;
		  IF SY <> OFSY
		  THEN
		   BEGIN
		    ERROR(8);   SKIP(FSYS OR [LPARENT]);   GOTO 1
		   END;
		 END
	       END
	      ELSE
	      NEW(LSP,TAGFWITHOUTID);
	      WITH LSP^ DO
	       BEGIN
		SIZE := 0;   FSTVAR := NIL;   SELFSTP := 0;
		IF FORM = TAGFWITHID
		THEN   TAGFIELDP := NIL
		ELSE   TAGFIELDTYPE := NIL;
	       END;
	      FRECVAR := LSP;
	      ID := LID;   KK := ALFALENG;                %RESTAURATION\
	      SEARCHID([TYPES],LCP1);
	      LSP1 := LCP1^.IDTYPE;
	      IF LSP1 <> NIL
	      THEN
	       IF (LSP1^.FORM <= SUBRANGE) OR STRING(LSP1)
	       THEN
		 BEGIN
		  IF COMPTYPES(REALPTR,LSP1)
		  THEN ERROR(109)
		  ELSE
		   IF STRING(LSP1)
		   THEN ERROR(399);
		  WITH LSP^ DO
		   BEGIN
		    IF FORM = TAGFWITHID
		    THEN
		     BEGIN
		      DISPL := DISPL + LSP1^.SIZE;
		      TAGFIELDP := LCP;
		      IF LCP <> NIL
		      THEN
		       IF LCP <> NIL
		       THEN   LCP^.IDTYPE := LSP1;
		     END
		    ELSE
		    TAGFIELDTYPE := LSP1
		   END;
		 END
	       ELSE   ERROR(110);
	      INSYMBOL;
	     END
	   END
	  ELSE
	   BEGIN
	    ERROR(2);   SKIP(FSYS OR [LPARENT])
	   END;
1:
	  LSP^.SIZE := DISPL;
	  LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL;
	   LOOP
	    LSP2 := NIL;
	     LOOP
	      CONSTANT(FSYS OR  [COMMA,COLON,LPARENT],LSP3,LVALU);
	      IF LSP <> NIL
	      THEN
	       IF LSP^.FORM = TAGFWITHID
	       THEN
		 BEGIN
		  IF LSP^.TAGFIELDP <> NIL
		  THEN
		   IF NOT COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP3)
		   THEN ERROR(111)
		 END
	       ELSE
		 IF NOT COMPTYPES(LSP^.TAGFIELDTYPE,LSP3)
		 THEN ERROR(111);
	      NEW(LSP3,VARIANT);
	      WITH LSP3^ DO
	       BEGIN
		NXTVAR := LSP1; SUBVAR := LSP2; VARVAL := LVALU; SELFSTP := 0
	       END;
	      LSP1 := LSP3; LSP2 := LSP3;
	     EXIT IF SY <> COMMA;
	      INSYMBOL
	     END;
	    IF SY = COLON
	    THEN INSYMBOL
	    ELSE ERROR(5);
	    IF SY = LPARENT
	    THEN INSYMBOL
	    ELSE ERROR(9);
	    FIELDLIST(FSYS OR  [RPARENT,SEMICOLON],LSP2);
	    IF DISPL > MAXSIZE
	    THEN MAXSIZE := DISPL;
	    WHILE LSP3 <> NIL DO
	     BEGIN
	      LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2;
	      LSP3^.SIZE := DISPL;
	      LSP3 := LSP4
	     END;
	    IF SY = RPARENT
	    THEN
	     BEGIN
	      INSYMBOL;
	      IF  NOT (SY IN FSYS OR  [SEMICOLON])
	      THEN
	       BEGIN
		ERROR(6); SKIP(FSYS OR  [SEMICOLON])
	       END
	     END
	    ELSE ERROR(4);
	   EXIT IF SY <> SEMICOLON;
	    DISPL := MINSIZE;
	    INSYMBOL
	   END;
	  DISPL := MAXSIZE;
	  LSP^.FSTVAR := LSP1;
	 END
	ELSE
	 IF LSP <> NIL
	 THEN
	   IF LSP^.FORM = ARRAYS
	   THEN FRECVAR := LSP
	   ELSE FRECVAR := NIL
       END %FIELDLIST\ ;

     BEGIN %TYP\
      IF  NOT (SY IN TYPEBEGSYS)
      THEN
       BEGIN
	ERROR(10); SKIP(FSYS OR  TYPEBEGSYS)
       END;
      IF SY IN TYPEBEGSYS
      THEN
       BEGIN
	CORRECTION := 0;
	IF SY IN SIMPTYPEBEGSYS
	THEN SIMPLETYPE(FSYS,FSP,FSIZE)
	ELSE
	%^\
	 IF SY = ARROW
	 THEN
	   BEGIN
	    NEW(LSP,POINTER); FSP := LSP;
	    WITH LSP^ DO
	     BEGIN
	      ELTYPE := NIL; SIZE := 2;   SELFSTP := 0
	     END;
	    INSYMBOL;
	    IF SY = IDENT
	    THEN
	     BEGIN
	      PRTERR := FALSE;   %NO ERROR IF SEARCH NOT SUCCESSFUL\
	      SEARCHID([TYPES],LCP); PRTERR := TRUE;
	      IF LCP = NIL
	      THEN   %FORWARD REFERENCED TYPE ID\
	       BEGIN
		NEW(LCP,TYPES);
		WITH LCP^ DO
		 BEGIN
		  NAME := ID; IDTYPE := LSP;
		  NEXT := FWPTR
		 END;
		FWPTR := LCP
	       END
	      ELSE
	       BEGIN
		IF LCP^.IDTYPE <> NIL
		THEN
		 IF LCP^.IDTYPE^.FORM = FILES
		 THEN ERROR(108)
		 ELSE LSP^.ELTYPE := LCP^.IDTYPE
	       END;
	      INSYMBOL;
	     END
	    ELSE ERROR(2);
	   END
	 ELSE
	   BEGIN
	    PACKFLAG :=  SY = PACKEDSY ;
	    IF PACKFLAG
	    THEN
	     BEGIN
	      INSYMBOL;
	      IF  NOT (SY IN TYPEDELS)
	      THEN
	       BEGIN
		ERROR(10); SKIP(FSYS OR  TYPEDELS)
	       END
	     END;
	    %ARRAY\
	    IF SY = ARRAYSY
	    THEN
	     BEGIN
	      INSYMBOL;
	      IF SY = LBRACK
	      THEN INSYMBOL
	      ELSE ERROR(11);
	      LSP1 := NIL;
	       LOOP
		NEW(LSP,ARRAYS);
		WITH LSP^ DO
		 BEGIN
		  AELTYPE := LSP1; INXTYPE := NIL;  SELFSTP := 0;
		  SIZE := 2;  PACKOPT := FALSE
		 END;
		LSP1 := LSP;
		SIMPLETYPE(FSYS OR  [COMMA,RBRACK,OFSY],LSP2,LSIZE);
		IF LSP2 <> NIL
		THEN
		 IF LSP2^.FORM  <=   SUBRANGE
		 THEN
		   BEGIN
		    IF LSP2 = REALPTR
		    THEN
		     BEGIN
		      ERROR(109); LSP2 := NIL
		     END
		    ELSE
		     IF LSP2 = INTPTR
		     THEN
		       BEGIN
			ERROR(149); LSP2 := NIL
		       END;
		    LSP^.INXTYPE := LSP2
		   END
		 ELSE
		   BEGIN
		    ERROR(113); LSP2 := NIL
		   END;
	       EXIT IF SY <> COMMA;
		INSYMBOL
	       END;
	      IF SY = RBRACK
	      THEN INSYMBOL
	      ELSE ERROR(12);
	      IF SY = OFSY
	      THEN INSYMBOL
	      ELSE ERROR(8);
	      TYP(FSYS,LSP,LSIZE);
	      IF LSP <> NIL
	      THEN          %FOR CALCULATION OF HYPOTH.ADDR\
	       IF LSP^.FORM = ARRAYS
	       THEN  CORRECTION := LSP^.ADDRCORR;
	       REPEAT
		WITH LSP1^ DO
		 BEGIN
		  LSP2 := AELTYPE; AELTYPE := LSP;
		  IF PACKFLAG AND (LSP = BOOLPTR)
		  THEN PACKOPT := TRUE;
		  IF INXTYPE <> NIL
		  THEN
		   BEGIN
		    GETBOUNDS(INXTYPE,LMIN,LMAX);
		    IF  PACKOPT
		    THEN
		     BEGIN
		      IF AELTYPE = BOOLPTR
		      THEN
		      LSIZE := 2 * ((LMAX - LMIN + 16) DIV 16)
		     END
		    ELSE
		     BEGIN
		      IF (AELTYPE = CHARPTR)  OR
			 ((AELTYPE^.FORM = SUBRANGE) AND (AELTYPE^.RANGETYPE = CHARPTR))
		      THEN
		      % PACK CHARACTERS ONE PER BYTE \
		       BEGIN
			CORRECTION := CORRECTION + LMIN;
			LSIZE := 2 * ((LMAX - LMIN + 2) DIV 2);
		       END
		      ELSE
		       BEGIN
			CORRECTION := CORRECTION + LMIN * LSIZE;
			LSIZE := LSIZE * (LMAX - LMIN + 1)
		       END
		     END;
		    ADDRCORR := CORRECTION;
		    SIZE := 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
		  TOP := TOP + 1; DISPLAY[TOP].FNAME := NIL;
		  DISPLAY[TOP].OCCUR := CREC
		 END
		ELSE ERROR(250);
		DISPL := 0;
		FIELDLIST(FSYS-[SEMICOLON] OR  [ENDSY],LSP1);
		NEW(LSP,RECORDS);
		WITH LSP^ DO
		 BEGIN
		  FSTFLD := DISPLAY[TOP].FNAME;  SELFSTP := 0;
		  RECVAR := LSP1; SIZE := DISPL; PACKSTRUCT := PACKFLAG
		 END;
		TOP := OLDTOP;
		IF SY = ENDSY
		THEN INSYMBOL
		ELSE ERROR(13)
	       END
	     ELSE
	      %SET\
	       IF SY = SETSY
	       THEN
		 BEGIN
		  INSYMBOL;
		  IF SY = OFSY
		  THEN INSYMBOL
		  ELSE ERROR(8);
		  SIMPLETYPE(FSYS,LSP1,LSIZE);
		  IF LSP1 <> NIL
		  THEN
		   IF LSP1^.FORM > SUBRANGE
		   THEN
		     BEGIN
		      ERROR(115); LSP1 := NIL
		     END
		   ELSE
		     IF LSP1 = REALPTR
		     THEN ERROR(114);
		  NEW(LSP,POWER);
		  WITH LSP^ DO
		   BEGIN
		    ELSET := LSP1;   SELFSTP := 0;
		    IF LSP1 = CHARPTR
		    THEN
		     BEGIN
		      LMIN := 0;   LMAX := 63
		     END
		    ELSE
		     IF LSP1 <> NIL
		     THEN
		       BEGIN
			GETBOUNDS(LSP1,LMIN,LMAX);
			IF (LSP1^.FORM = SUBRANGE) AND (LSP1^.RANGETYPE = CHARPTR)
			THEN
			 BEGIN
			  LMIN := 0;  LMAX := LMAX - 40B
			 END
		       END
		     ELSE   LMAX := 0;
		    IF (LMIN < 0) OR (LMAX = 0) OR (LMAX >= 64)
		    THEN ERROR(604);
		    IF LMAX <= 15  THEN SIZE := 2
				   ELSE SIZE := 8
		   END
		 END
	       ELSE
		%FILE\
		 IF SY = FILESY
		 THEN
		   BEGIN
		    INSYMBOL;
		    IF SY = OFSY
		    THEN INSYMBOL
		    ELSE ERROR(8);
		    TYP(FSYS,LSP1,LSIZE);
		    NEW(LSP,FILES);
		    WITH LSP^ DO
		     BEGIN
		      FILTYPE := LSP1; SIZE := 2;  SELFSTP := 0;
		     END;
		    IF LSP1 <> NIL
		    THEN
		     IF LSP1^.FORM = FILES
		     THEN
		       BEGIN
			ERROR(108); LSP^.FILTYPE := NIL
		       END;
		   END;
	    FSP := LSP
	   END;
	IF  NOT (SY IN FSYS)
	THEN
	 BEGIN
	  ERROR(6); SKIP(FSYS)
	 END
       END
      ELSE FSP := NIL;
      IF FSP = NIL
      THEN FSIZE := 2
      ELSE FSIZE := FSP^.SIZE
     END %TYP\ ;

    PROCEDURE LABELDECLARATION (*$Y+*) ;
    LABEL   1;
    VAR
      LLP: LBP;
     BEGIN
       LOOP
	IF SY = INTCONST
	THEN
	 BEGIN
	  LLP := FSTLABP;
	  WHILE LLP <> FLABP DO
	  IF LLP^.LABVAL = VAL.IVAL
	  THEN
	   BEGIN
	    ERROR(166); GOTO 1
	   END
	  ELSE LLP := LLP^.NEXTLAB;
	  NEW(LLP);
	  WITH LLP^ DO
	   BEGIN
	    LABVAL := VAL.IVAL; DEFINED := FALSE;
	    LABCHAIN := NIL; NEXTLAB := FSTLABP;
	    DECLARED := TRUE
	   END;
	  FSTLABP := LLP;
1:
	  INSYMBOL
	 END
	ELSE ERROR(15);
	IF  NOT (SY IN FSYS OR  [COMMA,SEMICOLON])
	THEN
	 BEGIN
	  ERROR(6); SKIP(FSYS OR  [COMMA,SEMICOLON])
	 END;
       EXIT IF SY <> COMMA;
	INSYMBOL
       END;
      IF SY = SEMICOLON
      THEN INSYMBOL
      ELSE ERROR(14)
     END %LABELDECLARATION\ ;

    PROCEDURE CONSTDECLARATION (*$Y+*) ;
    VAR
      LCP: CTP; LSP: STP; LVALU: VALU;
     BEGIN
      IF SY <> IDENT
      THEN
       BEGIN
	ERROR(2); SKIP(FSYS OR  [IDENT])
       END;
      WHILE SY = IDENT DO
       BEGIN
	NEW(LCP,KONST);
	WITH LCP^ DO
	 BEGIN
	  NAME := ID; IDTYPE := NIL; NEXT := NIL;  KADDR := 0
	 END;
	INSYMBOL;
	IF (SY = RELOP) AND (OP = EQOP)
	THEN INSYMBOL
	ELSE ERROR(16);
	CONSTANT(FSYS OR  [SEMICOLON],LSP,LVALU);
	ENTERID(LCP);
	LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU;
	IF SY = SEMICOLON
	THEN
	 BEGIN
	  INSYMBOL;
	  IF  NOT (SY IN FSYS OR  [IDENT])
	  THEN
	   BEGIN
	    ERROR(6); SKIP(FSYS OR  [IDENT])
	   END
	 END
	ELSE ERROR(14)
       END
     END %CONSTANTDECLARATION\ ;

    PROCEDURE TYPEDECLARATION (*$Y+*) ;
    VAR
      LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE;
     BEGIN
      IF SY <> IDENT
      THEN
       BEGIN
	ERROR(2); SKIP(FSYS OR  [IDENT])
       END;
      WHILE SY = IDENT DO
       BEGIN
	NEW(LCP,TYPES);
	WITH LCP^ DO
	 BEGIN
	  NAME := ID; IDTYPE := NIL
	 END;
	INSYMBOL;
	IF (SY = RELOP) AND (OP = EQOP)
	THEN INSYMBOL
	ELSE ERROR(16);
	TYP(FSYS OR  [SEMICOLON],LSP,LSIZE);
	ENTERID(LCP);
	LCP^.IDTYPE := LSP;
	%HAS ANY FORWARD REFERENCE BEEN SATISFIED:\
	LCP1 := FWPTR;
	WHILE LCP1 <> NIL DO
	 BEGIN
	  IF LCP1^.NAME = LCP^.NAME
	  THEN
	   BEGIN
	    LCP1^.IDTYPE^.ELTYPE := LCP^.IDTYPE;
	    IF LCP1 <> FWPTR
	    THEN
	    LCP2^.NEXT := LCP1^.NEXT
	    ELSE FWPTR := LCP1^.NEXT;
	   END;
	  LCP2 := LCP1; LCP1 := LCP1^.NEXT
	 END;
	IF SY = SEMICOLON
	THEN
	 BEGIN
	  INSYMBOL;
	  IF  NOT (SY IN FSYS OR  [IDENT])
	  THEN
	   BEGIN
	    ERROR(6); SKIP(FSYS OR  [IDENT])
	   END
	 END
	ELSE ERROR(14)
       END;
      IF FWPTR <> NIL
      THEN
       BEGIN
	ERROR(117); WRITELN;
	 REPEAT
	  WRITELN('   TYPE-ID ',FWPTR^.NAME);
	  FWPTR := FWPTR^.NEXT
	 UNTIL FWPTR = NIL;
	IF  NOT EOLN(INPUT)
	THEN  WRITE(' ':CHCNT + 8)
       END
     END %TYPEDECLARATION\ ;

    PROCEDURE VARDECLARATION (*$Y+*) ;
    VAR
      LCP,NXT: CTP; LSP: STP; LSIZE: ADDRRANGE;
     BEGIN
      NXT := NIL;
       REPEAT
	 LOOP
	  IF SY = IDENT
	  THEN
	   BEGIN
	    NEW(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(2);
	  IF  NOT (SY IN FSYS OR  [COMMA,COLON] OR  TYPEDELS)
	  THEN
	   BEGIN
	    ERROR(6); SKIP(FSYS OR  [COMMA,COLON,SEMICOLON] OR  TYPEDELS)
	   END;
	 EXIT IF SY <> COMMA;
	  INSYMBOL
	 END;
	IF SY = COLON
	THEN INSYMBOL
	ELSE ERROR(5);
	TYP(FSYS OR  [SEMICOLON] OR  TYPEDELS,LSP,LSIZE);
	WHILE NXT <> NIL DO
	WITH  NXT^ DO
	 BEGIN
	  IDTYPE := LSP;
	  LC := LC - LSIZE;    VADDR := LC;
	  IF  LSP <> NIL
	  THEN
	   BEGIN
	    IF  LSP^.FORM = ARRAYS
	    THEN  VADDR := VADDR - LSP^.ADDRCORR;
	    IF LSP^.FORM = FILES
	    THEN
	     BEGIN
              LSIZE := LSP^.FILTYPE^.SIZE;
	      VADDR := VADDR - LSIZE;  % ALLOCATE SPACE FOR RECORD BUFFER \
	      LC := LC-FILESIZECORR-LSIZE;
	      IF LSP^.FILTYPE = CHARPTR
	      THEN LC := LC - TEXTBUFFSIZE
	     END;
	   END;
	  NXT := NEXT
	 END;
	IF LSP <> NIL
	THEN
	 IF LSP^.FORM = ARRAYS
	 THEN
	   BEGIN
	    IF NOT TESTPACKED
	    THEN
	     BEGIN
	      WHILE  LSP^.AELTYPE^.FORM = ARRAYS DO
	      LSP := LSP^.AELTYPE;
	      TESTPACKED := LSP^.PACKOPT    %BASE LEVEL OF ARRAY PACKED?\
	     END
	   END
	 ELSE
	   IF  LSP^.FORM = RECORDS
	   THEN
	    %CHECK  IF A RECORD CONTAINS PACKED ARRAYSTRUCTURES\
	    TESTPACKED := TESTPACKED OR LSP^.PACKSTRUCT;
	IF SY = SEMICOLON
	THEN
	 BEGIN
	  INSYMBOL;
	  IF  NOT (SY IN FSYS OR  [IDENT])
	  THEN
	   BEGIN
	    ERROR(6); SKIP(FSYS OR  [IDENT])
	   END
	 END
	ELSE ERROR(14)
       UNTIL (SY <> IDENT) AND  NOT (SY IN TYPEDELS);
      IF FWPTR <> NIL
      THEN
       BEGIN
	ERROR(117); WRITELN;
	 REPEAT
	  WRITELN('   TYPE-ID ',FWPTR^.NAME);
	  FWPTR := FWPTR^.NEXT
	 UNTIL FWPTR = NIL;
	IF  NOT EOLN(INPUT)
	THEN  WRITE(' ':CHCNT + 8)
       END
     END %VARIABLEDECLARATION\ ;

    PROCEDURE PROCEDUREDECLARATION (FSY: SYMBOL);
    VAR
      OLDLEV: LEVRANGE; LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP;
      INTRPT: BOOLEAN;
      FORW: BOOLEAN; OLDTOP: DISPRANGE;
      LLC,LCM, PARLC,PARSIZE: ADDRRANGE;



      PROCEDURE PARAMTRLIST (FSY: SETOFSYS; VAR FPAR: CTP);
      VAR
	LCP,LCP1,LCP2,LCP3: CTP; LSP: STP; LKIND: IDKIND;
	LCP4: CTP;  LSP1,LSP2: STP;  DIM: INTEGER;

	PROCEDURE PARAMETERSPECIFICATION (FSY: SETOFSYS; VAR FPAR: CTP);
	VAR
	  LCP,LCP1,LCP2: CTP;    LSP: STP;
	  LKIND: IDKIND;
	  OK, ERRFOUND: BOOLEAN;
	  %DIGESTS THE ADDED  SYNTACTIC UNIT: <FORMAL FORMAL PARAM. SECTION>\

	  PROCEDURE  PSERROR (ERRORNO: INTEGER; STOPSYS: SETOFSYS);  (*$Y+*)
	   BEGIN
	    IF  NOT  ERRFOUND
	    THEN
	     BEGIN
	      ERRFOUND := TRUE;  ERROR(ERRORNO)
	     END;
	    SKIP(STOPSYS)
	   END;
	  % PSERROR\
 
 
	 (*$Y-  SAME MODULE *)

	 BEGIN  % PARAMETERSPECIFICATION \
	  LCP1 := NIL;  ERRFOUND := FALSE;
	  WHILE  SY IN [LPARENT,SEMICOLON] DO
	   BEGIN
	    INSYMBOL;
	    OK := FALSE;
	    IF  SY = PROCEDURESY
	    THEN
	     BEGIN
	      NEW(LCP,PROC,DECLARED,FORMAL);
	      WITH LCP^ DO
	       BEGIN
		IDTYPE := NIL; NEXT := LCP1; PARMLIST := NIL
	       END;
	      LCP1 := LCP ;    INSYMBOL;
	      IF  SY = LPARENT
	      THEN
	       BEGIN
		PARAMETERSPECIFICATION(FSY,LCP2); LCP1^.PARMLIST := LCP2
	       END ;
	      OK := TRUE
	     END
	    ELSE
	     IF  SY = FUNCTIONSY
	     THEN
	       BEGIN
		NEW(LCP,FUNC,DECLARED,FORMAL);
		WITH LCP^ DO
		 BEGIN
		  NEXT := LCP1;  PARMLIST := NIL;  IDTYPE := NIL
		 END;
		LCP1 := LCP;
		INSYMBOL;
		IF SY = LPARENT
		THEN
		 BEGIN
		  PARAMETERSPECIFICATION(FSY, LCP2); LCP1^.PARMLIST := LCP2
		 END ;
		IF SY = COLON
		THEN
		 BEGIN
		  INSYMBOL;
		  IF  SY = IDENT
		  THEN
		   BEGIN
		    SEARCHID([TYPES],LCP);
		    LSP := LCP^.IDTYPE;
		    INSYMBOL;
		    IF LSP <> NIL
		    THEN
		     IF LSP^.FORM >= FILES
		     THEN
		       BEGIN
			ERROR(120);   LSP := NIL
		       END;
		    LCP1^.IDTYPE := LSP;
		    OK := TRUE
		   END
		 END
	       END        %IF FUNCTIONSY\
	     ELSE
	       BEGIN
		IF SY = VARSY
		THEN
		 BEGIN
		  INSYMBOL;  LKIND := FORMAL;
		  IF  SY <> COLON
		  THEN  ERROR(607)
		  ELSE INSYMBOL
		 END
		ELSE  LKIND := ACTUAL;
		IF SY = IDENT
		THEN
		 BEGIN
		  SEARCHID([TYPES],LCP);   LSP := LCP^.IDTYPE;
		  IF  LSP <> NIL
		  THEN
		   IF (LKIND = ACTUAL) AND (LSP^.FORM = FILES)
		   THEN
		    ERROR(121);
		  NEW(LCP,VARS);
		  WITH  LCP^ DO
		   BEGIN
		    VKIND := LKIND; IDTYPE := LSP; NEXT := LCP1
		   END;
		  LCP1 := LCP;
		  INSYMBOL;   OK := TRUE
		 END
	       END;
	    IF  NOT (SY IN [RPARENT,SEMICOLON])  OR  NOT OK
	    THEN
	     BEGIN
	      PSERROR(608,[LPARENT,RPARENT,SEMICOLON] OR FSY);
	      WHILE  SY = LPARENT  DO
	       BEGIN
		PARAMETERSPECIFICATION(FSY,LCP2);
		SKIP([LPARENT,RPARENT,SEMICOLON] OR FSY)
	       END
	     END
	   END;
	  %WHILE SY\
	  IF SY = RPARENT
	  THEN INSYMBOL;
	  IF ERRFOUND
	  THEN FPAR := NIL
	  ELSE
	   BEGIN
	    LCP := NIL;
	    WHILE LCP1 <> NIL  DO
	    WITH  LCP1^ DO
	     BEGIN
	      LCP2 := NEXT;  NEXT := LCP;
	      LCP := LCP1; LCP1 := LCP2;
	     END;
	    FPAR := LCP
	   END
	 END;  %PARAMETERSPECIFICATION\

       BEGIN  %PARAMTRLIST\
	LCP1 := NIL;
	PARLC := 2;      %ADDRESS OF LAST PARAMETER IN THE LIST\
	IF  NOT (SY IN FSY OR  [LPARENT])
	THEN
	 BEGIN
	  ERROR(7); SKIP(FSYS OR  FSY OR  [LPARENT])
	 END;
	IF SY = LPARENT
	THEN
	 BEGIN
	  IF FORW
	  THEN ERROR(119);
	  INSYMBOL;
	  IF  NOT (SY IN [IDENT,VARSY,PROCEDURESY,FUNCTIONSY])
	  THEN
	   BEGIN
	    ERROR(7); SKIP(FSYS OR  [IDENT,RPARENT])
	   END;
	  WHILE SY IN [IDENT,VARSY,PROCEDURESY,FUNCTIONSY] DO
	   BEGIN
	    IF SY = PROCEDURESY
	    THEN
	     BEGIN
	      LCP4 := LCP1;   %FOR PARAMETERSPECIFICATION\
	       REPEAT
		INSYMBOL;
		IF SY = IDENT
		THEN
		 BEGIN
		  NEW(LCP,PROC,DECLARED,FORMAL);
		  WITH LCP^ DO
		   BEGIN
		    NAME := ID; IDTYPE := NIL; NEXT := LCP1;
		    PFLEV := LEVEL;  PARMLIST := NIL;
		    %ADDRESSING OF PARAMETERS CAN ONLY BE DONE AFTER
		     THEIR TOTAL LENGTH HAS BECOME KNOWN\
		   END;
		  ENTERID(LCP);
		  LCP1 := LCP;
		  INSYMBOL
		 END
		ELSE ERROR(2);
		IF  NOT (SY IN FSYS OR  [LPARENT,COMMA,SEMICOLON,RPARENT])
		THEN
		 BEGIN
		  ERROR(7); SKIP(FSYS OR [COMMA,LPARENT,
					  SEMICOLON,RPARENT])
		 END
	       UNTIL  SY <> COMMA;
	      IF  SY = LPARENT
	      THEN
	      PARAMETERSPECIFICATION(FSYS OR [SEMICOLON,RPARENT],LCP)
	      ELSE
	      LCP := NIL;
	      LCP2 := LCP1 ; %COPY POINTER TO PROCEDURE-ID LIST\
	      WHILE LCP2 <> LCP4 DO    %CHAIN SPECIF.LIST TO PROCEDURE-ID\
	       BEGIN
		LCP2^.PARMLIST := LCP;
		LCP2 := LCP2^.NEXT
	       END;
	     END
	    ELSE
	     BEGIN
	      IF SY = FUNCTIONSY
	      THEN
	       BEGIN
		LCP2 := NIL;
		 REPEAT
		  INSYMBOL;
		  IF SY = IDENT
		  THEN
		   BEGIN
		    NEW(LCP,FUNC,DECLARED,FORMAL);
		    WITH LCP^ DO
		     BEGIN
		      NAME := ID; IDTYPE := NIL; NEXT := LCP2;
		      PFLEV := LEVEL;   PARMLIST := NIL;
		     END;
		    ENTERID(LCP);
		    LCP2 := LCP;
		    INSYMBOL;
		   END;
		  IF NOT (SY IN [COMMA,COLON,LPARENT])
		  THEN
		   BEGIN
		    ERROR(7); SKIP(FSYS OR [COMMA,SEMICOLON,
					    RPARENT])
		   END;
		 UNTIL SY <> COMMA;
		IF  SY = LPARENT
		THEN
		PARAMETERSPECIFICATION(FSYS OR [SEMICOLON,COLON,RPARENT]
				       ,LCP4)
		ELSE LCP4 := NIL;
		IF SY = COLON
		THEN
		 BEGIN
		  INSYMBOL;
		  IF SY = IDENT
		  THEN
		   BEGIN
		    SEARCHID([TYPES],LCP);
		    LSP := LCP^.IDTYPE;
		    IF LSP <> NIL
		    THEN
		     IF  LSP^.FORM >= FILES
		     THEN
		       BEGIN
			ERROR(120); LSP := NIL
		       END;
		    LCP3 := LCP2;
		    WHILE LCP2 <> NIL DO
		     BEGIN
		      LCP2^.IDTYPE := LSP; LCP := LCP2;
		      LCP2^.PARMLIST := LCP4;
		      LCP2 := LCP2^.NEXT
		     END;
		    LCP^.NEXT := LCP1; LCP1 := LCP3;
		    INSYMBOL
		   END
		  ELSE ERROR(2);
		  IF  NOT (SY IN FSYS OR  [SEMICOLON,RPARENT])
		  THEN
		   BEGIN
		    ERROR(7); SKIP(FSYS OR  [SEMICOLON,RPARENT])
		   END
		 END
		ELSE ERROR(5)
	       END
	      ELSE  % SY IS NOT FUNCTION OR PROCEDURE \
	       BEGIN
		IF (SY = IDENT) AND (ID = 'STRING    ')
		THEN
		 BEGIN
		  PARSIZE := 4;
		  NEW(LSP,STRINGPARM);   LSP^.SIZE := PARSIZE;
		   REPEAT              %READ NEXT IDENTIFIER\
		    INSYMBOL;
		    IF SY = IDENT
		    THEN
		     BEGIN
		      NEW(LCP,VARS);
		      WITH LCP^ DO
		       BEGIN
			NAME := ID;   NEXT := LCP1;
			IDTYPE := LSP;   VKIND := FORMAL;   VLEV := LEVEL;
			VADDR := PARSIZE;         %TEMPORARILY CONTAINS SIZE\
		       END;
		      ENTERID(LCP);   LCP1 := LCP;
		      INSYMBOL;
		     END
		    ELSE   ERROR(2);
		    IF NOT (SY IN [COMMA,SEMICOLON,RPARENT])
		    THEN
		     BEGIN
		      ERROR(7);  SKIP(FSYS OR [COMMA,SEMICOLON,RPARENT])
		     END;
		   UNTIL  SY <> COMMA;
		 END
		ELSE   % SY IS NOT STRING \
		 BEGIN
		  IF SY = VARSY
		  THEN
		   BEGIN
		    LKIND := FORMAL; INSYMBOL
		   END
		  ELSE   LKIND := ACTUAL;
		  LCP2 := NIL;
		   LOOP
		    IF SY = IDENT
		    THEN
		     BEGIN
		      NEW(LCP,VARS);
		      WITH LCP^ DO
		       BEGIN
			NAME := ID; IDTYPE := LSP;
			VKIND := LKIND; NEXT := LCP2; VLEV := LEVEL;
		       END;
		      ENTERID(LCP);
		      LCP2 := LCP;
		      INSYMBOL;
		     END;
		    IF  NOT (SY IN [COMMA,COLON] OR  FSYS)
		    THEN
		     BEGIN
		      ERROR(7); SKIP(FSYS OR  [COMMA,SEMICOLON,
					       RPARENT])
		     END;
		   EXIT IF SY <> COMMA;
		    INSYMBOL
		   END;
		  IF SY = COLON
		  THEN
		   BEGIN
		    INSYMBOL;
		    IF NOT (SY IN [IDENT,ARRAYSY])
		    THEN ERROR(601)
		    ELSE
		     BEGIN
		      IF SY = ARRAYSY
		      THEN
		       BEGIN
			IF LKIND <> FORMAL
			THEN ERROR(602);
			INSYMBOL;  LSP1 := NIL;
			IF SY = LBRACK
			THEN INSYMBOL
			ELSE ERROR(11);
			 LOOP
			  NEW(LSP, BOUNDLESS);
			  LSP^.SUBSTRUCT := LSP1;   LSP1 := LSP;
			  TYP(FSYS OR [COMMA,RBRACK,OFSY],LSP2,DIM);
			  IF LSP2 <> NIL
			  THEN
			   IF LSP2^.FORM = SCALAR
			   THEN
			     BEGIN
			      IF LSP2 = REALPTR
			      THEN
			       BEGIN
				ERROR(109); LSP2 := NIL
			       END
			     END
			   ELSE
			     BEGIN
			      ERROR(600); LSP2 := NIL
			     END;
			  LSP^.INDEXTYPE := LSP2;
			 EXIT IF SY <> COMMA;
			  INSYMBOL
			 END;
			IF SY = RBRACK
			THEN INSYMBOL
			ELSE ERROR(12);
			IF SY = OFSY
			THEN INSYMBOL
			ELSE ERROR(8);
			IF SY = IDENT
			THEN
			 BEGIN
			  SEARCHID([TYPES], LCP);
			  LSP2 := LCP^.IDTYPE
			 END
			ELSE ERROR(2);
			LSP := LSP2;   DIM := 1;
			 REPEAT
			  WITH LSP1^ DO
			   BEGIN
			    LSP2 := SUBSTRUCT;  SUBSTRUCT := LSP;
			    UNSPECLEVEL := DIM;  SIZE := 0
			   END;
			  DIM := DIM + 1;
			  LSP := LSP1;  LSP1 := LSP2;
			 UNTIL LSP1 = NIL;
			PARSIZE := 2 * (DIM - 1)
		       END
		      ELSE
		       IF SY = IDENT
		       THEN
			 BEGIN
			  SEARCHID([TYPES],LCP);
			  LSP := LCP^.IDTYPE;
			  IF (LSP <> NIL) AND (LKIND = ACTUAL)
			  THEN
			   BEGIN
			    IF LSP^.FORM = FILES
			    THEN  ERROR(121);
			    PARSIZE := LSP^.SIZE
			   END
			  ELSE  PARSIZE := 2;
			 END;
		      LCP3 := LCP2;
		      WHILE LCP2 <> NIL DO
		       BEGIN
			LCP2^.IDTYPE := LSP; LCP := LCP2;
			LCP2^.VADDR := PARSIZE;
			%VADDR TEMPORARILY CONTAINS THE SIZE  OF THE
			 PARAMETER  IN THE PARAMETERLIST \
			LCP2 := LCP2^.NEXT
		       END;
		      LCP^.NEXT := LCP1; LCP1 := LCP3;
		      INSYMBOL;
		     END;
		    IF  NOT (SY IN FSYS OR  [SEMICOLON,RPARENT])
		    THEN
		     BEGIN
		      ERROR(7); SKIP(FSYS OR  [SEMICOLON,RPARENT])
		     END
		   END
		  ELSE ERROR(5);
		 END;
	       END;
	     END;
	    IF SY = SEMICOLON
	    THEN
	     BEGIN
	      INSYMBOL;
	      IF  NOT (SY IN FSYS OR [IDENT,VARSY,PROCEDURESY,FUNCTIONSY])
	      THEN
	       BEGIN
		ERROR(7); SKIP(FSYS OR  [IDENT,RPARENT])
	       END
	     END
	   END %WHILE\ ;
	  IF SY = RPARENT
	  THEN INSYMBOL
	  ELSE ERROR(4);
	  LCP3 := NIL;
	  %REVERSE POINTERS   AND  ASSIGN ADDRESSES  TO THE PARAMETERS\
	  WHILE LCP1 <> NIL DO
	  WITH LCP1^ DO
	   BEGIN
	    IF (KLASS = PROC) OR (KLASS = FUNC)
	    THEN
	     BEGIN
	      PFADDR := PARLC;  PARLC := PARLC + 4
	     END
	    ELSE
	     BEGIN
	      PARSIZE := VADDR;         %KLASS = VARS\
	      VADDR := PARLC; PARLC := PARLC + PARSIZE;
	      IF (VKIND = ACTUAL) AND ( IDTYPE^.FORM = ARRAYS)
	      THEN
	      VADDR := VADDR - IDTYPE^.ADDRCORR
	     END;
	    LCP2 := NEXT;  NEXT := LCP3 ;
	    LCP3 := LCP1; LCP1 := LCP2
	   END;
	  FPAR := LCP3
	 END
	ELSE FPAR := NIL
       END   % PARAMETERLIST \  ;

      PROCEDURE EXTERNALDECL(FCP:CTP) (*$Y+*) ;
       VAR  LCP: CTP;
       BEGIN
	FCP^.DECLPLACE := EXTRNL;
	IF SY = LPARENT
	THEN
	WITH FCP^ DO
	 BEGIN
	  INSYMBOL;
	  IF SY = IDENT
	  THEN
	   BEGIN
	    IF ID = 'ALTX      '
	    THEN DECLPLACE := EXTERNALTX
	    ELSE
	     IF ID = 'FORTRAN   '
	     THEN DECLPLACE := EXTERNFORTRAN
	     ELSE  ERROR(399) ;
	    INSYMBOL;
	    IF SY = COMMA
	    THEN INSYMBOL
	    ELSE
	     IF SY <> RPARENT
	     THEN ERROR(20);
	   END  % IF IDENT \ ;
	  IF SY = STRINGCONST
	  THEN
	   BEGIN
            NEW(EXTNAME);
	    WITH VAL.VALP^ DO
	    FOR I := 0 TO ALFALENG-1 DO
	    IF I > SLGTH
	    THEN EXTNAME^[I+1] := ' '
	    ELSE EXTNAME^[I+1] := SVAL[I];
	    INSYMBOL
	   END  % IF STRING \ ;
	  IF SY = RPARENT
	  THEN INSYMBOL
	  ELSE ERROR(4);
	 END  % IF LPARENT \ ;
	IF SY = SEMICOLON
	THEN INSYMBOL
	ELSE ERROR(14);
	IF NOT ( SY IN FSYS )
	THEN
	 BEGIN
	  ERROR(6);  SKIP(FSYS)
	 END;
        LCP := FCP^.NEXT;
        IF FCP^.DECLPLACE = EXTERNFORTRAN THEN
         WHILE LCP <> NIL DO
          BEGIN IF LCP^.VKIND <> FORMAL THEN ERROR(182);
           LCP^.VKIND := FORMAL;  LCP := LCP^.NEXT;   FCP^.PFLEV := 0;
          END;
       END  % EXTERNALDECL \ ;


      (*$Y- DONT SPLIT THESE MODULES *)
 
      PROCEDURE FINDEXTNAME( FCP: CTP );
       LABEL   1,99;
       VAR   DOT,I: INTEGER;   LCP: CTP;   CH: CHAR;
             SLOW: ALFA;

         FUNCTION COMPSTR(S1,S2: ALFA): BOOLEAN;
          VAR I: INTEGER;   B: BOOLEAN;
          BEGIN   B:=TRUE;
           FOR I:=1 TO 6 DO B := B AND ( S1[I]=S2[I] );
           COMPSTR := B;
          END  % COMPSTR \ ;

       FUNCTION COMP(FCP:CTP):BOOLEAN;
        LABEL   9,99;
        BEGIN   IF FCP = NIL THEN COMP := FALSE
         ELSE IF NOT (FCP^.KLASS IN [PROC,FUNC]) THEN GOTO 9
         ELSE IF COMPSTR(FCP^.NAME,SLOW) THEN COMP := TRUE
         ELSE IF FCP^.PFDECKIND<>DECLARED THEN GOTO 9
         ELSE IF FCP^.PFKIND<>ACTUAL THEN GOTO 9
         ELSE IF  FCP^.EXTNAME=NIL THEN GOTO 9
         ELSE IF COMPSTR(FCP^.EXTNAME^,SLOW)  THEN COMP := TRUE
         ELSE  GOTO 9;
         GOTO 99;
    9:   IF COMP(FCP^.LLINK) THEN COMP := TRUE
         ELSE COMP := COMP(FCP^.RLINK);
   99:  END % COMP \;
       BEGIN  % FINDEXTNAME \
        SLOW := FCP^.NAME;  DOT := 7;  CH := ' ';
    1:  FOR I := TOP DOWNTO 1 DO
         BEGIN
          IF COMP(DISPLAY[I].FNAME) THEN
           BEGIN
            IF DOT = 1 THEN BEGIN  ERROR(931);  GOTO 99  END
            ELSE
             BEGIN
              SLOW[DOT] := CH;
              DOT := DOT-1;   CH := SLOW[DOT];
              SLOW[DOT] := '.';    GOTO 1;
             END
           END % IF COMP \
         END %FOR \;
    99: IF DOT = 7 THEN FCP^.EXTNAME := NIL
        ELSE
         BEGIN   NEW(FCP^.EXTNAME);  FCP^.EXTNAME^ := SLOW;
         END;
       END   % FINDEXTNAME \;


    (*$Y+*)     (*   SPLIT MODULES AGAIN   *)

     BEGIN %PROCEDUREDECLARATION\
      PARLC := 0;
      LLC := LC;
      IF ONSWITCH['D'] THEN LC := -4 ELSE LC := -2;
      IF SY = IDENT
      THEN
       BEGIN
	SRCHSECTION(DISPLAY[TOP].FNAME,LCP);   %DECIDE WHETHER FORW.\
	IF LCP <> NIL
	THEN
	 BEGIN
	  IF LCP^.KLASS = PROC
	  THEN
	  FORW := (LCP^.DECLPLACE=FORWDECL) AND (FSY = PROCEDURESY) AND
	  (LCP^.PFKIND = ACTUAL)
	  ELSE
	   IF LCP^.KLASS = FUNC
	   THEN
	    FORW := (LCP^.DECLPLACE=FORWDECL) AND (FSY = FUNCTIONSY) AND (LCP^.PFKIND =
									  ACTUAL)
	   ELSE FORW := FALSE;
	  IF  NOT FORW
	  THEN ERROR(160)
	 END
	ELSE FORW := FALSE;
	IF  NOT FORW
	THEN
	 BEGIN
	  IF FSY = PROCEDURESY
	  THEN NEW(LCP,PROC,DECLARED,ACTUAL)
	  ELSE NEW(LCP,FUNC,DECLARED,ACTUAL);
	  WITH LCP^ DO
	   BEGIN
	    NAME := ID; IDTYPE := NIL;  NEXT := NIL;  FINDEXTNAME(LCP);
	    PFLEV := LEVEL; PFADDR := 0;  DECLPLACE := INTERNAL;
	   END;
	  ENTERID(LCP)
	 END;
	INSYMBOL
       END
      ELSE
       BEGIN
	ERROR(2);
	IF FSY = PROCEDURESY
	THEN LCP := UPRCPTR
	ELSE LCP := UFCTPTR;
       END;
      OLDLEV := LEVEL; OLDTOP := TOP;
      LEVEL := LEVEL + 1;
      IF TOP < DISPLIMIT
      THEN
       BEGIN
	TOP := TOP + 1;
	WITH DISPLAY[TOP] DO
	 BEGIN
	  IF FORW
	  THEN FNAME := LCP^.NEXT
	  ELSE FNAME := NIL;
	  OCCUR := BLCK
	 END
       END
      ELSE ERROR(250);
      IF FSY = PROCEDURESY
      THEN
       BEGIN
	PARAMTRLIST([SEMICOLON],LCP1);
	IF  NOT FORW
	THEN LCP^.NEXT := LCP1
       END
      ELSE
       BEGIN
	PARAMTRLIST([SEMICOLON,COLON],LCP1);
	IF  NOT FORW
	THEN LCP^.NEXT := LCP1;
	IF SY = COLON
	THEN
	 BEGIN
	  INSYMBOL;
	  IF SY = IDENT
	  THEN
	   BEGIN
	    IF FORW
	    THEN ERROR(122);
	    SEARCHID([TYPES],LCP1);
	    LSP := LCP1^.IDTYPE;
	    LCP^.IDTYPE := LSP;
	    IF LSP <> NIL
	    THEN
	     IF  LSP^.FORM >= FILES
	     THEN
	       BEGIN
		ERROR(120); LCP^.IDTYPE := NIL
	       END;
	    INSYMBOL
	   END
	  ELSE
	   BEGIN
	    ERROR(2); SKIP(FSYS OR  [SEMICOLON])
	   END
	 END
	ELSE
	 IF  NOT FORW
	 THEN ERROR(123)
       END;
      IF NOT FORW
      THEN  LCP^.PARLISTSIZE := PARLC;
      IF SY = SEMICOLON
      THEN INSYMBOL
      ELSE ERROR(14);
      IF SY = FORWARDSY
      THEN
       BEGIN
	IF FORW
	THEN ERROR(161)
	ELSE LCP^.DECLPLACE := FORWDECL ;
	INSYMBOL;
	IF SY = SEMICOLON
	THEN INSYMBOL
	ELSE ERROR(14);
	IF  NOT (SY IN FSYS)
	THEN
	 BEGIN
	  ERROR(6); SKIP(FSYS)
	 END
       END
      ELSE
       IF SY = EXTERNALSY
       THEN
	 BEGIN
	  INSYMBOL;  EXTERNALDECL(LCP)
	 END
       ELSE
	 BEGIN
	  WITH LCP^ DO
	  IF DECLPLACE = FORWDECL
	  THEN DECLPLACE := FORWFOUND ;
	   REPEAT
	    BLOCK(FSYS,SEMICOLON,LCP);
	    IF SY = SEMICOLON
	    THEN
	     BEGIN
	      INSYMBOL;
	      IF  NOT (SY IN [BEGINSY,PROCEDURESY,FUNCTIONSY])
	      THEN
	       BEGIN
		ERROR(6); SKIP(FSYS)
	       END
	     END
	    ELSE  IF MAIN OR (LEVEL > 2) THEN ERROR(14)
	   UNTIL SY IN [BEGINSY,PROCEDURESY,FUNCTIONSY,PERIOD];
	 END;
      LEVEL := OLDLEV; TOP := OLDTOP; LC := LLC;
     END %PROCEDUREDECLARATION\ ;


    PROCEDURE BODY(FSYS: SETOFSYS);
    VAR
      I: INTEGER; CIX1: CODERANGE ;
      LCMAX,LLC1,ADDR: ADDRRANGE; LCP: CTP;
      LLP: LBP;   INTRPT: BOOLEAN;

      PROCEDURE WRITOBJ ( VAR REC: OBJECTRECORD ) ;


       BEGIN
	IF NOT OFFSWITCH['K']
	THEN
	WRITOFILE( REC, PDP11OBJ (*$Z+*) , OUTPUTHGH (*$Z-*) )
        ELSE REC.LEN := 1;
       END;

    (*$Y-*)   (* NO MODULE SPLITTING FOR A WHILE *)

      FUNCTION RAD50 ( FSTR: ALFA ; FINDEX: INTEGER ): INTEGER ;
      VAR
	I,J: INTEGER ;
	FUNCTION RAD50C ( CH: CHAR ): INTEGER ;
	 BEGIN
	  IF CH IN LETTERS
	  THEN RAD50C := ORD(CH) - 64
	  ELSE
	   IF CH IN DIGITS
	   THEN RAD50C := ORD(CH) - 18
	   ELSE
	     IF CH = ' '
	     THEN RAD50C := 0
	     ELSE
	       IF CH = '$'
	       THEN RAD50C := 27
	       ELSE
		 IF CH = '.'
		 THEN RAD50C := 28
		 ELSE RAD50C := 29
	 END ;

       BEGIN % RAD50 \
	J := 0 ;
	FOR I := FINDEX TO FINDEX + 2 DO
	J := 40 * J + RAD50C ( FSTR[I] ) ;
	RAD50 := J
       END ;

      PROCEDURE PUTGR50 ( R50N1,R50N2,FLAGS,FVAL: INTEGER ) ;
       BEGIN
	WITH GSD DO
	 BEGIN
	  IF LEN > 17
	  THEN WRITOBJ ( GSD ) ;
	  VALUE[LEN+1] := R50N1 ;
	  VALUE[LEN+2] := R50N2 ;
	  VALUE[LEN+3] := FLAGS ;
	  VALUE[LEN+4] := FVAL ;
	  LEN := LEN + 4 ;
	 END
       END ;

      PROCEDURE PUTGSD ( FNAM: ALFA ; FLAGS,FVAL: INTEGER ) ;
       BEGIN
	PUTGR50 ( RAD50(FNAM,1) , RAD50(FNAM,4), FLAGS, FVAL )
       END;

      PROCEDURE PUTRLD ( FNAM: ALFA ; FTYP,FDISPL,FVAL: INTEGER ) ;
       BEGIN
	WITH RLD DO
	 BEGIN
	  VALUE[LEN+1] := FTYP + 256 * FDISPL ;
	  IF FTYP <> 8
	  THEN
	   BEGIN
	    VALUE [ LEN+2 ] := RAD50 ( FNAM, 1 ) ;
	    VALUE [ LEN + 3 ] := RAD50 ( FNAM, 4 ) ;
	    LEN := LEN + 2
	   END;
	  VALUE [ LEN + 2 ] := FVAL ;
	  LEN := LEN + 2 ;
	  IF LEN > 17
	  THEN
	   BEGIN
	    WRITOBJ(CODE) ;  WRITOBJ(RLD)
	   END ;
	 END ;
        (*$Z+*)   IF PRCODE AND (FTYP = RELOCFCN) 
                  THEN WRITELN( CEX, ';', FNAM:60 ); (*$Z-*)
       END ;

      PROCEDURE GLOBALDEF ( FNAM: ALFA ; FADDR: CODERANGE ) ;
       BEGIN
	IF GLOBALINDEX = GBLDFMAX
	THEN ERROR ( 999 )
	ELSE
	 BEGIN
	  GLOBALINDEX := GLOBALINDEX + 1 ;
	  WITH GLOBALENTRY [ GLOBALINDEX ] DO
	   BEGIN
	    EPADDR := FADDR ;
	    R50P1 := RAD50 ( FNAM, 1 ) ;
	    R50P2 := RAD50 ( FNAM, 4 ) ;
	   END
	 END
       END ;

      PROCEDURE PSECTDEF ( FNAM: ALFA ; FSIZE: CODERANGE ) ;
      VAR
	I: INTEGER ;
       BEGIN
	PUTGSD ( FNAM, PSECTDEFFLAGS, FSIZE ) ;
	FOR I := OLDGLOBALINDEX + 1 TO GLOBALINDEX DO
	WITH GLOBALENTRY [ I ] DO
	PUTGR50 ( R50P1, R50P2, GLOBALDEFFLAGS, EPADDR ) ;
       END ;

      PROCEDURE INCCIX;
       BEGIN
	CIX := CIX + 1;
	IF CODE.LEN = 21
	THEN
	 BEGIN
	  WRITOBJ ( CODE ) ;
	  IF RLD.LEN > 1
	  THEN WRITOBJ ( RLD ) ;
	 END ;
	WITH CODE DO
	 BEGIN
	  IF LEN = 1
	  THEN
	   BEGIN
	    LEN := 2 ;   VALUE [ 2 ] := 2 * CIX
	   END ;
	  LEN := LEN + 1
	 END
       END;

      (*$Z+*)


      PROCEDURE WRITEREG(MODE,REG: INTEGER );
       BEGIN
	IF ODD(MODE DIV 8)
	THEN   WRITE(CEX,'@');
	 CASE MODE DIV 16 OF
	  0:  WRITE(CEX,REGNAMES[REG]);
	  1:
	    IF REG = PC
	    THEN WRITE(CEX,'#C')
	    ELSE WRITE(CEX,'(',REGNAMES[REG],')+');
	  2:  WRITE(CEX,'-(',REGNAMES[REG],')');
	  3:  WRITE(CEX,'X(',REGNAMES[REG],')')
	 END
       END  %WRITEREG \ ;

      (*$Z-*)

      PROCEDURE GEN1(OPCODE: INSTRRANGE;  MODE, REGISTER: INTEGER);
      VAR
	BYTE: PACKED ARRAY[0..3] OF CHAR;
       BEGIN
	INCCIX;
	WITH CODE DO
	 BEGIN
	  VALUE [ LEN ] := INSTRVAL[OPCODE] + MODE + REGISTER ;
	  (*$Z+*)
	  IF PRCODE
	  THEN
	   BEGIN
	    IF OPCODE < CLR
	    THEN BYTE := 'B   '
	    ELSE BYTE := '    ';
	    WRITE(CEX,2*CIX:6:O,'    ',VALUE[LEN]:6:O,MN[OPCODE]:10,BYTE);
	    WRITEREG(MODE,REGISTER);  WRITELN(CEX)
	   END
	    (*$Z-*)
	 END
       END;
      %GEN1\

      PROCEDURE GEN2(OPCODE: INSTRRANGE;  SRCMODE, SRCREG, DSTMODE, DSTREG: INTEGER);
      VAR
	BYTE: PACKED ARRAY[0..3] OF CHAR;
       BEGIN
	INCCIX;
	WITH CODE DO
	 BEGIN
	  VALUE [ LEN ] := INSTRVAL[OPCODE] + 64 * (SRCMODE + SRCREG) + DSTMODE + DSTREG ;
	  (*$Z+*)
	  IF PRCODE
	  THEN
	   BEGIN
	    IF OPCODE < CLR
	    THEN BYTE :='B   '
	    ELSE BYTE:='    ';
	    WRITE(CEX,2*CIX:6:O,'    ',VALUE[LEN]:6:O,MN[OPCODE]:10,BYTE);
	    WRITEREG(SRCMODE,SRCREG);  WRITE(CEX,',');
	    WRITEREG(DSTMODE,DSTREG);  WRITELN(CEX)
	   END
	    (*$Z-*)
	 END
       END;
      %GEN2\

      PROCEDURE GENBR(BRCODE: INSTRRANGE;  OFFS: INTEGER);
       VAR   OFFSET: INTEGER;
       BEGIN
	INCCIX;
	IF OFFS < 0
	THEN OFFSET := OFFS + 256 ELSE OFFSET := OFFS;
	WITH CODE DO
	 BEGIN
	  VALUE [ LEN ] := INSTRVAL[BRCODE] +  OFFSET ;
	  (*$Z+*)
	  IF PRCODE
	  THEN  WRITELN(CEX,2*CIX:6:O,'    ',VALUE[LEN]:6:O,
				  MN[BRCODE]:10,OFFS:8,'    ;  ',2*(CIX+1+OFFS):6:O)
	  (*$Z-*)
	 END
       END;
      %GENBR\

      PROCEDURE  GENCONST(CNST: INTEGER);
       BEGIN
	INCCIX;
	WITH CODE DO
	VALUE [LEN] := CNST ;
	(*$Z+*)
	IF PRCODE
	THEN
	WRITELN(CEX,2*CIX:6:O,'    ',CNST:6:O,'       ',CNST:12)
	(*$Z-*)
       END  %GENCONST\ ;


      PROCEDURE GENSUBRCALL (SUBRNAME:RUNTIMEROUTS );
       FORWARD;


      PROCEDURE LINENODEF;
       BEGIN   IF LINENO <> OLDLINENO THEN
        BEGIN   OLDLINENO := LINENO;
	 IF TRACE THEN GENSUBRCALL ( TRACK );
         GEN2(MOV,REG,PC,INDEX,GP);
         GENCONST(LINEADDR);
	 IF FREQUENCE OR DEBUG THEN
	 WITH LASTLINE DO
	  BEGIN   GEN1 ( TST,AUTINC,PC );  GENCONST ( 0 );
	   IF LLADDR <> 0 THEN
	       PUTRLD ( LLPSECT,15B%PSECT ADD.REL.\,2*CODE.LEN-2,2*LLADDR);
	     LLPSECT := PSECT;   LLADDR := CIX - 3;
	  END;
	 IF FREQUENCE THEN
	  BEGIN  GEN1( INC,AUTINC,PC );  GENCONST ( 0 )
	  END;
        END
       END   % LINENODEF \;
 
      PROCEDURE MOVETOSP( N: INTEGER );
       VAR   I: INTEGER;
       BEGIN
	IF N > 4 THEN
	 BEGIN  GENSUBRCALL(MOVTS);
		GENCONST( N );
	 END
	ELSE FOR I:=1 TO N DO GEN2( MOV,AUTDEC,AD,AUTDEC,SP );
       END   % MOVE TO SP \;
 
      PROCEDURE MOVEFROMSP( N: INTEGER );
       VAR   I: INTEGER;
       BEGIN
	IF N > 4 THEN
	 BEGIN  GENSUBRCALL( MOVFS );
	        GENCONST( N );
	 END
	ELSE FOR I:=1 TO N DO GEN2( MOV,AUTINC,SP,AUTINC,AD );
       END   % MOVE FROM SP \;
 
 
 
      PROCEDURE  ADDTOP (I:INTEGER);
      (* GENERATE CODE TO ADD A CONSTANT TO TOP OF STACK *)
      BEGIN
      IF  I <> 0  THEN
	BEGIN
	GEN2 (ADD,AUTINC,PC,REGDEF,SP);
	GENCONST (I)
	END
      END;
 
 
 
      PROCEDURE  LOD (P: LEVRANGE; Q,SIZE: ADDRRANGE);   %FOR ADDRESSING VARI-\
      VAR
	I, REGISTER: INTEGER;                        %ABLES ON INTERMEDIATE\
       BEGIN                                              %LEVELS\
	IF SIZE = 2
	THEN
	 BEGIN
	  IF  P = 0
	  THEN  REGISTER := MP
	  ELSE
	   BEGIN
	    REGISTER := AD;
	    GEN2(MOV,REGDEF,MP,REG,AD);
	    FOR  I := 2  TO  P  DO
	    GEN2(MOV,REGDEF,AD,REG,AD)
	   END;
	  IF  COMPTYPES( GATTR.TYPTR, CHARPTR )
	  THEN
	   BEGIN
	    GEN1(CLR, AUTDEC,SP);
	    GEN2(MOVB,INDEX,REGISTER,REGDEF,SP)
	   END
	  ELSE      GEN2(MOV,INDEX,REGISTER,AUTDEC,SP);
	  GENCONST(Q)
	 END            %SIZE = 2\
	ELSE
	 BEGIN
	  IF  P = 0
	  THEN  GEN2(MOV,REG,MP,REG,AD)
	  ELSE
	   BEGIN
	    GEN2(MOV,REGDEF,MP,REG,AD);
	    FOR  I := 2  TO  P DO
	    GEN2(MOV,REGDEF,AD,REG,AD)
	   END;
	  GEN2(ADD,AUTINC,PC,REG,AD);
	  GENCONST(Q + SIZE);          %Q AND SIZE IN BYTES\
	    MOVETOSP( SIZE DIV 2 );
	 END
       END;
      %LOD \

      PROCEDURE  LDO (Q, VSIZE: ADDRRANGE);   %FOR LOADING GLOBALLY DECLARED\
      VAR
	I: INTEGER;                       %VARIABLES\
       BEGIN
	IF  VSIZE = 2
	THEN
	 IF COMPTYPES( GATTR.TYPTR , CHARPTR )
	 THEN
	   BEGIN
	    GEN1(CLR,AUTDEC,SP);
	    GEN2(MOVB,INDEX,GP,REGDEF,SP); GENCONST(Q);
	   END
	 ELSE
	   BEGIN
	    GEN2(MOV,INDEX,GP,AUTDEC,SP);
	    GENCONST(Q)
	   END
	ELSE
	 BEGIN
	  GEN2(MOV,REG,GP,REG,AD);
	  GEN2(ADD,AUTINC,PC,REG,AD);
	  GENCONST(Q + VSIZE);
	  MOVETOSP( VSIZE DIV 2 );
	 END
       END;
      %LDO \

      PROCEDURE  GENSUBRCALL;   %GENERATES RTRCALLS\
      VAR
	ID: ALFA ;   I: INTEGER ;
       BEGIN
	ID[1] := '$' ;
	FOR I := 0 TO 4 DO ID[I+2] := RNA[SUBRNAME][I] ;
	FOR I := 7 TO ALFALENG DO ID[I] := ' ' ;
	GEN2( JSR, REG, MP, INDEX, PC ) ;
	GENCONST ( 0 ) ;   PUTRLD ( ID, RELOCFCN, 2*CODE.LEN-2, 0 ) ;
	IF NOTCALLED [SUBRNAME]
	THEN
	 BEGIN
	  NOTCALLED [SUBRNAME] := FALSE ;
	  PUTGSD ( ID, GLOBALREFFLAGS, 0 )
	 END ;
       END;
      %GENSUBRCALL\

      PROCEDURE  GENUJP(LADDR: CODERANGE);
       BEGIN
	IF (LADDR <> 0) AND (CIX - LADDR <= 126)
	THEN
	GENBR(BR,LADDR - CIX - 2)
	ELSE
	 BEGIN
	  GEN1(JMP,INDEX,PC);
	  IF LADDR<>0
	  THEN GENCONST(2 * (LADDR-CIX-2))
	  ELSE GENCONST(0)
	 END;
       END;
      %GENUJP\

      PROCEDURE INSERT(ADDRS: CODERANGE; OFFST: ADDRRANGE);
       BEGIN
	IF CODE.LEN > 1
	THEN WRITOBJ( CODE ) ;
	WITH RLD DO
	 BEGIN
	  IF LEN > 19
	  THEN   WRITOBJ ( RLD ) ;
	  VALUE [ LEN+1 ] := 8 ;   % REDEFINE CURRENT LOCATION POINTER \
	  VALUE [ LEN+2 ] := 2 * ADDRS ;  % NEW LOCATION \
	  LEN := LEN + 2 ;    WRITOBJ ( RLD )
	 END ;
	WITH CODE DO
	 BEGIN
	  VALUE [ 2 ] := 2*ADDRS ;   VALUE [ 3 ] := OFFST ;
	  LEN := 3 ;   WRITOBJ ( CODE ) ;
	 END ;
	WITH RLD DO
	 BEGIN
	  VALUE [ 2 ] := 8 ;   VALUE [ 3 ] := 2 * CIX + 2 ;
	  LEN := 3 ;   WRITOBJ ( RLD ) ;
	 END ;
	(*$Z+*)
	IF PRCODE
	THEN
	 BEGIN
	  WRITELN(CEX,';');
	  WRITELN(CEX,2*ADDRS:6:O,'    ',OFFST:6:O);
	  WRITELN(CEX,';');
	 END
	  (*$Z-*)
       END ;

      PROCEDURE LOAD;
      VAR
	I: INTEGER;
       BEGIN
	WITH GATTR DO
	IF TYPTR <> NIL
	THEN
	 BEGIN
	   CASE KIND OF
	    CST:
		IF  TYPTR^.FORM = SCALAR
		THEN
		 IF  TYPTR = REALPTR
		 THEN
		   BEGIN
		    %HERE A  REAL  VALUE   IS   REPRESENTED BY TWO PDP-11 INTEGERS\
		    GEN2(MOV,AUTINC,PC,AUTDEC,SP);
		    GENCONST(CVAL.VALP^.TAIL);
		    GEN2(MOV,AUTINC,PC,AUTDEC,SP);
		    GENCONST(CVAL.VALP^.HEAD);
		   END
		 ELSE
		   IF CVAL.IVAL = 0
		   THEN  GEN1(CLR,AUTDEC,SP)
		   ELSE
		     BEGIN
		      GEN2(MOV,AUTINC,PC,AUTDEC,SP);
		      GENCONST(CVAL.IVAL)
		     END   %FORM = SCALAR\
		ELSE
		 IF TYPTR = NILPTR
		 THEN  GEN1(CLR,AUTDEC,SP)
		 ELSE  ERROR(400);
	    VARBL:
		   CASE  ACCESS  OF
		    DRCT:
			 IF  VLEVEL <= 1
			 THEN  LDO(DPLMT,TYPTR^.SIZE)
			 ELSE  LOD(LEVEL - VLEVEL,DPLMT,TYPTR^.SIZE);
		    INDRCT:
			   IF  TYPTR^.SIZE = 2
			   THEN
			    IF COMPTYPES ( TYPTR , CHARPTR )
			    THEN
			      BEGIN
			       GEN2(MOV,AUTINC,SP,REG,AD);
			       GEN1(CLR,AUTDEC,SP);
			       IF IDPLMT = 0
			       THEN
			       GEN2(MOVB,REGDEF,AD,REGDEF,SP)
			       ELSE
				BEGIN
				 GEN2(MOVB,INDEX,AD,REGDEF,SP);
				 GENCONST(IDPLMT)
				END
			      END
			    ELSE
			      IF IDPLMT = 0
			      THEN
			       GEN2(MOV,AUTINCDEF,SP,AUTDEC,SP)
			      ELSE
				BEGIN
				 GEN2(MOV,AUTINC,SP,REG,AD);
				 GEN2(MOV,INDEX,AD,AUTDEC,SP);
				 GENCONST(IDPLMT)
				END
			   ELSE
			    BEGIN
			     GEN2(MOV,AUTINC,SP,REG,AD);
			     GEN2(ADD,AUTINC,PC,REG,AD);
			     GENCONST(IDPLMT + TYPTR^.SIZE);
			     MOVETOSP( TYPTR^.SIZE DIV 2 );
			    END;
		    PACKD:
			  IF TYPTR = BOOLPTR
			  THEN
			  GENSUBRCALL(LPB)
			  ELSE   ERROR(400)
		   END;
	    EXPR:
	   END;
	  KIND := EXPR
	 END
       END %LOAD\ ;

      PROCEDURE GENFJP(LADDR: CODERANGE);
       BEGIN
	LOAD;
	IF GATTR.TYPTR <> NIL
	THEN
	 IF GATTR.TYPTR <> BOOLPTR
	 THEN ERROR(144);
	GEN1(TST,AUTINC,SP);
	IF (LADDR <> 0) AND (CIX - LADDR <= 126)
	THEN
	GENBR(BEQ,LADDR - CIX - 2)   %BACKWARD JUMP WITH OFFSET <= 128\
	ELSE
	 BEGIN
	  GENBR(BNE, 2);
	  GEN1(JMP,INDEX,PC);
	  IF LADDR <> 0
	  THEN GENCONST(2 * (LADDR - CIX - 2))
	  ELSE GENCONST(0)
	 END
       END;
      %GENFJP\

      (*$Y+*)     (*   MODULE SPLITTING   *)

      PROCEDURE STORE(VAR FATTR: ATTR);
      VAR
	I,P,REGISTER: INTEGER;
       BEGIN
	WITH FATTR DO
	IF TYPTR <> NIL
	THEN
	 CASE ACCESS OF
	  DRCT:
	       IF  VLEVEL <= 1
	       THEN            %STORE AT GLOBAL LEVEL\
		BEGIN
		 IF TYPTR^.SIZE = 2
		 THEN
		  BEGIN
		   IF COMPTYPES ( TYPTR , CHARPTR )
		   THEN
		    BEGIN
		     GEN2(MOV,AUTINC,SP,REG,R);
		     GEN2(MOVB,REG,R,INDEX,GP)
		    END
		   ELSE  GEN2(MOV,AUTINC,SP,INDEX,GP);
		   GENCONST(DPLMT)
		  END
		 ELSE
		  BEGIN
		   GEN2(MOV,REG,GP,REG,AD);
		   GEN2(ADD,AUTINC,PC,REG,AD);
		   GENCONST(DPLMT);
		   MOVEFROMSP( TYPTR^.SIZE DIV 2 );
		  END
		END
	       ELSE
		BEGIN
		 P := LEVEL - VLEVEL;
		 IF TYPTR^.SIZE = 2
		 THEN
		  BEGIN
		   IF P = 0
		   THEN  REGISTER := MP
		   ELSE
		    BEGIN
		     REGISTER := AD;
		     GEN2(MOV,REGDEF,MP,REG,AD);
		     FOR  I := 2  TO P DO
		     GEN2(MOV,REGDEF,AD,REG,AD)
		    END;
		   IF COMPTYPES ( TYPTR , CHARPTR )
		   THEN
		    BEGIN
		     GEN2(MOV,AUTINC,SP,REG,R);
		     GEN2(MOVB,REG,R,INDEX,REGISTER)
		    END
		   ELSE  GEN2(MOV,AUTINC,SP,INDEX,REGISTER);
		   GENCONST(DPLMT)
		  END
		 ELSE
		  BEGIN
		   IF  P = 0
		   THEN  GEN2(MOV,REG,MP,REG,AD)
		   ELSE
		    BEGIN
		     GEN2(MOV,REGDEF,MP,REG,AD);
		     FOR  I := 2 TO P DO
		     GEN2(MOV,REGDEF,AD,REG,AD)
		    END;
		   GEN2(ADD,AUTINC,PC,REG,AD);
		   GENCONST(DPLMT);
		   MOVEFROMSP( TYPTR^.SIZE DIV 2 );
		  END
		END;
	  INDRCT:
		 IF  IDPLMT <> 0
		 THEN ERROR(400)
		 ELSE
		  BEGIN
		   IF TYPTR^.SIZE = 2
		   THEN
		    IF COMPTYPES ( TYPTR , CHARPTR )
		    THEN
		      BEGIN
		       GEN2(MOV,AUTINC,SP,REG,R);
		       GEN2(MOVB,REG,R,AUTINCDEF,SP)
		      END
		    ELSE  GEN2(MOV,AUTINC,SP,AUTINCDEF,SP)
		   ELSE
		    BEGIN
		     GEN2(MOV,INDEX,SP,REG,AD);
		     GENCONST(TYPTR^.SIZE);
		     MOVEFROMSP( TYPTR^.SIZE DIV 2 );
		     GEN1(TST,AUTINC,SP)
		    END
		  END;
	  PACKD:
		IF TYPTR = BOOLPTR
		THEN  GENSUBRCALL(STPB)
		ELSE   ERROR(400)
	 END
       END %STORE\ ;

      (*$Y+*)     (*  MODULE SPLITTING  *)
      PROCEDURE LOADADDRESS;
      VAR
	I,J: INTEGER;
       BEGIN
	WITH GATTR DO
	IF TYPTR <> NIL
	THEN
	 BEGIN
	   CASE KIND OF
	    CST:
		IF NOT STRING(TYPTR)
		THEN ERROR(400);
	    VARBL:
		   CASE ACCESS OF
		    DRCT:
			  BEGIN
			   IF  VLEVEL <= 1
			   THEN
			   GEN2(MOV,REG,GP,AUTDEC,SP)
			   ELSE
			    BEGIN
			     I := LEVEL - VLEVEL;
			     IF I = 0
			     THEN GEN2(MOV,REG,MP,AUTDEC,SP)
			     ELSE
			      IF I = 1
			      THEN
			       GEN2(MOV,REGDEF,MP,AUTDEC,SP)
			      ELSE
				BEGIN
				 GEN2(MOV,REGDEF,MP,REG,AD);
				 FOR J := 3 TO  I DO
				 GEN2(MOV,REGDEF,AD,REG,AD);
				 GEN2(MOV,REGDEF,AD,AUTDEC,SP)
				END
			    END;
			   GEN2(ADD,AUTINC,PC,REGDEF,SP);
			   GENCONST(DPLMT)
			  END;
		    INDRCT:
			   ADDTOP (IDPLMT);
		    PACKD:
		   END;
	    EXPR:  ERROR(616)
	   END;
	  KIND := VARBL;
	  IF ACCESS <> PACKD
	  THEN
	   BEGIN
	    ACCESS := INDRCT; IDPLMT := 0
	   END
	 END
       END;
      %LOADADDRESS\

      (*$Y+*)     (*  NEW MODULE  *)

      PROCEDURE STATEMENT(FSYS: SETOFSYS);
      LABEL   1;
      VAR
	LCP: CTP; LLP: LBP;

	PROCEDURE  MULTIPLY;
	 BEGIN
	  IF EXTSET
	  THEN
	   BEGIN
	    GEN2(MOV,AUTINC,SP,REG,R);
	    GEN2(MULT,REG,R,AUTINC,SP);
	    GEN2(MOV,REG,R,AUTDEC,SP);
	   END
	  ELSE   GENSUBRCALL(MPI);
	 END;
	%MULTIPLY\

	(*$Y- DONT SPLIT THESE MODULES *)
 
	PROCEDURE EXPRESSION(FSYS: SETOFSYS); FORWARD;

	PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP);
	VAR
	  LATTR: ATTR; LCP: CTP; LMIN,LMAX: INTEGER;
	  P,SUBSTRSIZE: INTEGER;  LSP1: STP;

	 BEGIN
	  IF FCP <> NIL
	  THEN
	  %FCP = NIL INDICATES EITHER A STRINGCONSTANT OR A FUNCTIONRESULT OF\
	  %MULTIPLE TYPE FROM WHICH AN ELEMENT MUST BE SELECTED\
	  WITH FCP^, GATTR DO
	   BEGIN
	    TYPTR := IDTYPE; KIND := VARBL;
	     CASE KLASS OF
	      VARS:
		   IF VKIND = ACTUAL
		   THEN
		    BEGIN
		     ACCESS := DRCT; VLEVEL := VLEV;
		     DPLMT := VADDR
		    END
		   ELSE
		    BEGIN
		     P:= VADDR;
		     IF TYPTR <> NIL
		     THEN
		      IF TYPTR^.FORM = STRINGPARM
		      THEN
		       LOD(LEVEL - VLEV,P,4)
		      ELSE
			BEGIN
			 IF TYPTR^.FORM = BOUNDLESS
			 THEN
			 P := P + 2 * (TYPTR^.UNSPECLEVEL - 1);
			 %HYP.ADDR. OF BOUNDLESS ARRAYS ON LOCATION P\
			 IF TYPTR = CHARPTR
			 THEN TYPTR := INTPTR;
			 %ADDRESS MUST BE LOADED INSTEAD OF CHARACTERVALUE\
			 LOD(LEVEL - VLEV, P, 2);
			 TYPTR := IDTYPE;
			END;
		     ACCESS := INDRCT; IDPLMT := 0
		    END;
	      FIELD:
		    WITH DISPLAY[DISX] DO
		    IF OCCUR = CREC
		    THEN
		     BEGIN
		      ACCESS := DRCT; VLEVEL := CLEV;
		      DPLMT := CDSPL + FLDADDR
		     END
		    ELSE
		     BEGIN
		      TYPTR := INTPTR;   % <> CHARPTR FOR LOD AND LDO \
		      IF LEVEL = 1
		      THEN LDO(VDSPL,2)
		      ELSE LOD(0,VDSPL,2);
		      TYPTR := IDTYPE;
		      ACCESS := INDRCT; IDPLMT := FLDADDR
		     END;
	      FUNC:
		   IF PFDECKIND = STANDARD
		   THEN ERROR(150)
		   ELSE
		    IF PFLEV = 0
		    THEN ERROR(150)   %EXTERNAL FCT\
		    ELSE
		      IF PFKIND = FORMAL
		      THEN ERROR(151)
		      ELSE
			BEGIN
			 ACCESS := DRCT; VLEVEL := PFLEV + 1;
			 DPLMT := PARLISTSIZE; %ADDRESS OF FUNCTIONRESULT\
			 IF IDTYPE^.FORM=ARRAYS
			 THEN
			 DPLMT := DPLMT - IDTYPE^.ADDRCORR
			END
	     END %CASE\
	   END %WITH\;
	  IF  NOT (SY IN SELECTSYS OR  FSYS)
	  THEN
	   BEGIN
	    ERROR(59); SKIP(SELECTSYS OR  FSYS)
	   END;
	  WHILE SY IN SELECTSYS DO
	   BEGIN
	    %[\
	    IF SY = LBRACK
	    THEN
	     BEGIN
	       REPEAT
		WITH GATTR DO
		IF TYPTR <> NIL
		THEN
		 IF NOT (TYPTR^.FORM IN [ARRAYS,STRINGPARM,BOUNDLESS])
		 THEN
		   BEGIN
		    ERROR(138); GATTR.TYPTR := NIL
		   END;
		LATTR := GATTR;
		LOADADDRESS;
		INSYMBOL; EXPRESSION(FSYS OR  [COMMA,COLON,RBRACK]);
		LOAD;
		IF GATTR.TYPTR <> NIL
		THEN
		 IF GATTR.TYPTR^.FORM <> SCALAR
		 THEN ERROR(113);
		IF LATTR.TYPTR <> NIL
		THEN
		WITH LATTR.TYPTR^ DO
		 BEGIN
		  SUBSTRSIZE := -1;
		  WITH  GATTR DO
		   BEGIN
		    KIND := VARBL;ACCESS:= INDRCT; IDPLMT :=0
		   END;
		  IF SY = COLON  { .. }
		  THEN
		   BEGIN
		    IF FORM = BOUNDLESS
		    THEN ERROR(615)
		    ELSE
		     IF FORM = ARRAYS   { SUBSTRING OF A CHAR ARRAY }
		     THEN
		       BEGIN
			IF AELTYPE <> CHARPTR
			THEN ERROR(615);
			LSP1 := INXTYPE;
			IF LSP1 <> NIL
			THEN GETBOUNDS(INXTYPE,LMIN,LMAX);
		       END
		     ELSE		{ SUBSTRING OF A STRINGPARM }
		       BEGIN
			LSP1 := INTPTR;
			LMIN := 0;
		       END;
		    IF NOT COMPTYPES(LSP1,GATTR.TYPTR)
		    THEN ERROR(613);
		    LSP1 := GATTR.TYPTR;
		    INSYMBOL;   EXPRESSION(FSYS OR [RBRACK]);
		    LOAD;
		    IF NOT COMPTYPES(LSP1,GATTR.TYPTR)
		    THEN ERROR(614);
		    IF RUNTMCHECK
		    THEN
		     BEGIN
		      GEN2(MOV,AUTINC,PC,AUTDEC,SP);
		      GENCONST(LMIN);
		      IF FORM = ARRAYS
		      THEN
		       BEGIN
			GEN2(MOV,AUTINC,PC,AUTDEC,SP);
			GENCONST(LMAX);
		       END
		      ELSE
		       BEGIN
			GEN2(MOV,INDEX,SP,AUTDEC,SP);
			GENCONST(6);
		       END;
		      GENSUBRCALL(SUBSTRCHECK);
		     END;
 
		    GEN2(MOV,AUTINC,SP,REG,R);	{ COMPUTE SUBSTR LENGTH }
		    GEN2(SUB,REGDEF,SP,REG,R);
		    GEN1(INC,REG,R);
 
		    IF FORM = ARRAYS THEN	{ SUBSTR OF ARRAY }
			BEGIN
			GEN2(ADD,AUTINC,SP,REGDEF,SP);	{ ALTER ADDRESS }
			GEN2(MOV,REG,R,AUTDEC,SP)	{ LOAD LENGTH }
			END
		    ELSE			{ SUBSTR OF STRINGPARM }
			BEGIN
			GEN2(ADD,AUTINC,SP,INDEX,SP);	{ ALTER ADDRESS }
			GENCONST(2);
			GEN2(MOV,REG,R,REGDEF,SP)	{ ALTER LENGTH }
			END;
 
		    GATTR.KIND := EXPR;
		    IF LATTR.TYPTR^.FORM = STRINGPARM
		    THEN
		    GATTR.TYPTR := LATTR.TYPTR
		    ELSE   NEW(GATTR.TYPTR,STRINGPARM);
		   END
		  ELSE
		   IF FORM = BOUNDLESS
		   THEN
		     BEGIN
		      IF NOT COMPTYPES(INDEXTYPE,GATTR.TYPTR)
		      THEN ERROR(139);
		      IF UNSPECLEVEL > 1
		      THEN
		      %LOAD THE REQUIRED SIZE COMPONENT OF THE BOUNDLESS ARRAY-\
		      %PARAMETER FROM ITS PLACE IN THE PARAMETERLIST\
		       BEGIN
			IF FCP <> NIL
			THEN
			 BEGIN
			  IF (LEVEL - FCP^.VLEV) = 0
			  THEN P := MP
			  ELSE
			   BEGIN
			    P := AD;
			    GEN2(MOV,REGDEF,MP,REG,AD);
			    FOR P := 2 TO LEVEL - FCP^.VLEV DO
			    GEN2(MOV,REGDEF,AD,REG,AD);
			   END;
			  GEN2(MOV,INDEX,P,AUTDEC,SP);
			  GENCONST(FCP^.VADDR + 2 * (UNSPECLEVEL - 2))
			 END;
			MULTIPLY;
			GEN2(ADD,AUTINC,SP,REGDEF,SP);
		       END
		      ELSE
		       IF SUBSTRUCT <> NIL
		       THEN SUBSTRSIZE := SUBSTRUCT^.SIZE;
			%IF UNSPECLEVEL = 1 THEN SIZE = SIZE OF SUBSTRUCTURE\
		      GATTR.TYPTR := SUBSTRUCT
		     END
		   ELSE                   %FORM = ARRAYS\
		     IF FORM = ARRAYS
		     THEN
		       BEGIN
			IF INXTYPE <> NIL
			THEN GETBOUNDS(INXTYPE,LMIN,LMAX);
			IF RUNTMCHECK
			THEN
			 BEGIN
			  GENSUBRCALL(SUBRCHK);
			  GENCONST(LMIN);    GENCONST(LMAX);
			 END;
			IF PACKOPT
			THEN
			 BEGIN
			  GATTR.ACCESS := PACKD;
			  IF INXTYPE <> NIL
			  THEN
			   BEGIN
			    IF LMIN <> 0
			    THEN
			     BEGIN
			      GEN2(SUB, AUTINC,PC,REGDEF,SP);
			      GENCONST(LMIN)
			     END
			   END
			  ELSE   ERROR(606)
			 END
			ELSE
			 IF AELTYPE <> NIL
			 THEN SUBSTRSIZE := AELTYPE^.SIZE;
			IF NOT COMPTYPES(INXTYPE,GATTR.TYPTR)
			THEN ERROR(139);
			GATTR.TYPTR := AELTYPE
		       END
		     ELSE          %FORM = STRINGPARM\
		       BEGIN
			IF RUNTMCHECK
			THEN GENSUBRCALL(STRINGINDEX);
			SUBSTRSIZE := 1;
			IF NOT COMPTYPES(GATTR.TYPTR,INTPTR)
			THEN ERROR(139);
			GATTR.TYPTR := CHARPTR;
			GEN2(MOV,AUTINC,SP,REGDEF,SP);
		       END;
		  IF SUBSTRSIZE <> -1
		  THEN
		   BEGIN
		    IF GATTR.TYPTR <> NIL
		    THEN
		     BEGIN
		      IF (SUBSTRSIZE <> 6) AND (SUBSTRSIZE <= 8)
		      THEN
		       BEGIN
			IF NOT COMPTYPES ( GATTR.TYPTR , CHARPTR )
			THEN
			WHILE SUBSTRSIZE > 1 DO
			 BEGIN
			  SUBSTRSIZE := SUBSTRSIZE DIV 2;
			  GEN1(ASL,REGDEF,SP)
			 END;
		       END
		      ELSE
		       BEGIN
			GEN2(MOV,AUTINC,PC,AUTDEC,SP);
			GENCONST(SUBSTRSIZE);
			MULTIPLY;
		       END;
		      GEN2(ADD,AUTINC,SP,REGDEF,SP);
		     END
		   END
		 END
	       UNTIL SY <> COMMA;
	      IF SY = RBRACK
	      THEN INSYMBOL
	      ELSE ERROR(12)
	     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(140); TYPTR := NIL
		     END;
		  INSYMBOL;
		  IF SY = IDENT
		  THEN
		   BEGIN
		    IF TYPTR <> NIL
		    THEN
		     BEGIN
		      SRCHSECTION(TYPTR^.FSTFLD,LCP);
		      IF LCP = NIL
		      THEN
		       BEGIN
			ERROR(152); TYPTR := NIL
		       END
		      ELSE
		      WITH LCP^ DO
		       BEGIN
			TYPTR := IDTYPE;
			 CASE ACCESS OF
			  DRCT:   DPLMT := DPLMT + FLDADDR;
			  INDRCT: IDPLMT := IDPLMT + FLDADDR;
			  PACKD:  ERROR(400)
			 END
		       END
		     END;
		    INSYMBOL
		   END %SY = IDENT\
		  ELSE ERROR(2)
		 END %WITH GATTR\
	       END %IF SY = PERIOD\
	     ELSE
	      %^\
	       BEGIN
		IF GATTR.TYPTR <> NIL
		THEN
		WITH GATTR,TYPTR^ DO
		IF FORM IN [POINTER,FILES]
		THEN
		 BEGIN
		  LOAD;
		  IF FORM = POINTER
		  THEN TYPTR := ELTYPE
		  ELSE TYPTR := FILTYPE ;
		  IF TYPTR^.FORM = ARRAYS
		  THEN
		   IF TYPTR^.ADDRCORR <> 0
		   THEN
		     BEGIN
		      GEN2(SUB,AUTINC,PC,REGDEF,SP);
		      GENCONST(ELTYPE^.ADDRCORR)
		     END;
		  KIND := VARBL; ACCESS := INDRCT;
		  IDPLMT := 0
		 END
		ELSE ERROR(141);
		INSYMBOL
	       END;
	    IF  NOT (SY IN FSYS OR  SELECTSYS)
	    THEN
	     BEGIN
	      ERROR(6); SKIP(FSYS OR  SELECTSYS)
	     END
	   END;
	  % WHILE\
	  IF GATTR.TYPTR^.FORM = BOUNDLESS
	  THEN
	   IF GATTR.TYPTR^.UNSPECLEVEL > 1
	   THEN
	    LOD(LEVEL - FCP^.VLEV, FCP^.VADDR,
		2 * (GATTR.TYPTR^.UNSPECLEVEL - 1))
	 END %SELECTOR\ ;

	FUNCTION  LARGESET(FATTR: ATTR): BOOLEAN;
				%COMPARES SET SIZES AND		    \
				%CHECKS IF CONVERSIONS ARE NECESSARY\
	VAR			%AND CALLS THE CONVERSION ROUTINES\
	  L1,L2: INTEGER;
	  RTR: RUNTIMEROUTS;
	 BEGIN
	  IF NOT COMPTYPES(GATTR.TYPTR,FATTR.TYPTR)
	  THEN
	   BEGIN
	    ERROR(606); GATTR.TYPTR := NIL
	   END 
          ELSE
           BEGIN
	    L1 := FATTR.TYPTR^.SIZE;
	    L2 := GATTR.TYPTR^.SIZE;
	    IF L1 = L2
	    THEN
	     BEGIN
	      IF (FATTR.KIND = VARBL) AND (GATTR.KIND = VARBL) AND
	      (FATTR.TYPTR^.ELTYPE <> GATTR.TYPTR^.ELTYPE)
	      THEN
	       BEGIN
	        ERROR(605); GATTR.TYPTR := NIL
	       END
	     END
	    ELSE  % L1 <> L2 \
	     BEGIN
	      IF  L1 > L2
	      THEN
	       IF GATTR.KIND = VARBL
	       THEN
	         BEGIN
		  L1 := 2; RTR := REDSN
	         END
	       ELSE  RTR := EXPST
	      ELSE  % L1 < L2 \
	       IF FATTR.KIND = VARBL
	       THEN RTR := REDST
	       ELSE
	         BEGIN
		  L1 := 8; RTR := EXPSN
	         END;
	      GENSUBRCALL(RTR);
	     END;
	    GATTR.TYPTR^.SIZE := L1 ;
	    LARGESET :=   L1 = 8
	   END
	 END;
	%LARGESET\

        (*$Y+*)     (*  NEW MODULE  *)

	PROCEDURE CALL(FSYS: SETOFSYS; FCP: CTP);
	VAR
	  LKEY: 1..25;
	  FILECP: CTP;

	  PROCEDURE VARIABLE(FSYS: SETOFSYS);
	  VAR
	    LCP: CTP;
	   BEGIN
	    IF SY = IDENT
	    THEN
	     BEGIN
	      SEARCHID([VARS,FIELD],LCP); INSYMBOL
	     END
	    ELSE
	     BEGIN
	      ERROR(2); LCP := UVARPTR
	     END;
	    SELECTOR(FSYS,LCP)
	   END %VARIABLE\ ;

        (*$Y+*)     (*  NEW MODULE  *)
 
 
	  PROCEDURE GETFILEID;
	  VAR
	      LDISPL: INTEGER;
 
	   BEGIN
	   FILECP := NIL;
	   IF SY = IDENT THEN
	      BEGIN
	      PRTERR := FALSE; SEARCHID( [VARS], FILECP ); PRTERR := TRUE;
	      IF FILECP^.IDTYPE = NIL  THEN  FILECP := NIL
	      ELSE
	       IF FILECP^.IDTYPE^.FORM <> FILES
	       THEN FILECP := NIL;
	      END;
	   IF FILECP <> NIL  THEN
	      BEGIN
	      INSYMBOL;
              IF (LKEY IN [1,5,7,8,11,12,13]) AND (FILECP = TTYOUTPTR)
                 THEN FILECP := TTYINPTR;
	      END
	   ELSE   (* FILECP = NIL *)
	      IF ( LKEY IN [7,8,11,12,13]) AND ( INPUTPTR <> NIL )
	      THEN FILECP := INPUTPTR
	      ELSE
	       IF ( LKEY IN [2,9,10]) AND ( OUTPUTPTR <> NIL )
	       THEN FILECP := OUTPUTPTR
	       ELSE
		 IF ( LKEY IN [4,9,10]) AND ( TTYOUTPTR <> NIL )
		 THEN FILECP := TTYOUTPTR
		 ELSE
		   IF ( LKEY IN [7,8,11,12,13] ) AND (TTYINPTR <> NIL )
		   THEN FILECP := TTYINPTR
		   ELSE
		     ERROR(180) ;
	    CASE LKEY OF
		11: LDISPL := EOFSTATUS;
		12: LDISPL := EOLNSTATUS;
		13: LDISPL := IORESULT
	    END;
	    IF FILECP <> NIL THEN
	      BEGIN
	      SELECTOR ([SY],FILECP);
	      LOADADDRESS;
	      (* IF THIS FILE IS A FORMAL PARAMETER THEN THE ACTUAL
		 FILE, AS SUPPLIED BY THE CALLER, CAN BE TTY. SO, WE
		 HAVE TO DO A RUNTIME CONVERSION TO TTYIN FOR INPUT
		 TYPE FUNCTIONS.				    *)
	      IF (FILECP^.VKIND = FORMAL) AND (LKEY IN [1,5,7,8,11,12,13])
	      THEN	GENSUBRCALL (TTPAR);
	      (* GET ACTUAL VALUE OF EOF, EOLN AND IORESULT *)
	      IF LKEY >= 11 THEN
		 BEGIN GEN2( MOV,AUTINC,SP,REG,AD );
		       GEN2( MOV,INDEX,AD,AUTDEC,SP );
		       GENCONST( LDISPL )
		 END;
	      IF SY = COMMA  THEN  INSYMBOL
	      END
	   END  %  GETFILEID  \ ;
 
 
 
        (*$Y+*)     (*  NEW MODULE  *)
	  PROCEDURE GETPUTRESETREWRITE;
	  VAR
	    SUBRNAME: RUNTIMEROUTS;
	    I,J,SMIN,SMAX: INTEGER;
	   BEGIN
	    GETFILEID; 
	    IF LKEY > 4   % RESET, REWRITE \
	    THEN
	     BEGIN   %RESET, REWRITE \
	      IF FILECP^.IDTYPE <> NIL
	      THEN WITH FILECP^.IDTYPE^ DO
	      IF FORM = FILES
	      THEN
	       BEGIN
		GEN2(MOV,AUTINC,PC,AUTDEC,SP);
		IF FILTYPE = CHARPTR
		THEN GENCONST(-1)
		ELSE GENCONST(FILTYPE^.SIZE);
	       END;
	      FOR I := 1 TO 3 DO
	       BEGIN
		IF NOT ( SY IN [COMMA,RPARENT] )
		THEN
		 BEGIN
		  EXPRESSION(FSYS OR [COMMA,RPARENT]);
		  IF GATTR.TYPTR <> NIL
		  THEN
		  IF STRING(GATTR.TYPTR)
		  THEN
		   BEGIN
		    GETBOUNDS(GATTR.TYPTR^.INXTYPE,SMIN,SMAX);
                    IF GATTR.KIND = VARBL THEN
                     IF GATTR.ACCESS = DRCT
                     THEN GATTR.DPLMT := GATTR.DPLMT + SMIN
                     ELSE GATTR.IDPLMT := GATTR.IDPLMT + SMIN;
                    LOADADDRESS ;
		    GEN2(MOV,AUTINC,PC,AUTDEC,SP);
		    GENCONST(SMAX-SMIN+1)
		   END
		  ELSE
		    IF GATTR.TYPTR^.FORM <> STRINGPARM THEN ERROR(116);
		 END
		ELSE  (* ARGUMENT IS ABSENT *)
		 IF (I = 1) AND (FILECP <> NIL)
		 THEN
		  WITH FILECP^ DO
		   BEGIN
		    GENBR(BR,(ALFALENG+1)DIV 2);
		    J := 1 ;
		    WHILE J < ALFALENG DO
		     BEGIN
		      GENCONST(ORD(NAME[J])+256*
			       ORD(NAME[J+1]));   J := J+2 ;
		     END;
		    IF ODD(ALFALENG)
		    THEN GENCONST(ORD(NAME[J]));
		    GEN2(MOV,REG,PC,AUTDEC,SP);
		    GEN2(SUB,AUTINC,PC,REGDEF,SP);
		    GENCONST( 2 * ( ALFALENG DIV 2 ) + 2 );
		    GEN2(MOV,AUTINC,PC,AUTDEC,SP) ;
		    GENCONST(ALFALENG)
		   END
		 ELSE
		   BEGIN
		    GEN1(CLR,AUTDEC,SP);
		    GEN1(CLR,AUTDEC,SP)
		   END ;
                IF SY = COMMA THEN INSYMBOL;
	       END   %  FOR  \ ;
	      IF SY = RPARENT THEN GEN1(CLR,AUTDEC,SP)
	      ELSE
	       BEGIN
		EXPRESSION(FSYS OR [COMMA,RPARENT]);
		IF GATTR.TYPTR = NIL
		THEN ERROR(116)
		ELSE WITH GATTR.TYPTR^ DO
		IF (FORM = POWER) AND (SIZE = 2)
		THEN LOAD
		ELSE ERROR(116);
	       END;
	     END   % LKEY > 4  \
	    ELSE   (* GET, PUT *)
	     IF SY <> RPARENT
	     THEN
	       BEGIN
		EXPRESSION(FSYS OR [RPARENT]);
		IF COMPTYPES(INTPTR,GATTR.TYPTR)
		THEN LOAD
		ELSE ERROR(116);
		LKEY := LKEY + 1;
	       END;
	     CASE LKEY OF
	      1: SUBRNAME := GETCH;
	      2: SUBRNAME := GETR;
	      3: SUBRNAME := PUTCH;
	      4: SUBRNAME := PUTR;
	      5: SUBRNAME := RESETF;
	      6: SUBRNAME := REWRITEF
	     END;
	    GENSUBRCALL(SUBRNAME)
	   END %GETPUTRESETREWRITE\ ;

	  PROCEDURE READREADLN (*$Y+*) ;
	   VAR SMIN,SMAX: INTEGER;
	   BEGIN
	    GETFILEID;
	    IF ((LKEY = 7) OR ((LKEY = 8) AND (SY <>RPARENT) AND
	      (SY IN (FACBEGSYS - [LBRACK]) OR [ADDOP]))) AND (FILECP <> NIL)
	    THEN
	     LOOP
	      VARIABLE(FSYS OR  [COMMA,RPARENT]);
	      IF GATTR.TYPTR <> NIL
	      THEN
	       IF GATTR.TYPTR^.FORM = STRINGPARM
	       THEN
		 GENSUBRCALL(RDSTR)
	       ELSE  (* VARIABLE IS NOT STRINGPARM *)
	       BEGIN
	       LOADADDRESS;
	       IF COMPTYPES( FILECP^.IDTYPE^.FILTYPE, GATTR.TYPTR) AND
		  NOT COMPTYPES( GATTR.TYPTR,CHARPTR) THEN
		    BEGIN
		    IF GATTR.TYPTR^.FORM = ARRAYS  THEN
			ADDTOP (GATTR.TYPTR^.ADDRCORR);
		    GENSUBRCALL ( RDREC )
		    END
	       ELSE
		IF STRING ( GATTR.TYPTR )   THEN
		  BEGIN
		  ADDTOP (GATTR.TYPTR^.ADDRCORR);
		  GETBOUNDS (GATTR.TYPTR^.INXTYPE,SMIN,SMAX);
		  GEN2 (MOV,AUTINC,PC,AUTDEC,SP);
		  GENCONST (SMAX-SMIN+1);
		  GENSUBRCALL(RDSTR)
		  END
		ELSE
	       IF GATTR.TYPTR^.FORM  <=   SUBRANGE
	       THEN
		 IF COMPTYPES(INTPTR,GATTR.TYPTR)
		 THEN
		  GENSUBRCALL(RDI)
		 ELSE
		   IF COMPTYPES(REALPTR,GATTR.TYPTR)
		   THEN
		    GENSUBRCALL(RDR)
		   ELSE
		     IF COMPTYPES(CHARPTR,GATTR.TYPTR)
		     THEN
		      GENSUBRCALL(RDC)
		     ELSE ERROR(399)
	       ELSE ERROR(116)
	       END;  (* NOT STRINGPARM *)
	     EXIT IF SY <> COMMA;
	      INSYMBOL
	     END;
	   IF FILECP <> NIL THEN
	    IF (LKEY = 8) AND COMPTYPES(FILECP^.IDTYPE^.FILTYPE,CHARPTR)
	    THEN GENSUBRCALL(GETLINE)
	    ELSE GEN1(TST,AUTINC,SP) % REMOVE FILE ID \ ;
	   END %READ\ ;
 
 
 
 
	  PROCEDURE WRITEWRITELN (*$Y+*) ;
	  VAR
	    LSP: STP; DEFAULT, STACKD: BOOLEAN;
	    SMIN,SMAX: INTEGER;
	   BEGIN
	    GETFILEID;
	    IF ((LKEY = 9) OR ((LKEY = 10) AND ((SY <> RPARENT) AND
	       (SY IN (FACBEGSYS - [LBRACK]) OR [ADDOP])))) AND (FILECP <> NIL)
	    THEN
	     LOOP
	      EXPRESSION(FSYS OR  [COMMA,COLON,RPARENT]);
	      LSP := GATTR.TYPTR;
	      STACKD := FALSE;
	      IF LSP <> NIL
	      THEN
	       IF  LSP^.FORM <= POWER
	       THEN  LOAD
	       ELSE
		 IF LSP^.FORM <> STRINGPARM
		 THEN
		   IF  GATTR.KIND = EXPR
		   THEN
		    %MULTIPLE FUNCTIONRESULT ON STACK IS ACTUAL PARAMETER\
		     BEGIN
		      GEN2(MOV,REG,SP,AUTDEC,SP);  STACKD := TRUE
		     END
		   ELSE
		      BEGIN
		      LOADADDRESS;
		      IF  LSP^.FORM = ARRAYS  THEN  ADDTOP (LSP^.ADDRCORR)
		      END;
	    IF NOT COMPTYPES(CHARPTR,GATTR.TYPTR) AND
		   COMPTYPES(FILECP^.IDTYPE^.FILTYPE,GATTR.TYPTR)
	    THEN   GENSUBRCALL ( WRREC )
	    ELSE
	     BEGIN
	      IF SY = COLON
	      THEN
	       BEGIN
		INSYMBOL; EXPRESSION(FSYS OR  [COMMA,COLON,RPARENT]);
		IF GATTR.TYPTR <> NIL
		THEN
		 IF GATTR.TYPTR <> INTPTR
		 THEN ERROR(116);
		LOAD; DEFAULT := FALSE
	       END
	      ELSE DEFAULT := TRUE;
	      IF SY = COLON
	      THEN
	       BEGIN
		INSYMBOL;
		IF (SY = IDENT) AND (ID = 'O         ')
		THEN
		 BEGIN
		  INSYMBOL;
		  IF LSP <> INTPTR
		  THEN ERROR(206)
		  ELSE  GENSUBRCALL(WRIOCT)
		 END
		ELSE
		 BEGIN
		  EXPRESSION(FSYS OR  [COMMA,RPARENT]);
		  IF GATTR.TYPTR <> NIL
		  THEN
		   IF GATTR.TYPTR <> INTPTR
		   THEN ERROR(116);
		  IF LSP <> REALPTR
		  THEN ERROR(124);
		  LOAD; GENSUBRCALL(WRFIX);
		 END
	       END
	      ELSE
	       IF LSP = INTPTR
	       THEN
		 BEGIN
		  IF DEFAULT
		  THEN
		   BEGIN
		    GEN2(MOV,AUTINC,PC,AUTDEC,SP) ;
		    GENCONST( 8 )
		   END ;
		  GENSUBRCALL(WRI)
		 END
	       ELSE
		 IF LSP = REALPTR
		 THEN
		   BEGIN
		    IF DEFAULT
		    THEN
		     BEGIN
		      GEN2(MOV,AUTINC,PC,AUTDEC,SP);
		      GENCONST(15)
		     END;
		    GENSUBRCALL(WRR)
		   END
		 ELSE
		   IF LSP = CHARPTR
		   THEN
		     BEGIN
		      IF DEFAULT
		      THEN GENSUBRCALL(WRC)
		      ELSE GENSUBRCALL(WRCHA);
		     END
		   ELSE
                    IF LSP = BOOLPTR THEN
                     BEGIN IF DEFAULT THEN GENSUBRCALL(WRB)
                           ELSE GENSUBRCALL(WRBFX);
                     END
                    ELSE
		     IF LSP <> NIL
		     THEN
		       BEGIN
			IF LSP^.FORM = SCALAR
			THEN ERROR(399)
			ELSE
			 IF STRING(LSP)
			 THEN
			   BEGIN
			    GEN2(MOV,AUTINC,PC,AUTDEC,SP);
			    GETBOUNDS(LSP^.INXTYPE,SMIN,SMAX);
			    GENCONST(SMAX - SMIN + 1);
			    IF  DEFAULT
			    THEN
			    GEN2(MOV,REGDEF,SP,AUTDEC,SP);
			    GENSUBRCALL(WRS);
			    IF  STACKD
			    THEN
			     BEGIN
			      GEN2(ADD,AUTINC,PC,REG,SP);
			      GENCONST(LSP^.SIZE)
			      %REMOVE FUNCTIONRESULT FROM STACK\
			     END
			   END
			 ELSE
			   IF LSP^.FORM = STRINGPARM
			   THEN
			     BEGIN
			      IF DEFAULT
			      THEN  GEN2(MOV,REGDEF,SP,AUTDEC,SP)
			      ELSE
			       BEGIN
				GEN2(MOV,AUTINC,SP,REG,R);
				GEN2(MOV,REGDEF,SP,AUTDEC,SP);
				GEN2(MOV,REG,R,INDEX,SP);
				GENCONST(2);
			       END;
			      GENSUBRCALL(WRS)
			     END
			   ELSE
			    ERROR(116);
		       END;
	     END;
	     EXIT IF SY <> COMMA;
	      INSYMBOL
	     END;
	    IF FILECP <> NIL THEN
	    IF (LKEY = 10) AND COMPTYPES(FILECP^.IDTYPE^.FILTYPE,CHARPTR)
	    THEN GENSUBRCALL(PUTLINE)
	    ELSE GEN1(TST,AUTINC,SP) % REMOVE FILE ID \ ;
	   END %WRITE\ ;

	  PROCEDURE PACK (*$Y+*) ;
	  VAR
	    LSP,LSP1: STP;
	   BEGIN
	    ERROR(399);
	    (*$Z+*)
	    VARIABLE(FSYS OR  [COMMA,RPARENT]);
	    LSP := NIL; LSP1 := NIL;
	    IF GATTR.TYPTR <> NIL
	    THEN
	    WITH GATTR.TYPTR^ DO
	    IF FORM = ARRAYS
	    THEN
	     BEGIN
	      LSP := INXTYPE; LSP1 := AELTYPE
	     END
	    ELSE ERROR(116);
	    IF SY = COMMA
	    THEN INSYMBOL
	    ELSE ERROR(20);
	    EXPRESSION(FSYS OR  [COMMA,RPARENT]);
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM <> SCALAR
	     THEN ERROR(116)
	     ELSE
	       IF  NOT COMPTYPES(LSP,GATTR.TYPTR)
	       THEN ERROR(116);
	    IF SY = COMMA
	    THEN INSYMBOL
	    ELSE ERROR(20);
	    VARIABLE(FSYS OR  [RPARENT]);
	    IF GATTR.TYPTR <> NIL
	    THEN
	    WITH GATTR.TYPTR^ DO
	    IF FORM = ARRAYS
	    THEN
	     BEGIN
	      IF NOT COMPTYPES(AELTYPE,LSP1) OR NOT COMPTYPES(INXTYPE,LSP)
	      THEN ERROR(116)
	     END
	    ELSE ERROR(116)
	    (*$Z-*)
	   END %PACK\ ;

	  PROCEDURE UNPACK (*$Y+*) ;
	  VAR
	    LSP,LSP1: STP;
	   BEGIN
	    ERROR(399);
	    (*$Z+*)
	    VARIABLE(FSYS OR  [COMMA,RPARENT]);
	    LSP := NIL; LSP1 := NIL;
	    IF GATTR.TYPTR <> NIL
	    THEN
	    WITH GATTR.TYPTR^ DO
	    IF FORM = ARRAYS
	    THEN
	     BEGIN
	      LSP := INXTYPE; LSP1 := AELTYPE
	     END
	    ELSE ERROR(116);
	    IF SY = COMMA
	    THEN INSYMBOL
	    ELSE ERROR(20);
	    VARIABLE(FSYS OR  [COMMA,RPARENT]);
	    IF GATTR.TYPTR <> NIL
	    THEN
	    WITH GATTR.TYPTR^ DO
	    IF FORM = ARRAYS
	    THEN
	     BEGIN
	      IF  NOT COMPTYPES(AELTYPE,LSP1) OR
	      NOT COMPTYPES(INXTYPE,LSP)
	      THEN
	      ERROR(116)
	     END
	    ELSE ERROR(116);
	    IF SY = COMMA
	    THEN INSYMBOL
	    ELSE ERROR(20);
	    EXPRESSION(FSYS OR  [RPARENT]);
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM <> SCALAR
	     THEN ERROR(116)
	     ELSE
	       IF  NOT COMPTYPES(LSP,GATTR.TYPTR)
	       THEN ERROR(116);
		(*$Z-*)
	   END %UNPACK\ ;

	  PROCEDURE NEW1 (*$Y+*) ;
	   LABEL   1;
	  VAR
	    LSP,LSP1: STP;       LMIN,LMAX,I: INTEGER;
	    LSIZE,LSZ: ADDRRANGE; LVAL: VALU;   B: BOOLEAN;
	   BEGIN
	    VARIABLE(FSYS OR  [COMMA,RPARENT,COLON]); LOADADDRESS;
	    LSP := NIL;LSIZE := 0;
	    IF GATTR.TYPTR <> NIL
	    THEN
	    WITH GATTR.TYPTR^ DO
	    IF FORM = POINTER
	    THEN
	     BEGIN
	      IF ELTYPE <> NIL
	      THEN
	       BEGIN
		LSIZE := ELTYPE^.SIZE;
		IF ELTYPE^.FORM = RECORDS
		THEN
		 BEGIN
		  LSP := ELTYPE^.RECVAR; B := ELTYPE^.PACKSTRUCT
		 END
		ELSE
		 IF ELTYPE^.FORM = ARRAYS
		 THEN
		   BEGIN
		    LSP := ELTYPE; B := LSP^.PACKOPT
		   END;
		IF B
		THEN
		 BEGIN
		  GENSUBRCALL(CLRAREA);
		  GENCONST(ELTYPE^.SIZE DIV 2)
		 END
	       END
	     END
	    ELSE ERROR(116);
	    GEN2(MOV,INDEX,GP,REG,AD);
	    GENCONST(DAPADDR);
	    WHILE SY = COMMA DO
	     BEGIN
	      INSYMBOL; CONSTANT(FSYS OR [COMMA,COLON,RPARENT],LSP1,LVAL);
	      %CHECK TO INSERT HERE: IS CONSTANT IN TAGFIELDTYPE RANGE\
	      IF LSP = NIL
	      THEN ERROR(158)
	      ELSE
	       IF STRING(LSP1) OR  (LSP1 = REALPTR)
	       THEN ERROR(159)
	       ELSE
		 BEGIN
		  IF LSP^.FORM = TAGFWITHID
		  THEN
		   BEGIN
		    IF LSP^.TAGFIELDP <> NIL
		    THEN
		     IF COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP1)
		     THEN
		       BEGIN
			GEN2(MOV,AUTINC,PC,INDEX,AD);
			GENCONST(LVAL.IVAL);
			GENCONST(LSP^.TAGFIELDP^.FLDADDR);
		       END
		     ELSE
		       BEGIN
			ERROR(116);   GOTO 1
		       END
		   END
		  ELSE
		   IF LSP^.FORM = TAGFWITHOUTID
		   THEN
		     BEGIN
		      IF NOT COMPTYPES(LSP^.TAGFIELDTYPE,LSP1)
		      THEN
		       BEGIN
			ERROR(116);   GOTO 1
		       END
		     END
		   ELSE
		     BEGIN
		      ERROR(170);   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\ ;
 
 
	    { ASSIGN CURRENT HEAP BASE ADDRESS TO POINTER VARIABLE }
 
	    GEN2(MOV,REG,AD,AUTINCDEF,SP);
 
 
	    IF SY = COLON
	    THEN
	     BEGIN
	      INSYMBOL; EXPRESSION(FSYS OR  [RPARENT]);
	      IF LSP = NIL
	      THEN ERROR(163)
	      ELSE
	       IF LSP^.FORM <> ARRAYS
	       THEN ERROR(164)
	       ELSE
		 BEGIN
		  IF  NOT COMPTYPES(GATTR.TYPTR,LSP^.INXTYPE)
		  THEN
		  ERROR(116);
		  LSZ := 2;  LMIN := 1;
		  IF  LSP^.INXTYPE <> NIL
		  THEN
		  GETBOUNDS(LSP^.INXTYPE,LMIN,LMAX);
		  IF LSP^.AELTYPE <> NIL
		  THEN
		   IF  LSP^.AELTYPE = CHARPTR
		   THEN LSZ := 1
		   ELSE
		    LSZ := LSP^.AELTYPE^.SIZE;
		  LOAD;
		  IF LSP^.PACKOPT
		  THEN
		   BEGIN
		    GEN2(SUB,AUTINC,PC,REGDEF,SP);
		    GENCONST(LMIN - 1);   LSZ := 1;
                    FOR I := 1 TO 3 DO GEN1(ASR,REGDEF,SP)  % ... DIV 8 \ ;
		    GEN1(INC,REGDEF,SP);   LMIN := 1
		    %ALWAYS ADDS ONE BYTE\
		   END;
		  GEN2(MOV,AUTINC,SP,REG,R);
		  IF LSZ <> 1
		  THEN
		   IF  LSZ = 2
		   THEN  GEN1(ASL,REG,R)
		   ELSE
		     IF EXTSET
		     THEN
		       BEGIN
			GEN2(MULT,REG,R,AUTINC,PC);
			GENCONST(LSZ)
		       END
		     ELSE
		       BEGIN
			GEN2(MOV,AUTINC,PC,AUTDEC,SP);
			GENCONST(LSZ);
			GENSUBRCALL(MPI);
			GEN2(MOV,AUTINC,SP,REG,R)
		       END;
		  LSZ := LSIZE - LSP^.SIZE - LSZ * (LMIN - 1);
		  IF LSZ > 0
		  THEN
		   BEGIN
		    GEN2(ADD,AUTINC,PC,REG,R);
		    GENCONST(LSZ);
		   END;
		  IF (LSP^.AELTYPE = CHARPTR) OR LSP^.PACKOPT
		  THEN
		   BEGIN
		    GEN2(MOV,REG,R,REG,AR);
		    GEN2(BIC,AUTINC,PC,REG,AR);
		    GENCONST(-2);   GENBR(BEQ,1);
		    GEN1(INC,REG,R);
		    %TEST FOR ODD STRINGLENGTH; IN THIS CASE AN EXTRA\
		    %BYTE MUST BE ADDED TO MAINTAIN WORD BOUNDARY\
		   END;
		  GEN2(ADD,REG,R,INDEX,GP);
		  GENCONST(DAPADDR)
		 END
	     END
	    ELSE
	     BEGIN
	      GEN2(ADD,AUTINC,PC,INDEX,GP);	{ EXPAND HEAP }
	      GENCONST(LSIZE);  GENCONST(DAPADDR)
	     END;
	    IF HEAPCHECK
	    THEN   GENSUBRCALL(OVFLCHK);
	   END %NEW\ ;

	  PROCEDURE ABS (*$Y+*) ;
	   BEGIN
	    IF  GATTR.TYPTR = INTPTR
	    THEN
	     BEGIN
	      GEN1(TST,REGDEF,SP);
	      GENBR(BPL,1);
	      GEN1(NEG,REGDEF,SP)
	     END
	    ELSE
	     IF GATTR.TYPTR = REALPTR
	     THEN
	       BEGIN
		GEN2(BIC,AUTINC,PC,REGDEF,SP);
		GENCONST(100000B)
	       END
	     ELSE
	       BEGIN
		ERROR(125); GATTR.TYPTR := INTPTR
	       END
	   END %ABS\ ;

	  PROCEDURE SQR (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR = INTPTR
	    THEN
	     BEGIN
	      IF EXTSET
	      THEN
	       BEGIN
		GEN2(MOV,REGDEF,SP,REG,R);
		GEN2(MULT,REG,R,AUTINC,SP);
		GEN2(MOV,REG,R,AUTDEC,SP)
	       END
	      ELSE  GENSUBRCALL(SQI)
	     END
	    ELSE
	     IF  GATTR.TYPTR = REALPTR
	     THEN GENSUBRCALL(SQRR)
	     ELSE
	       BEGIN
		ERROR(125); GATTR.TYPTR := INTPTR
	       END
	   END %SQR\ ;

	  PROCEDURE TRUNC (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR <> REALPTR
	     THEN ERROR(125);
	    GENSUBRCALL(TRC);
	    GATTR.TYPTR := INTPTR
	   END %TRUNC\ ;

	  PROCEDURE ARITHMETICFUNCTIONS (*$Y+*) ;
	  VAR
	    RTR: RUNTIMEROUTS;
	   BEGIN
	    IF GATTR.TYPTR = INTPTR
	    THEN
	     BEGIN
	      GENSUBRCALL(FLT);   GATTR.TYPTR := REALPTR
	     END;
	    IF GATTR.TYPTR <> REALPTR
	    THEN  ERROR(125)
	    ELSE
	     BEGIN
	       CASE LKEY OF
		16:  RTR := RSIN;
		17:  RTR := RCOS;
		18:  RTR := RARCTAN;
		19:  RTR := REXP;
		20:  RTR := RLOG;
		21:  RTR := RSQRT
	       END;
	      GENSUBRCALL(RTR);
	     END;
	   END;
	  %ARITHMETICFUNCTIONS\

	  PROCEDURE ROUND (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR <> REALPTR
	     THEN ERROR(125);
	    GENSUBRCALL(RND);
	    GATTR.TYPTR := INTPTR
	   END;
	  %ROUND\

	  PROCEDURE ODD (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR <> INTPTR
	    THEN ERROR(125);
	    GEN2(BIC,AUTINC,PC,REGDEF,SP);
	    GENCONST(-2);
	    GATTR.TYPTR := BOOLPTR
	   END %ODD\ ;

	  PROCEDURE ORD (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF (GATTR.TYPTR^.FORM > POWER) OR (GATTR.TYPTR^.SIZE <> 2)
	     THEN ERROR(125);
	    GATTR.TYPTR := INTPTR
	   END %ORD\ ;

	  PROCEDURE CHR (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR <> INTPTR
	    THEN ERROR(125);
	    GATTR.TYPTR := CHARPTR
	   END %CHR\ ;

	  PROCEDURE PREDSUCC (*$Y+*) ;
	   BEGIN
	    IF  LKEY = 7
	    THEN  GEN1(DEC,REGDEF,SP)
	    ELSE  GEN1(INC,REGDEF,SP);     %NO BOUNDCHECKING IS DONE\
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM <> SCALAR
	     THEN ERROR(125);
	   END %PREDSUCC\ ;

	  PROCEDURE EOFEOLNIORES (*$Y+*) ;
	  VAR
	    LDISPL: INTEGER;
	   BEGIN
	     LKEY := LKEY + 2;   GETFILEID;
	    IF LKEY = 13   (* 11+2  *)
	    THEN GATTR.TYPTR := INTPTR
	    ELSE GATTR.TYPTR := BOOLPTR ;
	   END %EOF\ ;

	  PROCEDURE BREAKLN (*$Y+*) ;
	   BEGIN
	    GETFILEID;  GENSUBRCALL( BRK )
	   END;

	  PROCEDURE FORMFEED (*$Y+*) ;
	   BEGIN
	    GETFILEID;   GENSUBRCALL( FORMFD )
	   END;

	  PROCEDURE DATETIME (*$Y+*) ;
	   BEGIN
	    VARIABLE( FSYS OR [RPARENT]);  LOADADDRESS;
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF LKEY = 18
	     THEN GENSUBRCALL( TIME1 )
	     ELSE GENSUBRCALL( DATE1 );
	   END;


	  PROCEDURE HALT (*$Y+*) ;
	   BEGIN
            GENSUBRCALL( DUMP )
	   END  ;

	  PROCEDURE RUNTIME1 (*$Y+*) ;
	   BEGIN
	    GENSUBRCALL( RUNTM );
	    GATTR.TYPTR := INTPTR
	   END;

	  PROCEDURE MARKRELEASE (*$Y+*) ;
	   BEGIN
	    ERROR(903);   SKIP(FSYS OR [RPARENT]);
	    IF LKEY = 12
	    THEN GENSUBRCALL(MARKP)
	    ELSE GENSUBRCALL(RELEASEP)
	   END;

	  PROCEDURE   SPLITREAL (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR <> REALPTR
	    THEN ERROR(125);
	    IF SY =COMMA
	    THEN INSYMBOL
	    ELSE ERROR(20);
	    VARIABLE(FSYS OR [RPARENT]);
	    LOADADDRESS;
	    IF GATTR.TYPTR <> INTPTR
	    THEN ERROR(125);
	    GENSUBRCALL(SPLTRL);
	    GATTR.TYPTR := REALPTR;
	   END;
	  %SPLITREAL\

	  PROCEDURE SSIZE (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM <> STRINGPARM
	     THEN ERROR(626)
	     ELSE    GEN2(MOV,AUTINC,SP,REGDEF,SP);
	    GATTR.TYPTR := INTPTR;
	   END;

	  PROCEDURE   TWOPOW (*$Y+*) ;
	   BEGIN
	    IF GATTR.TYPTR <> INTPTR
	    THEN ERROR(125);
	    GENSUBRCALL(TWPOW);
	    GATTR.TYPTR := REALPTR;
	   END;
	  %TWOPOW\



	  PROCEDURE CALLNS1  (*$Y+*) ;
	   BEGIN
	    IF  SY IN  [LBRACK,PERIOD]
	    THEN   %ELEMENTSELECTION FROM MULTIPLE\
	     BEGIN                           %FUNCTIONRESULT\
	      IF GATTR.TYPTR <> NIL
	      THEN
	      WITH GATTR.TYPTR^ DO
	       BEGIN
		I := SIZE;
		GEN2(MOV,REG,SP,AUTDEC,SP); %MULTIPLE ADDRESS ON STACK\
		IF FORM = ARRAYS
		THEN
		 IF ADDRCORR <> 0
		 THEN
		   BEGIN
		    GEN2(SUB,AUTINC,PC,REGDEF,SP);
		    GENCONST(ADDRCORR)
		   END
	       END;
	      WITH GATTR DO
	       BEGIN
		KIND := VARBL ;  ACCESS := INDRCT;  IDPLMT := 0
	       END;
	      SELECTOR(FSYS, NIL);    %  \
	      %POSSIBILITIES AFTER SELECTOR: KIND = VARBL, ACCESS = INDRCT,OR
	       ACCESS = PACKD. AN ADDRESS (POSSIBLY  2-TUPLE)HAS BEEN PRODUCED
	       ON TOP OF  THE STACK; THE CONTENTS OF THIS ADDRESS (POSSIBLY A
	       MULTIPLE VALUE) MUST BE  LOADED ONTO THE STACK AFTER THE
	       FUNCTIONRESULT HAS BEEN REMOVED\
	      IF GATTR.TYPTR <> NIL
	      THEN
	      WITH  GATTR  DO
	      IF KIND = EXPR
	      THEN ERROR(609)
	      ELSE
	       IF  ACCESS = INDRCT
	       THEN       %FIELD OF RECORD OR ARRAY-EL\
		 BEGIN
		  GEN2(MOV,AUTINC,SP,REG,AR);
		  GEN2(MOV,REG,SP,REG,AD);
		  GEN2(ADD,AUTINC,PC,REG,AD);
		  GENCONST(I);
		  IF  TYPTR^.SIZE = 2
		  THEN
		   IF  TYPTR = CHARPTR
		   THEN
		     BEGIN
		      IF IDPLMT = 0
		      THEN  GEN2(MOVB,REGDEF,AR,REG,AR)
		      ELSE
		       BEGIN
			GEN2(MOVB,INDEX,AR,REG,AR);
			GENCONST(IDPLMT)
		       END;
		      GEN1(CLR,AUTDEC,AD);
		      GEN2(MOVB,REG,AR,REGDEF,AD);
		     END
		   ELSE
		     IF  IDPLMT = 0
		     THEN  GEN2(MOV,REGDEF,AR,AUTDEC,AD)
		     ELSE                      %MAY BE DONE MORE EFFICIENT\
		       BEGIN
			GEN2(MOV,INDEX,AR,AUTDEC,AD);
			GENCONST(IDPLMT)
		       END
		  ELSE
		   BEGIN
		    GEN2(ADD,AUTINC,PC,REG,AR);
		    GENCONST(IDPLMT + TYPTR^.SIZE);
		    GENSUBRCALL(MOVMR);
		    GENCONST(TYPTR^.SIZE DIV 2)
		   END;
		  GEN2(MOV,REG,AD,REG,SP);
		 END
	       ELSE
		 BEGIN           %ACCESSS = PACKD\
		  IF TYPTR = BOOLPTR
		  THEN
		   BEGIN
		    GENSUBRCALL(LPB);
		    GEN2(MOV,REGDEF,SP,INDEX,SP);
		    GENCONST(I);
		    GEN2(ADD,AUTINC,PC,REG,SP);
		    GENCONST(I)
		   END
		  ELSE ERROR(400);
		 END;
	      GATTR.KIND := EXPR
	     END;
	   END % CALLNS1 \ ;


	  PROCEDURE CALLNONSTANDARD (*$Y+*) ;
	  VAR
	    NXT,LCP: CTP;  LSP,LSP2: STP;   LKIND: IDKIND;
	    LSP1: STP;  LCP1,LCP2: CTP;
	    LMIN,LMAX,I,P: INTEGER; LATTR: ATTR; B: BOOLEAN;
            RELNAME: ALFA;

 
	    PROCEDURE BASE(PLEVEL: LEVRANGE);
	    VAR
	      I,MODE,REGISTER: INTEGER;
	     BEGIN
	      REGISTER := MP;
	      IF PLEVEL = 0
	      THEN  MODE := REG
	      ELSE  MODE := REGDEF;
	      IF PLEVEL > 1
	      THEN
	       BEGIN
		GEN2(MOV,REGDEF,MP,REG,AD);
		FOR  I := 3  TO PLEVEL DO  GEN2(MOV,REGDEF,AD,REG,AD);
		REGISTER := AD
	       END;
	      GEN2(MOV,MODE,REGISTER,AUTDEC,SP)
	     END;
 
	    (*$Y-  DONT SPLIT THESE MODULES *)

	    FUNCTION COMPSPECIFICATION (LCP1, LCP2: CTP): BOOLEAN;
	    VAR
	      ERR: BOOLEAN;
	     BEGIN
	      ERR := FALSE;
	      WHILE (LCP1 <> NIL) AND (LCP2 <> NIL) AND NOT ERR DO
	       BEGIN
		IF COMPTYPES(LCP1^.IDTYPE, LCP2^.IDTYPE) AND
		(LCP1^.KLASS = LCP2^.KLASS)
		THEN
		 BEGIN
		  IF LCP1^.KLASS = VARS
		  THEN
		   BEGIN
		    IF LCP1^.VKIND <> LCP2^.VKIND
		    THEN ERR := TRUE
		   END
		  ELSE
		  ERR := NOT COMPSPECIFICATION(LCP1^.PARMLIST,LCP2^.PARMLIST);
		 END
		ELSE     ERR := TRUE;
		LCP1 := LCP1^.NEXT;
		LCP2 := LCP2^.NEXT;
	       END;
	      IF LCP1 <> LCP2
	      THEN ERR := TRUE;
	      COMPSPECIFICATION := NOT ERR;
	     END;
	    %COMPSPECIFICATION\

	   BEGIN  % CALLNONSTANDARD \
	    WITH FCP^ DO
	     BEGIN
	      LKIND := PFKIND;
	      IF LKIND = ACTUAL
	      THEN  NXT := NEXT
	      ELSE  NXT := PARMLIST;               %NXT POINTS TO PARAM.LIST\
	      IF  KLASS = FUNC
	      THEN               %RESERVE PLACE FOR RESULT\
	       BEGIN
		IF IDTYPE^.SIZE = 2
		THEN  GEN1(CLR,AUTDEC,SP)
		ELSE
		 IF  IDTYPE^.SIZE = 4
		 THEN
		  GEN2(CMP,AUTDEC,SP,AUTDEC,SP)
		 ELSE
		   BEGIN
		    GEN2(SUB,AUTINC,PC,REG,SP);
		    GENCONST(IDTYPE^.SIZE)
		   END
	       END
	     END;
	    IF SY = LPARENT
	    THEN
	     BEGIN
	       REPEAT
		INSYMBOL;
		IF NXT = NIL
		THEN
		 BEGIN
		  ERROR(126); SKIP(FSYS OR [RPARENT])
		 END
		ELSE
		 BEGIN
		  IF NXT^.KLASS IN  [PROC,FUNC]
		  THEN    %PROCEDURE PARAM'S\
		   BEGIN
		    IF  SY <> IDENT
		    THEN
		     BEGIN
		      ERROR(2); SKIP(FSYS OR [COMMA,RPARENT])
		     END
		    ELSE
		    %PROCEDURE PARAM\
		     IF NXT^.KLASS = PROC
		     THEN  SEARCHID([PROC],LCP)
		     ELSE
		      %FUNCTION PARAM\
		       BEGIN
			SEARCHID([FUNC],LCP);
			IF  NOT COMPTYPES(LCP^.IDTYPE, NXT^.IDTYPE)
			THEN  ERROR(128)
		       END;
		    INSYMBOL;
		    IF  NOT (SY IN FSYS OR [COMMA,RPARENT])
		    THEN
		     BEGIN
		      ERROR(6);  SKIP(FSYS OR [COMMA,RPARENT])
		     END;
		    IF LCP <> NIL
		    THEN
		    WITH  LCP^  DO
		     BEGIN
		      P := LEVEL - PFLEV;
		      IF PFDECKIND = STANDARD
		      THEN ERROR(603);
		      LCP1 := NXT^.PARMLIST;
		      IF  PFKIND = ACTUAL
		      THEN   %ACTUAL PARAM IS AN\
		       BEGIN
			BASE(P);          %ACTUAL P/F\
			LCP2 := LCP^.NEXT;
			GEN2(MOV,REG,PC,AUTDEC,SP);
			GEN2(ADD,AUTINC,PC,REGDEF,SP);
                        IF DECLPLACE > EXTRNL THEN ERROR(609);
			  GENCONST( 0 %ADDRCHAIN\ );
                        IF EXTNAME = NIL THEN RELNAME := NAME
                        ELSE RELNAME := EXTNAME^ ;
			  PUTRLD( RELNAME, RELOCFCN, 2*CODE.LEN-2, 4);
			  PUTGSD(RELNAME, GLOBALREFFLAGS, 0 ) ;
		       END     %NOW ABSOLUTE CODEADDRESS OF P/F LOADED\
		      ELSE
		       BEGIN
			LCP2 := LCP^.PARMLIST;
			%ACTUAL PROCEDURE PARAM\
			IF  PFLEV <= 1
			THEN  LDO(PFADDR, 4)
			%IS FORMAL PROCEDURE\
			ELSE  LOD(P, PFADDR, 4)
		       END;
		      IF NOT COMPSPECIFICATION(LCP1,LCP2)
		      THEN ERROR(612);
		     END
		   END
		  ELSE   % NXT^.KLASS NOT IN [PROC,FUNC] \
		   BEGIN
		    LSP := NXT^.IDTYPE;
		    IF LSP <> NIL
		    THEN
		     BEGIN
		      IF NXT^.VKIND = FORMAL
		      THEN
		       BEGIN
			IF LSP^.FORM = STRINGPARM
			THEN
			 IF SY = IDENT
			 THEN
			   BEGIN
			    PRTERR := FALSE;   SEARCHID([FUNC],LCP1);
			    PRTERR := TRUE;
			    IF LCP1 <> NIL
			    THEN ERROR(399);
			   END;
			EXPRESSION(FSYS OR [COMMA,RPARENT]);
			IF LSP^.FORM = STRINGPARM
			THEN
			 BEGIN
			  IF GATTR.KIND <> EXPR
			  THEN
			   BEGIN
			    LOADADDRESS;
			    IF GATTR.TYPTR <> NIL
			    THEN
			    WITH GATTR.TYPTR^ DO
			    IF FORM = ARRAYS
			    THEN
			     BEGIN
			      IF INXTYPE <> NIL
			      THEN
			      GETBOUNDS(INXTYPE,LMIN,LMAX);
			      ADDTOP (LMIN);
			      GEN2(MOV,AUTINC,PC,AUTDEC,SP);
			      GENCONST(LMAX-LMIN+1);
			     END
			   END
			  ELSE  % GATTR.KIND = EXPR \
			   IF GATTR.TYPTR <> NIL
			   THEN
			     IF GATTR.TYPTR^.FORM <> STRINGPARM
			     THEN  ERROR(617)
			 END
			ELSE   % LSP^.FORM <> STRINGPARM \
			 IF GATTR.KIND = VARBL
			 THEN  LOADADDRESS
			 ELSE ERROR(154);
			LSP2 := GATTR.TYPTR;
			LSP1 := LSP;
			WHILE LSP1^.FORM = BOUNDLESS DO
			 BEGIN
			  IF LSP2 <> NIL
			  THEN
			   IF LSP2^.FORM = ARRAYS
			   THEN
			     BEGIN
			      LSP2 := LSP2^.AELTYPE;
			      IF LSP1^.UNSPECLEVEL > 1
			      THEN
			       BEGIN
				GEN2(MOV,AUTINC,PC,AUTDEC,SP);
				GENCONST(LSP2^.SIZE);
			       END
			     END
			   ELSE
			     IF LSP2^.FORM = BOUNDLESS
			     THEN
			       BEGIN
				IF ((LSP2^.UNSPECLEVEL = 1) AND (LSP1^.UNSPECLEVEL > 1))
				THEN
				 BEGIN
				  GEN2(MOV,AUTINC,PC,AUTDEC,SP);
				  GENCONST(LSP2^.SUBSTRUCT^.SIZE);
				 END;
				LSP2 := LSP2^.SUBSTRUCT;
			       END;
			  LSP1 := LSP1^.SUBSTRUCT;
			 END;
			IF NOT COMPTYPES(LSP1,LSP2)
			THEN ERROR(142)
		       END
		      ELSE
		      WITH  LSP^ DO
		       BEGIN
			IF (FORM = ARRAYS) OR (FORM = RECORDS)
			THEN
			 BEGIN
			  EXPRESSION(FSYS OR [COMMA,RPARENT]);
			  IF GATTR.KIND <> EXPR
			  THEN
			  % GATTR.TYPTR = EXPR  MEANS THAT THE ACTUAL PARAMETER WAS A FUNCTION,
			   THE RESULT OF WHICH HAS BEEN LEFT BEHIND ON THE STACK\
			   BEGIN
			    LOADADDRESS;
			    GEN2(MOV,AUTINC,SP,REG,AR);
			    IF FORM = ARRAYS
			    THEN
			    I := GATTR.TYPTR^.ADDRCORR
			    ELSE I := 0;
			    IF SIZE <= 10
			    THEN
			     BEGIN
			      GEN2(ADD,AUTINC,PC,REG,AR);
			      GENCONST(SIZE + I);
			      FOR I := 1 TO  SIZE DIV 2 DO
			      GEN2(MOV,AUTDEC,AR,AUTDEC,SP);
			     END
			    ELSE
			     BEGIN
			      GEN2(SUB,AUTINC,PC,REG,SP);
			      GENCONST(SIZE);
			      GEN2(MOV,REG,SP,REG,AD);
			      %NOW ADDRESS OF DESTINATION IN AD\
			      IF I <> 0
			      THEN
			       BEGIN
				GEN2(ADD,AUTINC,PC,REG,AR);
				GENCONST(ADDRCORR)
			       END;
			      GENSUBRCALL(MOVM2);
			      GENCONST(SIZE DIV 2);
			     END
			   END;
			  IF NOT  COMPTYPES(LSP,GATTR.TYPTR)
			  THEN    ERROR(142)
			 END                     %FORM=ARRAYS,ETC\
			ELSE
			 BEGIN
			  EXPRESSION(FSYS OR [COMMA,RPARENT])
			  ;LOAD ;
			  IF FORM = POWER
			  THEN
			   BEGIN
			    LATTR.TYPTR := LSP;
			    LATTR.KIND := VARBL ;
			    B := LARGESET(LATTR)
			   END
			  ELSE
			   IF COMPTYPES(REALPTR,LSP) AND
			    (GATTR.TYPTR = INTPTR)
			   THEN
			     BEGIN
			      GENSUBRCALL(FLT);
			      GATTR.TYPTR := REALPTR
			     END;
			  IF RUNTMCHECK
			  THEN
			   IF (FORM <= SUBRANGE) AND (LSP <> REALPTR) AND (LSP <> INTPTR)
			   THEN
			     BEGIN
			      GENSUBRCALL(SUBRCHK);  GETBOUNDS(LSP,LMIN,LMAX);
			      GENCONST(LMIN);   GENCONST(LMAX);
			     END;
			  IF NOT COMPTYPES(LSP,GATTR.TYPTR)
			  THEN ERROR(142)
			 END
		       END        %WITH  LSP..\
		     END      %LSP <> NIL\
		   END      % NXT^.KLASS\
		 END;
		%NXT = NIL\
		IF  NXT <> NIL
		THEN   NXT := NXT^.NEXT;
	       UNTIL   SY <> COMMA;
	      IF SY = RPARENT
	      THEN INSYMBOL
	      ELSE  ERROR(4)
	     END;
	    %IF  SY=LPARENT\
	    IF  NXT <> NIL
	    THEN ERROR(126);
	    WITH  FCP^ DO
	    IF LKIND = ACTUAL
	    THEN              %CALL THE ACTUAL PROCEDURE\
	     BEGIN
              IF EXTNAME = NIL THEN RELNAME := NAME
              ELSE RELNAME := EXTNAME^ ;
	      IF DECLPLACE < EXTERNFORTRAN THEN 
               BEGIN   BASE(LEVEL - PFLEV);         %LOADS THE STATIC LINK\
	        GEN2(JSR,REG,PC,INDEX,PC);
	        GENCONST( 0 ) ;
	        PUTRLD ( RELNAME, RELOCFCN, 2*CODE.LEN-2, 0 ) ;
	        PUTGSD ( RELNAME, GLOBALREFFLAGS, 0 ) ;
               END
              ELSE
               BEGIN  GEN2(MOV,AUTINC,PC,AUTDEC,SP);  GENCONST(PARLISTSIZE DIV 2);
                 GENSUBRCALL( FORTR );         GENCONST( 0 );
                 PUTRLD ( RELNAME, RELOCFCN, 2*CODE.LEN-2, 0 );
                 PUTGSD ( RELNAME, GLOBALREFFLAGS, 0 );
                 IF KLASS = FUNC THEN
                  BEGIN   GEN2(MOV,REG,AR,REGDEF,SP);
                   IF IDTYPE^.SIZE = 4 THEN
                    BEGIN   GEN2(MOV,REG,R,INDEX,SP);
                            GENCONST( 2 );
                    END
                  END
               END;
	     END
	    ELSE                                %CALL OF FORMAL PROCEDURE\
	     BEGIN
	      LOD(LEVEL - PFLEV,PFADDR,4);    %LOAD THE PROCEDURE PARAMETER\
	      GEN2(JSR,REG,PC,AUTINCDEF,SP)
	     END;
	    % WITH FCP\
	    GATTR.TYPTR := FCP^.IDTYPE;
	   END %CALLNONSTANDARD\ ;

	  PROCEDURE  CALLSTANDARD( FCP: CTP ) (*$Y+*) ;
	  (* FOR LKEY DEFINITIONS, SEE ENTERSTANDARD *)
	   BEGIN %CALLSTANDARD\
	    LKEY := FCP^.KEY;
	    IF (FCP^.KLASS = PROC) AND (LKEY = 14)
	    THEN   HALT
	    ELSE
	     IF (FCP^.KLASS = FUNC) AND (LKEY = 13)
	     THEN RUNTIME1
	     ELSE
	       IF (FCP^.KLASS = PROC) AND ((LKEY IN [2,4,8,10,12,13]) AND (SY <> LPARENT))
	       THEN
		 CASE LKEY OF
		  2:  FORMFEED;
		  4:  BREAKLN;
		  8:  READREADLN;
		  10:  WRITEWRITELN;
		  12:  GENSUBRCALL(MARKP);
		  13:  GENSUBRCALL(RELEASEP)
		 END
	       ELSE IF (FCP^.KLASS = FUNC) AND ((LKEY IN [9,10,11])
			AND (SY <> LPARENT)) THEN   EOFEOLNIORES
	       ELSE
		 BEGIN
		  IF SY = LPARENT
		  THEN INSYMBOL
		  ELSE ERROR(9);
		  IF FCP^.KLASS = PROC
		  THEN
		   CASE LKEY OF
		    2:    FORMFEED;
		    4:    BREAKLN;
		    1,3,
		    5,6:  GETPUTRESETREWRITE;
		    7,8:  READREADLN;
		    9,10: WRITEWRITELN;
		    11 :  NEW1;
		    12,13:MARKRELEASE;
		    15 :  PACK;
		    16 :  UNPACK;
		    17,18 :  DATETIME
		   END
		  ELSE  IF LKEY IN [9,10,11] THEN EOFEOLNIORES
		  ELSE
		   BEGIN
		    EXPRESSION(FSYS OR  [COMMA,RPARENT]);
		    IF LKEY <> 22 THEN  LOAD;
		     CASE LKEY OF
		      1:    ABS;
		      2:    SQR;
		      3:    TRUNC;
		      4:    ODD;
		      5:    ORD;
		      6:    CHR;
		      7,8:  PREDSUCC;
		      12:    ROUND;
		      14:    SPLITREAL;
		      15:    TWOPOW;
		      16,17,18,
		      19,20,21:
			       ARITHMETICFUNCTIONS;
		      22:    SSIZE
		     END
		   END;
		  IF SY = RPARENT
		  THEN INSYMBOL
		  ELSE ERROR(4)
		 END
	   END %CALLSTANDARD\ ;

	  (*$Y+*)  (* NEW MODULE *)

	 BEGIN   % CALL \
	  IF FCP^.PFDECKIND = STANDARD
	  THEN   CALLSTANDARD( FCP )
	  ELSE
	   BEGIN
	    CALLNONSTANDARD;
	    IF SY IN [LBRACK,PERIOD]
	    THEN CALLNS1
	   END
	 END   % CALL \ ;

	(*$Y+*)   (* SPLIT MODULES *)

	PROCEDURE EXPRESSION;
	VAR
	  LATTR: ATTR;  LOP: OPERATOR;  LSIZE: ADDRRANGE;
	  B,C,STACKD:  BOOLEAN;      SUBRNAME: RUNTIMEROUTS;
	  SMIN,SMAX: INTEGER;
	  MULTSSIZE: INTEGER;

	  PROCEDURE SMPLEEXPRESSION(FSYS: SETOFSYS);
	  VAR
	    LATTR: ATTR; LOP: OPERATOR; SIGNED: BOOLEAN;

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

	      PROCEDURE     LOADSTRINGCONSTANT;
	      VAR
		I: INTEGER;
	       BEGIN
		WITH GATTR DO
		IF TYPTR <> NIL
		THEN
		WITH CVAL.VALP^ DO
		 BEGIN
		  GENBR(BR,(SLGTH + 2) DIV 2);
		  I := 0;
		  WHILE I < SLGTH DO
		   BEGIN
		    GENCONST(ORD(SVAL[I]) + 256 *
			     ORD(SVAL[I + 1])); I := I + 2
		   END;
		  IF ODD(SLGTH+1)
		  THEN GENCONST(ORD(SVAL[I]));
		  GEN2(MOV,REG,PC,AUTDEC,SP);
		  GEN2(SUB,AUTINC,PC,REGDEF,SP);
		  GENCONST(TYPTR^.SIZE + 2)
		  %HYP. STRINGADDRESS ON STACK\
		 END
	       END;
	      %LOADSTRINGCONSTANT\

	      PROCEDURE FACTOR(FSYS: SETOFSYS);   (*$Y-  SAME MODULE *)
	      VAR
		LCP: CTP; LVP: CSP; VARPART: BOOLEAN;
		CSTPART:  SET OF 0..63;
		LSP,LSP1: STP;
		J,I,INTSET,K: INTEGER; FOURWORDSET: BOOLEAN;
		SCOUNT,LRMIN: INTEGER;  RANGEPART: BOOLEAN;

	       BEGIN
		IF NOT (SY IN FACBEGSYS)
		THEN
		 BEGIN
		  ERROR(58); SKIP(FSYS OR  FACBEGSYS);
		  GATTR.TYPTR := NIL
		 END;
		WHILE SY IN FACBEGSYS DO
		 BEGIN
		   CASE SY OF
		    %ID\    IDENT:
				   BEGIN
				    SEARCHID([KONST,VARS,FIELD,FUNC],LCP);
				    INSYMBOL;
				    IF LCP^.KLASS = FUNC
				    THEN
				     BEGIN
				      CALL(FSYS,LCP); GATTR.KIND := EXPR
				     END
				    ELSE
				     IF LCP^.KLASS = KONST
				     THEN
				      WITH GATTR, LCP^ DO
				       BEGIN
					TYPTR := IDTYPE; KIND := CST;
					CVAL := VALUES;
					IF STRING(TYPTR)
					THEN
					 BEGIN
					  IF (KADDR = 0) OR (DISX <> TOP)
					  THEN
					   BEGIN
					    LOADSTRINGCONSTANT;
					    IF DISX = TOP  THEN
						KADDR := 2 * CIX - 4 - IDTYPE^.SIZE
					   END
					  ELSE
					   BEGIN
					    GEN2(MOV,REG,PC,AUTDEC,SP);
					    GEN2(SUB,AUTINC,PC,REGDEF,SP);
					    GENCONST(2 * CIX - KADDR);
					    %HYPOTHETICAL ADDRESS OF STRINGCONSTANT ON THE STACK\
					   END;
					  IF SY = LBRACK
					  THEN
					   BEGIN
					    SELECTOR(FSYS,NIL); LOAD
					   END
					 END
				       END
				     ELSE   (* VARS OR FIELD *)
				       SELECTOR(FSYS,LCP);
 
				    (* REDUCE SUBRANGE TYPES TO THEIR
				       CORRESPONDING RANGE TYPES. NOTE THAT
				       THIS IS ALSO DONE TO FUNCTION RESULTS. *)
 
				    IF GATTR.TYPTR <> NIL
				    THEN
				    WITH GATTR, TYPTR^ DO
				    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
				    KIND := CST;
				    IF LGTH = 1
				    THEN
				     BEGIN
				      TYPTR := CHARPTR; CVAL := VAL;
				      INSYMBOL
				     END
				    ELSE
				     BEGIN
				      NEW(LSP,ARRAYS);
				      NEW(LSP1,SUBRANGE);
				      WITH LSP^ DO
				       BEGIN
					AELTYPE := CHARPTR;
					INXTYPE := LSP1; PACKOPT := FALSE;
					ADDRCORR := 0;
					SIZE := 2 * ((LGTH + 1) DIV 2);
				       END;
				      WITH  LSP1^ DO
				       BEGIN
					SIZE := 2;  RANGETYPE := INTPTR;
					MIN.IVAL := 0; MAX.IVAL := LGTH-1
				       END;
				      TYPTR := LSP;
				      CVAL := VAL; LOADSTRINGCONSTANT;
				      INSYMBOL;
				      IF SY = LBRACK
				      THEN
				       BEGIN
					SELECTOR(FSYS,NIL); LOAD
				       END
				     END;
				   END;
				 END;
		    %(\     LPARENT:
				     BEGIN
				      INSYMBOL; EXPRESSION(FSYS OR  [RPARENT]);
				      IF SY = RPARENT
				      THEN INSYMBOL
				      ELSE ERROR(4)
				     END;
		    %NOT\   NOTSY:
				   BEGIN
				    INSYMBOL; FACTOR(FSYS);
				    LOAD; GEN1(COM,REGDEF,SP);
				    GEN2(BIC,AUTINC,PC,REGDEF,SP);
				    GENCONST(-2);
				    IF GATTR.TYPTR <> NIL
				    THEN
				     IF GATTR.TYPTR <> BOOLPTR
				     THEN
				       BEGIN
					ERROR(135); GATTR.TYPTR := NIL
				       END;
				   END;
		    %[\     LBRACK:
				    BEGIN
				     INSYMBOL; CSTPART := [ ]; VARPART := FALSE;
				     FOURWORDSET := FALSE;
				     RANGEPART := FALSE;
				     NEW(LSP,POWER);
				     WITH LSP^ DO
				      BEGIN
				       ELSET := NIL; SIZE := 2
				      END;
				     IF SY = RBRACK
				     THEN
				      BEGIN
				       WITH GATTR DO
					BEGIN
					 TYPTR := LSP; KIND := CST
					END;
				       INSYMBOL
				      END
				     ELSE
				      BEGIN
					LOOP
					 EXPRESSION(FSYS OR  [COMMA,COLON,RBRACK]);
					 IF GATTR.TYPTR <> NIL
					 THEN
					  IF GATTR.TYPTR^.FORM <> SCALAR
					  THEN
					    BEGIN
					     ERROR(136); GATTR.TYPTR := NIL
					    END
					  ELSE
					    IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR)
					    THEN
					      BEGIN
					       IF GATTR.KIND = CST
					       THEN
						BEGIN
						 I := GATTR.CVAL.IVAL;
						 IF GATTR.TYPTR = CHARPTR
						 THEN I := I - 40B;
						 IF I > 15
						 THEN FOURWORDSET := TRUE;
						 IF (I > 63) OR (I < 0)  THEN
						   BEGIN
						   ERROR(604);
						   RANGEPART := FALSE
						   END
						 ELSE
						   IF SY = COLON  THEN
						     BEGIN
						     RANGEPART := TRUE;
						     LRMIN := I
						     END
						   ELSE
						     IF RANGEPART THEN
						       BEGIN
						       WHILE LRMIN <= I DO
							 BEGIN
							 CSTPART := CSTPART OR [LRMIN];
							 LRMIN := SUCC(LRMIN)
							 END;
						       RANGEPART := FALSE
						       END
						     ELSE (* NUMBER IS LEGAL AND NOT PART OF A SUBRANGE *)
						       CSTPART := CSTPART OR [I]
						END
					       ELSE
						BEGIN
						 LOAD;
						 IF (SY = COLON) OR RANGEPART
						 THEN
						  BEGIN
						   ERROR(21);   RANGEPART := NOT RANGEPART
						  END;
						 IF GATTR.TYPTR = CHARPTR
						 THEN
						  BEGIN
						   GEN2(SUB,AUTINC,PC,REGDEF,SP);
						   GENCONST(40B);
						  END;
						 IF NOT VARPART
						 THEN
						  BEGIN
						   VARPART := TRUE;
						   GETBOUNDS(GATTR.TYPTR,SMIN,SMAX)
						   ;
						   IF (SMAX <> 0) AND (SMAX <= 15)
						   AND NOT FOURWORDSET
						   THEN
						    BEGIN
						     GEN2(MOV,REGDEF,SP,REG,AR);
						     GEN1(CLR,REGDEF,SP);
						     GEN2(MOV,REG,AR,AUTDEC,SP)
						    END
						   ELSE
						    BEGIN
						     GENSUBRCALL(INITS);
						     FOURWORDSET := TRUE
						    END;
						  END;
						 GENSUBRCALL(SGSIN)
						END;
					       LSP^.ELSET := GATTR.TYPTR;
					       GATTR.TYPTR := LSP
					      END
					    ELSE ERROR(137);
					EXIT IF NOT  (SY IN [COMMA,COLON]);
					 INSYMBOL
					END;
				       IF SY = RBRACK
				       THEN INSYMBOL
				       ELSE ERROR(12)
				      END;
				     GATTR.KIND := EXPR;
				     IF FOURWORDSET
				     THEN  LSP^.SIZE := 8;
				     IF NOT (VARPART AND (CSTPART = []))
				     THEN
				      BEGIN
				       IF FOURWORDSET
				       THEN SCOUNT := 63
				       ELSE SCOUNT := 15;
				       FOR K := LSP^.SIZE DIV 2    DOWNTO 1 DO
					BEGIN
					 J := 40000B;   INTSET := 0;
					 IF SCOUNT IN CSTPART
					 THEN INTSET := INTSET + 100000B;
					 SCOUNT := SCOUNT - 1;
					 FOR  I := 0 TO  14 DO
					  BEGIN
					   IF SCOUNT IN CSTPART
					   THEN
					   INTSET := INTSET + J;
					   J := J DIV 2;
					   SCOUNT := SCOUNT - 1
					  END;
					 IF INTSET = 0
					 THEN  GEN1(CLR,AUTDEC,SP)
					 ELSE
					  BEGIN
					   GEN2(MOV,AUTINC,PC,AUTDEC,SP);
					   GENCONST(INTSET)
					  END;
					END;
				       IF VARPART
				       THEN
					IF  FOURWORDSET
					THEN GENSUBRCALL(UNI4)
					ELSE  GEN2(BIS, AUTINC,SP,REGDEF,SP);
				      END
				    END
		   END %CASE\ ;
		  IF  NOT (SY IN FSYS)
		  THEN
		   BEGIN
		    ERROR(6); SKIP(FSYS OR  FACBEGSYS)
		   END
		 END %WHILE\
	       END %FACTOR\ ;

	     BEGIN %TERM\
	      FACTOR(FSYS OR  [MULOP]);
	      WHILE SY = MULOP DO
	       BEGIN
		LOAD; LATTR := GATTR; LOP := OP;
		INSYMBOL; FACTOR(FSYS OR  [MULOP]); LOAD;
		IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL)
		THEN
		 CASE LOP OF
		  %*\       MUL:
				IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR)
				THEN MULTIPLY
				ELSE
				 BEGIN
				  IF LATTR.TYPTR = INTPTR
				  THEN
				   BEGIN
				    GENSUBRCALL(FLO);
				    LATTR.TYPTR := REALPTR
				   END
				  ELSE
				   IF GATTR.TYPTR = INTPTR
				   THEN
				     BEGIN
				      GENSUBRCALL(FLT);
				      GATTR.TYPTR := REALPTR
				     END;
				  IF (LATTR.TYPTR = REALPTR)
				  AND (GATTR.TYPTR = REALPTR)
				  THEN
				  GENSUBRCALL(MPR)
				  ELSE
				   BEGIN
				    ERROR(134); GATTR.TYPTR := NIL
				   END
				 END;
		  %/\       RDIV:
				  BEGIN
				   IF GATTR.TYPTR = INTPTR
				   THEN
				    BEGIN
				     GENSUBRCALL(FLT);
				     GATTR.TYPTR := REALPTR
				    END;
				   IF LATTR.TYPTR = INTPTR
				   THEN
				    BEGIN
				     GENSUBRCALL(FLO);
				     LATTR.TYPTR := REALPTR
				    END;
				   IF (LATTR.TYPTR = REALPTR)
				   AND (GATTR.TYPTR = REALPTR)
				   THEN
				   GENSUBRCALL(DVR)
				   ELSE
				    BEGIN
				     ERROR(134); GATTR.TYPTR := NIL
				    END
				  END;
		  %DIV\     IDIV:
				 IF (LATTR.TYPTR = INTPTR)
				 AND (GATTR.TYPTR = INTPTR)
				 THEN GENSUBRCALL(DVI)
				 ELSE
				  BEGIN
				   ERROR(134); GATTR.TYPTR := NIL
				  END;
		  %MOD\     IMOD:
				 IF (LATTR.TYPTR = INTPTR)
				 AND (GATTR.TYPTR = INTPTR)
				 THEN GENSUBRCALL(MODI)
				 ELSE
				  BEGIN
				   ERROR(134); GATTR.TYPTR := NIL
				  END;
		  %AND\     ANDOP:
				  IF (LATTR.TYPTR = BOOLPTR)
				  AND (GATTR.TYPTR = BOOLPTR)
				  THEN
				   BEGIN
				    GEN1(COM,REGDEF,SP);
				    GEN2(BIC,AUTINC,SP,REGDEF,SP)
				   END
				  ELSE
				   IF (LATTR.TYPTR^.FORM = POWER)
				   THEN
				     IF LARGESET(LATTR)
				     THEN GENSUBRCALL(INT4)
				     ELSE
				       BEGIN
					GEN1(COM,REGDEF,SP);  %INT1\
					GEN2(BIC,AUTINC,SP,REGDEF,SP)
				       END
				   ELSE
				     BEGIN
				      ERROR(134); GATTR.TYPTR := NIL
				     END
		 END %CASE\
		ELSE GATTR.TYPTR := NIL
	       END %WHILE\
	     END %TERM\ ;

	   BEGIN %SMPLEEXPRESSION\
	    SIGNED := FALSE;
	    IF (SY = ADDOP) AND (OP IN [PLUS,MINUS])
	    THEN
	     BEGIN
	      SIGNED := OP = MINUS; INSYMBOL
	     END;
	    TERM(FSYS OR  [ADDOP]);
	    IF SIGNED
	    THEN
	     BEGIN
	      LOAD;
	      IF GATTR.TYPTR = INTPTR
	      THEN GEN1(NEG,REGDEF,SP)
	      ELSE
	       IF  GATTR.TYPTR = REALPTR
	       THEN
		 BEGIN
		  GEN1(TST,REGDEF,SP);
		  GENBR(BEQ,2);   %TO PREVENT -0\
		  GEN2(ADD,AUTINC,PC,REGDEF,SP);   GENCONST(100000B);
		 END
	       ELSE
		 BEGIN
		  ERROR(134); GATTR.TYPTR := NIL
		 END
	     END;
	    WHILE SY = ADDOP DO
	      BEGIN
	      LOAD; LATTR := GATTR; LOP := OP;
	      INSYMBOL;
	      TERM(FSYS OR  [ADDOP]);
 
	      IF (GATTR.KIND = CST) AND (LOP IN [PLUS,MINUS]) AND
		 (GATTR.TYPTR=INTPTR) AND (LATTR.TYPTR=INTPTR)
		 THEN { USE IMMEDIATE INSTRUCTION }
		  BEGIN
		  IF GATTR.CVAL.IVAL = 1  THEN   { CAN USE INC/DEC }
		    IF LOP = PLUS THEN
		      GEN1(INC,REGDEF,SP)
		    ELSE
		      GEN1(DEC,REGDEF,SP)
		  ELSE  { CONSTANT IS NOT 1 }
		    BEGIN   { USE IMMEDIATE ADD/SUB }
		    IF LOP = PLUS THEN
		      GEN2(ADD,AUTINC,PC,REGDEF,SP)
		    ELSE
		      GEN2(SUB,AUTINC,PC,REGDEF,SP);
		    GENCONST (GATTR.CVAL.IVAL)
		    END;
		  GATTR.KIND := EXPR
		  END
 
	      ELSE  { USE NORMAL STACK INSTRUCTIONS }
 
		BEGIN
		LOAD { VALUE OF SECOND OPERAND } ;
		IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
		  CASE LOP OF
		  %+\     PLUS:
			       IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR)
			       THEN
			       GEN2(ADD,AUTINC,SP,REGDEF,SP)
			       ELSE
				BEGIN
				 IF LATTR.TYPTR = INTPTR
				 THEN
				  BEGIN
				   GENSUBRCALL(FLO);
				   LATTR.TYPTR := REALPTR
				  END
				 ELSE
				  IF GATTR.TYPTR = INTPTR
				  THEN
				    BEGIN
				     GENSUBRCALL(FLT);
				     GATTR.TYPTR := REALPTR
				    END;
				 IF (LATTR.TYPTR = REALPTR) AND (GATTR.TYPTR = REALPTR)
				 THEN  GENSUBRCALL(ADR)
				 ELSE
				  BEGIN
				   ERROR(134); GATTR.TYPTR := NIL
				  END
				END;
		  %-\     MINUS:
				IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR)
				THEN
				GEN2(SUB,AUTINC,SP,REGDEF,SP)
				ELSE
				 BEGIN
				  IF LATTR.TYPTR = INTPTR
				  THEN
				   BEGIN
				    GENSUBRCALL(FLO);
				    LATTR.TYPTR := REALPTR
				   END
				  ELSE
				   IF GATTR.TYPTR = INTPTR
				   THEN
				     BEGIN
				      GENSUBRCALL(FLT);
				      GATTR.TYPTR := REALPTR
				     END;
				  IF (LATTR.TYPTR = REALPTR) AND (GATTR.TYPTR = REALPTR)
				  THEN  GENSUBRCALL(SBR)
				  ELSE
				   IF  LATTR.TYPTR^.FORM = POWER
				   THEN
				     IF LARGESET(LATTR)
				     THEN GENSUBRCALL(DIF4)
				     ELSE
				      GEN2(BIC,AUTINC,SP,REGDEF,SP)
				   ELSE
				     BEGIN
				      ERROR(134); GATTR.TYPTR := NIL
				     END
				 END;
		  %OR\    OROP:
			       IF (LATTR.TYPTR = BOOLPTR) AND (GATTR.TYPTR = BOOLPTR)
			       THEN  GEN2(BIS,AUTINC,SP,REGDEF,SP)
			       ELSE
				IF LATTR.TYPTR^.FORM = POWER
				THEN
				  IF LARGESET(LATTR)
				  THEN GENSUBRCALL(UNI4)
				  ELSE
				   GEN2(BIS,AUTINC,SP,REGDEF,SP)
				ELSE
				 BEGIN   ERROR(134);  GATTR.TYPTR := NIL;
				 END
			END %CASE\
		ELSE  { EITHER GATTR.TYPTR OR LATTR.TYPTR IS NIL }
		  GATTR.TYPTR := NIL
		END { ELSE }
	      END %WHILE\
	   END %SIMPLEEXPRESSION\ ;

	  (*$Y+*)   (* NEW MODULE *)

	 BEGIN %EXPRESSION\
	  MULTSSIZE := 0;
	  SMPLEEXPRESSION(FSYS OR  [RELOP]);
	  IF SY = RELOP
	  THEN
	   BEGIN
	    STACKD := FALSE;
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM  <=   POWER
	     THEN LOAD
	     ELSE
	       IF GATTR.KIND = EXPR
	       THEN STACKD := TRUE
	       ELSE
		 BEGIN
		  LOADADDRESS;
		  IF GATTR.TYPTR^.FORM = ARRAYS  THEN
		     ADDTOP (GATTR.TYPTR^.ADDRCORR)
		 END;
	    LATTR := GATTR; LOP := OP;
	    INSYMBOL; SMPLEEXPRESSION(FSYS);
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM  <=   POWER
	     THEN LOAD
	     ELSE
	       IF STACKD
	       THEN                      %MULTIPLE LEFTM ON STACK\
		 BEGIN
		  IF GATTR.KIND = EXPR
		  THEN
		   BEGIN
		    GEN2(MOV,REG,SP,REG,AR);  %LOAD RIGHT MEMBER ADDR\
		    MULTSSIZE := GATTR.TYPTR^.SIZE;
		   END
		  ELSE
		   BEGIN
		    LOADADDRESS;
		    GEN2(MOV,AUTINC,SP,REG,AR); %LOAD RIGHT MEMBER ADDRESS\
		    IF GATTR.TYPTR^.FORM = ARRAYS  THEN
		       ADDTOP (GATTR.TYPTR^.ADDRCORR)
		   END;
		  GEN2(MOV,REG,SP,REG,AD);        %LOAD DESTINATIONADDRESS\
		  IF MULTSSIZE <> 0
		  THEN
		   BEGIN
		    GEN2(ADD,AUTINC,PC,REG,AD);
		    GENCONST(MULTSSIZE)
		   END;
		  MULTSSIZE := MULTSSIZE + LATTR.TYPTR^.SIZE
		 END
	       ELSE
		 IF GATTR.KIND = EXPR
		 THEN
		   BEGIN
		    STACKD := TRUE;
		    GEN2(MOV,REG,SP,REG,AR);
		    MULTSSIZE := GATTR.TYPTR^.SIZE;
		    GEN2(MOV,INDEX,SP,REG,AD);
		    GENCONST(MULTSSIZE);
		    MULTSSIZE := MULTSSIZE + 2;
		   END
		 ELSE
		   BEGIN
		    LOADADDRESS; STACKD := FALSE;
		    IF GATTR.TYPTR^.FORM = ARRAYS
		    THEN
		     IF GATTR.TYPTR^.ADDRCORR <> 0
		     THEN
		       BEGIN
			GEN2(ADD,AUTINC,PC,REGDEF,SP);
			GENCONST(GATTR.TYPTR^.ADDRCORR)
		       END
		   END;
	    IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL)
	    THEN
	     IF LOP = INOP
	     THEN
	       (* RECALL THAT SUBRANGE TYPES HAVE BEEN REDUCED TO SCALARS.
		  SEE PROCEDURE FACTOR (CASE OF IDENT).			   *)
	       IF (GATTR.TYPTR^.FORM = POWER ) AND (LATTR.TYPTR^.FORM=SCALAR)
	       THEN
		 IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR^.ELSET)
		 THEN
		   BEGIN
		    GETBOUNDS(LATTR.TYPTR,SMIN,SMAX);  %BOUNS OF SCAL.\
		    IF (LATTR.TYPTR = CHARPTR)
		    THEN
		     BEGIN
                      C := TRUE  % CHAR IN SET MUST BE REL SPACE \ ;
		      SMIN := 0;   SMAX := SMAX - 40B;
		     END ELSE C := FALSE;
		    B := ((SMAX = 0) OR (SMAX > 15));
		    %B=TRUE MEANS THAT A LARGE SET MUST BE USED\
		    LSIZE := GATTR.TYPTR^.SIZE;
		    IF (GATTR.KIND<>VARBL) AND B AND (LSIZE = 2)
		    THEN BEGIN  GENSUBRCALL(EXPST);
                      LSIZE := 8 END
		    ELSE  B := LSIZE = 8;
                    IF C THEN
                     BEGIN     GEN2( SUB, AUTINC, PC, INDEX, SP );
			       GENCONST( 40B % SPACE \ );
			       GENCONST( LSIZE )
		     END;
		    GENSUBRCALL(INN);
		    IF B
		    THEN GENCONST(8)
		    ELSE GENCONST(2);
		   END
		 ELSE
		   BEGIN
		    ERROR(129); GATTR.TYPTR := NIL
		   END
	       ELSE
		 BEGIN
		  ERROR(130); GATTR.TYPTR := NIL
		 END
	     ELSE
	       BEGIN
		IF LATTR.TYPTR <> GATTR.TYPTR
		THEN
		 IF LATTR.TYPTR = INTPTR
		 THEN
		   BEGIN
		    GENSUBRCALL(FLO);
		    LATTR.TYPTR := REALPTR
		   END
		 ELSE
		   IF GATTR.TYPTR = INTPTR
		   THEN
		     BEGIN
		      GENSUBRCALL(FLT);
		      GATTR.TYPTR := REALPTR
		     END;
		IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
		THEN
		 BEGIN
		  LSIZE := LATTR.TYPTR^.SIZE;
		   CASE LATTR.TYPTR^.FORM OF
		    SCALAR :
			     BEGIN
			      B := LATTR.TYPTR = REALPTR;
			      SUBRNAME := SCALRT[LOP,B]
			     END;
		    POINTER:
			    IF LOP = EQOP
			    THEN SUBRNAME := EQU
			    ELSE
			     IF LOP = NEOP
			     THEN SUBRNAME := NEQ
			     ELSE
			      SUBRNAME := ERRN;
		    POWER :
			    BEGIN
			     B := LARGESET(LATTR);
			      CASE LOP OF
			       LTOP,GTOP: SUBRNAME := ERRN;
			       LEOP:
				    IF B
				    THEN
				    SUBRNAME := LEQS4
				    ELSE  SUBRNAME := LEQS1;
			       GEOP:
				    IF B
				    THEN
				    SUBRNAME := GEQS4
				    ELSE  SUBRNAME := GEQS1;
			       NEOP:
				    IF B
				    THEN
				    SUBRNAME := NEQS4
				    ELSE  SUBRNAME := NEQ;
			       EQOP:
				    IF B
				    THEN
				    SUBRNAME := EQUS4
				    ELSE  SUBRNAME := EQU
			      END;
			    END;
		    ARRAYS,
		    RECORDS:
			     BEGIN
			      SUBRNAME := ARRT[LOP,STRING(LATTR.TYPTR),STACKD];
			      IF SUBRNAME IN [EQUM,EQUM2,NEQM,NEQM2]
			      THEN
			      LSIZE := LSIZE DIV 2;
			     END;
		    FILES :
			    BEGIN
			     ERROR(133); SUBRNAME := ERRN
			    END
		   END;
		  IF SUBRNAME = ERRN
		  THEN ERROR(131)
		  ELSE
		   IF LATTR.TYPTR^.FORM IN [ARRAYS,RECORDS]
		   THEN
		     IF SUBRNAME IN [EQUM2,NEQM2,LEQM2,LESM2,GEQM2,GRTM2]
		     THEN
		       BEGIN
			GEN2(MOV,AUTINC,PC,REG,R);
			GENCONST(LSIZE);        GENSUBRCALL(SUBRNAME);
		       END
		     ELSE
		       BEGIN
			GENSUBRCALL(SUBRNAME);  GENCONST(LSIZE)
		       END
		   ELSE          GENSUBRCALL(SUBRNAME)
		 END
		ELSE ERROR(129)
	       END;
	    GATTR.TYPTR := BOOLPTR; GATTR.KIND := EXPR;
	    IF MULTSSIZE <> 0
	    THEN
	     BEGIN
	      GEN2(MOV,REGDEF,SP,INDEX,SP);
	      GENCONST(MULTSSIZE);
	      GEN2(ADD,AUTINC,PC,REG,SP);
	      GENCONST(MULTSSIZE);
	     END
	   END %SY = RELOP\
	 END %EXPRESSION\ ;

	PROCEDURE ASSIGNMENT(FCP: CTP) (*$Y+*) ;
	VAR
	  LATTR: ATTR;
	  SMIN,SMAX: INTEGER;
	  LSP1: STP; STACKD: BOOLEAN; AL, I: INTEGER;
	 BEGIN
	  SELECTOR(FSYS OR  [BECOMES],FCP);
	  IF FCP^.KLASS = FUNC THEN
	   IF FCP^.PFLEV >= LEVEL THEN
	    BEGIN   ERROR ( 184 );   GATTR.TYPTR := NIL;
	    END;
	  IF SY = BECOMES
	  THEN
	   BEGIN
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF (GATTR.ACCESS <> DRCT) OR  (GATTR.TYPTR^.FORM > POWER)
	     THEN
	       BEGIN
		LOADADDRESS;
		IF GATTR.TYPTR^.FORM = ARRAYS  THEN
		   ADDTOP (GATTR.TYPTR^.ADDRCORR)
	       END;
	    LATTR := GATTR;
	    INSYMBOL; EXPRESSION(FSYS);
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM  <=   POWER
	     THEN LOAD
	     ELSE
	       IF GATTR.KIND = EXPR
	       THEN
		 BEGIN
		  STACKD := TRUE;
		  GEN2(MOV,REG,SP,REG,AR);
		  GEN2(ADD,AUTINC,PC,REG,SP);
		  GENCONST(GATTR.TYPTR^.SIZE);
		  GEN2(MOV,AUTINC,SP,REG,AD)
		 END   %WHEN THE MULTIPLE IS A FUNCTIONRESULT ON THE STACK\
	       ELSE
		 BEGIN
		  LOADADDRESS;  STACKD := FALSE;
		  IF GATTR.TYPTR^.FORM = ARRAYS  THEN
		     ADDTOP (GATTR.TYPTR^.ADDRCORR)
		 END;
	    IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL)
	    THEN
	     BEGIN
	      IF COMPTYPES(REALPTR,LATTR.TYPTR) AND (GATTR.TYPTR = INTPTR)
	      THEN
	       BEGIN
		GENSUBRCALL(FLT);
		GATTR.TYPTR := REALPTR
	       END;
	      IF LATTR.TYPTR^.FORM = POWER
	      THEN
	      STACKD := LARGESET(LATTR);   %SETCONVERSIONS ONLY\
	      IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
	      THEN
	       CASE LATTR.TYPTR^.FORM OF
		SCALAR,
		SUBRANGE:
			  BEGIN
			   IF RUNTMCHECK AND ((LATTR.TYPTR<>INTPTR) AND
					      (LATTR.TYPTR <> REALPTR))
			   THEN
			    BEGIN
			     GETBOUNDS(LATTR.TYPTR,SMIN,SMAX);
			     GENSUBRCALL(SUBRCHK);
			     GENCONST(SMIN);   GENCONST(SMAX);
			    END;
			   STORE(LATTR);
			  END;
		POINTER,
		POWER  : STORE(LATTR);
		ARRAYS,
		RECORDS:
			 BEGIN
			  AL := GATTR.TYPTR^.SIZE DIV 2;
			  IF STACKD
			  THEN
			   IF AL <= 3
			   THEN
			    FOR I:= 1 TO AL DO
			    GEN2(MOV,AUTINC,AR,AUTINC,AD)
			   ELSE
			     BEGIN
			      GENSUBRCALL(MOVM2);
			      GENCONST(AL);
			     END
			  ELSE
			   BEGIN
			    GENSUBRCALL(MOVM);
			    GENCONST(AL)
			   END
			 END;
		FILES: ERROR(146)
	       END
	      ELSE ERROR(129)
	     END
	   END %SY = BECOMES\
	  ELSE ERROR(51)
	 END %ASSIGNMENT\ ;

	PROCEDURE GOTOSTATEMENT (*$Y+*) ;
        LABEL   1;
	VAR
	  LLP: LBP;
	  LRP: REFLINKP ;
	 BEGIN
	  IF SY = INTCONST
	  THEN
	   BEGIN
	    LLP := FSTLABP;
	    WHILE LLP <> FLABP DO
	    WITH LLP^ DO
	    IF LABVAL = VAL.IVAL
	    THEN
	     BEGIN
	      IF DEFINED
	      THEN  GENUJP(LABADDR)
	      ELSE
	       BEGIN
		GENUJP( 0 );
		NEW ( LRP ) ;  LRP^.NEXTREF := LABCHAIN ;
		LABCHAIN := LRP ;  LRP^.REFADDR := CIX ;
	       END;
	      GOTO 1
	     END
	    ELSE LLP := NEXTLAB;
	    (* UNDECLARED AND UNDEFINED *)
	    GENUJP( 0 );
	    NEW(LRP);   NEW(LLP);
	    WITH LLP^ DO
	     BEGIN
	      LABVAL := VAL.IVAL; DEFINED := FALSE;
	      LABCHAIN := LRP; NEXTLAB := FSTLABP; DECLARED := FALSE;
	     END;
	    FSTLABP := LLP;
	    WITH LRP^ DO
	     BEGIN
	      NEXTREF := NIL;   REFADDR := CIX
	     END;
1:
	    INSYMBOL
	   END
	  ELSE ERROR(15)
	 END %GOTOSTATEMENT\ ;

	PROCEDURE COMPOUNDSTATEMENT (*$Y+*) ;
	 BEGIN
	   LOOP
	     REPEAT
	      STATEMENT(FSYS OR  [SEMICOLON,ENDSY])
	     UNTIL  NOT (SY IN STATBEGSYS);
	   EXIT IF SY <> SEMICOLON;
	    INSYMBOL
	   END;
	  IF SY = ENDSY
	  THEN INSYMBOL
	  ELSE ERROR(13)
	 END %COMPOUNDSTATEMENET\ ;

	PROCEDURE IFSTATEMENT (*$Y+*) ;
	VAR
	  LCIX1,LCIX2: CODERANGE;
	 BEGIN
	  EXPRESSION(FSYS OR  [THENSY]);
	  GENFJP(0); LCIX1 := CIX;
	  IF SY = THENSY
	  THEN INSYMBOL
	  ELSE ERROR(52);
	  STATEMENT(FSYS OR  [ELSESY]);
	  IF SY = ELSESY
	  THEN
	   BEGIN
	    GENUJP(0);  LCIX2 := CIX;
	    INSERT(LCIX1, 2 * (CIX - LCIX1));
	    INSYMBOL; STATEMENT(FSYS);
	    INSERT(LCIX2, 2 * (CIX - LCIX2));
	   END
	  ELSE INSERT(LCIX1,2 * (CIX - LCIX1));
	 END %IFSTATEMENT\ ;

	PROCEDURE CASESTATEMENT (*$Y+*) ;
        LABEL   1;
	TYPE
	  CIP = ^CASEINFO;
	  CASEINFO = PACKED
	  RECORD
	    NEXT: CIP;
	    CSSTART: CODERANGE;
	    CSEND: CODERANGE;
	    CSLAB: INTEGER
	  END;
	VAR
	  LSP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3: CIP; LVAL: VALU;
	  LADDR,OTHERADDR,OTHEREND: ADDRRANGE; LCIX: CODERANGE; LMIN,LMAX: INTEGER;
          OTHERCASE: BOOLEAN;     HEAPM: INTP;
	 BEGIN
	  EXPRESSION(FSYS OR  [OFSY,COMMA,COLON]);
	  HEAPMARK(HEAPM);
	  LOAD; %LOAD LABELVALUE\
	  GEN2(MOV,AUTINC,SP,REG,R);
	  GEN2(CMP,REG,R,AUTINC,PC);
	  GENCONST(0);
	  GENBR(BLT,3);
	  GEN2(CMP,REG,R,AUTINC,PC);
	  GENCONST(0);    GENBR(BLE,2);
	  GEN1(JMP,INDEX,PC);     GENCONST(0);
	  GEN1(ASL,REG,R);
	  GEN2(ADD,REG,PC,REG,R);   LCIX := CIX;
	  GEN2(ADD,INDEX,R,REG,R);
	  GENCONST(0);
	  GEN1(JMP,REGDEF,R);
	  LSP := GATTR.TYPTR;
	  IF LSP <> NIL
	  THEN
	   IF (LSP^.FORM <> SCALAR) OR  (LSP = REALPTR)
	   THEN
	     BEGIN
	      ERROR(144); LSP := NIL
	     END;
	  IF SY = OFSY
	  THEN INSYMBOL
	  ELSE ERROR(8);
	  FSTPTR := NIL; LPT3 := NIL;
	  OTHERADDR := 0;
	   LOOP
            OTHERCASE := SY = DEFAULTSY;
            IF OTHERCASE
	    THEN
	     BEGIN
	      IF OTHERADDR <> 0
	      THEN ERROR(156);
	      OTHERADDR := CIX + 1;   INSYMBOL
	     END
	    ELSE
	     LOOP
	      CONSTANT(FSYS OR  [COMMA,COLON],LSP1,LVAL);
	      IF LSP <> NIL
	      THEN
	       IF COMPTYPES(LSP,LSP1)
	       THEN
		 BEGIN
		  LPT1 := FSTPTR; LPT2 := NIL;
		  WHILE LPT1 <> NIL DO
		  WITH LPT1^ DO
		   BEGIN
		    IF CSLAB  <=   LVAL.IVAL
		    THEN
		     BEGIN
		      IF CSLAB = LVAL.IVAL
		      THEN ERROR(156);
		      GOTO 1
		     END;
		    LPT2 := LPT1; LPT1 := NEXT
		   END;
1:
		  NEW(LPT3);
		  WITH LPT3^ DO
		   BEGIN
		    NEXT := LPT1; CSLAB := LVAL.IVAL;
		    CSSTART := CIX + 1; CSEND := 0; %CSSTART IS CODEADDRESS\
		   END;
		  IF LPT2 = NIL
		  THEN FSTPTR := LPT3
		  ELSE LPT2^.NEXT := LPT3
		 END
	       ELSE ERROR(147);
	     EXIT IF SY <> COMMA;
	      INSYMBOL;
	     END;
	    IF SY = COLON
	    THEN INSYMBOL
	    ELSE ERROR(5);
	     REPEAT
	      STATEMENT(FSYS OR  [SEMICOLON])
	     UNTIL  NOT (SY IN STATBEGSYS);
	    GENUJP(0);  
            IF OTHERCASE THEN OTHEREND := CIX
            ELSE IF LPT3<>NIL THEN  LPT3^.CSEND := CIX;
	   EXIT IF SY <> SEMICOLON;
	    INSYMBOL
	   END;
	  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;
	    INSERT(LCIX + 2, 2 * (CIX - LCIX - LMIN));
	    INSERT(LCIX - 8, LMIN);
	    INSERT(LCIX - 5, LMAX);
	    IF LMAX - LMIN < CIXMAX
	    THEN
	     BEGIN
	      LADDR := CIX + 2 + LMAX - LMIN;
	      IF OTHERADDR = 0
	      THEN OTHERADDR := LADDR ELSE INSERT( OTHEREND, 2*(LADDR-OTHEREND-1));
	      INSERT(LCIX - 2,2 * (OTHERADDR - LCIX + 1));
	       REPEAT
		WITH FSTPTR^ DO
		 BEGIN
		  WHILE CSLAB > LMIN DO
		   BEGIN
		    GENCONST(2 * (OTHERADDR - LCIX - 1 - LMIN));
		    LMIN := LMIN + 1
		   END;
		  GENCONST(2 * (CSSTART - LCIX - CSLAB - 1));
		  IF CSEND <> 0
		  THEN INSERT(CSEND, 2 * (LADDR-CSEND-1));
		  FSTPTR := NEXT; LMIN := LMIN + 1
		 END
	       UNTIL FSTPTR = NIL
	     END
	    ELSE ERROR(157)
	   END;
	  IF SY = ENDSY
	  THEN INSYMBOL
	  ELSE ERROR(13);
	  HEAPRELEASE(HEAPM)
	 END %CASESTATEMENT\ ;

	PROCEDURE REPEATSTATEMENT (*$Y+*) ;
	VAR
	  LADDR: ADDRRANGE;
	 BEGIN
	  LADDR := CIX + 1;
	   LOOP
	     REPEAT
	      STATEMENT(FSYS OR  [SEMICOLON,UNTILSY])
	     UNTIL  NOT (SY IN STATBEGSYS);
	   EXIT IF SY <> SEMICOLON;
	    INSYMBOL
	   END;
	  IF SY = UNTILSY
	  THEN
	   BEGIN
	    INSYMBOL; EXPRESSION(FSYS); GENFJP(LADDR)
	   END
	  ELSE ERROR(53)
	 END %REPEATSTATEMENT\ ;

	PROCEDURE WHILESTATEMENT (*$Y+*) ;
	VAR
	  LADDR: ADDRRANGE; LCIX: CODERANGE;
	 BEGIN
	  LADDR := CIX + 1;
	  EXPRESSION(FSYS OR [DOSY]);
	  GENFJP(0); LCIX := CIX;
	  IF SY = DOSY
	  THEN INSYMBOL
	  ELSE ERROR(54);
	  STATEMENT(FSYS);
	  GENUJP(LADDR);
	  INSERT(LCIX, 2 * (CIX - LCIX))
	 END %WHILESTATEMENT\ ;

	PROCEDURE FORSTATEMENT (*$Y+*) ;
	VAR
	  LATTR: ATTR; LSP: STP; LADDR: ADDRRANGE; LSY: SYMBOL;
	  LCIX: CODERANGE;
	  REGR, I: INTEGER;   INSTR: INSTRRANGE;
	 BEGIN
	  IF SY = IDENT
	  THEN
	   BEGIN
	    SEARCHID([VARS],LCP);
	    WITH LCP^, LATTR DO
	     BEGIN
	      TYPTR := IDTYPE; KIND := VARBL;
	      IF VKIND = ACTUAL
	      THEN
	       BEGIN
		ACCESS := DRCT; VLEVEL := VLEV;
		DPLMT := VADDR
	       END
	      ELSE
	       BEGIN
		ERROR(155); TYPTR := NIL
	       END
	     END;
	    IF LATTR.TYPTR <> NIL
	    THEN
	     IF (LATTR.TYPTR^.FORM > SUBRANGE)
	      OR  COMPTYPES(REALPTR,LATTR.TYPTR)
	     THEN
	       BEGIN
		ERROR(143); LATTR.TYPTR := NIL
	       END;
	    INSYMBOL
	   END
	  ELSE
	   BEGIN
	    ERROR(2); SKIP(FSYS OR  [BECOMES,TOSY,DOWNTOSY,DOSY])
	   END;
	  IF SY = BECOMES
	  THEN
	   BEGIN
	    INSYMBOL; EXPRESSION(FSYS OR  [TOSY,DOWNTOSY,DOSY]);
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM <> SCALAR
	     THEN ERROR(144)
	     ELSE
	       IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
	       THEN
		 BEGIN
		  LOAD; STORE(LATTR)
		 END
	       ELSE ERROR(145)
	   END
	  ELSE
	   BEGIN
	    ERROR(51); SKIP(FSYS OR  [TOSY,DOWNTOSY,DOSY])
	   END;
	  IF SY IN [TOSY,DOWNTOSY]
	  THEN
	   BEGIN
	    LSY := SY; INSYMBOL; EXPRESSION(FSYS OR  [DOSY]);
	    IF GATTR.TYPTR <> NIL
	    THEN
	     IF GATTR.TYPTR^.FORM <> SCALAR
	     THEN ERROR(144)
	     ELSE
	       IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
	       THEN
		 BEGIN
		  LOAD;    LC := LC - 2;
		  GEN2(MOV,AUTINC,SP,INDEX,MP);
		  GENCONST(LC);
		  LADDR := CIX + 1;   %CODE-ADDR FOR JUMP\
		  IF LATTR.VLEVEL = LEVEL
		  THEN  REGR := MP
		  ELSE
		   IF LATTR.VLEVEL <= 1
		   THEN REGR := GP
		   ELSE
		     BEGIN
		      GEN2(MOV,REGDEF,MP,REG,AD);
		      FOR I := 2  TO LEVEL - LATTR.VLEVEL  DO
		      GEN2(MOV,REGDEF,AD,REG,AD);
		      REGR := AD
		     END;
		  IF LATTR.TYPTR = CHARPTR
		  THEN INSTR := CMPB
		  ELSE INSTR := CMP;
		  GEN2(INSTR,INDEX,REGR,INDEX,MP);
		  GENCONST(LATTR.DPLMT);
		  GENCONST(LC);
		  IF LSY = TOSY
		  THEN  INSTR := BLE
		  ELSE  INSTR := BGE;
		  GENBR(INSTR, 2);
		  IF LC < LCMAX
		  THEN LCMAX := LC
		 END
	       ELSE ERROR(145)
	   END
	  ELSE
	   BEGIN
	    ERROR(55); SKIP(FSYS OR  [DOSY])
	   END;
	  GEN1(JMP,INDEX,PC);
	  GENCONST(0);        LCIX := CIX;
	  IF SY = DOSY
	  THEN INSYMBOL
	  ELSE ERROR(54);
	  STATEMENT(FSYS);
	  IF  LSY = TOSY
	  THEN  INSTR := INC
	  ELSE  INSTR := DEC;
	  IF REGR = AD
	  THEN
	   BEGIN
	    GEN2(MOV,REGDEF,MP,REG,AD);
	    FOR I := 2 TO   LEVEL - LATTR.VLEVEL  DO
	    GEN2(MOV,REGDEF,AD,REG,AD)
	   END;
	  GEN1(INSTR,INDEX,REGR);
	  GENCONST(LATTR.DPLMT);
	  GENUJP(LADDR);
	  INSERT(LCIX, 2 * (CIX - LCIX)); LC := LC + 2
	 END %FORSTATEMENT\ ;

	PROCEDURE LOOPSTATEMENT (*$Y+*) ;
	VAR
	  LADDR: ADDRRANGE; LCIX: CODERANGE;
	 BEGIN
	  LADDR := CIX + 1;
	   LOOP
	     REPEAT
	      STATEMENT(FSYS OR  [SEMICOLON,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]);
	      LOAD
	     END
	    ELSE
	     BEGIN
	      ERROR(56); SKIP(FSYS OR  [SEMICOLON,ENDSY])
	     END;
	    GEN1(TST,AUTINC,SP);
	    GENBR(BEQ,2);
	    GEN1(JMP,INDEX,PC);
	    GENCONST(0);   LCIX := CIX;
	     LOOP
	       REPEAT
		STATEMENT(FSYS OR  [SEMICOLON,ENDSY])
	       UNTIL  NOT (SY IN STATBEGSYS);
	     EXIT IF SY <> SEMICOLON;
	      INSYMBOL
	     END;
	    GENUJP(LADDR);  INSERT(LCIX,2 * (CIX - LCIX))
	   END
	  ELSE ERROR(57);
	  IF SY = ENDSY
	  THEN INSYMBOL
	  ELSE ERROR(13)
	 END %LOOPSTATEMENT\ ;

	PROCEDURE WITHSTATEMENT (*$Y+*) ;
	VAR
	  LCP: CTP; LCNT1: DISPRANGE;  LCNT2: ADDRRANGE;
	 BEGIN
	  LCNT1 := 0; LCNT2 := 0;
	   LOOP
	    IF SY = IDENT
	    THEN
	     BEGIN
	      SEARCHID([VARS,FIELD],LCP); INSYMBOL
	     END
	    ELSE
	     BEGIN
	      ERROR(2); 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;
		  DISPLAY[TOP].FNAME := GATTR.TYPTR^.FSTFLD;
		  IF GATTR.ACCESS = DRCT
		  THEN
		  WITH DISPLAY[TOP] DO
		   BEGIN
		    OCCUR := CREC; CLEV := GATTR.VLEVEL;
		    CDSPL := GATTR.DPLMT
		   END
		  ELSE
		   BEGIN
		    LOADADDRESS;
		    LC := LC - 2; LCNT2 := LCNT2 - 2;
		    WITH DISPLAY[TOP] DO
		     BEGIN
		      OCCUR := VREC; VDSPL := LC
		     END;
		    IF LC < LCMAX
		    THEN LCMAX := LC;
		    GEN2(MOV,AUTINC,SP,INDEX,MP);
		    GENCONST(LC)
		   END
		 END
	       ELSE ERROR(250)
	     ELSE ERROR(140);
	   EXIT IF SY <> COMMA;
	    INSYMBOL
	   END;
	  IF SY = DOSY
	  THEN INSYMBOL
	  ELSE ERROR(54);
	  STATEMENT(FSYS);
	  TOP := TOP - LCNT1; LC := LC - LCNT2;
	 END %WITHSTATEMENT\ ;


	(*$Y+*)   (* NEW MODULE *)

       BEGIN %STATEMENT\
        IF RUNTMCHECK THEN LINENODEF;
	IF SY = INTCONST
	THEN %LABEL\
	 BEGIN
	  LLP := FSTLABP;
	  WHILE LLP <> FLABP DO
	  WITH LLP^ DO
	  IF LABVAL = VAL.IVAL
	  THEN
	   BEGIN
	    IF NOT DECLARED
	    THEN ERROR(900);
	    IF DEFINED
	    THEN ERROR(165);
	    WHILE LABCHAIN <> NIL DO
	    WITH LABCHAIN^ DO
	     BEGIN
	      INSERT ( REFADDR, 2*( CIX - REFADDR )) ;
	      LABCHAIN := NEXTREF
	     END ;
	    LABADDR := CIX + 1 ;  DEFINED := TRUE ;
	    GOTO 1
	   END
	  ELSE LLP := NEXTLAB;
	  ERROR(900);   NEW(LLP);
	  WITH LLP^ DO
	   BEGIN
	    DECLARED := FALSE;  LABVAL := VAL.IVAL;
	    DEFINED := TRUE; LABCHAIN := NIL;   NEXTLAB := FSTLABP;
	    LABADDR := CIX + 1;
	   END;
	  FSTLABP := LLP;
1:
	  INSYMBOL;
	  IF SY = COLON
	  THEN INSYMBOL
	  ELSE ERROR(5)
	 END;
	IF  NOT (SY IN FSYS OR  [IDENT])
	THEN
	 BEGIN
	  ERROR(6); SKIP(FSYS)
	 END;
	IF SY IN STATBEGSYS OR  [IDENT]
	THEN
	 BEGIN
	   CASE SY OF
	    IDENT:
		   BEGIN
		    SEARCHID([VARS,FIELD,FUNC,PROC],LCP); INSYMBOL;
		    IF LCP^.KLASS = PROC
		    THEN 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;
	  IF  NOT (SY IN FSYS)
	  THEN
	   BEGIN
	    ERROR(6); SKIP(FSYS)
	   END
	 END
       END %STATEMENT\ ;

      PROCEDURE STARTOFMAIN (*$Y+*) ;
       BEGIN
	EPMAIN := (CIX + 1);   LLC1 := 0 ;
	GENSUBRCALL( INITA ) ;
	IF OUTPUTPTR <> NIL
	THEN ADDR := OUTPUTPTR^.VADDR
	ELSE ADDR :=0 ;
	GENCONST( ADDR % OUTPUT \ ) ;
	IF INPUTPTR <> NIL
	THEN ADDR := INPUTPTR^.VADDR
	ELSE ADDR := 0 ;
	GENCONST ( ADDR % INPUT \ ) ;
	IF TTYOUTPTR <> NIL
	THEN ADDR := TTYOUTPTR^.VADDR
	ELSE ADDR := 0 ;
	GENCONST ( ADDR % TTYOUT \ ) ;
	IF TTYINPTR <> NIL
	THEN ADDR := TTYINPTR^.VADDR
	ELSE ADDR := 0 ;
	GENCONST ( ADDR % TTYIN \ ) ;
        TESTPACKED := TRUE;
	IF ONSWITCH['H'] THEN
	 BEGIN
	  GEN2(MOV,AUTINC,PC,INDEX,GP);
	  GENCONST(SELECTOR);
	  GENCONST(4%SELECTOR WORD\);
	 END;
	IF ONSWITCH['D'] THEN
	 BEGIN   GEN2(MOV,AUTINC,PC,INDEX,GP);   GENCONST(0);
	  PUTRLD('$DDTDF    ',RELOCFCN,2*CODE.LEN-2,2*DCIX+2);
	  GENCONST(-6);   COPYCTP( DISPLAY[0].FNAME );
	  GEN2( MOV,AUTINC,PC,INDEX,GP);   GENCONST(0);
	  PUTRLD('$DDTDF    ',RELOCFCN,2*CODE.LEN-2,2*INTPTR^.SELFSTP);
	  GENCONST(-8);
	  GEN2 ( MOV,AUTINC,PC,INDEX,GP );   GENCONST(0);
	  PUTRLD('$DDTDF    ',RELOCFCN,2*CODE.LEN-2,2*REALPTR^.SELFSTP);
	  GENCONST(-10);
	  GEN2 ( MOV,AUTINC,PC,INDEX,GP );   GENCONST(0);
	  PUTRLD('$DDTDF    ',RELOCFCN,2*CODE.LEN-2,2*CHARPTR^.SELFSTP);
	  GENCONST(-12);
	 END;
       END;

      PROCEDURE NEWMODULE (*$Y-*)   (*  CONTIGUOUS MODULE   *);
       BEGIN
        IF FIRSTMODULE THEN FIRSTMODULE := FALSE
        ELSE BEGIN
          IF GSD.LEN > 1 THEN WRITOBJ( GSD );
  	  GSD.VALUE[1] := 2 %  EGSD  \ ;  WRITOBJ( GSD );
  	  GSD.VALUE[1] := 6 %  EM    \ ;  WRITOBJ( GSD );
  	  GSD.VALUE[1] := 1 %  GSD   \ ;
          (*$Z+*)   (*  NEW MODULE  *)
          IF PRCODE THEN BEGIN WRITELN(CEX,'.END':30);
              PAGE(CEX);     END;
          (*$Z-*)
         END;
	PUTGSD ( PSECT, 0 % MODULE NAME \, 0 );
	PUTGSD ( OBJIDENT, 3000B % MODULE IDENT \, 0 );  WRITOBJ( GSD );
        FOR RTR := ERRN TO DUMRTR DO NOTCALLED[RTR] := TRUE;
	(*$Z+*)
	IF PRCODE
	THEN
	  WRITELN( CEX, '                       .TITLE   ',PSECT);
	(*$Z-*)
       END  % NEWMODULE \ ;



   PROCEDURE ENTERBODY;
     BEGIN
      IF PSECTGEN OR FIRSTMODULE  THEN  NEWMODULE;
 
      { FOR THE MAIN PROGRAM, GENERATE OBJECT CODE TO CAUSE	}
      { THE SETTING UP OF THE FCS FILE STORAGE REGION BY THE	}
      { TASK BUILDER.   THIS CODE IS EQUIVALENT TO:		}
      {								}
      {		.PSECT	$$FSR1	GBL,OVR,D			}
      {		.GLOBAL	.FSRCB	     ; TO BRING IN FCSFSR	}
      {	 F.BFHD == 20		     ; TO ENABLE ACTFIL OPTION	}
 
      IF FPROCP = NIL THEN   { MAIN PROGRAM }
	BEGIN
	PUTGSD ('$$FSR1    ', 2754B {PSECT NAME}, 0);
	PUTGSD ('.FSRCB    ', 2100B {SYMBOL REF}, 0);
	PUTGSD ('F.BFHD    ', 2110B {SYMBOL DEF}, 20B);
	WRITOBJ (GSD)
	END;
 
 
      PUTRLD ( PSECT, 7, 0, 2*CIX+2 ) ;   WRITOBJ ( RLD ) ;
      (*$Z+*)
      IF PRCODE
      THEN
       BEGIN
        WRITELN(CEX);  WRITELN(CEX);  WRITELN(CEX);
	WRITELN(CEX,'.PSECT':30,PSECT:15)
       END;
      (*$Z-*)
      IF FPROCP <> NIL
      THEN
      WITH FPROCP^ DO
       BEGIN
	PFADDR := 2 * (CIX + 1);
	LLC1 := PARLISTSIZE;
	GLOBALDEF ( PSECT, PFADDR ) ;
       END     %WITH  FPROCP\
      ELSE   STARTOFMAIN;
      GEN2(MOV,REG,SP,REG,AD);
      GEN2(MOV, REG,MP,AUTDEC,SP);
      GEN2(MOV, REG,AD,REG,MP);       %ENTER  BODY INSTRUCTIONS\
      IF TESTPACKED 
      THEN GENSUBRCALL(CLRSTK)
      ELSE  GEN2(SUB,AUTINC,PC,REG,SP);
      GENCONST(0);              CIX1 := CIX;
      IF ONSWITCH['D'] THEN
       BEGIN   GEN2 ( MOV,AUTINC,PC,INDEX,MP );   GENCONST(0);
	IF DISPLAY[TOP].FNAME <> NIL THEN
	   PUTRLD('$DDTDF    ',RELOCFCN,2*CODE.LEN-2,2*DCIX+2);
	GENCONST(-4);   COPYCTP( DISPLAY[TOP].FNAME )
       END;
      IF HEAPCHECK
      THEN BEGIN  LINENODEF;  GENSUBRCALL(OVFLCHK);
	   END;
      IF ONSWITCH['D'] AND (FPROCP = NIL) THEN   GENSUBRCALL ( DDTINIT );
      LCMAX := LC;
    END   % ENTERBODY \;
 
 
    PROCEDURE LEAVEBODY;
     BEGIN
      IF SY = ENDSY
      THEN INSYMBOL
      ELSE ERROR(13);
      LLP := FSTLABP; %TEST FOR UNDEFINED LABELS\
      WHILE LLP <> FLABP DO
      WITH LLP^ DO
       BEGIN
	IF  NOT DEFINED
	THEN
	 BEGIN
	  IF LABCHAIN = NIL
	  THEN ERROR(901)
	  ELSE ERROR(168);
	  WRITELN; WRITELN(' LABEL ',LABVAL)
	 END;
	LLP := NEXTLAB
       END;
      IF  FPROCP = NIL
      THEN
       BEGIN   IF ONSWITCH['Q'] THEN 
		BEGIN   GENSUBRCALL ( FREQV );
		 GENCONST(ORD(FILENAME[8])+256*ORD(FILENAME[9]));
		 GENCONST(ORD(FILENAME[6])+256*ORD(FILENAME[7]));
		 GENCONST(ORD(FILENAME[4])+256*ORD(FILENAME[5]));
		 GENCONST(ORD(FILENAME[2])+256*ORD(FILENAME[3]));
		 GENCONST(ORD(FILENAME[0])+256*ORD(FILENAME[1]));
		 GENCONST(0);
		 PUTRLD ( LASTLINE.LLPSECT,15B % PSECT ADD.REL. \,
			  2*CODE.LEN-2,2*LASTLINE.LLADDR);
		END;
	GENSUBRCALL ( EXITP );
       END
      ELSE
       BEGIN
	GEN2(MOV,AUTDEC,MP,REG,MP);
	GEN2(ADD,AUTINC,PC,REG,SP);
	GENCONST(LLC1 - LCMAX);           %RETURN FROM BODY INSTRUCTIONS\
	GEN1(RTS,REG,PC);
       END;
      I := -LCMAX - 2;
      DATASIZE := DATASIZE + I;
      IF  TESTPACKED
      THEN  INSERT(CIX1,I DIV 2)        %NUMBER OF WORDS\
      ELSE  INSERT(CIX1,I);
      FSTLABP := FLABP ;
      IF CODE.LEN > 1
      THEN WRITOBJ ( CODE ) ;
      IF  RLD.LEN > 1
      THEN WRITOBJ ( RLD  ) ;
      PSECTDEF ( PSECT, 2*CIX+2 ) ;
      CIXX := CIXX + CIX + 1 ;
      IF ( FPROCP = NIL ) OR ( SY = PERIOD )
      THEN
       BEGIN
	IF FPROCP = NIL  THEN
         BEGIN   
          PUTGSD ( PSECT, 1400B (* TRANSFER ADDRESS *), 2*EPMAIN ) ;
            PSECT := '$HEAP     ';
            IF PSECTGEN THEN NEWMODULE;
            DATASIZE := DATASIZE + 200;
            PUTGSD('999999    ',PSECTDEFFLAGS, DATASIZE );
            PUTGSD('$$HEAP    ',GLOBALDEFFLAGS,0);
           END;
	WRITOBJ ( GSD ) ;
	GSD.VALUE [ 1 ] := 2 % EGSD \ ;   WRITOBJ ( GSD ) ;
	GSD.VALUE [ 1 ] := 6 %  EM  \ ;   WRITOBJ ( GSD ) ;
       END
      ELSE
       IF GSD.LEN > 1
       THEN WRITOBJ ( GSD ) ;
      CIX := OLDCIX ;   PSECT := OLDPSECT ;
      GLOBALINDEX := OLDGLOBALINDEX ;
     END   % LEAVE BODY \;
 
    (*$Y+*)    (* MODULE SPLITTING AGAIN *)
 
    BEGIN   % BODY \
     ENTERBODY;
     LOOP
      REPEAT
       STATEMENT(FSYS OR [SEMICOLON,ENDSY])
      UNTIL NOT (SY IN STATBEGSYS);
     EXIT IF SY <> SEMICOLON;
      INSYMBOL;
     END;
     LEAVEBODY;
    END   % BODY \ ;

   (*$Y+*)     (*  NEW MODULE  *)

   BEGIN %BLOCK\
    HEAPMARK(HEAPM);
    TESTPACKED := FALSE;
    FLABP := FSTLABP; DP := TRUE;
    IF NOT MAIN AND (LEVEL = 1)
    THEN FSYS := FSYS OR [PERIOD];
    OLDPSECT := PSECT;
    IF FPROCP <> NIL
    THEN IF FPROCP^.EXTNAME <> NIL THEN PSECT := FPROCP^.EXTNAME^
    ELSE  PSECT := FPROCP^.NAME;
    OLDCIX := CIX ;  CIX := -1 ;
    OLDGLOBALINDEX := GLOBALINDEX ;
     REPEAT
      IF NOT (SY IN BLOCKBEGSYS) THEN
	BEGIN
	ERROR(6);
	SKIP(FSYS)
	END;
      IF SY = LABELSY THEN
        BEGIN
	INSYMBOL; LABELDECLARATION
        END;
      IF SY = CONSTSY THEN
        BEGIN
	INSYMBOL; CONSTDECLARATION
        END;
      IF SY = TYPESY THEN
        BEGIN
	INSYMBOL; TYPEDECLARATION
        END;
      IF SY = VARSY THEN
        BEGIN
	INSYMBOL; VARDECLARATION
        END;
      WHILE SY IN [PROCEDURESY,FUNCTIONSY] DO
        BEGIN
	LSY := SY; INSYMBOL; PROCEDUREDECLARATION(LSY)
        END;
      IF (SY <> BEGINSY) AND (MAIN OR (LEVEL > 1)) THEN
	BEGIN
	ERROR(18); SKIP(FSYS)
	END
     UNTIL (SY IN STATBEGSYS) OR ((SY = PERIOD) AND NOT MAIN AND (LEVEL = 1));
    DP := FALSE;
    IF MAIN OR ( LEVEL > 1 )
    THEN
     BEGIN
      IF SY = BEGINSY
      THEN INSYMBOL
      ELSE ERROR(17);
       REPEAT
	BODY(FSYS OR  [CASESY]);
	IF ( SY <> FSY ) AND ( SY <> PERIOD )
	THEN
	 BEGIN
	  ERROR(6); SKIP(FSYS OR  [FSY])
	 END
       UNTIL (SY = FSY) OR  (SY IN BLOCKBEGSYS) OR (SY = PERIOD);
     END  % IF MAIN OR LEVEL > 1 \
    ELSE
     IF SY <> PERIOD
     THEN ERROR(183);
    HEAPRELEASE(HEAPM); %DELETE LOCAL ENTRIES IN THE RUNTIME ''HEAP''\
   END %BLOCK\ ;

PROCEDURE PROGRAMHEADING (*$Y+*) ;
 
TYPE
    STANDARDFILES = ( TTY, TTYIN, INPUT, OUTPUT );
 
VAR
    CP: CTP;
    GLOBALSIZE: ADDRRANGE ;
    HEAD: BOOLEAN ;
    FILES: ARRAY[STANDARDFILES] OF ALFA ;
    THISFILE: STANDARDFILES ;
    GIVENFILES: SET OF STANDARDFILES ;
 
BEGIN
INSYMBOL ;   % GET FIRST SYMBOL \
 
(* SENSE SWITCHES THAT MUST BE AT START OF PROGRAM *)
MAIN := MAIN AND NOT OFFSWITCH['M'] OR ONSWITCH['M'];
IF DEBUG THEN ONSWITCH['D'] := TRUE ELSE OFFSWITCH['D'] := TRUE;
IF FREQUENCE THEN ONSWITCH['Q'] := TRUE ELSE OFFSWITCH['Q'] := TRUE;
 
GLOBALSIZE := DAPADDR + 2*MAXFILES + 6 ;  % SPACE FOR LUNTAB ETC. \
FILES[TTY] := 'TTY       ' ;
FILES[TTYIN] := 'TTYIN     ' ;
FILES[INPUT] := 'INPUT     ' ;
FILES[OUTPUT] := 'OUTPUT    ' ;
INPUTPTR  := NIL ;
OUTPUTPTR := NIL ;
TTYINPTR  := NIL ;
TTYOUTPTR := NIL ;
GIVENFILES := [] ;
 
IF MAIN THEN
    BEGIN
    IF (SY=IDENT) AND (ID='PROGRAM   ') THEN
	BEGIN
	HEAD := TRUE ;
	INSYMBOL ;
	IF SY = IDENT  THEN
	    BEGIN
	    PSECT := ID ;
	    INSYMBOL
	    END
	ELSE
	    ERROR (2)
	END
    ELSE	% MAIN PROGRAM WITH NO PROGRAM STATEMENT \
	BEGIN
	HEAD := FALSE ;
	ERROR (920);
	GIVENFILES := [INPUT,OUTPUT]    %DEFAULT FILES\
	END ;
 
    IF HEAD AND (SY=LPARENT) THEN
	BEGIN
	INSYMBOL ;
	LOOP
	    IF ID = FILES[TTY] THEN GIVENFILES := GIVENFILES OR [TTY,TTYIN]
	    ELSE IF ID = FILES[INPUT] THEN GIVENFILES := GIVENFILES OR [INPUT]
	    ELSE IF ID = FILES[OUTPUT] THEN GIVENFILES := GIVENFILES OR [OUTPUT]
	    ELSE ERROR (23) ;
	    INSYMBOL ;
	    EXIT IF SY <> COMMA ;
	    INSYMBOL
	    END %LOOP\ ;
	IF SY <> RPARENT THEN ERROR(4)
			ELSE INSYMBOL
	END  %IF LPARENT\ ;
    IF HEAD THEN IF (SY = SEMICOLON) THEN INSYMBOL
				     ELSE ERROR(14) ;
 
    IF HEAD THEN ID := '          '
    END %IF MAIN\
ELSE  % NOT MAIN \
    (* DECLARE FILES ACCESSIBLE TO SEPARATLY COMPILED PROCEDURE *)
    GIVENFILES := [TTY,TTYIN] ;
 
FOR THISFILE := TTY TO OUTPUT DO   % TTY AND TTYIN MUST BE FIRST \
    IF THISFILE IN GIVENFILES THEN
	BEGIN
	NEW ( CP, VARS ) ;
	WITH CP^ DO
	    BEGIN
	    NAME := FILES[THISFILE] ;
	    IDTYPE := TEXTPTR ;
	    VKIND := ACTUAL ;
	    NEXT := NIL ;
	    SELFCTP := 0 ;
	    GLOBALSIZE := GLOBALSIZE + FILESIZECORR + TEXTBUFFSIZE + 4 ;
	    IF THISFILE IN [TTY,TTYIN]
		THEN GLOBALSIZE := GLOBALSIZE - FDBSIZE ;
	    VADDR := GLOBALSIZE - 2
	    END  %WITH\ ;
	ENTERID (CP) ;
	CASE THISFILE OF
	    TTY:	TTYOUTPTR := CP ;
	    TTYIN:	TTYINPTR := CP ;
	    INPUT:	INPUTPTR := CP ;
	    OUTPUT:	OUTPUTPTR := CP
	    END
	END  %IF THISFILE..\ ;
 
DATASIZE := GLOBALSIZE ;
IF FREQUENCE AND (OUTPUTPTR = NIL)
THEN ERROR(930);
EXTSET := EXTSET AND NOT OFFSWITCH['E'] OR ONSWITCH['E'];
FLTSET := FLTSET AND NOT OFFSWITCH['G'] OR ONSWITCH['G'];
FPPUNIT:=FPPUNIT AND NOT OFFSWITCH['F'] OR ONSWITCH['F'];
PRCODE := PRCODE AND NOT OFFSWITCH['C'] OR ONSWITCH['C'];
LIST   := LIST   AND NOT OFFSWITCH['L'] OR ONSWITCH['L'];
WARNINGS := WARNINGS AND NOT OFFSWITCH['W'] OR ONSWITCH['W'];
PSECTGEN := PSECTGEN AND NOT OFFSWITCH['Y'] OR ONSWITCH['Y'];
CONDCOMP := CONDCOMP AND NOT OFFSWITCH['X'] OR ONSWITCH['X'];
HEAPCHECK  := HEAPCHECK  AND NOT OFFSWITCH['T'] OR ONSWITCH['T'];
FREQUENCE  := FREQUENCE  AND NOT OFFSWITCH['Q'] OR ONSWITCH['Q'];
RUNTMCHECK := RUNTMCHECK AND NOT OFFSWITCH['R'] OR ONSWITCH['R'];
EXTSET := EXTSET OR FLTSET OR FPPUNIT ;
TRACE := TRACE AND NOT OFFSWITCH['S'] OR ONSWITCH['S'];
IF FREQUENCE OR TRACE OR DEBUG THEN
     BEGIN   HEAPCHECK := TRUE;   ONSWITCH['T'] := TRUE   END;
IF DEBUG THEN
     BEGIN PSECTGEN := FALSE;  OFFSWITCH['Y'] := TRUE;  ONSWITCH['Y'] := FALSE;
     END;
OFFSWITCH['D'] := NOT ONSWITCH['D'];
OFFSWITCH['S'] := NOT ONSWITCH['S'];
OFFSWITCH['Q'] := NOT ONSWITCH['Q'];
LASTLINE.LLADDR := 0;   LASTLINE.LLPSECT := PSECT;
IF FREQUENCE THEN ONSWITCH['Q'] := TRUE;
IF DEBUG THEN   LC := -202 %WORKING SPACE FOR DEBUGGER\
 
END  % PROGRAMHEADING \ ;

  PROCEDURE ENTERSTANDARD (*$Y+*) ;
  VAR
    CP,CP1: CTP; I: INTEGER;
    LVP: CSP;   SP: STP;
    NA: ARRAY [1..58] OF ALFA;
    VAL: ARRAY [0..8] OF INTEGER;
   BEGIN                                                     %TYPE UNDERLIEING:\
    % ENTER STANDARD TYPES \
    %**********************\
    % INITPROCEDURE \ %STANDARDNAMES\
     BEGIN
      NA[ 1] := 'FALSE     '; NA[ 2] := 'TRUE      ';
      NA[ 3] := 'INPUT     '; NA[ 4] := 'OUTPUT    ';
      NA[ 5] := 'GET       '; NA[ 6] := 'PAGE      ';
      NA[ 7] := 'PUT       '; NA[ 8] := 'BREAK     ';
      NA[ 9] := 'RESET     '; NA[10] := 'REWRITE   ';
      NA[11] := 'READ      '; NA[12] := 'READLN    ';
      NA[13] := 'WRITE     '; NA[14] := 'WRITELN   ';
      NA[15] := 'NEW       '; NA[16] := 'MARK      ';
      NA[17] := 'RELEASE   '; NA[18] := 'HALT      ';
      NA[19] := 'PACK      '; NA[20] := 'UNPACK    ';
      NA[21] := 'DATE      '; NA[22] := 'TIME      ';
      NA[23] := 'ABS       '; NA[24] := 'SQR       ';
      NA[25] := 'TRUNC     '; NA[26] := 'ODD       ';
      NA[27] := 'ORD       '; NA[28] := 'CHR       ';
      NA[29] := 'PRED      '; NA[30] := 'SUCC      ';
      NA[31] := 'EOF       '; NA[32] := 'EOLN      ';
      NA[33] := 'IORESULT  '; NA[34] := 'ROUND     ';
      NA[35] := 'RUNTIME   '; NA[36] := 'SPLITREAL ';
      NA[37] := 'TWOPOW    '; NA[38] := 'SIN       ';
      NA[39] := 'COS       '; NA[40] := 'ARCTAN    ';
      NA[41] := 'EXP       '; NA[42] := 'LN        ';
      NA[43] := 'SQRT      '; NA[44] := 'SIZE      ';
      NA[45] := 'ALFALENG  '; NA[46] := 'MAXINT    ';
      NA[47] := 'MININT    '; NA[48] := 'MAXREAL   ';
      NA[49] := 'SMALLREAL '; NA[50] := 'MINREAL   ';
      NA[51] := 'RANDOM    '; NA[52] := 'UPDATE    ';
      NA[53] := 'APPEND    '; NA[54] := 'TEMPORARY ';
      NA[55] := 'INSERT    '; NA[56] := 'SHARED    ';
      NA[57] := 'SPOOL     '; NA[58] := 'BLOCK     ';
      VAL[0] := ALFALENG;  VAL[1] := 32767;    VAL[2] := 100000B;
      VAL[3] := 077777B;   VAL[4] := 032400B;  VAL[5] := 000001B;
      VAL[6] := 177777B;   VAL[7] := 000000B;  VAL[8] := 000000B;
     END %STANDARDNAMES\ ;

    NEW(INTPTR,SCALAR,STANDARD);                              %INTEGER\
    INTPTR^.SIZE := 2;   INTPTR^.SELFSTP := 0;
    NEW(REALPTR,SCALAR,STANDARD);                             %REAL\
    REALPTR^.SIZE := 4;   REALPTR^.SELFSTP := 0;
    NEW(CHARPTR,SCALAR,STANDARD);                             %CHAR\
    CHARPTR^.SIZE := 2;   CHARPTR^.SELFSTP := 0;
    NEW(BOOLPTR,SCALAR,DECLARED);                             %BOOLEAN\
    BOOLPTR^.SIZE := 2;   BOOLPTR^.SELFSTP := 0;
    NEW(NILPTR,POINTER);                                      %NIL\
    WITH NILPTR^ DO
     BEGIN
      ELTYPE := NIL; SIZE := 2;  SELFSTP := 0;
     END;
      BEGIN   NEW(TEXTPTR,FILES);                             %TEXT\
       WITH TEXTPTR^ DO
        BEGIN
         FILTYPE := CHARPTR; SIZE := 2;  SELFSTP := 0
        END;
      END;


    % ENTER STANDARD NAMES \
    %**********************\


    NEW(CP,TYPES);                                            %INTEGER\
    WITH CP^ DO
     BEGIN
      NAME := 'INTEGER   '; IDTYPE := INTPTR
     END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            %REAL\
    WITH CP^ DO
     BEGIN
      NAME := 'REAL      '; IDTYPE := REALPTR
     END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            %CHAR\
    WITH CP^ DO
     BEGIN
      NAME := 'CHAR      '; IDTYPE := CHARPTR
     END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            %BOOLEAN\
    WITH CP^ DO
     BEGIN
      NAME := 'BOOLEAN   '; IDTYPE := BOOLPTR
     END;
    ENTERID(CP);
    NEW(CP,KONST);                                            %NIL\
    WITH CP^ DO
     BEGIN
      NAME := 'NIL       '; IDTYPE := NILPTR;
      NEXT := NIL; VALUES.IVAL := 0
     END;
    ENTERID(CP);
IF DEFLEVEL >= 2 THEN
 BEGIN   NEW(CP,TYPES);
  WITH CP^ DO
   BEGIN   NAME := 'TEXT      ';  IDTYPE := TEXTPTR;
   END;
  ENTERID(CP);
  FOR I := 0 TO 5 DO
   BEGIN
    NEW(CP,KONST);                                            %ALFALENG\
    WITH CP^ DO
     BEGIN
      NAME := NA[I+45];   NEXT := NIL;
      IF I < 3 THEN
       BEGIN   IDTYPE := INTPTR;  VALUES.IVAL := VAL[I]
       END
      ELSE
       BEGIN   IDTYPE := REALPTR;
        (*$Z+*) NEW(CP1,KONST); (*SOLVE PROBLEM WITH NEW(LVP)*) (*$Z-*)
        NEW(LVP,REEL);
        LVP^.HEAD := VAL[I];   LVP^.TAIL := VAL[I+3];
        VALUES.VALP := LVP;
       END;
     END;
    ENTERID(CP);
   END;
 END;
IF DEFLEVEL >= 3 THEN
 BEGIN
  NEW(IOSPECPTR,SCALAR,DECLARED);   IOSPECPTR^.SIZE := 2;
  NEW(CP,TYPES);
  WITH CP^ DO
   BEGIN   NAME := 'IOSPEC    ';  IDTYPE := IOSPECPTR;
   END;
  ENTERID ( CP );
  CP1 := NIL;
  FOR I := 0 TO 7 DO
   BEGIN
    NEW( CP,KONST );
    WITH CP^ DO
     BEGIN
      NAME := NA[I+51];   IDTYPE := IOSPECPTR;
      NEXT := CP1;   VALUES.IVAL := I;
     END;
    ENTERID( CP );    CP1 := CP;
   END;
  IOSPECPTR^.FCONST := CP;
 END % IF DEFLEVEL >= 3 \ ;
IF DEFLEVEL >= 2 THEN
 BEGIN
  NEW( SP,SUBRANGE );
  WITH SP^ DO
   BEGIN   SIZE := 2;   SELFSTP := 0;   RANGETYPE := CHARPTR;
    MIN.IVAL := 0;   MAX.IVAL := 127;
   END;
  NEW( CP,TYPES );
  WITH CP^ DO
   BEGIN   NAME := 'ASCII     ';
    IDTYPE := SP;   SELFCTP := 0;
   END;
  NEW( SP,SUBRANGE );
  SP^ := CP^.IDTYPE^;   SP^.MAX.IVAL := 255;
  NEW( CP1,TYPES );
  WITH CP1^ DO
   BEGIN   NAME := 'BYTE      ';
    IDTYPE := SP;   SELFCTP := 0;
   END;
  ENTERID( CP );   ENTERID( CP1 );
 END   %  IF DEFLEVEL >= 2   \;
 
    CP1 := NIL;
    FOR I := 1 TO 2 DO
     BEGIN
      NEW(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 := 5 TO 22 DO
     IF (I<18) OR (DEFLEVEL>=1) THEN
     BEGIN
      NEW(CP,PROC,STANDARD);                           %GET,GETLN,PUT,PUTLN,RESET\
      WITH CP^ DO                                           %REWRITE,READ,READLN,WRITE,WRITELN,\
       BEGIN
	NAME := NA[I]; IDTYPE := NIL;                %NEW,MARK,RELEASE\
	NEXT := NIL; KEY := I - 4;                        %SETCONTENTS\
       END;
      %MARK,RELEASE\
      ENTERID(CP)
     END;
    FOR I := 23 TO 44 DO
     IF (I<36) OR (DEFLEVEL>=1) THEN
     BEGIN
      NEW(CP,FUNC,STANDARD);
      WITH CP^ DO
       BEGIN
	NAME := NA[I]; IDTYPE := NIL;
	NEXT := NIL;   KEY := I - 22;
       END;
      ENTERID(CP);
     END;
    NEW(CP,VARS);                         %PARAMETER OF PREDECLARED FUNCTIONS\
    WITH CP^ DO
     BEGIN
      NAME := '          '; IDTYPE := REALPTR;
      VKIND := ACTUAL; NEXT := NIL; VLEV := 1; VADDR := 0
     END;


    % ENTER UNDECLARED \
    %******************\

    NEW(UTYPPTR,TYPES);
    WITH UTYPPTR^ DO
     BEGIN
      NAME := '          '; IDTYPE := NIL
     END;
    NEW(UCSTPTR,KONST);
    WITH UCSTPTR^ DO
     BEGIN
      NAME := '          '; IDTYPE := NIL; NEXT := NIL;
      VALUES.IVAL := 0
     END;
    NEW(UVARPTR,VARS);
    WITH UVARPTR^ DO
     BEGIN
      NAME := '          '; IDTYPE := NIL; VKIND := ACTUAL;
      NEXT := NIL; VLEV := 0; VADDR := 0
     END;
    NEW(UFLDPTR,FIELD);
    WITH UFLDPTR^ DO
     BEGIN
      NAME := '          '; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0
     END;
    NEW(UPRCPTR,PROC,DECLARED,ACTUAL);
    WITH UPRCPTR^ DO
     BEGIN
      NAME := '          '; IDTYPE := NIL; DECLPLACE := INTERNAL;
      NEXT := NIL; EXTNAME := NIL;   PFLEV := 0; PFADDR :=0;
     END;
    NEW(UFCTPTR,FUNC,DECLARED,ACTUAL);
    WITH UFCTPTR^ DO
     BEGIN
      NAME := '          '; IDTYPE := NIL; NEXT := NIL;
      DECLPLACE := INTERNAL; EXTNAME := NIL;   PFLEV := 0; PFADDR := 0;
     END
    (* ADJUST INPUT ETC BECAUSE PRORAMHEADING IS CALLED BEFORE ENTERST *)
    IF INPUTPTR <> NIL THEN INPUTPTR^.IDTYPE := TEXTPTR;
    IF OUTPUTPTR <> NIL THEN OUTPUTPTR^.IDTYPE := TEXTPTR;
    IF TTYINPTR <> NIL THEN TTYINPTR^.IDTYPE := TEXTPTR;
    IF TTYOUTPTR <> NIL THEN TTYOUTPTR^.IDTYPE := TEXTPTR;
   END %ENTERUNDECL\ ;

  PROCEDURE OPENFILES (*$Y+*) ;


   BEGIN
    READFILEIDENTIFIER( DEFLEVEL, PAGEWIDTH, LINEWIDTH, ONSWITCH, OFFSWITCH,
	MCRLINE, MCRLEN, FILENAME, PDP11OBJ,
       (*$Z+*) OUTPUTHGH, (*$Z-*) INPUT, OUTPUT (*$Z+*) , CEX (*$Z-*) ) ;
   END  % OPENFILES \ ;

  PROCEDURE WRITESTAT;   (*$Y-*)
   BEGIN   IF ERRDETECTED THEN WRITE('**** ') ELSE WRITE('NO ');
    WRITELN('ERROR DETECTED');
    WRITELN('TOTAL PROGRAM SIZE     ', 2*CIXX+2:7:O);
    WRITELN('OUTERMOST DATA SIZE    ', -LC:7:O );
    WRITELN('RESERVED STACK & HEAP  ', DATASIZE:7:O);
    WRITELN;
    WRITELN ( MCRLINE : MCRLEN );
   END;

  (*$Y+*)  (* NEW MODULE *)
 
 
 BEGIN  (* MAIN PROGRAM *)
  INITTABLES;    INITTB;   INIT2;

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

  RTIME := RUNTIME;
  LEVEL := 0; TOP := 0;
  WITH DISPLAY[0] DO
   BEGIN
    FNAME := NIL; OCCUR := BLCK
   END;



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

  OPENFILES;
  LIST := LIST AND NOT OFFSWITCH['L'] OR ONSWITCH['L'];

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

  WTTHEAD( VERSION, DATESTR, TIMESTR );
  IF LIST
  THEN
   BEGIN
    NEWPAGE;   WRITELN;
    IF ONSWITCH['C'] OR PRCODE THEN
     BEGIN  WRITELN('INSTRUCTIONCOUNT');   WRITELN('-LOCATIONCOUNT');
      WRITE('-000002    ');   LINECNT := 3;
     END;
    WRITE ( LINENO:5, ' ':3 );
   END;

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

  PROGRAMHEADING ;
  ENTERSTANDARD ;
  WITH DISPLAY[1] DO
   BEGIN
    FNAME := NIL;   OCCUR := BLCK
   END;
  TOP := 1;   LEVEL := 1;
  CIXX := CIX;
  BLOCK(BLOCKBEGSYS OR STATBEGSYS - [CASESY],PERIOD,NIL);

  SRCLEVEL := -1;   ENDOFLINE;   WRITELN;


  RTIME := RUNTIME - RTIME;
  IF LIST THEN WRITESTAT;
  WTTSTAT( ERRDETECTED, 2*CIXX+2, DATASIZE, -LC, RTIME );
 END   (*$Y+*)   (* HEAP IN SEPARATE MODULE *) .




