*** empty log message ***
This commit is contained in:
parent
1781d8acf4
commit
022859007f
67
ase/stx/context.c
Normal file
67
ase/stx/context.c
Normal file
@ -0,0 +1,67 @@
|
||||
/*
|
||||
* $Id: context.c,v 1.1 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/stx/context.h>
|
||||
#include <xp/stx/object.h>
|
||||
|
||||
#define XP_STX_CONTEXT_DIMENSION 4
|
||||
#define XP_STX_CONTEXT_IP 0
|
||||
#define XP_STX_CONTEXT_METHOD 1
|
||||
#define XP_STX_CONTEXT_ARGUMENTS 2
|
||||
#define XP_STX_CONTEXT_TEMPORARIES 3
|
||||
|
||||
xp_stx_word_t xp_stx_new_context (xp_stx_t* stx,
|
||||
xp_stx_word_t method, xp_stx_word_t args, xp_stx_word_t temp)
|
||||
{
|
||||
xp_stx_word_t context;
|
||||
|
||||
context = xp_stx_alloc_object(stx,XP_STX_CONTEXT_DIMENSION);
|
||||
XP_STX_CLASS(stx,context) = stx->class_context;
|
||||
XP_STX_AT(stx,context,XP_STX_CONTEXT_IP) = XP_STX_TO_SMALLINT(0);
|
||||
XP_STX_AT(stx,context,XP_STX_CONTEXT_METHOD) = method;
|
||||
XP_STX_AT(stx,context,XP_STX_CONTEXT_ARGUMENTS) = args;
|
||||
XP_STX_AT(stx,context,XP_STX_CONTEXT_TEMPORARIES) = temp;
|
||||
|
||||
return context;
|
||||
}
|
||||
|
||||
static xp_stx_byte_t __fetch_byte (xp_stx_t* stx, xp_stx_word_t context)
|
||||
{
|
||||
xp_stx_word_t method, ip;
|
||||
|
||||
ip = XP_STX_AT(stx,context,XP_STX_CONTEXT_IP);
|
||||
method = XP_STX_AT(stx,context,XP_STX_CONTEXT_METHOD);
|
||||
|
||||
/* increment instruction pointer */
|
||||
XP_STX_AT(stx,context,XP_STX_CONTEXT_IP) =
|
||||
XP_STX_TO_SMALLINT((XP_STX_FROM_SMALLINT(ip) + 1));
|
||||
|
||||
return XP_STX_BYTEAT(stx,method,XP_STX_FROM_SMALLINT(ip));
|
||||
}
|
||||
|
||||
int xp_stx_run_context (xp_stx_t* stx, xp_stx_word_t context)
|
||||
{
|
||||
xp_stx_byte_t byte, operand;
|
||||
|
||||
while (!stx->__wantabort) {
|
||||
/* check_process_switch (); // hopefully */
|
||||
byte = __fetch_byte (stx, context);
|
||||
|
||||
xp_printf (XP_TEXT("code: %x\n"), byte);
|
||||
|
||||
switch (byte) {
|
||||
case PUSH_OBJECT:
|
||||
operand = __fetch_byte (stx, context);
|
||||
break;
|
||||
case SEND_UNARY_MESSAGE:
|
||||
operand = _fetch_byte (stx, context);
|
||||
break;
|
||||
case HALT:
|
||||
goto exit_run_context;
|
||||
}
|
||||
}
|
||||
|
||||
exit_run_context:
|
||||
return 0;
|
||||
}
|
26
ase/stx/context.h
Normal file
26
ase/stx/context.h
Normal file
@ -0,0 +1,26 @@
|
||||
/*
|
||||
* $Id: context.h,v 1.1 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#ifndef _XP_STX_CONTEXT_H_
|
||||
#define _XP_STX_CONTEXT_H_
|
||||
|
||||
#include <xp/stx/stx.h>
|
||||
|
||||
#define PUSH_OBJECT 0xA0
|
||||
#define SEND_UNARY_MESSAGE 0xB0
|
||||
#define HALT 0xFF
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
xp_stx_word_t xp_stx_new_context (xp_stx_t* stx,
|
||||
xp_stx_word_t method, xp_stx_word_t args, xp_stx_word_t temp);
|
||||
int xp_stx_run_context (xp_stx_t* stx, xp_stx_word_t context);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
28
ase/stx/extra.h
Normal file
28
ase/stx/extra.h
Normal file
@ -0,0 +1,28 @@
|
||||
/*
|
||||
* $Id: extra.h,v 1.1 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#ifndef _XP_STX_EXTRA_H_
|
||||
#define _XP_STX_EXTRA_H_
|
||||
|
||||
#include <xp/stx/stx.h>
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
xp_stx_word_t xp_stx_strlen (const xp_stx_char_t* str)
|
||||
|
||||
int xp_stx_strcmp (
|
||||
const xp_stx_char_t* s1, const xp_stx_char_t* s2);
|
||||
int xp_stx_strxcmp (
|
||||
const xp_stx_char_t* s1, xp_stx_word_t len, const xp_stx_char_t* s2);
|
||||
|
||||
xp_stx_word_t xp_stx_strhash (const xp_stx_char_t* str);
|
||||
xp_stx_word_t xp_stx_strxhash (const xp_stx_char_t* str, xp_stx_word_t len);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
@ -1,21 +1,27 @@
|
||||
/*
|
||||
* $Id: hash.c,v 1.8 2005-05-12 15:51:20 bacon Exp $
|
||||
* $Id: hash.c,v 1.9 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/stx/hash.h>
|
||||
#include <xp/stx/object.h>
|
||||
#include <xp/stx/misc.h>
|
||||
#include <xp/bas/assert.h>
|
||||
|
||||
#define _SYMBOL_LINK_DIMENSION 3
|
||||
#define _SYMBOL_LINK_LINK 0
|
||||
#define _SYMBOL_LINK_KEY 1
|
||||
#define _SYMBOL_LINK_VALUE 2
|
||||
|
||||
xp_stx_word_t xp_stx_new_symbol_link (
|
||||
xp_stx_t* stx, xp_stx_word_t key, xp_stx_word_t value)
|
||||
{
|
||||
xp_stx_word_t x;
|
||||
|
||||
x = xp_stx_alloc_object (stx, 3);
|
||||
x = xp_stx_alloc_object (stx, _SYMBOL_LINK_DIMENSION);
|
||||
XP_STX_CLASS(stx,x) = stx->class_symbol_link;
|
||||
/* XP_STX_AT(stx,x,0) = stx->nil; */
|
||||
XP_STX_AT(stx,x,1) = key;
|
||||
XP_STX_AT(stx,x,2) = value;
|
||||
/* XP_STX_AT(stx,x,_SYMBOL_LINK_LINK) = stx->nil; */
|
||||
XP_STX_AT(stx,x,_SYMBOL_LINK_KEY) = key;
|
||||
XP_STX_AT(stx,x,_SYMBOL_LINK_VALUE) = value;
|
||||
|
||||
return x;
|
||||
}
|
||||
@ -33,8 +39,34 @@ xp_stx_word_t xp_stx_hash_lookup (
|
||||
link = XP_STX_AT(stx,table,hash);
|
||||
|
||||
while (link != stx->nil) {
|
||||
if (XP_STX_AT(stx,link,0) == key) return link;
|
||||
link = XP_STX_AT(stx,link,2);
|
||||
if (XP_STX_AT(stx,link,_SYMBOL_LINK_KEY) == key) return link;
|
||||
link = XP_STX_AT(stx,link,_SYMBOL_LINK_LINK);
|
||||
}
|
||||
|
||||
return stx->nil; /* not found */
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_hash_lookup_symbol (
|
||||
xp_stx_t* stx, xp_stx_word_t table,
|
||||
xp_stx_word_t hash, xp_stx_char_t* key_str)
|
||||
{
|
||||
xp_stx_word_t link, key;
|
||||
|
||||
xp_assert (XP_STX_TYPE(stx,table) == XP_STX_INDEXED);
|
||||
|
||||
hash = hash % XP_STX_SIZE(stx,table);
|
||||
link = XP_STX_AT(stx,table,hash);
|
||||
|
||||
while (link != stx->nil) {
|
||||
key = XP_STX_AT(stx,link,_SYMBOL_LINK_KEY);
|
||||
|
||||
if (XP_STX_CLASS(stx,key) == stx->class_symbol &&
|
||||
xp_stx_strxcmp (
|
||||
&XP_STX_CHARAT(stx,key,0),
|
||||
XP_STX_SIZE(stx,key), key_str) == 0) {
|
||||
return link;
|
||||
}
|
||||
link = XP_STX_AT(stx,link,_SYMBOL_LINK_LINK);
|
||||
}
|
||||
|
||||
return stx->nil; /* not found */
|
||||
@ -58,13 +90,13 @@ void xp_stx_hash_insert (
|
||||
else {
|
||||
for (;;) {
|
||||
if (XP_STX_AT(stx,link,1) == key) {
|
||||
XP_STX_AT(stx,link,2) = value;
|
||||
XP_STX_AT(stx,link,_SYMBOL_LINK_VALUE) = value;
|
||||
break;
|
||||
}
|
||||
|
||||
next = XP_STX_AT(stx,link,0);
|
||||
next = XP_STX_AT(stx,link,_SYMBOL_LINK_LINK);
|
||||
if (next == stx->nil) {
|
||||
XP_STX_AT(stx,link,0) =
|
||||
XP_STX_AT(stx,link,_SYMBOL_LINK_LINK) =
|
||||
xp_stx_new_symbol_link (stx, key, value);
|
||||
break;
|
||||
}
|
||||
@ -86,7 +118,45 @@ void xp_stx_hash_traverse (
|
||||
|
||||
while (link != stx->nil) {
|
||||
func (stx,link);
|
||||
link = XP_STX_AT(stx,link,0);
|
||||
link = XP_STX_AT(stx,link,_SYMBOL_LINK_LINK);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
xp_stx_word_t xp_stx_new_symbol (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name)
|
||||
{
|
||||
xp_stx_word_t x, hash;
|
||||
|
||||
hash = xp_stx_strhash(name);
|
||||
x = xp_stx_hash_lookup_symbol(stx, stx->symbol_table, hash, name);
|
||||
if (x == stx->nil) {
|
||||
x = xp_stx_alloc_string_object (stx, name);
|
||||
XP_STX_CLASS(stx,x) = stx->class_symbol;
|
||||
xp_stx_hash_insert (stx, stx->symbol_table, hash, x, stx->nil);
|
||||
}
|
||||
else x = XP_STX_AT(stx,x,_SYMBOL_LINK_KEY);
|
||||
|
||||
return x;
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_new_symbol_pp (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name,
|
||||
const xp_stx_char_t* prefix, const xp_stx_char_t* postfix)
|
||||
{
|
||||
xp_stx_word_t x, hash;
|
||||
|
||||
hash = xp_stx_strhash(name);
|
||||
|
||||
x = xp_stx_hash_lookup_symbol(stx, stx->symbol_table, hash, name);
|
||||
if (x == stx->nil) {
|
||||
x = xp_stx_allocn_string_object (stx, prefix, name, postfix, XP_NULL);
|
||||
XP_STX_CLASS(stx,x) = stx->class_symbol;
|
||||
xp_stx_hash_insert (stx, stx->symbol_table, hash, x, stx->nil);
|
||||
}
|
||||
else x = XP_STX_AT(stx,x,_SYMBOL_LINK_KEY);
|
||||
|
||||
return x;
|
||||
}
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* $Id: hash.h,v 1.3 2005-05-12 15:25:06 bacon Exp $
|
||||
* $Id: hash.h,v 1.4 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#ifndef _XP_STX_HASH_H_
|
||||
@ -11,11 +11,15 @@
|
||||
extern "C"
|
||||
#endif
|
||||
|
||||
/* hash table manipulation */
|
||||
xp_stx_word_t xp_stx_new_symbol_link (
|
||||
xp_stx_t* stx, xp_stx_word_t key, xp_stx_word_t value);
|
||||
xp_stx_word_t xp_stx_hash_lookup (
|
||||
xp_stx_t* stx, xp_stx_word_t table,
|
||||
xp_stx_word_t hash, xp_stx_word_t key);
|
||||
xp_stx_word_t xp_stx_hash_lookup_symbol (
|
||||
xp_stx_t* stx, xp_stx_word_t table,
|
||||
xp_stx_word_t hash, xp_stx_char_t* key_str);
|
||||
void xp_stx_hash_insert (
|
||||
xp_stx_t* stx, xp_stx_word_t table,
|
||||
xp_stx_word_t hash, xp_stx_word_t key, xp_stx_word_t value);
|
||||
@ -23,6 +27,11 @@ void xp_stx_hash_traverse (
|
||||
xp_stx_t* stx, xp_stx_word_t table,
|
||||
void (*func) (xp_stx_t*,xp_stx_word_t));
|
||||
|
||||
xp_stx_word_t xp_stx_new_symbol (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name);
|
||||
xp_stx_word_t xp_stx_new_symbol_pp (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name,
|
||||
const xp_stx_char_t* prefix, const xp_stx_char_t* postfix);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* $Id: interp.c,v 1.1 2005-05-13 16:45:55 bacon Exp $
|
||||
* $Id: interp.c,v 1.2 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/stx/interp.h>
|
||||
@ -36,13 +36,21 @@ static byte_code_func_t byte_code_funcs[] =
|
||||
do_special
|
||||
};
|
||||
|
||||
int xp_stx_new_context (xp_stx_t* stx,
|
||||
xp_stx_word_t xp_stx_new_method (xp_stx_t* stx)
|
||||
{
|
||||
xp_stx_word_t method;
|
||||
method = xp_stx_alloc_object(XP_STX_METHOD_DIMENSION);
|
||||
|
||||
return method;
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_new_context (xp_stx_t* stx,
|
||||
xp_stx_word_t method, xp_stx_word_t args, xp_stx_word_t temp)
|
||||
{
|
||||
xp_stx_word_t context;
|
||||
|
||||
context = xp_stx_alloc_object(XP_STX_CONTEXT_DIMENSION);
|
||||
XP_STX_CLASS(stx,context) = stx->context_class;
|
||||
XP_STX_CLASS(stx,context) = stx->class_context;
|
||||
XP_STX_AT(stx,context,XP_STX_CONTEXT_METHOD) = method;
|
||||
XP_STX_AT(stx,context,XP_STX_CONTEXT_ARGUMENTS) = args;
|
||||
XP_STX_AT(stx,context,XP_STX_CONTEXT_TEMPORARIES) = temp;
|
||||
@ -50,6 +58,28 @@ int xp_stx_new_context (xp_stx_t* stx,
|
||||
return context;
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_new_process (xp_stx_t* stx, xp_stx_word_t method)
|
||||
{
|
||||
xp_stx_word_t process, stx;
|
||||
|
||||
process = xp_stx_alloc_object(XP_STX_PROCESS_DIMENSION);
|
||||
stack = xp_new_array(stx,50);
|
||||
|
||||
XP_STX_CLASS(stx,process) = stx->class_process;
|
||||
XP_STX_AT(stx,process,XP_STX_PROCESS_STACK) = stack;
|
||||
XP_STX_AT(stx,process,XP_STX_PROCESS_STACKTOP) = XP_STX_FROM_SMALLINT(6);
|
||||
XP_STX_AT(stx,process,XP_STX_PROCESS_LINK) = XP_STX_FROM_SMALLINT(1);
|
||||
|
||||
XP_STX_AT(stx,stack,0) = stx->nil; /* argument */
|
||||
XP_STX_AT(stx,stack,1) = XP_STX_FROM_SMALLINT(0); /* previous link */
|
||||
XP_STX_AT(stx,stack,2) = stx->nil; /* context */
|
||||
XP_STX_AT(stx,stack,3) = XP_STX_FROM_SMALLINT(1); /* return point */
|
||||
XP_STX_AT(stx,stack,4) = method;
|
||||
XP_STX_AT(stx,stack,5) = XP_STX_FROM_SMALLINT(1); /* byte offset */
|
||||
|
||||
return process;
|
||||
}
|
||||
|
||||
int xp_stx_execute (xp_stx_t* stx, xp_stx_word_t process)
|
||||
{
|
||||
int low, high;
|
||||
|
@ -1,5 +1,5 @@
|
||||
SRCS = stx.c memory.c object.c hash.c
|
||||
OBJS = stx.obj memory.obj object.obj hash.obj
|
||||
SRCS = stx.c memory.c object.c hash.c misc.c context.c
|
||||
OBJS = stx.obj memory.obj object.obj hash.obj misc.obj context.obj
|
||||
OUT = xpstx.lib
|
||||
|
||||
CC = lcc
|
||||
|
65
ase/stx/misc.c
Normal file
65
ase/stx/misc.c
Normal file
@ -0,0 +1,65 @@
|
||||
/*
|
||||
* $Id: misc.c,v 1.1 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/stx/misc.h>
|
||||
|
||||
xp_stx_word_t xp_stx_strlen (const xp_stx_char_t* str)
|
||||
{
|
||||
const xp_stx_char_t* p = str;
|
||||
while (*p != XP_STX_CHAR('\0')) p++;
|
||||
return p - str;
|
||||
}
|
||||
|
||||
int xp_stx_strcmp (const xp_stx_char_t* s1, const xp_stx_char_t* s2)
|
||||
{
|
||||
while (*s1 == *s2 && *s2 != XP_STX_CHAR('\0')) s1++, s2++;
|
||||
if (*s1 > *s2) return 1;
|
||||
else if (*s1 < *s2) return -1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int xp_stx_strxcmp (
|
||||
const xp_stx_char_t* s1, xp_stx_word_t len, const xp_stx_char_t* s2)
|
||||
{
|
||||
const xp_stx_char_t* end = s1 + len;
|
||||
while (s1 < end && *s2 != XP_STX_CHAR('\0') && *s1 == *s2) {
|
||||
s1++; s2++;
|
||||
}
|
||||
if (s1 == end && *s2 == XP_STX_CHAR('\0')) return 0;
|
||||
if (*s1 == *s2) return (s1 < end)? 1: -1;
|
||||
return (*s1 > *s2)? 1: -1;
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_strhash (const xp_stx_char_t* str)
|
||||
{
|
||||
xp_stx_word_t h = 0;
|
||||
xp_stx_byte_t* bp, * be;
|
||||
xp_stx_char_t* p = str;
|
||||
|
||||
while (*p != XP_STX_CHAR('\0')) {
|
||||
bp = (xp_stx_byte_t*)p;
|
||||
be = bp + xp_sizeof(xp_stx_char_t);
|
||||
while (bp < be) h = h * 31 + *bp++;
|
||||
p++;
|
||||
}
|
||||
|
||||
return h;
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_strxhash (const xp_stx_char_t* str, xp_stx_word_t len)
|
||||
{
|
||||
xp_stx_word_t h = 0;
|
||||
xp_stx_byte_t* bp, * be;
|
||||
xp_stx_char_t* p = str, * end = str + len;
|
||||
|
||||
while (p < end) {
|
||||
bp = (xp_stx_byte_t*)p;
|
||||
be = bp + xp_sizeof(xp_stx_char_t);
|
||||
while (bp < be) h = h * 31 + *bp++;
|
||||
p++;
|
||||
}
|
||||
|
||||
return h;
|
||||
}
|
||||
|
28
ase/stx/misc.h
Normal file
28
ase/stx/misc.h
Normal file
@ -0,0 +1,28 @@
|
||||
/*
|
||||
* $Id: misc.h,v 1.1 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#ifndef _XP_STX_MISC_H_
|
||||
#define _XP_STX_MISC_H_
|
||||
|
||||
#include <xp/stx/stx.h>
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
xp_stx_word_t xp_stx_strlen (const xp_stx_char_t* str);
|
||||
|
||||
int xp_stx_strcmp (
|
||||
const xp_stx_char_t* s1, const xp_stx_char_t* s2);
|
||||
int xp_stx_strxcmp (
|
||||
const xp_stx_char_t* s1, xp_stx_word_t len, const xp_stx_char_t* s2);
|
||||
|
||||
xp_stx_word_t xp_stx_strhash (const xp_stx_char_t* str);
|
||||
xp_stx_word_t xp_stx_strxhash (const xp_stx_char_t* str, xp_stx_word_t len);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
@ -1,20 +1,14 @@
|
||||
/*
|
||||
* $Id: object.c,v 1.12 2005-05-12 15:25:06 bacon Exp $
|
||||
* $Id: object.c,v 1.13 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/stx/object.h>
|
||||
#include <xp/stx/memory.h>
|
||||
#include <xp/stx/hash.h>
|
||||
#include <xp/stx/misc.h>
|
||||
#include <xp/bas/assert.h>
|
||||
#include <xp/bas/stdarg.h>
|
||||
|
||||
static xp_stx_word_t __strlen (const xp_stx_char_t* str)
|
||||
{
|
||||
const xp_stx_char_t* p = str;
|
||||
while (*p != XP_STX_CHAR('\0')) p++;
|
||||
return p - str;
|
||||
}
|
||||
|
||||
/* n: number of instance variables */
|
||||
xp_stx_word_t xp_stx_alloc_object (xp_stx_t* stx, xp_stx_word_t n)
|
||||
{
|
||||
@ -57,7 +51,7 @@ xp_stx_word_t xp_stx_alloc_string_object (
|
||||
{
|
||||
xp_stx_word_t idx, n;
|
||||
|
||||
n = __strlen(str);
|
||||
n = xp_stx_strlen(str);
|
||||
idx = xp_stx_memory_alloc (&stx->memory,
|
||||
(n + 1) * xp_sizeof(xp_stx_char_t) + xp_sizeof(xp_stx_object_t));
|
||||
if (idx >= stx->memory.capacity) return idx; /* failed */
|
||||
@ -79,7 +73,7 @@ xp_stx_word_t xp_stx_allocn_string_object (xp_stx_t* stx, ...)
|
||||
|
||||
xp_va_start (ap, stx);
|
||||
while ((p = xp_va_arg(ap, const xp_stx_char_t*)) != XP_NULL) {
|
||||
n += __strlen(p);
|
||||
n += xp_stx_strlen(p);
|
||||
}
|
||||
xp_va_end (ap);
|
||||
|
||||
@ -105,34 +99,9 @@ xp_stx_word_t xp_stx_allocn_string_object (xp_stx_t* stx, ...)
|
||||
|
||||
xp_stx_word_t xp_stx_hash_string_object (xp_stx_t* stx, xp_stx_word_t idx)
|
||||
{
|
||||
xp_stx_word_t nb, h = 0;
|
||||
xp_byte_t* p, * end;
|
||||
|
||||
xp_assert (XP_STX_TYPE(stx,idx) == XP_STX_CHAR_INDEXED);
|
||||
nb = XP_STX_SIZE(stx,idx) * xp_sizeof(xp_stx_char_t);
|
||||
p = (xp_byte_t*)&XP_STX_AT(stx,idx,0); end = p + nb;
|
||||
|
||||
while (p < end) h = h * 31 + *p++;
|
||||
return h;
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_new_symbol (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name)
|
||||
{
|
||||
xp_stx_word_t x;
|
||||
x = xp_stx_alloc_string_object (stx, name);
|
||||
XP_STX_CLASS(stx,x) = stx->class_symbol;
|
||||
return x;
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_new_symbol_pp (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name,
|
||||
const xp_stx_char_t* prefix, const xp_stx_char_t* postfix)
|
||||
{
|
||||
xp_stx_word_t x;
|
||||
x = xp_stx_allocn_string_object (stx, prefix, name, postfix, XP_NULL);
|
||||
XP_STX_CLASS(stx,x) = stx->class_symbol;
|
||||
return x;
|
||||
return xp_stx_strxhash (
|
||||
&XP_STX_CHARAT(stx,idx,0), XP_STX_SIZE(stx,idx));
|
||||
}
|
||||
|
||||
xp_stx_word_t xp_stx_new_class (xp_stx_t* stx, const xp_stx_char_t* name)
|
||||
@ -164,3 +133,17 @@ xp_stx_word_t xp_stx_new_class (xp_stx_t* stx, const xp_stx_char_t* name)
|
||||
return class;
|
||||
}
|
||||
|
||||
int xp_stx_lookup_global (
|
||||
xp_stx_t* stx, xp_stx_word_t key, xp_stx_word_t* value)
|
||||
{
|
||||
xp_stx_word_t link;
|
||||
|
||||
// TODO: maybe xp_stx_hash_object is required instead of
|
||||
// xp_stx_hash_string_object.
|
||||
link = xp_stx_hash_lookup (stx, stx->symbol_table,
|
||||
xp_stx_hash_string_object(stx,key), key);
|
||||
if (link == stx->nil) return -1;
|
||||
|
||||
*value = XP_STX_AT(stx,link,2);
|
||||
return 0;
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* $Id: object.h,v 1.10 2005-05-12 15:25:06 bacon Exp $
|
||||
* $Id: object.h,v 1.11 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#ifndef _XP_STX_OBJECT_H_
|
||||
@ -33,15 +33,12 @@ xp_stx_word_t xp_stx_alloc_string_object (
|
||||
xp_stx_word_t xp_stx_allocn_string_object (xp_stx_t* stx, ...);
|
||||
|
||||
xp_stx_word_t xp_stx_hash_string_object (xp_stx_t* stx, xp_stx_word_t idx);
|
||||
|
||||
xp_stx_word_t xp_stx_new_symbol (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name);
|
||||
xp_stx_word_t xp_stx_new_symbol_pp (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name,
|
||||
const xp_stx_char_t* prefix, const xp_stx_char_t* postfix);
|
||||
xp_stx_word_t xp_stx_new_class (
|
||||
xp_stx_t* stx, const xp_stx_char_t* name);
|
||||
|
||||
int xp_stx_lookup_global (
|
||||
xp_stx_t* stx, xp_stx_word_t key, xp_stx_word_t* value);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* $Id: stx.c,v 1.12 2005-05-12 15:33:38 bacon Exp $
|
||||
* $Id: stx.c,v 1.13 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/stx/stx.h>
|
||||
@ -31,7 +31,10 @@ xp_stx_t* xp_stx_open (xp_stx_t* stx, xp_stx_word_t capacity)
|
||||
stx->class_symbol = XP_STX_NIL;
|
||||
stx->class_metaclass = XP_STX_NIL;
|
||||
stx->class_symbol_link = XP_STX_NIL;
|
||||
stx->class_method = XP_STX_NIL;
|
||||
stx->class_context = XP_STX_NIL;
|
||||
|
||||
stx->__wantabort = xp_false;
|
||||
return stx;
|
||||
}
|
||||
|
||||
@ -152,6 +155,9 @@ int xp_stx_bootstrap (xp_stx_t* stx)
|
||||
tmp = XP_STX_CLASS(stx,class_Object);
|
||||
XP_STX_AT(stx,tmp,XP_STX_CLASS_SUPERCLASS) = class_Class;
|
||||
|
||||
stx->class_method = xp_stx_new_class (stx, XP_STX_TEXT("Method"));
|
||||
stx->class_context = xp_stx_new_class (stx, XP_STX_TEXT("Context"));
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* $Id: stx.h,v 1.11 2005-05-12 15:25:06 bacon Exp $
|
||||
* $Id: stx.h,v 1.12 2005-05-15 18:37:00 bacon Exp $
|
||||
*/
|
||||
|
||||
#ifndef _XP_STX_STX_H_
|
||||
@ -74,7 +74,11 @@ struct xp_stx_t
|
||||
xp_stx_word_t class_symbol;
|
||||
xp_stx_word_t class_metaclass;
|
||||
xp_stx_word_t class_symbol_link;
|
||||
xp_stx_word_t class_method;
|
||||
xp_stx_word_t class_context;
|
||||
|
||||
xp_bool_t __malloced;
|
||||
xp_bool_t __wantabort; // TODO: make it a function pointer
|
||||
};
|
||||
|
||||
#define XP_STX_NIL 0
|
||||
|
@ -1,18 +1,26 @@
|
||||
#include <xp/stx/stx.h>
|
||||
#include <xp/bas/stdio.h>
|
||||
|
||||
#include <xp/stx/object.h>
|
||||
#include <xp/stx/context.h>
|
||||
#include <xp/stx/hash.h>
|
||||
|
||||
void print_symbol_names (xp_stx_t* stx, xp_stx_word_t idx)
|
||||
{
|
||||
xp_stx_word_t key = XP_STX_AT(stx,idx,1);
|
||||
xp_printf (XP_TEXT("%s\n"), &XP_STX_CHARAT(stx,key,0));
|
||||
xp_printf (XP_TEXT("%u -> %s\n"), key, &XP_STX_CHARAT(stx,key,0));
|
||||
}
|
||||
|
||||
int xp_main ()
|
||||
int xp_main (int argc, xp_char_t* argv[])
|
||||
{
|
||||
xp_stx_t stx;
|
||||
xp_stx_word_t i;
|
||||
|
||||
if (argc != 2) { // TODO: argument processing
|
||||
xp_printf (XP_TEXT("Usage: %s [-f imageFile] MainClass"), argv[0]);
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (xp_stx_open (&stx, 10000) == XP_NULL) {
|
||||
xp_printf (XP_TEXT("cannot open stx\n"));
|
||||
return -1;
|
||||
@ -30,21 +38,32 @@ int xp_main ()
|
||||
|
||||
xp_stx_hash_traverse (&stx, stx.symbol_table, print_symbol_names);
|
||||
|
||||
/*
|
||||
for (i = 0; i < 20; i++) {
|
||||
xp_printf (XP_TEXT("%d, %d\n"),
|
||||
i, xp_stx_memory_alloc(&stx.memory, 100));
|
||||
{
|
||||
xp_stx_word_t class_name, method_name;
|
||||
xp_stx_word_t main_class;
|
||||
xp_stx_word_t method, context;
|
||||
|
||||
class_name = xp_stx_new_symbol (&stx,argv[1]);
|
||||
method_name = xp_stx_new_symbol (&stx,XP_STX_TEXT("main"));
|
||||
|
||||
if (xp_stx_lookup_global (&stx,class_name, &main_class) == -1) {
|
||||
xp_printf (XP_TEXT("non-existent class: %s\n"), argv[1]);
|
||||
return -1;
|
||||
}
|
||||
|
||||
for (i = 5; i < 10; i++) {
|
||||
xp_stx_memory_dealloc (&stx.memory, i);
|
||||
method = xp_stx_alloc_byte_object (&stx,100);
|
||||
XP_STX_CLASS(&stx,method) = stx.class_method;
|
||||
|
||||
XP_STX_BYTEAT(&stx,method,0) = PUSH_OBJECT;
|
||||
XP_STX_BYTEAT(&stx,method,1) = main_class;
|
||||
XP_STX_BYTEAT(&stx,method,2) = SEND_UNARY_MESSAGE;
|
||||
XP_STX_BYTEAT(&stx,method,3) = method_name;
|
||||
XP_STX_BYTEAT(&stx,method,4) = HALT;
|
||||
|
||||
context = xp_stx_new_context (&stx, method, stx.nil, stx.nil);
|
||||
xp_stx_run_context (&stx, context);
|
||||
}
|
||||
|
||||
for (i = 0; i < 20; i++) {
|
||||
xp_printf (XP_TEXT("%d, %d\n"),
|
||||
i, xp_stx_memory_alloc(&stx.memory, 100));
|
||||
}
|
||||
*/
|
||||
xp_stx_close (&stx);
|
||||
xp_printf (XP_TEXT("End of program\n"));
|
||||
return 0;
|
||||
|
Loading…
Reference in New Issue
Block a user