Commit 573bdc29 authored by pazsan's avatar pazsan

Added structure support in kernal

fixed bug on dictionary expand (512 wordlist limit)
parent e616847f
\ CROSS.FS The Cross-Compiler 06oct92py
\ $Id: cross.fs,v 1.23 1995-02-08 13:38:50 pazsan Exp $
\ $Id: cross.fs,v 1.24 1995-02-23 20:17:16 pazsan Exp $
\ Idea and implementation: Bernd Paysan (py)
\ Copyright 1992-94 by the GNU Forth Development Group
......@@ -120,8 +120,9 @@ H
-4 Constant :dovar
-5 Constant :douser
-6 Constant :dodefer
-7 Constant :dodoes
-8 Constant :doesjump
-7 Constant :dostruc
-8 Constant :dodoes
-9 Constant :doesjump
>CROSS
......@@ -287,7 +288,7 @@ VARIABLE Already
UNTIL
2 cells + count cr ." CROSS: Exists: " type 4 spaces drop
swap cell+ !
ELSE true ABORT" CROSS: Ghostnames inconsistent"
ELSE true abort" CROSS: Ghostnames inconsistent "
THEN ;
: resolve ( ghost tcfa -- )
......@@ -604,6 +605,10 @@ Build: ( n -- ) T A, H ;
by Constant
Builder AConstant
Build: ( d -- ) T , , H ;
DO: ( ghost -- d ) T dup cell+ @ swap @ H ;DO
Builder 2Constant
Build: T 0 , H ;
by Constant
Builder Value
......@@ -613,6 +618,29 @@ DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
Builder Defer
by Defer :dodefer resolve
\ Sturctures 23feb95py
>CROSS
: nalign ( addr1 n -- addr2 )
\ addr2 is the aligned version of addr1 wrt the alignment size n
1- tuck + swap invert and ;
>TARGET
Build: >r rot r@ nalign dup T , H ( align1 size offset )
+ swap r> nalign ;
DO: T @ H + ;DO
Builder Field
by Field :dostruc resolve
: struct T 0 1 chars H ;
: end-struct T 2Constant H ;
: cells: ( n -- size align )
T cells 1 cells H ;
\ ' 2Constant Alias2 end-struct
\ 0 1 T Chars H 2Constant struct
\ structural conditionals 17dec92py
>CROSS
......
......@@ -214,6 +214,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
&&dovar,
&&douser,
&&dodefer,
&&dostruc,
&&dodoes,
&&dodoes, /* dummy for does handler address */
#include "prim_labels.i"
......@@ -309,6 +310,14 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
cfa = *(Xt *)PFA1(cfa);
NEXT1;
dostruc:
#ifdef DEBUG
fprintf(stderr,"%08x: struc: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
#endif
TOS += *(Cell*)PFA1(cfa);
NEXT_P0;
NEXT;
dodoes:
/* this assumes the following structure:
defining-word:
......
......@@ -13,8 +13,9 @@ typedef void *Label;
#define DOVAR 2
#define DOUSER 3
#define DODEFER 4
#define DODOES 5
#define DOESJUMP 6
#define DOSTRUC 5
#define DODOES 6
#define DOESJUMP 7
#include "machine.h"
......
......@@ -918,10 +918,10 @@ Create ??? 0 , 3 c, char ? c, char ? c, char ? c,
: Constant (Constant) , ;
: AConstant (Constant) A, ;
: 2CONSTANT
create ( w1 w2 "name" -- )
: 2Constant
Create ( w1 w2 "name" -- )
2,
does> ( -- w1 w2 )
DOES> ( -- w1 w2 )
2@ ;
\ IS Defer What's Defers TO 24feb93py
......@@ -981,19 +981,20 @@ AVariable current
\ object oriented search list 17mar93py
\ word list structure:
\ struct
\ 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 -- )
struct
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
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 wordlist-link \ link field to other wordlists
\ 1 cells: field wordlist-extend \ points to wordlist extensions (eg hash)
\ end-struct wordlist-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 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) ;
......@@ -1005,7 +1006,7 @@ AVariable lookup G forth-wordlist lookup T !
G forth-wordlist current T !
: (search-wordlist) ( addr count wid -- nfa / false )
dup cell+ @ @ execute ;
dup wordlist-map @ find-method @ execute ;
: search-wordlist ( addr count wid -- 0 / xt +-1 )
(search-wordlist) dup IF found THEN ;
......@@ -1039,9 +1040,9 @@ Variable warnings G -1 warnings T !
last? if
name>string current @ check-shadow
then
current @ cell+ @ cell+ @ execute ;
current @ wordlist-map @ reveal-method @ execute ;
: rehash ( wid -- ) dup cell+ @ cell+ cell+ @ execute ;
: rehash ( wid -- ) dup wordlist-map @ rehash-method @ execute ;
: ' ( "name" -- addr ) name sfind 0= if -&13 bounce then ;
: ['] ( "name" -- addr ) ' postpone ALiteral ; immediate
......
/*
$Id: main.c,v 1.23 1995-02-14 18:18:36 pazsan Exp $
$Id: main.c,v 1.24 1995-02-23 20:17:22 pazsan Exp $
Copyright 1993 by the ANSI figForth Development Group
*/
......@@ -57,9 +57,9 @@ char *progname;
* addresses within the image are given relative to the start of the image.
* If the word is =-1, the address is NIL,
* If the word is between -2 and -5, it's a CFA (:, Create, Constant, User)
* If the word is -6, it's a DOES> CFA
* If the word is -7, it's a DOES JUMP
* If the word is <-7, it's a primitive
* If the word is -7, it's a DOES> CFA
* If the word is -8, it's a DOES JUMP
* If the word is <-9, it's a primitive
*/
void relocate(Cell *image, char *bitstring, int size, Label symbols[])
......@@ -79,7 +79,8 @@ void relocate(Cell *image, char *bitstring, int size, Label symbols[])
case CF(DOVAR) :
case CF(DOCON) :
case CF(DOUSER) :
case CF(DODEFER) : MAKE_CF(image+i,symbols[CF(image[i])]); break;
case CF(DODEFER) :
case CF(DOSTRUC) : MAKE_CF(image+i,symbols[CF(image[i])]); break;
case CF(DODOES) : MAKE_DOES_CF(image+i,image[i+1]+((Cell)image));
break;
case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
......
......@@ -90,7 +90,7 @@ variable effect-out-end ( pointer )
2variable effect-in-size
2variable effect-out-size
variable primitive-number -9 primitive-number !
variable primitive-number -10 primitive-number !
\ for several reasons stack items of a word are stored in a wordlist
\ since neither forget nor marker are implemented yet, we make a new
......
......@@ -21,8 +21,8 @@ Defer 'initvoc
Variable slowvoc slowvoc off
: wordlist ( -- wid )
here 0 A, Forth-wordlist cell+ @ A, voclink @ A, slowvoc @ A,
dup 2 cells + dup voclink ! 'initvoc ;
here 0 A, Forth-wordlist wordlist-map @ A, voclink @ A, slowvoc @ A,
dup wordlist-link dup voclink ! 'initvoc ;
: Vocabulary ( -- ) Create wordlist drop DOES> context ! ;
......@@ -36,12 +36,13 @@ Variable slowvoc slowvoc off
: (vocfind) ( addr count nfa1 -- nfa2|false )
\ !! generalize this to be independent of vp
drop 1 vp @
DO 2dup vp I cells + @ (search-wordlist) dup
IF nip nip
UNLOOP EXIT
THEN drop
-1 +LOOP
drop vp dup @ 1- cells over +
DO 2dup I 2@ over <>
IF (search-wordlist) dup
IF nip nip UNLOOP EXIT
THEN drop
ELSE drop 2drop THEN
[ -1 cells ] Literal +LOOP
2drop false ;
0 value locals-wordlist
......@@ -67,7 +68,7 @@ Create vocsearch ' (localsvocfind) A, ' (reveal) A, ' drop A,
\ Only root 14may93py
wordlist \ the wordlist structure
vocsearch over cell+ A! \ patch the map into it
vocsearch over wordlist-map A! \ patch the map into it
Vocabulary Forth
Vocabulary Root
......@@ -107,7 +108,8 @@ lookup A! \ our dictionary search order becomes the law
: .voc body> >name .name ;
: order 1 vp @ DO vp I cells + @ .voc -1 +LOOP 2 spaces
current @ .voc ;
: vocs voclink BEGIN @ dup @ WHILE dup 2 cells - .voc REPEAT drop ;
: vocs voclink BEGIN @ dup @ WHILE dup 0 wordlist-link - .voc REPEAT
drop ;
Root definitions
......@@ -125,16 +127,16 @@ include hash.fs
: marker, ( -- mark ) here dup A,
voclink @ A, voclink
BEGIN @ dup @ WHILE dup 2 cells - @ A, REPEAT drop
BEGIN @ dup @ WHILE dup 0 wordlist-link - @ A, REPEAT drop
udp @ , ;
: marker! ( mark -- ) dup @ swap cell+
dup @ voclink ! cell+
voclink
BEGIN @ dup @ WHILE over @ over 2 cells - !
BEGIN @ dup @ WHILE over @ over 0 wordlist-link - !
swap cell+ swap
REPEAT drop voclink
BEGIN @ dup @ WHILE dup 2 cells - rehash REPEAT drop
BEGIN @ dup @ WHILE dup 0 wordlist-link - rehash REPEAT drop
@ udp ! dp ! ;
: marker ( "mark" -- )
......
\ $Id: struct.fs,v 1.2 1994-07-29 11:16:26 anton Exp $
\ $Id: struct.fs,v 1.3 1995-02-23 20:17:25 pazsan Exp $
\ Usage example:
\
......@@ -16,9 +16,9 @@
\ addr2 is the aligned version of addr1 wrt the alignment size n
1- tuck + swap invert and ;
: create-field ( offset1 align1 size align -- offset2 align2 )
: field ( offset1 align1 size align -- offset2 align2 )
\ note: this version uses local variables
create
Header reveal -7 ( [ :dostruc ] Literal ) cfa,
>r rot r@ nalign dup , ( align1 size offset )
+ swap r> nalign ;
......@@ -27,10 +27,10 @@
0 1 chars end-struct struct
: field ( offset1 align1 size align -- offset2 align2 )
create-field
does> ( addr1 -- addr2 )
@ + ;
\ : field ( offset1 align1 size align -- offset2 align2 )
\ create-field
\ does> ( addr1 -- addr2 )
\ @ + ;
\ I don't really like the "type:" syntax. Any other ideas? - anton
\ Also, this seems to be somewhat general. It probably belongs to some
......
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