(****************************************
*                                       *
*     MODULA-2 Multi-Pass Compiler      *
*     ****************************      *
*                                       *
*       VAX/VMS Implementation          *
*                                       *
*                                       *
*     MVCAttributeHandling:             *
*                                       *
*     Attribute handling in Pass 4      *
*                                       *
*     Version 3.1 of  1-FEB-1983        *
*                                       *
*                                       *
*                                       *
*     Based on PDP11 Implementation     *
*     Version M22 of 25.02.81           *
*                                       *
*     Institut fuer Informatik          *
*     ETH-Zentrum                       *
*     CH-8092 Zuerich                   *
*                                       *
****************************************)

(****************************************
* Updates: see implementation module    *
****************************************)

DEFINITION MODULE MVCAttributHandling; (* VAX: J. Koch, M. Mall, EK *)

  IMPORT MVCompiler, MVCMnemonicsAndTraps;

  FROM SYSTEM IMPORT BYTE, SHORTWORD, LONGWORD;
  FROM MVCompiler IMPORT Idptr, Stptr;
  FROM MVCMnemonicsAndTraps IMPORT Mnemos, Traps;

  EXPORT QUALIFIED
         ArrayType,SetType,BooleanType,SignedType,SimpleType,
         DynArrayType,WordType,RealType,
         AttrMode,Condition,ModeSet,RegSet,Attribut,
         lc,StackTop,WithBase,loglevel,
         PutBlock,PutB,PutW,PutL,Put2B,
         UpdateCondJump,UpdateFwrdJump,MarkJump,MarkCondJump,GenJump,
         BranchTooLong,MoveCode,
         NewReg,IsRegMode,AbsRegMode,ReturnAtReg,RegAt,ConstAt,
         GenEntry,GenExit,CallProc,ResetTop,CallModSys,
         AdMode,SelectOpcode,Op1,Op2,Op3,Op4,
         Op1toReg,Op2or3,Op2C,TypeSize,
         MoveValue,MoveAddr,PushConst,PushValue,PushAddr,LoadValue,LoadAddr,
         PreLoad,PreMoveBools,ConvToCond,PosConstMul,
         NewWith,ReleaseWith,UseWith,
         MarkCondcode,ReleaseCondcode,UpdCondJump,
         LinkCondJump,CondJump,InvertJump,
         qptr,outloop,UpdateOutloop,Mark,Update;

  PROCEDURE ArrayType(s: Stptr): BOOLEAN;

  PROCEDURE SetType(s: Stptr): BOOLEAN;

  PROCEDURE BooleanType(s: Stptr): BOOLEAN;

  PROCEDURE SignedType(s: Stptr): BOOLEAN;

  PROCEDURE SimpleType(s: Stptr): BOOLEAN;

  PROCEDURE DynArrayType(s: Stptr): BOOLEAN;

  PROCEDURE WordType(s: Stptr): BOOLEAN;

  PROCEDURE RealType(s: Stptr): BOOLEAN;

  TYPE
    AttrMode  = (cstmode,nomode,regmode,absmode,globmode,
                 extmode,stackmode,cstpfmode,cstrealmode,
                 cststringmode,condmode);
    (*unusual sequence for efficiency*)

    Condition = (JEQ,JNE,JGE,JLE,JLT,JGT);

    ModeSet   = SET OF AttrMode;
    RegSet    = SET OF [0..10];

    Attribut  = RECORD
                  typtr: Stptr;
                  CASE mode: AttrMode OF
                    cstmode: 
                      valu: INTEGER; |
                    cstrealmode: 
                      rvalu: REAL; |
                    absmode,cstpfmode,globmode,extmode,cststringmode: 
                      addr: CARDINAL;
                      anptr: Idptr; |
                    regmode:
                      regnr: CARDINAL;
                      offset: INTEGER;
                      indexed,indirect: BOOLEAN; |
                    condmode: 
                      cond: Condition;
                      brtrue,signed: BOOLEAN;
                      (*only initialised if used*)
                  ELSE (*nomode,stackmode: no further fields*)
                  END
                END;

  VAR
    lc      : CARDINAL; (*location counter*)
    StackTop: INTEGER;  (*current top of stack relative to the top of stack
                          after the procedure entry*)
    WithBase: INTEGER;  (*basic offset (relative to mark pointer)
                          of any WITH argument in current procedure*)
    loglevel: INTEGER;  (*logical level*)

  PROCEDURE PutBlock(fnptr: Idptr);

  PROCEDURE PutB(b: BYTE);

  PROCEDURE PutW(w: SHORTWORD);

  PROCEDURE PutL(l: LONGWORD);

  PROCEDURE Put2B(byte1, byte2: BYTE);

  PROCEDURE UpdateFwrdJump(flc: CARDINAL);

  PROCEDURE MarkJump(VAR flc: CARDINAL);

  PROCEDURE MarkCondJump (opcode: Mnemos; VAR flc: CARDINAL);

  PROCEDURE GenJump(flc: CARDINAL);

  PROCEDURE UpdateCondJump(baseexprlc,xlst: CARDINAL);

  PROCEDURE BranchTooLong(flc: CARDINAL): BOOLEAN;

  PROCEDURE MoveCode(initlc: CARDINAL; VAR flc: CARDINAL);

  PROCEDURE ResetTop(i: INTEGER);

  PROCEDURE GenEntry(fnptr: Idptr);

  PROCEDURE GenExit(fnptr: Idptr);

  PROCEDURE CallProc(VAR fat: Attribut);

  PROCEDURE CallModSys(trap: Traps);

  PROCEDURE NewReg(): CARDINAL;

  PROCEDURE IsRegMode(VAR fat: Attribut): BOOLEAN;

  PROCEDURE AbsRegMode(VAR fat: Attribut): BOOLEAN;

  PROCEDURE ReturnAtReg(VAR fat: Attribut);

  PROCEDURE RegAt(freg: CARDINAL; ftyptr: Stptr; VAR fat: Attribut);

  PROCEDURE ConstAt(fconst: CARDINAL; ftyptr: Stptr; VAR fat: Attribut);

  PROCEDURE AdMode(VAR fat: Attribut);

  PROCEDURE SelectOpcode(opcode: Mnemos; VAR fat: Attribut): Mnemos;

  PROCEDURE Op1(opcode: Mnemos; VAR fat: Attribut);

  PROCEDURE Op2(opcode: Mnemos; VAR fat1,fat2: Attribut);

  PROCEDURE Op3(opcode: Mnemos; VAR fat1,fat2,fat3: Attribut);

  PROCEDURE Op4(opcode: Mnemos; VAR fat1,fat2,fat3,fat4: Attribut);

  PROCEDURE Op1toReg(opcode: Mnemos; VAR fat: Attribut);

  PROCEDURE Op2or3(opcode: Mnemos; VAR fat1, fat2: Attribut);

  PROCEDURE Op2C(opcode: Mnemos; fconst: INTEGER; VAR fat: Attribut);

  PROCEDURE TypeSize(VAR fat: Attribut): CARDINAL;

  PROCEDURE MoveValue(VAR fat,fat1: Attribut);

  PROCEDURE MoveAddr(fat: Attribut; VAR fat1: Attribut);

  PROCEDURE PushConst(fconst: INTEGER);

  PROCEDURE PushValue(VAR fat: Attribut);

  PROCEDURE PushAddr(VAR fat: Attribut);

  PROCEDURE LoadValue(VAR fat: Attribut);

  PROCEDURE LoadAddr(VAR fat: Attribut);

  PROCEDURE PreLoad(VAR fat1,fat2: Attribut);

  PROCEDURE PreMoveBools(VAR fat: Attribut);

  PROCEDURE ConvToCond(VAR fat: Attribut);

  PROCEDURE PosConstMul(VAR fat: Attribut; fconst: CARDINAL);

  PROCEDURE NewWith(VAR fat: Attribut);

  PROCEDURE ReleaseWith;

  PROCEDURE UseWith(flev: CARDINAL; VAR fat: Attribut);

  PROCEDURE MarkCondcode(VAR floglev: INTEGER; VAR flastmpj: CARDINAL);

  PROCEDURE ReleaseCondcode(floglev: INTEGER; flastmpj: CARDINAL);

  PROCEDURE UpdCondJump(b: BOOLEAN);

  PROCEDURE LinkCondJump(baselc: CARDINAL; VAR list: CARDINAL; blist: BOOLEAN);

  PROCEDURE CondJump(VAR fat: Attribut; b: BOOLEAN);

  PROCEDURE InvertJump(VAR fat: Attribut);

  TYPE
    qptr = POINTER TO qrec;
    qrec = RECORD
             x: CARDINAL;
             next: qptr
           END;

  VAR
    outloop: qptr;

  PROCEDURE UpdateOutloop(initlc, delta: CARDINAL);

  PROCEDURE Mark(VAR top: qptr);

  PROCEDURE Update(VAR top: qptr);


END MVCAttributHandling.