PROGRAM MAKEINL; {$C-} {$I-}

{* Version 2.0  22.11.1985  aus c't 1986,Heft 2 *}
Const      Left       : String[3]  = '(* ';
           Right      : String[3]  = ' *)';
           PRN        : String[4]  = '.PRN';
           INL        : String[4]  = '.INL';
           Leerstrg   : String[17] = '                ';
           Arrow      : String[8]  = ' -----> ';
           Header     : String[9]  = 'InLine'#13#10'(';
           Tail       : String[5]  = '$00)';
           Syoflow    : String[19] = 'Too many Variables'^G;
           Noexist    : String[9]  = 'No File !';
           Diskerr    : String[11] = 'Disk Full !';
           Direrr     : String[10] = 'Dir Full !';
           NoSymbol   : String[8]  = '????????';
           UnKnown    : String[22] = 'Error, cause unknown !';
           ASEGerr    : String[24] = 'Code must be relative !'^G;
           Warning    : String[30] = 'Overwrite Sourcefile ? (Y/N)'^G;
           Insert     : String[19] = 'Make-InLine Utility';
           Version    : String[39] = 'Version 2.0 - 11/1985 (c) Ulrich Fuchs';

Type       String_255    =  String[255];

           Listpointer   =  ^List;
           List          =  Record
                              ExtrnSymbol  :  String[20];
                              Pointer      :  Listpointer;
                            End;


Var        PrnText,InlText                                : Text;
           TextLine, NewLine, Opcode, Helpask,
           ASMText, Filename, Inlname, UpcaseLine         : String_255;
           OldLine                                        : Integer;


           EXTList, StartOfList, SearchPointer            : Listpointer;

           Mustdef,
           Continue, Skip, Ready,
           Extern, Quit ,NoError, First                   : Boolean;

           Ch                                             : Char;



Procedure Help;

Begin
  Writeln('Erzeugen von INLINE-Files aus xxx.PRN-Files des MACRO80-Assemblers.');

  Writeln('');
  Writeln('Syntax :  [DRIVE:] FILENAME [.TYPE] [/] [DRIVE:] [NEUNAME] [.INL]');
  Writeln('          [Quelle]                      [Ziel]');
  Writeln('');
  Writeln('Das Programm kann mit Argument aufgerufen werden. Dadurch ist die Wahl einiger');
  Writeln('Optionen (s.o.) durch die Angabe des Filenamens moeglich.');
  Writeln('MAKEINL meldet sich mit dem Stern, wenn es ohne Argument aufgerufen');
  Writeln('wird. Es kann dann eine Anweisung entsprechend obiger Syntax gegeben werden.');
  Writeln('Die in Klammern angegebenen Teile sind wahlweise. Wird nur der Filename ');
  Writeln('ohne Extension angegeben, so wird als Type  .PRN angenommen.');
  Writeln('Das generierte File wird unter FILENAME.INL abgelegt.');
  Writeln('--aus c"t 1986, Heft 2, Seite 64-67--');
  Writeln('------------------------------------------------------------------------------');

End;(*Help*)


Procedure ToUpper(VAR  Strg  : String_255);

Var   Count : byte;

Begin
  For Count  := 1 to Length(Strg) do
    Strg[Count] := Upcase(Strg[Count]);
End;{*ToUpper*}


Procedure Check_for_Err;

Var   Error : Byte;

Begin
  Error := IOresult;
  NoError := Error = 0;

  If Error <> 0 then
    Begin
      Writeln(#13#10#10#7);
      Case Error of
        $01  :   Writeln(Noexist);
        $F0  :   Writeln(Diskerr);
        $F1  :   Writeln(Direrr);
      Else Writeln(Unknown);
      End;
    End;
End;{*Check_for_Err*}


Procedure Select_Name(Var Name1,Name2 : String_255);

Var   Laenge2,N               :Byte;

Begin
  N := Pos('/',Filename);
  Laenge2 := Length(Filename) - N;

  If N > 0 then
    Begin
      Name2 := Copy(Filename,N + 1,Laenge2);
      Name1 := Copy(Filename,1,N - 1);

      If  (Laenge2 = 2) and (Name2[2] = ':') then
        Begin
          If Pos(':',Name1)=0 then
            Name2 := Concat(Name2,Name1)
          Else
            Name2 := Concat(Name2,Copy(Name1,3,N - 3));
          End;
        End
      Else
        Begin
          Name1 := Filename;
          Name2 := Filename;
        End;
End;{*Select_Name*}


Procedure Get_Name;

Var   Count, Punktpos : Byte;


Begin
  If First then
    Begin
      Filename := '';
      For Count := 1 to Mem[$80] - 1 do
      Filename  := Filename + Char(Mem[$81 + Count]);
    End;

  If (Filename = '') or Not First then
    Begin
      Write(#10'*');
      Readln(Filename);
    End;
  First := False;
  Quit := Filename = '';

  ToUpper(Filename);


  Select_Name(Filename,Inlname);

  If Pos('.',Filename) = 0 then Filename := Concat(Filename,PRN);

  If Pos('.',Inlname) = 0 then
    If Pos(':',Inlname) <> 4 then
      Inlname := Concat(Inlname,INL);

  If Filename = Inlname then
    Begin
      Write(Warning);
      Repeat
        Read(KBD,Ch);
        Ch :=Upcase(CH);
      until Ch in ['N','Y'];

      Writeln;
      If Ch <> 'Y' then Get_Name;
    End;

End;(*Get_Name*)



Procedure Form_NewLine;

Var   LineLength, Start, ExternalPos, Count               : Byte;
      ASEGerrFound, Comment,
      Code, Jump, Switch, Special                         : Boolean;
      ProgCounter, LabelPosition, Offset, Result          : Integer;
      Firstchar                                           : Char;
      Switchcode                                          : String[4];
      Strg                                                : String[6];



Procedure Fill_up  (Var   Line  : String_255; Spaces      : Integer);


Var   Index  : Byte;


Begin
  For Index  := 1 to Spaces - Length(Line) do Line := Line + ' ';
End;(*Fill_up*)



Procedure Insert_Symbol;

Var   Found  :Boolean;

Begin
  Found := False;
  SearchPointer := StartOfList;

  While (SearchPointer  <> NIL) and Not Found do
    Begin
      Found := Pos(SearchPointer^.ExtrnSymbol,UpcaseLine) > 0;
      If Found then Opcode := Opcode + SearchPointer^.ExtrnSymbol + '/';
      SearchPointer := SearchPointer^.Pointer;
    End;

  If Not Found then Opcode := Opcode + NoSymbol + '/';
End;(*Insert_Symbol*)



Procedure Calculate_Adress;

Begin
  Strg := '$' + Copy(TextLine,14,4);
  Val(Strg,LabelPosition,Result);
  Offset := LabelPosition - ProgCounter - 1;
  Str(Offset,Strg);
  If Offset <0 then
    Opcode := Opcode + '*' + Strg + '/'
  Else
    Opcode := Opcode + '*+' + Strg
      + '/';
End;(*Calculate_Adress*)



Procedure Define_Space;

Var  ToDefine, Count   : Integer;
     DefLine           : String[80];

Begin
  ToDefine := ProgCounter - OldLine;
  Count := 0;

  While Count < ToDefine do
    Begin
      DefLine := '';
      Repeat
        DefLine := DefLine + '$00/';
        Count := Count + 1;
      Until (Count Mod 4 = 0) or (Count = ToDefine);
      Writeln(DefLine);
      Writeln(InlText,DefLine);
    End;
Mustdef := False;
End; (* Define_Space *)



Begin
  Ready := TextLine = 'Macros:';
  LineLength := Length(TextLine);
  UpcaseLine := TextLine;
  ToUpper(UpcaseLine);

  ASEGerrFound := Pos('ASEG',UpcaseLine) > 0;
  If ASEGerrFound then
    If (Pos(';',TextLine) > Count) or (Pos(';',TextLine) = 0) then
      Begin
        Ready := True;
        Writeln(ASEGerr);
      End;


ExternalPos := Pos('EXT',UpcaseLine);
If ExternalPos >0 then
  Begin
    UpcaseLine := Copy(TextLine,ExternalPos,LineLength - ExternalPos +1);
    Count := Pos(' ',UpcaseLine);
    UpcaseLine := Copy(UpcaseLine,Count + 1,Length(UpcaseLine) - Count);
    While UpcaseLine[1] = ' ' do Delete(UpcaseLine,1,1);
    If (MemAvail > SizeOf(List)) or (MemAvail < 0)then
      Begin
        New(EXTList);
        EXTList^.ExtrnSymbol := UpcaseLine;
        EXTList^.Pointer := StartOfList;
        StartOfList := EXTList;
      End
    Else
      Begin
        NoError := False;
        Writeln(Syoflow);
    End;
End;


Code := (TextLine[7] = #39) or (TextLine[7] = '!');

Count := 1;
FirstChar := ^A;
While (Count <= LineLength) and (FirstChar <= ' ') do
  Begin
    FirstChar := TextLine[Count];
    Count := Count + 1;
  End;
Comment := FirstChar = ';';

Skip := Not (Code or Comment);

If Comment then
  Begin
    ASMText := Left + Copy(TextLine, Count,LineLength - Count + 1);
    Fill_up (ASMText,59);
    NewLine := Leerstrg + ASMText + Right;
  End;

If Code then
  Begin
    Strg := '$' + Copy(TextLine,3,4);
    Val(Strg,ProgCounter,Result);

    NewLine :=Copy(TextLine,11,LineLength - 10);

    If Mustdef then Define_Space;

    Switch := (NewLine[1] in ['D','E','F']) and (NewLine[2] = 'D');
    If Switch then
      Begin
        Switchcode := '$' + Copy(NewLine,1,2) + '/';
        Delete(NewLine,1,3);
      End;

    Extern := (NewLine[8] = '*');
    Jump := (NewLine[8] = #39) or (NewLine[8] = '!');
    Special := Jump or Extern;


  If NewLine[1] > ' ' then
    Opcode := '$' + Copy(NewLine,1,2) + '/'
  Else
    Begin
      Mustdef := (Pos(' DS ',UpcaseLine) > 0)
                  or (Pos(' DEFS ',UpcaseLine) > 0);
      OldLine := ProgCounter;
      Opcode := Leerstrg;
    End;

      If not Special then
        Begin
          If NewLine[6] <> ' ' then
            Opcode := Opcode + '$' + Copy(NewLine,6,2) + '/';

          If NewLine[4] <> ' ' then
            Opcode := Opcode + '$' + Copy(NewLine,4,2) + '/';

          If NewLine[6] = ' ' then
            If NewLine[7] > ' ' then
              Opcode := Opcode + '$' + Copy(NewLine,7,2) + '/';

          If NewLine[9] = ' ' then
            If NewLine[10] > ' ' then
              Opcode := Opcode + '$' + Copy(NewLine,10,2) + '/';

          If NewLine[3] > ' ' then
            Opcode := '$' + Copy(NewLine,3,2) + '/'
                       + '$' + Copy(NewLine,1,2) + '/';

          If NewLine[9] > ' ' then
            Opcode := Opcode +'$' + Copy(NewLine,8,2) + '/'
                       + '$' + Copy(NewLine,6,2) + '/';

        End;


      If Extern then Insert_Symbol;
      If Jump then Calculate_Adress;
      If Switch then Opcode := Switchcode + Opcode;

      Fill_up(Opcode,17);

      ASMText := Left + Copy(TextLine,33,LineLength - 32);
      Fill_up(ASMText,59);
      NewLine := Opcode + ASMText + Right;

    End;
End;(*Form_NewLine*)


(*   MAIN   *)


Begin
  ClrScr;
  First := True;
  Mustdef := False;
  Write(#10#10,Insert,#13#10,version,#13#10#10);
  Help;

Repeat
    Ready := False;
    Continue := True;
    Get_name;
    If Not Quit then
      Begin
        StartOfList := NIL;
        Writeln(#10,Filename,Arrow,Inlname,#10);
        Assign(PrnText,Filename);
        Assign(InlText,Inlname);
        Reset(PrnText);
        Check_for_Err;
        If NoError then
          Begin
            Rewrite(InlText);
            Check_for_Err;

            Writeln(InlText,Header);
            Writeln(Header);

            While Not Eof(PrnText) and NoError and Not Ready and Continue do
              Begin
                ReadLn(PrnText,TextLine);
                Form_NewLine;
                If not Skip then
                  Begin
                    Writeln(NewLine);
                    Writeln(InlText,NewLine);
                    Check_for_Err;
                  End;
                  If keypressed then
                    Begin
                      Read(KBD,Ch);
                      Continue := Ch <> ^X;
                    End;
              End;

            Writeln(InlText,Tail);
            Writeln(Tail);
        End;
      End;

    Close(PrnText);
    Close(InlText);

  Until Quit

End.