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

Merge branch 'main' into basemath

Browse Source
This commit is contained in:
florian 2024-07-16 22:49:39 +02:00
commit f6190e1a07
3 changed files with 146 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
compiler/wasm32/cpupi.pas
View File

@ -475,7 +475,8 @@ implementation
procedure tcpuprocinfo.generate_exit_label(list: tasmlist); procedure tcpuprocinfo.generate_exit_label(list: tasmlist);
begin begin
list.concat(taicpu.op_none(a_end_block)); if not (po_assembler in current_procinfo.procdef.procoptions) then
list.concat(taicpu.op_none(a_end_block));
inherited generate_exit_label(list); inherited generate_exit_label(list);
end; end;
@ -984,6 +985,8 @@ implementation
localslist: TAsmList; localslist: TAsmList;
labels_resolved, has_goto: Boolean; labels_resolved, has_goto: Boolean;
begin begin
if po_assembler in procdef.procoptions then
exit;
check_goto_br_instructions(aktproccode,has_goto); check_goto_br_instructions(aktproccode,has_goto);
localslist:=prepare_locals; localslist:=prepare_locals;

83
compiler/wasm32/hlcgcpu.pas
View File

@ -2051,31 +2051,35 @@ implementation
pd:=tcpuprocdef(current_procinfo.procdef); pd:=tcpuprocdef(current_procinfo.procdef);
g_procdef(list,pd); g_procdef(list,pd);
ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref); if not nostackframe then
if pd.base_pointer_ref.base<>NR_LOCAL_STACK_POINTER_REG then begin
ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref);
g_fingerprint(list); ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref);
if pd.base_pointer_ref.base<>NR_LOCAL_STACK_POINTER_REG then
ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref);
list.Concat(taicpu.op_sym(a_global_get,RefStackPointerSym)); g_fingerprint(list);
incstack(list,1);
list.Concat(taicpu.op_ref(a_local_set,pd.base_pointer_ref));
decstack(list,1);
if (localsize>0) then begin list.Concat(taicpu.op_sym(a_global_get,RefStackPointerSym));
list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref)); incstack(list,1);
incstack(list,1); list.Concat(taicpu.op_ref(a_local_set,pd.base_pointer_ref));
list.concat(taicpu.op_const(a_i32_const, localsize )); decstack(list,1);
incstack(list,1);
list.concat(taicpu.op_none(a_i32_sub)); if (localsize>0) then begin
decstack(list,1); list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
list.Concat(taicpu.op_ref(a_local_set,pd.frame_pointer_ref)); incstack(list,1);
decstack(list,1); list.concat(taicpu.op_const(a_i32_const, localsize ));
list.Concat(taicpu.op_ref(a_local_get,pd.frame_pointer_ref)); incstack(list,1);
incstack(list,1); list.concat(taicpu.op_none(a_i32_sub));
list.Concat(taicpu.op_sym(a_global_set,RefStackPointerSym)); decstack(list,1);
decstack(list,1); list.Concat(taicpu.op_ref(a_local_set,pd.frame_pointer_ref));
end; decstack(list,1);
list.Concat(taicpu.op_ref(a_local_get,pd.frame_pointer_ref));
incstack(list,1);
list.Concat(taicpu.op_sym(a_global_set,RefStackPointerSym));
decstack(list,1);
end;
end;
end; end;
procedure thlcgwasm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean); procedure thlcgwasm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
@ -2083,12 +2087,15 @@ implementation
pd: tcpuprocdef; pd: tcpuprocdef;
begin begin
pd:=tcpuprocdef(current_procinfo.procdef); pd:=tcpuprocdef(current_procinfo.procdef);
list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref)); if not nostackframe then
incstack(list,1); begin
list.Concat(taicpu.op_sym(a_global_set,RefStackPointerSym)); list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
decstack(list,1); incstack(list,1);
list.Concat(taicpu.op_sym(a_global_set,RefStackPointerSym));
decstack(list,1);
list.concat(taicpu.op_none(a_return)); list.concat(taicpu.op_none(a_return));
end;
list.concat(taicpu.op_none(a_end_function)); list.concat(taicpu.op_none(a_end_function));
end; end;
@ -2336,21 +2343,27 @@ implementation
procedure thlcgwasm.gen_entry_code(list: TAsmList); procedure thlcgwasm.gen_entry_code(list: TAsmList);
begin begin
inherited; inherited;
list.concat(taicpu.op_none(a_block)); if not (po_assembler in current_procinfo.procdef.procoptions) then
list.concat(taicpu.op_none(a_block)); begin
list.concat(taicpu.op_none(a_block));
list.concat(taicpu.op_none(a_block));
end;
end; end;
procedure thlcgwasm.gen_exit_code(list: TAsmList); procedure thlcgwasm.gen_exit_code(list: TAsmList);
begin begin
list.concat(taicpu.op_none(a_end_block)); if not (po_assembler in current_procinfo.procdef.procoptions) then
if ts_wasm_bf_exceptions in current_settings.targetswitches then begin
a_label(list,tcpuprocinfo(current_procinfo).CurrRaiseLabel); list.concat(taicpu.op_none(a_end_block));
if fevalstackheight<>0 then if ts_wasm_bf_exceptions in current_settings.targetswitches then
a_label(list,tcpuprocinfo(current_procinfo).CurrRaiseLabel);
if fevalstackheight<>0 then
{$ifdef DEBUG_WASMSTACK} {$ifdef DEBUG_WASMSTACK}
list.concat(tai_comment.Create(strpnew('!!! values remaining on stack at end of block !!!'))); list.concat(tai_comment.Create(strpnew('!!! values remaining on stack at end of block !!!')));
{$else DEBUG_WASMSTACK} {$else DEBUG_WASMSTACK}
internalerror(2021091801); internalerror(2021091801);
{$endif DEBUG_WASMSTACK} {$endif DEBUG_WASMSTACK}
end;
inherited; inherited;
end; end;

101
compiler/wasm32/rawasmtext.pas
View File

@ -64,7 +64,7 @@ Unit rawasmtext;
procedure HandleInstruction; procedure HandleInstruction;
procedure HandleFoldedInstruction; procedure HandleFoldedInstruction;
function HandlePlainInstruction: TWasmInstruction; function HandlePlainInstruction: TWasmInstruction;
procedure HandleBlockInstruction;virtual;abstract; procedure HandleBlockInstruction;
public public
function Assemble: tlinkedlist;override; function Assemble: tlinkedlist;override;
end; end;
@ -543,6 +543,8 @@ Unit rawasmtext;
procedure twasmreader.HandleInstruction; procedure twasmreader.HandleInstruction;
var
instr: TWasmInstruction;
begin begin
case actasmtoken of case actasmtoken of
AS_LPAREN: AS_LPAREN:
@ -558,11 +560,14 @@ Unit rawasmtext;
a_if: a_if:
HandleBlockInstruction; HandleBlockInstruction;
else else
HandlePlainInstruction; begin
instr:=HandlePlainInstruction;
instr.ConcatInstruction(curlist);
end;
end; end;
end; end;
else else
{error}; internalerror(2024071603);
end; end;
end; end;
@ -574,6 +579,7 @@ Unit rawasmtext;
instr: TWasmInstruction; instr: TWasmInstruction;
tmpS: string; tmpS: string;
begin begin
instr:=nil;
//Consume(AS_LPAREN); //Consume(AS_LPAREN);
case actasmtoken of case actasmtoken of
AS_OPCODE: AS_OPCODE:
@ -690,8 +696,16 @@ Unit rawasmtext;
end; end;
else else
begin begin
HandlePlainInstruction; instr:=HandlePlainInstruction;
{todo: parse next folded instructions, insert plain instruction after these} while actasmtoken<>AS_RPAREN do
begin
Consume(AS_LPAREN);
HandleFoldedInstruction;
end;
instr.ConcatInstruction(curlist);
instr.Free;
instr:=nil;
Consume(AS_RPAREN);
end; end;
end; end;
end; end;
@ -710,7 +724,7 @@ Unit rawasmtext;
result:=TWasmInstruction.create(TWasmOperand); result:=TWasmInstruction.create(TWasmOperand);
result.opcode:=actopcode; result.opcode:=actopcode;
Consume(AS_OPCODE); Consume(AS_OPCODE);
case actopcode of case result.opcode of
{ instructions, which require 0 operands } { instructions, which require 0 operands }
a_nop, a_nop,
a_unreachable, a_unreachable,
@ -776,6 +790,7 @@ Unit rawasmtext;
begin begin
if actasmtoken=AS_INTNUM then if actasmtoken=AS_INTNUM then
begin begin
result.ops:=1;
result.operands[1].opr.typ:=OPR_CONSTANT; result.operands[1].opr.typ:=OPR_CONSTANT;
result.operands[1].opr.val:=actinttoken; result.operands[1].opr.val:=actinttoken;
Consume(AS_INTNUM); Consume(AS_INTNUM);
@ -795,12 +810,14 @@ Unit rawasmtext;
case actasmtoken of case actasmtoken of
AS_INTNUM: AS_INTNUM:
begin begin
result.ops:=1;
result.operands[1].opr.typ:=OPR_FLOATCONSTANT; result.operands[1].opr.typ:=OPR_FLOATCONSTANT;
result.operands[1].opr.floatval:=actinttoken; result.operands[1].opr.floatval:=actinttoken;
Consume(AS_INTNUM); Consume(AS_INTNUM);
end; end;
AS_REALNUM: AS_REALNUM:
begin begin
result.ops:=1;
result.operands[1].opr.typ:=OPR_FLOATCONSTANT; result.operands[1].opr.typ:=OPR_FLOATCONSTANT;
result.operands[1].opr.floatval:=actfloattoken; result.operands[1].opr.floatval:=actfloattoken;
Consume(AS_REALNUM); Consume(AS_REALNUM);
@ -840,15 +857,82 @@ Unit rawasmtext;
a_i64_store32: a_i64_store32:
begin begin
{ TODO: parse the optional memarg operand } { TODO: parse the optional memarg operand }
result.ops:=1;
result.operands[1].opr.typ:=OPR_CONSTANT; result.operands[1].opr.typ:=OPR_CONSTANT;
result.operands[1].opr.val:=0; result.operands[1].opr.val:=0;
end; end;
{ instructions that take a local variable parameter (or index) }
a_local_get,
a_local_set,
a_local_tee:
case actasmtoken of
AS_INTNUM:
begin
result.ops:=1;
result.operands[1].opr.typ:=OPR_CONSTANT;
result.operands[1].opr.val:=actinttoken;
Consume(AS_INTNUM);
end;
{TODO:AS_ID}
else
begin
{ error: expected integer }
result.Free;
result:=nil;
Consume(AS_INTNUM);
end;
end;
a_global_get,
a_global_set:
case actasmtoken of
AS_INTNUM:
begin
result.ops:=1;
result.operands[1].opr.typ:=OPR_CONSTANT;
result.operands[1].opr.val:=actinttoken;
Consume(AS_INTNUM);
end;
{TODO:AS_ID}
else
begin
{ error: expected integer }
result.Free;
result:=nil;
Consume(AS_INTNUM);
end;
end;
else else
internalerror(2024071401); internalerror(2024071401);
end; end;
end; end;
else else
{error}; internalerror(2024071604);
end;
end;
procedure twasmreader.HandleBlockInstruction;
var
instr: TWasmInstruction;
begin
if actasmtoken<>AS_OPCODE then
internalerror(2024071601);
case actopcode of
a_if,
a_block,
a_loop:
begin
instr:=TWasmInstruction.create(TWasmOperand);
instr.opcode:=actopcode;
Consume(AS_OPCODE);
{TODO: implement the rest}
internalerror(2024071699);
end;
else
internalerror(2024071602);
end; end;
end; end;
@ -877,6 +961,9 @@ Unit rawasmtext;
case actasmtoken of case actasmtoken of
AS_END: AS_END:
break; { end assembly block } break; { end assembly block }
AS_OPCODE,
AS_LPAREN:
HandleInstruction;
else else
begin begin
Consume(actasmtoken); Consume(actasmtoken);