{ > PasExpr }

{ Tutu 20 feb 86 - hacked array totalbytes for new array access code }
{ Tutu 17 feb 86 - fixed caray conformance with D1.07 }
{ Tutu 11 feb 86 - hacked array access stuff }
{ Tutu hacked for ARM 29 jan 86 }
{ Sam fixed for Bug 14 with buffer variables -> D1.05 }


FUNCTION SIGNABLE : BOOLEAN;
{
  This function returns true if THISSYMP points to a descriptor which describes
  a type that can be preceeded by a sign (+ or -).
}
BEGIN
    SIGNABLE := (THISSYMP^.IDTYP = REEL) OR (ISINT (THISSYMP^))
END; { signable }


PROCEDURE KONSTANT;
{
  This procedure gets a constant (signed or unsigned) from the source file.
  The constant descriptor is pointed to by THISSYMP.
}
BEGIN
   GETSIGN;
   IF SYM <> KONST THEN ERROR (111);  {CONSTANT EXPECTED}
   IF SIGNED THEN
      IF SIGNABLE THEN
      BEGIN
         IF NEGSIGN THEN
         BEGIN
            BASESYMP^ := THISSYMP^;
            IF THISSYMP^.IDTYP = REEL THEN
               BASESYMP^.REELVAL := -(THISSYMP^.REELVAL)
            ELSE
               BASESYMP^.VAL := -(THISSYMP^.VAL);
            THISSYMP := BASESYMP
         END
      END
      ELSE ERROR (112)
END;  { konstant }


PROCEDURE ORDCON;
{
  This procedure gets an ordinal constant from the source file.
  i.e. idtyp = subr (ange).
}
BEGIN
   KONSTANT;
   IF THISSYMP^.IDTYP <> SUBR THEN
   BEGIN
      ERROR (136);
      THISSYMP^.VAL := 0
   END
END; { ordcon }


PROCEDURE UC; { Unsigned constant }
{
  This procedure gets an unsigned constant (including NIL) from source file.
}
BEGIN
   IF SYM = KONST THEN
   BEGIN
      IF (NOT SIGNABLE) AND (SIGNED) THEN ERROR (112)
   END
   ELSE
      IF SYM = NILSY THEN
      BEGIN
         IF SIGNED THEN ERROR (112);
         BASESYMP^.IDTYP := PNTR;
         BASESYMP^.VAL := 0;
         THISSYMP := BASESYMP
      END
      ELSE ERROR (111)
END; { uc }


PROCEDURE SETFUN (VAR FUNCRES : SYMREC; FUNCDESC : SYMREC);
{
  This procedure is used to set a id descriptor to hold info on a function's
  return result.
}
BEGIN
   FUNCRES     := FUNCDESC;
   FUNCRES.REF := FUNCDESC.REF^.FUNCREF;
   FUNCRES.LEV := SUCC (FUNCDESC.LEV);
   FUNCRES.ADR := FUNCDESC.REF^.FUNCVAR
END; { setfun }


PROCEDURE SETSUBRTYP (VAR DESCREK : SYMREC;DESC : STP);
{
  This procedure sets an id descriptor to hold info on a subr (ange) type whose
  type is pointed to by DESC.
}
BEGIN
   DESCREK.IDTYP := SUBR;
   DESCREK.OBJ := KONST;
   DESCREK.REF := DESC
END; { setsubrtyp }


FUNCTION ISLAB : BOOLEAN;
{
  This function returns TRUE if the symbol just read could be a LABEL.
  ie. integer constant represented by digits, not an identifier.
}
BEGIN
   ISLAB := (SYM = KONST) AND (BASESYMP = THISSYMP) AND (ISINT (THISSYMP^))
END; { islab }


PROCEDURE DEBLINE;
{
  If DEBUG is TRUE then this procedure outputs a here_is_short_debug_line
  BL-code to the temp code file if the line number is less than 256 otherwise
  a here_is_long_debug_line BL-code is output.
  If DEBUG is FALSE then this procedure does nothing.
}
BEGIN
   IF DEBUG THEN genopwtb (&4E, x.lineno) { Tutu - debug_line_long }

{ Tutu - was GENLORS (253-ORD (X.LINENO > 255) * 217,X.LINENO) {}
END; { debline }


FUNCTION CONTAINSFILE (TP : TYPES; RF : TYPREC; CHKTP : BOOLEAN) : BOOLEAN;
{
  This function recursively searches down through a linked list structure
  describing a type and returns TRUE if the type contains a file type anywhere
  in it.
  If the initial type (TP) is not to be checked then CHKTP is passed in a
  value FALSE.
  Superb bit of programming.
}
VAR CONTAINS : BOOLEAN;
    LAST : SYMP;
BEGIN
   CONTAINS := CHKTP AND (TP >= FYLE);
   IF NOT CONTAINS THEN
   BEGIN
      CASE TP OF
        FYLE,TXT   : CONTAINS := CONTAINSFILE (RF.TYP,RF.FILEREF^,TRUE);
        ARAY,CARAY : CONTAINS := CONTAINSFILE (RF.TYP,RF.ELREF^  ,TRUE);
        REKORD :
           BEGIN
              LAST := RF.LASTSYM;
              WHILE (LAST <> NIL) AND (NOT CONTAINS) DO
              BEGIN { search all field identifier types }
                 CONTAINS := CONTAINSFILE (LAST^.IDTYP,LAST^.REF^,TRUE);
                 LAST := LAST^.LINK
              END
           END
       END
       OTHERWISE
   END;
   CONTAINSFILE := CONTAINS
END; { containsfile }


FUNCTION LIMITS (DESC : SYMREC) : SI;
{
  This function returns the high bound of a subrange or the length of a string.
  It also sets a global variable LLIM to the low bound of the subrange or 1 if
  it is a string. For ordinal constants the high and low bounds are the same.
}
BEGIN
   IF DESC.OBJ = KONST THEN
   BEGIN
      IF DESC.IDTYP = SUBR THEN
      BEGIN
         LIMITS := DESC.VAL;
         LLIM := DESC.VAL
      END
      ELSE
      BEGIN
         LIMITS := DESC.STRLEN;
         LLIM := 1
      END
   END
   ELSE
   BEGIN
      IF DESC.IDTYP <> SUBR THEN
         DESC.REF := DESC.REF^.IREF;
      LIMITS := DESC.REF^.HIGH;
      LLIM := DESC.REF^.LOW
   END
END; { limits }


FUNCTION EQTYPS (VAR LEFT : SYMREC; RIGHT:SYMREC; ASSIGNCHK:BOOLEAN) : BOOLEAN;
{
   This function checks that the types described by LEFT and RIGHT are
   compatible (EQTYPS returns true if they are else false). If they are mixed
   integer and real then MIXED is set true and EQTYPS returns false.
   This function also generates range checking code if ASSIGNCHK is true and
   also does type conversion for integers which should be reals.
}
VAR NO_CONSTS : BOOLEAN;
    LEFTC : SYMREC;
    LREF,
    RREF : TYPREC;
BEGIN
   MIXED := FALSE;
   LEFTC := LEFT;
   LREF := LEFTC.REF^;
   RREF := RIGHT.REF^;
   IF LEFTC.IDTYP = RIGHT.IDTYP THEN
   BEGIN
      EQTYPS := TRUE;
      NO_CONSTS := (LEFTC.OBJ <> KONST) AND (RIGHT.OBJ <> KONST);
      IF NO_CONSTS THEN EQTYPS := LEFTC.REF = RIGHT.REF;
      CASE LEFTC.IDTYP OF
        STRNG : BEGIN { Check that strings are the same size }
                   EQTYPS := (LIMITS (LEFTC) = LIMITS (RIGHT))
                END;
        SUBR  : BEGIN { Check for subranges ie ordinals }
                   EQTYPS := (LREF.TYP = RREF.TYP) AND
                                (LREF.SUBRREF = RREF.SUBRREF);
                END;
        SETT  : BEGIN
                   IF NO_CONSTS THEN
                      EQTYPS := LEFTC.PAK = RIGHT.PAK;
                   IF (LEFTC.REF <> NIL) AND (RIGHT.REF <> NIL) THEN
                      IF (LREF.TYP <> RREF.TYP) OR
                         (LREF.SUBRREF <> RREF.SUBRREF) THEN
                      BEGIN
                         ERROR (139);
                         EQTYPS := FALSE
                      END
                END
      END
      OTHERWISE;

     { Generate range checking code if required }
      IF (RNGCHK AND ASSIGNCHK) AND
         ((LEFTC.IDTYP = SETT) OR (LEFTC.IDTYP = SUBR)) THEN
         IF ISINT (LEFTC) THEN
         BEGIN
            IF (LREF.LOW <> -MAXINT) OR
               (LREF.HIGH <> MAXINT) THEN
{ Tutu - was   IF BYTES (LREF.LOW,LREF.HIGH) = 1 THEN
               BEGIN
                  FLUSHNGEN (&F6{Chk_int_s{{);
                  GENUB (LREF.LOW);
                  GENUB (LREF.HIGH)
               END
               ELSE
}              BEGIN
                  FLUSHNGEN (76{Chk_int_l});
                  GENSI (LREF.LOW);
                  GENSI (LREF.HIGH)
               END
         END
         ELSE
         BEGIN
            FLUSHNGEN (74{Chkbce}+ (ORD (LEFTC.IDTYP = SETT)*150));
            GENUB (LREF.LOW);
            GENUB (LREF.HIGH)
         END
   END
   ELSE
   BEGIN  { Check for mixed integer and real operands }
      EQTYPS := FALSE;
      IF LEFTC.IDTYP = REEL THEN
      BEGIN
         IF ISINT (RIGHT) THEN
         BEGIN { Gen code to convert TOS to real}
            FLUSHNGEN (FLTROP);
            EQTYPS := ASSIGNCHK;
            MIXED := TRUE
         END
      END
      ELSE
         IF (RIGHT.IDTYP = REEL) AND (ISINT (LEFTC)) THEN
         BEGIN { Gen code to convert TOS-1 to real }
            IF ASSIGNCHK THEN
               ERROR (11) { Can't assign real to integer }
            ELSE
            BEGIN
               LEFT.IDTYP := REEL;
               LEFT.REF := NIL
            END;
            FLUSHNGEN (FLTLOP);
            MIXED := TRUE
         END
   END
END;  { eqtyps }


PROCEDURE VAL_CONF_DISPOSE (THISSYMP : SYMP);
{
  This procedure generates code to dispose of a value_conformant_array copy on
  the heap. Called when a GOTO out of, or the end of the procedure is found.
}
BEGIN
   WHILE THISSYMP <> NIL DO
   BEGIN
      IF (THISSYMP^.IDTYP = CARAY) AND THISSYMP^.NRM THEN
      BEGIN
         IF X.ACTIVLEV <> X.LEVEL THEN SETLEV (X.LEVEL);
{ Tutu - both 11's below were 15's - psh_int instead of psh_uwd }
         GENLORS (11,THISSYMP^.ADR);   { Push array_copy adr on heap to TOS }
         GENLORS (11,THISSYMP^.ADR+4); { Push array_copy size to TOS }
         GENUB (168) { Release heap }
      END;
      THISSYMP := THISSYMP^.LINK
   END
END; { val_conf_dispose }


PROCEDURE BLKSTMT (TERMSY : SYMBOLS);
{
  This procedure parses a Block_statement which is redefined by me as
  BEGIN [statement_seq] END or REPEAT [statement_seq] UNTIL boolean
  where statement_seq is defined as stmt [; stmt]. See 'passtmt' file for
  BLKSTMT procedure block.
}
VAR THISSEQ : UW;


PROCEDURE STKUP (STKEL : UW);
{
  This procedure increments the amount of crap on the stack by STKEL and keeps
  track of the largest size that the stack grows to. (Only approximate but,
  close enough).
}
BEGIN
   X.STKINC := STKEL + X.STKINC;
   IF X.STKINC > X.MAXSTK THEN X.MAXSTK := X.STKINC
END; { stkup }


PROCEDURE APARAMLIST (LASTPARAM : SYMP); FORWARD;
{
  This procedure parses an actual parameter list by calling GETARG (which type
  checks the parameter) for each parameter in the list. Also checks that number
  of parameters are correct.
}


PROCEDURE PFCALL (PROCDESC : SYMP);
{
  This procedure parses all user procedure or function calls and generates code
  to call them. If PROCDESC^.NRM is false then this procedure is a procedural
  parameter.
}
BEGIN
   IF NOT PROCDESC^.NRM THEN
   BEGIN { Procedural parameter }
      GENUB (67); { Push Display }
      STKUP (dspsize) { Tutu - was 16 }
   END;

   FLUSHNGEN (MARKS);
   STKUP (hkfsize); { Tutu - was 9 }
   APARAMLIST (PROCDESC^.REF^.LASTPARAM);

   IF PROCDESC^.NRM THEN
   BEGIN
      FLUSHNGEN (CALLS);
{ Tutu - was GENUB (PROCDESC^.ADR) {}
      genuw (procdesc^.adr) { Tutu }
   END

   ELSE
   BEGIN { Procedural parameter }
      IF X.ACTIVLEV <> PROCDESC^.LEV THEN SETLEV (PROCDESC^.LEV);
      GENOPWTB (225,PROCDESC^.ADR); { S_call_param }
      FLUSHNGEN (239)  { Debodge_display }
   END;
   X.ACTIVLEV := X.LEVEL
END; { pfcall }


PROCEDURE FACTOR (VAR CODEINFO:SYMREC; VAR STKEL : UW); FORWARD;
{
  This procedure parses a factor.
}


PROCEDURE TERM (VAR LFACTOR:SYMREC; VAR LSTKEL : UW);
{
  This procedure parses a term. ie FACTOR 0orMore[ multop FACTOR].
}
VAR SAVEMULTOP : SYMBOLS;
    RFACTOR : SYMREC;
    RSTKEL : UW;
BEGIN
   FACTOR (LFACTOR,LSTKEL);
   WHILE SYM IN [MULT,SLASH,DIVSY,MODSY,ANDSY] DO
   BEGIN
      SAVEMULTOP := SYM;
      NXTSYMOK;
      FACTOR (RFACTOR,RSTKEL);
      X.STKINC := (-RSTKEL) + X.STKINC;
      CASE SAVEMULTOP OF
        ANDSY : BEGIN
                   IF (LFACTOR.REF <> BOOLDESC) OR
                      (RFACTOR.REF <> BOOLDESC) THEN ERROR (161);
                   FLUSHNGEN (ANDOP)
                END;
        MODSY,
        DIVSY : BEGIN
                   IF NOT (ISINT (LFACTOR) AND ISINT (RFACTOR)) THEN ERROR (163);
                   IF SAVEMULTOP = MODSY THEN FLUSHNGEN (MODOP)
                   ELSE FLUSHNGEN (IDIVOP)
                END;
        SLASH : BEGIN
                   IF EQTYPS (LFACTOR,RFACTOR,FALSE) OR MIXED THEN
                   BEGIN
                      IF LFACTOR.IDTYP <> REEL THEN
                      BEGIN
                         IF NOT ISINT (LFACTOR) THEN ERROR (159);
                         FLUSHNGEN (FLTROP);
                         FLUSHNGEN (FLTLOP)
                      END;
                      FLUSHNGEN (RDIVOP)
                   END
                   ELSE ERROR (159);
                   LFACTOR.IDTYP := REEL;
                   LFACTOR.REF := NIL
                END;
        MULT  : BEGIN
                   IF EQTYPS (LFACTOR,RFACTOR,FALSE) OR MIXED THEN
                   BEGIN
                      IF LFACTOR.IDTYP = REEL THEN
                         FLUSHNGEN (RMULOP)
                      ELSE
                         IF ISINT (LFACTOR) THEN
                            FLUSHNGEN (IMULOP)
                         ELSE
                            IF LFACTOR.IDTYP = SETT THEN
                               FLUSHNGEN (SMULOP)
                            ELSE ERROR (159)
                   END
                   ELSE ERROR (159)
                END
      END  { case }
   END
END; { term }


PROCEDURE GB (OP : UB; DESC : SYMREC);
{
  This procedure is called when a subtraction, addition or relational operation
  BL-code is needed. Passed into the procedure in OP is the basic operation
  eg op_add_int = 106 (which is the first BL-code add_operation). The machine
  code call to TABSEARCH looks up in a table (indexing on DESC.IDTYP) a byte
  value, which is the offset to add to the basic operation to get to the
  operation of the correct type. eg if DESC.IDTYP = real then the offset
  returned is 14 which when added to 106 gives 120 which is the BL-code
  op_add_real
}
BEGIN
   IF ISINT (DESC) THEN DESC.IDTYP := INT;
   FLUSHNGEN (OP + CODE0 (TABSEARCH,ORD (DESC.IDTYP),OLO,OHI{OPTYPVAL}) MOD 128)
END; { gb }


PROCEDURE SIMPEXP (VAR LTERM:SYMREC; VAR LSTKEL : UW);
{
  This procedure parses a simple expression.
  ie. [SIGN] TERM 0orMore[ ADDOP TERM]
}
VAR SAVEADOP : SYMBOLS;
    RTERM : SYMREC;
    ISNEGSIGN,
    HASSIGN : BOOLEAN;
    RSTKEL : UW;
BEGIN
   GETSIGN;

   HASSIGN := SIGNED;
   ISNEGSIGN := NEGSIGN;
   TERM (LTERM,LSTKEL);
   IF HASSIGN THEN
   BEGIN
      IF (ISINT (LTERM)) OR (LTERM.IDTYP = REEL) THEN
      BEGIN
         IF ISNEGSIGN THEN
         BEGIN { Inverse of term required }
            IF LTERM.IDTYP = REEL THEN FLUSHNGEN (RNEGOP)
            ELSE FLUSHNGEN (INEGOP)
         END
      END
      ELSE ERROR (112) { Can't sign non numerics }
   END;

   WHILE SYM IN [PLUS,MINUS,ORSY] DO
   BEGIN
      SAVEADOP := SYM;
      NXTSYMOK;
      SIGNED := FALSE;
      TERM (RTERM,RSTKEL);
      X.STKINC := (-RSTKEL) + X.STKINC;
      IF SAVEADOP = ORSY THEN
      BEGIN
         IF (LTERM.REF <> BOOLDESC)OR (RTERM.REF <> BOOLDESC) THEN ERROR (161);
         FLUSHNGEN (OROP)
      END
      ELSE
      BEGIN
         IF EQTYPS (LTERM,RTERM,FALSE) OR MIXED THEN
         BEGIN
            IF (LTERM.IDTYP <> REEL) AND (LTERM.IDTYP <> SETT) AND
               (NOT ISINT (LTERM)) THEN ERROR (159);
            GB (ORD (SAVEADOP)+94,LTERM)
         END
         ELSE ERROR (159)
      END
   END
END;  { simpexp }


PROCEDURE EXPRESSION (VAR LSIMP:SYMREC; VAR LSTKEL : UW);
{
  This procedure parses an expression.
  ie. SIMPLE_EXPRESSION  [RELOP SIMPLE_EXPRESSION].
}
VAR SAVERELOP : SYMBOLS;
    RSIMP : SYMREC;
    RSTKEL : UW;
BEGIN
   SIMPEXP (LSIMP,LSTKEL);
   IF SYM IN [EQUALS,NE,LT,GT,LE,GE,INSY] THEN
   BEGIN
      SAVERELOP := SYM;
      NXTSYMOK;
      SIMPEXP (RSIMP,RSTKEL);
      X.STKINC :=  (-(RSTKEL + LSTKEL)) + X.STKINC + reasize; { Tutu - was 5 }

      IF SAVERELOP = INSY THEN
      BEGIN
         IF (RSIMP.IDTYP = SETT) AND (LSIMP.IDTYP = SUBR) THEN
         BEGIN
            IF ISINT (LSIMP) THEN FLUSHNGEN (IINOP)
            ELSE FLUSHNGEN (BINOP);
            IF RSIMP.REF <> NIL THEN
               IF LSIMP.REF^.SUBRREF <> RSIMP.REF^.SUBRREF THEN ERROR (78)
         END
         ELSE ERROR (159)
      END
      ELSE
         IF EQTYPS (LSIMP,RSIMP,FALSE) OR MIXED THEN
         BEGIN
            IF (SAVERELOP >= LE) THEN
            BEGIN
               IF (LSIMP.IDTYP=PNTR)
               OR ((LSIMP.IDTYP=SETT) AND (SAVERELOP >= LT)) THEN ERROR (159)
            END;
            IF LSIMP.IDTYP > STRNG THEN ERROR (159);
            GB (ORD (SAVERELOP)+69,LSIMP);
            IF LSIMP.IDTYP = STRNG THEN
               GENUW (LIMITS (LSIMP))
         END
         ELSE ERROR (6);
         SETSUBRTYP (LSIMP,BOOLDESC)
   END
END; { expression }


PROCEDURE EXPRESS (VAR DESC:SYMREC);
{
  This procedure is used to call EXPRESSION when the returned value of STKEL is
  not needed. It saves on code by not having to call EXPRESSION with 2 params.
}
VAR STKEL : UW;
BEGIN
   EXPRESSION (DESC,STKEL)
END; { express }


PROCEDURE LOCADESC (ARRAE : SYMREC; ADESCREF : STP);
{
  This procedure generates code to push the address of the array descriptor
  associated with ARRAE onto the stack.
}
VAR LOCORPUSH : UB;
BEGIN
   IF ARRAE.IDTYP = CARAY THEN
   BEGIN
      ARRAE.IDTYP := PNTR;
      LOCORPUSH := PUSH
   END
   ELSE
   BEGIN
      LOCORPUSH := LOCATE;
      ARRAE.IDTYP := REKORD
   END;
   ARRAE.NRM := TRUE;
   ARRAE.OBJ := VARID;
   ARRAE.LEV := ADESCREF^.ALEV MOD 128;
   ARRAE.ADR := ADESCREF^.ADESCOFF;
   GENMOV (LOCORPUSH,ARRAE)
END; { locadesc }


PROCEDURE ACTIVREC (RECDESC : SYMREC);
{
  This procedure adds the record's field id list (pointed to by a field of
  RECDESC) to the list of activated field identifiers.
  Also checks that RECDESC does actually describe a record.
}
BEGIN
   NEW (NEWACTIVE);
   NEWACTIVE^.NEXT := ACTIVELIST;
   ACTIVELIST := NEWACTIVE;
   NEWACTIVE^.FIELDS := NIL;
   IF RECDESC.IDTYP <> REKORD THEN ERROR (150)
   ELSE NEWACTIVE^.FIELDS := RECDESC.REF { Activate this record's field ids }
END; { activrec }


PROCEDURE VARACCESS (VAR CODEINFO:SYMREC);
{
  This procedure is used to parse any variable access. ie. either generates
  code to get the address of a variable onto the stack, or if it is a simple
  variable which is not a var param then it sets NOCODE to true and returns
  without generating any code (the caller should then generate the code).
  To parse the variable, repetition is used rather than recursion.
}
VAR ENDACCESS,            { End of variable detected }
    LOOP : BOOLEAN;       { Used in the array parser to signal that another
                            index is present (ie comma detected) }
    COPYINFO,
    INDEXINFO : SYMREC;   { Holds array's index & record's field descriptor. }
    ADESC1,               { Holds pointer to first the array descriptor in case
                            of multidimensional arrays (ADESCOFF must be the
                            base of the first array, same goes for ALEV) }
    SAVEREF : STP;        { Saves COPYINFO.REF }
    FOFFSET,              { Record's field offset if variable is a field }
    DESCOFF,              { Offset from start of array descriptor to find start
                            of sub_array descriptor. }
{   TOTBYTES : SI;        { Total number of bytes on the stack for a
  Removed by Tutu 21-Feb-86 BL-code array_access. }

    DIMS : UB;            { Number of parsed dimensions of the array. }
    SAVECADR,             { Saved code address (to say if any code has been
                            generated by the variable access. }
    STKP : UW;            { Used to save the stack pointer in order to restore
                            it later. }
    SAVERETKONST,
    NOT_CARAY, this_vars_LHS : BOOLEAN; { Sam - fixes Bug 14 }


PROCEDURE LOCVAR;
{
  This procedure is used to locate a variable. ie. get its address on TOS.
}
BEGIN
   IF COPYINFO.IDTYP = CARAY THEN COPYINFO.NRM := FALSE;
   GENMOV (LOCATE,COPYINFO);
   IF (COPYINFO.OBJ = FIELD) OR (COPYINFO.OBJ = TAG) THEN
      GENRECOFF (FOFFSET)
END; { locvar }


BEGIN { varaccess }
   this_vars_LHS := LHS; { Sam }
   DESCOFF := 0;
   ENDACCESS := FALSE;
   FLUSH;
   COPYINFO := THISSYMP^;
   SIMPLE := TRUE; { Flags if variable is a simple variable }
   NOCODE := FALSE;
   SAVECADR := X.CADR;
   IF NOT (COPYINFO.OBJ IN [VARID,FIELD,TAG,FUNC]) THEN ERROR (1);
   IF COPYINFO.IDTYP >= FYLE THEN
      IF COPYINFO.ADR < -2 THEN { Permanent file not declared in global vars }
         ERROR (153)
      ELSE
         IF COPYINFO.ADR < 0 THEN ERROR (16);
   IF COPYINFO.OBJ = FUNC THEN
   BEGIN
      IF DISPLAY[SUCC (COPYINFO.LEV)] <> COPYINFO.REF THEN
         ERROR (66); { Can only assign value to current function id }
      SETFUN (COPYINFO,COPYINFO);
      THISSYMP^.FUNCASS := TRUE; { Flags that the func id has been assigned}
      IF NOT LHS THEN { Function designators are allowed only on the left }
         ERROR (67);   { hand side of an assignment statement }

      IF NOT COPYINFO.NRM THEN ERROR (99);
   END;
   IF (COPYINFO.OBJ = FIELD) OR (COPYINFO.OBJ = TAG) THEN
   BEGIN
      FOFFSET := COPYINFO.ADR;
      COPYINFO.NRM := FALSE;
      COPYINFO.LEV := X.LEVEL;
      SIMPLE := FALSE;
      COPYINFO.ADR := THISACTIVE^.WITHADR
   END;
   NEXTSYM;
   ADESC1 := COPYINFO.REF;

   IF NOT (SYM IN [LBRAK,AT,DOT]) THEN
   BEGIN  { Simple variable }
      IF (COPYINFO.OBJ = FIELD) OR (COPYINFO.OBJ = TAG) OR
         ((COPYINFO.IDTYP <= REKORD) AND (COPYINFO.IDTYP >= STRNG)) OR
         NOT (COPYINFO.NRM AND this_vars_LHS) THEN { Sam }
         LOCVAR
      ELSE
      BEGIN
         IF (COPYINFO.LEV < X.LEVEL) AND (VARP OR this_vars_LHS) THEN
            THISSYMP^.THREAT := TRUE;
         NOCODE := TRUE
      END
   END
   ELSE { Pointer,file,record or array variable }
   BEGIN
      SIMPLE := FALSE;
      LOCVAR;

      REPEAT
         CASE SYM OF
           AT :
              BEGIN
                 copyinfo.funcass := false; { Tutu - 6.6.3.7.3 fix }
                 DESCOFF := 0;
                 IF COPYINFO.IDTYP = PNTR THEN
                 BEGIN
                    IF COPYINFO.OBJ = FUNC THEN ERROR (162);
                    GENMOV (IPUSH+ORD (ASSCHK)*7,COPYINFO);
                    NXTSYMOK;
                    COPYINFO.IDTYP := COPYINFO.REF^.TYP;
                    COPYINFO.REF := COPYINFO.REF^.PNTRREF
                 END
                 ELSE
                 BEGIN
                    COPYINFO.PERM := FALSE;
                    IF this_vars_LHS OR VARP THEN FLUSHNGEN (240{IdentifyI_Wbuff})
                    ELSE FLUSHNGEN (75{IdentifyI_Rbuff});
                    IF COPYINFO.IDTYP = FYLE THEN
                    BEGIN
                       COPYINFO.IDTYP := COPYINFO.REF^.TYP;
                       COPYINFO.PAK := COPYINFO.REF^.FILEPAC;
                       NXTSYMOK;
                       COPYINFO.REF := COPYINFO.REF^.FILEREF
                    END
                    ELSE
                       IF COPYINFO.IDTYP = TXT THEN
                       BEGIN
                          COPYINFO.IDTYP := SUBR;
                          NXTSYMOK
                       END
                       ELSE
                       BEGIN
                          ERROR (148);
                          NEXTSYM
                       END
                 END;
                 ADESC1 := COPYINFO.REF
              END; { OF AT }
           DOT :
              BEGIN
                 copyinfo.funcass := copyinfo.pak;
 { Tutu - 6.6.3.7.3 - set to pak field of parent if not simple }
                 DESCOFF := 0;
                 ACTIVREC (COPYINFO);
                { Get the field id }
                 NXTSYMOK;
                 INDEXINFO := THISSYMP^;
                 IF (SYM <> TAG) AND (SYM <> FIELD) THEN ERROR (65);
                 IF THISACTIVE <> NEWACTIVE THEN { wrong field id }
                    ERROR (137);
                { Deactivate the field id }
                 ACTIVELIST := ACTIVELIST^.NEXT;
                 DISPOSE (NEWACTIVE);
                 NEXTSYM;
                 GENRECOFF (INDEXINFO.ADR);
                 COPYINFO.REF := INDEXINFO.REF;
                 COPYINFO.IDTYP := INDEXINFO.IDTYP;
                 COPYINFO.PAK := INDEXINFO.PAK;
                 COPYINFO.OBJ := INDEXINFO.OBJ;
                 ADESC1 := COPYINFO.REF
              END;

           LBRAK :
              BEGIN {SYM = [}
                 copyinfo.funcass := copyinfo.pak;
 { Tutu - 6.6.3.7.3 - set to pak field of parent if not simple }
                 DESCOFF := 0;
                 ADESC1 := COPYINFO.REF;
                 STKP := X.STKINC;
               { Push array descriptor address onto top of stack }
                 LOCADESC (COPYINFO,ADESC1);

{ Tutu - removed totbytes := 0; { Tutu - was 4, then twiceptrsize }
{ ptr, base now pulled off extra to this in SystemA }

                 DIMS := 0;
                 SAVERETKONST := RETKONST;

                 WHILE SYM = LBRAK DO
                 BEGIN
                    NOT_CARAY := COPYINFO.IDTYP <> CARAY;
                    NXTSYMOK;

                    REPEAT
                       IF (COPYINFO.IDTYP > ARAY)
                       OR (COPYINFO.IDTYP<STRNG) THEN ERROR (151);
                       LHS := FALSE;
                       RETKONST := FALSE;
                       EXPRESS (INDEXINFO);

{ Tutu - removed       totbytes := totbytes + 4; { Tutu - all stacked indices
                                                             are 4 bytes long }
{ Tutu - was TOTBYTES := TOTBYTES + SUCC(ORD(ISINT (INDEXINFO)) * 3); }

                       COPYINFO.IDTYP := SUBR;
                       SAVEREF := COPYINFO.REF;
                       COPYINFO.REF := COPYINFO.REF^.IREF;
                       IF NOT EQTYPS (COPYINFO,INDEXINFO,NOT_CARAY)
                       THEN ERROR (160);
                       DIMS := SUCC (DIMS);
                       LOOP := ISCOMA;
                       IF LOOP THEN NXTSYMOK;
                       COPYINFO.IDTYP := SAVEREF^.TYP;
                       COPYINFO.REF := SAVEREF^.ELREF;
                                 { Update array descriptor adr for next array }
                       IF (COPYINFO.IDTYP <= ARAY)
                       AND (COPYINFO.IDTYP >= STRNG)
                       THEN DESCOFF := DESCOFF + totaldescsize; {Tutu - was 11}
                       COPYINFO.PAK := SAVEREF^.ALEV > 127
                    UNTIL (NOT LOOP) OR (SYM = RBRAK);

                    IF LOOP THEN ERROR (149);
                    CHKNEXT (RBRAK)
                 END;

                 X.STKINC := STKP;
                 RETKONST := SAVERETKONST;

                { Generate code to get base address of array element }
                 IF RNGCHK AND (NOT NOT_CARAY) THEN
                    FLUSHNGEN (81{Chk_caray})
                 ELSE
                    FLUSHNGEN (AACESOP);

{ Tutu - was     IF TOTBYTES > 255 THEN ERROR (121);
                 GENUB (TOTBYTES);
}
                 if dims > 255 then error (121); { Tutu }
                 GENUB (DIMS) { Tutu - only need count of indices now }
              END
         END
         OTHERWISE ENDACCESS := TRUE

      UNTIL ENDACCESS
   END;

   IF (COPYINFO.IDTYP < STRNG) AND (SAVECADR = X.CADR)
      AND (CBUFF.BASICOP = LOCATE) AND LHS THEN
   BEGIN { No code has been generated for the left hand side of an assignment
           statement, but a locate code has been put into the code buffer.
           Remove the locate from buffer so that 1 byte can be saved by using
           a POP value at the end of the statement instead of a POP INDIRECT. }
      NOCODE := TRUE;
      CBUFF.BASICOP := 0;
      COPYINFO.ADR := CBUFF.VARADR
   END;

   CODEINFO := COPYINFO;
   ADESC := DESCOFF;
   ADESCREF := ADESC1
END;  { varaccess }

{$S'PasExpr2'}