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

⟦34d4a1b63⟧ TextFile

    Length: 11735 (0x2dd7)
    Types: TextFile
    Names: »P4BOOL.PAS«

Derivation

└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
    └─⟦this⟧ »RTP\P4BOOL.PAS« 
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
    └─⟦this⟧ »RTP\P4BOOL.PAS« 
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
    └─⟦this⟧ »RTP\P4BOOL.PAS« 
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
    └─⟦this⟧ »P4BOOL.PAS« 
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
    └─⟦this⟧ »RTP\P4BOOL.PAS«

TextFile

\r
\r
    PROCEDURE Decode;\r
      (* The procedure convert the EST[Top] element to decode form,\r
         by generating a compare instruction. When generating the CMP inst.\r
         make sure there is a free accumulator *)\r
      VAR\r
        Addr : Address;\r
        StAddr : st_address;\r
        Reg : Register;\r
\r
      BEGIN\r
          (*#BEGINTEST\r
             IF TestPass4 >= 4 THEN\r
               BEGIN\r
                 writeln(TestOutput,' START Decode');\r
               END;\r
          (*ENDTEST#*)\r
        IF ESTSort(ESTTop) <> S_Decode THEN\r
          BEGIN\r
            StAddr := ESTTop^.OprType;\r
{$IFDEF PI3}\r
\r
            IF ESTSort(ESTTop) = S_Memery THEN\r
              BEGIN\r
                loc(ESTTop,Addr);\r
\r
                (* To make sure that there is one free accumulator *)\r
                SetSourceAddr(Addr);\r
                Reg := GetRegister(ABCDRegister,RNil);\r
                ReleaseRegister(Reg);\r
\r
\r
                CodeAddrConst(iCMP,b,Addr,0);\r
\r
                ESTPop;\r
                ReleaseAddr(Addr);\r
              END\r
\r
            ELSE\r
              BEGIN\r
                LoadRegister(ESTTop,AllRegister,Rnil,b);\r
                Reg := ESTTop^.R;\r
\r
                CodeRegConst(iCMP,b,Reg,0);\r
\r
                ReleaseRegister(Reg);\r
                ESTPop;\r
              END;\r
\r
            ESTPushDecode(St_NillAddr,St_NillAddr, iJE);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
            Megaload(ESTTop);\r
            ESTPop;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
            ESTPushDecode(St_NillAddr,St_NillAddr, iNIL);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
            ESTPushDecode(St_NillAddr,St_NillAddr, rOR);\r
{$ENDIF}\r
\r
         END;\r
          (*#BEGINTEST\r
             IF TestPass4 >= 4 THEN\r
               BEGIN\r
                 writeln(TestOutput,' SLUT  Decode');\r
               END;\r
          (*ENDTEST#*)\r
\r
      END;  (* End Decode *)\r
\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
    PROCEDURE Encode;\r
      (* The procedure converts the EST[Top] element to encode form,\r
         by generating code *)\r
\r
      VAR\r
        Reg : Register;\r
        Bool : boolean;\r
        L : St_Address;\r
        Ptr : St_ElemPtr;\r
\r
      BEGIN\r
          (*#BEGINTEST\r
             IF TestPass4 >= 4 THEN\r
               BEGIN\r
                 writeln(TestOutput,' START  Encode');\r
               END;\r
          (*ENDTEST#*)\r
        IF ESTSort(ESTTop) = S_Decode THEN\r
         BEGIN\r
{$IFDEF PI3}\r
           Reg := GetRegister(ABCDRegister,RNil);;\r
\r
           IF ( Equal_Addr( ESTTop^.FalseLab,St_NillAddr) AND\r
                Equal_Addr( ESTTop^.TrueLab,St_NillAddr)) THEN\r
             BEGIN\r
               CodeRegConst(iMOV,b,Reg,0);\r
               St_Declaration(CLabel,AnonymousName,L,Ptr);\r
               CodeJump(ESTTop^.Condition,L);\r
               CodeReg(iINC,w,Reg);\r
               GenerateLabel(L);\r
             END\r
\r
           ELSE\r
           IF NOT Equal_Addr(ESTTop^.FalseLab, St_NillAddr ) THEN\r
             BEGIN\r
               FallThruTrue;\r
               CodeRegConst(iMOV,b,Reg,1);\r
               St_Declaration(CLabel,AnonymousName,L,Ptr);\r
               CodeJump(iJMP,L);\r
               GenerateLabel(ESTTop^.FalseLab);\r
               CodeRegReg(iXOR,w,Reg,Reg);\r
               GenerateLabel(L);\r
             END\r
\r
           ELSE\r
           (* ESTTop^.TrueLab <> St_NillAddr *)\r
             BEGIN\r
               FallThruFalse;\r
               CodeRegReg(iXOR,w,Reg,Reg);\r
               St_Declaration(CLabel,AnonymousName,L,Ptr);\r
               CodeJump(iJMP,L);\r
               GenerateLabel(ESTTop^.TrueLab);\r
               CodeRegConst(iMOV,b,Reg,1);\r
               GenerateLabel(L);\r
             END;\r
           ESTPop;\r
           ESTPushReg(BooleanType,Reg);\r
{$ENDIF}\r
\r
{$IFDEF RC5000}\r
           IF Equal_Addr( ESTTop^.TrueLab,St_NillAddr) THEN\r
             BEGIN\r
               IF (ESTTop^.Condition = mEQC) or ( ESTTop^.Condition = iJE) THEN\r
               CodeConst(mEQC,0,AnonymousSpix)\r
               ELSE\r
               IF (ESTTop^.Condition = iJNE) then\r
                 BEGIN\r
                   CodeConst(mEQC,0,AnonymousSpix);\r
                   CodeConst(mEQC,0,AnonymousSpix);\r
                 END;\r
             END\r
           ELSE\r
             BEGIN\r
             IF (ESTTop^.Condition = iNIL) or (ESTTop^.Condition = iJNE) THEN\r
               CodeConst(mEQC,0,AnonymousSpix);\r
\r
               GenerateLabel(ESTTop^.TrueLab);\r
               CodeConst(mEQC,0,AnonymousSpix);\r
             END;\r
\r
\r
           IF NOT Equal_Addr(ESTTop^.FalseLab, St_NillAddr ) THEN\r
             BEGIN\r
               GenerateLabel(ESTTop^.FalseLab);\r
             END;\r
\r
\r
              ESTPop;\r
\r
              ESTPushStack(BooleanType,true);\r
              StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
\r
{$IFDEF RC3502}\r
             IF ESTTop^.Condition = rNOT THEN GenCode(rNOT)\r
             ELSE\r
               IF ESTTop^.Condition <> rOR THEN\r
                 BEGIN\r
                   CodeConst(rRECHW,0,Anonymousspix);\r
                   GenCode(ESTTop^.Condition);\r
                 END;\r
\r
           IF NOT Equal_Addr(ESTTop^.FalseLab, St_NillAddr ) THEN\r
             BEGIN\r
               St_Declaration(CLabel,AnonymousName,L,Ptr);\r
               if InStack = 0 THEN CodeConst(rRESTA,2,Anonymousspix);\r
               CodeJump(iJMP,L);\r
               InStack := InStack - 1;\r
               GenerateLabel(ESTTop^.FalseLab);\r
               CodeConst(rRECHW,0, Anonymousspix);\r
               GenerateLabel(L);\r
             END;\r
           IF NOT Equal_Addr(ESTTop^.TrueLab, St_NillAddr ) THEN\r
             BEGIN\r
               St_Declaration(CLabel,AnonymousName,L,Ptr);\r
               if InStack = 0 THEN CodeConst(rRESTA,2,Anonymousspix);\r
               CodeJump(iJMP,L);\r
               InStack := Instack - 1;\r
               GenerateLabel(ESTTop^.TrueLab);\r
               CodeConst(rRECHW,1,Anonymousspix);\r
               GenerateLabel(L);\r
             END;\r
           ESTPop;\r
           ESTPushStack(BooleanType,false);\r
{$ENDIF}\r
\r
         END;\r
          (*#BEGINTEST\r
             IF TestPass4 >= 4 THEN\r
               BEGIN\r
                 writeln(TestOutput,' SLUT  Encode');\r
               END;\r
          (*ENDTEST#*)\r
\r
      END; (* End Encode *)\r
\r
\r
    (* ------------------------------------------------------------ *)\r
\r
\r
\r
\r
    PROCEDURE FallThruFalse;\r
      (* Fall Thru on False. The procedure makes sure that the\r
         EST[Top] element is in decode form. The procedure generate\r
         code to fall thru on false and jump to a truelabel on true *)\r
\r
     VAR\r
        Ptr : St_ElemPtr;\r
\r
     BEGIN\r
          (*#BEGINTEST\r
             IF TestPass4 >= 4 THEN\r
               BEGIN\r
                 writeln(TestOutput,' START  FallThruFalse');\r
               END;\r
          (*ENDTEST#*)\r
\r
       IF ESTSort(ESTTop) <> S_Decode THEN\r
         Decode;\r
{$IFDEF PI3}\r
       IF ESTTop^.Condition <> INil THEN\r
         BEGIN\r
           IF Equal_Addr(ESTTop^.TrueLab,St_NillAddr) THEN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.TrueLab,Ptr);\r
           CodeJump(NegInstruction[ESTTop^.Condition],ESTTop^.TrueLab);\r
           ESTTop^.Condition := INil;\r
         END\r
       ELSE\r
         IF Equal_Addr(ESTTop^.TrueLab, St_NillAddr) THEN\r
           BEGIN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.TrueLab,Ptr);\r
             CodeJump(iJMP,ESTTop^.TrueLab);\r
           END;\r
\r
\r
{$ENDIF}\r
{$IFDEF RC3502}\r
       IF ESTTop^.Condition <> INil THEN\r
         BEGIN\r
           IF ESTTop^.Condition = rNOT THEN ESTTop^.Condition := rEQ\r
           ELSE\r
           IF ESTTop^.Condition = rOR THEN ESTTop^.Condition := rNE;\r
           IF Equal_Addr(ESTTop^.TrueLab,St_NillAddr) THEN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.TrueLab,Ptr);\r
           CodeJump(JumpInstruction[NegInstruction[ESTTop^.Condition]]\r
                    ,ESTTop^.TrueLab);\r
           ESTTop^.Condition := INil;\r
         END\r
       ELSE\r
         IF Equal_Addr(ESTTop^.TrueLab, St_NillAddr) THEN\r
           BEGIN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.TrueLab,Ptr);\r
             CodeJump(rJMPRW,ESTTop^.TrueLab);\r
           END;\r
\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
          if (ESTTop^.Condition = iNil) or (ESTTop^.Condition = iJNE) then\r
               codeconst(mEQC,0,AnonymousSpix);\r
\r
         IF Equal_Addr(ESTTop^.TrueLab, St_NillAddr) THEN\r
           BEGIN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.TrueLab,Ptr);\r
           END;\r
\r
         CodeJump(mCJ,ESTTop^.TrueLab);\r
\r
{$ENDIF}\r
       IF NOT Equal_Addr(ESTTop^.FalseLab, St_NillAddr) THEN\r
         BEGIN\r
           GenerateLabel(ESTTop^.FalseLab);\r
           ESTTop^.FalseLab := St_NillAddr;\r
         END;\r
\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 4 THEN\r
               BEGIN\r
                 writeln(TestOutput,' SLUT  FallThruFalse');\r
               END;\r
          (*ENDTEST#*)\r
\r
    END;  (* FallThruFalse *)\r
\r
\r
    (* ---------------------------------------------------------------- *)\r
\r
    PROCEDURE FallThruTrue;\r
      (* Fall thru on true. Analogous to FallThruFalse *)\r
\r
     VAR\r
        Ptr : St_ElemPtr;\r
\r
\r
     BEGIN\r
          (*#BEGINTEST\r
             IF TestPass4 >= 4 THEN\r
               BEGIN\r
                 writeln(TestOutput,' START  FallThruFalse');\r
               END;\r
          (*ENDTEST#*)\r
\r
       IF ESTSort(ESTTop) <> S_Decode THEN\r
         Decode;\r
{$IFDEF RC3502}\r
\r
       IF ESTTop^.Condition <> INil THEN\r
         BEGIN\r
           IF ESTTop^.Condition = rNOT THEN ESTTop^.Condition := rEQ\r
           ELSE\r
           IF ESTTop^.Condition = rOR THEN ESTTop^.Condition := rNE;\r
           IF Equal_Addr(ESTTop^.FalseLab, St_NillAddr) THEN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.FalseLab,Ptr);\r
           CodeJump(JumpInstruction[ESTTop^.Condition],ESTTop^.FalseLab);\r
           ESTTop^.Condition := INil;\r
         END\r
       ELSE\r
         IF Equal_Addr(ESTTop^.FalseLab, St_NillAddr) THEN\r
           BEGIN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.FalseLab,Ptr);\r
             CodeJump(rJMPRW,ESTTop^.FalseLab);\r
           END;\r
\r
\r
\r
\r
{$ENDIF}\r
{$IFDEF PI3}\r
\r
       IF ESTTop^.Condition <> INil THEN\r
         BEGIN\r
           IF Equal_Addr(ESTTop^.FalseLab, St_NillAddr) THEN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.FalseLab,Ptr);\r
           CodeJump(ESTTop^.Condition,ESTTop^.FalseLab);\r
           ESTTop^.Condition := INil;\r
         END\r
       ELSE\r
         IF Equal_Addr(ESTTop^.FalseLab, St_NillAddr) THEN\r
           BEGIN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.FalseLab,Ptr);\r
             CodeJump(iJMP,ESTTop^.FalseLab);\r
           END;\r
\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
        if (ESTTop^.Condition = mEQC) or (ESTTop^.Condition = iJE) then\r
               codeconst(mEQC,0,AnonymousSpix);\r
\r
         IF Equal_Addr(ESTTop^.FalseLab, St_NillAddr) THEN\r
           BEGIN\r
             St_Declaration(CLabel,AnonymousName,ESTTop^.FalseLab,Ptr);\r
           END;\r
\r
         CodeJump(mCJ,ESTTop^.FalseLab);\r
\r
{$ENDIF}\r
       IF NOT Equal_Addr(ESTTop^.TrueLab, St_NillAddr) THEN\r
         BEGIN\r
           GenerateLabel(ESTTop^.TrueLab);\r
           ESTTop^.TrueLab := St_NillAddr;\r
         END;\r
\r
\r
          (*#BEGINTEST\r
             IF TestPass4 >= 4 THEN\r
               BEGIN\r
                 writeln(TestOutput,' SLUT  FallThruTrue');\r
               END;\r
          (*ENDTEST#*)\r
\r
    END;  (* FallThruTrue *)\r
\r
\r
   (* ---------END PROCEDURE  BOOLEANEXP -----------BOOLEANEXP -- *)\r
\r
\r
«eof»