--- gforth/prim	2001/12/25 16:55:10	1.87
+++ gforth/prim	2002/08/28 21:46:58	1.97
@@ -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
@@ -101,6 +104,7 @@
 \E inst-stream  stack-prefix #
 \E 
 \E set-current
+\E store-optimization on
 
 \ 
 \ 
@@ -179,7 +183,7 @@ SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
 define(condbranch,
 $1 ( `#'ndisp $2 ) $3
 $4	SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
-TAIL;
+INST_TAIL;
 }
 SUPER_CONTINUE;
 $5
@@ -189,7 +193,7 @@ $5
 $1-lp+!`#' ( `#'ndisp `#'nlocals $2 ) $3_lp_plus_store_number
 $4    lp += nlocals;
 SET_IP((Xt *)(((Cell)(IP-2))+ndisp));
-TAIL;
+INST_TAIL;
 }
 SUPER_CONTINUE;
 
@@ -216,7 +220,7 @@ if (f==0) {
   sp++;
   IF_spTOS(spTOS = sp[0]);
   SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
-  TAIL;
+  INST_TAIL;
 }
 SUPER_CONTINUE;
 
@@ -311,7 +315,7 @@ nlimit=0;
 (?do)	( #ndisp nlimit nstart -- R:nlimit R:nstart )	gforth	paren_question_do
 if (nstart == nlimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
-    TAIL;
+    INST_TAIL;
 }
 SUPER_CONTINUE;
 :
@@ -327,7 +331,7 @@ SUPER_CONTINUE;
 (+do)	( #ndisp nlimit nstart -- R:nlimit R:nstart )	gforth	paren_plus_do
 if (nstart >= nlimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
-    TAIL;
+    INST_TAIL;
 }
 SUPER_CONTINUE;
 :
@@ -343,7 +347,7 @@ SUPER_CONTINUE;
 (u+do)	( #ndisp ulimit ustart -- R:ulimit R:ustart )	gforth	paren_u_plus_do
 if (ustart >= ulimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
-    TAIL;
+    INST_TAIL;
 }
 SUPER_CONTINUE;
 :
@@ -359,7 +363,7 @@ SUPER_CONTINUE;
 (-do)	( #ndisp nlimit nstart -- R:nlimit R:nstart )	gforth	paren_minus_do
 if (nstart <= nlimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
-    TAIL;
+    INST_TAIL;
 }
 SUPER_CONTINUE;
 :
@@ -375,7 +379,7 @@ SUPER_CONTINUE;
 (u-do)	( #ndisp ulimit ustart -- R:ulimit R:ustart )	gforth	paren_u_minus_do
 if (ustart <= ulimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
-    TAIL;
+    INST_TAIL;
 }
 SUPER_CONTINUE;
 :
@@ -1356,7 +1360,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 +1367,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 +1374,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 +2167,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 +2175,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 +2209,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
@@ -2396,6 +2411,13 @@ xt = peephole_opt(xt1, xt2, wpeeptable);
 
 call	( #a_callee -- R:a_retaddr )	new
 ""Call callee (a variant of docol with inline argument).""
+#ifdef DEBUG
+    {
+      CFA_TO_NAME((((Cell *)a_callee)-2));
+      fprintf(stderr,"%08lx: call %08lx %.*s\n",(Cell)ip,(Cell)a_callee,
+	      len,name);
+    }
+#endif
 a_retaddr = (Cell *)IP;
 SET_IP((Xt *)a_callee);
 
@@ -2405,6 +2427,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)
 
 \+