paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 17:47:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ add compiler support for the Z80 MSX-DOS target

Browse Source 
git-svn-id: trunk@45596 -
This commit is contained in:
svenbarth 2020-06-06 17:16:20 +00:00
parent 1e1c17cb61
commit 921e73ab0c
12 changed files with 590 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -849,6 +849,7 @@ compiler/systems/i_linux.pas svneol=native#text/plain
compiler/systems/i_macos.pas svneol=native#text/plain
compiler/systems/i_morph.pas svneol=native#text/plain
compiler/systems/i_msdos.pas svneol=native#text/plain
compiler/systems/i_msxdos.pas svneol=native#text/pascal
compiler/systems/i_nativent.pas svneol=native#text/pascal
compiler/systems/i_nds.pas svneol=native#text/plain
compiler/systems/i_nwl.pas svneol=native#text/plain
@ -883,6 +884,7 @@ compiler/systems/t_linux.pas svneol=native#text/plain
compiler/systems/t_macos.pas svneol=native#text/plain
compiler/systems/t_morph.pas svneol=native#text/plain
compiler/systems/t_msdos.pas svneol=native#text/plain
compiler/systems/t_msxdos.pas svneol=native#text/pascal
compiler/systems/t_nativent.pas svneol=native#text/pascal
compiler/systems/t_nds.pas svneol=native#text/plain
compiler/systems/t_nwl.pas svneol=native#text/plain

2
compiler/ngenutil.pas
View File

@ -1559,7 +1559,7 @@ implementation
tcb.free;
{ allocate an initial heap on embedded systems }
if target_info.system in (systems_embedded+systems_freertos+[system_z80_zxspectrum]) then
if target_info.system in (systems_embedded+systems_freertos+[system_z80_zxspectrum,system_z80_msxdos]) then
begin
{ tai_datablock cannot yet be handled via the high level typed const
builder, because it implies the generation of a symbol, while this

2
compiler/ogrel.pas
View File

@ -1328,7 +1328,7 @@ implementation
idtxt : 'REL';
asmbin : '';
asmcmd : '';
supported_targets : [system_z80_embedded,system_z80_zxspectrum];
supported_targets : [system_z80_embedded,system_z80_zxspectrum,system_z80_msxdos];
flags : [af_outputbinary,af_smartlink_sections];
labelprefix : '..@';
labelmaxlen : 79;

4
compiler/options.pas
View File

@ -3365,6 +3365,8 @@ begin
target_unsup_features:=[f_dynlibs];
system_z80_zxspectrum:
target_unsup_features:=[f_threading,f_dynlibs{,f_fileio,f_textio},f_commandargs,f_exitcode];
system_z80_msxdos:
target_unsup_features:=[f_threading,f_dynlibs];
else
target_unsup_features:=[];
end;
@ -3952,7 +3954,7 @@ begin
end;
{ Set up default value for the heap }
if target_info.system in (systems_embedded+systems_freertos+[system_z80_zxspectrum]) then
if target_info.system in (systems_embedded+systems_freertos+[system_z80_zxspectrum,system_z80_msxdos]) then
begin
case target_info.system of
{$ifdef AVR}

7
compiler/systems.inc
View File

@ -198,7 +198,8 @@
system_arm_freertos, { 106 }
system_aarch64_win64, { 107 }
system_z80_embedded, { 108 }
system_z80_zxspectrum { 109 }
system_z80_zxspectrum, { 109 }
system_z80_msxdos { 110 }
);
type
@ -299,8 +300,10 @@
ld_int_msdos,
ld_int_win16,
ld_int_zxspectrum,
ld_int_msxdos,
ld_freertos,
ld_zxspectrum
ld_zxspectrum,
ld_msxdos
);
tar = (ar_none

2
compiler/systems.pas
View File

@ -379,7 +379,7 @@ interface
system_i386_openbsd,system_x86_64_openbsd,
system_riscv32_linux,system_riscv64_linux,
system_aarch64_win64,
system_z80_zxspectrum
system_z80_zxspectrum,system_z80_msxdos
]+systems_darwin+systems_amigalike;
{ all systems that use the PE+ header in the PE/COFF file

120
compiler/systems/i_msxdos.pas Normal file
View File

@ -0,0 +1,120 @@
{
Copyright (c) 1998-2002 by Peter Vreman
This unit implements support information structures for MS-DOS
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
{ This unit implements support information structures for go32v2. }
unit i_msxdos;
{$i fpcdefs.inc}
{$ifdef go32v2}
{ As wlib uses a different Dos-Extender, long-command line
encoding for DJGPP does not work here.
Put all inside a script file instead }
{$define USE_SCRIPTED_WLIB}
{$endif}
interface
uses
systems;
const
system_z80_msxdos_info : tsysteminfo =
(
system : system_z80_msxdos;
name : 'MSX-DOS';
shortname : 'MSXDOS';
flags : [tf_use_8_3,
{$ifdef Z80_SMARTLINK_SECTIONS}
tf_smartlink_sections,
{$else Z80_SMARTLINK_SECTIONS}
tf_smartlink_library,
tf_no_objectfiles_when_smartlinking,
{$endif Z80_SMARTLINK_SECTIONS}
tf_cld,tf_no_generic_stackcheck,tf_emit_stklen];
cpu : cpu_z80;
unit_env : 'MSXDOSUNITS';
extradefines : '';
exeext : '.exe';
defext : '.def';
scriptext : '.bat';
smartext : '.sl';
unitext : '.ppu';
unitlibext : '.ppl';
asmext : '.s';
objext : '.o';
resext : '.res';
resobjext : '.or';
sharedlibext : '.dll';
staticlibext : '.a';
staticlibprefix : '';
sharedlibprefix : '';
sharedClibext : '.dll';
staticClibext : '.a';
staticClibprefix : 'lib';
sharedClibprefix : '';
importlibprefix : '';
importlibext : '.al';
Cprefix : '';
newline : #13#10;
dirsep : '\';
assem : as_z80_rel;
assemextern : as_sdcc_sdasz80;
link : ld_int_msxdos;
linkextern : ld_msxdos;
ar : ar_sdcc_sdar;
res : res_none;
dbg : dbg_dwarf2;
script : script_unix;
endian : endian_little;
alignment :
(
procalign : 1;
loopalign : 1;
jumpalign : 0;
jumpalignskipmax : 0;
coalescealign : 0;
coalescealignskipmax : 0;
constalignmin : 0;
constalignmax : 1;
varalignmin : 0;
varalignmax : 1;
localalignmin : 0;
localalignmax : 1;
recordalignmin : 0;
recordalignmax : 1;
maxCrecordalign : 1
);
first_parm_offset : 4;
stacksize : 1024;
stackalign : 1;
abi : abi_default;
llvmdatalayout : 'todo';
);
implementation
initialization
{$ifdef cpuz80}
{$ifdef msxdos}
set_source_info(system_z80_msxdos_info);
{$endif msxdos}
{$endif cpuz80}
end.

450
compiler/systems/t_msxdos.pas Normal file
View File

@ -0,0 +1,450 @@
{
Copyright (c) 1998-2002 by Peter Vreman
This unit implements support import,export,link routines
for the (z80) MSX-DOS target
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit t_msxdos;
{$i fpcdefs.inc}
{$define USE_LINKER_WLINK}
interface
implementation
uses
SysUtils,
cutils,cfileutl,cclasses,
globtype,globals,systems,verbose,cscript,
fmodule,i_msxdos,
link,aasmbase,cpuinfo,ogrel,owar;
const
DefaultOrigin = $100;
type
{ sdld - the sdld linker from the SDCC project ( http://sdcc.sourceforge.net/ ) }
{ vlink - the vlink linker by Frank Wille (http://sun.hasenbraten.de/vlink/ ) }
TLinkerMSXDOS=class(texternallinker)
private
FOrigin: Word;
Function WriteResponseFile_Sdld: Boolean;
Function WriteResponseFile_Vlink: Boolean;
procedure SetDefaultInfo_Sdld;
procedure SetDefaultInfo_Vlink;
function MakeExecutable_Sdld: boolean;
function MakeExecutable_Vlink: boolean;
public
procedure SetDefaultInfo; override;
function MakeExecutable: boolean; override;
procedure InitSysInitUnitName; override;
function postprocessexecutable(const fn : string;isdll:boolean): boolean;
end;
TInternalLinkerMSXDOS=class(tinternallinker)
private
FOrigin: Word;
protected
procedure DefaultLinkScript;override;
function ExecutableFilename:String;override;
public
constructor create;override;
procedure InitSysInitUnitName;override;
function MakeExecutable: boolean; override;
function postprocessexecutable(const fn : string): boolean;
end;
{*****************************************************************************
TLinkerMSXDOS
*****************************************************************************}
function TLinkerMSXDOS.WriteResponseFile_Sdld: Boolean;
Var
linkres : TLinkRes;
s : TCmdStr;
prtobj: string[80];
begin
result:=False;
prtobj:='prt0';
{ Open link.res file }
LinkRes:=TLinkRes.Create(outputexedir+Info.ResName,true);
{ Write the origin (i.e. the program load address) }
LinkRes.Add('-b _CODE='+tostr(FOrigin));
if not (target_info.system in systems_internal_sysinit) and (prtobj <> '') then
begin
s:=FindObjectFile(prtobj,'',false);
LinkRes.AddFileName(s);
end;
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
begin
if not(cs_link_on_target in current_settings.globalswitches) then
s:=FindObjectFile(s,'',false);
LinkRes.AddFileName((maybequoted(s)));
end;
end;
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
while not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
LinkRes.Add('-l'+maybequoted(s));
end;
end;
{ Write and Close response }
linkres.writetodisk;
linkres.free;
result:=True;
end;
function TLinkerMSXDOS.WriteResponseFile_Vlink: Boolean;
Var
linkres : TLinkRes;
s : TCmdStr;
prtobj: string[80];
begin
result:=false;
prtobj:='prt0';
{ Open link.res file }
LinkRes:=TLinkRes.Create(outputexedir+Info.ResName,true);
LinkRes.Add('INPUT (');
if not (target_info.system in systems_internal_sysinit) and (prtobj <> '') then
begin
s:=FindObjectFile(prtobj,'',false);
LinkRes.AddFileName(maybequoted(FixFileName(s)));
end;
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
begin
s:=FindObjectFile(s,'',false);
LinkRes.AddFileName(maybequoted(FixFileName(s)));
end;
end;
while not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
LinkRes.AddFileName(maybequoted(FixFileName(s)));
end;
LinkRes.Add(')');
with LinkRes do
begin
Add('');
Add('SECTIONS');
Add('{');
Add(' . = 0x'+hexstr(FOrigin,4)+';');
Add(' .text : { *(.text .text.* ) }');
Add(' .data : { *(.data .data.* .rodata .rodata.* .bss .bss.* .fpc.* .stack .stack.* ) }');
Add('}');
end;
{ Write and Close response }
linkres.writetodisk;
linkres.free;
result:=true;
end;
procedure TLinkerMSXDOS.SetDefaultInfo_Sdld;
const
ExeName='sdldz80';
begin
FOrigin:=$100;
with Info do
begin
ExeCmd[1]:=ExeName+' -n $OPT -i $MAP $EXE -f $RES'
end;
end;
procedure TLinkerMSXDOS.SetDefaultInfo_Vlink;
const
ExeName='vlink';
begin
FOrigin:=$100;
with Info do
begin
ExeCmd[1]:=ExeName+' -bihex $GCSECTIONS -e $STARTSYMBOL $STRIP $OPT -o $EXE -T $RES'
end;
end;
procedure TLinkerMSXDOS.SetDefaultInfo;
begin
if not (cs_link_vlink in current_settings.globalswitches) then
SetDefaultInfo_Sdld
else
SetDefaultInfo_Vlink;
end;
function TLinkerMSXDOS.MakeExecutable_Sdld: boolean;
var
binstr,
cmdstr,
mapstr: TCmdStr;
success : boolean;
StaticStr,
//GCSectionsStr,
DynLinkStr,
StripStr,
FixedExeFileName: string;
begin
{ for future use }
StaticStr:='';
StripStr:='';
mapstr:='';
DynLinkStr:='';
FixedExeFileName:=maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.ihx')));
if (cs_link_map in current_settings.globalswitches) then
mapstr:='-mw';
{ Write used files and libraries }
WriteResponseFile_Sdld();
{ Call linker }
SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$EXE',FixedExeFileName);
Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName))));
Replace(cmdstr,'$STATIC',StaticStr);
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$MAP',mapstr);
//Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
Replace(cmdstr,'$DYNLINK',DynLinkStr);
success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
{ Remove ReponseFile }
if success and not(cs_link_nolink in current_settings.globalswitches) then
DeleteFile(outputexedir+Info.ResName);
{ Post process }
if success and not(cs_link_nolink in current_settings.globalswitches) then
success:=PostProcessExecutable(FixedExeFileName,false);
result:=success; { otherwise a recursive call to link method }
end;
function TLinkerMSXDOS.MakeExecutable_Vlink: boolean;
var
binstr,
cmdstr: TCmdStr;
success: boolean;
GCSectionsStr,
StripStr,
StartSymbolStr,
FixedExeFilename: string;
begin
GCSectionsStr:='-gc-all -mtype';
StripStr:='';
StartSymbolStr:='start';
FixedExeFileName:=maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.ihx')));
{ Write used files and libraries }
WriteResponseFile_Vlink();
{ Call linker }
SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$EXE',FixedExeFileName);
Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName))));
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$STARTSYMBOL',StartSymbolStr);
Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
{ Remove ReponseFile }
if success and not(cs_link_nolink in current_settings.globalswitches) then
DeleteFile(outputexedir+Info.ResName);
{ Post process }
if success and not(cs_link_nolink in current_settings.globalswitches) then
success:=PostProcessExecutable(FixedExeFileName,false);
result:=success;
end;
function TLinkerMSXDOS.MakeExecutable: boolean;
begin
if not (cs_link_vlink in current_settings.globalswitches) then
result:=MakeExecutable_Sdld
else
result:=MakeExecutable_Vlink;
end;
procedure TLinkerMSXDOS.InitSysInitUnitName;
begin
sysinitunit:='si_prc';
end;
function TLinkerMSXDOS.postprocessexecutable(const fn: string; isdll: boolean): boolean;
begin
result:=DoExec(FindUtil(utilsprefix+'ihxutil'),' -t bin '+fn+' '+maybequoted(ScriptFixFileName(current_module.exefilename)),true,false);
end;
{*****************************************************************************
TInternalLinkerZXSpectrum
*****************************************************************************}
procedure TInternalLinkerMSXDOS.DefaultLinkScript;
var
s : TCmdStr;
prtobj: string[80];
begin
prtobj:='prt0';
if not (target_info.system in systems_internal_sysinit) and (prtobj <> '') then
LinkScript.Concat('READOBJECT ' + maybequoted(FindObjectFile(prtobj,'',false)));
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
begin
if not(cs_link_on_target in current_settings.globalswitches) then
s:=FindObjectFile(s,'',false);
LinkScript.Concat('READOBJECT ' + maybequoted(s));
end;
end;
LinkScript.Concat('GROUP');
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
while not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
if s<>'' then
LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s));
end;
end;
LinkScript.Concat('ENDGROUP');
LinkScript.Concat('IMAGEBASE '+tostr(FOrigin));
LinkScript.Concat('EXESECTION .text');
LinkScript.Concat(' OBJSECTION _CODE');
LinkScript.Concat('ENDEXESECTION');
LinkScript.Concat('EXESECTION .data');
LinkScript.Concat(' OBJSECTION _DATA');
LinkScript.Concat('ENDEXESECTION');
LinkScript.Concat('EXESECTION .bss');
LinkScript.Concat(' OBJSECTION _BSS');
LinkScript.Concat(' OBJSECTION _HEAP');
LinkScript.Concat(' OBJSECTION _STACK');
LinkScript.Concat('ENDEXESECTION');
LinkScript.Concat('ENTRYNAME start');
end;
constructor TInternalLinkerMSXDOS.create;
begin
inherited create;
CArObjectReader:=TArObjectReader;
CExeOutput:=TIntelHexExeOutput;
CObjInput:=TRelObjInput;
if ImageBaseSetExplicity then
FOrigin:=ImageBase
else
FOrigin:=DefaultOrigin;
end;
function TInternalLinkerMSXDOS.ExecutableFilename:String;
begin
result:=ChangeFileExt(current_module.exefilename,'.ihx');
end;
procedure TInternalLinkerMSXDOS.InitSysInitUnitName;
begin
sysinitunit:='si_prc';
end;
function TInternalLinkerMSXDOS.MakeExecutable: boolean;
begin
result:=inherited;
{ Post process }
if result and not(cs_link_nolink in current_settings.globalswitches) then
result:=PostProcessExecutable(maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.ihx'))));
end;
function TInternalLinkerMSXDOS.postprocessexecutable(const fn: string): boolean;
var
exitcode: longint;
FoundBin: ansistring;
Found: Boolean;
utilexe: TCmdStr;
begin
result:=false;
utilexe:=utilsprefix+'ihxutil'+source_info.exeext;
FoundBin:='';
Found:=false;
if utilsdirectory<>'' then
Found:=FindFile(utilexe,utilsdirectory,false,Foundbin);
if (not Found) then
Found:=FindExe(utilexe,false,Foundbin);
if Found then
begin
exitcode:=RequotedExecuteProcess(foundbin,' -t bin '+fn+' '+maybequoted(ScriptFixFileName(current_module.exefilename)));
result:=exitcode<>0;
end;
end;
{*****************************************************************************
Initialize
*****************************************************************************}
initialization
{$ifdef z80}
RegisterLinker(ld_msxdos,TLinkerMSXDOS);
RegisterLinker(ld_int_msxdos,TInternalLinkerMSXDOS);
RegisterTarget(system_z80_msxdos_info);
{$endif z80}
end.

3
compiler/utils/ppuutils/ppudump.pp
View File

@ -229,7 +229,8 @@ const
{ 106 } 'FreeRTos-arm',
{ 107 } 'Win64-AArch64',
{ 108 } 'Embedded-Z80',
{ 109 } 'ZXSpectrum-Z80'
{ 109 } 'ZXSpectrum-Z80',
{ 110 } 'MSX-DOS-Z80'
);
const

2
compiler/z80/agsdasz80.pas
View File

@ -901,7 +901,7 @@ unit agsdasz80;
idtxt : 'SDCC-SDASZ80';
asmbin : 'sdasz80';
asmcmd : '-g -o $EXTRAOPT $OBJ $ASM';
supported_targets : [system_Z80_embedded,system_z80_zxspectrum];
supported_targets : [system_Z80_embedded,system_z80_zxspectrum,system_z80_msxdos];
flags : [af_needar];
labelprefix : '.L';
labelmaxlen : 79;

2
compiler/z80/agz80vasm.pas
View File

@ -929,7 +929,7 @@ unit agz80vasm;
idtxt : 'VASM';
asmbin : 'vasmz80_std';
asmcmd : '-quiet -Fvobj -o $OBJ $EXTRAOPT $ASM';
supported_targets : [system_z80_embedded, system_z80_zxspectrum];
supported_targets : [system_z80_embedded, system_z80_zxspectrum, system_z80_msxdos];
flags : [af_needar,af_smartlink_sections];
labelprefix : '.L';
labelmaxlen : -1;

3
compiler/z80/cputarg.pas
View File

@ -41,6 +41,9 @@ implementation
{$ifndef NOTARGETZXSPECTRUM}
,t_zxspectrum
{$endif}
{$ifndef NOTARGETMSXDOS}
,t_msxdos
{$endif}
{**************************************
Assemblers