added an experimental hash table (search/order.fs) (94adafcb) · Commits · Bernd Paysan / gforth

cross.fs

+13 −5

Original line number	Diff line number	Diff line
		\ CROSS.FS The Cross-Compiler 06oct92py
		\ $Id: cross.fs,v 1.4 1994-05-18 17:29:50 pazsan Exp $
		\ $Id: cross.fs,v 1.5 1994-06-01 10:05:14 pazsan Exp $
		\ Idea and implementation: Bernd Paysan (py)
		\ Copyright 1992 by the ANSI figForth Development Group

		@@ -23,6 +23,12 @@

		include other.fs \ ansforth extentions for cross

		: comment? ( c-addr u -- c-addr u )
		2dup s" (" compare 0=
		IF postpone (
		ELSE 2dup s" \" compare 0= IF postpone \ THEN
		THEN ;

		decimal

		\ number? 11may93jaw
		@@ -155,10 +161,10 @@ endian 0 pad ! -1 pad c! pad @ 0<
		\ Fixed bug in else part 11may93jaw

		[IFDEF] Memory \ Memory is a bigFORTH feature
		Memory
		also Memory
		: initmem ( var len -- )
		2dup swap handle! >r @ r> erase ;
		Target
		toss
		[ELSE]
		: initmem ( var len -- )
		tuck allocate abort" CROSS: No memory for target"
		@@ -263,8 +269,10 @@ Variable atonce atonce off
		: gfind ( string -- ghost true/1 / string false )
		\ searches for string in word-list ghosts
		\ !! wouldn't it be simpler to just use search-wordlist ? ae
		>r get-order 0 set-order also ghosts r> find >r >r
		set-order r> r@ IF >body THEN r> ;
		dup count [ ' ghosts >body ] ALiteral search-wordlist
		\ >r get-order 0 set-order also ghosts r> find >r >r
		>r r@ IF >body nip THEN r> ;
		\ set-order r> r@ IF >body THEN r> ;

		VARIABLE Already

engine.c

+2 −32

Original line number	Diff line number	Diff line
		/*
		$Id: engine.c,v 1.6 1994-05-18 17:29:52 pazsan Exp $
		$Id: engine.c,v 1.7 1994-06-01 10:05:15 pazsan Exp $
		Copyright 1992 by the ANSI figForth Development Group
		*/

		@@ -14,16 +14,10 @@
		#include <stdlib.h>
		#include <time.h>
		#include <sys/time.h>
		#include <sys/unistd.h>
		#include "forth.h"
		#include "io.h"

		#ifndef unlink
		extern unlink(char *);
		#endif
		#ifndef ftruncate
		extern ftruncate(int, int);
		#endif

		typedef union {
		struct {
		#ifdef BIG_ENDIAN
		@@ -87,30 +81,6 @@ int emitcounter;

		static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};

		#if ~defined(select) && defined(DOS)
		/* select replacement for DOS computers for ms only */
		void select(int n, int a, int b, int c, struct timeval * timeout)
		{
		struct timeval time1;
		struct timeval time2;
		struct timezone zone1;

		gettimeofday(&time1,&zone1);
		time1.tv_sec += timeout->tv_sec;
		time1.tv_usec += timeout->tv_usec;
		while(time1.tv_usec >= 1000000)
		{
		time1.tv_usec -= 1000000;
		time1.tv_sec++;
		}
		do
		{
		gettimeofday(&time2,&zone1);
		}
		while(time2.tv_usec < time1.tv_usec \|\| time2.tv_sec < time1.tv_sec);
		}
		#endif

		Label engine(Xt ip, Cell sp, Cell rp, Float *fp, Address lp)
		/* executes code at ip, if ip!=NULL
		returns array of machine code labels (for use in a loader), if ip==NULL

gforth.texi

+1 −1

Original line number	Diff line number	Diff line
		@@ -327,7 +327,7 @@ standard complying program and if you are using local variables in a
		word, forget about return stack manipulations in that word (see the
		standard document for the exact rules).

		@subsetion Data stack
		@subsection Data stack
		drop
		nip
		dup

glocals.fs

+6 −5

Original line number	Diff line number	Diff line
		@@ -74,6 +74,7 @@ include search-order.fs
		vocabulary locals \ this contains the local variables
		' locals >body Constant locals-list \ acts like a variable that contains
		\ a linear list of locals names
		: locals-list! ( list -- ) locals-list ! locals-list rehash ;

		create locals-buffer 1000 allot \ !! limited and unsafe
		\ here the names of the local variables are stored

kernal.fs

+16 −5

Original line number	Diff line number	Diff line
		@@ -131,6 +131,7 @@ Defer source
		dup count chars bounds
		?DO I c@ toupper I c! 1 chars +LOOP ;
		: (name) ( -- addr ) bl word ;
		: (cname) ( -- addr ) bl word capitalize ;

		\ Literal 17dec92py

		@@ -594,27 +595,35 @@ AVariable current

		\ word list structure:
		\ struct
		\ 1 cells: field find-method \ xt: ( c_addr u w1 -- name-id ) w1 is a method-\ specific wordlist-id (not the same as wid)
		\ 1 cells: field find-method \ xt: ( c_addr u wid -- name-id )
		\ 1 cells: field reveal-method \ xt: ( -- )
		\ 1 cells: field rehash-method \ xt: ( wid -- )
		\ \ !! what else
		\ end-struct wordlist-map-struct

		\ struct
		\ 1 cells: field wordlist-id \ not the same as wid; representation depends on implementation
		\ 1 cells: field wordlist-map \ pointer to a wordlist-map-struct
		\ 1 cells: field ????
		\ 1 cells: field ????
		\ 1 cells: field wordlist-link \ link field to other wordlists
		\ 1 cells: field wordlist-extend \ points to wordlist extensions (eg hash)
		\ end-struct wordlist-struct

		: f83find ( addr len wordlist -- nfa / false ) @ (f83find) ;
		: f83casefind ( addr len wordlist -- nfa / false ) @ (f83casefind) ;

		\ Search list table: find reveal
		Create f83search ' (f83find) A, ' (reveal) A,
		Create f83search ' f83casefind A, ' (reveal) A, ' drop A,

		: caps-name ['] (cname) IS name ['] f83find f83search ! ;
		: case-name ['] (name) IS name ['] f83casefind f83search ! ;
		: case-sensitive ['] (name) IS name ['] f83find f83search ! ;

		Create forth-wordlist NIL A, G f83search T A, NIL A, NIL A,
		AVariable search G forth-wordlist search T !
		G forth-wordlist current T !

		: (search-wordlist) ( addr count wid -- nfa / false )
		dup @ swap cell+ @ @ execute ;
		dup ( @ swap ) cell+ @ @ execute ;

		: search-wordlist ( addr count wid -- 0 / xt +-1 )
		(search-wordlist) dup IF found THEN ;
		@@ -644,6 +653,8 @@ Variable warnings G -1 warnings T !
		then
		current @ cell+ @ cell+ @ execute ;

		: rehash ( wid -- ) dup cell+ @ cell+ cell+ @ execute ;

		: ' ( "name" -- addr ) name find 0= no.extensions ;
		: ['] ( "name" -- addr ) ' postpone ALiteral ; immediate
		\ Input 13feb93py