--- a/Array.st Mon Nov 08 03:32:43 1993 +0100
+++ b/Array.st Sat Dec 11 01:42:02 1993 +0100
@@ -27,7 +27,7 @@
are used very often in the system, some methods have been tuned by
reimplementation as primitive.
-$Header: /cvs/stx/stx/libbasic/Array.st,v 1.5 1993-11-08 02:28:44 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Array.st,v 1.6 1993-12-11 00:39:56 claus Exp $
written spring 89 by claus
'!
@@ -59,12 +59,14 @@
REGISTER int indx;
REGISTER int nIndex;
+ OBJ cls;
if (_isSmallInteger(index)) {
indx = _intVal(index) - 1;
if (indx >= 0) {
nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
- indx += _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+ if ((cls = _qClass(self)) != Array)
+ indx += _intVal(_ClassInstPtr(cls)->c_ninstvars);
if (indx < nIndex) {
RETURN ( _InstPtr(self)->i_instvars[indx] );
}
@@ -83,12 +85,14 @@
REGISTER int indx;
REGISTER int nIndex;
+ OBJ cls;
if (_isSmallInteger(index)) {
indx = _intVal(index) - 1;
if (indx >= 0) {
nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
- indx += _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+ if ((cls = _qClass(self)) != Array)
+ indx += _intVal(_ClassInstPtr(cls)->c_ninstvars);
if (indx < nIndex) {
_InstPtr(self)->i_instvars[indx] = anObject;
__STORE(self, anObject);
@@ -101,33 +105,48 @@
^ super at:index put:anObject
! !
+!Array methodsFor:'converting'!
+
+asArray
+ "return the receiver as an array"
+
+ "could be an instance of a subclass..."
+ self class == Array ifTrue:[
+ ^ self
+ ].
+ ^ super asArray
+! !
+
!Array methodsFor:'copying'!
copyWith:something
"reimplemented for speed if receiver is an Array"
%{
- OBJ nObj;
+ OBJ nObj, element;
int mySize;
- int i, nIndex;
- OBJ *op;
+ int nIndex;
+ REGISTER OBJ *srcP, *dstP;
extern int newSpace;
if (_qClass(self) == Array) {
mySize = _qSize(self);
_qAlignedNew(nObj, mySize + sizeof(OBJ), __context);
- _InstPtr(nObj)->o_class = Array;
+ if (nObj) {
+ _InstPtr(nObj)->o_class = Array;
- nIndex = (mySize - OHDR_SIZE) / sizeof(OBJ);
- /* sorry: must take care of stores ... */
- op = _ArrayInstPtr(self)->a_element;
- for (i=0; i<nIndex; i++) {
- _ArrayInstPtr(nObj)->a_element[i] = *op;
- __STORE(nObj, *op);
- op++;
+ nIndex = (mySize - OHDR_SIZE) / sizeof(OBJ);
+ /* sorry: must take care of stores ... */
+ srcP = _ArrayInstPtr(self)->a_element;
+ dstP = _ArrayInstPtr(nObj)->a_element;
+ while (nIndex--) {
+ element = *srcP++;
+ *dstP++ = element;
+ __STORE(nObj, element);
+ }
+ *dstP = something;
+ __STORE(nObj, something);
+ RETURN ( nObj );
}
- _ArrayInstPtr(nObj)->a_element[i] = something;
- __STORE(nObj, something);
- RETURN ( nObj );
}
%}
.
@@ -202,6 +221,9 @@
nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
stopIndex = _intVal(stop) - 1;
count = stopIndex - startIndex + 1;
+ if (count == 0) {
+ RETURN ( self );
+ }
if ((count > 0) && (stopIndex < nIndex)) {
repStartIndex = _intVal(repStart) - 1;
if (repStartIndex >= 0) {
@@ -379,6 +401,27 @@
^ super identityIndexOf:anElement startingAt:start
! !
+!Array methodsFor:'printing & storing'!
+
+isLiteral
+ "return true, if the receiver can be used as a literal"
+
+ self do:[:element |
+ element isLiteral ifFalse:[^ false]
+ ].
+ ^ true
+!
+
+storeOn:aStream
+ self isLiteral ifTrue:[
+ aStream nextPutAll:'#('.
+ self do:[:element | element storeOn:aStream. aStream space].
+ aStream nextPutAll:')'
+ ] ifFalse:[
+ super storeOn:aStream
+ ]
+! !
+
!Array methodsFor:'enumeration'!
do:aBlock
@@ -399,30 +442,38 @@
if (__isBlock(aBlock)
&& ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
&& (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+#ifdef NEW_BLOCK_CALL
+ for (; index < nIndex; index++) {
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+
+ (*codeVal)(aBlock, CON_COMMA _InstPtr(self)->i_instvars[index]);
+ }
+#else
home = _BlockInstPtr(aBlock)->b_home;
- rHome = home;
- if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
- /*
- * home will not move - keep in a fast register
- */
+ rHome = home;
+ if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
+ /*
+ * home will not move - keep in a fast register
+ */
for (; index < nIndex; index++) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
(*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index]);
}
- } else {
+ } else {
for (; index < nIndex; index++) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
(*codeVal)(home, CON_COMMA _InstPtr(self)->i_instvars[index]);
}
}
+#endif
} else {
for (; index < nIndex; index++) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
(*val.ilc_func)(aBlock, _value_, CON_COMMA nil, &val,
- _InstPtr(self)->i_instvars[index]);
+ _InstPtr(self)->i_instvars[index]);
}
}
%}
@@ -447,16 +498,23 @@
if (__isBlock(aBlock)
&& ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
&& (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+#ifdef NEW_BLOCK_CALL
+ for (index=nIndex-1; index >= endIndex; index--) {
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(aBlock, CON_COMMA _InstPtr(self)->i_instvars[index]);
+ }
+#else
home = _BlockInstPtr(aBlock)->b_home;
for (index=nIndex-1; index >= endIndex; index--) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
(*codeVal)(home, CON_COMMA _InstPtr(self)->i_instvars[index]);
}
+#endif
} else {
for (index=nIndex=1; index >= endIndex; index--) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
(*val.ilc_func)(aBlock, _value_, CON_COMMA nil, &val,
- _InstPtr(self)->i_instvars[index]);
+ _InstPtr(self)->i_instvars[index]);
}
}
%}
@@ -483,11 +541,11 @@
indexLow = _intVal(start);
if (indexLow > 0) {
indexHigh = _intVal(stop);
- if (_qClass(self) != Array) {
+ if (_qClass(self) != Array) {
nInsts = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
indexLow += nInsts;
indexHigh += nInsts;
- }
+ }
nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
if (indexHigh <= nIndex) {
indexLow--;
@@ -495,19 +553,26 @@
if (__isBlock(aBlock)
&& ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
&& (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+#ifdef NEW_BLOCK_CALL
+ for (index=indexLow; index <= indexHigh; index++) {
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(aBlock, CON_COMMA _InstPtr(self)->i_instvars[index]);
+ }
+#else
home = _BlockInstPtr(aBlock)->b_home;
- rHome = home;
- if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
+ rHome = home;
+ if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
for (index=indexLow; index <= indexHigh; index++) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
(*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index]);
}
- } else {
+ } else {
for (index=indexLow; index <= indexHigh; index++) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
(*codeVal)(home, CON_COMMA _InstPtr(self)->i_instvars[index]);
}
- }
+ }
+#endif
} else {
for (index=indexLow; index <= indexHigh; index++) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
@@ -540,6 +605,15 @@
if (__isBlock(aBlock)
&& ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
&& (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+#ifdef NEW_BLOCK_CALL
+ for (; index < nIndex; index++) {
+ if (InterruptPending != nil) interrupt(CONARG);
+
+ element = _InstPtr(self)->i_instvars[index];
+ if (element != nil)
+ (*codeVal)(aBlock, CON_COMMA element);
+ }
+#else
home = _BlockInstPtr(aBlock)->b_home;
for (; index < nIndex; index++) {
if (InterruptPending != nil) interrupt(CONARG);
@@ -548,6 +622,7 @@
if (element != nil)
(*codeVal)(home, CON_COMMA element);
}
+#endif
} else {
for (; index < nIndex; index++) {
if (InterruptPending != nil) interrupt(CONARG);
@@ -560,4 +635,17 @@
%}
.
^ self
+!
+
+addAllTo:aCollection
+ "add all elements of the receiver to aCollection.
+ return aCollection."
+
+ |stop "{ Class: SmallInteger }"|
+
+ stop := self size.
+ 1 to:stop do:[:idx |
+ aCollection add:(self at:idx)
+ ].
+ ^ aCollection
! !
--- a/Behavior.st Mon Nov 08 03:32:43 1993 +0100
+++ b/Behavior.st Sat Dec 11 01:42:02 1993 +0100
@@ -38,7 +38,7 @@
NOTICE: layout known by compiler and runtime system; be careful when changing
-$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.5 1993-11-08 02:29:06 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.6 1993-12-11 00:41:45 claus Exp $
written Dec 88 by claus
'!
@@ -80,6 +80,29 @@
^ self
! !
+!Behavior methodsFor:'copying'!
+
+deepCopy
+ "return a deep copy of the receiver
+ - return the receiver here - time will show if this is ok"
+
+ ^ self
+!
+
+deepCopyUsing:aDictionary
+ "return a deep copy of the receiver
+ - return the receiver here - time will show if this is ok"
+
+ ^ self
+!
+
+simpleDeepCopy
+ "return a deep copy of the receiver
+ - return the receiver here - time will show if this is ok"
+
+ ^ self
+! !
+
!Behavior methodsFor:'creating an instance of myself'!
uninitializedNew
@@ -115,6 +138,7 @@
%{ /* NOCONTEXT */
extern char *newNextPtr, *newEndPtr;
+ OBJ new();
OBJ newobj;
int instsize;
REGISTER int nInstVars;
@@ -126,10 +150,18 @@
nInstVars = _intVal(_INST(instSize));
instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);
- PROTECT(self);
- _qAlignedNew(newobj, instsize, SENDER);
- UNPROTECT(self);
+ if (_CanDoQuickAlignedNew(instsize)) {
+ _qCheckedAlignedNew(newobj, instsize);
+ /* stupid: c-compilers should find this out themselfes ... */
+ goto ok;
+ } else {
+ PROTECT_CONTEXT
+ newobj = new(instsize, SENDER);
+ UNPROTECT_CONTEXT
+ }
+
if (newobj != nil) {
+ok:
_InstPtr(newobj)->o_class = self;
if (nInstVars) {
@@ -180,14 +212,14 @@
if (_isSmallInteger(anInteger)) {
nindexedinstvars = _intVal(anInteger);
if (nindexedinstvars >= 0) {
+ PROTECT_CONTEXT
nInstVars = _intVal(_INST(instSize));
flags = _intVal(_INST(flags)) & ARRAYMASK;
switch (flags) {
case BYTEARRAY:
instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(char);
- PROTECT(self);
_qNew(newobj, instsize, SENDER);
- UNPROTECT(self);
+ UNPROTECT_CONTEXT
if (newobj == nil) {
break;
}
@@ -215,9 +247,8 @@
case WORDARRAY:
instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(short);
- PROTECT(self);
_qNew(newobj, instsize, SENDER);
- UNPROTECT(self);
+ UNPROTECT_CONTEXT
if (newobj == nil) {
break;
}
@@ -240,9 +271,8 @@
case LONGARRAY:
instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(long);
- PROTECT(self);
_qAlignedNew(newobj, instsize, SENDER);
- UNPROTECT(self);
+ UNPROTECT_CONTEXT
if (newobj == nil) {
break;
}
@@ -272,9 +302,8 @@
case FLOATARRAY:
instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(float);
- PROTECT(self);
_qNew(newobj, instsize, SENDER);
- UNPROTECT(self);
+ UNPROTECT_CONTEXT
if (newobj == nil) {
break;
}
@@ -290,9 +319,8 @@
case DOUBLEARRAY:
instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(double);
- PROTECT(self);
_qNew(newobj, instsize, SENDER);
- UNPROTECT(self);
+ UNPROTECT_CONTEXT
if (newobj == nil) {
break;
}
@@ -310,9 +338,8 @@
case POINTERARRAY:
nInstVars += nindexedinstvars;
instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);
- PROTECT(self);
_qAlignedNew(newobj, instsize, SENDER);
- UNPROTECT(self);
+ UNPROTECT_CONTEXT
if (newobj == nil) {
break;
}
@@ -341,9 +368,8 @@
*/
if (nindexedinstvars == 0) {
instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);
- PROTECT(self);
_qAlignedNew(newobj, instsize, SENDER);
- UNPROTECT(self);
+ UNPROTECT_CONTEXT
if (newobj == nil) {
break;
}
@@ -373,20 +399,52 @@
}
%}
.
+ "arrive here if something went wrong ...
+ figure out what"
+
(anInteger isMemberOf:SmallInteger) ifFalse:[
self error:'argument to new: must be Integer'
] ifTrue:[
- (anInteger >= 0) ifTrue:[
- "sorry but this class has no indexed instvars - need 'new' "
+ (anInteger < 0) ifTrue:[
+ self error:'bad (negative) argument to new'
+ ] ifFalse:[
self isVariable ifFalse:[
- self error:'not indexed - cannot create with new:'
+ self error:'class has no indexed instvars - cannot create with new:'
] ifTrue:[
ObjectMemory allocationFailureSignal raise
]
- ] ifFalse:[
- self error:'bad (negative) argument to new'
]
]
+!
+
+readFrom:aStream
+ "read an objects printed representation from the argument, aStream and return it.
+ The read object must be a kind of myself
+ - to get any object, use 'Object readFrom:...' since everything is kindOf:Object.
+ This is the reverse operation to 'storeOn:'.
+ Notice, that storeOn: does not handle circular references and
+ multiple references to the same object - use storeBinary: for this."
+
+ |newObject|
+
+ newObject := Compiler evaluate:aStream.
+ (newObject isKindOf:self) ifFalse:[
+ self error:('expected ' , self name)
+ ].
+ ^ newObject
+
+ "|s|
+ s := WriteStream on:String new.
+ #(1 2 3 4) storeOn:s.
+ Object readFrom:(ReadStream on:s contents)
+ "
+!
+
+readFromString:aString
+ "create an object from its printed representation
+ (i.e. stored using storeOn: or storeString)"
+
+ ^ self readFrom:(ReadStream on:aString)
! !
!Behavior methodsFor:'autoload check'!
@@ -922,6 +980,28 @@
!Behavior methodsFor: 'binary storage'!
+readBinaryFrom:aStream
+ "read an objects binary representation from the argument,
+ aStream and return it.
+ The read object must be a kind of myself
+ - to get any object, use 'Object readFrom:...'
+ This is the reverse operation to 'storeBinaryOn:'. "
+
+ |newObject|
+
+ newObject := (BinaryInputManager new:1024) readFrom:aStream.
+ (newObject isKindOf:self) ifFalse:[
+ self error:('expected ' , self name)
+ ].
+ ^ newObject
+
+ "|s|
+ s := WriteStream on:ByteArray new.
+ #(1 2 3 4) storeBinaryOn:s.
+ Object readBinaryFrom:(ReadStream on:s contents)
+ "
+!
+
binaryDefinitionFrom: stream manager: manager
| obj basicSize i |
--- a/Block.st Mon Nov 08 03:32:43 1993 +0100
+++ b/Block.st Sat Dec 11 01:42:02 1993 +0100
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Block.st,v 1.5 1993-11-08 02:29:13 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Block.st,v 1.6 1993-12-11 00:42:02 claus Exp $
written spring 89 by claus
'!
@@ -93,19 +93,19 @@
!Block class methodsFor:'instance creation'!
-code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:sourcePos initialPC:initialPC literals:literals
+code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:sourcePos initialPC:initialPC literals:literals dynamic:dynamic
"create a new cheap (homeless) block.
Not for public use - special hook for the compiler."
|newBlock|
- newBlock := super basicNew.
- newBlock code:codeAddress.
- newBlock byteCode:bCode.
- newBlock nargs:numArgs.
- newBlock sourcePosition:sourcePos.
- newBlock initialPC:initialPC.
- newBlock literals:literals.
+ newBlock := super basicNew code:codeAddress
+ byteCode:bCode
+ nargs:numArgs
+ sourcePosition:sourcePos
+ initialPC:initialPC
+ literals:literals
+ dynamic:dynamic.
^ newBlock
!
@@ -126,6 +126,8 @@
!Block methodsFor:'testing'!
isBlock
+ "return true, if this is a block - yes we I am"
+
^ true
! !
@@ -179,6 +181,18 @@
!Block methodsFor:'private accessing'!
+code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:srcPos initialPC:iPC literals:lits dynamic:dynamic
+ "set all relevant internals"
+
+ self code:codeAddress.
+ byteCode := bCode.
+ nargs := numArgs.
+ sourcePos := srcPos.
+ initialPC := iPC.
+ literals := lits.
+ self dynamic:dynamic
+!
+
code:anAddress
"set the code field - danger alert.
This is not an object but the address of the blocks machine instructions.
@@ -219,6 +233,24 @@
"set the literal array for evaluation - danger alert"
literals := aLiteralArray
+!
+
+dynamic:aBoolean
+ "set the flag bit stating that the machine code was created
+ dynamically and should be flushed on image-restart"
+
+ |newFlags|
+
+ newFlags := flags.
+%{
+ /* made this a primitive to get define in stc.h */
+ if (aBoolean == true)
+ newFlags = _MKSMALLINT(_intVal(newFlags) | F_DYNAMIC);
+ else
+ newFlags = _MKSMALLINT(_intVal(newFlags) & ~F_DYNAMIC);
+%}
+.
+ flags := newFlags
! !
!Block methodsFor:'error handling'!
@@ -271,14 +303,23 @@
if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
+ thecode = _BlockInstPtr(self)->b_code;
+#ifdef NEW_BLOCK_CALL
+ if (thecode != (OBJFUNC)nil) {
+ /* compiled machine code */
+ RETURN ( (*thecode)(self, COMMA_SND) );
+ }
+ /* interpreted code */
+ RETURN ( interpret(self, 0, nil, nil COMMA_SND, nil) );
+#else
home = _BlockInstPtr(self)->b_home;
- thecode = _BlockInstPtr(self)->b_code;
if (thecode != (OBJFUNC)nil) {
/* compiled machine code */
RETURN ( (*thecode)(home COMMA_SND) );
}
/* interpreted code */
RETURN ( interpret(self, 0, nil, home COMMA_SND, nil) );
+#endif
}
%}
.
@@ -299,19 +340,19 @@
if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
- home = _BlockInstPtr(self)->b_home;
thecode = _BlockInstPtr(self)->b_code;
+#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
-#ifdef PASS_ARG_REF
- RETURN ( (*thecode)(home COMMA_SND, &arg) );
-#else
- RETURN ( (*thecode)(home COMMA_SND, arg) );
-#endif
+ RETURN ( (*thecode)(self COMMA_SND, arg) );
}
/* interpreted code */
-#ifdef PASS_ARG_REF
- RETURN ( interpret(self, 1, nil, home COMMA_SND, nil, &arg) );
+ RETURN ( interpret(self, 1, nil, nil COMMA_SND, nil, arg) );
#else
+ home = _BlockInstPtr(self)->b_home;
+ if (thecode != (OBJFUNC)nil) {
+ RETURN ( (*thecode)(home COMMA_SND, arg) );
+ }
+ /* interpreted code */
RETURN ( interpret(self, 1, nil, home COMMA_SND, nil, arg) );
#endif
}
@@ -334,18 +375,17 @@
if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
- home = _BlockInstPtr(self)->b_home;
thecode = _BlockInstPtr(self)->b_code;
+#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
-#ifdef PASS_ARG_REF
- RETURN ( (*thecode)(home COMMA_SND, &arg1) );
+ RETURN ( (*thecode)(self COMMA_SND, arg1, arg2) );
+ }
+ RETURN ( interpret(self, 2, nil, nil COMMA_SND, nil, arg1, arg2) );
#else
+ home = _BlockInstPtr(self)->b_home;
+ if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home COMMA_SND, arg1, arg2) );
-#endif
}
-#ifdef PASS_ARG_REF
- RETURN ( interpret(self, 2, nil, home COMMA_SND, nil, &arg1) );
-#else
RETURN ( interpret(self, 2, nil, home COMMA_SND, nil, arg1, arg2) );
#endif
}
@@ -368,18 +408,17 @@
if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
- home = _BlockInstPtr(self)->b_home;
thecode = _BlockInstPtr(self)->b_code;
+#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
-#ifdef PASS_ARG_REF
- RETURN ( (*thecode)(home COMMA_SND, &arg1) );
+ RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3) );
+ }
+ RETURN ( interpret(self, 3, nil, nil COMMA_SND, nil, arg1, arg2, arg3) );
#else
+ home = _BlockInstPtr(self)->b_home;
+ if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3) );
-#endif
}
-#ifdef PASS_ARG_REF
- RETURN ( interpret(self, 3, nil, home COMMA_SND, nil, &arg1) );
-#else
RETURN ( interpret(self, 3, nil, home COMMA_SND, nil, arg1, arg2, arg3) );
#endif
}
@@ -402,18 +441,17 @@
if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
- home = _BlockInstPtr(self)->b_home;
thecode = _BlockInstPtr(self)->b_code;
+#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
-#ifdef PASS_ARG_REF
- RETURN ( (*thecode)(home COMMA_SND, &arg1) );
+ RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4) );
+ }
+ RETURN ( interpret(self, 4, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4) );
#else
+ home = _BlockInstPtr(self)->b_home;
+ if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4) );
-#endif
}
-#ifdef PASS_ARG_REF
- RETURN ( interpret(self, 4, nil, home COMMA_SND, nil, &arg1) );
-#else
RETURN ( interpret(self, 4, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4) );
#endif
}
@@ -436,18 +474,17 @@
if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
- home = _BlockInstPtr(self)->b_home;
thecode = _BlockInstPtr(self)->b_code;
+#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
-#ifdef PASS_ARG_REF
- RETURN ( (*thecode)(home COMMA_SND, &arg1) );
+ RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4, arg5) );
+ }
+ RETURN ( interpret(self, 5, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5) );
#else
+ home = _BlockInstPtr(self)->b_home;
+ if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5) );
-#endif
}
-#ifdef PASS_ARG_REF
- RETURN ( interpret(self, 5, nil, home COMMA_SND, nil, &arg1) );
-#else
RETURN ( interpret(self, 5, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5) );
#endif
}
@@ -470,18 +507,17 @@
if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
- home = _BlockInstPtr(self)->b_home;
thecode = _BlockInstPtr(self)->b_code;
+#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
-#ifdef PASS_ARG_REF
- RETURN ( (*thecode)(home COMMA_SND, &arg1) );
+ RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4, arg5, arg6) );
+ }
+ RETURN ( interpret(self, 6, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5, arg6) );
#else
+ home = _BlockInstPtr(self)->b_home;
+ if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5, arg6) );
-#endif
}
-#ifdef PASS_ARG_REF
- RETURN ( interpret(self, 6, nil, home COMMA_SND, nil, &arg1) );
-#else
RETURN ( interpret(self, 6, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5, arg6) );
#endif
}
@@ -513,6 +549,8 @@
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
switch (_intVal(_INST(nargs))) {
+ default:
+ goto error;
case 7:
a7 = _ArrayInstPtr(argArray)->a_element[6];
case 6:
@@ -530,23 +568,25 @@
case 0:
break;
}
- home = _BlockInstPtr(self)->b_home;
thecode = _BlockInstPtr(self)->b_code;
+#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
-#ifdef PASS_ARG_REF
- RETURN ( (*thecode)(home COMMA_SND, &a1) );
+ RETURN ( (*thecode)(self COMMA_SND, a1, a2, a3, a4, a5, a6, a7) );
+ }
+ RETURN ( interpret(self, _intVal(_INST(nargs)), nil,
+ nil COMMA_SND, nil, a1, a2, a3, a4, a5, a6, a7) );
#else
+ home = _BlockInstPtr(self)->b_home;
+ if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home COMMA_SND, a1, a2, a3, a4, a5, a6, a7) );
-#endif
}
-#ifdef PASS_ARG_REF
- RETURN ( interpret(self, _intVal(_INST(nargs)), nil,
- home COMMA_SND, nil, &a1) );
-#else
RETURN ( interpret(self, _intVal(_INST(nargs)), nil,
home COMMA_SND, nil, a1, a2, a3, a4, a5, a6, a7) );
#endif
+error: ;
%}
+.
+ self error:'only blocks with up-to 7 arguments supported'
!
valueNowOrOnUnwindDo:aBlock