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

* some fixes, does not yet compile

Browse Source
This commit is contained in:
Jonas Maebe 2000-05-01 11:03:32 +00:00
parent 6e996c65e5
commit 44845ec919
2 changed files with 95 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
compiler/new/agatt.pas
View File

@ -26,7 +26,7 @@ unit agatt;
interface interface
uses uses
globals,systems,errors,cobjects,aasm,strings,files,assemble globals,systems,{errors,}cobjects,aasm,strings,files,assemble,cpuasm
{$ifdef GDB} {$ifdef GDB}
,gdb ,gdb
{$endif GDB} {$endif GDB}
@ -69,13 +69,13 @@ unit agatt;
Abstract Abstract
end; end;
Procedure tattasmlist.WriteInstruction (P : paicpu); virtual; Procedure tattasmlist.WriteInstruction (P : paicpu);
Begin Begin
Abstract Abstract
End; End;
function tattamslist.getopstr(const o:toper) : string; function tattasmlist.getopstr(const o:toper) : string;
var var
hs : string; hs : string;
begin begin
@ -103,7 +103,14 @@ unit agatt;
getopstr:=hs; getopstr:=hs;
end; end;
else else
{$ifndef testing}
internalerror(10001); internalerror(10001);
{$else testing}
begin
writeln('internalerror 10001');
halt(1);
end;
{$endif testing}
end; end;
end; end;
@ -524,7 +531,14 @@ unit agatt;
; ;
else else
{$ifndef testing}
internalerror(10000); internalerror(10000);
{$else testing}
begin
writeln('internalerror 10001');
halt(1);
end;
{$endif testing}
end; end;
hp:=pai(hp^.next); hp:=pai(hp^.next);
end; end;
@ -606,7 +620,10 @@ unit agatt;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2000-01-07 01:14:50 peter Revision 1.4 2000-05-01 11:03:32 jonas
* some fixes, does not yet compile
Revision 1.3 2000/01/07 01:14:50 peter
* updated copyright to 2000 * updated copyright to 2000
Revision 1.2 1999/09/03 13:08:36 jonas Revision 1.2 1999/09/03 13:08:36 jonas

116
compiler/new/powerpc/agas.pas
View File

@ -25,7 +25,8 @@ unit agas;
interface interface
uses uses
cpubase,dos,globals,systems,errors,cobjects,aasm,strings,files cpubase,dos,globals,systems,{errors,}cobjects,aasm,strings,files,
agatt
{$ifdef GDB} {$ifdef GDB}
,gdb ,gdb
{$endif GDB} {$endif GDB}
@ -33,12 +34,12 @@ unit agas;
type type
paicpuattasmlist=^taicpuattasmlist; paicpuattasmlist=^taicpuattasmlist;
taicpuattasmlist=object(tasmlist) taicpuattasmlist=object(tattasmlist)
function getreferencestring(var ref : treference) : string; Virtual; function getreferencestring(var ref : treference) : string; Virtual;
function getopstr_jmp(const o:toper) : string; Virtual; function getopstr_jmp(const o:toper) : string; Virtual;
procedure WriteInstruction (P : Pai); virtual; procedure WriteInstruction (HP : Pai); virtual;
procedure cond2str(op: tasnop; c: tasmcond): string; function cond2str(op: tasmop; c: tasmcond): string;
{ to construct the output for conditional branches } { to construct the output for conditional branches }
function branchmode(o: tasmop): string[4]; function branchmode(o: tasmop): string[4];
@ -47,43 +48,45 @@ unit agas;
implementation implementation
uses cpuasm;
const const
att_op2str : array[tasmop] of string[14] = ('<none>', att_op2str : array[tasmop] of string[14] = ('<none>',
'add','add.','addo','addo.','addc','addc.','addco','addco., 'add','add.','addo','addo.','addc','addc.','addco','addco.',
'adde','adde.','addeo','addeo.','addi','addic','addic.','addis, 'adde','adde.','addeo','addeo.','addi','addic','addic.','addis',
'addme','addme.','addmeo','addmeo.','addze','addze.','addzeo, 'addme','addme.','addmeo','addmeo.','addze','addze.','addzeo',
'addzeo.','and','and.','andc','andc.','andi.','andis.','b, 'addzeo.','and','and.','andc','andc.','andi.','andis.','b',
'ba','bl','bla','bc','bca','bcl','bcla','bcctr','bcctrl','bclr, 'ba','bl','bla','bc','bca','bcl','bcla','bcctr','bcctrl','bclr',
'bclrl','cmp','cmpi','cmpl','cmpli','cntlzw','cntlzw.','crand, 'bclrl','cmp','cmpi','cmpl','cmpli','cntlzw','cntlzw.','crand',
'crandc','creqv','crnand','crnor','cror','crorc','crxor','dcba, 'crandc','creqv','crnand','crnor','cror','crorc','crxor','dcba',
'dcbf','dcbi','dcbst','dcbt','divw','divw.','divwo','divwo., 'dcbf','dcbi','dcbst','dcbt','divw','divw.','divwo','divwo.',
'divwu','divwu.','divwuo','divwuo.','eciwx','ecowx','eieio','eqv, 'divwu','divwu.','divwuo','divwuo.','eciwx','ecowx','eieio','eqv',
'eqv.','extsb','extsb.','extsh','extsh.','fabs','fabs.','fadd, 'eqv.','extsb','extsb.','extsh','extsh.','fabs','fabs.','fadd',
'fadd.','fadds','fadds.','fcompo','fcmpu','fctiw','fctw.','fctwz, 'fadd.','fadds','fadds.','fcompo','fcmpu','fctiw','fctw.','fctwz',
'fctwz.','fdiv','fdiv.','fdivs','fdivs.','fmadd','fmadd.','fmadds, 'fctwz.','fdiv','fdiv.','fdivs','fdivs.','fmadd','fmadd.','fmadds',
'fmadds.','fmr','fmsub','fmsub.','fmsubs','fmsubs.','fmul','fmul., 'fmadds.','fmr','fmsub','fmsub.','fmsubs','fmsubs.','fmul','fmul.',
'fmuls','fmuls.','fnabs','fnabs.','fneg','fneg.','fnmadd, 'fmuls','fmuls.','fnabs','fnabs.','fneg','fneg.','fnmadd',
'fnmadd.','fnmadds','fnmadds.','fnmsub','fnmsub.','fnmsubs, 'fnmadd.','fnmadds','fnmadds.','fnmsub','fnmsub.','fnmsubs',
'fnmsubs.','fres','fres.','frsp','frsp.','frsqrte','frsqrte., 'fnmsubs.','fres','fres.','frsp','frsp.','frsqrte','frsqrte.',
'fsel','fsel.','fsqrt','fsqrt.','fsqrts','fsqrts.','fsub','fsub., 'fsel','fsel.','fsqrt','fsqrt.','fsqrts','fsqrts.','fsub','fsub.',
'fsubs','fsubs.','icbi','isync','lbz','lbzu','lbzux','lbzx, 'fsubs','fsubs.','icbi','isync','lbz','lbzu','lbzux','lbzx',
'lfd','lfdu','lfdux','lfdx','lfs','lfsu','lfsux','lfsx','lha, 'lfd','lfdu','lfdux','lfdx','lfs','lfsu','lfsux','lfsx','lha',
'lhau','lhaux','lhax','hbrx','lhz','lhzu','lhzux','lhzx','lmw, 'lhau','lhaux','lhax','hbrx','lhz','lhzu','lhzux','lhzx','lmw',
'lswi','lswx','lwarx','lwbrx','lwz','lwzu','lwzux','lwzx','mcrf, 'lswi','lswx','lwarx','lwbrx','lwz','lwzu','lwzux','lwzx','mcrf',
'mcrfs','lcrxe','mfcr','mffs','maffs.','mfmsr','mfspr','mfsr, 'mcrfs','lcrxe','mfcr','mffs','maffs.','mfmsr','mfspr','mfsr',
'mfsrin','mftb','mtfcrf','mtfd0','mtfsb1','mtfsf','mtfsf., 'mfsrin','mftb','mtfcrf','mtfd0','mtfsb1','mtfsf','mtfsf.',
'mtfsfi','mtfsfi.','mtmsr','mtspr','mtsr','mtsrin','mulhw, 'mtfsfi','mtfsfi.','mtmsr','mtspr','mtsr','mtsrin','mulhw',
'mulhw.','mulhwu','mulhwu.','mulli','mullh','mullw.','mullwo, 'mulhw.','mulhwu','mulhwu.','mulli','mullh','mullw.','mullwo',
'mullwo.','nand','nand.','neg','neg.','nego','nego.','nor','nor., 'mullwo.','nand','nand.','neg','neg.','nego','nego.','nor','nor.',
'or','or.','orc','orc.','ori','oris', 'rfi', 'rlwimi', 'rlwimi.', 'or','or.','orc','orc.','ori','oris', 'rfi', 'rlwimi', 'rlwimi.',
'rlwinm', 'tlwinm.','rlwnm','sc','slw', 'slw.', 'sraw', 'sraw., 'rlwinm', 'tlwinm.','rlwnm','sc','slw', 'slw.', 'sraw', 'sraw.',
'srawi', 'srawi.','srw', 'srw.', 'stb', 'stbu', 'stbux','stbx','stfd', 'srawi', 'srawi.','srw', 'srw.', 'stb', 'stbu', 'stbux','stbx','stfd',
'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx', 'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx',
'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw', 'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw',
'stwbrx', 'stwx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo', 'stwbrx', 'stwx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo',
'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.', 'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.',
'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo., 'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo.',
'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie, 'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie',
'tlbsync', 'tw', 'twi', 'xor', 'xor.', 'xori', 'xoris', 'tlbsync', 'tw', 'twi', 'xor', 'xor.', 'xori', 'xoris',
{ some simplified mnemonics } { some simplified mnemonics }
'subi', 'subis', 'subic', 'subic.', 'sub', 'sub.', 'subo', 'subo.', 'subi', 'subis', 'subic', 'subic.', 'sub', 'sub.', 'subo', 'subo.',
@ -92,7 +95,7 @@ unit agas;
'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.', 'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.',
'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi', 'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi',
'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove', 'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove',
'crnot', 'mt', 'mf','nop', 'li', 'la', 'mr','not', 'mtcr'); 'crnot', 'mt', 'mf','nop', 'li', 'lis', 'la', 'mr','not', 'mtcr');
function taicpuattasmlist.getreferencestring(var ref : treference) : string; function taicpuattasmlist.getreferencestring(var ref : treference) : string;
var var
@ -100,8 +103,13 @@ unit agas;
begin begin
if ref.is_immediate then if ref.is_immediate then
begin begin
{$ifndef testing}
internalerror(1000101); internalerror(1000101);
exit; exit;
{$else testing}
writeln('internalerror 1000101');
halt(1);
{$endif testing}
end end
else else
begin begin
@ -109,7 +117,14 @@ unit agas;
begin begin
inc(offset,offsetfixup); inc(offset,offsetfixup);
if (offset < -32768) or (offset > 32767) then if (offset < -32768) or (offset > 32767) then
{$ifndef testing}
internalerror(19991); internalerror(19991);
{$else testing}
begin
writeln('internalerror 19991');
halt(1);
end;
{$endif testing}
s:=''; s:='';
if assigned(symbol) then if assigned(symbol) then
s:=s+symbol^.name + symaddr2str[symaddr]; s:=s+symbol^.name + symaddr2str[symaddr];
@ -127,8 +142,15 @@ unit agas;
s:=s+'('+att_reg2str[base]+')' s:=s+'('+att_reg2str[base]+')'
else if (index<>R_NO) and (base<>R_NO) and (offset = 0) then else if (index<>R_NO) and (base<>R_NO) and (offset = 0) then
s:=s+att_reg2str[base]+','+att_reg2str[index] s:=s+att_reg2str[base]+','+att_reg2str[index]
else if (index<>R_NO) or (base<>R_NO)) then else if ((index<>R_NO) or (base<>R_NO)) then
internalerror(19992); {$ifndef testing}
internalerror(19992);
{$else testing}
begin
writeln('internalerror 19992');
halt(1);
end;
{$endif testing}
end; end;
end; end;
getreferencestring:=s; getreferencestring:=s;
@ -155,26 +177,33 @@ unit agas;
getopstr_jmp:=hs; getopstr_jmp:=hs;
end; end;
else else
{$ifndef testing}
internalerror(10001); internalerror(10001);
{$else testing}
begin
writeln('internalerror 10001');
halt(1);
end;
{$endif testing}
end; end;
end; end;
Procedure taicpuattasmlist.WriteInstruction (P : Pai); Procedure taicpuattasmlist.WriteInstruction (HP : Pai);
var op: TAsmOp; var op: TAsmOp;
s: string; s: string;
i: byte; i: byte;
sep: string[3];
begin begin
op:=paicpu(hp)^.opcode; op:=paicpu(hp)^.opcode;
if not is_calljmp(o) then if is_calljmp(op) then
s:=#9+att_op2str[op];
else
{ direct BO/BI in op[0] and op[1] not supported, put them in condition! } { direct BO/BI in op[0] and op[1] not supported, put them in condition! }
s:=s+cond2str(op,paicpu(hp)^.condition)+ s:=s+cond2str(op,paicpu(hp)^.condition)+
getopstr_jmp(paicpu(hp)^.oper[0]) getopstr_jmp(paicpu(hp)^.oper[0])
else else
{ process operands } { process operands }
begin begin
s:=#9+att_op2str[op];
if paicpu(hp)^.ops<>0 then if paicpu(hp)^.ops<>0 then
begin begin
if not is_calljmp(op) then if not is_calljmp(op) then
@ -190,7 +219,7 @@ unit agas;
AsmWriteLn(s); AsmWriteLn(s);
end; end;
procedure taicpuattasmlist.cond2str(op: tasmop; c: tasmcond): string; function taicpuattasmlist.cond2str(op: tasmop; c: tasmcond): string;
{ note: no checking is performed whether the given combination of } { note: no checking is performed whether the given combination of }
{ conditions is valid } { conditions is valid }
var tempstr: sintrg; var tempstr: sintrg;
@ -244,7 +273,10 @@ unit agas;
end. end.
{ {
$Log$ $Log$
Revision 1.5 2000-03-26 16:37:36 jonas Revision 1.6 2000-05-01 11:03:32 jonas
* some fixes, does not yet compile
Revision 1.5 2000/03/26 16:37:36 jonas
+ use cpubase unit + use cpubase unit
- removed use of alpha unit - removed use of alpha unit