1 /******************************************************************************
2 * Copyright (c) 2004, 2008 IBM Corporation
4 * This program and the accompanying materials
5 * are made available under the terms of the BSD License
6 * which accompanies this distribution, and is available at
7 * http://www.opensource.org/licenses/bsd-license.php
10 * IBM Corporation - initial implementation
11 *****************************************************************************/
15 // Copyright 2002,2003,2004 Segher Boessenkool <segher@kernel.crashing.org>
19 #define NEXT00 goto *cfa->a
20 #define NEXT0 cfa = ip->a; NEXT00
21 #define NEXT ip++; NEXT0
23 #define PRIM(name) code_##name: { \
24 asm volatile ("#### " #name : : : "memory"); \
25 void *w = (cfa = (++ip)->a)->a;
26 #define MIRP goto *w; }
35 // These macros could be replaced to allow for TOS caching etc.
42 #define RNOS (*(rp-1))
49 // For terminal input.
50 PRIM(TIB) PUSH; TOS.a = the_tib; MIRP
52 // For pockets (temporary string buffers).
53 PRIM(POCKETS) PUSH; TOS.a = the_pockets; MIRP
55 // exception register area
56 PRIM(EREGS) PUSH; TOS.a = the_exception_frame; MIRP
58 // client register area
59 PRIM(CIREGS) PUSH; TOS.a = the_client_frame; MIRP
62 // (According to the PowerPC ABI the stack-pointer points to the
63 // lowest **USED** value.
64 // I.e. it is decremented before a new element is stored on the
66 PRIM(CISTACK) PUSH; TOS.a = the_client_stack
67 + (sizeof(the_client_stack) / CELLSIZE); MIRP
69 // compile-in-interpret buffer
70 PRIM(COMP_X2d_BUFFER) PUSH; TOS.a = the_comp_buffer; MIRP
72 // Paflof base address
73 PRIM(PAFLOF_X2d_START) PUSH; TOS.a = _start_OF; MIRP
76 PRIM(HEAP_X2d_START) PUSH; TOS.a = the_heap_start; MIRP
77 PRIM(HEAP_X2d_END) PUSH; TOS.a = the_heap_end; MIRP
80 PRIM(FDT_X2d_START) PUSH; TOS.u = fdt_start; MIRP
83 PRIM(ROMFS_X2d_BASE) PUSH; TOS.u = romfs_base; MIRP
85 // if the low level firmware is epapr compliant it will put the
86 // epapr magic into r6 before starting paflof
87 // epapr-magic is a copy of r6
88 PRIM(EPAPR_X2d_MAGIC) PUSH; TOS.u = epapr_magic; MIRP
90 // Initially mapped area size (for ePAPR compliant LLFW)
91 PRIM(EPAPR_X2d_IMA_X2d_SIZE) PUSH; TOS.u = epapr_ima_size; MIRP
104 PUSH; TOS.a = cfa + 2;
131 dp->n += (cfa + 1)->n;
152 type_n dis = (++ip)->n;
153 ip = (cell *)((type_u)ip + dis);
158 type_n dis = (++ip)->n;
160 ip = (cell *)((type_u)ip + dis);
165 // Jump to "defer BP"
169 ip = (cell * ) xt_BP+2;
191 PRIM(DUP) cell x = TOS; PUSH; TOS = x; MIRP
192 PRIM(OVER) cell x = NOS; PUSH; TOS = x; MIRP
193 PRIM(PICK) TOS = *(dp - TOS.n - 1); MIRP
199 PRIM(SWAP) cell x = NOS; NOS = TOS; TOS = x; MIRP
202 PRIM(_X3e_R) RPUSH; RTOS = TOS; POP; MIRP
203 PRIM(R_X3e) PUSH; TOS = RTOS; RPOP; MIRP
204 PRIM(R_X40) PUSH; TOS = RTOS; MIRP
207 PRIM(DEPTH) PUSH; TOS.u = dp - the_data_stack; MIRP
208 PRIM(DEPTH_X21) dp = the_data_stack + TOS.u - 1; MIRP
209 PRIM(RDEPTH) PUSH; TOS.u = rp - the_return_stack + 1; MIRP
210 PRIM(RDEPTH_X21) rp = the_return_stack + TOS.u - 1; POP; MIRP
211 PRIM(RPICK) TOS = *(rp - TOS.n); MIRP
214 PRIM(_X2b) NOS.u += TOS.u; POP; MIRP
215 PRIM(_X2d) NOS.u -= TOS.u; POP; MIRP
216 PRIM(_X2a) NOS.u *= TOS.u; POP; MIRP
219 PRIM(LSHIFT) NOS.u <<= TOS.u; POP; MIRP
220 PRIM(RSHIFT) NOS.u >>= TOS.u; POP; MIRP
221 PRIM(ASHIFT) NOS.n >>= TOS.u; POP; MIRP
222 PRIM(AND) NOS.u &= TOS.u; POP; MIRP
223 PRIM(OR) NOS.u |= TOS.u; POP; MIRP
224 PRIM(XOR) NOS.u ^= TOS.u; POP; MIRP
227 #define GET_TYPE1(t) { \
228 t *restrict a = (t *restrict)(TOS.a); \
231 #define GET_TYPE2(t) \
234 #define GET_TYPE3(t) \
238 #define PUT_TYPE1(t) { \
239 t *restrict a = TOS.a; \
244 #define PUT_TYPE2(t) \
248 #define GET_CELL1 GET_TYPE1(type_u)
249 #define PUT_CELL1 PUT_TYPE1(type_u)
250 #define GET_CHAR1 GET_TYPE1(type_c)
251 #define PUT_CHAR1 PUT_TYPE1(type_c)
252 #define GET_WORD1 GET_TYPE1(type_w)
253 #define PUT_WORD1 PUT_TYPE1(type_w)
254 #define GET_LONG1 GET_TYPE1(type_l)
255 #define PUT_LONG1 PUT_TYPE1(type_l)
256 #define GET_XONG1 GET_TYPE1(type_u)
257 #define PUT_XONG1 PUT_TYPE1(type_u)
259 #define GET_CELL2 GET_TYPE2(type_u)
260 #define PUT_CELL2 PUT_TYPE2(type_u)
261 #define GET_CHAR2 GET_TYPE2(type_c)
262 #define PUT_CHAR2 PUT_TYPE2(type_c)
263 #define GET_WORD2 GET_TYPE2(type_w)
264 #define PUT_WORD2 PUT_TYPE2(type_w)
265 #define GET_LONG2 GET_TYPE2(type_l)
266 #define PUT_LONG2 PUT_TYPE2(type_l)
267 #define GET_XONG2 GET_TYPE2(type_u)
268 #define PUT_XONG2 PUT_TYPE2(type_u)
270 #define GET_CELL3 GET_TYPE3(type_u)
271 #define GET_CHAR3 GET_TYPE3(type_c)
272 #define GET_WORD3 GET_TYPE3(type_w)
273 #define GET_LONG3 GET_TYPE3(type_l)
274 #define GET_XONG3 GET_TYPE3(type_u)
276 #define GET_CELL GET_CELL1 GET_CELL2 GET_CELL3
277 #define PUT_CELL PUT_CELL1 PUT_CELL2
278 #define GET_CHAR GET_CHAR1 GET_CHAR2 GET_CHAR3
279 #define PUT_CHAR PUT_CHAR1 PUT_CHAR2
280 #define GET_WORD GET_WORD1 GET_WORD2 GET_WORD3
281 #define PUT_WORD PUT_WORD1 PUT_WORD2
282 #define GET_LONG GET_LONG1 GET_LONG2 GET_LONG3
283 #define PUT_LONG PUT_LONG1 PUT_LONG2
284 #define GET_XONG GET_XONG1 GET_XONG2 GET_XONG3
285 #define PUT_XONG PUT_XONG1 PUT_XONG2
287 PRIM(_X40) GET_CELL; MIRP
288 PRIM(_X21) PUT_CELL; MIRP
289 PRIM(C_X40) GET_CHAR; MIRP
290 PRIM(C_X21) PUT_CHAR; MIRP
291 PRIM(W_X40) GET_WORD; MIRP
292 PRIM(W_X21) PUT_WORD; MIRP
293 PRIM(L_X40) GET_LONG; MIRP
294 PRIM(L_X21) PUT_LONG; MIRP
295 PRIM(X_X40) GET_XONG; MIRP
296 PRIM(X_X21) PUT_XONG; MIRP
299 #define UGET_TYPE1(t) { \
300 type_c *restrict a = (type_c *restrict)(TOS.a); \
302 type_c *restrict c = (type_c *restrict)&b;
304 #define UGET_TYPE2(t) \
308 #define UGET_TYPE3(t) \
312 #define UPUT_TYPE1(t) { \
313 type_c *restrict a = (type_c *restrict)(TOS.a); \
315 type_c *restrict c = (type_c *restrict)&b; \
319 #define UPUT_TYPE2(t) \
323 #define UPUT_TYPE3(t) }
325 #define UGET_WORD1 UGET_TYPE1(type_w)
326 #define UPUT_WORD1 UPUT_TYPE1(type_w)
327 #define UGET_WORD2 UGET_TYPE2(type_w)
328 #define UPUT_WORD2 UPUT_TYPE2(type_w)
329 #define UGET_WORD3 UGET_TYPE3(type_w)
330 #define UPUT_WORD3 UPUT_TYPE3(type_w)
331 #define UGET_LONG1 UGET_TYPE1(type_l)
332 #define UPUT_LONG1 UPUT_TYPE1(type_l)
333 #define UGET_LONG2 UGET_TYPE2(type_l)
334 #define UPUT_LONG2 UPUT_TYPE2(type_l)
335 #define UGET_LONG3 UGET_TYPE3(type_l)
336 #define UPUT_LONG3 UPUT_TYPE3(type_l)
338 #define UGET_WORD UGET_WORD1 UGET_WORD2 UGET_WORD3
339 #define UPUT_WORD UPUT_WORD1 UPUT_WORD2 UPUT_WORD3
340 #define UGET_LONG UGET_LONG1 UGET_LONG2 UGET_LONG2 UGET_LONG3
341 #define UPUT_LONG UPUT_LONG1 UPUT_LONG2 UPUT_LONG2 UPUT_LONG3
343 PRIM(UNALIGNED_X2d_W_X40) UGET_WORD; MIRP
344 PRIM(UNALIGNED_X2d_W_X21) UPUT_WORD; MIRP
345 PRIM(UNALIGNED_X2d_L_X40) UGET_LONG; MIRP
346 PRIM(UNALIGNED_X2d_L_X21) UPUT_LONG; MIRP
350 PRIM(_X3c) NOS.n = -(NOS.n < TOS.n); POP; MIRP
351 PRIM(U_X3c) NOS.n = -(NOS.u < TOS.u); POP; MIRP
352 PRIM(0_X3c) TOS.n = -(TOS.n < 0); MIRP
353 PRIM(_X3d) NOS.n = -(NOS.u == TOS.u); POP; MIRP
354 PRIM(0_X3d) TOS.n = -(TOS.u == 0); MIRP
362 PRIM(DODO) RPUSH; RTOS = NOS; RPUSH; RTOS = TOS; POP; POP; MIRP
367 type_n dis = (++ip)->n;
369 ip = (cell *restrict)((type_c *restrict)ip + dis);
378 type_n dis = (++ip)->n;
380 if (rp->n == (rp - 1)->n)
383 ip = (cell *restrict)((type_c *restrict)ip + dis);
390 type_n dis = (++ip)->n;
400 if ((type_u)((rp - 1)->n - 1 - lo) < hi - lo)
403 ip = (cell *restrict)((type_c *restrict)ip + dis);
408 type_n dis = (++ip)->n;
410 ip = (cell *restrict)((type_c *restrict)ip + dis);
415 type_n dis = (++ip)->n;
418 ip = (cell *restrict)((type_c *restrict)ip + dis);
441 code_EXECUTE: // don't need this as prim
449 type_u n = TOS.u; POP;
450 unsigned char *q = TOS.a; POP;
451 unsigned char *p = TOS.a; POP;
458 unsigned char c = (dp--)->u;
459 type_n size = ((dp--)->n);
460 unsigned char *d = (unsigned char *)((dp--)->u);
461 type_u fill_v=c | c <<8;
463 fill_v |= fill_v << 16;
464 switch (((type_u)d | (type_u)size) & (sizeof(type_u)-1)) {
466 type_u *up = (type_u *)d;
467 #if (__LONG_MAX__ > 2147483647L)
468 fill_v |= fill_v << 32;
470 while ((size-=sizeof(type_u)) >= 0)
473 case sizeof(type_l): {
474 type_l *lp = (type_l *)d;
476 while ((size-=sizeof(type_l)) >= 0)
477 *lp++ = (type_l)fill_v;
479 case sizeof(type_w): {
480 type_w *wp = (type_w *)d;
482 while ((size-=sizeof(type_w)) >= 0)
483 *wp++ = (type_w)fill_v;
487 *d++ = (unsigned char)c;
494 type_n len = ((dp--)->n);
495 unsigned char *addr2 = (unsigned char *)((dp--)->u);
496 unsigned char *addr1 = (unsigned char *)((dp--)->u);
499 if (*addr1 > *addr2) {
503 else if (*addr1 < *addr2) {
516 type_u size = ((dp--)->u);
517 type_u *d = (type_u *)((dp--)->u);
518 type_u *s = (type_u *)((dp--)->u);
519 _FASTRMOVE(s, d, size);
524 // String compare, case insensitive:
525 // : string=ci ( str1 len1 str2 len2 -- equal? )
527 type_u l2 = TOS.u; POP;
528 unsigned char *p2 = TOS.a; POP;
529 type_u l1 = TOS.u; POP;
530 unsigned char *p1 = TOS.a;
533 TOS.n = -1; /* Default to TRUE */
535 if (toupper(*p1) != toupper(*p2)) {
548 // bool dependend pick
549 // ?PICK ( v1 v2 bool -- v1|v2 )
551 type_u b = TOS.u; POP;
552 if (b) { NOS = TOS; }
556 /* zcount ( zstr -- str len ) */
558 type_u len = strlen(TOS.a);
563 memset(hash_table, 0, sizeof(hash_table));
571 /* hash ( str len -- hash )
572 * this word is used in find-hash.fs to create
573 * a hash to accelerate word lookup */
575 type_u len = TOS.u; POP;
576 unsigned char *str = TOS.a;
581 hash ^= tolower(*str);
585 /* we only want hash values which size is smaller
587 hash &= HASHSIZE - 1;
588 /* access the hash table in steps of CELLSIZE */
590 /* return a pointer for this hash in the hash table */
591 TOS.a = hash_table + hash;