primitives: key?, ms and time&date added

engine.c: time.h for ms and time&date included
bugs fixed to run tt.pfe

engine.c

 /*
-  $Id: engine.c,v 1.1 1994-02-11 16:30:46 anton Exp $
+  $Id: engine.c,v 1.2 1994-04-20 17:12:00 pazsan Exp $
   Copyright 1992 by the ANSI figForth Development Group
 */
 
@@ -12,6 +12,7 @@
 #include <fcntl.h>
 #include <assert.h>
 #include <stdlib.h>
+#include <time.h>
 #include "forth.h"
 #include "io.h"
 

extend.fs

@@ -16,6 +16,9 @@ decimal
 : 2r>   postpone r> postpone r> ; immediate restrict
 : 2r@   postpone 2r> postpone 2dup postpone 2>r ; immediate restrict
 
+: 2Literal  swap postpone Literal  postpone Literal ;
+  immediate restrict
+
 \ CASE OF ENDOF ENDCASE                                 17may93jaw
 
 \ just as described in dpANS5
@@ -64,7 +67,8 @@ decimal
 
 \ ERASE                                                 17may93jaw
 
-: erase 0 1 chars um/mod nip 0 fill ;
+: erase ( 0 1 chars um/mod nip )  0 fill ;
+: blank ( 0 1 chars um/mod nip ) bl fill ;
 
 \ ROLL                                                  17may93jaw
 

kernal.fs

@@ -268,7 +268,7 @@ Defer parser
 Defer name      ' (name) IS name
 Defer notfound
 
-: no.extensions  ( string -- )   IF &-13 bounce THEN ;
+: no.extensions  ( string -- )  IF  &-13 bounce  THEN ;
 
 ' no.extensions IS notfound
 
@@ -286,7 +286,7 @@ Defer notfound
 : compiler     ( name -- ) find  ?dup
   IF  0> IF  execute EXIT THEN compile, EXIT THEN number? dup
   IF  0> IF  swap postpone Literal  THEN  postpone Literal
-  ELSE  notfound  THEN ;
+  ELSE  drop notfound  THEN ;
 
 : [     ['] interpreter  IS parser state off ; immediate
 : ]     ['] compiler     IS parser state on  ;
@@ -486,8 +486,8 @@ Create ???  ," ???"
 : (Constant)  Header reveal [ :docon ] ALiteral cfa, ;
 : Constant  (Constant) , ;
 : AConstant (Constant) A, ;
-: 2CONSTANT ( w1 w2 "name" -- ) \ double
-    (constant) 2, ;
+: 2Constant ( w1 w2 "name" -- ) \ double
+  Create 2, DOES> 2@ ;
     
 \ IS Defer What's Defers TO                            24feb93py
 

locals.fs

@@ -6,18 +6,33 @@ Variable locals  here locals !  100 ( some) cells allot
   postpone Literal postpone + ;
 : delocal, ( offset -- ) local, postpone rp! ;
 : (local  DOES>  @ local, postpone @ ;
+: f>r  r> rp@ 1 floats - dup rp! f! >r ;
+: (flocal DOES>  @ local, postpone f@ ;
 
-: <local ( -- sys1 )  current @ @ loffset @ locals @ ;  immediate
+: do-nothing ;
+: ralign  r>
+  BEGIN  rp@ [ 1 floats 1- ] Literal and
+         WHILE  [ ' do-nothing >body ] ALiteral >r
+  REPEAT  >r ;
+
+: <local ( -- sys1 )  current @ @ loffset @ locals @
+  over 0= IF  postpone  ralign  THEN  ;                 immediate
 : local: ( -- )  postpone >r  last @ lastcfa @ here locals @ dp !
   cell loffset +! Create  loffset @ , immediate (local
   here locals !  dp !  lastcfa ! last ! ;               immediate
+: flocal: ( -- )  last @ lastcfa @ here locals @ dp !
+  BEGIN  loffset @ 0 1 floats fm/mod drop  WHILE
+         0 postpone Literal postpone >r  1 cells  loffset +!  REPEAT
+  postpone f>r  Create  loffset @ , immediate (flocal
+  here locals !  dp !  lastcfa ! last ! ;               immediate
 : local> ( sys1 -- sys2 ) ;                             immediate
 : local; ( sys2 -- ) locals ! dup delocal,
   loffset ! current @ ! ;                               immediate
 : TO  >in @ ' dup @ [ ' (local >body cell+ ] ALiteral =
   IF    >body @ local, postpone ! drop
-  ELSE  drop >in ! postpone to  THEN  ;                 immediate
-: EXIT  loffset @ IF  0 delocal,  THEN  postpone EXIT ; immediate
+  ELSE  dup @ [ ' (flocal >body cell+ ] ALiteral =
+        IF    >body @ local, postpone f!  drop
+        ELSE  drop >in ! postpone to  THEN THEN ;       immediate
 
 : DO      2 cells loffset +!  postpone DO     ; immediate restrict
 : ?DO     2 cells loffset +!  postpone ?DO    ; immediate restrict
@@ -36,6 +51,12 @@ Variable locals  here locals !  100 ( some) cells allot
   BEGIN  dup 0< 0= WHILE  >in ! postpone local:  REPEAT  drop
   r> >in ! postpone local> ;                  immediate restrict
 
+: F{ postpone <local  -1
+  BEGIN  >in @ name dup c@ 1 = swap 1+ c@ '| = and  UNTIL
+  drop >in @ >r
+  BEGIN  dup 0< 0= WHILE  >in ! postpone Flocal:  REPEAT  drop
+  r> >in ! postpone local> ;                  immediate restrict
+
 ' local; alias } immediate restrict
 
 \ ANS Locals                                           19aug93py
@@ -64,6 +85,7 @@ Create inlocal  5 cells allot  inlocal off
 
 : ;      ?local; postpone ; ;                 immediate restrict
 : DOES>  ?local; postpone DOES> ;             immediate
+: EXIT  inlocal @ IF  0 delocal,  THEN  postpone EXIT ; immediate
 
 : locals|
   BEGIN  name dup c@ 1 = over 1+ c@ '| = and 0=  WHILE

primitives

 /*
-$Id: primitives,v 1.1 1994-02-11 16:30:46 anton Exp $
+$Id: primitives,v 1.2 1994-04-20 17:12:06 pazsan Exp $
 Copyright 1992 by the ANSI figForth Development Group
 
 WARNING: This file is processed by m4. Make sure your identifiers
@@ -194,6 +194,10 @@ fflush(stdout);
 /* !! noecho */
 n = key();
 
+key?	-- n		fig	key_q
+fflush(stdout);
+n = key_query;
+
 cr	--		fig
 puts("");
 
@@ -591,6 +595,25 @@ wfileid=(Cell)popen(pname,mode[n]);
 pclose	wfileid -- wior	own
 wior=pclose((FILE *)wfileid);
 
+time&date	-- nyear nmonth nday nhour nmin nsec	ansi	time_and_date
+struct timeval time1;
+struct timezone zone1;
+struct tm *ltime;
+gettimeofday(&time1,&zone1);
+ltime=localtime(&time1.tv_sec);
+nyear =ltime->tm_year+1900;
+nmonth=ltime->tm_mon;
+nday  =ltime->tm_mday;
+nhour =ltime->tm_hour;
+nmin  =ltime->tm_min;
+nsec  =ltime->tm_sec;
+
+ms	n --	ansi
+struct timeval timeout;
+timeout.tv_sec=n/1000;
+timeout.tv_usec=1000*(n%1000);
+(void)select(0,0,0,0,&timeout);
+
 allocate	u -- a_addr wior	memory
 a_addr = (Cell *)malloc(u);
 wior = a_addr==NULL;	/* !! define a return code */

startup.fs

@@ -7,6 +7,7 @@ include float.fs
 include search-order.fs
 \ include toolsext.fs
 include wordinfo.fs
+include vt100.fs
 \ include colorize.fs
 include see.fs
 include bufio.fs