[OpenBIOS] [PATCH] variable instatiation support
Samuel Rydh
samuel at ibrium.se
Tue Nov 4 02:43:47 CET 2003
Hi,
This patch adds variable instantiation support. It is intended to
be used for device node instantiation.
Some implementational details:
- all template data is put into the dictionary. The thought behind this
is to make it possible to put both methods and template data in
a single wordlist.
- instantiated variables are stored in a continuous block of memory
(in contrast to the template data which is spread out in the dictionary).
A small example file is also attached to this e-mail.
Regards,
/Samuiel
-------------- next part --------------
# This is a BitKeeper generated patch for the following project:
# Project Name: OpenBIOS BK repository (tracks a CVS tree)
# This patch format is intended for GNU patch command version 2.5 or higher.
# This patch includes the following deltas:
# ChangeSet 1.6 -> 1.7
# forth/device/fcode.fs 1.1 -> 1.2
# kernel/kernel/internal.c 1.1 -> 1.2
# kernel/kernel/primitives.c 1.4 -> 1.5
# kernel/arch/unix/unix.c 1.1 -> 1.2
# kernel/forth/bootstrap.fs 1.1 -> 1.2
#
# The following is the BitKeeper ChangeSet Log
# --------------------------------------------
# 03/11/04 samuel at ibrium.se 1.7
# support for variable instantiation
# --------------------------------------------
#
diff -Nru a/forth/device/fcode.fs b/forth/device/fcode.fs
--- a/forth/device/fcode.fs Tue Nov 4 02:07:03 2003
+++ b/forth/device/fcode.fs Tue Nov 4 02:07:03 2003
@@ -125,12 +125,47 @@
\ instance ( -- )
\ Mark next defining word as instance specific.
+\
-: instance
- ." instance: word not implemented"
+: instance ( -- )
+ true #instance !
+;
+
+\ The following instance-related words are not a part of the OF standard
+\ but function as an API for variable instantiation.
+
+\ instance-size ( -- size )
+\ Returns the size of the template data in the dictionary.
+\ This function is partially redundant since #instance-offs can be used.
+
+: instance-size ( -- size )
+ get-current
+ begin
+ @ dup 0<> if dup na1+ @ instance-cfa? else true then
+ until
+ dup 0<> if
+ dup 2 /n* + @ swap 3 /n* + @ +
+ then
;
-
+\ instance-init ( buffer -- )
+\ Clones template data (of instance-size) from the dictionary
+
+: instance-init
+ get-current
+ begin @ dup 0<> while
+ dup /n + @ instance-cfa? if \ buffer dict
+ 2dup 2 /n* + @ + \ buffer dict dest
+ over 3 /n* + @ \ buffer dict dest size
+ 2 pick 4 /n* + \ buffer dict dest size src
+ -rot
+ move
+ then
+ repeat
+ 2drop
+ ;
+
+
\ new-token ( F:/FCode#/ -- )
\ Create a new unnamed FCode function
diff -Nru a/kernel/arch/unix/unix.c b/kernel/arch/unix/unix.c
--- a/kernel/arch/unix/unix.c Tue Nov 4 02:07:03 2003
+++ b/kernel/arch/unix/unix.c Tue Nov 4 02:07:03 2003
@@ -67,7 +67,7 @@
static const char *wordnames[] = {
"(semis)", "", "(lit)", "", "", "", "", "(do)", "(?do)", "(loop)",
- "(+loop)", "dup", "2dup", "?dup", "over", "2over", "pick", "drop",
+ "(+loop)", "", "", "", "dup", "2dup", "?dup", "over", "2over", "pick", "drop",
"2drop", "nip", "roll", "rot", "-rot", "swap", "2swap", ">r", "r>",
"r@", "depth", "depth!", "rdepth", "rdepth!", "+", "-", "*", "u*",
"mu/mod", "abs", "negate", "max", "min", "lshift", "rshift", ">>a",
@@ -76,7 +76,7 @@
"sp@", "move", "fill", "(emit)", "(?key)", "(key)", "execute",
"here", "here!", "dobranch", "do?branch", "unaligned-w@",
"unaligned-w!", "unaligned-l@", "unaligned-l!", "ioc@", "iow@",
- "iol@", "ioc!", "iow!", "iol!", "i", "j", "call"
+ "iol@", "ioc!", "iow!", "iol!", "i", "j", "call", "instance!"
};
/*
diff -Nru a/kernel/forth/bootstrap.fs b/kernel/forth/bootstrap.fs
--- a/kernel/forth/bootstrap.fs Tue Nov 4 02:07:03 2003
+++ b/kernel/forth/bootstrap.fs Tue Nov 4 02:07:03 2003
@@ -184,8 +184,8 @@
begin
?dup
while
- dup @ \ leaves -- leaves *leaves )
- swap \ -- *leaves leaves )
+ dup @ \ leaves -- leaves *leaves )
+ swap \ -- *leaves leaves )
here over - \ -- *leaves leaves here-leaves
swap ! \ -- *leaves
repeat
@@ -849,17 +849,44 @@
\ 7.3.9.2.4 Miscellaneous dictionary (part 2)
\
+variable #instance-base
+variable #instance-offs
+variable #instance
+
+\ the following instance words are used internally
+\ to implement variable instantiation.
+
+: set-instance ( instancebuf -- )
+ dup #instance-base ! instance!
+;
+
+: get-instance ( -- instancebuf )
+ #instance-base @
+;
+
+: instance-cfa? ( cfa -- true | false )
+ b e within \ b,c and d are instance defining words
+;
+
+: (ito) ( xt-new xt-defer -- )
+ #instance-base @ 0= if
+ 3 na+ !
+ else
+ na1+ @ #instance-base @ + !
+ then
+;
+
: to
['] ' execute
+ dup @ instance-cfa?
state @ if
- ['] (lit) , , ['] (to) ,
- else
- /n + !
+ swap ['] (lit) , , if ['] (ito) else ['] (to) then ,
+ else
+ if (ito) else /n + ! then
then
; immediate
-
\
\ 7.3.4.2 Console Input
\
@@ -1231,21 +1258,46 @@
reveal
;
+: instance, ( size -- )
+ dup #instance-offs @ dup rot + #instance-offs !
+ , , \ offset size
+;
+
+: instance? ( -- flag )
+ #instance @ dup if
+ false #instance !
+ then
+;
+
: value
parse-word header
- 3 , ,
+ instance? if
+ /n b , instance, , \ DOIVAL
+ else
+ 3 , ,
+ then
reveal
;
: variable
parse-word header
- 4 , 0 ,
+ instance? if
+ /n c , instance, 0 ,
+ else
+ 4 , 0 ,
+ then
reveal
;
: buffer:
parse-word header
- 4 , allot
+ instance? if
+ /n over /n 1- and - /n 1- and + \ align buffer size
+ dup c , instance, \ DOIVAR
+ else
+ 4 ,
+ then
+ allot
reveal
;
@@ -1255,7 +1307,11 @@
: defer ( new-name< > -- )
parse-word header
- 5 ,
+ instance? if
+ 2 /n* d , instance, \ DOIDEFER
+ else
+ 5 ,
+ then
['] (undefined-defer) ,
['] (semis) ,
reveal
diff -Nru a/kernel/kernel/internal.c b/kernel/kernel/internal.c
--- a/kernel/kernel/internal.c Tue Nov 4 02:07:03 2003
+++ b/kernel/kernel/internal.c Tue Nov 4 02:07:03 2003
@@ -261,3 +261,38 @@
PUSHR(startval);
}
}
+
+static ucell instance_base = 0;
+
+static void setinstance(void)
+{
+ instance_base = POP();
+}
+
+static void doivar(void)
+{
+ ucell r, *p = (ucell *)(*(ucell *) PC + sizeof(ucell));
+ /* printk("ivar, offset: %d size: %d\n", p[0], p[1] ); */
+
+ r = instance_base ? instance_base + p[0] : (ucell)&p[2];
+ PUSH( r );
+}
+
+static void doival(void)
+{
+ ucell r, *p = (ucell *)(*(ucell *) PC + sizeof(ucell));
+ /* printk("ivar, offset: %d size: %d\n", p[0], p[1] ); */
+
+ r = instance_base ? instance_base + p[0] : (ucell)&p[2];
+ PUSH( *(ucell *)r );
+}
+
+static void doidefer(void)
+{
+ ucell *p = (ucell *)(*(ucell *) PC + sizeof(ucell));
+ /* printk("doidefer, offset: %d size: %d\n", p[0], p[1] ); */
+
+ PUSHR(PC);
+ PC = instance_base ? instance_base + p[0] : (ucell)&p[2];
+ PC -= sizeof(ucell);
+}
diff -Nru a/kernel/kernel/primitives.c b/kernel/kernel/primitives.c
--- a/kernel/kernel/primitives.c Tue Nov 4 02:07:03 2003
+++ b/kernel/kernel/primitives.c Tue Nov 4 02:07:03 2003
@@ -51,6 +51,9 @@
doisdo,
doloop,
doplusloop,
+ doival,
+ doivar,
+ doidefer,
/*
* primitives
@@ -133,5 +136,6 @@
iolstore, /* iol! */
loop_i, /* i */
loop_j, /* j */
- call /* call */
+ call, /* call */
+ setinstance, /* instance! */
};
-------------- next part --------------
\ create some instance variables
20 instance value alpha
instance variable beta
instance defer function
200 instance buffer: gamma
cr ." Template data size: " instance-size . cr
\ some test functions
: incbeta ( -- ) beta @ 1+ to beta ;
: incalpha ( -- ) alpha 1+ to alpha ;
: pushone ( -- ) 1 ;
: pushtwo ( -- ) 2 ;
30 to beta
' pushone to function
\ allocate two instances and copy template data
here dup instance-size allot value instance1 instance-init
here dup instance-size allot value instance2 instance-init
: report
cr cr
." ALPHA : " alpha . cr
." BETA : " beta @ . cr
." DEFER : " function . cr
." GAMMA : " gamma . cr cr
;
report
\ enter instance 1
instance1 set-instance
cr ." ---- INSTANCE ONE ----"
report
incalpha
incbeta
' pushtwo to function
report
\ enter instance 2
instance2 set-instance
cr ." ---- INSTANCE TWO ----"
report incbeta incbeta report
\ back to the no-instance case
cr ." ---- TEMPLATE DATA ----"
0 set-instance
report
\ enter instance 1
cr ." ---- INSTANCE ONE ----"
instance1 set-instance
report
More information about the OpenBIOS
mailing list