Topspeed_JPI/TS-V3/MODBASE/SCANUTIL.MOD

IMPLEMENTATION MODULE ScanUtils;
(*
 *  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/scanutil.mov   1.2   17 Mar 1991 17:56:48   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();
    END Init;


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


  PROCEDURE ScanForByte(size : INTEGER; lookfor : SYSTEM.BYTE;
      start : SYSTEM.ADDRESS; caseMatters: CaseSensitivity ) : INTEGER;
    VAR
      cnt: INTEGER;
      tmpAdr: LowLevel.Address8086;
    BEGIN
      tmpAdr.x := start;
      IF size < 0 THEN
        FOR cnt := 0 TO ABS(size + 1) DO
          IF caseMatters = CaseInsens THEN
            IF CAP(CHAR(lookfor)) = CAP(tmpAdr.b^) THEN
              RETURN cnt;
            END;
          ELSE
            IF CHAR(lookfor) = tmpAdr.b^ THEN
              RETURN cnt;
            END;
          END;
          DEC(tmpAdr.off);
        END;
      ELSIF size > 0 THEN
        FOR cnt := 0 TO (size - 1) DO
          IF caseMatters = CaseInsens THEN
            IF CAP(CHAR(lookfor)) = CAP(tmpAdr.b^) THEN
              RETURN cnt;
            END;
          ELSE
            IF CHAR(lookfor) = tmpAdr.b^ THEN
              RETURN cnt;
            END;
          END;
          INC(tmpAdr.off);
        END;
      END;
      RETURN size;
    END ScanForByte;


  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, CaseSens) > HIGH(breakchars)) DO
        DEC(cnt);
      END;
      IF (cnt=0) AND
         (Pos(thestr[0], breakchars, CaseSens) > 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, CaseSens)) DO
        DEC( tmp.off );
        DEC(cnt);
      END;
      IF (cnt=0) AND (NOT Present(tmp.b^, breakchars, CaseSens)) 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;
      caseMatters: CaseSensitivity ): BOOLEAN;
    BEGIN
      IF caseMatters = CaseInsens THEN
        StrEdit.CAPstr(str1);
        StrEdit.CAPstr(str2);
      END;
      RETURN M2Strings.CompareStr(str1, str2) = 0;
    END Equal;


  PROCEDURE FindNthPattern(pattern: ARRAY OF CHAR; which: CARDINAL;
      searchIn: ARRAY OF CHAR; caseMatters: CaseSensitivity ): 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, caseMatters);
        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;
      caseMatters: CaseSensitivity ): BOOLEAN;
    VAR
      tmp, cnt: CARDINAL;
      lngth: INTEGER;
      tmpadr: LowLevel.Address8086;
      result: BOOLEAN;
    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), caseMatters );
        (* 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;
        (* 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. *)
      result := TRUE;
      cnt := StartingSpot;
      WHILE ((cnt < tmp) AND result) DO
        IF (TheStr[cnt] # space) AND (TheStr[cnt] # tab) THEN
          result := FALSE;
        END;
        INC(cnt);
      END;
      RETURN result;
    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, CaseSens ) 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 := LowLevel.ScanEQ(SYSTEM.SIZE(Openers), bufch,
          SYSTEM.ADR(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; caseMatters: CaseSensitivity ): 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 := ScanForByte( MaxScan, PatAdr.b^, ScanAreaAdr,
            caseMatters );
        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 caseMatters = CaseInsens THEN
                IF CAP(AreaAdr.b^) # CAP(PatAdr.b^) THEN
                (*if next element # object, stop comparing*)
                  EXIT;
                END;
              ELSE
                IF AreaAdr.b^ # PatAdr.b^ THEN
                (*if next element # object, stop comparing*)
                  EXIT;
                END;
              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 := ScanForByte( MaxScan,
              PatAdr.b^, AreaAdr.a, caseMatters );
          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; caseMatters: CaseSensitivity ) : CARDINAL;
    BEGIN
      RETURN PatternScan( SYSTEM.ADR(s2), M2Strings.Length(s2), s,
          size, caseMatters );
    END PosAdr;


  PROCEDURE Pos(s2 : ARRAY OF CHAR; s : ARRAY OF CHAR;
      caseMatters: CaseSensitivity ) : 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 := ScanForByte(len, s2[0], SYSTEM.ADR(s[0]), caseMatters);
        (*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 caseMatters = CaseInsens THEN
              IF CAP(s[i+j]) # CAP(s2[0+j]) THEN
              (*if next element # to object, stop comparing*)
                EXIT;
              END;
            ELSE
              IF s[i+j] # s2[0+j] THEN
              (*if next element # to object, stop comparing*)
                EXIT;
              END;
            END;
            INC(j);
          END;
          i := i + 1 + CARDINAL(
              ScanForByte( len-1-i, s2[0], SYSTEM.ADR(s[i+1]), caseMatters));
          (*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; caseMatters: CaseSensitivity ) : 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, caseMatters ) 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, caseMatters) THEN
             (*Now we know everything to the left of the pattern
               is okay.*)
          IF (spot2>=M2Strings.Length(obj)) OR Present(obj[spot2],
              delimiters, caseMatters) THEN
            (*And now we know everything is okay to the right.*)
            RETURN (spot1);
          END;
        END;
      END;
      RETURN (HIGH(obj)+1);
    END PosDelimited;


  PROCEDURE Positn(s2 : ARRAY OF CHAR; s : ARRAY OF CHAR; i : CARDINAL;
      caseMatters: CaseSensitivity ) : 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, caseMatters );
        IF PosAdrResult < (len - i) THEN
          RETURN i + PosAdrResult;
        END;
      END;
      RETURN (HIGH(s)+1);
      (* String not found.*)
    END Positn;


  PROCEDURE Present(str1, str2 : ARRAY OF CHAR;
      caseMatters: CaseSensitivity ) : BOOLEAN;
    BEGIN
      IF Pos( str1, str2, caseMatters ) <= HIGH(str2) THEN
        RETURN (TRUE);
      ELSE
        RETURN (FALSE);
      END;
    END Present;


  PROCEDURE PresentPos(str1, str2 : ARRAY OF CHAR; VAR spot:
      CARDINAL; caseMatters: CaseSensitivity ) : BOOLEAN;
    VAR
      size: CARDINAL;
    BEGIN
      size := M2Strings.Length(str2);
      spot := PosAdr( str1, SYSTEM.ADR(str2), size, caseMatters );
      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; caseMatters: CaseSensitivity ): 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, caseMatters );
      RETURN tmpc = 0;
    END SubStrMatch;


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