--- gforth/prim 2002/01/04 20:31:53 1.88 +++ gforth/prim 2002/06/17 12:34:41 1.95 @@ -53,15 +53,18 @@ \ your code does not fall through, the results are not stored into the \ stack. Use different names on both sides of the '--', if you change a \ value (some stores to the stack are optimized away). -\ -\ +\ +\ For superinstructions the syntax is: +\ +\ forth-name [/ c-name] = forth-name forth-name ... +\ \ \ The stack variables have the following types: \ \ name matches type \ f.* Bool \ c.* Char -\ [nw].* Cell +\ [nw].* Cell \ u.* UCell \ d.* DCell \ ud.* UDCell @@ -1356,7 +1359,6 @@ a_addr = (Cell *)DOES_CODE(xt); 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); -CACHE_FLUSH(xt,(size_t)PFA(0)); : ! ; @@ -1364,7 +1366,6 @@ does-code! ( a_addr xt -- ) gforth does ""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); -CACHE_FLUSH(xt,(size_t)PFA(0)); : dodoes: over ! cell+ ! ; @@ -1372,7 +1373,6 @@ does-handler! ( a_addr -- ) gforth does_ ""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); -CACHE_FLUSH((caddr_t)a_addr,DOES_HANDLER_SIZE); : drop ; @@ -2166,7 +2166,7 @@ Variable UP wcall ( u -- ) gforth IF_fpTOS(fp[0]=fpTOS); FP=fp; -sp=(Cell*)(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP); +sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); fp=FP; IF_spTOS(spTOS=sp[0];) IF_fpTOS(fpTOS=fp[0]); @@ -2174,10 +2174,23 @@ IF_fpTOS(fpTOS=fp[0]); \+file open-dir ( c_addr u -- wdirid wior ) gforth open_dir +""Open the directory specified by @i{c-addr, u} +and return @i{dir-id} for futher access to it."" wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1)); wior = IOR(wdirid == 0); read-dir ( c_addr u1 wdirid -- u2 flag wior ) gforth read_dir +""Attempt to read the next entry from the directory specified +by @i{dir-id} to the buffer of length @i{u1} at address @i{c-addr}. +If the attempt fails because there is no more entries, +@i{ior}=0, @i{flag}=0, @i{u2}=0, and the buffer is unmodified. +If the attempt to read the next entry fails because of any other reason, +return @i{ior}<>0. +If the attempt succeeds, store file name to the buffer at @i{c-addr} +and return @i{ior}=0, @i{flag}=true and @i{u2} equal to the size of the file name. +If the length of the file name is greater than @i{u1}, +store first @i{u1} characters from file name into the buffer and +indicate "name too long" with @i{ior}, @i{flag}=true, and @i{u2}=@i{u1}."" struct dirent * dent; dent = readdir((DIR *)wdirid); wior = 0; @@ -2195,6 +2208,7 @@ if(dent == NULL) { } close-dir ( wdirid -- wior ) gforth close_dir +""Close the directory specified by @i{dir-id}."" wior = IOR(closedir((DIR *)wdirid)); filename-match ( c_addr1 u1 c_addr2 u2 -- flag ) gforth match_file @@ -2412,6 +2426,28 @@ a_addr = (Cell *)(up+u); compile-prim ( xt1 -- xt2 ) new compile_prim xt2 = (Xt)compile_prim((Label)xt1); +lit@ / lit_fetch = lit @ + +lit-perform ( #a_addr -- ) new lit_perform +ip=IP; +SUPER_END; +EXEC(*(Xt *)a_addr); + +lit+ / lit_plus = lit + + +does-exec ( #a_cfa -- R:nest a_pfa ) new does_exec +a_pfa = PFA(a_cfa); +nest = (Cell)ip; +IF_spTOS(spTOS = sp[0]); +#ifdef DEBUG + { + CFA_TO_NAME(a_cfa); + fprintf(stderr,"%08lx: does %08lx %.*s\n", + (Cell)ip,(Cell)a_cfa,len,name); + } +#endif +SET_IP(DOES_CODE1(a_cfa)); + include(peeprules.vmg) \+