Commit 4092edec authored by Bernd Paysan's avatar Bernd Paysan
Browse files

primitives: key?, ms and time&date added 

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

engine.c

+2 −1
Original line number Diff line number Diff line 
/*

  $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

+5 −1
Original line number Diff line number Diff line
@@ -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

+4 −4
Original line number Diff line number Diff line
@@ -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

+25 −3
Original line number Diff line number Diff line
@@ -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

+24 −1
Original line number Diff line number Diff line 
/*

$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 */