mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 19:29:24 +02:00
* m68k updates from v10 merged
This commit is contained in:
peter
parent
f959b8e668
commit
c4b84ce276
@ -37,6 +37,8 @@ interface
|
||||
|
||||
function min(a,b : longint) : longint;
|
||||
function max(a,b : longint) : longint;
|
||||
function SwapLong(x : longint): longint;
|
||||
function SwapWord(x : word): word;
|
||||
function align(i,a:longint):longint;
|
||||
function used_align(varalign,minalign,maxalign:longint):longint;
|
||||
function size_2_align(len : longint) : longint;
|
||||
@ -136,6 +138,30 @@ uses
|
||||
end;
|
||||
|
||||
|
||||
Function SwapLong(x : longint): longint;
|
||||
var
|
||||
y : word;
|
||||
z : word;
|
||||
Begin
|
||||
y := (x shr 16) and $FFFF;
|
||||
y := ((y shl 8) and $FFFF) or ((y shr 8) and $ff);
|
||||
z := x and $FFFF;
|
||||
z := ((z shl 8) and $FFFF) or ((z shr 8) and $ff);
|
||||
SwapLong := (longint(z) shl 16) or longint(y);
|
||||
End;
|
||||
|
||||
|
||||
Function SwapWord(x : word): word;
|
||||
var
|
||||
z : byte;
|
||||
Begin
|
||||
z := (x shr 8) and $ff;
|
||||
x := x and $ff;
|
||||
x := (x shl 8);
|
||||
SwapWord := x or z;
|
||||
End;
|
||||
|
||||
|
||||
function align(i,a:longint):longint;
|
||||
{
|
||||
return value <i> aligned <a> boundary
|
||||
@ -708,7 +734,10 @@ initialization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2001-07-01 20:16:15 peter
|
||||
Revision 1.9 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.8 2001/07/01 20:16:15 peter
|
||||
* alignmentinfo record added
|
||||
* -Oa argument supports more alignment settings that can be specified
|
||||
per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
|
||||
|
||||
@ -42,7 +42,7 @@ interface
|
||||
ts32real = single;
|
||||
ts64real = double;
|
||||
ts80real = extended;
|
||||
ts64comp = comp;
|
||||
ts64comp = extended;
|
||||
{$endif}
|
||||
{$ifdef alpha}
|
||||
bestreal = extended;
|
||||
@ -208,7 +208,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2001-07-01 20:16:15 peter
|
||||
Revision 1.14 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.13 2001/07/01 20:16:15 peter
|
||||
* alignmentinfo record added
|
||||
* -Oa argument supports more alignment settings that can be specified
|
||||
per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
|
||||
|
||||
@ -1431,17 +1431,19 @@ implementation
|
||||
LOC_REGISTER,LOC_CREGISTER:
|
||||
begin
|
||||
case orddef.typ of
|
||||
u8bit:
|
||||
u8bit,uchar,bool8bit:
|
||||
tai:=Taicpu.Op_reg_reg(A_MOVZX,S_BL,location.register,destreg);
|
||||
s8bit:
|
||||
tai:=Taicpu.Op_reg_reg(A_MOVSX,S_BL,location.register,destreg);
|
||||
u16bit:
|
||||
u16bit,uwidechar,bool16bit:
|
||||
tai:=Taicpu.Op_reg_reg(A_MOVZX,S_WL,location.register,destreg);
|
||||
s16bit:
|
||||
tai:=Taicpu.Op_reg_reg(A_MOVSX,S_WL,location.register,destreg);
|
||||
u32bit,s32bit:
|
||||
u32bit,bool32bit,s32bit:
|
||||
if location.register <> destreg then
|
||||
tai:=Taicpu.Op_reg_reg(A_MOV,S_L,location.register,destreg);
|
||||
else
|
||||
internalerror(330);
|
||||
end;
|
||||
if delloc then
|
||||
ungetregister(location.register);
|
||||
@ -1455,18 +1457,20 @@ implementation
|
||||
begin
|
||||
r:=newreference(location.reference);
|
||||
case orddef.typ of
|
||||
u8bit:
|
||||
u8bit,uchar,bool8bit:
|
||||
tai:=Taicpu.Op_ref_reg(A_MOVZX,S_BL,r,destreg);
|
||||
s8bit:
|
||||
tai:=Taicpu.Op_ref_reg(A_MOVSX,S_BL,r,destreg);
|
||||
u16bit:
|
||||
u16bit,uwidechar,bool16bit:
|
||||
tai:=Taicpu.Op_ref_reg(A_MOVZX,S_WL,r,destreg);
|
||||
s16bit:
|
||||
tai:=Taicpu.Op_ref_reg(A_MOVSX,S_WL,r,destreg);
|
||||
u32bit:
|
||||
u32bit,bool32bit:
|
||||
tai:=Taicpu.Op_ref_reg(A_MOV,S_L,r,destreg);
|
||||
s32bit:
|
||||
tai:=Taicpu.Op_ref_reg(A_MOV,S_L,r,destreg);
|
||||
else
|
||||
internalerror(330);
|
||||
end;
|
||||
end;
|
||||
if delloc then
|
||||
@ -2996,7 +3000,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.25 2001-07-01 20:16:18 peter
|
||||
Revision 1.26 2001-07-30 20:59:28 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.25 2001/07/01 20:16:18 peter
|
||||
* alignmentinfo record added
|
||||
* -Oa argument supports more alignment settings that can be specified
|
||||
per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
|
||||
|
||||
@ -372,6 +372,7 @@ implementation
|
||||
new(hr);
|
||||
reset_reference(hr^);
|
||||
hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
|
||||
location.register:=getregister32;
|
||||
emit_ref_reg(A_LEA,S_L,hr,location.register);
|
||||
end
|
||||
else
|
||||
@ -1423,7 +1424,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.17 2001-07-16 13:19:08 jonas
|
||||
Revision 1.18 2001-07-30 20:59:29 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.17 2001/07/16 13:19:08 jonas
|
||||
* fixed allocation of register before release in second_cstring_to_pchar
|
||||
|
||||
Revision 1.16 2001/07/08 21:00:17 peter
|
||||
|
||||
@ -190,12 +190,13 @@ implementation
|
||||
constsethi:=pos;
|
||||
if pos<constsetlo then
|
||||
constsetlo:=pos;
|
||||
l:=pos shr 3;
|
||||
mask:=1 shl (pos mod 8);
|
||||
{ to do this correctly we use the 32bit array }
|
||||
l:=pos shr 5;
|
||||
mask:=1 shl (pos mod 32);
|
||||
{ do we allow the same twice }
|
||||
if (constset^[l] and mask)<>0 then
|
||||
if (pconst32bitset(constset)^[l] and mask)<>0 then
|
||||
Message(parser_e_illegal_set_expr);
|
||||
constset^[l]:=constset^[l] or mask;
|
||||
pconst32bitset(constset)^[l]:=pconst32bitset(constset)^[l] or mask;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -1044,8 +1045,20 @@ implementation
|
||||
function ttypeconvnode.first_int_to_real : tnode;
|
||||
begin
|
||||
first_int_to_real:=nil;
|
||||
if registersfpu<1 then
|
||||
registersfpu:=1;
|
||||
{$ifdef m68k}
|
||||
if (cs_fp_emulation in aktmoduleswitches) or
|
||||
(tfloatdef(resulttype.def).typ=s32real) then
|
||||
begin
|
||||
if registers32<1 then
|
||||
registers32:=1;
|
||||
end
|
||||
else
|
||||
if registersfpu<1 then
|
||||
registersfpu:=1;
|
||||
{$else not m68k}
|
||||
if registersfpu<1 then
|
||||
registersfpu:=1;
|
||||
{$endif not m68k}
|
||||
location.loc:=LOC_FPU;
|
||||
end;
|
||||
|
||||
@ -1415,7 +1428,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.29 2001-07-08 21:00:15 peter
|
||||
Revision 1.30 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.29 2001/07/08 21:00:15 peter
|
||||
* various widestring updates, it works now mostly without charset
|
||||
mapping supported
|
||||
|
||||
|
||||
@ -36,6 +36,8 @@ interface
|
||||
type
|
||||
pconstset = ^tconstset;
|
||||
tconstset = array[0..31] of byte;
|
||||
pconst32bitset = ^tconst32bitset;
|
||||
tconst32bitset = array[0..7] of longint;
|
||||
|
||||
tnodetype = (
|
||||
addn, {Represents the + operator.}
|
||||
@ -795,7 +797,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.17 2001-06-04 18:14:16 peter
|
||||
Revision 1.18 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.17 2001/06/04 18:14:16 peter
|
||||
* store blocktype info in tnode
|
||||
|
||||
Revision 1.16 2001/06/04 11:53:13 peter
|
||||
|
||||
@ -98,7 +98,7 @@ implementation
|
||||
stacksize:=target_info.stacksize;
|
||||
|
||||
{ open assembler response }
|
||||
AsmRes:=TAsmScript.Create(outputexedir+'ppas');
|
||||
GenerateAsmRes(outputexedir+'ppas');
|
||||
|
||||
{ open deffile }
|
||||
DefFile:=TDefFile.Create(outputexedir+inputfile+target_info.defext);
|
||||
@ -617,7 +617,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 2001-07-01 20:16:16 peter
|
||||
Revision 1.21 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.20 2001/07/01 20:16:16 peter
|
||||
* alignmentinfo record added
|
||||
* -Oa argument supports more alignment settings that can be specified
|
||||
per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
|
||||
|
||||
@ -297,7 +297,7 @@ implementation
|
||||
{$ifdef m68k}
|
||||
if target_info.target<>target_m68k_PalmOS then
|
||||
begin
|
||||
dataSegment.concat(Tai_symbol.Createdataname_global('HEAP_SIZE',0));
|
||||
dataSegment.concat(Tai_symbol.Createdataname_global('HEAPSIZE',4));
|
||||
dataSegment.concat(Tai_const.Create_32bit(heapsize));
|
||||
end;
|
||||
{$else m68k}
|
||||
@ -1335,7 +1335,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.37 2001-06-18 20:36:25 peter
|
||||
Revision 1.38 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.37 2001/06/18 20:36:25 peter
|
||||
* -Ur switch (merged)
|
||||
* masm fixes (merged)
|
||||
* quoted filenames for go32v2 and win32
|
||||
|
||||
@ -247,11 +247,16 @@ begin
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
s32floattype.setdef(tfloatdef.create(s32real));
|
||||
s64floattype.setdef(tfloatdef.create(s32real));
|
||||
if (cs_fp_emulation in aktmoduleswitches) then
|
||||
s80floattype.setdef(tfloatdef.create(s32real)))
|
||||
begin
|
||||
s64floattype.setdef(tfloatdef.create(s32real));
|
||||
s80floattype.setdef(tfloatdef.create(s32real)))
|
||||
end
|
||||
else
|
||||
s80floattype.setdef(tfloatdef.create(s80real));
|
||||
begin
|
||||
s64floattype.setdef(tfloatdef.create(s64real));
|
||||
s80floattype.setdef(tfloatdef.create(s80real));
|
||||
end;
|
||||
{$endif}
|
||||
{ some other definitions }
|
||||
voidpointertype.setdef(tpointerdef.create(voidtype));
|
||||
@ -266,7 +271,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.17 2001-07-09 21:15:41 peter
|
||||
Revision 1.18 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.17 2001/07/09 21:15:41 peter
|
||||
* Length made internal
|
||||
* Add array support for Length
|
||||
|
||||
|
||||
@ -70,6 +70,7 @@ implementation
|
||||
curconstsegment : TAAsmoutput;
|
||||
ll : tasmlabel;
|
||||
s : string;
|
||||
c : char;
|
||||
ca : pchar;
|
||||
tmpguid : tguid;
|
||||
aktpos : longint;
|
||||
@ -370,15 +371,14 @@ implementation
|
||||
{ untrue - because they are considered }
|
||||
{ arrays of 32-bit values CEC }
|
||||
|
||||
{ store as longint values in little-endian format }
|
||||
if target_info.endian = endian_little then
|
||||
if source_info.endian = target_info.endian then
|
||||
begin
|
||||
for l:= 0 to p.resulttype.def.size-1 do
|
||||
curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[l]));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ store as longint values in big-endian format }
|
||||
{ store as longint values in swaped format }
|
||||
j:=0;
|
||||
for l:=0 to ((p.resulttype.def.size-1) div 4) do
|
||||
begin
|
||||
@ -430,7 +430,10 @@ implementation
|
||||
end
|
||||
else if is_constcharnode(p) then
|
||||
begin
|
||||
strval:=pchar(@tordconstnode(p).value);
|
||||
{ strval:=pchar(@tordconstnode(p).value);
|
||||
THIS FAIL on BIG_ENDIAN MACHINES PM }
|
||||
c:=chr(tordconstnode(p).value and $ff);
|
||||
strval:=@c;
|
||||
strlength:=1
|
||||
end
|
||||
else if is_constresourcestringnode(p) then
|
||||
@ -560,7 +563,8 @@ implementation
|
||||
else
|
||||
if is_constcharnode(p) then
|
||||
begin
|
||||
ca:=pchar(@tordconstnode(p).value);
|
||||
c:=chr(tordconstnode(p).value and $ff);
|
||||
ca:=@c;
|
||||
len:=1;
|
||||
end
|
||||
else
|
||||
@ -885,7 +889,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.27 2001-07-08 21:00:15 peter
|
||||
Revision 1.28 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.27 2001/07/08 21:00:15 peter
|
||||
* various widestring updates, it works now mostly without charset
|
||||
mapping supported
|
||||
|
||||
|
||||
@ -1356,7 +1356,10 @@ implementation
|
||||
if t.is_conditional then
|
||||
handleconditional(t)
|
||||
else
|
||||
t.proc{$ifdef FPCPROCVAR}(){$endif};
|
||||
begin
|
||||
Message1(scan_d_handling_switch,'$'+hs);
|
||||
t.proc{$ifdef FPCPROCVAR}(){$endif};
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -2599,7 +2602,10 @@ exit_label:
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 2001-07-15 11:56:21 peter
|
||||
Revision 1.21 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.20 2001/07/15 11:56:21 peter
|
||||
* merged fixed relative path fix
|
||||
|
||||
Revision 1.19 2001/07/08 21:00:16 peter
|
||||
|
||||
@ -44,10 +44,37 @@ type
|
||||
end;
|
||||
|
||||
TAsmScript = class (TScript)
|
||||
Constructor Create(Const ScriptName : String);
|
||||
Procedure AddAsmCommand (Const Command, Options,FileName : String);
|
||||
Procedure AddLinkCommand (Const Command, Options, FileName : String);
|
||||
Procedure AddDeleteCommand (Const FileName : String);
|
||||
Constructor Create(Const ScriptName : String); virtual;
|
||||
Procedure AddAsmCommand (Const Command, Options,FileName : String);virtual;abstract;
|
||||
Procedure AddLinkCommand (Const Command, Options, FileName : String);virtual;abstract;
|
||||
Procedure AddDeleteCommand (Const FileName : String);virtual;abstract;
|
||||
Procedure AddDeleteDirCommand (Const FileName : String);virtual;abstract;
|
||||
end;
|
||||
|
||||
TAsmScriptDos = class (TAsmScript)
|
||||
Constructor Create (Const ScriptName : String); override;
|
||||
Procedure AddAsmCommand (Const Command, Options,FileName : String);override;
|
||||
Procedure AddLinkCommand (Const Command, Options, FileName : String);override;
|
||||
Procedure AddDeleteCommand (Const FileName : String);override;
|
||||
Procedure AddDeleteDirCommand (Const FileName : String);override;
|
||||
Procedure WriteToDisk;override;
|
||||
end;
|
||||
|
||||
TAsmScriptAmiga = class (TAsmScript)
|
||||
Constructor Create (Const ScriptName : String); override;
|
||||
Procedure AddAsmCommand (Const Command, Options,FileName : String);override;
|
||||
Procedure AddLinkCommand (Const Command, Options, FileName : String);override;
|
||||
Procedure AddDeleteCommand (Const FileName : String);override;
|
||||
Procedure AddDeleteDirCommand (Const FileName : String);override;
|
||||
Procedure WriteToDisk;override;
|
||||
end;
|
||||
|
||||
TAsmScriptUnix = class (TAsmScript)
|
||||
Constructor Create (Const ScriptName : String);override;
|
||||
Procedure AddAsmCommand (Const Command, Options,FileName : String);override;
|
||||
Procedure AddLinkCommand (Const Command, Options, FileName : String);override;
|
||||
Procedure AddDeleteCommand (Const FileName : String);override;
|
||||
Procedure AddDeleteDirCommand (Const FileName : String);override;
|
||||
Procedure WriteToDisk;override;
|
||||
end;
|
||||
|
||||
@ -59,6 +86,8 @@ type
|
||||
var
|
||||
AsmRes : TAsmScript;
|
||||
|
||||
Procedure GenerateAsmRes(const st : string);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
@ -87,7 +116,7 @@ end;
|
||||
|
||||
constructor TScript.CreateExec(const s:string);
|
||||
begin
|
||||
fn:=FixFileName(s)+source_info.scriptext;
|
||||
fn:=FixFileName(s)+target_info.scriptext;
|
||||
executable:=true;
|
||||
data:=TStringList.Create;
|
||||
end;
|
||||
@ -143,14 +172,18 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScript.AddAsmCommand (Const Command, Options,FileName : String);
|
||||
{****************************************************************************
|
||||
Asm Response
|
||||
****************************************************************************}
|
||||
|
||||
Constructor TAsmScriptDos.Create (Const ScriptName : String);
|
||||
begin
|
||||
Inherited Create(ScriptName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptDos.AddAsmCommand (Const Command, Options,FileName : String);
|
||||
begin
|
||||
{$ifdef Unix}
|
||||
if FileName<>'' then
|
||||
Add('echo Assembling '+FileName);
|
||||
Add (Command+' '+Options);
|
||||
Add('if [ $? != 0 ]; then DoExitAsm '+FileName+'; fi');
|
||||
{$else}
|
||||
if FileName<>'' then
|
||||
begin
|
||||
Add('SET THEFILE='+FileName);
|
||||
@ -158,18 +191,11 @@ begin
|
||||
end;
|
||||
Add(command+' '+Options);
|
||||
Add('if errorlevel 1 goto asmend');
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
Procedure TasmScript.AddLinkCommand (Const Command, Options, FileName : String);
|
||||
Procedure TAsmScriptDos.AddLinkCommand (Const Command, Options, FileName : String);
|
||||
begin
|
||||
{$ifdef Unix}
|
||||
if FileName<>'' then
|
||||
Add('echo Linking '+FileName);
|
||||
Add (Command+' '+Options);
|
||||
Add('if [ $? != 0 ]; then DoExitLink '+FileName+'; fi');
|
||||
{$else}
|
||||
if FileName<>'' then
|
||||
begin
|
||||
Add('SET THEFILE='+FileName);
|
||||
@ -177,29 +203,23 @@ begin
|
||||
end;
|
||||
Add (Command+' '+Options);
|
||||
Add('if errorlevel 1 goto linkend');
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScript.AddDeleteCommand (Const FileName : String);
|
||||
Procedure TAsmScriptDos.AddDeleteCommand (Const FileName : String);
|
||||
begin
|
||||
{$ifdef Unix}
|
||||
Add('rm '+FileName);
|
||||
{$else}
|
||||
Add('Del '+FileName);
|
||||
{$endif}
|
||||
Add('Del '+FileName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScript.WriteToDisk;
|
||||
Procedure TAsmScriptDos.AddDeleteDirCommand (Const FileName : String);
|
||||
begin
|
||||
Add('Rmdir '+FileName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptDos.WriteToDisk;
|
||||
Begin
|
||||
{$ifdef Unix}
|
||||
AddStart('{ echo "An error occurred while linking $1"; exit 1; }');
|
||||
AddStart('DoExitLink ()');
|
||||
AddStart('{ echo "An error occurred while assembling $1"; exit 1; }');
|
||||
AddStart('DoExitAsm ()');
|
||||
AddStart('#!/bin/sh');
|
||||
{$else}
|
||||
AddStart('@echo off');
|
||||
Add('goto end');
|
||||
Add(':asmend');
|
||||
@ -208,10 +228,151 @@ Begin
|
||||
Add(':linkend');
|
||||
Add('echo An error occured while linking %THEFILE%');
|
||||
Add(':end');
|
||||
{$endif}
|
||||
inherited WriteToDisk;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
Amiga Asm Response
|
||||
****************************************************************************}
|
||||
|
||||
Constructor TAsmScriptAmiga.Create (Const ScriptName : String);
|
||||
begin
|
||||
Inherited Create(ScriptName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptAmiga.AddAsmCommand (Const Command, Options,FileName : String);
|
||||
begin
|
||||
if FileName<>'' then
|
||||
begin
|
||||
Add('SET THEFILE '+FileName);
|
||||
Add('echo Assembling $THEFILE');
|
||||
end;
|
||||
Add(command+' '+Options);
|
||||
Add('if error');
|
||||
Add('skip asmend');
|
||||
Add('endif');
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptAmiga.AddLinkCommand (Const Command, Options, FileName : String);
|
||||
begin
|
||||
if FileName<>'' then
|
||||
begin
|
||||
Add('SET THEFILE '+FileName);
|
||||
Add('echo Linking $THEFILE');
|
||||
end;
|
||||
Add (Command+' '+Options);
|
||||
Add('if error');
|
||||
Add('skip linkend');
|
||||
Add('endif');
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptAmiga.AddDeleteCommand (Const FileName : String);
|
||||
begin
|
||||
Add('Delete '+FileName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptAmiga.AddDeleteDirCommand (Const FileName : String);
|
||||
begin
|
||||
Add('Delete '+FileName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptAmiga.WriteToDisk;
|
||||
Begin
|
||||
Add('skip end');
|
||||
Add('lab asmend');
|
||||
Add('echo An error occured while assembling $THEFILE');
|
||||
Add('skip end');
|
||||
Add('lab linkend');
|
||||
Add('echo An error occured while linking $THEFILE');
|
||||
Add('lab end');
|
||||
inherited WriteToDisk;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Unix Asm Response
|
||||
****************************************************************************}
|
||||
|
||||
Constructor TAsmScriptUnix.Create (Const ScriptName : String);
|
||||
begin
|
||||
Inherited Create(ScriptName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptUnix.AddAsmCommand (Const Command, Options,FileName : String);
|
||||
begin
|
||||
if FileName<>'' then
|
||||
Add('echo Assembling '+FileName);
|
||||
Add (Command+' '+Options);
|
||||
Add('if [ $? != 0 ]; then DoExitAsm '+FileName+'; fi');
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptUnix.AddLinkCommand (Const Command, Options, FileName : String);
|
||||
begin
|
||||
if FileName<>'' then
|
||||
Add('echo Linking '+FileName);
|
||||
Add (Command+' '+Options);
|
||||
Add('if [ $? != 0 ]; then DoExitLink '+FileName+'; fi');
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptUnix.AddDeleteCommand (Const FileName : String);
|
||||
begin
|
||||
Add('rm '+FileName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptUnix.AddDeleteDirCommand (Const FileName : String);
|
||||
begin
|
||||
Add('rmdir '+FileName);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmScriptUnix.WriteToDisk;
|
||||
Begin
|
||||
AddStart('{ echo "An error occurred while linking $1"; exit 1; }');
|
||||
AddStart('DoExitLink ()');
|
||||
AddStart('{ echo "An error occurred while assembling $1"; exit 1; }');
|
||||
AddStart('DoExitAsm ()');
|
||||
AddStart('#!/bin/sh');
|
||||
inherited WriteToDisk;
|
||||
end;
|
||||
|
||||
|
||||
Procedure GenerateAsmRes(const st : string);
|
||||
begin
|
||||
{$ifdef i386}
|
||||
case target_info.target of
|
||||
target_i386_linux,
|
||||
target_i386_freebsd,
|
||||
target_i386_sunos,
|
||||
target_i386_beos :
|
||||
AsmRes:=TAsmScriptUnix.Create(st);
|
||||
else
|
||||
AsmRes:=TAsmScriptDos.Create(st);
|
||||
end;
|
||||
{$else not i386}
|
||||
{$ifdef m68k}
|
||||
case target_info.target of
|
||||
target_m68k_amiga :
|
||||
AsmRes:=TAsmScriptAmiga.Create(st);
|
||||
target_m68k_linux :
|
||||
AsmRes:=TAsmScriptUnix.Create(st);
|
||||
else
|
||||
AsmRes:=TAsmScriptDos.Create(st);
|
||||
end;
|
||||
{$else not m68k}
|
||||
AsmRes:=TAsmScriptUnix.Create(st);
|
||||
{$endif not m68k}
|
||||
{$endif not i386}
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Link Response
|
||||
@ -237,7 +398,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 2001-07-10 21:01:35 peter
|
||||
Revision 1.11 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.10 2001/07/10 21:01:35 peter
|
||||
* fixed crash with writing of the linker script
|
||||
|
||||
Revision 1.9 2001/04/18 22:01:58 peter
|
||||
|
||||
@ -684,7 +684,7 @@ interface
|
||||
pbestrealtype : ^ttype = @s80floattype;
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
pbestrealtype : ^ttype = @s32floattype;
|
||||
pbestrealtype : ^ttype = @s64floattype;
|
||||
{$endif}
|
||||
{$ifdef alpha}
|
||||
pbestrealtype : ^ttype = @s64floattype;
|
||||
@ -1930,11 +1930,9 @@ implementation
|
||||
{ found this solution in stabsread.c from GDB v4.16 }
|
||||
s64comp : stabstring := strpnew('r'+
|
||||
tstoreddef(s32bittype.def).numberstring+';-'+tostr(savesize)+';0;');
|
||||
{$ifdef i386}
|
||||
{ under dos at least you must give a size of twelve instead of 10 !! }
|
||||
{ this is probably do to the fact that in gcc all is pushed in 4 bytes size }
|
||||
s80real : stabstring := strpnew('r'+tstoreddef(s32bittype.def).numberstring+';12;0;');
|
||||
{$endif i386}
|
||||
else
|
||||
internalerror(10005);
|
||||
end;
|
||||
@ -5525,7 +5523,10 @@ Const local_symtable_index : longint = $8001;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.37 2001-07-30 11:52:57 jonas
|
||||
Revision 1.38 2001-07-30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.37 2001/07/30 11:52:57 jonas
|
||||
* fixed web bugs 1563/1564: procvars of object can't be regvars (merged)
|
||||
|
||||
Revision 1.36 2001/07/01 20:16:16 peter
|
||||
|
||||
@ -460,19 +460,24 @@ procedure create_tokenidx;
|
||||
length, so a search only will be done in that small part }
|
||||
var
|
||||
t : ttoken;
|
||||
i : longint;
|
||||
c : char;
|
||||
begin
|
||||
fillchar(tokenidx^,sizeof(tokenidx^),0);
|
||||
for t:=low(ttoken) to high(ttoken) do
|
||||
begin
|
||||
if not arraytokeninfo[t].special then
|
||||
begin
|
||||
if ord(tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].first)=0 then
|
||||
tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].first:=t;
|
||||
tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].last:=t;
|
||||
i:=length(arraytokeninfo[t].str);
|
||||
c:=arraytokeninfo[t].str[1];
|
||||
if ord(tokenidx^[i,c].first)=0 then
|
||||
tokenidx^[i,c].first:=t;
|
||||
tokenidx^[i,c].last:=t;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure inittokens;
|
||||
begin
|
||||
tokeninfo:=@arraytokeninfo;
|
||||
@ -490,7 +495,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 2001-06-03 21:57:38 peter
|
||||
Revision 1.12 2001-07-30 20:59:28 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.11 2001/06/03 21:57:38 peter
|
||||
+ hint directive parsing support
|
||||
|
||||
Revision 1.10 2001/05/06 17:12:43 jonas
|
||||
|
||||
Loading…
Reference in New Issue
Block a user