home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 02 / tricks / inlasm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-14  |  4.9 KB  |  154 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      INLASM.PAS                        *)
  3. (*     Programm zur Umwandlung von Objekt-Dateien in      *)
  4. (*       Turbo-Pascal INLINE-Prozeduren/Funktionen.       *)
  5. (*              (C) 1989 R. Geier & TOOLBOX               *)
  6. (* ------------------------------------------------------ *)
  7. PROGRAM InlAsm;
  8.  
  9. USES  Crt;
  10.  
  11. CONST
  12.   LF  = #10;
  13.   CR  = #13;
  14.   BS  = #8;
  15.   BEL = #7;
  16.   Count : ShortInt = 14;
  17.  
  18. VAR
  19.   InFile                   : FILE OF BYTE;
  20.   OutFile                  : TEXT        ;
  21.   InFileName, OutFileName,
  22.   ProcHeader, OutStr       : STRING      ;
  23.   HexStr                   : STRING[3]   ;
  24.   InlByte                  : BYTE        ;
  25.   IOFehler, Start          : BOOLEAN     ;
  26.   ch                       : CHAR        ;
  27.  
  28.   PROCEDURE Hex(VAR z : BYTE);
  29.          (* wandelt Dezimalbyte in Hexadezimal-String um *)
  30.   CONST
  31.     HexDigits : ARRAY[0..15] OF CHAR =
  32.                  ('0','1','2','3','4','5','6','7','8','9',
  33.                   'A','B','C','D','E','F');
  34.   VAR
  35.     FirstDigit, SecDigit : CHAR;
  36.     Digit                : BYTE;
  37.   BEGIN
  38.     Digit  := z DIV 16; FirstDigit := HexDigits[Digit];
  39.     Digit  := z MOD 16; SecDigit   := HexDigits[Digit];
  40.     HexStr := '$' + FirstDigit + SecDigit;
  41.   END;
  42.  
  43.   PROCEDURE Eingaben;
  44.  
  45.     PROCEDURE StUpCase(VAR st : STRING);
  46.              (* wandelt einen String in Großbuchstaben um *)
  47.     VAR
  48.       i : BYTE;
  49.     BEGIN
  50.       FOR i:= 1 TO Length(st) DO BEGIN
  51.         IF st[i] IN ['ä','ö','ü'] THEN BEGIN
  52.           CASE st[i] OF
  53.             'ä' : st[i] := 'Ä';
  54.             'ö' : st[i] := 'Ö';
  55.             'ü' : st[i] := 'Ü';
  56.           END;
  57.         END ELSE st[i] := UpCase(st[i]);
  58.       END;
  59.     END;
  60.  
  61.   BEGIN
  62.     ClrScr;   HighVideo;
  63.     WriteLn('INLASM  V. 1.0');   LowVideo;
  64.     WriteLn;     WriteLn;
  65.     LowVideo ;
  66.     WriteLn('Name der Object-Datei des Debuggers [.OBJ]: ');
  67.     Write('> ');   HighVideo;
  68.     ReadLn(InFileName);
  69.     StUpCase(InFileName);
  70.     IF Pos('.',InFileName)=0 THEN
  71.       InFileName := InFileName + '.OBJ';
  72.     GotoXY(3,5); Write(InFileName); LowVideo; WriteLn(' <');
  73.     Assign(InFile,InFileName);
  74.     {$I-} Reset(InFile); {$I+}
  75.     IOFehler := IOResult <> 0;
  76.     IF IOFehler THEN BEGIN
  77.       GotoXY(1,24);
  78.       WriteLn(BEL,'Die Datei ',InFileName,
  79.          ' existiert nicht. Programm abgebrochen.');
  80.       Halt;
  81.     END;
  82.     GotoXY(1,6);
  83.     WriteLn('Name der Ausgabedatei...............[.INL]: ');
  84.     Write('> ');   HighVideo;
  85.     ReadLn(OutFileName);
  86.     StUpCase(OutFileName);
  87.     IF Pos('.INL',OutFileName)=0 THEN
  88.                         OutFileName := OutFileName + '.INL';
  89.     GotoXY(3,7);    Write(OutFileName);
  90.     LowVideo;     WriteLn(' <');
  91.     Assign(OutFile,OutFileName);
  92.     {$I-} Reset(OutFile); {$I+}
  93.  
  94.     IOFehler := IOResult = 0;
  95.     IF IOFehler THEN BEGIN
  96.       GotoXY(1,24);
  97.       Write(BEL,'Die Datei ',OutFileName,
  98.          ' existiert bereits. Überschreiben (J/N)? ');
  99.       ch := ReadKey;
  100.       IF NOT(UpCase(ch) = 'J') THEN Halt;
  101.       Write(ch);
  102.       Rewrite(OutFile);
  103.     END ELSE Rewrite(OutFile);
  104.  
  105.     GotoXY(1,8);
  106.     WriteLn('Prozedur/Funktionskopf....................: ');
  107.     Write('> ');    HighVideo;    ReadLn(ProcHeader);
  108.     IF (Pos('.P.',ProcHeader)=1) OR
  109.        (Pos('.p.',ProcHeader)=1) THEN BEGIN
  110.       Delete(ProcHeader,1,3);
  111.       ProcHeader := 'Procedure' + ProcHeader;
  112.     END;
  113.     IF (Pos('.F.',ProcHeader)=1) OR
  114.        (Pos('.f.',ProcHeader)=1) THEN BEGIN
  115.       Delete(ProcHeader,1,3);
  116.       ProcHeader := 'Function' + ProcHeader;
  117.     END;
  118.     GotoXY(3,9);   Write(ProcHeader);
  119.     LowVideo;  WriteLn(' <');
  120.   END; (* Eingaben *)
  121.  
  122. BEGIN
  123.   Start := FALSE; Eingaben;     HighVideo;
  124.   Window(1,11,79,21);
  125.   OutStr := ProcHeader + CR + 'Begin' + CR + '  INLINE(';
  126.   Write(OutFile,OutStr);
  127.    (* Ausgabe des Prozedur/Funktionskopfes in Datei       *)
  128.   OutStr := ProcHeader + LF + CR + 'Begin' + LF + CR +
  129.                                                 '  INLINE(';
  130.   Write(OutStr);
  131.    (* Ausgabe des Prozedur/Funktionskopfes auf Bildschirm *)
  132.   WHILE NOT(Eof(InFile)) DO BEGIN
  133.     IF Start THEN Write(OutFile,'/');
  134.     IF Count >= 75 THEN BEGIN
  135.       Count := 14; Write(OutFile,CR,'         ');
  136.       Write(LF,CR,'         ');
  137.     END;
  138.     Read(InFile,InlByte);   (* 1 Byte aus OBJ-Datei lesen *)
  139.     Hex(InlByte);           (* in Hex-String umwandeln    *)
  140.     Write(OutFile,HexStr);  (* Ausgabe in Datei           *)
  141.     Write(HexStr,'/');      (* Ausgabe auf Bildschirm     *)
  142.     Inc(Count,4);
  143.     Start := TRUE;
  144.   END;
  145.   Write(OutFile,');' + CR +'END;');
  146.   WriteLn(BS,');', + LF + CR + 'End;');
  147.   Close(InFile);   Close(OutFile);
  148.   NormVideo;   WriteLn;
  149.   WriteLn('INLINE-Datei ',OutFileName, ' erstellt...');
  150.   REPEAT UNTIL KeyPressed;
  151. END.
  152. (* ------------------------------------------------------ *)
  153. (*                Ende von INLASM.PAS                     *)
  154.