home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
02
/
tricks
/
inlasm.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-11-13
|
5KB
|
154 lines
(* ------------------------------------------------------ *)
(* INLASM.PAS *)
(* Programm zur Umwandlung von Objekt-Dateien in *)
(* Turbo-Pascal INLINE-Prozeduren/Funktionen. *)
(* (C) 1989 R. Geier & TOOLBOX *)
(* ------------------------------------------------------ *)
PROGRAM InlAsm;
USES Crt;
CONST
LF = #10;
CR = #13;
BS = #8;
BEL = #7;
Count : ShortInt = 14;
VAR
InFile : FILE OF BYTE;
OutFile : TEXT ;
InFileName, OutFileName,
ProcHeader, OutStr : STRING ;
HexStr : STRING[3] ;
InlByte : BYTE ;
IOFehler, Start : BOOLEAN ;
ch : CHAR ;
PROCEDURE Hex(VAR z : BYTE);
(* wandelt Dezimalbyte in Hexadezimal-String um *)
CONST
HexDigits : ARRAY[0..15] OF CHAR =
('0','1','2','3','4','5','6','7','8','9',
'A','B','C','D','E','F');
VAR
FirstDigit, SecDigit : CHAR;
Digit : BYTE;
BEGIN
Digit := z DIV 16; FirstDigit := HexDigits[Digit];
Digit := z MOD 16; SecDigit := HexDigits[Digit];
HexStr := '$' + FirstDigit + SecDigit;
END;
PROCEDURE Eingaben;
PROCEDURE StUpCase(VAR st : STRING);
(* wandelt einen String in Großbuchstaben um *)
VAR
i : BYTE;
BEGIN
FOR i:= 1 TO Length(st) DO BEGIN
IF st[i] IN ['ä','ö','ü'] THEN BEGIN
CASE st[i] OF
'ä' : st[i] := 'Ä';
'ö' : st[i] := 'Ö';
'ü' : st[i] := 'Ü';
END;
END ELSE st[i] := UpCase(st[i]);
END;
END;
BEGIN
ClrScr; HighVideo;
WriteLn('INLASM V. 1.0'); LowVideo;
WriteLn; WriteLn;
LowVideo ;
WriteLn('Name der Object-Datei des Debuggers [.OBJ]: ');
Write('> '); HighVideo;
ReadLn(InFileName);
StUpCase(InFileName);
IF Pos('.',InFileName)=0 THEN
InFileName := InFileName + '.OBJ';
GotoXY(3,5); Write(InFileName); LowVideo; WriteLn(' <');
Assign(InFile,InFileName);
{$I-} Reset(InFile); {$I+}
IOFehler := IOResult <> 0;
IF IOFehler THEN BEGIN
GotoXY(1,24);
WriteLn(BEL,'Die Datei ',InFileName,
' existiert nicht. Programm abgebrochen.');
Halt;
END;
GotoXY(1,6);
WriteLn('Name der Ausgabedatei...............[.INL]: ');
Write('> '); HighVideo;
ReadLn(OutFileName);
StUpCase(OutFileName);
IF Pos('.INL',OutFileName)=0 THEN
OutFileName := OutFileName + '.INL';
GotoXY(3,7); Write(OutFileName);
LowVideo; WriteLn(' <');
Assign(OutFile,OutFileName);
{$I-} Reset(OutFile); {$I+}
IOFehler := IOResult = 0;
IF IOFehler THEN BEGIN
GotoXY(1,24);
Write(BEL,'Die Datei ',OutFileName,
' existiert bereits. Überschreiben (J/N)? ');
ch := ReadKey;
IF NOT(UpCase(ch) = 'J') THEN Halt;
Write(ch);
Rewrite(OutFile);
END ELSE Rewrite(OutFile);
GotoXY(1,8);
WriteLn('Prozedur/Funktionskopf....................: ');
Write('> '); HighVideo; ReadLn(ProcHeader);
IF (Pos('.P.',ProcHeader)=1) OR
(Pos('.p.',ProcHeader)=1) THEN BEGIN
Delete(ProcHeader,1,3);
ProcHeader := 'Procedure' + ProcHeader;
END;
IF (Pos('.F.',ProcHeader)=1) OR
(Pos('.f.',ProcHeader)=1) THEN BEGIN
Delete(ProcHeader,1,3);
ProcHeader := 'Function' + ProcHeader;
END;
GotoXY(3,9); Write(ProcHeader);
LowVideo; WriteLn(' <');
END; (* Eingaben *)
BEGIN
Start := FALSE; Eingaben; HighVideo;
Window(1,11,79,21);
OutStr := ProcHeader + CR + 'Begin' + CR + ' INLINE(';
Write(OutFile,OutStr);
(* Ausgabe des Prozedur/Funktionskopfes in Datei *)
OutStr := ProcHeader + LF + CR + 'Begin' + LF + CR +
' INLINE(';
Write(OutStr);
(* Ausgabe des Prozedur/Funktionskopfes auf Bildschirm *)
WHILE NOT(Eof(InFile)) DO BEGIN
IF Start THEN Write(OutFile,'/');
IF Count >= 75 THEN BEGIN
Count := 14; Write(OutFile,CR,' ');
Write(LF,CR,' ');
END;
Read(InFile,InlByte); (* 1 Byte aus OBJ-Datei lesen *)
Hex(InlByte); (* in Hex-String umwandeln *)
Write(OutFile,HexStr); (* Ausgabe in Datei *)
Write(HexStr,'/'); (* Ausgabe auf Bildschirm *)
Inc(Count,4);
Start := TRUE;
END;
Write(OutFile,');' + CR +'END;');
WriteLn(BS,');', + LF + CR + 'End;');
Close(InFile); Close(OutFile);
NormVideo; WriteLn;
WriteLn('INLINE-Datei ',OutFileName, ' erstellt...');
REPEAT UNTIL KeyPressed;
END.
(* ------------------------------------------------------ *)
(* Ende von INLASM.PAS *)