|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 4608 (0x1200)
Types: TextFile
Names: »compare4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »compare4tx «
\f
<* compare_text page ...1...
1981 10 08 *>
external
integer procedure compare_text (tx1, tx2, chars);
long array tx1, tx2 ;
integer chars ;
<**********************************************************************>
<* *>
<* The procedure compares two text strings stored as 8-bit characters *>
<* in two long arrays tx1 and tx2. *>
<* *>
<* Call: *>
<* *>
<* compare_text (tx1, tx2, chars); *>
<* *>
<* compare_text (return, integer). The result of the comparison : *>
<* 0 : tx1 = tx2 *>
<* 1 : tx1 < tx2 *>
<* -1 : tx1 > tx2 *>
<* *>
<* tx1, tx2 (call , long arrays). each of the two arrays is *>
<* supposed to contain a string of 8-bit characters *>
<* starting at the first character of the element *>
<* with index 1. *>
<* *>
<* chars (call and return, integer). The call value denotes *>
<* the maximum number of characters to be compared. *>
<* The call value may be <= 0 meaning number of char- *>
<* acters in the shortest array. *>
<* The return value will be the field address of the *>
<* word at wich the comparison stopped. *>
<* *>
<* Function : *>
<* *>
<* The contents of tx1 and tx2 are compared, word by word (24 bits).*>
<* The comparison involves at most 'chars' characters, but the com- *>
<* parison stops as soon as a difference between the strings is en- *>
<* countered or the last character of a word contains a null char- *>
<* acter or when the upper index of one of the arrays is reached. *>
<* *>
<**********************************************************************>
\f
<* compare_text page ...2...
1981 10 08 *>
begin
integer chars_exceeding, hw, i1, i2, l1, l2, u1, u2, m1, m2 ;
integer field wf ;
l1 := system (3, u1, tx1); <*array bounds*>
l2 := system (3, u2, tx2);
m1 := 6 * (u1-l1+1); <*no of chars in tx1*>
m2 := 6 * (u2-l2+1); <* -do- in tx2*>
if chars <= 0 or chars > m1 or chars > m2 then
chars := (if m1 < m2 then m1 else m2); <*outside bounds => shortest*>
hw := (chars+2)//3 * 2; <*chars characters extending in hw halfwords*>
wf := 0;
for wf := wf+2 while wf < hw
and tx1.wf = tx2.wf
and tx1.wf extract 8 <> 0 do <*nothing*> ;
i1 := tx1.wf; <*word to be examined*>
i2 := tx2.wf;
if wf = hw then
begin <*last word remains to be compared, not neccessarily all chars*>
chars_exceeding := (3 - chars mod 3) mod 3; <*chars to be shifted out*>
i1 := i1 shift (-8*chars_exceeding);
i2 := i2 shift (-8*chars_exceeding);
end;
compare_text :=
if extend 0 add i1 = extend 0 add i2 then 0 else
if extend 0 add i1 > extend 0 add i2 then 1 else -1;
<*long comparison to avoid integer exception by comparison*>
chars := wf; <*field address of last word in comparison*>
end procedure compare_text;
end;
▶EOF◀