123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143 |
- {
- Copyright (c) 1998-2008 by Carl Eric Codere and Peter Vreman
- Copyright (c) 2024 by Nikolay Nikolov
- Does the parsing for the WebAssembly styled inline assembler.
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- Unit rawasmtext;
- {$i fpcdefs.inc}
- Interface
- uses
- cclasses,
- globtype,
- rasm,rawasm,
- aasmbase,cpubase;
- type
- tasmtoken = (
- AS_NONE,AS_LPAREN,AS_RPAREN,AS_ID,AS_END,AS_OPCODE,AS_INTNUM,
- AS_REALNUM,AS_STRING,AS_PARAM,AS_RESULT,AS_THEN,AS_ELSE,AS_TYPE,AS_VALTYPE
- );
- tasmkeyword = string[10];
- const
- token2str : array[tasmtoken] of tasmkeyword=(
- '','(',')','identifier','end','opcode','integer','float','string',
- 'param','result','then','else','type','valtype');
- type
- { twasmreader }
- twasmreader = class(tasmreader)
- private
- actwasmbasictype: TWasmBasicType;
- actasmpattern_origcase: string;
- actasmtoken : tasmtoken;
- prevasmtoken : tasmtoken;
- actinttoken : aint;
- actfloattoken : double;
- procedure SetupTables;
- procedure GetToken;
- function consume(t : tasmtoken):boolean;
- function is_asmopcode(const s: string):boolean;
- function is_valtype(const s: string):boolean;
- procedure HandleInstruction;
- procedure HandleFoldedInstruction;
- function HandlePlainInstruction: TWasmInstruction;
- procedure HandleBlockInstruction;
- public
- function Assemble: tlinkedlist;override;
- end;
- Implementation
- uses
- { helpers }
- cutils,
- { global }
- globals,verbose,
- systems,
- { aasm }
- cpuinfo,aasmtai,aasmdata,aasmcpu,
- { symtable }
- symconst,symbase,symtype,symsym,symtable,symdef,symutil,symcpu,
- { parser }
- scanner,pbase,
- procinfo,
- rabase,rautils,
- cgbase,cgutils,cgobj,
- hlcgobj,hlcgcpu,
- { wasm }
- itcpuwasm
- ;
- {*****************************************************************************
- twasmreader
- *****************************************************************************}
- procedure twasmreader.SetupTables;
- var
- i: TAsmOp;
- begin
- iasmops:=TFPHashList.create;
- for i:=firstop to lastop do
- if wasm_op2str[i]<>'end' then
- iasmops.Add(wasm_op2str[i],Pointer(PtrInt(i)));
- end;
- procedure twasmreader.GetToken;
- var
- has_sign, is_hex, is_float: Boolean;
- function GetIntToken: aint;
- var
- s: string;
- u64: UInt64;
- begin
- s:=actasmpattern;
- if has_sign and (s[1]='-') then
- begin
- delete(s,1,1);
- if is_hex then
- begin
- delete(s,1,2);
- Val('$'+s,u64);
- end
- else
- Val(s,u64);
- {$push} {$R-}{$Q-}
- result:=aint(-u64);
- {$pop}
- end
- else
- begin
- if has_sign then
- delete(s,1,1);
- if is_hex then
- begin
- delete(s,1,2);
- Val('$'+s,u64);
- end
- else
- Val(s,u64);
- result:=aint(u64);
- end;
- end;
- function GetFloatToken: double;
- var
- s: string;
- begin
- s:=actasmpattern;
- if is_hex then
- begin
- { TODO: parse hex floats }
- internalerror(2024071501);
- end
- else
- Val(s,result);
- end;
- var
- len: Integer;
- tmpS: string;
- tmpI, tmpCode: Integer;
- begin
- c:=scanner.c;
- { save old token and reset new token }
- prevasmtoken:=actasmtoken;
- actasmtoken:=AS_NONE;
- { reset }
- actasmpattern:='';
- { while space, tab, new line or comment, continue scan... }
- while c in [' ',#9,#13,#10] do
- begin
- c:=current_scanner.asmgetchar;
- case c of
- ';':
- begin
- c:=current_scanner.asmgetchar;
- case c of
- { ;; comment until end of line }
- ';':
- begin
- { skip until end of line }
- repeat
- c:=current_scanner.asmgetchar;
- until c in [#13,#10];
- end;
- else
- current_scanner.illegal_char(c);
- end;
- end;
- '(':
- begin
- current_scanner.gettokenpos;
- c:=current_scanner.asmgetchar;
- case c of
- { (; block comment ;) }
- ';':
- begin
- { skip until ;) }
- repeat
- c:=current_scanner.asmgetchar;
- if c=';' then
- begin
- c:=current_scanner.asmgetchar;
- if c=')' then
- begin
- c:=current_scanner.asmgetchar;
- break;
- end;
- end;
- until false;
- end;
- else
- begin
- actasmtoken:=AS_LPAREN;
- exit;
- end;
- end;
- end;
- end;
- end;
- current_scanner.gettokenpos;
- case c of
- ')':
- begin
- c:=current_scanner.asmgetchar;
- actasmtoken:=AS_RPAREN;
- end;
- '$','a'..'z','A'..'Z':
- begin
- len:=0;
- while c in ['A'..'Z','a'..'z','0'..'9',
- '!','#','$','%','&','''','*','+','-','.','/',
- ':','<','=','>','?','@','\','^','_','`','|','~'] do
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- actasmpattern[0]:=chr(len);
- actasmpattern_origcase:=actasmpattern;
- if actasmpattern[1]='$' then
- actasmtoken:=AS_ID
- else if is_asmopcode(actasmpattern) or
- is_valtype(actasmpattern) then
- exit
- else if upper(actasmpattern) = 'END' then
- begin
- uppervar(actasmpattern);
- actasmtoken:=AS_END;
- exit;
- end
- else
- begin
- message1(asmr_e_unknown_opcode,actasmpattern);
- actasmtoken:=AS_NONE;
- end;
- end;
- '0'..'9','+','-':
- begin
- len:=0;
- has_sign:=false;
- is_hex:=false;
- is_float:=false;
- if c in ['+','-'] then
- begin
- has_sign:=true;
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- if c='0' then
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- if c='x' then
- begin
- is_hex:=true;
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- end;
- if is_hex then
- begin
- while c in ['0'..'9','a'..'f','A'..'F'] do
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- end
- else
- begin
- while c in ['0'..'9'] do
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- end;
- if c='.' then
- begin
- is_float:=true;
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- { parse the fractional part }
- if is_hex then
- begin
- while c in ['0'..'9','a'..'f','A'..'F'] do
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- end
- else
- begin
- while c in ['0'..'9'] do
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- end;
- end;
- if (is_hex and (c in ['p','P'])) or
- ((not is_hex) and (c in ['e','E'])) then
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- if c in ['+','-'] then
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- while c in ['0'..'9'] do
- begin
- inc(len);
- actasmpattern[len]:=c;
- c:=current_scanner.asmgetchar;
- end;
- end;
- actasmpattern[0]:=chr(len);
- if is_float then
- begin
- actasmtoken:=AS_REALNUM;
- actfloattoken:=GetFloatToken;
- end
- else
- begin
- actasmtoken:=AS_INTNUM;
- actinttoken:=GetIntToken;
- end;
- end;
- '"':
- begin
- actasmpattern:='';
- repeat
- c:=current_scanner.asmgetchar;
- case c of
- '\' :
- begin
- c:=current_scanner.asmgetchar;
- case c of
- 't':
- begin
- actasmpattern:=actasmpattern+#9;
- c:=current_scanner.asmgetchar;
- end;
- 'n':
- begin
- actasmpattern:=actasmpattern+#10;
- c:=current_scanner.asmgetchar;
- end;
- 'r':
- begin
- actasmpattern:=actasmpattern+#13;
- c:=current_scanner.asmgetchar;
- end;
- '"':
- begin
- actasmpattern:=actasmpattern+'"';
- c:=current_scanner.asmgetchar;
- end;
- '''':
- begin
- actasmpattern:=actasmpattern+'''';
- c:=current_scanner.asmgetchar;
- end;
- '\':
- begin
- actasmpattern:=actasmpattern+'\';
- c:=current_scanner.asmgetchar;
- end;
- 'u':
- begin
- tmpS:='';
- c:=current_scanner.asmgetchar;
- while c in ['0'..'9','a'..'f','A'..'F'] do
- begin
- tmpS:=tmpS+c;
- c:=current_scanner.asmgetchar;
- end;
- if tmpS<>'' then
- begin
- Val('$'+tmpS,tmpI,tmpCode);
- if (tmpI<$D800) or ((tmpI>=$E000) and (tmpI<$110000)) then
- begin
- if tmpI<=$7F then
- actasmpattern:=actasmpattern+Chr(tmpI)
- else if tmpI<=$7FF then
- actasmpattern:=actasmpattern+
- Chr(%11000000 or (tmpI shr 6))+
- Chr(%10000000 or (tmpI and $3F))
- else if tmpI<=$FFFF then
- actasmpattern:=actasmpattern+
- Chr(%11100000 or (tmpI shr 12))+
- Chr(%10000000 or ((tmpI shr 6) and $3F))+
- Chr(%10000000 or (tmpI and $3F))
- else
- actasmpattern:=actasmpattern+
- Chr(%11110000 or (tmpI shr 18))+
- Chr(%10000000 or ((tmpI shr 12) and $3F))+
- Chr(%10000000 or ((tmpI shr 6) and $3F))+
- Chr(%10000000 or (tmpI and $3F))
- end
- else
- Message1(asmr_e_escape_seq_ignored,'u'+tmpS);
- end
- else
- Message1(asmr_e_escape_seq_ignored,'u');
- end;
- '0'..'9','a'..'f','A'..'F':
- begin
- tmpS:=c;
- c:=current_scanner.asmgetchar;
- if c in ['0'..'9','a'..'f','A'..'F'] then
- begin
- tmpS:=tmpS+c;
- c:=current_scanner.asmgetchar;
- Val('$'+tmpS,tmpI,tmpCode);
- actasmpattern:=actasmpattern+Chr(tmpI);
- end
- else
- begin
- Message1(asmr_e_escape_seq_ignored,tmpS+c);
- c:=current_scanner.asmgetchar;
- end;
- end;
- else
- begin
- Message1(asmr_e_escape_seq_ignored,c);
- c:=current_scanner.asmgetchar;
- end;
- end;
- end;
- '"' :
- begin
- c:=current_scanner.asmgetchar;
- break;
- end;
- #10,#13:
- Message(scan_f_string_exceeds_line);
- #0..#9,#11,#12,#14..#31,#127:
- current_scanner.illegal_char(c);
- else
- actasmpattern:=actasmpattern+c;
- end;
- until false;
- actasmtoken:=AS_STRING;
- exit;
- end;
- else
- current_scanner.illegal_char(c);
- end;
- end;
- function twasmreader.consume(t: tasmtoken): boolean;
- begin
- Consume:=true;
- if t<>actasmtoken then
- begin
- Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
- Consume:=false;
- end;
- repeat
- gettoken;
- until actasmtoken<>AS_NONE;
- end;
- function twasmreader.is_asmopcode(const s: string): boolean;
- begin
- actopcode:=tasmop(PtrUInt(iasmops.Find(s)));
- if actopcode<>A_NONE then
- begin
- actasmtoken:=AS_OPCODE;
- is_asmopcode:=true;
- end
- else
- is_asmopcode:=false;
- end;
- function twasmreader.is_valtype(const s: string): boolean;
- begin
- actwasmbasictype:=wbt_Unknown;
- case s of
- 'i32':
- actwasmbasictype:=wbt_i32;
- 'i64':
- actwasmbasictype:=wbt_i64;
- 'f32':
- actwasmbasictype:=wbt_f32;
- 'f64':
- actwasmbasictype:=wbt_f64;
- 'funcref':
- actwasmbasictype:=wbt_funcref;
- 'externref':
- actwasmbasictype:=wbt_externref;
- 'v128':
- actwasmbasictype:=wbt_v128;
- end;
- if actwasmbasictype<>wbt_Unknown then
- begin
- actasmtoken:=AS_VALTYPE;
- is_valtype:=true;
- end
- else
- is_valtype:=false;
- end;
- procedure twasmreader.HandleInstruction;
- var
- instr: TWasmInstruction;
- begin
- case actasmtoken of
- AS_LPAREN:
- begin
- Consume(AS_LPAREN);
- HandleFoldedInstruction;
- end;
- AS_OPCODE:
- begin
- case actopcode of
- a_block,
- a_loop,
- a_if:
- HandleBlockInstruction;
- else
- begin
- instr:=HandlePlainInstruction;
- instr.ConcatInstruction(curlist);
- end;
- end;
- end;
- else
- internalerror(2024071603);
- end;
- end;
- procedure twasmreader.HandleFoldedInstruction;
- var
- HasLabel, HasType, HasParam, HasResult, HasInstructions,
- HasThen, HasElse: Boolean;
- instr: TWasmInstruction;
- tmpS: string;
- begin
- instr:=nil;
- //Consume(AS_LPAREN);
- case actasmtoken of
- AS_OPCODE:
- begin
- case actopcode of
- a_block,
- a_loop,
- a_if:
- begin
- Consume(AS_OPCODE);
- HasType:=False;
- HasParam:=False;
- HasResult:=False;
- HasInstructions:=False;
- HasThen:=False;
- HasElse:=False;
- instr:=TWasmInstruction.create(TWasmOperand);
- instr.opcode:=actopcode;
- HasLabel:=False;
- if actasmtoken=AS_ID then
- begin
- Consume(AS_ID);
- HasLabel:=True;
- end;
- repeat
- case actasmtoken of
- AS_LPAREN:
- begin
- Consume(AS_LPAREN);
- case actasmtoken of
- AS_TYPE:
- begin
- if HasElse or HasThen or HasInstructions or HasResult or HasParam or HasType then
- begin
- {TODO: error}
- end;
- Consume(AS_TYPE);
- //TODO: consume u32 or id
- Consume(actasmtoken);
- Consume(AS_RPAREN);
- end;
- AS_PARAM:
- begin
- if HasElse or HasThen or HasInstructions or HasResult then
- begin
- {TODO: error}
- end;
- Consume(AS_PARAM);
- if actasmtoken=AS_ID then
- begin
- tmpS:=actasmpattern;
- Consume(AS_ID);
- if actasmtoken=AS_VALTYPE then
- instr.AddParam(actasmpattern,actwasmbasictype);
- Consume(AS_VALTYPE);
- end
- else
- begin
- while actasmtoken<>AS_RPAREN do
- begin
- if actasmtoken=AS_VALTYPE then
- instr.AddParam('',actwasmbasictype);
- Consume(AS_VALTYPE);
- end;
- end;
- Consume(AS_RPAREN);
- end;
- AS_RESULT:
- begin
- if HasElse or HasThen or HasInstructions then
- begin
- {TODO: error}
- end;
- Consume(AS_RESULT);
- while actasmtoken<>AS_RPAREN do
- begin
- if actasmtoken=AS_VALTYPE then
- instr.AddResult(actwasmbasictype);
- Consume(AS_VALTYPE);
- end;
- Consume(AS_RPAREN);
- end;
- AS_THEN:
- begin
- if instr.opcode<>a_if then
- {error!};
- Consume(AS_THEN);
- HasThen:=True;
- while actasmtoken<>AS_RPAREN do
- HandleInstruction;
- Consume(AS_RPAREN);
- end;
- AS_ELSE:
- begin
- if instr.opcode<>a_if then
- {error!};
- Consume(AS_ELSE);
- HasElse:=True;
- while actasmtoken<>AS_RPAREN do
- HandleInstruction;
- Consume(AS_RPAREN);
- end;
- else
- begin
- HasInstructions:=True;
- HandleFoldedInstruction;
- end;
- end;
- end;
- else
- {todo: error};
- end;
- until false;
- end;
- else
- begin
- 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;
- else
- {error}
- end;
- end;
- function twasmreader.HandlePlainInstruction: TWasmInstruction;
- var
- srsym: tsym;
- srsymtable: TSymtable;
- globsym: TWasmGlobalAsmSymbol;
- begin
- result:=nil;
- case actasmtoken of
- AS_OPCODE:
- begin
- result:=TWasmInstruction.create(TWasmOperand);
- result.opcode:=actopcode;
- Consume(AS_OPCODE);
- case result.opcode of
- { instructions, which require 0 operands }
- a_nop,
- a_unreachable,
- a_return,
- a_ref_is_null,
- a_drop,
- a_memory_size,
- a_memory_grow,
- a_memory_fill,
- a_memory_copy,
- a_i32_clz,a_i32_ctz,a_i32_popcnt,a_i32_add,a_i32_sub,a_i32_mul,a_i32_div_s,a_i32_div_u,a_i32_rem_s,a_i32_rem_u,a_i32_and,a_i32_or,a_i32_xor,a_i32_shl,a_i32_shr_s,a_i32_shr_u,a_i32_rotl,a_i32_rotr,
- a_i64_clz,a_i64_ctz,a_i64_popcnt,a_i64_add,a_i64_sub,a_i64_mul,a_i64_div_s,a_i64_div_u,a_i64_rem_s,a_i64_rem_u,a_i64_and,a_i64_or,a_i64_xor,a_i64_shl,a_i64_shr_s,a_i64_shr_u,a_i64_rotl,a_i64_rotr,
- a_f32_abs,a_f32_neg,a_f32_ceil,a_f32_floor,a_f32_trunc,a_f32_nearest,a_f32_sqrt,a_f32_add,a_f32_sub,a_f32_mul,a_f32_div,a_f32_min,a_f32_max,a_f32_copysign,
- a_f64_abs,a_f64_neg,a_f64_ceil,a_f64_floor,a_f64_trunc,a_f64_nearest,a_f64_sqrt,a_f64_add,a_f64_sub,a_f64_mul,a_f64_div,a_f64_min,a_f64_max,a_f64_copysign,
- a_i32_eqz,a_i32_eq,a_i32_ne,a_i32_lt_s,a_i32_lt_u,a_i32_gt_s,a_i32_gt_u,a_i32_le_s,a_i32_le_u,a_i32_ge_s,a_i32_ge_u,
- a_i64_eqz,a_i64_eq,a_i64_ne,a_i64_lt_s,a_i64_lt_u,a_i64_gt_s,a_i64_gt_u,a_i64_le_s,a_i64_le_u,a_i64_ge_s,a_i64_ge_u,
- a_f32_eq,a_f32_ne,a_f32_lt,a_f32_gt,a_f32_le,a_f32_ge,
- a_f64_eq,a_f64_ne,a_f64_lt,a_f64_gt,a_f64_le,a_f64_ge,
- a_i32_wrap_i64,
- a_i32_trunc_f32_s,
- a_i32_trunc_f32_u,
- a_i32_trunc_f64_s,
- a_i32_trunc_f64_u,
- a_i32_trunc_sat_f32_s,
- a_i32_trunc_sat_f32_u,
- a_i32_trunc_sat_f64_s,
- a_i32_trunc_sat_f64_u,
- a_i64_extend_i32_s,
- a_i64_extend_i32_u,
- a_i64_trunc_f32_s,
- a_i64_trunc_f32_u,
- a_i64_trunc_f64_s,
- a_i64_trunc_f64_u,
- a_i64_trunc_sat_f32_s,
- a_i64_trunc_sat_f32_u,
- a_i64_trunc_sat_f64_u,
- a_i64_trunc_sat_f64_s,
- a_f32_convert_i32_s,
- a_f32_convert_i32_u,
- a_f32_convert_i64_s,
- a_f32_convert_i64_u,
- a_f32_demote_f64,
- a_f64_convert_i32_s,
- a_f64_convert_i32_u,
- a_f64_convert_i64_s,
- a_f64_convert_i64_u,
- a_f64_promote_f32,
- a_i32_reinterpret_f32,
- a_i64_reinterpret_f64,
- a_f32_reinterpret_i32,
- a_f64_reinterpret_i64,
- a_i32_extend8_s,
- a_i32_extend16_s,
- a_i64_extend8_s,
- a_i64_extend16_s,
- a_i64_extend32_s,
- a_atomic_fence:
- ;
- { instructions with an integer const operand }
- a_i32_const,
- a_i64_const:
- 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);
- end
- else
- begin
- { error: expected integer }
- result.Free;
- result:=nil;
- Consume(AS_INTNUM);
- end;
- end;
- { instructions with a float const operand }
- a_f32_const,
- a_f64_const:
- begin
- 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);
- end;
- else
- begin
- { error: expected real }
- result.Free;
- result:=nil;
- Consume(AS_REALNUM);
- end;
- end;
- end;
- { instructions with an optional memarg operand }
- a_i32_load,
- a_i64_load,
- a_f32_load,
- a_f64_load,
- a_i32_load8_s,
- a_i32_load8_u,
- a_i32_load16_s,
- a_i32_load16_u,
- a_i64_load8_s,
- a_i64_load8_u,
- a_i64_load16_s,
- a_i64_load16_u,
- a_i64_load32_s,
- a_i64_load32_u,
- a_i32_store,
- a_i64_store,
- a_f32_store,
- a_f64_store,
- a_i32_store8,
- a_i32_store16,
- a_i64_store8,
- a_i64_store16,
- a_i64_store32,
- a_memory_atomic_notify,
- a_memory_atomic_wait32,
- a_memory_atomic_wait64,
- a_i32_atomic_load,
- a_i64_atomic_load,
- a_i32_atomic_load8_u,
- a_i32_atomic_load16_u,
- a_i64_atomic_load8_u,
- a_i64_atomic_load16_u,
- a_i64_atomic_load32_u,
- a_i32_atomic_store,
- a_i64_atomic_store,
- a_i32_atomic_store8,
- a_i32_atomic_store16,
- a_i64_atomic_store8,
- a_i64_atomic_store16,
- a_i64_atomic_store32,
- a_i32_atomic_rmw_add,
- a_i64_atomic_rmw_add,
- a_i32_atomic_rmw8_add_u,
- a_i32_atomic_rmw16_add_u,
- a_i64_atomic_rmw8_add_u,
- a_i64_atomic_rmw16_add_u,
- a_i64_atomic_rmw32_add_u,
- a_i32_atomic_rmw_sub,
- a_i64_atomic_rmw_sub,
- a_i32_atomic_rmw8_sub_u,
- a_i32_atomic_rmw16_sub_u,
- a_i64_atomic_rmw8_sub_u,
- a_i64_atomic_rmw16_sub_u,
- a_i64_atomic_rmw32_sub_u,
- a_i32_atomic_rmw_and,
- a_i64_atomic_rmw_and,
- a_i32_atomic_rmw8_and_u,
- a_i32_atomic_rmw16_and_u,
- a_i64_atomic_rmw8_and_u,
- a_i64_atomic_rmw16_and_u,
- a_i64_atomic_rmw32_and_u,
- a_i32_atomic_rmw_or,
- a_i64_atomic_rmw_or,
- a_i32_atomic_rmw8_or_u,
- a_i32_atomic_rmw16_or_u,
- a_i64_atomic_rmw8_or_u,
- a_i64_atomic_rmw16_or_u,
- a_i64_atomic_rmw32_or_u,
- a_i32_atomic_rmw_xor,
- a_i64_atomic_rmw_xor,
- a_i32_atomic_rmw8_xor_u,
- a_i32_atomic_rmw16_xor_u,
- a_i64_atomic_rmw8_xor_u,
- a_i64_atomic_rmw16_xor_u,
- a_i64_atomic_rmw32_xor_u,
- a_i32_atomic_rmw_xchg,
- a_i64_atomic_rmw_xchg,
- a_i32_atomic_rmw8_xchg_u,
- a_i32_atomic_rmw16_xchg_u,
- a_i64_atomic_rmw8_xchg_u,
- a_i64_atomic_rmw16_xchg_u,
- a_i64_atomic_rmw32_xchg_u,
- a_i32_atomic_rmw_cmpxchg,
- a_i64_atomic_rmw_cmpxchg,
- a_i32_atomic_rmw8_cmpxchg_u,
- a_i32_atomic_rmw16_cmpxchg_u,
- a_i64_atomic_rmw8_cmpxchg_u,
- a_i64_atomic_rmw16_cmpxchg_u,
- a_i64_atomic_rmw32_cmpxchg_u:
- 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;
- AS_ID:
- begin
- case actasmpattern of
- '$'+STACK_POINTER_SYM:
- begin
- result.ops:=1;
- result.operands[1].opr.typ:=OPR_SYMBOL;
- result.operands[1].opr.symbol:=thlcgwasm(hlcg).RefStackPointerSym;
- Consume(AS_ID);
- end;
- '$'+TLS_SIZE_SYM,
- '$'+TLS_ALIGN_SYM,
- '$'+TLS_BASE_SYM:
- begin
- globsym:=TWasmGlobalAsmSymbol(
- current_asmdata.RefAsmSymbolByClass(
- TWasmGlobalAsmSymbol,
- Copy(actasmpattern,2,Length(actasmpattern)-1),
- AT_WASM_GLOBAL));
- globsym.WasmGlobalType:=wbt_i32;
- result.ops:=1;
- result.operands[1].opr.typ:=OPR_SYMBOL;
- result.operands[1].opr.symbol:=globsym;
- Consume(AS_ID);
- end;
- else
- internalerror(2024072002);
- end;
- end;
- else
- begin
- { error: expected integer }
- result.Free;
- result:=nil;
- Consume(AS_INTNUM);
- end;
- end;
- a_call:
- case actasmtoken of
- AS_ID:
- begin
- AsmSearchSym(upper(Copy(actasmpattern,2,Length(actasmpattern)-1)),srsym,srsymtable);
- if assigned(srsym) then
- begin
- case srsym.typ of
- procsym:
- begin
- if Tprocsym(srsym).ProcdefList.Count>1 then
- Message(asmr_w_calling_overload_func);
- result.ops:=2;
- result.operands[1].opr.typ:=OPR_SYMBOL;
- result.operands[1].opr.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname,AT_FUNCTION);
- result.operands[2].opr.typ:=OPR_FUNCTYPE;
- result.operands[2].opr.functype:=tcpuprocdef(tprocsym(srsym).ProcdefList[0]).create_functype;
- Consume(AS_ID);
- end;
- else
- Message(asmr_e_wrong_sym_type);
- end;
- end
- else
- Message1(sym_e_unknown_id,actasmpattern);
- end;
- else
- begin
- { error: expected identifier }
- result.Free;
- result:=nil;
- Consume(AS_ID);
- end;
- end;
- else
- internalerror(2024071401);
- end;
- end;
- else
- 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;
- function twasmreader.Assemble: tlinkedlist;
- begin
- Message1(asmr_d_start_reading,'WebAssembly');
- firsttoken:=TRUE;
- { sets up all opcode and register tables in uppercase }
- if not _asmsorted then
- begin
- SetupTables;
- _asmsorted:=TRUE;
- end;
- curlist:=TAsmList.Create;
- { we might need to know which parameters are passed in registers }
- if not parse_generic then
- current_procinfo.generate_parameter_info;
- { start tokenizer }
- gettoken;
- { main loop }
- repeat
- case actasmtoken of
- AS_END:
- break; { end assembly block }
- AS_OPCODE,
- AS_LPAREN:
- HandleInstruction;
- else
- begin
- Consume(actasmtoken);
- //Message(asmr_e_syntax_error);
- //RecoverConsume(false);
- end;
- end;
- until false;
- { Return the list in an asmnode }
- assemble:=curlist;
- Message1(asmr_d_finish_reading,'WebAssembly');
- end;
- {*****************************************************************************
- Initialize
- *****************************************************************************}
- const
- asmmode_wasm_standard_info : tasmmodeinfo =
- (
- id : asmmode_standard;
- idtxt : 'STANDARD';
- casmreader : twasmreader;
- );
- initialization
- RegisterAsmMode(asmmode_wasm_standard_info);
- end.
|