paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 17:09:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Patch from Wiktor Sywula for watcom support

Browse Source
This commit is contained in:
michael 2003-09-30 08:39:50 +00:00
parent 0dda0a07c5
commit 953269fcff
5 changed files with 102 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
compiler/i386/ag386int.pas
View File

@ -169,21 +169,6 @@ implementation
AsmWrite(symbol.name); AsmWrite(symbol.name);
first:=false; first:=false;
end; end;
if (aktoutputformat = as_i386_wasm) then
begin
if offset<0 then
begin
AsmWrite(tostr(offset));
first:=false;
end
else if (offset>0) then
begin
if not first then
AsmWrite('+');
AsmWrite(tostr(offset));
first:=false;
end;
end;
if (base<>NR_NO) then if (base<>NR_NO) then
begin begin
if not(first) then if not(first) then
@ -202,8 +187,6 @@ implementation
if scalefactor<>0 then if scalefactor<>0 then
AsmWrite('*'+tostr(scalefactor)); AsmWrite('*'+tostr(scalefactor));
end; end;
if (aktoutputformat <> as_i386_wasm) then
begin
if offset<0 then if offset<0 then
begin begin
AsmWrite(tostr(offset)); AsmWrite(tostr(offset));
@ -214,7 +197,6 @@ implementation
AsmWrite('+'+tostr(offset)); AsmWrite('+'+tostr(offset));
first:=false; first:=false;
end; end;
end;
if first then if first then
AsmWrite('0'); AsmWrite('0');
AsmWrite(']'); AsmWrite(']');
@ -617,7 +599,6 @@ implementation
word prefix to get selectors word prefix to get selectors
to be pushed in 2 bytes PM } to be pushed in 2 bytes PM }
if (taicpu(hp).opsize=S_W) and if (taicpu(hp).opsize=S_W) and
(
( (
( (
(taicpu(hp).opcode=A_PUSH) or (taicpu(hp).opcode=A_PUSH) or
@ -625,12 +606,7 @@ implementation
) and ) and
(taicpu(hp).oper[0].typ=top_reg) and (taicpu(hp).oper[0].typ=top_reg) and
is_segment_reg(taicpu(hp).oper[0].reg) is_segment_reg(taicpu(hp).oper[0].reg)
) or ) then
(
(taicpu(hp).opcode=A_PUSH) and
(taicpu(hp).oper[0].typ=top_const)
)
) then
AsmWriteln(#9#9'DB'#9'066h'); AsmWriteln(#9#9'DB'#9'066h');
{ added prefix instructions, must be on same line as opcode } { added prefix instructions, must be on same line as opcode }
@ -661,7 +637,16 @@ implementation
end end
else else
prefix:= ''; prefix:= '';
AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix); if (aktoutputformat = as_i386_wasm) and
(taicpu(hp).opsize=S_W) and
(taicpu(hp).opcode=A_PUSH) and
(taicpu(hp).oper[0].typ=top_const) then
begin
AsmWriteln(#9#9'DB 66h,68h ; pushw imm16');
AsmWrite(#9#9'DW');
end
else
AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix);
if taicpu(hp).ops<>0 then if taicpu(hp).ops<>0 then
begin begin
if is_calljmp(taicpu(hp).opcode) then if is_calljmp(taicpu(hp).opcode) then
@ -890,7 +875,10 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.39 2003-09-23 17:56:06 peter Revision 1.40 2003-09-30 08:39:50 michael
+ Patch from Wiktor Sywula for watcom support
Revision 1.39 2003/09/23 17:56:06 peter
* locals and paras are allocated in the code generation * locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when * tvarsym.localloc contains the location of para/local when
generating code for the current procedure generating code for the current procedure

7
compiler/pmodules.pas
View File

@ -359,6 +359,8 @@ implementation
; ;
system_powerpc_macos: system_powerpc_macos:
; ;
system_i386_watcom:
;
system_alpha_linux: system_alpha_linux:
; ;
system_m68k_Mac: system_m68k_Mac:
@ -1441,7 +1443,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.126 2003-09-23 18:03:08 peter Revision 1.127 2003-09-30 08:39:50 michael
+ Patch from Wiktor Sywula for watcom support
Revision 1.126 2003/09/23 18:03:08 peter
* add missing release of main_proc * add missing release of main_proc
Revision 1.125 2003/09/23 17:56:05 peter Revision 1.125 2003/09/23 17:56:05 peter

11
compiler/systems/i_watcom.pas
View File

@ -2,7 +2,7 @@
$Id$ $Id$
Copyright (c) 1998-2002 by Peter Vreman Copyright (c) 1998-2002 by Peter Vreman
This unit implements support information structures for go32v2 This unit implements support information structures for Watcom
This program is free software; you can redistribute it and/or modify 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 it under the terms of the GNU General Public License as published by
@ -19,7 +19,7 @@
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
**************************************************************************** ****************************************************************************
} }
{ This unit implements support information structures for go32v2. } { This unit implements support information structures for Watcom. }
unit i_watcom; unit i_watcom;
{$i fpcdefs.inc} {$i fpcdefs.inc}
@ -63,7 +63,7 @@ unit i_watcom;
newline : #13#10; newline : #13#10;
dirsep : '\'; dirsep : '\';
files_case_relevent : false; files_case_relevent : false;
assem : as_i386_coff; assem : as_i386_wasm;
assemextern : as_gas; assemextern : as_gas;
link : nil; link : nil;
linkextern : nil; linkextern : nil;
@ -105,6 +105,9 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.1 2003-09-06 10:01:11 florian Revision 1.2 2003-09-30 08:39:50 michael
+ Patch from Wiktor Sywula for watcom support
Revision 1.1 2003/09/06 10:01:11 florian
+ added *_watcom units + added *_watcom units
} }

56
compiler/systems/t_watcom.pas
View File

@ -25,30 +25,29 @@ unit t_watcom;
{$i fpcdefs.inc} {$i fpcdefs.inc}
interface interface
implementation
uses
link,
cclasses,cutils,strings,globtype,globals,
systems,verbose,script,fmodule,i_watcom;
uses
link;
type type
plinkerwatcom=^tlinkerwatcom;
tlinkerwatcom=class(texternallinker) tlinkerwatcom=class(texternallinker)
private private
Function WriteResponseFile(isdll:boolean) : Boolean; Function WriteResponseFile(isdll:boolean) : Boolean;
public public
constructor create;override; constructor Create;override;
procedure SetDefaultInfo;virtual; procedure SetDefaultInfo;override;
function MakeExecutable:boolean;virtual; function MakeExecutable:boolean;override;
{ function MakeSharedLibrary:boolean;virtual;} { function MakeSharedLibrary:boolean;override;}
end; end;
implementation
uses
cclasses,cutils,strings,globtype,globals,systems,verbose,script,fmodule,i_watcom;
{**************************************************************************** {****************************************************************************
TLinkerWatcom TLinkerWatcom
****************************************************************************} ****************************************************************************}
@ -64,7 +63,7 @@ end;
procedure TLinkerWatcom.SetDefaultInfo; procedure TLinkerWatcom.SetDefaultInfo;
begin begin
with Info do with Info do
ExeCmd[1]:='wlink system causeway option quiet $OPT $STRIP name $EXE @$RES'; ExeCmd[1]:='wlink system causeway option quiet option nocaseexact $OPT $STRIP name $EXE @$RES';
end; end;
Function TLinkerWatcom.WriteResponseFile(isdll:boolean) : Boolean; Function TLinkerWatcom.WriteResponseFile(isdll:boolean) : Boolean;
@ -79,12 +78,21 @@ begin
{ Open link.res file } { Open link.res file }
LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
{ Write object files, start with prt0 }
LinkRes.Add('file '+GetShortName(FindObjectFile('prt0','',false)));
if not ObjectFiles.Empty then
While not ObjectFiles.Empty do
begin
S:=ObjectFiles.GetFirst;
LinkRes.AddFileName('file '+GetShortName(s));
end;
{ Write staticlibraries } { Write staticlibraries }
if not StaticLibFiles.Empty then if not StaticLibFiles.Empty then
While not StaticLibFiles.Empty do While not StaticLibFiles.Empty do
begin begin
S:=StaticLibFiles.GetFirst; S:=StaticLibFiles.GetFirst;
LinkRes.AddFileName('file '+GetShortName(s)) LinkRes.AddFileName('file '+GetShortName(s));
end; end;
(* (*
@ -143,12 +151,9 @@ begin
{ Call linker } { Call linker }
SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
if pos(' ',current_module.exefilename^)>0 then Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
Replace(cmdstr,'$EXE','"'+current_module.exefilename^+'"')
else
Replace(cmdstr,'$EXE',current_module.exefilename^);
Replace(cmdstr,'$OPT',Info.ExtraOptions); Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',outputexedir+Info.ResName); Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
Replace(cmdstr,'$STRIP',StripStr); Replace(cmdstr,'$STRIP',StripStr);
success:=DoExec(FindUtil(BinStr),cmdstr,true,false); success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
@ -164,12 +169,19 @@ begin
MakeSharedLibrary:=false; MakeSharedLibrary:=false;
end;} end;}
{*****************************************************************************
Initialize
*****************************************************************************}
initialization initialization
RegisterExternalLinker(system_i386_watcom_info,TLinkerWatcom); RegisterExternalLinker(system_i386_watcom_info,TLinkerWatcom);
RegisterTarget(system_i386_watcom_info); RegisterTarget(system_i386_watcom_info);
end. end.
{ {
$Log$ $Log$
Revision 1.1 2003-09-06 10:01:11 florian Revision 1.2 2003-09-30 08:39:50 michael
+ Patch from Wiktor Sywula for watcom support
Revision 1.1 2003/09/06 10:01:11 florian
+ added *_watcom units + added *_watcom units
} }

73
rtl/watcom/prt0.asm
View File

@ -5,50 +5,57 @@
.387 .387
.386p .386p
name prt0 name prt0
assume nothing assume nothing
extrn PASCALMAIN : near extrn PASCALMAIN : near
public start extrn HEAPSIZE : dword
public ___exit public start
public ___sbrk public ___exit
public ___sbrk
public HEAP
.STACK 1000h .STACK 1000h
.CODE .CODE
start proc near start proc near
jmp short main jmp short main
db "WATCOM" db "WATCOM"
main: main:
push ds push ds
pop es pop es
push ds push ds
pop fs pop fs
call PASCALMAIN mov eax,HEAPSIZE
mov ah,4Ch push eax
int 21h call ___sbrk
mov HEAP,eax
pop eax
call PASCALMAIN
start endp start endp
___exit proc near ___exit proc near
pop eax pop eax
mov ah,4Ch mov ah,4Ch
int 21h int 21h
___exit endp ___exit endp
___sbrk proc near ___sbrk proc near
mov ebx,dword ptr [esp+4] ; size mov ebx,dword ptr [esp+4]
mov cx,bx mov ecx,ebx
shr ebx,16 shr ebx,16
mov ax,501h mov ax,501h
int 31h int 31h
jnc sbrk_ok jnc sbrk_ok
sbrk_failed: xor eax,eax
xor eax,eax ret
ret sbrk_ok:
sbrk_ok: shl ebx,16
shl ebx,16 mov bx,cx
mov bx,cx mov eax,ebx
mov eax,ebx ret
ret
___sbrk endp ___sbrk endp
.DATA
HEAP dd 0
end start end start