version 1.71, 2001/01/27 20:14:55
|
version 1.75, 2001/02/26 15:14:20
|
Line 72
|
Line 72
|
\ df_.* DFloat * |
\ df_.* DFloat * |
\ sf_.* SFloat * |
\ sf_.* SFloat * |
\ xt.* XT |
\ xt.* XT |
\ wid.* WID |
|
\ f83name.* F83Name * |
\ f83name.* F83Name * |
|
|
\E get-current prefixes set-current |
\E get-current prefixes set-current |
Line 91
|
Line 90
|
\E s" DFloat *" single data-stack type-prefix df_ |
\E s" DFloat *" single data-stack type-prefix df_ |
\E s" SFloat *" single data-stack type-prefix sf_ |
\E s" SFloat *" single data-stack type-prefix sf_ |
\E s" Xt" single data-stack type-prefix xt |
\E s" Xt" single data-stack type-prefix xt |
\E s" WID" single data-stack type-prefix wid |
|
\E s" struct F83Name *" single data-stack type-prefix f83name |
\E s" struct F83Name *" single data-stack type-prefix f83name |
\E s" struct Longname *" single data-stack type-prefix longname |
\E s" struct Longname *" single data-stack type-prefix longname |
\E |
\E |
Line 1187 f83name2=f83name1;
|
Line 1185 f83name2=f83name1;
|
r> @ |
r> @ |
REPEAT THEN nip nip ; |
REPEAT THEN nip nip ; |
: (find-samelen) ( u f83name1 -- u f83name2/0 ) |
: (find-samelen) ( u f83name1 -- u f83name2/0 ) |
BEGIN 2dup cell+ c@ $1F and <> WHILE @ dup 0= UNTIL THEN ; |
BEGIN 2dup cell+ c@ $1F and <> WHILE @ dup 0= UNTIL THEN ; |
|
|
\+hash |
\+hash |
|
|
Line 2288 for (; longname1 != NULL; longname1 = (s
|
Line 2286 for (; longname1 != NULL; longname1 = (s
|
break; |
break; |
longname2=longname1; |
longname2=longname1; |
: |
: |
BEGIN dup WHILE (find-samelen) dup WHILE |
BEGIN dup WHILE (findl-samelen) dup WHILE |
>r 2dup r@ cell+ char+ capscomp 0= |
>r 2dup r@ cell+ cell+ capscomp 0= |
IF 2drop r> EXIT THEN |
IF 2drop r> EXIT THEN |
r> @ |
r> @ |
REPEAT THEN nip nip ; |
REPEAT THEN nip nip ; |
: (find-samelen) ( u longname1 -- u longname2/0 ) |
: (findl-samelen) ( u longname1 -- u longname2/0 ) |
BEGIN 2dup cell+ c@ $1F and <> WHILE @ dup 0= UNTIL THEN ; |
BEGIN 2dup cell+ @ lcount-mask and <> WHILE @ dup 0= UNTIL THEN ; |
|
|
\+hash |
\+hash |
|
|
Line 2314 while(a_addr != NULL)
|
Line 2312 while(a_addr != NULL)
|
} |
} |
: |
: |
BEGIN dup WHILE |
BEGIN dup WHILE |
2@ >r >r dup r@ cell+ c@ $1F and = |
2@ >r >r dup r@ cell+ @ lcount-mask and = |
IF 2dup r@ cell+ char+ capscomp 0= |
IF 2dup r@ cell+ cell+ capscomp 0= |
IF 2drop r> rdrop EXIT THEN THEN |
IF 2drop r> rdrop EXIT THEN THEN |
rdrop r> |
rdrop r> |
REPEAT nip nip ; |
REPEAT nip nip ; |
Line 2337 while(a_addr != NULL)
|
Line 2335 while(a_addr != NULL)
|
} |
} |
: |
: |
BEGIN dup WHILE |
BEGIN dup WHILE |
2@ >r >r dup r@ cell+ c@ $1F and = |
2@ >r >r dup r@ cell+ @ lcount-mask and = |
IF 2dup r@ cell+ char+ -text 0= |
IF 2dup r@ cell+ cell+ -text 0= |
IF 2drop r> rdrop EXIT THEN THEN |
IF 2drop r> rdrop EXIT THEN THEN |
rdrop r> |
rdrop r> |
REPEAT nip nip ; |
REPEAT nip nip ; |
|
|
\+ |
\+ |
|
|
|
primtable ( -- wprimtable ) new |
|
""wprimtable is a table containing the xts of the primitives indexed |
|
by sequence-number in prim (for use in prepare-peephole-table)."" |
|
wprimtable = (Cell)primtable(symbols+DOESJUMP+1,MAX_SYMBOLS-DOESJUMP-1); |
|
|
|
prepare-peephole-table ( wprimtable -- wpeeptable ) new prepare_peephole_opt |
|
""wpeeptable is a data structure used by @code{peephole-opt}; it is |
|
constructed by combining a primitives table with a simple peephole |
|
optimization table."" |
|
wpeeptable = prepare_peephole_table((Xt *)wprimtable); |
|
|
|
peephole-opt ( xt1 xt2 wpeeptable -- xt ) new peephole_opt |
|
""xt is the combination of xt1 and xt2 (according to wpeeptable); if |
|
they cannot be combined, xt is 0."" |
|
xt = peephole_opt(xt1, xt2, wpeeptable); |
|
|
|
lit_plus = lit + |
|
|
|
call ( #a_callee -- R:a_retaddr ) |
|
""Call callee (a variant of docol with inline argument)."" |
|
a_retaddr = (Cell *)IP; |
|
SET_IP((Xt *)a_callee); |
|
|
|
useraddr ( #u -- a_addr ) |
|
a_addr = (Cell *)(up+u); |
|
|
|
|
|
|