{*	Pa*cal Link-80 version 3.2                  *}
{*	*}
{*     Program to produce an INLINE-statement from an M80 REL-file     *}
{*	*}
{*	Programmed in Turbo Pa*cal by J.A.C.G. van der Valk       *}
{*	van Langendonckstraat 2 / 3076 SL Rotterdam            *}
{*	Phone: 010-4320625                       *}
{*	*}
{*	Copyright 1986 by J.A.C.G. van der Valk              *}
{*	*}
{*	*}
{*	This code is donated to public domain for non-commercial use only!	*}
{*	It i* prohibited to *@11 this code (or any part of it) to third	*}
{*	parties ; to use this code code for any other commercial gain or to	*}
{*	distribute any program (in source or object form) ,developed by use	*}
{*	of the code in this file, on a commercial basis without prior	*}
{*	written permission by the author.	*}
{*	*}
const
PrtOn=^P; PrtOff=^N; Bell-^G; LF=^J; CR*^M; UP=^K;
type
symboltype = string[8];
fnamtype  = string[20];
anystring = string[80];
hextype   * string[2];
FileRecord = array [0..127] of byte;
LoadItem  = record
typecode:byte; contents:byte; end;
var
FileBuffer	: FileRecord;
count,	{ counter for lay out of .INC file       }
offset,	{ offset for PC-relative code           }
DataSize,	{ *ize of Data - segment               }
ProgSize,	{ size of Code - *egment               }
ErrorCnt,	{ number of fatal errors detected       }
EntryCnt,	{ number of entry sumbols defined        }
Maxloc,	{ maximum for LC on the heap            }
LC,	{ Location Counter                    . }
Pba*e,	{ Base for LC in Code Segment           }
C*ba*e,	{ Base for LC in Data Segment           }
Tsize,	{ Total Size of Code + Data             }
BitCnt,	{ Number of bit* read from .REL-file    }
ByteCnt,	{ Current Byte-number in .REL-file       }
ExtCnt,	{ Counter for external symbol storage    }
i	{ general purpose counter               }
:integer;
STOP	boolean;	{	Flag for terminating .REL-file	reading }
PrtOut	boolean;	{	Flag for shadow-output on printer      }
symbol	symboltype;	{	symbol in special link items	}
s	string[5];	{	string for LC in inl-file	}
fnam	string[15];	{	file - name of .REL file	}
WrkRec	LoadItem;	{	variable for storing temporary	code    }
c	char;	{	dummy character	}
relfil  file;	{	.REL - file from M80 assembler	}
inlfil,	{	file for inline statement	}
fentry,	{	file for table of entry points	}
f      :text;	{	file for listing on LST: or CON:	}
dsk    :byte;	{	current disk number	}
label
9399;	{ label to EXIT the program             }
{*	*:
{*	This code is donated to public domain for non-commercial	use only!   *!
{*	It is prohibited to sell this code (or any part of it)	to third   *!
{*	parties ; to use this code code for any other commercial	gain or to  *!
{*	distribute any program (in whatever form) ,developed	by use     *!
{*	of the code in this file, on a commercial basis without prior    *!
{*	written permission by the author.	*!
{*	*:
Procedure ClrEos; var i:byte; begin
for i:=14 to 24 do
begin
gotoxy(l,i);clreol
end; end;
Procedure Error(Errno:integer); begin
write(Bell,'Error ',Errno:2,' '); case Errno of 0: begin
writeln('Unsupported Special Link item'); writeln('please consult the PL80-manual!'); end; 1: begin
writeln(^Code size exeeds available workspace'); writeln('Split source-code if possible!'); write(^Continue anyhow (Y/N)? :');
read(kbd,c);if Upcase(c)='Y' then writeln('Y') else writeln('N'); Stop:=(Upcase(c){}'Y'); end; 2: begin
writeln('COMMON blocks are not supportedK); writeln('please take notice of the PL80-manual!');

end; 3: begin
writeln(^Heap-overflow while linking'); writeln('Check ORG-statements in source-code!^); Stop:=true; end; 4: begin
writeln(^Heap-overflow on Chaining External : ',symbol); writeln(^Split source-code if possible!'); stop:=true end;
end;{ of case } ErrorCnt:=ErrorCnt+l; end;
procedure Directory(s:fnamtype);
const
extend = 12; setDMA = 26; searchFirst = 17; searchNext = 18;
var
FCB	:array[0..32] of char;
directorynamen                          :array[0..3,0..31] of char;
drivenaam                                :char;
dot,index,regelaantal,directorycode       :integer;
begin
for index:=l to length(s) do s[index]:=Upcase(s[lndex]);
drivenaam:=chr(Bdos(25)+65);
if s[2]=':' then
begin
drivenaam:=Upcase(s[l]);
s:=copy(s,3,255); end;
if Length(s)=0 then s:='*.*'; writeln('Drive : ',drivenaam);
if (s[l]='*') and (s[2]='.') then s:='77777779'+copy(s,2,255); dot:=Pos(/.',s);
if dot}0 then for index:=dot to 8 do Insert(' ',s,dot); if (s[9]='.') and (s[10]='*/) then s:=copy(s,l,9)+/???'; if dot}0 then delete(s,9,l); for index:=Length(s) to 10 do s:=s+' '; FCB[0]:=chr(ord(drivenaam)-64); for index:=l to 11 do FCB[index]:=s[index]; for index:=12 to 32 do FCB[index]:=chr(0);
bdos(setDMA,addr(directorynamen));
directorycode:=bdos(searchfirst,addr(FC8));
regelaantal:=0;
if directorycode=255 then writeln('No files *.REL foundK);
while directorycode{255 do
begin

if directorynamen[directorycode,extend]=chr(0)
then
begin
if regelaantal}0 then write(' l ');
write(copy(directorynamen[directorycode],2,8), ^.^); for index:=9 to 11 do
write(chr(127 and ord(directorynamen[directorycode,index]))); regelaantal:=(regelaantal+l)mod 5; if regelaantal=0 then writeln; end;
directorycode:=bdos(searchnext); end;
if regelaantal}0 then writeln; end;
procedure MemWrite(nn:integer;var WrkRec:LoadItem); begin
if nn{=Maxloc then
move(WrkRec,mem[nn*sizeof(LoadItem)+HeapPtr],sizeof(LoadItem))
else Error(3); end;
procedure MemRead(nn:integer;var WrkRec:LoadItem); begin
if nn{= Maxloc then
move(mem[nn*sizeof(LoadItem)+HeapPtr],WrkRec,sizeof(LoadItem)); end;
Procedure StoreExtrnl(symbol:symboltype); var WrkRec:LoadItem;
i:byte; begin
if (Tsize+(ExtCnt+l)*9) }= Maxloc then Error(4) else begin
for i:=0 to 8 do begin
WrkRec.typecode:=3; WrkRec.contents:=ord(symbol[i]); MemWrite((Tsize+ExtCnt*9+i),WrkRec); end;
ExtCnt:=ExtCnt+l; end; end;
Procedure GetExtrnl(nn:integer;var symbol:symboltype); var WrkRec:LoadItem;
i:byte; begin
for i:=0 to 8 do begin
MemRead((Tsize+ExtCnt*9+i),WrkRec); symbol[i]:=chr(WrkRec.contents); end; end;

Function Hex(b:byte):hextype;
const HexTabl:string[16]='0123456789ABCDEF';
begin
Hex:=HexTabl[(b shr 4)+l] + HexTabl[(b and $OF)+1]; end;
procedure center(str:anystring);
var i:integer;
begin
for i:=l to (80-length(str)) div 2 do write(' ');
writeln(str); end;
procedure conout(c:char);	'
const Prt:boolean=false;
begin
if c=PrtOn then Prt:=true
else if c=PrtOff then Prt:=false
else begin
Bios(3,ord(c)); if Prt and (c{}Bell) then Bios(4,ord(c)); end; end;
procedure init;
var i     : integer;
dummy : real; begin
BitCnt:=-l; ByteCnt:=-l; STOP:=False; ErrorCnti=0;
EntryCnt:=6; ExtCnt:=0; count:=0;
LC:=0; Pbase:=0; ProgSize:=-l;
dummy:=memavail; if dummy{0 then dummy:=dummy+65536.0;
Maxloc:=Trunc(dummy/sizeof(LoadItem))-l;
conoutptr:=addr(conout);
{ Hello messages }
ClrScr; writeln;
center(' P A S C A L   L I N K  -  80 ');
writeln;
center('version: 3.2 / dd:17-07-1986');
center('Programmed by  J.A.C.G. van der Valk');
center('van Langendonckstraat 2 / 3076  SL  Rotterdam');
center('Phone : 010 - 4320625');
writeln;
center('(c) 1986 by FalconSoft (tm)');
writeln(LF);
writeln('Free work space : ',Maxloc:5,' bytes');
writeln;
Directory('*.rel');
dsk:=Bdos(25); { get current disk }
{ Input requests }
writeln('Hit {RETURN} to toggle default drive (A/B)',LF);

write('Name of .REL - file to convert 7 : '); readln(fnam);
for i:=l to length(fnam) do fnam[i]:=Upcase(fnam[i]);
i:=Pos('.',fnam);
if i}0 then delete(fnam,i,255);
if (fnam[2]=':') and (Length(fnam)=2) then
begin
dsk:=ord(fnam[l])-65;
if dsk in [0,1] then Bdos(14,dsk);
fnam:='  '; end;
{$I-}
assign(relfil,fnam+^.REL^);reset(relfil); while IOresult{}0 do begin ClrEol;
if (fnam[2]=':') and (Length(fnam)}0) then begin
dsk:=ord(fnam[l])-65;
if dsk in[0,l] then Bdos(14,d*k);
fnam:=copy(fnam,3,255); end else
if length(Fnam)=0 then begin
if dsk=l then dsk:=0 else dsk:=l;
Bdos(14,d*k);
ClrEos;gotoxy(l,14);Directory('*.rel');
writeln('Hit {RETURN} to toggle default drive (A/B)',LF);
write('Name of .REL - file to convert 7 : ');
readln(fnam);
ClrEol; end else begin
ClrEos;gotoxy(l,14);Directory('*.rel');
writeln('Hit {RETURN} to toggle default drive (A/B)',LF,LF);
write(Bell,'File ',chr(dsk+65),':',fnam,'.REL not foundK,CR,UP);
write('Name of .REL - file to convert 7 : '); ClrEol; readln(fnam); end;
for i:=l to length(fnam) do fnam[i]:*Upcase(fnam[i]); i:=Po$('.',fnam); if i}0 then delete(fnam,i,255); if (fnam[2]=':') and (Length(fnam)=2) then begin
dsk:=ord(fnam[l])-65;
if dsk in[0,l] then Bdos(14,dsk);
fnam:='  '; end;
assign(relfil,fnam+'.REL'); reset(relfil); end; {$I+}
if fnam[2]=':' then fnam:=copy(fnam,3,255); { delete drive specification if still present }
ClrEol;
Bdos(13);     { reset disk system }

Bdos(14,dsk);  { restore previous default drive } write('Send output to LST: device also (Y/N)? ]^);read(kbd,c); if Upcase(c)='Y' then writeln('Y',PrtOn) else writeln('N'); writeln; end;
function getbit:byte; var mask:byte; begin
BitCnt:=(BitCnt+l) mod 8;
if BitCnt=0
then ByteCnt:=(ByteCnt+l) mod 128;
if ByteCnt+BitCnt=0 then
begin
BlockRead(RelFil,FileBuffer,l);
end;
Mask:=128 shr BitCnt;
if (FileBuffer[Bytecnt] and mask)=0
then Getbit:=0 else Getbit:=l; end;
function RelCode:byte; begin
relcode:=(GetBit shl 1) + GetBit; end;
function CtrlField:integer; begin
CtrlField:=(GetBit shl 3) +
(GetBit shl 2) + (GetBit shl 1) +
GetBit; end;
function GetByte:byte;
var i,B:byte;
begin
B:=0;
for i:=7 downto 0
do B:=B+(GetBit shl i);
Getbyte:*B; end;
function GetInteger:integer; begin
GetInteger:=GetByte + Swap(GetByte); end;
Procedure GetAfield(var yy,nn:integer); begin
yy:=RelCode;
nn:=GetInteger; end;
Procedure GetBfield(var symbol:symboltype); var i,zzz:byte;

begin
zzz:=GetBit*4+GetBit*2+GetBit;
if zzz=0 then zzz:=8;
symbol:='';
for i:=l to zzz do symbol:=symbol+chr(GetByte); end;
Procedure LoadByte; begin
WrkRec.typecode:=0;
WrkRec.contents:=GetByte;
MemWrite(LC,WrkRec);
LC:=LC+1; end;
Procedure LoadProgRel;
var x:integer;
begin
x:=GetInteger+Pbase;
WrkRec.typecode:=l;
WrkRec.contents:=lo(x);
MemWrite(LC,WrkRec);
WrkRec.contenta:=hi(x);
MemWrite(LC+l,WrkRec);
LC:=LC+2; end;
Procedure LoadDataRel;
var x:integer;
begin
x:=GetInteger+Dbase;
WrkRec.typecode:=l;
WrkRec,contents:=lo(x);
MemWrite(LC,WrkRec);
WrkRec.contents:=hi(x);
MemWrite(LC+l,WrkRec);
LC:=LC+2; end;
Procedure LoadCommRel;
var x:integer;
b*gin
x:=GetInteqer;
LC:=LC+2; end;
Procedure SpecialLink;
var x,yy,nn,nextloc,nextcode:integer;
begin
Case CtrlField of 0: begin
GetBfield(symbol);
writeln('Entry symbol	--} ',symbol);
end;
1: begin

GetBfield(symbol);
writeln('Select COMMON block      --} ',symbol); Error(2); end; 2: begin
GetBfield(symbol);
writeln(^Program Name	-} ',symbol);
end;
3: begin
GetBfield(symbol);
writeln(^Request iibrary search   --} ',symbol); Error(0); end; 4: begin
GetBfield(symbol);
writeln('Extention Link item      --} ',symbol); Error(0);stop:=true; end; 5: begin
GetAfield(yy,nn);GetBfield(symbol); writeln('Define COMMON size       -} ',symbol); writeln('$',Hex(yy),'  $',Hex(hi(nn)),Hex(lo(nn))); Error(0); end; 6: begin
GetAfield(yy,nn);GetBfield(symbol);
writeln('Chain External	--} ',symbol);
case yy of
1: nn:=nn+Pbase;
2: nn:=nn+Dbase;
3: begin
nn:=nn+Tsize; Error(2); end;
end;{ of case } MemRead(nn,WrkRec);
writeln('loc = $',Hex(hi(nn)),Hex(lo(nn))); nextloc:=nn;nextcode:=yy; if nn+yy=0 then
writeln('WARNING: Chain is empty, inspect source code!^); while nextcode+nextloc}0 do begin
nextloc:=WrkRec.contents; nextcode:=WrkRec.typecode; WrkRec.contents:=lo(ExtCnt); WrkRec.typecode:=2; MemWrite(nn,WrkRec); MemRead(nn+i,WrkRec);
nextloc:=nextloc+swap(WrkRec.contents); if nextcode+nextloc}0 then
writeln('loc = $',hex(hi(nextloc)),hex(lo(nextloc))); WrkRec.typecode:=2;WrkRec.contents:=hi(ExtCnt); MemWrite(nn+l,WrkRec); nn:=nextloc;MemRead(nn,WrkRec); end;

StoreExtrnl(symbol); end;
7: begin
GetAfield(yy,nn);GetBfield(symbol);
writeln('Define Entry point       --} ',symbol);
writeln('$',Hex(yy),'  $',Hex(hi(nn)),Hex(lo(nn)));
case yy of
l:nn:=nn+Pbase;
2:nn:=nn+dbase;
3:begin
ErrorCnt:=ErrorCnt+l;
writeln(^Error: entry in common block^); end;
end;{ of case } if EntryCnt=0 then begin
assign(fentry,fnam+'.ENT');rewrite(fentry); writeln(fentry,'Table of Entry symbols '); writeln(fentry,'corresponding to ',fnam,'.INL'); writeln(fentry); end;
write(fentry,symbol);
for x:=l to 8-length(symbol) do write(fentry,' '); writeln(fentry,' = $',hex(hi(nn)),Hex(lo(nn))); EntryCnt:=EntryCnt+l; end; 8: begin
getAfield(yy,nn);
write('External - offset        -} '); writeln('$',Hex(yy),'  $',Hex(hi(nn)),Hex(lo(nn))); Error(0); end; 9: begin
getAfield(yy,nn);
write(^External + offset        --} ^); writeln('$',Hex(yy),'  $',Hex(hi(nn)),Hex(lo(nn))); Error(0); end; lO:begin
getAfield(yy,nn);
write('Define Size of DATA area  --} '); writeln('$',Hex(hi(nn)),Hex(lo(nn))); DataSize:=nn; end; ll:begin
GetAfield(yy,nn);
write('Set Loading LC to ');
case yy of
1: write('CSEG');
2: write('DSEG');
3: write('COMM');
end;{ of case }
writeln('    --} $',Hex(hi(nn)),Hex(lo(nn)));
case yy of

1: LC:=Pbase+nn; 2: LC:=Dbase+nn; 3: LC:=Tsize+nn; end;{ of case } end; 12:begin
getAfield(yy,nn);
write(^Chain Address	--} ');
writeln('$',Hex(yy),'  $/,Hex(hi(nn)),Hex(lo(nn)));
nextloc:=nn;nextcode:=yy;
while nextcode+nextloc}0 do
begin
nextloc:=WrkRec.contents;WrkRec.contents:=LC; nextcode:=WrkRec.t^pecode; MemWrite(nn,WrkRec);MemRead(nn+l,WrkRec); nextloc:=nextloc+swap(WrkRec.contents); writeln('loc = $',hex(hi(nextloc)),hex(lo(nextloc))); WrkRec.contents:=LC; MemWrite(nn+l,WrkRec); nn:=nextloc;MemRead(nn,WrkRec); end; end; 13:begin
getAfield(yy,ProgSize);
writeln('Define PROGRAM Size      --} $',
Hex(hi(ProgSize)),Hex(lo(ProgSize)));
Dbase:=ProgSize+3;{ create space for JP ENDofDSEG }
Tsize:=ProgSize+DataSize;
if datasize}0 then tsize:=tsize+3;
if Tsize}Maxloc then Error(l)
else begin
WrkRec.typecode:=0; WrkRec.contents:=0; for x:=0 to Tsize-l do MemWrite(x,WrkRec); { Block-Data space (DS) initialized to nuil-bytes } end; end; 14:begin
getAfield(yy,nn); writeln('END of PROGRAM');
Bitcnt:=-l; { forces to next byte boundary } end; 15:begin
Stop:=true;
writeln('END of FILE'); end;
end;{ of case } end;
begin init;
While not STOP do begin
if Getbit=0 then loadbyte
else begin

case relcode of O:SpecialLink; l:LoadProgRel; 2:LoadDataRel; 3:LoadCommRel; end;{ of case } end; end;
writeln(LF,LF,^diagnostics for linkage of file ',fnam,'.REL',LF);
writeln(^Free workspace available : ',Maxloc:5,' bytes');
if Tsize{Maxloc then
writeln(^Total workspace used    : ',(Tsize+ExtCnt*9):5,' bytes')
else writeln(^Code size exeeds work space^);
writeln(^Total code size         : ',Tsize:5,' bytes');
writeln('Code segment size       : ',Progsize:5,' bytes');
writeln('Data segment size       : ',Datasize:5,' bytes');
if Tsize{Maxloc then
begin
if ExtCnt}0 then
writeln('number of externals      : ',ExtCnt:5)
else writeln('no externals usedK);
if EntryCnt}0 then
writeln('number of entry-points   : ',EntryCnt:5)
else writeln('no entry points definedK); end;
LC:=0;
if EntryCnt}0 then close(fentry);
if ErrorCnt}0 then
begin
writeln(f);
writeln(ErrorCnt:3,' fatal error(s) detected',LF);
write('make inline-file anyway (Y/N)? ');read(kbd,c);
if Upcase(c){}'Y' then
begin
writeln('NK);
if EntryCnt}0 then erase(fentry); goto 9999;
end else writeln(^Y'); end else writeln(^no fatal errors detectedK);
writeln(PrtOff);
writeln('creating ',fnam,'.INL...');
write('Bytes written : ',#27,'.0');
assign(inlfil,fnam+'.INL');rewrite(inlfil);
write(inlfil,' INLINE({00000} ');
while LC { Tsize do begin
MemRead(LC,WrkRec); case WrkRec.typecode of 0: begin
write(inlfil,'$',Hex(WrkRec.contents)); LC:=LC+1;

end; 1: begin
offset:=WrkRec.contents; MemRead(LC+l,WrkRec);
offset:=offset+swap(WrkRec.contents)-LC; if offset}0 then write(inlfil,'*+',offset) else write(inlfil,'*',offset); LC:=LC+2; end; 2: begin
ExtCnt:=WrkRec.contents; MemRead(LC+l,WrkRec); ExtCnt:=ExtCnt+swap(WrkRec.contents); GetExtrnl(ExtCnt,s^mbol); write(inlfil,symbol); LC:=LC+2; end; else
begin
write(^Internal error, program aborted^); close(inlfil);erase(inlfil); goto 9999; end; end;{ of case }
if LC { Tsize
then write(inlfil,'/') else writeln(inlfil,');');
if (LC=ProgSize) and (Datasize}0) then
begin
writeln(inlfil,'$C3/*+',Tsize-LC-l,'/'); LC:=LC+3;
writeln(inlfil,'       { start of DATA segment }'); Str(LC,s);for i:=length(s) to 4 do s:='0'+s; write(inlfil,'       {',s,'} '); count:=0; end;
count:=(count+l) mod 10; if count=0 then begin
writeln(inlfil);
Str(LC,s);for i:=length(s) to 4 do s:='0'+s; write(inlfil,/       {',s,'} '); end;
write(LC:5,^H,^H,^H,^H,^H); end;
close(inlfil); 9999:
writeln(#27,'.2'); close(relfil); end.
