Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP_ADV.ZIP/LIST0415.PAS

Pascal/Delphi Source File | 1989-07-31 | 8.1 KB | 317 lines

{$R-,S-,I-,D+,F-,V-,B-,N-,L+ }
{$M 8192,0,0}
Program C2P;
{ This program will process the .ASM file that has been       }
{ generated by the TC2TP program.  It will construct the file }
{ in such a manner as to allow the Turbo Pascal program to    }
{ link in the appropriate .OBJ file.                          }

Uses
  Tools;

Const
  BUFFERSIZE       = 16384;

Type
  StrPtr           = ^String;
  Path             = String[70];
  Str20            = String[20];
  Str80            = String[80];
  Str4             = String[4];
  Str8             = String[8];
  TextBuffer       = Array[1..BUFFERSIZE] of Byte;

Var
  Line             : String;
  OutFileName      : Path;
  F,OutF           : Text;
  InBuffer,
  OutBuffer        : TextBuffer;
  Code_Seg_Name    : Str20;

Const
  NumLines         : Word = 0;
  Proc_Keyword     : Str4      = 'PROC';
  Endp_Keyword     : Str4      = 'ENDP';
  Public_Keyword   : String[6] = 'PUBLIC';
  Extrn_Keyword    : String[5] = 'EXTRN';
  EndS_Keyword     : Str4      = 'ENDS';
  Segment_Keyword  : String[7] = 'SEGMENT';
  Assume_Keyword   : String[6] = 'ASSUME';
  Group_Keyword    : String[5] = 'GROUP';
  DGROUP_Keyword   : String[6] = 'DGROUP:';
  TEXT_Seg_Def     : String[5] = '_TEXT';
  DATA_Seg_Def     : String[5] = '_DATA';
  BSS_Seg_Def      : Str4      = '_BSS';

  Cur_Seg_Name     : Str20 = 'CODE';
  InCodeSegment    : Boolean = TRUE;

Procedure HaltError( ErrorCode : Integer; S : String );
{ Error handler, display error number, display error  }
{ message, terminate and set DOS error level to       }
{ ErrorCode.      }

Begin
  Writeln( 'Error ',ErrorCode );
  Writeln( S );
  Halt( ErrorCode );
End;

Procedure OutputLine( Line : String );
{ Procedure to output a new line to our assembly file.        }

Var
  E : Word;

Begin
  Writeln( OutF,Line );
  E := IOResult;
  If E <> 0 Then
    HaltError( E, 'Error writing ' + OutFileName );
End;

Procedure EndS_Def;
{ Procedure to output an end of segment identifier to the new }
{ assembly file being generated.                              }

Var
  E : Integer;
  S : Str80;

Begin
  S := Cur_Seg_Name + '       ' + 'ENDS';
  OutputLine( S );
  InCodeSegment := FALSE;
End;

Procedure BeginS_Def;
{ Procedure to output the beginning of a segment to the new   }
{ assembly file being generated.                              }
Var
  E : Integer;
  S : String;
  Allignment : Str4;

Begin
  If InCodeSegment Then
  Begin
    Allignment := 'BYTE';
    Cur_Seg_Name   := 'CODE';
  End
  Else
  Begin
    Allignment := 'WORD';
    Cur_Seg_Name := 'DATA';
  End;
  S := Cur_Seg_Name + '  SEGMENT ' + Allignment + ' PUBLIC';
  OutputLine( S );
End;

Procedure Assume_Def;
{ Procedure to output the correct ASSUMEs for the new         }
{ assembly file being generated.                              }

Var
  E : Integer;

Begin
  OutputLine( '          ASSUME CS:CODE,DS:DATA' );
End;

Function CompareString( Var S1,S2 : String ) : Boolean;
{ if the strings are equal (including length) returns true    }

Begin
  CompareString :=
       CompMem( S1,S2,Succ( Length( S1 ) ) ) = _EQUAL_;
End;

Procedure Examine( Var S,Orig_Line : String );
{ The main logic line processing routine!  This procedure     }
{ determines how to translate each line into an assembly      }
{ language suitable for a TP4 bound asm module.  Since        }
{ there are only two segments we'll be using in the TP4 bound }
{ ASP file (the output file), the logic engine toggles        }
{ between emitting code (and the associated statements) and   }
{ data (and its statements).                                  }
Var
  SS : String;
  FirstWord : Str80;
  E : Integer;
  _Data_,_BSS_,_TEXT_
                   : Boolean;
Begin
  SS := S; { make a copy of the string and work on   }
           { the copy }

  { if this is an end segment definition then end    }
  { the current segment and Exit }

  If WordOnLine( EndS_Keyword,SS ) Then
  Begin
    Ends_Def;
    Exit;
  End;

  { if this is an ASSUME statement, then translate it }
  { and Exit }

  If WordOnLine( Assume_Keyword,SS ) Then
  Begin
    Assume_Def;
    Exit;
  End;

  { We ignore all GROUP statements }

  If WordOnLine( Group_Keyword,SS ) Then
    Exit;

  { the following conditional checks for an inline asm}
  { reference to DGROUP. if found, it is changed to   }
  { DATA in the ASP file. }

  If Pos( Dgroup_Keyword,SS ) > 0 Then
    ReplaceString( 'DGROUP','DATA',Orig_Line );

  { now get the first word on the line.  At this point}
  { all we need to do is check the first word, because}
  { We've already looked for ASSUME, GROUP and ENDS   }
  { statements.  We now decide whether this is a      }
  { segment definition, if so, it is translated       }
  { accordingly.  Otherwise it is either code or data }
  { and it is written out to the ASP output file.     }

  If WordOnLine( Segment_Keyword,SS ) Then
  Begin

    FirstWord := ParseWord( SS,' ' ); { parse the first word  }

    { reset some booleans }
    _Data_  := FALSE;
    _BSS_   := FALSE;
    _TEXT_  := FALSE;

    { check to see if this line is a segment definition }
    If CompareString( FirstWord,DATA_Seg_Def ) Then
      _Data_:= TRUE
    Else
      If CompareString(FirstWord,BSS_Seg_Def) Then
        _BSS_ := TRUE

    { in case we're in a large memory model, we don't look }
    { for the segment _TEXT explicitly, instead, we look   }
    { for a segment which includes the string _TEXT.       }

    Else
      If Pos( TEXT_Seg_Def,FirstWord ) > 0 Then
      Begin
        _TEXT_ := TRUE;
        Code_Seg_Name := FirstWord;
      End;

    { if this is a segment, we decide whether it's code }
    { or data, and deal with it.  Otherwise, the line is}
    { either code, comment, or data, and should be      }
    { passed to the ASP file }

    If _Data_ or _BSS_ or _TEXT_ Then
    Begin
      If _TEXT_ Then
        InCodeSegment := TRUE
      Else
        InCodeSegment := FALSE;
      BeginS_Def; { start a new segment }
    End
    Else
      OutputLine( Orig_Line );
  End
  Else
    OutputLine(Orig_Line); { code, data,or comment, so     }
                           { output }
End;

procedure Process_Line(S : String);

Var
  E : Integer;
  Line : String;

Begin
  { prepare Line for processing: }
  Line := Trim(Line);      { trim leading and trailing}
                           { white space }
  If Length( Line ) = 0 Then{ if the length of trimed  }
                           { string is 0, then Exit.  }
    Exit;

  Line := ExpandTabs( S );   { replace tabs with spaces }
  Line := UpperCase( Line );  { uppercase chars only     }

  Examine( Line,S ); { Call main logic. NOTE: This      }
                   { routine takes as parameters both }
                   { the prepared var Line and a copy }
                   { of the original source line.     }

End;

procedure Process_Asm_File( FPath : Path );

Var
  E,
  L : Integer;

Begin
  OutFileName := FileExt( FPath,'ASP' );
  Assign( F,FPath );
  SetTextBuf( F,InBuffer );
  Reset( F );
  E := IOResult;
  If E <> 0 Then
    HaltError(E,FPath + ' not found.');
  Assign( OutF,OutFileName );
  SetTextBuf( OutF,OutBuffer );
  Rewrite( OutF );
  E := IOResult;
  If E <> 0 Then
    HaltError(E,'Error opening '+OutFileName);
  Writeln('Creating new file: ',OutFileName);
  Writeln('working...');
  While Not EOF( F ) Do
  Begin
    Inc( NumLines );
    Readln( F,Line );
    E := IOResult;
    If E <> 0 Then
      HaltError( E,'Error reading ' + FPath );
    Process_Line( Line );
  End;
  Close( F );
  E := IOResult;
  Close( OutF );
  E := IOResult;
  If E <> 0 Then
    HaltError( E,'Error closing '+OutFileName );

End;

Var
  FName : Path;

Begin
  If ParamCount < 1 Then
  Begin
    Writeln( 'C2P AsmFileName' );
    Halt(99);
  End;
  FName := ParamStr( 1 );

  If Pos( '.',FName ) = 0 Then
    FName := FName + '.ASM';

  Process_Asm_File( FName );
  Writeln( NumLines,' lines processed' );
  Writeln( 'Success!' );
End.