Commit 94adafcb authored by pazsan's avatar pazsan

added an experimental hash table (search/order.fs)

allowed the user to select caps-stored names or even case-
sensitive search.
Made gforth.texi compilable.
parent 2c6934a3
\ 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
......
/*
$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
......
......@@ -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
......
......@@ -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
......@@ -412,7 +413,7 @@ variable dead-code \ true if normal code at "here" would be dead
else
0 0
endif
locals-list !
locals-list!
locals-size ! ;
: check-begin ( list -- )
......@@ -446,12 +447,12 @@ variable dead-code \ true if normal code at "here" would be dead
dead-code @
if
>resolve
locals-list !
locals-list!
locals-size !
else
locals-size @ 3 roll - compile-lp+!#
>resolve
locals-list @ common-list locals-list !
locals-list @ common-list locals-list!
locals-size @ locals-list @ list-size - compile-lp+!#
endif
dead-code off ; immediate
......@@ -461,7 +462,7 @@ variable dead-code \ true if normal code at "here" would be dead
: endscope ( dest -- )
drop
locals-list @ common-list locals-list !
locals-list @ common-list locals-list!
locals-size @ locals-list @ list-size - compile-lp+!#
drop ; immediate
......@@ -622,7 +623,7 @@ variable leave-sp leave-stack leave-sp !
clear-leave-stack
0 locals-size !
locals-buffer locals-dp !
0 locals-list ! ; ( clear locals vocabulary )
0 locals-list! ; ( clear locals vocabulary )
: locals-;-hook ( sys addr xt -- sys )
0 TO locals-wordlist
......
......@@ -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
......
......@@ -621,7 +621,14 @@ wior = a_addr2==NULL; /* !! Define a return code */
(f83find) c_addr u f83name1 -- f83name2 new paren_f83find
for (; f83name1 != NULL; f83name1 = f83name1->next)
if (F83NAME_COUNT(f83name1)==u && !F83NAME_SMUDGE(f83name1) &&
if (F83NAME_COUNT(f83name1)==u &&
strncmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
break;
f83name2=f83name1;
(f83casefind) c_addr u f83name1 -- f83name2 new paren_f83casefind
for (; f83name1 != NULL; f83name1 = f83name1->next)
if (F83NAME_COUNT(f83name1)==u &&
strncasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
break;
f83name2=f83name1;
......@@ -817,7 +824,7 @@ else
represent r c_addr u -- n f1 f2 float
char *sig;
int flag;
sig=ecvt(r, u, &n, &flag);
sig=ecvt(r, u, (int *)&n, &flag);
f1=FLAG(flag!=0);
f2=FLAG(isdigit(sig[0])!=0);
memmove(c_addr,sig,u);
......@@ -829,7 +836,7 @@ char number[u+1];
char *endconv;
cstr(number, c_addr, u);
r=strtod(number,&endconv);
if(flag=FLAG(!(int)*endconv))
if((flag=FLAG(!(int)*endconv)))
{
IF_FTOS(fp[0] = FTOS);
fp += -1;
......@@ -839,7 +846,7 @@ else if(*endconv=='d' || *endconv=='D')
{
*endconv='E';
r=strtod(number,&endconv);
if(flag=FLAG(!(int)*endconv))
if((flag=FLAG(!(int)*endconv)))
{
IF_FTOS(fp[0] = FTOS);
fp += -1;
......@@ -978,4 +985,4 @@ lp -= sizeof(Float);
*(Float *)lp = r;
up! a_addr -- new up_store
up=a_addr;
up=(char *)a_addr;
......@@ -2,8 +2,8 @@
$10 constant maxvp
Variable vp
0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A,
0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A,
0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A,
0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A,
: get-current ( -- wid ) current @ ;
: set-current ( wid -- ) current ! ;
......@@ -11,12 +11,57 @@ Variable vp
: context ( -- addr ) vp dup @ cells + ;
: definitions ( -- ) context @ current ! ;
\ hash search 29may94py
\ uses a direct hash mapped cache --- idea from Heinz Schnitter
: hashkey ( addr count -- key )
swap c@ toupper 3 * + $3F and ; \ gives a simple hash key
Variable hits
Variable fails
: hash-find ( addr count wid -- nfa / false )
>r 2dup hashkey
cells r@ 3 cells + @ + \ hashed addr
dup @
IF >r r@ @ cell+ c@ over =
IF 2dup r@ @ cell+ char+ capscomp 0=
IF 2drop r> @ rdrop 1 hits +! EXIT THEN THEN
r>
THEN r> swap >r @ (f83casefind) dup
IF dup r@ ! THEN rdrop 1 fails +! ;
: hash-reveal ( -- )
last?
IF dup cell+ count hashkey cells
current @ 3 cells + @ + !
(reveal)
THEN ;
: clear-hash ( wid -- ) 3 cells + @ $40 cells erase ;
Create hashsearch
' hash-find A, ' hash-reveal A, ' clear-hash A,
\ for testing
: .hash ( wid -- ) 3 cells + @ ?dup 0= ?EXIT cr
8 0 DO
8 0 DO dup I J 8 * + cells + @ dup
IF cell+ count $1F and tuck 10 min type
10 swap - spaces
ELSE drop 10 spaces THEN
LOOP
LOOP drop ;
\ wordlist Vocabulary also previous 14may93py
AVariable voclink
: wordlist ( -- wid )
here 0 A, Forth-wordlist cell+ @ A, voclink @ A, 0 A,
here 0 A, hashsearch A, voclink @ A,
here cell+ A, here $40 cells dup allot erase
dup 2 cells + voclink ! ;
: Vocabulary ( -- ) Create wordlist drop DOES> context ! ;
......@@ -29,7 +74,7 @@ AVariable voclink
\ vocabulary find 14may93py
: (vocfind) ( addr count nfa1 -- nfa2|false )
: (vocfind) ( addr count wid -- nfa2|false )
\ !! generalize this to be independent of vp
drop 1 vp @
DO 2dup vp I cells + @ (search-wordlist) dup
......@@ -41,7 +86,7 @@ AVariable voclink
0 value locals-wordlist
: (localsvocfind) ( addr count nfa1 -- nfa2|false )
: (localsvocfind) ( addr count wid -- nfa2|false )
\ !! use generalized (vocfind)
drop locals-wordlist
IF 2dup locals-wordlist (search-wordlist) dup
......@@ -57,7 +102,8 @@ AVariable voclink
\ (including locals)
\ this is the wordlist-map of the dictionary
Create vocsearch ' (localsvocfind) A, ' (reveal) A,
Create vocsearch
' (localsvocfind) A, ' (reveal) A, ' drop A,
\ Only root 14may93py
......@@ -77,6 +123,8 @@ Only Forth also definitions
search A! \ our dictionary search order becomes the law
' Forth >body AConstant Forth-wordlist
\ get-order set-order 14may93py
: get-order ( -- wid1 .. widn n )
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment