From ce69989a86d3af9d2c6144ed2aa9705d46007fff Mon Sep 17 00:00:00 2001 From: "hyunghwan.chung" Date: Tue, 9 May 2017 15:48:44 +0000 Subject: [PATCH] touched up primitive failure handling a bit --- moo/kernel/Apex.moo | 27 ++++++++------------------- moo/kernel/Class.moo | 8 +------- moo/kernel/Except.moo | 34 +++++++++++----------------------- moo/kernel/Process.moo | 12 ------------ moo/kernel/X11.moo | 14 +------------- moo/lib/exec.c | 23 +++++++++++++++++++---- moo/lib/gc.c | 2 +- 7 files changed, 41 insertions(+), 79 deletions(-) diff --git a/moo/kernel/Apex.moo b/moo/kernel/Apex.moo index f93d0fc..aa5fce8 100644 --- a/moo/kernel/Apex.moo +++ b/moo/kernel/Apex.moo @@ -53,28 +53,17 @@ extend Apex method(#class,#primitive) basicNew. method(#class,#primitive) basicNew: size. - - (* - method(#class) basicNew - { - | perr | - - self primitiveFailed. - - ## perr := thisProcess primError. - ## if (perr == xxxx) { self cannotInstantiate } - ## else { self primitiveFailed }. - } - + (* the following definition is almost equivalent to the simpler definition + * method(#class,#primitive) basicNew: size. + * found above. + * in the following defintion, the primitiveFailed method is executed + * from the basicNew: context. but in the simpler definition, it is executed + * in the context of the caller of the basicNew:. the context of the basicNew: + * method is not even created method(#class) basicNew: size { - | perr | - self primitiveFailed. - - ## perr := thisProcess primError. - ## if (perr == xxxx) { self cannotInstantiate } - ## else { self primitiveFailed }. + self primitiveFailed(thisContext method) }*) method(#class) new diff --git a/moo/kernel/Class.moo b/moo/kernel/Class.moo index 2c01a3b..3c5bde8 100644 --- a/moo/kernel/Class.moo +++ b/moo/kernel/Class.moo @@ -2,19 +2,13 @@ ## the Class object should be a variable-pointer object because ## it needs to accomodate class instance variables. ## -class(#pointer) Class(Apex) +class(#pointer,#limited) Class(Apex) { var spec, selfspec, superclass, subclasses, name, modname. var instvars, classinstvars, classvars, pooldics. var instmthdic, classmthdic, nsdic, cdic. var trsize, initv, initv_ci. - method(#class) basicNew - { - ## you must not instantiate a new class this way. - self cannotInstantiate. - } - method(#class) initialize { ^self. diff --git a/moo/kernel/Except.moo b/moo/kernel/Except.moo index d1966a3..0412370 100644 --- a/moo/kernel/Except.moo +++ b/moo/kernel/Except.moo @@ -379,10 +379,6 @@ class PrimitiveFailureException(Exception) { } -class InstantiationFailureException(Exception) -{ -} - class NoSuchMessageException(Exception) { } @@ -413,30 +409,22 @@ class ProhibitedMessageException(Exception) extend Apex { - method(#dual,#variadic) primitiveFailed() + method(#dual,#liberal) primitiveFailed(method) { - | a b | - - thisContext vargCount dump. - a := 1. + | a b msg | + + (*System logNl: 'Arguments: '. + a := 0. b := thisContext vargCount. -'PRIMITIVE FAILED............................................' dump. -self dump. while (a < b) { - (thisContext vargAt: a) dump. + System logNl: (thisContext vargAt: a) asString. a := a + 1. - }. - -('PRIMITIVE FAILED....' & (thisContext vargAt: 0)) dump. - - PrimitiveFailureException signal: 'PRIMITIVE FAILED'. - } - - method(#dual) cannotInstantiate - { - ## TODO: use displayString or something like that instead of name.... - InstantiationFailureException signal: 'Cannot instantiate ' & (self name). + }.*) + + msg := thisProcess primError asString. + if (method notNil) { msg := msg & ' - ' & (method owner name) & '<<' & (method name) }. + PrimitiveFailureException signal: msg. } method(#dual) doesNotUnderstand: message_name diff --git a/moo/kernel/Process.moo b/moo/kernel/Process.moo index 35d5f73..d291434 100644 --- a/moo/kernel/Process.moo +++ b/moo/kernel/Process.moo @@ -3,18 +3,6 @@ class(#pointer,#final,#limited) Process(Object) { var initial_context, current_context, state, sp, prev, next, sem, perr. - method(#class) basicNew - { - (* instantiation is not allowed. a process is strictly a VM managed object *) - self cannotInstantiate - } - - method(#class) basicNew: size - { - (* instantiation is not allowed. a process is strictly a VM managed object *) - self cannotInstantiate - } - method prev { ^self.prev } method next { ^self.next } diff --git a/moo/kernel/X11.moo b/moo/kernel/X11.moo index e628f24..6098b43 100644 --- a/moo/kernel/X11.moo +++ b/moo/kernel/X11.moo @@ -229,22 +229,10 @@ class X11.GC(Object) from 'x11.gc' ## --------------------------------------------------------------------------- -class X11.Component(Object) +class(#limited) X11.Component(Object) { var parent. - method new - { - ## you must call new: parent instead. - self cannotInstantiate - } - - method new: parent - { - ## you must call new: parent instead. - self cannotInstantiate - } - method parent { ^self.parent diff --git a/moo/lib/exec.c b/moo/lib/exec.c index 99cc426..7433c78 100644 --- a/moo/lib/exec.c +++ b/moo/lib/exec.c @@ -4087,15 +4087,30 @@ static int start_method (moo_t* moo, moo_oop_method_t method, moo_oow_t nargs) }; moo_oow_t i; - MOO_DEBUG2 (moo, "Sending primitiveFailed for empty primitive body - %.*js\n", MOO_OBJ_GET_SIZE(method->name), MOO_OBJ_GET_CHAR_SLOT(method->name)); + if (stack_base != moo->sp - nargs - 1) + { + /* a primitive function handler must not touch the stack when it returns soft failure */ + MOO_DEBUG3 (moo, "Stack seems to get corrupted by a primitive handler function - %O<<%.*js\n", method->owner, MOO_OBJ_GET_SIZE(method->name), MOO_OBJ_GET_CHAR_SLOT(method->name)); + moo->errnum = MOO_EINTERN; + return -1; + } - ////// //moo->sp = stack_base + 1; /* keep the receiver only. drop all arguments */ + MOO_DEBUG3 (moo, "Sending primitiveFailed for empty primitive body - %O<<%.*js\n", method->owner, MOO_OBJ_GET_SIZE(method->name), MOO_OBJ_GET_CHAR_SLOT(method->name)); -//if the primitive handler function screwed the stack??? partially popped??? can't handle excessive pops... + /* + * | arg1 | <---- stack_base + 3 + * | arg0 | <---- stack_base + 2 + * | receiver | <---- stack_base + 1 + * | | <---- stack_base + */ + /* push out arguments by one slot */ MOO_STACK_PUSH (moo, moo->_nil); /* fake */ for (i = moo->sp; i > stack_base + 2; i--) MOO_STACK_SET (moo, i, MOO_STACK_GET(moo, i - 1)); - MOO_STACK_SET (moo, stack_base + 2, (moo_oop_t)method->name); + /* inject the method as the first argument */ + MOO_STACK_SET (moo, stack_base + 2, (moo_oop_t)method); + + /* send primitiveFailed to self */ if (send_private_message (moo, prim_fail_msg, 15, 0, nargs + 1) <= -1) return -1; break; #endif diff --git a/moo/lib/gc.c b/moo/lib/gc.c index f37b06a..642c029 100644 --- a/moo/lib/gc.c +++ b/moo/lib/gc.c @@ -153,7 +153,7 @@ static int ignite_1 (moo_t* moo) * The instance of Class can have indexed instance variables * which are actually class variables. * -------------------------------------------------------------- */ - moo->_class = alloc_kernel_class (moo, 0, 0, MOO_CLASS_SPEC_MAKE(MOO_CLASS_NAMED_INSTVARS, 1, MOO_OBJ_TYPE_OOP)); + moo->_class = alloc_kernel_class (moo, MOO_CLASS_SELFSPEC_FLAG_LIMITED, 0, MOO_CLASS_SPEC_MAKE(MOO_CLASS_NAMED_INSTVARS, 1, MOO_OBJ_TYPE_OOP)); if (!moo->_class) return -1; MOO_ASSERT (moo, MOO_OBJ_GET_CLASS(moo->_class) == MOO_NULL);