1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
unit wasmdef;
{$i fpcdefs.inc}
interface
uses
symtype, symsym, symdef, symconst, constexp
,defutil, procdefutil, cclasses;
type
{ TWasmTypeEntry }
TWasmTypeEntry = class(Tobject)
name : string; // always empty
idx : integer;
constructor Create(aidx: integer; aname: string);
end;
{ TWasmProcTypeLookup }
TWasmProcTypeLookup = class(TObject)
list: TFPHashObjectList;
idx: integer;
constructor Create(astartIndex: integer = 0);
destructor Destroy; override;
function GetTypeIndex(const typecode: string): Integer;
end;
// encodes procedure definition to a code used for the proc type lookup
// it's case-sensitive!!!
// i = i32, I = i64, f = f32, F = f32
function WasmGetTypeCodeForDef(def: tdef; var ch: char): Boolean;
function WasmGetTypeCode(aprocdef: tabstractprocdef): string;
{ returns whether a def always resides in memory,
rather than in wasm local variables...) }
function wasmAlwayInMem(def: tdef): boolean;
function get_para_push_size(def: tdef): tdef;
implementation
function get_para_push_size(def: tdef): tdef;
begin
result:=def;
if def.typ=orddef then
case torddef(def).ordtype of
u8bit,uchar:
if torddef(def).high>127 then
result:=s8inttype;
u16bit:
begin
if torddef(def).high>32767 then
result:=s16inttype;
end
else
;
end;
end;
function wasmAlwayInMem(def: tdef): boolean;
begin
case def.typ of
arraydef,
filedef,
recorddef,
objectdef,
stringdef:
result:=true;
else
result:=false;
end;
end;
function WasmGetTypeCodeForDef(def: tdef; var ch: char): Boolean;
begin
Result := assigned(def);
if not Result then Exit;
case def.typ of
floatdef:
if def.size = 4 then ch :='f'
else ch :='F';
orddef:
if def.size = 8 then ch :='I'
else ch := 'i';
// todo: set can be bigger
else
ch:='i'; // by address
end;
end;
function WasmGetTypeCode(aprocdef: tabstractprocdef): string;
var
ch : char;
i : integer;
begin
Result := '';
if not Assigned(aprocdef) then exit;
for i:=0 to aprocdef.paras.Count-1 do begin
WasmGetTypeCodeForDef( tparavarsym(aprocdef.paras[i]).paraloc[callerside].Def, ch);
result:=result+ch;
end;
if assigned(aprocdef) then begin
result:=result+':';
WasmGetTypeCodeForDef(aprocdef.returndef, ch);
result:=result+ch;
end;
end;
{ TWasmTypeEntry }
constructor TWasmTypeEntry.Create(aidx: integer; aname: string);
begin
idx := aidx;
name := aname;
end;
{ TWasmProcTypeLookup }
constructor TWasmProcTypeLookup.Create(astartIndex: integer = 0);
begin
inherited Create;
list := TFPHashObjectList.Create(true);
idx := astartIndex;
end;
destructor TWasmProcTypeLookup.Destroy;
begin
list.Free;
inherited Destroy;
end;
function TWasmProcTypeLookup.GetTypeIndex(const typecode: string): Integer;
var
en : TWasmTypeEntry;
begin
en := TWasmTypeEntry(list.Find(typecode));
if not Assigned(en) then begin
en := TWasmTypeEntry.Create(idx, ''); // no need to copy
inc(idx);
list.Add(typecode, en);
end;
Result := en.idx;
end;
end.
|
