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

⟦e06885b9f⟧ TextFile

    Length: 24047 (0x5def)
    Types: TextFile
    Names: »P4STATST.PAS«

Derivation

└─⟦037c0ce35⟧ Bits:30010524 DVBS1.SW2114.src.2.6-2 RTP compiler source SW2104+SW2114 Disk#2 30/1-92 HHA
    └─⟦this⟧ »RTP\P4STATST.PAS« 
└─⟦828f0d3dd⟧ Bits:30010527 DVBS1.SW2114.src.2.6-5 RTP Compiler Source SW2104+SW2114 Disk 2 92.02.03 HEJ HHA
    └─⟦this⟧ »RTP\P4STATST.PAS« 
└─⟦891417be1⟧ Bits:30010519 DVBS1.SW2114.src.2-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
    └─⟦this⟧ »RTP\P4STATST.PAS«

TextFile

\r
   (*----  TYPES  STATEMENTSTACK -------------STATEMENTSTACK --- *)\r
\r
 TYPE\r
\r
     (* The types described a Statement stack element *)\r
     StatKind = ( S_Loop, S_Lock, S_Region,\r
                   S_If, S_Case, S_Routine, S_Prog );\r
\r
\r
\r
\r
     SSTelementRef = ^SSTelement;\r
\r
\r
     SSTelement =\r
       RECORD\r
         Next : SSTelementRef;\r
           (* used for internal representation of the stack *)\r
\r
         CASE Kind : StatKind OF\r
\r
           S_Loop :\r
                 (ContLabel : St_Address;\r
                    (* Label to jump to on continueloop *)\r
                  ExitLabel : St_Address;\r
                    (* Label to jump to on exitloop *)\r
                  RepeatLabel : St_Address;\r
                     (* Label to jump to on repeat stat for\r
                        repeatstat and forstat *)\r
                  Up : Boolean;\r
                     (* Only used for forstat. True if Up. False if\r
                        down *)\r
                  offsetOfSize : integer;\r
                     (* used when initializing arrays in RC3502 *)\r
                        );\r
\r
\r
           S_If     : (IfFalseLabel : St_Address;\r
                     (* Label to goto on false *)\r
                   IfEndLabel : St_Address;\r
                     (* Label to goto when end if *)   );\r
\r
\r
           S_Case   : (TabelLabel : St_Address;\r
                    (* Label where the casetabel is dumped *)\r
                   CaseEnd : St_Address;\r
                    (* Label where to goto when the case\r
                       terminate *)\r
                   CaseOtherwise : St_Address;\r
                     (* Label to goto on otherwise *)\r
                   Lower,Higher : integer;\r
                      (* Gives the lower and higher case index *)\r
                      );\r
\r
           S_Routine, S_Prog :\r
                  (P_ExitLabel : St_Address;\r
                   (* Label to goto on exitstatement *)\r
                   EntryPoint : St_Address;\r
                    (* the startlabel *)\r
                   TempLabel : St_Address;\r
                    (* label to generate when going from codemode = false\r
                       to codemode = true  *)\r
                   VarSize : Word;\r
                    (* the size of the local variabel *)\r
                   MaxStackSize : Word;\r
                    (* The max stack size for the block.\r
                       Used to test for stack overflow when enter the\r
                       block *)\r
{$IFDEF RC35_50}\r
                   GlobalVarSize : Word;\r
                       (* Size of program variables *)\r
                   ParSize : word;\r
                       (* size of program parametres *)\r
                   Dynamicalloc : Boolean;\r
                   ExternalRoutine : boolean;\r
{$ENDIF}\r
                   LocalRef : Boolean;\r
                     (* True If routine contains a local ref var *)\r
                                        );\r
\r
           S_Region   : (RegVar : St_Address);\r
           S_Lock     : (ESTLockvar : ESTElementRef);\r
\r
       END; (* end SSTelement *)\r
\r
\r
    (*********** END TYPES StatementStack *******************)\r
\r
\r
\r
      (************************* VAR STATEMENTSTACK *****************)\r
 VAR\r
      SSTTop : SSTelementRef; (* pointer to stacktop *)\r
\r
\r
      Codemode : boolean;\r
          (* The block generating code for is in codemode *)\r
\r
\r
\r
\r
\r
\r
\r
  (* ------------------- PROCEDURE STATEMENTSTACK ------------------ *)\r
\r
\r
\r
    PROCEDURE InitSST;\r
\r
    PROCEDURE SubRegToSP( Reg : Register);\r
\r
    PROCEDURE SSTPushLoop;\r
\r
    PROCEDURE SSTPush;\r
\r
    PROCEDURE SSTPushRoutine(EP : St_Address; Size : Word; MaxSize : Word;\r
                              LocRef : Boolean);\r
\r
    PROCEDURE SSTPop;\r
    PROCEDURE SetCodeModeToTrue;\r
    PROCEDURE SetCodeModeToFalse;\r
    PROCEDURE LeaveRegion(RegV : St_Address);\r
\r
    PROCEDURE LeaveLock(Lockend : boolean; VAR ESTLockVar : ESTElementRef);\r
\r
    FUNCTION OutOfRepStat : SSTelementRef;\r
\r
    FUNCTION OutOfBlock : SSTelementRef;\r
{$IFDEF RC3502}\r
    PROCEDURE ChangeAppetite(Val : Integer);\r
{$ENDIF}\r
\r
\r
IMPLEMENTATION\r
{$IFDEF PI3}\r
uses sthcom,p4regadm,p4code,p4evalst,p4estopr;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
uses sthcom,p450code,p4evalst,p450eopr;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
uses sthcom,p435code,p4evalst,p435eopr;\r
{$ENDIF}\r
\r
    PROCEDURE InitSST;\r
      (* The procedure initilize the SST *)\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START InitSST' );\r
               END;\r
          (*ENDTEST#*)\r
     \r
        Codemode := false;\r
        SSTTop := nil;\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT InitSST' );\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;\r
\r
\r
(**********************************************************)\r
     PROCEDURE SubRegToSP( Reg : Register);\r
       VAR\r
         Addr : Address;\r
         Lab  : St_Address;\r
         Ptr : St_ElemPtr;\r
         Reg1 : Register;\r
       BEGIN\r
             (* Check for stack overflow *)\r
{$IFDEF PI3}\r
             (* Get the StackBound *)\r
             Addr.Seg := DS;\r
             Addr.Base := RNil;\r
             Addr.Index := RNil;\r
             Addr.Displacement := StackBoundOffset;\r
             Addr.Spix := Anonymousspix;\r
\r
             Reg1 := GetRegister(AllRegister,Rnil);\r
\r
             CodeRegReg(iMOV,w,Reg1,SP);\r
             CodeRegAddr(iSUB,w,Reg1,Addr);\r
             CodeRegReg(iCMP,w,Reg1,Reg);\r
             St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
             CodeJump(iJA,Lab);\r
             CodeFault(StackOverFlowInt,StackOverFlowExc);\r
             GenerateLabel(Lab);\r
             CodeRegReg(iSUB,w,SP,Reg);\r
             ReleaseRegister(Reg1);\r
{$ENDIF}\r
        END;\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
\r
    (* The following procedure pushed an element *)\r
\r
    PROCEDURE SSTPushLoop;\r
\r
      VAR\r
        Ref : SSTelementRef;\r
        Ptr : St_elemPtr;\r
\r
      BEGIN\r
\r
   (*#BEGINTEST\r
      IF TestPass4 >= 3 THEN\r
        BEGIN\r
          writeln(TestOutPut,' START SSTPushLoop' );\r
        END;\r
   (*ENDTEST#*)\r
\r
        (* Make a new stacktop *)\r
        new(Ref);\r
        Ref^.Next := SSTTop;\r
        SSTTop := Ref;\r
\r
       (* Initialize the stacktop *)\r
        SSTTop^.Kind := S_Loop;\r
        WITH SSTTop^ DO\r
          BEGIN\r
            St_Declaration(CLabel,AnonymousName,ContLabel,Ptr);\r
            St_Declaration(CLabel,AnonymousName,ExitLabel,Ptr);\r
          END;\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT SSTPushLoop' );\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;\r
\r
\r
\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
    PROCEDURE SSTPush;\r
\r
      VAR\r
        Ref : SSTelementRef;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START SSTPush' );\r
               END;\r
          (*ENDTEST#*)\r
\r
        (* Make a new stacktop *)\r
        new(Ref);\r
        Ref^.Next := SSTTop;\r
        SSTTop := Ref;\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT SSTPush' );\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;\r
\r
\r
\r
\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
    PROCEDURE SSTPushRoutine(EP : St_Address; Size : Word; MaxSize : Word;\r
                              LocRef : Boolean);\r
\r
      VAR\r
        Ref : SSTelementRef;\r
        Ptr : St_ElemPtr;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START SSTPushRoutine' );\r
               END;\r
          (*ENDTEST#*)\r
\r
        (* Make a new stacktop *)\r
        new(Ref);\r
        Ref^.Next := SSTTop;\r
        SSTTop := Ref;\r
\r
        (* Initialize the stacktop *)\r
        SSTTop^.Kind := S_Routine;\r
        WITH SSTTop^ DO\r
          BEGIN\r
            St_Declaration(cLabel,AnonymousName,P_ExitLabel,Ptr);\r
            EntryPoint := EP;\r
            TempLabel := St_NillAddr;\r
            VarSize := Size;\r
            MaxStackSize := MaxSize;\r
            LocalRef := LocRef;\r
          END;\r
{$IFDEF RC5000}\r
        SSTTop^.DynamicAlloc := false;\r
        SSTTop^.ExternalRoutine := false;\r
        IF SSTTop^.Next <> NIL THEN\r
         BEGIN\r
          SSTTop^.ParSize := SSTTop^.Next^.ParSize;\r
	  SSTTop^.GlobalVarSize := SSTTop^.Next^.GlobalVarSize;\r
	 END;\r
{$ENDIF}\r
         (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT SSTPushRoutine' );\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;\r
\r
\r
\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
\r
    PROCEDURE SSTPop;\r
      (* the procedure pops an element *)\r
\r
      VAR\r
        Ref : SSTelementRef;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START SSTPop' );\r
               END;\r
          (*ENDTEST#*)\r
\r
        Ref := SSTTop;\r
        SSTTop := SSTTop^.Next;\r
        dispose(Ref);\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT SSTPop' );\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;\r
\r
\r
\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
\r
    PROCEDURE SetCodeModeToTrue;\r
      (* Codemode is set to true *)\r
\r
      VAR\r
        Addr : Address;\r
        Reg : Register;\r
        i : integer;\r
        Lab : St_Address;\r
        Ptr : St_ElemPtr;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START SetCodeModeToTrue' );\r
               END;\r
          (*ENDTEST#*)\r
\r
\r
        IF Codemode = false THEN\r
          BEGIN\r
{$IFDEF RC5000}\r
           StaOff := (SSTTop^.MaxStackSize - SSTTop^.VarSize) div 4 ;\r
	   VarOff := (StaOff + 2 + CurrentNiv) + (SSTTOP^.VarSize div 4);\r
           LocalVarSize :=  SSTTop^.VarSize;\r
	   GlobalParSize := SSTTop^.ParSize;\r
	   GlobalVarSize := SSTTop^.GlobalVarSize;\r
           TempOffset := StaOff;\r
           ParamIndex := 0;\r
{$ENDIF}\r
            Codemode := true;\r
            IF Equal_Addr(SSTTop^.TempLabel,St_NillAddr) THEN\r
              BEGIN\r
                (* First time codemode is true in this block *)\r
{$IFDEF RC3502}\r
                GenerateEntryPoint(SSTTop^.EntryPoint);\r
                IF (SSTTop^.Kind = S_Prog) THEN\r
                  BEGIN\r
                    ChangeAppetite(BonAppetite);\r
                    CodeConst(rRECHW,0,AnonymousSpix);\r
                    CodeConst(rSTVGB,ExOpCode,AnonymousSpix);\r
                  END;\r
{$ELSE}\r
                GenerateLabel(SSTTop^.EntryPoint);\r
{$ENDIF}\r
{$IFDEF PI3}\r
\r
                IF (SSTTop^.Kind = S_Prog) THEN\r
                  BEGIN\r
                     IF OptionBreakPoint\r
                       THEN     CodeConst(iINT,3);\r
                   END\r
                ELSE\r
\r
\r
                   (* SSTTop^.Kind <> S_Prog  *)\r
                  (* Generate code: ENTER VarSize, CurrentNiv *)\r
\r
                  BEGIN  (* Makes new stack frame *)\r
                    CodeReg(iPUSH,w,BP);\r
\r
                    IF CurrentNiv = 1 THEN Reg := BP ELSE Reg := AX;\r
                    CodeRegReg(iMOV,w,Reg,SP);\r
\r
                    WITH Addr DO\r
                      BEGIN\r
                        Spix := AnonymousSpix;\r
                        Seg := SS;\r
                        Base := BP;\r
                        Index := RNil;\r
                      END;\r
\r
(* $nocheck*)\r
                    FOR i := 1 TO CurrentNiv - 1 DO\r
                      BEGIN\r
                        Addr.Displacement := -2 * i;\r
                        CodeAddr(iPUSH,w,Addr);\r
                      END;\r
\r
(* $check *)\r
\r
                    CodeReg(iPUSH,w,Reg);\r
                    IF CurrentNiv <> 1 THEN CodeRegReg(iMOV,w,BP,Reg);\r
\r
                  END;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
                   CodeConst(mLDL,1,AnonymousSpix);\r
                   CodeConst(mAJW,- (SSTTop^.MaxStackSize div 4) -\r
                                  ( Currentniv + 2),AnonymousSpix);\r
\r
                   (* Check for stack overflow *)\r
                   IF (CurrentNiv <> 0) AND\r
                      (SSTTop^.ExternalRoutine = false) THEN\r
                       CodeConst(mLDNL,0,Anonymousspix);\r
                   CodeConst(mLDNL,Proc_StackLimit,Anonymousspix);\r
                   CodeConst(mLDLP,0,Anonymousspix);\r
                   (*\r
                   GenCode(mCSUB0);*)\r
                   GenCode(mGT);\r
                    St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
                    CodeJump(mCJ,Lab);\r
\r
                    (*CodeFault(StackOverFlowInt,StackOverFlowExc);*)\r
                    CodeConst(mLDC,StackOverFlowExc,Anonymousspix);\r
                    CodeConst(mLDL,VarOff + 1,Anonymousspix);\r
                     IF (CurrentNiv <> 0) AND\r
                      (SSTTop^.ExternalRoutine = false) THEN\r
                      CodeConst(mLDNL,0,AnonymousSpix);\r
                    CodeConst(mLDL,VarOff + 1,Anonymousspix);\r
                     IF (CurrentNiv <> 0) AND\r
                      (SSTTop^.ExternalRoutine = false) THEN\r
                      CodeConst(mLDNL,0,AnonymousSpix);\r
                    CodeConst(mLDNL,10,Anonymousspix);\r
                    Gencode(mGCALL);\r
\r
                    GenerateLabel(Lab);\r
\r
\r
                   CodeConst(mLDL,VarOff + 1,Anonymousspix);\r
\r
                   IF (CurrentNiv = 0) OR\r
                      (SSTTop^.ExternalRoutine) then\r
                     BEGIN\r
                       CodeConst(mSTL,StaOff,Anonymousspix);\r
                     END\r
                   ELSE\r
                     BEGIN\r
                       Codeconst(mLDLP,StaOff,AnonymousSpix);\r
                       CodeConst(mLDC,(1 + CurrentNiv) * 4 ,AnonymousSpix);\r
                       GenCode(mMOVE);\r
                     END;\r
                   CodeConst(mLDLP,VarOff,AnonymousSpix);\r
                   CodeConst(mSTL,StaOff + CurrentNiv + 1,AnonymousSpix);\r
\r
                  IF SSTTop^.Kind <> S_Prog THEN\r
                  BEGIN\r
\r
                    IF SSTTop^.LocalRef THEN\r
                      CallRoutine(anonymousspix,Mark_LocalRef,St_extern);\r
                  END;\r
\r
{$ENDIF}\r
\r
\r
                    (* Check for stack overflow *)\r
{$IFDEF PI3}\r
                    (* Get the StackBound *)\r
                    Addr.Seg := DS;\r
                    Addr.Base := RNil;\r
                    Addr.Index := RNil;\r
                    Addr.Displacement := StackBoundOffset;\r
                    Addr.Spix := Anonymousspix;\r
\r
                    CodeRegReg(iMOV,w,AX,SP);\r
                    CodeRegAddr(iSUB,w,AX,Addr);\r
                    CodeRegConst(iCMP,w,AX,SSTTop^.MaxStackSize);\r
                    St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
                    CodeJump(iJA,Lab);\r
                    CodeFault(StackOverFlowInt,StackOverFlowExc);\r
                    GenerateLabel(Lab);\r
\r
\r
\r
\r
                  IF SSTTop^.Kind <> S_Prog THEN\r
                  BEGIN\r
                    IF SSTTop^.VarSize <> 0 THEN\r
                      CodeRegConst(iSUB,w,SP,SSTTop^.VarSize);\r
\r
                    IF SSTTop^.LocalRef THEN\r
                      CallRoutine(anonymousspix,Mark_LocalRef,St_extern);\r
                  END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
               IF SSTTop^.VarSize <> 0 THEN\r
               CodeConst(rRENHB,SSTTop^.VarSize,AnonymousSpix);\r
{$ENDIF}\r
              END\r
\r
            ELSE  (* ENTER has been called *)\r
              GenerateLabel(SSTTop^.TempLabel);\r
\r
          END;\r
\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT SetCodeModeToTrue' );\r
               END;\r
          (*ENDTEST#*)\r
      END;\r
\r
\r
\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
    PROCEDURE SetCodeModeToFalse;\r
      (* CodeMode is set to False *)\r
\r
      VAR\r
        Lab : St_Address;\r
        Ptr : St_ElemPtr;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START SetCodeModeToFalse' );\r
               END;\r
          (*ENDTEST#*)\r
\r
        IF Codemode = true THEN\r
          BEGIN\r
            Codemode := false;\r
            St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
            CodeJump(iJMP,Lab);\r
            SSTTop^.TempLabel := Lab;\r
          END;\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT SetCodeModeToFalse' );\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;\r
\r
\r
\r
\r
\r
    (* ---------------------------------------------------------------*)\r
\r
\r
    PROCEDURE LeaveRegion(RegV : St_Address);\r
      (* Generate Code to get out of a region statement *)\r
\r
      VAR Ptr : St_ElemPtr;\r
          Lab : St_Address;\r
          Addr : Address;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START LeaveRegion' );\r
               END;\r
          (*ENDTEST#*)\r
{$IFNDEF RC3502}\r
        St_Retrieve(RegV,Ptr);\r
\r
        PushAddr(Ptr);\r
\r
        ESTTop^.Par := P_Normal;\r
{$ENDIF}\r
{$IFDEF PI3}\r
        Loc(ESTTop,Addr);\r
(* $nocheck*)\r
        Addr.Displacement := Addr.Displacement + SharedCounterOffset;\r
\r
        CodeAddr(iDEC,w,Addr);\r
        CodeAddrConst(iCMP,w,Addr,0);\r
\r
        St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
        CodeJump(iJNE,Lab);\r
\r
        ESTTop^.Par := P_Share;\r
        Loc(ESTTop,Addr);\r
        ESTTop^.A_Displacement := ESTTop^.A_Displacement - LengthOfSemaphore;\r
\r
{$ENDIF}\r
\r
{$IFDEF RC5000}\r
            ESTTop^.OprType := IntegerType;\r
\r
            MakeCopyOfTop;\r
            AddOffsetToAddr(ESTTop,SharedCounterOffset);\r
\r
            MakeCopyOfTop;\r
            MakeCopyOfTop;\r
            MegaLoad(ESTTop);\r
            CodeConst(mADC,-1,Anonymousspix);\r
            MegaStore(4);\r
\r
            MegaLoad(ESTTop);\r
            ESTPop;\r
            CodeConst(mEQC,0,Anonymousspix);\r
\r
            St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
            CodeJump(mCJ,Lab);\r
\r
            ESTTop^.Par := P_Share;\r
            MegaMakeAddr(ESTTop);\r
            ESTTop^.T_ObjectOffset := ESTTop^.T_ObjectOffset -\r
                                      LengthOfSemaphore;\r
{$ENDIF}\r
{$IFNDEF RC3502}\r
        PushOperand;\r
{$ENDIF}\r
        CallRoutine(AnonymousSpix,SignalS,St_Extern);\r
{$IFNDEF RC3502}\r
        GenerateLabel(Lab);\r
\r
        ESTPop;\r
{$ENDIF}\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT LeaveRegion' );\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;  (* LeaveRegion *)\r
\r
\r
\r
    (* ---------------------------------------------------------------*)\r
\r
\r
\r
\r
    PROCEDURE LeaveLock(Lockend : Boolean; VAR ESTLockVar : ESTElementRef);\r
      (* Generate Code to get out of a Lock statement *)\r
\r
      VAR Addr : Address;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START LeaveLock' );\r
               END;\r
          (*ENDTEST#*)\r
{$IFDEF PI3}\r
\r
        GetReg(ES);\r
        GetReg(SI);\r
\r
        CodeReg(iPOP,w,SI);\r
        CodeReg(iPOP,w,ES);\r
\r
        With Addr DO\r
          BEGIN\r
            Spix := AnonymousSpix;\r
            Seg := ES;\r
            Base := RNil;\r
            Displacement := LockedOffset;\r
            Index := SI;\r
          END;\r
\r
        CodeAddr(iDEC,w,Addr);\r
        ReleaseAddr(Addr);\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
        ESTTop^.xforward := ESTLockvar;\r
        ESTLockVar^.Backward := ESTTop;\r
        ESTTop := ESTLockVar;\r
        IF NOT LockEnd THEN\r
          BEGIN\r
            MakeCopyOfTop;\r
            ExchangeTopElements;\r
            ESTLockVar := ESTTop;\r
            ESTTop := ESTTop^.BackWard;\r
            ESTTop^.xforward := nil;\r
          END;\r
        ESTTop^.OprType := IntegerType;\r
        AddOffsetToAddr(ESTTop,LockedOffset);\r
        MakeCopyOfTop;\r
        MegaLoad(ESTTop);\r
        CodeConst(mADC,-1,AnonymousSpix);\r
        MegaStore(4);\r
\r
{$ENDIF}\r
{$IFDEF RC3502}\r
        GenCode(rLRELE);\r
{$ENDIF}\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT LeaveLock' );\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;  (* Leavelock *)\r
\r
\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
    FUNCTION OutOfRepStat : SSTelementRef;\r
      (* Generate code to be ready to get out of the innermost repetition\r
         statement. The function returns the SSTelem. for the repetition\r
         statement *)\r
      VAR\r
        SSTTemp : SSTelementRef;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START OutOfRepStat' );\r
               END;\r
          (*ENDTEST#*)\r
\r
        SSTTemp := SSTTop;\r
\r
        WHILE (SSTTemp^.Kind  <> S_Loop ) DO\r
          BEGIN\r
            IF ( SSTTemp^.Kind = S_Region ) THEN\r
              LeaveRegion(SSTTemp^.RegVar)\r
            ELSE\r
              IF ( SSTTemp^.Kind = S_Lock  ) THEN\r
              (* Generate code to get out of the lock statement *)\r
              LeaveLock(false,SSTTemp^.ESTLockVar);\r
\r
            SSTTemp := SSTTemp^.Next;\r
          END;\r
\r
        OutOfRepStat := SSTTemp;\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT OutOfRepStat' );\r
               END;\r
          (*ENDTEST#*)\r
\r
\r
      END;\r
\r
\r
\r
    (* ---------------------------------------------------------------*)\r
\r
\r
    FUNCTION OutOfBlock : SSTelementRef;\r
      (* Generate code to be ready to get out of the innermost Block\r
         The function returns the SSTelem for the block *)\r
      VAR\r
        SSTTemp : SSTelementRef;\r
\r
      BEGIN\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' START OutOfBlock' );\r
               END;\r
          (*ENDTEST#*)\r
\r
        SSTTemp := SSTTop;\r
\r
        WHILE ((SSTTemp^.Kind  <> S_Routine ) AND\r
               (SSTTemp^.Kind  <> S_Prog )) DO\r
          BEGIN\r
            IF ( SSTTemp^.Kind = S_Region ) THEN\r
              LeaveRegion(SSTTemp^.RegVar)\r
            ELSE\r
              IF  ( SSTTemp^.Kind = S_Lock  ) THEN\r
              (* Generate code to get out of the lock statement *)\r
              LeaveLock(false,SSTTemp^.ESTLockVar);\r
\r
            SSTTemp := SSTTemp^.Next;\r
          END;\r
\r
        OutOfBlock := SSTTemp;\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 3 THEN\r
               BEGIN\r
                 writeln(TestOutPut,' SLUT OutOfBlock' );\r
               END;\r
          (*ENDTEST#*)\r
\r
\r
      END;\r
{$IFDEF RC3502}\r
    PROCEDURE ChangeAppetite(Val : Integer);\r
    BEGIN\r
      CodeConst(rREVGW,MaxStack,AnonymousSpix);\r
      IF Val <> 0 THEN\r
        BEGIN\r
         CodeConst(rRECHW,Val,AnonymousSpix);\r
         GenCode(rUSUB);\r
        END;\r
      GenCode(rCGREG);\r
      CodeConst(rUADHW,-2,AnonymousSpix);\r
      GenCode(rCRPUT);\r
    END;\r
{$ENDIF}\r
\r
\r
 (* -------END  STATEMENTSTACK ------- STATEMENTSSTACK --- *)\r
\r
\r
\r
«eof»