--- gforth/prim 2003/01/07 22:38:36 1.114 +++ gforth/prim 2003/01/10 21:19:59 1.120 @@ -1404,13 +1404,6 @@ while(a_addr != NULL) rdrop r> REPEAT nip nip ; -(hashkey) ( c_addr u1 -- u2 ) gforth paren_hashkey -u2=0; -while(u1--) - u2+=(Cell)toupper(*c_addr++); -: - 0 -rot bounds ?DO I c@ toupper + LOOP ; - (hashkey1) ( c_addr u ubits -- ukey ) gforth paren_hashkey1 ""ukey is the hash key for the string c_addr u fitting in ubits bits"" /* this hash function rotates the key at every step by rot bits within @@ -1473,58 +1466,8 @@ f_addr = (Float *)((((Cell)c_addr)+(size : [ 1 floats 1- ] Literal + [ -1 floats ] Literal and ; ->body ( xt -- a_addr ) core to_body -"" Get the address of the body of the word represented by @i{xt} (the address -of the word's data field)."" -a_addr = PFA(xt); -: - 2 cells + ; - \ threading stuff is currently only interesting if we have a compiler \fhas? standardthreading has? compiler and [IF] - ->code-address ( xt -- c_addr ) gforth to_code_address -""@i{c-addr} is the code address of the word @i{xt}."" -/* !! This behaves installation-dependently for DOES-words */ -c_addr = (Address)CODE_ADDRESS(xt); -: - @ ; - ->does-code ( xt -- a_addr ) gforth to_does_code -""If @i{xt} is the execution token of a child of a @code{DOES>} word, -@i{a-addr} is the start of the Forth code after the @code{DOES>}; -Otherwise @i{a-addr} is 0."" -a_addr = (Cell *)DOES_CODE(xt); -: - cell+ @ ; - -code-address! ( c_addr xt -- ) gforth code_address_store -""Create a code field with code address @i{c-addr} at @i{xt}."" -MAKE_CF(xt, c_addr); -: - ! ; - -does-code! ( a_addr xt -- ) gforth does_code_store -""Create a code field at @i{xt} for a child of a @code{DOES>}-word; -@i{a-addr} is the start of the Forth code after @code{DOES>}."" -MAKE_DOES_CF(xt, a_addr); -: - dodoes: over ! cell+ ! ; - -does-handler! ( a_addr -- ) gforth does_handler_store -""Create a @code{DOES>}-handler at address @i{a-addr}. Normally, -@i{a-addr} points just behind a @code{DOES>}."" -MAKE_DOES_HANDLER(a_addr); -: - drop ; - -/does-handler ( -- n ) gforth slash_does_handler -""The size of a @code{DOES>}-handler (includes possible padding)."" -/* !! a constant or environmental query might be better */ -n = DOES_HANDLER_SIZE; -: - 2 cells ; - threading-method ( -- n ) gforth threading_method ""0 if the engine is direct threaded. Note that this may change during the lifetime of an image."" @@ -1886,10 +1829,11 @@ flag = FLAG(!fnmatch(pattern, string, 0) newline ( -- c_addr u ) gforth ""String containing the newline sequence of the host OS"" char newline[] = { -#if defined(unix) || defined(__MACH__) -/* Darwin/MacOS X sets __MACH__, but not unix. */ +#if DIRSEP=='/' +/* Unix */ '\n' #else +/* DOS, Win, OS/2 */ '\r','\n' #endif }; @@ -2454,23 +2398,6 @@ xt = peephole_opt(xt1, xt2, wpeeptable); compile-prim ( xt1 -- xt2 ) obsolete compile_prim xt2 = (Xt)compile_prim((Label)xt1); -\ set-next-code and call2 do not appear in images and can be -\ renumbered arbitrarily - -set-next-code ( #w -- ) gforth set_next_code -#ifdef NO_IP -next_code = (Label)w; -#endif - -call2 ( #a_callee #a_ret_addr -- R:a_ret_addr ) gforth -/* call with explicit return address */ -#ifdef NO_IP -INST_TAIL; -JUMP(a_callee); -#else -assert(0); -#endif - compile-prim1 ( a_prim -- ) gforth compile_prim1 ""compile prim (incl. immargs) at @var{a_prim}"" compile_prim1(a_prim); @@ -2488,6 +2415,23 @@ decompile-prim ( a_code -- a_prim ) gfor compile_prim1ed to a_code"" a_prim = (Label)decompile_code((Label)a_code); +\ set-next-code and call2 do not appear in images and can be +\ renumbered arbitrarily + +set-next-code ( #w -- ) gforth set_next_code +#ifdef NO_IP +next_code = (Label)w; +#endif + +call2 ( #a_callee #a_ret_addr -- R:a_ret_addr ) gforth +/* call with explicit return address */ +#ifdef NO_IP +INST_TAIL; +JUMP(a_callee); +#else +assert(0); +#endif + \+ include(peeprules.vmg)