Topspeed_JPI/TS-V3/MODBASE/POSUTILS.MOD

IMPLEMENTATION MODULE PosUtils;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/posutils.mov   1.6   10 Mar 1991 15:31:30   coleb  $
 *
 *)



IMPORT LowLevel;
IMPORT M2Strings;
IMPORT Numbers;
IMPORT StrEdit;
IMPORT SYSTEM;

VAR
  Initialized : BOOLEAN;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
      LowLevel.Init();
      M2Strings.Init();
      Numbers.Init();
      StrEdit.Init();
      CaseSensitive := FALSE;
    END Init;


CONST
  space = ' ';
  tab = CHAR(9);

  PROCEDURE BreakPoint(VAR thestr : ARRAY OF CHAR; maxlength : CARDINAL;
      breakchars : ARRAY OF CHAR) : CARDINAL;
    VAR
      cnt : CARDINAL;
    BEGIN
      cnt := maxlength-1;
      WHILE (cnt>0) AND (Pos(thestr[cnt],breakchars)>HIGH(breakchars)) DO
        DEC(cnt);
      END;
      IF (cnt=0) AND (Pos(thestr[0],breakchars)>HIGH(breakchars)) THEN
        RETURN (maxlength);
      ELSE
        RETURN (cnt);
      END;
    END BreakPoint;


  PROCEDURE BreakPtAdr( TheAdr: SYSTEM.ADDRESS; TheSize: CARDINAL;
      maxlength : CARDINAL; breakchars : ARRAY OF CHAR) :
      CARDINAL;
    VAR
      cnt : CARDINAL;
      tmp : LowLevel.Address8086;
    BEGIN
      cnt := maxlength-1;
      tmp.a := TheAdr;
      INC( tmp.off, cnt );
      WHILE (cnt>0) AND (NOT Present(tmp.b^, breakchars)) DO
        DEC( tmp.off );
        DEC(cnt);
      END;
      IF (cnt=0) AND (NOT Present(tmp.b^, breakchars)) THEN
        RETURN maxlength;
      ELSE
        RETURN cnt;
      END;
    END BreakPtAdr;


  PROCEDURE ByteCount( size: CARDINAL; lookfor: CHAR; start:
      SYSTEM.ADDRESS): CARDINAL;
    VAR
      cnt, offset, skipped: CARDINAL;
    BEGIN
      cnt := 0;
      offset := 0;
      WHILE offset < size DO
        skipped := LowLevel.ScanEQ( size - offset, lookfor,
            LowLevel.AddAddr(start, offset) );
        IF skipped < (size - offset) THEN
          INC( cnt );
          INC( offset, skipped + 1 );
        ELSE
          RETURN cnt;
        END;
      END;
      RETURN cnt;
    END ByteCount;


  PROCEDURE Equal( str1, str2: ARRAY OF CHAR ): BOOLEAN;
    BEGIN
      RETURN M2Strings.CompareStr(str1, str2) = 0;
    END Equal;


  PROCEDURE FindNthPattern(pattern: ARRAY OF CHAR; which: CARDINAL;
      searchIn: ARRAY OF CHAR): CARDINAL;
    VAR
      cnt, lastSpot, inLngth: CARDINAL;
      found : BOOLEAN;
    BEGIN
      found := FALSE;
      lastSpot := 0;
      cnt := 0;
      inLngth := M2Strings.Length(searchIn);
      REPEAT
        lastSpot := Positn(pattern, searchIn, lastSpot);
        IF lastSpot >= inLngth THEN
          cnt := which + 1;
        ELSE
          INC(cnt);
        END;
        IF cnt = which THEN
          found := TRUE;
        END;
      UNTIL found OR (cnt > which);
      IF cnt > which THEN
        RETURN(65535);
      ELSE
        RETURN(lastSpot);
      END;
    END FindNthPattern;


  PROCEDURE FirstNonMatching(TheChar : CHAR; VAR TheStr : ARRAY OF CHAR) :
      CHAR;
    (* Returns the first character in TheStr that does not match
       TheChar. If none found, returns TheChar. *)
    VAR
      spot, leng : CARDINAL;
    BEGIN
      leng := M2Strings.Length(TheStr);
      IF leng = 0 THEN
        RETURN TheChar;
      END;
      spot := LowLevel.ScanNE( leng, TheChar, SYSTEM.ADR(TheStr) );
      IF spot < leng THEN
        RETURN TheStr[spot];
      ELSE
        RETURN TheChar;
      END;
    END FirstNonMatching;


  PROCEDURE IsAlphaChar( TheChar: CHAR ): BOOLEAN;
    BEGIN
      RETURN ((TheChar >= 'a') AND (TheChar <= 'z')) OR ((TheChar
          >= 'A') AND (TheChar <= 'Z'));
    END IsAlphaChar;


  PROCEDURE IsBlank(TheStr : ARRAY OF CHAR) : BOOLEAN;
     (*TRUE if thestr is all blanks *)
    VAR
      answer, leng : CARDINAL;
    BEGIN
      leng := M2Strings.Length(TheStr);
      IF leng=0 THEN
        RETURN TRUE;
      END;
      answer := LowLevel.ScanNE(leng,space,SYSTEM.ADR(TheStr));
      RETURN (answer>=leng);
    END IsBlank;


  PROCEDURE IsNextPattern( Pattern: ARRAY OF CHAR; VAR TheStr:
      ARRAY OF CHAR; StartingSpot: CARDINAL ): BOOLEAN;
    VAR
      tmp: CARDINAL;
      lngth: INTEGER;
      tmpadr: LowLevel.Address8086;
    BEGIN
      lngth := INTEGER(M2Strings.Length(TheStr)) - INTEGER(StartingSpot);
        (* Don't bother looking if the StartingSpot is greater than the
           length of the string. *)
      IF lngth < 0 THEN
        RETURN FALSE;
      END;
      tmp := PosAdr( Pattern, LowLevel.AddAddr( SYSTEM.ADR(TheStr),
          StartingSpot), CARDINAL(lngth) );
        (* Figure out where Pattern appears, if at all. *)
      IF tmp = CARDINAL(lngth) THEN
        (* If it doesn't appear at all, return FALSE. *)
        RETURN FALSE;
      END;
      tmpadr.a := SYSTEM.ADR(TheStr);
      INC( tmpadr.off, StartingSpot );
        (* tmp now represents the offset beyond StartingSpot at which
           Pattern appears.  We want to know if that's the same offset
           as the first nonblank character beyond StartingSpot. *)
      RETURN tmp = CARDINAL(LowLevel.ScanNE( lngth, space, tmpadr.a ));
    END IsNextPattern;


  PROCEDURE IsNumber( TheStr: ARRAY OF CHAR; StartingSpot:
      CARDINAL ): BOOLEAN;
    VAR
      AllNumbers, PointFound, AtLeastOneFound : BOOLEAN;
      EndStr, index : CARDINAL;
      bufch : CHAR;
    BEGIN
      M2Strings.Delete( TheStr, 0, StartingSpot );
      StrEdit.CrunchBlanks( TheStr );
      EndStr := M2Strings.Length(TheStr);
      IF (EndStr = 0) OR Present( space, TheStr ) THEN
        RETURN FALSE;
      END;
      DEC( EndStr );
      index := 0;
      AtLeastOneFound := FALSE;
      PointFound := FALSE;
      AllNumbers := TRUE;
      REPEAT
        bufch := TheStr[index];
        IF IsNumericChar( bufch ) THEN
          AtLeastOneFound := TRUE;
        ELSIF (bufch = '-') OR (bufch = '+') THEN
          IF NOT (index = 0) THEN
            AllNumbers := FALSE;
          END;
        ELSIF bufch = '.' THEN
          IF PointFound THEN
            AllNumbers := FALSE;
          ELSE
            PointFound := TRUE;
          END;
        ELSE
          AllNumbers := FALSE;
        END;
        INC( index );
      UNTIL (NOT AllNumbers) OR (index > EndStr);
      RETURN AtLeastOneFound AND AllNumbers;
    END IsNumber;


  PROCEDURE IsNumericChar( TheChar: CHAR ): BOOLEAN;
    BEGIN
      RETURN (TheChar >= '0') AND (TheChar <= '9');
    END IsNumericChar;


  PROCEDURE IsWhiteSpace( TheChar: CHAR ): BOOLEAN;
    BEGIN
      RETURN (TheChar = space) OR (TheChar = tab);
    END IsWhiteSpace;


  PROCEDURE LastNonMatching(TheChar : CHAR; VAR TheStr
      : ARRAY OF CHAR) : CHAR;
    (* Starts at the end of TheStr and searches backward for a
       character that does not match TheChar. If none found,
       returns TheChar. *)
    VAR
      spot: INTEGER;
    BEGIN
      spot := M2Strings.Length(TheStr);
      IF spot = 0 THEN
        RETURN TheChar;
      ELSE
        DEC( spot );
      END;
      WHILE (TheStr[spot] = TheChar) AND (spot > 0) DO
        DEC( spot );
      END;
      IF spot > 0 THEN
        RETURN TheStr[spot];
      ELSE
        RETURN TheChar;
      END;
    END LastNonMatching;


  PROCEDURE MatchingPos( spot: CARDINAL; TheStr: ARRAY
     OF CHAR ): CARDINAL;
       (*Returns the position of the ending character that matches
         the beginning character at position spot within TheStr.  If
         TheStr does not have a valid beginning character at spot,
         or if spot is not inside the present length of TheStr, or
         if no matching ending character is found, MatchingPos
         returns spot.*)
    VAR
      TmpSpot, StackCount, lngth : CARDINAL;
      Opener, Closer, bufch: CHAR;
      Openers, Closers: ARRAY [0..3] OF CHAR;
    BEGIN
      StrEdit.AssignStr( '[{(<', Openers );
      StrEdit.AssignStr( ']})>', Closers );
      lngth := M2Strings.Length( TheStr );
      IF spot >= lngth THEN
        RETURN spot;
      END;
      bufch := TheStr[spot];
      TmpSpot := Pos( bufch, Openers );
      IF TmpSpot <= HIGH( Openers ) THEN
        Opener := bufch;
        Closer := Closers[ TmpSpot ];
        TmpSpot := spot + 1;
        StackCount := 0;
        WHILE TmpSpot < lngth DO
          IF TheStr[ TmpSpot ] = Opener THEN
            INC( StackCount );
          ELSIF TheStr[ TmpSpot ] = Closer THEN
            IF StackCount = 0 THEN
              RETURN TmpSpot;
            ELSE
              DEC( StackCount );
            END;
          END;
          INC( TmpSpot );
        END;
      END;
      RETURN spot;
    END MatchingPos;


  PROCEDURE PatternScan( PatternAdr: SYSTEM.ADDRESS;
      PatternSize: CARDINAL; ScanAreaAdr: SYSTEM.ADDRESS;
      ScanAreaSize: CARDINAL ): CARDINAL;
    VAR
      BytesSkipped, ThisScan, cnt, PossibleStartSpots : CARDINAL;
      MaxScan: INTEGER;
      PatAdr, AreaAdr: LowLevel.Address8086;
    BEGIN
      PatAdr.a := PatternAdr;
      AreaAdr.a := ScanAreaAdr;
      IF (ScanAreaSize >= PatternSize) AND (PatternSize#0) THEN
        PossibleStartSpots := ScanAreaSize - PatternSize + 1;
        IF PossibleStartSpots > 32766 THEN
          MaxScan := 32766;
        ELSE
          MaxScan := PossibleStartSpots;
        END;
        BytesSkipped := LowLevel.ScanEQ( MaxScan, PatAdr.b^, ScanAreaAdr );
        ThisScan := BytesSkipped;
        INC( AreaAdr.off, ThisScan );
        WHILE (BytesSkipped < PossibleStartSpots) DO
          IF ThisScan < CARDINAL(MaxScan) THEN
            cnt := 0;
            LOOP
            (* as long as following elements equal do:*)
              INC( cnt );
              IF cnt >= PatternSize THEN
              (*if at end of pattern, we've found a match*)
                RETURN BytesSkipped;
              END;
              INC( PatAdr.off );
              INC( AreaAdr.off );
              IF AreaAdr.b^ # PatAdr.b^ THEN
              (*if next element # object, stop comparing*)
                EXIT;
              END;
            END;
          END;
          INC( BytesSkipped );
          IF BytesSkipped > PossibleStartSpots THEN
            RETURN ScanAreaSize;
            (* Pattern not found. *)
          ELSIF (PossibleStartSpots - BytesSkipped) > 32766 THEN
            MaxScan := 32766;
          ELSE
            MaxScan := PossibleStartSpots - BytesSkipped;
          END;
          PatAdr.a := PatternAdr;
          AreaAdr.a := ScanAreaAdr;
          INC( AreaAdr.off, BytesSkipped );
          ThisScan := LowLevel.ScanEQ( MaxScan,
              PatAdr.b^, AreaAdr.a );
          INC( BytesSkipped, ThisScan );
          INC( AreaAdr.off, ThisScan );
        END;
      END;
      RETURN ScanAreaSize;
      (* Pattern not found. *)
    END PatternScan;


  PROCEDURE PosAdr(VAR s2 : ARRAY OF CHAR; s : SYSTEM.ADDRESS;
      size: CARDINAL) : CARDINAL;
    BEGIN
      RETURN PatternScan( SYSTEM.ADR(s2), M2Strings.Length(s2), s, size );
    END PosAdr;


  PROCEDURE Pos(s2 : ARRAY OF CHAR; s : ARRAY OF CHAR) : CARDINAL;
  (* Return the index in s of the first occurence of the substring s2,
     or High(s)+1 if there are no occurences of s2.*)
    VAR
      i, j, n, n2, len : CARDINAL;
    BEGIN
      n := M2Strings.Length(s);
      (*length of string to search in*)
      n2 := M2Strings.Length(s2);
      (*length of string to search for*)
      IF (n>=n2) AND (n2#0) THEN
      (*only search if target bigger than object; object non-null*)
        len := n-n2+1;
        (* number of possible starting positions *)
        i := LowLevel.ScanEQ(len,s2[0],SYSTEM.ADR(s[0]));
        (*changed; start at first occurence of s2[0]*)
        WHILE (i<len) DO
        (*only for possible starting positions*)
          j := 1;
          LOOP
          (* as long as following elements equal object do:*)
            IF j>=n2 THEN
            (*if at end of object, finished*)
              RETURN i;
            END;
            IF s[i+j]<>s2[0+j] THEN
            (*if next element <> to object, stop comparing*)
              EXIT;
            END;
            INC(j);
          END;
          i := i+1+CARDINAL(LowLevel.ScanEQ(len-1-i,s2[0],SYSTEM.ADR(s[i+1])));
          (*changed: try next possible starting position *)
        END;
      END;
      RETURN (HIGH(s)+1);
      (* String not found.   *)
    END Pos;


  PROCEDURE PosDelimited(VAR pattern, obj, delimiters : ARRAY OF
      CHAR) : CARDINAL;
    (*These are VAR parameters just for purposes of efficiency.
      Neither is actually changed.*)
    VAR
      spot1, spot2 : CARDINAL;
    BEGIN
      (*PosDelimited*)
      IF PresentPos( pattern, obj, spot1 ) THEN
        spot2 := spot1 + M2Strings.Length(pattern);
          (*spot2 should now point to the character after the
            pattern*)
        IF (spot1=0)
           OR
           Present(obj[spot1-1],delimiters) THEN
             (*Now we know everything to the left of the pattern
               is okay.*)
          IF (spot2>=M2Strings.Length(obj)) OR Present(obj[spot2],
              delimiters) THEN
            (*And now we know everything is okay to the right.*)
            RETURN (spot1);
          END;
        END;
      END;
      RETURN (HIGH(obj)+1);
    END PosDelimited;


  PROCEDURE Pos1by1(s2 : ARRAY OF CHAR; s : ARRAY OF CHAR) : CARDINAL;
  (* Return the index in s of the first occurence of the substring s2,
     or High(s)+1 if there are no occurences of s2.*)
    VAR
      found : BOOLEAN;
      i, j, n, n2, len : CARDINAL;
    BEGIN
      n := M2Strings.Length(s);
      (*length of string to search in*)
      n2 := M2Strings.Length(s2);
      (*length of string to search for*)
      IF (n >= n2) AND (n2 > 0) THEN
      (*only search if the target is bigger then the object*)
        len := n-n2;
        (* highest possible starting index *)
        i := 0;
        WHILE (i<=len) DO
        (*for every possible starting position*)
          IF (s[i]=s2[0]) THEN
          (*if equals first char of object*)
            j := 1;
            LOOP
            (* as long as target elements equal object do:*)
              IF j>n2-1 THEN
              (*if at end of object, finsihed*)
                RETURN i;
              END;
              IF s[i+j]<>s2[0+j] THEN
              (*if next element <> to object, stop comparing*)
                EXIT;
              END;
              INC(j);
            END;
          END;
          INC(i);
          (* try next possible starting position *)
        END;
      END;
      RETURN (HIGH(s)+1);
      (* String not found.*)
    END Pos1by1;


  PROCEDURE Positn(s2 : ARRAY OF CHAR; s : ARRAY OF CHAR; i : CARDINAL) :
      CARDINAL;
  (* Return the index in s of the first occurence of the substring s2,
     at or after index i, or HIGH(s)+1 if there are no occurences of s2.*)
    VAR
      len, PosAdrResult: CARDINAL;
    BEGIN
      len := M2Strings.Length( s );
      IF len > i THEN
        PosAdrResult := PosAdr( s2, SYSTEM.ADR(s[i]), len - i );
        IF PosAdrResult < (len - i) THEN
          RETURN i + PosAdrResult;
        END;
      END;
      RETURN (HIGH(s)+1);
      (* String not found.*)
    END Positn;


  PROCEDURE PosInsensitive(str1, str2 : ARRAY OF CHAR) : CARDINAL;
    BEGIN
      StrEdit.CAPstr(str1);
      StrEdit.CAPstr(str2);
      RETURN Pos(str1,str2);
    END PosInsensitive;


  PROCEDURE Present(str1, str2 : ARRAY OF CHAR) : BOOLEAN;
    BEGIN
      IF NOT CaseSensitive THEN
        StrEdit.CAPstr(str1);
        StrEdit.CAPstr(str2);
      END;
      IF Pos(str1,str2)<=HIGH(str2) THEN
        RETURN (TRUE);
      ELSE
        RETURN (FALSE);
      END;
    END Present;


  PROCEDURE PresentPos(str1, str2 : ARRAY OF CHAR; VAR spot:
      CARDINAL) : BOOLEAN;
    VAR
      size: CARDINAL;
    BEGIN
      IF NOT CaseSensitive THEN
        StrEdit.CAPstr(str1);
        StrEdit.CAPstr(str2);
      END;
      size := M2Strings.Length(str2);
      spot := PosAdr( str1, SYSTEM.ADR(str2), size );
      IF spot < size THEN
        RETURN (TRUE);
      ELSE
        spot := HIGH(str2) + 1;
        RETURN (FALSE);
      END;
    END PresentPos;


  PROCEDURE SubStrMatch( str1: ARRAY OF CHAR; StartingAt1,
      EndingAt1: CARDINAL; VAR str2: ARRAY OF CHAR; StartingAt2,
      EndingAt2: CARDINAL ): BOOLEAN;
    VAR
      size1, size2, tmpc: CARDINAL;
    BEGIN
      size1 := M2Strings.Length(str1);
      size2 := M2Strings.Length(str2);
      IF (size1 <= StartingAt1) OR (size2 <= StartingAt2) OR
          (StartingAt1 > EndingAt1) OR (StartingAt2 > EndingAt2) THEN
        RETURN FALSE;
      END;
      size1 := Numbers.Min( EndingAt1 + 1, size1) - StartingAt1;
      size2 := Numbers.Min( EndingAt2 + 1, size2) - StartingAt2;
      tmpc := PatternScan( SYSTEM.ADR(str1[StartingAt1]), size1,
          SYSTEM.ADR(str2[StartingAt2]), size2 );
      RETURN tmpc = 0;
    END SubStrMatch;


BEGIN
  Initialized := FALSE;
  Init();
END PosUtils.