SetModule;

$NoIndex

  TYPE
    (* The type sets describes the way a set is represented on runtime *)

    setbit = Array(4..4) of byte;

    Settemp = RECORD
             Length : integer;   
             BitVector : setbit;
           END;

    SetAddr = ^Settemp;


    SetConst = Array(1..2) Of Integer;


  FUNCTION GetMemory(Size : Integer) : SetAddr; EXTERNAL;

  PROCEDURE PutMemory(Addr : SetAddr; Size : integer); EXTERNAL;
.


  (******************** ADDSET ******************************)

  FUNCTION AddSet(Addr1 : SetAddr; Size1 : integer;
                  Addr2 : SetAddr; Size2 : integer) : SetAddr;

    (* Add the sets given by addr1 and addr2. Temp memery are allocated
       for the result. The memery for the operands are released if temp.
       memery *)
   
    VAR
      Length : integer;
      ResAddr : SetAddr;
      Res : Byte;
      Index1, Index2 : Integer;
      Rel1,Rel2 : Boolean;

    BEGIN
      index1 := 0;
      index2 := 0;
      Rel1 := ( size1 = 0);
      Rel2 := ( Size2 = 0);
      IF Rel1 THEN
        BEGIN
         Size1 := Addr1^.Length;
         Index1 := 4;
        END;
      IF Rel2 THEN
        BEGIN
          Size2 := Addr2^.Length;
          Index2 := 4;
        END;

      IF Size1 < size2 THEN Length := Size2 ELSE Length := Size1;

       (* Allocated memery for the result *)
      resaddr := GetMemory(Length + #H004);
      ResAddr^.Length := Length;
 

      (* The add is made by  BitVector1 or Bitvector2 *)
      FOR Index := 1 TO Length DO
        BEGIN
          IF (index > size1) THEN
            Res := Addr2^.BitVector(Index2 + Index - 1)
          ELSE
          IF (index > size2) THEN
              Res := Addr1^.BitVector(Index1 + index - 1) 
          ELSE
              Res := Addr1^.BitVector(Index1 + index - 1) OR
                     Addr2^.BitVector(Index2 + index - 1);
 
          ResAddr^.BitVector(Index + 3) := Res;
        END;


       (*  Release memery if nes *)
      IF Rel2 THEN
        BEGIN
          PutMemory(Addr2,Size2 + #H004);
        END;

      IF Rel1 THEN
        BEGIN
          PutMemory(Addr1,Size1 + #H004);
        END;

      AddSet := ResAddr;
    END;



  (*********************** SUBSET *****************************)

  FUNCTION SubSet(Addr1 : SetAddr; Size1 : integer;
                  Addr2 : SetAddr; Size2 : integer) : SetAddr;
    (* If addr1 is represented in temp. memery this memery is used for the 
       result. Else temp. memery is allocated for the result. The memery
       for the 2. operand is released if temp. memery *)

    VAR
      Length : integer;
      ResAddr : SetAddr;
      Res : Byte;
      Index1, Index2 : Integer;
      Rel1,Rel2 : Boolean;

    BEGIN
      index1 := 0;
      index2 := 0;
      Rel1 := ( size1 = 0);
      Rel2 := ( Size2 = 0);
      IF Rel1 THEN
        BEGIN
         Size1 := Addr1^.Length;
         Index1 := 4;
        END;
      IF Rel2 THEN
        BEGIN
          Size2 := Addr2^.Length;
          Index2 := 4;
        END;

     Length := Size1;

       (* Allocated memery for the result *)
      IF Rel1 THEN
        ResAddr := Addr1
      ELSE
        BEGIN
          resaddr := GetMemory(Length + #H004);
          ResAddr^.Length := Length;
        END; 

      (* Sub sets are made by Bitvector1 And (not Bitvector2)  *)
      FOR Index := 1 TO Length DO
        BEGIN
          IF (index > size2) THEN
            Res := Addr1^.BitVector(Index1 + Index - 1)
          ELSE
              Res := Addr1^.BitVector(Index1 + index - 1) AND
                     ( NOT Addr2^.BitVector(Index2 + index - 1));
 
          ResAddr^.BitVector(Index + 3) := Res;
        END;


       (*  Release memery if nes *)
      IF Rel2 THEN
        BEGIN
          PutMemory(Addr2,Size2 + #H004);
        END;

      SubSet := ResAddr;
    END;



  (************************* MULTSET **********************)


  FUNCTION MultSet(Addr1 : SetAddr; Size1 : Integer;
                   Addr2 : SetAddr; Size2 : Integer) : SetAddr;
   
    (* If addr1 or addr2 is represented in temp. memery this memery is used 
       for the result. Else temp. memery is allocated for the result. The memery
       for the 2. operand is released if temp. memery and not used for result *)

    VAR
      Length : integer;
      ResAddr : SetAddr;
      Res : Byte;
      Index1, Index2 : Integer;
      Rel1,Rel2 : Boolean;

    BEGIN
      index1 := 0;
      index2 := 0;
      Rel1 := ( size1 = 0);
      Rel2 := ( Size2 = 0);
      IF Rel1 THEN
        BEGIN
         Size1 := Addr1^.Length;
         Index1 := 4;
         Length := Size1;
         ResAddr := Addr1;
        END;
      IF Rel2 THEN
        BEGIN
          Size2 := Addr2^.Length;
          Index2 := 4;
          IF not Rel1 THEN
            BEGIN
              Length := Size2;
              ResAddr := Addr2;
            END;
        END;

       (* Allocated memery for the result *)
      IF NOT (Rel1 OR Rel2)  THEN
        BEGIN
          if Size1 > size2 THEN Length := Size2 ELSE Length := Size1;
          resaddr := GetMemory(Length + #H004);
          ResAddr^.Length := Length;
        END; 

      (* Mult sets are made by Bitvector1 And Bitvector2)  *)
      FOR Index := 1 TO Length DO
        BEGIN
          IF (index > size2) or (index > Size1) THEN
            Res := 0
          ELSE
              Res := Addr1^.BitVector(Index1 + index - 1) AND
                     Addr2^.BitVector(Index2 + index - 1);
 
          ResAddr^.BitVector(Index + 3) := Res;
        END;


       (*  Release memery if nes *)
      IF Rel1 AND Rel2 THEN
        BEGIN
          PutMemory(Addr2,Size2 + #H004);
        END;

      MultSet := ResAddr;
    END;


  (***************************** INSET **************************)

  FUNCTION InSet(elem : integer;Addr : SetAddr; Size : Integer) : Boolean;
    (* The function returns true if elem is in the set Addr .
       The memery addr is released if temp. memery *)

    VAR
      Rel,Res : Boolean;
      index : integer;
      ByteOffset, BitOffset : integer;


    BEGIN
      index := 0;
      Rel := ( size = 0);
      IF Rel THEN
        BEGIN
         Size := Addr^.Length;
         Index := 4;
        END;
    

      IF (elem < 0) OR ( (size * 8) <= elem) THEN 
            Res := false
          ELSE
            BEGIN
              ByteOffset := elem Div 8;
              BitOffset := elem Mod 8;
              WITH Res As x : Byte DO 
                x := (Addr^.BitVector(index + ByteOffset) 
                                       Shift (-BitOffset)) AND #H1;
            END;

      IF  Rel THEN
        BEGIN
          PutMemory(Addr,size + #H004);
        END;


      InSet := Res;
    END;


  (*********************** ASSIGNSET ************************)

  PROCEDURE AssignSet(Addr1 : SetAddr;Low : integer;
                      Addr2 : SetAddr; Size,High : integer);
    (* The set given by Addr2 is assign to Addr1. Addr2 may not have values 
       outside the range low..high.
       IF addr2 is Temp. memery then the memery is released  *)

    VAR
       index : integer;
       rel : boolean;


    BEGIN
      index := 0;
      Rel := ( size = 0);
      IF Rel THEN
        BEGIN
         Size := Addr2^.Length;
         Index := 4;
        END;
      IF Low DIV 8 < size THEN
      BEGIN
        FOR i := 1 to (low DIV 8) DO
        IF Addr2^.Bitvector(index + i - 1) <> 0 THEN
           Exception(63);
        IF ( Addr2^.Bitvector(index + (Low Div 8)) AND
           ( (1 SHIFT (Low MOD 8))-1 ) ) <> 0 THEN 
           Exception(63);
      END;
      
      IF high DIV 8 < size THEN
      BEGIN
        FOR i := (high DIV 8)+2 to size DO
        IF Addr2^.Bitvector(index + i - 1) <> 0 THEN
           Exception(63);
        IF ( Addr2^.Bitvector(index + (High Div 8)) SHIFT
            ( - (High MOD 8) - 1   ) ) <> 0 THEN 
           Exception(63);
      END;



      FOR i := 0 TO (High DIV 8) DO
        BEGIN
          IF i >= Size THEN
             Addr1^.Bitvector(i) := 0
          ELSE
             Addr1^.BitVector(i) := Addr2^.BitVector(Index + i);
        END;
           
      (*  Release memery *)
      IF  Rel THEN
        BEGIN
          PutMemory(Addr2,Size + #H004);
        END;
    END;



   (***************************** MAKESET *************************)



  FUNCTION MakeSet(Lengthset1 : Integer; SetKon : SetConst) : SetAddr;
    
    (* SetKon Gives a number of range values. The procedure makes a set
       containing these values 
       SetKon is in the following format :
           Lengthset1        : Number of ranges.
           SetKon(i * 2 - 1  : lower for the i'te range.
           SetKon(i * 2 )    : higher for the i'te range.*)
    VAR
      Min, Max : Integer;
      LowKon, HighKon : Integer;
      ByteOffset, BitOffset : integer;
      Length : integer;
      ResAddr : SetAddr;
  
    BEGIN
      (* Compute min and max for the new set *)
          Min := SetKon(1);
          Max := SetKon(2);
          FOR i := 2 TO LengthSet1 DO
            BEGIN
              IF Min > SetKon(i * 2 - 1) THEN Min := SetKon(i * 2 - 1);
              IF Max <= SetKon(i * 2) THEN Max := SetKon(i * 2);
            END;

          IF Min < 0 THEN Exception(63);
          
          Length := ( (Max DIV 8) + 1);

      (* Allocate memery *)
          ResAddr := GetMemory(Length + #H004);
          ResAddr^.Length := Length;

          FOR i := 1 TO (Length) DO
            ResAddr^.BitVector(i+3) := #H00;

          FOR i := 1 TO LengthSet1 DO
          BEGIN
            HighKon := SetKon(i*2);
            LowKon := SetKon(i * 2 - 1);
            FOR i := LowKon TO HighKon DO
             BEGIN
               ByteOffset := (i Div 8)+4;
               BitOffset  := i MOD 8;
               ResAddr^.BitVector(ByteOffset) := (#H1 Shift BitOffset) OR
                                               ResAddr^.BitVector(ByteOffset);
             END;
         END;
     MakeSet := ResAddr;
    END;



  (************************* LESET ***********************)

  FUNCTION LESet(Addr1 : SetAddr; Size1 : Integer;
                 Addr2 : SetAddr; Size2 : Integer) : Boolean;
   
   
    VAR
      Length : integer;
      Res    : Boolean;
      Res1,Res2 : Byte;
      Index1, Index2 : Integer;
      Rel1,Rel2 : Boolean;

    BEGIN
      index1 := 0;
      index2 := 0;
      Rel1 := ( size1 = 0);
      Rel2 := ( Size2 = 0);
      IF Rel1 THEN
        BEGIN
         Size1 := Addr1^.Length;
         Index1 := 4;
        END;
      IF Rel2 THEN
        BEGIN
          Size2 := Addr2^.Length;
          Index2 := 4;
        END;

      IF Size1 < size2 THEN Length := Size2 ELSE Length := Size1;

      (* <= is made by Bitvector1 = (Bitvector1 and Bitvector2)  *)
      Res := True;
      FOR Index := 1 TO Length DO
        BEGIN
          IF (index > size1) THEN
            Res1 := 0
          ELSE
            Res1 := Addr1^.BitVector(Index1 + Index - 1);
          IF (index > size2) THEN
            Res2 := 0
          ELSE
            Res2 := Addr2^.BitVector(Index2 + Index - 1);

          Res := Res AND (Res1 = (Res1 AND Res2)); 
        END;


       (*  Release memery if nes *)
      IF Rel2 THEN
        BEGIN
          PutMemory(Addr2,Size2 + #H004);
        END;

      IF Rel1 THEN
        BEGIN
          PutMemory(Addr1,Size1 + #H004);
        END;

      LESet := Res;
    END;


  (**************************** GESET ************************)



  FUNCTION GESet(Addr1 : SetAddr; Size1 : Integer;
                 Addr2 : SetAddr; Size2 : Integer) : Boolean;


    FUNCTION LESet(Addr1 : SetAddr; Size1 : Integer;
                 Addr2 : SetAddr; Size2 : Integer) : Boolean; EXTERNAL;
   

    BEGIN
      GESet := LESet(Addr2,Size2,Addr1,Size1);
    END;




  (***************************** EQSET **************************)

  FUNCTION EqSet(Addr1 : SetAddr; Size1 : Integer;
                 Addr2 : SetAddr; Size2 : Integer) : Boolean;
   
   
    VAR
      Length : integer;
      Res : boolean;
      Res1,Res2 : Byte;
      Index1, Index2 : Integer;
      Rel1,Rel2 : Boolean;

    BEGIN
      index1 := 0;
      index2 := 0;
      Rel1 := ( size1 = 0);
      Rel2 := ( Size2 = 0);
      IF Rel1 THEN
        BEGIN
         Size1 := Addr1^.Length;
         Index1 := 4;
        END;
      IF Rel2 THEN
        BEGIN
          Size2 := Addr2^.Length;
          Index2 := 4;
        END;

      IF Size1 < size2 THEN Length := Size2 ELSE Length := Size1;

      (* = is made by Bitvector1 = Bitvector2  *)
      Res := True;
      FOR Index := 1 TO Length DO
        BEGIN
          IF (index > size1) THEN
            Res1 := 0
          ELSE
            Res1 := Addr1^.BitVector(Index1 + Index - 1);
          IF (index > size2) THEN
            Res2 := 0
          ELSE
            Res2 := Addr2^.BitVector(Index2 + Index - 1);

          Res := Res AND (Res1 = Res2); 
        END;


       (*  Release memery if nes *)
      IF Rel2 THEN
        BEGIN
          PutMemory(Addr2,Size2 + #H004);
        END;

      IF Rel1 THEN
        BEGIN
          PutMemory(Addr1,Size1 + #H004);
        END;

      EQSet := Res;
    END;


  (**************************** NESET ***************************)


  FUNCTION NESet(Addr1 : SetAddr; Size1 : Integer;
                 Addr2 : SetAddr; Size2 : Integer) : Boolean;

    FUNCTION EqSet(Addr1 : SetAddr; Size1 : Integer;
                 Addr2 : SetAddr; Size2 : Integer) : Boolean; EXTERNAL;
   


    BEGIN
      NeSet := Not EQSet(Addr1,Size1,Addr2,Size2);
    END

       
 .