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 F:pmlink.bit}	{Bit-Management}
{$I F:pmlink.utl}	{Utilities}

  function RetrWd (N: integer): integer; {fetches 16-bit word from WB:}
    Var WB: ByteRec;	WW: integer absolute WB;
  Begin
    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; {starting with No 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 to entry in Offset-table}
   End;

   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);	{Error - no processing}
       2:	PrgName := BField;
       6:	SetExtern;
       8:	DefOffs (-AField);
       9:	DefOffs (AField);
       14,15:	Begin PrgLen := PC; BitCnt :=0; EoPrg := true End
     End				{Program or File end}
   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.