Browse Source

+ More TP syntax compatible

carl 25 years ago
parent
commit
b6d9988f22
1 changed files with 48 additions and 12 deletions
  1. 48 12
      utils/ptopu.pp

+ 48 - 12
utils/ptopu.pp

@@ -266,18 +266,49 @@ CONST
     General functions, not part of the object.
     General functions, not part of the object.
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
+  function upperStr(const s : string) : string;
+  var
+    i  : longint;
+  begin
+     for i:=1 to length(s) do
+      if s[i] in ['a'..'z'] then
+       upperStr[i]:=char(byte(s[i])-32)
+      else
+       upperStr[i]:=s[i];
+     upperStr[0]:=s[0];
+  end;
+
+  function LowerStr(const s : string) : string;
+  var
+    i  : longint;
+  begin
+     for i:=1 to length(s) do
+      if s[i] in ['A'..'Z'] then
+       LowerStr[i]:=char(byte(s[i])+32)
+      else
+       LowerStr[i]:=s[i];
+     LowerStr[0]:=s[0];
+  end;
+
+
+
 Function IntToStr(I : LongInt) : String;
 Function IntToStr(I : LongInt) : String;
 
 
+var
+ s : string;
 begin
 begin
-  str(I,IntToStr);
+  str(I,s);
+  IntToStr := s;
 end;
 end;
 
 
 Function StrToInt(Const S : String) : Integer;
 Function StrToInt(Const S : String) : Integer;
 
 
 Var Code : integer;
 Var Code : integer;
+    Res : Integer;
 
 
 begin
 begin
-  Val(S,StrToInt,Code);
+  Val(S, Res, Code);
+  StrToInt := Res;
   If Code<>0 then StrToInt:=0;
   If Code<>0 then StrToInt:=0;
 end;
 end;
 
 
@@ -310,7 +341,9 @@ Function hash(Symbol: String): Byte;
     overflow checking must be turned off for this function even if they
     overflow checking must be turned off for this function even if they
     are enabled for the rest of the program.  }
     are enabled for the rest of the program.  }
   BEGIN
   BEGIN
+{$R-}
     hash := (ORD(Symbol[1]) * 5 + ORD(Symbol[length(Symbol)])) * 5 + length(Symbol)
     hash := (ORD(Symbol[1]) * 5 + ORD(Symbol[length(Symbol)])) * 5 + length(Symbol)
+{$R+}
   END; { of hash }
   END; { of hash }
 
 
 Procedure CreateHash;
 Procedure CreateHash;
@@ -346,7 +379,7 @@ Procedure ClassID(Value: Token;
       IsKeyWord := FALSE
       IsKeyWord := FALSE
     END
     END
     ELSE BEGIN
     ELSE BEGIN
-      KeyValue:=upCase(Value);
+      KeyValue:= UpperStr(Value);
       tabent := hash(Keyvalue);
       tabent := hash(Keyvalue);
       IF Keyvalue = hashtable[tabent].Keyword THEN BEGIN
       IF Keyvalue = hashtable[tabent].Keyword THEN BEGIN
         idtype := hashtable[tabent].symtype;
         idtype := hashtable[tabent].symtype;
@@ -501,7 +534,7 @@ end;
 
 
 Function ReadString (S: PStream): String;
 Function ReadString (S: PStream): String;
 
 
-Var Buffer : ShortString;
+Var Buffer : String;
     I : Byte;
     I : Byte;
 
 
 begin
 begin
@@ -514,11 +547,11 @@ begin
   If S^.Status=stReadError then Dec(I);
   If S^.Status=stReadError then Dec(I);
   If Buffer[i]=#10 Then Dec(I);
   If Buffer[i]=#10 Then Dec(I);
   If Buffer[I]=#13 then Dec(I);
   If Buffer[I]=#13 then Dec(I);
-  SetLength(Buffer,I);
+  Buffer[0] := chr(I);
   ReadString:=Buffer;
   ReadString:=Buffer;
 end;
 end;
 
 
-Procedure WriteString (S : PStream; Const ST : String);
+Procedure WriteString (S : PStream; ST : String);
 
 
 begin
 begin
   S^.Write(St[1],length(St));
   S^.Write(St[1],length(St));
@@ -598,7 +631,7 @@ Procedure TPrettyPrinter.StoreNextChar(VAR lngth: INTEGER;
     IF lngth < maxsymbolsize THEN BEGIN
     IF lngth < maxsymbolsize THEN BEGIN
       Inc(lngth);
       Inc(lngth);
       Value[lngth] := currchar.Value;
       Value[lngth] := currchar.Value;
-      Setlength(Value,lngth);
+      Value[0] := chr(Lngth);
     END;
     END;
   END; { of StoreNextChar }
   END; { of StoreNextChar }
 
 
@@ -874,13 +907,13 @@ Procedure TPrettyPrinter.PrintSymbol;
     IF (currsym^.IsKeyWord) then
     IF (currsym^.IsKeyWord) then
       begin
       begin
       If upper in sets^.selected Then
       If upper in sets^.selected Then
-        WriteString (OutS,Upcase(currsym^.value))
+        WriteString (OutS,UpperStr(currsym^.value))
       else if lower in sets^.selected then
       else if lower in sets^.selected then
-        WriteString (OutS,Lowercase(currsym^.value))
+        WriteString (OutS,LowerStr(currsym^.value))
       else if capital in sets^.selected then
       else if capital in sets^.selected then
         begin
         begin
         WriteString(OutS,UpCase(CurrSym^.Value[1]));
         WriteString(OutS,UpCase(CurrSym^.Value[1]));
-        WriteString(OutS,LowerCase(Copy(CurrSym^.Value,2,255)));
+        WriteString(OutS,LowerStr(Copy(CurrSym^.Value,2,255)));
         end
         end
       else
       else
         WriteString(OutS,Currsym^.Value);
         WriteString(OutS,Currsym^.Value);
@@ -1034,7 +1067,7 @@ begin
       J:=Pos('=',Line);
       J:=Pos('=',Line);
       If J>0 then
       If J>0 then
         begin
         begin
-        Line:=LowerCase(Line);
+        Line:=LowerStr(Line);
         Name:=Copy(Line,1,j-1);
         Name:=Copy(Line,1,j-1);
         Delete(Line,1,J);
         Delete(Line,1,J);
         { indents or options ? }
         { indents or options ? }
@@ -1190,7 +1223,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2000-01-07 16:46:04  daniel
+  Revision 1.5  2000-02-06 19:57:45  carl
+  + More TP syntax compatible
+
+  Revision 1.4  2000/01/07 16:46:04  daniel
     * copyright 2000
     * copyright 2000
 
 
   Revision 1.3  1999/07/08 21:17:11  michael
   Revision 1.3  1999/07/08 21:17:11  michael