--- gforth/prim 2003/08/20 13:29:19 1.140 +++ gforth/prim 2003/09/14 21:16:48 1.144 @@ -148,7 +148,7 @@ undefine(`symbols') (docol) ( -- R:a_retaddr ) gforth-internal paren_docol ""run-time routine for colon definitions"" -a_retaddr = (Cell *)ip; +a_retaddr = (Cell *)IP; SET_IP((Xt *)PFA(CFA)); (docon) ( -- w ) gforth-internal paren_docon @@ -165,7 +165,8 @@ a_user = (Cell *)(up+*(Cell *)PFA(CFA)); (dodefer) ( -- ) gforth-internal paren_dodefer ""run-time routine for deferred words"" -SUPER_END; +ip=IP; /* undo any ip updating that may have been performed by NEXT_P0 */ +SUPER_END; /* !! probably unnecessary and may lead to measurement errors */ EXEC(*(Xt *)PFA(CFA)); (dofield) ( n1 -- n2 ) gforth-internal paren_field @@ -174,7 +175,7 @@ n2 = n1 + *(Cell *)PFA(CFA); (dodoes) ( -- a_body R:a_retaddr ) gforth-internal paren_dodoes ""run-time routine for @code{does>}-defined words"" -a_retaddr = (Cell *)ip; +a_retaddr = (Cell *)IP; a_body = PFA(CFA); SET_IP(DOES_CODE1(CFA)); @@ -637,6 +638,10 @@ n = compare(c_addr1, u1, c_addr2, u2); : rot 2dup swap - >r min swap -text dup IF rdrop ELSE drop r> sgn THEN ; +: -text ( c_addr1 u c_addr2 -- n ) + swap bounds + ?DO dup c@ I c@ = WHILE 1+ LOOP drop 0 + ELSE c@ I c@ - unloop THEN sgn ; : sgn ( n -- -1/0/1 ) dup 0= IF EXIT THEN 0< 2* 1+ ; @@ -1395,6 +1400,14 @@ longname2=listlfind(c_addr, u, longname1 REPEAT THEN nip nip ; : (findl-samelen) ( u longname1 -- u longname2/0 ) BEGIN 2dup cell+ @ lcount-mask and <> WHILE @ dup 0= UNTIL THEN ; +: capscomp ( c_addr1 u c_addr2 -- n ) + swap bounds + ?DO dup c@ I c@ <> + IF dup c@ toupper I c@ toupper = + ELSE true THEN WHILE 1+ LOOP drop 0 + ELSE c@ toupper I c@ toupper - unloop THEN sgn ; +: sgn ( n -- -1/0/1 ) + dup 0= IF EXIT THEN 0< 2* 1+ ; \+hash @@ -2266,6 +2279,14 @@ u3 = 0; # endif #endif +wcall ( u -- ) gforth +IF_fpTOS(fp[0]=fpTOS); +FP=fp; +sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); +fp=FP; +IF_spTOS(spTOS=sp[0];) +IF_fpTOS(fpTOS=fp[0]); + \+FFCALL av-start-void ( c_addr -- ) gforth av_start_void @@ -2415,7 +2436,9 @@ va-return-double ( r -- ) gforth va_retu va_return_double(clist, r); return 0; -\- +\+ + +\+OLDCALL define(`uploop', `pushdef(`$1', `$2')_uploop(`$1', `$2', `$3', `$4', `$5')`'popdef(`$1')') @@ -2456,18 +2479,10 @@ fcall(20) \+ \+ -wcall ( u -- ) gforth -IF_fpTOS(fp[0]=fpTOS); -FP=fp; -sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); -fp=FP; -IF_spTOS(spTOS=sp[0];) -IF_fpTOS(fpTOS=fp[0]); +\g peephole \+peephole -\g peephole - compile-prim1 ( a_prim -- ) gforth compile_prim1 ""compile prim (incl. immargs) at @var{a_prim}"" compile_prim1(a_prim);