(*$M-,R-,T-,B+*)
  (************************************************************
   *                                                         *
   *							     *
   *                 PASCAL-DDT PROGRAM                      *
   *                 ******************                      *
   *                                                         *
   *                                                         *
   *       AUTHOR: PETER PUTFARKEN                           *
   *                                                         *
   *       POST - MORTEM - DUMP  BY                          *
   *       B. NEBEL AND B. PRETSCHNER (APR 76)               *
   *                                                         *
   *       INSTITUT FUER INFORMATIK                          *
   *       SCHLUETERSTRASSE 70                               *
   *       D-2000 HAMBURG 13				     *
   *       GERMANY					     *
   *							     *
   *       VERSION AUG 79:                                   *
   *       MODIFIED FOR PDP-11 UNDER RSX-11M BY:             *
   *       SEVED TORSTENDAHL & STEEN NORGAARD                *
   *       TELEFONAKTIEBOLAGET LM ERICSSON                   *
   *       S-126 25  STOCKHOLM                               *
   *							     *
   *       VERSION FEB 80:                                   *
   *       PERMITS DEBUGGER TO BE OVERLAID WITH USER PROG.   *
   *       TWO EXTERNAL ASSEMBLY ROUTINES 'SETBRP' AND       *
   *       'CLRBRP' HAVE BEEN ADDED TO SET AND CANCEL BREAK  *
   *       POINTS. THESE TWO ROUTINES ACCESSES CODE OF USER  *
   *       PROGRAM AND SHALL THEREFORE BE KEPT IN THE ROOT   *
   *       SEGMENT OF THE OVERLAY STRUCTURE.                 *
   *                                                         *
   ***********************************************************)

CONST
  VERSION  =  'PASCAL PDP-11 DEBUG VERSION: FEB 80';
  BPMAX    =  20; (* MAX NR OF BREAK POINTS TO BE SET *)
  SETMAX   =  63;
  BITMAX   =  15;
  MAXSTRGUB=  77; (* MAX STRING LENGTH = 78 *)
  OFFSET   =  40B; (* = ORD(' ') *)
  MAXTABS  =  4;
  MAXADDR  =  32767;
  CODEMAX  =  32767;
  MAXINT   =  32767;
  ALFALENG =  10;
  DEBUGRES =  250;    (* NR OF WORDS RESERVED ON STACK FOR GLOB VARS OF PASCAL-DDT PROGRAM *)
TYPE
  BITRANGE = 0..BITMAX;
(*- FEB 80
  LINEELEMP= ^LINEELEM;
  LINEELEM = RECORD
               MOV     : INTEGER;
               LINENO  : INTEGER;
               OFFS    : INTEGER;
               TST     : INTEGER;
               PREVLINE: LINEELEMP
             END;
-*)
 
  (* CONSTANTS *)
  (* ********* *)

  STRGTYPE = PACKED ARRAY [0..MAXSTRGUB] OF CHAR;
  CSTCLASS = (REEL,PSET,STRG);
  CSP = ^ CONSTANT;
  CONSTANT = RECORD
               CASE CCLASS: CSTCLASS OF
		    REEL: (HEAD,TAIL: INTEGER; RVAL: REAL);
		    PSET: (PVAL: SET OF 0..63);
		    STRG: (SLGTH: 0..MAXSTRGUB;
			   SVAL: STRGTYPE)
	     END;

  VALU = RECORD
	   CASE BOOLEAN OF
		TRUE: (IVAL: INTEGER);
		FALSE: (VALP: CSP)
	 END;
 
  (* DATA STRUCTURES *)
  (* *************** *)
 
  STRUCTFORM = (SCALAR,SUBRANGE,POINTER,POWER,ARRAYS,RECORDS,FILES,BOUNDLESS,TAGFWITHID,TAGFWITHOUTID,
                VARIANT,STRINGPARM);
  FORMSET=SET OF STRUCTFORM;
  LEVRANGE = 0..MAXADDR;
  ADDRRANGE = -MAXADDR..MAXADDR;
  DECLKIND = (STANDARD,DECLARED);
  STP = ^STRUCTURE; 
  CTP = ^IDENTIFIER;
  STRUCTURE = PACKED RECORD
		       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:  (FIRSTFIELD:CTP;NXTVAR,SUBVAR: STP; VARVAL: VALU)
		     END;

  (* IDENTIFIERS *)
  (* *********** *)
 
  ALFA = PACKED ARRAY[1..ALFALENG] OF CHAR; 
  IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC);
  IDKIND = (ACTUAL,FORMAL);
  FORWARDOREXT = (INTERNAL,FORWDECL,FORWFOUND,EXTRNL,EXTERNALTX,EXTERNFORTRAN);
  ALFAP = ^ALFA;
  CODERANGE = 0 .. CODEMAX;
  IDENTIFIER = PACKED RECORD
			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;
  
  (* BASIC SYMBOLS *)
  (* ************* *)

  SYMBOL= (IDENT,INTCONST,
           REALCONST,CHARCONST,STRINGCONST,NOTSY,BECOMES,EQSY,LPARENTSY,RPARENTSY,LBRACKSY,RBRACKSY,
           COLONSY,COMMASY,PERIODSY,ARROWSY,SLASHSY,PLUSSY,MINUSSY,MULSY,EOLSY,OTHERSY);

  ASCIIMNEMONICS = (NUL,SOH,STX,ETX,EOT,ENQ,ACK,BEL,
		     BS,HT,LF,VT,FF,CR,SO,SI,
		     DLE,DC1,DC2,DC3,DC4,NAK,SYN,ETB,
		     CAN,EM,SUB,ESC,FS,GS,RS,US,DEL);

  KEYWORD = (EXAMKW,DEPKW,BREAKKW,SETKW,CANCELKW,LISTKW,TRACEKW,
             DUMPKW,CALLSKW,STACKKW,HEAPKW,CONTINKW,COMMENTKW,EXECKW);

  COMMAND = (LISTBP,SETBP,CANCELBP,TRACECALL,EXAMINE,DEPOSIT,
             STACKDUMP,HEAPDUMP,CONTINUE,CANCELEXEC,COMMENT,NOCOMMAND);

  (* EXPRESSIONS *)
  (* *********** *)
 
  CVALU = RECORD
            CASE INTEGER OF
             1:  (IVAL: INTEGER);
             2:  (BVAL: BOOLEAN);
             3:  (RVAL: REAL);
             4:  (PVAL: SET OF 0..63);
             5:  (VALP: CSP)
          END;
  ATTRKIND = (CST,VARBL,EXPR);
  ATTR = RECORD
	   TYPTR: STP;
	   CASE KIND: ATTRKIND OF
		CST,
		EXPR:  (CVAL: CVALU);
		VARBL:(PACKFG: BOOLEAN;
		       GADDR: ADDRRANGE;
		       GBITCOUNT: BITRANGE;
                       GPACKSIZE: BITRANGE)
	 END;
  (* STACK ACCESS *)
  (* ************ *)
 
  ACR = ^ACTIVATIONREC;
  ACTIVATIONREC = ARRAY[0 .. 0] OF RECORD
                                    CASE INTEGER OF
                                     1: (STACKP : ACR);
                                     2: (IDPTR  : CTP);
                                     3: (STPTR  : STP);
                                     4: (CONT   : INTEGER)
                                   END;
  LINKTYPE = (DYNAMIC,STATIC);
 
  (* DEBUG STATUS *)
  (* ************ *)
 
  STATUSKIND = (INITC,HALTC,CNTRLCC,ODDADDRC,MEMPROTC,BREAKC,IOTC,
                PRIVINSTC,EMTC,TRPC,FPPC);


VAR
 
  (* SET  AT COMPILATION OF PROGRAM TO BE DEBUGGED *)
  GIDTREE: CTP; (* GLOBAL IDTREE *)
  SIDTREE: CTP; (* STANDARD IDTREE *)
  INTPTR : STP; (* PREDECLARED TYPE INTEGER *)
  REALPTR: STP; (* PREDECLARED TYPE REAL    *)
  BOOLPTR: STP; (* PREDECLARED TYPE BOOLEAN *)
  CHARPTR: STP; (* PREDECLARED TYPE CHAR    *)
  LASTLINEELEM: INTEGER; (* ADDRESS OF START OF LINE ELEMENT CHAIN IN CODE *)
 
  (* SET AT INITIAL INVOCATION OF DEBUGGER *)
  GBASIS : ACR; (* GLOBAL STACK BASE *)
  HEAPBOT: INTEGER; (* HEAP BOTTOM *)
  
  (* SET AT EVERY INVOCATION OF DEBUGGER *)
  LBASIS : ACR; (* STACK BASE OF UNDERBREAKED PROCEDURE *)
  LHEAP  : ACR; (* START OF HEAP ENTRY CHAIN *)
  STACKTOP: INTEGER; (* TOP OF USER STACK *)
  CAUSE  : STATUSKIND; (* REASON FOR DEBUG INVOCATION *)
  
  (* TABLE OF ACTIVE BREAK POINTS *)
  BPLAST: 0..BPMAX;  (* CURRENT NUMBER OF ACTIVE BREAK POINTS *)
  BPTABLE: ARRAY[1..BPMAX] OF
           PACKED RECORD
                   LINENUM: INTEGER;  (* SOURCE LINENR OF BP *)
                   CODEADDR: INTEGER  (* CODE ADDRESS OF BREAK INSTR *)
                  END;

  (* DO NOT CHANGE ORDER OF PREVIOUS VARIABLE DECLARATIONS! *)
 
  DUMP,TABS: BOOLEAN;
  TABULATOR: ARRAY[BOOLEAN,1..MAXTABS] OF INTEGER;
  NL: BOOLEAN;
  CH: CHAR;
  ID: ALFA;
  VAL: CVALU;
  STRINGVAL: CSP;
  STRINGTYPE, STRINGINDEX: STP;
  LGTH: INTEGER;
  CHCNT, LEFTSPACE: INTEGER;
  SY: SYMBOL;
  KWID: ARRAY[ KEYWORD ] OF ALFA;
  ACTLINENR: INTEGER;
  BASIS,SAVEBASIS,NULLPTR: ACR; (* STACK POINTERS *)
  HEAPTOP: INTEGER;
  STACKBOT: INTEGER;
  LADDR: ADDRRANGE;
  DIGITS, LETTERS: SET OF CHAR;
  GATTR: ATTR;
  LINK: LINKTYPE;
  FILENAME: PACKED ARRAY[1..14] OF CHAR;
  FILEISOPEN: BOOLEAN;
 
  (* TYPE CONVERTERS *)
  SETCV : PACKED RECORD
                  CASE BOOLEAN OF
                   FALSE: (CONST1:INTEGER;CONST2:INTEGER;CONST3:INTEGER;CONST4:INTEGER);
                   TRUE : (MASK: SET OF 0..SETMAX)
                 END;
  ASCIICV: RECORD
		 CASE INTEGER OF
		  1: (IVAL: INTEGER);
		  2: (MNEMO: ASCIIMNEMONICS)
	        END;
  BYTECV: PACKED RECORD
		   CASE INTEGER OF
                            1: (BYTES: ARRAY[0..1] OF CHAR);
                            2: (BITS: PACKED ARRAY[BITRANGE] OF BOOLEAN);
                            3: (INTCONST: INTEGER)
		 END;
  REALCV: RECORD
            CASE BOOLEAN OF
             FALSE: (HEAD: INTEGER; TAIL: INTEGER);
             TRUE : (RVAL: REAL)
          END;
  POINTERCV: RECORD
               CASE INTEGER OF
                1:  (CONT: INTEGER);
                2:  (STACKP: ACR);
                3:  (STRINGP: ^ STRGTYPE)
             END;
 
  (******************************************************************************************************)

  PROCEDURE DEBUG( VAR TTY,OUTPUT: TEXT );


  VAR
    COM: COMMAND;
    POINTERCNT: INTEGER;
    FILEOUTPUT: BOOLEAN;
  
  (* FOLLOWING TWO ASSEMBLER ROUTINES 'SETBRP' AND 'CLRBRP'
     PERMITS DEBUGGER TO BE OVERLAID WITH USER PROGRAM *)

  PROCEDURE SETBRP(VAR LINENR: INTEGER;VAR CODEADDR: INTEGER;VAR RES: INTEGER); EXTERN;
  (* SET BREAK POINT AT LINE 'LINENR'.
     INPUT:
       LINENR
     OUTPUT:
       RES            = 0 IF OK
                        1 IF LINENR TOO LARGE
                        2 IF LINENR NOT FOUND
       CODEADDR       = CODE ADDRESS OF BREAK INSTRUCTION
       LINENR         = UNCHANGED IF RES = 0
                        MAXLINENR IF RES = 1
                        LUB(LINENR) IF RES = 2
  *)

  PROCEDURE CLRBRP(CODEADDR: INTEGER); EXTERN;
  (* CANCEL BREAK POINT BY INSERTING THE INSTRUCTION 5727B (TST)
     IN LOCATION 'CODEADDR' OF USER CODE SEGMENT.
     INPUT:
       CODEADDR
     OUTPUT:
       -
  *)

  PROCEDURE INIT;
  (* INITIALIZE DEBUGGER *)
   BEGIN
    DIGITS := ['0'..'9'];
    LETTERS := ['A'..'Z'];
    STRINGTYPE := NIL;
    TABULATOR[TRUE,1]:=35;
    TABULATOR[TRUE,2]:=65;
    TABULATOR[TRUE,3]:=95;
    TABULATOR[TRUE,4]:=MAXINT;
    TABULATOR[FALSE,1]:=0;
    TABULATOR[FALSE,2]:=0;
    TABULATOR[FALSE,3]:=35;
    TABULATOR[FALSE,4]:=MAXINT;
    TABS:=FALSE;
    DUMP:=FALSE;
    FILEISOPEN:=FALSE;
    KWID[EXAMKW  ]:='EXAMINE   ';  KWID[DEPKW   ]:='DEPOSIT   ';
    KWID[BREAKKW ]:='BREAKS    ';  KWID[SETKW   ]:='SET       ';
    KWID[CANCELKW]:='CANCEL    ';  KWID[LISTKW  ]:='LIST      ';
    KWID[TRACEKW ]:='TRACE     ';  KWID[DUMPKW  ]:='DUMP      ';
    KWID[CALLSKW ]:='CALLSEQUEN';  KWID[STACKKW ]:='STACK     ';
    KWID[HEAPKW  ]:='HEAP      ';  KWID[CONTINKW]:='CONTINUE  ';
    KWID[COMMENTKW]:='COMMENT   '; KWID[EXECKW  ]:='EXECUTION ';
    BPLAST :=0;
    HEAPBOT := HEAPBOT DIV 2; (* WORD ADDR OF HEAP BOTTOM *)
    IF HEAPBOT < 0
    THEN HEAPBOT := HEAPBOT + MAXINT + 1;
    STACKBOT := ORD(GBASIS) DIV 2; (* WORD ADDR OF STACK BOTTOM *)
    IF STACKBOT < 0 THEN STACKBOT := STACKBOT + MAXINT + 1;
    STACKBOT := STACKBOT - DEBUGRES;
    (* SET NULLPTR:=0 *)
    WITH POINTERCV DO
     BEGIN
      CONT:=0;
      NULLPTR:=STACKP
     END;
   END (*INIT*);

    PROCEDURE SYSTEMERROR( KIND : INTEGER );
    (* REPORT AN INTERNAL SYSTEM ERROR *)
     BEGIN
      WRITELN(TTY);
      WRITELN(TTY,'%? DEBUG-SYSTEM ERROR: ',KIND:2);
     END;


    PROCEDURE ERROR;
    (* MARK AN ERROR IN CURRENT POS OF INPUT LINE AND ZEROISE GATTR.TYPTR *)
     BEGIN
      WRITE(TTY,'^ ':CHCNT+3);
      GATTR.TYPTR := NIL
     END (*ERROR*);


    PROCEDURE NEWLINE(VAR FIL: TEXT);
    (* GENERATE A TABULATOR CONTROLLED LINESHIFT AND INITIATE NEXT LINE *)
    VAR
      I:INTEGER;
     BEGIN
      I:=1;
      IF TABS
      THEN
      WHILE (TABULATOR[DUMP,I] <= CHCNT) DO
      I:=I+1;
      IF (I = MAXTABS) OR NOT TABS
      THEN
       BEGIN
	WRITELN(FIL);
	WRITE(FIL,'  ',' ':LEFTSPACE);
	CHCNT:=LEFTSPACE;
       END
      ELSE
       BEGIN
	WRITE(FIL,' ':TABULATOR[DUMP,I]-CHCNT);
	CHCNT:=TABULATOR[DUMP,I];
       END (* ELSE *)
     END (* NEWLINE *);

    FUNCTION LENGTH(FVAL: INTEGER): INTEGER;
    (* CALCULATE NR. OF POSITIONS OCCUPIED BY A PRINTABLE INTEGER VALUE *)
    VAR
      E: INTEGER;
     BEGIN
      IF FVAL < 0
      THEN
       BEGIN
	E := 1; FVAL := -FVAL
       END
      ELSE E := 0;
      IF FVAL < 10
      THEN E := E + 1
      ELSE IF FVAL < 100
           THEN E := E + 2
           ELSE IF FVAL < 1000
                THEN E := E + 3
                ELSE IF FVAL < 10000
                     THEN E := E + 4
                     ELSE E := E + 5;
      LENGTH := E
     END (*LENGTH*);

    PROCEDURE INSYMBOL;
    (* READ NEXT BASIC SYMBOL AND RETURN ITS DESCRIPTION IN
       THE GLOBALS SY,ID,VAL,LGTH *)
    CONST
      DIGMAX = 9;
    VAR
      IVAL,SCALE,EXP,I,J,K: INTEGER;
      RVAL,R,FAC,MANT: REAL;
      CASECONV,STRINGTOOLONG, SIGN: BOOLEAN;
      DIGIT: ARRAY[1..DIGMAX] OF 0..9;
      BINEXP,SGN: INTEGER;

      PROCEDURE NEXTCH;
      (* READ NEXT CHAR OF INPUT AND RETURN IT IN GLOBAL 'CH'.
         'CHCNT' IS UPDATED *)
      VAR
        ORDCH: 0..255;
       BEGIN
	IF EOLN(TTY)
        THEN CH:=' '
	ELSE BEGIN
              READ(TTY,CH);
              ORDCH:=ORD(CH);
              IF ORDCH>177B
              THEN BEGIN
                    ORDCH:=ORDCH-200B;
                    CH:=CHR(ORDCH)
                   END;
              IF ORDCH<40B THEN CH:=' '
              ELSE IF (ORDCH>137B) AND CASECONV
                   THEN CH:=CHR(ORDCH-40B);
             END;
	CHCNT := CHCNT + 1
       END (*NEXTCH*);

     BEGIN (*INSYMBOL*)
      CASECONV := TRUE;
      WHILE NOT EOLN(TTY) AND (CH=' ') DO NEXTCH;
       CASE CH OF
	' ':
	       SY := EOLSY;
	'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
		ID := '          '; I := 0;
		 REPEAT
		  IF I < ALFALENG
		  THEN
		   BEGIN
		    I := I + 1;
		    ID[I] := CH
		   END;
		  NEXTCH
		 UNTIL NOT ( CH IN LETTERS OR DIGITS );
		SY := IDENT;
                LGTH:=I;
	       END;
	'0','1','2','3','4','5','6','7','8',
	'9':
		   BEGIN
		    SY := INTCONST; 
		    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;  I:= DIGMAX;
                      WRITELN(TTY,'NUMBER TOO LARGE')
		     END;
		    IVAL := 0;  RVAL := 0;
		    IF CH = 'B'
		    THEN
		     BEGIN
		      IF (I>6) OR ((I=6) AND (DIGIT[1]>1))
		      THEN
		       BEGIN
			ERROR;  IVAL := 0;
                        WRITELN(TTY,'NUMBER TOO LARGE');
		       END
		      ELSE
		      FOR K := 1 TO I DO
		       BEGIN
			IF DIGIT[K] > 7
			THEN BEGIN
                              ERROR;
                              WRITELN(TTY,'ILLEGAL OCTAL NUMBER')
                             END;
			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 
                             BEGIN
                              ERROR;
                              WRITELN(TTY,'DIGIT EXPECTED')
                             END
			    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 
                         BEGIN
                          ERROR;
                          WRITELN(TTY,'DIGIT EXPECTED')
                         END
			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
			R := 1E0;   %NOTE POSSIBLE OVERFLOW OR UNDERFLOW\
			IF SCALE < 0
			THEN
			 BEGIN
			  FAC := 0.1; SCALE := -SCALE
			 END
			ELSE FAC := 10E0;
			 REPEAT
			  IF ODD(SCALE)
			  THEN R := R*FAC;
			  FAC := SQR(FAC); SCALE := SCALE DIV 2
			 UNTIL SCALE = 0;   %NOW R = 10^SCALE\
			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;  IVAL := 0;
                          WRITELN(TTY,'NUMBER TOO LARGE')
			 END
		       END
		      ELSE
		       BEGIN
                        VAL.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;  MANT := 0E0;
                          WRITELN(TTY,'NUMBER TOO LARGE')
			 END;
		       END
		     END
		   END;
	':':
	       BEGIN
		NEXTCH;
		IF  CH = '='
		THEN
		 BEGIN
		  SY := BECOMES; NEXTCH
		 END
		ELSE SY := COLONSY
	       END;
	'''':
	       BEGIN
                CASECONV := FALSE;
		LGTH := 0; STRINGTOOLONG := FALSE;
		IF STRINGTYPE= NIL
		THEN
		 BEGIN
		  NEW(STRINGVAL,STRG); NEW(STRINGTYPE,ARRAYS); NEW(STRINGINDEX,SUBRANGE);
		  WITH  STRINGINDEX^ DO
		   BEGIN
                    SIZE := 2;
		    RANGETYPE := INTPTR; MIN.IVAL := 0
		   END;
		  WITH STRINGTYPE^ DO
		   BEGIN
                    AELTYPE:=CHARPTR;
		    INXTYPE := STRINGINDEX; 
                    PACKOPT:=FALSE;
                    ADDRCORR:=0;
		   END
		 END;
		 REPEAT
		   REPEAT
		    NEXTCH;
		    IF LGTH <= MAXSTRGUB
		    THEN
		     BEGIN
                      STRINGVAL^.SVAL[LGTH]:=CH;
                      LGTH:=LGTH+1
		     END
		    ELSE STRINGTOOLONG := TRUE
		   UNTIL EOLN(TTY) OR (CH = '''');
		  IF STRINGTOOLONG
		  THEN
		   BEGIN
		    ERROR; WRITELN(TTY,'STRING CONSTANT IS TOO LONG')
		   END;
		  IF CH <> ''''
		  THEN
		   BEGIN
		    ERROR; WRITELN(TTY,'STRING CONSTANT CONTAINS "<CR><LF>"')
		   END
		  ELSE NEXTCH
		 UNTIL CH <> '''';
		LGTH := LGTH - 1;   (*NOW LGTH = NR OF CHARS IN STRING*)
		IF LGTH = 1
		THEN
		 BEGIN
		  SY := CHARCONST; VAL.IVAL := ORD(STRINGVAL^.SVAL[0])
		 END
		ELSE
		 BEGIN
		  SY := STRINGCONST;
		  STRINGINDEX^.MAX.IVAL := LGTH-1;
                  STRINGTYPE^.SIZE:=LGTH+ORD(ODD(LGTH));
                  STRINGVAL^.SLGTH:=LGTH-1;
                  VAL.VALP:=STRINGVAL;
		 END
	       END;
	'=':
	       BEGIN
		SY := EQSY;  NEXTCH
	       END;
	'/':
	       BEGIN
		SY := SLASHSY; NEXTCH
	       END;
	'[':
	       BEGIN
		SY := LBRACKSY; NEXTCH
	       END;
	']':
	       BEGIN
		SY := RBRACKSY; NEXTCH
	       END;
	'.':
	       BEGIN
                NEXTCH;
                IF CH='.'
                THEN BEGIN CH:=':'; SY:=COLONSY; NEXTCH END
                ELSE
                IF CH=')'
                THEN BEGIN SY:=RBRACKSY; NEXTCH END
                ELSE SY:=PERIODSY
	       END;
	'^':
	       BEGIN
		SY := ARROWSY;  NEXTCH
	       END;
	',':
	       BEGIN
		SY := COMMASY;  NEXTCH
	       END;
	'+':
	       BEGIN
		SY := PLUSSY;   NEXTCH
	       END;
	'*':
	       BEGIN
		SY := MULSY;    NEXTCH
	       END;
	'-':
	       BEGIN
		SY := MINUSSY;  NEXTCH
	       END;
	'(':
	       BEGIN
                NEXTCH;
                IF CH='.'
                THEN BEGIN SY:=LBRACKSY; NEXTCH END
                ELSE SY:=LPARENTSY
	       END;
	')':
	       BEGIN
		SY := RPARENTSY;  NEXTCH
	       END;
	OTHERS:
	       SY := OTHERSY
       END;
     END (*INSYMBOL*);

    PROCEDURE SUCCBASIS(LINK: LINKTYPE);
     (* SETS 'BASIS' TO STACKBASE OF NEXT STATIC/DYNAMIC HIGHER PROC. *)
    VAR
      ADDR: INTEGER;
    BEGIN
      IF LINK=STATIC
      THEN BASIS:=BASIS^[0].STACKP
      ELSE BASIS:=BASIS^[-1].STACKP;
      ADDR := ORD(BASIS) DIV 2; (* WORD ADDRESS *)
      IF ADDR < 0 THEN ADDR := ADDR + MAXINT + 1;
      IF (ADDR > (STACKBOT + DEBUGRES)) OR (ADDR < STACKTOP)
      THEN BEGIN
            WRITELN(TTY,'ERROR IN PROCEDURE-BACKTRACING');
            BASIS:=GBASIS;
           END;
    END (* SUCCBASIS *);

    PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP);
    (* SEARCH FOR NAME (=ID) IN IDTREE POINTED AT BY FCP.
       RESULTING RECORD POINTER RETURNED IN FCP1.
       FCP1 = NIL IF NOT FOUND *)
    LABEL
      1;
     BEGIN
      WHILE FCP <> NIL DO WITH FCP^ DO
       BEGIN
	IF NAME = ID

	THEN GOTO 1;
	IF NAME < ID
	THEN FCP := RLINK
	ELSE FCP := LLINK
       END;
1:
      FCP1 := FCP
     END (*SEARCHSECTION*);

    PROCEDURE SEARCHID(VAR FCP: CTP);
    (* SEARCH FOR NAME IN IDTREES ON DECREASING STATIC LEVELS UNTIL FOUND*)
    VAR
      IDTREE,LCP: CTP;
     BEGIN
      BASIS := LBASIS;
      LCP := NIL;
      LOOP
       IDTREE := BASIS^[-2].IDPTR;
       IF IDTREE <> NIL
       THEN (* SKIP FIRST NODE HOLDING NAME OF HOST PROC *)
            SEARCHSECTION(IDTREE^.LLINK,LCP);
      EXIT IF (LCP <> NIL) OR (BASIS = GBASIS);
       SUCCBASIS(STATIC);
      END (*LOOP*);
      IF LCP = NIL
      THEN (* SEARCH STANDARD TREE *)
           SEARCHSECTION(GBASIS^[-3].IDPTR,LCP);
      FCP := LCP
     END (*SEARCHID*);

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

    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 IF FSP1^.FORM = BOUNDLESS 
           THEN COMPTYPES := FALSE
           ELSE COMPTYPES := TRUE
      ELSE
       IF (FSP1 <> NIL) AND (FSP2 <> NIL)
       THEN
	 IF FSP1^.FORM = FSP2^.FORM
	 THEN
	   CASE FSP1^.FORM OF
	    SCALAR:
		   COMPTYPES := FALSE;
		   (* IDENTICAL SCALARS DECLARED ON DIFFERENT LEVELS ARE
		    NOT RECOGNIZED TO BE COMPATIBLE*)
	    SUBRANGE:
		   COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2^.RANGETYPE);
            POINTER:
                   IF POINTERCNT = 10
                   THEN COMPTYPES := FALSE
                   ELSE BEGIN
                         POINTERCNT := POINTERCNT+1;
                         COMPTYPES := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE);
                         POINTERCNT := POINTERCNT-1
                        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;
                    COMPTYPES := COMP
		   END;
		  (*ALTERNATIVES: -- ADD A THIRD BOOLEAN TERM: INDEXTYPE MUST
		   BE COMPATIBLE. MAY GIVE TROUBLE FOR ENT OF STRINGCONSTANTS
		   -- ADD A FOURTH BOOLEAN TERM: LOWBOUNDS MUST
		   BE THE SAME*)
	    RECORDS:
		   BEGIN
		    NXT1 := FSP1^.FSTFLD; NXT2 := FSP2^.FSTFLD; COMP := TRUE;
                    WHILE (NXT1 <> NIL) AND (NXT2<> NIL) DO
                     BEGIN
                      COMP:=COMPTYPES(NXT1^.IDTYPE,NXT2^.IDTYPE) AND COMP;
                      NXT1:=NXT1^.NEXT; NXT2:=NXT2^.NEXT
                     END;
                    COMPTYPES:=COMP AND (NXT1=NIL) AND (NXT2=NIL)
                    AND (FSP1^.RECVAR=NIL) AND (FSP2^.RECVAR=NIL)
                   END;
                   (* IDENTICAL RECORDS ARE RECOGNIZED TO BE COMPATIBLE
                      IF 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 COMPTYPES := FALSE
       ELSE COMPTYPES := TRUE
     END (*COMPTYPES*) ;

    PROCEDURE WORDADDR(VAR ADDR: INTEGER; CHECKLIM: BOOLEAN);
    (* CONVERTS THE BYTE ADDRESS 'ADDR' TO CORRESP. WORD ADDRESS.
       'ADDR' IS CHECKED TO BE WITHIN STACK LIMITS IF CHECKLIM *)
    BEGIN
      ADDR := ADDR DIV 2;
      IF ADDR < 0 THEN ADDR := ADDR + MAXINT + 1;
      IF CHECKLIM AND (( ADDR > STACKBOT ) OR ( ADDR < STACKTOP ))
      THEN BEGIN
            WRITELN(TTY,'  ADDRESS=',ADDR*2 :6:O,' OUT OF USER STACK AREA');
            GATTR.TYPTR := NIL;
           END;
    END (* WORDADDR *);
 
    FUNCTION NEXTBYTE: INTEGER;
    (* RETURN THE VALUE OF A VARIABLE COMPONENT WHOSE ADDRESS IS
       DESCRIBED BY 'GATTR'.
       ADJUST 'GATTR' TO ADDRESS OF NEXT COMPONENT *)
    VAR
      LVAL,J: INTEGER;
     BEGIN
      WITH GATTR DO
      IF PACKFG
      THEN
       BEGIN
	LVAL := 0;
	IF GPACKSIZE + GBITCOUNT  >  BITMAX + 1
	THEN
	 BEGIN
	  GADDR := GADDR + 1;
	  GBITCOUNT := 0
	 END;
	WITH BYTECV DO
	 BEGIN
	  INTCONST := BASIS^[GADDR].CONT;
          FOR J := GBITCOUNT + GPACKSIZE - 1 DOWNTO GBITCOUNT DO
	  LVAL := LVAL*2 + ORD(BITS[J])
	 END;
	GBITCOUNT := GBITCOUNT + GPACKSIZE;
	NEXTBYTE := LVAL
       END (*IF PACKFG*)
      ELSE
       BEGIN
	IF GBITCOUNT > 0
	THEN SYSTEMERROR(1);
	NEXTBYTE := BASIS^[GADDR].CONT;
	GADDR := GADDR + 1; GBITCOUNT := 0
       END
     END (*NEXTBYTE*);

    PROCEDURE PUTNEXTBYTE( FVAL: INTEGER );
    (* PUT THE VALUE 'FVAL' IN STACKPOSITION DESCRIBED BY 'GATTR'.
       ADJUST 'GATTR' TO ADDRESS OF NEXT COMPONENT *)
    VAR
      J: INTEGER;
     BEGIN
      WITH GATTR DO
       IF PACKFG THEN
       WITH BYTECV DO
       BEGIN
	IF GPACKSIZE + GBITCOUNT > BITMAX + 1
	THEN
	 BEGIN
	  GADDR := GADDR + 1;   GBITCOUNT := 0
	 END;
	INTCONST := BASIS^[GADDR].CONT;
        FOR J := GBITCOUNT TO GBITCOUNT + GPACKSIZE - 1 DO
	 BEGIN
	  BITS[J] := ODD(FVAL);
	  FVAL := FVAL DIV 2
	 END;
	GBITCOUNT := GBITCOUNT + GPACKSIZE;
	BASIS^[GADDR].CONT := INTCONST
       END
       ELSE
        BEGIN
         BASIS^[GADDR].CONT := FVAL;
         GADDR := GADDR+1
        END
     END (*PUTNEXTBYTE*);

    PROCEDURE LOAD;
      (* LOAD VALUE OF VARIABLE COMPONENT WHOSE ADDRESS IS DESCRIBED BY 'GATTR' INTO 'GATTR.CVAL'*)
     BEGIN
      WITH GATTR DO
      IF KIND = VARBL
      THEN
       IF TYPTR <> NIL
       THEN
	 IF TYPTR^.FORM <= POINTER
	 THEN
	   BEGIN
	    KIND := EXPR;
            IF TYPTR = REALPTR
            THEN WITH REALCV DO
                 BEGIN
                  HEAD := NEXTBYTE;
                  TAIL := NEXTBYTE;
                  CVAL.RVAL := RVAL
                 END
            ELSE CVAL.IVAL := NEXTBYTE
	   END;
     END (*LOAD*);

    PROCEDURE GETFIELD( FCP:CTP );
    (* RETURN DESCRIPTOR OF RECORD FIELD 'FCP' IN 'GATTR' 
       ASSUMING 'GATTR' ON INPUT HOLDS DESCRIPTOR OF RECORD *)
     BEGIN
      WITH FCP^, GATTR DO
       BEGIN
	IF KLASS <> FIELD
	THEN SYSTEMERROR(3);
        IF IDTYPE^.FORM = ARRAYS
        THEN GADDR := GADDR+(FLDADDR+IDTYPE^.ADDRCORR)DIV 2
        ELSE GADDR := GADDR+FLDADDR DIV 2;
        GBITCOUNT := 0;
        PACKFG := FALSE;
	TYPTR := IDTYPE
       END (*WITH*)
     END (*GETFIELD*);

    PROCEDURE EXPRESSION; FORWARD;

    PROCEDURE SELECTOR;
    (* ANALYSE QUALIFIED VARIABLE.
       RETURN DESCRIPTION OF COMPONENT IN 'GATTR'.
       'GATTR' HOLDS ON INPUT DESCRIPTION OF UNQUALIFIED VARIABLE *)
    LABEL
      1;
    VAR
      LCP: CTP;
      LMIN, LMAX: INTEGER;
      LATTR: ATTR;
      INDEX, I, INDEXOFFSET, BYTESINWORD: INTEGER;
     BEGIN
      WHILE SY IN [LBRACKSY,ARROWSY,PERIODSY] DO  WITH GATTR DO
       CASE SY OF
	LBRACKSY:
	       BEGIN
		 REPEAT
		  IF TYPTR <> NIL
		  THEN
		   IF TYPTR^.FORM <> ARRAYS
		   THEN
		     BEGIN
		      ERROR; WRITELN(TTY,'TYPE OF VARIABLE IS NOT ARRAY')
		     END;
		  INSYMBOL;
		  LATTR := GATTR;
		  EXPRESSION;
		  IF (TYPTR <> NIL) AND (LATTR.TYPTR<>NIL)
		  THEN
		   BEGIN
		    IF COMPTYPES( GATTR.TYPTR, LATTR.TYPTR^.INXTYPE )
		    THEN WITH GATTR DO
		     BEGIN
		      LOAD;
		      INDEX := CVAL.IVAL;
		      GATTR := LATTR;
		      WITH TYPTR^ DO
		       BEGIN
			GETBOUNDS(INXTYPE, LMIN, LMAX );
                        INDEXOFFSET := INDEX - LMIN;
                        IF INDEX < LMIN
			THEN I := LMIN - INDEX
			ELSE
			 IF INDEX > LMAX
			 THEN
			  I:= INDEX - LMAX
			 ELSE
			  GOTO 1;
			ERROR; WRITE(TTY,'ARRAY-INDEX');
			IF INDEX < LMIN
			THEN WRITE(TTY, ' LESS THAN LOW BOUND')
			ELSE WRITE(TTY, ' GREATER THAN HIGH BOUND');
                        WRITELN(TTY,' BY ',I:LENGTH(I));
1:
                        IF PACKOPT OR COMPTYPES(AELTYPE,CHARPTR)
			THEN
			 BEGIN
			  PACKFG := TRUE;
                          IF AELTYPE = BOOLPTR
                          THEN BEGIN
                                BYTESINWORD := BITMAX+1; GPACKSIZE := 1;
                               END
                          ELSE BEGIN 
                                BYTESINWORD := 2; GPACKSIZE := 8;
                               END;
			 I := INDEXOFFSET MOD BYTESINWORD;
			  GADDR := GADDR + (INDEXOFFSET DIV BYTESINWORD);
                          IF INDEXOFFSET < 0
                          THEN BEGIN
                                GADDR := GADDR - 1;
                                I := I + BYTESINWORD;
                               END;
			  GBITCOUNT := I * GPACKSIZE
			 END
			ELSE GADDR := GADDR + (AELTYPE^.SIZE * INDEXOFFSET) DIV 2;
			IF TYPTR <> NIL
			THEN TYPTR := AELTYPE
		       END (*WITH TYPTR^*)
		     END (*IF COMPTYPES*)
		    ELSE
		     BEGIN
		      ERROR; WRITELN(TTY,'INDEX-TYPE IS NOT COMPATIBLE WITH DECLARATION')
		     END
		   END (*IF TYPTR<>NIL*)
		 UNTIL SY <> COMMASY;
		IF SY = RBRACKSY
		THEN INSYMBOL
		ELSE
		 BEGIN
		  ERROR; WRITELN(TTY,'"]" EXPECTED')
		 END;
	       END;
	PERIODSY:
	       BEGIN
		IF TYPTR <> NIL
		THEN
		 IF TYPTR^.FORM <> RECORDS
		 THEN
		   BEGIN
		    ERROR; WRITELN(TTY,'TYPE OF VARIABLE IS NOT RECORD')
		   END;
		INSYMBOL;
		IF SY = IDENT
		THEN
		 BEGIN
		  IF TYPTR <> NIL
		  THEN
		   BEGIN
		    SEARCHSECTION(TYPTR^.FSTFLD, LCP);
		    IF LCP = NIL
		    THEN
		     BEGIN
		      ERROR; WRITELN(TTY,'NO SUCH FIELD IN THIS RECORD')
		     END
		    ELSE GETFIELD(LCP)
		   END (*TYPTR <> NIL*);
		  INSYMBOL
		 END
		ELSE
		 BEGIN
		  ERROR; WRITELN(TTY,'IDENTIFIER EXPECTED')
		 END
	       END (*PERIODSY*);
	ARROWSY:
	       BEGIN
		INSYMBOL;
		IF TYPTR <> NIL
		THEN
		 CASE TYPTR^.FORM OF
		  POINTER:
			 BEGIN
                          GADDR := BASIS^[GADDR].CONT;
                          WORDADDR(GADDR,FALSE);
			  IF GADDR = ORD(NIL)
			  THEN
			   BEGIN
			    ERROR; WRITELN(TTY,'POINTER IS NIL')
			   END
			  ELSE
                           IF (GADDR > HEAPTOP)
                            OR (GADDR < HEAPBOT)
			   THEN
			     BEGIN
			      ERROR; WRITELN(TTY,'POINTER IS OUT OF HEAP');
                 WRITELN(TTY,'POINTER=',GADDR:6:O,' HEAPTOP=',HEAPTOP:6:O,' HEAPBOT=',HEAPBOT:6:O);
			     END
			   ELSE TYPTR := TYPTR^.ELTYPE;
                          PACKFG := FALSE; GPACKSIZE := 0; GBITCOUNT := 0;
			 END;
		  FILES:
                         BEGIN
                          GADDR := BASIS^[GADDR].CONT;
                          IF TYPTR^.FILTYPE=CHARPTR
                          THEN BEGIN
                                PACKFG := TRUE;
                                GPACKSIZE := 8;
                                IF ODD(GADDR)
                                THEN GBITCOUNT := 8
                                ELSE GBITCOUNT := 0;
                               END 
                          ELSE BEGIN
                                PACKFG := FALSE;
                                GPACKSIZE := 0;
                                GBITCOUNT := 0;
                               END;
                          WORDADDR(GADDR,FALSE);
			  TYPTR := TYPTR^.FILTYPE
			 END;
		  OTHERS:
			 BEGIN
			  ERROR;
			  WRITELN(TTY,'TYPE OF VARIABLE MUST BE FILE OR POINTER')
			 END
		 END (*CASE FORM*);
	       END (*ARROW*)
       END (*CASE*)
     END (*SELECTOR*);

    PROCEDURE VARIABLE;
    VAR
      LCP: CTP;
     BEGIN
      (*VARIABLE*)
      SEARCHID(LCP);
      INSYMBOL;
      IF LCP = NIL
      THEN
       BEGIN
	ERROR; WRITELN(TTY,'NOT FOUND')
       END
      ELSE
       BEGIN
	WITH LCP^, GATTR  DO
	 CASE KLASS OF
	  TYPES:
		 BEGIN
		  ERROR; WRITELN(TTY,'IS TYPE')
		 END;
	  KONST:
		 BEGIN
		  KIND := CST;
                  IF IDTYPE = REALPTR
                  THEN CVAL.RVAL := VALUES.VALP^.RVAL
                  ELSE IF IDTYPE^.FORM = ARRAYS (*STRING CONSTANT *)
                       THEN CVAL.VALP := VALUES.VALP
                       ELSE CVAL.IVAL := VALUES.IVAL;
                  BASIS := NULLPTR;
		  TYPTR := IDTYPE
		 END;
	  VARS:
		 BEGIN
		  KIND := VARBL;
                  TYPTR := IDTYPE;
                  GADDR := VADDR + ORD(BASIS);
                  BASIS := NULLPTR;
                  IF (VKIND = FORMAL) AND (TYPTR^.FORM <> STRINGPARM)
                  THEN BEGIN
                        WORDADDR(GADDR,TRUE);
                        IF TYPTR <> NIL THEN GADDR := BASIS^[GADDR].CONT ;
                       END;
                  IF IDTYPE^.FORM = ARRAYS
                  THEN GADDR := GADDR + IDTYPE^.ADDRCORR; (*TRUE ADDRESS*)
                  WORDADDR(GADDR,IDTYPE^.FORM<>FILES);
		  GBITCOUNT := 0; PACKFG := FALSE; GPACKSIZE := 0;
		  SELECTOR
		 END;
       (* FIELD:  CANNOT OCCUR *)
	  PROC:
		 BEGIN
		  ERROR; WRITELN(TTY,'IS PROCEDURE')
		 END;
	  FUNC:
		 BEGIN
		  ERROR; WRITELN(TTY,'IS FUNCTION')
		 END
	 END (*CASE CLASS*)
       END
     END (*VARIABLE*);

    PROCEDURE EXPRESSION;
    (* READ AND EVALUATE AN EXPRESSION AND RETURN RESULT IN 'GATTR'.
       HEAVY RESTRICTIONS ON SYNTAX OF <EXPRESSION> *)

      PROCEDURE SIMPLEEXPRESSION;
      VAR
	SIGNED: BOOLEAN;
        LATTR: ATTR;
        LOP: SYMBOL;

        PROCEDURE TERM;
        VAR
          LATTR: ATTR;

          PROCEDURE FACTOR;
          VAR
            I,RMIN: INTEGER;
            LSP: STP;
            RANGEPART: BOOLEAN;
           BEGIN
             CASE SY OF
              IDENT: VARIABLE;
              INTCONST,
              REALCONST,
              CHARCONST:
                     WITH GATTR DO
                      BEGIN
                       KIND := CST; CVAL := VAL;
                       IF SY=INTCONST
                       THEN TYPTR := INTPTR
                       ELSE
                        IF SY=REALCONST
                        THEN TYPTR := REALPTR
                        ELSE TYPTR := CHARPTR;
		       INSYMBOL
		      END;
	      STRINGCONST:
		     WITH GATTR DO
		      BEGIN
		       TYPTR := STRINGTYPE;
		       KIND := VARBL; PACKFG := FALSE;
                       GADDR := ORD(VAL.VALP);
                       WORDADDR(GADDR,FALSE);
                       GADDR := GADDR+2;
                       GBITCOUNT := 0;
                       GPACKSIZE := 0;
		       INSYMBOL
		      END;
	      NOTSY:
		     BEGIN
		      INSYMBOL; FACTOR;
		      WITH GATTR DO
		      IF TYPTR = BOOLPTR
		      THEN
		       BEGIN
			LOAD;  CVAL.BVAL  :=  NOT CVAL.BVAL
		       END
		      ELSE
		       BEGIN
			ERROR; WRITELN(TTY,'TYPE IS NOT BOOLEAN')
		       END
		     END (* NOT *);
	      LPARENTSY:
		     BEGIN
		      INSYMBOL; EXPRESSION;
		      IF SY = RPARENTSY
		      THEN INSYMBOL
		      ELSE
		       BEGIN
			ERROR;
			WRITELN(TTY,'")" EXPECTED')
		       END
		     END (* ( *) ;
              LBRACKSY:
                     BEGIN (* SET *)
                      SETCV.MASK := [];
                      NEW(LSP,POWER);
                      WITH LSP^ DO
                      BEGIN
                       ELSET := NIL; SIZE := 2
                      END;
                      RANGEPART := FALSE;
                      INSYMBOL;
                      WHILE (SY <> EOLSY) AND (SY <> RBRACKSY) DO
                      WITH GATTR DO
                      BEGIN
                       IF SY = IDENT
                       THEN VARIABLE
                       ELSE IF (SY = INTCONST) OR (SY = CHARCONST)
                            THEN BEGIN
                                  KIND := CST;
                                  CVAL := VAL;
                                  IF SY = INTCONST
                                  THEN TYPTR := INTPTR
                                  ELSE TYPTR := CHARPTR;
                                  INSYMBOL
                                 END
                            ELSE ERROR;
                       IF TYPTR <> NIL
                       THEN IF (KIND = CST) AND (TYPTR^.FORM = SCALAR) AND COMPTYPES(LSP^.ELSET,TYPTR)
                            THEN BEGIN
                                  I := CVAL.IVAL;
                                  IF TYPTR = CHARPTR
                                  THEN I := I-OFFSET;
                                  IF I > BITMAX
                                  THEN LSP^.SIZE := 8;
                                  IF (I > SETMAX) OR (I < 0)
                                  THEN ERROR
                                  ELSE SETCV.MASK := SETCV.MASK OR [I];
                                  IF SY = COLONSY
                                  THEN BEGIN
                                        RANGEPART := TRUE;
                                        RMIN := I; 
                                       END 
                                  ELSE IF RANGEPART
                                       THEN BEGIN
                                             RMIN := RMIN+1;
                                             WHILE RMIN < I DO
                                             BEGIN
                                              SETCV.MASK := SETCV.MASK OR [RMIN];
                                              RMIN := RMIN+1 
                                             END;
                                             RANGEPART := FALSE 
                                            END;
                                  LSP^.ELSET := TYPTR;
                                 END
                            ELSE ERROR;
                       IF (TYPTR = NIL) OR NOT (SY IN [RBRACKSY,COLONSY,COMMASY])
                       THEN BEGIN
                             IF TYPTR <> NIL
                             THEN ERROR;
                             WRITELN(TTY,'SET CONSTRUCTOR ERROR');
                             WHILE SY <> EOLSY DO INSYMBOL;
                            END;
                       IF (SY = COLONSY) OR (SY = COMMASY)
                       THEN INSYMBOL;
                      END (* WHILE WITH GATTR DO *);
                      IF SY = RBRACKSY
                      THEN INSYMBOL;

                      IF GATTR.TYPTR <> NIL
                      THEN WITH GATTR DO
                           BEGIN
                            TYPTR := LSP;
                            CVAL.PVAL := SETCV.MASK;
                           END;
                     END (* [ *);
	      OTHERS:
		     BEGIN
		      ERROR; WRITELN(TTY,'FACTOR EXPECTED')
		     END
	     END (* CASE *)
	   END (*FACTOR*);

	 BEGIN (*TERM*)
	  FACTOR;
	  WHILE SY = MULSY DO
	   BEGIN
	    INSYMBOL;
	    LOAD; LATTR := GATTR;
	    FACTOR; LOAD;
	    IF COMPTYPES(LATTR.TYPTR,INTPTR) AND
	    COMPTYPES(GATTR.TYPTR,INTPTR)
	    THEN GATTR.CVAL.IVAL := GATTR.CVAL.IVAL * LATTR.CVAL.IVAL
            ELSE IF (LATTR.TYPTR = REALPTR) AND (GATTR.TYPTR = REALPTR)
                 THEN GATTR.CVAL.RVAL := GATTR.CVAL.RVAL * LATTR.CVAL.RVAL
            ELSE
	     BEGIN
	      ERROR; WRITELN(TTY,'OPERANDS MUST BE OF TYPE INTEGER OR REAL')
	     END
	   END
	 END (*TERM*);

       BEGIN (*SIMPLEEXPRESSION*)
	IF SY IN [PLUSSY,MINUSSY]
	THEN WITH GATTR DO
	 BEGIN
	  SIGNED := SY=MINUSSY ;
	  INSYMBOL; TERM;
	  IF COMPTYPES(TYPTR,INTPTR) OR COMPTYPES(TYPTR,REALPTR)
	  THEN
	   BEGIN
	    IF SIGNED
	    THEN
	     BEGIN
	      LOAD; 
              IF COMPTYPES(TYPTR,INTPTR)
              THEN CVAL.IVAL := -CVAL.IVAL
              ELSE CVAL.RVAL := -CVAL.RVAL;
	     END
	   END
	  ELSE
	   BEGIN
	    ERROR; WRITELN(TTY,'NO SIGN ALLOWED HERE')
	   END
	 END (*MINUS*)
	ELSE TERM;
	WHILE SY IN [PLUSSY,MINUSSY] DO
	 BEGIN
	  LOP := SY; INSYMBOL;
	  LOAD; LATTR := GATTR;
	  TERM; LOAD;
	  IF COMPTYPES(LATTR.TYPTR,INTPTR) AND
	  COMPTYPES(GATTR.TYPTR,INTPTR)
	  THEN
	   IF LOP = PLUSSY
	   THEN GATTR.CVAL.IVAL := LATTR.CVAL.IVAL + GATTR.CVAL.IVAL
	   ELSE GATTR.CVAL.IVAL := LATTR.CVAL.IVAL - GATTR.CVAL.IVAL
          ELSE
           IF COMPTYPES(LATTR.TYPTR,REALPTR)
             AND COMPTYPES(GATTR.TYPTR,REALPTR)
           THEN 
            IF LOP = PLUSSY
            THEN GATTR.CVAL.RVAL := LATTR.CVAL.RVAL + GATTR.CVAL.RVAL
            ELSE GATTR.CVAL.RVAL := LATTR.CVAL.RVAL - GATTR.CVAL.RVAL
	  ELSE
	   BEGIN
	    ERROR; WRITELN(TTY,'OPERANDS MUST BE OF TYPE INTEGER OR REAL ')
	   END
	 END
       END (*SIMPLEEXPRESSION*);

     BEGIN (*EXPRESSION*)
      SIMPLEEXPRESSION
     END (*EXPRESSION*);

    PROCEDURE WRITENAME(VAR FIL: TEXT;NAME:ALFA);
    (* WRITE OUT 'NAME' IN MINIMAL SPACE.
       POSITION COUNTER 'CHCNT' IS UPDATED *)
    LABEL
      1;
    VAR
      RUN:INTEGER;
     BEGIN
      FOR RUN := 1 TO 10 DO
      IF NAME[RUN]=' '
      THEN GOTO 1
      ELSE WRITE(FIL,NAME[RUN]);
1:
      CHCNT:=CHCNT+RUN-1;
     END (*WRITENAME*);

    PROCEDURE WRITEPRONAME(VAR FIL: TEXT);
    (* WRITE OUT NAME OF PROCEDURE WHOSE ACTIVATION RECORD IS GIVEN BY 'BASIS' *)
     BEGIN
       IF BASIS^[-2].IDPTR=NIL
       THEN WRITE(FIL,'UNKNOWN')
       ELSE WRITENAME(FIL,BASIS^[-2].IDPTR^.NAME)
     END (* WRITEPRONAME *);
    
    PROCEDURE WRITEHEADER(VAR FIL: TEXT);
    (* WRITE OUT HEADER FOR A DEBUG SESSION *)
    BEGIN
      WRITELN(FIL,VERSION);
      DATE(ID);
      WRITE(FIL,ID);
      TIME(ID);
      WRITELN(FIL,'    ',ID);
      WRITE(FIL,'PROGRAM NAME: ');
      WRITELN(FIL,GBASIS^[-2].IDPTR^.NAME);
    END (*WRITEHEADER*);

    PROCEDURE WRITESCALAR(VAR FIL: TEXT;FVAL:INTEGER; FSP: STP);
    (* WRITE OUT SCALAR,SUBRANGE OR POINTER WITH VALUE 'FVAL' AND TYPE 'FSP' *)
    VAR
      LCP: CTP; LENG,MAXVAL,MINVAL: INTEGER;
     BEGIN
      LENG:=0;
      IF FSP <> NIL
      THEN WITH FSP^ DO
       CASE FORM OF
	SCALAR:
	      IF SCALKIND=STANDARD
	      THEN
	       IF FSP=INTPTR
	       THEN
		 BEGIN
		  LENG := LENGTH(FVAL); WRITE(FIL, FVAL:LENG)
		 END
	       ELSE
		 IF FSP=REALPTR
		 THEN WITH REALCV DO
		   BEGIN
                    HEAD := FVAL; TAIL := NEXTBYTE;
		    WRITE(FIL, RVAL); LENG := 17
		   END
		 ELSE (*==>CHARPTR*)
		   BEGIN
		    IF FSP <> CHARPTR
		    THEN SYSTEMERROR(4)
		    ELSE
		     IF (FVAL<0) OR (FVAL>177B)
		     THEN
		       BEGIN
			WRITE(FIL,FVAL:6:O,'B',' (ILL. CHAR.)');LENG:=20;
		       END
		     ELSE
		       BEGIN
			IF (FVAL<40B) OR (FVAL=177B)
			THEN
			 BEGIN
			  IF FVAL = 177B
			  THEN FVAL := 40B;
 			  WRITE(FIL,FVAL:3:O,'B'); LENG := 4
			 END
			ELSE
			 BEGIN
			  WRITE(FIL,'''',CHR(FVAL),''''); LENG := 3
			 END
		       END;
		   END
	      ELSE (*SCALKIND==>DECLARED*)
	       BEGIN
		LCP := FCONST;
		IF FVAL >= 0
		THEN  WHILE LCP^.VALUES.IVAL > FVAL DO LCP := LCP^.NEXT;
		WITH LCP^ DO
		IF VALUES.IVAL <> FVAL
		THEN
		 BEGIN
		  WRITESCALAR(FIL,FVAL,INTPTR); WRITE(FIL,'(OUT OF RANGE)'); LENG := 14
		 END
		ELSE
		WRITENAME(FIL,NAME);
	       END;
	SUBRANGE:
	       BEGIN
		WRITESCALAR(FIL,FVAL,RANGETYPE); LENG := 0;
		IF NOT COMPTYPES(REALPTR,RANGETYPE)
		THEN
		 BEGIN
		  IF RANGETYPE<>INTPTR
		  THEN
		  GETBOUNDS(RANGETYPE,MINVAL,MAXVAL);
		  IF (FVAL <= MAXVAL) AND (FVAL >= MINVAL) OR (INTPTR=RANGETYPE)
		  THEN
		   BEGIN
		    GETBOUNDS(FSP,MINVAL,MAXVAL);
		    IF (FVAL > MAXVAL) OR (FVAL < MINVAL)
		    THEN
		     BEGIN
		      WRITE(FIL,'(OUT OF SUBRANGE)');
		      LENG:=17;
		     END (* IF ..>...<.. *);
		   END (* IF ..=<..=>..=.. *);
		 END (* IF COMPTYPES *);
	       END;
	POINTER:
	      IF FVAL = ORD(NIL)
	      THEN
	       BEGIN
		WRITE(FIL,'NIL'); LENG := 3
	       END
	      ELSE
	       BEGIN
		WRITE(FIL,FVAL:6:O,'B');
                WORDADDR(FVAL,FALSE);
		IF (FVAL < HEAPBOT) OR (FVAL > HEAPTOP)
		THEN
		 BEGIN
		  WRITE(FIL,'(OUT OF HEAP)');
		  LENG:=20;
		 END

		ELSE
		LENG:=7;
	       END;
	OTHERS:
	       SYSTEMERROR(5)
       END (*CASE*);
      CHCNT := CHCNT + LENG;
      TABS:=TRUE;
     END (*WRITESCALAR*);

    PROCEDURE WRITESTRUCTURE(VAR FIL: TEXT; FSP: STP );
    (* WRITE OUT THE VALUE(S) OF A VARIABLE DESCRIBED BY 'GATTR' AND TYPE 'FSP' *)
    CONST
      FDBSIZE = 48; (* SIZE IN WORDS OF FILE DESCRIPTOR BLOCK *)
    VAR
      INX, I : INTEGER;
      FDBADDR,LSPACE,CSIZE, CURRCOMPO, LMIN, LMAX, LENG: INTEGER;
      OATTR, LATTR: ATTR;
      ILLSTRING,NEXTEQ, LASTEQ, NOCOMMA: BOOLEAN;
      AAELTYPE,IINXTYPE : STP;


      PROCEDURE WRITEFIELDLIST(FNEXTFLD: CTP; FRECVAR: STP);
      (* WRITE OUT FIELDS OF RECORD VARIABLE DESCRIBED BY 'GATTR'.
         'FNEXTFIELD' IS ID OF FIRST FIELD, 'FRECVAR' TYPE OF FIRST VARIANT *)
      LABEL
	1;
      VAR
	LSP: STP;
        J,LMIN,LMAX : INTEGER;
	LATTR : ATTR;
	TAGF  : CTP;
       BEGIN
	LATTR := GATTR; TAGF := NIL;
	IF FRECVAR <> NIL
	THEN
	 IF FRECVAR^.FORM = TAGFWITHID
	 THEN TAGF := FRECVAR^.TAGFIELDP;
	WHILE (FNEXTFLD <> NIL) AND (FNEXTFLD <> TAGF) DO
	 BEGIN
	  NEWLINE(FIL);
	  GETFIELD(FNEXTFLD);
	  WITH FNEXTFLD^ DO
	   BEGIN
	    WRITENAME(FIL,NAME);WRITE(FIL,'=');
	    CHCNT:=CHCNT+1;
	    NL := TRUE;
	    LEFTSPACE:=LEFTSPACE+2;
	    WRITESTRUCTURE(FIL,IDTYPE);
	    LEFTSPACE:=LEFTSPACE-2;
	    FNEXTFLD := NEXT
	   END;
	  IF FNEXTFLD<>NIL
	  THEN
	  WITH FNEXTFLD^.IDTYPE^ DO
	  IF FORM=ARRAYS
	  THEN
           BEGIN
           GETBOUNDS(INXTYPE,LMIN,LMAX);
	  TABS:= TABS AND
	  COMPTYPES(AELTYPE , CHARPTR) AND
	  (LMAX-LMIN <= 20 )
         END
	  ELSE
	  TABS:=TABS AND (FORM<=POINTER)
	  ELSE
	  TABS:=FALSE;
	  GATTR := LATTR
	 END (*WHILE*);
	IF TAGF <> NIL
	THEN
	 BEGIN
	  WITH TAGF^ DO
	   BEGIN
	    NEWLINE(FIL);
	    WRITENAME(FIL,NAME);
	    WRITE(FIL,'=');
	    CHCNT:=CHCNT+1;
	    GETFIELD( TAGF );
	    J := NEXTBYTE;
	    WRITESCALAR(FIL,J, IDTYPE);
	    WRITE(FIL,' (TAGFIELD)');
	    CHCNT:=CHCNT+11;
	   END;
	  LSP := FRECVAR^.FSTVAR;
	  TABS:=FALSE;
	   LOOP
	    IF LSP = NIL
	    THEN
	     BEGIN
	      WRITE(FIL,'(NO CORRESP. VARIANT)'); GOTO 1
	     END
	   EXIT IF LSP^.VARVAL.IVAL = J;
	    LSP := LSP^.NXTVAR
	   END (*LOOP*);
	  WITH LSP^ DO
	   BEGIN
	    IF FORM <> VARIANT
	    THEN
	    SYSTEMERROR(6);
	    GATTR := LATTR;
	  WRITEFIELDLIST( FIRSTFIELD, SUBVAR );  
	    TABS:=FALSE;
	   END;
1:
	 END
       END (*WRITEFIELDLIST*);
       PROCEDURE RAD50TOASCII(VAR NAME: ALFA; INDEX,RAD50WORD: INTEGER);
       (* CONVERTS A RADIX 50B WORD INTO 3 ASCII CHARACTERS RETURNED IN
          NAME[INDEX..INDEX+2] *)
       VAR
         I,J,K,L: INTEGER;
       BEGIN (*RAD50TOASCII*)
         L := RAD50WORD;
         FOR I := INDEX+2 DOWNTO INDEX DO
          BEGIN
           K := L DIV 50B;
           IF K < 0
           THEN K := K+1638 (*= (2**16) DIV 50B *) ;
           J := L-K*50B;
           IF J < 0 
           THEN BEGIN
                 J := J+50B; K := K-1
                END;
           IF J = 0
           THEN CH := ' '
           ELSE IF (J >= 1B) AND (J <= 32B) (* LETTERS *)
                THEN CH := CHR(J+100B)
                ELSE IF (J >=36B) AND (J <=47B) (* DIGITS *)
                     THEN CH := CHR(J+22B)
                     ELSE IF J=33B
                          THEN CH := '$'
                          ELSE IF J=34B
                               THEN CH := '.'
                               ELSE CH := '?';
           NAME[I] := CH;
           L := K
          END;
     END (*RAD50TOASCII*);
 
     BEGIN (*WRITESTRUCTURE*)
      IF FSP <> NIL
      THEN WITH FSP^ DO
      IF FORM <= POINTER
      THEN  WRITESCALAR (FIL, NEXTBYTE, FSP )
      ELSE
       BEGIN
	LATTR := GATTR;
	WITH GATTR DO
	 BEGIN
	   CASE FORM OF
	    POWER:
		   BEGIN
		    NOCOMMA := TRUE; WRITE(FIL, '['); LENG := 1;
		    WITH SETCV DO
		     BEGIN
                      CONST2 := 0; CONST3 := 0; CONST4 := 0;
                      CONST1 := BASIS^[GADDR].CONT;
                      IF SIZE > 2
                      THEN BEGIN
                            CONST2 := BASIS^[GADDR+1].CONT;
                            CONST3 := BASIS^[GADDR+2].CONT;
                            CONST4 := BASIS^[GADDR+3].CONT;
                           END;
		      FOR INX := 0 TO SETMAX DO
		      IF INX IN MASK
		      THEN
		       BEGIN
			IF NOCOMMA
			THEN NOCOMMA := FALSE
			ELSE WRITE(FIL,',');
			LENG := LENG + 1;
			IF COMPTYPES(ELSET,CHARPTR)
			THEN I := INX + OFFSET
			ELSE I := INX;
			WRITESCALAR(FIL,I,ELSET)
		       END
		     END (*WITH SETCV*);
		    WRITE(FIL,']' ); CHCNT := CHCNT + LENG;
		    TABS:=FALSE;
		   END (*POWER*);
        STRINGPARM,
	    ARRAYS:
                   BEGIN
                    IF FORM = STRINGPARM
                    THEN BEGIN
                          LENG := BASIS^[GADDR].CONT;
                          GADDR := BASIS^[GADDR+1].CONT;
                          WORDADDR(GADDR,FALSE);
                          AAELTYPE := CHARPTR;
                          IINXTYPE := INTPTR;
                          LMIN := 0;
                          LMAX := LENG-1;
                         END
                    ELSE BEGIN (* FORM = ARRAYS *)
                          GETBOUNDS(INXTYPE,LMIN,LMAX);
                          LENG := LMAX-LMIN+1;
                          AAELTYPE := AELTYPE;
                          IINXTYPE := INXTYPE;
                         END;
                    CSIZE := (AAELTYPE^.SIZE+1) DIV 2;
		    ILLSTRING:=FALSE;
		    IF COMPTYPES(AAELTYPE , CHARPTR) AND (LENG<=MAXSTRGUB+1)
		    THEN
		     BEGIN
		      POINTERCV.CONT := GADDR*2; (*BYTE ADDRESS*)
		      INX:=0;
		      WITH POINTERCV DO
		      WHILE (INX<LENG) AND NOT ILLSTRING DO
		      IF (STRINGP^[INX] < CHR(40B (*' '*))) OR (STRINGP^[INX] > CHR(176B ))
		      THEN ILLSTRING := TRUE
		      ELSE INX:=INX+1;
                      IF ILLSTRING
		      THEN
		       BEGIN
			WRITE(FIL,'STRING CONTAINS ILLEGAL CHAR');
			TABS:=FALSE;
			LEFTSPACE:=LEFTSPACE+2;
			NEWLINE(FIL);
			WRITE(FIL,'THE COMPONENTS ARE:');
			NL:=TRUE;
		       END;
		     END (* TEST ILLSTRING *);
		    IF COMPTYPES(AAELTYPE , CHARPTR) AND (LENG<=MAXSTRGUB+1) AND NOT ILLSTRING
		    THEN (*STRING*)
		     BEGIN
		      WRITE ( FIL,  '''',  POINTERCV.STRINGP^ : LENG,  '''' ) ;
		      CHCNT := CHCNT + LENG + 2;
		      TABS:= (LENG <= 20);
		     END (*STRING*)
		    ELSE
		     BEGIN
		      TABS:=FALSE;
		      PACKFG:=PACKOPT OR COMPTYPES(AAELTYPE,CHARPTR);
                      IF PACKFG
                      THEN IF COMPTYPES(AAELTYPE,BOOLPTR)
                           THEN BEGIN
                                 GPACKSIZE:=1; GBITCOUNT:=0
                                END
                           ELSE BEGIN
                                 GPACKSIZE:=8;
                                 GBITCOUNT:=0
                                END;
		      LASTEQ:=FALSE;
		      FOR INX:= LMIN TO LMAX DO
		       BEGIN
			IF INX=LMAX
			THEN NEXTEQ:=FALSE
			ELSE
			 IF (AAELTYPE^.FORM <= POINTER) AND (AAELTYPE <> REALPTR)
			 THEN
			   BEGIN
			    OATTR:=GATTR;
			    CURRCOMPO:=NEXTBYTE;
			    NEXTEQ:=CURRCOMPO = NEXTBYTE;
			    GATTR:=OATTR;
			   END
			 ELSE
			   BEGIN
			    NEXTEQ:=TRUE;I:=0;
			     LOOP
                              NEXTEQ := (BASIS^[GADDR+I].CONT=BASIS^[GADDR+CSIZE+I].CONT);
                             EXIT IF NOT NEXTEQ OR (I=CSIZE-1);
                              I := I+1
                             END
                           END;
                        IF NOT (LASTEQ AND NEXTEQ)
                        THEN BEGIN
                              IF NL
                              THEN NEWLINE(FIL)
                              ELSE NL := TRUE;
                              WRITE(FIL,'[');
                              WRITESCALAR(FIL,INX,IINXTYPE);
                              WRITE(FIL,']');
                              CHCNT := CHCNT+2;
                             END;
                        IF NOT NEXTEQ
			THEN
			 BEGIN
			  WRITE(FIL,'=');CHCNT:=CHCNT+1;
			  LEFTSPACE:=LEFTSPACE + 3;
			  NL:=TRUE;
			  WRITESTRUCTURE(FIL,AAELTYPE);
			  LEFTSPACE:=LEFTSPACE - 3;
			 END
			ELSE
			 BEGIN
			  IF NOT LASTEQ
			  THEN
			   BEGIN
			    WRITE(FIL,'..');
			    CHCNT:=CHCNT+2;
			    NL:=FALSE;
			   END;
			  IF (AAELTYPE^.FORM <= POINTER) AND (AAELTYPE <> REALPTR)
			  THEN CURRCOMPO:=NEXTBYTE
			  ELSE GADDR:=GADDR+CSIZE;
			 END (* NEXTEQ *);
			LASTEQ:=NEXTEQ;
		       END (* FOR *);
		      TABS:=FALSE;
		      IF ILLSTRING
		      THEN LEFTSPACE := LEFTSPACE - 2;
		     END (* NOT STRING *);
		   END (*ARRAYS*);
	    RECORDS:
		   BEGIN
		    WRITE(FIL,'RECORD');
		    LSPACE := LEFTSPACE; LEFTSPACE := CHCNT + 1;
		    TABS:=FALSE;
		    WRITEFIELDLIST(FSTFLD,RECVAR);
		    TABS:=FALSE;
		    LEFTSPACE := LEFTSPACE - 1; NEWLINE(FIL);
		    WRITE(FIL,'END');
		    LEFTSPACE := LSPACE;
		   END;
            FILES:
                   BEGIN
                    FDBADDR := GADDR-FDBSIZE-4;
                    TABS := FALSE;
                    (* FILE OPENED IF BYTE 34 IN FDB <> 0 *)
                    BYTECV.INTCONST := BASIS^[FDBADDR+17].CONT;
                    IF ORD(BYTECV.BYTES[0]) <> 0
                    THEN BEGIN
                          (* FILE IS OPEN *)
                          NEWLINE(FIL);
                          (* WRITE EXTERNAL FILE NAME *)
                          WRITE(FIL,'FILENAME= '); CHCNT := CHCNT+10;
                          INX := 1;
                          FOR I := 0 TO 2 DO
                          BEGIN
                           RAD50TOASCII(ID,INX,BASIS^[FDBADDR+36+I].CONT);
                           INX := INX+3
                          END;
                          ID[10] := ' ';
                          WRITENAME(FIL,ID);
                          (* EXTENTION *)
                          WRITE(FIL,'.'); CHCNT := CHCNT+1;
                          ID := '          ';
                          RAD50TOASCII(ID,1,BASIS^[FDBADDR+39].CONT);
                          WRITENAME(FIL,ID);
                          (* VERSION *)
                          WRITE(FIL,';'); CHCNT := CHCNT+1;
                          WRITESCALAR(FIL,BASIS^[FDBADDR+40].CONT,INTPTR);
                          NEWLINE(FIL);
                          TABS := TRUE;
                          WRITE(FIL,'IOSELECT= ['); CHCNT := CHCNT+11;
                          BYTECV.INTCONST := BASIS^[GADDR-1].CONT;
                          NOCOMMA := TRUE;
                          FOR I := 0 TO 7 DO
                           IF BYTECV.BITS[I]
                           THEN BEGIN
                                 IF NOCOMMA
                                 THEN NOCOMMA := FALSE
                                 ELSE BEGIN
                                       WRITE(FIL,','); CHCNT := CHCNT+1;
                                      END;
                                 CASE I OF
                                  0: ID := 'RANDOM    ';
                                  1: ID := 'UPDATE    ';
                                  2: ID := 'APPEND    ';
                                  3: ID := 'TEMPORARY ';
                                  4: ID := 'INSERT    ';
                                  5: ID := 'SHARED    ';
                                  6: ID := 'SPOOL     ';
                                  7: ID := 'BLOCK     '
                                 END (* CASE *);
                                 WRITENAME(FIL,ID)
                                END;
                          WRITE(FIL,']'); CHCNT := CHCNT+1;
                          NEWLINE(FIL);
                          WRITE(FIL,'IORESULT= '); CHCNT := CHCNT+10;
                          WRITESCALAR(FIL,BASIS^[GADDR-2].CONT,INTPTR);
                          NEWLINE(FIL);
                          WRITE(FIL,'EOF= '); CHCNT := CHCNT+5;
                          WRITESCALAR(FIL,BASIS^[GADDR-3].CONT,BOOLPTR);
                          NEWLINE(FIL);
                          WRITE(FIL,'EOLN= '); CHCNT := CHCNT+6;
                          WRITESCALAR(FIL,BASIS^[GADDR-4].CONT,BOOLPTR);
                          NEWLINE(FIL);
                          WRITE(FIL,'COMPONENT= '); CHCNT := CHCNT+11;
                          GADDR := BASIS^[GADDR].CONT;
                          IF TYPTR^.FILTYPE = CHARPTR
                          THEN BEGIN
                                PACKFG := TRUE;
                                GPACKSIZE := 8;
                                IF ODD(GADDR)
                                THEN GBITCOUNT := 8
                                ELSE GBITCOUNT := 0;
                               END;
                          WORDADDR(GADDR,FALSE);
                          TYPTR := TYPTR^.FILTYPE;
                          WRITESTRUCTURE(FIL,TYPTR);
                         END
                    ELSE WRITE(FIL,'FILE NOT OPENED');
                   END (* FILES *)
           END (* CASE FORM *)
	 END (*WITH GATTR*);
	GATTR := LATTR;
	WITH GATTR DO
	 BEGIN
	  GADDR := GADDR + SIZE DIV 2; GBITCOUNT := 0
	 END
       END (*IF FORM > POINTER*)
     END (* WRITESTRUCTURE *);

    PROCEDURE ASSIGNMENT;
    VAR
      LATTR: ATTR;
      LSP: STP;
      SIZE,BYTE,I: INTEGER;
     BEGIN
      INSYMBOL;
      if sy <> ident
      then begin
            error; writeln(tty,'variable expected')
           end
      else
      begin
      VARIABLE;
      IF GATTR.KIND <> VARBL
      THEN BEGIN
            ERROR; WRITELN(TTY,'assignment allowed to variables only')
           END
           else if sy <> becomes
                then begin
                      error; writeln(tty,'":=" expected')
                     end
      ELSE BEGIN
            LATTR := GATTR;
            insymbol;
            EXPRESSION;
            insymbol;
            IF SY <> EOLSY
            THEN BEGIN
                  ERROR; WRITELN(TTY,'<EOL> EXPECTED')
                 END
            ELSE IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)
                 THEN BEGIN
                       IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL)
                       THEN IF LATTR.PACKFG
                            THEN BEGIN
                                  LOAD;
                                  BYTE := GATTR.CVAL.IVAL;
                                  GATTR := LATTR;
                                  PUTNEXTBYTE(BYTE);
                                 END
                            ELSE IF GATTR.KIND <> VARBL
                                 THEN IF GATTR.TYPTR = REALPTR
                                      THEN
                                       WITH REALCV DO
                                       BEGIN
                                        RVAL := GATTR.CVAL.RVAL;
                                        BASIS^[LATTR.GADDR].CONT:=HEAD;
                                        BASIS^[LATTR.GADDR+1].CONT:=TAIL
                                       END
                                      ELSE
                                       IF LATTR.TYPTR^.FORM = POWER
                                       THEN WITH SETCV DO
                                            BEGIN
                                             MASK := GATTR.CVAL.PVAL;
                                             BASIS^[LATTR.GADDR].CONT := CONST1;
                                             IF LATTR.TYPTR^.SIZE > 2
                                             THEN BEGIN
                                                   BASIS^[LATTR.GADDR+1].CONT := CONST2;
                                                   BASIS^[LATTR.GADDR+2].CONT := CONST3;
                                                   BASIS^[LATTR.GADDR+3].CONT := CONST4
                                                  END
                                            END
                                      ELSE BASIS^[LATTR.GADDR].CONT:=GATTR.CVAL.IVAL
                                 ELSE IF GATTR.PACKFG
                                      THEN BASIS^[LATTR.GADDR].CONT:=NEXTBYTE
                                      ELSE BEGIN (* BOTH NON PACKED VARS *)
                                            SIZE:=(LATTR.TYPTR^.SIZE+1) DIV 2;
                                            FOR I:=0 TO SIZE-1 DO
                                             BASIS^[LATTR.GADDR+I].CONT:= BASIS^[GATTR.GADDR+I].CONT;
                                           END;
                      END (* IF COMPTYPES *)
                 ELSE BEGIN
                       ERROR; WRITELN(TTY,'TYPE-CONFLICT IN ASSIGNMENT')
                      END
           end
           END
     END (* ASSIGNMENT *);

    PROCEDURE LISTBREAKS;
    (* EXECUTE 'LIST BREAKS' COMMAND *)
    VAR
      BP,LINENR: INTEGER;
    BEGIN
     INSYMBOL;
     IF SY <> EOLSY
     THEN BEGIN
           ERROR;
           WRITELN(TTY,'<EOL> EXPECTED')
          END
     ELSE FOR BP := 1 TO BPLAST DO
           BEGIN
            LINENR := BPTABLE[BP].LINENUM;
            WRITELN(TTY,'  ',LINENR: LENGTH(LINENR))
           END;
    END (*LISTBREAKS*);

    PROCEDURE SETCANCELBREAKS(COM: COMMAND);
    (* EXECUTE 'SET BREAKS' (COM = SETBP) OR 'CANCEL BREAKS' (COM =  = CANCELBP) *)
    VAR
      LINENR,CODEADDRESS,RES: INTEGER;
      BP,BP1: 0..BPMAX;
      FOUND: BOOLEAN;

    PROCEDURE SEARCHBPTABLE(VAR FOUND: BOOLEAN; VAR INDEX: INTEGER; LINENR: INTEGER);
    (* SEARCH BPTABLE FOR A MATCH WITH 'LINENR' AND RETURN RESULT
       IN 'FOUND' AND 'INDEX'.
       IF FOUND BPTABLE[INDEX] HOLDS RECORD SEARCHED
       OTHERWISE BPTABLE[INDEX] IS FIRST FREE RECORD *)
    VAR
      I: INTEGER;
      CYCLE: BOOLEAN;
    BEGIN (* SEARCHBPTABLE *)
     I := BPLAST;
     CYCLE := TRUE; FOUND :=FALSE;
     WHILE (I > 0) AND CYCLE DO
      IF BPTABLE[I].LINENUM > LINENR
      THEN I := I-1
      ELSE CYCLE := FALSE;
     IF I > 0
     THEN FOUND := BPTABLE[I].LINENUM=LINENR;
     IF FOUND
     THEN INDEX := I
     ELSE INDEX := I+1
    END (*SEARCHBPTABLE*);

    BEGIN (*SETCANCELBREAKS*)
     INSYMBOL;
     REPEAT
      IF SY = INTCONST
      THEN BEGIN
            LINENR := VAL.IVAL;
            SEARCHBPTABLE(FOUND,BP,LINENR);
            IF COM = CANCELBP
            THEN IF FOUND
                 THEN BEGIN (* CANCEL BREAKPOINT *)
                       WITH BPTABLE[BP] DO
                        BEGIN
                         LINENUM := 0;
                         CLRBRP(CODEADDR);
                         CODEADDR := 0
                        END;
                       (* COMPRESS TABLE *)
                       BPLAST := BPLAST - 1;
                       FOR BP1:= BP TO BPLAST DO
                           BPTABLE[BP1] := BPTABLE[BP1+1]
                       END
                  ELSE BEGIN
                        ERROR;
                        WRITELN(TTY,'WAS NOT SET')
                       END
             ELSE (* COM = SETBP *)
                  IF FOUND
                  THEN BEGIN
                        ERROR;
                        WRITELN(TTY,'WAS ALREADY SET')
                       END
                  ELSE IF BPLAST = BPMAX
                       THEN BEGIN
                             ERROR;
                             WRITELN(TTY,'TOO MANY BREAK POINTS');
                             WHILE SY <> EOLSY DO INSYMBOL
                            END
                       ELSE BEGIN
                             SETBRP(LINENR,CODEADDRESS,RES);
                             IF RES > 0
                             THEN BEGIN
                                   ERROR;
                                   IF RES = 1
                                   THEN WRITELN(TTY,'LINENR TOO LARGE')
                                   ELSE WRITELN(TTY,'BREAK NOT POSSIBLE. NEXT POSSIBLE LINE IS: ',LINENR:5)
                                  END
                             ELSE BEGIN
                                   (* UPDATE BPTABLE *)
                                   FOR BP1 := BPLAST DOWNTO BP DO
                                    BPTABLE[BP1+1] := BPTABLE[BP1];
                                   BPLAST := BPLAST + 1;
                                   WITH BPTABLE[BP] DO
                                    BEGIN
                                     LINENUM := LINENR;
                                     CODEADDR := CODEADDRESS
                                    END
                                  END
                            END
           END
      ELSE BEGIN
            ERROR;
            WRITELN(TTY,'LINENR EXPECTED')
           END;
    
      INSYMBOL;
      IF SY = COMMASY
      THEN INSYMBOL
      ELSE IF SY <> EOLSY
           THEN BEGIN
                 ERROR;
                 WRITELN(TTY,'<EOL> OR "," EXPECTED');
                 WHILE SY <> EOLSY DO INSYMBOL
                END;

     UNTIL SY = EOLSY;

    END (*SETCANCELBREAKS*);

    PROCEDURE TRACEOUT;
    (* EXECUTE 'TRACE CALLSEQUENCE' COMMAND.
      LIST NAMES OF ALL PROCEDURES PRESENT ON STACK FOLLOWING DYNAMIC LINKS.
        LIST IS GENERATED IN REVERSE ORDER OF CALL *)
     VAR LINENR: INTEGER;
     BEGIN
      WRITELN(TTY);
      WRITELN(TTY,'  PROC/FUNC    CALLED IN LINE');
      WHILE ORD(BASIS) <> ORD(GBASIS) DO
       BEGIN
        IF BASIS^[-2].IDPTR=NIL
        THEN WRITE(TTY,'  UNKNOWN   ')
        ELSE WRITE(TTY,'  ',BASIS^[-2].IDPTR^.NAME);
        LINENR := BASIS^[-3].CONT;
        WRITELN(TTY,'   ',LINENR:LENGTH(LINENR));
        SUCCBASIS(DYNAMIC)
       END;
      WRITELN(TTY,'  MAIN')
     END (*TRACEOUT*);

    PROCEDURE ONEVAROUT(VAR FIL: TEXT;LCP:CTP);
    (* WRITE OUT NAME AND VALUE OF VARIABLE WITH ID POINTER 'LCP' *)
     BEGIN
      WITH LCP^,GATTR DO

       BEGIN
	KIND:=VARBL;
        TYPTR:=IDTYPE;
        GADDR:=VADDR+ORD(SAVEBASIS);
        IF (VKIND=FORMAL) AND (TYPTR^.FORM<>STRINGPARM)
	THEN
        BEGIN
        WORDADDR(GADDR,TRUE);
	IF TYPTR<>NIL THEN GADDR:=NULLPTR^[GADDR].CONT ;
        END;
        IF IDTYPE^.FORM = ARRAYS
        THEN GADDR := GADDR + IDTYPE^.ADDRCORR; (*TRUE ADDRESS*)
        WORDADDR(GADDR,TRUE);
        PACKFG := FALSE;
        GPACKSIZE := 0;
        GBITCOUNT := 0;
	WRITENAME(FIL,NAME);
	WRITE(FIL,'=');
	CHCNT:=CHCNT+1;
	IF IDTYPE^.FORM > POWER
	THEN
	 BEGIN
	  NL:=TRUE;
	  LEFTSPACE:=2;
	 END;
	WRITESTRUCTURE(FIL,IDTYPE);
	IF IDTYPE^.FORM >= POWER
	THEN
	 BEGIN
	  LEFTSPACE:=0;
	  TABS:=FALSE;
	  NEWLINE(FIL);
	 END;
	NEWLINE(FIL);
       END (* WITH *);
     END (* ONEVAROUT *);

    PROCEDURE SECTIONOUT(VAR FIL: TEXT;LCP:CTP;FFORMSET:FORMSET);
    (* WRITE OUT NAME AND VALUE OF ALL VARIABLES IN IDTREE POINTED
       AT BY 'LCP' AND WHOSE TYPE FORM IS IN 'FFORMSET' *)
     BEGIN (*SECTIONOUT*)
      WITH LCP^ DO
       BEGIN
	IF LLINK<>NIL
	THEN
	SECTIONOUT(FIL,LLINK,FFORMSET);
	IF (KLASS=VARS) AND (IDTYPE^.FORM IN FFORMSET)
	THEN
	ONEVAROUT(FIL,LCP);
	IF RLINK<>NIL
	THEN
	SECTIONOUT(FIL,RLINK,FFORMSET);
       END (* WITH *);
     END (* SECTIONOUT *);

    PROCEDURE LISTVAR;
    (* EXECUTE 'EXAMINE' COMMAND *)
     BEGIN
      INSYMBOL;
      IF SY = IDENT
      THEN BEGIN
            VARIABLE;
            IF SY <> EOLSY
            THEN BEGIN
                  ERROR; WRITELN(TTY,'<EOL> EXPECTED')
                 END
            ELSE WITH GATTR DO
                  IF TYPTR <> NIL
                  THEN BEGIN
                        CHCNT := 0;
                        write(tty,'  ');
                        LEFTSPACE := 0;
                        NL := FALSE;
                        IF KIND <> VARBL
                        THEN IF TYPTR^.FORM = ARRAYS
                             THEN BEGIN (* STRING CONSTANT *)
                                   GADDR := CVAL.IVAL+4; (* = BASE OF SVAL *)
                                   WORDADDR(GADDR,FALSE);
                                   BASIS := NULLPTR;
                                   PACKFG := FALSE;
                                   GPACKSIZE := 0;
                                   GBITCOUNT := 0;
                                   KIND := VARBL;
                                   WRITESTRUCTURE(TTY,TYPTR)
                                  END
                             ELSE IF TYPTR = REALPTR
                                  THEN (* REAL CONSTANT *)
                                       WRITE(TTY,CVAL.RVAL)
                                  ELSE (* SCALAR CONSTANT *)
                                       WRITESCALAR(TTY,CVAL.IVAL,TYPTR)
                        ELSE WRITESTRUCTURE(TTY,TYPTR);
                        WRITELN(TTY)
                       END
           END
      ELSE BEGIN
            ERROR; WRITELN(TTY,'VARIABLE EXPECTED')
           END
     END (*LISTVAR*);

    PROCEDURE STACKOUT(VAR FIL: TEXT);
    (* EXECUTE 'DUMP STACK' COMMAND 
     TRACE STACK AND LIST LOCAL VARIABLES OF ALL ACTIVE PROCS *)
    VAR
      CALLCNT: INTEGER;
      TREEPNT: CTP;
      LINK: LINKTYPE;
      KEEPBASIS: ACR;
      I,J: INTEGER;
      LESSEQ: BOOLEAN;
     BEGIN
      CHCNT := 0;
      CALLCNT := 1;
      TABS := FALSE;
      LINK := DYNAMIC;
      BASIS := LBASIS;
      KEEPBASIS := GBASIS;
            WRITELN(FIL);
            WRITELN(FIL,'  VARIABLES OF CALLED PROCEDURES/FUNCTIONS');
            WRITELN(FIL,'  ========================================');
            WRITELN(FIL);
            
            LOOP
             SAVEBASIS := BASIS;
             BASIS := NULLPTR;
             TREEPNT := SAVEBASIS^[-2].IDPTR;
             IF SAVEBASIS = GBASIS
             THEN WRITELN(FIL,'  * * * * MAIN * * * *')
             ELSE IF TREEPNT = NIL
                  THEN WRITELN(FIL,'  PROC/FUNC UNKNOWN')
                  ELSE IF TREEPNT^.KLASS = FUNC
                       THEN WRITELN(FIL,'  FUNCTION  ',TREEPNT^.NAME)
                       ELSE WRITELN(FIL,'  PROCEDURE ',TREEPNT^.NAME);
             IF SAVEBASIS = GBASIS
             THEN WRITELN(FIL,'  --------------------')
             ELSE WRITELN(FIL,'  ---------'); 
             NEWLINE(FIL);
             I := ORD(SAVEBASIS);
             J := ORD(KEEPBASIS);
             IF ((I>=0) AND (J>=0)) OR ((I<0) AND (J<0))
             THEN LESSEQ := I<=J
             ELSE LESSEQ := I>=0;
             IF LESSEQ AND (LINK=STATIC)
             THEN WRITELN(FIL,'  CONTENT ALREADY LISTED')
             ELSE IF TREEPNT = NIL
                  THEN WRITELN(FIL,'  VARIABLES UNKNOWN')
                  ELSE
                  BEGIN
                  TREEPNT := TREEPNT^.LLINK;
                  IF TREEPNT = NIL
                  THEN WRITELN(FIL,'  +++ NO VARIABLES +++')
                  ELSE BEGIN
                        SECTIONOUT(FIL,TREEPNT,[SCALAR,SUBRANGE,POINTER]);
                        TABS := FALSE;
                        IF CHCNT <> 0
                        THEN NEWLINE(FIL);
                        NEWLINE(FIL);
                        SECTIONOUT(FIL,TREEPNT,[POWER,ARRAYS,RECORDS,FILES,STRINGPARM]);
                        TABS := FALSE;
                       END;
                  END;
           WRITELN(FIL);
          EXIT IF SAVEBASIS = GBASIS;
           IF CALLCNT = 10
           THEN BEGIN
                 WRITELN(FIL,'  SINCE THERE ARE MORE THAN 10 DYNAMIC NESTED PROCS/FUNCS');
                 WRITELN(FIL,'  NOW ONLY VARIABLES OF STATIC NESTED PROCS/FUNCS WILL BE LISTED');
                 WRITELN(FIL);
                 WRITELN(FIL,'  VARIABLES OF STATIC NESTED PROCEDURES/FUNCTIONS');
                 WRITELN(FIL,'  ===============================================');
                 WRITELN(FIL);
                 LINK := STATIC;
                 KEEPBASIS := SAVEBASIS;
                 TABS := FALSE;
                 BASIS := LBASIS;
                 CALLCNT := CALLCNT + 1;
                END
           ELSE BEGIN
                 CALLCNT := CALLCNT + 1;
                 BASIS := SAVEBASIS;
                 SUCCBASIS(LINK)
                END
            END (*LOOP*)
     END (*STACKOUT*);
 
    PROCEDURE HEAPOUT(VAR FIL: TEXT);
    (* EXECUTE 'DUMP HEAP' COMMAND
       LIST ALL VARIABLES ALLOCATED ON HEAP *)
    VAR
      CHEAP: ACR;
      VALTYPE: STP;
     BEGIN (*HEAPOUT*)
            WRITELN(FIL);
            WRITELN(FIL,'  HEAP CONTENTS');
            WRITELN(FIL,'  =============');
            WRITELN(FIL);
            TABS := FALSE;
            CHCNT := 0;
            CHEAP := LHEAP;
            BASIS := NULLPTR;
            IF LHEAP = NIL
            THEN WRITELN(FIL,'  NO VARIABLES ALLOCATED IN D+ SECTION');
            WHILE CHEAP <> NIL DO
             BEGIN
              NEWLINE(FIL);
              WRITE(FIL,(ORD(CHEAP)+4):6:O,'B^=');
              CHCNT := CHCNT + 10;
              VALTYPE := CHEAP^[1].STPTR; (*POINTS AT TYPE OF VALUE*)
              IF VALTYPE = NIL
              THEN BEGIN
                    NEWLINE(FIL);
                    WRITELN(FIL,'  TYPE OF VARIABLE UNKNOWN')
                   END
              ELSE BEGIN
                    WITH GATTR DO
                     BEGIN
                      TYPTR := VALTYPE;
                      KIND := VARBL;
                      PACKFG := FALSE;
                      GPACKSIZE := 0;
                      GBITCOUNT := 0;
                      GADDR := ORD(CHEAP);
                      WORDADDR(GADDR,FALSE);
                      GADDR := GADDR+2;
                     END;
                    NL := TRUE;
                    WRITESTRUCTURE(FIL,VALTYPE)
                   END;
              TABS := FALSE;
              NEWLINE(FIL);
              CHEAP := CHEAP^[0].STACKP
             END (*WHILE*);
            WRITELN(FIL);
     END (*HEAPOUT*);

    PROCEDURE DECIDEFILE(VAR FILEOUTPUT: BOOLEAN);
    (* DECIDE WHETHER DUMP SHALL GO TO FILE OUTPUT (TRUE)
       OR TO FILE TTY (FALSE) *)
    LABEL
      1;
    VAR
      NAME: ALFA;
      I: INTEGER;
    BEGIN (*DECIDEFILE*)
     1: WHILE SY<>EOLSY DO INSYMBOL;
      WRITELN(TTY);
      WRITE(TTY,'  DO YOU WANT DUMP ON SEPARATE FILE (TYPE: Y) OR HERE (TYPE: N) ? ');
      BREAK(TTY);
      READLN(TTY);
      CH:=' ';
      CHCNT:=0;
      INSYMBOL;
      IF SY=IDENT
      THEN IF ID[1]='Y'
           THEN FILEOUTPUT:=TRUE
           ELSE IF ID[1]='N'
                THEN FILEOUTPUT:=FALSE
                ELSE GOTO 1
      ELSE GOTO 1;
      WHILE SY<>EOLSY DO INSYMBOL;

      IF FILEOUTPUT
      THEN BEGIN
            IF FILEISOPEN
            THEN PAGE(OUTPUT)
            ELSE BEGIN
                  FILENAME:='              ';
                  NAME:=GBASIS^[-2].IDPTR^.NAME;
                  I:=1;
                  LOOP
                    FILENAME[I]:=NAME[I];
                   EXIT IF (NAME[I]=' ') OR (I>=9);
                    I:=I+1
                  END (*LOOP*);
                  IF NAME[I]=' ' THEN I:=I-1;
                  FILENAME[I+1]:='.'; FILENAME[I+2]:='D';
                  FILENAME[I+3]:='M'; FILENAME[I+4]:='P';
                  REWRITE(OUTPUT,FILENAME);
                  FILEISOPEN:=TRUE;
                 END;
            WRITELN(OUTPUT);
            WRITEHEADER(OUTPUT);
            WRITELN(OUTPUT); WRITELN(OUTPUT);
           END;
    END (*DECIDEFILE*);

    PROCEDURE READCOM( VAR COM: COMMAND);
    (* READ AND ANALYSE USER COMMAND FROM TTY *)
    VAR
      KW1,KW2: KEYWORD;

      FUNCTION READKEYWRD( VAR KEY: KEYWORD) : BOOLEAN;
      (* READ NEXT KEYWORD FROM TTY *)
      LABEL
        1;
      VAR
        I: INTEGER;
        FOUND: BOOLEAN;
        K: KEYWORD;
       BEGIN (*READKEYWRD*)
        INSYMBOL;
        IF (SY = IDENT) AND (LGTH >= 2)
        THEN
         BEGIN
          FOUND := FALSE;
          FOR K:= EXAMKW TO EXECKW DO
           BEGIN
            I :=1; FOUND := TRUE;
            WHILE (I <= LGTH) AND FOUND DO
             IF ID[I] <> KWID[K][I]
             THEN FOUND := FALSE
             ELSE I := I+1;
            IF FOUND THEN GOTO 1;
           END;
     1:   READKEYWRD := FOUND;
          IF FOUND THEN KEY := K;
         END
        ELSE READKEYWRD := FALSE
       END (* READKEYWRD *);

     BEGIN (* READCOM *)
      COM := NOCOMMAND;
      IF READKEYWRD(KW1)
      THEN
       CASE KW1 OF
        EXAMKW  :  COM := EXAMINE;
        DEPKW   :  COM := DEPOSIT;
        CONTINKW:  COM := CONTINUE;
        COMMENTKW: COM := COMMENT;
        TRACEKW :  IF READKEYWRD(KW2)
                   THEN IF KW2 = CALLSKW
                        THEN COM := TRACECALL;
        LISTKW,
        SETKW   :  IF READKEYWRD(KW2)
                   THEN IF KW2 = BREAKKW
                        THEN IF KW1 = SETKW
                             THEN COM := SETBP
                             ELSE COM := LISTBP;
        DUMPKW  :  IF READKEYWRD(KW2)
                   THEN IF KW2 = STACKKW
                        THEN COM := STACKDUMP
                        ELSE IF KW2 = HEAPKW
                             THEN COM := HEAPDUMP;
        CANCELKW:  IF READKEYWRD(KW2)
                   THEN IF KW2 = BREAKKW
                        THEN COM := CANCELBP
                        ELSE IF KW2 = EXECKW
                             THEN COM := CANCELEXEC;
        OTHERS  :  COM := NOCOMMAND
       END (* CASE *);
     END (* READCOM *);

   BEGIN (* DEBUG *)
    MARK;
    WRITELN(TTY);
    CHCNT:=0;
    BASIS := LBASIS;
    HEAPTOP := GBASIS^[4].CONT;
    WORDADDR(HEAPTOP,FALSE);
    WORDADDR(STACKTOP,FALSE);
    ACTLINENR := GBASIS^[1].CONT;
    CASE CAUSE OF
     INITC  : BEGIN
               INIT;
               WRITEHEADER(TTY);
              END;
     BREAKC : BEGIN
               WRITE(TTY,'BREAK IN ');
               WRITEPRONAME(TTY);
               WRITELN(TTY,' AT LINE ',ACTLINENR:LENGTH(ACTLINENR))
              END;
     OTHERS : BEGIN
               IF CAUSE = HALTC
               THEN WRITE(TTY,'BREAK BY HALT IN ')
               ELSE WRITE(TTY,'BREAK BY RUNTIME ERROR IN ');
               WRITEPRONAME(TTY);
               WRITELN(TTY,' IN LINE ',ACTLINENR:LENGTH(ACTLINENR));
               CASE CAUSE OF
                ODDADDRC  : WRITELN(TTY,'ODD ADDRESS');
                MEMPROTC  : WRITELN(TTY,'MEMORY PROTECTION VIOLATION');
                PRIVINSTC : WRITELN(TTY,'ATTEMPT TO EXECUTE PRIVILEGED INSTRUCTION');
                EMTC      : WRITELN(TTY,'ATTEMPT TO EXECUTE EMT-INSTRUCTION');
                TRPC      : WRITELN(TTY,'ATTEMPT TO EXECUTE TRP-INSTRUCTION');
                FPPC      : WRITELN(TTY,'FLOATING-POINT ARITHMETIC ERROR');
                OTHERS    :
               END (*CASE*);
              END
    END (*CASE*);

   REPEAT
      WRITE(TTY,'? ');
      BREAK(TTY);
      READLN(TTY);
      CH := ' ';
      CHCNT := 0;
      BASIS := LBASIS;
      READCOM(COM);
      CASE COM OF
       LISTBP    :  LISTBREAKS;
       SETBP,
       CANCELBP  :  SETCANCELBREAKS(COM);
       TRACECALL :  TRACEOUT;
       EXAMINE   :  LISTVAR;
       DEPOSIT   :  ASSIGNMENT;
       STACKDUMP,
       HEAPDUMP  :  BEGIN
                     DECIDEFILE(FILEOUTPUT);
                     IF COM=STACKDUMP
                     THEN IF FILEOUTPUT
                          THEN STACKOUT(OUTPUT)
                          ELSE STACKOUT(TTY)
                     ELSE IF FILEOUTPUT
                          THEN HEAPOUT(OUTPUT)
                          ELSE HEAPOUT(TTY);
                     IF FILEOUTPUT
                     THEN WRITELN(TTY,'  DUMPED ON FILE: ',FILENAME);
                    END;
       CANCELEXEC,
       CONTINUE  :  (* EMPTY *);
       COMMENT   :  WHILE NOT EOLN(TTY) DO READ(TTY,CH);
       NOCOMMAND :  WRITELN(TTY,'COMMAND ERROR')
      END (* CASE *)
    UNTIL (COM = CONTINUE) OR (COM = CANCELEXEC);
    RELEASE;
    WRITELN(TTY);
    IF COM = CANCELEXEC 
    THEN CAUSE := HALTC;
    IF (COM = CONTINUE) AND (CAUSE <> INITC) AND (CAUSE <> BREAKC)
    THEN WRITELN(TTY,'CANNOT CONTINUE')
   END (* DEBUG *).