From: <bi...@us...> - 2007-04-11 10:29:43
|
Revision: 263 http://svn.sourceforge.net/oorexx/?rev=263&view=rev Author: bigrixx Date: 2007-04-11 03:29:43 -0700 (Wed, 11 Apr 2007) Log Message: ----------- Switch core Rexx classes over to using USE STRICT, get rid a bunch of the old SOM stuff that was still in the image file, put USESTRICT in the vft restoration table so USE STRICT can be used in the kernel image classes. Modified Paths: -------------- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx interpreter-3.x/trunk/kernel/RexxClasses/SystemObjects.orx interpreter-3.x/trunk/kernel/parser/InstructionParser.cpp interpreter-3.x/trunk/kernel/runtime/PrimitiveClasses.h interpreter-3.x/trunk/kernel/runtime/RexxStartup.cpp Modified: interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-04-10 23:27:43 UTC (rev 262) +++ interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-04-11 10:29:43 UTC (rev 263) @@ -97,114 +97,23 @@ /* Call the system dependant routine to define addition methods */ systemMethods = 'SystemMethods.orx'() /* case sensitive */ -/********************************************************steve do these need to be moved to class ? -.class~!addmeth('!SOMDEFINE', systemMethods~!somdefine) -.class~!addmeth('!CEXPORT', systemMethods~!cexport) -********************************************************************************/ - -say ('creating .!sender and defining its instance methods') -sender = .object~subclass('sender') -sender_mdict = .table~new -sender_mdict~put(.methods~sender_init, 'INIT') -sender_mdict~put(.methods~sender_send, 'SEND') -sender_mdict~put(kernel_methods["SENDER_GETPID"], '!GETPID') -sender_mdict~put(kernel_methods["SENDER_SENDMESSAGE"], '!SEND_MESSAGE') -sender~!define_methods(sender_mdict) -sender~!rexxdefined /* Mark as unchangeable */ -.environment~setentry('!sender',sender) - - say ('creating .!server and defining its instance methods') server = .object~subclass('server') server_mdict = .table~new -server_mdict~put(.methods~server_add_method, 'ADDMETHOD') -server_mdict~put(.methods~server_addclass, 'ADDCLASS') -server_mdict~put(.methods~server_addproxy, 'ADDPROXY') -server_mdict~put(.methods~server_dispatch, 'DISPATCH') -/* -server_mdict~put(.methods~server_dump, '!DUMP') -*/ -server_mdict~put(.methods~server_exit, 'EXIT') -server_mdict~put(.methods~server_free, 'FREE') -server_mdict~put(.methods~server_import, 'IMPORT') -server_mdict~put(.methods~server_!import_lineage, '!IMPORT_LINEAGE') server_mdict~put(.methods~server_init, 'INIT') -server_mdict~put(kernel_methods['!SOMSERVER_INITDSOM'], '!INITDSOM') -server_mdict~put(kernel_methods['!SOMSERVER_INITDSOMWPS'], '!INITDSOMWPS') -server_mdict~put(kernel_methods['!SERVER_WAIT'], '!MESSAGEWAIT') server_mdict~put(kernel_methods['RUN_PROGRAM'], 'RUN_PROGRAM') server_mdict~put(kernel_methods['CALL_PROGRAM'], 'CALL_PROGRAM') server_mdict~put(kernel_methods['CALL_STRING'], 'CALL_STRING') -server_mdict~put(.methods~server_local, 'LOCAL') -server_mdict~put(.methods~server_make_proxy, 'MAKE_PROXY') -server_mdict~put(.methods~server_new_class, 'NEW_CLASS') -server_mdict~put(.methods~server_oclass, 'OCLASS') -server_mdict~put(.methods~server_remove_oref, 'REMOVE_OREF') -server_mdict~put(.methods~server_!startMessageWait, '!STARTMESSAGEWAIT') server_mdict~put(.methods~server_save_result, 'SAVE_RESULT') -server_mdict~put(.methods~server_!send_init, '!SEND_INIT') -server_mdict~put(.methods~server_send, 'SEND') -server_mdict~put(.methods~server_setid, 'SETID') -server_mdict~put(.methods~server_setsom, 'SETSOM') -server_mdict~put(.methods~server_somD_init, 'SOMD_INIT') -server_mdict~put(.methods~server_somlook, 'SOMLOOK') -server_mdict~put(.methods~server_somobj, 'SOMOBJ') -server_mdict~put(.methods~server_!setMethod, '!SETMETHOD') - - /* Now install the system specific methods for SERVER */ -server_mdict~put(systemMethods~server_findsomclass , 'FINDSOMCLASS') -server_mdict~put(systemMethods~server_init_local , 'INIT_LOCAL') -server_mdict~put(systemMethods~server_somclass , '!SOMCLASS') -server_mdict~put(systemMethods~server_sominitialize , 'SOMINITIALIZE') -server_mdict~put(systemMethods~server_somname , 'SOMNAME') -server_mdict~put(systemMethods~server_somparent , 'SOMPARENT') -server_mdict~put(systemMethods~server_somproxy , 'SOMPROXY') -server_mdict~put(systemMethods~server_somtrace , 'SOMTRACE') -server_mdict~put(systemMethods~server_c_sominit , '!C_SOMINITIALIZE') - server~!define_methods(server_mdict) server~!rexxdefined /* Mark as unchangeable */ -.environment~setentry('!server',server) +.environment~setentry('!server', server) -say ('creating .!DSOMServerProxy and defining its instance methods') -dserver = .object~subclass('DSOMServerProxy') -dserver_mdict = .table~new -dserver_mdict~put(.methods~dserver_unknown , 'UNKNOWN' ) -dserver_mdict~put(.methods~dserver_import , 'IMPORT' ) -dserver_mdict~put(.methods~dserver_hasmethod , 'HASMETHOD' ) -dserver_mdict~put(.methods~dserver_init , 'INIT' ) - -dserver~!define_methods(dserver_mdict) -dserver~!rexxdefined /* Mark as unchangeable */ -.environment~setentry('!DSOMServerProxy',dserver) - -say ('creating .!SOMDServer Methods') -sdserver_mdict = .directory~new -sdserver_mdict~put(kernel_methods['SOMDSERVER_GETCLASSOBJ'], 'SOMDGETCLASSOBJ') -sdserver_mdict~put(kernel_methods['SOMDSERVER_CREATEOBJ'] , 'SOMDCREATEOBJ' ) -sdserver_mdict~put(kernel_methods['SOMDSERVER_DELETEOBJ'] , 'SOMDDELETEOBJ' ) - -.environment~setentry('!SOMDServerMethods', sdserver_mdict) - -say ('creating .!SOMD_ObjectMgr Methods') -objMgr_mdict = .directory~new -objMgr_mdict~put(kernel_methods['SOMDOBJECTMGR_ENHANCESERVER'],'ENHANCESERVER') -objMgr_mdict~put(.methods~objMgr_findServer , 'SOMDFINDANYSERVERBYCLASS') -objMgr_mdict~put(.methods~objMgr_findServer , 'SOMDFINDSERVER' ) -objMgr_mdict~put(.methods~objMgr_findServer , 'SOMDFINDSERVERSBYCLASS' ) -objMgr_mdict~put(.methods~objMgr_findServer , 'SOMDFINDSERVERBYNAME' ) -objMgr_mdict~put(.methods~objMgr_findServer , '!SOMDMETHODSINSTALLED' ) - -.environment~setentry('!SOMDObjectMgrMethods', objMgr_mdict) - /* make references to .local return the local environment */ .environment~setmethod('LOCAL',kernel_methods['LOCAL']) -/* install Standalone SOM methods into environment */ -call 'SOMMethods.orx' /* case sensitive for Unix */ - /* load the system objects */ call 'SystemObjects.orx' /* all lower case for Unix @MAE002M */ @@ -228,17 +137,10 @@ /* DIFFERENCE method */ /*****************************************/ ::METHOD single_difference /* take the difference of collections*/ -use arg other /* get the companion object */ +use strict arg other /* get the companion object */ -signal on syntax /*@CHM004M*/ /* trap unknown method calls */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ +signal on nomethod /* trap unknown method calls */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ - new = self~copy /* make a new collection */ do index over other /* loop over the other collection */ new~remove(index) /* "subtract" this item */ @@ -246,22 +148,17 @@ return new /* return the difference collection */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: /* unknown method sent */ + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") /*****************************************/ /* XOR method */ /*****************************************/ ::METHOD single_xor /* take the exclusive or of a set */ -use arg other /* get the companion object */ +use strict arg other /* get the companion object */ -signal on syntax /*@CHM004M*/ /* trap unknown method calls */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ +signal on nomethod /* trap unknown method calls */ new = self~copy if other~hasmethod("union") then /* is other non-primitive collection?*/ @@ -280,24 +177,18 @@ return new /* return the XOR collection */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") /*****************************************/ /* INTERSECTION method */ /*****************************************/ ::METHOD single_intersection /* take the intersection of sets */ -use arg other /* get the other collection */ +use strict arg other /* get the other collection */ -signal on syntax /*@CHM004M*/ /* trap unknown method calls */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ +signal on nomethod /* trap unknown method calls */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ - new = self~class~new /* create a new collection */ do index over other /* loop over the other collection */ if self~hasindex(index) then /* in this collection? */ @@ -306,24 +197,18 @@ return new /* return the result collection */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") /*****************************************/ /* UNION method */ /*****************************************/ ::METHOD single_union /* take the union of sets */ -use arg other /* get the other collection */ +use strict arg other /* get the other collection */ -signal on syntax /*@CHM004M*/ /* trap unknown method calls */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ +signal on nomethod /* trap unknown method calls */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ - new = self~copy /* copy the collection */ if other~hasmethod("union") then /* is other non-primitive collection?*/ do index over other /* do for directory, table, relation */ @@ -337,28 +222,22 @@ return new /* return the target collection */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") /*****************************************/ /* SUBSET method */ /*****************************************/ ::METHOD single_subset /* do we have a subset? */ -use arg other /* get the other collection */ +use strict arg other /* get the other collection */ -signal on syntax /*@CHM004M*/ /* trap unknown method calls */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ +signal on nomethod /* trap unknown method calls */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ - if other~hasmethod("union") then /* is other non-primitive collection?*/ do index over self /* do for directory, table, relation */ if \other~hasindex(index) then /* not in the other collection? */ - return 0 /* return FALSE (no subset) */ + return .false /* return FALSE (no subset) */ end else do /* do it for array, queue, and list */ object = self~copy /* make a copy of this object */ @@ -368,10 +247,11 @@ return 0=object~items /* if nothing left -> proper subset */ end -return 1 /* collection is a proper subset */ +return .true /* collection is a proper subset */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") /*============================================================================*/ /* M A N Y I T E M M I X I N (for Relation) */ @@ -381,17 +261,10 @@ /* UNION method */ /*****************************************/ ::METHOD many_union -use arg other /* get the other collection */ +use strict arg other /* get the other collection */ -signal on syntax /*@CHM004M*/ /* trap unknown method requests */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ +signal on nomethod /* trap unknown method requests */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ - new = self~copy /* copy ourself */ if other~hasmethod("union") then /* is other non-primitive collection?*/ do /* do for directory, table, relation */ @@ -407,24 +280,19 @@ end return new /* return the union collection */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") + /*****************************************/ /* DIFFERENCE method */ /*****************************************/ ::METHOD many_difference /* take the difference of collections*/ -use arg other /* get the companion object */ +use strict arg other /* get the companion object */ -signal on syntax /*@CHM004M*/ /* trap unknown method requests */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ +signal on nomethod /* trap unknown method requests */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ - new = self~copy /* make a new set */ if other~hasmethod("union") then /* is other non-primitive collection?*/ do /* do for directory, table, relation */ @@ -440,24 +308,19 @@ end return new /* return the difference collection */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") + /*****************************************/ /* XOR method */ /*****************************************/ ::METHOD many_xor /* take the exclusive or of a set */ -use arg other /* get the companion object */ +use strict arg other /* get the companion object */ -signal on syntax /*@CHM004M*/ /* trap unknown method calls */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ +signal on nomethod /* trap unknown method calls */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ - new = self~copy catcher = self~class~new /* create a new empty one */ if other~hasmethod("union") then /* is other non-primitive collection?*/ @@ -481,24 +344,19 @@ end return new~union(catcher) /* now remerge these collections */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") + /*****************************************/ /* INTERSECTION method */ /*****************************************/ ::METHOD many_intersection /* take the intersection of sets */ -use arg other /* get the other collection */ +use strict arg other /* get the other collection */ -signal on syntax /*@CHM004M*/ /* trap unknown method calls */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ +signal on nomethod /* trap unknown method calls */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ - new = self~class~new /* start with a new collection */ object = self~copy /* copy the target collection */ if other~hasmethod("union") then /* is other non-primitive collection?*/ @@ -524,22 +382,18 @@ end return new /* return the new collection */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") + /*****************************************/ /* SUBSET method */ /*****************************************/ ::METHOD many_subset /* do we have a subset? */ -use arg other /* get the other collection */ +use strict arg other /* get the other collection */ -signal on syntax /*@CHM004M*/ /* trap unknown method calls */ -if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ -if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ -if \other~hasmethod("hasindex") /* is other a collection? */ - then raise syntax 93.948 array(1, "Collection") /* no, complain about it */ +signal on nomethod /* trap unknown method calls */ object = self~copy /* make a copy of this object */ if other~hasmethod("union") then /* is other non-primitive collection?*/ @@ -556,8 +410,9 @@ end return 0=object~items /* if nothing left -> proper subset */ -syntax: /* unknown method sent */ - raise propagate /* just send on to the caller */ +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") @@ -565,246 +420,50 @@ /* APPENDALL method */ /*****************************************/ ::method ordered_appendall - use arg other - if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ - if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ - supplier = other~supplier /* get an other supplier */ - do while supplier~available /* loop over the other collection */ - self~append(supplier~item) -- appending the item - supplier~next + use strict arg other + + signal on nomethod + + do item over other~allItems /* loop over the other collection */ + self~append(item) -- appending the item end +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") /*****************************************/ /* PUTALL method */ /*****************************************/ ::method collection_putall - use arg other - if (arg() < 1) /* no index given? */ - then raise syntax 93.901 array (1) /* raise an error */ - if (arg() > 1) /* too many arguments? */ - then raise syntax 93.902 array (1) /* raise an error */ + use strict arg other + signal on nomethod + supplier = other~supplier /* get an other supplier */ do while supplier~available /* loop over the other collection */ self~put(supplier~item, supplier~index) -- putting the item using the same index supplier~next end +nomethod: + -- an unknown method is an argument problem. report it as such. + raise syntax 93.948 array(1, "Collection") -/* ******************************** */ -/* S E R V E R M E T H O D S */ -/* ******************************** */ -/* -/* Keep for future Debugging !!!!!!!!!!! */ -::method server_dump - /* dump the server tables */ - expose classdir signature_to_object object_to_signature +::METHOD server_save_result + /* anchor a passed out result */ + expose savedResults + use arg resultObj + savedResults[resultObj] = resultObj - say 'classdir ***********************' - do i over classdir - say left(i, 10) classdir[i] - end /* do */ - say 's2o ****************************' - do i over signature_to_object - say left(i, 10) signature_to_object[i] - end /* do */ - - say 'o2s ****************************' - do i over object_to_signature - say left(i, 60) object_to_signature[i] - end /* do */ -*/ - -::METHOD server_add_method - /* add a method to a proxy class */ - use arg class, mname, ename, lname - class~define(mname,.nmethod~new(ename,lname)) - -::METHOD server_addclass - /* add a class to the class table */ - /*** will not be needed when we have the phase III metaclass ***/ - expose classdir - use arg oryxclass, somclass - classdir~setentry(somclass,oryxclass) - -::METHOD server_dispatch unguarded - /* add a proxy to the proxy table */ - use arg messageObj - messageObj~send - return - -::METHOD server_exit unguarded - /* end the domain server */ - use arg option - -::METHOD server_free /* free an object by signature */ - expose classdir object_to_signature signature_to_object - use arg objectProxy - /* if in the table, */ - if object_to_signature~hasindex(objectProxy) Then do - /* remove both aspects of this */ - signature_to_object~remove(object_to_signature[objectProxy]) - object_to_signature~remove(objectProxy) - end - if classdir~hasentry(objectProxy~somobj) then - classdir~remove(objectProxy~somobj) /* and also from the class directory */ - -::METHOD server_make_proxy /* find or create a SOM proxy object */ - /* called whenever an address to a */ - /* SOM object needs to be changed */ - /* into a SOM proxy object. This */ - /* may have already happened for an */ - /* object, so we first check our */ - /* table of proxied objects */ - /* The object to locate is given to */ - /* as an integer object that */ - /* represents the address of the */ - /* SOM object */ - expose som classdir signature_to_object object_to_signature somInit sender - use arg signature - - if \somInit then - self~somInitialize(.true) - /* not in the server table? */ - if \signature_to_object~hasentry(signature) & som then do - if .localserver \= self then Do - guard off - /* nope, do process switch and */ - /* resend the message. */ - return sender~send(self, self, 'MAKE_PROXY', .array~of(signature)) - end - else Do - /* all set, lets make a proxy. */ - /* There's no entry in servertab for this SOM object, so we need to */ - /* make one. It can be a dumb somproxy unless its class hierarchy */ - /* contains any Oryx classes that have been exported to SOM, in which */ - /* case the SOM class hierarchy needs to be imported and a class- */ - /* specific proxy used. The classes are imported in a top-down order */ - /* via the IMPORT method of the class class. I have no idea how this */ - /* will be generalized to handle multiple inheritance in SOM, but */ - /* that's not today's problem. */ - - classid = self~!somclass(signature)/* get the object's class */ - /* no entry there? */ - if \classdir~hasentry(classid) then do - sclass = classid /* copy the SOM class id */ - do forever /* loop until success/failure */ - sclass = self~somparent(sclass)/* get this classes parent */ - if sclass = 0 then /* reached the top? */ - leave /* nothing more to do */ - /* do we know about this one? */ - if classdir~hasentry(sclass) then - /* and is it imported? */ - if \classdir~entry(sclass)~!imported then - leave /* we're done */ - end - if sclass \= 0 then do /* found a target */ - guard off /* allow import/inherit/!export to do an addclass */ - /* import this class also */ - self~import(self~somname(classid)) - guard on - end - end - /* now have a class? */ - if classdir~hasentry(classid) then - /* got a class to work with? */ - proxy = classdir~entry(classid)~!newopart(signature) - else /* just just bare bones proxy */ - proxy = .!somproxy~!newopart(signature) - self~setid(proxy, signature) /* update the tables */ - end - end - /* return the proxy object */ - return signature_to_object~entry(signature) - -::METHOD server_import unguarded - /* create a new shadowed class */ - expose sender somInit - use arg id, metaclass, classMethods - - signal on syntax /*@CHM004A*/ - if \somInit then - self~somInitialize(.true) - /* Running on correct process ? */ - if .localserver \= self then Do - /* no, switch to correct process. */ - guard off - return sender~send(self, self, 'IMPORT', arg(1,'A')) - End - else Do - if \var('METACLASS') Then /* no metaclass given? */ - metaclass = .nil /* just .nil for the metaclass */ - if \var('CLASSMETHODS') Then /* no metaclass given? */ - classMethods = .nil /* just .nil for the metaclass */ - /* go get the som class */ - somclass = self~findSomClass(id, 0, 0) - if .nil = somclass then /* nothing back? */ - raise syntax 98.912 array (id) /* need to raise an error */ - /* Now import the class and its */ - /*hierarchy. */ - return self~!import_lineage(somclass, metaclass, classMethods) - End - - return /*@CHM004A*/ - -syntax: raise propagate /*@CHM004A*/ - -::METHOD server_!import_lineage unguarded - /* recursive import of som classes */ - use arg somclass, metaclass, classMethods - /* Lookup, class in server classtable*/ - outclass = self~oclass(somclass~somobj) - if .nil = outclass then /* If not already imported/known */ - do /* Do actual Import */ - parent = somclass~somGetParent /* Get the parent class for somclass */ - /* At root of hierarchy? */ - if .nil = parent | parent = somclass then Do - if .nil = metaclass then /* Explicit MetaClass given? */ - metaclass = .sclass /* SCLASS is the meta class. */ - /* Additional Class methods given? */ - /* Nope, create new OREX class, */ - /*Add SOM Methods, via class_import */ - outclass = .!somproxy~subclass(somclass~somGetName, metaclass, classMethods)~~!import - End - else - do - /* not at root, and this class not */ - /*imported yet. o now import it. */ - rexxparent = self~!import_lineage(parent, metaclass, .nil) - /* Meta Class given? */ - if .nil = metaclass then - /* Nope, will have same as superclass*/ - outclass = rexxparent~subclass(somclass~somGetName,,classMethods)~~!import - else /* no metaclass provided */ - outclass = rexxparent~subclass(somclass~somGetName, metaclass, classMethods)~~!import - - /* store in server's tables */ - self~setid(outclass, somclass~somobj) - self~addclass(outclass, outclass~!somclass) - end - end - return outclass /* return the imported Class */ - - ::METHOD server_init /* initialize a server */ - expose classdir signature_to_object object_to_signature som localenv somInit savedResults somdInit + expose localenv savedResults - classdir = .directory~new - signature_to_object = .directory~new - object_to_signature = .table~new savedResults = .table~new - som = .false - somInit = .false - somdInit = .false - self~init_local .local~setentry('LOCALSERVER',self) - self~!send_init /* set system objects in the local environment */ .local~setentry('STDIN',.stream~new('STDIN')~~command('open nobuffer')) @@ -815,277 +474,3 @@ .local~setentry('ERROR', .monitor~new(.stderr)) .local~setentry('STDQUE',.rx_queue~new~~set('SESSION')) - -::METHOD server_!send_init - /* initialize the Oryx client (SEND method) interface */ - expose sender - sender = .!sender~new - -::METHOD server_save_result - /* anchor a passed out result */ - expose savedResults - use arg resultObj - savedResults[resultObj] = resultObj - -::method server_!startMessageWait unguarded - /* return to caller. */ - reply - /* Now go and wait for messages */ - /* to arrive, this method NEVER */ - /* returns. */ - self~!messageWait - -::METHOD server_send unguarded - /* send a message through sender to */ - /*Mak sure we run on correct process */ - expose sender - use arg target, message, args - /* Were args omitted? */ - if arg(3,'o') then - args = .array~new(0) - - sender~send(self, target, message, args) - if var('RESULT') then - return result - -::METHOD server_local unguarded - /* return the local environment */ - expose localenv - return localenv - - -::METHOD server_new_class - /* create a new proxy class */ - use arg name, superclass - class = .class~new(name) - if .environment~hasentry(superclass) then - class~inherit(.environment~entry(superclass)) - else - class~inherit(.object) - .environment~setentry(name,class) - return class - -::METHOD server_oclass - /* find an Oryx class in the class table */ - expose classdir - use arg somclass - return classdir~entry(somclass) /* just return the class entry */ - -::METHOD server_remove_object /* remove an object from our tables */ - expose object_to_signature - use arg object - object_to_signature~remove(object) - if object~hasmethod('FREESOMOBJ') then - object~freesomobj - -::METHOD server_setid unguarded - /* set up a client id for an object */ - expose signature_to_object object_to_signature - use arg object, signature - /* already have know about this */ - /* signature. */ - if \signature_to_object~hasentry(signature) then - /* no add this to directory. */ - signature_to_object[signature] = object - /* always add to object_to_sig */ - object_to_signature[object] = signature - - -::METHOD server_setsom - /* make the server work according to SOM rules */ - expose som - som = .true - -::METHOD server_somd_init - expose somInit somdInit - - /* Allow for multiple invocations */ - /* of SOMD_Init, return is done */ - if \somdInit then Do - - if \somInit then /* See if SOM initialized. */ - self~somInitialize(.true) /* initialize if not. */ - /* Initialize the DSOM env, and */ - /* set up SOMD_ObjectMgr in local */ - /* environment */ - .local['SOMD_OBJECTMGR'] = self~!initDSOM - .local['DSOM'] = .!DSOMServerProxy~new - somdInit = .true /* indicate DSOM initialized. */ - end - /* Return the dsom serverProxy */ - return .dsom - - -::METHOD server_somlook unguarded - /* look to see if OREF has SOM object reference */ - expose object_to_signature - use arg object - if object_to_signature~hasindex(object) then do - return object_to_signature[object] - end - else - return .nil /* special value meaning no SOM object */ - - -::METHOD server_somobj - /* convert OREF to SOM object reference */ - expose object_to_signature - use arg object - - /* look up in servertab for now, but we could send a SOMOBJ message */ - /* to proxy objects - if we could identify them.... */ - /* no proxy created for this? */ - if \object_to_signature~hasindex(object) then do - somclass = .nil /* no somclass so far */ - class = object~class /* get the object's class */ - if class~hasmethod('SOMCLASS') then/* potentially have a SOM class? */ - somclass = class~!somclass /* get the som class */ - if .nil = somclass then /* if it didn't work, use default */ - return .nil /* no SOMObject/SOMClass, doesn't */ - /* exist. */ - guard off /* allow somInit to run */ - /* get a som object signature */ - /* (which also updates the lookup */ - /* tables for us */ - somobj = self~somproxy(object,somclass) - end - else - /* just return this directly */ - somobj = object_to_signature[object] - return somobj - - -::METHOD server_!setMethod - /* add a new method to server object */ - use arg name, method - self~setMethod(name, method) - -/* ******************************** */ -/* S E N D E R M E T H O D S */ -/* ******************************** */ - - -::METHOD sender_init - /* initialize the Oryx client (SEND method) interface */ - expose pid - - exit = 0 - terminated = 0 - ready = 0 - pid = self~!getPid - return - -::METHOD sender_send unguarded - /* send a message on this process */ - expose pid - use arg server, target, message, args - - signal on syntax name exception /*** trap termination events ***/ - - messageObj = .message~new(target, message, 'a', args) - /* This ensures the message is sent */ - /*on correct process */ - self~!send_message(pid, messageObj) - - messageObj~result - if var('RESULT') then - return result - else - return - -exception: - exit - -/* ************************************************** */ -/* D S O M C l i e n t P r o x y M E T H O D S */ -/* *************************************************** */ - -::METHOD dserver_init - expose server - self~init:super /* Forward to superClass */ - server = .localServer /* Remember local server, Actual svr */ - -::METHOD dserver_import - expose server - use arg id, metaclass, classMethods - /* Lookup class through DSOM_ObjectMg*/ - /* And then do OREXX class creation */ - /* Stuff. If not found in DSOM do */ - /* Local .SOM import */ - /* create a new shadowed class */ - - signal on syntax /*@CHM004A*/ - /* Running on correct process ? */ - if .localserver \= server then Do - /* no, switch to correct process. */ - guard off - return server~send(self, 'IMPORT', arg(1,'A')) - End - else Do - if \var('METACLASS') Then /* no metaclass given? */ - metaclass = .dsclass /* use default DSOM metaClass */ - if \var('CLASSMETHODS') Then /* no classMethods Given? */ - classMethods = .nil /* just .nil for the metaclass */ - /* Force load of local class */ - somclass = server~findSomClass(id, 0, 0) - if .nil = somclass then /* nothing back? */ - raise syntax 98.912 array (id) /* need to raise an error */ - /* go get the DSOM class */ - /* Lookup a DSOM Server for class. */ - dsomServer = .somd_objectMgr~somdFindAnyServerByClass(id); - - if .nil = dsomServer then /*Did we find a server? */ - /* No, */ - /* Let base server(SOM) try to import*/ - return server~import(id, metaclass, classMethods) - else Do - /* Now ask DSOM Server for class obj */ - somclass = dsomServer~somdGetClassObj(id) - End - - if .nil = somclass then /* nothing back? */ - raise syntax 98.912 array (id) /* need to raise an error */ - /* Now import the class and its */ - /*hierarchy. */ - return server~!import_lineage(somclass, metaclass, classMethods) - End - - return /*@CHM004A*/ - -syntax: raise propagate /*@CHM004A*/ - -::METHOD dserver_hasmethod - expose server - use arg method - /* Do I know about method? */ - if \self~hasmethod:super(method) then - return server~hasmethod(method) /* Nope, see if real Server does. */ - else - return .true /* I know so let use know it. */ - -::METHOD dserver_unknown - expose server - use arg msgname, arglist - /* Forward all messages to Actual */ - /*Server */ - forward to (server) message (msgname) arguments (arglist) - -/* ************************************************** */ -/* S O M D O b j e c t M g r M E T H O D S */ -/* *************************************************** */ - -::method objMgr_FindServer - /* FOrward message to super class */ - forward class (super) continue - somdServer = result - /* Now add the Kernel level */ - /*SOMDServer methods, certain ones */ - /*cannot go through dsom_send */ - /* See if already installed methods? */ - if \somdServer~hasmethod('!SOMDMETHODSINSTALLED') then Do - /* Make sure Server gets enhanced. */ - /* also installs the !SOMDMETHODSINS */ - /* Methodsso it isn't done again. */ - self~enhanceServer(somdServer, .!somdServerMethods) - End - return somdServer Modified: interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx 2007-04-10 23:27:43 UTC (rev 262) +++ interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx 2007-04-11 10:29:43 UTC (rev 263) @@ -93,54 +93,39 @@ ::METHOD init /* standard init method */ /* access general stream state */ expose stream_name - signal on syntax /*@CHM004A*/ - use arg stream_name /* get the stream name */ - if arg() = 1 then do /* only a name given */ - /* get as a string */ - stream_name = stream_name~request('STRING') - if .nil == stream_name then /* not a real string value? */ - raise syntax 93.938 array (1) /* this is an error */ - self~!c_stream_init(stream_name) /* initialize the stream block */ - /* upper case the name */ - parse upper var stream_name upper_stream_name - /* one of the standard names? */ - /* @CHM002M - also check for standard stream names with colons */ - if upper_stream_name = 'STDIN' | upper_stream_name = 'STDIN:' |, - upper_stream_name = 'STDOUT' | upper_stream_name = 'STDOUT:' |, - upper_stream_name = 'STDERR' | upper_stream_name = 'STDERR:' then - self~!std_set /* have a standard stream */ - /* and handle open? */ - else if substr(upper_stream_name,1,7) = 'HANDLE:' then - /* set this as a handle type */ - self~!handle_set(substr(stream_name,8)) - end - else - raise syntax 93.903 array (1) /* raise an error */ - - return /*@CHM004A*/ - -syntax: raise propagate /*@CHM004A*/ - + use strict arg stream_name /* get the stream name */ + /* get as a string */ + stream_name = stream_name~request('STRING') + if .nil == stream_name then /* not a real string value? */ + raise syntax 93.938 array (1) /* this is an error */ + self~!c_stream_init(stream_name) /* initialize the stream block */ + /* upper case the name */ + parse upper var stream_name upper_stream_name + /* one of the standard names? */ + /* - also check for standard stream names with colons */ + if upper_stream_name = 'STDIN' | upper_stream_name = 'STDIN:' |, + upper_stream_name = 'STDOUT' | upper_stream_name = 'STDOUT:' |, + upper_stream_name = 'STDERR' | upper_stream_name = 'STDERR:' then + self~!std_set /* have a standard stream */ + /* and handle open? */ + else if substr(upper_stream_name,1,7) = 'HANDLE:' then + /* set this as a handle type */ + self~!handle_set(substr(stream_name,8)) + return /* close and uninit are actually the */ /* same method */ ::METHOD close EXTERNAL 'REXX stream_close' ::METHOD uninit EXTERNAL 'REXX stream_close' ::METHOD arrayout /* write out lines as an array */ - use arg array /* access the array */ + use strict arg array, type=.nil /* access the array */ /* the count must be defined in case a SYNTAX or NOTREADY */ /* condition is raised */ count = 0 /* set initial counter */ - signal on syntax /* enable the syntax handler and */ signal on notready /* the notready handler */ - signal on halt /* catch Ctrl-Break */ - if arg() > 2 then /* too many arguments? */ - raise syntax 93.902 array (2) /* this is an error */ - if arg(2,'E') then do /* have a second argument? */ - type = arg(2) /* get the type */ if abbrev('LINES', type) then /* line type operation? */ lineout = 1 /* set the line flag */ else if abbrev('CHARS', type) then /* character operation? */ @@ -162,34 +147,22 @@ return 0 notready: /* standard notready handler */ -syntax: /* standard syntax handler (shared) */ raise propagate return (array~items - count) -halt: /* forward HALT condition */ - raise propagate - ::METHOD arrayin /* arrayin method */ forward message 'MAKEARRAY' ::METHOD makearray /* stream makearray method */ - signal on syntax /* enable the syntax handler and */ + use strict arg type='LINES' signal on notready /* the notready handler */ - signal on halt /* catch Ctrl-Break */ - if arg() > 1 then /* too many arguments? */ - raise syntax 93.902 array (1) /* this is an error */ - - if arg(1,'E') then do /* have a second argument? */ - parse upper arg type /* get the type */ - if abbrev('LINES', type) then /* line type operation? */ + type = type~upper + if abbrev('LINES', type) then /* line type operation? */ linein = 1 /* set the line flag */ - else if abbrev('CHARS', type) then /* character operation? */ + else if abbrev('CHARS', type) then /* character operation? */ linein = 0 /* not a line operation */ - else - raise syntax 93 /* raise an error */ - end else - linein = 1 /* set the default lookup */ + raise syntax 93 /* raise an error */ queue = .queue~new /* create a queue item */ /* Begin - change loop logic */ @@ -208,26 +181,13 @@ /* return the array we've got so far */ raise propagate return (queue~makearray) -syntax: /* standard syntax handerl (shared) */ - raise propagate return ('') - -halt: /* forward HALT condition */ - raise propagate - ::METHOD command /* process a stream command */ expose stream_name /* access the stream name */ - /*@CHM004M - moved to the beginning */ - signal on syntax /* enable syntax handler */ + + use strict arg command signal on notready /* enable notready handler */ - signal on halt /* catch Ctrl-Break */ - if (arg() < 1) /* no command given? */ - /* raise an error */ - then raise syntax 93.901 array (1) - if (arg() > 1) /* too many arguments? */ - /* raise an error */ - then raise syntax 93.902 array (1) - parse upper arg command_word parms /* get the command name */ + parse upper var command command_word parms /* get the command name */ command_word = ' 'command_word /* add a leading blank */ /* expand any abbreviations */ parse value ' CLOSE FLUSH OPEN POSITION QUERY SEEK' with (command_word) +1 command_word . @@ -257,17 +217,14 @@ end notready: /* standard notready handler */ -syntax: /* standard syntax handler (shared) */ -halt: /* forward HALT condition */ raise propagate ::METHOD open EXTERNAL 'REXX stream_open' ::METHOD query /* standard query routine */ - arg subcommand parms /* get the parms */ - signal on syntax /* enable the standard handlers */ + use strict arg subcommand + parse upper var subcommand subcommand parms signal on notready - signal on halt /* catch Ctrl-Break */ subcommand = ' 'subcommand /* add a leading blank */ /* resolve abbreviations */ parse value ' DATETIME EXISTS HANDLE POSITION SEEK SIZE STREAMTYPE TIMESTAMP' with (subcommand) +1 subcommand . @@ -329,27 +286,15 @@ end notready: /* standard notready handler */ -syntax: /* standard syntax handler (shared) */ raise propagate return (self~description) -halt: /* forward HALT condition */ - raise propagate - ::METHOD say UNGUARDED /* the SAY method */ - signal on halt /* catch Ctrl-Break */ return self~lineout(arg(1)) /* write the target line out */ -halt: /* forward HALT condition */ - raise propagate - ::METHOD supplier /* create a supplier object */ -signal on syntax /*@CHM004A*/ -if (arg() > 0) then /* too many arguments? */ - raise syntax 93.902 array (0) /* raise an error */ +use strict arg return .stream_supplier~new(self) /* return a stream supplier */ -syntax: raise propagate /*@CHM004A*/ - ::CLASS 'Stream_Supplier' /* stream supplier class */ ::METHOD init /* initialization method */ /* access the state information */ @@ -368,11 +313,8 @@ ::METHOD next /* step to next element */ /* access the state information */ expose stream position line available transient +use strict arg -signal on syntax /*@CHM004A*/ -if (arg() > 0) then /* too many arguments? */ - raise syntax 93.902 array (0) /* raise an error */ - if \available then /* already reached the end? */ raise syntax 93.937 /* this is an error */ position = position + 1 /* bump the index */ @@ -385,37 +327,28 @@ notready: /* notready condition occurred */ available = 0 /* nothing available now */ return /* all finished */ -syntax: raise propagate /*@CHM004A*/ ::METHOD available /* is an item available? */ expose available /* access the flag item */ -signal on syntax /*@CHM004A*/ -if (arg() > 0) then /* too many arguments? */ - raise syntax 93.902 array (0) /* raise an error */ +use strict arg return available /* return the access flag */ -syntax: raise propagate /*@CHM004A*/ ::METHOD item /* get the current supplier value */ expose line available /* access needed object variables */ -signal on syntax /*@CHM004A*/ -if (arg() > 0) then /* too many arguments? */ - raise syntax 93.902 array (0) /* raise an error */ +use strict arg if \available then /* already reached the end? */ raise syntax 93.937 /* this is an error */ return line /* return the file line */ -syntax: raise propagate /*@CHM004A*/ ::METHOD index /* get the current supplier index */ expose position available /* access needed object variables */ -signal on syntax /*@CHM004A*/ +use strict arg ... [truncated message content] |
From: <bi...@us...> - 2007-04-11 15:06:10
|
Revision: 265 http://svn.sourceforge.net/oorexx/?rev=265&view=rev Author: bigrixx Date: 2007-04-11 08:06:06 -0700 (Wed, 11 Apr 2007) Log Message: ----------- Add Collection, MapCollection, and OrderedCollection mixins and have the Rexx defined collections use them. Modified Paths: -------------- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx interpreter-3.x/trunk/kernel/classes/ClassClass.cpp interpreter-3.x/trunk/kernel/classes/ClassClass.hpp interpreter-3.x/trunk/kernel/runtime/RexxActivity.cpp interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-04-11 14:05:53 UTC (rev 264) +++ interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-04-11 15:06:06 UTC (rev 265) @@ -54,6 +54,12 @@ appendMethods = .table~new appendMethods~put(.methods~ordered_appendall, 'APPENDALL') +/* +.array~inherit(.OrderedCollection); +.list~inherit(.OrderedCollection); +.queue~inherit(.OrderedCollection); +*/ + .array~!define_methods(appendMethods) .list~!define_methods(appendMethods) .queue~!define_methods(appendMethods) @@ -62,11 +68,6 @@ putMethods = .table~new putMethods~put(.methods~collection_putall, 'PUTALL') -.table~!define_methods(putMethods) -.directory~!define_methods(putMethods) -.relation~!define_methods(putMethods) - - say ('Adding setlike methods to table, relation, and directory') set_methods = .table~new /* get a table directory */ /* add the single item methods */ @@ -86,14 +87,14 @@ set_methods~put(.methods~many_xor, 'XOR') .relation~!define_methods(set_methods) /* add to relation */ - /* make sure the classes don't */ -.table~!rexxdefined /* get changed by users */ -.directory~!rexxdefined -.relation~!rexxdefined -.array~!rexxdefined -.list~!rexxdefined -.queue~!rexxdefined +.collection~!rexxdefined +.orderedcollection~!rexxdefined +.mapcollection~!rexxdefined +.environment~setentry('COLLECTION', .collection) +.environment~setentry('ORDEREDCOLLECTION', .orderedcollection) +.environment~setentry('MAPCOLLECTION', .mapcollection) + /* Call the system dependant routine to define addition methods */ systemMethods = 'SystemMethods.orx'() /* case sensitive */ @@ -474,3 +475,8 @@ .local~setentry('ERROR', .monitor~new(.stderr)) .local~setentry('STDQUE',.rx_queue~new~~set('SESSION')) + +-- tagging classes for Collection class types +::CLASS Collection MIXINCLASS Object +::CLASS OrderedCollection MIXINCLASS Collection +::CLASS MapCollection MIXINCLASS Collection Modified: interpreter-3.x/trunk/kernel/classes/ClassClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ClassClass.cpp 2007-04-11 14:05:53 UTC (rev 264) +++ interpreter-3.x/trunk/kernel/classes/ClassClass.cpp 2007-04-11 15:06:06 UTC (rev 265) @@ -381,11 +381,16 @@ return (RexxTable *)methods->copy(); } -void RexxClass::subClassable( - PCHAR class_id) /* name of this class */ -/*****************************************************************************/ -/* Function: Initialize a Rexx subclassable class */ -/*****************************************************************************/ +/** + * Initialize a base Rexx class. + * + * @param class_id The name of the class. + * @param restricted Whether we should turn the RexxRestricted flag on at this time. + * Some classes get additional customization after initial + * creation, so we delay setting this attribute until the + * class is fully constructed. + */ +void RexxClass::subClassable(PCHAR class_id, bool restricted) { /* get a copy of the class instance */ /* behaviour mdict before the merge */ @@ -488,15 +493,6 @@ this->behaviour->setClass(TheClassClass); /* set the somclass to .nil */ OrefSet(this, this->somClass, (RexxInteger *)TheNilObject); - /* The class_info for Rexx classes */ - /* is updated with rexxdefined */ - /* for all the classes except */ - /* TABLE DIRECTORY AND RELATION */ - /* this will be done in BaseClasses.orx */ - /* after they inherit from singleitem */ - /* or manyitem mixin class */ - if (this != TheTableClass && this != TheDirectoryClass && this != TheRelationClass) - this->class_info |= REXX_DEFINED; /* SOMPROXY/M_SOMPROXY aren't */ /* primitive any more either. */ if (TheMSomProxyClass != this && TheSomProxyClass != this) Modified: interpreter-3.x/trunk/kernel/classes/ClassClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ClassClass.hpp 2007-04-11 14:05:53 UTC (rev 264) +++ interpreter-3.x/trunk/kernel/classes/ClassClass.hpp 2007-04-11 15:06:06 UTC (rev 265) @@ -85,7 +85,7 @@ RexxTable *getInstanceBehaviourDictionary(); RexxTable *getBehaviourDictionary(); RexxString *defaultName(); - void subClassable(PCHAR); + void subClassable(PCHAR, bool); RexxObject *defineMethod(RexxString *, RexxMethod *); RexxObject *defineMethods(RexxTable *); RexxObject *deleteMethod(RexxString *); Modified: interpreter-3.x/trunk/kernel/runtime/RexxActivity.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxActivity.cpp 2007-04-11 14:05:53 UTC (rev 264) +++ interpreter-3.x/trunk/kernel/runtime/RexxActivity.cpp 2007-04-11 15:06:06 UTC (rev 265) @@ -1073,9 +1073,11 @@ memory_mark(this->save); memory_mark(this->local); memory_mark(this->conditionobj); + memory_mark(this->processObj); memory_mark(this->requiresTable); memory_mark(this->nextWaitingActivity); memory_mark(this->waitingObject); + memory_mark(this->currentExit); memory_mark(this->nestedInfo.currentExit); memory_mark(this->nestedInfo.shvexitvalue); for (i = 0; i < LAST_EXIT; i++) @@ -1099,9 +1101,11 @@ memory_mark_general(this->save); memory_mark_general(this->local); memory_mark_general(this->conditionobj); + memory_mark_general(this->processObj); memory_mark_general(this->requiresTable); memory_mark_general(this->nextWaitingActivity); memory_mark_general(this->waitingObject); + memory_mark_general(this->currentExit); memory_mark_general(this->nestedInfo.currentExit); memory_mark_general(this->nestedInfo.shvexitvalue); Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-11 14:05:53 UTC (rev 264) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-11 15:06:06 UTC (rev 265) @@ -190,6 +190,7 @@ CHARCONSTANT(MAKEINTEGER, "MAKEINTEGER"); CHARCONSTANT(MAKESTRING, "MAKESTRING"); CHARCONSTANT(MAKE_PROXY, "MAKE_PROXY"); +CHARCONSTANT(MAPCOLLECTION, "MAPCOLLECTION"); CHARCONSTANT(MATCH, "MATCH"); CHARCONSTANT(MATCHCHAR, "MATCHCHAR"); CHARCONSTANT(MEMORY, "MEMORY"); @@ -227,6 +228,7 @@ CHARCONSTANT(OF, "OF"); CHARCONSTANT(OFF, "OFF"); CHARCONSTANT(ON, "ON"); +CHARCONSTANT(ORDEREDCOLLECTION, "ORDEREDCOLLECTION"); CHARCONSTANT(OUTPUT, "OUTPUT"); CHARCONSTANT(PARSE, "PARSE"); CHARCONSTANT(PEEK, "PEEK"); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-11 14:05:53 UTC (rev 264) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-11 15:06:06 UTC (rev 265) @@ -814,8 +814,8 @@ TheObjectBehaviour->setMethodDictionaryScope(TheObjectClass); /* Now call the class subclassable */ /* method for OBJECT then CLASS */ - TheObjectClass->subClassable("Object"); - TheClassClass->subClassable("Class"); + TheObjectClass->subClassable("Object", true); + TheClassClass->subClassable("Class", true); /************************************** The rest of the classes can now be */ /************************************** set up. */ @@ -856,7 +856,7 @@ /* Now call the class subclassable */ /* method */ - TheArrayClass->subClassable("Array"); + TheArrayClass->subClassable("Array", false); /***************************************************************************/ /* DIRECTORY */ @@ -893,7 +893,7 @@ /* Now call the class subclassable */ /* method */ - TheDirectoryClass->subClassable("Directory"); + TheDirectoryClass->subClassable("Directory", false); /***************************************************************************/ /* ENVELOPE */ @@ -911,7 +911,7 @@ /* Now call the class subclassable */ /* method */ - TheEnvelopeClass->subClassable("Envelope"); + TheEnvelopeClass->subClassable("Envelope", true); /***************************************************************************/ /* LIST */ @@ -952,7 +952,7 @@ /* Now call the class subclassable */ /* method */ - TheListClass->subClassable("List"); + TheListClass->subClassable("List", false); /***************************************************************************/ /* MESSAGE */ @@ -986,7 +986,7 @@ /* Now call the class subclassable */ /* method */ - TheMessageClass->subClassable("Message"); + TheMessageClass->subClassable("Message", true); /***************************************************************************/ /* METHOD */ @@ -1016,7 +1016,7 @@ /* Now call the class subclassable */ /* method */ - TheMethodClass->subClassable("Method"); + TheMethodClass->subClassable("Method", true); /***************************************************************************/ /* QUEUE */ @@ -1056,7 +1056,7 @@ /* Now call the class subclassable */ /* method */ - TheQueueClass->subClassable("Queue"); + TheQueueClass->subClassable("Queue", false); /***************************************************************************/ /* RELATION */ @@ -1095,7 +1095,7 @@ /* Now call the class subclassable */ /* method */ - TheRelationClass->subClassable("Relation"); + TheRelationClass->subClassable("Relation", false); /***************************************************************************/ /* STEM */ @@ -1134,7 +1134,7 @@ /* Now call the class subclassable */ /* method */ - TheStemClass->subClassable("Stem"); + TheStemClass->subClassable("Stem", false); /***************************************************************************/ /* STRING */ @@ -1247,7 +1247,7 @@ /* Now call the class subclassable */ /* method */ - TheStringClass->subClassable("String"); + TheStringClass->subClassable("String", true); /***************************************************************************/ @@ -1285,7 +1285,7 @@ TheMutableBufferBehaviour->setMethodDictionaryScope(TheMutableBufferClass); /* Now call the class subclassable */ /* method */ - TheMutableBufferClass->subClassable("MutableBuffer"); + TheMutableBufferClass->subClassable("MutableBuffer", true); /***************************************************************************/ /* INTEGER */ @@ -1349,7 +1349,7 @@ /* Now call the class subclassable */ /* method */ - TheIntegerClass->subClassable("String"); + TheIntegerClass->subClassable("String", true); /***************************************************************************/ /* NUMBERSTRING */ @@ -1413,117 +1413,10 @@ /* Now call the class subclassable */ /* method */ - TheNumberStringClass->subClassable("String"); + TheNumberStringClass->subClassable("String", true); - /***************************************************************************/ - /* SOMPROXY */ - /***************************************************************************/ - /* SOMProxy needs additional setup */ - /* Before installing external methods*/ - /* but after .class has been built */ - somproxy_setup(); - /* Add the NEW methods to the class */ - /* behaviour mdict */ - defineKernelMethod(CHAR_NEW , TheSomProxyClassBehaviour, CPPMSOMCL(RexxSOMProxyClass::newRexx), A_COUNT); - defineKernelMethod(CHAR_INIT , TheSomProxyClassBehaviour, CPPMSOMCL(RexxSOMProxyClass::init), A_COUNT); - defineKernelMethod(CHAR_UNKNOWN , TheSomProxyClassBehaviour, CPPM(RexxObject::unknownRexx), 2); - defineKernelMethod(CHAR_INITPROXY , TheSomProxyClassBehaviour, CPPM(RexxObject::initProxyRexx), 1); - defineKernelMethod(CHAR_FREESOMOBJ, TheSomProxyClassBehaviour, CPPM(RexxObject::freeSOMObjRexx), 0); - defineKernelMethod(CHAR_SERVER , TheSomProxyClassBehaviour, CPPM(RexxObject::serverRexx), 0); - defineKernelMethod(CHAR_SOMOBJ , TheSomProxyClassBehaviour, CPPM(RexxObject::SOMObjRexx), 0); - defineKernelMethod(CHAR_HASMETHOD , TheSomProxyClassBehaviour, CPPM(RexxObject::hasMethodRexx), 1); - defineKernelMethod(CHAR_SOMDNEW , TheSomProxyClassBehaviour, CPPMSOMCL(RexxSOMProxyClass::somdNew), 0); - - /* set the scope of the methods to */ - /* this classes oref */ -// TheSOMProxyClassBehaviour->setMethodDictionaryScope(OREF_SOMPROXY); - /* Add the instance methods to the */ - /* instance behaviour mdict */ - defineKernelMethod(CHAR_INITPROXY , TheSomProxyBehaviour, CPPM(RexxObject::initProxyRexx), 1); - defineKernelMethod(CHAR_FREESOMOBJ, TheSomProxyBehaviour, CPPM(RexxObject::freeSOMObjRexx), 0); - defineKernelMethod(CHAR_SERVER , TheSomProxyBehaviour, CPPM(RexxObject::serverRexx), 0); - defineKernelMethod(CHAR_SOMOBJ , TheSomProxyBehaviour, CPPM(RexxObject::SOMObjRexx), 0); - defineKernelMethod(CHAR_UNKNOWN , TheSomProxyBehaviour, CPPM(RexxObject::unknownRexx), 2); - defineKernelMethod(CHAR_HASMETHOD , TheSomProxyBehaviour, CPPM(RexxObject::hasMethodRexx), 1); - defineKernelMethod(CHAR_MAKESTRING, TheSomProxyBehaviour, CPPM(RexxObject::makeStringRexx), 0); - - defineKernelMethod(CHAR_PLUS , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_plusRexx), 1); - defineKernelMethod(CHAR_SUBTRACT , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_minusRexx), 1); - defineKernelMethod(CHAR_MULTIPLY , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_multiplyRexx), 1); - defineKernelMethod(CHAR_DIVIDE , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_divideRexx), 1); - defineKernelMethod(CHAR_INTDIV , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_integerDivideRexx), 1); - defineKernelMethod(CHAR_REMAINDER , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_remainderRexx), 1); - defineKernelMethod(CHAR_POWER , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_powerRexx), 1); - defineKernelMethod(CHAR_NULLSTRING , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_abuttalRexx), 1); - defineKernelMethod(CHAR_CONCATENATE , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_concatRexx), 1); - defineKernelMethod(CHAR_BLANK , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_concatBlankRexx), 1); - defineKernelMethod(CHAR_EQUAL , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_equalRexx), 1); - defineKernelMethod(CHAR_BACKSLASH_EQUAL , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_notEqualRexx), 1); - defineKernelMethod(CHAR_GREATERTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_isGreaterThanRexx), 1); - defineKernelMethod(CHAR_BACKSLASH_GREATERTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_isBackslashGreaterThanRexx), 1); - defineKernelMethod(CHAR_LESSTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_isLessThanRexx), 1); - defineKernelMethod(CHAR_BACKSLASH_LESSTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_isBackslashLessThanRexx), 1); - defineKernelMethod(CHAR_GREATERTHAN_EQUAL , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_isGreaterOrEqualRexx), 1); - defineKernelMethod(CHAR_LESSTHAN_EQUAL , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_isLessOrEqualRexx), 1); - defineKernelMethod(CHAR_STRICT_EQUAL , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_strictEqualRexx), 1); - defineKernelMethod(CHAR_STRICT_BACKSLASH_EQUAL , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_strictNotEqualRexx), 1); - defineKernelMethod(CHAR_STRICT_GREATERTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_strictGreaterThanRexx), 1); - defineKernelMethod(CHAR_STRICT_BACKSLASH_GREATERTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_strictBackslashGreaterThanRexx), 1); - defineKernelMethod(CHAR_STRICT_LESSTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_strictLessThanRexx), 1); - defineKernelMethod(CHAR_STRICT_BACKSLASH_LESSTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_strictBackslashLessThanRexx), 1); - defineKernelMethod(CHAR_STRICT_GREATERTHAN_EQUAL , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_strictGreaterOrEqualRexx), 1); - defineKernelMethod(CHAR_STRICT_LESSTHAN_EQUAL , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_strictLessOrEqualRexx), 1); - defineKernelMethod(CHAR_LESSTHAN_GREATERTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_lessThanGreaterThanRexx), 1); - defineKernelMethod(CHAR_GREATERTHAN_LESSTHAN , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_greaterThanLessThanRexx), 1); - defineKernelMethod(CHAR_AND , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_andRexx), 1); - defineKernelMethod(CHAR_OR , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_orRexx), 1); - defineKernelMethod(CHAR_XOR , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_xorRexx), 1); - defineKernelMethod(CHAR_BACKSLASH , TheSomProxyBehaviour, CPPMSOM(RexxSOMProxy::operator_notRexx), 1); - - /* set the scope of the methods to */ - /* this classes oref */ - TheSomProxyBehaviour->setMethodDictionaryScope(TheSomProxyClass); - - /* Now call the class subclassable */ - /* method */ - TheSomProxyClass->subClassable("SOMProxy"); - /***************************************************************************/ - /* M_SOMPROXY */ - /***************************************************************************/ - - /* Add the NEW methods to the class */ - { /* behaviour mdict */ - RexxBehaviour *MetaBehav = TheMSomProxyClass->behaviour; - RexxBehaviour *MetaInstanceBehav = TheMSomProxyClass->instanceBehaviour; - /* M_SOMPROXY is a meta. so make */ - /* it gets classes/meta NEW */ - defineKernelMethod(CHAR_NEW , MetaBehav , CPPMC(RexxClass::newRexx), A_COUNT); - - defineKernelMethod(CHAR_NEW , MetaInstanceBehav, CPPMSOMCL(RexxSOMProxyClass::newRexx), A_COUNT); - defineKernelMethod(CHAR_INIT , MetaInstanceBehav, CPPMSOMCL(RexxSOMProxyClass::init), A_COUNT); - defineKernelMethod(CHAR_UNKNOWN , MetaInstanceBehav, CPPM(RexxObject::unknownRexx), 2); - defineKernelMethod(CHAR_INITPROXY , MetaInstanceBehav, CPPM(RexxObject::initProxyRexx), 1); - defineKernelMethod(CHAR_FREESOMOBJ, MetaInstanceBehav, CPPM(RexxObject::freeSOMObjRexx), 0); - defineKernelMethod(CHAR_SERVER , MetaInstanceBehav, CPPM(RexxObject::serverRexx), 0); - defineKernelMethod(CHAR_SOMOBJ , MetaInstanceBehav, CPPM(RexxObject::SOMObjRexx), 0); - defineKernelMethod(CHAR_HASMETHOD , MetaInstanceBehav, CPPM(RexxObject::hasMethodRexx), 1); - defineKernelMethod(CHAR_SOMDNEW , MetaInstanceBehav, CPPMSOMCL(RexxSOMProxyClass::somdNew), 0); - - /* set the scope of the methods to */ - /* this classes oref */ -// MetaBehav->setMethodDictionaryScope(OREF_M_SOMPROXY); - MetaInstanceBehav->setMethodDictionaryScope(TheMSomProxyClass); - - /* Now call the class subclassable */ - /* method */ - /* NOTE: this may need a special meth*/ - /* so that its a subclass of class */ - TheMSomProxyClass->subClassable("M_SOMProxy"); - } - - /***************************************************************************/ /* SUPPLIER */ /***************************************************************************/ /* Add the NEW methods to the class */ @@ -1544,7 +1437,7 @@ /* Now call the class subclassable */ /* method */ - TheSupplierClass->subClassable("Supplier"); + TheSupplierClass->subClassable("Supplier", true); /***************************************************************************/ /* TABLE */ @@ -1578,7 +1471,7 @@ /* Now call the class subclassable */ /* method */ - TheTableClass->subClassable("Table"); + TheTableClass->subClassable("Table", false); /***************************************************************************/ /***************************************************************************/ @@ -1653,14 +1546,6 @@ /* and the system version info */ kernel_public(CHAR_VERSION,SysVersion(),TheSystem); -#ifdef SOM - /* indicate running with SOM V2 */ - kernel_public(CHAR_SOMVERSION, IntegerTwo, TheSystem); -#else - /* SOM not in system use level 0 */ - kernel_public(CHAR_SOMVERSION, IntegerZero, TheSystem); -#endif - /******************************************************************************/ /* Complete the image build process, calling BaseClasses to establish */ /* the rest of the REXX image. */ @@ -1670,13 +1555,6 @@ /* BaseClasses.ORX and ORYXJ.ORX. */ /* create a kernel methods directory */ kernel_methods = (RexxDirectory *)save(new_directory()); - kernel_methods->put(createKernelMethod(CPPMSOMS(RexxSOMServer::initDSom), 0), kernel_name(CHAR_SHRIEKSOMSERVER_INITDSOM) ); - kernel_methods->put(createKernelMethod(CPPMSOMS(RexxSOMServer::initDSomWPS), 0), kernel_name(CHAR_SHRIEKSOMSERVER_INITDSOMWPS) ); - kernel_methods->put(createKernelMethod(CPPMSOMDS(RexxSOMDServer::getClassObj), 1), kernel_name(CHAR_SOMDSERVER_GETCLASSOBJ) ); - kernel_methods->put(createKernelMethod(CPPMSOMDS(RexxSOMDServer::createObj), 1), kernel_name(CHAR_SOMDSERVER_CREATEOBJ) ); - kernel_methods->put(createKernelMethod(CPPMSOMDS(RexxSOMDServer::deleteObj), 1), kernel_name(CHAR_SOMDSERVER_DELETEOBJ) ); - kernel_methods->put(createKernelMethod(CPPMSOMDO(RexxSOMDObjectMgr::enhanceServer), 2), kernel_name(CHAR_SOMDOBJECTMGR_ENHANCESERVER) ); - kernel_methods->put(createKernelMethod(CPPMSRV(RexxServer::messageWait), 0), kernel_name(CHAR_SHRIEKSERVER_WAIT) ); kernel_methods->put(createKernelMethod(CPPMLOC(RexxLocal::local), 0), kernel_name(CHAR_LOCAL)); kernel_methods->put(createKernelMethod(CPPMLOC(RexxLocal::runProgram), 1), kernel_name(CHAR_RUN_PROGRAM)); kernel_methods->put(createKernelMethod(CPPMLOC(RexxLocal::callString), A_COUNT), kernel_name(CHAR_CALL_STRING)); @@ -1700,13 +1578,41 @@ /* now call BaseClasses to finish the image*/ ((RexxObject *)CurrentActivity)->shriekRun(meth, OREF_NULL, OREF_NULL, (RexxObject **)&kernel_methods, 1); discard(kernel_methods); /* release the directory lock */ - /* remove kernel from .environment */ - TheEnvironment->remove(kernel_name(CHAR_KERNEL)); /* define and suppress methods in the nil object */ TheNilObject->defMethod(kernel_name(CHAR_COPY), (RexxMethod *)TheNilObject); TheNilObject->defMethod(kernel_name(CHAR_START), (RexxMethod *)TheNilObject); TheNilObject->defMethod(kernel_name(CHAR_OBJECTNAMEEQUALS), (RexxMethod *)TheNilObject); + + RexxClass *ordered = (RexxClass *)TheEnvironment->get(kernel_name(CHAR_ORDEREDCOLLECTION)); + + TheArrayClass->inherit(ordered, OREF_NULL); + TheArrayClass->setRexxDefined(); + + TheQueueClass->inherit(ordered, OREF_NULL); + TheQueueClass->setRexxDefined(); + + TheListClass->inherit(ordered, OREF_NULL); + TheListClass->setRexxDefined(); + + RexxClass *map = (RexxClass *)TheEnvironment->get(kernel_name(CHAR_MAPCOLLECTION)); + + TheTableClass->inherit(map, OREF_NULL); + TheTableClass->setRexxDefined(); + + TheRelationClass->inherit(map, OREF_NULL); + TheRelationClass->setRexxDefined(); + + TheDirectoryClass->inherit(map, OREF_NULL); + TheDirectoryClass->setRexxDefined(); + + TheStemClass->inherit(map, OREF_NULL); + TheStemClass->setRexxDefined(); + + // this has been protecting every thing critical + // from GC events thus far, but now we remove it because + // it contains things we don't want to save in the image. + TheEnvironment->remove(kernel_name(CHAR_KERNEL)); return true; } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-13 21:42:37
|
Revision: 274 http://svn.sourceforge.net/oorexx/?rev=274&view=rev Author: bigrixx Date: 2007-04-13 14:42:35 -0700 (Fri, 13 Apr 2007) Log Message: ----------- Remove ASSERT from USE STRICT, allow default value on just plain USE ARG, some more SOM class removal. Modified Paths: -------------- interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.cpp interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.hpp interpreter-3.x/trunk/kernel/kernel.mak interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h interpreter-3.x/trunk/kernel/messages/rexxmsg.xml interpreter-3.x/trunk/kernel/parser/InstructionParser.cpp interpreter-3.x/trunk/kernel/parser/SourceFile.hpp interpreter-3.x/trunk/kernel/parser/Token.hpp interpreter-3.x/trunk/kernel/platform/windows/WindowsMethods.orx interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc interpreter-3.x/trunk/kernel/runtime/RexxConstants.cpp interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp Removed Paths: ------------- interpreter-3.x/trunk/kernel/RexxClasses/SOMInterfaceObjects.orx interpreter-3.x/trunk/kernel/RexxClasses/SOMMethods.orx Deleted: interpreter-3.x/trunk/kernel/RexxClasses/SOMInterfaceObjects.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/SOMInterfaceObjects.orx 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/RexxClasses/SOMInterfaceObjects.orx 2007-04-13 21:42:35 UTC (rev 274) @@ -1,94 +0,0 @@ -/*----------------------------------------------------------------------------*/ -/* */ -/* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */ -/* Copyright (c) 2005-2006 Rexx Language Association. All rights reserved. */ -/* */ -/* This program and the accompanying materials are made available under */ -/* the terms of the Common Public License v1.0 which accompanies this */ -/* distribution. A copy is also available at the following address: */ -/* http://www.oorexx.org/license.html */ -/* */ -/* Redistribution and use in source and binary forms, with or */ -/* without modification, are permitted provided that the following */ -/* conditions are met: */ -/* */ -/* Redistributions of source code must retain the above copyright */ -/* notice, this list of conditions and the following disclaimer. */ -/* Redistributions in binary form must reproduce the above copyright */ -/* notice, this list of conditions and the following disclaimer in */ -/* the documentation and/or other materials provided with the distribution. */ -/* */ -/* Neither the name of Rexx Language Association nor the names */ -/* of its contributors may be used to endorse or promote products */ -/* derived from this software without specific prior written permission. */ -/* */ -/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ -/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ -/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */ -/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ -/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ -/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */ -/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */ -/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */ -/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */ -/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */ -/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ -/* */ -/*----------------------------------------------------------------------------*/ -/******************************************************************************/ -/* REXX Macros rexxsomm.cmd */ -/* */ -/* Create the REXX SOM Interface Objects */ -/* */ -/******************************************************************************/ -/* this is a method installed on the server class. */ -expose somClassMgrObj somInit -use arg fullInit - -if \var('FULLINIT') then fullinit = 1 - -if \fullInit - then Do - /* set up a public entry for the SOM class manager object */ - .localserver~setsom - .localserver~setid(.nil,0) - .local~setentry('!SOM',.localserver) - .local~setentry('SOM',.localserver) - end -else do - if \sominit then Do - somInit = .true - somClassMgrObj = self~!C_somInitialize - .local~setentry('SOMClassMgrObject',.!SOM~make_proxy(somClassMgrObj)) - if \.environment~hasentry('sclass') then do - /* create the class for classes */ - /*shadowed from or to SOM */ - sclass = .!M_SOMProxy~subclass('sclass') - sclass~define('NEW', .!somMethods~sclass_new) - sclass~define('!IMPORT', .!somMethods~sclass_!import) - sclass~define('SOMPROXY', .!somMethods~sclass_somproxy) - .environment['SCLASS'] = sclass - End - if \.environment~hasentry('dsclass') then do - /* create the class for classes */ - /*shadowed from or to DSOM */ - dsclass = .sclass~subclass('dsclass') - dsclass~define('NEW', .!somMethods~dsclass_new) - .environment['DSCLASS'] = dsclass - End - - /* create shadows for SOMObject and SOMClass classes */ - .local~setentry('SOMObject',.!somproxy~subclass('SOMObject',.sclass)~~!import) - .localserver~addclass(.SOMObject,.SOMObject~!somclass) - .local~setentry('SOMClass',.!SOM~import('SOMClass')) - - /* Initializing SOM under the Shell */ - /* or in the MVS operating system? */ - if (self \= .wps) & ('MVS' \= .system~intname~translate) then - /* Nope, so start message Wait loop, */ - /* The Shell will do this on its own*/ - /* it needs this delayed.... */ - self~!startMessageWait - End - -end Deleted: interpreter-3.x/trunk/kernel/RexxClasses/SOMMethods.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/SOMMethods.orx 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/RexxClasses/SOMMethods.orx 2007-04-13 21:42:35 UTC (rev 274) @@ -1,85 +0,0 @@ -/*----------------------------------------------------------------------------*/ -/* */ -/* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */ -/* Copyright (c) 2005-2006 Rexx Language Association. All rights reserved. */ -/* */ -/* This program and the accompanying materials are made available under */ -/* the terms of the Common Public License v1.0 which accompanies this */ -/* distribution. A copy is also available at the following address: */ -/* http://www.oorexx.org/license.html */ -/* */ -/* Redistribution and use in source and binary forms, with or */ -/* without modification, are permitted provided that the following */ -/* conditions are met: */ -/* */ -/* Redistributions of source code must retain the above copyright */ -/* notice, this list of conditions and the following disclaimer. */ -/* Redistributions in binary form must reproduce the above copyright */ -/* notice, this list of conditions and the following disclaimer in */ -/* the documentation and/or other materials provided with the distribution. */ -/* */ -/* Neither the name of Rexx Language Association nor the names */ -/* of its contributors may be used to endorse or promote products */ -/* derived from this software without specific prior written permission. */ -/* */ -/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ -/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ -/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */ -/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ -/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ -/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */ -/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */ -/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */ -/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */ -/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */ -/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ -/* */ -/*----------------------------------------------------------------------------*/ -/******************************************************************************/ -/* REXX Macros rexxsomm.cmd */ -/* */ -/* All standalone methods needed by SOM Support */ -/* */ -/******************************************************************************/ -/* Get installed into a directory for use later on*/ - -.environment["!SOMMETHODS"] = .METHODS - -/* ************************************ */ -/* S C L A S S M E T H O D S */ -/* ************************************ */ -::METHOD sclass_new - /* create a new instance of the class (SOM and Oryx parts) */ - inst = self~somNew - - signal on syntax /* trap init errors */ - forward to (inst) message 'INIT' continue - return inst - -syntax: - raise propagate /* reraise any init errors */ - -::method sclass_!import - self~!import:.class /* 1st do entire import. */ - /* Make sure local server knows */ - /* about imported class */ - .localServer~setid(self, self~!somclass) - self~initProxy(self~!somclass) /* initialize proxy part */ - -::method sclass_somproxy unguarded - /* return corresponding SOM class proxy */ - /* return the proxy equivalent */ - return self~server~make_proxy(self~!somclass) - -::METHOD dsclass_new - /* create a new instance of the */ - /*class (SOM and Oryx parts) */ - inst = self~somdNew - - signal on syntax /* trap init errors */ - forward to (inst) message 'INIT' continue - return inst - -syntax: - raise propagate /* reraise any init errors */ - Modified: interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.cpp 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.cpp 2007-04-13 21:42:35 UTC (rev 274) @@ -50,7 +50,7 @@ #include "ExpressionBaseVariable.hpp" -RexxInstructionUseStrict::RexxInstructionUseStrict(size_t count, bool extraAllowed, RexxQueue *variable_list, RexxQueue *defaults, RexxQueue *assertions) +RexxInstructionUseStrict::RexxInstructionUseStrict(size_t count, bool strict, bool extraAllowed, RexxQueue *variable_list, RexxQueue *defaults) { // set the variable count and the option flag variableCount = count; @@ -65,7 +65,6 @@ count--; OrefSet(this, variables[count].variable, (RexxVariableBase *)variable_list->pop()); OrefSet(this, variables[count].defaultValue, defaults->pop()); - OrefSet(this, variables[count].assertion, assertions->pop()); // if this is a real variable, see if this is the last of the required ones. if (minimumRequired < count + 1 && variables[count].variable != OREF_NULL) @@ -94,7 +93,6 @@ { memory_mark(this->variables[i].variable); memory_mark(this->variables[i].defaultValue); - memory_mark(this->variables[i].assertion); } cleanUpMemoryMark } @@ -116,7 +114,6 @@ { memory_mark_general(this->variables[i].variable); memory_mark_general(this->variables[i].defaultValue); - memory_mark_general(this->variables[i].assertion); } cleanUpMemoryMarkGeneral } @@ -139,7 +136,6 @@ { flatten_reference(newThis->variables[i].variable, envelope); flatten_reference(newThis->variables[i].defaultValue, envelope); - flatten_reference(newThis->variables[i].assertion, envelope); } cleanUpFlatten } @@ -151,32 +147,35 @@ // get the argument information from the context RexxObject **arglist = context->getMethodArgumentList(); size_t argcount = context->getMethodArgumentCount(); - - // not enough of the required arguments? That's an error - if (argcount < minimumRequired) + // strict checking means we need to enforce min/max limits + if (strictChecking) { - // this is a pain, but there are different errors for method errors vs. call errors. - if (context->inMethod()) + // not enough of the required arguments? That's an error + if (argcount < minimumRequired) { - report_exception1(Error_Incorrect_method_minarg, new_integer(minimumRequired)); + // this is a pain, but there are different errors for method errors vs. call errors. + if (context->inMethod()) + { + report_exception1(Error_Incorrect_method_minarg, new_integer(minimumRequired)); + } + else + { + report_exception2(Error_Incorrect_call_minarg, context->getCallname(), new_integer(minimumRequired)); + } } - else + // potentially too many? + if (!variableSize && argcount > variableCount) { - report_exception2(Error_Incorrect_call_minarg, context->getCallname(), new_integer(minimumRequired)); + if (context->inMethod()) + { + report_exception1(Error_Incorrect_method_maxarg, new_integer(variableCount)); + } + else + { + report_exception2(Error_Incorrect_call_maxarg, context->getCallname(), new_integer(variableCount)); + } } } - // potentially too many? - if (!variableSize && argcount > variableCount) - { - if (context->inMethod()) - { - report_exception1(Error_Incorrect_method_maxarg, new_integer(variableCount)); - } - else - { - report_exception2(Error_Incorrect_call_maxarg, context->getCallname(), new_integer(variableCount)); - } - } // now we process each of the variable definitions left-to-right for (size_t i = 0; i < variableCount; i++) @@ -209,18 +208,26 @@ } else { - if (context->inMethod()) + // not doing strict checks, revert to old rules and drop the variable. + if (!strictChecking) { - report_exception1(Error_Incorrect_method_noarg, new_integer(i + 1)); + variable->drop(context); + } else { - report_exception2(Error_Incorrect_call_noarg, context->getCallname(), new_integer(i + 1)); + if (context->inMethod()) + { + report_exception1(Error_Incorrect_method_noarg, new_integer(i + 1)); + } + else + { + report_exception2(Error_Incorrect_call_noarg, context->getCallname(), new_integer(i + 1)); + } } + } } - // now go check any assertions about the argument - checkAssertion(i, context, stack); } } context->pauseInstruction(); // do debug pause if necessary @@ -249,41 +256,3 @@ } -/** - * Run the assertion checks, if any, for an argument. - * - * @param position The list position of the check. - * @param context The current execution context. - * @param stack The execution context evaluation stack. - */ -void RexxInstructionUseStrict::checkAssertion(size_t position, RexxActivation *context, RexxExpressionStack *stack) -{ - // assertions are optional...only do this if one was specified. - RexxObject *assertion = variables[position].assertion; - - if (assertion != OREF_NULL) - { - // evaluate the expression, and trace, if necessary - RexxObject *assertionResult = assertion->evaluate(context, stack); - context->traceResult(assertionResult); - stack->pop(); // remove the value from the stack - - // the comparison methods return either .true or .false, so we - // can to a quick test against those. - if (assertionResult == TheTrueObject) - { - return; // the assertion passed - } - if (assertionResult == TheFalseObject) - { - report_exception1(Error_Execution_use_arg_assertion, new_integer(position + 1)); - } - // this is something we need to evaluate further - if (!assertionResult->truthValue(Error_Logical_value_use_strict_assert)) - { - report_exception1(Error_Execution_use_arg_assertion, new_integer(position + 1)); - } - } -} - - Modified: interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.hpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.hpp 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.hpp 2007-04-13 21:42:35 UTC (rev 274) @@ -51,14 +51,13 @@ public: RexxVariableBase *variable; // the variable accessor RexxObject *defaultValue; // default value for optional variables - RexxObject *assertion; // optional assertion to validate the value. }; class RexxInstructionUseStrict : public RexxInstruction { public: inline void *operator new(size_t size, void *ptr) {return ptr;}; - RexxInstructionUseStrict(size_t, bool, RexxQueue *, RexxQueue *, RexxQueue *); + RexxInstructionUseStrict(size_t, bool, bool, RexxQueue *, RexxQueue *); inline RexxInstructionUseStrict(RESTORETYPE restoreType) { ; }; void live(); void liveGeneral(); @@ -67,11 +66,11 @@ protected: RexxObject *getArgument(RexxObject **arglist, size_t count, size_t target); - void checkAssertion(size_t position, RexxActivation *context, RexxExpressionStack *stack); size_t variableCount; // count of variables to process size_t minimumRequired; // the minimum number of require arguments bool variableSize; // additional arguments allowed after last + bool strictChecking; // determines whether to apply strict argument checks UseVariable variables[1]; // List of variables for USE }; #endif Modified: interpreter-3.x/trunk/kernel/kernel.mak =================================================================== --- interpreter-3.x/trunk/kernel/kernel.mak 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/kernel.mak 2007-04-13 21:42:35 UTC (rev 274) @@ -189,7 +189,7 @@ # SYSUT32OBJ = $(OR_OUTDIR)\rxcmd32.$(OBJ) # define files copied by the make to the test directory -ORXFILES=$(OR_OUTDIR)\CoreClasses.orx $(OR_OUTDIR)\SOMInterfaceObjects.orx $(OR_OUTDIR)\SOMMethods.orx $(OR_OUTDIR)\SystemObjects.orx \ +ORXFILES=$(OR_OUTDIR)\CoreClasses.orx $(OR_OUTDIR)\SystemObjects.orx \ $(OR_OUTDIR)\StreamClasses.orx $(OR_OUTDIR)\SystemMethods.orx $(OR_OUTDIR)\WindowsMethods.orx \ $(OR_OUTDIR)\PlatformObjects.orx $(OR_OUTDIR)\orexxole.cls Modified: interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h 2007-04-13 21:42:35 UTC (rev 274) @@ -208,7 +208,6 @@ #define Error_Invalid_subkeyword_forward_class 25921 #define Error_Invalid_subkeyword_message 25922 #define Error_Invalid_subkeyword_select 25923 -#define Error_Invalid_subkeyword_use_strict_option 25924 #define Error_Invalid_whole_number 26000 #define Error_Invalid_whole_number_power 26008 #define Error_Invalid_whole_number_repeat 26002 @@ -264,7 +263,6 @@ #define Error_Logical_value_guard 34902 #define Error_Logical_value_authorization 34903 #define Error_Logical_value_property 34904 -#define Error_Logical_value_use_strict_assert 34905 #define Error_Invalid_expression 35000 #define Error_Invalid_expression_general 35001 #define Error_Invalid_expression_user_defined 35900 @@ -296,7 +294,6 @@ #define Error_Invalid_expression_forward_class 35928 #define Error_Invalid_expression_logical_list 35929 #define Error_Invalid_expression_use_strict_default 35930 -#define Error_Invalid_expression_use_strict_assert 35931 #define Error_Unmatched_parenthesis 36000 #define Error_Unmatched_parenthesis_user_defined 36900 #define Error_Unmatched_parenthesis_paren 36901 @@ -529,7 +526,6 @@ #define Error_Execution_no_concurrency 98951 #define Error_Invalid_data_type_for_objspec 98974 #define Error_Execution_class_server_not_installed 98952 -#define Error_Execution_use_arg_assertion 98953 #define Error_Translation 99000 #define Error_Translation_user_defined 99900 #define Error_Translation_duplicate_class 99901 Modified: interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h 2007-04-13 21:42:35 UTC (rev 274) @@ -235,7 +235,6 @@ #define Error_Invalid_subkeyword_signalonname_msg 295 #define Error_Invalid_subkeyword_parse_msg 296 #define Error_Invalid_subkeyword_use_msg 297 -#define Error_Invalid_subkeyword_use_strict_option_msg 297 #define Error_Invalid_subkeyword_raise_msg 298 #define Error_Invalid_subkeyword_raiseoption_msg 299 #define Error_Invalid_subkeyword_description_msg 300 @@ -588,11 +587,8 @@ #define Error_Unexpected_end_select_nolabel_msg 658 #define Error_Logical_value_logical_list_msg 659 #define Error_Invalid_expression_logical_list_msg 660 -#define Error_Logical_value_use_strict_assert_msg 661 -#define Error_Execution_use_arg_assertion_msg 662 #define Error_Translation_use_strict_ellipsis_msg 663 #define Error_Invalid_expression_use_strict_default_msg 664 -#define Error_Invalid_expression_use_strict_assert_msg 666 #endif Modified: interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h 2007-04-13 21:42:35 UTC (rev 274) @@ -210,7 +210,6 @@ MINOR(Error_Invalid_subkeyword_forward_class) MINOR(Error_Invalid_subkeyword_message) MINOR(Error_Invalid_subkeyword_select) - MINOR(Error_Invalid_subkeyword_use_strict_option) MAJOR(Error_Invalid_whole_number) MINOR(Error_Invalid_whole_number_power) MINOR(Error_Invalid_whole_number_repeat) @@ -266,7 +265,6 @@ MINOR(Error_Logical_value_guard) MINOR(Error_Logical_value_authorization) MINOR(Error_Logical_value_property) - MINOR(Error_Logical_value_use_strict_assert) MAJOR(Error_Invalid_expression) MINOR(Error_Invalid_expression_general) MINOR(Error_Invalid_expression_user_defined) @@ -298,7 +296,6 @@ MINOR(Error_Invalid_expression_forward_class) MINOR(Error_Invalid_expression_logical_list) MINOR(Error_Invalid_expression_use_strict_default) - MINOR(Error_Invalid_expression_use_strict_assert) MAJOR(Error_Unmatched_parenthesis) MINOR(Error_Unmatched_parenthesis_user_defined) MINOR(Error_Unmatched_parenthesis_paren) @@ -531,7 +528,6 @@ MINOR(Error_Execution_no_concurrency) MINOR(Error_Invalid_data_type_for_objspec) MINOR(Error_Execution_class_server_not_installed) - MINOR(Error_Execution_use_arg_assertion) MAJOR(Error_Translation) MINOR(Error_Translation_user_defined) MINOR(Error_Translation_duplicate_class) Modified: interpreter-3.x/trunk/kernel/messages/rexxmsg.xml =================================================================== --- interpreter-3.x/trunk/kernel/messages/rexxmsg.xml 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/messages/rexxmsg.xml 2007-04-13 21:42:35 UTC (rev 274) @@ -1515,15 +1515,6 @@ <SymbolicName>Error_Invalid_subkeyword_select</SymbolicName> <Text>SELECT must be followed by the keyword LABEL; found <q><Sub position="1" name="word"/></q></Text> </SubMessage> - <SubMessage> - <Code>25</Code> - <Subcode>924</Subcode> - <MessageNumber>297</MessageNumber> - <Component>Rexx</Component> - <Severity>Warning</Severity> - <SymbolicName>Error_Invalid_subkeyword_use_strict_option</SymbolicName> - <Text>USE STRICT argument option must be ASSERT; found <q><Sub position="1" name="word"/></q></Text> - </SubMessage> </Subcodes> </Message> <Message> @@ -2052,15 +2043,6 @@ <SymbolicName>Error_Logical_value_property</SymbolicName> <Text>Property logical value must be exactly <q>0</q>, <q>1</q>, <q>true</q>, or <q>false</q>; found <q><Sub position="1" name="value"/></q></Text> </SubMessage> - <SubMessage> - <Code>34</Code> - <Subcode>905</Subcode> - <MessageNumber>661</MessageNumber> - <Component>Rexx</Component> - <Severity>Warning</Severity> - <SymbolicName>Error_Logical_value_use_strict_assert</SymbolicName> - <Text>USE STRICT ARG ASSERT logical value must be exactly <q>0</q> or <q>1</q>; found <q><Sub position="1" name="value"/></q></Text> - </SubMessage> </Subcodes> </Message> <Message> @@ -2352,15 +2334,6 @@ <SymbolicName>Error_Invalid_expression_use_strict_default</SymbolicName> <Text>Missing expression following <q>=</q> token of a USE STRICT ARG instruction</Text> </SubMessage> - <SubMessage> - <Code>35</Code> - <Subcode>931</Subcode> - <MessageNumber>666</MessageNumber> - <Component>Rexx</Component> - <Severity>Warning</Severity> - <SymbolicName>Error_Invalid_expression_use_strict_assert</SymbolicName> - <Text>Missing expression following ASSERT keyword of a USE STRICT ARG instruction</Text> - </SubMessage> </Subcodes> </Message> <Message> @@ -2939,7 +2912,7 @@ <Component>Rexx</Component> <Severity>Warning</Severity> <SymbolicName>Error_Conversion_raise</SymbolicName> - <Text>Value of RAISE SYNTAX expression of DO instruction must be numeric; found <q><Sub position="1" name="value"/></q></Text> + <Text>Value of RAISE instruction SYNTAX expression must be numeric; found <q><Sub position="1" name="value"/></q></Text> </SubMessage> </Subcodes> </Message> @@ -4537,15 +4510,6 @@ <SymbolicName>Error_Execution_class_server_not_installed</SymbolicName> <Text><Sub position="1" name="servername"/> class server not installed</Text> </SubMessage> - <SubMessage> - <Code>98</Code> - <Subcode>953</Subcode> - <MessageNumber>662</MessageNumber> - <Component>Rexx</Component> - <Severity>Error</Severity> - <SymbolicName>Error_Execution_use_arg_assertion</SymbolicName> - <Text>USE STRICT ARG ASSERT expression at position <Sub position="1" name="position"/> failed</Text> - </SubMessage> </Subcodes> </Message> <Message> Modified: interpreter-3.x/trunk/kernel/parser/InstructionParser.cpp =================================================================== --- interpreter-3.x/trunk/kernel/parser/InstructionParser.cpp 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/parser/InstructionParser.cpp 2007-04-13 21:42:35 UTC (rev 274) @@ -2172,11 +2172,18 @@ return (RexxInstruction *)newObject; /* done, return this */ } +/** + * Parse a USE STRICT ARG instruction. + * + * @return The executable instruction object. + */ RexxInstruction *RexxSource::useNew() -/****************************************************************************/ -/* Function: Create a USE instruction object */ -/****************************************************************************/ { + // assume we only require the simpler form of the instruction until + // we find a feature that requires the enhanced one. + bool generateStrict = false; + bool strictChecking = false; // no strict checking enabled yet + // The STRICT keyword turns this into a different instruction with different // syntax rules RexxToken *token = nextReal(); @@ -2184,84 +2191,24 @@ if (subkeyword == SUBKEY_STRICT) { - return useStrictNew(); + token = nextReal(); // skip over the token + generateStrict = true; // we need the enhanced version here + strictChecking = true; // apply the strict checks. } // the only subkeyword supported is ARG - if (subkeyword != SUBKEY_ARG) - { - report_error_token(Error_Invalid_subkeyword_use, token); - } - size_t variableCount = 0; /* no variables yet */ - RexxQueue *variable_list = new_queue(); // we might be parsing message terms, so we can't use the subterms list. - saveObject(variable_list); - token = nextReal(); /* get the next token */ - // keep processing tokens to the end - while (token->classId != TOKEN_EOC) - { - // this could be a token to skip a variable - if (token->classId == TOKEN_COMMA) - { - // this goes on as a variable, but an empty entry to process - variable_list->push(OREF_NULL); - variableCount++; - } - else // something real. This could be a single symbol or a message term - { - previousToken(); // push the current token back for term processing - // see if we can get a variable or a message term from this - RexxObject *retriever = variableOrMessageTerm(); - if (retriever != OREF_NULL) - { - variable_list->push(retriever); - variableCount++; - token = nextReal(); - if (token->classId == TOKEN_EOC) - { - break; - } - else if (token->classId != TOKEN_COMMA) - { - report_error_token(Error_Translation_use_comma, token); - } - } - else // invalid assignment type - { - report_error_token(Error_Variable_expected_USE, token); - } - } - token = nextReal(); /* get the next token */ - } - /* create a new translator object */ - RexxObject *newObject = new_variable_instruction(USE, Use, sizeof(RexxInstructionUse) + (variableCount - 1) * sizeof(RexxObject *)); - /* now complete this */ - new ((void *)newObject) RexxInstructionUse(variableCount, variable_list); - removeObj(variable_list); - return(RexxInstruction *)newObject; /* done, return this */ -} - -/** - * Parse a USE STRICT ARG instruction. - * - * @return The executable instruction object. - */ -RexxInstruction *RexxSource::useStrictNew() -{ - RexxToken *token = nextReal(); - // the only subkeyword supported is ARG if (subKeyword(token) != SUBKEY_ARG) { report_error_token(Error_Invalid_subkeyword_use, token); } - // we accumulate 3 sets of data here, so we need 3 queues to push them in + // we accumulate 2 sets of data here, so we need 2 queues to push them in + // if this is the SIMPLE version, the second queue will be empty. size_t variableCount = 0; RexxQueue *variable_list = new_queue(); // we might be parsing message terms, so we can't use the subterms list. saveObject(variable_list); RexxQueue *defaults_list = new_queue(); saveObject(defaults_list); - RexxQueue *assertions_list = new_queue(); - saveObject(assertions_list); token = nextReal(); /* get the next token */ bool allowOptionals = false; // we don't allow trailing optionals unless the list ends with "..." @@ -2275,7 +2222,6 @@ // we also need to push empty entries on the other queues to keep everything in sync. variable_list->push(OREF_NULL); defaults_list->push(OREF_NULL); - assertions_list->push(OREF_NULL); variableCount++; // step to the next token, and go process more token = nextReal(); @@ -2316,21 +2262,21 @@ if (token->classId == TOKEN_EOC) { defaults_list->push(OREF_NULL); - assertions_list->push(OREF_NULL); break; } // if we've hit a comma here, step to the next token and continue with the next variable else if (token->classId == TOKEN_COMMA) { defaults_list->push(OREF_NULL); - assertions_list->push(OREF_NULL); token = nextReal(); continue; } // if this is NOT a comma, we potentially have a - // default value and/or and ASSERT to process. + // default value if (token->subclass == OPERATOR_EQUAL) { + // this requires the enhanced form of USE to implement. + generateStrict = true; // this is a constant expression value. Single token forms // are fine without parens, more complex forms require parens as // delimiters. @@ -2348,13 +2294,11 @@ // a terminator takes us out. We need to keep all 3 lists in sync with dummy entries. if (token->classId == TOKEN_EOC) { - assertions_list->push(OREF_NULL); break; } // if we've hit a comma here, step to the next token and continue with the next variable else if (token->classId == TOKEN_COMMA) { - assertions_list->push(OREF_NULL); token = nextReal(); continue; } @@ -2364,55 +2308,27 @@ // we need a more defaults marker defaults_list->push(OREF_NULL); } + } + } - // this MUST be the ASSERT keyword here. We've already taken care of other options, so - // it's do or die now. - if (token->classId != TOKEN_SYMBOL) - { - report_error_token(Error_Invalid_subkeyword_use_strict_option, token); - } - else - { - if (subKeyword(token) != SUBKEY_ASSERT) - { - report_error_token(Error_Invalid_subkeyword_use_strict_option, token); - } - RexxObject *condition = this->constantLogicalExpression(); - if (condition == OREF_NULL) - { - report_error(Error_Invalid_expression_use_strict_assert); - } - assertions_list->push(condition); + RexxObject *newObject; - // Sigh, yet another check for EOC or COMMA... - token = nextReal(); - if (token->classId == TOKEN_EOC) - { - break; - } - // if we've hit a comma here, step to the next token and continue with the next variable - else if (token->classId == TOKEN_COMMA) - { - // step to the next token and continue - token = nextReal(); - continue; - } - else - { - // all that work, and we still found something invalid - report_error_token(Error_Invalid_subkeyword_use_strict_option, token); - } - } - } + // if we use any of the enhanced features, we need the strict form. + if (generateStrict) + { + newObject = new_variable_instruction(USE, UseStrict, sizeof(RexxInstructionUseStrict) + (variableCount == 0 ? 0 : (variableCount - 1)) * sizeof(UseVariable)); + new ((void *)newObject) RexxInstructionUseStrict(variableCount, strictChecking, allowOptionals, variable_list, defaults_list); } + else + { + // simpler, legacy form + newObject = new_variable_instruction(USE, Use, sizeof(RexxInstructionUse) + (variableCount - 1) * sizeof(RexxObject *)); + new ((void *)newObject) RexxInstructionUse(variableCount, variable_list); + } - /* create a new translator object */ - RexxObject *newObject = new_variable_instruction(USE, UseStrict, sizeof(RexxInstructionUseStrict) + (variableCount == 0 ? 0 : (variableCount - 1)) * sizeof(UseVariable)); - /* now complete this */ - new ((void *)newObject) RexxInstructionUseStrict(variableCount, allowOptionals, variable_list, defaults_list, assertions_list); + // release the object locks and return; removeObj(variable_list); removeObj(defaults_list); - removeObj(assertions_list); - return(RexxInstruction *)newObject; /* done, return this */ + return(RexxInstruction *)newObject; } Modified: interpreter-3.x/trunk/kernel/parser/SourceFile.hpp =================================================================== --- interpreter-3.x/trunk/kernel/parser/SourceFile.hpp 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/parser/SourceFile.hpp 2007-04-13 21:42:35 UTC (rev 274) @@ -247,7 +247,6 @@ RexxInstruction *thenNew(RexxToken *, RexxInstructionIf *); RexxInstruction *traceNew(); RexxInstruction *useNew(); - RexxInstruction *useStrictNew(); void holdObject(RexxObject *object) { this->holdstack->push(object);}; void saveObject(RexxObject *object) { this->savelist->put(object, object); }; void removeObj(RexxObject *object) { if (object != OREF_NULL) this->savelist->remove(object); }; Modified: interpreter-3.x/trunk/kernel/parser/Token.hpp =================================================================== --- interpreter-3.x/trunk/kernel/parser/Token.hpp 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/parser/Token.hpp 2007-04-13 21:42:35 UTC (rev 274) @@ -237,7 +237,8 @@ #define SUBKEY_ARGUMENTS SUBKEY_MESSAGE + 1 #define SUBKEY_LABEL SUBKEY_ARGUMENTS + 1 #define SUBKEY_STRICT SUBKEY_LABEL + 1 -#define SUBKEY_ASSERT SUBKEY_STRICT + 1 +#define SUBKEY_TRUE SUBKEY_STRICT + 1 +#define SUBKEY_FALSE SUBKEY_TRUE + 1 /* token extended types - end of clause */ #define CLAUSEEND_EOF 2301 Modified: interpreter-3.x/trunk/kernel/platform/windows/WindowsMethods.orx =================================================================== --- interpreter-3.x/trunk/kernel/platform/windows/WindowsMethods.orx 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/platform/windows/WindowsMethods.orx 2007-04-13 21:42:35 UTC (rev 274) @@ -39,12 +39,10 @@ /* This is our starting point for */ /* The return directory of methods */ meths = .methods~copy - /* add the SOM Initializationroutne*/ -meths[server_SomInitialize] = .method~newfile("SOMInterfaceObjects.orx") functions = .kernel~functions /* get the function table */ /**************************************************************/ - /* Define the OS/2 system specific functions */ + /* Define the Windows system specific functions */ /**************************************************************/ functions['BEEP'] = meths~function_beep functions['SETLOCAL'] = meths~function_setlocal @@ -116,16 +114,3 @@ ::method function_rxmessagebox EXTERNAL 'REXX sysMessageBox' -/* ******************************** */ -/* S E R V E R M E T H O D S */ -/* ******************************** */ - -::METHOD server_init_local EXTERNAL 'REXX server_init_local' -::METHOD server_C_sominit EXTERNAL 'REXX server_c_sominit' -::METHOD server_findSomClass EXTERNAL 'REXX server_findsomclass' -::METHOD server_somclass EXTERNAL 'REXX server_somclass' -::METHOD server_somname EXTERNAL 'REXX server_somname' -::METHOD server_somparent EXTERNAL 'REXX server_somparent' -::METHOD server_somproxy EXTERNAL 'REXX server_somproxy' -::METHOD server_somtrace EXTERNAL 'REXX server_somtrace' - Modified: interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc =================================================================== --- interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc 2007-04-13 21:42:35 UTC (rev 274) @@ -235,7 +235,6 @@ Error_Invalid_subkeyword_signalonname "SIGNAL ON condition must be followed by the keyword NAME; found ""&1""" Error_Invalid_subkeyword_parse "PARSE must be followed by one of the keywords ARG, LINEIN, PULL, SOURCE, VALUE, VAR, or VERSION; found ""&1""" Error_Invalid_subkeyword_use "USE must be followed by the keyword ARG; found ""&1""" - Error_Invalid_subkeyword_use_strict_option "USE STRICT argument option must be ASSERT; found ""&1""" Error_Invalid_subkeyword_raise "RAISE must be followed by one of the keywords ERROR, FAILURE, HALT, LOSTDIGITS, NOMETHOD, NOSTRING, NOTREADY, NOVALUE, SYNTAX, or USER; found ""&1""" Error_Invalid_subkeyword_raiseoption "Unknown keyword on RAISE instruction; found ""&1""" Error_Invalid_subkeyword_description "Duplicate DESCRIPTION keyword found" @@ -346,7 +345,7 @@ Error_Conversion_to "Value of TO expression of DO instruction must be numeric; found ""&1""" Error_Conversion_by "Value of BY expression of DO instruction must be numeric; found ""&1""" Error_Conversion_control "Value of control variable expression of DO instruction must be numeric; found ""&1""" - Error_Conversion_raise "Value of RAISE SYNTAX expression of DO instruction must be numeric; found ""&1""" + Error_Conversion_raise "Value of RAISE instruction SYNTAX expression must be numeric; found ""&1""" Error_Overflow_overflow "Arithmetic overflow detected at: ""&1&2&3""" Error_Overflow_underflow "Arithmetic underflow detected at: ""&1&2&3""" Error_Overflow_zero "Arithmetic overflow; divisor must not be zero" @@ -588,11 +587,8 @@ Error_Unexpected_end_select_nolabel "END corresponding to SELECT on line &2 must not have a symbol following it because there is no LABEL; found ""&1""" Error_Logical_value_logical_list "Value of logical list expression element must be exactly ""0"" or ""1""; found ""&2""" Error_Invalid_expression_logical_list "Missing expression in logical_expression_list" - Error_Logical_value_use_strict_assert "USE STRICT ARG ASSERT logical value must be exactly ""0"" or ""1""; found ""&1""" - Error_Execution_use_arg_assertion "USE STRICT ARG ASSERT expression at position &1 failed" Error_Translation_use_strict_ellipsis "The ""..."" argument marker can only appear at the end of the argument list" Error_Invalid_expression_use_strict_default "Missing expression following ""="" token of a USE STRICT ARG instruction" - Error_Invalid_expression_use_strict_assert "Missing expression following ASSERT keyword of a USE STRICT ARG instruction" END Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.cpp 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.cpp 2007-04-13 21:42:35 UTC (rev 274) @@ -124,7 +124,6 @@ KWD(CHAR_ARG, SUBKEY_ARG) KWD(CHAR_ARGUMENTS, SUBKEY_ARGUMENTS) KWD(CHAR_ARRAY, SUBKEY_ARRAY) - KWD(CHAR_ASSERT, SUBKEY_ASSERT) KWD(CHAR_BY, SUBKEY_BY) KWD(CHAR_CLASS, SUBKEY_CLASS) KWD(CHAR_CONTINUE, SUBKEY_CONTINUE) @@ -133,6 +132,7 @@ KWD(CHAR_ENGINEERING, SUBKEY_ENGINEERING) KWD(CHAR_EXIT, SUBKEY_EXIT) KWD(CHAR_EXPOSE, SUBKEY_EXPOSE) + KWD(CHAR_FALSE, SUBKEY_FALSE) KWD(CHAR_FOR, SUBKEY_FOR) KWD(CHAR_FOREVER, SUBKEY_FOREVER) KWD(CHAR_FORM, SUBKEY_FORM) @@ -148,6 +148,7 @@ KWD(CHAR_STRICT, SUBKEY_STRICT) KWD(CHAR_THEN, SUBKEY_THEN) KWD(CHAR_TO, SUBKEY_TO) + KWD(CHAR_TRUE, SUBKEY_TRUE) KWD(CHAR_UNTIL, SUBKEY_UNTIL) KWD(CHAR_VALUE, SUBKEY_VALUE) KWD(CHAR_WHEN, SUBKEY_WHEN) Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-13 00:50:00 UTC (rev 273) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-13 21:42:35 UTC (rev 274) @@ -72,7 +72,6 @@ CHARCONSTANT(ARRAY, "ARRAY"); CHARCONSTANT(ARGUMENTS, "ARGUMENTS"); CHARCONSTANT(ARRAYSYM, "ARRAY"); -CHARCONSTANT(ASSERT, "ASSERT"); CHARCONSTANT(AT, "AT"); CHARCONSTANT(ATTRIBUTE, "ATTRIBUTE"); CHARCONSTANT(AVAILABLE, "AVAILABLE"); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-14 00:24:00
|
Revision: 275 http://svn.sourceforge.net/oorexx/?rev=275&view=rev Author: bigrixx Date: 2007-04-13 17:23:58 -0700 (Fri, 13 Apr 2007) Log Message: ----------- Add empty and isEmpty methods to the collection classes. Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp interpreter-3.x/trunk/kernel/classes/ListClass.cpp interpreter-3.x/trunk/kernel/classes/ListClass.hpp interpreter-3.x/trunk/kernel/classes/StemClass.cpp interpreter-3.x/trunk/kernel/classes/StemClass.hpp interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.hpp interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-04-14 00:23:58 UTC (rev 275) @@ -196,6 +196,45 @@ /** + * Empty all of the items from an array. + * + * @return No return value. + */ +RexxObject *RexxArray::empty() +{ + + // if not working with an oldspace object (VERY likely), we can just use memset to clear + // everything. + if (!OldSpace(this)) + { + memset(this->data(), '\0', sizeof(RexxObject *) * this->arraySize); + } + else + { + // sigh, we have to use OrefSet + for (size_t i = 0; i < this->arraySize; i++) + { + + OrefSet(this, this->objects[i], OREF_NULL); + } + } + return OREF_NULL; // no real return value +} + + +/** + * Test if an array is empty. + * + * @return True if the array is empty, false otherwise + */ +RexxObject *RexxArray::isEmpty() +{ + return (numItems() == 0) ? TheTrueObject : TheFalseObject; +} + + + +/** * Append an item after the last item in the array. * * @param value The value to append. Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-04-14 00:23:58 UTC (rev 275) @@ -132,6 +132,8 @@ void ensureSpace(size_t newSize); RexxObject *newRexx(RexxObject **, size_t); RexxObject *of(RexxObject **, size_t); + RexxObject *empty(); + RexxObject *isEmpty(); inline void addLast(RexxObject *item) { this->insertItem(item, this->size() + 1); } inline void addFirst(RexxObject *item) { this->insertItem(item, 1); } Modified: interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp 2007-04-14 00:23:58 UTC (rev 275) @@ -615,11 +615,40 @@ /* Function: Reset a directory to a "pristine" empty state */ /******************************************************************************/ { - OrefSet(this, this->contents, new_hashtab(DEFAULT_HASH_SIZE)); - OrefSet(this, this->method_table, OREF_NULL); - OrefSet(this, this->unknown_method, OREF_NULL); + // empty the hashtables without reallocating. + contents->empty(); + if (method_table != OREF_NULL) + { + method_table->empty(); + } + // clear out the unknown method. + OrefSet(this, this->unknown_method, OREF_NULL); } + +/** + * Empty a hash table collection. + * + * @return nothing + */ +RexxObject *RexxDirectory::empty() +{ + reset(); + return OREF_NULL; +} + + +/** + * Test if a HashTableCollection is empty. + * + * @return + */ +RexxObject *RexxDirectory::isEmpty() +{ + return items() == 0 ? TheTrueObject : TheFalseObject; +} + + RexxObject *RexxDirectory::newRexx( RexxObject **init_args, size_t argCount) Modified: interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp 2007-04-14 00:23:58 UTC (rev 275) @@ -78,6 +78,8 @@ RexxArray *allItems(); RexxArray *allIndexes(); void reset(); + RexxObject *empty(); + RexxObject *isEmpty(); RexxObject *newRexx(RexxObject **init_args, size_t); Modified: interpreter-3.x/trunk/kernel/classes/ListClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ListClass.cpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/classes/ListClass.cpp 2007-04-14 00:23:58 UTC (rev 275) @@ -731,6 +731,37 @@ /** + * Empty all of the items from a list. + * + * @return No return value. + */ +RexxObject *RexxList::empty() +{ + // just iterate through the list, copying the elements. + RexxArray *array = (RexxArray *)new_array(this->count); + while (this->first != LIST_END) + { + // get the list entry and remove the value + LISTENTRY *element = ENTRY_POINTER(this->first); + primitiveRemove(element); + } + return OREF_NULL; +} + + + +/** + * Test if a list is empty. + * + * @return True if the list is empty, false otherwise + */ +RexxObject *RexxList::isEmpty() +{ + return (count == 0) ? TheTrueObject : TheFalseObject; +} + + +/** * Return an array containing all elements contained in the list, * in sorted order. * Modified: interpreter-3.x/trunk/kernel/classes/ListClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ListClass.hpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/classes/ListClass.hpp 2007-04-14 00:23:58 UTC (rev 275) @@ -103,6 +103,8 @@ RexxObject *removeLast() { return (this->last != LIST_END) ? this->primitiveRemove(ENTRY_POINTER(this->last)) : TheNilObject; } LISTENTRY *getEntry(RexxObject *, RexxObject *); RexxObject *indexOfValue(RexxObject *); + RexxObject *empty(); + RexxObject *isEmpty(); void addLast(RexxObject *value); void addFirst(RexxObject *value); Modified: interpreter-3.x/trunk/kernel/classes/StemClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StemClass.cpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/classes/StemClass.cpp 2007-04-14 00:23:58 UTC (rev 275) @@ -480,19 +480,8 @@ RexxCompoundElement *variable; /* table variable entry */ RexxArray *array; /* returned array */ LONG count; /* count of variables */ -// tails.dump(); - /* traverse through all of the items */ - /* in the stem variable dictionary, */ - /* counting each real variable */ - count = 0; /* start with zero */ - variable = tails.first(); /* get the first variable */ - while (variable != OREF_NULL) { /* while more values to process */ - /* this a real variable? */ - if (variable->getVariableValue() != OREF_NULL) - count++; /* count this variable */ - variable = tails.next(variable); /* go get the next one */ - } - array = new_array(count); /* get the array */ + + array = new_array(items()); /* get the array */ count = 1; /* start at the beginning again */ variable = tails.first(); /* get the first variable */ @@ -645,41 +634,76 @@ */ RexxArray *RexxStem::allItems() { - // first, run the tree and get a count of the real items contained here - arraysize_t count = 0; + // now we know how big the return result will be, get an array and + // populate it, using the same traversal logic as before + RexxArray *array = new_array(items()); + // we index the array with a origin-one index, so we start with one this time + arraysize_t count = 1; + RexxCompoundElement *variable = tails.first(); while (variable != OREF_NULL) { - // we only want to include the non-dropped compounds, so we only count - // elements with real values. + // only add the real values if (variable->getVariableValue() != OREF_NULL) { - count++; + array->put(variable->getVariableValue(), count++); } - // and keep iterating variable = tails.next(variable); } - // now we know how big the return result will be, get an array and - // populate it, using the same traversal logic as before - RexxArray *array = new_array(count); - // we index the array with a origin-one index, so we start with one this time - count = 1; + return array; // tada, finished +} - variable = tails.first(); + +/** + * Get the count of non-dropped items in the stem. + * + * @return The number of non-dropped items. + */ +arraysize_t RexxStem::items() +{ + arraysize_t count = 0; + + RexxCompoundElement *variable = tails.first(); while (variable != OREF_NULL) { - // only add the real values + // we only want to include the non-dropped compounds, so we only count + // elements with real values. if (variable->getVariableValue() != OREF_NULL) { - array->put(variable->getVariableValue(), count++); + count++; } + // and keep iterating variable = tails.next(variable); } - return array; // tada, finished + return count; } /** + * Empty the stem. This also clears dropped and exposed tails, + * + * @return Nothing. + */ +RexxObject *RexxStem::empty() +{ + tails.clear(); // just clear the tails. + return OREF_NULL; +} + + +/** + * Test if the stem is empty. + * + * @return True if the stem is empty, false otherwise. + */ +RexxObject *RexxStem::isEmpty() +{ + return (items() == 0) ? TheTrueObject : TheFalseObject; +} + + + +/** * Create an array of all indexes of the stem. * * @return An array of all tail names used in the stem. @@ -733,6 +757,7 @@ } + /******************************************************************************/ /* Function: Below are a series of comparison routines used by the qsort() */ /* library function when sorting stems. */ Modified: interpreter-3.x/trunk/kernel/classes/StemClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StemClass.hpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/classes/StemClass.hpp 2007-04-14 00:23:58 UTC (rev 275) @@ -78,6 +78,9 @@ RexxArray *allIndexes(); RexxSupplier *supplier(); RexxObject *request(RexxString *); + RexxObject *empty(); + RexxObject *isEmpty(); + arraysize_t items(); void dropValue(); RexxObject *unknown (RexxString *, RexxArray *); Modified: interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp 2007-04-14 00:23:58 UTC (rev 275) @@ -121,6 +121,7 @@ return newProxy; } + RexxObject *RexxHashTableCollection::copy(void) /******************************************************************************/ /* Function: Copy a hash based collection object */ @@ -255,6 +256,7 @@ return this->contents->merge(target); } + RexxObject *RexxHashTableCollection::copyValues( long depth) /* depth to propagate the copy to */ /******************************************************************************/ @@ -323,3 +325,26 @@ { return this->contents->allIndexes(); } + + +/** + * Empty a hash table collection. + * + * @return nothing + */ +RexxObject *RexxHashTableCollection::empty() +{ + contents->empty(); + return OREF_NULL; +} + + +/** + * Test if a HashTableCollection is empty. + * + * @return + */ +RexxObject *RexxHashTableCollection::isEmpty() +{ + return contents->isEmpty() ? TheTrueObject : TheFalseObject; +} Modified: interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp 2007-04-14 00:23:58 UTC (rev 275) @@ -69,6 +69,8 @@ RexxObject *merge(RexxHashTableCollection *); RexxArray *allItems(); RexxArray *allIndexes(); + RexxObject *empty(); + RexxObject *isEmpty(); inline long items() { return this->contents->totalEntries(); }; inline long first() { return this->contents->first(); }; Modified: interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.hpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.hpp 2007-04-14 00:23:58 UTC (rev 275) @@ -36,7 +36,7 @@ /* */ /*----------------------------------------------------------------------------*/ /******************************************************************************/ -/* REXX Kernel RexxCompoundTable.hpp */ +/* REXX Kernel RexxCompoundTable.hpp */ /* */ /* Balanced binary tree table for stem variables */ /* */ Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-14 00:23:58 UTC (rev 275) @@ -122,6 +122,7 @@ CHARCONSTANT(DLFDouble , "DLFDouble"); CHARCONSTANT(DOUBLE, "DOUBLE"); CHARCONSTANT(DSOM, "DSOM"); +CHARCONSTANT(EMPTY, "EMPTY"); CHARCONSTANT(ENCODEBASE64, "ENCODEBASE64"); CHARCONSTANT(ENGINEERING, "ENGINEERING"); CHARCONSTANT(ENHANCED, "ENHANCED"); @@ -172,6 +173,7 @@ CHARCONSTANT(INTERFACE, "INTERFACE"); CHARCONSTANT(INTNAME, "INTNAME"); CHARCONSTANT(ISA, "ISA"); +CHARCONSTANT(ISEMPTY, "ISEMPTY"); CHARCONSTANT(ISINSTANCEOF, "ISINSTANCEOF"); CHARCONSTANT(ITEM, "ITEM"); CHARCONSTANT(ITEMS, "ITEMS"); Modified: interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp 2007-04-14 00:23:58 UTC (rev 275) @@ -1251,20 +1251,11 @@ /* Function: Create an array containing the hash table values */ /******************************************************************************/ { - size_t count; /* count of values */ size_t i; /* loop counter */ size_t j; /* loop counter */ RexxArray *result; /* result array */ - count = 0; /* no items yet */ - /* loop through all of the items */ - for (i = 0; i < this->totalSlotsSize(); i++) { - /* is this a real entry? */ - if (this->entries[i].index != OREF_NULL) - count++; /* add to the counter */ - } - - result = new_array(count); /* get a new array */ + result = new_array(items()); /* get a new array */ j = 0; /* set the insertion point */ /* loop through all of the items */ for (i = 0; i < this->totalSlotsSize(); i++) { @@ -1276,6 +1267,96 @@ return result; /* return the result array */ } + +/** + * count the number of items in the hash table. + * + * @return The item count. + */ +size_t RexxHashTable::items() +{ + size_t count = 0; + + for (size_t i = 0; i < this->totalSlotsSize(); i++) + { + + if (this->entries[i].index != OREF_NULL) + { + count++; + } + } + return count; +} + + +/** + * Empty an individual hashtable bucket. This will clear + * the entire chain. + * + * @param position The hash table bucket to clear. + */ +void RexxHashTable::emptySlot(HashLink position) +{ + if (this->entries[position].index != OREF_NULL) + { + // we have an initial link, so clear those entries out + OrefSet(this,this->entries[position].index,OREF_NULL); + OrefSet(this,this->entries[position].value,OREF_NULL); + // we have at least a head element, so run the chain + // clearing everything out + + // step to the next link. The remainder are cleared out and + // returned to the free pool. + HashLink next = entries[position].next; + // and make sure the link is severed. + entries[position].next = NO_MORE; + while (next != NO_MORE) + { + position = next; + // clear the entries out + OrefSet(this,this->entries[position].index,OREF_NULL); + OrefSet(this,this->entries[position].value,OREF_NULL); + + // get the next link, and clear the link info in the current + next = entries[position].next; + entries[position].next = NO_MORE; + // if this creates a new highwater mark, move the free pointer. + if (position > this->free) + { + this->free = position; + } + + } + } +} + + +/** + * Empty a HashTable. + */ +void RexxHashTable::empty() +{ + // run the main hash bucket clearing the links + for (HashLink i = 0; i < mainSlotsSize(); i++) + { + emptySlot(i); + } +} + + +/** + * Test if the hash table is empty. + * + * @return + */ +bool RexxHashTable::isEmpty() +{ + return items() == 0; +} + + + + RexxArray *RexxHashTable::makeArray(void) /******************************************************************************/ /* Function: Create an array containing the hash table indexes. */ @@ -1291,20 +1372,11 @@ /* Function: Create an array containing the hash table indexes. */ /******************************************************************************/ { - size_t count; /* count of values */ size_t i; /* loop counter */ size_t j; /* loop counter */ RexxArray *result; /* result array */ - count = 0; /* no items yet */ - /* loop through all of the items */ - for (i = 0; i < this->totalSlotsSize(); i++) { - /* is this a real entry? */ - if (this->entries[i].index != OREF_NULL) - count++; /* add to the counter */ - } - - result = new_array(count); /* get a new array */ + result = new_array(items()); /* get a new array */ j = 0; /* set the insertion point */ /* loop through all of the items */ for (i = 0; i < this->totalSlotsSize(); i++) { @@ -1328,13 +1400,7 @@ RexxArray *values; /* value array */ RexxArray *indexes; /* index array */ - count = 0; /* no items yet */ - /* loop through all of the items */ - for (i = 0; i < this->totalSlotsSize(); i++) { - /* is this a real entry? */ - if (this->entries[i].index != OREF_NULL) - count++; /* add to the counter */ - } + count = items(); /* no items yet */ values = new_array(count); /* get a new array */ indexes = new_array(count); /* and an index array */ Modified: interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp 2007-04-14 00:23:58 UTC (rev 275) @@ -69,6 +69,10 @@ void liveGeneral(); void flatten(RexxEnvelope *); RexxArray * makeArray(); + void empty(); + bool isEmpty(); + size_t items(); + void emptySlot(HashLink); HashLink next(HashLink position); RexxObject *value(HashLink position); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-13 21:42:35 UTC (rev 274) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 00:23:58 UTC (rev 275) @@ -158,6 +158,8 @@ CPPMA(RexxArray::append), CPPMA(RexxArray::allIndexes), CPPMA(RexxArray::allItems), +CPPMA(RexxArray::empty), +CPPMA(RexxArray::isEmpty), CPPMC1(RexxArray::newRexx), CPPMA(RexxArray::makeString), @@ -176,6 +178,8 @@ CPPMD(RexxDirectory::supplier), CPPMA(RexxDirectory::allIndexes), CPPMA(RexxDirectory::allItems), +CPPMA(RexxDirectory::empty), +CPPMA(RexxDirectory::isEmpty), CPPMD(RexxDirectory::newRexx), @@ -230,6 +234,8 @@ CPPML(RexxList::append), CPPML(RexxList::allIndexes), CPPML(RexxList::allItems), +CPPMA(RexxList::empty), +CPPMA(RexxList::isEmpty), CPPMLC(RexxListClass::newRexx), CPPMLC(RexxListClass::classOf), @@ -313,6 +319,8 @@ CPPMSTEM(RexxStem::supplier), CPPMSTEM(RexxStem::allIndexes), CPPMSTEM(RexxStem::allItems), +CPPMSTEM(RexxStem::empty), +CPPMSTEM(RexxStem::isEmpty), CPPMSTEM(RexxStem::newRexx), @@ -495,6 +503,8 @@ CPPMHC(RexxHashTableCollection::supplier), CPPMHC(RexxHashTableCollection::allItems), CPPMHC(RexxHashTableCollection::allIndexes), +CPPMHC(RexxHashTableCollection::empty), +CPPMHC(RexxHashTableCollection::isEmpty), CPPMTBL(RexxTable::newRexx), @@ -850,6 +860,8 @@ defineKernelMethod(CHAR_MAKESTRING ,TheArrayBehaviour, CPPMA(RexxArray::makeString), 1); defineKernelMethod(CHAR_ALLINDEXES ,TheArrayBehaviour, CPPMA(RexxArray::allIndexes), 0); defineKernelMethod(CHAR_ALLITEMS ,TheArrayBehaviour, CPPMA(RexxArray::allItems), 0); + defineKernelMethod(CHAR_EMPTY ,TheArrayBehaviour, CPPMA(RexxArray::empty), 0); + defineKernelMethod(CHAR_ISEMPTY ,TheArrayBehaviour, CPPMA(RexxArray::isEmpty), 0); /* set the scope of the methods to */ /* this classes oref */ TheArrayBehaviour->setMethodDictionaryScope(TheArrayClass); @@ -879,6 +891,8 @@ defineKernelMethod(CHAR_MAKEARRAY , TheDirectoryBehaviour, CPPM(RexxObject::makeArrayRexx), 0); defineKernelMethod(CHAR_ALLITEMS , TheDirectoryBehaviour, CPPMD(RexxDirectory::allItems), 0); defineKernelMethod(CHAR_ALLINDEXES , TheDirectoryBehaviour, CPPMD(RexxDirectory::allIndexes), 0); + defineKernelMethod(CHAR_EMPTY , TheDirectoryBehaviour, CPPMD(RexxDirectory::empty), 0); + defineKernelMethod(CHAR_ISEMPTY , TheDirectoryBehaviour, CPPMD(RexxDirectory::isEmpty), 0); defineKernelMethod(CHAR_PUT , TheDirectoryBehaviour, CPPMD(RexxDirectory::put), 2); defineKernelMethod(CHAR_REMOVE , TheDirectoryBehaviour, CPPMD(RexxDirectory::remove), 1); defineKernelMethod(CHAR_SETENTRY , TheDirectoryBehaviour, CPPMD(RexxDirectory::setEntry), 2); @@ -946,6 +960,8 @@ defineKernelMethod(CHAR_APPEND ,TheListBehaviour, CPPMA(RexxList::append), 1); defineKernelMethod(CHAR_ALLITEMS ,TheListBehaviour, CPPML(RexxList::allItems), 0); defineKernelMethod(CHAR_ALLINDEXES ,TheListBehaviour, CPPML(RexxList::allIndexes), 0); + defineKernelMethod(CHAR_EMPTY ,TheListBehaviour, CPPML(RexxList::empty), 0); + defineKernelMethod(CHAR_ISEMPTY ,TheListBehaviour, CPPML(RexxList::isEmpty), 0); /* set the scope of the methods to */ /* this classes oref */ TheListBehaviour->setMethodDictionaryScope(TheListClass); @@ -1049,6 +1065,8 @@ defineKernelMethod(CHAR_APPEND ,TheQueueBehaviour, CPPMQ(RexxQueue::append), 1); defineKernelMethod(CHAR_ALLITEMS ,TheQueueBehaviour, CPPML(RexxList::allItems), 0); defineKernelMethod(CHAR_ALLINDEXES ,TheQueueBehaviour, CPPMQ(RexxQueue::allIndexes), 0); + defineKernelMethod(CHAR_EMPTY ,TheQueueBehaviour, CPPMQ(RexxList::empty), 0); + defineKernelMethod(CHAR_ISEMPTY ,TheQueueBehaviour, CPPMQ(RexxList::isEmpty), 0); /* set the scope of the methods to */ /* this classes oref */ @@ -1088,6 +1106,8 @@ defineKernelMethod(CHAR_SUPPLIER , TheRelationBehaviour, CPPMREL(RexxRelation::supplier), 1); defineKernelMethod(CHAR_ALLITEMS , TheRelationBehaviour, CPPMHC(RexxHashTableCollection::allItems), 0); defineKernelMethod(CHAR_ALLINDEXES , TheRelationBehaviour, CPPMHC(RexxHashTableCollection::allIndexes), 0); + defineKernelMethod(CHAR_EMPTY , TheRelationBehaviour, CPPMHC(RexxHashTableCollection::empty), 0); + defineKernelMethod(CHAR_ISEMPTY , TheRelationBehaviour, CPPMHC(RexxHashTableCollection::isEmpty), 0); /* set the scope of the methods to */ /* this classes oref */ @@ -1117,6 +1137,8 @@ defineKernelMethod(CHAR_SUPPLIER ,TheStemBehaviour, CPPMSTEM(RexxStem::supplier), 0); defineKernelMethod(CHAR_ALLINDEXES ,TheStemBehaviour, CPPMSTEM(RexxStem::allIndexes), 0); defineKernelMethod(CHAR_ALLITEMS ,TheStemBehaviour, CPPMSTEM(RexxStem::allItems), 0); + defineKernelMethod(CHAR_EMPTY ,TheStemBehaviour, CPPMSTEM(RexxStem::empty), 0); + defineKernelMethod(CHAR_ISEMPTY ,TheStemBehaviour, CPPMSTEM(RexxStem::isEmpty), 0); defineKernelMethod(CHAR_UNKNOWN ,TheStemBehaviour, CPPM(RexxObject::unknownRexx), 2); /* set the scope of the methods to */ @@ -1464,6 +1486,8 @@ defineKernelMethod(CHAR_SUPPLIER , TheTableBehaviour, CPPMHC(RexxHashTableCollection::supplier), 0); defineKernelMethod(CHAR_ALLITEMS , TheTableBehaviour, CPPMHC(RexxHashTableCollection::allItems), 0); defineKernelMethod(CHAR_ALLINDEXES , TheTableBehaviour, CPPMHC(RexxHashTableCollection::allIndexes), 0); + defineKernelMethod(CHAR_EMPTY , TheTableBehaviour, CPPMHC(RexxHashTableCollection::empty), 0); + defineKernelMethod(CHAR_ISEMPTY , TheTableBehaviour, CPPMHC(RexxHashTableCollection::isEmpty), 0); /* set the scope of the methods to */ /* this classes oref */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-14 00:42:10
|
Revision: 276 http://svn.sourceforge.net/oorexx/?rev=276&view=rev Author: bigrixx Date: 2007-04-13 17:42:11 -0700 (Fri, 13 Apr 2007) Log Message: ----------- [ 1699837 ] Add "of" class method to queue Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/QueueClass.cpp interpreter-3.x/trunk/kernel/classes/QueueClass.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/QueueClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/QueueClass.cpp 2007-04-14 00:23:58 UTC (rev 275) +++ interpreter-3.x/trunk/kernel/classes/QueueClass.cpp 2007-04-14 00:42:11 UTC (rev 276) @@ -260,6 +260,8 @@ return result; } + + RexxObject *RexxQueue::newRexx(RexxObject **init_args, size_t argCount) /******************************************************************************/ /* Function: Create an instance of a queue */ @@ -278,6 +280,55 @@ return (RexxObject *)newObject; /* return the new object */ } +RexxQueue *RexxQueue::ofRexx( + RexxObject **args, /* array of list items */ + size_t argCount) /* size of the argument array */ +/******************************************************************************/ +/* Function: Create a new queue containing the given items */ +/******************************************************************************/ +{ + LONG size; /* size of the array */ + LONG i; /* loop counter */ + RexxQueue *newQueue; /* newly created list */ + RexxObject *item; /* item to add */ + + if (TheQueueClass == ((RexxClass *)this)) { /* creating an internel list item? */ + size = argCount; /* get the array size */ + newQueue = new RexxQueue; /* get a new list */ + save(newQueue); /* protect from garbage collection */ + for (i = 0; i < size; i++) { /* step through the array */ + item = args[i]; /* get the next item */ + if (item == OREF_NULL) { /* omitted item? */ + discard(newQueue); /* release the new list */ + /* raise an error on this */ + report_exception1(Error_Incorrect_method_noarg, new_integer(i + 1)); + } + /* add this to the list end */ + newQueue->addLast(item); + } + } + else { + size = argCount; /* get the array size */ + /* get a new list */ + newQueue = (RexxQueue *)send_message0(this, OREF_NEW); + save(newQueue); /* protect from garbage collection */ + for (i = 0; i < size; i++) { /* step through the array */ + item = args[i]; /* get the next item */ + if (item == OREF_NULL) { /* omitted item? */ + discard(newQueue); /* release the new list */ + /* raise an error on this */ + report_exception1(Error_Incorrect_method_noarg, new_integer(i + 1)); + } + /* add this to the list end */ + send_message1(newQueue, OREF_QUEUENAME, item); + } + } + discard(hold(newQueue)); /* release the collection lock */ + return newQueue; /* give back the list */ +} + + + void *RexxQueue::operator new(size_t size) /******************************************************************************/ /* Function: Create an instance of a queue */ Modified: interpreter-3.x/trunk/kernel/classes/QueueClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/QueueClass.hpp 2007-04-14 00:23:58 UTC (rev 275) +++ interpreter-3.x/trunk/kernel/classes/QueueClass.hpp 2007-04-14 00:42:11 UTC (rev 276) @@ -64,6 +64,7 @@ RexxObject *peek(); RexxObject *supplier(); RexxObject *newRexx(RexxObject **, size_t); + RexxQueue *ofRexx(RexxObject **, size_t); RexxObject *append(RexxObject *); RexxArray *allIndexes(); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 00:23:58 UTC (rev 275) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 00:42:11 UTC (rev 276) @@ -312,6 +312,7 @@ CPPML(RexxQueue::allIndexes), CPPMQ(RexxQueue::newRexx), +CPPMQ(RexxQueue::ofRexx), CPPMSTEM(RexxStem::bracket), /* Stem methods */ CPPMSTEM(RexxStem::bracketEqual), @@ -1041,6 +1042,7 @@ /* Add the NEW method to the class */ /* behaviour mdict */ defineKernelMethod(CHAR_NEW, TheQueueClassBehaviour, CPPMQ(RexxQueue::newRexx), A_COUNT); + defineKernelMethod(CHAR_OF, TheQueueClassBehaviour, CPPMQ(RexxQueue::ofRexx), A_COUNT); /* set the scope of the methods to */ /* this classes oref */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-14 01:31:26
|
Revision: 277 http://svn.sourceforge.net/oorexx/?rev=277&view=rev Author: bigrixx Date: 2007-04-13 18:31:23 -0700 (Fri, 13 Apr 2007) Log Message: ----------- [ 1700112 ] Add "ABSTRACT" option to the METHOD directive Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h interpreter-3.x/trunk/kernel/messages/rexxmsg.xml interpreter-3.x/trunk/kernel/parser/SourceFile.cpp interpreter-3.x/trunk/kernel/parser/Token.hpp interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc interpreter-3.x/trunk/kernel/runtime/RexxConstants.cpp interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp 2007-04-14 01:31:23 UTC (rev 277) @@ -1255,6 +1255,12 @@ return method_save->getAttribute()->getValue(this->getObjectVariables(method_save->scope)); } +RexxObject *RexxObject::abstractMethod(RexxObject **args, size_t count) +{ + report_exception1(Error_Incorrect_method_abstract, last_msgname()); + return OREF_NULL; +} + RexxString *RexxObject::defaultName() /******************************************************************************/ /* Function: Handle "final" string coercion level */ Modified: interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp 2007-04-14 01:31:23 UTC (rev 277) @@ -50,6 +50,7 @@ #define getAttributeIndex 0 /* location of getAttribute method */ #define setAttributeIndex 1 /* location of setAttribute method */ +#define abstractIndex 2 /* location of the abstractMethod */ class RexxObject; class RexxCompoundTail; @@ -260,6 +261,7 @@ RexxObject *getObjectVariable(RexxString *, RexxObject *); RexxObject *setAttribute(RexxObject *); RexxObject *getAttribute(); + RexxObject *abstractMethod(RexxObject **, size_t); void addObjectVariables(RexxVariableDictionary *); void copyObjectVariables(RexxObject *newObject); RexxObject *superScope(RexxObject *); Modified: interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h 2007-04-14 01:31:23 UTC (rev 277) @@ -469,6 +469,7 @@ #define Error_Incorrect_method_invbase64 93962 #define Error_Unsupported_method 93963 #define Error_Application_error 93964 +#define Error_Incorrect_method_abstract 93965 #define Error_No_method 97000 #define Error_No_method_name 97001 #define Error_No_method_user_defined 97900 Modified: interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h 2007-04-14 01:31:23 UTC (rev 277) @@ -589,6 +589,7 @@ #define Error_Invalid_expression_logical_list_msg 660 #define Error_Translation_use_strict_ellipsis_msg 663 #define Error_Invalid_expression_use_strict_default_msg 664 +#define Error_Incorrect_method_abstract_msg 665 #endif Modified: interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h 2007-04-14 01:31:23 UTC (rev 277) @@ -471,6 +471,7 @@ MINOR(Error_Incorrect_method_invbase64) MINOR(Error_Unsupported_method) MINOR(Error_Application_error) + MINOR(Error_Incorrect_method_abstract) MAJOR(Error_No_method) MINOR(Error_No_method_name) MINOR(Error_No_method_user_defined) Modified: interpreter-3.x/trunk/kernel/messages/rexxmsg.xml =================================================================== --- interpreter-3.x/trunk/kernel/messages/rexxmsg.xml 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/messages/rexxmsg.xml 2007-04-14 01:31:23 UTC (rev 277) @@ -3991,6 +3991,15 @@ <SymbolicName>Error_Application_error</SymbolicName> <Text>Application error: <Sub position="1" name="message"/></Text> </SubMessage> + <SubMessage> + <Code>93</Code> + <Subcode>965</Subcode> + <MessageNumber>665</MessageNumber> + <Component>Rexx</Component> + <Severity>Warning</Severity> + <SymbolicName>Error_Incorrect_method_abstract</SymbolicName> + <Text>Method <Sub position="1" name="name"/> is ABSTRACT and cannot be directly invoked</Text> + </SubMessage> </Subcodes> </Message> <Message> Modified: interpreter-3.x/trunk/kernel/parser/SourceFile.cpp =================================================================== --- interpreter-3.x/trunk/kernel/parser/SourceFile.cpp 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/parser/SourceFile.cpp 2007-04-14 01:31:23 UTC (rev 277) @@ -1555,6 +1555,7 @@ BOOL Class; /* method is a class method */ BOOL Public; /* had a public keyword */ BOOL Attribute; /* attribute option is specified */ + bool abstractMethod; // this is an abstract method BOOL subclass; /* had a subclass keyword */ INT type; /* subkeyword type */ PCHAR entryName; /* REXX entry point name */ @@ -1737,6 +1738,7 @@ guard = DEFAULT_GUARD; /* default is guarding */ Class = FALSE; /* default is an instance method */ Attribute = FALSE; /* init Attribute flag */ + abstractMethod = false; // not abstract token = nextReal(); /* get the next token */ externalname = OREF_NULL; /* not an external method yet */ retriever = OREF_NULL; /* no associated retriever yet */ @@ -1822,7 +1824,7 @@ /* duplicates are invalid */ report_error_token(Error_Invalid_subkeyword_method, token); /* EXTERNAL already specified ? */ - if (externalname != OREF_NULL) + if (externalname != OREF_NULL || abstractMethod) /* EXTERNAL and ATTRIBUTE are */ /* mutually exclusive */ report_error_token(Error_Invalid_subkeyword_method, token); @@ -1830,7 +1832,21 @@ retriever = this->getRetriever(internalname); Attribute = TRUE; /* flag for later processing */ break; + /* ::METHOD name ABSTRACT */ + case SUBDIRECTIVE_ABSTRACT: + if (abstractMethod) + { + report_error_token(Error_Invalid_subkeyword_method, token); + } + // not compatible with ATTRIBUTE or EXTERNAL + if (externalname != OREF_NULL || Attribute) + { + report_error_token(Error_Invalid_subkeyword_method, token); + } + abstractMethod = true; /* flag for later processing */ + break; + default: /* invalid keyword */ /* this is an error */ report_error_token(Error_Invalid_subkeyword_method, token); @@ -1870,6 +1886,13 @@ /* create a generic kernel method */ method = new_method(getAttributeIndex, CPPM(RexxObject::getAttribute), 0, OREF_NULL); } + // abstract method? + else if (abstractMethod) + { + /* Go check the next clause to make */ + this->checkDirective(); /* sure that no code follows */ + method = new_method(abstractIndex, CPPM(RexxObject::abstractMethod), A_COUNT, OREF_NULL); + } /* not an external method? */ else if (externalname == OREF_NULL) { /* go do the next block of code */ Modified: interpreter-3.x/trunk/kernel/parser/Token.hpp =================================================================== --- interpreter-3.x/trunk/kernel/parser/Token.hpp 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/parser/Token.hpp 2007-04-14 01:31:23 UTC (rev 277) @@ -265,6 +265,7 @@ #define SUBDIRECTIVE_MIXINCLASS 2510 #define SUBDIRECTIVE_ATTRIBUTE 2511 #define SUBDIRECTIVE_PROTECTED 2512 +#define SUBDIRECTIVE_ABSTRACT 2513 /* condition keywords */ Modified: interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc =================================================================== --- interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc 2007-04-14 01:31:23 UTC (rev 277) @@ -589,6 +589,7 @@ Error_Invalid_expression_logical_list "Missing expression in logical_expression_list" Error_Translation_use_strict_ellipsis "The ""..."" argument marker can only appear at the end of the argument list" Error_Invalid_expression_use_strict_default "Missing expression following ""="" token of a USE STRICT ARG instruction" + Error_Incorrect_method_abstract "Method &1 is ABSTRACT and cannot be directly invoked" END Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.cpp 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.cpp 2007-04-14 01:31:23 UTC (rev 277) @@ -309,6 +309,7 @@ /*********************************************************************/ KWDTABLE SubDirectives[] = { /* language directive subkeywords */ + KWD(CHAR_ABSTRACT, SUBDIRECTIVE_ABSTRACT) KWD(CHAR_ATTRIBUTE, SUBDIRECTIVE_ATTRIBUTE) KWD(CHAR_CLASS, SUBDIRECTIVE_CLASS) KWD(CHAR_EXTERNAL, SUBDIRECTIVE_EXTERNAL) Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-14 01:31:23 UTC (rev 277) @@ -411,6 +411,7 @@ /*now names for the builtin functions */ CHARCONSTANT(ABBREV, "ABBREV"); CHARCONSTANT(ABS, "ABS"); +CHARCONSTANT(ABSTRACT, "ABSTRACT"); CHARCONSTANT(ADDRESS, "ADDRESS"); CHARCONSTANT(ARG, "ARG"); CHARCONSTANT(B2X, "B2X"); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 00:42:11 UTC (rev 276) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 01:31:23 UTC (rev 277) @@ -80,6 +80,7 @@ /* predictable location */ CPPM(RexxObject::getAttribute), CPPM(RexxObject::setAttribute), +CPPM(RexxObject::abstractMethod), // also must be at this location ALWAYS CPPM(RexxObject::objectName), CPPM(RexxObject::objectNameEquals), CPPM(RexxObject::run), This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-14 16:22:38
|
Revision: 280 http://svn.sourceforge.net/oorexx/?rev=280&view=rev Author: bigrixx Date: 2007-04-14 09:22:38 -0700 (Sat, 14 Apr 2007) Log Message: ----------- [ 1700617 ] Change supplier~index for multidimension arrays [ 1700532 ] StemClass.hpp needs an #include of SupplierClass [ 1698603 ] Add hasItem and Index methods to other collections. array class only. [ 1700606 ] Control stack full error from array makestring. Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp interpreter-3.x/trunk/kernel/classes/StemClass.hpp interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-04-14 06:11:38 UTC (rev 279) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-04-14 16:22:38 UTC (rev 280) @@ -36,7 +36,7 @@ /* */ /*----------------------------------------------------------------------------*/ /******************************************************************************/ -/* REXX Kernel ArrayClass.c */ +/* REXX Kernel ArrayClass.c */ /* */ /* Primitive Array Class */ /* */ @@ -478,7 +478,7 @@ if (fMultiDim) { /* add the index location */ - indexes->put((RexxObject*) indexToStringRep(i, buffer, multiIndex), count); + indexes->put((RexxObject*) indexToArray(i), count); } else { /* add the index location */ indexes->put((RexxObject*) new_integer(i), count); @@ -496,45 +496,7 @@ return (RexxObject *)new_supplier(values, indexes); } -RexxString* RexxArray::indexToStringRep(size_t idx, char *buffer, size_t *indices) -/******************************************************************************/ -/* Function: Create human-readable representation for multi-dimensional index*/ -/******************************************************************************/ -{ - char *tmp = buffer; - size_t dims; - size_t dimension; - size_t digit; - size_t i; - /* create the string representation of the multidimensional array. as the */ - /* single indices can only be determined with the last first, they are */ - /* stored in the indices array first and then made human-readable. */ - /* this method gets the char buffer passed in so it does not have to alloc*/ - /* memory on each call. the allocation is done in RexxArray::supplier in- */ - /* stead. the same is true for the indices array. */ - idx--; - dims = this->dimensions->size(); - for (i = dims; i != 0; i--) { - dimension = ((RexxInteger *)this->dimensions->get(i))->value; - digit = idx % dimension; /* calculate current index */ - indices[dims-i] = digit+1; /* set digit in indices array */ - idx = (idx - digit) / dimension; /* remove numberspace for this index */ - } - - tmp[0] = 0x00; /* create string representation */ - for (i = dims; i > 0; i--) { - if (i == dims) { - sprintf(tmp,"%d",indices[i-1]); - } else { - sprintf(tmp,",%d",indices[i-1]); - } - tmp = tmp + strlen(tmp); - } - - return new_cstring(buffer); /* create RexxString for char buffer */ -} - void RexxArray::setExpansion(RexxObject * expansion) /******************************************************************************/ /* Function: Set a new expansion array item */ @@ -1111,7 +1073,8 @@ return newArray; } - +// Temporary bypass for BUG #1700606 +#if 0 RexxString *RexxArray::primitiveMakeString() /******************************************************************************/ /* Function: Handle a REQUEST('STRING') request for a REXX string object */ @@ -1119,9 +1082,14 @@ { return this->makeString((RexxString *)OREF_NULL); /* forward to the real makestring method */ } +#endif +RexxString *RexxArray::makeString(RexxString *format) +{ + return toString(format); +} -RexxString *RexxArray::makeString(RexxString *format) +RexxString *RexxArray::toString(RexxString *format) /******************************************************************************/ /* Function: Make a string out of an array */ /******************************************************************************/ @@ -1187,7 +1155,11 @@ { mutbuffer->append((RexxObject *) line_end_string); } - mutbuffer->append(item); + RexxObject *stringValue = item->requiredString(); + if (stringValue != TheNilObject) + { + mutbuffer->append(stringValue); + } first = false; } } @@ -1393,6 +1365,121 @@ return this; /* All done, return array */ } + +/** + * Find the index of a single item in the array. + * + * @param item The item to locate. + * + * @return The numeric index of the item. + */ +arraysize_t RexxArray::findSingleIndexItem(RexxObject *item) +{ + for (arraysize_t i = 0; i < this->arraySize; i++) + { + // if there's an object in the slot, compare it. + if (objects[i] != OREF_NULL) + { + // if the items are equal, return the index + if (item->equalValue(objects[i])) + { + return i + 1; + } + } + } + return 0; +} + + +/** + * Convert a multi-dimensional array index into an array + * of index values for the flattened dimension. + * + * @param idx The index to covert. + * + * @return An array of the individual index items. + */ +RexxObject* RexxArray::indexToArray(size_t idx) +{ + // work with an origin-origin zero version of the index, which is easier + // do work with. + idx--; + // get the number of dimensions specified. + size_t dims = this->dimensions->size(); + // get an array we fill in as we go + RexxArray *index = new_array(dims); + + for (size_t i = dims; i > 0; i--) + { + // get the next dimension size + size_t dimension = ((RexxInteger *)this->dimensions->get(i))->value; + // now get the remainder. This tells us the position within this + // dimension of the array. Make an integer object and store in the + // array. + size_t digit = idx % dimension; + // the digit is origin-zero, but the Rexx index is origin-one. + index->put(new_integer(digit + 1), i); + // now strip out that portion of the index. + idx = (idx - digit) / dimension; + } + // return the array object + discard_hold(index); + return index; +} + + +/** + * Return the index for the first occurrence of the target in + * the array. + * + * @param target The target object. + * + * @return The index for the array. For a multi-dimensional array, this + * returns an array of indices. + */ +RexxObject *RexxArray::index(RexxObject *target) +{ + // we require the index to be there. + required_arg(target, ONE); + // see if we have this item. If not, then + // we return .nil. + arraysize_t index = findSingleIndexItem(target); + + if (index == 0) + { + return TheNilObject; + } + // single dimensional arrays are easy, we return + if (this->dimensions == OREF_NULL || this->dimensions->size() == 1) + { + return new_integer(index); + } + else + { + // convert this into an array of integers + return indexToArray(index); + } +} + + +/** + * Test if an item is within the array. + * + * @param target The target test item. + * + * @return .true if this item exists in the array. .false if it does not + * exist. + */ +RexxObject *RexxArray::hasItem(RexxObject *target) +{ + // this is pretty simple. One argument, required, and just search to see + // if we have it. + required_arg(target, ONE); + return findSingleIndexItem(target) == 0 ? TheFalseObject : TheTrueObject; +} + + + void copyElements( COPYELEMENTPARM *parm, size_t newDimension) Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-04-14 06:11:38 UTC (rev 279) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-04-14 16:22:38 UTC (rev 280) @@ -93,8 +93,12 @@ RexxArray *makeArray(); RexxArray *allItems(); RexxArray *allIndexes(); + RexxString *toString(RexxString *); RexxString *makeString(RexxString *); +// Temporary bypass for BUG #1700606 +#if 0 RexxString *primitiveMakeString(); +#endif RexxObject *getRexx(RexxObject **, size_t); void put(RexxObject * eref, size_t pos); RexxObject *putRexx(RexxObject **, size_t); @@ -134,6 +138,8 @@ RexxObject *of(RexxObject **, size_t); RexxObject *empty(); RexxObject *isEmpty(); + RexxObject *index(RexxObject *); + RexxObject *hasItem(RexxObject *); inline void addLast(RexxObject *item) { this->insertItem(item, this->size() + 1); } inline void addFirst(RexxObject *item) { this->insertItem(item, 1); } @@ -143,7 +149,8 @@ inline RexxObject **data() { return this->expansionArray->objects; } inline RexxObject **data(size_t pos) { return &((this->data())[pos-1]);} inline RexxArray *getExpansion() { return this->expansionArray; } - inline RexxString *indexToStringRep(size_t, char*, size_t*); // def. 1048 + arraysize_t findSingleIndexItem(RexxObject *item); + RexxObject* indexToArray(size_t idx); size_t arraySize; /* current size of array */ size_t maximumSize; /* Maximum size array can grow */ Modified: interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp 2007-04-14 06:11:38 UTC (rev 279) +++ interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp 2007-04-14 16:22:38 UTC (rev 280) @@ -1072,6 +1072,28 @@ return string_value; /* return the converted form */ } +/** + * Handle a string request for a required string value where + * the caller wishes to handle the error itself. + * + * @return The object's string value, or OREF_NULL if this is not a + * string. + */ +RexxString *RexxObject::requiredString() +{ + // primitive object? We have a bypass for this + if (isPrimitive(this)) + { + return this->makeString(); + } + else + { + // we have to use REQUEST to get this + return (RexxString *)this->sendMessage(OREF_REQUEST, OREF_STRINGSYM); + } +} + + RexxInteger *RexxObject::requestInteger( size_t precision ) /* precision to use */ /******************************************************************************/ Modified: interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp 2007-04-14 06:11:38 UTC (rev 279) +++ interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp 2007-04-14 16:22:38 UTC (rev 280) @@ -215,6 +215,7 @@ LONG requestLong(size_t); RexxArray *requestArray(); RexxString *requiredString(LONG); + RexxString *requiredString(); RexxInteger *requiredInteger(LONG, size_t); LONG requiredLong(LONG, size_t precision = DEFAULT_DIGITS); LONG requiredPositive(LONG, size_t precision = DEFAULT_DIGITS); @@ -292,6 +293,13 @@ RexxObject *SOMObjRexx(); RexxObject *serverRexx(); BOOL callSecurityManager(RexxString *, RexxDirectory *); + // compare 2 values for equality, potentially falling back on the + // "==" method for the test. + bool inline equalValue(RexxObject *other) + { + // test first for direct equality, followed by value equality. + return (this == other) || this->isEqual(other); + } // Define operator methods here. Modified: interpreter-3.x/trunk/kernel/classes/StemClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StemClass.hpp 2007-04-14 06:11:38 UTC (rev 279) +++ interpreter-3.x/trunk/kernel/classes/StemClass.hpp 2007-04-14 16:22:38 UTC (rev 280) @@ -55,6 +55,8 @@ #define SORT_ASCENDING 0 #define SORT_DECENDING 1 +class RexxSupplier; + class RexxStem : public RexxObject { public: void *operator new (size_t); Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-14 06:11:38 UTC (rev 279) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-14 16:22:38 UTC (rev 280) @@ -350,6 +350,7 @@ CHARCONSTANT(TABLE, "TABLE"); CHARCONSTANT(TARGET, "TARGET"); CHARCONSTANT(TOKENIZE_ONLY, "//T"); +CHARCONSTANT(TOSTRING, "TOSTRING"); CHARCONSTANT(TRACEBACK, "TRACEBACK"); CHARCONSTANT(TRANSLATE, "TRANSLATE"); CHARCONSTANT(TRUE, "TRUE"); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 06:11:38 UTC (rev 279) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 16:22:38 UTC (rev 280) @@ -161,6 +161,9 @@ CPPMA(RexxArray::allItems), CPPMA(RexxArray::empty), CPPMA(RexxArray::isEmpty), +CPPMA(RexxArray::index), +CPPMA(RexxArray::hasItem), +CPPMA(RexxArray::toString), CPPMC1(RexxArray::newRexx), CPPMA(RexxArray::makeString), @@ -860,10 +863,13 @@ defineKernelMethod(CHAR_PREVIOUS ,TheArrayBehaviour, CPPMA(RexxArray::previousRexx), 1); defineKernelMethod(CHAR_APPEND ,TheArrayBehaviour, CPPMA(RexxArray::append), 1); defineKernelMethod(CHAR_MAKESTRING ,TheArrayBehaviour, CPPMA(RexxArray::makeString), 1); + defineKernelMethod(CHAR_TOSTRING ,TheArrayBehaviour, CPPMA(RexxArray::toString), 1); defineKernelMethod(CHAR_ALLINDEXES ,TheArrayBehaviour, CPPMA(RexxArray::allIndexes), 0); defineKernelMethod(CHAR_ALLITEMS ,TheArrayBehaviour, CPPMA(RexxArray::allItems), 0); defineKernelMethod(CHAR_EMPTY ,TheArrayBehaviour, CPPMA(RexxArray::empty), 0); defineKernelMethod(CHAR_ISEMPTY ,TheArrayBehaviour, CPPMA(RexxArray::isEmpty), 0); + defineKernelMethod(CHAR_INDEX ,TheArrayBehaviour, CPPMA(RexxArray::index), 1); + defineKernelMethod(CHAR_HASITEM ,TheArrayBehaviour, CPPMA(RexxArray::hasItem), 1); /* set the scope of the methods to */ /* this classes oref */ TheArrayBehaviour->setMethodDictionaryScope(TheArrayClass); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-14 18:58:24
|
Revision: 281 http://svn.sourceforge.net/oorexx/?rev=281&view=rev Author: bigrixx Date: 2007-04-14 11:58:25 -0700 (Sat, 14 Apr 2007) Log Message: ----------- [ 1698603 ] Add hasItem and Index methods to other collections. The rest of the collections, minus stem, which will be addressed later. Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp interpreter-3.x/trunk/kernel/classes/ListClass.cpp interpreter-3.x/trunk/kernel/classes/ListClass.hpp interpreter-3.x/trunk/kernel/classes/QueueClass.cpp interpreter-3.x/trunk/kernel/classes/QueueClass.hpp interpreter-3.x/trunk/kernel/classes/RelationClass.cpp interpreter-3.x/trunk/kernel/classes/RelationClass.hpp interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.cpp interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp 2007-04-14 18:58:25 UTC (rev 281) @@ -649,6 +649,63 @@ } + +/** + * Retrieve an index for a given item. Which index is returned + * is indeterminate. + * + * @param target The target object. + * + * @return The index for the target object, or .nil if no object was + * found. + */ +RexxObject *RexxDirectory::indexRexx(RexxObject *target) +{ + // required argument + required_arg(target, ONE); + // retrieve this from the hash table + RexxObject *result = this->contents->getIndex(target); + // not found, return .nil + if (result == OREF_NULL) + { + // rats, we might need to do this the hardway + if (this->method_table != OREF_NULL) + { + RexxTable *methodTable = this->method_table; + + for (HashLink index = methodTable->first(); methodTable->available(index); index = methodTable->next(index)) + { + // we need to run each method, looking for a value that matches + RexxString *name = (RexxString *)methodTable->index(index); + RexxMethod *method = (RexxMethod *)methodTable->value(index); + RexxObject *value = method->run(CurrentActivity, this, name, 0, NULL); + // got a match? + if (target->equalValue(value)) + { + return name; // the name is the index + } + } + } + return TheNilObject; // the nil object is the unknown index + } + return result; +} + + +/** + * Test if a given item exists in the collection. + * + * @param target The target object. + * + * @return .true if the object exists, .false otherwise. + */ +RexxObject *RexxDirectory::hasItem(RexxObject *target) +{ + required_arg(target, ONE); + // the lookup is more complicated, so just delegate to the index lookup code. + return indexRexx(target) != TheNilObject ? TheTrueObject : TheFalseObject; +} + RexxObject *RexxDirectory::newRexx( RexxObject **init_args, size_t argCount) Modified: interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp 2007-04-14 18:58:25 UTC (rev 281) @@ -80,6 +80,8 @@ void reset(); RexxObject *empty(); RexxObject *isEmpty(); + RexxObject *indexRexx(RexxObject *); + RexxObject *hasItem(RexxObject *); RexxObject *newRexx(RexxObject **init_args, size_t); Modified: interpreter-3.x/trunk/kernel/classes/ListClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ListClass.cpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/classes/ListClass.cpp 2007-04-14 18:58:25 UTC (rev 281) @@ -786,6 +786,66 @@ } +/** + * Return the index of the first item with a matching value + * in the list. Returns .nil if the object is not found. + * + * @param target The target object. + * + * @return The index of the item, or .nil. + */ +RexxObject *RexxList::index(RexxObject *target) +{ + // we require the index to be there. + required_arg(target, ONE); + + // ok, now run the list looking for the target item + long next = this->first; + for (long i = 1; i <= this->count; i++) + { + LISTENTRY *element = ENTRY_POINTER(next); + // if we got a match, return the item + if (target->equalValue(element->value)) + { + return new_integer(next); + } + next = element->next; + } + // no match + return TheNilObject; +} + + +/** + * Tests whether there is an object with the given value in the + * list. + * + * @param target The target value. + * + * @return .true if there is a match, .false otherwise. + */ +RexxObject *RexxList::hasItem(RexxObject *target) +{ + // we require the index to be there. + required_arg(target, ONE); + + // ok, now run the list looking for the target item + long next = this->first; + for (long i = 1; i <= this->count; i++) + { + LISTENTRY *element = ENTRY_POINTER(next); + // if we got a match, return the item + if (target->equalValue(element->value)) + { + return TheTrueObject; + } + next = element->next; + } + // no match + return TheFalseObject; +} + + RexxObject *RexxList::indexOfValue( RexxObject *value) /*****************************************************************************/ Modified: interpreter-3.x/trunk/kernel/classes/ListClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ListClass.hpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/classes/ListClass.hpp 2007-04-14 18:58:25 UTC (rev 281) @@ -105,6 +105,8 @@ RexxObject *indexOfValue(RexxObject *); RexxObject *empty(); RexxObject *isEmpty(); + RexxObject *index(RexxObject *); + RexxObject *hasItem(RexxObject *); void addLast(RexxObject *value); void addFirst(RexxObject *value); Modified: interpreter-3.x/trunk/kernel/classes/QueueClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/QueueClass.cpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/classes/QueueClass.cpp 2007-04-14 18:58:25 UTC (rev 281) @@ -261,7 +261,37 @@ } +/** + * Return the index of the first item with a matching value + * in the list. Returns .nil if the object is not found. + * + * @param target The target object. + * + * @return The index of the item, or .nil. + */ +RexxObject *RexxQueue::index(RexxObject *target) +{ + // we require the index to be there. + required_arg(target, ONE); + // ok, now run the list looking for the target item + long next = this->first; + for (long i = 1; i <= this->count; i++) + { + LISTENTRY *element = ENTRY_POINTER(next); + // if we got a match, return the item + if (target->equalValue(element->value)) + { + // queue indices are positional. + return new_integer(i); + } + next = element->next; + } + // no match + return TheNilObject; +} + + RexxObject *RexxQueue::newRexx(RexxObject **init_args, size_t argCount) /******************************************************************************/ /* Function: Create an instance of a queue */ Modified: interpreter-3.x/trunk/kernel/classes/QueueClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/QueueClass.hpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/classes/QueueClass.hpp 2007-04-14 18:58:25 UTC (rev 281) @@ -67,6 +67,7 @@ RexxQueue *ofRexx(RexxObject **, size_t); RexxObject *append(RexxObject *); RexxArray *allIndexes(); + RexxObject *index(RexxObject *); inline RexxObject *pop() { return this->removeFirst();}; inline void push(RexxObject *obj) { this->addFirst(obj);}; Modified: interpreter-3.x/trunk/kernel/classes/RelationClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/RelationClass.cpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/classes/RelationClass.cpp 2007-04-14 18:58:25 UTC (rev 281) @@ -133,9 +133,15 @@ /* Function: Remove an item from a relation using an index */ /******************************************************************************/ { - required_arg(value, ONE); /* make sure we have a value */ - required_arg(index, TWO); /* and the index */ - return this->contents->hasItem(value, index); + required_arg(value, ONE); /* make sure we have a value */ + if (index == OREF_NULL) // just an item search + { + return this->contents->hasItem(value); + } + else // tuple search + { + return this->contents->hasItem(value, index); + } } RexxObject *RexxRelation::allIndex( @@ -160,22 +166,7 @@ return this->contents->allIndex(index); } -RexxObject *RexxRelation::getIndex( - RexxObject *index) /* index to get */ -/******************************************************************************/ -/* Function: return all value with the same index */ -/******************************************************************************/ -{ - RexxObject *result; /* returned result */ - required_arg(index, ONE); /* make sure we have an index */ - /* just get from the hash table */ - result = this->contents->getIndex(index); - if (result == OREF_NULL) /* nothing found? */ - result = TheNilObject; /* just return a nil */ - return result; -} - RexxObject *RexxRelation::put( RexxObject *value, /* new value to add */ RexxObject *index) /* index for insertion */ Modified: interpreter-3.x/trunk/kernel/classes/RelationClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/RelationClass.hpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/classes/RelationClass.hpp 2007-04-14 18:58:25 UTC (rev 281) @@ -58,7 +58,6 @@ RexxObject *hasItem(RexxObject *, RexxObject *); RexxObject *allAt(RexxObject *); RexxObject *allIndex(RexxObject *); - RexxObject *getIndex(RexxObject *); RexxObject *itemsRexx(RexxObject *); RexxSupplier *supplier(RexxObject *); RexxObject *removeItem(RexxObject *, RexxObject *); Modified: interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.cpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/instructions/UseStrictInstruction.cpp 2007-04-14 18:58:25 UTC (rev 281) @@ -195,7 +195,7 @@ } else { - RexxObject *defaultValue = variables[i].defaultValue; + RexxObject *defaultValue = variables[i].defaultValue->evaluate(context, stack); // and omitted argument is only value if we've marked it as optional // by giving it a default value @@ -225,7 +225,6 @@ report_exception2(Error_Incorrect_call_noarg, context->getCallname(), new_integer(i + 1)); } } - } } } Modified: interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp 2007-04-14 18:58:25 UTC (rev 281) @@ -301,6 +301,45 @@ return (value != OREF_NULL) ? (RexxObject *)TheTrueObject : (RexxObject *)TheFalseObject; } + +/** + * Retrieve an index for a given item. Which index is returned + * is indeterminate. + * + * @param target The target object. + * + * @return The index for the target object, or .nil if no object was + * found. + */ +RexxObject *RexxHashTableCollection::indexRexx(RexxObject *target) +{ + // required argument + required_arg(target, ONE); + // retrieve this from the hash table + RexxObject *result = this->contents->getIndex(target); + // not found, return .nil + if (result == OREF_NULL) + { + return TheNilObject; + } + return result; +} + + +/** + * Test if a given item exists in the collection. + * + * @param target The target object. + * + * @return .true if the object exists, .false otherwise. + */ +RexxObject *RexxHashTableCollection::hasItem(RexxObject *target) +{ + required_arg(target, ONE); + return this->contents->hasItem(target); +} + + RexxSupplier *RexxHashTableCollection::supplier() /******************************************************************************/ /* Function: create a table supplier */ Modified: interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp 2007-04-14 18:58:25 UTC (rev 281) @@ -64,7 +64,9 @@ RexxObject *put(RexxObject *, RexxObject *); RexxObject *add(RexxObject *, RexxObject *); RexxObject *allAt(RexxObject *); + RexxObject *hasItem(RexxObject *); RexxObject *hasIndex(RexxObject *); + RexxObject *indexRexx(RexxObject * value); RexxSupplier *supplier(); RexxObject *merge(RexxHashTableCollection *); RexxArray *allItems(); Modified: interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp 2007-04-14 18:58:25 UTC (rev 281) @@ -546,6 +546,38 @@ return (RexxObject *)TheFalseObject; /* item was not found */ } + +/** + * Test if an item exists in the hash collection. + * + * @param value The test value. + * + * @return .true if it exists, .false otherwise. + */ +RexxObject *RexxHashTable::hasItem(RexxObject *value) +{ + // our size + size_t size = this->totalSlotsSize(); + + TABENTRY *ep = this->entries; + TABENTRY *endp = ep + size; + /* loop through all of the entries */ + for (; ep < endp; ep++) + { + // if we have an item, see if it's the one we're looking for. + if (ep->index != OREF_NULL) + { + if (EQUAL_VALUE(value, ep->value)) + { + return TheTrueObject; // return the index value + + } + } + } + return TheFalseObject; +} + + RexxObject *RexxHashTable::nextItem( RexxObject *value, /* item to locate */ RexxObject *index ) /* index to locate */ Modified: interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp 2007-04-14 18:58:25 UTC (rev 281) @@ -108,6 +108,7 @@ RexxArray *stringGetAll(RexxString *key); RexxObject *stringMerge(RexxHashTable *target); RexxObject *hasItem(RexxObject * value, RexxObject *key); + RexxObject *hasItem(RexxObject * value); void reMerge(RexxHashTable *target); void primitiveMerge(RexxHashTable *target); RexxHashTable *insert(RexxObject *value, RexxObject *index, HashLink position, LONG type); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 16:22:38 UTC (rev 280) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 18:58:25 UTC (rev 281) @@ -184,6 +184,8 @@ CPPMA(RexxDirectory::allItems), CPPMA(RexxDirectory::empty), CPPMA(RexxDirectory::isEmpty), +CPPMA(RexxDirectory::indexRexx), +CPPMA(RexxDirectory::hasItem), CPPMD(RexxDirectory::newRexx), @@ -240,6 +242,8 @@ CPPML(RexxList::allItems), CPPMA(RexxList::empty), CPPMA(RexxList::isEmpty), +CPPMA(RexxList::index), +CPPMA(RexxList::hasItem), CPPMLC(RexxListClass::newRexx), CPPMLC(RexxListClass::classOf), @@ -314,6 +318,7 @@ CPPMQ(RexxQueue::remove), CPPML(RexxQueue::append), CPPML(RexxQueue::allIndexes), +CPPML(RexxQueue::index), CPPMQ(RexxQueue::newRexx), CPPMQ(RexxQueue::ofRexx), @@ -450,45 +455,6 @@ CPPMMUTB(RexxMutableBuffer::setBufferSize), CPPMMUTB(RexxMutableBuffer::uninitMB), -CPPMSOM(RexxSOMProxy::operator_equal), - /* SOMProxy Operator methods.... */ -CPPMSOM(RexxSOMProxy::operator_plusRexx), -CPPMSOM(RexxSOMProxy::operator_minusRexx), -CPPMSOM(RexxSOMProxy::operator_multiplyRexx), -CPPMSOM(RexxSOMProxy::operator_divideRexx), -CPPMSOM(RexxSOMProxy::operator_integerDivideRexx), -CPPMSOM(RexxSOMProxy::operator_remainderRexx), -CPPMSOM(RexxSOMProxy::operator_powerRexx), -CPPMSOM(RexxSOMProxy::operator_abuttalRexx), -CPPMSOM(RexxSOMProxy::operator_concatRexx), -CPPMSOM(RexxSOMProxy::operator_concatBlankRexx), -CPPMSOM(RexxSOMProxy::operator_equalRexx), -CPPMSOM(RexxSOMProxy::operator_notEqualRexx), -CPPMSOM(RexxSOMProxy::operator_isGreaterThanRexx), -CPPMSOM(RexxSOMProxy::operator_isBackslashGreaterThanRexx), -CPPMSOM(RexxSOMProxy::operator_isLessThanRexx), -CPPMSOM(RexxSOMProxy::operator_isBackslashLessThanRexx), -CPPMSOM(RexxSOMProxy::operator_isGreaterOrEqualRexx), -CPPMSOM(RexxSOMProxy::operator_isLessOrEqualRexx), -CPPMSOM(RexxSOMProxy::operator_strictEqualRexx), -CPPMSOM(RexxSOMProxy::operator_strictNotEqualRexx), -CPPMSOM(RexxSOMProxy::operator_strictGreaterThanRexx), -CPPMSOM(RexxSOMProxy::operator_strictBackslashGreaterThanRexx), -CPPMSOM(RexxSOMProxy::operator_strictLessThanRexx), -CPPMSOM(RexxSOMProxy::operator_strictBackslashLessThanRexx), -CPPMSOM(RexxSOMProxy::operator_strictGreaterOrEqualRexx), -CPPMSOM(RexxSOMProxy::operator_strictLessOrEqualRexx), -CPPMSOM(RexxSOMProxy::operator_lessThanGreaterThanRexx), -CPPMSOM(RexxSOMProxy::operator_greaterThanLessThanRexx), -CPPMSOM(RexxSOMProxy::operator_andRexx), -CPPMSOM(RexxSOMProxy::operator_orRexx), -CPPMSOM(RexxSOMProxy::operator_xorRexx), -CPPMSOM(RexxSOMProxy::operator_notRexx), - -CPPMSOMCL(RexxSOMProxyClass::newRexx), -CPPMSOMCL(RexxSOMProxyClass::init), -CPPMSOMCL(RexxSOMProxyClass::somdNew), - CPPMSUP(RexxSupplier::available), /* Supplier methods */ CPPMSUP(RexxSupplier::next), CPPMSUP(RexxSupplier::value), @@ -503,23 +469,24 @@ CPPMHC(RexxHashTableCollection::add), CPPMHC(RexxHashTableCollection::allAt), CPPMHC(RexxHashTableCollection::hasIndex), -CPPMTBL(RexxTable::itemsRexx), CPPMHC(RexxHashTableCollection::merge), CPPMHC(RexxHashTableCollection::supplier), CPPMHC(RexxHashTableCollection::allItems), CPPMHC(RexxHashTableCollection::allIndexes), CPPMHC(RexxHashTableCollection::empty), CPPMHC(RexxHashTableCollection::isEmpty), +CPPMHC(RexxHashTableCollection::indexRexx), +CPPMHC(RexxHashTableCollection::hasItem), +CPPMTBL(RexxTable::itemsRexx), CPPMTBL(RexxTable::newRexx), CPPMREL(RexxRelation::put), /* Relation methods */ CPPMREL(RexxRelation::removeItemRexx), -CPPMREL(RexxRelation::hasItem), CPPMREL(RexxRelation::allIndex), -CPPMREL(RexxRelation::getIndex), CPPMREL(RexxRelation::itemsRexx), CPPMREL(RexxRelation::supplier), +CPPMREL(RexxRelation::hasItem), CPPMREL(RexxRelation::newRexx), @@ -907,7 +874,9 @@ defineProtectedKernelMethod(CHAR_SETMETHOD , TheDirectoryBehaviour, CPPMD(RexxDirectory::setMethod), 2); defineKernelMethod(CHAR_SUPPLIER , TheDirectoryBehaviour, CPPMD(RexxDirectory::supplier), 0); defineKernelMethod(CHAR_UNKNOWN , TheDirectoryBehaviour, CPPM(RexxObject::unknownRexx), 2); - defineProtectedKernelMethod(CHAR_UNSETMETHOD , TheDirectoryBehaviour, CPPMD(RexxDirectory::remove), 1); // ENG004M + defineProtectedKernelMethod(CHAR_UNSETMETHOD , TheDirectoryBehaviour, CPPMD(RexxDirectory::remove), 1); + defineKernelMethod(CHAR_INDEX , TheDirectoryBehaviour, CPPMD(RexxDirectory::indexRexx), 1); + defineKernelMethod(CHAR_HASITEM , TheDirectoryBehaviour, CPPMD(RexxDirectory::hasItem), 1); /* set the scope of the methods to */ /* this classes oref */ @@ -970,6 +939,8 @@ defineKernelMethod(CHAR_ALLINDEXES ,TheListBehaviour, CPPML(RexxList::allIndexes), 0); defineKernelMethod(CHAR_EMPTY ,TheListBehaviour, CPPML(RexxList::empty), 0); defineKernelMethod(CHAR_ISEMPTY ,TheListBehaviour, CPPML(RexxList::isEmpty), 0); + defineKernelMethod(CHAR_INDEX ,TheListBehaviour, CPPML(RexxList::index), 1); + defineKernelMethod(CHAR_HASITEM ,TheListBehaviour, CPPML(RexxList::hasItem), 1); /* set the scope of the methods to */ /* this classes oref */ TheListBehaviour->setMethodDictionaryScope(TheListClass); @@ -1076,6 +1047,8 @@ defineKernelMethod(CHAR_ALLINDEXES ,TheQueueBehaviour, CPPMQ(RexxQueue::allIndexes), 0); defineKernelMethod(CHAR_EMPTY ,TheQueueBehaviour, CPPMQ(RexxList::empty), 0); defineKernelMethod(CHAR_ISEMPTY ,TheQueueBehaviour, CPPMQ(RexxList::isEmpty), 0); + defineKernelMethod(CHAR_INDEX ,TheQueueBehaviour, CPPML(RexxQueue::index), 1); + defineKernelMethod(CHAR_HASITEM ,TheQueueBehaviour, CPPML(RexxList::hasItem), 1); /* set the scope of the methods to */ /* this classes oref */ @@ -1107,7 +1080,7 @@ defineKernelMethod(CHAR_AT , TheRelationBehaviour, CPPMHC(RexxHashTableCollection::getRexx), 1); defineKernelMethod(CHAR_HASINDEX , TheRelationBehaviour, CPPMHC(RexxHashTableCollection::hasIndex), 1); defineKernelMethod(CHAR_HASITEM , TheRelationBehaviour, CPPMREL(RexxRelation::hasItem), 2); - defineKernelMethod(CHAR_INDEX , TheRelationBehaviour, CPPMREL(RexxRelation::getIndex), 1); + defineKernelMethod(CHAR_INDEX , TheRelationBehaviour, CPPMREL(RexxHashTableCollection::indexRexx), 1); defineKernelMethod(CHAR_ITEMS , TheRelationBehaviour, CPPMREL(RexxRelation::itemsRexx), 1); defineKernelMethod(CHAR_PUT , TheRelationBehaviour, CPPMREL(RexxRelation::put), 2); defineKernelMethod(CHAR_REMOVE , TheRelationBehaviour, CPPMHC(RexxHashTableCollection::removeRexx), 1); @@ -1497,6 +1470,8 @@ defineKernelMethod(CHAR_ALLINDEXES , TheTableBehaviour, CPPMHC(RexxHashTableCollection::allIndexes), 0); defineKernelMethod(CHAR_EMPTY , TheTableBehaviour, CPPMHC(RexxHashTableCollection::empty), 0); defineKernelMethod(CHAR_ISEMPTY , TheTableBehaviour, CPPMHC(RexxHashTableCollection::isEmpty), 0); + defineKernelMethod(CHAR_INDEX , TheTableBehaviour, CPPMHC(RexxHashTableCollection::indexRexx), 1); + defineKernelMethod(CHAR_HASITEM , TheTableBehaviour, CPPMHC(RexxHashTableCollection::hasItem), 1); /* set the scope of the methods to */ /* this classes oref */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-14 23:37:51
|
Revision: 283 http://svn.sourceforge.net/oorexx/?rev=283&view=rev Author: bigrixx Date: 2007-04-14 16:37:51 -0700 (Sat, 14 Apr 2007) Log Message: ----------- [ 1700734 ] Make the stem class a map collection. Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/StemClass.cpp interpreter-3.x/trunk/kernel/classes/StemClass.hpp interpreter-3.x/trunk/kernel/runtime/RexxCompoundElement.hpp interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.cpp interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/StemClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StemClass.cpp 2007-04-14 21:51:01 UTC (rev 282) +++ interpreter-3.x/trunk/kernel/classes/StemClass.cpp 2007-04-14 23:37:51 UTC (rev 283) @@ -186,17 +186,125 @@ /* with all of the indices taken as constants */ /******************************************************************************/ { - RexxObject * value; /* element value */ - if (argCount == 0) /* default value request? */ return this->value; /* just return the default value */ /* create a searchable tail from the array elements */ RexxCompoundTail resolved_tail(tails, argCount); /* now look up this element */ - value = evaluateCompoundVariableValue(OREF_NULL, &resolved_tail); - return value; /* return variable value */ + return evaluateCompoundVariableValue(OREF_NULL, &resolved_tail); } + +/** + * Test if this compound variable has a given index. + * + * @param tails The set of tail expressions. + * @param argCount The argument count + * + * @return True if the fully resolved tail exists in the stem, false + * otherwise. + */ +RexxObject *RexxStem::hasIndex(RexxObject **tails, size_t argCount) +{ + if (argCount == 0) + { + return TheTrueObject; // we always have something here + } + // compose the tail element + RexxCompoundTail resolved_tail(tails, argCount); + // see if we have a compound + RexxCompoundElement *compound = findCompoundVariable(&resolved_tail); + // if there's a variable there, and it has a real value, then + // this is true. + if (compound != OREF_NULL && compound->getVariableValue() != OREF_NULL) + { + return TheTrueObject; + } + // nope, we got nuttin' + return TheFalseObject; +} + + +/** + * Remove an item from the collection. This is essentially + * equivalent to a drop operation on the stem variable. + * + * @param tails The set of tail indexes. + * @param argCount The number of indexes. + * + * @return The removed object. If nothing was removed, this returns + * .nil. + */ +RexxObject *RexxStem::remove(RexxObject **tails, size_t argCount) +{ + // if asked to remove the default value, reset this back to the name + if (argCount == 0) + { + // replace with the name and return the old value. + RexxObject *oldValue = this->value; + OrefSet(this, value, getName()); + return oldValue; + } + + // compose the tail element + RexxCompoundTail resolved_tail(tails, argCount); + RexxCompoundElement *compound = findCompoundVariable(&resolved_tail); + // if there's a variable there, and it has a real value, then + // we have something to remove + if (compound != OREF_NULL && compound->getVariableValue() != OREF_NULL) + { + // get the value, which is the return value, and drop the variable. + RexxObject *oldValue = compound->getVariableValue(); + compound->drop(); + return oldValue; + } + return TheNilObject; // nothing dropped. +} + + +/** + * Search for any index that matches the target object. + * + * @param target The object of interest. + * + * @return .true if the object is in the collection, .false otherwise. + */ +RexxObject *RexxStem::hasItem(RexxObject *target) +{ + RexxCompoundElement *variable = findByValue(target); + return variable == OREF_NULL ? TheFalseObject : TheTrueObject; +} + + +/** + * Return the index for a target item. + * + * @param target The target object. + * + * @return The tail name for the match, or .nil if it was not found. + */ +RexxObject *RexxStem::index(RexxObject *target) +{ + RexxCompoundElement *variable = findByValue(target); + if (variable != OREF_NULL) + { + return variable->getName(); + } + return TheNilObject; +} + +/** + * Return the number of items set in the collection. + * + * @return The count of items in the collection, not counting the + * default value. + */ +RexxObject *RexxStem::itemsRexx() +{ + return new_integer(items()); +} + + RexxObject *RexxStem::bracketEqual( RexxObject **tails, /* tail elements */ size_t argCount) /* number of tail elements */ @@ -655,6 +763,28 @@ /** + * Locate a stem item by value. + * + * @return The compound item for the located element. + */ +RexxCompoundElement *RexxStem::findByValue(RexxObject *target) +{ + RexxCompoundElement *variable = tails.first(); + while (variable != OREF_NULL) + { + RexxObject *value = variable->getVariableValue(); + // if this has a value, and we have a match, then return it + if (value != OREF_NULL && target->equalValue(value)) + { + return variable; + } + variable = tails.next(variable); + } + return OREF_NULL; // not here, oh dear +} + + +/** * Get the count of non-dropped items in the stem. * * @return The number of non-dropped items. Modified: interpreter-3.x/trunk/kernel/classes/StemClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StemClass.hpp 2007-04-14 21:51:01 UTC (rev 282) +++ interpreter-3.x/trunk/kernel/classes/StemClass.hpp 2007-04-14 23:37:51 UTC (rev 283) @@ -88,6 +88,14 @@ RexxObject *unknown (RexxString *, RexxArray *); RexxObject *bracket (RexxObject **, size_t); RexxObject *bracketEqual(RexxObject **, size_t); + + RexxObject *hasIndex(RexxObject **, size_t); + RexxObject *remove(RexxObject **, size_t); + RexxObject *hasItem(RexxObject *); + RexxObject *index(RexxObject *); + RexxObject *itemsRexx(); + + RexxString *tail(RexxArray *, long); RexxObject *newRexx(RexxObject **, size_t); RexxObject *evaluateCompoundVariableValue(RexxActivation *context, RexxCompoundTail *resolved_tail); @@ -96,6 +104,7 @@ RexxCompoundElement *getCompoundVariable(RexxCompoundTail *name); RexxCompoundElement *exposeCompoundVariable(RexxCompoundTail *name); RexxCompoundElement *findCompoundVariable(RexxCompoundTail *name); + RexxCompoundElement *findByValue(RexxObject *target); void dropCompoundVariable(RexxCompoundTail *name); void setCompoundVariable(RexxCompoundTail *name, RexxObject *value); void setValue(RexxObject *value); Modified: interpreter-3.x/trunk/kernel/runtime/RexxCompoundElement.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCompoundElement.hpp 2007-04-14 21:51:01 UTC (rev 282) +++ interpreter-3.x/trunk/kernel/runtime/RexxCompoundElement.hpp 2007-04-14 23:37:51 UTC (rev 283) @@ -67,7 +67,6 @@ RexxCompoundElement *left; /* the left child */ RexxCompoundElement *right; /* the right child */ RexxCompoundElement *parent; /* the parent entry to this node */ - RexxString *tail_name; /* the node name (tail part only) */ unsigned short leftdepth; /* depth on the left side */ unsigned short rightdepth; /* depth on the right side */ RexxCompoundElement *real_element; /* a potential expose indirection */ Modified: interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.cpp 2007-04-14 21:51:01 UTC (rev 282) +++ interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.cpp 2007-04-14 23:37:51 UTC (rev 283) @@ -45,28 +45,6 @@ #include "RexxCompoundTable.hpp" #include "RexxCompoundElement.hpp" -void RexxCompoundTable::dump() -{ - fprintf(stderr,"-------- dumping %p\n",root); - dump(root); - fprintf(stderr,"-------------------------\n"); -} - -void RexxCompoundTable::dump(RexxCompoundElement *current) -{ - RexxCompoundElement *left, *right; - if (current == OREF_NULL) return; - left = current->left; - right = current->right; - if (left == OREF_NULL && right == OREF_NULL) { - fprintf(stderr,"%p a leaf, p %p (%s)\n",current,current->parent,current->tail_name->stringData); - } else { - fprintf(stderr,"%p a node, l %p r %p p %p (%s)\n",current,left,right,current->parent,current->tail_name->stringData); - dump(left); - dump(right); - } -} - void RexxCompoundTable::init( RexxStem *parent) /* the parent object we're embedded in */ { Modified: interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.hpp 2007-04-14 21:51:01 UTC (rev 282) +++ interpreter-3.x/trunk/kernel/runtime/RexxCompoundTable.hpp 2007-04-14 23:37:51 UTC (rev 283) @@ -70,8 +70,6 @@ void copy(RexxStem *newObject, RexxStem *oldObject); void init(RexxStem *parent); void clear(); - void dump(); - void dump(RexxCompoundElement*); inline RexxCompoundElement *get(RexxCompoundTail *name) { return findEntry(name); } RexxCompoundElement *findEntry(RexxCompoundTail *tail) /******************************************************************************/ Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 21:51:01 UTC (rev 282) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 23:37:51 UTC (rev 283) @@ -331,6 +331,11 @@ CPPMSTEM(RexxStem::allItems), CPPMSTEM(RexxStem::empty), CPPMSTEM(RexxStem::isEmpty), +CPPMSTEM(RexxStem::itemsRexx), +CPPMSTEM(RexxStem::hasIndex), +CPPMSTEM(RexxStem::remove), +CPPMSTEM(RexxStem::index), +CPPMSTEM(RexxStem::hasItem), CPPMSTEM(RexxStem::newRexx), @@ -1114,6 +1119,8 @@ /* instance behaviour mdict */ defineKernelMethod(CHAR_BRACKETS ,TheStemBehaviour, CPPMSTEM(RexxStem::bracket), A_COUNT); defineKernelMethod(CHAR_BRACKETSEQUAL ,TheStemBehaviour, CPPMSTEM(RexxStem::bracketEqual), A_COUNT); + defineKernelMethod(CHAR_AT ,TheStemBehaviour, CPPMSTEM(RexxStem::bracket), A_COUNT); + defineKernelMethod(CHAR_PUT ,TheStemBehaviour, CPPMSTEM(RexxStem::bracketEqual), A_COUNT); defineKernelMethod(CHAR_MAKEARRAY ,TheStemBehaviour, CPPM(RexxObject::makeArrayRexx), 0); defineKernelMethod(CHAR_REQUEST ,TheStemBehaviour, CPPMSTEM(RexxStem::request), 1); defineKernelMethod(CHAR_SUPPLIER ,TheStemBehaviour, CPPMSTEM(RexxStem::supplier), 0); @@ -1123,6 +1130,12 @@ defineKernelMethod(CHAR_ISEMPTY ,TheStemBehaviour, CPPMSTEM(RexxStem::isEmpty), 0); defineKernelMethod(CHAR_UNKNOWN ,TheStemBehaviour, CPPM(RexxObject::unknownRexx), 2); + defineKernelMethod(CHAR_ITEMS ,TheStemBehaviour, CPPMSTEM(RexxStem::itemsRexx), 0); + defineKernelMethod(CHAR_HASINDEX ,TheStemBehaviour, CPPMSTEM(RexxStem::hasIndex), A_COUNT); + defineKernelMethod(CHAR_REMOVE ,TheStemBehaviour, CPPMSTEM(RexxStem::remove), A_COUNT); + defineKernelMethod(CHAR_INDEX ,TheStemBehaviour, CPPMSTEM(RexxStem::index), 1); + defineKernelMethod(CHAR_HASITEM ,TheStemBehaviour, CPPMSTEM(RexxStem::hasItem), 1); + /* set the scope of the methods to */ /* this classes oref */ TheStemBehaviour->setMethodDictionaryScope(TheStemClass); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-15 01:09:14
|
Revision: 284 http://svn.sourceforge.net/oorexx/?rev=284&view=rev Author: bigrixx Date: 2007-04-14 18:09:15 -0700 (Sat, 14 Apr 2007) Log Message: ----------- [ 1700828 ] add a removeItem method to collection classes. Modified Paths: -------------- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp interpreter-3.x/trunk/kernel/classes/ListClass.cpp interpreter-3.x/trunk/kernel/classes/ListClass.hpp interpreter-3.x/trunk/kernel/classes/RelationClass.cpp interpreter-3.x/trunk/kernel/classes/StemClass.cpp interpreter-3.x/trunk/kernel/classes/StemClass.hpp interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-04-15 01:09:15 UTC (rev 284) @@ -137,6 +137,15 @@ signal on nomethod /* trap unknown method calls */ +-- the merge operation differs for mapcollections vs. more item-oriented +-- collections like set or array. For map collections, we determine membership +-- based on index value. For other collections, it is determined by +-- item value. +if other~isa(.setcollection) | other~isa(.orderedcollection) then do + do item over other~allitems -- we use the items only + end +end + new = self~copy /* make a new collection */ do index over other /* loop over the other collection */ new~remove(index) /* "subtract" this item */ Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-04-15 01:09:15 UTC (rev 284) @@ -1475,6 +1475,31 @@ /** + * Remove the target object from the collection. + * + * @param target The target object. + * + * @return The removed object (same as target). + */ +RexxObject *RexxArray::removeItem(RexxObject *target) +{ + // we require the index to be there. + required_arg(target, ONE); + // see if we have this item. If not, then + // we return .nil. + arraysize_t index = findSingleIndexItem(target); + + if (index == 0) + { + return TheNilObject; + } + // remove the item at the location + OrefSet(this, objects[index - 1], OREF_NULL); + return target; +} + + +/** * Test if an item is within the array. * * @param target The target test item. Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-04-15 01:09:15 UTC (rev 284) @@ -140,6 +140,7 @@ RexxObject *isEmpty(); RexxObject *index(RexxObject *); RexxObject *hasItem(RexxObject *); + RexxObject *removeItem(RexxObject *); inline void addLast(RexxObject *item) { this->insertItem(item, this->size() + 1); } inline void addFirst(RexxObject *item) { this->insertItem(item, 1); } Modified: interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/DirectoryClass.cpp 2007-04-15 01:09:15 UTC (rev 284) @@ -706,6 +706,27 @@ return indexRexx(target) != TheNilObject ? TheTrueObject : TheFalseObject; } + +/** + * Remove a given item from the collection. + * + * @param target The target object. + * + * @return .true if the object exists, .false otherwise. + */ +RexxObject *RexxDirectory::removeItem(RexxObject *target) +{ + required_arg(target, ONE); + // the lookup is more complicated, so just delegate to the index lookup code. + RexxObject *index = indexRexx(target); + // just use the retrieved index to remove. + if (index != TheNilObject) + { + return remove((RexxString *)index); + } + return TheNilObject; // nothing removed. +} + RexxObject *RexxDirectory::newRexx( RexxObject **init_args, size_t argCount) Modified: interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/DirectoryClass.hpp 2007-04-15 01:09:15 UTC (rev 284) @@ -82,6 +82,7 @@ RexxObject *isEmpty(); RexxObject *indexRexx(RexxObject *); RexxObject *hasItem(RexxObject *); + RexxObject *removeItem(RexxObject *); RexxObject *newRexx(RexxObject **init_args, size_t); Modified: interpreter-3.x/trunk/kernel/classes/ListClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ListClass.cpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/ListClass.cpp 2007-04-15 01:09:15 UTC (rev 284) @@ -846,6 +846,36 @@ } +/** + * Removes an item from the collection. + * + * @param target The target value. + * + * @return The target item. + */ +RexxObject *RexxList::removeItem(RexxObject *target) +{ + // we require the index to be there. + required_arg(target, ONE); + + // ok, now run the list looking for the target item + long next = this->first; + for (long i = 1; i <= this->count; i++) + { + LISTENTRY *element = ENTRY_POINTER(next); + // if we got a match, return the item + if (target->equalValue(element->value)) + { + // remove this item + return primitiveRemove(element); + } + next = element->next; + } + // no match + return TheNilObject; +} + + RexxObject *RexxList::indexOfValue( RexxObject *value) /*****************************************************************************/ Modified: interpreter-3.x/trunk/kernel/classes/ListClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ListClass.hpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/ListClass.hpp 2007-04-15 01:09:15 UTC (rev 284) @@ -107,6 +107,7 @@ RexxObject *isEmpty(); RexxObject *index(RexxObject *); RexxObject *hasItem(RexxObject *); + RexxObject *removeItem(RexxObject *); void addLast(RexxObject *value); void addFirst(RexxObject *value); Modified: interpreter-3.x/trunk/kernel/classes/RelationClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/RelationClass.cpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/RelationClass.cpp 2007-04-15 01:09:15 UTC (rev 284) @@ -118,9 +118,16 @@ RexxObject *item; /* removed item */ required_arg(value, ONE); /* make sure we have a value */ - required_arg(index, TWO); /* and the index */ - item = this->contents->removeItem(value, index); + // standard remove form? + if (index == OREF_NULL) + { + item = this->contents->removeItem(value); + } + else // multi-item form + { + item = this->contents->removeItem(value, index); + } if (item == OREF_NULL) /* If nothing found, give back .nil */ item = TheNilObject; /* (never return OREF_NULL to REXX) */ return item; /* return removed value */ Modified: interpreter-3.x/trunk/kernel/classes/StemClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StemClass.cpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/StemClass.cpp 2007-04-15 01:09:15 UTC (rev 284) @@ -276,7 +276,31 @@ } + /** + * Remove an item from the collection. + * + * @param target The object of interest. + * + * @return .true if the object is in the collection, .false otherwise. + */ +RexxObject *RexxStem::removeItem(RexxObject *target) +{ + RexxCompoundElement *compound = findByValue(target); + // if there's a variable there, and it has a real value, then + // we have something to remove + if (compound != OREF_NULL && compound->getVariableValue() != OREF_NULL) + { + // get the value, which is the return value, and drop the variable. + RexxObject *oldValue = compound->getVariableValue(); + compound->drop(); + return oldValue; + } + return TheNilObject; // nothing dropped. +} + + +/** * Return the index for a target item. * * @param target The target object. Modified: interpreter-3.x/trunk/kernel/classes/StemClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StemClass.hpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/classes/StemClass.hpp 2007-04-15 01:09:15 UTC (rev 284) @@ -94,6 +94,7 @@ RexxObject *hasItem(RexxObject *); RexxObject *index(RexxObject *); RexxObject *itemsRexx(); + RexxObject *removeItem(RexxObject *); RexxString *tail(RexxArray *, long); Modified: interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp 2007-04-15 01:09:15 UTC (rev 284) @@ -327,6 +327,22 @@ /** + * Remove an item specified by value. + * + * @param target The target object. + * + * @return The target object again. + */ +RexxObject *RexxHashTableCollection::removeItem(RexxObject *target) +{ + // required argument + required_arg(target, ONE); + // the contents handle all of this. + return this->contents->removeItem(target); +} + + +/** * Test if a given item exists in the collection. * * @param target The target object. Modified: interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/runtime/RexxCollection.hpp 2007-04-15 01:09:15 UTC (rev 284) @@ -73,6 +73,7 @@ RexxArray *allIndexes(); RexxObject *empty(); RexxObject *isEmpty(); + RexxObject *removeItem(RexxObject *value); inline long items() { return this->contents->totalEntries(); }; inline long first() { return this->contents->first(); }; Modified: interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp 2007-04-15 01:09:15 UTC (rev 284) @@ -441,6 +441,7 @@ return OREF_NULL; /* removed item not found */ } + RexxObject *RexxHashTable::primitiveRemoveItem( RexxObject *value, /* item to remove */ RexxObject *index ) /* index to remove */ @@ -578,6 +579,38 @@ } +/** + * Removes an item from the hash table. + * + * @param value The test value. + * + * @return .true if it exists, .false otherwise. + */ +RexxObject *RexxHashTable::removeItem(RexxObject *value) +{ + // our size + size_t size = this->totalSlotsSize(); + + TABENTRY *ep = this->entries; + TABENTRY *endp = ep + size; + /* loop through all of the entries */ + for (; ep < endp; ep++) + { + // if we have an item, see if it's the one we're looking for. + if (ep->index != OREF_NULL) + { + if (EQUAL_VALUE(value, ep->value)) + { + // this is complicated, so it's easier to just remove + // this using the fully qualified tuple. + return removeItem(value, ep->index); + } + } + } + return TheNilObject; +} + + RexxObject *RexxHashTable::nextItem( RexxObject *value, /* item to locate */ RexxObject *index ) /* index to locate */ Modified: interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/runtime/RexxHashTable.hpp 2007-04-15 01:09:15 UTC (rev 284) @@ -102,6 +102,7 @@ RexxArray *allItems(); RexxArray *allIndexes(); RexxObject *removeItem(RexxObject *value, RexxObject *key); + RexxObject *removeItem(RexxObject *value); RexxObject *stringGet(RexxString *key); RexxHashTable *stringPut(RexxObject *value, RexxString *key); RexxHashTable *stringAdd(RexxObject *value, RexxString *key); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-14 23:37:51 UTC (rev 283) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-15 01:09:15 UTC (rev 284) @@ -163,6 +163,7 @@ CPPMA(RexxArray::isEmpty), CPPMA(RexxArray::index), CPPMA(RexxArray::hasItem), +CPPMA(RexxArray::removeItem), CPPMA(RexxArray::toString), CPPMC1(RexxArray::newRexx), @@ -186,6 +187,7 @@ CPPMA(RexxDirectory::isEmpty), CPPMA(RexxDirectory::indexRexx), CPPMA(RexxDirectory::hasItem), +CPPMA(RexxDirectory::removeItem), CPPMD(RexxDirectory::newRexx), @@ -244,6 +246,7 @@ CPPMA(RexxList::isEmpty), CPPMA(RexxList::index), CPPMA(RexxList::hasItem), +CPPMA(RexxList::removeItem), CPPMLC(RexxListClass::newRexx), CPPMLC(RexxListClass::classOf), @@ -336,6 +339,7 @@ CPPMSTEM(RexxStem::remove), CPPMSTEM(RexxStem::index), CPPMSTEM(RexxStem::hasItem), +CPPMSTEM(RexxStem::removeItem), CPPMSTEM(RexxStem::newRexx), @@ -482,6 +486,7 @@ CPPMHC(RexxHashTableCollection::isEmpty), CPPMHC(RexxHashTableCollection::indexRexx), CPPMHC(RexxHashTableCollection::hasItem), +CPPMHC(RexxHashTableCollection::removeItem), CPPMTBL(RexxTable::itemsRexx), CPPMTBL(RexxTable::newRexx), @@ -501,9 +506,6 @@ CPPMMEM(RexxMemory::setDump), CPPMMEM(RexxMemory::gutCheck), -CPPMSOMS(RexxSOMServer::initDSom), /* SOM server methods ... */ -CPPMSOMS(RexxSOMServer::initDSomWPS), - CPPMLOC(RexxLocal::local), /* the .local environment methods */ CPPMLOC(RexxLocal::runProgram), CPPMLOC(RexxLocal::callProgram), @@ -513,13 +515,6 @@ CPPMSND(RexxSender::sendMessage), CPPMSRV(RexxServer::messageWait), /* the .server class methods */ - -CPPMSOMDS(RexxSOMDServer::getClassObj), /* the .dsom class methods */ -CPPMSOMDS(RexxSOMDServer::createObj), -CPPMSOMDS(RexxSOMDServer::deleteObj), - /* the .objectMgr methods. */ -CPPMSOMDO(RexxSOMDObjectMgr::enhanceServer), - NULL /* final terminating method */ }; @@ -842,6 +837,7 @@ defineKernelMethod(CHAR_ISEMPTY ,TheArrayBehaviour, CPPMA(RexxArray::isEmpty), 0); defineKernelMethod(CHAR_INDEX ,TheArrayBehaviour, CPPMA(RexxArray::index), 1); defineKernelMethod(CHAR_HASITEM ,TheArrayBehaviour, CPPMA(RexxArray::hasItem), 1); + defineKernelMethod(CHAR_REMOVEITEM ,TheArrayBehaviour, CPPMA(RexxArray::removeItem), 1); /* set the scope of the methods to */ /* this classes oref */ TheArrayBehaviour->setMethodDictionaryScope(TheArrayClass); @@ -881,7 +877,7 @@ defineKernelMethod(CHAR_UNKNOWN , TheDirectoryBehaviour, CPPM(RexxObject::unknownRexx), 2); defineProtectedKernelMethod(CHAR_UNSETMETHOD , TheDirectoryBehaviour, CPPMD(RexxDirectory::remove), 1); defineKernelMethod(CHAR_INDEX , TheDirectoryBehaviour, CPPMD(RexxDirectory::indexRexx), 1); - defineKernelMethod(CHAR_HASITEM , TheDirectoryBehaviour, CPPMD(RexxDirectory::hasItem), 1); + defineKernelMethod(CHAR_REMOVEITEM , TheDirectoryBehaviour, CPPMD(RexxDirectory::removeItem), 1); /* set the scope of the methods to */ /* this classes oref */ @@ -946,6 +942,7 @@ defineKernelMethod(CHAR_ISEMPTY ,TheListBehaviour, CPPML(RexxList::isEmpty), 0); defineKernelMethod(CHAR_INDEX ,TheListBehaviour, CPPML(RexxList::index), 1); defineKernelMethod(CHAR_HASITEM ,TheListBehaviour, CPPML(RexxList::hasItem), 1); + defineKernelMethod(CHAR_REMOVEITEM ,TheListBehaviour, CPPML(RexxList::removeItem), 1); /* set the scope of the methods to */ /* this classes oref */ TheListBehaviour->setMethodDictionaryScope(TheListClass); @@ -1054,6 +1051,7 @@ defineKernelMethod(CHAR_ISEMPTY ,TheQueueBehaviour, CPPMQ(RexxList::isEmpty), 0); defineKernelMethod(CHAR_INDEX ,TheQueueBehaviour, CPPML(RexxQueue::index), 1); defineKernelMethod(CHAR_HASITEM ,TheQueueBehaviour, CPPML(RexxList::hasItem), 1); + defineKernelMethod(CHAR_REMOVEITEM ,TheQueueBehaviour, CPPML(RexxList::removeItem), 1); /* set the scope of the methods to */ /* this classes oref */ @@ -1135,6 +1133,7 @@ defineKernelMethod(CHAR_REMOVE ,TheStemBehaviour, CPPMSTEM(RexxStem::remove), A_COUNT); defineKernelMethod(CHAR_INDEX ,TheStemBehaviour, CPPMSTEM(RexxStem::index), 1); defineKernelMethod(CHAR_HASITEM ,TheStemBehaviour, CPPMSTEM(RexxStem::hasItem), 1); + defineKernelMethod(CHAR_REMOVEITEM ,TheStemBehaviour, CPPMSTEM(RexxStem::removeItem), 1); /* set the scope of the methods to */ /* this classes oref */ @@ -1485,6 +1484,7 @@ defineKernelMethod(CHAR_ISEMPTY , TheTableBehaviour, CPPMHC(RexxHashTableCollection::isEmpty), 0); defineKernelMethod(CHAR_INDEX , TheTableBehaviour, CPPMHC(RexxHashTableCollection::indexRexx), 1); defineKernelMethod(CHAR_HASITEM , TheTableBehaviour, CPPMHC(RexxHashTableCollection::hasItem), 1); + defineKernelMethod(CHAR_REMOVEITEM , TheTableBehaviour, CPPMHC(RexxHashTableCollection::removeItem), 1); /* set the scope of the methods to */ /* this classes oref */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-04-15 17:44:57
|
Revision: 294 http://svn.sourceforge.net/oorexx/?rev=294&view=rev Author: bigrixx Date: 2007-04-15 10:44:58 -0700 (Sun, 15 Apr 2007) Log Message: ----------- Autogenerate the error messages documentation. Modified Paths: -------------- interpreter-3.x/trunk/kernel/kernel.mak Added Paths: ----------- interpreter-3.x/trunk/kernel/messages/DocErrorMessages.sgml Modified: interpreter-3.x/trunk/kernel/kernel.mak =================================================================== --- interpreter-3.x/trunk/kernel/kernel.mak 2007-04-15 17:10:03 UTC (rev 293) +++ interpreter-3.x/trunk/kernel/kernel.mak 2007-04-15 17:44:58 UTC (rev 294) @@ -285,13 +285,6 @@ # Update the Windows Message Table resource if necessary -!IFDEF JAPANESE -$(OR_OUTDIR)\winmsgjp.res: $(OR_ORYXKSRC)\winmsgtb.jap - @ECHO . - @ECHO ResourceCompiling winmsgjp.res - $(rc) $(rcflags_common) -r -c932 -fo$(@) $(**) -!ENDIF - $(KWINDOWS)\winmsgtb.rc: $(KWINDOWS)\WinMessageResource.xsl $(KMESSAGES)\rexxmsg.xml @ECHO . @ECHO Generating $(@) @@ -302,6 +295,11 @@ @ECHO Generating $(@) xalan -o $(@) $(KMESSAGES)\rexxmsg.xml $(KMESSAGES)\RexxErrorCodes.xsl +$(KMESSAGES)\DocErrorMessages.sgml: $(KMESSAGES)\DocBookErrors.xsl $(KMESSAGES)\rexxmsg.xml + @ECHO . + @ECHO Generating $(@) + xalan -o $(@) $(KMESSAGES)\rexxmsg.xml $(KMESSAGES)\DocBookErrors.xsl + $(KMESSAGES)\RexxMessageNumbers.h: $(KMESSAGES)\RexxMessageNumbers.xsl $(KMESSAGES)\rexxmsg.xml @ECHO . @ECHO Generating $(@) @@ -312,10 +310,10 @@ @ECHO Generating $(@) xalan -o $(@) $(KMESSAGES)\rexxmsg.xml $(KMESSAGES)\RexxMessageTable.xsl -$(OR_OUTDIR)\winmsgtb.res: $(KWINDOWS)\winmsgtb.rc +$(OR_OUTDIR)\winmsgtb.res: $(KWINDOWS)\winmsgtb.rc $(KMESSAGES)\DocErrorMessages.sgml @ECHO . @ECHO ResourceCompiling $(@) - $(rc) $(rcflags_common) $(OR_ORYXRCINCL) -r -fo$(@) $(**) + $(rc) $(rcflags_common) $(OR_ORYXRCINCL) -r -fo$(@) $(KWINDOWS)\winmsgtb.rc # Update the version information block $(OR_OUTDIR)\verinfo.res: $(KWINDOWS)\verinfo.rc Added: interpreter-3.x/trunk/kernel/messages/DocErrorMessages.sgml =================================================================== --- interpreter-3.x/trunk/kernel/messages/DocErrorMessages.sgml (rev 0) +++ interpreter-3.x/trunk/kernel/messages/DocErrorMessages.sgml 2007-04-15 17:44:58 UTC (rev 294) @@ -0,0 +1,3707 @@ +<section id="errorlist"> +<title>Error List</title> +<section id="ERR3"> +<title>Error 3 - Failure during initialization</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>The REXX program could not be read from the disk.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Failure during initialization: File "<emphasis>filename</emphasis>" is unreadable</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Failure during initialization: Program "<emphasis>program</emphasis>" was not found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Error writing output file "<emphasis>file</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>Program "<emphasis>program_name</emphasis>" cannot be run by this version of the REXX interpreter</para> +</listitem> +</varlistentry> +<varlistentry> +<term>904</term> +<listitem> +<para>Failure during initialization: Program "<emphasis>program</emphasis>" needs to be tokenized. To run untokenized scripts you need a full version of Object REXX.</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR4"> +<title>Error 4 - Program interrupted</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>The system interrupted the execution of your program because of an error or a user request.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Program interrupted with <emphasis>condition</emphasis> condition</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR5"> +<title>Error 5 - System resources exhausted</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>While trying to execute a program, the language processor was unable to get the resources it needed to continue. For example, it could not get the space needed for its work areas or variables. The program that called the language processor might itself have already used up most of the available storage. Or a request for storage might have been for more than the implementation maximum.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR6"> +<title>Error 6 - Unmatched "/*" or quote</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A comment or literal string was started but never finished. This could be because the language processor detected: + <itemizedlist> + <listitem> +<para>The end of the program (or the end of the string in an INTERPRET instruction) without finding the ending "*/" for a comment or the ending quotation mark for a literal string</para> +</listitem> + <listitem> +<para>The end of the line for a literal string.</para> +</listitem> + </itemizedlist> + </para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Unmatched comment delimiter ("/*") on line <emphasis>line_number</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Unmatched single quote (')</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>Unmatched double quote (")</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR7"> +<title>Error 7 - WHEN or OTHERWISE expected</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>At least one WHEN construct (and possibly an OTHERWISE clause) +is expected within a SELECT instruction. This message is issued if any +other instruction is found or there is no WHEN construct before the +OTHERWISE or all WHEN expressions are false and an OTHERWISE is not +present. A common cause of this error is if you forget the DO and END +around the list of instructions following a WHEN. For example:</para> +<programlisting> +WRONG RIGHT + +Select Select +When a=c then When a=c then DO +Say 'A equals C' Say 'A equals C' +exit exit +Otherwise nop end +end Otherwise nop +end +</programlisting> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>SELECT on line <emphasis>line_number</emphasis> requires WHEN</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>SELECT on line <emphasis>line_number</emphasis> requires WHEN, OTHERWISE, or END</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>All WHEN expressions of SELECT are false; OTHERWISE expected</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR8"> +<title>Error 8 - Unexpected THEN or ELSE</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A THEN or an ELSE clause was found that does not match a +corresponding IF or WHEN clause. This often occurs because of a +missing END or DO...END in the THEN part of a complex IF...THEN...ELSE +construction. For example:</para> +<programlisting> +WRONG RIGHT + +If a=c then do; If a=c then do; +Say EQUALS Say EQUALS +exit exit +else end +Say NOT EQUALS else +Say NOT EQUALS +</programlisting> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>THEN has no corresponding IF or WHEN clause</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>ELSE has no corresponding THEN clause</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR9"> +<title>Error 9 - Unexpected WHEN or OTHERWISE</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A WHEN or OTHERWISE was found outside of a SELECT construction. You might have accidentally enclosed the instruction in a DO...END construction by leaving out an END, or you might have tried to branch to it with a SIGNAL instruction (which does not work because the SELECT is then ended).</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>WHEN has no corresponding SELECT</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>OTHERWISE has no corresponding SELECT</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR10"> +<title>Error 10 - Unexpected or unmatched END</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>More ENDs were found in your program than DO or SELECT instructions, or the ENDs did not match the DO or SELECT instructions. This message also occurs if you try to transfer control into the middle of a loop using SIGNAL. In this case, the language processor does not expect the END because it did not process the previous DO instruction. Remember also that SIGNAL deactivates any current loops, so it cannot transfer control from one place inside a loop to another.</para> +<para>Another cause for this message is placing an END immediately after a THEN or ELSE subkeyword or specifying a name on the END keyword that does not match the name following DO. Putting the name of the control variable on ENDs that close repetitive loops can also help locate this kind of error.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>END has no corresponding DO or SELECT</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Symbol following END ("<emphasis>symbol</emphasis>") must either match control variable or LABEL of block specification ("<emphasis>control_variable</emphasis>" on line <emphasis>line_number</emphasis>) or be omitted</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>END corresponding to block on line <emphasis>symbol</emphasis> must not have a symbol following it because there is no LABEL or control variable; found "<emphasis>line_number</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>Symbol following END ("<emphasis>symbol</emphasis>") must match LABEL of SELECT specification ("<emphasis>control_variable</emphasis>" on line <emphasis>line_number</emphasis>) or be omitted</para> +</listitem> +</varlistentry> +<varlistentry> +<term>005</term> +<listitem> +<para>END must not immediately follow THEN</para> +</listitem> +</varlistentry> +<varlistentry> +<term>006</term> +<listitem> +<para>END must not immediately follow ELSE</para> +</listitem> +</varlistentry> +<varlistentry> +<term>007</term> +<listitem> +<para>END corresponding to SELECT on line <emphasis>symbol</emphasis> must not have a symbol following it because there is no LABEL; found "<emphasis>line_number</emphasis>"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR11"> +<title>Error 11 - Control stack full</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>Your program exceeds the nesting level limit for control structures (for example, DO...END and IF...THEN...ELSE). This could be because of a looping INTERPRET instruction, such as:</para> +<programlisting> + + line='INTERPRET line' + INTERPRET line + + </programlisting> +<para>These lines loop until they exceed the nesting level limit and the language processor issues this message. Similarly, a recursive subroutine or internal function that does not end correctly can loop until it causes this message.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Insufficient control stack space; cannot continue execution</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR13"> +<title>Error 13 - Invalid character in program</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A character was found outside a literal (quoted) string that is not a blank or one of the valid alphanumeric and special characters.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Incorrect character in program "<emphasis>character</emphasis>" ('<emphasis>hex_character</emphasis>'X)</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR14"> +<title>Error 14 - Incomplete DO/SELECT/IF</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>At the end of the program or the string for an INTERPRET instruction, a DO or SELECT instruction was found without a matching END or an IF clause that is not followed by a THEN clause. Putting the name of the control variable on each END closing a controlled loop can help locate this kind of error.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>DO instruction on line <emphasis>line_number</emphasis> requires matching END</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>SELECT instruction on line <emphasis>line_number</emphasis> requires matching END</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>THEN on line <emphasis>line_number</emphasis> must be followed by an instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>ELSE on line <emphasis>line_number</emphasis> must be followed by an instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>OTHERWISE on line <emphasis>line_number</emphasis> requires matching END</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR15"> +<title>Error 15 - Invalid hexadecimal or binary string</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>Hexadecimal strings must not have leading or trailing blanks and blanks can only be embedded at byte boundaries. Only the digits 0-9 and the letters a-f and A-F are allowed. The following are valid hexadecimal strings: </para> +<programlisting> + + '13'x + 'A3C2 1c34'x + '1de8'x + + </programlisting> +<para>Binary strings can have blanks only at the boundaries of groups of four binary digits. Only the digits 0 and 1 are allowed. These are valid binary strings: </para> +<programlisting> + + '1011'b + '110 1101'b + '101101 11010011'b + + </programlisting> +<para>You might have mistyped one of the digits, for example, typing a letter O instead of the number 0. Or you might have used the one-character symbol X or B (the name of the variable X or B, respectively) after a literal string when the string is not intended as a hexadecimal or binary specification. In this case, use the explicit concatenation operator (||) to concatenate the string to the value of the symbol.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Incorrect location of blank in position <emphasis>position</emphasis> in hexadecimal string</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Incorrect location of blank in position <emphasis>position</emphasis> in binary string</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>Only 0-9, a-f, A-F, and blank are valid in a hexadecimal string; found "<emphasis>character</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>Only 0, 1, and blank are valid in a binary string; found "<emphasis>character</emphasis>"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR16"> +<title>Error 16 - Label not found</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A SIGNAL instruction has been executed or an event for which a trap was set with SIGNAL ON has occurred, and the language processor could not find the label specified. You might have mistyped the label or forgotten to include it.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Label "<emphasis>label_name</emphasis>" not found</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR17"> +<title>Error 17 - Unexpected PROCEDURE</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A PROCEDURE instruction was encountered at an incorrect position. This could occur because no internal routines are active or because the PROCEDURE instruction was not the first instruction processed after the CALL instruction or function call. One cause for this error is dropping through to an internal routine, rather than calling it with a CALL instruction or a function call.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>PROCEDURE is valid only when it is the first instruction executed after an internal CALL or function invocation</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>INTERPRET data must not contain PROCEDURE</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR18"> +<title>Error 18 - THEN expected</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A THEN clause must follow each REXX IF or WHEN clause. The language processor found another clause before it found a THEN clause.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>IF instruction on line <emphasis>line_number</emphasis> requires matching THEN clause</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>WHEN instruction on line <emphasis>line_number</emphasis> requires matching THEN clause</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR19"> +<title>Error 19 - String or symbol expected</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A symbol or string was expected after the CALL or SIGNAL keywords +but none was found. You might have omitted the string or symbol or inserted a +special character (such as a parenthesis). + </para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>String or symbol expected after ADDRESS keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>String or symbol expected after CALL keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>String or symbol expected after NAME keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>String or symbol expected after SIGNAL keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>006</term> +<listitem> +<para>String or symbol expected after TRACE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>007</term> +<listitem> +<para>String or symbol expected after PARSE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>String or symbol expected after ::CLASS keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>String or symbol expected after ::METHOD keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>String or symbol expected after ::ROUTINE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>904</term> +<listitem> +<para>String or symbol expected after ::REQUIRES keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>905</term> +<listitem> +<para>String or symbol expected after EXTERNAL keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>906</term> +<listitem> +<para>String or symbol expected after METACLASS keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>907</term> +<listitem> +<para>String or symbol expected after SUBCLASS keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>908</term> +<listitem> +<para>String or symbol expected after INHERIT keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>909</term> +<listitem> +<para>String or symbol expected after tilde (~)</para> +</listitem> +</varlistentry> +<varlistentry> +<term>911</term> +<listitem> +<para>String or symbol expected after superclass colon (:)</para> +</listitem> +</varlistentry> +<varlistentry> +<term>912</term> +<listitem> +<para>String or symbol expected after STREAM keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>913</term> +<listitem> +<para>String or symbol expected after MIXINCLASS keyword</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR20"> +<title>Error 20 - Symbol expected</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A symbol is expected after CALL ON, CALL OFF, END, ITERATE, LEAVE, NUMERIC, PARSE, SIGNAL ON, or SIGNAL OFF. Also, a list of symbols or variable references is expected after DROP, EXPOSE, and PROCEDURE EXPOSE. Either there was no symbol when one was required or the language processor found another token.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Symbol expected after DROP keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Symbol expected after EXPOSE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>Symbol expected after PARSE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>904</term> +<listitem> +<para>Symbol expected after PARSE VAR</para> +</listitem> +</varlistentry> +<varlistentry> +<term>905</term> +<listitem> +<para>NUMERIC must be followed by one of the keywords DIGITS, FORM, or FUZZ; found "<emphasis>symbol</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>906</term> +<listitem> +<para>Symbol expected after "(" of a variable reference</para> +</listitem> +</varlistentry> +<varlistentry> +<term>907</term> +<listitem> +<para>Symbol expected after LEAVE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>908</term> +<listitem> +<para>Symbol expected after ITERATE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>909</term> +<listitem> +<para>Symbol expected after END keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>911</term> +<listitem> +<para>Symbol expected after ON keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>912</term> +<listitem> +<para>Symbol expected after OFF keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>913</term> +<listitem> +<para>Symbol expected after USE ARG</para> +</listitem> +</varlistentry> +<varlistentry> +<term>914</term> +<listitem> +<para>Symbol expected after RAISE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>915</term> +<listitem> +<para>Symbol expected after USER keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>916</term> +<listitem> +<para>Symbol expected after ::</para> +</listitem> +</varlistentry> +<varlistentry> +<term>917</term> +<listitem> +<para>Symbol expected after superclass colon (:)</para> +</listitem> +</varlistentry> +<varlistentry> +<term>918</term> +<listitem> +<para>Symbol expected after LABEL keyword</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR21"> +<title>Error 21 - Invalid data on end of clause</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A clause such as SELECT or NOP is followed by a token other than a comment.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Data must not follow the NOP keyword; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Data must not follow the SELECT keyword; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>Data must not follow the NAME keyword; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>904</term> +<listitem> +<para>Data must not follow the condition name; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>905</term> +<listitem> +<para>Data must not follow the SIGNAL label name; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>906</term> +<listitem> +<para>Data must not follow the TRACE setting; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>907</term> +<listitem> +<para>Data must not follow the LEAVE control variable name; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>908</term> +<listitem> +<para>Data must not follow the ITERATE control variable name; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>909</term> +<listitem> +<para>Data must not follow the END control variable name; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>911</term> +<listitem> +<para>Data must not follow the NUMERIC FORM specification; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>912</term> +<listitem> +<para>Data must not follow the GUARD OFF specification; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR22"> +<title>Error 22 - Invalid character string</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A literal string contains character codes that are not valid. This might be because some characters are not possible, or because the character set is extended and certain character combinations are not allowed.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Incorrect character string "<emphasis>character_string</emphasis>" ('<emphasis>hex_string</emphasis>'X)</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Incorrect double-byte character</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR23"> +<title>Error 23 - Invalid data string</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A data string (that is, the result of an expression) contains character codes that are not valid. This might be because some characters are not possible, or because the character set is extended and certain character combinations are not allowed.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Incorrect data string "<emphasis>string</emphasis>" ('<emphasis>hex_string</emphasis>'X)</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR24"> +<title>Error 24 - Invalid TRACE request</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>This message is issued when: + <itemizedlist> + <listitem> +<para>The option on a TRACE instruction or the argument to the built-in function does not start with A, C, E, F, I, L, N, O, or R.</para> +</listitem> + <listitem> +<para>In interactive debugging, you entered a number that is not a whole number.</para> +</listitem> + </itemizedlist> + </para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>TRACE request letter must be one of "ACEFILNOR"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Numeric TRACE requests are valid only from interactive debugging</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR25"> +<title>Error 25 - Invalid subkeyword found</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>An unexpected token was found at his position of an instruction where a particular subkeyword was expected. For example, in a NUMERIC instruction, the second token must be DIGITS, FUZZ, or FORM.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>CALL ON must be followed by one of the keywords ERROR, FAILURE, HALT, NOTREADY, USER, or ANY; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>CALL OFF must be followed by one of the keywords ERROR, FAILURE, HALT, NOTREADY, USER, or ANY; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>SIGNAL ON must be followed by one of the keywords ERROR, FAILURE, HALT, LOSTDIGITS, NOTREADY, NOMETHOD, NOSTRING, NOVALUE, SYNTAX, USER, or ANY; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>SIGNAL OFF must be followed by one of the keywords ERROR, FAILURE, HALT, LOSTDIGITS, NOTREADY, NOMETHOD, NOSTRING, NOVALUE, SYNTAX, USER, or ANY; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>011</term> +<listitem> +<para>NUMERIC FORM must be followed by one of the keywords SCIENTIFIC or ENGINEERING; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>012</term> +<listitem> +<para>PARSE must be followed by one of the keywords ARG, LINEIN, PULL, SOURCE, VALUE, VAR, or VERSION; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>015</term> +<listitem> +<para>NUMERIC must be followed by one of the keywords DIGITS, FORM, or FUZZ; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>017</term> +<listitem> +<para>PROCEDURE must be followed by the keyword EXPOSE or nothing; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Unknown keyword on ::CLASS directive; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Unknown keyword on ::METHOD directive; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>Unknown keyword on ::ROUTINE directive; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>904</term> +<listitem> +<para>Unknown keyword on ::REQUIRES directive; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>905</term> +<listitem> +<para>USE must be followed by the keyword ARG; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>906</term> +<listitem> +<para>RAISE must be followed by one of the keywords ERROR, FAILURE, HALT, LOSTDIGITS, NOMETHOD, NOSTRING, NOTREADY, NOVALUE, SYNTAX, or USER; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>907</term> +<listitem> +<para>Unknown keyword on RAISE instruction; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>908</term> +<listitem> +<para>Duplicate DESCRIPTION keyword found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>909</term> +<listitem> +<para>Duplicate ADDITIONAL or ARRAY keyword found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>911</term> +<listitem> +<para>Duplicate RETURN or EXIT keyword found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>912</term> +<listitem> +<para>GUARD ON or GUARD OFF must be followed by the keyword WHEN; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>913</term> +<listitem> +<para>GUARD must be followed by the keyword ON or OFF; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>914</term> +<listitem> +<para>CALL ON condition must be followed by the keyword NAME; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>915</term> +<listitem> +<para>SIGNAL ON condition must be followed by the keyword NAME; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>916</term> +<listitem> +<para>Unknown keyword on FORWARD instruction; found "<emphasis>keyword</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>917</term> +<listitem> +<para>Duplicate TO keyword found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>918</term> +<listitem> +<para>Duplicate ARGUMENTS or ARRAY keyword found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>919</term> +<listitem> +<para>Duplicate RETURN or CONTINUE keyword found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>921</term> +<listitem> +<para>Duplicate CLASS keyword found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>922</term> +<listitem> +<para>Duplicate MESSAGE keyword found</para> +</listitem> +</varlistentry> +<varlistentry> +<term>923</term> +<listitem> +<para>SELECT must be followed by the keyword LABEL; found "<emphasis>word</emphasis>"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR26"> +<title>Error 26 - Invalid whole number</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>An expression was found that did not evaluate to a whole number or is greater than the limit (the default is 999 999 999): + <itemizedlist> + <listitem> +<para>The positional patterns in parsing templates (including variable positional patterns)</para> +</listitem> + <listitem> +<para>The operand to the right of the power operator</para> +</listitem> + <listitem> +<para>The values of exprr and exprf in the DO instruction</para> +</listitem> + <listitem> +<para>The values given for DIGITS or FUZZ in the NUMERIC instruction</para> +</listitem> + <listitem> +<para>The number used in the option of the TRACE setting This error is also raised if the value is not permitted (for example, a negative repetition count in a DO instruction), or the division performed during an integer divide or remainder operation does not result in a whole number.</para> +</listitem> + </itemizedlist> + </para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>002</term> +<listitem> +<para>Value of repetition count expression in DO instruction must be zero or a positive whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>Value of FOR expression in DO instruction must be zero or a positive whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>Positional pattern of PARSE template must be a whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>005</term> +<listitem> +<para>NUMERIC DIGITS value must be a positive whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>006</term> +<listitem> +<para>NUMERIC FUZZ value must be zero or a positive whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>007</term> +<listitem> +<para>Number used in TRACE setting must be a whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>008</term> +<listitem> +<para>Operand to the right of the power operator (**) must be a whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>011</term> +<listitem> +<para>Result of % operation did not result in a whole number</para> +</listitem> +</varlistentry> +<varlistentry> +<term>012</term> +<listitem> +<para>Result of // operation did not result in a whole number</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Result of a method call did not result in a whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR27"> +<title>Error 27 - Invalid DO syntax</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A syntax error was found in the DO instruction. You probably used BY, TO, FOR, WHILE, or UNTIL twice, used a WHILE and an UNTIL, or used BY, TO, or FOR when there is no control variable specified.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>WHILE and UNTIL keywords cannot be used on the same DO loop</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Incorrect data following FOREVER keyword on the DO loop; found "<emphasis>data</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>DO keyword <emphasis>keyword</emphasis> can be specified only once</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR28"> +<title>Error 28 - Invalid LEAVE or ITERATE</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A LEAVE or ITERATE instruction was found at an incorrect position. Either no loop was active, or the name specified on the instruction did not match the control variable of any active loop. Note that internal routine calls and the INTERPRET instruction protect DO loops by making them inactive. Therefore, for example, a LEAVE instruction in a subroutine cannot affect a DO loop in the calling routine. You probably tried to use the SIGNAL instruction to transfer control within or into a loop. Because a SIGNAL instruction ends all active loops, any ITERATE or LEAVE instruction causes this message.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>LEAVE is valid only within a repetitive loop or labeled block instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>ITERATE is valid only within a repetitive loop</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>Symbol following LEAVE ("<emphasis>symbol</emphasis>") must either match the label of a current loop or block instruction.</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>Symbol following ITERATE ("<emphasis>symbol</emphasis>") must either match the label of a current loop or be omitted</para> +</listitem> +</varlistentry> +<varlistentry> +<term>005</term> +<listitem> +<para>Symbol following ITERATE ("<emphasis>symbol</emphasis>") does not match a repetitive block instruction</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR29"> +<title>Error 29 - Environment name too long</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>The environment name specified on the ADDRESS instruction is longer than permitted for the system under which the interpreter is running.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Environment name exceeds <emphasis>limit</emphasis> characters; found "<emphasis>environment_name</emphasis>"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR30"> +<title>Error 30 - Name or string too long</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A variable name, label name, literal (quoted) string has exceeded the allowed limit of 250 characters. The limit for names includes any substitutions. A possible cause of this error is if you use a period (.) in a name, causing an unexpected substitution. Leaving off an ending quotation mark for a literal string, or putting a single quotation mark in a string, can cause this error because several clauses can be included in the string. For example, write the string 'don't' as 'don't' or "don't".</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Name exceeds 250 characters: "<emphasis>name</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Literal string exceeds 250 characters: "<emphasis>string</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Hexadecimal literal string exceeds 250 characters "<emphasis>string</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Binary literal string exceeds 250 characters "<emphasis>string</emphasis>"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR31"> +<title>Error 31 - Name starts with number or "."</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A variable was found whose name begins with a numeric digit or a period. You cannot assign a value to such a variable because you could then redefine numeric constants.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>A value cannot be assigned to a number; found "<emphasis>number</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Variable symbol must not start with a number; found "<emphasis>symbol</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>Variable symbol must not start with a "."; found "<emphasis>symbol</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR33"> +<title>Error 33 - Invalid expression result</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>The result of an expression was found not to be valid in the context in which it was used.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Value of NUMERIC DIGITS ("<emphasis>value</emphasis>") must exceed value of NUMERIC FUZZ ("<emphasis>value</emphasis>")</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Value of NUMERIC DIGITS ("<emphasis>value</emphasis>") must not exceed <emphasis>value</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Incorrect expression result following VALUE keyword of ADDRESS instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Incorrect expression result following VALUE keyword of SIGNAL instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>Incorrect expression result following VALUE keyword of TRACE instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>904</term> +<listitem> +<para>Incorrect expression result following SYNTAX keyword of RAISE instruction</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR34"> +<title>Error 34 - Logical value not 0 or 1</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>An expression was found in an IF, WHEN, DO WHILE, or DO UNTIL phrase that did not result in a 0 or 1. Any value operated on by a logical operator must result in a 0 or 1. For example, the phrase If result then exit rc fails if result has a value other than 0 or 1.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Value of expression following IF keyword must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Value of expression following WHEN keyword must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>Value of expression following WHILE keyword must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>Value of expression following UNTIL keyword must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>005</term> +<listitem> +<para>Value of expression to the left of the logical operator "<emphasis>operator</emphasis>" must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>006</term> +<listitem> +<para>Value of logical list expression element must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Logical value must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Value of expression following GUARD keyword must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>Authorization return value must be exactly "0" or "1"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>904</term> +<listitem> +<para>Property logical value must be exactly "0", "1", "true", or "false"; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR35"> +<title>Error 35 - Invalid expression</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>An expression contains a grammatical error. Possible causes: + <itemizedlist> + <listitem> +<para>An expression is missing when one is required</para> +</listitem> + <listitem> +<para>You ended an expression with an operator</para> +</listitem> + <listitem> +<para>You specified, in an expression, two operators next to one another with nothing in between them</para> +</listitem> + <listitem> +<para>You did not specify a right parenthesis when one was required</para> +</listitem> + <listitem> +<para>You used special characters (such as operators) in an intended character expression without enclosing them in quotation marks</para> +</listitem> + </itemizedlist> + </para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Incorrect expression detected at "<emphasis>token</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Prefix operator "<emphasis>operator</emphasis>" is not followed by an expression term</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Missing conditional expression following IF keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>Missing conditional expression following WHEN keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>904</term> +<listitem> +<para>Missing initial expression for DO control variable</para> +</listitem> +</varlistentry> +<varlistentry> +<term>905</term> +<listitem> +<para>Missing expression following BY keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>906</term> +<listitem> +<para>Missing expression following TO keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>907</term> +<listitem> +<para>Missing expression following FOR keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>908</term> +<listitem> +<para>Missing expression following WHILE keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>909</term> +<listitem> +<para>Missing expression following UNTIL keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>911</term> +<listitem> +<para>Missing expression following OVER keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>912</term> +<listitem> +<para>Missing expression following INTERPRET keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>913</term> +<listitem> +<para>Missing expression following OPTIONS keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>914</term> +<listitem> +<para>Missing expression following VALUE keyword of an ADDRESS instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>915</term> +<listitem> +<para>Missing expression following VALUE keyword of a SIGNAL instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>916</term> +<listitem> +<para>Missing expression following VALUE keyword of a TRACE instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>917</term> +<listitem> +<para>Missing expression following VALUE keyword of a NUMERIC FORM instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>918</term> +<listitem> +<para>Missing expression following assignment instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>919</term> +<listitem> +<para>Operator "<emphasis>operator</emphasis>" is not followed by an expression term</para> +</listitem> +</varlistentry> +<varlistentry> +<term>921</term> +<listitem> +<para>Missing expression following GUARD keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>922</term> +<listitem> +<para>Missing expression following DESCRIPTION keyword of a RAISE instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>923</term> +<listitem> +<para>Missing expression following ADDITIONAL keyword of a RAISE instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>924</term> +<listitem> +<para>Missing "(" on expression list of the ARRAY keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>925</term> +<listitem> +<para>Missing expression following TO keyword of a FORWARD instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>926</term> +<listitem> +<para>Missing expression following ARGUMENTS keyword of a FORWARD instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>927</term> +<listitem> +<para>Missing expression following MESSAGE keyword of a FORWARD instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>928</term> +<listitem> +<para>Missing expression following CLASS keyword of a FORWARD instruction</para> +</listitem> +</varlistentry> +<varlistentry> +<term>929</term> +<listitem> +<para>Missing expression in logical_expression_list</para> +</listitem> +</varlistentry> +<varlistentry> +<term>930</term> +<listitem> +<para>Missing expression following "=" token of a USE STRICT ARG instruction</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR36"> +<title>Error 36 - Unmatched "(" or "[" in expression</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A matched parenthesis or bracket was found within an expression. There are more left parentheses than right parentheses or more left brackets than right brackets. To include a single parenthesis in a command, enclose it in quotation marks.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Left parenthesis "(" in position <emphasis>position</emphasis> on line <emphasis>line_number</emphasis> requires a corresponding right parenthesis ")"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Square bracket "[" in position <emphasis>position</emphasis> on line <emphasis>line_number</emphasis> requires a corresponding right square bracket "]"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR37"> +<title>Error 37 - Unexpected ",", ")", or "]"</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>Either a comma was found outside a function invocation, or there are too many right parentheses or right square brackets in an expression. To include a comma in a character expression, enclose it in quotation marks. For example, write the instruction: </para> +<programlisting> + Say Enter A, B, or C + </programlisting> +<para>as follows:</para> +<programlisting> + Say 'Enter A, B, or C' + </programlisting> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Unexpected ","</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Unmatched ")" in expression</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Unexpected "]"</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR38"> +<title>Error 38 - Invalid template or pattern</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>A special character that is not allowed within a parsing template (for example, "%") has been found, or the syntax of a variable pattern is incorrect (that is, no symbol was found after a left parenthesis). This message is also issued if you omit the WITH subkeyword in a PARSE VALUE instruction.</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>Incorrect PARSE template detected at "<emphasis>column_position</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>002</term> +<listitem> +<para>Incorrect PARSE position detected at "<emphasis>column_position</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>PARSE VALUE instruction requires WITH keyword</para> +</listitem> +</varlistentry> +<varlistentry> +<term>900</term> +<listitem> +<para> +<emphasis>message</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>901</term> +<listitem> +<para>Missing PARSE relative position</para> +</listitem> +</varlistentry> +</variablelist> +</section> +<section id="ERR39"> +<title>Error 39 - Evaluation stack overflow</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>The expression is too complex to be evaluated by the language processor.</para> +</section> +<section id="ERR40"> +<title>Error 40 - Incorrect call to routine</title> +<para> +<emphasis role="bold">Explanation:</emphasis> +</para> +<para>An incorrect call to a routine was found. Possible causes: + <itemizedlist> + <listitem> +<para>You passed incorrect data (arguments) to the built-in or external routine.</para> +</listitem> + <listitem> +<para>You passed too many arguments to the built-in, external, or internal routine.</para> +</listitem> + <listitem> +<para>The external routine called was not compatible with the language processor.</para> +</listitem> + </itemizedlist> + If you did not try to call a routine, you might have a symbol or a string adjacent to a "(" when you meant it to be separated by a blank or other operator. The language processor would treat this as a function call. For example, write TIME(4+5) as follows: TIME*(4+5)</para> +<para>The associated subcodes are: </para> +<variablelist> +<varlistentry> +<term>001</term> +<listitem> +<para>External routine "<emphasis>routine</emphasis>" failed</para> +</listitem> +</varlistentry> +<varlistentry> +<term>003</term> +<listitem> +<para>Not enough arguments in invocation of <emphasis>routine</emphasis>; minimum expected is <emphasis>number</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>004</term> +<listitem> +<para>Too many arguments in invocation of <emphasis>routine</emphasis>; maximum expected is <emphasis>number</emphasis> +</para> +</listitem> +</varlistentry> +<varlistentry> +<term>005</term> +<listitem> +<para>Missing argument in invocation of <emphasis>routine</emphasis>; argument <emphasis>argument_number</emphasis> is required</para> +</listitem> +</varlistentry> +<varlistentry> +<term>011</term> +<listitem> +<para> +<emphasis>function_name</emphasis> argument <emphasis>argument_number</emphasis> must be a number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>012</term> +<listitem> +<para> +<emphasis>function_name</emphasis> argument <emphasis>argument_number</emphasis> must be a whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>013</term> +<listitem> +<para> +<emphasis>function_name</emphasis> argument <emphasis>argument_number</emphasis> must be zero or positive; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>014</term> +<listitem> +<para> +<emphasis>function_name</emphasis> argument <emphasis>argument_number</emphasis> must be positive; found "<emphasis>value</emphasis>"</para> +</listitem> +</... [truncated message content] |
From: <bi...@us...> - 2007-04-17 12:01:45
|
Revision: 306 http://svn.sourceforge.net/oorexx/?rev=306&view=rev Author: bigrixx Date: 2007-04-17 05:01:46 -0700 (Tue, 17 Apr 2007) Log Message: ----------- [ 1702148 ] Add a caseless compare ability to string. Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/StringClass.cpp interpreter-3.x/trunk/kernel/classes/StringClass.hpp interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/StringClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClass.cpp 2007-04-17 11:23:02 UTC (rev 305) +++ interpreter-3.x/trunk/kernel/classes/StringClass.cpp 2007-04-17 12:01:46 UTC (rev 306) @@ -377,6 +377,30 @@ return !memcmp(this->stringData, other->stringData, otherLen); } + +/** + * Primitive string caseless comparison. + * + * @param otherObj The other string to compare. + * + * @return true if the strings compare, false otherwise. + */ +bool RexxString::primitiveCaselessIsEqual(RexxObject *otherObj) +{ + // we have one required string object + required_arg(otherObj, ONE); + RexxString *other = REQUEST_STRING(otherObj); + stringsize_t otherLen = other->getLength(); + // can't compare equal if different lengths + if (otherLen != this->getLength()) + { + return false; + } + // do the actual string compare + return CaselessCompare((PUCHAR)this->getStringData(), (PUCHAR)other->getStringData(), otherLen) == 0; +} + + long RexxString::comp(RexxObject *other) /******************************************************************************/ /* Function: Do a value comparison of two strings for the non-strict */ @@ -706,6 +730,34 @@ return numstr->formatRexx(Integers, Decimals, MathExp, ExpTrigger); } + +/** + * The string equals() method, which does a strict compare with + * another string object. + * + * @param other The other string object. + * + * @return True if the strings are equal, false for inequality. + */ +RexxInteger *RexxString::equals(RexxString *other) +{ + return this->primitiveIsEqual(other) ? TheTrueObject : TheFalseObject; +} + +/** + * The string equals() method, which does a strict caseless + * compare with another string object. + * + * @param other The other string object. + * + * @return True if the strings are equal, false for inequality. + */ +RexxInteger *RexxString::caselessEquals(RexxString *other) +{ + return this->primitiveCaselessIsEqual(other) ? TheTrueObject : TheFalseObject; +} + + RexxInteger *RexxString::strictEqual(RexxObject *other) /******************************************************************************/ /* Function: Strict ("==") equality operator...also returns the hash value */ Modified: interpreter-3.x/trunk/kernel/classes/StringClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClass.hpp 2007-04-17 11:23:02 UTC (rev 305) +++ interpreter-3.x/trunk/kernel/classes/StringClass.hpp 2007-04-17 12:01:46 UTC (rev 306) @@ -102,6 +102,7 @@ BOOL isEqual(RexxObject *); BOOL primitiveIsEqual(RexxObject *); + bool primitiveCaselessIsEqual(RexxObject *); long strictComp(RexxObject *); long comp(RexxObject *); RexxInteger *equal(RexxObject *); @@ -229,6 +230,9 @@ RexxInteger *matchChar(RexxInteger *position_, RexxString *matchSet); RexxInteger *caselessMatchChar(RexxInteger *position_, RexxString *matchSet); + RexxInteger *RexxString::equals(RexxString *other); + RexxInteger *RexxString::caselessEquals(RexxString *other); + RexxArray *makeArray(RexxString *); /****************************************************************************/ Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-17 11:23:02 UTC (rev 305) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-04-17 12:01:46 UTC (rev 306) @@ -82,6 +82,7 @@ CHARCONSTANT(CALL, "CALL"); CHARCONSTANT(CALL_PROGRAM, "CALL_PROGRAM"); CHARCONSTANT(CALL_STRING, "CALL_STRING"); +CHARCONSTANT(CASELESSEQUALS, "CASELESSEQUALS"); CHARCONSTANT(CASELESSLASTPOS, "CASELESSLASTPOS"); CHARCONSTANT(CASELESSMATCH, "CASELESSMATCH"); CHARCONSTANT(CASELESSMATCHCHAR, "CASELESSMATCHCHAR"); @@ -130,6 +131,7 @@ CHARCONSTANT(ENVELOPE, "ENVELOPE"); CHARCONSTANT(ENVIRONMENT, "ENVIRONMENT"); CHARCONSTANT(ERROR, "ERROR"); +CHARCONSTANT(EQUALS, "EQUALS"); CHARCONSTANT(ERRORTEXT, "ERRORTEXT"); CHARCONSTANT(ERRORCONDITION, "ERRORCONDITION"); CHARCONSTANT(EXIT, "EXIT"); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-17 11:23:02 UTC (rev 305) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-04-17 12:01:46 UTC (rev 306) @@ -444,6 +444,8 @@ CPPMSTR(RexxString::caselessMatch), CPPMSTR(RexxString::matchChar), CPPMSTR(RexxString::caselessMatchChar), +CPPMSTR(RexxString::equals), +CPPMSTR(RexxString::caselessEquals), /* End of BIF methods */ CPPMSTR(RexxString::makeArray), @@ -1257,6 +1259,8 @@ defineKernelMethod(CHAR_CASELESSMATCH ,TheStringBehaviour, CPPMSTR(RexxString::caselessMatch), 4); defineKernelMethod(CHAR_MATCHCHAR ,TheStringBehaviour, CPPMSTR(RexxString::matchChar), 2); defineKernelMethod(CHAR_CASELESSMATCHCHAR ,TheStringBehaviour, CPPMSTR(RexxString::caselessMatchChar), 2); + defineKernelMethod(CHAR_EQUALS ,TheStringBehaviour, CPPMSTR(RexxString::equals), 1); + defineKernelMethod(CHAR_CASELESSEQUALS ,TheStringBehaviour, CPPMSTR(RexxString::caselessEquals), 1); /* set the scope of the methods to */ /* this classes oref */ TheStringBehaviour->setMethodDictionaryScope(TheStringClass); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-01 15:44:20
|
Revision: 327 http://svn.sourceforge.net/oorexx/?rev=327&view=rev Author: bigrixx Date: 2007-05-01 08:44:18 -0700 (Tue, 01 May 2007) Log Message: ----------- [ 1701478 ] Add general purpose sorting framework Modified Paths: -------------- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp interpreter-3.x/trunk/kernel/classes/IntegerClass.cpp interpreter-3.x/trunk/kernel/classes/IntegerClass.hpp interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp interpreter-3.x/trunk/kernel/classes/StringClass.cpp interpreter-3.x/trunk/kernel/classes/StringClass.hpp interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp interpreter-3.x/trunk/kernel/messages/DocErrorMessages.sgml interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h interpreter-3.x/trunk/kernel/messages/rexxmsg.xml interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc interpreter-3.x/trunk/kernel/runtime/GlobalNames.h interpreter-3.x/trunk/kernel/runtime/Initialization.cpp interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp interpreter-3.x/trunk/kernel/runtime/RexxCore.h interpreter-3.x/trunk/kernel/runtime/RexxMemory.cpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-05-01 15:44:18 UTC (rev 327) @@ -96,6 +96,12 @@ .environment~setentry('MAPCOLLECTION', .mapcollection) .environment~setentry('SETCOLLECTION', .setcollection) +.environment~setentry('COMPARABLE', .comparable) +.environment~setentry('COMPARATOR', .comparator) +.environment~setentry('CASELESSCOMPARATOR', .caselesscomparator) +.environment~setentry('COLUMNCOMPARATOR', .columncomparator) +.environment~setentry('CASELESSCOLUMNCOMPARATOR', .caselesscolumncomparator) + /* Call the system dependant routine to define addition methods */ systemMethods = 'SystemMethods.orx'() /* case sensitive */ @@ -744,7 +750,44 @@ ::CLASS MapCollection MIXINCLASS Collection ::CLASS SetCollection MIXINCLASS Collection +-- sort comparison classes. +::CLASS Comparable MIXINCLASS Object +::METHOD compareTo ABSTRACT +::CLASS Comparator MIXINCLASS Object +::METHOD compare +use strict arg left, right +return left~compareTo(right) + +::CLASS CaselessComparator MIXINCLASS Comparator +::METHOD compare +use strict arg left, right +return left~caselessCompareTo(right) + +::CLASS ColumnComparator MIXINCLASS Object +::METHOD init +expose start length +use strict arg start, length + +::METHOD compare +expose start length + +use strict arg left, right +return left~compareTo(right, start, length) + +::CLASS CaselessColumnComparator MIXINCLASS Object +::METHOD init +expose start length +use strict arg start, length + +::METHOD compare +expose start length + +use strict arg left, right +return left~caselessCompareTo(right, start, length) + + + /* ******************************** */ /* M O N I T O R C L A S S */ /* ******************************** */ Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-05-01 15:44:18 UTC (rev 327) @@ -1890,6 +1890,451 @@ return temp; } + +/** + * The merge sort routine. This will partition the data in to + * two sections, mergesort each partition, then merge the two + * partitions together. + * + * @param working The working array (same size as the sorted array). + * @param left The left bound of the partition. + * @param right The right bounds of the parition. + */ +void RexxArray::mergeSort(RexxArray *working, size_t left, size_t right) +{ + if (right > left) + { + size_t mid = (right + left) / 2; + mergeSort(working, left, mid); + mergeSort(working, mid + 1, right); + merge(working, left, mid + 1, right); + } +} + + +/** + * Perform the merge operation on two partitions. + * + * @param working The temporary working storage. + * @param left The left bound of the range. + * @param mid The midpoint of the range. This merges the two partitions + * (left, mid - 1) and (mid, right). + * @param right The right bound of the array. + */ +void RexxArray::merge(RexxArray *working, size_t left, size_t mid, size_t right) +{ + size_t leftEnd = mid - 1; + size_t elements = right - left + 1; + size_t mergePosition = left; + + while ((left <= leftEnd) && (mid <= right)) + { + RexxObject *leftItem = get(left); + RexxObject *midItem = get(mid); + if (leftItem->compareTo(midItem) <= 0) + { + working->put(leftItem, mergePosition); + mergePosition++; + left++; + } + else + { + working->put(midItem, mergePosition); + mergePosition++; + mid++; + } + } + + // now we have to copy any remainders in the segments + while (left <= leftEnd) + { + RexxObject *item = get(left); + working->put(item, mergePosition); + left++; + mergePosition++; + } + + while (mid <= right) + { + RexxObject *item = get(mid); + working->put(item, mergePosition); + mid++; + mergePosition++; + } + + // we've not modified the right position, so we can use that now to copy the + // merged elements back into the original array in reverse order + for (size_t i = 1; i <= elements; i++) + { + RexxObject *item = working->get(right); + put(item, right); + right--; + } +} + + +/** + * The merge sort routine. This will partition the data in to + * two sections, mergesort each partition, then merge the two + * partitions together. + * + * @param comparator The comparator object used for the compares. + * @param working The working array (same size as the sorted array). + * @param left The left bound of the partition. + * @param right The right bounds of the parition. + */ +void RexxArray::mergeSort(RexxObject *comparator, RexxArray *working, size_t left, size_t right) +{ + if (right > left) + { + size_t mid = (right + left) / 2; + mergeSort(comparator, working, left, mid); + mergeSort(comparator, working, mid + 1, right); + merge(comparator, working, left, mid + 1, right); + } +} + + +/** + * Perform the merge operation on two partitions. + * + * @param comparator The comparator used to produce the ordering. + * @param working The temporary working storage. + * @param left The left bound of the range. + * @param mid The midpoint of the range. This merges the two partitions + * (left, mid - 1) and (mid, right). + * @param right The right bound of the array. + */ +void RexxArray::merge(RexxObject *comparator, RexxArray *working, size_t left, size_t mid, size_t right) +{ + size_t leftEnd = mid - 1; + size_t elements = right - left + 1; + size_t mergePosition = left; + + while ((left <= leftEnd) && (mid <= right)) + { + RexxObject *leftItem = get(left); + RexxObject *midItem = get(mid); + if (sortCompare(comparator, leftItem, midItem) <= 0) + { + working->put(leftItem, mergePosition); + mergePosition++; + left++; + } + else + { + working->put(midItem, mergePosition); + mergePosition++; + mid++; + } + } + + // now we have to copy any remainders in the segments + while (left <= leftEnd) + { + RexxObject *item = get(left); + working->put(item, mergePosition); + left++; + mergePosition++; + } + + while (mid <= right) + { + RexxObject *item = get(mid); + working->put(item, mergePosition); + mid++; + mergePosition++; + } + + // we've not modified the right position, so we can use that now to copy the + // merged elements back into the original array in reverse order + for (size_t i = 1; i <= elements; i++) + { + RexxObject *item = working->get(right); + put(item, right); + right--; + } +} + + +/** + * Recursive quick sort routine for sorting a partition. + * + * @param left The left bound of the partition. + * @param right The right bound of the partition. + */ +void RexxArray::quickSort(size_t left, size_t right) +{ + size_t old_left = left; + size_t old_right = right; + + RexxObject *pivot = get(left); // get the pivot value + + // now find the new partitioning + while (left < right) + { + // fix the right end + while (get(right)->compareTo(pivot) >= 0 && (left < right)) + { + right--; + } + // did we find a mismatch while testing? then pull things in from the left too + if (left != right) + { + // swap these and pull the left in + put(get(right), left); + left++; + } + // now compare from the left + while (get(left)->compareTo(pivot) <= 0 && (left < right)) + { + left++; + } + // still not done? + if (left != right) + { + // swap these two and continue + put(get(left), right); + right--; + } + } + + // store the pivot value in the current left position + put(pivot, left); + // this is the new pivot point + size_t pivotPoint = left; + // restore the old end points + left = old_left; + right = old_right; + // something to the left of the pivot? + if (left < pivotPoint) + { + // sort the left partition + quickSort(left, pivotPoint - 1); + } + // and also the right partition if we have one + if (right > pivotPoint) + { + quickSort(pivotPoint + 1, right); + } +} + + +/** + * Recursive quick sort routine for sorting a partition. + * + * @param left The left bound of the partition. + * @param right The right bound of the partition. + */ +void RexxArray::quickSort(RexxObject *comparator, size_t left, size_t right) +{ + size_t old_left = left; + size_t old_right = right; + + RexxObject *pivot = get(left); // get the pivot value + + // now find the new partitioning + while (left < right) + { + // fix the right end + while (sortCompare(comparator, get(right), pivot) >= 0 && (left < right)) + { + right--; + } + // did we find a mismatch while testing? then pull things in from the left too + if (left != right) + { + // swap these and pull the left in + put(get(right), left); + left++; + } + // now compare from the left + while (sortCompare(comparator, get(left), pivot) <= 0 && (left < right)) + { + left++; + } + // still not done? + if (left != right) + { + // swap these two and continue + put(get(left), right); + right--; + } + } + + // store the pivot value in the current left position + put(pivot, left); + // this is the new pivot point + size_t pivotPoint = left; + // restore the old end points + left = old_left; + right = old_right; + // something to the left of the pivot? + if (left < pivotPoint) + { + // sort the left partition + quickSort(comparator, left, pivotPoint - 1); + } + // and also the right partition if we have one + if (right > pivotPoint) + { + quickSort(comparator, pivotPoint + 1, right); + } +} + + +/** + * Utility method for calling the sort comparators during a sort + * operation. + * + * @param comparator The comparator object. + * @param left The left object to compare. + * @param right The right object to compare. + * + * @return -1, 0, 1 depending on the compare results. + */ +wholenumber_t RexxArray::sortCompare(RexxObject *comparator, RexxObject *left, RexxObject *right) +{ + RexxObject *result = comparator->sendMessage(OREF_COMPARE, left, right); + wholenumber_t comparison = result->longValue(DEFAULT_DIGITS); + if (comparison == NO_LONG) + { + reportException(Error_Invalid_whole_number_compare, result); + } + return comparison; +} + + +/** + * Sort elements of the array in place, using a quicksort. + * + * @return Returns the same array, with the elements sorted. + */ +RexxArray *RexxArray::sortRexx() +{ + arraysize_t count = numItems(); + if (count == 0) // if the count is zero, sorting is easy! + { + return this; + } + + // make sure this is a non-sparse array. Checking up front means we don't + // need to check on each compare operation. + for (arraysize_t i = 1; i <= count; i++) + { + if (get(i) == OREF_NULL) + { + reportException(Error_Execution_sparse_array, new_integer(i)); + } + } + + // go do the quick sort + quickSort(1, count); + return this; +} + + +/** + * Sort elements of the array in place, using a quicksort. + * + * @return Returns the same array, with the elements sorted. + */ +RexxArray *RexxArray::sortWithRexx(RexxObject *comparator) +{ + required_arg(comparator, ONE); + + arraysize_t count = numItems(); + if (count <= 1) // if the count is zero, sorting is easy! + { + return this; + } + + // make sure this is a non-sparse array. Checking up front means we don't + // need to check on each compare operation. + for (arraysize_t i = 1; i <= count; i++) + { + if (get(i) == OREF_NULL) + { + reportException(Error_Execution_sparse_array, new_integer(i)); + } + } + + // go do the quick sort + quickSort(comparator, 1, count); + return this; +} + + +/** + * Sort elements of the array in place, using a quicksort. + * + * @return Returns the same array, with the elements sorted. + */ +RexxArray *RexxArray::stableSortRexx() +{ + arraysize_t count = numItems(); + if (count == 0) // if the count is zero, sorting is easy! + { + return this; + } + + // make sure this is a non-sparse array. Checking up front means we don't + // need to check on each compare operation. + for (arraysize_t i = 1; i <= count; i++) + { + if (get(i) == OREF_NULL) + { + reportException(Error_Execution_sparse_array, new_integer(i)); + } + } + + // the merge sort requires a temporary scratch area for the sort. + RexxArray *working = new_array(count); + save(working); + + // go do the quick sort + mergeSort(working, 1, count); + discard_hold(working); + return this; +} + + +/** + * Sort elements of the array in place, using a quicksort. + * + * @return Returns the same array, with the elements sorted. + */ +RexxArray *RexxArray::stableSortWithRexx(RexxObject *comparator) +{ + required_arg(comparator, ONE); + + arraysize_t count = numItems(); + if (count <= 1) // if the count is zero, sorting is easy! + { + return this; + } + + // make sure this is a non-sparse array. Checking up front means we don't + // need to check on each compare operation. + for (arraysize_t i = 1; i <= count; i++) + { + if (get(i) == OREF_NULL) + { + reportException(Error_Execution_sparse_array, new_integer(i)); + } + } + + // the merge sort requires a temporary scratch area for the sort. + RexxArray *working = new_array(count); + save(working); + + // go do the quick sort + mergeSort(comparator, working, 1, count); + discard_hold(working); + return this; +} + + void * RexxArray::operator new(size_t size, RexxObject *first) /******************************************************************************/ /* Function: Create an array with 1 element (new_array1) */ Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-05-01 15:44:18 UTC (rev 327) @@ -141,6 +141,17 @@ RexxObject *index(RexxObject *); RexxObject *hasItem(RexxObject *); RexxObject *removeItem(RexxObject *); + void mergeSort(RexxArray *working, size_t left, size_t right); + void merge(RexxArray *working, size_t left, size_t mid, size_t right); + void mergeSort(RexxObject *comparator, RexxArray *working, size_t left, size_t right); + void merge(RexxObject *comparator, RexxArray *working, size_t left, size_t mid, size_t right); + void quickSort(size_t left, size_t right); + void quickSort(RexxObject *comparator, size_t left, size_t right); + wholenumber_t sortCompare(RexxObject *comparator, RexxObject *left, RexxObject *right); + RexxArray *sortRexx(); + RexxArray *sortWithRexx(RexxObject *comparator); + RexxArray *stableSortRexx(); + RexxArray *stableSortWithRexx(RexxObject *comparator); inline void addLast(RexxObject *item) { this->insertItem(item, this->size() + 1); } inline void addFirst(RexxObject *item) { this->insertItem(item, 1); } Modified: interpreter-3.x/trunk/kernel/classes/IntegerClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/IntegerClass.cpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/IntegerClass.cpp 2007-05-01 15:44:18 UTC (rev 327) @@ -975,13 +975,13 @@ { long i; /* loop counter */ - for (i=0;i<INTEGERCACHESIZE ;i++ ) { /* now create all our cached integers*/ - OrefSet(this, this->integercache[i], new RexxInteger (i)); + for (i=INTEGERCACHELOW; i<INTEGERCACHESIZE; i++ ) { /* now create all our cached integers*/ + OrefSet(this, this->integercache[i - INTEGERCACHELOW], new RexxInteger (i)); /* force the item to create its string value too. This can save */ /* us a lot of time when string indices are used for compound */ /* variables and also eliminate a bunch of old-new table */ /* references. */ - this->integercache[i]->stringValue(); + this->integercache[i - INTEGERCACHELOW]->stringValue(); } } @@ -996,8 +996,8 @@ setUpMemoryMark /* now mark the cached integers */ - for (i = 0;i < INTEGERCACHESIZE ;i++ ) { - memory_mark(this->integercache[i]); + for (i = INTEGERCACHELOW; i < INTEGERCACHESIZE ;i++ ) { + memory_mark(this->integercache[i - INTEGERCACHELOW]); } cleanUpMemoryMark } @@ -1013,8 +1013,8 @@ setUpMemoryMarkGeneral /* now mark the cached integers */ - for (i = 0;i < INTEGERCACHESIZE ;i++ ) { - memory_mark_general(this->integercache[i]); + for (i = INTEGERCACHELOW; i < INTEGERCACHESIZE ;i++ ) { + memory_mark_general(this->integercache[i - INTEGERCACHELOW]); } cleanUpMemoryMarkGeneral } Modified: interpreter-3.x/trunk/kernel/classes/IntegerClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/IntegerClass.hpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/IntegerClass.hpp 2007-05-01 15:44:18 UTC (rev 327) @@ -45,6 +45,7 @@ #define Included_RexxInteger void integer_create (void); +#define INTEGERCACHELOW -10 #define INTEGERCACHESIZE 100 #define MAX_INTEGER_LENGTH 10 @@ -149,13 +150,13 @@ void *operator new (size_t); void *operator new(size_t size, long size1, RexxBehaviour *classBehave, RexxBehaviour *instance) { return new (size, classBehave, instance) RexxClass; } RexxIntegerClass(); - RexxInteger *newCache(long value) {if (value >= 0 && value < INTEGERCACHESIZE) - return this->integercache[value]; + RexxInteger *newCache(long value) {if (value >= INTEGERCACHELOW && value < INTEGERCACHESIZE) + return this->integercache[value - INTEGERCACHELOW]; else return new RexxInteger (value); }; void live(); void liveGeneral(); /* array of fast aloocation integers 0-99 */ - RexxInteger *integercache[INTEGERCACHESIZE]; + RexxInteger *integercache[INTEGERCACHESIZE - INTEGERCACHELOW]; }; #endif Modified: interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp 2007-05-01 15:44:18 UTC (rev 327) @@ -147,6 +147,26 @@ /** + * Wrapper around the compareTo() method that validates and + * extracts integer value. + * + * @param other The other comparison object + * + * @return -1, 0, 1 depending on the comparison result. + */ +wholenumber_t RexxObject::compareTo(RexxObject *other ) +{ + RexxObject *result = sendMessage(OREF_COMPARETO, other); + wholenumber_t comparison = result->longValue(DEFAULT_DIGITS); + if (comparison == NO_LONG) + { + reportException(Error_Invalid_whole_number_compareto, result); + } + return comparison; +} + + +/** * Test if an internal object is an instance of another class. * * @param other The test class. Modified: interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/ObjectClass.hpp 2007-05-01 15:44:18 UTC (rev 327) @@ -300,6 +300,7 @@ // test first for direct equality, followed by value equality. return (this == other) || this->isEqual(other); } + virtual wholenumber_t compareTo(RexxObject *); // Define operator methods here. Modified: interpreter-3.x/trunk/kernel/classes/StringClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClass.cpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/StringClass.cpp 2007-05-01 15:44:18 UTC (rev 327) @@ -401,6 +401,27 @@ } +/** + * Wrapper around the compareTo() method that validates and + * extracts integer value. + * + * @param other The other comparison object + * + * @return -1, 0, 1 depending on the comparison result. + */ +wholenumber_t RexxString::compareTo(RexxObject *other ) +{ + if (isPrimitive(this)) + { + return compareToRexx((RexxString *)other, OREF_NULL, OREF_NULL)->value; + } + else + { + return RexxObject::compareTo(other); + } +} + + long RexxString::comp(RexxObject *other) /******************************************************************************/ /* Function: Do a value comparison of two strings for the non-strict */ Modified: interpreter-3.x/trunk/kernel/classes/StringClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClass.hpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/StringClass.hpp 2007-05-01 15:44:18 UTC (rev 327) @@ -105,6 +105,7 @@ bool primitiveCaselessIsEqual(RexxObject *); long strictComp(RexxObject *); long comp(RexxObject *); + wholenumber_t compareTo(RexxObject *); RexxInteger *equal(RexxObject *); RexxInteger *strictEqual(RexxObject *); RexxInteger *notEqual(RexxObject *); @@ -230,6 +231,11 @@ RexxInteger *matchChar(RexxInteger *position_, RexxString *matchSet); RexxInteger *caselessMatchChar(RexxInteger *position_, RexxString *matchSet); + RexxInteger *compareToRexx(RexxString *other, RexxInteger *start_, RexxInteger *len_); + RexxInteger *caselessCompareToRexx(RexxString *other, RexxInteger *start_, RexxInteger *len_); + RexxInteger *primitiveCompareTo(RexxString *other, stringsize_t start, stringsize_t len); + RexxInteger *primitiveCaselessCompareTo(RexxString *other, stringsize_t start, stringsize_t len); + RexxInteger *RexxString::equals(RexxString *other); RexxInteger *RexxString::caselessEquals(RexxString *other); Modified: interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp 2007-05-01 15:44:18 UTC (rev 327) @@ -1326,3 +1326,174 @@ return TheFalseObject; } + +/** + * Do a sorting comparison of two strings. + * + * @param other The other compare string. + * @param start_ The starting compare position within the target string. + * @param len_ The length of the compare substring. + * + * @return True if the two regions match, false for any mismatch. + */ +RexxInteger *RexxString::compareToRexx(RexxString *other, RexxInteger *start_, RexxInteger *len_) +{ + other = stringArgument(other, ARG_ONE); + + stringsize_t start = optionalPositionArgument(start_, 1, ARG_TWO); + stringsize_t len = optionalLengthArgument(len_, getLength() - start + 1, ARG_THREE); + + return primitiveCompareTo(other, start, len); +} + + +/** + * Perform a compare of regions of two string objects. Returns + * -1, 0, 1 based on the relative ordering of the two strings. + * + * @param other The source string for the compare. + * @param start The starting offset within the target string. + * @param len The length of the substring to compare. + * + * @return -1 if the target string is less than, 0 if the two strings are + * equal, 1 if the target string is the greater. + */ +RexxInteger *RexxString::primitiveCompareTo(RexxString *other, stringsize_t start, stringsize_t len) +{ + stringsize_t myLength = getLength(); + stringsize_t otherLength = other->getLength(); + + // if doing the compare outside of the string length, we're less than the other string + // unless the start is + if (start > myLength) + { + return start > otherLength ? IntegerZero : IntegerMinusOne; + } + // if beyond the other length, they we're the larger + if (start > otherLength) + { + return IntegerOne; + } + + start--; // make the starting point origin zero + + myLength = min(len, myLength - start); + otherLength = min(len, otherLength - start); + + len = min(myLength, otherLength); + + wholenumber_t result = memcmp(getStringData() + start, other->getStringData() + start, len); + + // if they compare equal, then they are only + if (result == 0) + { + if (myLength == otherLength) + { + return IntegerZero; + } + else if (myLength > otherLength) + { + return IntegerOne; + } + else + { + return IntegerMinusOne; + } + } + else if (result > 0) + { + return IntegerOne; + } + else + { + return IntegerMinusOne; + } +} + + + + +/** + * Do a sorting comparison of two strings. + * + * @param other The other compare string. + * @param start_ The starting compare position within the target string. + * @param len_ The length of the compare substring. + * + * @return True if the two regions match, false for any mismatch. + */ +RexxInteger *RexxString::caselessCompareToRexx(RexxString *other, RexxInteger *start_, RexxInteger *len_) +{ + other = stringArgument(other, ARG_ONE); + + stringsize_t start = optionalPositionArgument(start_, 1, ARG_TWO); + stringsize_t len = optionalLengthArgument(len_, getLength() - start + 1, ARG_THREE); + + return primitiveCaselessCompareTo(other, start, len); +} + + + + +/** + * Perform a compare of regions of two string objects. Returns + * -1, 0, 1 based on the relative ordering of the two strings. + * + * @param other The source string for the compare. + * @param start The starting offset within the target string. + * @param len The length of the substring to compare. + * + * @return -1 if the target string is less than, 0 if the two strings are + * equal, 1 if the target string is the greater. + */ +RexxInteger *RexxString::primitiveCaselessCompareTo(RexxString *other, stringsize_t start, stringsize_t len) +{ + stringsize_t myLength = getLength(); + stringsize_t otherLength = other->getLength(); + + // if doing the compare outside of the string length, we're less than the other string + // unless the start is + if (start > myLength) + { + return start > otherLength ? IntegerZero : IntegerMinusOne; + } + // if beyond the other length, they we're the larger + if (start > otherLength) + { + return IntegerOne; + } + + start--; // make the starting point origin zero + + myLength = min(len, myLength - start); + otherLength = min(len, otherLength - start); + + len = min(myLength, otherLength); + + wholenumber_t result = CaselessCompare((PUCHAR)getStringData() + start, (PUCHAR)other->getStringData() + start, len); + + // if they compare equal, then they are only + if (result == 0) + { + if (myLength == otherLength) + { + return IntegerZero; + } + else if (myLength > otherLength) + { + return IntegerOne; + } + else + { + return IntegerMinusOne; + } + } + else if (result > 0) + { + return IntegerOne; + } + else + { + return IntegerMinusOne; + } +} Modified: interpreter-3.x/trunk/kernel/messages/DocErrorMessages.sgml =================================================================== --- interpreter-3.x/trunk/kernel/messages/DocErrorMessages.sgml 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/messages/DocErrorMessages.sgml 2007-05-01 15:44:18 UTC (rev 327) @@ -1199,6 +1199,18 @@ <para>Result of a method call did not result in a whole number; found "<emphasis>value</emphasis>"</para> </listitem> </varlistentry> +<varlistentry> +<term>902</term> +<listitem> +<para>Result of a COMPARETO method call did not result in a whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> +<varlistentry> +<term>903</term> +<listitem> +<para>Result of a COMPARE method call did not result in a whole number; found "<emphasis>value</emphasis>"</para> +</listitem> +</varlistentry> </variablelist> </section> <section id="ERR27"> @@ -3287,6 +3299,13 @@ <para>Invalid parameter type for key form "<emphasis>keyform</emphasis>"</para> </listitem> </varlistentry> +<varlistentry> +<term>975</term> +<listitem> +<para>Missing array element at position <emphasis>position</emphasis> +</para> +</listitem> +</varlistentry> </variablelist> </section> <section id="ERR99"> Modified: interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/messages/RexxErrorCodes.h 2007-05-01 15:44:18 UTC (rev 327) @@ -220,6 +220,8 @@ #define Error_Invalid_whole_number_rem 26012 #define Error_Invalid_whole_number_method 26901 #define Error_Invalid_whole_number_user_defined 26900 +#define Error_Invalid_whole_number_compareto 26902 +#define Error_Invalid_whole_number_compare 26903 #define Error_Invalid_do 27000 #define Error_Invalid_do_whileuntil 27001 #define Error_Invalid_do_forever 27901 @@ -527,6 +529,7 @@ #define Error_Execution_no_concurrency 98951 #define Error_Invalid_data_type_for_objspec 98974 #define Error_Execution_class_server_not_installed 98952 +#define Error_Execution_sparse_array 98975 #define Error_Translation 99000 #define Error_Translation_user_defined 99900 #define Error_Translation_duplicate_class 99901 Modified: interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/messages/RexxMessageNumbers.h 2007-05-01 15:44:18 UTC (rev 327) @@ -590,6 +590,9 @@ #define Error_Translation_use_strict_ellipsis_msg 663 #define Error_Invalid_expression_use_strict_default_msg 664 #define Error_Incorrect_method_abstract_msg 665 +#define Error_Invalid_whole_number_compareto_msg 666 +#define Error_Invalid_whole_number_compare_msg 667 +#define Error_Execution_sparse_array_msg 668 #endif Modified: interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h =================================================================== --- interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h 2007-05-01 15:44:18 UTC (rev 327) @@ -222,6 +222,8 @@ MINOR(Error_Invalid_whole_number_rem) MINOR(Error_Invalid_whole_number_method) MINOR(Error_Invalid_whole_number_user_defined) + MINOR(Error_Invalid_whole_number_compareto) + MINOR(Error_Invalid_whole_number_compare) MAJOR(Error_Invalid_do) MINOR(Error_Invalid_do_whileuntil) MINOR(Error_Invalid_do_forever) @@ -529,6 +531,7 @@ MINOR(Error_Execution_no_concurrency) MINOR(Error_Invalid_data_type_for_objspec) MINOR(Error_Execution_class_server_not_installed) + MINOR(Error_Execution_sparse_array) MAJOR(Error_Translation) MINOR(Error_Translation_user_defined) MINOR(Error_Translation_duplicate_class) Modified: interpreter-3.x/trunk/kernel/messages/rexxmsg.xml =================================================================== --- interpreter-3.x/trunk/kernel/messages/rexxmsg.xml 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/messages/rexxmsg.xml 2007-05-01 15:44:18 UTC (rev 327) @@ -1634,6 +1634,24 @@ <SymbolicName>Error_Invalid_whole_number_user_defined</SymbolicName> <Text><Sub position="1" name="message"/></Text> </SubMessage> + <SubMessage> + <Code>26</Code> + <Subcode>902</Subcode> + <MessageNumber>666</MessageNumber> + <Component>Rexx</Component> + <Severity>Warning</Severity> + <SymbolicName>Error_Invalid_whole_number_compareto</SymbolicName> + <Text>Result of a COMPARETO method call did not result in a whole number; found <q><Sub position="1" name="value"/></q></Text> + </SubMessage> + <SubMessage> + <Code>26</Code> + <Subcode>903</Subcode> + <MessageNumber>667</MessageNumber> + <Component>Rexx</Component> + <Severity>Warning</Severity> + <SymbolicName>Error_Invalid_whole_number_compare</SymbolicName> + <Text>Result of a COMPARE method call did not result in a whole number; found <q><Sub position="1" name="value"/></q></Text> + </SubMessage> </Subcodes> </Message> <Message> @@ -4519,6 +4537,15 @@ <SymbolicName>Error_Execution_class_server_not_installed</SymbolicName> <Text><Sub position="1" name="servername"/> class server not installed</Text> </SubMessage> + <SubMessage> + <Code>98</Code> + <Subcode>975</Subcode> + <MessageNumber>668</MessageNumber> + <Component>Rexx</Component> + <Severity>Error</Severity> + <SymbolicName>Error_Execution_sparse_array</SymbolicName> + <Text>Missing array element at position <Sub position="1" name="position"/></Text> + </SubMessage> </Subcodes> </Message> <Message> Modified: interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc =================================================================== --- interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/platform/windows/winmsgtb.rc 2007-05-01 15:44:18 UTC (rev 327) @@ -590,6 +590,9 @@ Error_Translation_use_strict_ellipsis "The ""..."" argument marker can only appear at the end of the argument list" Error_Invalid_expression_use_strict_default "Missing expression following ""="" token of a USE STRICT ARG instruction" Error_Incorrect_method_abstract "Method &1 is ABSTRACT and cannot be directly invoked" + Error_Invalid_whole_number_compareto "Result of a COMPARETO method call did not result in a whole number; found ""&1""" + Error_Invalid_whole_number_compare "Result of a COMPARE method call did not result in a whole number; found ""&1""" + Error_Execution_sparse_array "Missing array element at position &1" END Modified: interpreter-3.x/trunk/kernel/runtime/GlobalNames.h =================================================================== --- interpreter-3.x/trunk/kernel/runtime/GlobalNames.h 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/runtime/GlobalNames.h 2007-05-01 15:44:18 UTC (rev 327) @@ -64,6 +64,8 @@ GLOBAL_NAME(CLOSE, CHAR_CLOSE) GLOBAL_NAME(CODE, CHAR_CODE) GLOBAL_NAME(COMMAND, CHAR_COMMAND) + GLOBAL_NAME(COMPARE, CHAR_COMPARE) + GLOBAL_NAME(COMPARETO, CHAR_COMPARETO) GLOBAL_NAME(CONCATENATE, CHAR_CONCATENATE) GLOBAL_NAME(CONDITION, CHAR_CONDITION) GLOBAL_NAME(CSELF, CHAR_CSELF) Modified: interpreter-3.x/trunk/kernel/runtime/Initialization.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Initialization.cpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/runtime/Initialization.cpp 2007-05-01 15:44:18 UTC (rev 327) @@ -201,6 +201,7 @@ IntegerSeven = new_integer(7L); IntegerEight = new_integer(8L); IntegerNine = new_integer(9L); + IntegerMinusOne = new_integer(-1); restoreStrings(); /* restore the global strings */ nmethod_restore(); /* fix up native methods */ activity_restore(); /* do activity restores */ Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-05-01 15:44:18 UTC (rev 327) @@ -82,6 +82,7 @@ CHARCONSTANT(CALL, "CALL"); CHARCONSTANT(CALL_PROGRAM, "CALL_PROGRAM"); CHARCONSTANT(CALL_STRING, "CALL_STRING"); +CHARCONSTANT(CASELESSCOMPARETO, "CASELESSCOMPARETO"); CHARCONSTANT(CASELESSEQUALS, "CASELESSEQUALS"); CHARCONSTANT(CASELESSLASTPOS, "CASELESSLASTPOS"); CHARCONSTANT(CASELESSMATCH, "CASELESSMATCH"); @@ -93,6 +94,8 @@ CHARCONSTANT(CODE, "CODE"); CHARCONSTANT(COMMAND, "COMMAND"); CHARCONSTANT(COMMON_RETRIEVERS, "COMMON_RETRIEVERS"); +CHARCONSTANT(COMPARETO, "COMPARETO"); +CHARCONSTANT(COMPARABLE, "COMPARABLE"); CHARCONSTANT(COMPLETED, "COMPLETED"); CHARCONSTANT(CONDITION, "CONDITION"); CHARCONSTANT(CONTINUE, "CONTINUE"); @@ -322,7 +325,11 @@ CHARCONSTANT(SOMOBJ, "SOMOBJ"); CHARCONSTANT(SOMSYM, "SOMREF"); CHARCONSTANT(SOMVERSION, "SOMVERSION"); +CHARCONSTANT(SORT, "SORT"); +CHARCONSTANT(SORTWITH, "SORTWITH"); CHARCONSTANT(SOURCE, "SOURCE"); +CHARCONSTANT(STABLESORT, "STABLESORT"); +CHARCONSTANT(STABLESORTWITH, "STABLESORTWITH"); CHARCONSTANT(START, "START"); CHARCONSTANT(STARTAT, "STARTAT"); CHARCONSTANT(STATE, "STATE"); Modified: interpreter-3.x/trunk/kernel/runtime/RexxCore.h =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCore.h 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/runtime/RexxCore.h 2007-05-01 15:44:18 UTC (rev 327) @@ -438,6 +438,7 @@ EXTERN RexxInteger * IntegerSeven INITGLOBALPTR; /* Static integer 7 */ EXTERN RexxInteger * IntegerEight INITGLOBALPTR; /* Static integer 8 */ EXTERN RexxInteger * IntegerNine INITGLOBALPTR; /* Static integer 9 */ +EXTERN RexxInteger * IntegerMinusOne INITGLOBALPTR; /* Static integer -1 */ /******************************************************************************/ Modified: interpreter-3.x/trunk/kernel/runtime/RexxMemory.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxMemory.cpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/runtime/RexxMemory.cpp 2007-05-01 15:44:18 UTC (rev 327) @@ -2051,6 +2051,7 @@ IntegerSeven = new_integer(7L); IntegerEight = new_integer(8L); IntegerNine = new_integer(9L); + IntegerMinusOne = new_integer(-1); /* avoid that through caching */ /* TheTrueObject == IntegerOne etc. */ Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-01 15:03:57 UTC (rev 326) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-01 15:44:18 UTC (rev 327) @@ -165,6 +165,10 @@ CPPMA(RexxArray::hasItem), CPPMA(RexxArray::removeItem), CPPMA(RexxArray::toString), +CPPMA(RexxArray::sortRexx), +CPPMA(RexxArray::stableSortRexx), +CPPMA(RexxArray::sortWithRexx), +CPPMA(RexxArray::stableSortWithRexx), CPPMC1(RexxArray::newRexx), CPPMA(RexxArray::makeString), @@ -446,6 +450,8 @@ CPPMSTR(RexxString::caselessMatchChar), CPPMSTR(RexxString::equals), CPPMSTR(RexxString::caselessEquals), +CPPMSTR(RexxString::compareToRexx), +CPPMSTR(RexxString::caselessCompareToRexx), /* End of BIF methods */ CPPMSTR(RexxString::makeArray), @@ -840,6 +846,10 @@ defineKernelMethod(CHAR_INDEX ,TheArrayBehaviour, CPPMA(RexxArray::index), 1); defineKernelMethod(CHAR_HASITEM ,TheArrayBehaviour, CPPMA(RexxArray::hasItem), 1); defineKernelMethod(CHAR_REMOVEITEM ,TheArrayBehaviour, CPPMA(RexxArray::removeItem), 1); + defineKernelMethod(CHAR_SORT ,TheArrayBehaviour, CPPMA(RexxArray::sortRexx), 0); + defineKernelMethod(CHAR_SORTWITH ,TheArrayBehaviour, CPPMA(RexxArray::sortWithRexx), 1); + defineKernelMethod(CHAR_STABLESORT ,TheArrayBehaviour, CPPMA(RexxArray::stableSortRexx), 0); + defineKernelMethod(CHAR_STABLESORTWITH ,TheArrayBehaviour, CPPMA(RexxArray::stableSortWithRexx), 1); /* set the scope of the methods to */ /* this classes oref */ TheArrayBehaviour->setMethodDictionaryScope(TheArrayClass); @@ -1261,13 +1271,15 @@ defineKernelMethod(CHAR_CASELESSMATCHCHAR ,TheStringBehaviour, CPPMSTR(RexxString::caselessMatchChar), 2); defineKernelMethod(CHAR_EQUALS ,TheStringBehaviour, CPPMSTR(RexxString::equals), 1); defineKernelMethod(CHAR_CASELESSEQUALS ,TheStringBehaviour, CPPMSTR(RexxString::caselessEquals), 1); + defineKernelMethod(CHAR_COMPARETO ,TheStringBehaviour, CPPMSTR(RexxString::compareToRexx), 3); + defineKernelMethod(CHAR_CASELESSCOMPARETO ,TheStringBehaviour, CPPMSTR(RexxString::caselessCompareToRexx), 3); /* set the scope of the methods to */ /* this classes oref */ TheStringBehaviour->setMethodDictionaryScope(TheStringClass); /* Now call the class subclassable */ /* method */ - TheStringClass->subClassable("String", true); + TheStringClass->subClassable("String", false); /***************************************************************************/ @@ -1634,6 +1646,11 @@ TheStemClass->inherit(map, OREF_NULL); TheStemClass->setRexxDefined(); + RexxClass *comparable = (RexxClass *)TheEnvironment->get(kernel_name(CHAR_COMPARABLE)); + + TheStringClass->inherit(comparable, OREF_NULL); + TheStringClass->setRexxDefined(); + // this has been protecting every thing critical // from GC events thus far, but now we remove it because // it contains things we don't want to save in the image. This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-01 17:14:16
|
Revision: 328 http://svn.sourceforge.net/oorexx/?rev=328&view=rev Author: bigrixx Date: 2007-05-01 10:14:17 -0700 (Tue, 01 May 2007) Log Message: ----------- [ 1708391 ] Add IsSubclassOf method to Class Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/ClassClass.cpp interpreter-3.x/trunk/kernel/classes/ClassClass.hpp interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/ClassClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ClassClass.cpp 2007-05-01 15:44:18 UTC (rev 327) +++ interpreter-3.x/trunk/kernel/classes/ClassClass.cpp 2007-05-01 17:14:17 UTC (rev 328) @@ -1766,6 +1766,22 @@ } +/** + * A stub to test compatibility of two classes. + * + * @param other The class for the superclass test. + * + * @return True if the class is a subclass of the argument class (or IS + * the argument class). + */ +RexxObject *RexxClass::isSubclassOf(RexxClass *other) +{ + required_arg(other, ONE); // must have the other argument + return isCompatibleWith(other) ? TheTrueObject : TheFalseObject; +} + + + void *RexxClass::operator new(size_t size, long size1, /* additional size */ RexxBehaviour *class_behaviour, /* new class behaviour */ Modified: interpreter-3.x/trunk/kernel/classes/ClassClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ClassClass.hpp 2007-05-01 15:44:18 UTC (rev 327) +++ interpreter-3.x/trunk/kernel/classes/ClassClass.hpp 2007-05-01 17:14:17 UTC (rev 328) @@ -113,7 +113,9 @@ void setMetaClass(RexxClass *); RexxClass *external(RexxString *, RexxClass *, RexxTable *); bool isCompatibleWith(RexxClass *other); + RexxObject *isSubclassOf(RexxClass *other); + inline BOOL rexxDefined() { return this->class_info & REXX_DEFINED; }; inline BOOL imported() { return this->class_info & IMPORTED; } inline void setImported() { this->class_info |= IMPORTED; } Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-05-01 15:44:18 UTC (rev 327) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-05-01 17:14:17 UTC (rev 328) @@ -179,6 +179,7 @@ CHARCONSTANT(INTNAME, "INTNAME"); CHARCONSTANT(ISA, "ISA"); CHARCONSTANT(ISEMPTY, "ISEMPTY"); +CHARCONSTANT(ISSUBCLASSOF, "ISSUBCLASSOF"); CHARCONSTANT(ISINSTANCEOF, "ISINSTANCEOF"); CHARCONSTANT(ITEM, "ITEM"); CHARCONSTANT(ITEMS, "ITEMS"); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-01 15:44:18 UTC (rev 327) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-01 17:14:17 UTC (rev 328) @@ -140,6 +140,7 @@ CPPMC(RexxClass::equal), CPPMC(RexxClass::strictEqual), CPPMC(RexxClass::notEqual), +CPPMC(RexxClass::isSubclassOf), CPPMC1(RexxClass::newRexx), @@ -739,7 +740,6 @@ defineKernelMethod(CHAR_MIXINCLASS ,TheClassBehaviour, CPPMC(RexxClass::mixinclass), 3); defineKernelMethod(CHAR_QUERYMIXINCLASS ,TheClassBehaviour, CPPMC(RexxClass::queryMixinClass), 0); defineKernelMethod(CHAR_NEWOPART ,TheClassBehaviour, CPPMC(RexxClass::newOpart), 1); - defineKernelMethod(CHAR_SOMCLASS ,TheClassBehaviour, CPPMC(RexxClass::getSomClass), 0); defineKernelMethod(CHAR_SUBCLASS ,TheClassBehaviour, CPPMC(RexxClass::subclass), 3); defineProtectedKernelMethod(CHAR_SUBCLASSES ,TheClassBehaviour, CPPMC(RexxClass::getSubClasses), 0); defineProtectedKernelMethod(CHAR_SUPERCLASSES ,TheClassBehaviour, CPPMC(RexxClass::getSuperClasses), 0); @@ -751,6 +751,7 @@ defineKernelMethod(CHAR_LESSTHAN_GREATERTHAN ,TheClassBehaviour, CPPMC(RexxClass::notEqual), 1); defineKernelMethod(CHAR_GREATERTHAN_LESSTHAN ,TheClassBehaviour, CPPMC(RexxClass::notEqual), 1); defineKernelMethod(CHAR_STRICT_BACKSLASH_EQUAL ,TheClassBehaviour, CPPMC(RexxClass::notEqual), 1); + defineKernelMethod(CHAR_ISSUBCLASSOF ,TheClassBehaviour, CPPMC(RexxClass::isSubclassOf), 1); /* and the private class methods */ defineProtectedKernelMethod(CHAR_SHRIEKREXXDEFINED,TheClassBehaviour, CPPMC(RexxClass::setRexxDefined), 0); defineProtectedKernelMethod(CHAR_SHRIEKIMPORT,TheClassBehaviour, CPPMC(RexxClass::importMethod), 0); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-01 21:22:42
|
Revision: 332 http://svn.sourceforge.net/oorexx/?rev=332&view=rev Author: bigrixx Date: 2007-05-01 14:22:44 -0700 (Tue, 01 May 2007) Log Message: ----------- [ 1710824 ] Add named queue support to linein/out Modified Paths: -------------- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx interpreter-3.x/trunk/kernel/RexxClasses/SystemMethods.orx interpreter-3.x/trunk/kernel/platform/unix/UnixMethods.orx interpreter-3.x/trunk/kernel/platform/windows/WindowsMethods.orx Modified: interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-05-01 18:08:47 UTC (rev 331) +++ interpreter-3.x/trunk/kernel/RexxClasses/CoreClasses.orx 2007-05-01 21:22:44 UTC (rev 332) @@ -742,7 +742,7 @@ .local~setentry('STDERR',.stream~new('STDERR')~~command('open nobuffer')) .local~setentry('ERROR', .monitor~new(.stderr)) - .local~setentry('STDQUE',.rx_queue~new~~set('SESSION')) + .local~setentry('STDQUE',.RexxQueue~new('SESSION')) -- tagging classes for Collection class types ::CLASS Collection MIXINCLASS Object Modified: interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx 2007-05-01 18:08:47 UTC (rev 331) +++ interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx 2007-05-01 21:22:44 UTC (rev 332) @@ -53,7 +53,7 @@ /*environment */ .environment~setentry('STREAM', .Stream) .environment~setentry('STREAM_SUPPLIER', .Stream_Supplier) -.environment~setentry('RX_QUEUE', .rx_queue) +.environment~setentry('REXXQUEUE', .rx_queue) /***************************************************/ /* Create the stream class */ @@ -354,7 +354,20 @@ /* Create the rx_queue class and define its associated methods */ /*****************************************************************/ ::CLASS rx_queue +::METHOD create CLASS EXTERNAL 'REXX rexx_create_queue' +::METHOD delete CLASS EXTERNAL 'REXX rexx_delete_queue' +::METHOD init + use strict arg name = "SESSION" + if name \= 'SESSION' then do + createdName = self~class~create(name) + Say "Created queue name is" createdName + if createdName \= name then do + self~class~delete(createdName) + end + end + self~set(name) + ::METHOD get /* get the queue name */ expose named_queue /* just expose and return */ return named_queue @@ -369,8 +382,6 @@ ::METHOD push EXTERNAL 'REXX rexx_push_queue' ::METHOD queue EXTERNAL 'REXX rexx_queue_queue' -::METHOD create EXTERNAL 'REXX rexx_create_queue' -::METHOD delete EXTERNAL 'REXX rexx_delete_queue' ::METHOD pull EXTERNAL 'REXX rexx_pull_queue' ::METHOD linein EXTERNAL 'REXX rexx_linein_queue' ::METHOD query EXTERNAL 'REXX rexx_query_queue' Modified: interpreter-3.x/trunk/kernel/RexxClasses/SystemMethods.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/SystemMethods.orx 2007-05-01 18:08:47 UTC (rev 331) +++ interpreter-3.x/trunk/kernel/RexxClasses/SystemMethods.orx 2007-05-01 21:22:44 UTC (rev 332) @@ -57,12 +57,12 @@ when 'WINDOWS' = sysIntName | 'WINDOWSNT' = sysIntName | 'WINDOWS95' = sysIntName then do methodDirectory = 'WindowsMethods.orx'() /* get the WIN specific met*/ - .environment~setentry('LINEEND', '0d0a'x) + .environment~setentry('ENDOFLINE', '0d0a'x) end /* running on LINUX ? */ when 'LINUX' = sysIntname | 'SUNOS' = sysIntname | 'AIX' = sysIntname Then do /* Like on AIX */ methodDirectory = 'UnixMethods.orx'() /* get the Linux specific m. */ - .environment~setentry('LINEEND', '0a'x) + .environment~setentry('ENDOFLINE', '0a'x) end otherwise raise syntax 1.000 Modified: interpreter-3.x/trunk/kernel/platform/unix/UnixMethods.orx =================================================================== --- interpreter-3.x/trunk/kernel/platform/unix/UnixMethods.orx 2007-05-01 18:08:47 UTC (rev 331) +++ interpreter-3.x/trunk/kernel/platform/unix/UnixMethods.orx 2007-05-01 21:22:44 UTC (rev 332) @@ -88,13 +88,13 @@ raise syntax 40.026 array ('RXQUEUE', 2, queue_name) if (Arg(2,'o') = 1) then queue_name = 'S00001Q0000000001' - return .stdque~create(queue_name) + return .RexxQueue~create(queue_name) end if substr(keyword,1,1) = 'D' then do if symbol(queue_name) = 'BAD' then raise syntax 40.026 array ('RXQUEUE', 2, queue_name) - return .stdque~delete(queue_name) + return .RexxQueue~delete(queue_name) end /* message expects 4 arguments*/ raise syntax 40.904 array ('RXQUEUE', 1, 'CDGS', keyword) Modified: interpreter-3.x/trunk/kernel/platform/windows/WindowsMethods.orx =================================================================== --- interpreter-3.x/trunk/kernel/platform/windows/WindowsMethods.orx 2007-05-01 18:08:47 UTC (rev 331) +++ interpreter-3.x/trunk/kernel/platform/windows/WindowsMethods.orx 2007-05-01 21:22:44 UTC (rev 332) @@ -88,13 +88,13 @@ raise syntax 40.026 array ('RXQUEUE', 2, queue_name) if (Arg(2,'o') = 1) then queue_name = 'S00001Q0000000001' - return .stdque~create(queue_name) + return .RexxQueue~create(queue_name) end if substr(keyword,1,1) = 'D' then do if symbol(queue_name) = 'BAD' then raise syntax 40.026 array ('RXQUEUE', 2, queue_name) - return .stdque~delete(queue_name) + return .RexxQueue~delete(queue_name) end raise syntax 40.904 array ('RXQUEUE', 1, 'CDGS', keyword) return This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-02 13:24:53
|
Revision: 336 http://svn.sourceforge.net/oorexx/?rev=336&view=rev Author: bigrixx Date: 2007-05-02 06:24:53 -0700 (Wed, 02 May 2007) Log Message: ----------- Tweak the RexxQueue class slightly. C Modified Paths: -------------- interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp interpreter-3.x/trunk/kernel/runtime/GlobalNames.h Modified: interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx =================================================================== --- interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx 2007-05-02 12:45:40 UTC (rev 335) +++ interpreter-3.x/trunk/kernel/RexxClasses/StreamClasses.orx 2007-05-02 13:24:53 UTC (rev 336) @@ -359,6 +359,7 @@ ::METHOD init use strict arg name = "SESSION" + name = name~upper if name \= 'SESSION' then do createdName = self~class~create(name) if createdName \= name then do @@ -385,8 +386,15 @@ if named_queue \= 'SESSION' then do self~class~delete(named_queue) end + +::METHOD lineout + forward message 'QUEUE' + +::METHOD say + forward message 'QUEUE' + ::METHOD push EXTERNAL 'REXX rexx_push_queue' ::METHOD queue EXTERNAL 'REXX rexx_queue_queue' ::METHOD pull EXTERNAL 'REXX rexx_pull_queue' ::METHOD linein EXTERNAL 'REXX rexx_linein_queue' -::METHOD query EXTERNAL 'REXX rexx_query_queue' +::METHOD queued EXTERNAL 'REXX rexx_query_queue' Modified: interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp =================================================================== --- interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp 2007-05-02 12:45:40 UTC (rev 335) +++ interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp 2007-05-02 13:24:53 UTC (rev 336) @@ -2959,7 +2959,7 @@ if (CurrentActivity->sysExitMsqSiz(context, &queuesize)) { queue = CurrentActivity->local->at(OREF_REXXQUEUE); /* return count on the queue */ - return send_message0(queue, OREF_QUERY); + return send_message0(queue, OREF_QUEUED); } else return queuesize; /* return count from system exit */ Modified: interpreter-3.x/trunk/kernel/runtime/GlobalNames.h =================================================================== --- interpreter-3.x/trunk/kernel/runtime/GlobalNames.h 2007-05-02 12:45:40 UTC (rev 335) +++ interpreter-3.x/trunk/kernel/runtime/GlobalNames.h 2007-05-02 13:24:53 UTC (rev 336) @@ -136,6 +136,7 @@ GLOBAL_NAME(PULL, CHAR_PULL) GLOBAL_NAME(PUSH, CHAR_PUSH) GLOBAL_NAME(PUT, CHAR_PUT) + GLOBAL_NAME(QUEUED, CHAR_QUEUED) GLOBAL_NAME(QUEUENAME, CHAR_QUEUE) GLOBAL_NAME(QUERY, CHAR_QUERY) GLOBAL_NAME(RC, CHAR_RC) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-02 20:40:40
|
Revision: 345 http://svn.sourceforge.net/oorexx/?rev=345&view=rev Author: bigrixx Date: 2007-05-02 13:40:40 -0700 (Wed, 02 May 2007) Log Message: ----------- [ 1711477 ] tab characters are not consistently recognized as whitespace Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/NumberStringClass.cpp interpreter-3.x/trunk/kernel/classes/NumberStringClass.hpp interpreter-3.x/trunk/kernel/classes/StringClass.cpp interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp interpreter-3.x/trunk/kernel/classes/StringClassWord.cpp interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp interpreter-3.x/trunk/kernel/instructions/ParseTarget.cpp interpreter-3.x/trunk/kernel/parser/Scanner.cpp Modified: interpreter-3.x/trunk/kernel/classes/NumberStringClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/NumberStringClass.cpp 2007-05-02 18:14:18 UTC (rev 344) +++ interpreter-3.x/trunk/kernel/classes/NumberStringClass.cpp 2007-05-02 20:40:40 UTC (rev 345) @@ -681,12 +681,12 @@ InPtr = (PUCHAR) number; /*Point to start of input string. */ EndData = InPtr + length; /*Point to end of Data + 1. */ - while (*InPtr == ch_BLANK) /* Skip all leading blanks. */ + while (*InPtr == ch_BLANK || *InPtr == ch_TAB) /* Skip all leading blanks. */ InPtr++; /* Skip it, and go on to next char */ /* Is this a sign Character? */ if ((ch = *InPtr) == ch_MINUS || ch == ch_PLUS) { InPtr++; /* Yes, skip it. */ - while (*InPtr == ch_BLANK) /* Ship all leading blanks. */ + while (*InPtr == ch_BLANK || *InPtr == ch_TAB) /* Ship all leading blanks. */ InPtr++; /* Skip it, and go on to next char */ } @@ -742,7 +742,7 @@ } /* At this point all that should be */ /* left Are trailing blanks. */ - while (*InPtr == ch_BLANK) /* Skip all trailing blanks */ + while (*InPtr == ch_BLANK || *InPtr == ch_TAB) /* Skip all trailing blanks */ InPtr++; /* Skip it, and go on to next char */ if (InPtr >= EndData) /* Did we reach end of data */ return FALSE; /* this was fine */ @@ -1279,7 +1279,7 @@ InPtr = (PUCHAR) number; /*Point to start of input string. */ EndData = InPtr + length; /*Point to end of Data + 1. */ - while (*InPtr == ch_BLANK) /* Ship all leading blanks. */ + while (*InPtr == ch_BLANK || *InPtr == ch_TAB) /* Ship all leading blanks. */ InPtr++; /* Skip it, and go on to next char */ /* Is this a sign Character? */ if ((ch = *InPtr) == ch_MINUS || ch == ch_PLUS) { @@ -1287,7 +1287,7 @@ if (ch == ch_MINUS) /* is it a Minus sign? */ this->sign = -1; /* Yup, indicate a negative number. */ } - while (*InPtr == ch_BLANK) /* Ship all leading blanks. */ + while (*InPtr == ch_BLANK || *InPtr == ch_TAB) /* Ship all leading blanks. */ InPtr++; /* Skip it, and go on to next char */ ch = *InPtr; /* Get 1st Digit. */ MaxDigits = NumDigits = length; /* Set our max digits counter. */ Modified: interpreter-3.x/trunk/kernel/classes/NumberStringClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/NumberStringClass.hpp 2007-05-02 18:14:18 UTC (rev 344) +++ interpreter-3.x/trunk/kernel/classes/NumberStringClass.hpp 2007-05-02 20:40:40 UTC (rev 345) @@ -58,6 +58,7 @@ #define ch_ONE '1' /* Define the One character. */ #define ch_FIVE '5' /* Define the Five character. */ #define ch_NINE '9' /* Define the Nine character. */ +#define ch_TAB '\t' /* Define the alternate whitespace char */ #define DEFAULTDIGITS 9 /* Define the default digits setting. */ #define DEFAULTFUZZ 0 /* Define the default fuzz setting. */ Modified: interpreter-3.x/trunk/kernel/classes/StringClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClass.cpp 2007-05-02 18:14:18 UTC (rev 344) +++ interpreter-3.x/trunk/kernel/classes/StringClass.cpp 2007-05-02 20:40:40 UTC (rev 345) @@ -474,12 +474,12 @@ secondStart = (PUCHAR)second->stringData; /* get pointer to start of data */ /* while we have leading blanks. */ - while (firstLen > 0 && *firstStart == ch_BLANK) { + while (firstLen > 0 && (*firstStart == ch_BLANK || *firstStart == ch_TAB)) { firstStart++; /* ignore character and look at next */ firstLen--; /* and string is now one char less. */ } /* while we have leading blanks. */ - while (secondLen > 0 && *secondStart == ch_BLANK) { + while (secondLen > 0 && (*secondStart == ch_BLANK || *secondStart == ch_TAB)) { secondStart++; /* ignore character and look at next */ secondLen--; /* and string is now one char less. */ } @@ -1610,14 +1610,14 @@ digitsLeft = this->length; /* Skip all leading blanks */ - for (; digitsLeft && *digitPtr == ch_BLANK; ++digitPtr, --digitsLeft) ; + for (; digitsLeft && (*digitPtr == ch_BLANK || *digitPtr == ch_TAB); ++digitPtr, --digitsLeft) ; if (digitsLeft){ /* Still Digits left ? */ if (*digitPtr == ch_PLUS || *digitPtr == ch_MINUS) { /* need to move past the sign and */ /* remove any remaining blanks. */ for (++digitPtr, --digitsLeft; - digitsLeft && *digitPtr == ' '; + digitsLeft && (*digitPtr == ch_BLANK || *digitPtr == ch_TAB); ++digitPtr, --digitsLeft) ; /* Yes, skip any blanks */ if (!digitsLeft) /* Did we reach end of data ? */ @@ -1637,7 +1637,7 @@ } /* if chars left make sure all are */ /* blanks. */ - for (; digitsLeft && *digitPtr == ch_BLANK; ++digitPtr, --digitsLeft) ; + for (; digitsLeft && (*digitPtr == ch_BLANK || *digitPtr == ch_TAB); ++digitPtr, --digitsLeft) ; /* skipped all trailing blanks. */ /* we better be at the end of the */ /* string, otherwise its invalid. */ Modified: interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp 2007-05-02 18:14:18 UTC (rev 344) +++ interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp 2007-05-02 20:40:40 UTC (rev 345) @@ -104,7 +104,7 @@ INT rc; /* return code */ rc = FALSE; /* default to failure */ - if (*String != ' ') { /* if no leading blank */ + if (*String != ' ' && *String != '\t') { /* if no leading blank */ SpaceFound = 0; /* set initial space flag */ Count = 0; /* start count with zero */ Current = (PUCHAR)String; /* point to start */ @@ -116,7 +116,7 @@ if (c != '\0' && strchr(Set, c) != NULL) Count++; /* bump count */ else { - if (c == ' ') { /* if c blank */ + if (c == ' ' || c == '\t') { /* if c blank */ if (!SpaceFound) { /* if 1st blank */ /* save position */ Residue = (Count % Modulus); @@ -135,7 +135,7 @@ } } if (rc) { /* still good? */ - if (c == ' ') /* if trailing blank */ + if (c == ' ' || c == '\t') /* if trailing blank */ rc = FALSE; /* report error */ else if (SpaceFound && (Count % Modulus) != Residue) rc = FALSE; /* grouping problem */ Modified: interpreter-3.x/trunk/kernel/classes/StringClassWord.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClassWord.cpp 2007-05-02 18:14:18 UTC (rev 344) +++ interpreter-3.x/trunk/kernel/classes/StringClassWord.cpp 2007-05-02 20:40:40 UTC (rev 345) @@ -74,7 +74,7 @@ Length = *StringLength; /* get the length */ for (;Length; Length--) { /* scan entire string */ - if (*Scan != ' ') /* if not a space */ + if (*Scan != ' ' && *Scan != '\t') /* if not a space */ break; /* just quit the loop */ Scan++; /* step to next character */ } @@ -103,7 +103,7 @@ Length = *StringLength; /* get the length */ for (;Length; Length--) { /* scan entire string */ - if (*Scan == ' ') /* if not a space */ + if (*Scan == ' ' || *Scan == '\t') /* if not a space */ break; /* just quit the loop */ Scan++; /* step to next character */ } Modified: interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp =================================================================== --- interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp 2007-05-02 18:14:18 UTC (rev 344) +++ interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp 2007-05-02 20:40:40 UTC (rev 345) @@ -1206,13 +1206,6 @@ while (!invalid && *formatscan != '\0') { switch (*formatscan) { /* process each format piece */ -// case ' ': /* blank to skip */ -// case '/': /* slash to skip */ -// case ':': /* colon to skip */ -// case '.': /* period to skip */ -// /* code moved to otherwise */ -// break; /* go around */ - case 'm': /* month spec */ /* test and convert */ output->month = (SHORT) GetNumber(inputscan, MONTH_SIZE, &invalid); Modified: interpreter-3.x/trunk/kernel/instructions/ParseTarget.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/ParseTarget.cpp 2007-05-02 18:14:18 UTC (rev 344) +++ interpreter-3.x/trunk/kernel/instructions/ParseTarget.cpp 2007-05-02 20:40:40 UTC (rev 345) @@ -380,7 +380,7 @@ /* scan for nonblanks is guaranteed to stop before getting into */ /* trouble, which eliminates the need to check against the */ /* length */ - while (*scan == ' ') { + while (*scan == ' ' || *scan == '\t') { scan++; /* step for each match found */ } /* set the new location */ @@ -389,7 +389,18 @@ word = OREF_NULLSTRING; /* just return a null string */ else { /* have a real word */ /* look for the next blank */ - endScan = (PUCHAR)memchr(scan, ' ', this->end - this->subcurrent); + endScan = NULL; + PUCHAR scanner = scan; + PUCHAR endPosition = (PUCHAR)string->stringData + this->end; + while (scanner < endPosition) + { + if (*scanner == ' ' || *scanner == '\t') + { + endScan = scanner; + break; + } + scanner++; + } if (endScan == NULL) { /* no match? */ /* calculate the length */ length = this->end - this->subcurrent; @@ -456,14 +467,25 @@ /* scan for nonblanks is guaranteed to stop before getting into */ /* trouble, which eliminates the need to check against the */ /* length */ - while (*scan == ' ') { + while (*scan == ' ' || *scan == '\t') { scan++; /* step for each match found */ } /* set the new location */ this->subcurrent = scan - (PUCHAR)(this->string->stringData); if (this->subcurrent < this->end) {/* something left over? */ /* look for the next blank */ - endScan = (PUCHAR)memchr(scan, ' ', this->end - this->subcurrent); + endScan = NULL; + PUCHAR scanner = scan; + PUCHAR endPosition = (PUCHAR)string->stringData + this->end; + while (scanner < endPosition) + { + if (*scanner == ' ' || *scanner == '\t') + { + endScan = scanner; + break; + } + scanner++; + } if (endScan == NULL) /* no match? */ this->subcurrent = this->end; /* use the rest of it */ else Modified: interpreter-3.x/trunk/kernel/parser/Scanner.cpp =================================================================== --- interpreter-3.x/trunk/kernel/parser/Scanner.cpp 2007-05-02 18:14:18 UTC (rev 344) +++ interpreter-3.x/trunk/kernel/parser/Scanner.cpp 2007-05-02 20:40:40 UTC (rev 345) @@ -730,7 +730,7 @@ real_length = length; /* pick up the string length */ for (i = 0; i < length; i++) { /* loop through entire string */ /* got a blank? */ - if (this->current[inpointer] == ' ') { + if (this->current[inpointer] == ' ' || this->current[inpointer] == '\t') { blanks = TRUE; /* remember scanning blanks */ /* don't like initial blanks or groups after the first */ /* which are not in twos (hex) or fours (binary) */ @@ -790,7 +790,7 @@ /* get the next nibble */ nibble = this->current[inpointer]; inpointer++; /* step to the next character */ - while (nibble == ' ') { /* step over any inter-nibble blanks */ + while (nibble == ' ' || nibble == '\t') { /* step over any inter-nibble blanks */ /* get the next nibble */ nibble = this->current[inpointer]; inpointer++; /* step to the next character */ @@ -836,7 +836,7 @@ /* get the next bit */ nibble = this->current[inpointer]; inpointer++; /* step to the next character */ - while (nibble == ' ') { /* step over any inter-nibble blanks */ + while (nibble == ' ' || nibble == '\t') { /* step over any inter-nibble blanks */ /* get the next nibble */ nibble = this->current[inpointer]; inpointer++; /* step to the next character */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-10-24 23:33:53
|
Revision: 1076 http://oorexx.svn.sourceforge.net/oorexx/?rev=1076&view=rev Author: bigrixx Date: 2007-10-24 16:33:55 -0700 (Wed, 24 Oct 2007) Log Message: ----------- Merge of warning removals back into trunk. Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/StringClass.cpp interpreter-3.x/trunk/kernel/classes/StringClassConversion.cpp interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp interpreter-3.x/trunk/kernel/expression/ExpressionFunction.cpp interpreter-3.x/trunk/kernel/expression/ExpressionFunction.hpp interpreter-3.x/trunk/kernel/instructions/CallInstruction.cpp interpreter-3.x/trunk/kernel/instructions/DoBlock.cpp interpreter-3.x/trunk/kernel/instructions/DoInstruction.cpp interpreter-3.x/trunk/kernel/instructions/EndIf.cpp interpreter-3.x/trunk/kernel/instructions/EndInstruction.cpp interpreter-3.x/trunk/kernel/instructions/ForwardInstruction.cpp interpreter-3.x/trunk/kernel/instructions/MessageInstruction.cpp interpreter-3.x/trunk/kernel/instructions/NumericInstruction.cpp interpreter-3.x/trunk/kernel/instructions/OptionsInstruction.cpp interpreter-3.x/trunk/kernel/instructions/ParseTarget.cpp interpreter-3.x/trunk/kernel/instructions/ParseTrigger.cpp interpreter-3.x/trunk/kernel/instructions/RaiseInstruction.cpp interpreter-3.x/trunk/kernel/instructions/SelectInstruction.cpp interpreter-3.x/trunk/kernel/messages/RexxMessageTable.h interpreter-3.x/trunk/kernel/messages/RexxMessageTable.xsl interpreter-3.x/trunk/kernel/parser/InstructionParser.cpp interpreter-3.x/trunk/kernel/parser/Scanner.cpp interpreter-3.x/trunk/kernel/parser/SourceFile.cpp interpreter-3.x/trunk/kernel/parser/Token.cpp interpreter-3.x/trunk/kernel/platform/unix/ErrorMessages.cpp interpreter-3.x/trunk/kernel/runtime/GlobalNames.h interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp Modified: interpreter-3.x/trunk/kernel/classes/StringClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClass.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/classes/StringClass.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -244,30 +244,28 @@ /******************************************************************************/ { RexxString *newSelf; /* converted string value */ - RexxNumberString *numberString; /* numberstring value of string */ if (!OTYPE(String, this)) { /* not truly a string type? */ newSelf = this->requestString(); /* do the conversion */ /* get a new numberstring Obj */ OrefSet(newSelf, newSelf->NumberString, (RexxNumberString *)new_numberstring(newSelf->getStringData(), newSelf->getLength())); /* save the number string */ - numberString = newSelf->NumberString; - if (numberString != OREF_NULL) /* Did number convert OK? */ + if (newSelf->NumberString != OREF_NULL) /* Did number convert OK? */ SetObjectHasReferences(newSelf); /* Make sure we are sent Live... */ + return newSelf->NumberString; } else { /* real primitive string */ /* get a new numberstring Obj */ OrefSet(this, this->NumberString, (RexxNumberString *)new_numberstring(this->getStringData(), this->getLength())); - numberString = this->NumberString; /* save the number string */ - if (numberString == OREF_NULL) /* Did number convert OK? */ + if (this->NumberString == OREF_NULL) /* Did number convert OK? */ this->setNonNumeric(); /* mark as a nonnumeric */ else { SetObjectHasReferences(this); /* Make sure we are sent Live... */ /* connect the string and number */ this->NumberString->setString(this); } + return this->NumberString; } - return numberString; /* return the numberString Object. */ } Modified: interpreter-3.x/trunk/kernel/classes/StringClassConversion.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClassConversion.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/classes/StringClassConversion.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -436,7 +436,7 @@ /* the input string is an invalid length */ report_exception(Error_Incorrect_method_invbase64); } - const char *source = (char *)this->getStringData(); + const char *source = this->getStringData(); /* figure out the output string length */ size_t outputLength = (inputLength / 4) * 3; if (*(source + inputLength - 1) == '=') Modified: interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/classes/StringClassMisc.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -95,11 +95,11 @@ /* one or more blanks. */ /*********************************************************************/ { - char c; /* current character */ + char c = '\0'; /* current character */ size_t Count; /* # set members found */ const char *Current; /* current location */ int SpaceFound; /* space found yet? */ - size_t Residue; /* if space_found, # set members */ + size_t Residue = 0; /* if space_found, # set members */ int rc; /* return code */ rc = FALSE; /* default to failure */ Modified: interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp =================================================================== --- interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -938,7 +938,7 @@ BUILTIN(ARG) { RexxString *option; /* function option */ RexxInteger *n; /* arg position count */ - RexxObject *result; /* function result */ + RexxObject *result = OREF_NULL; /* function result */ RexxObject **arglist; /* activation argument list */ size_t position; /* position argument */ size_t size; /* array size */ @@ -971,10 +971,6 @@ result = OREF_NULLSTRING; /* this too is a null string */ } } - /* have a null string? */ - else if (option->getLength() == 0) - /* this is an error */ - report_exception4(Error_Incorrect_call_list, new_cstring(CHAR_ARG), IntegerTwo, new_string("AENO", 4), option); else { /* need to process an option */ position = n->getValue(); /* get the integer value */ /* must be a positive integer */ @@ -1164,7 +1160,7 @@ /*convert the value */ int basedays = indate->longValue(9); /* bad value? */ - if (basedays == NO_LONG || !timestamp.setBaseDate(basedays)) + if (basedays == (int)NO_LONG || !timestamp.setBaseDate(basedays)) { report_exception3(Error_Incorrect_call_format_invalid, new_cstring(CHAR_DATE), indate, new_string((PCHAR)&style2, 1)); } @@ -1198,7 +1194,7 @@ /*convert the value */ int yearday = indate->longValue(9); /* bad value? */ - if (yearday == NO_LONG || yearday < 0 || yearday > YEAR_DAYS + 1 || + if (yearday == (int)NO_LONG || yearday < 0 || yearday > YEAR_DAYS + 1 || (yearday > YEAR_DAYS && !LeapYear(current.year))) { report_exception3(Error_Incorrect_call_format_invalid, new_cstring(CHAR_DATE), indate, new_string((PCHAR)&style2, 1)); @@ -1251,7 +1247,6 @@ int day = timestamp.day; /* get various date parts */ int month = timestamp.month; int year = timestamp.year; - int separator = ' '; // each format with a separator has it's own default switch (style) { /* process the various styles */ @@ -1402,21 +1397,21 @@ case 'H': /* 'H'ours format */ { int i = intime->longValue(9); /* convert the value */ - valid = i != NO_LONG && timestamp.setHours(i); + valid = i !=(int)NO_LONG && timestamp.setHours(i); break; } case 'S': /* 'S'econds format */ { int i = intime->longValue(9); /* convert the value */ - valid = i != NO_LONG && timestamp.setSeconds(i); + valid = i != (int)NO_LONG && timestamp.setSeconds(i); break; } case 'M': /* 'M'inutes format */ { int i = intime->longValue(9); /* convert the value */ - valid = i != NO_LONG && timestamp.setMinutes(i); + valid = i != (int)NO_LONG && timestamp.setMinutes(i); break; } @@ -1475,7 +1470,7 @@ else { // format as a long time - sprintf(work, "%lu.%06lu", (int)(threshold / (int64_t)MICROSECONDS), (int)(threshold % (int64_t)MICROSECONDS)); + sprintf(work, "%d.%06d", (int)(threshold / (int64_t)MICROSECONDS), (int)(threshold % (int64_t)MICROSECONDS)); } /* format the result */ if (style == 'R') /* is this a reset call? */ @@ -1690,13 +1685,11 @@ { report_exception3(Error_Incorrect_call_symbol, new_cstring(CHAR_VALUE), IntegerOne, variable); } - else { /* need to perform lookup */ - /* get the variable value */ - result = retriever->getValue(context); - if (newvalue != OREF_NULL) /* have a new value to assign? */ - /* do the assignment */ - retriever->assign(context, stack, newvalue); - } + /* get the variable value */ + result = retriever->getValue(context); + if (newvalue != OREF_NULL) /* have a new value to assign? */ + /* do the assignment */ + retriever->assign(context, stack, newvalue); } else if (selector->getLength() == 0) { /* null string selector? */ /* get the existing value */ @@ -2039,7 +2032,7 @@ RexxInteger *position; /* target position */ RexxInteger *count; /* count of lines */ RexxString *name; /* stream name */ - RexxString *result; /* linein result */ + RexxString *result = OREF_NULL; /* linein result */ BOOL added; /* add to stream table */ fix_args(CHARIN); /* check required arguments */ @@ -2080,7 +2073,7 @@ RexxObject *stream; /* target stream */ RexxInteger *line; /* target position */ RexxString *name; /* stream name */ - RexxString *result; /* linein result */ + RexxString *result = OREF_NULL; /* linein result */ RexxString *string; /* target string */ RexxString *fullName; /* fully qual'd stream name */ BOOL added; /* add to stream table */ @@ -2135,7 +2128,7 @@ RexxObject *stream; /* target stream */ RexxInteger *position; /* target position */ RexxString *name; /* stream name */ - RexxString *result; /* linein result */ + RexxString *result = OREF_NULL; /* linein result */ RexxString *string; /* target string */ RexxString *fullName; /* fully qual'd stream name */ BOOL added; /* add to stream table */ @@ -2178,7 +2171,6 @@ RexxString *option; /* option: "N" or "C" */ RexxInteger *result; /* linein result */ BOOL added; /* add to stream table */ - RexxString *quick; fix_args(LINES); /* check required arguments */ @@ -2196,32 +2188,30 @@ stream = resolve_stream(name, context, stack, TRUE, NULL, &added); if (option != OREF_NULL) - switch (option->getChar(0)) { /* process the option character */ - case 'C': - case 'c': - quick = new_cstring("C"); - break; - case 'N': - case 'n': - quick = new_cstring("N"); - break; - case '\0': /* argument 'O'mitted? */ - quick = new_cstring("N"); - break; - default: /* unknown option */ - /* this is an error */ - report_exception4(Error_Incorrect_call_list, new_cstring(CHAR_ARG), IntegerTwo, new_string("NC", 2), option); - break; + { + switch (option->getChar(0)) { /* process the option character */ + case 'C': + case 'c': + break; + case 'N': + case 'n': + break; + default: /* unknown option */ + /* this is an error */ + report_exception4(Error_Incorrect_call_list, new_cstring(CHAR_ARG), IntegerTwo, new_string("NC", 2), option); + break; + } } - else - quick = new_cstring("N"); + else { + option = OREF_NORMAL; + } /* use modified LINES method with quick flag */ - result = (RexxInteger *)send_message1(stream, OREF_LINES,quick); + result = (RexxInteger *)send_message1(stream, OREF_LINES, option); } /* for compatibility this needs */ /* to only return 0 or 1 */ - if (quick->getChar(0) == 'N') + if (toupper(option->getChar(0)) == 'N') return (result != IntegerZero) ? IntegerOne : IntegerZero; else return result; @@ -2285,19 +2275,18 @@ /* we need to now, whether the stream already was in the stream table (added = FALSE) */ //stream = resolve_stream(name, context, stack, TRUE, &added); - if (action == OREF_NULL) { /* no action given? */ - action_char = STREAM_STATUS; /* this is a status attempt */ - } - else { - if (action->getLength() == 0) { /* get a null string? */ - /* this is an error */ - report_exception4(Error_Incorrect_call_list, OREF_STREAM, IntegerTwo, new_string("SDC", 3), action); - } - else { - /* get the option character */ + action_char = STREAM_STATUS; /* this is a status attempt */ + if (action != OREF_NULL) { /* no action given? */ + if (action->getLength() == 0) { /* get a null string? */ + /* this is an error */ + report_exception4(Error_Incorrect_call_list, OREF_STREAM, IntegerTwo, new_string("SDC", 3), action); + } + /* get the option character */ action_char = toupper(action->getChar(0)); - } } + + result = OREF_NULL; + switch (action_char) { /* process the options */ case STREAM_STATUS: /* stream(name, s) */ if (argcount > 2) { /* given a third argument? */ @@ -2395,7 +2384,7 @@ #define CONDITION_option 1 BUILTIN(CONDITION) { - INT style; /* style of condition output */ + int style = 'I'; /* style of condition output */ RexxString *option; /* function option */ RexxDirectory *conditionobj; /* current trapped condition object */ RexxObject *result; /* returned result */ @@ -2403,14 +2392,15 @@ fix_args(CONDITION); /* expand arguments to full value */ /* get the option string */ option = optional_string(CONDITION, option); - if (option == OREF_NULL) /* just using default format? */ - style = 'I'; /* use the 'Normal form */ - else if (option->getLength() == 0) /* have a null string? */ - /* this is an error */ - report_exception4(Error_Incorrect_call_list, new_cstring(CHAR_CONDITION), IntegerOne, new_string("ACDIOS", 6), option); - else /* need to process an option */ - /* option is first character */ - style = toupper(option->getChar(0)); + if (option != OREF_NULL) /* just using default format? */ + { + if (option->getLength() == 0) /* have a null string? */ + /* this is an error */ + report_exception4(Error_Incorrect_call_list, new_cstring(CHAR_CONDITION), IntegerOne, new_string("ACDIOS", 6), option); + + /* option is first character */ + style = toupper(option->getChar(0)); + } /* get current trapped condition */ conditionobj = context->getConditionObj(); Modified: interpreter-3.x/trunk/kernel/expression/ExpressionFunction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/expression/ExpressionFunction.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/expression/ExpressionFunction.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -59,7 +59,7 @@ RexxString *function_name, /* name of the function */ size_t argCount, /* count of arguments */ RexxQueue *arglist, /* function arguments */ - LONG builtin_index, /* index of possible built-in func */ + size_t builtinIndex, /* index of possible built-in func */ BOOL string ) /* string or symbol invocation */ /******************************************************************************/ /* Function: Create a function expression object */ @@ -79,7 +79,7 @@ } /* set the builtin index for later */ /* resolution step */ - this->builtin_index = (SHORT)builtin_index; + this->builtin_index = builtinIndex; if (string) /* have a string lookup? */ this->flags |= function_nointernal;/* do not check for internal routines*/ @@ -113,8 +113,8 @@ /* Function: Normal garbage collection live marking */ /******************************************************************************/ { - INT i; /* loop counter */ - INT count; /* argument count */ + size_t i; /* loop counter */ + size_t count; /* argument count */ setUpMemoryMark memory_mark(this->u_name); @@ -129,8 +129,8 @@ /* Function: Generalized object marking */ /******************************************************************************/ { - INT i; /* loop counter */ - INT count; /* argument count */ + size_t i; /* loop counter */ + size_t count; /* argument count */ setUpMemoryMarkGeneral memory_mark_general(this->u_name); @@ -145,8 +145,8 @@ /* Function: Flatten an object */ /******************************************************************************/ { - INT i; /* loop counter */ - INT count; /* argument count */ + size_t i; /* loop counter */ + size_t count; /* argument count */ setUpFlatten(RexxExpressionFunction) @@ -165,9 +165,9 @@ /* Function: Execute a REXX function */ /******************************************************************************/ { - RexxObject *result; /* returned result */ - INT argcount; /* count of arguments */ - INT i; /* loop counter */ + RexxObject *result = OREF_NULL; /* returned result */ + size_t argcount; /* count of arguments */ + size_t i; /* loop counter */ LONG stacktop; /* top location on the stack */ context->activity->stackSpace(); /* check if enough stack is there */ Modified: interpreter-3.x/trunk/kernel/expression/ExpressionFunction.hpp =================================================================== --- interpreter-3.x/trunk/kernel/expression/ExpressionFunction.hpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/expression/ExpressionFunction.hpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -53,7 +53,7 @@ class RexxExpressionFunction : public RexxInternalObject { public: - RexxExpressionFunction(RexxString *, size_t, RexxQueue *, LONG, BOOL); + RexxExpressionFunction(RexxString *, size_t, RexxQueue *, size_t, BOOL); inline RexxExpressionFunction(RESTORETYPE restoreType) { ; }; void resolve(RexxDirectory *); void live(); Modified: interpreter-3.x/trunk/kernel/instructions/CallInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/CallInstruction.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/CallInstruction.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -55,8 +55,8 @@ extern pbuiltin builtin_table[]; /* table of builtin function stubs */ RexxInstructionCall::RexxInstructionCall( - RexxObject *name, /* CALL name */ - RexxString *condition, /* CALL ON/OFF condition */ + RexxObject *_name, /* CALL name */ + RexxString *_condition, /* CALL ON/OFF condition */ size_t argCount, /* count of arguments */ RexxQueue *argList, /* call arguments */ CHAR flags, /* CALL flags */ @@ -66,9 +66,9 @@ /******************************************************************************/ { /* set the name */ - OrefSet(this, this->name, (RexxString *)name); + OrefSet(this, this->name, (RexxString *)_name); /* and the condition */ - OrefSet(this, this->condition, condition); + OrefSet(this, this->condition, _condition); i_flags = flags; /* copy the flags */ call_builtin_index = builtin_index; /* and the builtin function index */ /* no arguments */ @@ -84,8 +84,8 @@ /* Function: Normal garbage collection live marking */ /******************************************************************************/ { - INT i; /* loop counter */ - INT count; /* argument count */ + size_t i; /* loop counter */ + size_t count; /* argument count */ setUpMemoryMark memory_mark(this->nextInstruction); /* must be first one marked */ @@ -102,8 +102,8 @@ /* Function: Generalized object marking */ /******************************************************************************/ { - INT i; /* loop counter */ - INT count; /* argument count */ + size_t i; /* loop counter */ + size_t count; /* argument count */ setUpMemoryMarkGeneral /* must be first one marked */ @@ -121,8 +121,8 @@ /* Function: Flatten an object */ /******************************************************************************/ { - INT i; /* loop counter */ - INT count; /* argument count */ + size_t i; /* loop counter */ + size_t count; /* argument count */ setUpFlatten(RexxInstructionCall) @@ -172,13 +172,13 @@ /* Function: Execute a REXX CALL instruction */ /******************************************************************************/ { - INT argcount; /* count of arguments */ - INT i; /* loop counter */ - INT type; /* type of call */ - INT builtin_index; /* builtin function index */ - RexxObject *result; /* returned result */ - RexxInstruction *target; /* resolved call target */ - RexxString *name; /* resolved function name */ + size_t argcount; /* count of arguments */ + size_t i; /* loop counter */ + int type; /* type of call */ + int builtin_index; /* builtin function index */ + RexxObject *result = OREF_NULL;/* returned result */ + RexxInstruction *_target; /* resolved call target */ + RexxString *_name; /* resolved function name */ RexxDirectory *labels; /* labels table */ context->activity->stackSpace(); /* check if enough stack is there */ @@ -196,17 +196,17 @@ /* evaluate the variable */ result = this->name->evaluate(context, stack); stack->toss(); /* toss the top item */ - name = REQUEST_STRING(result); /* force to string form */ + _name = REQUEST_STRING(result); /* force to string form */ context->traceResult(name); /* trace if necessary */ /* resolve potential builtins */ - builtin_index = context->source->resolveBuiltin(name); - target = OREF_NULL; /* clear out the target */ + builtin_index = context->source->resolveBuiltin(_name); + _target = OREF_NULL; /* clear out the target */ labels = context->getLabels(); /* get the labels table */ if (labels != OREF_NULL) /* have labels in the program? */ /* look up label and go to normal */ /* signal processing */ - target = (RexxInstruction *)(labels->at(name)); - if (target != OREF_NULL) /* found one? */ + _target = (RexxInstruction *)(labels->at(_name)); + if (_target != OREF_NULL) /* found one? */ type = call_internal; /* have an internal call */ /* have a builtin by this name? */ else if (builtin_index != NO_BUILTIN) @@ -215,8 +215,8 @@ type = call_external; /* set as so */ } else { /* set up for a normal call */ - target = this->target; /* copy the target */ - name = (RexxString *)this->name; /* the name value */ + _target = this->target; /* copy the target */ + _name = (RexxString *)this->name; /* the name value */ /* and the builtin index */ builtin_index = call_builtin_index; type = i_flags&call_type_mask; /* just copy the type info */ @@ -242,7 +242,7 @@ case call_internal: /* need to process internal routine */ /* go process the internal call */ - result = context->internalCall(target, argcount, stack); + result = context->internalCall(_target, argcount, stack); break; case call_builtin: /* builtin function call */ @@ -252,7 +252,7 @@ case call_external: /* need to call externally */ /* go process the external call */ - result = context->externalCall(name, argcount, stack, OREF_ROUTINENAME); + result = context->externalCall(_name, argcount, stack, OREF_ROUTINENAME); break; } if (result != OREF_NULL) { /* result returned? */ Modified: interpreter-3.x/trunk/kernel/instructions/DoBlock.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/DoBlock.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/DoBlock.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -47,15 +47,15 @@ #include "DoBlock.hpp" RexxDoBlock::RexxDoBlock( - RexxBlockInstruction* parent, /* parent DO block */ - INT indent ) /* current indentation level */ + RexxBlockInstruction* _parent, /* parent DO block */ + INT _indent ) /* current indentation level */ /******************************************************************************/ /* Function: complete BLOCK instruction initialization */ /******************************************************************************/ { ClearObject(this); /*Clear the object. */ - OrefSet(this, this->parent, parent); /* remember the parent block */ - this->indent = indent; /* save the indentation level */ + OrefSet(this, this->parent, _parent); /* remember the parent block */ + this->indent = _indent; /* save the indentation level */ } void RexxDoBlock::live() Modified: interpreter-3.x/trunk/kernel/instructions/DoInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/DoInstruction.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/DoInstruction.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -59,7 +59,7 @@ void RexxInstructionDo::matchLabel( - RexxInstructionEnd *end, /* end to match up */ + RexxInstructionEnd *_end, /* end to match up */ RexxSource *source ) /* parsed source file (for errors) */ /******************************************************************************/ /* Function: Verify that the name on an END and the END statement match */ @@ -69,8 +69,8 @@ LOCATIONINFO location; /* location of the end */ size_t lineNum; /* instruction line number */ - name = end->name; /* get then END name */ - end->getLocation(&location); /* get location of END instruction */ + name = _end->name; /* get then END name */ + _end->getLocation(&location); /* get location of END instruction */ if (name != OREF_NULL) { /* was a name given? */ lineNum = this->lineNumber; /* Instruction line number */ @@ -297,7 +297,7 @@ /* an integer value already, and */ /* we're dealing with a "normal */ /* NUMERIC DIGITS setting */ - if (OTYPE(Integer, result) && context->digits() >= DEFAULT_DIGITS) { + if (OTYPE(Integer, result) && context->digits() >= (long)DEFAULT_DIGITS) { /* get the value directly */ count = ((RexxInteger *)result)->getValue(); context->traceResult(result);/* trace if necessary */ @@ -314,7 +314,7 @@ count = REQUEST_LONG(result, NO_LONG); } /* bad value, too small or too big? */ - if (count == NO_LONG || count < 0) + if (count == (long)NO_LONG || count < 0) /* report an exception */ report_exception1(Error_Invalid_whole_number_repeat, object); doblock->setFor(count); /* save the new value */ @@ -330,7 +330,7 @@ /* an integer value already, and */ /* we're dealing with a "normal */ /* NUMERIC DIGITS setting */ - if (OTYPE(Integer, result) && context->digits() >= DEFAULT_DIGITS) { + if (OTYPE(Integer, result) && context->digits() >= (long)DEFAULT_DIGITS) { /* get the value directly */ count = ((RexxInteger *)result)->getValue(); context->traceResult(result);/* trace if necessary */ @@ -347,7 +347,7 @@ count = REQUEST_LONG(result, NO_LONG); } /* bad value, too small or too big? */ - if (count == NO_LONG || count < 0) + if (count == (long)NO_LONG || count < 0) /* report an exception */ report_exception1(Error_Invalid_whole_number_repeat, object); doblock->setFor(count); /* save the new value */ @@ -425,14 +425,14 @@ { size_t i; /* loop control variable */ RexxObject *result; /* expression result */ - RexxObject *initial; /* initial variable value */ + RexxObject *_initial; /* initial variable value */ RexxObject *object; /* original result object (for error)*/ LONG count; /* for count */ /* evaluate the initial expression */ - initial = this->initial->evaluate(context, stack); + _initial = this->initial->evaluate(context, stack); /* force rounding */ - initial = callOperatorMethod(initial, OPERATOR_PLUS, OREF_NULL); + _initial = callOperatorMethod(_initial, OPERATOR_PLUS, OREF_NULL); /* process each of the expressions */ for (i = 0; i < 3 && this->expressions[i] != 0; i++) { switch (this->expressions[i]) { /* process various keywords */ @@ -477,7 +477,7 @@ /* an integer value already, and */ /* we're dealing with a "normal */ /* NUMERIC DIGITS setting */ - if (OTYPE(Integer, result) && context->digits() >= DEFAULT_DIGITS) + if (OTYPE(Integer, result) && context->digits() >= (long)DEFAULT_DIGITS) { /* get the value directly */ count = ((RexxInteger *)result)->getValue(); @@ -495,7 +495,7 @@ count = REQUEST_LONG(result, NO_LONG); } /* bad value, too small or too big? */ - if (count == NO_LONG || count < 0) + if (count == (long)NO_LONG || count < 0) /* report an exception */ report_exception1(Error_Invalid_whole_number_for, object); doblock->setFor(count); /* save the new value */ @@ -509,7 +509,7 @@ doblock->setCompare(OPERATOR_GREATERTHAN); } /* do the initial assignment */ - this->control->assign(context, stack, initial); + this->control->assign(context, stack, _initial); } BOOL RexxInstructionDo::checkOver( Modified: interpreter-3.x/trunk/kernel/instructions/EndIf.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/EndIf.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/EndIf.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -49,13 +49,13 @@ RexxInstructionEndIf::RexxInstructionEndIf( - RexxInstructionIf *parent) /* base parent instruction (IF/WHEN) */ + RexxInstructionIf *_parent) /* base parent instruction (IF/WHEN) */ /******************************************************************************/ /* Function: Complete initialization of a PARSE ENDIF object */ /******************************************************************************/ { this->setType(KEYWORD_ENDTHEN); /* set the default type */ - OrefSet(this, this->parent, parent); /* remember parent IF/WHEN/ELSE */ + OrefSet(this, this->parent, _parent);/* remember parent IF/WHEN/ELSE */ parent->setEndInstruction(this); /* hook up with the parent object */ /* is this the ELSE end? */ if (parent->instructionInfo.type == KEYWORD_ELSE) Modified: interpreter-3.x/trunk/kernel/instructions/EndInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/EndInstruction.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/EndInstruction.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -50,12 +50,12 @@ #include "DoBlock.hpp" RexxInstructionEnd::RexxInstructionEnd( - RexxString *name) /* The END instruction name */ + RexxString *_name) /* The END instruction name */ /****************************************************************************/ /* Function: Set the name of an END instruction */ /****************************************************************************/ { - OrefSet(this, this->name, name); + OrefSet(this, this->name, _name); } void RexxInstructionEnd::live() Modified: interpreter-3.x/trunk/kernel/instructions/ForwardInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/ForwardInstruction.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/ForwardInstruction.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -104,36 +104,36 @@ /* Function: Execute a forward instruction */ /******************************************************************************/ { - RexxObject *target; /* evaluated target */ - RexxString *message; /* evaluated message */ - RexxObject *superClass; /* evaluated super class */ + RexxObject *_target; /* evaluated target */ + RexxString *_message; /* evaluated message */ + RexxObject *_superClass; /* evaluated super class */ RexxObject *result; /* message result */ RexxObject *temp; /* temporary object */ size_t count = 0; /* count of array expressions */ size_t i; /* loop counter */ - RexxObject **arguments; + RexxObject **_arguments; context->traceInstruction(this); /* trace if necessary */ if (!context->inMethod()) /* is this a method clause? */ /* raise an error */ report_exception(Error_Execution_forward); - target = OREF_NULL; /* no object yet */ - message = OREF_NULL; /* no message over ride */ - superClass = OREF_NULL; /* no super class over ride */ - arguments = OREF_NULL; /* no argument over ride */ + _target = OREF_NULL; /* no object yet */ + _message = OREF_NULL; /* no message over ride */ + _superClass = OREF_NULL; /* no super class over ride */ + _arguments = OREF_NULL; /* no argument over ride */ if (this->target != OREF_NULL) /* sent to a different object? */ /* get the expression value */ - target = this->target->evaluate(context, stack); + _target = this->target->evaluate(context, stack); if (this->message != OREF_NULL) { /* sending a different message? */ /* get the expression value */ temp = this->message->evaluate(context, stack); - message = REQUEST_STRING(temp); /* get the string version */ - message = message->upper(); /* and force to uppercase */ + _message = REQUEST_STRING(temp); /* get the string version */ + _message = _message->upper(); /* and force to uppercase */ } if (this->superClass != OREF_NULL) /* overriding the super class? */ /* get the expression value */ - superClass = this->superClass->evaluate(context, stack); + _superClass = this->superClass->evaluate(context, stack); if (this->arguments != OREF_NULL) { /* overriding the arguments? */ /* get the expression value */ temp = this->arguments->evaluate(context, stack); @@ -156,7 +156,7 @@ count--; /* step back the count */ } } - arguments = argArray->data(); /* point directly to the argument data */ + _arguments = argArray->data(); /* point directly to the argument data */ } if (this->array != OREF_NULL) { /* have an array of extra info? */ count = this->array->size(); /* get the expression count */ @@ -173,10 +173,10 @@ } } /* now point at the stacked values */ - arguments = stack->arguments(count); + _arguments = stack->arguments(count); } /* go forward this */ - result = context->forward(target, message, superClass, arguments, count, i_flags&forward_continue); + result = context->forward(_target, _message, _superClass, _arguments, count, i_flags&forward_continue); if (i_flags&forward_continue) { /* not exiting? */ if (result != OREF_NULL) { /* result returned? */ context->traceResult(result); /* trace if necessary */ Modified: interpreter-3.x/trunk/kernel/instructions/MessageInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/MessageInstruction.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/MessageInstruction.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -168,24 +168,24 @@ /****************************************************************************/ { RexxObject *result; /* message expression result */ - RexxObject *super; /* target super class */ + RexxObject *_super; /* target super class */ LONG argcount; /* count of arguments */ - RexxObject *target; /* message target */ + RexxObject *_target; /* message target */ LONG i; /* loop counter */ context->traceInstruction(this); /* trace if necessary */ /* evaluate the target */ - target = this->target->evaluate(context, stack); + _target = this->target->evaluate(context, stack); if (this->super != OREF_NULL) { /* have a message lookup override? */ - if (target != context->receiver) /* sender and receiver different? */ + if (_target != context->receiver) /* sender and receiver different? */ /* this is an error */ report_exception(Error_Execution_super); /* get the variable value */ - super = this->super->evaluate(context, stack); + _super = this->super->evaluate(context, stack); stack->toss(); /* pop the top item */ } else - super = OREF_NULL; /* use the default lookup */ + _super = OREF_NULL; /* use the default lookup */ argcount = message_argument_count; /* get the argument count */ for (i = 0; i < argcount; i++) { /* loop through the argument list */ @@ -207,7 +207,7 @@ result = stack->send(this->name, argcount); else /* evaluate the message w/override */ - result = stack->send(this->name, super, argcount); + result = stack->send(this->name, _super, argcount); stack->popn(argcount); /* remove any arguments */ if (i_flags&message_i_double) /* double twiddle form? */ result = target; /* get the target element */ Modified: interpreter-3.x/trunk/kernel/instructions/NumericInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/NumericInstruction.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/NumericInstruction.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -49,7 +49,7 @@ #include "Token.hpp" RexxInstructionNumeric::RexxInstructionNumeric( - RexxObject *expression, /* optional expression */ + RexxObject *_expression, /* optional expression */ USHORT type, /* type of numeric instruction */ UCHAR flags) /* processing flags */ /****************************************************************************/ @@ -57,7 +57,7 @@ /****************************************************************************/ { /* copy the expression */ - OrefSet(this, this->expression, expression); + OrefSet(this, this->expression, _expression); numeric_type = type; /* the type */ i_flags = flags; /* and the flag settings */ } @@ -71,8 +71,8 @@ { RexxObject *result; /* expression evaluation result */ RexxString *stringResult; /* converted string */ - LONG setting; /* binary form of the setting */ - LONG tempVal; /* temporary value for errors */ + int setting; /* binary form of the setting */ + int tempVal; /* temporary value for errors */ context->traceInstruction(this); /* trace if necessary */ /* process the different types of */ @@ -90,7 +90,7 @@ /* convert the value */ setting = REQUEST_LONG(result, NO_LONG); /* bad value? */ - if (setting == NO_LONG || setting < 1) + if (setting == (int)NO_LONG || setting < 1) /* report an exception */ report_exception1(Error_Invalid_whole_number_digits, result); /* problem with the fuzz setting? */ @@ -114,7 +114,7 @@ /* convert the value */ setting = REQUEST_LONG(result, NO_LONG); /* bad value? */ - if (setting == NO_LONG || setting < 0) + if (setting == (int)NO_LONG || setting < 0) /* report an exception */ report_exception1(Error_Invalid_whole_number_fuzz, result); /* problem with the digits setting? */ Modified: interpreter-3.x/trunk/kernel/instructions/OptionsInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/OptionsInstruction.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/OptionsInstruction.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -48,12 +48,12 @@ #include "OptionsInstruction.hpp" RexxInstructionOptions::RexxInstructionOptions( - RexxObject *expression) /* associated expression object */ + RexxObject *_expression) /* associated expression object */ /******************************************************************************/ /* Initialize a REXX OPTION instruction */ /******************************************************************************/ { - OrefSet(this, this->expression, expression); + OrefSet(this, this->expression, _expression); } void RexxInstructionOptions::execute( @@ -64,18 +64,18 @@ /******************************************************************************/ { RexxObject *value; /* output value */ - RexxString *stringValue; /* string version of the value */ + RexxString *stringVal; /* string version of the value */ LONG i; /* loop counter */ RexxString *word; /* current word */ context->traceInstruction(this); /* trace if necessary */ /* get the expression value */ value = this->expression->evaluate(context, stack); - stringValue = REQUEST_STRING(value); /* get the string version */ + stringVal = REQUEST_STRING(value); /* get the string version */ context->traceResult(value); /* trace the output value */ for (i = 1; ;i++) { /* now process each word */ /* get the next word */ - word = (RexxString *)(stringValue->word(new_integer(i))); + word = (RexxString *)(stringVal->word(new_integer(i))); if (word->getLength() == 0) /* get the length of the word */ break; /* if length of word = 0 then stop */ Modified: interpreter-3.x/trunk/kernel/instructions/ParseTarget.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/ParseTarget.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/ParseTarget.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -55,10 +55,10 @@ extern ACTIVATION_SETTINGS *current_settings; void RexxTarget::init( - RexxObject *string, /* target string */ - RexxObject **arglist, /* argument list */ - size_t argcount, /* size of the argument list */ - BOOL translate, /* translation flag */ + RexxObject *_string, /* target string */ + RexxObject **_arglist, /* argument list */ + size_t _argcount, /* size of the argument list */ + BOOL _translate, /* translation flag */ BOOL multiple, /* have multiple strings */ RexxActivation *context, /* execution context */ RexxExpressionStack *s) /* current expression stack */ @@ -66,10 +66,10 @@ /* Function: Initialize a parse target object */ /******************************************************************************/ { - this->translate = translate; /* save the translation flag */ - this->arglist = arglist; /* we have an array of strings */ - this->argcount = argcount; - this->string = (RexxString *)string; /* save the string also */ + this->translate = _translate; /* save the translation flag */ + this->arglist = _arglist; /* we have an array of strings */ + this->argcount = _argcount; + this->string = (RexxString *)_string; /* save the string also */ this->next_argument = 1; /* start with the first argument */ this->stack = s; // save the expression stack for saving object references in this->stackTop = s->location(); // save the stack top for resets @@ -259,7 +259,7 @@ void RexxTarget::search( - RexxString *string) /* target search string */ + RexxString *needle) /* target search string */ /******************************************************************************/ /* Arguments: target location string */ /******************************************************************************/ @@ -269,10 +269,10 @@ /* search for the string trigger */ /* use DBCS character count as index into DBCS string */ if (DBCS_MODE) { - this->end = this->string->pos(string, + this->end = this->string->pos(needle, DBCS_CharacterCount(this->string->getStringData(), this->start)); } else { - this->end = this->string->pos(string, this->start); + this->end = this->string->pos(needle, this->start); } if (this->end == 0) { /* not found? */ this->end = this->string_length; /* that is the end position */ @@ -294,7 +294,7 @@ } void RexxTarget::caselessSearch( - RexxString *string) /* target search string */ + RexxString *needle) /* target search string */ /******************************************************************************/ /* Arguments: target location string */ /******************************************************************************/ @@ -304,10 +304,10 @@ /* search for the string trigger */ /* use DBCS character count as index into DBCS string */ if (DBCS_MODE) { - this->end = this->string->caselessPos(string, + this->end = this->string->caselessPos(needle, DBCS_CharacterCount(this->string->getStringData(), this->start)); } else { - this->end = this->string->caselessPos(string, this->start); + this->end = this->string->caselessPos(needle, this->start); } if (this->end == 0) { /* not found? */ this->end = this->string_length; /* that is the end position */ Modified: interpreter-3.x/trunk/kernel/instructions/ParseTrigger.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/ParseTrigger.cpp 2007-10-24 23:22:08 UTC (rev 1075) +++ interpreter-3.x/trunk/kernel/instructions/ParseTrigger.cpp 2007-10-24 23:33:55 UTC (rev 1076) @@ -51,25 +51,25 @@ #include "ExpressionBaseVariable.hpp" RexxTrigger::RexxTrigger( - INT type, /* type of trigger */ - RexxObject *value, /* value to evaluatate */ - LONG variableCount, /* count of variables ... [truncated message content] |
From: <mie...@us...> - 2007-05-07 04:48:30
|
Revision: 358 http://svn.sourceforge.net/oorexx/?rev=358&view=rev Author: miesfeld Date: 2007-05-06 21:48:32 -0700 (Sun, 06 May 2007) Log Message: ----------- Fix compiler errors on Linux. error: extra qualification 'xx::' on member 'yy' Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/StringClass.hpp interpreter-3.x/trunk/kernel/parser/SourceFile.hpp Modified: interpreter-3.x/trunk/kernel/classes/StringClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/StringClass.hpp 2007-05-06 22:37:00 UTC (rev 357) +++ interpreter-3.x/trunk/kernel/classes/StringClass.hpp 2007-05-07 04:48:32 UTC (rev 358) @@ -236,8 +236,8 @@ RexxInteger *primitiveCompareTo(RexxString *other, stringsize_t start, stringsize_t len); RexxInteger *primitiveCaselessCompareTo(RexxString *other, stringsize_t start, stringsize_t len); - RexxInteger *RexxString::equals(RexxString *other); - RexxInteger *RexxString::caselessEquals(RexxString *other); + RexxInteger *equals(RexxString *other); + RexxInteger *caselessEquals(RexxString *other); RexxArray *makeArray(RexxString *); Modified: interpreter-3.x/trunk/kernel/parser/SourceFile.hpp =================================================================== --- interpreter-3.x/trunk/kernel/parser/SourceFile.hpp 2007-05-06 22:37:00 UTC (rev 357) +++ interpreter-3.x/trunk/kernel/parser/SourceFile.hpp 2007-05-07 04:48:32 UTC (rev 358) @@ -213,7 +213,7 @@ RexxInstruction *commandNew(); RexxInstruction *doNew(); RexxInstruction *loopNew(); - RexxInstruction *RexxSource::createLoop(); + RexxInstruction *createLoop(); RexxInstruction *createDoLoop(RexxInstructionDo *, bool); RexxInstruction *dropNew(); RexxInstruction *elseNew(RexxToken *); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-08 20:03:29
|
Revision: 363 http://svn.sourceforge.net/oorexx/?rev=363&view=rev Author: bigrixx Date: 2007-05-08 13:03:30 -0700 (Tue, 08 May 2007) Log Message: ----------- Remove UNINIT forcing from the drop instruction. Modified Paths: -------------- interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp interpreter-3.x/trunk/kernel/instructions/DropInstruction.cpp Modified: interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp =================================================================== --- interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp 2007-05-08 13:53:34 UTC (rev 362) +++ interpreter-3.x/trunk/kernel/expression/BuiltinFunctions.cpp 2007-05-08 20:03:30 UTC (rev 363) @@ -2659,15 +2659,6 @@ result = (RexxString *)send_message2(stream, OREF_LINEOUT, string, line); break; } - // close or open error? - //if (argcount == 1 && name->length > 0 || added && ((RexxInteger *)result)->value > 0) - //{ - // // remove from stream table - // context->settings.streams->remove(fullName); - // force uninit of the stream object to collect orphaned memory - // memoryObject.reclaim(); - // CurrentActivity->uninitObject((RexxObject *)stream); - //} } return result; /* all finished */ } @@ -2711,15 +2702,6 @@ result = (RexxString *)send_message2(stream, OREF_CHAROUT, string, position); break; } - // close or open error? - //if (argcount == 1 && name->length > 0 || added && ((RexxInteger *)result)->value > 0) - //{ - // remove from stream table - // context->settings.streams->remove(fullName); - // force uninit of the stream object to collect orphaned memory - // memoryObject.reclaim(); - // CurrentActivity->uninitObject((RexxObject *)stream); - //} return result; /* all finished */ } @@ -2915,19 +2897,6 @@ } } - // remove from streamTable - //if (fClose || added && fOpen && !((RexxString *)result)->isEqual(new_cstring("READY:"))) - //{ - // context->settings.streams->remove(fullName); - // force uninit of the stream object to collect orphaned memory - // but only when stream should is closed */ - // if (fClose) - // { - // memoryObject.reclaim(); - // CurrentActivity->uninitObject((RexxObject *)stream); - // } - //} - discard(command); /* use discard instead of discard_hold */ discard(command_upper); /* use discard instead of discard_hold */ break; Modified: interpreter-3.x/trunk/kernel/instructions/DropInstruction.cpp =================================================================== --- interpreter-3.x/trunk/kernel/instructions/DropInstruction.cpp 2007-05-08 13:53:34 UTC (rev 362) +++ interpreter-3.x/trunk/kernel/instructions/DropInstruction.cpp 2007-05-08 20:03:30 UTC (rev 363) @@ -122,7 +122,6 @@ { size_t size; /* size of guard variables list */ size_t i; /* loop counter */ - BOOL forceUninits = FALSE; /* objects that require uninit methods */ context->traceInstruction(this); /* trace if necessary */ /* get the array size */ @@ -131,29 +130,9 @@ for (i = 0; i < size; i++) { /* loop through the variable list */ /* get the value of the variable */ RexxObject *varObject = this->variables[i]->getValue(context); - /* does the referenced value have an uninit method? If we find */ - /* one that does, we're going to have to force a GC and run the */ - /* uninit methods when we finish dropping */ - if (varObject != OREF_NULL && CurrentActivity->isPendingUninit(varObject)) { - /* we wan */ - forceUninits = TRUE; - } /* have the variable drop itself */ variables[i]->drop(context); } - - /* if we have objects with uninit methods that we've just dropped */ - /* references to, we try to run the uninit methods now, as that */ - /* is what the user expectations are. However, since a memory */ - /* reclaim operation is very expensive, we only do this if we've */ - /* dropped references to objects with uninit methods. */ - if (forceUninits) { - /* make sure dead objects are marked dead in the uninit table */ - memoryObject.reclaim(); - /* now go run the uninit stuff */ - TheActivityClass->checkUninitQueue(); - } - context->pauseInstruction(); /* do debug pause if necessary */ } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-29 00:35:26
|
Revision: 405 http://svn.sourceforge.net/oorexx/?rev=405&view=rev Author: bigrixx Date: 2007-05-28 17:35:19 -0700 (Mon, 28 May 2007) Log Message: ----------- [ 1727061 ] Sending "!SOMPROXY" to .environment causes a trap Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/ClassClass.cpp interpreter-3.x/trunk/kernel/runtime/GlobalNames.h interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp interpreter-3.x/trunk/kernel/runtime/RexxMemory.cpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/ClassClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ClassClass.cpp 2007-05-29 00:18:18 UTC (rev 404) +++ interpreter-3.x/trunk/kernel/classes/ClassClass.cpp 2007-05-29 00:35:19 UTC (rev 405) @@ -454,7 +454,7 @@ /* initialization. */ /* Now fill in the state data */ - if (TheObjectClass != this && TheMSomProxyClass != this && TheSomProxyClass != this) { + if (TheObjectClass != this ) { /* set up the new metaclass list */ OrefSet(this, this->metaClass, new_array1(TheClassClass)); /* the metaclass mdict list */ @@ -493,11 +493,8 @@ this->behaviour->setClass(TheClassClass); /* set the somclass to .nil */ OrefSet(this, this->somClass, (RexxInteger *)TheNilObject); - /* SOMPROXY/M_SOMPROXY aren't */ - /* primitive any more either. */ - if (TheMSomProxyClass != this && TheSomProxyClass != this) /* these are primitive classes */ - this->class_info |= PRIMITIVE_CLASS; + this->class_info |= PRIMITIVE_CLASS; if (this == TheClassClass) /* mark CLASS as a meta class */ this->setMeta(); Modified: interpreter-3.x/trunk/kernel/runtime/GlobalNames.h =================================================================== --- interpreter-3.x/trunk/kernel/runtime/GlobalNames.h 2007-05-29 00:18:18 UTC (rev 404) +++ interpreter-3.x/trunk/kernel/runtime/GlobalNames.h 2007-05-29 00:35:19 UTC (rev 405) @@ -156,8 +156,6 @@ GLOBAL_NAME(SESSION, CHAR_SESSION) GLOBAL_NAME(SET, CHAR_SET) GLOBAL_NAME(SETUID, CHAR_SETUID) - GLOBAL_NAME(SHRIEKSOMPROXY, CHAR_SHRIEKSOMPROXY) - GLOBAL_NAME(SHRIEK_CLASS, CHAR_SHRIEKCLASS) GLOBAL_NAME(SIGL, CHAR_SIGL) GLOBAL_NAME(SIGNAL, CHAR_SIGNAL) GLOBAL_NAME(SOM, CHAR_SOM) Modified: interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-05-29 00:18:18 UTC (rev 404) +++ interpreter-3.x/trunk/kernel/runtime/RexxConstants.hpp 2007-05-29 00:35:19 UTC (rev 405) @@ -302,10 +302,7 @@ CHARCONSTANT(SHRIEKREXXDEFINED, "!REXXDEFINED"); CHARCONSTANT(SHRIEKRUN, "!RUN"); CHARCONSTANT(SHRIEKSERVER_WAIT, "!SERVER_WAIT"); -CHARCONSTANT(SHRIEKSOMPROXY, "!SOMPROXY"); -CHARCONSTANT(SHRIEKM_SOMPROXY, "!M_SOMPROXY"); CHARCONSTANT(SHRIEK_STREAMS, "!STREAMS"); -CHARCONSTANT(SHRIEKSOMPROXY_UNKNOWN, "!SOMPROXY_UNKNOWN"); CHARCONSTANT(SHRIEKSOMSERVER_INITDSOM, "!SOMSERVER_INITDSOM"); CHARCONSTANT(SHRIEKSOMSERVER_INITDSOMWPS, "!SOMSERVER_INITDSOMWPS"); CHARCONSTANT(SIGL, "SIGL"); Modified: interpreter-3.x/trunk/kernel/runtime/RexxMemory.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxMemory.cpp 2007-05-29 00:18:18 UTC (rev 404) +++ interpreter-3.x/trunk/kernel/runtime/RexxMemory.cpp 2007-05-29 00:35:19 UTC (rev 405) @@ -2102,7 +2102,6 @@ TheNativeCodeClass = (RexxNativeCodeClass *)TheSaveArray->get(saveArray_NMETHOD); TheGenericSomMethod = (RexxSOMCode *)TheSaveArray->get(saveArray_GENERIC_SOMMETHOD); TheCommonRetrievers = (RexxDirectory *)TheSaveArray->get(saveArray_COMMON_RETRIEVERS); - TheMSomProxyClass = (RexxSOMProxyClass *)TheSaveArray->get(saveArray_M_SOMPROXY); TheStaticRequires = (RexxDirectory *)TheSaveArray->get(saveArray_STATIC_REQ); ThePublicRoutines = (RexxDirectory *)TheSaveArray->get(saveArray_PUBLIC_RTN); @@ -2121,7 +2120,6 @@ RESTORE_CLASS(NumberString, numberstring, RexxNumberStringClass); RESTORE_CLASS(Queue, queue, RexxClass); RESTORE_CLASS(Stem, stem, RexxClass); - RESTORE_CLASS(SomProxy, somproxy, RexxSOMProxyClass); RESTORE_CLASS(Supplier, supplier, RexxClass); RESTORE_CLASS(Table, table, RexxClass); RESTORE_CLASS(Relation, relation, RexxClass); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-29 00:18:18 UTC (rev 404) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-29 00:35:19 UTC (rev 405) @@ -604,7 +604,6 @@ CLASS_CREATE(Message, RexxClass); /* RexxMessage */ CLASS_CREATE(MutableBuffer, RexxClass); - somproxy_create(); /* RexxSOMProxy */ /* build the common retriever tables */ TheCommonRetrievers = (RexxDirectory *)new_directory(); /* add all of the special variables */ @@ -1547,8 +1546,6 @@ kernel_public(CHAR_STRING ,TheStringClass ,TheEnvironment); kernel_public(CHAR_MUTABLEBUFFER ,TheMutableBufferClass ,TheEnvironment); kernel_public(CHAR_STEM ,TheStemClass ,TheEnvironment); - kernel_public(CHAR_SHRIEKSOMPROXY ,TheSomProxyClass,TheEnvironment); - kernel_public(CHAR_SHRIEKM_SOMPROXY ,TheMSomProxyClass,TheEnvironment); kernel_public(CHAR_SUPPLIER ,TheSupplierClass,TheEnvironment); kernel_public(CHAR_SYSTEM ,TheSystem ,TheEnvironment); kernel_public(CHAR_TABLE ,TheTableClass ,TheEnvironment); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-29 15:35:54
|
Revision: 408 http://svn.sourceforge.net/oorexx/?rev=408&view=rev Author: bigrixx Date: 2007-05-29 08:35:52 -0700 (Tue, 29 May 2007) Log Message: ----------- [ 1727098 ] 'instanceMethods' on class objects: duplicates, and missing? Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp interpreter-3.x/trunk/kernel/runtime/RexxBehaviour.cpp interpreter-3.x/trunk/kernel/runtime/RexxBehaviour.hpp interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp 2007-05-29 14:15:44 UTC (rev 407) +++ interpreter-3.x/trunk/kernel/classes/ObjectClass.cpp 2007-05-29 15:35:52 UTC (rev 408) @@ -275,37 +275,8 @@ */ RexxSupplier *RexxObject::instanceMethods(RexxClass *class_object) { - /* if no parameter specified */ - /* return my behaviour mdict as a */ - /* supplier object */ - if (class_object == OREF_NULL) - { - return this->behaviour->getMethodDictionary()->supplier(); - } - /* if TheNilObject specified */ - /* return my instance mdict as a */ - /* supplier object */ - if (class_object == TheNilObject) - { - // we might not have instance methods defined. - RexxTable *instanceMethods = this->behaviour->getInstanceMethodDictionary(); - if (instanceMethods != OREF_NULL) - { - return instanceMethods->supplier(); - } - // no instance methods, return a null supplier - return (RexxSupplier *)TheNullArray->supplier(); - } - - // if we're an instance of that class - if (isInstanceOf(class_object)) - { - /* let the class specified return */ - /* it's own methods */ - return (RexxSupplier *)send_message1(class_object, OREF_METHODS, TheNilObject); - } - /* or just return a null supplier */ - return (RexxSupplier *)TheNullArray->supplier(); + // the behaviour handles all of this + return this->behaviour->getMethods(class_object); } Modified: interpreter-3.x/trunk/kernel/runtime/RexxBehaviour.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxBehaviour.cpp 2007-05-29 14:15:44 UTC (rev 407) +++ interpreter-3.x/trunk/kernel/runtime/RexxBehaviour.cpp 2007-05-29 15:35:52 UTC (rev 408) @@ -441,6 +441,56 @@ } } + +/** + * Extract from the method dictionary all methods defined with + * a given scope. + * + * @param scope The target scope. If null, then all methods + * are returned. + * + * @return A supplier holding the names and methods with the target + * scope. This supplier can be empty. + */ +RexxSupplier *RexxBehaviour::getMethods(RexxObject *scope) +{ + // if asking for everything, just return the supplier. + if (scope == OREF_NULL) + { + return this->methodDictionary->supplier(); + } + + size_t count = 0; + + long i; + // travese the method dictionary, searching for methods with the target scope + for (i = this->methodDictionary->first(); this->methodDictionary->index(i) != OREF_NULL; i = this->methodDictionary->next(i)) + { + if (((RexxMethod *)this->methodDictionary->value(i))->getScope() == scope) + { + count++; + } + } + + RexxArray *names = new_array(count); + RexxArray *methods = new_array(count); + count = 1; + + // pass two, copy the entries into the array + for (i = this->methodDictionary->first(); this->methodDictionary->index(i) != OREF_NULL; i = this->methodDictionary->next(i)) + { + if (((RexxMethod *)this->methodDictionary->value(i))->getScope() == scope) + { + names->put(this->methodDictionary->index(i), count); + methods->put(this->methodDictionary->value(i), count); + count++; + } + } + + return (RexxSupplier *)new_supplier(methods, names); +} + + RexxObject *RexxBehaviour::setScopes( RexxObjectTable *newscopes) /* new table of scopes */ /******************************************************************************/ Modified: interpreter-3.x/trunk/kernel/runtime/RexxBehaviour.hpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxBehaviour.hpp 2007-05-29 14:15:44 UTC (rev 407) +++ interpreter-3.x/trunk/kernel/runtime/RexxBehaviour.hpp 2007-05-29 15:35:52 UTC (rev 408) @@ -90,6 +90,7 @@ RexxObject *mergeScope( RexxObject *); BOOL checkScope( RexxObject *); void subclass(RexxBehaviour *); + RexxSupplier *getMethods(RexxObject *scope); void merge( RexxBehaviour *); void methodDictionaryMerge( RexxTable *); Modified: interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp 2007-05-29 14:15:44 UTC (rev 407) +++ interpreter-3.x/trunk/kernel/runtime/RexxCollection.cpp 2007-05-29 15:35:52 UTC (rev 408) @@ -153,7 +153,14 @@ /* Returned: Nothing */ /******************************************************************************/ { - return this->add(value, index); + // put this in with duplicate protection + RexxHashTable *newHash = this->contents->putNodupe(value, index); + // the put can expand, so protect against that + if (newHash != OREF_NULL) + { + OrefSet(this, this->contents, newHash); + } + return OREF_NULL; } RexxObject *RexxHashTableCollection::removeRexx( Modified: interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp 2007-05-29 14:15:44 UTC (rev 407) +++ interpreter-3.x/trunk/kernel/runtime/RexxHashTable.cpp 2007-05-29 15:35:52 UTC (rev 408) @@ -1189,6 +1189,7 @@ return result; /* return the count */ } + RexxObject *RexxHashTable::merge( RexxHashTableCollection *target) /* target other collection */ /******************************************************************************/ @@ -1207,6 +1208,7 @@ return OREF_NULL; /* always returns nothing */ } + void RexxHashTable::reMerge( RexxHashTable *newHash) /* target other collection */ /******************************************************************************/ Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-29 14:15:44 UTC (rev 407) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-29 15:35:52 UTC (rev 408) @@ -731,14 +731,12 @@ defineProtectedKernelMethod(CHAR_DELETE ,TheClassBehaviour, CPPMC(RexxClass::deleteMethod), 1); defineKernelMethod(CHAR_ENHANCED ,TheClassBehaviour, CPPMC(RexxClass::enhanced), A_COUNT); defineKernelMethod(CHAR_ID ,TheClassBehaviour, CPPMC(RexxClass::getId), 0); - defineKernelMethod(CHAR_IMPORTED ,TheClassBehaviour, CPPMC(RexxClass::importedRexx), 0); defineKernelMethod(CHAR_INHERIT ,TheClassBehaviour, CPPMC(RexxClass::inherit), 2); defineProtectedKernelMethod(CHAR_METACLASS ,TheClassBehaviour, CPPMC(RexxClass::getMetaClass), 0); defineKernelMethod(CHAR_METHOD ,TheClassBehaviour, CPPMC(RexxClass::method), 1); defineKernelMethod(CHAR_METHODS ,TheClassBehaviour, CPPMC(RexxClass::methods), 1); defineKernelMethod(CHAR_MIXINCLASS ,TheClassBehaviour, CPPMC(RexxClass::mixinclass), 3); defineKernelMethod(CHAR_QUERYMIXINCLASS ,TheClassBehaviour, CPPMC(RexxClass::queryMixinClass), 0); - defineKernelMethod(CHAR_NEWOPART ,TheClassBehaviour, CPPMC(RexxClass::newOpart), 1); defineKernelMethod(CHAR_SUBCLASS ,TheClassBehaviour, CPPMC(RexxClass::subclass), 3); defineProtectedKernelMethod(CHAR_SUBCLASSES ,TheClassBehaviour, CPPMC(RexxClass::getSubClasses), 0); defineProtectedKernelMethod(CHAR_SUPERCLASSES ,TheClassBehaviour, CPPMC(RexxClass::getSuperClasses), 0); @@ -751,9 +749,7 @@ defineKernelMethod(CHAR_GREATERTHAN_LESSTHAN ,TheClassBehaviour, CPPMC(RexxClass::notEqual), 1); defineKernelMethod(CHAR_STRICT_BACKSLASH_EQUAL ,TheClassBehaviour, CPPMC(RexxClass::notEqual), 1); defineKernelMethod(CHAR_ISSUBCLASSOF ,TheClassBehaviour, CPPMC(RexxClass::isSubclassOf), 1); - /* and the private class methods */ defineProtectedKernelMethod(CHAR_SHRIEKREXXDEFINED,TheClassBehaviour, CPPMC(RexxClass::setRexxDefined), 0); - defineProtectedKernelMethod(CHAR_SHRIEKIMPORT,TheClassBehaviour, CPPMC(RexxClass::importMethod), 0); /* set the scope of the methods to */ /* the CLASS scope */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-29 16:31:35
|
Revision: 409 http://svn.sourceforge.net/oorexx/?rev=409&view=rev Author: bigrixx Date: 2007-05-29 09:31:36 -0700 (Tue, 29 May 2007) Log Message: ----------- [ 1727101 ] 'instanceMethods' on class objects: methods in supercl too Make sure the Class version of DEFAULTNAME is explicitly exported. Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/ClassClass.cpp interpreter-3.x/trunk/kernel/classes/ClassClass.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/ClassClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ClassClass.cpp 2007-05-29 15:35:52 UTC (rev 408) +++ interpreter-3.x/trunk/kernel/classes/ClassClass.cpp 2007-05-29 16:31:36 UTC (rev 409) @@ -1777,8 +1777,16 @@ return isCompatibleWith(other) ? TheTrueObject : TheFalseObject; } +RexxString *RexxClass::defaultNameRexx() +/******************************************************************************/ +/* Function: Exported access to an object virtual function */ +/******************************************************************************/ +{ + return this->defaultName(); /* forward to the virtual function */ +} + void *RexxClass::operator new(size_t size, long size1, /* additional size */ RexxBehaviour *class_behaviour, /* new class behaviour */ Modified: interpreter-3.x/trunk/kernel/classes/ClassClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ClassClass.hpp 2007-05-29 15:35:52 UTC (rev 408) +++ interpreter-3.x/trunk/kernel/classes/ClassClass.hpp 2007-05-29 16:31:36 UTC (rev 409) @@ -114,6 +114,7 @@ RexxClass *external(RexxString *, RexxClass *, RexxTable *); bool isCompatibleWith(RexxClass *other); RexxObject *isSubclassOf(RexxClass *other); + RexxString *defaultNameRexx(); inline BOOL rexxDefined() { return this->class_info & REXX_DEFINED; }; Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-29 15:35:52 UTC (rev 408) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-29 16:31:36 UTC (rev 409) @@ -114,6 +114,7 @@ CPPM(RexxObject::newRexx), CPPMC(RexxClass::setRexxDefined), /* Class methods */ +CPPMC(RexxClass::defaultNameRexx), CPPMC(RexxClass::queryMixinClass), CPPMC(RexxClass::getId), CPPMC(RexxClass::getBaseClass), @@ -750,6 +751,7 @@ defineKernelMethod(CHAR_STRICT_BACKSLASH_EQUAL ,TheClassBehaviour, CPPMC(RexxClass::notEqual), 1); defineKernelMethod(CHAR_ISSUBCLASSOF ,TheClassBehaviour, CPPMC(RexxClass::isSubclassOf), 1); defineProtectedKernelMethod(CHAR_SHRIEKREXXDEFINED,TheClassBehaviour, CPPMC(RexxClass::setRexxDefined), 0); + defineKernelMethod(CHAR_DEFAULTNAME ,TheClassBehaviour, CPPM(RexxClass::defaultNameRexx), 0); /* set the scope of the methods to */ /* the CLASS scope */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-29 22:31:54
|
Revision: 411 http://svn.sourceforge.net/oorexx/?rev=411&view=rev Author: bigrixx Date: 2007-05-29 15:31:56 -0700 (Tue, 29 May 2007) Log Message: ----------- [ 1727936 ] Array's "first"-method: add multidimensionality support [ 1727937 ] Array's last"-method: add multidimensionality support [ 1727939 ] Array's "next"-method: add multidimensionality support [ 1727940 ] Array's "previous"-method: add multidimensionality support Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-05-29 17:00:54 UTC (rev 410) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.cpp 2007-05-29 22:31:56 UTC (rev 411) @@ -804,10 +804,6 @@ RexxObject **thisObject; size_t arraySize; /* size of the array */ - /* multidimensional array? */ - if (this->dimensions != OREF_NULL && this->dimensions->size() != 1) - /* yes - report error */ - CurrentActivity->reportException(Error_Incorrect_method_array_dimension, CHAR_FIRST); /* get the address of the first */ /*element in the array */ thisObject = this->expansionArray->objects; @@ -820,7 +816,7 @@ result = TheNilObject; /* return nil object */ else /* return index of the first entry */ - result = (RexxObject *)new_integer(i+1); + result = (RexxObject *)convertIndex(i + 1); return result; } @@ -834,10 +830,6 @@ RexxObject *result; RexxObject **thisObject; - /* multidimensional array? */ - if (this->dimensions != OREF_NULL && this->dimensions->size() != 1) - /* yes - report error */ - CurrentActivity->reportException(Error_Incorrect_method_array_dimension, CHAR_LAST); /* get the address of the first */ /*element in the array */ thisObject = this->data(); @@ -849,11 +841,11 @@ result = TheNilObject; /* return nil object */ else /* return index to the last entry */ - result = (RexxObject *)new_integer(i); + result = (RexxObject *)convertIndex(i); return result; } -RexxObject *RexxArray::nextRexx(RexxObject *index) +RexxObject *RexxArray::nextRexx(RexxObject **arguments, size_t argCount) /******************************************************************************/ /* Function: Return the next entry after a given array index */ /******************************************************************************/ @@ -862,30 +854,31 @@ RexxObject *result; RexxObject **thisObject; size_t arraySize; /* size of the array */ - - required_arg(index, ONE); /* this is required. */ - /* multidimensional array? */ - if (this->dimensions != OREF_NULL && this->dimensions->size() != 1) - /* no - report error */ - CurrentActivity->reportException(Error_Incorrect_method_array_dimension, CHAR_NEXT); + /* go validate the index */ + size_t position = this->validateIndex(arguments, argCount, 1, RaiseBoundsTooMany | RaiseBoundsInvalid); + // out of bounds results in the .nil object + if (position == NO_LONG) + { + return TheNilObject; + } /* get the address of the first */ /*element in the array */ thisObject = this->data(); arraySize = this->size(); /* get the size of the array */ /* find next entry in the array with */ /*data */ - for (i = index->requiredPositive(ARG_ONE); i < arraySize && thisObject[i] == OREF_NULL; i++); + for (i = position; i < arraySize && thisObject[i] == OREF_NULL; i++); if (i >= this->size()) result = TheNilObject; /* return nil object */ else /* return index of the next entry */ - result = (RexxObject *)new_integer(i+1); + result = (RexxObject *)convertIndex(i + 1); return result; } -RexxObject *RexxArray::previousRexx(RexxObject *index) +RexxObject *RexxArray::previousRexx(RexxObject **arguments, size_t argCount) /******************************************************************************/ /* Function: Return the index preceeding a given index */ /******************************************************************************/ @@ -895,14 +888,10 @@ RexxObject **thisObject; size_t arraySize; /* size of the array */ - required_arg(index, ONE); /* this is required. */ - /* multidimensional array? */ - if (this->dimensions != OREF_NULL && this->dimensions->size() != 1) - /* no - report error */ - CurrentActivity->reportException(Error_Incorrect_method_array_dimension, CHAR_PREVIOUS); + size_t position = this->validateIndex(arguments, argCount, 1, RaiseBoundsTooMany | RaiseBoundsInvalid); /* get the index object into an */ /*integer object */ - i = index->requiredPositive(ARG_ONE); + i = position; arraySize = this->size(); /* get the size of the array */ @@ -926,7 +915,7 @@ else /* return the index to the */ /*previous entry */ - result = (RexxObject *)new_integer(i); + result = (RexxObject *)convertIndex(i); return result; } Modified: interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-05-29 17:00:54 UTC (rev 410) +++ interpreter-3.x/trunk/kernel/classes/ArrayClass.hpp 2007-05-29 22:31:56 UTC (rev 411) @@ -111,8 +111,8 @@ RexxInteger *sizeRexx(); RexxObject *firstRexx(); RexxObject *lastRexx(); - RexxObject *nextRexx(RexxObject *); - RexxObject *previousRexx(RexxObject *); + RexxObject *nextRexx(RexxObject **, size_t); + RexxObject *previousRexx(RexxObject **, size_t); RexxArray *section(size_t, size_t); RexxObject *sectionRexx(RexxObject *, RexxObject *); RexxObject *sectionSubclass(size_t, size_t); Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-29 17:00:54 UTC (rev 410) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-29 22:31:56 UTC (rev 411) @@ -832,8 +832,8 @@ defineKernelMethod(CHAR_SUPPLIER ,TheArrayBehaviour, CPPMA(RexxArray::supplier), 0); defineKernelMethod(CHAR_FIRST ,TheArrayBehaviour, CPPMA(RexxArray::firstRexx), 0); defineKernelMethod(CHAR_LAST ,TheArrayBehaviour, CPPMA(RexxArray::lastRexx), 0); - defineKernelMethod(CHAR_NEXT ,TheArrayBehaviour, CPPMA(RexxArray::nextRexx), 1); - defineKernelMethod(CHAR_PREVIOUS ,TheArrayBehaviour, CPPMA(RexxArray::previousRexx), 1); + defineKernelMethod(CHAR_NEXT ,TheArrayBehaviour, CPPMA(RexxArray::nextRexx), A_COUNT); + defineKernelMethod(CHAR_PREVIOUS ,TheArrayBehaviour, CPPMA(RexxArray::previousRexx), A_COUNT); defineKernelMethod(CHAR_APPEND ,TheArrayBehaviour, CPPMA(RexxArray::append), 1); defineKernelMethod(CHAR_MAKESTRING ,TheArrayBehaviour, CPPMA(RexxArray::makeString), 1); defineKernelMethod(CHAR_TOSTRING ,TheArrayBehaviour, CPPMA(RexxArray::toString), 1); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bi...@us...> - 2007-05-30 18:35:51
|
Revision: 420 http://svn.sourceforge.net/oorexx/?rev=420&view=rev Author: bigrixx Date: 2007-05-30 11:35:43 -0700 (Wed, 30 May 2007) Log Message: ----------- [ 1728442 ] 'Queue': please add 'first', 'last', 'next', 'previous' Modified Paths: -------------- interpreter-3.x/trunk/kernel/classes/QueueClass.cpp interpreter-3.x/trunk/kernel/classes/QueueClass.hpp interpreter-3.x/trunk/kernel/runtime/Setup.cpp Modified: interpreter-3.x/trunk/kernel/classes/QueueClass.cpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/QueueClass.cpp 2007-05-30 17:32:29 UTC (rev 419) +++ interpreter-3.x/trunk/kernel/classes/QueueClass.cpp 2007-05-30 18:35:43 UTC (rev 420) @@ -102,41 +102,48 @@ return OREF_NULL; /* return nothing */ } -RexxObject *RexxQueue::getEntry(RexxObject *index, RexxObject *position) + +LISTENTRY *RexxQueue::locateEntry(RexxObject *index, RexxObject *position) /******************************************************************************/ /* Function: Resolve a queue index argument to a list index */ /******************************************************************************/ { - RexxInteger *integerIndex; /* requested integer index */ - LONG item_index; /* converted item number */ - RexxObject *listIndex; /* located list index */ + // we must have an index + if (index == OREF_NULL) + { + report_exception1(Error_Incorrect_method_noarg, position); + } - if (index == OREF_NULL) /* must have one here */ - /* else an error */ - report_exception1(Error_Incorrect_method_noarg, position); - /* force to integer form */ - integerIndex = (RexxInteger *)REQUEST_INTEGER(index); - if (integerIndex == TheNilObject) /* doesn't exist? */ - /* raise an exception */ - report_exception1(Error_Incorrect_method_index, index); - /* get the binary value */ - item_index = integerIndex->value; - if (item_index < 1) /* not a valid index? */ - /* raise an exception */ - report_exception1(Error_Incorrect_method_index, index); - /* get the first index */ - listIndex = this->firstRexx(); - /* locate the item */ - while (listIndex != TheNilObject) { /* loop while still items */ - item_index--; /* count this one */ - if (item_index == 0) /* count run out? */ - return (RexxObject *)listIndex; /* bingo, got what we need */ - /* step to the next item */ - listIndex = this->next(listIndex); - } - return OREF_NULL; /* list item not found */ + // and it must be a valid whole number + RexxInteger *integerIndex = (RexxInteger *)REQUEST_INTEGER(index); + if (integerIndex == TheNilObject) + { + report_exception1(Error_Incorrect_method_index, index); + } + // and positive + wholenumber_t item_index = integerIndex->value; + if (item_index < 1) + { + report_exception1(Error_Incorrect_method_index, index); + } + + // we need to iterate through the entries to locate this + LISTENTRY *listIndex = ENTRY_POINTER(this->first); + while (listIndex != NULL) + { + // have we reached the entry? return the item + item_index--; + if (item_index == 0) + { + return listIndex; + } + // step to the next entry + listIndex = ENTRY_POINTER(listIndex->next); + } + return NULL; // this queue item not found } + RexxObject *RexxQueue::put( RexxObject *value, /* value to add */ RexxObject *index) /* target index */ @@ -144,16 +151,13 @@ /* Function: Replace the value of an item already in the queue. */ /******************************************************************************/ { - RexxObject *list_index; /* list index */ - + required_arg(value, ONE); /* must have a value also */ /* locate this entry */ - list_index = this->getEntry(index, IntegerTwo); - required_arg(value, ONE); /* must have a value also */ + LISTENTRY *list_index = this->locateEntry(index, IntegerTwo); if (list_index == NULL) /* not a valid index? */ /* raise an error */ report_exception1(Error_Incorrect_method_index, index); - /* just do a put into the list */ - this->RexxList::put(value, list_index); + OrefSet(this->table, list_index->value, value); return OREF_NULL; /* return nothing at all */ } @@ -163,14 +167,11 @@ /* Function: Retrieve the value for a given queue index */ /******************************************************************************/ { - RexxObject *result; /* returned result */ - RexxObject *list_index; /* list index */ - /* locate this entry */ - list_index = this->getEntry(index, IntegerOne); + LISTENTRY *list_index = this->locateEntry(index, IntegerOne); if (list_index == NULL) /* not a valid index? */ return TheNilObject; /* doesn't exist, return .NIL */ - result = this->value(list_index); /* get the list entry */ + RexxObject *result = list_index->value; /* get the list entry */ if (result == OREF_NULL) /* not there? */ result = TheNilObject; /* just return NIL */ return (RexxObject *)result; /* return this item */ @@ -181,14 +182,10 @@ /* Function: Remove a given queue item */ /******************************************************************************/ { - RexxObject *list_index; /* list index */ - /* locate this entry */ - list_index = this->getEntry(index, IntegerOne); - if (list_index == NULL) /* not a valid index? */ - return TheNilObject; /* doesn't exist, return .NIL */ + LISTENTRY *list_index = this->locateEntry(index, IntegerOne); /* remove from the list */ - return this->RexxList::remove(list_index); + return this->primitiveRemove(list_index); } RexxObject *RexxQueue::hasindex(RexxObject *index) @@ -197,10 +194,8 @@ /* Function: Return an index existence flag */ /******************************************************************************/ { - RexxObject *list_index; /* list index */ - /* locate this entry */ - list_index = this->getEntry(index, IntegerOne); + LISTENTRY *list_index = this->locateEntry(index, IntegerOne); /* return an existence flag */ return (RexxObject *) (( list_index != NULL) ? TheTrueObject : TheFalseObject); } @@ -210,18 +205,10 @@ /* Function: Return the first element of the queue without removing it */ /******************************************************************************/ { - RexxObject *first; /* index of first item */ - RexxObject *item; /* returned item */ - - /* get index of first item */ - first = this->firstRexx(); - item = TheNilObject; /* default no first item */ - if (first != TheNilObject) /* have an item in the list? */ - /* retrieve the item without removal */ - item = this->value(first); - return (RexxObject *)item; /* return the first item */ + return firstItem(); } + RexxObject *RexxQueue::supplier() /******************************************************************************/ /* Function: Create a supplier for a queue object */ @@ -292,6 +279,112 @@ } +RexxObject *RexxQueue::firstRexx(void) +/******************************************************************************/ +/* Function: Return index of the first list item */ +/******************************************************************************/ +{ + if (this->first == LIST_END) + { + return TheNilObject; // empty queue is the .nil object + } + + else + { + return (RexxObject *)IntegerOne; // first index is always one + } +} + + +RexxObject *RexxQueue::lastRexx(void) +/******************************************************************************/ +/* Function: Return index of the last list item */ +/******************************************************************************/ +{ + if (this->last == LIST_END) + { + return TheNilObject; // no last item is an empty queue...return .nil + + } + else + { + // return the item count as the final index + return (RexxObject *)new_integer(this->items()); + } +} + +RexxObject *RexxQueue::next( + RexxObject *index) /* index of the target item */ +/******************************************************************************/ +/* Function: Return the next item after the given indexed item */ +/******************************************************************************/ +{ + LISTENTRY *element; /* current working entry */ + /* locate this entry */ + element = this->locateEntry(index, (RexxObject *)IntegerOne); + if (element == NULL) /* not a valid index? */ + { + report_exception1(Error_Incorrect_method_index, index); + } + + if (element->next == LIST_END) /* no next item? */ + { + return TheNilObject; /* just return .nil */ + } + else + { + /* return the next item */ + return (RexxObject *)new_integer(entryToIndex(element->next)); + } +} + + +RexxObject *RexxQueue::previous( + RexxObject *index) /* index of the target item */ +/******************************************************************************/ +/* Function: Return the item previous to the indexed item */ +/******************************************************************************/ +{ + LISTENTRY *element; /* current working entry */ + + /* locate this entry */ + element = this->locateEntry(index, (RexxObject *)IntegerOne); + if (element == NULL) /* not a valid index? */ + /* raise an error */ + report_exception1(Error_Incorrect_method_index, index); + + if (element->previous == LIST_END) /* no previous item? */ + return TheNilObject; /* just return .nil */ + else { /* return the previous item index */ + return (RexxObject *)new_integer(entryToIndex(element->previous)); + } +} + + +/** + * Convert an entry index into a queue index relative to the + * beginning. + * + * @param target The target index position. + * + * @return The queue index value. + */ +long RexxQueue::entryToIndex(long target) +{ + long current = this->first; + long counter = 0; + while (current != LIST_END) + { + if (current == target) + { + return counter + 1; + } + + current = ENTRY_POINTER(current)->next; + } +} + + RexxObject *RexxQueue::newRexx(RexxObject **init_args, size_t argCount) /******************************************************************************/ /* Function: Create an instance of a queue */ Modified: interpreter-3.x/trunk/kernel/classes/QueueClass.hpp =================================================================== --- interpreter-3.x/trunk/kernel/classes/QueueClass.hpp 2007-05-30 17:32:29 UTC (rev 419) +++ interpreter-3.x/trunk/kernel/classes/QueueClass.hpp 2007-05-30 18:35:43 UTC (rev 420) @@ -56,7 +56,7 @@ RexxObject *pullRexx(); RexxObject *pushRexx(RexxObject *); RexxObject *queueRexx(RexxObject *); - RexxObject *getEntry(RexxObject *, RexxObject *); + LISTENTRY *locateEntry(RexxObject *, RexxObject *); RexxObject *put(RexxObject *, RexxObject *); RexxObject *at(RexxObject *); RexxObject *remove(RexxObject *); @@ -68,6 +68,11 @@ RexxObject *append(RexxObject *); RexxArray *allIndexes(); RexxObject *index(RexxObject *); + RexxObject *firstRexx(); + RexxObject *lastRexx(); + RexxObject *next(RexxObject *); + RexxObject *previous(RexxObject *); + long entryToIndex(long target); inline RexxObject *pop() { return this->removeFirst();}; inline void push(RexxObject *obj) { this->addFirst(obj);}; Modified: interpreter-3.x/trunk/kernel/runtime/Setup.cpp =================================================================== --- interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-30 17:32:29 UTC (rev 419) +++ interpreter-3.x/trunk/kernel/runtime/Setup.cpp 2007-05-30 18:35:43 UTC (rev 420) @@ -328,6 +328,10 @@ CPPML(RexxQueue::append), CPPML(RexxQueue::allIndexes), CPPML(RexxQueue::index), +CPPML(RexxQueue::firstRexx), +CPPML(RexxQueue::lastRexx), +CPPML(RexxQueue::next), +CPPML(RexxQueue::previous), CPPMQ(RexxQueue::newRexx), CPPMQ(RexxQueue::ofRexx), @@ -932,13 +936,13 @@ defineKernelMethod(CHAR_BRACKETSEQUAL,TheListBehaviour, CPPML(RexxList::put), 2); defineKernelMethod(CHAR_MAKEARRAY ,TheListBehaviour, CPPM(RexxObject::makeArrayRexx), 0); defineKernelMethod(CHAR_AT ,TheListBehaviour, CPPML(RexxList::value), 1); - defineKernelMethod(CHAR_FIRST ,TheListBehaviour, CPPML(RexxList::firstRexx), 0); defineKernelMethod(CHAR_FIRSTITEM ,TheListBehaviour, CPPML(RexxList::firstItem), 0); defineKernelMethod(CHAR_HASINDEX ,TheListBehaviour, CPPML(RexxList::hasIndex), 1); defineKernelMethod(CHAR_INSERT ,TheListBehaviour, CPPML(RexxList::insertRexx), 2); defineKernelMethod(CHAR_ITEMS ,TheListBehaviour, CPPML(RexxList::itemsRexx), 0); + defineKernelMethod(CHAR_LASTITEM ,TheListBehaviour, CPPML(RexxList::lastItem), 0); + defineKernelMethod(CHAR_FIRST ,TheListBehaviour, CPPML(RexxList::firstRexx), 0); defineKernelMethod(CHAR_LAST ,TheListBehaviour, CPPML(RexxList::lastRexx), 0); - defineKernelMethod(CHAR_LASTITEM ,TheListBehaviour, CPPML(RexxList::lastItem), 0); defineKernelMethod(CHAR_NEXT ,TheListBehaviour, CPPML(RexxList::next), 1); defineKernelMethod(CHAR_PREVIOUS ,TheListBehaviour, CPPML(RexxList::previous), 1); defineKernelMethod(CHAR_PUT ,TheListBehaviour, CPPML(RexxList::put), 2); @@ -1062,6 +1066,10 @@ defineKernelMethod(CHAR_INDEX ,TheQueueBehaviour, CPPML(RexxQueue::index), 1); defineKernelMethod(CHAR_HASITEM ,TheQueueBehaviour, CPPML(RexxList::hasItem), 1); defineKernelMethod(CHAR_REMOVEITEM ,TheQueueBehaviour, CPPML(RexxList::removeItem), 1); + defineKernelMethod(CHAR_FIRST ,TheQueueBehaviour, CPPMQ(RexxQueue::firstRexx), 0); + defineKernelMethod(CHAR_LAST ,TheQueueBehaviour, CPPMQ(RexxQueue::lastRexx), 0); + defineKernelMethod(CHAR_NEXT ,TheQueueBehaviour, CPPMQ(RexxQueue::next), 1); + defineKernelMethod(CHAR_PREVIOUS ,TheQueueBehaviour, CPPMQ(RexxQueue::previous), 1); /* set the scope of the methods to */ /* this classes oref */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |