|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 30100 (0x7594)
Types: TextFile
Names: »RTPLIBPA.S86«
└─⟦037c0ce35⟧ Bits:30010524 DVBS1.SW2114.src.2.6-2 RTP compiler source SW2104+SW2114 Disk#2 30/1-92 HHA
└─⟦this⟧ »RTP\RTPLIBPA.S86«
└─⟦828f0d3dd⟧ Bits:30010527 DVBS1.SW2114.src.2.6-5 RTP Compiler Source SW2104+SW2114 Disk 2 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\RTPLIBPA.S86«
└─⟦891417be1⟧ Bits:30010519 DVBS1.SW2114.src.2-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\RTPLIBPA.S86«
└─⟦a2bcc95d7⟧ Bits:30010511 DVBS1.SW2114.src.2.14-2 SW2114 REAL #2/4 TIME PASCAL SOURCE REL 2.14 92.09.01
└─⟦this⟧ »RTP\RTPLIBPA.S86«
SetModule;\r
\r
$NoIndex\r
\r
TYPE\r
(* The type sets describes the way a set is represented on runtime *)\r
\r
Sets = RECORD\r
Length : integer; (* Length = (high div 8) - (Low div 8) + 1 *)\r
Low : Integer; (* High = Low + (Length * 8 ) - 1 *)\r
BitVector : Array(0..0) Of Byte;\r
END;\r
\r
SetAddr = ^Sets;\r
\r
AddrType = (OnStack, TempAndOnStack, OnStackAndTemp, Temp);\r
\r
(* AddrType describes the kind of memery used to represent the operands\r
OnStack : Private memery are used for both operands.\r
OnStackAndTemp : Private memery are used for 1. operand and temp.\r
memery for 2. operand.\r
TempAndOnStack : Private memery are used for 2. operand and temp.\r
memery for 1. operand.\r
Temp : Temp. memery are used for both operands. *)\r
\r
\r
\r
\r
SetConst = Array(0..0) Of Integer;\r
\r
\r
FUNCTION Get_Segment(Size : integer; Kind : Mem_Type) : integer; EXTERNAL;\r
\r
PROCEDURE Put_Segment(Addr : integer; Size : integer; Kind : Mem_Type); EXTERNAL;\r
\r
PROCEDURE Fault(i : integer); EXTERNAL;\r
.\r
\r
\r
(******************** ADDSET ******************************)\r
\r
FUNCTION AddSet(Addr1,Addr2 : SetAddr; AddrT : AddrType) : SetAddr;\r
\r
(* Add the sets given by addr1 and addr2. Temp memery are allocated\r
for the result. The memery for the operands are released if temp.\r
memery *)\r
\r
VAR\r
Low1, Low2, Low, High1, High2, High : Integer;\r
Length : integer;\r
ResAddr : SetAddr;\r
Res : Byte;\r
Index1, Index2 : Integer;\r
Snyd : RECORD\r
x : Array(0..0) Of integer;\r
y : SetAddr;\r
END;\r
\r
\r
BEGIN\r
IF (Addr1^.Length = #H000) AND (Addr2^.Length = #H000) THEN\r
(* Both sets are empty *)\r
Length := #H000\r
ELSE\r
BEGIN\r
IF Addr1^.Length <> #H000 THEN\r
BEGIN\r
Low1 := Addr1^.Low;\r
High1 := Low1 + (Addr1^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low1 := MaxInt;\r
High1 := MinInt; \r
END;\r
\r
IF Addr2^.Length <> #H000 THEN\r
BEGIN\r
Low2 := Addr2^.Low;\r
High2 := Low2 + (Addr2^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low2 := MaxInt;\r
High2 := MinInt; \r
END;\r
\r
\r
(* Low := Min(Low1,Low2) *)\r
IF Low2 < Low1 THEN Low := Low2\r
ELSE Low := Low1;\r
\r
(* High := Max(High1,High2) *)\r
IF High2 > High1 THEN High := High2\r
ELSE High := High1;\r
\r
Length := ( (High Div 8) - ( Low Div 8) + 1 );\r
END;\r
\r
\r
(* Allocated memery for the result *)\r
Snyd.x(2) := Get_Segment(Length + #H004,Mem_Private);\r
Snyd.x(1) := #H000;\r
ResAddr := Snyd.y;\r
ResAddr^.Length := Length;\r
ResAddr^.Low := Low;\r
\r
Index1 := 0;\r
Index2 := 0;\r
\r
(* The add is made by BitVector1 or Bitvector2 *)\r
FOR Index := 0 TO (Length) - 1 DO\r
BEGIN\r
IF (Low1 <= Low) AND (Low <= High1) THEN\r
BEGIN\r
Res := Addr1^.BitVector(index1);\r
Index1 := Index1 + 1;\r
END\r
ELSE\r
Res := #H00;\r
\r
IF (Low2 <= Low) AND (Low <= High2) THEN\r
BEGIN\r
Res := Addr2^.BitVector(index2) OR Res;\r
Index2 := Index2 + 1;\r
END;\r
\r
ResAddr^.BitVector(Index) := Res;\r
Low := Low + 8;\r
END;\r
\r
\r
(* Release memery if nes *)\r
IF (AddrT = Temp) OR (AddrT = OnStackAndTemp) THEN\r
BEGIN\r
Snyd.y := Addr2;\r
Put_Segment(Snyd.x(2),Addr2^.Length + #H004,Mem_Private);\r
END;\r
\r
IF (AddrT = Temp) OR (AddrT = TempAndOnStack) THEN\r
BEGIN\r
Snyd.y := Addr1;\r
Put_Segment(Snyd.x(2),Addr1^.Length + #H004,Mem_Private);\r
END;\r
\r
AddSet := ResAddr;\r
END;\r
\r
\r
\r
(*********************** SUBSET *****************************)\r
\r
FUNCTION SubSet(Addr1,Addr2 : SetAddr; AddrT : AddrType) : SetAddr;\r
(* If addr1 is represented in temp. memery this memery is used for the \r
result. Else temp. memery is allocated for the result. The memery\r
for the 2. operand is released if temp. memery *)\r
\r
VAR\r
Low2, Low, High2 : Integer;\r
Length : integer;\r
ResAddr : SetAddr;\r
Res : Byte;\r
Index2 : Integer;\r
Snyd : RECORD\r
x : Array(0..0) Of integer;\r
y : SetAddr;\r
END;\r
\r
\r
BEGIN\r
Length := Addr1^.Length;\r
IF Length = #H000 THEN Low := MaxInt\r
ELSE Low := Addr1^.Low;\r
\r
IF (AddrT = TempAndOnStack) OR (AddrT = Temp) THEN\r
(* memery for 1. operand is used to the result *)\r
(* AddrT := Pred(Pred(AddrT)) *)\r
BEGIN\r
AddrT := Pred(AddrT); \r
END\r
\r
ELSE\r
BEGIN\r
(* Allocate new memery *)\r
Snyd.x(2) := Get_Segment(Length + #H004,Mem_Private);\r
Snyd.x(1) := #H000;\r
ResAddr := Snyd.y;\r
ResAddr^.Length := Length;\r
ResAddr^.Low := Low;\r
FOR i := 0 TO (Length) - 1 DO\r
ResAddr^.BitVector(i) := Addr1^.BitVector(i); \r
Addr1 := ResAddr;\r
END;\r
\r
IF Addr2^.Length = #H000 THEN\r
BEGIN\r
Low2 := MaxInt;\r
High2 := MinInt;\r
END\r
ELSE\r
BEGIN\r
Low2 := Addr2^.Low;\r
High2 := Low2 + (Addr2^.Length * #H0008 - #H001);\r
END;\r
\r
Index2 := 0;\r
\r
(* Sub sets are made by Bitvector1 And (not Bitvector2) *)\r
FOR Index := 0 TO (Length) - 1 DO\r
BEGIN\r
IF (Low2 <= Low) AND (Low <= High2) THEN\r
BEGIN\r
Addr1^.BitVector(index) := Addr1^.BitVector(index) AND\r
( NOT Addr2^.BitVector(Index2));\r
Index2 := Index2 + 1;\r
END;\r
Low := Low + 8;\r
END;\r
\r
\r
(* Release temp. memery *)\r
IF (AddrT = OnStackAndTemp) THEN\r
BEGIN\r
Snyd.y := Addr2;\r
Put_Segment(Snyd.x(2),Addr2^.Length + #H004,Mem_Private);\r
END;\r
\r
SubSet := Addr1;\r
END;\r
\r
\r
(************************* MULTSET **********************)\r
\r
\r
FUNCTION MultSet(Addr1,Addr2 : SetAddr; AddrT : AddrType) : SetAddr;\r
\r
(* If addr1 is represented in temp. memery this memery is used for the \r
result. Else temp. memery is allocated for the result. The memery\r
for the 2. operand is released if temp. memery *)\r
\r
VAR\r
Low2, Low, High2 : Integer;\r
Length : integer;\r
ResAddr : SetAddr;\r
Res : Byte;\r
Index2 : Integer;\r
Snyd : RECORD\r
x : Array(0..0) Of integer;\r
y : SetAddr;\r
END;\r
\r
\r
BEGIN\r
Length := Addr1^.Length;\r
IF Length = #H000 THEN Low := MaxInt\r
ELSE Low := Addr1^.Low;\r
\r
IF (AddrT = TempAndOnStack) OR (AddrT = Temp) THEN\r
(* AddrT := Pred(Pred(AddrT)) *) BEGIN\r
AddrT := Pred(AddrT);\r
END\r
ELSE\r
BEGIN\r
(* Allocate new memery *)\r
Snyd.x(2) := Get_Segment(Length + #H004,Mem_Private);\r
Snyd.x(1) := #H000;\r
ResAddr := Snyd.y;\r
ResAddr^.Length := Length;\r
ResAddr^.Low := Low;\r
FOR i := 0 TO (Length) - 1 DO\r
ResAddr^.BitVector(i) := Addr1^.BitVector(i); \r
Addr1 := ResAddr;\r
END;\r
\r
IF Addr2^.Length = #H000 THEN\r
BEGIN\r
Low2 := MaxInt;\r
High2 := MinInt;\r
END\r
ELSE\r
BEGIN\r
Low2 := Addr2^.Low;\r
High2 := Low2 + (Addr2^.Length * #H0008 - #H001);\r
END;\r
\r
Index2 := 0;\r
\r
(* Mult sets is made by BitVector1 AND BitVector2 *)\r
FOR Index := 0 TO (Length) - 1 DO\r
BEGIN\r
IF (Low2 <= Low) AND (Low <= High2) THEN\r
BEGIN\r
Addr1^.BitVector(index) := Addr1^.BitVector(index) AND\r
( Addr2^.BitVector(Index2));\r
Index2 := Index2 + 1;\r
END\r
ELSE\r
Addr1^.BitVector(Index) := #H00;\r
\r
Low := Low + 8;\r
END;\r
\r
\r
IF (AddrT = OnStackAndTemp) THEN\r
BEGIN\r
Snyd.y := Addr2;\r
Put_Segment(Snyd.x(2),Addr2^.Length + #H004,Mem_Private);\r
END;\r
\r
MultSet := Addr1;\r
END;\r
\r
\r
(***************************** INSET **************************)\r
\r
FUNCTION InSet(elem : integer;Addr : SetAddr; AddrT : AddrType) : Boolean;\r
(* The function returns true if elem is in the set Addr .\r
The memery addr is released if temp. memery *)\r
\r
VAR\r
Res : Boolean;\r
Low, High : integer;\r
ByteOffset, BitOffset : integer;\r
Snyd : RECORD\r
x : Array(0..0) Of integer;\r
y : SetAddr;\r
END;\r
\r
\r
BEGIN\r
\r
IF Addr^.Length = #H000 THEN Res := false\r
ELSE\r
BEGIN\r
Low := Addr^.Low;\r
High := Low + (Addr^.Length * #H008 - #H001);\r
\r
IF (elem < low) OR ( High < elem) THEN \r
Res := false\r
ELSE\r
BEGIN\r
ByteOffset := (elem - low) Div 8;\r
BitOffset := (elem - low) Mod 8;\r
WITH Res As x : Byte DO \r
x := (Addr^.BitVector(ByteOffset) Shift (-BitOffset)) AND #H1;\r
END;\r
END;\r
\r
IF (AddrT <> OnStack) THEN\r
BEGIN\r
Snyd.y := Addr;\r
Put_Segment(Snyd.x(2),Addr^.Length + #H004,Mem_Private);\r
END;\r
\r
\r
InSet := Res;\r
END;\r
\r
\r
(*********************** ASSIGNSET ************************)\r
\r
PROCEDURE AssignSet(Addr1,Addr2 : SetAddr; AddrT : AddrType;\r
Low,High : integer);\r
(* The set given by Addr2 is assign to Addr1. Addr2 may not have values \r
outside the range low..high.\r
IF addr2 is Temp. memery then the memery is released *)\r
\r
VAR\r
Low2,High2 : integer;\r
LowIndex, HighIndex : integer;\r
Length2 : integer;\r
Snyd : RECORD\r
x : Array(0..0) Of integer;\r
y : SetAddr;\r
END;\r
\r
\r
\r
\r
BEGIN\r
IF Addr2^.Length = #H000 THEN Addr1^.Length := #H000\r
ELSE\r
BEGIN\r
Low2 := Addr2^.Low;\r
Length2 := Addr2^.Length;\r
High2 := Low2 + (Length2 * #H0008 - #H0001);\r
LowIndex := 0;\r
HighIndex := LowIndex + (Length2) - 1;\r
\r
(* Remove Low bytes eq 0 *)\r
While (LowIndex <= HighIndex) AND\r
(Addr2^.BitVector(LowIndex) = #H00) DO\r
BEGIN\r
Low2 := Low2 + 8;\r
LowIndex := LowIndex + 1;\r
Length2 := Length2 - #H0001;\r
END;\r
\r
(* Remove High bytes eq 0 *)\r
While (LowIndex <= HighIndex) AND\r
(Addr2^.BitVector(HighIndex) = #H00) DO\r
BEGIN\r
High2 := High2 - 8;\r
HighIndex := HighIndex - 1;\r
Length2 := Length2 - #H001;\r
END;\r
\r
\r
IF Length2 = #H000 THEN Addr1^.Length :=#H000\r
ELSE\r
BEGIN\r
IF Low > Low2 THEN\r
IF ( ( Low - Low2 >= 8) OR\r
( ( Addr2^.BitVector(LowIndex) Shift\r
(8 - (Low - Low2)) AND #HFF) <> #H0) ) THEN\r
(* Set Error *)\r
Fault(63);\r
\r
IF High2 > High THEN\r
IF ( ( High2 - High >= 8) OR\r
( Addr2^.BitVector(HighIndex) Shift\r
((High2 - High) - 8 ) <> #H0) ) THEN\r
(* Set Error *)\r
Fault(63);\r
\r
(* Make the assignment *)\r
Addr1^.Length := Length2;\r
Addr1^.Low := Low2;\r
FOR i := 0 TO (Length2) - 1 DO\r
Addr1^.BitVector(i) := Addr2^.BitVector(LowIndex + i);\r
END;\r
END;\r
\r
(* Release memery *)\r
IF (AddrT <> OnStack) THEN\r
BEGIN\r
Snyd.y := Addr2;\r
Put_Segment(Snyd.x(2),Addr2^.Length + #H004,Mem_Private);\r
END;\r
END;\r
\r
\r
\r
(*************************** PUSHSET **********************)\r
\r
FUNCTION PushSet(Addr : SetAddr) : SetAddr;\r
(* The Set given by addr is moved into temp memery *)\r
\r
VAR\r
ResAddr : SetAddr;\r
Snyd : RECORD\r
x : Array(0..0) Of integer;\r
y : SetAddr;\r
END;\r
\r
BEGIN\r
\r
Snyd.x(2) := Get_Segment(Addr^.Length + #H004,Mem_Private);\r
Snyd.x(1) := #H000;\r
ResAddr := Snyd.y;\r
ResAddr^.Length := Addr^.Length;\r
ResAddr^.Low := Addr^.Low;\r
FOR i := 0 TO (ResAddr^.Length) - 1 DO\r
ResAddr^.BitVector(i) := Addr^.BitVector(i);\r
PushSet := ResAddr;\r
END;\r
\r
\r
\r
\r
(***************************** MAKESET *************************)\r
\r
\r
\r
FUNCTION MakeSet(SetKon : SetConst) : SetAddr;\r
\r
(* SetKon Gives a number of range values. The procedure makes a set\r
containing these values \r
SetKon is in the following format :\r
SetKon(0) : Number of ranges.\r
SetKon(i * 2 ) : lower for the i'te range.\r
SetKon(i * 2 - 1) : higher for the i'te range.*)\r
VAR\r
Min, Max : Integer;\r
Low, High : Integer;\r
LowKon, HighKon : Integer;\r
ByteOffset, BitOffset : integer;\r
Length : integer;\r
ResAddr : SetAddr;\r
Snyd : RECORD\r
x : Array(0..0) Of integer;\r
y : SetAddr;\r
END;\r
\r
BEGIN\r
IF SetKon(0) = 0 THEN\r
BEGIN (* Make empty set *)\r
Snyd.x(2) := Get_Segment( #H004,Mem_Private);\r
Snyd.x(1) := #H000;\r
ResAddr := Snyd.y;\r
ResAddr^.Length := #H000;\r
END\r
ELSE\r
BEGIN\r
(* Compute min and max for the new set *)\r
Min := SetKon(2);\r
Max := SetKon(1);\r
FOR i := 2 TO SetKon(0) DO\r
BEGIN\r
IF Min > SetKon(i * 2) THEN Min := SetKon(i * 2);\r
IF Max <= SetKon(i * 2 - 1) THEN Max := SetKon(i * 2 - 1);\r
END;\r
\r
Low := ((Min) DIV #H008 * #H008);\r
High := (((Max) DIV #H008) * #H008) + 7;\r
Length := ( (High DIV 8) - (Low DIV 8) + 1);\r
\r
(* Allocate memery *)\r
Snyd.x(2) := Get_Segment(Length + #H004,Mem_Private);\r
Snyd.x(1) := #H000;\r
ResAddr := Snyd.y;\r
ResAddr^.Length := Length;\r
ResAddr^.Low := Low;\r
FOR i := 0 TO (Length) - 1 DO\r
ResAddr^.BitVector(i) := #H00;\r
\r
\r
\r
FOR i := 1 TO SetKon(0) DO\r
BEGIN\r
HighKon := SetKon(i*2-1);\r
LowKon := SetKon(i * 2);\r
FOR i := LowKon TO HighKon DO\r
BEGIN\r
ByteOffset := (i - Low) Div 8;\r
BitOffset := (i - Low) MOD 8;\r
ResAddr^.BitVector(ByteOffset) := (#H1 Shift BitOffset) OR\r
ResAddr^.BitVector(ByteOffset);\r
END;\r
END;\r
END;\r
MakeSet := ResAddr;\r
END;\r
\r
\r
\r
(************************* LESET ***********************)\r
\r
FUNCTION LESet(Addr1,Addr2 : SetAddr; AddrT : AddrType) : Boolean;\r
\r
VAR\r
Low1, Low2, Low, High1, High2, High : Integer;\r
Length : Integer;\r
ResAddr : SetAddr;\r
Result : Boolean;\r
Res1,res2 : Byte;\r
Index1, Index2 : Integer;\r
Snyd : RECORD\r
x : Array(0..0) Of Integer;\r
y : SetAddr;\r
END;\r
\r
\r
BEGIN\r
Result := true;\r
IF (Addr1^.Length <> #H000) OR (Addr2^.Length <> #H000) THEN\r
BEGIN\r
(* Not empty sets *)\r
IF Addr1^.Length <> #H000 THEN\r
BEGIN\r
Low1 := Addr1^.Low;\r
High1 := Low1 + (Addr1^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low1 := MaxInt;\r
High1 := MinInt; \r
END;\r
\r
IF Addr2^.Length <> #H000 THEN\r
BEGIN\r
Low2 := Addr2^.Low;\r
High2 := Low2 + (Addr2^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low2 := MaxInt;\r
High2 := MinInt; \r
END;\r
\r
\r
IF Low2 < Low1 THEN Low := Low2\r
ELSE Low := Low1;\r
\r
IF High2 > High1 THEN High := High2\r
ELSE High := High1;\r
\r
Length := ( (High Div 8) - ( Low Div 8) + 1 );\r
\r
\r
Index1 := 0;\r
Index2 := 0;\r
\r
(* <= is made by Bitvector1 = (Bitvector1 and Bitvector2) *)\r
FOR Index := 0 TO (Length) - 1 DO\r
BEGIN\r
IF (Low1 <= Low) AND (Low <= High1) THEN\r
BEGIN\r
Res1 := Addr1^.BitVector(index1);\r
Index1 := Index1 + 1;\r
END\r
ELSE\r
Res1 := #H00;\r
\r
IF (Low2 <= Low) AND (Low <= High2) THEN\r
BEGIN\r
Res2 := Addr2^.BitVector(index2);\r
Index2 := Index2 + 1;\r
END\r
ELSE\r
Res2 := #H00;\r
\r
Result := Result AND ( Res1 = (Res1 AND Res2));\r
Low := Low + 8;\r
END;\r
END;\r
\r
\r
(* Release Memery *)\r
IF (AddrT = Temp) OR (AddrT = OnStackAndTemp) THEN\r
BEGIN\r
Snyd.y := Addr2;\r
Put_Segment(Snyd.x(2),Addr2^.Length + #H004,Mem_Private);\r
END;\r
\r
IF (AddrT = Temp) OR (AddrT = TempAndOnStack) THEN\r
BEGIN\r
Snyd.y := Addr1;\r
Put_Segment(Snyd.x(2),Addr1^.Length + #H004,Mem_Private);\r
END;\r
\r
LESet := Result;\r
END;\r
\r
\r
(**************************** GESET ************************)\r
\r
\r
FUNCTION GESet(Addr1,Addr2 : SetAddr; AddrT : AddrType) : Boolean;\r
\r
VAR\r
Low1, Low2, Low, High1, High2, High : Integer;\r
Length : Integer;\r
ResAddr : SetAddr;\r
Result : Boolean;\r
Res1,res2 : Byte;\r
Index1, Index2 : Integer;\r
Snyd : RECORD\r
x : Array(0..0) Of Integer;\r
y : SetAddr;\r
END;\r
\r
\r
BEGIN\r
Result := true;\r
IF (Addr1^.Length <> #H000) OR (Addr2^.Length <> #H000) THEN\r
BEGIN\r
(* Not empty sets *)\r
IF Addr1^.Length <> #H000 THEN\r
BEGIN\r
Low1 := Addr1^.Low;\r
High1 := Low1 + (Addr1^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low1 := MaxInt;\r
High1 := MinInt; \r
END;\r
\r
IF Addr2^.Length <> #H000 THEN\r
BEGIN\r
Low2 := Addr2^.Low;\r
High2 := Low2 + (Addr2^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low2 := MaxInt;\r
High2 := MinInt; \r
END;\r
\r
\r
IF Low2 < Low1 THEN Low := Low2\r
ELSE Low := Low1;\r
\r
IF High2 > High1 THEN High := High2\r
ELSE High := High1;\r
\r
Length := ( (High Div 8) - ( Low Div 8) + 1 );\r
\r
\r
Index1 := 0;\r
Index2 := 0;\r
\r
(* >= is made by Bitvector2 = (Bitvector2 and Bitvector1) *)\r
FOR Index := 0 TO (Length) - 1 DO\r
BEGIN\r
IF (Low1 <= Low) AND (Low <= High1) THEN\r
BEGIN\r
Res1 := Addr1^.BitVector(index1);\r
Index1 := Index1 + 1;\r
END\r
ELSE\r
Res1 := #H00;\r
\r
IF (Low2 <= Low) AND (Low <= High2) THEN\r
BEGIN\r
Res2 := Addr2^.BitVector(index2);\r
Index2 := Index2 + 1;\r
END\r
ELSE\r
Res2 := #H00;\r
\r
Result := Result AND ( Res2 = (Res1 AND Res2));\r
Low := Low + 8;\r
END;\r
END;\r
\r
\r
(* Release Memery *)\r
IF (AddrT = Temp) OR (AddrT = OnStackAndTemp) THEN\r
BEGIN\r
Snyd.y := Addr2;\r
Put_Segment(Snyd.x(2),Addr2^.Length + #H004,Mem_Private);\r
END;\r
\r
IF (AddrT = Temp) OR (AddrT = TempAndOnStack) THEN\r
BEGIN\r
Snyd.y := Addr1;\r
Put_Segment(Snyd.x(2),Addr1^.Length + #H004,Mem_Private);\r
END;\r
\r
GESet := Result;\r
\r
END;\r
\r
\r
\r
\r
(***************************** EQSET **************************)\r
FUNCTION EQSet(Addr1,Addr2 : SetAddr; AddrT : AddrType) : Boolean;\r
\r
VAR\r
Low1, Low2, Low, High1, High2, High : Integer;\r
Length : Integer;\r
ResAddr : SetAddr;\r
Result : Boolean;\r
Res1,res2 : Byte;\r
Index1, Index2 : Integer;\r
Snyd : RECORD\r
x : Array(0..0) Of Integer;\r
y : SetAddr;\r
END;\r
\r
\r
BEGIN\r
Result := True;\r
IF (Addr1^.Length = #H000) AND (Addr2^.Length = #H000) THEN \r
ELSE\r
BEGIN\r
IF Addr1^.Length <> #H000 THEN\r
BEGIN\r
Low1 := Addr1^.Low;\r
High1 := Low1 + (Addr1^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low1 := MaxInt;\r
High1 := MinInt; \r
END;\r
\r
IF Addr2^.Length <> #H000 THEN\r
BEGIN\r
Low2 := Addr2^.Low;\r
High2 := Low2 + (Addr2^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low2 := MaxInt;\r
High2 := MinInt; \r
END;\r
\r
\r
IF Low2 < Low1 THEN Low := Low2\r
ELSE Low := Low1;\r
\r
IF High2 > High1 THEN High := High2\r
ELSE High := High1;\r
\r
Length := ( (High Div 8) - ( Low Div 8) + 1 );\r
\r
\r
Index1 := 0;\r
Index2 := 0;\r
\r
FOR Index := 0 TO (Length) - 1 DO\r
BEGIN\r
IF (Low1 <= Low) AND (Low <= High1) THEN\r
BEGIN\r
Res1 := Addr1^.BitVector(index1);\r
Index1 := Index1 + 1;\r
END\r
ELSE\r
Res1 := #H00;\r
\r
IF (Low2 <= Low) AND (Low <= High2) THEN\r
BEGIN\r
Res2 := Addr2^.BitVector(index2);\r
Index2 := Index2 + 1;\r
END\r
ELSE\r
Res2 := #H00;\r
\r
Result := Result AND ( Res2 = Res1);\r
Low := Low + 8;\r
END;\r
END;\r
\r
\r
IF (AddrT = Temp) OR (AddrT = OnStackAndTemp) THEN\r
BEGIN\r
Snyd.y := Addr2;\r
Put_Segment(Snyd.x(2),Addr2^.Length + #H004,Mem_Private);\r
END;\r
\r
IF (AddrT = Temp) OR (AddrT = TempAndOnStack) THEN\r
BEGIN\r
Snyd.y := Addr1;\r
Put_Segment(Snyd.x(2),Addr1^.Length + #H004,Mem_Private);\r
END;\r
\r
EQSet := Result;\r
END;\r
\r
\r
\r
(**************************** NESET ***************************)\r
\r
\r
FUNCTION NESet(Addr1,Addr2 : SetAddr; AddrT : AddrType) : Boolean;\r
\r
\r
VAR\r
Low1, Low2, Low, High1, High2, High : Integer;\r
Length : Integer;\r
ResAddr : SetAddr;\r
Result : Boolean;\r
Res1,res2 : Byte;\r
Index1, Index2 : Integer;\r
Snyd : RECORD\r
x : Array(0..0) Of Integer;\r
y : SetAddr;\r
END;\r
\r
\r
BEGIN\r
Result := True;\r
IF (Addr1^.Length = #H000) AND (Addr2^.Length = #H000) THEN \r
ELSE\r
BEGIN\r
IF Addr1^.Length <> #H000 THEN\r
BEGIN\r
Low1 := Addr1^.Low;\r
High1 := Low1 + (Addr1^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low1 := MaxInt;\r
High1 := MinInt; \r
END;\r
\r
IF Addr2^.Length <> #H000 THEN\r
BEGIN\r
Low2 := Addr2^.Low;\r
High2 := Low2 + (Addr2^.Length * #H0008 - #H0001);\r
END\r
ELSE\r
BEGIN\r
Low2 := MaxInt;\r
High2 := MinInt; \r
END;\r
\r
\r
IF Low2 < Low1 THEN Low := Low2\r
ELSE Low := Low1;\r
\r
IF High2 > High1 THEN High := High2\r
ELSE High := High1;\r
\r
Length := ( (High Div 8) - ( Low Div 8) + 1 );\r
\r
\r
Index1 := 0;\r
Index2 := 0;\r
\r
FOR Index := 0 TO (Length) - 1 DO\r
BEGIN\r
IF (Low1 <= Low) AND (Low <= High1) THEN\r
BEGIN\r
Res1 := Addr1^.BitVector(index1);\r
Index1 := Index1 + 1;\r
END\r
ELSE\r
Res1 := #H00;\r
\r
IF (Low2 <= Low) AND (Low <= High2) THEN\r
BEGIN\r
Res2 := Addr2^.BitVector(index2);\r
Index2 := Index2 + 1;\r
END\r
ELSE\r
Res2 := #H00;\r
\r
Result := Result AND ( Res2 = Res1);\r
Low := Low + 8;\r
END;\r
END;\r
\r
\r
IF (AddrT = Temp) OR (AddrT = OnStackAndTemp) THEN\r
BEGIN\r
Snyd.y := Addr2;\r
Put_Segment(Snyd.x(2),Addr2^.Length + #H004,Mem_Private);\r
END;\r
\r
IF (AddrT = Temp) OR (AddrT = TempAndOnStack) THEN\r
BEGIN\r
Snyd.y := Addr1;\r
Put_Segment(Snyd.x(2),Addr1^.Length + #H004,Mem_Private);\r
END;\r
\r
NESet := not Result;\r
END;\r
\r
(* only to partner *) \r
PROCEDURE chaindequeue( VAR ch: chain; VAR ref: reference );\r
PROCEDURE chainextract( VAR ch: chain; VAR ref: reference ); EXTERNAL;\r
BEGIN\r
chainextract( ch, ref );\r
END;\r
\r
PROCEDURE chainenqueue( VAR ch: chain; VAR ref: reference );\r
PROCEDURE chaininsert( VAR ch: chain; VAR ref: reference ); EXTERNAL;\r
BEGIN\r
IF chainlength( ch ) > 0 THEN chaindown( ch );\r
chaininsert( ch, ref );\r
chainup( ch );\r
END;\r
\r
PROCEDURE start( VAR proc: process; prio: integer );\r
BEGIN\r
exception( 5 );\r
END;\r
\r
PROCEDURE resume( VAR proc: process );\r
BEGIN\r
exception( 5 );\r
END;\r
\r
(* *)\r
PROCEDURE tofrom( VAR to_ref: reference; to_offset: integer; \r
VAR from_ref: reference; from_offset: integer;\r
bytes: integer );\r
TYPE tdata = array( 1..bytes ) OF byte;\r
BEGIN\r
LOCKBUF to_ref TO t: RECORD\r
skip: array(1..to_offset) OF byte;\r
data: tdata;\r
END DO\r
LOCKBUF from_ref TO f: RECORD\r
skip: array(1..from_offset) OF byte;\r
data: tdata;\r
END DO t.data:= f.data;\r
END;\r
\r
FUNCTION wildcompare( VAR name: string; VAR key: string ): boolean; \r
VAR j, star_i, skip_j, length_name, length_key: integer;\r
ch_name, ch_key: char;\r
equal: boolean; \r
BEGIN\r
j:= 1;\r
star_i:= 1;\r
length_name:= name!length;\r
length_key:= key!length;\r
WHILE length_name > 0 DO\r
BEGIN\r
ch_name:= name( length_name );\r
IF (ch_name = ' ') OR (ch_name = chr(0))\r
THEN length_name:= length_name - 1\r
ELSE EXITLOOP;\r
END;\r
WHILE length_key > 0 DO\r
BEGIN\r
ch_key:= key( length_key );\r
IF (ch_key = ' ') OR (ch_key = chr(0))\r
THEN length_key:= length_key - 1\r
ELSE EXITLOOP;\r
END;\r
REPEAT\r
equal:= true;\r
FOR i:= star_i TO length_key DO\r
BEGIN\r
IF j <= length_name THEN \r
BEGIN\r
ch_name:= name(j);\r
IF (ch_name >= 'a') AND ( ch_name <= 'z') \r
THEN ch_name:= chr( ord(ch_name) - 32)\r
ELSE IF ord(ch_name) = 0 THEN ch_name:=' ';\r
END ELSE ch_name:=' ';\r
ch_key:= key(j);\r
IF (ch_key >= 'a') AND ( ch_key <= 'z') \r
THEN ch_key:= chr( ord(ch_key) - 32)\r
ELSE IF ord(ch_key) = 0 THEN ch_key:=' ';\r
IF ord(ch_key) = 0 THEN ch_key:=' ';\r
IF ch_key = '*' THEN\r
BEGIN star_i:= i + 1; skip_j:= j + 1; END ELSE\r
IF (ch_key = ch_name) OR (ch_key = '?') THEN j:= j + 1 ELSE\r
BEGIN equal:= false; EXITLOOP; END;\r
END;\r
equal:= equal AND (length_name = ( j - 1 ));\r
j:= skip_j;\r
skip_j:= skip_j + 1;\r
UNTIL equal OR (j > length_name + 1);\r
wildcompare:= equal;\r
END;\r
\r
FUNCTION deletemailbox(INSPECT mbx_name: string): integer;\r
BEGIN\r
deletemailbox:= 0;\r
END; \r
\r
FUNCTION namemailbox(VAR m: mailbox; INSPECT mbx_name: string): integer;\r
TYPE plmname = array(0..12) of char;\r
\r
PROCEDURE name_object( VAR mbx: mailbox; VAR name: plmname );\r
EXTERNAL;\r
\r
VAR name: plmname:= (:chr(12),12***' ':);\r
length: integer;\r
BEGIN\r
if mbx_name!length > 12 then length:= 12 else length:= mbx_name!length;\r
FOR i:= 1 TO length do\r
name(i):= mbx_name(i);\r
name_object( m, name );\r
namemailbox:= 0;\r
END;\r
$code \r
FUNCTION searchmailbox(INSPECT mbx_name: string): ^mailbox;\r
TYPE plmname = array(0..12) of char;\r
\r
FUNCTION search_object( VAR name: plmname ): ^mailbox;\r
EXTERNAL;\r
\r
VAR name: plmname:= (: chr(12), 12***' ':);\r
length: integer;\r
mbx: ^mailbox;\r
BEGIN\r
if mbx_name!length > 12 then length:= 12 else length:= mbx_name!length;\r
trace(mbx_name!length);\r
FOR i:= 1 TO length do\r
begin\r
name(i):= mbx_name(i);\r
trace(ord(name(i)));\r
end;\r
mbx:= search_object( name );\r
trace(ord(nil(mbx)));\r
IF nil(mbx) THEN BEGIN\r
name(0):= chr(length);\r
searchmailbox:= search_object( name );\r
END ELSE searchmailbox:= mbx;\r
END. \r
$nocode\r
\r