PROCEDURE ERROR(*ERRORNUM: INTEGER*);
  VAR CH: CHAR;
BEGIN
  WITH USERINFO DO
    IF (ERRSYM <> SYMCURSOR) OR (ERRBLK <> SYMBLK) THEN
      BEGIN
	ERRSYM := SYMCURSOR; ERRBLK := SYMBLK;
	ERRNUM := ERRORNUM;
	IF STUPID THEN EXIT(COMPILER);
	WRITELN(OUTPUT); CH := ' ';
	WRITE(OUTPUT,SYMBUFP^:SYMCURSOR);
	WRITELN(OUTPUT,' <<<< Error # ',ERRORNUM:0);
	WRITE(OUTPUT,'Hit <SPACE> to continue');
	REPEAT UNITREAD(2,CH,1);
	UNTIL (CH = ' ') OR (CH = CHR(27));
	IF (ERRORNUM > 400) OR (CH = CHR(27)) THEN EXIT(COMPILER);
	WRITELN(OUTPUT);
	WRITE(OUTPUT,'<',SCREENDOTS:4,'>')
      END
END (*ERROR*) ;

PROCEDURE GETNEXTPAGE;
BEGIN SYMCURSOR := 0;
  IF INCLUDING THEN
    IF BLOCKREAD(INCLFILE,SYMBUFP^,2,SYMBLK) = 0 THEN
      BEGIN CLOSE(INCLFILE); INCLUDING := FALSE;
	SYMBLK := OLDSYMBLK; SYMCURSOR := OLDSYMCURSOR;
	LINESTART := SYMCURSOR   (*AT CR...WILL PRINT EXTRA LINE*)
      END;
  IF NOT INCLUDING THEN
    IF BLOCKREAD(USERINFO.WORKSYM^,SYMBUFP^,2,SYMBLK) <> 2 THEN
      ERROR(401);
  SYMBLK := SYMBLK+2
END (*GETNEXTPAGE*) ;

PROCEDURE PRINTLINE;
  VAR LPUNIT: INTEGER;
      A: PACKED ARRAY [0..1] OF CHAR;

  PROCEDURE WRITEINT(IVAL: INTEGER);
    VAR I,IPOT: INTEGER; CH: CHAR; ZAP: BOOLEAN;
	A: PACKED ARRAY [0..5] OF CHAR;
  BEGIN ZAP := TRUE; IPOT := 10000; A[0] := ' ';
    FOR I := 1 TO 5 DO
      BEGIN
	CH := CHR(IVAL DIV IPOT + ORD('0'));
	IF I <> 5 THEN
	  IF ZAP THEN
	    IF CH = '0' THEN CH := ' '
	    ELSE ZAP := FALSE;
	A[I] := CH;
	IVAL := IVAL MOD IPOT;
	IPOT := IPOT DIV 10
      END;
    UNITWRITE(LPUNIT,A,6)
  END (*WRITEINT*) ;

BEGIN LPUNIT := 6; (*PRINTLINE*)
  WRITEINT(SCREENDOTS); WRITEINT(CURPROC);
  A[0] := ':';
  IF DP THEN A[1] := 'D' ELSE A[1] := 'C';
  UNITWRITE(LPUNIT,A,2); WRITEINT(LINEINFO);
  A := '  '; UNITWRITE(LPUNIT,A,2); UNITWRITE(LPUNIT,A,2);
  UNITWRITE(LPUNIT,SYMBUFP^[LINESTART],SYMCURSOR-LINESTART,,TRUE)
END (*PRINTLINE*) ;

PROCEDURE STARTINCL;
(*I APOLOGIZE FOR SUCH KLOODGE AS THIS BUT IT HAS TO
  BE IN RIGHT NOW...*)
VAR TSTART,TLENG: INTEGER; TITLE: STRING[40];
BEGIN
  TSTART := SYMCURSOR+2;
  SYMCURSOR := SCAN(80,=CHR(EOL),SYMBUFP^[TSTART])+TSTART+1;
  TLENG := SYMCURSOR-TSTART-3;
  TITLE[0] := CHR(TLENG);
  MOVELEFT(SYMBUFP^[TSTART],TITLE[1],TLENG);
  OPENOLD(INCLFILE,TITLE);
  IF IORESULT <> 0 THEN
    BEGIN
      OPENOLD(INCLFILE,CONCAT(TITLE,'.TEXT'));
      IF IORESULT <> 0 THEN ERROR(403)
    END;
  SCREENDOTS := SCREENDOTS+1;
  IF LIST THEN PRINTLINE;
  INCLUDING := TRUE;
  OLDSYMCURSOR := SYMCURSOR-1; (*POINT AT CR...PREVENT END PAGE BLOWUP*)
  OLDSYMBLK := SYMBLK-2; (*SYMBLK IS NEXT TO READ...SAVE CUR PAGE#*)
  SYMBLK := 2; GETNEXTPAGE; LINESTART := SYMCURSOR;
  INSYMBOL; EXIT(INSYMBOL)  (*WEIRD, ISNT IT...*)
END (*STARTINCL*) ;

PROCEDURE INSYMBOL; (* COMPILER VERSION 3.4 06-NOV-76 *)
  LABEL 1;
  VAR LVP: CSP; X: INTEGER;

PROCEDURE CHECKEND;
BEGIN (* CHECKS FOR THE END OF THE PAGE *)
  WRITE(OUTPUT,'.');
  SCREENDOTS := SCREENDOTS+1;
  SYMCURSOR := SYMCURSOR + 1;
  IF (SCREENDOTS-STARTDOTS) MOD 50 = 0 THEN
    BEGIN WRITELN(OUTPUT);
      WRITE(OUTPUT,'<',SCREENDOTS:4,'>')
    END;
  IF LIST THEN PRINTLINE;
  IF SYMBUFP^[SYMCURSOR]=CHR(0) THEN GETNEXTPAGE;
  LINESTART := SYMCURSOR;
  IF SYMBUFP^[SYMCURSOR] = CHR(16) (*DLE*) THEN
    SYMCURSOR := SYMCURSOR+2
  ELSE
    BEGIN
      SYMCURSOR := SYMCURSOR+SCAN(80,<>CHR(9),SYMBUFP^[SYMCURSOR]);
      SYMCURSOR := SYMCURSOR+SCAN(80,<>' ',SYMBUFP^[SYMCURSOR])
    END;
  IF DP THEN LINEINFO := LC ELSE LINEINFO := IC
END;

PROCEDURE COMMENTER;
  VAR CH,SW,DEL: CHAR;
BEGIN
  SYMCURSOR := SYMCURSOR+2; (* POINT TO THE FIRST CH PAST "(*" *)
  IF SYMBUFP^[SYMCURSOR]='$'
    THEN
      BEGIN
	IF SYMBUFP^[SYMCURSOR+1] <> '*' THEN
	REPEAT
	  CH := SYMBUFP^[SYMCURSOR+1];
	  SW := SYMBUFP^[SYMCURSOR+2];
	  DEL := SYMBUFP^[SYMCURSOR+3];
	  CASE CH OF
	  'G': GOTOOK := (SW='+');
	  'I': IF (SW='+') OR (SW='-') THEN IOCHECK := (SW='+')
	       ELSE STARTINCL;
	  'L': LIST := (SW='+');
	  'R': RANGECHECK := (SW='+');
	  'U': BEGIN SYSCOMP := (SW = '-');
		 RANGECHECK := NOT SYSCOMP;
		 IOCHECK := RANGECHECK;
		 GOTOOK := SYSCOMP
	       END
	  END (*CASES*);
	  SYMCURSOR := SYMCURSOR+3;
	UNTIL DEL <> ',';
      END;
  SYMCURSOR := SYMCURSOR-1; (* ADJUST *)
  REPEAT
    REPEAT
      SYMCURSOR := SYMCURSOR+1;
      WHILE SYMBUFP^[SYMCURSOR] = CHR(EOL) DO CHECKEND
    UNTIL SYMBUFP^[SYMCURSOR]='*';
  UNTIL SYMBUFP^[SYMCURSOR+1]=')';
  SYMCURSOR := SYMCURSOR+2;
END (*COMMENTER*);

PROCEDURE STRING;
VAR
  T: PACKED ARRAY [1..80] OF CHAR;
  TP,NBLANKS,L: INTEGER;
  DUPLE: BOOLEAN;

BEGIN
  DUPLE := FALSE; (* INDICATES WHEN '' IS PRESENT *)
  TP := 0; (* INDEX INTO TEMPORARY STRING *)
  REPEAT
    IF DUPLE THEN SYMCURSOR := SYMCURSOR+1;
    REPEAT
      SYMCURSOR := SYMCURSOR+1;
      TP := TP+1;
      IF SYMBUFP^[SYMCURSOR] = CHR(EOL) THEN
	BEGIN ERROR(202); CHECKEND END;
      T[TP] := SYMBUFP^[SYMCURSOR];
    UNTIL SYMBUFP^[SYMCURSOR]='''';
    DUPLE := TRUE;
  UNTIL SYMBUFP^[SYMCURSOR+1]<>'''';
  TP := TP-1; (* ADJUST *)
  SY := STRINGCONST; OP := NOOP;
  LGTH := TP; (* GROSS *)
  IF TP=1 (* SINGLE CHARACTER CONSTANT *)
    THEN
      VAL.IVAL := ORD(T[1])
    ELSE
      WITH SCONST@ DO
	BEGIN
	  CCLASS := STRG;
	  SLGTH := TP;
	  MOVELEFT(T[1],SVAL[1],TP);
	  VAL.VALP := SCONST
	END
END(*STRING*);

PROCEDURE NUMBER;
VAR
  EXPONENT,ENDI,ENDF,ENDE,SIGN,IPART,FPART,EPART,
  ISUM:  INTEGER;
  TIPE: (REALTIPE,INTEGERTIPE);
  RSUM: REAL;
  J: INTEGER;
BEGIN
  (* TAKES A NUMBER AND DECIDES WHETHER IT'S REAL
     OR INTEGER AND CONVERTS IT TO THE INTERNAL
     FORM. *)
  TIPE := INTEGERTIPE;
  ENDI := 0;
  ENDF := 0;
  ENDE := 0;
  SIGN := 1;
  EPART := 9999; (* OUT OF REACH *)
  IPART := SYMCURSOR; (* INTEGER PART STARTS HERE *)
  REPEAT
    SYMCURSOR := SYMCURSOR+1
  UNTIL (SYMBUFP^[SYMCURSOR]<'0') OR (SYMBUFP^[SYMCURSOR]>'9');
  (* SYMCURSOR NOW POINTS AT FIRST CHARACTER PAST INTEGER PART *)
  ENDI := SYMCURSOR-1; (* MARK THE END OF IPART *)
  IF SYMBUFP^[SYMCURSOR]='.'
    THEN
      IF SYMBUFP^[SYMCURSOR+1]<>'.'  (* WATCH OUT FOR '..' *)
	THEN
	  BEGIN
	    TIPE := REALTIPE;
	    SYMCURSOR := SYMCURSOR+1;
	    FPART := SYMCURSOR; (* BEGINNING OF FPART *)
	    REPEAT
	      SYMCURSOR := SYMCURSOR+1
	    UNTIL (SYMBUFP^[SYMCURSOR]<'0') OR (SYMBUFP^[SYMCURSOR]>'9');
	    ENDF := SYMCURSOR-1;
	  END;
  IF SYMBUFP^[SYMCURSOR]='E'
    THEN
      BEGIN
	TIPE := REALTIPE;
	SYMCURSOR := SYMCURSOR+1;
	IF SYMBUFP^[SYMCURSOR]='-'
	  THEN
	    BEGIN
	      SYMCURSOR := SYMCURSOR+1;
	      SIGN := -1;
	    END
	  ELSE
	    IF SYMBUFP^[SYMCURSOR]='+'
	      THEN
		SYMCURSOR := SYMCURSOR+1;
	EPART := SYMCURSOR; (* BEGINNING OF EXPONENT *)
	WHILE (SYMBUFP^[SYMCURSOR]>='0') AND (SYMBUFP^[SYMCURSOR]<='9') DO
	  SYMCURSOR := SYMCURSOR+1;
  	ENDE := SYMCURSOR-1;
	IF ENDE<EPART THEN ERROR(201); (* ERROR IN REAL CONSTANT *)
      END;
  (* NOW CONVERT TO INTERNAL FORM *)
  IF TIPE=INTEGERTIPE
    THEN
      BEGIN
	ISUM := 0;
	FOR J := IPART TO ENDI DO
	  BEGIN
	    IF (ISUM>3276) OR ((ISUM=3276) AND (SYMBUFP^[J]>'7')) THEN
		BEGIN ERROR(203); J := ENDI END
	    ELSE ISUM := ISUM*10+ORD(SYMBUFP^[J])-ORD('0');
	  END;
	  SY := INTCONST;  OP := NOOP;
	  VAL.IVAL := ISUM;
	END
      ELSE
       BEGIN (* REAL NUMBER HERE *)
	 RSUM := 0;
	 FOR J := IPART TO ENDI DO
	   BEGIN
	     RSUM := RSUM*10+(ORD(SYMBUFP^[J])-ORD('0'));
	   END;
	 FOR J := ENDF DOWNTO FPART DO
	   RSUM := RSUM+(ORD(SYMBUFP^[J])-ORD('0'))/PWROFTEN(J-FPART+1);
	 EXPONENT := 0;
	 FOR J := EPART TO ENDE DO
	   EXPONENT := EXPONENT*10+ORD(SYMBUFP^[J])-ORD('0');
	 IF SIGN=-1
	   THEN
	     RSUM := RSUM/PWROFTEN(EXPONENT)
	   ELSE
	     RSUM := RSUM*PWROFTEN(EXPONENT);
	 SY := REALCONST;  OP := NOOP;
	 NEW(LVP,REEL);
	 LVP^.CCLASS := REEL;
	 LVP^.RVAL := RSUM;
	 VAL.VALP := LVP;
       END;
  SYMCURSOR := SYMCURSOR-1; (* ADJUST FOR POSTERITY *)
END;

BEGIN (* INSYMBOL *)
  OP := NOOP;
1:  SY := OTHERSY; (* IF NO CASES EXERCISED BLOW UP *)
  CASE SYMBUFP^[SYMCURSOR] OF
  '''':STRING;
  '0','1','2','3','4','5','6','7','8','9':
       NUMBER;
  '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':
       IDSEARCH(SYMCURSOR,SYMBUFP^); (* MAGIC PROC *)
  '(': BEGIN
	 IF SYMBUFP^[SYMCURSOR+1]='*'
	   THEN
	     BEGIN
	       COMMENTER;
	       GOTO 1; (* GET ANOTHER TOKEN *)
	     END
	   ELSE
	     SY := LPARENT;
       END;
  ')': SY := RPARENT;
  ',': SY := COMMA;
  ' ','	': BEGIN SYMCURSOR := SYMCURSOR+1; GOTO 1; END;
  '.': BEGIN
	 IF SYMBUFP^[SYMCURSOR+1]='.'
	   THEN
	     BEGIN
	       SYMCURSOR := SYMCURSOR+1;
	       SY := COLON
	     END
	   ELSE
	     SY := PERIOD;
       END;
  ':': IF SYMBUFP^[SYMCURSOR+1]='='
	 THEN
	   BEGIN
	     SYMCURSOR := SYMCURSOR+1;
	     SY := BECOMES;
	  END
	ELSE
	   SY := COLON;
  ';': SY := SEMICOLON;
  '@','^':
       SY := ARROW;
  '[': SY := LBRACK;
  ']': SY := RBRACK;
  '*': BEGIN SY := MULOP; OP := MUL END;
  '+': BEGIN SY := ADDOP; OP := PLUS END;
  '-': BEGIN SY := ADDOP; OP := MINUS END;
  '/': BEGIN SY := MULOP; OP := RDIV END;
  '<': BEGIN
	 SY := RELOP;
	 OP := LTOP;
	 CASE SYMBUFP^[SYMCURSOR+1] OF
	   '>': BEGIN
		  OP := NEOP;
		  SYMCURSOR := SYMCURSOR+1
		END;
	   '=': BEGIN
		  OP := LEOP;
		  SYMCURSOR := SYMCURSOR+1
		END
	 END;
       END;
  '=': BEGIN SY := RELOP; OP := EQOP END;
  '>': BEGIN
	 SY := RELOP;
	 IF SYMBUFP^[SYMCURSOR+1]='='
	   THEN
	     BEGIN
	       OP := GEOP;
	       SYMCURSOR := SYMCURSOR+1;
	     END
	   ELSE
	     OP := GTOP;
       END
END (* CASE SYMBUFP^[SYMCURSOR] OF *);
  IF SY=OTHERSY THEN
    IF SYMBUFP^[SYMCURSOR] = CHR(EOL) THEN
      BEGIN CHECKEND; GOTO 1 END
    ELSE ERROR(400);
  SYMCURSOR := SYMCURSOR+1; (* NEXT CALL TALKS ABOUT NEXT TOKEN *)
END (*INSYMBOL*) ;

  PROCEDURE ENTERID(*FCP: CTP*);
    VAR LCP,LCP1: CTP; I: INTEGER;
  BEGIN LCP := DISPLAY[TOP].FNAME;
    IF LCP = NIL THEN DISPLAY[TOP].FNAME := FCP
    ELSE
      BEGIN I := TREESEARCH(LCP,LCP1,FCP^.NAME);
	WHILE I = 0 DO
	  BEGIN ERROR(101);
	    IF LCP1^.RLINK = NIL THEN I := 1
	    ELSE I := TREESEARCH(LCP1^.RLINK,LCP1,FCP^.NAME)
	  END;
	IF I = 1 THEN LCP1^.RLINK := FCP ELSE LCP1^.LLINK := FCP
      END;
    FCP^.LLINK := NIL; FCP^.RLINK := NIL
  END (*ENTERID*) ;

  PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP);
  BEGIN
    IF FCP <> NIL THEN
      IF TREESEARCH(FCP,FCP1,ID) = 0 THEN (*NADA*)
      ELSE FCP1 := NIL
    ELSE FCP1 := NIL
  END (*SEARCHSECTION*) ;

  PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP);
    LABEL 1; VAR LCP: CTP;
  BEGIN
    FOR DISX := TOP DOWNTO 0 DO
      BEGIN LCP := DISPLAY[DISX].FNAME;
	IF LCP <> NIL THEN
	  IF TREESEARCH(LCP,LCP,ID) = 0 THEN
	    IF LCP^.KLASS IN FIDCLS THEN GOTO 1
	    ELSE
	      IF PRTERR THEN ERROR(103)
	      ELSE LCP := NIL
	  ELSE LCP := NIL
      END;
    IF PRTERR THEN
      BEGIN ERROR(104);
	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);
  BEGIN
    WITH FSP^ DO
      IF FORM = SUBRANGE THEN
	BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END
      ELSE
	BEGIN FMIN := 0;
	  IF FSP = CHARPTR THEN FMAX := 255
	  ELSE
	    IF FSP^.FCONST <> NIL THEN
	      FMAX := FSP^.FCONST^.VALUES.IVAL
	    ELSE FMAX := 0
	END
  END (*GETBOUNDS*) ;

  PROCEDURE SKIP(FSYS: SETOFSYS);
  BEGIN WHILE NOT(SY IN FSYS) DO INSYMBOL
  END (*SKIP*) ;

  FUNCTION PAOFCHAR(FSP: STP): BOOLEAN;
  BEGIN PAOFCHAR := FALSE;
    IF FSP <> NIL THEN
      IF FSP^.FORM = ARRAYS THEN
	PAOFCHAR := FSP^.AISPACKD AND (FSP^.AELTYPE = CHARPTR)
  END (*PAOFCHAR*) ;

  FUNCTION STRGTYPE(FSP: STP) : BOOLEAN;
  BEGIN STRGTYPE := FALSE;
    IF PAOFCHAR(FSP) THEN STRGTYPE := FSP^.AISSTRNG
  END (*STRGTYPE*) ;

  PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU);
    VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG);
	LVP: CSP;
  BEGIN LSP := NIL; FVALU.IVAL := 0;
    IF NOT(SY IN CONSTBEGSYS) THEN
      BEGIN ERROR(50); SKIP(FSYS+CONSTBEGSYS) END;
    IF SY IN CONSTBEGSYS THEN
      BEGIN
	IF SY = STRINGCONSTSY THEN
	  BEGIN
	    IF LGTH = 1 THEN LSP := CHARPTR
	    ELSE
	      BEGIN
		NEW(LSP,ARRAYS,TRUE,TRUE);
		LSP^ := STRGPTR^;
		LSP^.MAXLENG := LGTH;
		LSP^.INXTYPE := NIL;
		NEW(LVP);
		LVP^ := VAL.VALP^;
		VAL.VALP := LVP
	      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
			  BEGIN NEW(LVP,REEL);
			    LVP^.CCLASS := REEL;
			    LVP^.RVAL := -FVALU.VALP^.RVAL;
			    FVALU.VALP := LVP;
			  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
			  VAL.VALP^.RVAL := -VAL.VALP^.RVAL;
		    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;
    VAR NXT1,NXT2: CTP; COMP: BOOLEAN;
      LTESTP1,LTESTP2 : TESTP;
  BEGIN
    IF FSP1 = FSP2 THEN COMPTYPES := TRUE
    ELSE
      IF (FSP1 = NIL) OR (FSP2 = NIL) THEN COMPTYPES := TRUE
      ELSE
	IF FSP1^.FORM = FSP2^.FORM THEN
	  CASE FSP1^.FORM OF
	    SCALAR:
	      COMPTYPES := FALSE;
	    SUBRANGE:
	      COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,
				       FSP2^.RANGETYPE);
	    POINTER:
		BEGIN
		  COMP := FALSE; LTESTP1 := GLOBTESTP;
		  LTESTP2 := GLOBTESTP;
		  WHILE LTESTP1 <> NIL DO
		    WITH LTESTP1^ DO
		      BEGIN
			IF (ELT1 = FSP1^.ELTYPE) AND
			  (ELT2 = FSP2^.ELTYPE) THEN COMP := TRUE;
			LTESTP1 := LASTTESTP
		      END;
		  IF NOT COMP THEN
		    BEGIN NEW(LTESTP1);
		      WITH LTESTP1^ DO
			BEGIN ELT1 := FSP1^.ELTYPE;
			  ELT2 := FSP2^.ELTYPE;
			  LASTTESTP := GLOBTESTP
			END;
		      GLOBTESTP := LTESTP1;
		      COMP := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE)
		    END;
		  COMPTYPES := COMP; GLOBTESTP := LTESTP2
		END;
	    POWER:
	      COMPTYPES := COMPTYPES(FSP1^.ELSET,FSP2^.ELSET);
	    ARRAYS:
	      BEGIN
		COMP := COMPTYPES(FSP1^.AELTYPE,FSP2^.AELTYPE)
			AND (FSP1^.AISPACKD = FSP2^.AISPACKD);
		IF COMP AND FSP1^.AISPACKD THEN
		    COMP := (FSP1^.ELSPERWD = FSP2^.ELSPERWD)
			    AND (FSP1^.ELWIDTH = FSP2^.ELWIDTH)
			    AND (FSP1^.AISSTRNG = FSP2^.AISSTRNG);
		IF COMP AND NOT STRGTYPE(FSP1) THEN
		  COMP := (FSP1^.SIZE = FSP2^.SIZE);
		COMPTYPES := COMP;
	      END;
	    RECORDS:
	      BEGIN NXT1 := FSP1^.FSTFLD; NXT2 := FSP2^.FSTFLD;
		COMP := TRUE;
		WHILE (NXT1 <> NIL) AND (NXT2 <> NIL) AND COMP DO
		  BEGIN COMP:=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;
	    FILES:
	      COMPTYPES := COMPTYPES(FSP1^.FILTYPE,FSP2^.FILTYPE)
	  END (*CASE*)
	ELSE (*FSP1^.FORM <> FSP2^.FORM*)
	  IF FSP1^.FORM = SUBRANGE THEN
	    COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2)
	  ELSE
	    IF FSP2^.FORM = SUBRANGE THEN
	      COMPTYPES := COMPTYPES(FSP1,FSP2^.RANGETYPE)
	    ELSE COMPTYPES := FALSE
  END (*COMPTYPES*) ;