program PMLink;

  const MaxInd = $1500;  MaxSym = 255;

  type  PrgInd    = 0..MaxInd;    SymInd   = 1..MaxSym;
        SymString = string[6];    FName    = string[14];
        AnyString = string[127];
        Bits      = 0..8;         ItemT    = 0..15;
        FlagT     = (Norm,Rel,Ext,NegOffs,PosOffs);
        ByteRec   = record Low,High: byte end;

  var   Prog:    array[PrgInd] of
                   record Flag:FlagT; Cont: byte end;
        PC:        integer;           OffsPtr: byte;
        SymTab:    array[SymInd] of SymString;
        OffsTab:   array[1..255] of record OPC,Value: integer end;
        Finis,ErrFlag,EoPrg,EoFile: boolean;
        RelFile:   file;              InlFile: text;
        BytePtr:   0..128;            BitCnt:  Bits;
        Buffer:    array[0..127] of byte;
        WB:        ByteRec;           WW: integer absolute WB;
        PrgName:   SymString;
        PrgLen:    integer;           SymPtr:  SymInd;
        AField:    integer;           BField:  string[7];

{$I pmlink.bit}     {Bit-Management}
{$I pmlink.utl)     {Utilities}

  function RetrWd (N: integer): integer;   { holt ein 16-Bit- }
    var WB: ByteRec;  WW: integer absolute WB; {Wort aus dem     }
  begin                                        {Programmspeicher }
    with WB do
      begin Low := Prog[N].Cont; High := Prog[Succ(N)].Cont end;
    RetrWd := WW
  end;
 procedure FirstPass;

   procedure RelErr (Mess: SymString);
   begin Writeln ('PC = ',Hex(PC), ', Modul: ',PrgName,
                  ',  ',Mess,' relative;   Argument: ',Hex(GetWord)) end;

   procedure SpLErr (Item: ItemT);
   begin Writeln ('PC = ',Hex(PC),', Modul: ',PrgName,', Item: ',Item:2,
                  ', AField: ',Hex(AField),', BField: ',BField) end;

   procedure Store (Bt: byte; F: FlagT);
   begin
     with Prog[PC] do begin Flag := F; Cont := Bt end;
     PC := Succ(PC)
   end;

   procedure GetAField;
   begin
     case GetBits(2) of
       0,1: AField := GetWord;
       2:   RelErr ('Data'); 3: RelErr ('Common')
     end
   end;

   procedure GetBField; var N: 1..6;
   begin
     BField[0] := Chr(GetBits(3));
     for N:=1 to Length(BField) do BField[N] := Chr(GetByte)
   end;
  procedure SetExtern; var Next: integer;
  begin
    SymTab[Symptr] := BField;
    repeat
     Next := RetrWd(AField);
     with Prog[AField] do begin Cont := SymPtr; Flag := Ext end;
     Prog[Succ(AField)].Cont := 0;  {Voreinstellung: kein Offset}
     AField := Next
   until Next=0;
   SymPtr := Succ(SymPtr)
  end;

   procedure SetOffs; var N: byte;
   begin
     for N := 1 to Pred(OffsPtr) do
       Prog[Succ(OffsTab[N].OPC)].Cont := N  {Pointer auf Eintrag }
   end;                                      {in Offset-Tabelle}

   procedure ExtLink; var N: 1..7;
   begin
     BField[0] := Chr(Max(Succ(GetBits(3)),2));
     for N:=1 to Length(BField) do BField[N] := Chr(GetByte)
   end;

   procedure DefOffs (Offset: integer);
   begin
     with OffsTab[OffsPtr] do begin OPC := PC; Value := Offset end;
     OffsPtr := Succ(OffsPtr)
   end;

   procedure StoreWd (Word: integer; F:FlagT);
   begin Store (Lo(Word),F); Store (Hi(Word),F) end;

   procedure SpLink;
     var Item: ItemT;
   begin
     Item := GetBits(4); AField := 0; BField := '';
     if Item in [5..14] then GetAField;
     if Item in [0..3,5..7] then GetBField
     else case Item of
       4:  ExtLink;  {extension link item}
       15: EoFile := true
     end;
     case Item of
       1,3..5,11,12: SpLErr (Item);  {Fehler, keine Verarbeitung}
       2:     PrgName := BField;   6: SetExtern;
       8:     DefOffs (-AField);   9: DefOffs (AField);
       14,15: begin PrgLen := PC; BitCnt := 0; EoPrg := true end
     end                               {Programm- oder File-Ende}
   end;  {SpLink}

 begin  {FirstPass}
   PC := 0; SymPtr := 1; OffsPtr := 1; EoPrg := false;
   repeat
     if GetBits(1)=0 then Store (GetByte,Norm)
     else case GetBits(2) of
       0: SpLink;   {special link item}
       1: StoreWd (GetWord,Rel);
       2: RelErr ('Data'); 3: RelErr ('Common')
     end
   until EoPrg;
   SetOffs
 end;    {FirstPass}


 procedure SecPass;

   procedure Header;
   begin
     Writeln (InlFile); Write (InlFile, '  begin');
     if PrgName<>'' then Write (InlFile,' {Modul ',PrgName,'}');
     Writeln (InlFile); Write (InlFile,'    inline (')
   end;

   procedure WriteLine;

     var EndLine: boolean; ItemCnt: 0..15; LPos: 0..70;

    procedure AdjustLpos; var K,N: 0..7;
    begin
      K := ItemCnt * 4 - LPos - 1; LPos := LPos + K;
      for N:=1 to K do Write (InlFile,' ')
    end;

    procedure WriteItem;

      procedure WriteNorm;
      begin
        Write (InlFile,'$',Copy (Hex(Prog[PC].Cont),3,2));
        PC := Succ(PC); LPos := LPos + 3; Itemcnt := Succ(Itemcnt)
      end;

      procedure WriteRel; var Item: string[5]; Value: integer;
      begin
        Value := RetrWd(PC) - PC; Str(Value,Item);
        if Value>=0 then Item := '+' + Item;
        Write (InlFile,'*',Item);
        PC := Succ(Succ(PC)); ItemCnt := ItemCnt + 2;
        LPos := LPos + Succ(Length(Item))
      end;

      procedure WriteExtern;
        var Name: SymString;
            OP: byte;   Offset: integer;   OffStr: string[6];
      begin
        Name := SymTab[Prog[PC].Cont]; PC := Succ(PC);
        OP := Prog[PC].Cont;           PC := Succ(PC);
        if OP>0 then
        begin Offset := OffsTab[OP].Value; Str (Offset,OffStr);
              if Offset>0 then Name := Name + '+';
              Name := Name + OffStr end;
        Write (InlFile,Name);
        ItemCnt := ItemCnt + 2; LPos := LPos + Length(Name)
      end;

    begin  {WriteItem}
      case Prog[PC].Flag of
        Norm: WriteNorm;   Rel: WriteRel;   Ext: WriteExtern
      end;
    end;   {WriteItem}

  begin  {WriteLine}
    Writeln (InlFile); Write (InlFile,'  {',Hex(PC),'}   ');
    if Odd(PC) then
      begin Write (InlFile,'   '); ItemCnt := 1; LPos := 4 end
      else begin ItemCnt := 0; LPos := 0 end;
    repeat
      WriteItem;
      EoPrg := (PC>=PrgLen); EndLine := (ItemCnt>15); AdjustLPos;
      if not EoPrg then begin Write (InlFile,'/'); LPos := Succ(LPos) end;
    until (EndLine or EoPrg)
  end;   {WriteLine}

  procedure ClosePrg;
  begin
    Writeln (InlFile,')'); Write (InlFile,'  end;');
    if PrgName <> '' then Write (InlFile,'  (',PrgName,')');
    Writeln (InlFile)
  end;

begin  {SecPass}
  PC := 0; EoPrg := false; Header;
  repeat WriteLine until EoPrg;
  ClosePrg
end;   {SecPass}
begin  {PMLink}
  repeat
    OpenFiles; Writeln;
    if not (Finis or ErrFlag) then
    begin
      repeat
        FirstPass; if not EoFile then SecPass
      until EoFile;
      Close (InlFile)
    end
   until Finis
end.