66 #define EXIT (void*)ctx->exit_addr
67 #define START_IP (ctx->generate?(int)MEMORY(ctx->generate):0)
68 #define LOCAL_IP (ctx->size)
69 #define IP START_IP+LOCAL_IP
70 #define REL(addr) relative( ctx, (uint_t)addr )
72 #define EMIT1(a) emit_1(ctx,a)
73 #define EMIT2(a) emit_2(ctx,a)
74 #define EMIT3(a,b) emit_2(ctx,a); emit_1(ctx,b)
75 #define EMIT4(a) emit_4(ctx,a)
76 #define EMIT5(a,b) emit_1(ctx,a); emit_4(ctx,(uint_t)b)
77 #define EMIT6(a,b) emit_2(ctx,a); emit_4(ctx,(uint_t)b)
96 int next_instruction =
IP + 4;
97 return (
uint_t)(addr-next_instruction);
118 #define PUSH_EAX { EMIT1(0x50); INSTR("push eax"); }
119 #define PUSH_EDX { EMIT1(0x52); INSTR("push edx"); }
120 #define PUSH_EBP { EMIT1(0x55); INSTR("push ebp"); }
121 #define PUSH_ESI { EMIT1(0x56); INSTR("push esi"); }
122 #define PUSH_EBX { EMIT1(0x53); INSTR("push ebx"); }
124 #define POP_EAX { EMIT1(0x58); INSTR("pop eax"); }
125 #define POP_EDX { EMIT1(0x5A); INSTR("pop edx"); }
126 #define POP_EBP { EMIT1(0x5D); INSTR("pop ebp"); }
127 #define POP_ESI { EMIT1(0x5E); INSTR("pop esi"); }
128 #define POP_EBX { EMIT1(0x5B); INSTR("pop ebx"); }
130 #define PUSH_MEM_EAX(ofs) { EMIT6(0xB0FF,ofs); INSTR("push [eax%p]",ofs); }
131 #define PUSH_MEM_EBP(ofs) { EMIT6(0xB5FF,ofs); INSTR("push [ebp%p]",ofs); }
132 #define PUSH_MEM_ESI(ofs) { EMIT6(0xB6FF,ofs); INSTR("push [esi%p]",ofs); }
134 #define PUSH_MEM(ofs) { EMIT6(0x35FF,ofs); INSTR("push [%d]",ofs); }
136 #define PUSH_SOURCE(s) { EMIT5(0x68,s); INSTR("push (%l)",s); }
137 #define PUSH_CONST(n) { EMIT5(0x68,n); INSTR("push %d",n); }
138 #define PUSH_ATOM(a) { EMIT5(0x68,a); INSTR("push %a",a); }
139 #define PUSH_ATOMSTR(a,s) { EMIT5(0x68,a); INSTR("push %s",s); }
141 #define MOV_EAX_ATOM(atom) { EMIT5(0xB8,atom); INSTR("mov eax,%a",atom); }
142 #define MOV_ESI_CONST(n) { EMIT5(0xBE,n); INSTR("mov esi,%d",n); }
143 #define MOV_ESI_CONST(n) { EMIT5(0xBE,n); INSTR("mov esi,%d",n); }
144 #define MOV_EBX_CONST(n) { EMIT5(0xBB,n); INSTR("mov ebx,%d",n); }
146 #define MOV_EAX_EBP { EMIT2(0xE889); INSTR("mov eax,ebp"); }
147 #define MOV_EBP_ESP { EMIT2(0xE589); INSTR("mov ebp,esp"); }
148 #define MOV_ESP_EBP { EMIT2(0xEC89); INSTR("mov esp,ebp"); }
149 #define MOV_ESI_EBP { EMIT2(0xEE89); INSTR("mov esi,ebp"); }
151 #define MOV_EAX_MEM_ESP { EMIT3(0x048B,0x24); INSTR("mov eax,[esp]"); }
152 #define MOV_EAX_MEM_EBP(ofs) { EMIT3(0x458B,ofs); INSTR("mov eax,[ebp%p]",ofs); }
153 #define MOV_EAX_MEM_EAX(ofs) { EMIT3(0x408B,ofs); INSTR("mov eax,[eax%p]",ofs); }
154 #define MOV_EAX_MEM_OFS(ofs) { EMIT6(0x058B,ofs); INSTR("mov eax,[%d]",ofs); }
155 #define MOV_EBP_MEM_OFS(ofs) { EMIT6(0x2D8B,ofs); INSTR("mov ebp,[%d]",ofs); }
156 #define MOV_EBX_MEM_OFS(ofs) { EMIT6(0x1D8B,ofs); INSTR("mov ebp,[%d]",ofs); }
158 #define MOV_MEM_EBP_EAX(ofs) { EMIT6(0x8589,ofs); INSTR("mov [ebp%p],eax",ofs); }
159 #define MOV_MEM_ESI_EAX(ofs) { EMIT6(0x8689,ofs); INSTR("mov [esi%p],eax",ofs); }
160 #define MOV_MEM_OFS_EAX(ofs) { EMIT6(0x0589,ofs); INSTR("mov [%d],eax",ofs); }
161 #define MOV_MEM_OFS_EBP(ofs) { EMIT6(0x2D89,ofs); INSTR("mov [%d],ebp",ofs); }
162 #define MOV_MEM_OFS_CONST(ofs,n) {EMIT6(0x05C7,ofs); EMIT4(n); \
163 INSTR("mov [%d],%a", ofs, n); }
165 #define MOV_ESI_SSMEM_ESI_4 { EMIT4(0xFC768B36); INSTR("mov esi,ss:[esi-4]"); }
166 #define MOV_ESI_SSMEM_EBP_4 { EMIT4(0xFC758B36); INSTR("mov esi,ss:[ebp-4]"); }
168 #define INC_EAX_MEM(n) { EMIT3(0x40FF,n); INSTR("inc [eax%p]",n); }
169 #define DEC_EAX_MEM(n) { EMIT3(0x48FF,n); INSTR("dec [eax%p]",n); }
171 #define RET { EMIT1(0xC3); INSTR("ret"); }
173 #define ADD_EAX_CONST_4(n) { EMIT5(0x05,n); INSTR("add eax,%d",n); }
174 #define ADD_ESI_CONST_4(n) { EMIT6(0xC681,n); INSTR("add esi,%d",n); }
176 #define CMP_EBX_CONST(n) { EMIT3(0xFB83,n); INSTR("cmp ebx,%d",n); }
177 #define CMP_EAX_CONST(n) { EMIT5(0x3D,n); INSTR("cmp eax,%d",n); }
178 #define CMP_EAX_ATOM(a) { EMIT5(0x3D,a); INSTR("cmp eax,%l",a); }
179 #define CMP_ID_ERROR { EMIT2(0x7880); EMIT1(OFFSET_ID); EMIT1(ERROR_ID);\
180 INSTR("cmp [eax+ID],ERROR_ID"); }
181 #define CMP_MEM_EBP(ofs,val) { EMIT2(0x7D80); EMIT1(ofs); EMIT1(val);\
182 INSTR("cmp [eax%p],%d",ofs,val); }
183 #define CMP_MEM_OFS_CONST_4(ofs,n) { EMIT6(0x3D81,ofs); EMIT4(n); INSTR("cmp [%d],%a", ofs, n); }
184 #define CMP_MEM_OFS_CONST_1(ofs,n) { EMIT6(0x3D80,ofs); EMIT1(n); \
185 INSTR("cmp [%d],%d", ofs, n); }
188 #define JE_EXIT { EMIT6(0x840F,REL(EXIT)); INSTR("je exit"); }
189 #define JE(addr,name) { EMIT6(0x840F,REL(addr)); INSTR("je %s",name); }
190 #define JNE(addr,name) { EMIT6(0x850F,REL(addr)); INSTR("jne %s",name); }
191 #define JNZ(addr,name) { EMIT6(0x850F,REL(addr)); INSTR("jnz %s",name); }
193 #define JMP_EXIT { EMIT5(0xE9,REL(EXIT)); INSTR("jmp exit"); }
194 #define JMP(addr,name) { EMIT5(0xE9,REL(addr)); INSTR("jmp %s",name); }
195 #define JMP_ATOM(addr,name) { EMIT5(0xE9,REL(addr)); INSTR("jmp %a",name); }
196 #define JMP_EAX(name) { EMIT2(0xE0FF); INSTR("jmp %a",name); }
198 #define CALL(addr,name) { EMIT5(0xE8,REL(addr)); INSTR("call %s",name); }
199 #define CALL_ATOM(addr,name) { EMIT5(0xE8,REL(addr)); INSTR("call %a",name); }
201 #define CALL_MEM(addr,name) { EMIT6(0x15FF,addr); INSTR("call [%a]",name); }
202 #define CALL_MEM_EAX(addr,name) { EMIT6(0x90FF,addr); INSTR("call [eax+%s]",name); }
204 #define FSTPF_MEM_ESP { EMIT2(0x1CD9); EMIT1(0x24); INSTR("fstpf [esp]"); } // FSTP for float
205 #define FSTPD_MEM_ESP { EMIT2(0x1CDD); EMIT1(0x24); INSTR("fstpd [esp]"); } // FSTP for double
207 #define INT_3 { EMIT1(0xCC); INSTR("int 3"); }
208 #define NOP { EMIT1(0x90); INSTR("nop"); }
253 INFO(
"=========================" );
255 INFO(
"=========================" );
266 INFO(
"initialize system data" );
282 INFO(
"initialize local variables" );
300 INFO(
"check all inputs" );
366 INFO(
"free local variables" );
373 INFO(
"free system data" );
378 INFO(
"recover frame pointers" );
480 INFO(
"check for errors in proc %a",
CAR(source) );
501 INFO(
"check for errors in %a",
CAR(source) );
521 INFO(
"check for errors in func %a",
CAR(source) );
623 int addr = (int)&
VALUE(var);
631 REM(
"value of %a",
NAME(var) );
688 int addr = (int)&
VALUE(var);
700 INFO(
"assign new value to %a",
NAME(var) );
715 INFO(
"check for errors of %a",
CAR(source) );
745 int addr = (int)&
VALUE(var);
810 printf(
"This primitive is not defined yet -> ");
933 INFO(
"output current result" );
964 INFO(
"exit with no result" );
1002 INFO(
"check boolean result" );
1037 JE( 0,
TEXT(
"$else") );
REM(
"goto if-else block" );
1058 JMP( 0,
TEXT(
"ifend") );
REM(
"skip if-else block" );
1118 INFO(
"start bofy of repeat" );
1172 INFO(
"check validity of repeat count" );
1183 JE( 0,
TEXT(
"skip_repeat") );
1243 INFO(
"calculate next loop of repeat" );
1260 INFO(
"no more loops" );
1297 INFO(
"start bofy of forever" );
1323 INFO(
"calculate next loop of forever" );
1327 JMP( branch,
TEXT(
"forever") );
1386 REM(
"call as function" );
1388 REM(
"call as procedure" );
1514 INFO(
"test condition of while/until" );
1525 JE( 0, is_while?
TEXT(
"skip_while"):
TEXT(
"skip_until") );
1555 INFO(
"finalization of while/until" );
1556 JMP( loop_branch, is_while?
TEXT(
"while"):
TEXT(
"until") );
1648 INFO(
"start of catch block" );
1676 INFO(
"check result of catch block" );
1835 INFO(
"actual execution of run" );
1885 INFO(
"actual execution of runresult" );
1963 INFO(
"check validity of for count" );
1974 JE( 0,
TEXT(
"skip_for") );
2029 INFO(
"calculate next loop of for" );
2046 INFO(
"no more loops" );
2106 INFO(
"=========================" );
2107 INFO(
" EXTERNAL FUNCTION %a",
NAME(func) );
2108 INFO(
"=========================" );
2117 REM(
"clear error flag" );
2120 INFO(
"convert parameters to C-types" );
2151 INFO(
"call to external function" );
2155 INFO(
"check error flag" );
2158 JE( 0,
TEXT(
"$ok") );
REM(
"continue if no error" );
2166 INFO(
"convert function result" );
2218 INFO(
"=========================" );
2219 INFO(
" INTERNAL FUNCTION %a",
NAME(func) );
2220 INFO(
"=========================" );
2224 INFO(
"convert parameters to atoms" );
2249 INFO(
"call to internal function" );
2262 INFO(
"convert function result" );