DataMuseum.dk

Presents historical artifacts from the history of:

DANOSI

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DANOSI

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦db76f4dc1⟧ TextFile

    Length: 11623 (0x2d67)
    Types: TextFile
    Names: »P4EVALST.PAS«

Derivation

└─⟦a2bcc95d7⟧ Bits:30010511 DVBS1.SW2114.src.2.14-2 SW2114 REAL #2/4 TIME PASCAL SOURCE REL 2.14 92.09.01
    └─⟦this⟧ »RTP\P4EVALST.PAS«

TextFile

{$O+,F+}\r
unit p4evalst;\r
interface\r
\r
  (*************** PROCEDURE EVALSTACK ****************************)\r
  (* This module impl. the evaluating stack used by Pass4.\r
     The module impl. the operations on the stack and the operations\r
     on the stack elements  *)\r
\r
uses pscplm,mpaunit,sthunit,p4unit;\r
\r
\r
    (* ---- VAR  EVALSTACK------------EVALSTACK------------*)\r
\r
\r
VAR\r
      bottom_esttop,\r
      ESTTop : ESTelementRef; (* pointer to stacktop *)\r
\r
\r
      LastOnStack : ESTelementRef;\r
        (* Pointer to the last element pushed on the stack *)\r
\r
\r
    function is_dynamic(ptr: st_elemptr; size: word):boolean;\r
\r
    PROCEDURE InitEST;\r
\r
    PROCEDURE MakeNewStackTop;\r
\r
    PROCEDURE ESTPushConst(LOprType : st_address;\r
                           LValue : integer);\r
\r
    PROCEDURE ESTPushReg(LOprType : st_address;\r
                         LReg : Register);\r
\r
    PROCEDURE ESTPushStack(LOprType : st_address;\r
                           LIndVar : Boolean);\r
\r
    PROCEDURE ESTPushAddr (LSpix : SpixRange;\r
                           LOprType : st_address;\r
                           LIndVar : Boolean;\r
                           LPar : ParType;\r
                           Niv : integer;\r
                           Offset : word);\r
\r
    PROCEDURE ESTPushIndAddr(LSpix : SpixRange;\r
                             LOprType : st_address;\r
                             LIndVar : Boolean;\r
                             LPar : ParType;\r
                             Niv : integer;\r
                             Offset : word;\r
                             ObjectOffset : word);\r
\r
    PROCEDURE ESTPushAbsAddr(LSpix : SpixRange;\r
                             LOprType : st_address;\r
                             LIndVar : Boolean;\r
                             LPar : ParType;\r
                             Seg : Register;\r
                             BPUsed : Boolean;\r
                             Displacement : word;\r
                             Index : Register);\r
\r
    PROCEDURE ESTPushCAddr(LSpix : SpixRange;\r
                           LOprType : st_address;\r
                           LIndVar : Boolean;\r
                           LPar : ParType;\r
                           LLab : St_Address;\r
                           ObjectOffset : word);\r
\r
    PROCEDURE ESTPushDecode(LFalseLab : St_Address;\r
                            LTrueLab : St_Address;\r
                            LCondition : Instruction);\r
\r
    PROCEDURE ESTPop;\r
    FUNCTION ESTSort(e : ESTelementRef) : OperandSort;\r
\r
 IMPLEMENTATION\r
\r
\r
\r
    function is_dynamic(ptr: st_elemptr; size: word):boolean;\r
    var dyn: boolean;\r
    begin\r
      dyn:= dynamictype in ptr^.spec_struct;\r
      if dyn then\r
      begin if size<>0 then (*writeln('DYNAMIC?, line ',linenumber);*) end\r
      else begin\r
        if size=0 then (*writeln('NOT DYNAMIC?, line ',linenumber)*);\r
      end;\r
      is_dynamic:=dyn;\r
    end;\r
\r
    PROCEDURE InitEST;\r
      (* The procedure initialize the EST *)\r
\r
      BEGIN\r
      (*#BEGINTEST\r
        IF TestPass4 >= 10 THEN writeln(testOutput,'Start InitEST ');\r
      (*ENDTEST#*)\r
        (* Make dummy element *)\r
\r
        new(ESTTop);\r
        bottom_esttop:= esttop;\r
        LastOnStack := ESTTop;\r
\r
\r
\r
      (*#BEGINTEST\r
        IF TestPass4 >= 10 THEN writeln(testOutput,'Slut InitEST ');\r
      (*ENDTEST#*)\r
      END;  (* InitEST *)\r
\r
\r
    (* ----------------------------------------------- *)\r
\r
\r
\r
    PROCEDURE MakeNewStackTop;\r
      (* Makes a new uninitilazed StackTop *)\r
      BEGIN\r
\r
      (*#BEGINTEST\r
        IF TestPass4 >= 9 THEN writeln(testOutput,'Start MakeNewStackTop ');\r
      (*ENDTEST#*)\r
        new(ESTTop^.xForWard);\r
        ESTTop^.xForWard^.BackWard := ESTTop;\r
        ESTTop := ESTTop^.xForWard;\r
        ESTTop^.Set_Temp := false;\r
        ESTTop^.BitLength := 0;\r
        ESTTOP^.Spix := Anonymousspix;\r
        ESTTop^.Par := P_Normal;\r
\r
      (*#BEGINTEST\r
        IF TestPass4 >= 9 THEN writeln(testOutput,'Slut MakeNewStackTop ');\r
      (*ENDTEST#*)\r
\r
\r
\r
      END;  (* MakeNewStackTop *)\r
\r
\r
\r
    (* -----------------------------------------*)\r
\r
\r
    PROCEDURE ESTPushConst(LOprType : st_address;\r
                           LValue : integer);\r
\r
      BEGIN\r
\r
        MakeNewStackTop;\r
        WITH ESTTop^ DO\r
          BEGIN\r
            Kind := O_Const;\r
            IndVar := true;\r
            OprType := LOprType;\r
            Value := LValue;\r
          END;\r
\r
\r
      END;  (* ESTPushConst *)\r
\r
\r
    (* ---------------------------------------*)\r
\r
\r
    PROCEDURE ESTPushReg(LOprType : st_address;\r
                         LReg : Register);\r
\r
      BEGIN\r
\r
        MakeNewStackTop;\r
        WITH ESTTop^ DO\r
          BEGIN\r
            Kind := O_Reg;\r
            IndVar := true;\r
            OprType := LOprType;\r
            R := LReg;\r
          END;\r
\r
        RegInf[LReg].ESTPointer := ESTTop;\r
\r
\r
\r
      END;  (* ESTPushReg *)\r
\r
    (* -----------------------------------------*)\r
\r
\r
    PROCEDURE ESTPushStack(LOprType : st_address;\r
                           LIndVar : Boolean);\r
\r
      BEGIN\r
\r
\r
        MakeNewStackTop;\r
        WITH ESTTop^ DO\r
          BEGIN\r
            Kind := O_Stack;\r
            OprType := LOprType;\r
            Par := P_Normal;\r
            IndVar := LIndVar;\r
            T_Address := false;\r
            T_ObjectOffset := 0;\r
          END;\r
\r
        LastOnStack := ESTTop;\r
\r
\r
\r
      END;  (* ESTPushStack *)\r
\r
\r
    (* ------------------------------------------ *)\r
\r
\r
    PROCEDURE ESTPushAddr (LSpix : SpixRange;\r
                           LOprType : st_address;\r
                           LIndVar : Boolean;\r
                           LPar : ParType;\r
                           Niv : integer;\r
                           Offset : word);\r
\r
      BEGIN\r
      (*#BEGINTEST\r
        IF TestPass4 >= 9 THEN writeln(testOutput,'Start ESTPushAddr '\r
                                            ,niv,' ',offset);\r
      (*ENDTEST#*)\r
\r
\r
        MakeNewStackTop;\r
        WITH ESTTop^ DO\r
          BEGIN\r
            Kind := O_Addr;\r
            Spix := LSpix;\r
            OprType := LOprType;\r
            IndVar := LIndVar;\r
            Par := LPar;\r
            A_Niv := Niv;\r
            A_Offset := Offset;\r
          END;\r
\r
\r
      END;  (* ESTPushAddr *)\r
\r
\r
    (* ---------------------------------------------- *)\r
\r
\r
    PROCEDURE ESTPushIndAddr(LSpix : SpixRange;\r
                             LOprType : st_address;\r
                             LIndVar : Boolean;\r
                             LPar : ParType;\r
                             Niv : integer;\r
                             Offset : word;\r
                             ObjectOffset : word);\r
\r
      BEGIN\r
      (*#BEGINTEST\r
        IF TestPass4 >= 9 THEN writeln(testOutput,'Start ESTPushIndAddr '\r
                                            ,niv,' ',offset,' ',objectoffset);\r
      (*ENDTEST#*)\r
\r
\r
        MakeNewStackTop;\r
        WITH ESTTop^ DO\r
          BEGIN\r
            Kind := O_IndAddr;\r
            Spix := LSpix;\r
            OprType := LOprType;\r
            IndVar := LIndVar;\r
            Par := LPar;\r
            I_Niv := Niv;\r
            I_Offset := Offset;\r
            I_ObjectOffset := ObjectOffset;\r
            Accesscheck := false;\r
          END;\r
\r
\r
      END;  (* ESTPushIndAddr *)\r
\r
\r
    (* ---------------------------------------------- *)\r
\r
\r
    PROCEDURE ESTPushAbsAddr(LSpix : SpixRange;\r
                             LOprType : st_address;\r
                             LIndVar : Boolean;\r
                             LPar : ParType;\r
                             Seg : Register;\r
                             BPUsed : Boolean;\r
                             Displacement : word;\r
                             Index : Register);\r
\r
      BEGIN\r
\r
        MakeNewStackTop;\r
        WITH ESTTop^ DO\r
          BEGIN\r
            Kind := O_AbsAddr;\r
            Spix := LSpix;\r
            OprType := LOprType;\r
            IndVar := LIndVar;\r
            Par := LPar;\r
            A_Seg := Seg;\r
            A_BPUsed := BPUsed;\r
            A_Displacement := Displacement;\r
            A_Index := Index;\r
          END;\r
\r
        (* Update register information *)\r
        RegInf[Seg].ESTPointer := ESTTop;\r
        RegInf[Index].ESTPointer := ESTTop;\r
\r
\r
\r
      END; (* ESTPushAbsAddr *)\r
\r
\r
\r
    (* ---------------------------------------------- *)\r
\r
\r
    PROCEDURE ESTPushCAddr(LSpix : SpixRange;\r
                           LOprType : st_address;\r
                           LIndVar : Boolean;\r
                           LPar : ParType;\r
                           LLab : St_Address;\r
                           ObjectOffset : word);\r
\r
      BEGIN\r
\r
        MakeNewStackTop;\r
        WITH ESTTop^ DO\r
          BEGIN\r
            Kind := O_CAddr;\r
            Spix := LSpix;\r
            OprType := LOprType;\r
            IndVar := LIndVar;\r
            Par := LPar;\r
            C_Label := LLab;\r
            C_ObjectOffset := ObjectOffset;\r
          END;\r
\r
\r
      END;  (* ESTPushCAddr *)\r
\r
\r
    (* ---------------------------------------------- *)\r
\r
\r
    PROCEDURE ESTPushDecode(LFalseLab : St_Address;\r
                            LTrueLab : St_Address;\r
                            LCondition : Instruction);\r
\r
      BEGIN\r
\r
        MakeNewStackTop;\r
        WITH ESTTop^ DO\r
          BEGIN\r
            Kind := O_Decode;\r
            OprType := BooleanType;\r
            FalseLab := LFalseLab;\r
            TrueLab := LTrueLab;\r
            Condition := LCondition;\r
          END;\r
\r
\r
      END; (* ESTPushDecode *)\r
\r
\r
    (* ---------------------------------------------- *)\r
\r
\r
\r
\r
\r
    PROCEDURE ESTPop;\r
      (* An ESTelement is poped. The register used in the element\r
         is not released but PointerEST is set to nil   *)\r
\r
      BEGIN\r
\r
        (* Update RegInf *)\r
        IF ESTTop^.Kind = O_Reg THEN\r
          RegInf[ESTTop^.R].ESTPointer := nil\r
        ELSE\r
        IF ESTTop^.Kind = O_AbsAddr THEN\r
          BEGIN\r
            RegInf[ESTTop^.A_Seg].ESTPointer := Nil;\r
            RegInf[ESTTop^.A_Index].ESTPointer := Nil;\r
          END;\r
\r
\r
\r
        IF LastOnStack = ESTTop THEN\r
          LastOnStack := ESTTop^.BackWard;\r
\r
        ESTTop := ESTTop^.BackWard;\r
        Dispose(ESTTop^.xForWard);\r
\r
\r
\r
      END; (* ESTPop *)\r
\r
    (* ---------------------------------------------- *)\r
\r
\r
\r
\r
\r
\r
    FUNCTION ESTSort(e : ESTelementRef) : OperandSort;\r
      (* If the function returns\r
          S_Const : operand is a constant.\r
          S_Stack : operand on the runtimestack\r
          S_Reg   : operand in a register\r
          S_Memery: operand specified by an address\r
          S_Decode: operand in decode form  *)\r
\r
      BEGIN\r
          (*#BEGINTEST\r
             IF TestPass4 >= 6 THEN\r
               BEGIN\r
                 writeln(TestOutput,' START  ','ESTSort');\r
               END;\r
          (*ENDTEST#*)\r
\r
        CASE e^.Kind OF\r
\r
          O_Const : ESTSort := S_Const;\r
\r
          O_Reg   : ESTSort := S_Reg;\r
\r
          O_Stack,\r
          O_StackOrTemp : ESTSort := S_Stack;\r
\r
          O_Decode : ESTSort := S_Decode;\r
\r
          (*OTHERWISE*) ELSE ESTSort := S_Memery;\r
\r
        END;  (* end case *)\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 6 THEN\r
               BEGIN\r
                 writeln(TestOutput,' SLUT  ','ESTSort');\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;  (* ESTSort *)\r
\r
\r
\r
END.\r
\r
\r
      (* -------------END   EVALSTACK -------- EVALSTACK -- *)\r
\r
\r
\r
\r
«eof»