hyung-hwan/moo
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

touched up some primitive functions

Browse Source
This commit is contained in:
hyunghwan.chung 2017-12-03 17:08:04 +00:00
parent a817083543
commit 7395a5d2d2
7 changed files with 135 additions and 190 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
moo/kernel/Apex.moo
View File

@ -90,76 +90,46 @@ extend Apex
## -------------------------------------------------------
## -------------------------------------------------------
##method(#dual,#primitive,#lenient) _shallowCopy.
##method(#dual,#primitive) shallowCopy.
method(#dual) shallowCopy
{
<primitive: #_shallow_copy>
self primitiveFailed(thisContext method).
}
method(#dual,#primitive,#lenient) _shallowCopy.
method(#dual,#primitive) shallowCopy.
## -------------------------------------------------------
## -------------------------------------------------------
method(#dual,#primitive,#lenient) _basicSize.
method(#dual,#primitive) basicSize.
method(#dual) basicAt: index
{
| perr |
<primitive: #_basic_at>
## TODO: create a common method that translate a primitive error to some standard exceptions of primitive failure.
perr := thisProcess primError.
if (perr == Error.Code.ERANGE) { self index: index outOfRange: (self basicSize) }
elsif (perr == Error.Code.EPERM) { self messageProhibited: #basicAt }
else { self primitiveFailed }
}
method(#dual) basicAt: index put: anObject
{
| perr |
<primitive: #_basic_at_put>
perr := thisProcess primError.
if (perr == Error.Code.ERANGE) { self index: index outOfRange: (self basicSize) }
elsif (perr == Error.Code.EPERM) { self messageProhibited: #basicAt:put: }
else { self primitiveFailed }
}
method(#dual,#primitive) basicAt: index.
method(#dual,#primitive) basicAt: index put: value.
(* ------------------------------------------------------------------
* FINALIZATION SUPPORT
* ------------------------------------------------------------------ *)
method(#dual,#primitive) addToBeFinalized.
##method(#dual,#primitive) removeToBeFinalized.
method(#dual,#primitive) removeToBeFinalized.
(* ------------------------------------------------------------------
* HASHING
* ------------------------------------------------------------------ *)
method(#dual,#primitive) hash.
(*
method(#dual) hash
{
<primitive: #_hash>
<primitive: #Apex_hash>
self subclassResponsibility: #hash
}
}*)
(* ------------------------------------------------------------------
* IDENTITY TEST
* ------------------------------------------------------------------ *)
method(#dual) == anObject
{
(* check if the receiver is identical to anObject.
* this doesn't compare the contents *)
<primitive: #_identical>
self primitiveFailed.
}
## check if the receiver is identical to anObject.
## this doesn't compare the contents
method(#dual, #primitive) == anObject.
method(#dual) ~~ anObject
{
<primitive: #_not_identical>
<primitive: #'Apex_~~'>
^(self == anObject) not.
}
@ -168,13 +138,13 @@ extend Apex
* ------------------------------------------------------------------ *)
method(#dual) = anObject
{
<primitive: #_equal>
<primitive: #'Apex_='>
self subclassResponsibility: #=
}
method(#dual) ~= anObject
{
<primitive: #_not_equal>
<primitive: #'Apex_~='>
^(self = anObject) not.
}
@ -243,50 +213,41 @@ extend Apex
method(#dual) isKindOf: aClass
{
<primitive: #_is_kind_of>
<primitive: #Apex_isKindOf:>
^(self isMemberOf: aClass) or: [self class inheritsFrom: aClass].
}
## -------------------------------------------------------
## -------------------------------------------------------
method(#dual) respondsTo: selector
{
<primitive: #_responds_to>
self primitiveFailed
}
method(#dual,#primitive) respondsTo: selector.
## -------------------------------------------------------
## -------------------------------------------------------
method(#dual,#variadic) perform(selector)
{
<primitive: #_perform>
self primitiveFailed
}
method(#dual,#variadic,#primitive) perform(selector).
method(#dual) perform: selector
{
<primitive: #_perform>
<primitive: #Apex_perform>
self primitiveFailed
}
method(#dual) perform: selector with: arg1
{
<primitive: #_perform>
<primitive: #Apex_perform>
self primitiveFailed
}
method(#dual) perform: selector with: arg1 with: arg2
{
<primitive: #_perform>
<primitive: #Apex_perform>
self primitiveFailed
}
method(#dual) perform: selector with: arg1 with: arg2 with: arg3
{
<primitive: #_perform>
<primitive: #Apex_perform>
self primitiveFailed
}

4
moo/kernel/Collect.moo
View File

@ -205,14 +205,14 @@ class(#character,#final,#limited,#immutable) Symbol(String)
method = anObject
{
(* for a symbol, equality check is the same as the identity check *)
<primitive: #_identical>
<primitive: #'Apex_=='>
self primitiveFailed.
}
method ~= anObject
{
(* for a symbol, equality check is the same as the identity check *)
<primitive: #_not_identical>
<primitive: #'Apex_~~'>
^(self == anObject) not.
}
}

44
moo/kernel/Context.moo
View File

@ -56,22 +56,20 @@ class(#pointer,#final,#limited) MethodContext(Context)
^self.ip + 1
}
method goto: anInteger
{
<primitive: #_context_goto>
self primitiveFailed. ## TODO: need to make this a hard failure?
}
method pc: anInteger
{
self.ip := anInteger.
}
## it is similar to the pc: method but it doesn't
## push the return value to the stack.
method(#primitive) goto: pc.
method sp
{
^self.sp.
}
method sp: new_sp
{
self.sp := new_sp
@ -113,55 +111,43 @@ class(#pointer,#final,#limited) BlockContext(Context)
^self.home vargAt: index
}
## TODO: how can i pass variadic arguments to newProcess
## method(#variadic) fork() -> how to pass them to newProcess???
method fork
{
## crate a new process in the runnable state
^self newProcess resume.
}
method newProcess
{
## create a new process in the suspended state
<primitive: #_block_new_process>
self primitiveFailed.
}
method(#variadic,#primitive) newProcess().
method newProcessWith: anArray
{
## create a new process in the suspended state passing the elements
## of anArray as block arguments
<primitive: #_block_new_process>
self primitiveFailed.
}
## evaluate the block
method(#variadic,#primitive) value().
method value
{
<primitive: #_block_value>
self primitiveFailed.
}
method value: a
{
<primitive: #_block_value>
<primitive: #BlockContext_value>
self primitiveFailed.
}
method value: a value: b
{
<primitive: #_block_value>
<primitive: #BlockContext_value>
self primitiveFailed.
}
method value: a value: b value: c
{
<primitive: #_block_value>
<primitive: #BlockContext_value>
self primitiveFailed.
}
method value: a value: b value: c value: d
{
<primitive: #_block_value>
<primitive: #BlockContext_value>
self primitiveFailed.
}
method value: a value: b value: c value: d value: e
{
<primitive: #_block_value>
<primitive: #BlockContext_value>
self primitiveFailed.
}

5
moo/kernel/Except.moo
View File

@ -487,6 +487,11 @@ extend Apex
if (msg isNil) { msg := ec asString }.
if (method notNil) { msg := msg & ' - ' & (method owner name) & '>>' & (method name) }.
### TODO: convert an exception to a more specific one depending on the error code.
###if (ec == Error.Code.ERANGE) { self index: index outOfRange: (self basicSize) }
### elsif (ec == Error.Code.EPERM) { self messageProhibited: method name }
### elsif (ec == Error.Code.ENOIMPL) { self subclassResponsibility: method name }.
(PrimitiveFailureException (* in: method *) withErrorCode: ec) signal: msg.
}

109
moo/lib/exec.c
View File

@ -1751,8 +1751,7 @@ static int _equal_objects (moo_t* moo, moo_oop_t rcv, moo_oop_t arg)
MOO_ASSERT (moo, MOO_OBJ_GET_FLAGS_TYPE(rcv) == MOO_OBJ_TYPE_OOP);
#if 1
MOO_DEBUG1 (moo, "<_equal_objects> Cannot compare objects of type %d\n", (int)MOO_OBJ_GET_FLAGS_TYPE(rcv));
moo_seterrnum (moo, MOO_ENOIMPL); /* TODO: better error code */
moo_seterrbfmt (moo, MOO_ENOIMPL, "no builtin comparison implemented for %O and %O", rcv, arg); /* TODO: better error code */
return -1;
#else
for (i = 0; i < MOO_OBJ_GET_SIZE(rcv); i++)
@ -1911,7 +1910,7 @@ static moo_pfrc_t pf_basic_at (moo_t* moo, moo_ooi_t nargs)
if (!MOO_OOP_IS_POINTER(rcv))
{
/* the receiver is a special numeric object, not a normal pointer */
moo_seterrnum (moo, MOO_EINVAL);
moo_seterrbfmt (moo, MOO_EMSGRCV, "receiver not indexable - %O", rcv);
return MOO_PF_FAILURE;
}
@ -1919,13 +1918,13 @@ static moo_pfrc_t pf_basic_at (moo_t* moo, moo_ooi_t nargs)
if (moo_inttooow (moo, pos, &idx) <= 0)
{
/* negative integer or not integer */
moo_seterrnum (moo, MOO_EINVAL);
moo_seterrbfmt (moo, MOO_EINVAL, "invalid position - %O", pos);
return MOO_PF_FAILURE;
}
if (idx >= MOO_OBJ_GET_SIZE(rcv))
{
/* index out of range */
moo_seterrnum (moo, MOO_ERANGE);
moo_seterrbfmt (moo, MOO_ERANGE, "position out of bound - %O", pos);
return MOO_PF_FAILURE;
}
@ -1973,14 +1972,14 @@ static moo_pfrc_t pf_basic_at_put (moo_t* moo, moo_ooi_t nargs)
if (!MOO_OOP_IS_POINTER(rcv))
{
/* the receiver is a special numeric object, not a normal pointer */
moo_seterrnum (moo, MOO_EINVAL);
moo_seterrbfmt (moo, MOO_EMSGRCV, "receiver not indexable - %O", rcv);
return MOO_PF_FAILURE;
}
if (MOO_OBJ_GET_FLAGS_RDONLY(rcv))
{
/* TODO: better error handling */
moo_seterrnum (moo, MOO_EPERM);
moo_seterrbfmt (moo, MOO_EPERM, "now allowed to change a read-only object - %O", rcv);
return MOO_PF_FAILURE;
}
@ -1990,13 +1989,13 @@ static moo_pfrc_t pf_basic_at_put (moo_t* moo, moo_ooi_t nargs)
if (moo_inttooow (moo, pos, &idx) <= 0)
{
/* negative integer or not integer */
moo_seterrnum (moo, MOO_EINVAL);
moo_seterrbfmt (moo, MOO_EINVAL, "invalid position - %O", pos);
return MOO_PF_FAILURE;
}
if (idx >= MOO_OBJ_GET_SIZE(rcv))
{
/* index out of range */
moo_seterrnum (moo, MOO_ERANGE);
moo_seterrbfmt (moo, MOO_ERANGE, "position out of bound - %O", pos);
return MOO_PF_FAILURE;
}
@ -2131,8 +2130,7 @@ static moo_pfrc_t pf_hash (moo_t* moo, moo_ooi_t nargs)
default:
/* MOO_OBJ_TYPE_OOP, ... */
MOO_DEBUG1 (moo, "<pf_hash> Cannot hash an object of type %d\n", type);
moo_seterrnum (moo, MOO_ENOIMPL); /* TODO: better error code? */
moo_seterrbfmt(moo, MOO_ENOIMPL, "no builtin hash implemented for %O", rcv); /* TODO: better error code? */
return MOO_PF_FAILURE;
}
break;
@ -2177,7 +2175,7 @@ static moo_pfrc_t pf_responds_to (moo_t* moo, moo_ooi_t nargs)
if (MOO_CLASSOF(moo,selector) != moo->_symbol)
{
moo_seterrnum (moo, MOO_EINVAL);
moo_seterrbfmt (moo, MOO_EINVAL, "invalid argument - %O", selector);
return MOO_PF_FAILURE;
}
@ -2207,7 +2205,7 @@ static moo_pfrc_t pf_perform (moo_t* moo, moo_ooi_t nargs)
if (MOO_CLASSOF(moo,selector) != moo->_symbol)
{
moo_seterrnum (moo, MOO_EINVAL);
moo_seterrbfmt (moo, MOO_EINVAL, "invalid argument - %O", selector);
return MOO_PF_FAILURE;
}
@ -2227,6 +2225,8 @@ static moo_pfrc_t pf_perform (moo_t* moo, moo_ooi_t nargs)
return MOO_PF_SUCCESS;
}
/* ------------------------------------------------------------------ */
static moo_pfrc_t pf_context_goto (moo_t* moo, moo_ooi_t nargs)
{
moo_oop_t rcv;
@ -2245,9 +2245,7 @@ static moo_pfrc_t pf_context_goto (moo_t* moo, moo_ooi_t nargs)
pc = MOO_STACK_GETARG(moo, nargs, 0);
if (!MOO_OOP_IS_SMOOI(pc) || MOO_OOP_TO_SMOOI(pc) < 0)
{
MOO_LOG1 (moo, MOO_LOG_PRIMITIVE | MOO_LOG_ERROR,
"Error(%hs) - invalid pc\n", __PRIMITIVE_NAME__);
moo_seterrnum (moo, MOO_EINVAL);
moo_seterrbfmt (moo, MOO_EINVAL, "invalid pc - %O", pc);
return MOO_PF_FAILURE;
}
@ -2259,6 +2257,8 @@ static moo_pfrc_t pf_context_goto (moo_t* moo, moo_ooi_t nargs)
return MOO_PF_SUCCESS;
}
/* ------------------------------------------------------------------ */
static moo_pfrc_t __block_value (moo_t* moo, moo_oop_context_t rcv_blkctx, moo_ooi_t nargs, moo_ooi_t num_first_arg_elems, moo_oop_context_t* pblkctx)
{
/* prepare a new block context for activation.
@ -2291,21 +2291,16 @@ static moo_pfrc_t __block_value (moo_t* moo, moo_oop_context_t rcv_blkctx, moo_o
* you can't send 'value' again to reactivate it.
* For example, [thisContext value] value. */
MOO_ASSERT (moo, MOO_OBJ_GET_SIZE(rcv_blkctx) > MOO_CONTEXT_NAMED_INSTVARS);
MOO_LOG2 (moo, MOO_LOG_PRIMITIVE | MOO_LOG_ERROR,
"Error(%hs) - re-valuing of a block context - %O\n", __PRIMITIVE_NAME__, rcv_blkctx);
moo_seterrnum (moo, MOO_EPERM);
moo_seterrbfmt (moo, MOO_EPERM, "re-valuing of a block context - %O", rcv_blkctx);
return MOO_PF_FAILURE;
}
MOO_ASSERT (moo, MOO_OBJ_GET_SIZE(rcv_blkctx) == MOO_CONTEXT_NAMED_INSTVARS);
if (MOO_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs) != actual_arg_count /* nargs */)
{
MOO_LOG4 (moo, MOO_LOG_PRIMITIVE | MOO_LOG_ERROR,
"Error(%hs) - wrong number of arguments to a block context %O - %zd expected, %zd given\n",
__PRIMITIVE_NAME__, rcv_blkctx, MOO_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs), actual_arg_count);
moo_seterrnum (moo, MOO_ENUMARGS);
moo_seterrbfmt (moo, MOO_ENUMARGS,
"wrong number of arguments to a block context %O - %zd expected, %zd given",
rcv_blkctx, MOO_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs), actual_arg_count);
return MOO_PF_FAILURE;
}
@ -2320,10 +2315,7 @@ static moo_pfrc_t __block_value (moo_t* moo, moo_oop_context_t rcv_blkctx, moo_o
moo_pushtmp (moo, (moo_oop_t*)&rcv_blkctx);
blkctx = (moo_oop_context_t) moo_instantiate (moo, moo->_block_context, MOO_NULL, local_ntmprs);
moo_poptmp (moo);
if (!blkctx)
{
return MOO_PF_FAILURE;
}
if (!blkctx) return MOO_PF_FAILURE;
#if 0
/* shallow-copy the named part including home, origin, etc. */
@ -2393,12 +2385,13 @@ static moo_pfrc_t pf_block_new_process (moo_t* moo, moo_ooi_t nargs)
/* create a new process from a block context.
* the receiver must be be a block.
* [ 1 + 2 ] newProcess.
* [ :a :b | a + b ] newProcess: #(1 2)
* [ :a :b | a + b ] newProcess(1, 2)
*/
int x;
moo_oop_context_t rcv_blkctx, blkctx;
moo_oop_process_t proc;
#if 0
moo_ooi_t num_first_arg_elems = 0;
MOO_ASSERT (moo, nargs <= 1);
@ -2418,20 +2411,18 @@ static moo_pfrc_t pf_block_new_process (moo_t* moo, moo_ooi_t nargs)
num_first_arg_elems = MOO_OBJ_GET_SIZE(xarg);
}
#endif
rcv_blkctx = (moo_oop_context_t)MOO_STACK_GETRCV(moo, nargs);
if (MOO_CLASSOF(moo, rcv_blkctx) != moo->_block_context)
{
/* the receiver must be a block context */
MOO_LOG2 (moo, MOO_LOG_PRIMITIVE | MOO_LOG_ERROR,
"Error(%hs) - invalid receiver, not a block context - %O\n", __PRIMITIVE_NAME__, rcv_blkctx);
moo_seterrnum (moo, MOO_EINVAL);
return MOO_PF_FAILURE;
}
MOO_PF_CHECK_RCV (moo, MOO_CLASSOF(moo,rcv_blkctx) == moo->_block_context);
/* this primitive creates a new process with a block as if the block
* is sent the value message */
#if 0
x = __block_value (moo, rcv_blkctx, nargs, num_first_arg_elems, &blkctx);
#else
x = __block_value (moo, rcv_blkctx, nargs, 0, &blkctx);
#endif
if (x <= 0) return x; /* both hard failure and soft failure */
/* reset the sender field to moo->_nil because this block context
@ -2441,7 +2432,7 @@ static moo_pfrc_t pf_block_new_process (moo_t* moo, moo_ooi_t nargs)
blkctx->sender = (moo_oop_context_t)moo->_nil;
proc = make_process (moo, blkctx);
if (!proc) return MOO_PF_HARD_FAILURE; /* hard failure */ /* TOOD: can't this be treated as a soft failure? throw an exception instead?? */
if (!proc) return MOO_PF_FAILURE; /* hard failure */ /* TOOD: can't this be treated as a soft failure? throw an exception instead?? */
/* __block_value() has popped all arguments and the receiver.
* PUSH the return value instead of changing the stack top */
@ -4306,29 +4297,6 @@ static pf_t pftab[] =
{
{ "_dump", { pf_dump, 0, MA } },
{ "_identical", { pf_identical, 1, 1 } },
{ "_not_identical", { pf_not_identical, 1, 1 } },
{ "_equal", { pf_equal, 1, 1 } },
{ "_not_equal", { pf_not_equal, 1, 1 } },
{ "_shallow_copy", { pf_shallow_copy, 0, 0 } },
{ "_basic_at", { pf_basic_at, 1, 1 } },
{ "_basic_at_put", { pf_basic_at_put, 2, 2 } },
{ "_hash", { pf_hash, 0, 0 } },
{ "_is_kind_of", { pf_is_kind_of, 1, 1, } },
{ "_responds_to", { pf_responds_to, 1, 1 } },
{ "_perform", { pf_perform, 1, MA } },
{ "_context_goto", { pf_context_goto, 1, 1 } },
{ "_block_value", { pf_block_value, 0, MA } },
{ "_block_new_process", { pf_block_new_process, 0, 1 } },
{ "_processor_schedule", { pf_processor_schedule, 1, 1 } },
{ "_integer_add", { pf_integer_add, 1, 1 } },
@ -4354,6 +4322,8 @@ static pf_t pftab[] =
{ "_integer_inttostr", { pf_integer_inttostr, 1, 1 } },
{ "Apex_addToBeFinalized", { pf_add_to_be_finalized, 0, 0 } },
{ "Apex_basicAt:", { pf_basic_at, 1, 1 } },
{ "Apex_basicAt:put:", { pf_basic_at_put, 2, 2 } },
{ "Apex_basicNew", { pf_basic_new, 0, 0 } },
{ "Apex_basicNew:", { pf_basic_new, 1, 1 } },
{ "Apex_basicSize", { pf_basic_size, 0, 0 } },
@ -4361,7 +4331,20 @@ static pf_t pftab[] =
{ "Apex_basicNew:", { pf_basic_new, 1, 1 } },
{ "Apex_basicSize", { pf_basic_size, 0, 0 } },
{ "Apex_class", { pf_class, 0, 0 } },
{ "Apex_hash", { pf_hash, 0, 0 } },
{ "Apex_isKindOf:", { pf_is_kind_of, 1, 1, } },
{ "Apex_perform", { pf_perform, 1, MA } },
{ "Apex_removeToBeFinalized", { pf_remove_to_be_finalized, 0, 0 } },
{ "Apex_respondsTo:", { pf_responds_to, 1, 1 } },
{ "Apex_shallowCopy", { pf_shallow_copy, 0, 0 } },
{ "Apex_==", { pf_identical, 1, 1 } },
{ "Apex_~~", { pf_not_identical, 1, 1 } },
{ "Apex_=", { pf_equal, 1, 1 } },
{ "Apex_~=", { pf_not_equal, 1, 1 } },
{ "BlockContext_value", { pf_block_value, 0, MA } },
{ "BlockContext_newProcess", { pf_block_new_process, 0, MA } },
{ "Character_asInteger", { pf_character_as_smooi, 0, 0 } },
@ -4369,6 +4352,8 @@ static pf_t pftab[] =
{ "Error_asInteger", { pf_error_as_integer, 0, 0 } },
{ "Error_asString", { pf_error_as_string, 0, 0 } },
{ "MethodContext_goto:", { pf_context_goto, 1, 1 } },
{ "Process_resume", { pf_process_resume, 0, 0 } },
{ "Process_sp", { pf_process_sp, 0, 0 } },
{ "Process_suspend", { pf_process_suspend, 0, 0 } },

17
moo/lib/main.c
View File

@ -2098,7 +2098,7 @@ static int handle_logopt (moo_t* moo, const moo_bch_t* str)
}
while (cm);
xtn->logmask |= MOO_LOG_ALL_LEVELS; /* TODO: parse leves also */
xtn->logmask |= MOO_LOG_ALL_LEVELS; /* TODO: parse levels also */
}
else
{
@ -2130,10 +2130,15 @@ int main (int argc, char* argv[])
int i, xret;
moo_bci_t c;
static moo_bopt_lng_t lopt[] =
{
{ ":log", 'l' },
{ MOO_NULL, '\0' }
};
static moo_bopt_t opt =
{
"l:",
MOO_NULL
lopt
};
const char* logopt = MOO_NULL;
@ -2229,15 +2234,19 @@ int main (int argc, char* argv[])
return -1;
}
}
else
{
/* default logging mask when no logging option is set */
xtn->logmask = MOO_LOG_ALL_TYPES | MOO_LOG_ERROR | MOO_LOG_FATAL;
}
if (moo_ignite(moo) <= -1)
{
moo_logbfmt (moo, MOO_LOG_ERROR, "ERROR: cannot ignite moo - [%d] %js\n", moo_geterrnum(moo), moo_geterrstr(moo));
moo_logbfmt (moo, MOO_LOG_ERROR | MOO_LOG_STDERR, "ERROR: cannot ignite moo - [%d] %js\n", moo_geterrnum(moo), moo_geterrstr(moo));
close_moo (moo);
return -1;
}
#if defined(macintosh)
i = 20;
xtn->source_path = "test.st";

1
moo/lib/moo.c
View File

@ -193,7 +193,6 @@ void moo_fini (moo_t* moo)
if (cb->fini) cb->fini (moo);
}
moo_rbt_walk (&moo->modtab, unload_module, moo); /* unload all modules */
moo_rbt_fini (&moo->modtab);