paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 01:29:27 +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

5
compiler/wasm32/cpupi.pas
View File

@ -475,7 +475,8 @@ implementation
procedure tcpuprocinfo.generate_exit_label(list: tasmlist);
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);
end;
@ -984,6 +985,8 @@ implementation
localslist: TAsmList;
labels_resolved, has_goto: Boolean;
begin
if po_assembler in procdef.procoptions then
exit;
check_goto_br_instructions(aktproccode,has_goto);
localslist:=prepare_locals;

83
compiler/wasm32/hlcgcpu.pas
View File

@ -2051,31 +2051,35 @@ implementation
pd:=tcpuprocdef(current_procinfo.procdef);
g_procdef(list,pd);
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);
if not nostackframe then
begin
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));
incstack(list,1);
list.Concat(taicpu.op_ref(a_local_set,pd.base_pointer_ref));
decstack(list,1);
g_fingerprint(list);
if (localsize>0) then begin
list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
incstack(list,1);
list.concat(taicpu.op_const(a_i32_const, localsize ));
incstack(list,1);
list.concat(taicpu.op_none(a_i32_sub));
decstack(list,1);
list.Concat(taicpu.op_ref(a_local_set,pd.frame_pointer_ref));
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;
list.Concat(taicpu.op_sym(a_global_get,RefStackPointerSym));
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_ref(a_local_get,pd.base_pointer_ref));
incstack(list,1);
list.concat(taicpu.op_const(a_i32_const, localsize ));
incstack(list,1);
list.concat(taicpu.op_none(a_i32_sub));
decstack(list,1);
list.Concat(taicpu.op_ref(a_local_set,pd.frame_pointer_ref));
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;
procedure thlcgwasm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
@ -2083,12 +2087,15 @@ implementation
pd: tcpuprocdef;
begin
pd:=tcpuprocdef(current_procinfo.procdef);
list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
incstack(list,1);
list.Concat(taicpu.op_sym(a_global_set,RefStackPointerSym));
decstack(list,1);
if not nostackframe then
begin
list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
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));
end;
@ -2336,21 +2343,27 @@ implementation
procedure thlcgwasm.gen_entry_code(list: TAsmList);
begin
inherited;
list.concat(taicpu.op_none(a_block));
list.concat(taicpu.op_none(a_block));
if not (po_assembler in current_procinfo.procdef.procoptions) then
begin
list.concat(taicpu.op_none(a_block));
list.concat(taicpu.op_none(a_block));
end;
end;
procedure thlcgwasm.gen_exit_code(list: TAsmList);
begin
list.concat(taicpu.op_none(a_end_block));
if ts_wasm_bf_exceptions in current_settings.targetswitches then
a_label(list,tcpuprocinfo(current_procinfo).CurrRaiseLabel);
if fevalstackheight<>0 then
if not (po_assembler in current_procinfo.procdef.procoptions) then
begin
list.concat(taicpu.op_none(a_end_block));
if ts_wasm_bf_exceptions in current_settings.targetswitches then
a_label(list,tcpuprocinfo(current_procinfo).CurrRaiseLabel);
if fevalstackheight<>0 then
{$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}
internalerror(2021091801);
internalerror(2021091801);
{$endif DEBUG_WASMSTACK}
end;
inherited;
end;

101
compiler/wasm32/rawasmtext.pas
View File

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