PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: STP; VAR FSIZE: ADDRRANGE);
    VAR LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP;
	LSIZE,DISPL: ADDRRANGE; LMIN,LMAX: INTEGER;
	PACKING: BOOLEAN; NEXTBIT,NUMBITS: BITRANGE;

    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 := 1;
      IF NOT (SY IN SIMPTYPEBEGSYS) THEN
	BEGIN ERROR(1); SKIP(FSYS + SIMPTYPEBEGSYS) END;
      IF SY IN SIMPTYPEBEGSYS THEN
	BEGIN
	  IF SY = LPARENT THEN
	    BEGIN TTOP := TOP;
	      WHILE DISPLAY[TOP].OCCUR <> BLCK DO TOP := TOP - 1;
	      NEW(LSP,SCALAR,DECLARED);
	      WITH LSP^ DO
		BEGIN SIZE := INTSIZE; FORM := SCALAR;
		  SCALKIND := DECLARED
		END;
	      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; KLASS := KONST
		      END;
		    ENTERID(LCP);
		    LCNT := LCNT + 1;
		    LCP1 := LCP; INSYMBOL
		  END
		ELSE ERROR(2);
		IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN
		  BEGIN ERROR(6); SKIP(FSYS + [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; FORM := SUBRANGE;
			  IF STRGTYPE(RANGETYPE) THEN
			    BEGIN ERROR(148); RANGETYPE := NIL END;
			  MIN := VALUES; SIZE := INTSIZE
			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
		    BEGIN LSP := LCP^.IDTYPE;
		      IF (LSP = STRGPTR) AND (SY = LBRACK) THEN
			BEGIN INSYMBOL;
			  CONSTANT(FSYS + [RBRACK],LSP1,LVALU);
			  IF LSP1 = INTPTR THEN
			    BEGIN
			      IF (LVALU.IVAL <= 0) OR
				 (LVALU.IVAL > STRGLGTH) THEN
				BEGIN ERROR(203);
				  LVALU.IVAL := DEFSTRGLGTH
				END;
			      IF LVALU.IVAL <> DEFSTRGLGTH THEN
				BEGIN NEW(LSP,ARRAYS,TRUE,TRUE);
				  LSP^ := STRGPTR^;
				  WITH LSP^,LVALU DO
				    BEGIN MAXLENG := IVAL;
				      SIZE := (IVAL+CHRSPERWD) DIV CHRSPERWD
				    END
				END
			    END
			  ELSE ERROR(15);
			  IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)
			END;
		      IF LSP <> NIL THEN FSIZE := LSP^.SIZE
		    END
		END (*SY = IDENT*)
	      ELSE
		BEGIN NEW(LSP,SUBRANGE); LSP^.FORM := SUBRANGE;
		  CONSTANT(FSYS + [COLON],LSP1,LVALU);
		  IF STRGTYPE(LSP1) THEN
		    BEGIN ERROR(148); LSP1 := NIL END;
		  WITH LSP^ DO
		    BEGIN RANGETYPE:=LSP1; MIN:=LVALU; SIZE:=INTSIZE END;
		  IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
		  CONSTANT(FSYS,LSP1,LVALU);
		  LSP^.MAX := LVALU;
		  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 ERROR(399)
		      ELSE
			IF MIN.IVAL > MAX.IVAL THEN
			  BEGIN ERROR(102); MAX.IVAL := MIN.IVAL END
	    END;
	  FSP := LSP;
	  IF NOT (SY IN FSYS) THEN
	    BEGIN ERROR(6); SKIP(FSYS) END
	END
	  ELSE FSP := NIL
    END (*SIMPLETYPE*) ;

    FUNCTION PACKABLE(FSP: STP): BOOLEAN;
      VAR LMIN,LMAX: INTEGER;
    BEGIN PACKABLE := FALSE;
      IF (FSP <> NIL) AND PACKING THEN
	WITH FSP^ DO
	  CASE FORM OF
	    SUBRANGE,
	    SCALAR:  IF (FSP <> INTPTR) AND (FSP <> REALPTR) THEN
		       BEGIN GETBOUNDS(FSP,LMIN,LMAX);
			 IF LMIN >= 0 THEN
			   BEGIN PACKABLE := TRUE;
			     NUMBITS := 1; LMIN := 1;
			     WHILE LMIN < LMAX DO
			       BEGIN LMIN := LMIN + 1;
				 LMIN := LMIN + LMIN - 1;
				 NUMBITS := NUMBITS + 1
			       END
			   END
		       END;
	    POWER:   IF PACKABLE(ELSET) THEN
		       BEGIN GETBOUNDS(ELSET,LMIN,LMAX);
			 LMAX := LMAX + 1;
			 IF LMAX < BITSPERWD THEN
			   BEGIN PACKABLE := TRUE;
			     NUMBITS := LMAX
			   END
		       END
	  END (* CASES *);
    END (*PACKABLE*) ;

    PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FRECVAR: STP);
      VAR LCP,LCP1,NXT,NXT1,LAST: CTP; LSP,LSP1,LSP2,LSP3,LSP4: STP;
	  MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU;
	  MAXBIT,MINBIT: BITRANGE;

      PROCEDURE ALLOCATE(FCP: CTP);
	VAR ONBOUND: BOOLEAN;
      BEGIN ONBOUND := FALSE;
	WITH FCP^ DO
	  IF PACKABLE(IDTYPE) THEN
	    BEGIN
	      IF (NUMBITS + NEXTBIT) > BITSPERWD THEN
		BEGIN DISPL := DISPL + 1; NEXTBIT := 0; ONBOUND := TRUE END;
	      FLDADDR := DISPL; FISPACKD := TRUE;
	      FLDWIDTH := NUMBITS; FLDRBIT := NEXTBIT;
	      NEXTBIT := NEXTBIT + NUMBITS
	    END
	  ELSE
	    BEGIN DISPL := DISPL + ORD(NEXTBIT > 0);
	      NEXTBIT := 0; ONBOUND := TRUE;
	      FISPACKD := FALSE; FLDADDR := DISPL;
	      IF IDTYPE <> NIL THEN
		DISPL := DISPL + IDTYPE^.SIZE
	    END;
	IF ONBOUND AND (LAST <> NIL) THEN
	  WITH LAST^ DO
	    IF FISPACKD THEN
	      IF FLDRBIT = 0 THEN FISPACKD := FALSE
	      ELSE
		IF (FLDWIDTH <= 8) AND (FLDRBIT <= 8) THEN
		  BEGIN FLDWIDTH := 8; FLDRBIT := 8 END
      END (*ALLOCATE*) ;

      PROCEDURE VARIANTLIST;
	VAR GOTTAGNAME: BOOLEAN;
      BEGIN NEW(LSP,TAGFLD);
	WITH LSP^ DO
	  BEGIN TAGFIELDP := NIL; FSTVAR := NIL; FORM := TAGFLD END;
	FRECVAR := LSP;
	INSYMBOL;
	IF SY = IDENT THEN
	  BEGIN
	    IF PACKING THEN NEW(LCP,FIELD,TRUE)
	    ELSE NEW(LCP,FIELD,FALSE);
	    WITH LCP^ DO
	      BEGIN IDTYPE := NIL; KLASS:=FIELD;
		NEXT := NIL; FISPACKD := FALSE
	      END;
	    GOTTAGNAME := FALSE; PRTERR := FALSE;
	    SEARCHID([TYPES],LCP1); PRTERR := TRUE;
	    IF LCP1 = NIL THEN
	      BEGIN GOTTAGNAME := TRUE;
		LCP^.NAME := ID; ENTERID(LCP); INSYMBOL;
		IF SY = COLON THEN INSYMBOL ELSE ERROR(5)
	      END;
	    IF SY = IDENT THEN
	      BEGIN SEARCHID([TYPES],LCP1);
		LSP1 := LCP1^.IDTYPE;
		IF LSP1 <> NIL THEN
		  BEGIN
		    IF LSP1^.FORM <= SUBRANGE THEN
		      BEGIN
			IF COMPTYPES(REALPTR,LSP1) THEN ERROR(109);
			LCP^.IDTYPE := LSP1; LSP^.TAGFIELDP := LCP;
			IF GOTTAGNAME THEN ALLOCATE(LCP)
		      END
		    ELSE ERROR(110)
		  END;
		INSYMBOL
	      END
	    ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END
	  END
	ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END;
	LSP^.SIZE := DISPL + ORD(NEXTBIT > 0);
	IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
	LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL;
	MINBIT := NEXTBIT; MAXBIT := NEXTBIT;
	REPEAT LSP2 := NIL;
	  REPEAT CONSTANT(FSYS + [COMMA,COLON,LPARENT],LSP3,LVALU);
	    IF LSP^.TAGFIELDP <> NIL THEN
	      IF NOT COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP3) THEN
		ERROR(111);
	    NEW(LSP3,VARIANT);
	    WITH LSP3^ DO
	      BEGIN NXTVAR := LSP1; SUBVAR := LSP2;
		VARVAL := LVALU; FORM := VARIANT
	      END;
	    LSP1 := LSP3; LSP2 := LSP3;
	    TEST := SY <> COMMA;
	    IF NOT TEST THEN INSYMBOL
	  UNTIL TEST;
	  IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
	  IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);
	  IF SY = RPARENT THEN LSP2 := NIL
	  ELSE
	    FIELDLIST(FSYS + [RPARENT,SEMICOLON],LSP2);
	  IF DISPL > MAXSIZE THEN
	    BEGIN MAXSIZE := DISPL; MAXBIT := NEXTBIT END
	  ELSE
	    IF (DISPL = MAXSIZE) AND (NEXTBIT > MAXBIT) THEN
	      MAXBIT := NEXTBIT;
	  WHILE LSP3 <> NIL DO
	    BEGIN LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2;
	      LSP3^.SIZE := DISPL + ORD(NEXTBIT > 0);
	      LSP3 := LSP4
	    END;
	  IF SY = RPARENT THEN
	    BEGIN INSYMBOL;
	      IF NOT (SY IN FSYS + [SEMICOLON]) THEN
		BEGIN ERROR(6); SKIP(FSYS + [SEMICOLON]) END
	    END
	  ELSE ERROR(4);
	  TEST := SY <> SEMICOLON;
	  IF NOT TEST THEN
	    BEGIN INSYMBOL;
	      DISPL := MINSIZE; NEXTBIT := MINBIT
	    END
	UNTIL TEST;
	DISPL := MAXSIZE; NEXTBIT := MAXBIT;
	LSP^.FSTVAR := LSP1
      END (*VARIANTLIST*) ;

    BEGIN (*FIELDLIST*)
      NXT1 := NIL; LSP := NIL; LAST := NIL;
      IF NOT (SY IN [IDENT,CASESY]) THEN
	BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END;
      WHILE SY = IDENT DO
	BEGIN NXT := NXT1;
	  REPEAT
	    IF SY = IDENT THEN
	      BEGIN
		IF PACKING THEN NEW(LCP,FIELD,TRUE)
		ELSE NEW(LCP,FIELD,FALSE);
		WITH LCP^ DO
		  BEGIN NAME := ID; IDTYPE := NIL; NEXT := NXT;
		    KLASS := FIELD; FISPACKD := FALSE
		  END;
		NXT := LCP;
		ENTERID(LCP);
		INSYMBOL
	      END
	    ELSE ERROR(2);
	    IF NOT (SY IN [COMMA,COLON]) THEN
	      BEGIN ERROR(6); SKIP(FSYS + [COMMA,COLON,SEMICOLON,CASESY]) END;
	    TEST := SY <> COMMA;
	    IF NOT TEST  THEN INSYMBOL
	  UNTIL TEST;
	  IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
	  TYP(FSYS + [CASESY,SEMICOLON],LSP,LSIZE);
	  IF LSP <> NIL THEN
	    IF LSP^.FORM = FILES THEN ERROR(108);
	  WHILE NXT <> NXT1 DO
	    WITH NXT^ DO
	      BEGIN IDTYPE := LSP; ALLOCATE(NXT);
		IF NEXT = NXT1 THEN LAST := NXT;
		NXT := NEXT
	      END;
	  NXT1 := LCP;
	  IF SY = SEMICOLON THEN
	    BEGIN INSYMBOL;
	      IF NOT (SY IN [IDENT,CASESY]) THEN
		BEGIN ERROR(19); SKIP(FSYS + [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 VARIANTLIST
      ELSE FRECVAR := NIL
    END (*FIELDLIST*) ;

    PROCEDURE POINTERTYPE;
    BEGIN NEW(LSP,POINTER); FSP := LSP;
      WITH LSP^ DO
	BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM := POINTER END;
      INSYMBOL;
      IF SY = IDENT THEN
	BEGIN PRTERR := FALSE;
	  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; KLASS := TYPES
		END;
	      FWPTR := LCP
	    END
	  ELSE
	    BEGIN
	      IF LCP^.IDTYPE <> NIL THEN
		IF (LCP^.IDTYPE^.FORM <> FILES) OR SYSCOMP THEN
		  LSP^.ELTYPE := LCP^.IDTYPE
		ELSE ERROR(108)
	    END;
	  INSYMBOL;
	END
      ELSE ERROR(2)
    END (*POINTERTYPE*) ;

  BEGIN (*TYP*)
    PACKING := FALSE;
    IF NOT (SY IN TYPEBEGSYS) THEN
       BEGIN ERROR(10); SKIP(FSYS + TYPEBEGSYS) END;
    IF SY IN TYPEBEGSYS THEN
      BEGIN
	IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,FSP,FSIZE)
	ELSE
  (*^*)   IF SY = ARROW THEN POINTERTYPE
	  ELSE
	    BEGIN
	      IF SY = PACKEDSY THEN
		BEGIN INSYMBOL; PACKING := TRUE;
		  IF NOT (SY IN TYPEDELS) THEN
		    BEGIN ERROR(10); SKIP(FSYS + TYPEDELS) END
		END;
  (*ARRAY*)   IF SY = ARRAYSY THEN
		BEGIN INSYMBOL;
		  IF SY = LBRACK THEN INSYMBOL ELSE ERROR(11);
		  LSP1 := NIL;
		  REPEAT
		    IF PACKING THEN NEW(LSP,ARRAYS,TRUE,FALSE)
		    ELSE NEW(LSP,ARRAYS,FALSE);
		    WITH LSP^ DO
		      BEGIN AELTYPE := LSP1; INXTYPE := NIL;
			IF PACKING THEN AISSTRNG := FALSE;
			AISPACKD := FALSE;  FORM := ARRAYS
		      END;
		    LSP1 := LSP;
		    SIMPLETYPE(FSYS + [COMMA,RBRACK,OFSY],LSP2,LSIZE);
		    LSP1^.SIZE := 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;
		    TEST := SY <> COMMA;
		    IF NOT TEST THEN INSYMBOL
		  UNTIL TEST;
		  IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12);
		  IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
		  TYP(FSYS,LSP,LSIZE);
		  IF LSP <> NIL THEN
		    IF LSP^.FORM = FILES THEN ERROR(108);
		  IF PACKABLE(LSP) THEN
		    IF NUMBITS + NUMBITS <= BITSPERWD THEN
		      WITH LSP1^ DO
			BEGIN AISPACKD := TRUE;
			  ELSPERWD := BITSPERWD DIV NUMBITS;
			  ELWIDTH := NUMBITS
			END;
		  REPEAT
		    WITH LSP1^ DO
		      BEGIN LSP2 := AELTYPE; AELTYPE := LSP;
			IF INXTYPE <> NIL THEN
			  BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
			    IF AISPACKD THEN
			      LSIZE := (LMAX-LMIN+ELSPERWD)
						 DIV ELSPERWD
			    ELSE
			      LSIZE := LSIZE*(LMAX - LMIN + 1);
			    IF LSIZE <= 0 THEN
			      BEGIN ERROR(398); LSIZE := 1 END;
			    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;
			WITH DISPLAY[TOP] DO
			  BEGIN FNAME := NIL; OCCUR := REC END
		      END
		    ELSE ERROR(250);
		    DISPL := 0; NEXTBIT := 0;
		    FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1);
		    DISPL := DISPL + ORD(NEXTBIT > 0);
		    NEW(LSP,RECORDS);
		    WITH LSP^ DO
		      BEGIN FSTFLD := DISPLAY[TOP].FNAME;
			RECVAR := LSP1; SIZE := DISPL;
			FORM := RECORDS
		      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
			    BEGIN ERROR(114); LSP1 := NIL END;
		      NEW(LSP,POWER);
		      WITH LSP^ DO
			BEGIN ELSET := LSP1; FORM := POWER;
			  IF LSP1 <> NIL THEN
			    BEGIN GETBOUNDS(LSP1,LMIN,LMAX);
			      SIZE := (LMAX + BITSPERWD) DIV BITSPERWD
			    END
			  ELSE SIZE := 0
			END
		    END
		  ELSE
  (*FILE*)          IF SY = FILESY THEN
		      BEGIN INSYMBOL; NEW(LSP,FILES);
			WITH LSP^ DO
			  BEGIN FORM := FILES; FILTYPE := NIL END;
			IF SY = OFSY THEN
			  BEGIN INSYMBOL; TYP(FSYS,LSP1,LSIZE) END
			ELSE LSP1 := NIL;
			LSP^.FILTYPE := LSP1;
			IF LSP1 <> NIL THEN
			  LSP^.SIZE := FILESIZE + LSP1^.SIZE
			ELSE LSP^.SIZE := NILFILESIZE
		      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 := 1 ELSE FSIZE := FSP^.SIZE
  END (*TYP*) ;

  PROCEDURE GENLDC(IVAL: INTEGER); FORWARD;

  PROCEDURE GENBYTE(FBYTE: INTEGER);
  BEGIN
    CODEP^[IC] := CHR(FBYTE); IC := IC+1
  END (*GENBYTE*) ;

  PROCEDURE GENWORD(FWORD: INTEGER);
  BEGIN
    IF ODD(IC) THEN IC := IC + 1;
    MOVELEFT(FWORD,CODEP^[IC],2);
    IC := IC + 2
  END (*GENWORD*) ;

  PROCEDURE GENBIG(IVAL: INTEGER);
    VAR LOWORDER: CHAR;
  BEGIN
    IF IVAL <= 127 THEN GENBYTE(IVAL)
    ELSE
      BEGIN MOVELEFT(IVAL,CODEP^[IC],2); LOWORDER := CODEP^[IC];
	CODEP^[IC] := CHR(ORD(CODEP^[IC+1])+128);
	CODEP^[IC+1] := LOWORDER; IC := IC+2
      END
  END (*GENBIG*) ;

  PROCEDURE GEN0(FOP: OPRANGE);
    VAR I: INTEGER;
  BEGIN
    GENBYTE(FOP+128);
    IF FOP = 38(*LCA*) THEN
      WITH GATTR.CVAL.VALP^ DO
	BEGIN GENBYTE(SLGTH);
	  FOR I := 1 TO SLGTH DO GENBYTE(ORD(SVAL[I]))
	END
  END (*GEN0*) ;

  PROCEDURE GEN1(FOP: OPRANGE; FP2: INTEGER);
    LABEL 1;
    VAR I,J: INTEGER;
  BEGIN
    GENBYTE(FOP+128);
    IF FOP = 51(*LDC*) THEN
      BEGIN
	IF FP2 = 2 THEN I := REALSIZE
	ELSE
	  BEGIN I := 8;
	    WHILE I > 0 DO
	      IF GATTR.CVAL.VALP^.CSTVAL[I] <> 0 THEN GOTO 1
	      ELSE I := I - 1;
      1:  END;
	GATTR.TYPTR^.SIZE := I;
	IF I > 1 THEN
	  BEGIN GENBYTE(I);
	    FOR J := I DOWNTO 1 DO GENWORD(GATTR.CVAL.VALP^.CSTVAL[J])
	  END
	ELSE
	  BEGIN IC := IC - 1;
	    IF I = 1 THEN GENLDC(GATTR.CVAL.VALP^.CSTVAL[1])
	  END
      END
    ELSE
      IF FOP IN [30(*CSP*),32(*ADJ*),45(*RNP*),
		 46(*CIP*),60(*LDM*),61(*STM*),
		 65(*RBP*),66(*CBP*),78(*CLP*),
		 42(*SAS*),79(*CGP*)] THEN GENBYTE(FP2)
      ELSE
	IF ((FOP = 74(*LDL*)) OR (FOP = 39(*LDO*)))
	    AND (FP2 <= 16) THEN
	  BEGIN IC := IC-1;
	    IF FOP = 39(*LDO*) THEN GENBYTE(231+FP2)
	    ELSE GENBYTE(215+FP2)
	  END
	ELSE
	  IF (FOP = 35(*IND*)) AND (FP2 <= 7) THEN
	    BEGIN IC := IC-1; GENBYTE(248+FP2) END
	  ELSE GENBIG(FP2)
  END (*GEN1*) ;

  PROCEDURE GEN2(FOP: OPRANGE; FP1,FP2: INTEGER);
  BEGIN
    IF (FOP = 64(*IXP*)) OR (FOP = 77(*CXP*)) THEN
      BEGIN GENBYTE(FOP+128); GENBYTE(FP1); GENBYTE(FP2);
      END
    ELSE
      IF FOP IN [47(*EQU*),48(*GEQ*),49(*GRT*),
		 52(*LEQ*),53(*LES*),55(*NEQ*)] THEN
	IF FP1 = 0 THEN GEN0(FOP+20)
	ELSE
	  BEGIN GEN1(FOP,FP1+FP1);
	    IF FP1 > 4 THEN GENBIG(FP2)
	  END
      ELSE
	BEGIN (*LDA,LOD,STR*)
	  IF FP1 = 0 THEN GEN1(FOP+20,FP2)
	  ELSE
	    BEGIN
	      GENBYTE(FOP+128); GENBYTE(FP1); GENBIG(FP2)
	    END
	END;
  END (*GEN2*) ;

  PROCEDURE GENLDC;
  BEGIN
    IF (IVAL >= 0) AND (IVAL <= 127) THEN GENBYTE(IVAL)
    ELSE
      BEGIN GENBYTE(51(*LDC*)+148);
	MOVELEFT(IVAL,CODEP^[IC],2);
	IC := IC+2
      END
  END (*GENLDC*) ;

  PROCEDURE GENJMP(FOP: OPRANGE; FLBP: LBP);
    VAR DISP: INTEGER;
  BEGIN
    WITH FLBP^ DO
      IF DEFINED THEN
	BEGIN
	  GENBYTE(FOP+128);
	  DISP := OCCURIC-IC-1;
	  IF (DISP >= 0) AND (DISP <= 127) THEN GENBYTE(DISP)
	  ELSE
	    BEGIN
	      IF JTABINX = 0 THEN
		BEGIN JTABINX := NEXTJTAB;
		  IF NEXTJTAB = MAXJTAB THEN ERROR(253)
		  ELSE NEXTJTAB := NEXTJTAB + 1;
		  JTAB[JTABINX] := OCCURIC
		END;
	      DISP := -JTABINX;
	      GENBYTE(248-JTABINX-JTABINX)
	    END;
	END
      ELSE
	BEGIN MOVELEFT(REFLIST,CODEP^[IC],2);
	  IF FOP = 57(*UJP*) THEN DISP := IC + 4096
	  ELSE DISP := IC;
	  REFLIST := DISP; IC := IC+2
	END;
  END (*GENJMP*) ;

  PROCEDURE LOAD; FORWARD;

  PROCEDURE GENFJP(FLBP: LBP);
  BEGIN LOAD;
    IF GATTR.TYPTR <> BOOLPTR THEN ERROR(135);
    GENJMP(33(*FJP*),FLBP)
  END (*GENFJP*) ;

  PROCEDURE GENLABEL(VAR FLBP: LBP);
  BEGIN NEW(FLBP);
    WITH FLBP^ DO
      BEGIN DEFINED := FALSE; REFLIST := MAXADDR END
  END (*GENLABEL*) ;

  PROCEDURE PUTLABEL(FLBP: LBP);
    VAR LREF: INTEGER; LOP: OPRANGE;
  BEGIN
    WITH FLBP^ DO
      BEGIN LREF := REFLIST;
	DEFINED := TRUE; OCCURIC := IC; JTABINX := 0;
	WHILE LREF < MAXADDR DO
	  BEGIN
	    IF LREF >= 4096 THEN
	      BEGIN LREF := LREF - 4096; LOP := 57(*UJP*) END
	    ELSE LOP := 33(*FJP*);
	    IC := LREF;
	    MOVELEFT(CODEP^[IC],LREF,2);
	    GENJMP(LOP,FLBP)
	  END;
	IC := OCCURIC
      END
  END (*PUTLABEL*) ;

  PROCEDURE LOAD;
  BEGIN
    WITH GATTR DO
      IF TYPTR <> NIL THEN
	BEGIN
	  CASE KIND OF
	    CST:   IF (TYPTR^.FORM = SCALAR) AND (TYPTR <> REALPTR) THEN
		     GENLDC(CVAL.IVAL)
		   ELSE
		     IF TYPTR = NILPTR THEN GEN0(31(*LDCN*))
		     ELSE
		       IF TYPTR = REALPTR THEN GEN1(51(*LDC*),2)
		       ELSE GEN1(51(*LDC*),5);
	    VARBL: CASE ACCESS OF
		     DRCT:   IF VLEVEL = 1 THEN GEN1(39(*LDO*),DPLMT)
			     ELSE GEN2(54(*LOD*),LEVEL-VLEVEL,DPLMT);
		     INDRCT: GEN1(35(*IND*),IDPLMT);
		     PACKD:  GEN0(58(*LDP*));
		     MULTI:  GEN1(60(*LDM*),TYPTR^.SIZE);
		     BYTE:   GEN0(62(*LDB*))
		   END;
	    EXPR:
	  END;
	  IF (TYPTR^.FORM = POWER) AND (KIND <> EXPR) THEN
	    GENLDC(TYPTR^.SIZE);
	  KIND := EXPR
	END
  END (*LOAD*) ;

  PROCEDURE STORE(VAR FATTR: ATTR);
  BEGIN
    WITH FATTR DO
      IF TYPTR <> NIL THEN
	CASE ACCESS OF
	  DRCT:   IF VLEVEL = 1 THEN GEN1(43(*SRO*),DPLMT)
		  ELSE GEN2(56(*STR*),LEVEL-VLEVEL,DPLMT);
	  INDRCT: IF IDPLMT <> 0 THEN ERROR(400)
		  ELSE GEN0(26(*STO*));
	  PACKD:  GEN0(59(*STP*));
	  MULTI:  GEN1(61(*STM*),TYPTR^.SIZE);
	  BYTE:   GEN0(63(*STB*))
	END
  END (*STORE*) ;

  PROCEDURE LOADADDRESS;
  BEGIN
    WITH GATTR DO
      IF TYPTR <> NIL THEN
	BEGIN
	  CASE KIND OF
	    CST:   IF STRGTYPE(TYPTR) THEN GEN0(38(*LCA*))
		   ELSE ERROR(400);
	    VARBL: CASE ACCESS OF
		     DRCT:   IF VLEVEL = 1 THEN GEN1(37(*LAO*),DPLMT)
			     ELSE GEN2(50(*LDA*),LEVEL-VLEVEL,DPLMT);
		     INDRCT: IF IDPLMT <> 0 THEN GEN1(34(*INC*),IDPLMT+IDPLMT);
		     PACKD:  ERROR(103)
		   END
	  END;
	  KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0
	END
  END (*LOADADDRESS*) ;

  PROCEDURE WRITECODE(FORCEBUF: BOOLEAN);
    VAR CODEINX,LIC,I: INTEGER;
  BEGIN CODEINX := 0; LIC := IC;
    REPEAT
      I := 512-CURBYTE;
      IF I > LIC THEN I := LIC;
      MOVELEFT(CODEP^[CODEINX],DISKBUF[CURBYTE],I);
      CODEINX := CODEINX+I;
      CURBYTE := CURBYTE+I;
      IF (CURBYTE = 512) OR FORCEBUF THEN
	BEGIN
	  IF BLOCKWRITE(USERINFO.WORKCODE^,DISKBUF,1,CURBLK) <> 1 THEN
	    ERROR(402);
	  CURBLK := CURBLK+1; CURBYTE := 0
	END;
      LIC := LIC-I
    UNTIL LIC = 0;
  END (*WRITECODE*) ;

  PROCEDURE FINISHSEG;
    VAR I: INTEGER;
  BEGIN IC := 0;
    FOR I := NEXTPROC-1 DOWNTO 1 DO GENWORD(SEGINX+IC-PROCTABLE[I]);
    GENBYTE(SEG); GENBYTE(NEXTPROC-1);
    SEGTABLE[SEG].CODELENG := SEGINX+IC;
    WRITECODE(TRUE); SEGINX := 0; CODEINSEG := FALSE
  END (*FINISHSEG*) ;