Merge branch 'main' into basemath

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

View File

@ -475,6 +475,7 @@ implementation
procedure tcpuprocinfo.generate_exit_label(list: tasmlist); procedure tcpuprocinfo.generate_exit_label(list: tasmlist);
begin begin
if not (po_assembler in current_procinfo.procdef.procoptions) then
list.concat(taicpu.op_none(a_end_block)); 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;

View File

@ -2051,6 +2051,9 @@ implementation
pd:=tcpuprocdef(current_procinfo.procdef); pd:=tcpuprocdef(current_procinfo.procdef);
g_procdef(list,pd); g_procdef(list,pd);
if not nostackframe then
begin
ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref); ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref);
if pd.base_pointer_ref.base<>NR_LOCAL_STACK_POINTER_REG then if pd.base_pointer_ref.base<>NR_LOCAL_STACK_POINTER_REG then
ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref); ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref);
@ -2077,18 +2080,22 @@ implementation
decstack(list,1); decstack(list,1);
end; 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);
var var
pd: tcpuprocdef; pd: tcpuprocdef;
begin begin
pd:=tcpuprocdef(current_procinfo.procdef); pd:=tcpuprocdef(current_procinfo.procdef);
if not nostackframe then
begin
list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref)); list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
incstack(list,1); incstack(list,1);
list.Concat(taicpu.op_sym(a_global_set,RefStackPointerSym)); list.Concat(taicpu.op_sym(a_global_set,RefStackPointerSym));
decstack(list,1); 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,11 +2343,16 @@ implementation
procedure thlcgwasm.gen_entry_code(list: TAsmList); procedure thlcgwasm.gen_entry_code(list: TAsmList);
begin begin
inherited; inherited;
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));
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
if not (po_assembler in current_procinfo.procdef.procoptions) then
begin begin
list.concat(taicpu.op_none(a_end_block)); list.concat(taicpu.op_none(a_end_block));
if ts_wasm_bf_exceptions in current_settings.targetswitches then if ts_wasm_bf_exceptions in current_settings.targetswitches then
@ -2351,6 +2363,7 @@ implementation
{$else DEBUG_WASMSTACK} {$else DEBUG_WASMSTACK}
internalerror(2021091801); internalerror(2021091801);
{$endif DEBUG_WASMSTACK} {$endif DEBUG_WASMSTACK}
end;
inherited; inherited;
end; end;

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);