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

⟦3c3c5b2ef⟧ TextFile

    Length: 20518 (0x5026)
    Types: TextFile
    Names: »P4REGADM.PAS«

Derivation

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

TextFile

{$O+,F+}\r
unit p4regadm;\r
interface\r
uses p4unit;\r
\r
    (* ------ CONST  REGISTERADM -------REGISTERADM ---*)\r
CONST\r
\r
      NormalMinFreeReg  = 2;\r
\r
\r
\r
\r
\r
\r
\r
      (************************ VAR REGISTERADMISTRATOR **************)\r
VAR\r
\r
\r
      MakingFreeReg : boolean;\r
         (* If true the user can allocate all register else only MinFreeReg\r
        can be allocated *)\r
\r
      NoOfFreeReg : integer;\r
        (* gives the number of free register *)\r
\r
\r
      MinFreeReg : integer;  (* Must be greater than 1 *)\r
\r
\r
\r
\r
\r
\r
\r
    PROCEDURE InitRegisterAdm;\r
\r
\r
    FUNCTION FreeRegister(RegT : RegisterType) : Register;\r
\r
    PROCEDURE MakeFreeRegister;\r
\r
\r
    PROCEDURE MakeRegFree( r : Register);\r
\r
    PROCEDURE GetReg(r : Register);\r
\r
    FUNCTION GetRegister(RegT : RegisterType; Reg : Register) : Register;    PROCEDURE ReleaseRegister(r : Register);\r
\r
    PROCEDURE ReleaseAddr(VAR a : Address);\r
\r
    PROCEDURE SetSourceEST(e : ESTelementRef);\r
\r
    PROCEDURE SetSourceAddr(VAR a : Address);\r
\r
    PROCEDURE SetSource( Reg : Register);\r
\r
\r
\r
\r
IMPLEMENTATION\r
uses pscplm,mpaunit,sthcom,sthunit,p4evalst,p4estopr,p4code;\r
        (************** PRIVATE TYPES FOR REGADM **********)\r
 TYPE\r
      PListOfRegCont = ^ListOfRegCont;\r
         (* List of register which contents other register contains while\r
        making free register *)\r
\r
      ListOfRegCont = RECORD\r
                RegisterOwner, RegisterTemp : Register;\r
                Next : PListOfRegCont;\r
                  END;\r
\r
\r
\r
\r
      (*************** PRIVATE VAR FOR REGADM *************)\r
 VAR\r
      ListOfReg : PListOfRegCont;\r
        (* List of register's contents in other regisrer *)\r
\r
\r
  (********************* PROCEDURE REGADM *********************)\r
  (* This module impl. operations on register used to allocate\r
     register    *)\r
\r
\r
\r
\r
\r
   (*#BEGINTEST\r
\r
  PROCEDURE TestRegAdm;\r
    { Prints reginf for all register }\r
\r
     PROCEDURE PrintStatus( S : RegStatus);\r
       BEGIN\r
         CASE S OF\r
           Free :   write(TestOutput,'F  ');\r
           NotFree: write(TestOutput,'NF  ');\r
           SourceAndNotFree:  write(TestOutput,'S  ');\r
           SourceAndDist : write(TestOutput,'SD  ');\r
           NotChange : write(TestOutput,'NC  ');\r
         END;\r
       END;  \r
\r
  \r
    BEGIN\r
      write(TestOutPut,'AX ');\r
      PrintStatus(RegInf[AX].Status);\r
      write(TestOutPut,'CX ');\r
      PrintStatus(RegInf[CX].Status);\r
      write(TestOutPut,'DX ');\r
      PrintStatus(RegInf[DX].Status);\r
      write(TestOutPut,'BX ');\r
      PrintStatus(RegInf[BX].Status);\r
      write(TestOutPut,'SI ');\r
      PrintStatus(RegInf[SI].Status);\r
      write(TestOutPut,'DI ');\r
      PrintStatus(RegInf[DI].Status);\r
      write(TestOutPut,'ES ');\r
      PrintStatus(RegInf[ES].Status);\r
      writeln(TestOutput);\r
    END;\r
\r
  (*ENDTEST#*)\r
\r
    (* -------------------------------------------------------- *)\r
\r
\r
            \r
\r
\r
    PROCEDURE InitRegisterAdm;\r
      (* The procedure initialize the module RegisterAdm *)\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','InitRegisterAdm');\r
             END;\r
        (*ENDTEST#*)\r
\r
        RegInf[AX].Status := Free;\r
        RegInf[BX].Status := Free;\r
        RegInf[CX].Status := Free;\r
        RegInf[DX].Status := Free;\r
        RegInf[SI].Status := Free;\r
        RegInf[DI].Status := Free;\r
        RegInf[ES].Status := Free;\r
\r
        RegInf[AX].ESTPointer := Nil;\r
        RegInf[BX].ESTPointer := Nil;\r
        RegInf[CX].ESTPointer := Nil;\r
        RegInf[DX].ESTPointer := Nil;\r
        RegInf[SI].ESTPointer := Nil;\r
        RegInf[DI].ESTPointer := Nil;\r
        RegInf[ES].ESTPointer := Nil;\r
\r
\r
        NoOfFreeReg := 7;\r
\r
        MinFreeReg := NormalMinFreeReg;\r
\r
\r
        MakingFreeReg := False;\r
        ListOfReg := nil;\r
\r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','InitRegisterAdm');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END;\r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
\r
    FUNCTION FreeRegister(RegT : RegisterType) : Register;\r
      (* The function returns a free register else RNil\r
         is returned *)\r
      VAR R, Reg : Register;\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','FreeRegister');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
            Reg := RNil;\r
\r
            Case RegT OF\r
\r
              SpecificReg, AllRegister,ABCDRegister :\r
                BEGIN\r
                  FOR R := BX DownTo AX DO\r
                    IF RegInf[r].Status = Free THEN Reg := r;\r
                  \r
                  IF (Reg = RNil) AND (RegT <> ABCDRegister) THEN\r
                    IF RegInf[SI].Status = Free THEN Reg := SI\r
                    ELSE\r
                      IF RegInf[DI].Status = Free THEN Reg := DI;\r
                END;\r
\r
              AddrRegister,IndexRegister :\r
                BEGIN\r
                  IF RegInf[SI].Status = Free THEN Reg := SI\r
                  ELSE\r
                    IF RegInf[DI].Status = Free THEN Reg := DI\r
                    ELSE\r
                      IF (RegInf[BX].Status = Free) AND (RegT = AddrRegister)\r
                        THEN Reg := BX;\r
                END;\r
            END; (* case *)\r
\r
        FreeRegister := Reg;\r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','FreeRegister ',ord(Reg));\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
\r
\r
\r
    PROCEDURE MakeFreeRegister;\r
      (* The procedure makes some free register by pushing the run time\r
         Stack *)\r
\r
      VAR\r
        r : Register;\r
        List : PListOfRegCont;\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','MakeFreeRegister');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
        FOR r := AX TO ES DO\r
          IF RegInf[r].Status = SourceAndNotFree THEN\r
            RegInf[r].Status := NotChange;\r
\r
        MakingFreeReg := true;\r
        MinFreeReg := 0;\r
\r
        WHILE NoOfFreeReg <= NormalMinFreeReg DO Push1Operand;\r
\r
        MinFreeReg := NormalMinFreeReg;\r
        MakingFreeReg := False;\r
\r
        WHILE ListOfReg <> nil DO\r
          BEGIN\r
            CodeRegReg(iMOV,w,ListOfReg^.RegisterOwner,\r
                                         ListOfReg^.RegisterTemp);\r
            RegInf[ListOfReg^.RegisterOwner] := RegInf[ListOfReg^.RegisterTemp];\r
            RegInf[ListOfReg^.RegisterTemp].Status := Free;\r
            RegInf[ListOfReg^.RegisterTemp].ESTPointer := nil;\r
            List := ListOfReg;\r
            ListOfReg := List^.Next;\r
            dispose(List);\r
          END;\r
\r
        FOR r := AX TO ES DO\r
          IF RegInf[r].Status = NotChange THEN\r
            RegInf[r].Status := SourceAndNotFree;\r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','MakeFreeRegister');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
\r
\r
    PROCEDURE MakeRegFree( r : Register);\r
      (* Makes r Free *)\r
\r
      VAR\r
        ESTRef : ESTelementRef;\r
        Reg : Register;\r
        Found : Boolean;\r
        List : PListOfRegCont;\r
        Ptr : St_elemptr;\r
        R_HasBeenReleased  : Boolean;\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','MakeregFree');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
        R_HasBeenReleased := false;\r
\r
\r
        ESTRef := RegInf[r].EStPointer;\r
        IF ((Not MakingFreeReg) AND\r
            ((ESTRef = nil) OR\r
             (RegInf[r].Status <> NotFree))) THEN Fatal_Error(Pass4,1);\r
\r
\r
        IF ( MakingFreeReg AND\r
            (( RegInf[r].Status <> NotFree) OR\r
             (ESTRef = Nil))) THEN\r
          BEGIN\r
            (* Making free and the register may not be change *)\r
            Reg := FreeRegister(AllRegister);\r
\r
            CodeRegReg(iMOV,w,Reg,r);\r
            RegInf[Reg] := RegInf[r];\r
\r
            (* Who is the owner of r's contents *)\r
            List := ListOfReg;\r
            Found := False;\r
        \r
            WHILE ( Not Found AND (List <> Nil)) DO\r
              BEGIN\r
                IF List^.RegisterTemp = r THEN\r
                  BEGIN\r
                    List^.RegisterTemp := Reg;\r
                    Found := True;\r
                  END;\r
                List := List^.Next;\r
              END;\r
\r
            IF NOT Found THEN\r
              BEGIN\r
                (* r is the owner *)\r
                new(List);\r
                List^.RegisterOwner := r;\r
                List^.RegisterTemp := Reg;\r
                List^.Next := ListOfReg;\r
                ListOfReg := List;\r
              END;\r
          END\r
 \r
        ELSE\r
          BEGIN\r
            (*  r must be substitued by another register *)\r
\r
            IF ESTRef^.Kind = O_Reg THEN\r
              BEGIN\r
                Reg := FreeRegister(AllRegister);\r
\r
                (* Reg is a free register *)\r
                CodeRegReg(iMOV,w,Reg,r);\r
\r
                ESTRef^.R := Reg;\r
                (* r is free *)\r
              END\r
\r
            ELSE (* ESTRef^.Kind = O_AbsAddr *)\r
              BEGIN\r
                (* if the operand is simpel it is loaded  *)\r
                ST_Retrieve(ESTRef^.OprType,Ptr);\r
                Reg := FreeRegister(AllRegister);\r
                IF ( ( MinFreeReg = NormalMinFreeReg)  AND\r
                     ESTRef^.IndVar AND\r
                   ((Ptr^.St_Size = 1) OR ( Ptr^.St_Size = 2) ) AND\r
                    ( ESTRef^.A_Seg = ES) AND\r
                    (ORD(ESTRef^.A_Index) >= ORD(BX)  )) THEN\r
                   BEGIN\r
                     (* The operand can be loaded without allocating new register *)\r
                     MinFreeReg := 0;\r
                     \r
                     LoadRegister(ESTRef,SpecificReg,Reg,w);\r
                     MinFreeReg := NormalMinFreeReg;\r
                     R_HasBeenReleased := true;\r
                   END\r
                ELSE\r
\r
                IF ESTRef^.A_Seg = r THEN\r
                  BEGIN (* Try to get a segment register *)\r
                    IF RegInf[ES].Status = Free THEN\r
                      Reg := ES\r
                    ELSE\r
                        Reg := FreeRegister(AllRegister);\r
\r
\r
                    (* Reg is free *)\r
                    CodeRegReg(iMOV,w,Reg,r);\r
\r
                    ESTRef^.A_Seg := Reg;\r
                    (* r is free *)\r
                  END\r
                ELSE\r
                 BEGIN\r
                   (* ESTRef^.A_Index = r *)\r
                   Reg := FreeRegister(AddrRegister);\r
                   IF Reg = RNil THEN Reg := FreeRegister(AllRegister);\r
\r
                   (* Reg is free *)\r
                   CodeRegReg(iMOV,w,Reg,r);\r
\r
                   ESTRef^.A_Index := Reg;\r
                   (* r is free *)\r
                 END;\r
              END;\r
          \r
            (* update RegInf for Reg *)\r
            RegInf[Reg].Status := NotFree;\r
            RegInf[Reg].ESTPointer := ESTRef;\r
          END;\r
\r
\r
        IF R_HasBeenReleased = false THEN\r
          BEGIN\r
            (* update reginf for r *)\r
            RegInf[r].Status := Free;\r
            RegInf[r].ESTPointer := nil;\r
          END;\r
  \r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','MakeRegFree');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
\r
    PROCEDURE GetReg(r : Register);\r
      (* The procedure makes r free and allocated it*)\r
\r
      VAR\r
        Reg : Register;\r
\r
      BEGIN\r
        Reg := GetRegister(SpecificReg,r);\r
      END; \r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
    FUNCTION GetRegister(RegT : RegisterType; Reg : Register) : Register;\r
      (* The function makes a  free register and allocated it *)\r
\r
      VAR R : Register;\r
          Ref : EstElementRef;\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','GetRegister ', Nooffreereg,' ',\r
                                                   ord(reg), ' ',ord(RegT));\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
        IF Reg = RNil THEN\r
          BEGIN\r
            (* Try to get a source register *)\r
            Case RegT OF\r
 \r
              SpecificReg, AllRegister,ABCDRegister :\r
                BEGIN\r
                  FOR R := BX DownTo AX DO\r
                    IF RegInf[r].Status = SourceAndNotFree THEN Reg := r;\r
                  IF (Reg = RNIL) AND (RegT <> ABCDRegister) THEN\r
                    IF RegInf[SI].Status = SourceAndNotFree THEN Reg := SI\r
                    ELSE\r
                      IF RegInf[DI].Status = SourceAndNotFree THEN Reg := DI;\r
                END;\r
\r
              AddrRegister,IndexRegister :\r
                BEGIN\r
                  IF RegInf[SI].Status = SourceAndNotFree THEN Reg := SI\r
                  ELSE\r
                    IF RegInf[DI].Status = SourceAndNotFree THEN Reg := DI\r
                    ELSE\r
                      IF (RegInf[BX].Status = SourceAndNotFree) AND\r
                         (RegT = AddrRegister)  THEN Reg := BX;\r
                END;\r
            END; (* case *)\r
          END;\r
\r
      IF NoOfFreeReg <= MinFreeReg THEN\r
        IF (Reg = RNil) OR (RegInf[Reg].Status <> SourceAndNotFree) THEN\r
          (* no source register can be allocated. make a register free *)\r
          MakeFreeRegister;\r
\r
      IF Reg = RNil THEN Reg := FreeRegister(RegT);\r
\r
      IF Reg = RNil THEN\r
        BEGIN\r
          (* Find the first register used on EST that can be used *)\r
          Ref := LastOnStack^.xForWard;\r
          While Reg = RNil DO\r
           BEGIN\r
\r
            Case RegT OF\r
 \r
              SpecificReg, AllRegister,ABCDRegister :\r
                BEGIN\r
                  FOR R := BX DownTo AX DO\r
                    IF RegInf[r].ESTPointer = Ref THEN Reg := r;\r
                  IF (Reg = RNil) AND (RegT <> ABCDRegister) THEN\r
                    IF RegInf[SI].ESTPointer = Ref THEN Reg := SI\r
                    ELSE\r
                      IF RegInf[DI].ESTPointer = Ref THEN Reg := DI;\r
                END;\r
\r
              AddrRegister,IndexRegister :\r
                BEGIN\r
                  IF RegInf[SI].ESTPointer = Ref THEN Reg := SI\r
                  ELSE\r
                    IF RegInf[DI].ESTPointer = Ref THEN Reg := DI\r
                    ELSE\r
                      IF (RegInf[BX].ESTPointer = Ref) AND\r
                         (RegT = AddrRegister) THEN Reg := BX;\r
                END;\r
            END; (* case *)\r
            Ref := Ref^.xForWard;\r
           END;\r
        END;\r
\r
      (* Reg Must be allocated *)\r
      With RegInf[Reg] DO\r
        BEGIN\r
          IF Status = SourceAndNotFree THEN Status := SourceAndDist\r
          ELSE\r
            BEGIN\r
              IF Status = NotFree THEN MakeRegFree(Reg);\r
              Status := NotFree;\r
              ESTPointer := Nil;\r
              NoOfFreeReg := NoOfFreeReg - 1;\r
            END;\r
        END;\r
\r
\r
\r
\r
      GetRegister := Reg;\r
\r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','GetRegister');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
    PROCEDURE ReleaseRegister(r : Register);\r
      (* The register r is set to free *)\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','ReleaseRegister ',ord(r));\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
        IF (((ord(AX) <= ord(r)) AND (ord(r) <= ord(BX)) ) OR\r
            (r = SI) OR (r = DI) OR (r = ES)) THEN\r
          BEGIN\r
            IF RegInf[r].Status = SourceAndDist\r
              THEN RegInf[r].Status := NotFree\r
            ELSE\r
              BEGIN\r
                RegInf[r].Status := Free;\r
                RegInf[r].ESTPointer := nil;\r
                NoOfFreeReg := NoOfFreeReg + 1;\r
              END;\r
          END;\r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','ReleaseRegister');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
    PROCEDURE ReleaseAddr(VAR a : Address);\r
      (* Every register used in a is set to free *)\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','ReleaseAddr');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
        IF a.Seg = ES THEN ReleaseRegister(ES);\r
        IF a.Base = BX THEN ReleaseRegister(BX);\r
        IF a.Index <> RNil THEN ReleaseRegister(a.Index);\r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','ReleaseAddr');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
    PROCEDURE SetSourceEST(e : ESTelementRef);\r
      (* Set register used in e to SourceAndNotFree *)\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','SetSourceEST');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
        IF e^.Kind = O_Reg THEN\r
          RegInf[e^.R].Status := SourceAndNotFree\r
        ELSE\r
        IF e^.Kind = O_AbsAddr THEN\r
          BEGIN\r
            RegInf[e^.A_Seg].Status := SourceAndNotFree;\r
            RegInf[e^.A_Index].Status := SourceAndNotFree;\r
          END;\r
      \r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','SetSourceEST');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
    PROCEDURE SetSourceAddr(VAR a : Address);\r
     (* Set register used in a to SourceAndNotFree *)\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','SetSourceAddr');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
        RegInf[a.Seg].Status := SourceAndNotFree;\r
        RegInf[a.Index].Status := SourceAndNotFree; \r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','SetSourceAddr');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
\r
\r
\r
   (*------------------------------------------------------------- *)\r
\r
\r
\r
    PROCEDURE SetSource( Reg : Register);\r
      (* Set reg to SourceAndNotFree *)\r
\r
      BEGIN\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' START  ','SetSource');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
\r
        RegInf[Reg].Status := SourceAndNotFree;\r
\r
        (*#BEGINTEST\r
           IF TestPass4 >= 7 THEN\r
             BEGIN\r
               writeln(TestOutput,' SLUT  ','SetSource');\r
               TestRegAdm;\r
             END;\r
        (*ENDTEST#*)\r
      END; \r
\r
END.\r
   (********** END PROCEDURE REGADM ******************)\r
\r
«eof»