Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1065.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1065
Author: eem
Time: 15 February 2015, 12:08:49.599 pm
UUID: 128de3ba-1195-4a3e-af85-eae5d25b1410
Ancestors: VMMaker.oscog-eem.1064
Make sure that integral comparisons against zero
are signed, casting the receiver as necessary.
Refactor the typeOf:in: machinery to allow the
TMethod and the CCodeGenerator to dance together.
=============== Diff against VMMaker.oscog-eem.1064 ===============
Item was added:
+ ----- Method: CCodeGenerator>>emitSignedComparison:for:on:indent: (in category 'C translation support') -----
+ emitSignedComparison: operator for: msgNode on: aStream indent: level
+ "Emit a signed comparison.
+ Make sure the receiver expression is signed if comparing against zero."
+
+ | arg rcvrType |
+ ((arg := msgNode args first) isConstant
+ and: [arg value isInteger
+ and: [arg value = 0
+ and: [(self typeFor: msgNode receiver in: currentMethod)
+ ifNil: [false]
+ ifNotNil: [:t| (rcvrType := t) first = $u]]]]) ifTrue:
+ [aStream nextPut: $(; nextPutAll: (self signedTypeForIntegralType: rcvrType); nextPut: $)].
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream space; nextPutAll: operator; space.
+ self emitCExpression: arg on: aStream!
Item was changed:
----- Method: CCodeGenerator>>generateGreaterThan:on:indent: (in category 'C translation') -----
generateGreaterThan: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ self emitSignedComparison: #> for: msgNode on: aStream indent: level!
- self emitCExpression: msgNode receiver on: aStream.
- aStream nextPutAll: ' > '.
- self emitCExpression: msgNode args first on: aStream.!
Item was changed:
----- Method: CCodeGenerator>>generateGreaterThanOrEqual:on:indent: (in category 'C translation') -----
generateGreaterThanOrEqual: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ self emitSignedComparison: #>= for: msgNode on: aStream indent: level!
- self emitCExpression: msgNode receiver on: aStream.
- aStream nextPutAll: ' >= '.
- self emitCExpression: msgNode args first on: aStream.!
Item was changed:
----- Method: CCodeGenerator>>generateLessThan:on:indent: (in category 'C translation') -----
generateLessThan: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ self emitSignedComparison: #< for: msgNode on: aStream indent: level!
- self emitCExpression: msgNode receiver on: aStream.
- aStream nextPutAll: ' < '.
- self emitCExpression: msgNode args first on: aStream.!
Item was changed:
----- Method: CCodeGenerator>>generateLessThanOrEqual:on:indent: (in category 'C translation') -----
generateLessThanOrEqual: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ self emitSignedComparison: #<= for: msgNode on: aStream indent: level!
- self emitCExpression: msgNode receiver on: aStream.
- aStream nextPutAll: ' <= '.
- self emitCExpression: msgNode args first on: aStream.!
Item was changed:
----- Method: CCodeGenerator>>inferTypesForImplicitlyTypedVariablesAndMethods (in category 'type inference') -----
inferTypesForImplicitlyTypedVariablesAndMethods
"Infer the return tupe and the types of untyped variables.
As far as variables go, for now we try only to infer variables
assigned the result of #longLongAt:, but much more could be
done here."
"Iterate over all methods, inferring #void return types, until we reach a fixed point."
| firstTime allMethods |
firstTime := true.
allMethods := apiMethods
ifNil: [methods]
ifNotNil: [(Set withAll: methods)
addAll: apiMethods;
yourself].
+ "Make an initial pass to assign the return types of all simple mehtods that return constants."
+ allMethods do:
+ [:m|
+ m isReturnConstant ifTrue:
+ [m inferReturnTypeIn: self]].
[| changedReturnType |
changedReturnType := false.
allMethods do:
[:m|
firstTime ifTrue:
[m removeFinalSelfReturnIn: self. "must preceed recordDeclarationsIn: because it may set returnType"
m recordDeclarationsIn: self].
m inferTypesForImplicitlyTypedVariablesIn: self.
(m inferReturnTypeIn: self) ifTrue:
[changedReturnType := true]].
firstTime := false.
changedReturnType] whileTrue.
"Type all as-yet-untyped methods as the default"
methods do:
[:m|
m returnType ifNil:
[m returnType: (self implicitReturnTypeFor: m selector)]]!
Item was removed:
- ----- Method: CCodeGenerator>>returnTypeForSend: (in category 'type inference') -----
- returnTypeForSend: aTSendNode
- "Answer the return type for a send. Absent sends default to #sqInt."
- | sel |
- ^(self anyMethodNamed: (sel := aTSendNode selector))
- ifNil: [kernelReturnTypes
- at: sel
- ifAbsent:
- [^sel
- caseOf: {
- [#asVoidPointer] -> [#'void *'].
- [#asUnsignedInteger] -> [#usqInt].
- [#asLong] -> [#long].
- [#asUnsignedLong] -> [#'unsigned long'].
- [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
- [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
- [#cCoerce:to:] -> [aTSendNode args last value].
- [#cCoerceSimple:to:] -> [aTSendNode args last value] }
- otherwise: [#sqInt]]]
- ifNotNil:
- [:m|
- m returnType ifNotNil:
- [:type| "map fields to #usqInt"
- ((type beginsWith: 'unsigned')
- and: [(type includes: $:)
- and: [type last isDigit]])
- ifTrue: [#usqInt]
- ifFalse: [type]]]!
Item was added:
+ ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') -----
+ returnTypeForSend: aTSendNode in: aTMethod
+ "Answer the return type for a send. Absent sends default to #sqInt.
+ The bitwise operators answer unsigned versions of their argument types, at least in gcc
+ although this author can't find that in the C99 spec. If you can find this, please let me know."
+ | sel |
+ ^(self anyMethodNamed: (sel := aTSendNode selector))
+ ifNil: [kernelReturnTypes
+ at: sel
+ ifAbsent:
+ [^sel
+ caseOf: {
+ [#bitAnd:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod].
+ [#bitOr:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod].
+ [#bitXor:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod].
+ [#asVoidPointer] -> [#'void *'].
+ [#asVoidPointer] -> [#'void *'].
+ [#asUnsignedInteger] -> [#usqInt].
+ [#asLong] -> [#long].
+ [#asUnsignedLong] -> [#'unsigned long'].
+ [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
+ [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
+ [#cCoerce:to:] -> [aTSendNode args last value].
+ [#cCoerceSimple:to:] -> [aTSendNode args last value] }
+ otherwise: [#sqInt]]]
+ ifNotNil:
+ [:m|
+ m returnType ifNotNil:
+ [:type| "map fields to #usqInt"
+ ((type beginsWith: 'unsigned')
+ and: [(type includes: $:)
+ and: [type last isDigit]])
+ ifTrue: [#usqInt]
+ ifFalse: [type]]]!
Item was added:
+ ----- Method: CCodeGenerator>>signedTypeForIntegralType: (in category 'type inference') -----
+ signedTypeForIntegralType: aCTypeString
+ (aCTypeString beginsWith: 'unsigned ') ifTrue:
+ [^aCTypeString allButFirst: 8].
+
+ (aCTypeString beginsWith: 'usq') ifTrue:
+ [^aCTypeString allButFirst].
+
+ self error: 'unknown type'.
+ ^#long!
Item was added:
+ ----- Method: CCodeGenerator>>typeFor:in: (in category 'type inference') -----
+ typeFor: aNode in: aTMethod
+ aNode isVariable ifTrue:
+ [^aTMethod typeFor: aNode in: self].
+ aNode isSend ifTrue:
+ [^self returnTypeForSend: aNode in: currentMethod].
+ ^#sqInt!
Item was added:
+ ----- Method: CCodeGenerator>>unsignedTypeForBitwiseSend:in: (in category 'type inference') -----
+ unsignedTypeForBitwiseSend: aTSendNode in: aTMethod
+ "The result of the bitwise operators in C is unsigned."
+ | t1 t2 type |
+ t1 := (self typeFor: aTSendNode receiver in: aTMethod) ifNil: [^nil].
+ t2 := (self typeFor: aTSendNode args first in: aTMethod) ifNil: [^nil].
+ type := (self sizeOfIntegralCType: t1) >= (self sizeOfIntegralCType: t1)
+ ifTrue: [t1]
+ ifFalse: [t2].
+ ^type first = $u
+ ifTrue: [type]
+ ifFalse:
+ [(type beginsWith: 'sq')
+ ifTrue: ['u', type]
+ ifFalse: ['unsigned ', type]]!
Item was changed:
----- Method: TMethod>>addTypesFor:to:in: (in category 'type inference') -----
addTypesFor: node to: typeSet in: aCodeGen
| expr |
expr := node.
[expr isAssignment or: [expr isStmtList]] whileTrue:
[expr isAssignment ifTrue:
[expr := expr variable].
expr isStmtList ifTrue:
[expr := expr statements last]].
expr isSend ifTrue:
[(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) ifTrue:
[^expr args do:
[:block|
self addTypesFor: block to: typeSet in: aCodeGen]].
(#(= ~= == ~~ < > <= >= anyMask: noMask:) includes: expr selector) ifTrue:
[^typeSet add: #sqInt].
(#(+ - * / // \\ mod: quo: bitAnd: bitClear: bitOr: bitXor: bitShift:) includes: expr selector) ifTrue:
[| types |
types := Set new.
self addTypesFor: expr receiver to: types in: aCodeGen.
(types size = 1 and: [types anyOne last = $*]) ifTrue: "pointer arithmetic"
[^typeSet add: types anyOne].
self addTypesFor: expr args first to: types in: aCodeGen.
types := aCodeGen harmonizeReturnTypesIn: types.
types size = 2 ifTrue:
[(types includes: #double) ifTrue:
[^typeSet add: #double].
(types includes: #float) ifTrue:
[^typeSet add: #float].
^self]. "don't know; leave unspecified."
^types notEmpty ifTrue:
[typeSet add: types anyOne]].
+ ^(aCodeGen returnTypeForSend: expr in: self) ifNotNil:
- ^(aCodeGen returnTypeForSend: expr) ifNotNil:
[:type| typeSet add: type]].
expr isVariable ifTrue:
[(aCodeGen typeOfVariable: expr name)
ifNotNil: [:type| typeSet add: type]
ifNil: [typeSet add: (expr name = 'self'
ifTrue: [#void]
ifFalse: [#sqInt])]].
expr isConstant ifTrue:
[| val |
val := expr value.
val isInteger ifTrue:
[typeSet add: ((val >= 0 ifTrue: [val] ifFalse: [-1 - val]) highBit <= 32
ifTrue: [#sqInt]
ifFalse: [#sqLong])].
(#(nil true false) includes: val) ifTrue:
[typeSet add: #sqInt].
val isFloat ifTrue:
[typeSet add: #float]]!
Item was changed:
----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
inferTypesForImplicitlyTypedVariablesIn: aCodeGen
"infer types for untyped variables form assignments and arithmetic uses.
This for debugging:
(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
| explicitlyTyped effectiveNodes |
explicitlyTyped := declarations keys asSet.
effectiveNodes := Dictionary new. "this for debugging"
parseTree nodesDo:
[:node| | type var |
"If there is something of the form i >= 0, then i should be signed, not unsigned."
(node isSend
and: [(locals includes: (var := node receiver variableNameOrNil))
and: [(explicitlyTyped includes: var) not
and: [(#(<= < >= >) includes: node selector)
and: [node args first isConstant
and: [node args first value = 0
and: [(type := self typeFor: var in: aCodeGen) notNil
and: [type first == $u]]]]]]]) ifTrue:
[declarations at: var put: (declarations at: var) allButFirst.
effectiveNodes at: var put: { declarations at: var. node }].
"if an assignment of a known send, set the variable's type to the return type of the send."
(node isAssignment
and: [(locals includes: (var := node variable name))
and: [(declarations includesKey: var) not
and: [node expression isSend
+ and: [(type := aCodeGen returnTypeForSend: node expression in: self) notNil]]]]) ifTrue:
- and: [(type := aCodeGen returnTypeForSend: node expression) notNil]]]]) ifTrue:
[(#(sqInt void) includes: type) ifFalse:
["the $: is to map things like unsigned field : 3 to usqInt"
declarations
at: var
put: ((type includes: $:) ifTrue: [#usqInt] ifFalse: [type]), ' ', var.
effectiveNodes at: var put: { declarations at: var. node }]]].
^effectiveNodes!
Item was changed:
----- Method: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') -----
isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen
"Answer if the given parameter node may be substituted directly into the body of
the method during inlining, instead of being bound to the actual parameter variable.
We allow a constant, a local variable, or a formal parameter, or simple expressions
involving only these to to be directly substituted. Note that global variables cannot
be subsituted into methods with possible side effects (i.e., methods that may assign
to global variables) because the inlined method might depend on having the value of
the global variable captured when it is passed in as an argument."
| madeNonTrivialCall count constantExpression usageCount |
aNode isConstant ifTrue: [^true].
aNode isVariable ifTrue:
[((locals includes: aNode name)
or: [(args includes: aNode name)
or: [#('self' 'true' 'false' 'nil') includes: aNode name]]) ifTrue: [^true].
"We can substitute any variable provided it is only read in the method being inlined,
and if it is not read after any non-trivial call (which may update the variable)."
madeNonTrivialCall := false.
(targetMeth isComplete
and: [targetMeth parseTree
noneSatisfy:
[:node|
(node isSend
and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue:
[madeNonTrivialCall := true].
(madeNonTrivialCall and: [node isVariable and: [node name = argName]])
or: [node isAssignment
and: [node variable name = argName]]]
unless:
[:node|
node isSend and: [aCodeGen isAssertSelector: node selector]]]) ifTrue:
[^true].
^targetMeth maySubstituteGlobal: aNode name in: aCodeGen].
"For now allow literal blocks to be substituted. They better be accessed only
with value[:value:*] messages though!!"
aNode isStmtList ifTrue: [^true].
count := 0.
constantExpression := true.
"scan expression tree; must contain only constants, builtin ops, and inlineable vars"
aNode nodesDo:
[:node|
node isConstant
ifTrue: [] ifFalse:
[node isSend
ifTrue:
[((VMBasicConstants mostBasicConstantSelectors includes: node selector)
or: [node isBuiltinOperator]) ifFalse: [^false].
count := count + 1] ifFalse:
[node isVariable ifTrue:
[(aCodeGen isNonArgumentImplicitReceiverVariableName: node name) ifFalse:
[constantExpression := false.
((locals includes: node name)
or: [(args includes: node name)
or: [(#('self' 'true' 'false' 'nil') includes: node name)
or: [targetMeth maySubstituteGlobal: node name in: aCodeGen]]]) ifFalse: [^false]]] ifFalse:
[^false]]]].
"inline constant expressions"
constantExpression ifNil: [^true].
"scan target to find usage count"
usageCount := 0.
targetMeth parseTree nodesDo:
[:node|
(node isVariable and: [node name = argName]) ifTrue:
[usageCount := usageCount + 1]].
+ "(usageCount > 1 and: [count <= usageCount]) ifTrue:
+ [[UsageCounts := Dictionary new.
+ self removeClassVarName: #UsageCounts].
+ (UsageCounts at: usageCount ifAbsentPut: [Set new]) add: ({targetMeth. argName. aNode})]."
"Now only inline expressions if they are used only once or are simple
+ w.r.t. the usage count, and the usage count is not large; a heuristic that seems to work well enough."
+ ^usageCount = 1 or: [usageCount <= 7 and: [count <= usageCount]]!
- w.r.t. the usage count; a heuristic that seems to work well enough."
- ^usageCount = 1 or: [count <= usageCount]!
Item was added:
+ ----- Method: TMethod>>isReturnConstant (in category 'testing') -----
+ isReturnConstant
+ ^parseTree statements size = 1
+ and: [parseTree statements last isReturn
+ and: [parseTree statements last expression isLeaf]]!
Item was changed:
----- Method: TMethod>>typeFor:in: (in category 'utilities') -----
typeFor: aVariable in: aCodeGen
"Answer the type for aVariable, deferring to aCodeGen (which defers to the vmClass)
if no type is found and the variable is global (not an arg or a local). Expect the
cCodeGen to answer nil for variables without types. nil for typelessness is required
by the type propagation logic in inlineSend:directReturn:exitVar:in:."
^(declarations
at: aVariable asString
ifAbsent: [((locals includes: aVariable) or: [args includes: aVariable]) ifFalse:
[aCodeGen typeOfVariable: aVariable]]) ifNotNil:
[:decl|
+ aCodeGen extractTypeFor: aVariable asString fromDeclaration: decl]!
- aCodeGen extractTypeFor: aVariable fromDeclaration: decl]!
1
0
14 Feb '15
Revision: 3256
Author: eliot
Date: 2015-02-13 18:19:04 -0800 (Fri, 13 Feb 2015)
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.1064
Slang:
Rescue translation of the non-64-bit Spur VMs by
a) doing a better job of suoper expansions, handling expansions
that are returning ifs as well as just returns correctly.
b) transforming variable := expr ifTrue: [s1] ifFalse: [s2] into
expr ifTrue: [variable := s1] ifFalse: [variable := s2]
to allow inlining of s1 & s2.
And take advantage of the better inlining in copyAndForward:
General:
Simplify primitiveDisplayString given isArray:.
Refactor positive32BitIntegerFor: and signed32BitIntegerFor: in the realization
that these reduce to essentially integerObjectOf: in 64-bit Spur. The idea is
to inline if in 64-bit Spur but not if in the 32-bit VMs. Add notOption:
processing to allow excluding noInlineSigned32BitIntegerFor: et al. Add
hasSixtyFourBitImmediates to no longer assume that wordSize = 8 implies 64-bit
immediates.
Use positiveMachineIntegerFor: in place of
positive32BitIntegerFor: in some plugins.
Simplify two B3DAcceleratorPlugin prims given topRemappableOop and isArray:
With these changes 64-bit Spur Stack Linux manages
3548 run, 3495 passes, 0 expected failures, 47 failures, 6 errors, 0 unexpected passes
Builds:
Nuke the newspeak.stack.v3 builds
Modified Paths:
--------------
branches/Cog/nscogsrc/plugins/B2DPlugin/B2DPlugin.c
branches/Cog/nscogsrc/plugins/BitBltPlugin/BitBltPlugin.c
branches/Cog/nscogsrc/plugins/FilePlugin/FilePlugin.c
branches/Cog/nscogsrc/plugins/IA32ABI/IA32ABI.c
branches/Cog/nscogsrc/plugins/LargeIntegers/LargeIntegers.c
branches/Cog/nscogsrc/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c
branches/Cog/nscogsrc/plugins/VMProfileLinuxSupportPlugin/VMProfileLinuxSupportPlugin.c
branches/Cog/nscogsrc/plugins/VMProfileMacSupportPlugin/VMProfileMacSupportPlugin.c
branches/Cog/nscogsrc/vm/cointerp.c
branches/Cog/nscogsrc/vm/cointerp.h
branches/Cog/nscogsrc/vm/gcc3x-cointerp.c
branches/Cog/nsspursrc/vm/cointerp.c
branches/Cog/nsspursrc/vm/cointerp.h
branches/Cog/nsspursrc/vm/gcc3x-cointerp.c
branches/Cog/nsspurstacksrc/vm/gcc3x-interp.c
branches/Cog/nsspurstacksrc/vm/interp.c
branches/Cog/scripts/findUnofficialFiles
branches/Cog/sistasrc/vm/cointerp.c
branches/Cog/sistasrc/vm/cointerp.h
branches/Cog/sistasrc/vm/gcc3x-cointerp.c
branches/Cog/spursistasrc/vm/cointerp.c
branches/Cog/spursistasrc/vm/cointerp.h
branches/Cog/spursistasrc/vm/gcc3x-cointerp.c
branches/Cog/spursrc/vm/cointerp.c
branches/Cog/spursrc/vm/cointerp.h
branches/Cog/spursrc/vm/gcc3x-cointerp.c
branches/Cog/spurstack64src/vm/gcc3x-interp.c
branches/Cog/spurstack64src/vm/interp.c
branches/Cog/spurstacksrc/vm/gcc3x-interp.c
branches/Cog/spurstacksrc/vm/interp.c
branches/Cog/src/plugins/B2DPlugin/B2DPlugin.c
branches/Cog/src/plugins/B3DAcceleratorPlugin/B3DAcceleratorPlugin.c
branches/Cog/src/plugins/BitBltPlugin/BitBltPlugin.c
branches/Cog/src/plugins/BochsIA32Plugin/BochsIA32Plugin.c
branches/Cog/src/plugins/FilePlugin/FilePlugin.c
branches/Cog/src/plugins/GdbARMPlugin/GdbARMPlugin.c
branches/Cog/src/plugins/IA32ABI/IA32ABI.c
branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c
branches/Cog/src/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c
branches/Cog/src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c
branches/Cog/src/plugins/SqueakFFIPrims/IA32FFIPlugin.c
branches/Cog/src/plugins/UnicodePlugin/UnicodePlugin.c
branches/Cog/src/plugins/VMProfileLinuxSupportPlugin/VMProfileLinuxSupportPlugin.c
branches/Cog/src/plugins/VMProfileMacSupportPlugin/VMProfileMacSupportPlugin.c
branches/Cog/src/vm/cointerp.c
branches/Cog/src/vm/cointerp.h
branches/Cog/src/vm/cointerpmt.c
branches/Cog/src/vm/cointerpmt.h
branches/Cog/src/vm/gcc3x-cointerp.c
branches/Cog/src/vm/gcc3x-cointerpmt.c
branches/Cog/stacksrc/vm/gcc3x-interp.c
branches/Cog/stacksrc/vm/interp.c
Added Paths:
-----------
branches/Cog/scripts/mkvmarchives
Removed Paths:
-------------
branches/Cog/build.linux32x86/newspeak.stack.v3/
branches/Cog/build.macos32x86/newspeak.stack.v3/
branches/Cog/build.win32x86/newspeak.stack.v3/
Property Changed:
----------------
branches/Cog/platforms/Cross/vm/sqSCCSVersion.h
Modified: branches/Cog/nscogsrc/plugins/B2DPlugin/B2DPlugin.c
===================================================================
--- branches/Cog/nscogsrc/plugins/B2DPlugin/B2DPlugin.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/plugins/B2DPlugin/B2DPlugin.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,9 +1,9 @@
/* Automatically generated by
- VMPluginCodeGenerator VMMaker.oscog-eem.990 uuid: f4a22308-891c-4542-b6a4-10fe174bc82a
+ VMPluginCodeGenerator VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- BalloonEnginePlugin VMMaker.oscog-eem.990 uuid: f4a22308-891c-4542-b6a4-10fe174bc82a
+ BalloonEnginePlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
*/
-static char __buildInfo[] = "BalloonEnginePlugin VMMaker.oscog-eem.990 uuid: f4a22308-891c-4542-b6a4-10fe174bc82a " __DATE__ ;
+static char __buildInfo[] = "BalloonEnginePlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3 " __DATE__ ;
@@ -836,9 +836,9 @@
static void * loadBBFn;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "B2DPlugin VMMaker.oscog-eem.990 (i)"
+ "B2DPlugin VMMaker.oscog-eem.1064 (i)"
#else
- "B2DPlugin VMMaker.oscog-eem.990 (e)"
+ "B2DPlugin VMMaker.oscog-eem.1064 (e)"
#endif
;
static int* objBuffer;
@@ -9155,9 +9155,12 @@
return primitiveFailFor(GEFBadPoint);
}
/* begin loadBitmapFill:colormap:tile:from:along:normal:xIndex: */
- tileFlag1 = (tileFlag
- ? 1
- : 0);
+ if (tileFlag) {
+ tileFlag1 = 1;
+ }
+ else {
+ tileFlag1 = 0;
+ }
/* begin point1Get */
point1 = ((int *) (workBuffer + GWPoint1));
/* begin point2Get */
Modified: branches/Cog/nscogsrc/plugins/BitBltPlugin/BitBltPlugin.c
===================================================================
--- branches/Cog/nscogsrc/plugins/BitBltPlugin/BitBltPlugin.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/plugins/BitBltPlugin/BitBltPlugin.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,9 +1,9 @@
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.998 uuid: 20a6acb3-9a01-4219-b650-8966301ffe11
+ SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- BitBltSimulation VMMaker.oscog-eem.998 uuid: 20a6acb3-9a01-4219-b650-8966301ffe11
+ BitBltSimulation VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
*/
-static char __buildInfo[] = "BitBltSimulation VMMaker.oscog-eem.998 uuid: 20a6acb3-9a01-4219-b650-8966301ffe11 " __DATE__ ;
+static char __buildInfo[] = "BitBltSimulation VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3 " __DATE__ ;
@@ -269,9 +269,7 @@
#if !defined(SQUEAK_BUILTIN_PLUGIN)
static sqInt (*byteSizeOf)(sqInt oop);
-static sqInt (*classArray)(void);
static sqInt (*failed)(void);
-static sqInt (*fetchClassOf)(sqInt oop);
static sqInt (*fetchIntegerofObject)(sqInt fieldIndex, sqInt objectPointer);
static sqInt (*fetchLong32ofObject)(sqInt fieldIndex, sqInt oop);
static sqInt (*fetchPointerofObject)(sqInt index, sqInt oop);
@@ -280,6 +278,7 @@
static sqInt (*integerObjectOf)(sqInt value);
static sqInt (*integerValueOf)(sqInt oop);
static void * (*ioLoadFunctionFrom)(char *functionName, char *moduleName);
+static sqInt (*isArray)(sqInt oop);
static sqInt (*isBytes)(sqInt oop);
static sqInt (*isIntegerObject)(sqInt objectPointer);
static sqInt (*isPointers)(sqInt oop);
@@ -302,9 +301,7 @@
static sqInt (*storeIntegerofObjectwithValue)(sqInt index, sqInt oop, sqInt integer);
#else /* !defined(SQUEAK_BUILTIN_PLUGIN) */
extern sqInt byteSizeOf(sqInt oop);
-extern sqInt classArray(void);
extern sqInt failed(void);
-extern sqInt fetchClassOf(sqInt oop);
extern sqInt fetchIntegerofObject(sqInt fieldIndex, sqInt objectPointer);
extern sqInt fetchLong32ofObject(sqInt fieldIndex, sqInt oop);
extern sqInt fetchPointerofObject(sqInt index, sqInt oop);
@@ -313,6 +310,7 @@
extern sqInt integerObjectOf(sqInt value);
extern sqInt integerValueOf(sqInt oop);
extern void * ioLoadFunctionFrom(char *functionName, char *moduleName);
+extern sqInt isArray(sqInt oop);
extern sqInt isBytes(sqInt oop);
extern sqInt isIntegerObject(sqInt objectPointer);
extern sqInt isPointers(sqInt oop);
@@ -346,9 +344,9 @@
};
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "BitBltPlugin VMMaker.oscog-eem.998 (i)"
+ "BitBltPlugin VMMaker.oscog-eem.1064 (i)"
#else
- "BitBltPlugin VMMaker.oscog-eem.998 (e)"
+ "BitBltPlugin VMMaker.oscog-eem.1064 (e)"
#endif
;
static sqInt noHalftone;
@@ -5033,12 +5031,18 @@
sqInt val;
sqInt _return_value;
- colorA = (BytesPerOop == 4
- ? positive32BitValueOf(stackValue(2))
- : positive64BitValueOf(stackValue(2)));
- colorB = (BytesPerOop == 4
- ? positive32BitValueOf(stackValue(1))
- : positive64BitValueOf(stackValue(1)));
+ if (BytesPerOop == 4) {
+ colorA = positive32BitValueOf(stackValue(2));
+ }
+ else {
+ colorA = positive64BitValueOf(stackValue(2));
+ }
+ if (BytesPerOop == 4) {
+ colorB = positive32BitValueOf(stackValue(1));
+ }
+ else {
+ colorB = positive64BitValueOf(stackValue(1));
+ }
testID = stackIntegerValue(0);
rcvr = stackValue(3);
if (failed()) {
@@ -5157,39 +5161,32 @@
kernDelta = stackIntegerValue(0);
xTable = stackObjectValue(1);
glyphMap = stackObjectValue(2);
- if (!(((fetchClassOf(xTable)) == (classArray()))
- && ((fetchClassOf(glyphMap)) == (classArray())))) {
- return primitiveFail();
- }
- if (!((slotSizeOf(glyphMap)) == 256)) {
- return primitiveFail();
- }
- if (failed()) {
- return null;
- }
- maxGlyph = (slotSizeOf(xTable)) - 2;
stopIndex = stackIntegerValue(3);
startIndex = stackIntegerValue(4);
sourceString = stackObjectValue(5);
- if (!(isBytes(sourceString))) {
- return primitiveFail();
+ bbObj = stackObjectValue(6);
+ if (failed()) {
+ return null;
}
- if (!((startIndex > 0)
+ if (!((isArray(xTable))
+ && ((isArray(glyphMap))
+ && (((slotSizeOf(glyphMap)) == 256)
+ && ((isBytes(sourceString))
+ && ((startIndex > 0)
&& ((stopIndex > 0)
- && (stopIndex <= (byteSizeOf(sourceString)))))) {
+ && ((stopIndex <= (byteSizeOf(sourceString)))
+ && ((loadBitBltFromwarping(bbObj, 0))
+ && ((combinationRule != 30)
+ && (combinationRule != 0x1F))))))))))) {
return primitiveFail();
}
- bbObj = stackObjectValue(6);
- if (!(loadBitBltFromwarping(bbObj, 0))) {
- return primitiveFail();
- }
- if ((combinationRule == 30)
- || (combinationRule == 0x1F)) {
- /* needs extra source alpha */
+ /* See if we can go directly into copyLoopPixMap (usually we can) */
- return primitiveFail();
- }
+ maxGlyph = (slotSizeOf(xTable)) - 2;
+
+ /* no point using slower version */
+
quickBlt = (destBits != 0)
&& ((sourceBits != 0)
&& ((noSource == 0)
@@ -6653,9 +6650,7 @@
#if !defined(SQUEAK_BUILTIN_PLUGIN)
byteSizeOf = interpreterProxy->byteSizeOf;
- classArray = interpreterProxy->classArray;
failed = interpreterProxy->failed;
- fetchClassOf = interpreterProxy->fetchClassOf;
fetchIntegerofObject = interpreterProxy->fetchIntegerofObject;
fetchLong32ofObject = interpreterProxy->fetchLong32ofObject;
fetchPointerofObject = interpreterProxy->fetchPointerofObject;
@@ -6664,6 +6659,7 @@
integerObjectOf = interpreterProxy->integerObjectOf;
integerValueOf = interpreterProxy->integerValueOf;
ioLoadFunctionFrom = interpreterProxy->ioLoadFunctionFrom;
+ isArray = interpreterProxy->isArray;
isBytes = interpreterProxy->isBytes;
isIntegerObject = interpreterProxy->isIntegerObject;
isPointers = interpreterProxy->isPointers;
Modified: branches/Cog/nscogsrc/plugins/FilePlugin/FilePlugin.c
===================================================================
--- branches/Cog/nscogsrc/plugins/FilePlugin/FilePlugin.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/plugins/FilePlugin/FilePlugin.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,9 +1,9 @@
/* Automatically generated by
- VMPluginCodeGenerator VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d
+ VMPluginCodeGenerator VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- FilePlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d
+ FilePlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
*/
-static char __buildInfo[] = "FilePlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d " __DATE__ ;
+static char __buildInfo[] = "FilePlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3 " __DATE__ ;
@@ -177,9 +177,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "FilePlugin VMMaker.oscog-eem.983 (i)"
+ "FilePlugin VMMaker.oscog-eem.1064 (i)"
#else
- "FilePlugin VMMaker.oscog-eem.983 (e)"
+ "FilePlugin VMMaker.oscog-eem.1064 (e)"
#endif
;
static void * sCCPfn;
@@ -853,9 +853,12 @@
|| (!(isWordsOrBytes(array)))) {
return primitiveFailFor(PrimErrBadArgument);
}
- elementSize = (isWords(array)
- ? 4
- : 1);
+ if (isWords(array)) {
+ elementSize = 4;
+ }
+ else {
+ elementSize = 1;
+ }
if (!((startIndex >= 1)
&& (((startIndex + count) - 1) <= (slotSizeOf(array))))) {
return primitiveFailFor(PrimErrBadIndex);
@@ -1080,9 +1083,12 @@
|| (!(isWordsOrBytes(array)))) {
return primitiveFailFor(PrimErrBadArgument);
}
- elementSize = (isWords(array)
- ? 4
- : 1);
+ if (isWords(array)) {
+ elementSize = 4;
+ }
+ else {
+ elementSize = 1;
+ }
if (!((startIndex >= 1)
&& (((startIndex + count) - 1) <= (slotSizeOf(array))))) {
return primitiveFailFor(PrimErrBadIndex);
Modified: branches/Cog/nscogsrc/plugins/IA32ABI/IA32ABI.c
===================================================================
--- branches/Cog/nscogsrc/plugins/IA32ABI/IA32ABI.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/plugins/IA32ABI/IA32ABI.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,9 +1,9 @@
/* Automatically generated by
- VMPluginCodeGenerator VMMaker.oscog-eem.1032 uuid: a3c915e6-d663-4d65-ab41-493c71498549
+ VMPluginCodeGenerator VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- NewsqueakIA32ABIPlugin VMMaker.oscog-eem.1032 uuid: a3c915e6-d663-4d65-ab41-493c71498549
+ NewsqueakIA32ABIPlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
*/
-static char __buildInfo[] = "NewsqueakIA32ABIPlugin VMMaker.oscog-eem.1032 uuid: a3c915e6-d663-4d65-ab41-493c71498549 " __DATE__ ;
+static char __buildInfo[] = "NewsqueakIA32ABIPlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3 " __DATE__ ;
@@ -223,9 +223,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "IA32ABI VMMaker.oscog-eem.1032 (i)"
+ "IA32ABI VMMaker.oscog-eem.1064 (i)"
#else
- "IA32ABI VMMaker.oscog-eem.1032 (e)"
+ "IA32ABI VMMaker.oscog-eem.1064 (e)"
#endif
;
@@ -288,9 +288,12 @@
rcvr = stackValue(0);
value = longAt((rcvr + BaseHeaderSize) + BytesPerOop);
- valueOop = (BytesPerWord == 8
- ? positive64BitIntegerFor(value)
- : positive32BitIntegerFor(value));
+ if (BytesPerWord == 8) {
+ valueOop = positive64BitIntegerFor(value);
+ }
+ else {
+ valueOop = positive32BitIntegerFor(value);
+ }
return methodReturnValue(valueOop);
}
@@ -704,9 +707,9 @@
|| (((((usqInt)byteOffset)) + 8) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -752,9 +755,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -793,9 +796,9 @@
|| (((((usqInt)byteOffset)) + 4) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -841,9 +844,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1086,9 +1089,9 @@
|| (((((usqInt)byteOffset)) + 1) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1131,9 +1134,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1168,9 +1171,9 @@
|| (((((usqInt)byteOffset)) + 4) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1211,9 +1214,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1251,9 +1254,9 @@
|| (((((usqInt)byteOffset)) + 8) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1299,9 +1302,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1337,9 +1340,9 @@
|| (((((usqInt)byteOffset)) + 2) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1382,9 +1385,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1408,9 +1411,12 @@
rcvr = stackValue(0);
value = ((sqInt) (longAt(rcvr + BaseHeaderSize)));
- valueOop = (BytesPerWord == 8
- ? signed64BitIntegerFor(value)
- : signed32BitIntegerFor(value));
+ if (BytesPerWord == 8) {
+ valueOop = signed64BitIntegerFor(value);
+ }
+ else {
+ valueOop = signed32BitIntegerFor(value);
+ }
return methodReturnValue(valueOop);
}
@@ -1563,9 +1569,9 @@
|| (((((usqInt)byteOffset)) + 1) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1607,9 +1613,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1644,9 +1650,9 @@
|| (((((usqInt)byteOffset)) + 4) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1687,9 +1693,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1727,9 +1733,9 @@
|| (((((usqInt)byteOffset)) + 8) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1776,9 +1782,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1814,9 +1820,9 @@
|| (((((usqInt)byteOffset)) + 2) <= (abs(dataSize))))) {
return primitiveFailFor(PrimErrBadIndex);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
@@ -1858,9 +1864,9 @@
if (isOopImmutable(rcvr)) {
return primitiveFailFor(PrimErrNoModification);
}
- if (((startAddr = ((longAt(rcvr + BaseHeaderSize)) > 0
- ? (rcvr + BaseHeaderSize) + BytesPerOop
- : longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
+ if ((((longAt(rcvr + BaseHeaderSize)) > 0
+ ? (startAddr = (rcvr + BaseHeaderSize) + BytesPerOop)
+ : (startAddr = longAt((rcvr + BaseHeaderSize) + BytesPerOop)))) == 0) {
return primitiveFailFor(PrimErrBadReceiver);
}
addr = startAddr + byteOffset;
Modified: branches/Cog/nscogsrc/plugins/LargeIntegers/LargeIntegers.c
===================================================================
--- branches/Cog/nscogsrc/plugins/LargeIntegers/LargeIntegers.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/plugins/LargeIntegers/LargeIntegers.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,9 +1,9 @@
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.1048 uuid: 8c759c0d-f612-4018-8a05-45ec7f6af78f
+ SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- LargeIntegersPlugin VMMaker.oscog-eem.1048 uuid: 8c759c0d-f612-4018-8a05-45ec7f6af78f
+ LargeIntegersPlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
*/
-static char __buildInfo[] = "LargeIntegersPlugin VMMaker.oscog-eem.1048 uuid: 8c759c0d-f612-4018-8a05-45ec7f6af78f " __DATE__ ;
+static char __buildInfo[] = "LargeIntegersPlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3 " __DATE__ ;
@@ -173,9 +173,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "LargeIntegers v1.5 VMMaker.oscog-eem.1048 (i)"
+ "LargeIntegers v1.5 VMMaker.oscog-eem.1064 (i)"
#else
- "LargeIntegers v1.5 VMMaker.oscog-eem.1048 (e)"
+ "LargeIntegers v1.5 VMMaker.oscog-eem.1064 (e)"
#endif
;
static const int orOpIndex = 1;
@@ -731,9 +731,12 @@
dl = divLen - 1;
ql = quoLen;
dh = pDiv[dl - 1];
- dnh = (dl == 1
- ? 0
- : pDiv[dl - 2]);
+ if (dl == 1) {
+ dnh = 0;
+ }
+ else {
+ dnh = pDiv[dl - 2];
+ }
for (k = 1; k <= ql; k += 1) {
/* maintain quo*arg+rem=self */
@@ -1557,9 +1560,12 @@
dl = divLen - 1;
ql = quoLen;
dh = pDiv[dl - 1];
- dnh = (dl == 1
- ? 0
- : pDiv[dl - 2]);
+ if (dl == 1) {
+ dnh = 0;
+ }
+ else {
+ dnh = pDiv[dl - 2];
+ }
for (k = 1; k <= ql; k += 1) {
/* maintain quo*arg+rem=self */
@@ -2167,12 +2173,12 @@
if (len == 0) {
return integerObjectOf(0);
}
-
- /* SmallInteger minVal digitLength */
-
- sLen = ((MinSmallInteger) < -1073741824
- ? 8
- : 4);
+ if ((MinSmallInteger) < -1073741824) {
+ sLen = 8;
+ }
+ else {
+ sLen = 4;
+ }
if (len <= sLen) {
/* SmallInteger minVal */
@@ -2244,9 +2250,15 @@
if (len == 0) {
return integerObjectOf(0);
}
- sLen = ((MinSmallInteger) > 0x3FFFFFFF
- ? 8
- : 4);
+ if ((MinSmallInteger) > 0x3FFFFFFF) {
+
+ /* SmallInteger maxVal digitLength. */
+
+ sLen = 8;
+ }
+ else {
+ sLen = 4;
+ }
if ((len <= sLen)
&& ((digitOfBytesat(aLargePositiveInteger, sLen)) <= (cDigitOfCSIat(MaxSmallInteger, sLen)))) {
Modified: branches/Cog/nscogsrc/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c
===================================================================
--- branches/Cog/nscogsrc/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,16 +1,16 @@
/* Automatically generated by
- VMPluginCodeGenerator VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d
+ VMPluginCodeGenerator VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- MiscPrimitivePlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d
- Bitmap * Graphics-bf.303 uuid: 59c75040-7563-4061-8425-81f4467d3eb8
- ByteArray * Collections.spur-bf.588 uuid: 80ef5d3c-140e-4225-98f4-354435f1372e
- ByteString * Collections.spur-bf.588 uuid: 80ef5d3c-140e-4225-98f4-354435f1372e
+ MiscPrimitivePlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
+ Bitmap * Graphics-kfr.305 uuid: ad7be66f-dd0c-8443-b773-b96836359b05
+ ByteArray * Collections.spur-mt.591, Collections.spur-eem.603 uuid: dd41c76b-9063-421b-87bc-4229ac3f5243
+ ByteString * Collections.spur-mt.591, Collections.spur-eem.603 uuid: dd41c76b-9063-421b-87bc-4229ac3f5243
SampledSound Sound-bf.42 uuid: 01b2784a-0ad7-4a6b-a996-3388ab820acd
*/
-static char __buildInfo[] = "MiscPrimitivePlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d\n\
-Bitmap * Graphics-bf.303 uuid: 59c75040-7563-4061-8425-81f4467d3eb8\n\
-ByteArray * Collections.spur-bf.588 uuid: 80ef5d3c-140e-4225-98f4-354435f1372e\n\
-ByteString * Collections.spur-bf.588 uuid: 80ef5d3c-140e-4225-98f4-354435f1372e\n\
+static char __buildInfo[] = "MiscPrimitivePlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3\n\
+Bitmap * Graphics-kfr.305 uuid: ad7be66f-dd0c-8443-b773-b96836359b05\n\
+ByteArray * Collections.spur-mt.591, Collections.spur-eem.603 uuid: dd41c76b-9063-421b-87bc-4229ac3f5243\n\
+ByteString * Collections.spur-mt.591, Collections.spur-eem.603 uuid: dd41c76b-9063-421b-87bc-4229ac3f5243\n\
SampledSound Sound-bf.42 uuid: 01b2784a-0ad7-4a6b-a996-3388ab820acd " __DATE__ ;
@@ -94,9 +94,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "MiscPrimitivePlugin VMMaker.oscog-eem.983 (i)"
+ "MiscPrimitivePlugin VMMaker.oscog-eem.1064 (i)"
#else
- "MiscPrimitivePlugin VMMaker.oscog-eem.983 (e)"
+ "MiscPrimitivePlugin VMMaker.oscog-eem.1064 (e)"
#endif
;
Modified: branches/Cog/nscogsrc/plugins/VMProfileLinuxSupportPlugin/VMProfileLinuxSupportPlugin.c
===================================================================
--- branches/Cog/nscogsrc/plugins/VMProfileLinuxSupportPlugin/VMProfileLinuxSupportPlugin.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/plugins/VMProfileLinuxSupportPlugin/VMProfileLinuxSupportPlugin.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,9 +1,9 @@
/* Automatically generated by
- VMPluginCodeGenerator VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d
+ VMPluginCodeGenerator VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- VMProfileLinuxSupportPlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d
+ VMProfileLinuxSupportPlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
*/
-static char __buildInfo[] = "VMProfileLinuxSupportPlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d " __DATE__ ;
+static char __buildInfo[] = "VMProfileLinuxSupportPlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3 " __DATE__ ;
@@ -51,6 +51,7 @@
/*** Function Prototypes ***/
static int countnummodules(struct dl_phdr_info *info, size_t size, void *ignored);
EXPORT(const char*) getModuleName(void);
+static sqInt positiveMachineIntegerFor(unsigned long value);
EXPORT(sqInt) primitiveDLSymInLibrary(void);
EXPORT(sqInt) primitiveExecutableModules(void);
EXPORT(sqInt) primitiveInterpretAddress(void);
@@ -73,6 +74,7 @@
static sqInt (*nilObject)(void);
static sqInt (*popRemappableOop)(void);
static sqInt (*positive32BitIntegerFor)(sqInt integerValue);
+static sqInt (*positive64BitIntegerFor)(sqLong integerValue);
static sqInt (*primitiveFailFor)(sqInt reasonCode);
static sqInt (*pushRemappableOop)(sqInt oop);
static sqInt (*stackValue)(sqInt offset);
@@ -90,6 +92,7 @@
extern sqInt nilObject(void);
extern sqInt popRemappableOop(void);
extern sqInt positive32BitIntegerFor(sqInt integerValue);
+extern sqInt positive64BitIntegerFor(sqLong integerValue);
extern sqInt primitiveFailFor(sqInt reasonCode);
extern sqInt pushRemappableOop(sqInt oop);
extern sqInt stackValue(sqInt offset);
@@ -100,9 +103,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "VMProfileLinuxSupportPlugin VMMaker.oscog-eem.983 (i)"
+ "VMProfileLinuxSupportPlugin VMMaker.oscog-eem.1064 (i)"
#else
- "VMProfileLinuxSupportPlugin VMMaker.oscog-eem.983 (e)"
+ "VMProfileLinuxSupportPlugin VMMaker.oscog-eem.1064 (e)"
#endif
;
static sqInt numModules;
@@ -128,7 +131,15 @@
return moduleName;
}
+static sqInt
+positiveMachineIntegerFor(unsigned long value)
+{
+ return (BytesPerWord == 8
+ ? positive64BitIntegerFor(value)
+ : positive32BitIntegerFor(value));
+}
+
/* Answer the address of the symbol whose name is the first argument
in the library whose name is the second argument, or nil if none. */
@@ -175,7 +186,9 @@
if (!ok) {
return primitiveFailFor(PrimErrNotFound);
}
- return methodReturnValue(positive32BitIntegerFor(((unsigned long)addr)));
+ return methodReturnValue((BytesPerWord == 8
+ ? positive64BitIntegerFor(((unsigned long)addr))
+ : positive32BitIntegerFor(((unsigned long)addr))));
}
@@ -217,8 +230,9 @@
{
extern void interpret();
-
- return methodReturnValue(positive32BitIntegerFor(((unsigned long)interpret)));
+ return methodReturnValue((BytesPerWord == 8
+ ? positive64BitIntegerFor(((unsigned long)interpret))
+ : positive32BitIntegerFor(((unsigned long)interpret))));
}
static int
@@ -313,6 +327,7 @@
nilObject = interpreterProxy->nilObject;
popRemappableOop = interpreterProxy->popRemappableOop;
positive32BitIntegerFor = interpreterProxy->positive32BitIntegerFor;
+ positive64BitIntegerFor = interpreterProxy->positive64BitIntegerFor;
primitiveFailFor = interpreterProxy->primitiveFailFor;
pushRemappableOop = interpreterProxy->pushRemappableOop;
stackValue = interpreterProxy->stackValue;
Modified: branches/Cog/nscogsrc/plugins/VMProfileMacSupportPlugin/VMProfileMacSupportPlugin.c
===================================================================
--- branches/Cog/nscogsrc/plugins/VMProfileMacSupportPlugin/VMProfileMacSupportPlugin.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/plugins/VMProfileMacSupportPlugin/VMProfileMacSupportPlugin.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,9 +1,9 @@
/* Automatically generated by
- VMPluginCodeGenerator VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d
+ VMPluginCodeGenerator VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- VMProfileMacSupportPlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d
+ VMProfileMacSupportPlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
*/
-static char __buildInfo[] = "VMProfileMacSupportPlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d " __DATE__ ;
+static char __buildInfo[] = "VMProfileMacSupportPlugin VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3 " __DATE__ ;
@@ -45,6 +45,7 @@
/*** Function Prototypes ***/
EXPORT(const char*) getModuleName(void);
+static sqInt positiveMachineIntegerFor(unsigned long value);
EXPORT(sqInt) primitiveDLSym(void);
EXPORT(sqInt) primitiveExecutableModulesAndOffsets(void);
EXPORT(sqInt) setInterpreter(struct VirtualMachine*anInterpreter);
@@ -66,6 +67,7 @@
static sqInt (*popthenPush)(sqInt nItems, sqInt oop);
static sqInt (*popRemappableOop)(void);
static sqInt (*positive32BitIntegerFor)(sqInt integerValue);
+static sqInt (*positive64BitIntegerFor)(sqLong integerValue);
static sqInt (*primitiveFail)(void);
static sqInt (*primitiveFailFor)(sqInt reasonCode);
static sqInt (*pushRemappableOop)(sqInt oop);
@@ -87,6 +89,7 @@
extern sqInt popthenPush(sqInt nItems, sqInt oop);
extern sqInt popRemappableOop(void);
extern sqInt positive32BitIntegerFor(sqInt integerValue);
+extern sqInt positive64BitIntegerFor(sqLong integerValue);
extern sqInt primitiveFail(void);
extern sqInt primitiveFailFor(sqInt reasonCode);
extern sqInt pushRemappableOop(sqInt oop);
@@ -99,9 +102,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "VMProfileMacSupportPlugin VMMaker.oscog-eem.983 (i)"
+ "VMProfileMacSupportPlugin VMMaker.oscog-eem.1064 (i)"
#else
- "VMProfileMacSupportPlugin VMMaker.oscog-eem.983 (e)"
+ "VMProfileMacSupportPlugin VMMaker.oscog-eem.1064 (e)"
#endif
;
@@ -118,7 +121,15 @@
return moduleName;
}
+static sqInt
+positiveMachineIntegerFor(unsigned long value)
+{
+ return (BytesPerWord == 8
+ ? positive64BitIntegerFor(value)
+ : positive32BitIntegerFor(value));
+}
+
/* Answer the address of the argument in the current process or nil if none. */
EXPORT(sqInt)
@@ -146,7 +157,9 @@
free(name);
return methodReturnValue((addr == 0
? nilObject()
- : positive32BitIntegerFor(((unsigned long)addr))));
+ : (BytesPerWord == 8
+ ? positive64BitIntegerFor(((unsigned long)addr))
+ : positive32BitIntegerFor(((unsigned long)addr)))));
}
@@ -209,13 +222,23 @@
return primitiveFail();
}
storePointerofObjectwithValue((i * 4) + 1, topRemappableOop(), valueObj);
- valueObj = positive32BitIntegerFor(start);
+ if (BytesPerWord == 8) {
+ valueObj = positive64BitIntegerFor(start);
+ }
+ else {
+ valueObj = positive32BitIntegerFor(start);
+ }
if (failed()) {
popRemappableOop();
return primitiveFail();
}
storePointerofObjectwithValue((i * 4) + 2, topRemappableOop(), valueObj);
- valueObj = positive32BitIntegerFor(size);
+ if (BytesPerWord == 8) {
+ valueObj = positive64BitIntegerFor(size);
+ }
+ else {
+ valueObj = positive32BitIntegerFor(size);
+ }
if (failed()) {
popRemappableOop();
return primitiveFail();
@@ -253,6 +276,7 @@
popthenPush = interpreterProxy->popthenPush;
popRemappableOop = interpreterProxy->popRemappableOop;
positive32BitIntegerFor = interpreterProxy->positive32BitIntegerFor;
+ positive64BitIntegerFor = interpreterProxy->positive64BitIntegerFor;
primitiveFail = interpreterProxy->primitiveFail;
primitiveFailFor = interpreterProxy->primitiveFailFor;
pushRemappableOop = interpreterProxy->pushRemappableOop;
Modified: branches/Cog/nscogsrc/vm/cointerp.c
===================================================================
--- branches/Cog/nscogsrc/vm/cointerp.c 2015-02-13 03:00:34 UTC (rev 3255)
+++ branches/Cog/nscogsrc/vm/cointerp.c 2015-02-14 02:19:04 UTC (rev 3256)
@@ -1,9 +1,9 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1060 uuid: c43c476e-10ff-420e-a2eb-c17d4624e338
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
from
- CoInterpreter VMMaker.oscog-eem.1060 uuid: c43c476e-10ff-420e-a2eb-c17d4624e338
+ CoInterpreter VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
*/
-static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.1060 uuid: c43c476e-10ff-420e-a2eb-c17d4624e338 " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.1064 uuid: 9d9d2583-03e6-4b6b-9b24-51587933f8f3 " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -766,6 +766,7 @@
EXPORT(void) primitiveSubtractLargeIntegers(void);
static void primitiveTestAndSetOwnershipOfCriticalSection(void);
static void primitiveTestDisplayDepth(void);
+static void primitiveTimesTwoPower(void);
static void primitiveTruncated(void);
static void primitiveUnloadModule(void);
static void primitiveUpdateTimezone(void);
@@ -914,7 +915,6 @@
sqInt falseObject(void);
sqInt fetchByteofObject(sqInt byteIndex, sqInt oop);
sqInt fetchClassOf(sqInt oop);
-static sqInt fetchLong32ofFloatObject(sqInt fieldIndex, sqInt oop) NoDbgRegParms;
sqInt fetchLong32ofObject(sqInt fieldIndex, sqInt oop);
sqInt fetchPointerofObject(sqInt fieldIndex, sqInt oop);
static void finalizeReference(usqInt oop) NoDbgRegParms;
@@ -931,6 +931,7 @@
static sqInt fwdBlockValid(sqInt addr) NoDbgRegParms;
static sqInt goodContextSize(sqInt oop) NoDbgRegParms;
static sqInt hasForwardingBlock(sqInt objOop) NoDbgRegParms;
+static sqInt hasSixtyFourBitImmediates(void);
static sqInt headerWhileForwardingOf(sqInt oop) NoDbgRegParms;
sqInt indexablePointersFormat(void);
sqInt instanceSizeOf(sqInt classObj);
@@ -1146,6 +1147,7 @@
static sqInt marriedContextpointsTostackDeltaForCurrentFrame(sqInt spouseContext, sqInt anOop, sqInt stackDeltaForCurrentFrame) NoDbgRegParms;
static void marryContextInNewStackPageAndInitializeInterpreterRegisters(sqInt aContext) NoDbgRegParms;
static sqInt marryFrameSP(char *theFP, char *theSP) NoDbgRegParms;
+static sqInt maybeInlinePositive32BitIntegerFor(sqInt integerValue) NoDbgRegParms;
static sqInt maybeSelectorOfMethod(sqInt methodObj) NoDbgRegParms;
sqInt methodArgumentCount(void);
sqInt methodArg(sqInt index);
@@ -1159,6 +1161,7 @@
EXPORT(void) moduleUnloaded(char *aModuleName);
static char * nameOfClass(sqInt classOop) NoDbgRegParms;
static StackPage * newStackPage(void);
+static sqInt noInlineSigned32BitIntegerFor(sqInt integerValue) NoDbgRegParms;
static sqInt noInlineTemporaryin(sqInt offset, char *theFP) NoDbgRegParms;
static sqInt noInlineTemporaryinput(sqInt offset, char *theFP, sqInt valueOop) NoDbgRegParms;
static sqInt noMarkedContextsOnPage(StackPage *thePage) NoDbgRegParms;
@@ -1365,17 +1368,18 @@
_iss sqInt profileProcess;
_iss sqInt profileSemaphore;
_iss usqInt fwdTableNext;
-_iss sqInt longRunningPrimitiveCheckMethod;
_iss sqInt profileMethod;
_iss usqInt compStart;
+_iss sqInt longRunningPrimitiveCheckMethod;
+_iss sqInt weakRootCount;
_iss sqInt extraRootCount;
_iss sqInt growHeadroom;
_iss sqInt statGrowMemory;
_iss sqInt tempOop2;
-_iss sqInt weakRootCount;
_iss sqInt classNameIndex;
_iss sqInt lastMethodCacheProbeWrite;
_iss sqInt preemptionYields;
+_iss sqInt cogCodeSize;
_iss usqLong nextWakeupUsecs;
_iss sqInt statMarkCount;
_iss sqInt cogCompiledCodeCompactionCalledFor;
@@ -1393,7 +1397,6 @@
_iss usqLong statCheckForEvents;
_iss usqLong statGCEndUsecs;
_iss sqInt statSweepCount;
-_iss sqInt cogCodeSize;
_iss usqInt compEnd;
_iss sqInt externalPrimitiveTableFirstFreeIndex;
_iss sqInt shrinkThreshold;
@@ -1422,11 +1425,13 @@
_iss sqInt totalObjectCount;
_iss sqInt fullScreenFlag;
_iss usqInt gcBiasToGrowThreshold;
+_iss sqInt imageFloatsBigEndian;
_iss sqInt interruptKeycode;
_iss sqInt interruptPending;
_iss usqInt memory;
_iss sqInt methodDictLinearSearchLimit;
_iss usqLong nextPollUsecs;
+_iss sqInt savedWindowSize;
_iss usqLong statForceInterruptCheck;
_iss usqLong statIGCDeltaUsecs;
_iss sqInt statPendingFinalizationSignals;
@@ -1439,22 +1444,20 @@
_iss sqInt gcBiasToGrow;
_iss sqInt gcBiasToGrowGCLimit;
_iss sqInt globalSessionID;
-_iss sqInt imageFloatsBigEndian;
+_iss usqLong longRunningPrimitiveGCUsecs;
_iss sqInt longRunningPrimitiveSignalUndelivered;
_iss sqInt maxExtSemTabSizeSet;
-_iss sqInt savedWindowSize;
_iss sqInt statCodeCompactionCount;
_iss usqLong statCodeCompactionUsecs;
_iss sqInt statRootTableCount;
_iss sqInt statSurvivorCount;
+_iss sqInt the2ndUnknownShort;
_iss sqInt classByteArrayCompactIndex;
_iss sqInt fullGCLock;
_iss sqInt gcSemaphoreIndex;
_iss sqInt imageHeaderFlags;
-_iss usqLong longRunningPrimitiveGCUsecs;
_iss sqInt overflowLimit;
_iss StackPage * overflowedPage;
-_iss sqInt the2ndUnknownShort;
_iss long methodCache[MethodCacheSize + 1 /* 4097 */];
_iss sqInt atCache[AtCacheTotalSize + 1 /* 65 */];
_iss sqInt traceLog[TraceBufferSize /* 768 */];
@@ -1572,7 +1575,7 @@
/* 51 */ primitiveTruncated,
/* 52 */ primitiveFractionalPart,
/* 53 */ primitiveExponent,
- /* 54 */ (void (*)(void))0,
+ /* 54 */ primitiveTimesTwoPower,
/* 55 */ primitiveSquareRoot,
/* 56 */ primitiveSine,
/* 57 */ primitiveArctan,
@@ -2096,7 +2099,7 @@
/* 575 */ (void (*)(void))0,
0 };
char expensiveAsserts = 0;
-const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.1060";
+const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.1064";
sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */;
volatile int sendTrace;
@@ -2434,9 +2437,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (0 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 0 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 0 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (0 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 0 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 0 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2453,9 +2459,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (1 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 1 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 1 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (1 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 1 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 1 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2472,9 +2481,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (2 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 2 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 2 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (2 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 2 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 2 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2491,9 +2503,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (3 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 3 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 3 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (3 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 3 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 3 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2510,9 +2525,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (4 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 4 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 4 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (4 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 4 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 4 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2529,9 +2547,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (5 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 5 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 5 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (5 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 5 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 5 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2548,9 +2569,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (6 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 6 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 6 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (6 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 6 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 6 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2567,9 +2591,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (7 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 7 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 7 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (7 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 7 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 7 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2586,9 +2613,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (8 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 8 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 8 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (8 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 8 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 8 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
longAtPointerput((localSP -= BytesPerOop), object);
}
break;
@@ -2605,9 +2635,12 @@
/* begin pushTemporaryVariable: */
/* begin internalPush: */
- object = (9 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))
- ? longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 9 /* currentBytecode bitAnd: 15 */) * BytesPerWord))
- : longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 9 /* currentBytecode bitAnd: 15 */) * BytesPerWord)));
+ if (9 /* currentBytecode bitAnd: 15 */ < ((frameNumArgs = byteAt((localFP + FoxIFrameFlags) + 1)))) {
+ object = longAt((localFP + FoxCallerSavedIP) + ((frameNumArgs - 9 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
+ else {
+ object = longAt(((localFP + FoxIFReceiver) - BytesPerWord) + ((frameNumArgs - 9 /* currentBytecode bitAnd: 15 */) * BytesPerWord));
+ }
@@ Diff output truncated at 50000 characters. @@
2
1
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1064.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1064
Author: eem
Time: 13 February 2015, 5:47:49.105 pm
UUID: 9d9d2583-03e6-4b6b-9b24-51587933f8f3
Ancestors: VMMaker.oscog-eem.1063
And take advantage of the better inlining in copyAndForward:
=============== Diff against VMMaker.oscog-eem.1063 ===============
Item was changed:
----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') -----
copyAndForward: survivor
"copyAndForward: survivor copies a survivor object either to
futureSurvivorSpace or, if it is to be promoted, to oldSpace.
It leaves a forwarding pointer behind. If the object is weak
then corpse is threaded onto the weakList for later treatment."
<inline: false>
| bytesInObj format tenure newLocation |
self assert: ((manager isInEden: survivor) "cog methods should be excluded."
or: [manager isInPastSpace: survivor]).
bytesInObj := manager bytesInObject: survivor.
format := manager formatOf: survivor.
tenure := self shouldBeTenured: survivor. "Allow Slang to inline."
+ newLocation := (tenure or: [futureSurvivorStart + bytesInObj > futureSpace limit])
+ ifTrue: [self copyToOldSpace: survivor bytes: bytesInObj format: format]
+ ifFalse: [self copyToFutureSpace: survivor bytes: bytesInObj].
- (tenure or: [futureSurvivorStart + bytesInObj > futureSpace limit])
- ifTrue: [newLocation := self copyToOldSpace: survivor bytes: bytesInObj format: format]
- ifFalse: [newLocation := self copyToFutureSpace: survivor bytes: bytesInObj].
manager forwardSurvivor: survivor to: newLocation.
"if weak or ephemeron add to the relevant list for subsequent scanning."
(manager isWeakFormat: format) ifTrue:
[self addToWeakList: survivor].
((manager isEphemeronFormat: format)
and: [(self isScavengeSurvivor: (manager keyOfEphemeron: newLocation)) not]) ifTrue:
[self addToEphemeronList: survivor].
^newLocation!
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1063.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1063
Author: eem
Time: 13 February 2015, 5:37:10.894 pm
UUID: c4480dac-ed58-41cc-a585-b6b4a89c72c8
Ancestors: VMMaker.oscog-eem.1062
Slang:
Rescue translation of the non-64-bit Spur VMs by
a) doing a better job of suoper expansions, handling expansions
that are returning ifs as well as just returns correctly.
b) transforming variable := expr ifTrue: [s1] ifFalse: [s2] into
expr ifTrue: [variable := s1] ifFalse: [variable := s2]
to allow inlining of s1 & s2.
=============== Diff against VMMaker.oscog-eem.1062 ===============
Item was changed:
----- Method: ReturnNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
asTranslatorNodeIn: aTMethod
"Make a CCodeGenerator equivalent of a return."
| exprTranslation lastExpr |
exprTranslation := expr asTranslatorNodeIn: aTMethod.
(expr isMessage
and: [expr receiver isVariableNode
and: [expr receiver key = 'super'
and: [exprTranslation isStmtList]]]) ifTrue:
["super expansions containing returns are fine, and (as of 6/25/2012 19:27) the last
return is elided from the expansion by TMethod>>superExpansionNodeFor:args:.
So we need to ensure the last expression is a return and simply reuse any other
returns in the expansion."
+ lastExpr := exprTranslation statements last.
+ (lastExpr isReturn
+ or: [lastExpr isReturningIf]) ifFalse:
+ [exprTranslation statements
+ at: exprTranslation statements size
+ put:
+ (TReturnNode new
+ setExpression: lastExpr;
+ comment: comment;
+ yourself)].
- exprTranslation statements last isReturn ifFalse:
- [lastExpr := exprTranslation statements removeLast.
- exprTranslation statements addLast:
- (TReturnNode new
- setExpression: lastExpr;
- comment: comment;
- yourself)].
^exprTranslation].
^TReturnNode new
setExpression: exprTranslation;
comment: comment;
yourself!
Item was changed:
----- Method: TAssignmentNode>>emitStatementListExpansion:on:level:generator: (in category 'C code generation') -----
emitStatementListExpansion: stmtList on: aStream level: level generator: aCodeGen
+ stmtList statements last = variable ifTrue:
- | lastStmt copy |
- lastStmt := stmtList statements last.
- lastStmt = variable ifTrue:
[^expression emitCCodeOn: aStream level: level generator: aCodeGen].
+ stmtList copy
+ assignLastExpressionTo: variable;
+ emitCCodeOn: aStream level: level generator: aCodeGen!
- copy := stmtList copy.
- copy statements
- at: stmtList statements size
- put: (TAssignmentNode new
- setVariable: variable
- expression: lastStmt).
- copy emitCCodeOn: aStream level: level generator: aCodeGen!
Item was changed:
----- Method: TAssignmentNode>>setVariable:expression: (in category 'accessing') -----
setVariable: varNode expression: expressionNode
+ self assert: (expressionNode isGoTo or: [expressionNode isLabel]) not.
-
variable := varNode.
expression := expressionNode.!
Item was added:
+ ----- Method: TMethod>>transformConditionalAssignment:in: (in category 'inlining') -----
+ transformConditionalAssignment: node in: aCodeGen
+ "If possible asnwer the transformation of code of the form
+ var := e1
+ ifTrue: [e2 ifTrue: [v1] ifFalse: [v2]]
+ ifFalse: [v3]
+ into
+ e1
+ ifTrue: [e2 ifTrue: [var := v1] ifFalse: [var := v2]]
+ ifFalse: [var := v3]
+ to allow inlining of v1, v2, et al. Otherwise answer nil."
+
+ | expr |
+ ^(node isAssignment
+ and: [(expr := node expression) isSend
+ and: [#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector]]) ifTrue:
+ [expr copy
+ arguments:
+ (expr args collect:
+ [:stmtList| stmtList copy assignLastExpressionTo: node variable]);
+ yourself]!
Item was changed:
----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') -----
tryToInlineMethodsIn: aCodeGen
"Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined."
| stmtLists didSomething newStatements sendsToInline |
self definedAsMacro ifTrue:
[complete := true.
^false].
didSomething := false.
sendsToInline := Dictionary new: 100.
parseTree
nodesDo:
[:node|
+ (self transformConditionalAssignment: node in: aCodeGen) ifNotNil:
+ [:replacement|
+ sendsToInline at: node put: replacement].
(self inlineableFunctionCall: node in: aCodeGen) ifTrue:
[(self inlineFunctionCall: node in: aCodeGen) ifNotNil:
[:replacement|
sendsToInline at: node put: replacement]]]
unless: "Don't inline the arguments to asserts to keep the asserts readable"
[:node|
node isSend
and: [node selector == #cCode:inSmalltalk:
or: [aCodeGen isAssertSelector: node selector]]].
sendsToInline isEmpty ifFalse:
[didSomething := true.
parseTree := parseTree replaceNodesIn: sendsToInline].
didSomething ifTrue:
[writtenToGlobalVarsCache := nil.
^didSomething].
stmtLists := self statementsListsForInliningIn: aCodeGen.
stmtLists do:
[:stmtList|
newStatements := OrderedCollection new: 100.
stmtList statements do:
[:stmt|
(self inlineCodeOrNilForStatement: stmt in: aCodeGen)
ifNil: [newStatements addLast: stmt]
ifNotNil: [:inlinedStmts|
didSomething := true.
newStatements addAllLast: inlinedStmts]].
stmtList setStatements: newStatements asArray].
didSomething ifTrue:
[writtenToGlobalVarsCache := nil.
^didSomething].
complete ifFalse:
[self checkForCompleteness: stmtLists in: aCodeGen.
complete ifTrue: [ didSomething := true ]]. "marking a method complete is progress"
^didSomething!
Item was added:
+ ----- Method: TStmtListNode>>assignLastExpressionTo: (in category 'transformations') -----
+ assignLastExpressionTo: variableNode
+ "Destructively transform the receiver so that its last expression is assigned to the argument."
+ | index |
+ index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not].
+ statements
+ at: index
+ put: (TAssignmentNode new
+ setVariable: variableNode
+ expression: (statements at: index))!
1
0
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.240.mcz
==================== Summary ====================
Name: Cog-eem.240
Author: eem
Time: 13 February 2015, 3:24:44.829 pm
UUID: bcf4a8fb-68ca-4c19-87cf-2f9903bd4b32
Ancestors: Cog-eem.239
Spur Bootstrap:
Adapt to VMMaker.oscog-eem.1048, using
runLeakCheckerForFullGC.
Nuke unused code.
Partial merge with Cog.pharo-EstebanLorenzano.242
=============== Diff against Cog-eem.239 ===============
Item was changed:
----- Method: Context>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') -----
ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments
"Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
arguments are given as arguments to this message. If successful, push result and return
resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
execution needs to be intercepted and simulated to avoid execution running away."
| value |
"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
the debugger from entering various run-away activities such as spawning a new
process, etc. Injudicious use results in the debugger not being able to debug
interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
primitiveIndex = 19 ifTrue:
[ Smalltalk tools debugger
openContext: self
label:'Code simulation error'
contents: nil].
((primitiveIndex between: 201 and: 222)
+ and: [(self objectClass: aReceiver) includesBehavior: BlockClosure]) ifTrue:
- and: [aReceiver class includesBehavior: BlockClosure]) ifTrue:
[((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
[^aReceiver simulateValueWithArguments: arguments caller: self].
primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
[^aReceiver simulateValueWithArguments: arguments first caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
[^self send: arguments first to: aReceiver with: arguments allButFirst super: false].
primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
[^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (self objectClass: aReceiver)].
primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
[^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
"Mutex>>primitiveEnterCriticalSection
Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
[| active effective |
active := Processor activeProcess.
effective := active effectiveProcess.
"active == effective"
value := primitiveIndex = 186
ifTrue: [aReceiver primitiveEnterCriticalSectionOnBehalfOf: effective]
ifFalse: [aReceiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
^(self isPrimFailToken: value)
ifTrue: [value]
ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
[^Context
sender: self
receiver: aReceiver
method: (arguments at: 2)
arguments: (arguments at: 1)].
"Closure primitives"
(primitiveIndex = 200 and: [self == aReceiver]) ifTrue:
"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
[^self push: (BlockClosure
outerContext: aReceiver
startpc: pc + 2
numArgs: arguments first
copiedValues: arguments last)].
primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
[(arguments size = 2
and: [arguments first isInteger
and: [(self objectClass: arguments last) == Array]]) ifFalse:
[^Context primitiveFailTokenFor: nil].
^self doPrimitive: arguments first method: meth receiver: aReceiver args: arguments last].
value := primitiveIndex = 120 "FFI method"
ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
ifFalse:
[primitiveIndex = 117 "named primitives"
ifTrue: [self tryNamedPrimitiveIn: meth for: aReceiver withArgs: arguments]
ifFalse: [aReceiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value)
ifTrue: [value]
ifFalse: [self push: value]!
Item was changed:
----- Method: Spur32to64BitBootstrap>>writeSnapshot:headerFlags:screenSize: (in category 'snapshot') -----
writeSnapshot: imageFileName headerFlags: headerFlags screenSize: screenSizeInteger
heap64
checkFreeSpace;
+ runLeakCheckerForFullGC.
- runLeakCheckerForFullGC: true.
interpreter64
setImageHeaderFlagsFrom: headerFlags;
setDisplayForm: nil;
imageName: imageFileName;
writeImageFileIO.
Transcript cr; show: 'Done!!'!
Item was changed:
----- Method: SpurBootstrap>>launch:simulatorClass:headerFlags: (in category 'testing') -----
launch: heap simulatorClass: simulatorClass headerFlags: headerFlags
| sim methodCacheSize |
sim := simulatorClass onObjectMemory: heap.
heap coInterpreter: sim.
(sim class allInstVarNames includes: 'cogCodeSize')
ifTrue:
[sim initializeInterpreter: 0.
methodCacheSize := sim methodCache size * heap wordSize.
sim instVarNamed: 'heapBase' put: heap startOfMemory;
instVarNamed: 'numStackPages' put: 8;
instVarNamed: 'cogCodeSize' put: 1024*1024;
moveMethodCacheToMemoryAt: sim cogCodeSize + sim computeStackZoneSize;
movePrimTraceLogToMemoryAt: sim cogCodeSize + sim computeStackZoneSize + methodCacheSize;
"sendTrace: 1+ 2 + 8 + 16;"
initializeCodeGenerator]
ifFalse:
[sim initializeInterpreter: 0].
heap
initializeNewSpaceVariables;
bootstrapping: false;
assimilateNewSegment: (heap segmentManager segments at: 0).
sim
setImageHeaderFlagsFrom: headerFlags;
imageName: ImageName;
flushExternalPrimitives;
openAsMorph;
transcript: Transcript. "deep copy copies this"
"sim
instVarNamed: 'printSends' put: true;
instVarNamed: 'printReturns' put: true;
instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal." "for now"
heap
setCheckForLeaks: 0;
+ runLeakCheckerForFullGC.
- runLeakCheckerForFullGC: true.
sim halt; run!
Item was changed:
----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
rehashImage
"Rehash all collections in newHeap.
Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
| n sim rehashFlags dotDate rehashSym sizeSym |
rehashSym := map at: (self findSymbol: #rehash).
sizeSym := map at: (self findSymbol: #size).
+ sim := StackInterpreterSimulator
+ onObjectMemory: newHeap
+ options: #(ObjectMemory #Spur32BitMemoryManager).
- sim := StackInterpreterSimulator onObjectMemory: newHeap.
sim
setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags;
imageName: 'spur image';
assertValidExecutionPointersAtEachStep: false..
newHeap coInterpreter: sim.
sim bootstrapping: true.
sim initializeInterpreter: 0.
sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
+
+ sim redirectTranscriptToHost.
newHeap
setHashBitsOf: newHeap nilObject to: 1;
setHashBitsOf: newHeap falseObject to: 2;
setHashBitsOf: newHeap trueObject to: 3.
rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize.
n := 0.
newHeap classTableObjectsDo:
[:class| | classIndex |
sim messageSelector: rehashSym.
"Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
((sim lookupMethodNoMNUEtcInClass: class) = 0
and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
[n := n + 1.
classIndex := newHeap rawHashBitsOf: class.
rehashFlags
at: classIndex >> 3 + 1
put: ((rehashFlags at: classIndex >> 3 + 1)
bitOr: (1 << (classIndex bitAnd: 7)))]].
Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
dotDate := Time now asSeconds.
n := 0.
self withExecutableInterpreter: sim
do: [sim setBreakSelector: 'error:'.
"don't rehash twice (actually without limit), so don't rehash any new objects created."
newHeap allExistingOldSpaceObjectsDo:
[:o| | classIndex |
classIndex := newHeap classIndexOf: o.
((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
[Time now asSeconds > dotDate ifTrue:
[Transcript nextPut: $.; flush.
dotDate := Time now asSeconds].
"2845 = n ifTrue: [self halt]."
"Rehash an object if its size is > 0.
Symbol implements rehash, but let's not waste time rehashing it; in Squeak
up to 2013 symbols are kept in a set which will get reashed anyway..
Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
((sim addressCouldBeClassObj: o)
or: [(self interpreter: sim
object: o
perform: sizeSym
withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse:
[self interpreter: sim
object: o
perform: rehashSym
withArguments: #()]]]]!
Item was changed:
----- Method: SpurBootstrap>>validate (in category 'bootstrap image') -----
validate
| p n duplicates maxClassIndex savedEndOfMemory |
self assert: (reverseMap at: newHeap specialObjectsOop) = oldHeap specialObjectsOop.
self assert: (map at: oldHeap specialObjectsOop) = newHeap specialObjectsOop.
self assert: (reverseMap at: newHeap classTableRootObj ifAbsent: []) isNil.
duplicates := { 3. newHeap arrayClassIndexPun. newHeap weakArrayClassIndexPun }.
maxClassIndex := classToIndex inject: 0 into: [:a :b| a max: b].
self assert: ((newHeap arrayClassIndexPun to: maxClassIndex) select:
[:idx| | classObj |
(classObj := newHeap classOrNilAtIndex: idx) ~= newHeap nilObject
and: [(newHeap classIndexOf: classObj) = (newHeap rawHashBitsOf: classObj)]]) isEmpty.
0 to: maxClassIndex do:
[:index| | classObj |
(index <= newHeap tagMask
and: [index > newHeap isForwardedObjectClassIndexPun]) ifTrue:
[(classObj := newHeap classOrNilAtIndex: index) = newHeap nilObject
ifTrue:
[self assert: (classToIndex keyAtValue: index ifAbsent: []) isNil]
ifFalse:
[self assert: (newHeap classIndexOf: classObj) ~= (newHeap rawHashBitsOf: classObj).
(duplicates includes: index) ifFalse:
[self assert: (newHeap rawHashBitsOf: classObj) = index]]]].
classToIndex keysAndValuesDo:
[:oldClass :idx|
self assert: (newHeap rawHashBitsOf: (map at: oldClass)) = idx.
self assert: oldClass = (reverseMap at: (newHeap classAtIndex: idx))].
n := 0.
savedEndOfMemory := newHeap endOfMemory.
newHeap setEndOfMemory: newHeap freeOldSpaceStart.
newHeap allObjectsDo:
[:o|
(o <= newHeap trueObject
or: [o > lastClassTablePage]) ifTrue:
[self assert: (reverseMap includesKey: o).
self assert: (newHeap fetchClassOfNonImm: o) = (map at: (oldHeap fetchClassOfNonImm: (reverseMap at: o)))].
n := n + 1.
p := o].
newHeap setEndOfMemory: savedEndOfMemory.
self touch: p.
self assert: (n between: map size and: map size + ((imageTypes includes: 'squeak')
ifTrue: [6]
+ ifFalse: [10])). "+ 6 or 10 is room for freelists & classTable"
- ifFalse: [8])). "+ 6 or 8 is room for freelists & classTable"
"check some class properties to ensure the format changes are correct"
self assert: (newHeap fixedFieldsOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = 0.
self assert: (newHeap instSpecOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = newHeap arrayFormat!
Item was changed:
----- Method: SpurBootstrap>>writeSnapshot:ofTransformedImage:headerFlags:screenSize: (in category 'testing') -----
writeSnapshot: imageFileName ofTransformedImage: spurHeap headerFlags: headerFlags screenSize: screenSizeInteger
"The bootstrapped image typically contains a few big free chunks and one huge free chunk.
Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges
and saving."
| penultimate ultimate sizes counts barriers sim |
sim := StackInterpreterSimulator onObjectMemory: spurHeap.
sim bootstrapping: true.
spurHeap
coInterpreter: sim;
setEndOfMemory: spurHeap endOfMemory + spurHeap bridgeSize. "hack; initializeInterpreter: cuts it back by bridgeSize"
sim initializeInterpreter: 0;
setImageHeaderFlagsFrom: headerFlags;
setDisplayForm: nil.
spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
(spurHeap isFreeObject: penultimate) ifTrue: "old, pre-pigCompact segmented save"
[self assert: (spurHeap isSegmentBridge: ultimate).
sizes := Bag new.
spurHeap allObjectsInFreeTree: (spurHeap freeLists at: 0) do:
[:f|
sizes add: (spurHeap bytesInObject: f)].
counts := sizes sortedCounts.
self assert: counts last key = 1. "1 huge chunk"
counts size > 1
ifTrue:
[self assert: ((counts at: counts size - 1) key > 2
and: [(counts at: counts size - 1) value > 1024]).
barriers := (1 to: (counts at: counts size - 1) key) collect:
[:ign| spurHeap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value].
barriers := barriers, {spurHeap allocateOldSpaceChunkOfExactlyBytes: (spurHeap bytesInObject: penultimate)}]
ifFalse:
[barriers := {spurHeap allocateOldSpaceChunkOfExactlyBytes: (spurHeap bytesInObject: penultimate)}].
barriers last ifNotNil:
[:end|
spurHeap setEndOfMemory: end.
spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
self assert: (spurHeap addressAfter: ultimate) = end]].
spurHeap checkFreeSpace.
+ spurHeap runLeakCheckerForFullGC.
- spurHeap runLeakCheckerForFullGC: true.
barriers ifNotNil: "old, pre-pigCompact segmented save"
[spurHeap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| spurHeap objectStartingAt: b])].
spurHeap checkFreeSpace.
+ spurHeap runLeakCheckerForFullGC.
- spurHeap runLeakCheckerForFullGC: true.
sim bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: true.
sim imageName: imageFileName.
sim writeImageFileIO.
Transcript cr; show: 'Done!!'!
Item was removed:
- ----- Method: SpurBootstrap>>writeSnapshotOfTransformedImage (in category 'testing') -----
- writeSnapshotOfTransformedImage
- self writeSnapshotOfTransformedImageAs: 'spur.image'!
Item was removed:
- ----- Method: SpurBootstrap>>writeSnapshotOfTransformedImageAs: (in category 'testing') -----
- writeSnapshotOfTransformedImageAs: imageFileName
- "The bootstrapped image typically contains a few big free chunks and one huge free chunk.
- Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges
- and saving."
- | penultimate ultimate heap sizes counts barriers sim |
- heap := TransformedImage veryDeepCopy.
- sim := StackInterpreterSimulator onObjectMemory: heap.
- sim bootstrapping: true.
- heap coInterpreter: sim.
- sim initializeInterpreter: 0;
- setImageHeaderFlagsFrom: ImageHeaderFlags;
- setDisplayForm: nil;
- setSavedWindowSize: ImageScreenSize >> 16 @ (ImageScreenSize bitAnd: 16rFFFF).
- heap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
- self assert: (heap isFreeObject: penultimate).
- self assert: (heap isSegmentBridge: ultimate).
- sizes := Bag new.
- heap allObjectsInFreeTree: (heap freeLists at: 0) do:
- [:f|
- sizes add: (heap bytesInObject: f)].
- counts := sizes sortedCounts.
- self assert: counts last key = 1. "1 huge chunk"
- counts size > 1
- ifTrue:
- [self assert: ((counts at: counts size - 1) key > 2
- and: [(counts at: counts size - 1) value > 1024]).
- barriers := (1 to: (counts at: counts size - 1) key) collect:
- [:ign| heap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value].
- barriers := barriers, {heap allocateOldSpaceChunkOfExactlyBytes: (heap bytesInObject: penultimate)}]
- ifFalse:
- [barriers := {heap allocateOldSpaceChunkOfExactlyBytes: (heap bytesInObject: penultimate)}].
- heap setEndOfMemory: barriers last.
- heap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
- self assert: (heap addressAfter: ultimate) = barriers last.
- heap checkFreeSpace.
- heap runLeakCheckerForFullGC: true.
- heap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| heap objectStartingAt: b]).
- heap checkFreeSpace.
- heap runLeakCheckerForFullGC: true.
- sim bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: true.
- sim imageName: imageFileName.
- sim writeImageFileIO!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEisSpur (in category 'method prototypes') -----
+ VirtualMachinePROTOTYPEisSpur
+ "this value is always true but is here for backward compatibility (non Spur images should return false)"
+ ^ true!
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1062.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1062
Author: eem
Time: 13 February 2015, 11:37:27.254 am
UUID: 5016dc92-e170-43ca-bef4-9f8fb53a75f9
Ancestors: VMMaker.oscog-eem.1061
Simplify primitiveDisplayString given isArray:.
=============== Diff against VMMaker.oscog-eem.1061 ===============
Item was changed:
----- Method: BitBltSimulation>>primitiveDisplayString (in category 'primitives') -----
primitiveDisplayString
| kernDelta xTable glyphMap stopIndex startIndex sourceString bbObj maxGlyph ascii glyphIndex sourcePtr left quickBlt |
<export: true>
<var: #sourcePtr type: 'char *'>
+ interpreterProxy methodArgumentCount = 6 ifFalse:
+ [^interpreterProxy primitiveFail].
- interpreterProxy methodArgumentCount = 6
- ifFalse:[^interpreterProxy primitiveFail].
kernDelta := interpreterProxy stackIntegerValue: 0.
xTable := interpreterProxy stackObjectValue: 1.
glyphMap := interpreterProxy stackObjectValue: 2.
- ((interpreterProxy fetchClassOf: xTable) = interpreterProxy classArray and:[
- (interpreterProxy fetchClassOf: glyphMap) = interpreterProxy classArray])
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: glyphMap) = 256 ifFalse:[^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^nil].
- maxGlyph := (interpreterProxy slotSizeOf: xTable) - 2.
-
stopIndex := interpreterProxy stackIntegerValue: 3.
startIndex := interpreterProxy stackIntegerValue: 4.
sourceString := interpreterProxy stackObjectValue: 5.
- (interpreterProxy isBytes: sourceString) ifFalse:[^interpreterProxy primitiveFail].
- (startIndex > 0 and:[stopIndex > 0 and:[
- stopIndex <= (interpreterProxy byteSizeOf: sourceString)]])
- ifFalse:[^interpreterProxy primitiveFail].
-
bbObj := interpreterProxy stackObjectValue: 6.
+ interpreterProxy failed ifTrue:
+ [^nil].
+
+ ((interpreterProxy isArray: xTable)
+ and: [(interpreterProxy isArray: glyphMap)
+ and: [(interpreterProxy slotSizeOf: glyphMap) = 256
+ and: [(interpreterProxy isBytes: sourceString)
+ and: [startIndex > 0
+ and: [stopIndex > 0
+ and: [stopIndex <= (interpreterProxy byteSizeOf: sourceString)
+ and: [(self loadBitBltFrom: bbObj)
+ and: [combinationRule ~= 30 "these two need extra source alpha"
+ and: [combinationRule ~= 31]]]]]]]]]) ifFalse:
+ [^interpreterProxy primitiveFail].
+ maxGlyph := (interpreterProxy slotSizeOf: xTable) - 2.
- (self loadBitBltFrom: bbObj) ifFalse:[^interpreterProxy primitiveFail].
- (combinationRule = 30 or:[combinationRule = 31]) "needs extra source alpha"
- ifTrue:[^interpreterProxy primitiveFail].
"See if we can go directly into copyLoopPixMap (usually we can)"
quickBlt := destBits ~= 0 "no OS surfaces please"
and:[sourceBits ~= 0 "and again"
and:[noSource = false "needs a source"
and:[sourceForm ~= destForm "no blits onto self"
+ and:[cmFlags ~= 0
+ or:[sourceMSB ~= destMSB
+ or:[sourceDepth ~= destDepth]]]]]]. "no point using slower version"
- and:[(cmFlags ~= 0
- or:[sourceMSB ~= destMSB
- or:[sourceDepth ~= destDepth]]) "no point using slower version"
- ]]]].
left := destX.
sourcePtr := interpreterProxy firstIndexableField: sourceString.
startIndex to: stopIndex do:[:charIndex|
ascii := interpreterProxy byteAtPointer: sourcePtr + charIndex - 1.
glyphIndex := interpreterProxy fetchInteger: ascii ofObject: glyphMap.
(glyphIndex < 0 or:[glyphIndex > maxGlyph])
ifTrue:[^interpreterProxy primitiveFail].
sourceX := interpreterProxy fetchInteger: glyphIndex ofObject: xTable.
width := (interpreterProxy fetchInteger: glyphIndex+1 ofObject: xTable) - sourceX.
interpreterProxy failed ifTrue:[^nil].
self clipRange. "Must clip here"
(bbW > 0 and:[bbH > 0]) ifTrue: [
quickBlt ifTrue:[
self destMaskAndPointerInit.
self copyLoopPixMap.
"both, hDir and vDir are known to be > 0"
affectedL := dx.
affectedR := dx + bbW.
affectedT := dy.
affectedB := dy + bbH.
] ifFalse:[self copyBits]].
interpreterProxy failed ifTrue:[^nil].
destX := destX + width + kernDelta.
].
affectedL := left.
self showDisplayBits.
"store destX back"
interpreterProxy storeInteger: BBDestXIndex ofObject: bbObj withValue: destX.
interpreterProxy pop: 6. "pop args, return rcvr"!
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1061.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1061
Author: eem
Time: 13 February 2015, 11:21:50.348 am
UUID: bbb9d477-8fc5-4f93-a996-48a20fafeeff
Ancestors: VMMaker.oscog-eem.1060
Refactor positive32BitIntegerFor: and signed32BitIntegerFor:
in the realization that these reduce to essentially
integerObjectOf: in64-bit Spur. The idea is to inline if in
64-bit Spur but not if in the 32-bit VMs. Add notOption:
processing to allow excluding noInlineSigned32BitIntegerFor:
et al. Add hasSixtyFourBitImmediates to no longer assume
that wordSize = 8 implies 64-bit immediates.
Use positiveMachineIntegerFor: in place of
positive32BitIntegerFor: in some plgins.
Simplify two B3DAcceleratorPlugin prims given
topRemappableOop and isArray:
Fix a simulation bug in shortAt:put:.
With these changes 64-bit Spur Stack Linux manages
3548 run, 3495 passes, 0 expected failures, 47 failures, 6 errors, 0 unexpected passes
=============== Diff against VMMaker.oscog-eem.1060 ===============
Item was changed:
----- Method: B3DAcceleratorPlugin>>primitiveGetRendererColorMasks (in category 'primitives-renderer') -----
primitiveGetRendererColorMasks
+ | handle masks array |
- | handle result masks array arrayOop |
<export: true>
+ <var: #masks declareC:'unsigned int masks[4]'>
- <var: #masks declareC:'int masks[4]'>
interpreterProxy methodArgumentCount = 2
ifFalse:[^interpreterProxy primitiveFail].
array := interpreterProxy stackObjectValue: 0.
handle := interpreterProxy stackIntegerValue: 1.
interpreterProxy failed ifTrue:[^nil].
+ ((interpreterProxy isArray: array)
+ and: [(interpreterProxy slotSizeOf: array) = 4
+ and: [self cCode:'b3dxGetRendererColorMasks(handle, masks)' inSmalltalk:[false]]])
- (interpreterProxy fetchClassOf: array) = interpreterProxy classArray
ifFalse:[^interpreterProxy primitiveFail].
+ interpreterProxy pushRemappableOop: array.
+ 0 to: 3 do: [:i|
+ interpreterProxy
+ storePointer: i
+ ofObject: interpreterProxy topRemappableOop
+ withValue: (interpreterProxy positive32BitIntegerFor: (masks at: i))].
+ interpreterProxy popRemappableOop.
+ ^interpreterProxy pop: 2 "pop args return receiver"!
- (interpreterProxy slotSizeOf: array) = 4
- ifFalse:[^interpreterProxy primitiveFail].
- result := self cCode:'b3dxGetRendererColorMasks(handle, masks)' inSmalltalk:[false].
- result ifFalse:[^interpreterProxy primitiveFail].
- arrayOop := array.
- 0 to: 3 do:[:i|
- interpreterProxy pushRemappableOop: arrayOop.
- result := interpreterProxy positive32BitIntegerFor: (masks at: i).
- arrayOop := interpreterProxy popRemappableOop.
- interpreterProxy storePointer: i ofObject: arrayOop withValue: result].
- ^interpreterProxy pop: 2. "pop args return receiver"!
Item was changed:
----- Method: B3DAcceleratorPlugin>>primitiveTextureGetColorMasks (in category 'primitives-textures') -----
primitiveTextureGetColorMasks
+ | handle masks array renderer |
- | handle result masks array renderer arrayOop |
<export: true>
+ <var: #masks declareC:'unsigned int masks[4]'>
- <var: #masks declareC:'int masks[4]'>
interpreterProxy methodArgumentCount = 3
ifFalse:[^interpreterProxy primitiveFail].
array := interpreterProxy stackObjectValue: 0.
handle := interpreterProxy stackIntegerValue: 1.
renderer := interpreterProxy stackIntegerValue: 2.
interpreterProxy failed ifTrue:[^nil].
+ ((interpreterProxy isArray: array)
+ and: [(interpreterProxy slotSizeOf: array) = 4
+ and: [self cCode:'b3dxTextureColorMasks(renderer, handle, masks)' inSmalltalk:[false]]])
- (interpreterProxy fetchClassOf: array) = interpreterProxy classArray
ifFalse:[^interpreterProxy primitiveFail].
+ interpreterProxy pushRemappableOop: array.
+ 0 to: 3 do: [:i|
+ interpreterProxy
+ storePointer: i
+ ofObject: interpreterProxy topRemappableOop
+ withValue: (interpreterProxy positive32BitIntegerFor: (masks at: i))].
+ interpreterProxy popRemappableOop.
+ ^interpreterProxy pop: 3 "pop args return receiver"!
- (interpreterProxy slotSizeOf: array) = 4
- ifFalse:[^interpreterProxy primitiveFail].
- result := self cCode:'b3dxTextureColorMasks(renderer, handle, masks)' inSmalltalk:[false].
- result ifFalse:[^interpreterProxy primitiveFail].
- arrayOop := array.
- 0 to: 3 do:[:i|
- interpreterProxy pushRemappableOop: arrayOop.
- result := interpreterProxy positive32BitIntegerFor: (masks at: i).
- arrayOop := interpreterProxy popRemappableOop.
- interpreterProxy storePointer: i ofObject: arrayOop withValue: result].
- ^interpreterProxy pop: 3. "pop args return receiver"!
Item was added:
+ ----- Method: CCodeGenerator>>optionIsTrue:in: (in category 'utilities') -----
+ optionIsTrue: pragma in: aClass
+ "Answer whether an option: or notOption: pragma is true in the context of aClass.
+ The argument to the option: pragma is interpreted as either a Cogit class name
+ or a class variable name or a variable name in VMBasicConstants."
+ | key |
+ key := pragma argumentAt: 1.
+ "If the option is the name of a subclass of Cogit, include it if it inherits from the Cogit class."
+ (Smalltalk classNamed: key) ifNotNil:
+ [:optionClass|
+ aClass cogitClass ifNotNil:
+ [:cogitClass|
+ (optionClass includesBehavior: Cogit) ifTrue:
+ [^cogitClass includesBehavior: optionClass]].
+ aClass objectMemoryClass ifNotNil:
+ [:objectMemoryClass|
+ ((optionClass includesBehavior: ObjectMemory)
+ or: [optionClass includesBehavior: SpurMemoryManager]) ifTrue:
+ [^objectMemoryClass includesBehavior: optionClass]]].
+ "Lookup options in options, class variables of the defining class, VMBasicConstants, the interpreterClass and the objectMemoryClass"
+ {aClass initializationOptions.
+ aClass.
+ VMBasicConstants.
+ aClass interpreterClass.
+ aClass objectMemoryClass} do:
+ [:scopeOrNil|
+ scopeOrNil ifNotNil:
+ [:scope|
+ (scope bindingOf: key) ifNotNil:
+ [:binding|
+ binding value ~~ false ifTrue: [^true]]]].
+ ^false!
Item was changed:
----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
shouldIncludeMethodFor: aClass selector: selector
"Answer whether a method shoud be translated. Process optional methods by
interpreting the argument to the option: pragma as either a Cogit class name
or a class variable name or a variable name in VMBasicConstants. Exclude
methods with the doNotGenerate pragma."
+ | optionPragmas notOptionPragmas |
+ (aClass >> selector pragmaAt: #doNotGenerate) ifNotNil:
+ [^false].
+
- | pragmas |
"where is pragmasAt: ??"
+ optionPragmas := (aClass >> selector) pragmas select: [:p| p keyword == #option:].
+ notOptionPragmas := (aClass >> selector) pragmas select: [:p| p keyword == #notOption:].
+ (optionPragmas notEmpty or: [notOptionPragmas notEmpty]) ifTrue:
+ [^(optionPragmas allSatisfy: [:pragma| self optionIsTrue: pragma in: aClass])
+ and: [notOptionPragmas noneSatisfy: [:pragma| self optionIsTrue: pragma in: aClass]]].
+
+ ^true!
- (pragmas := (aClass >> selector) pragmas select: [:p| p keyword == #option:]) notEmpty ifTrue:
- [pragmas do:
- [:pragma| | key |
- key := pragma argumentAt: 1.
- "If the option is the name of a subclass of Cogit, include it if it inherits from the Cogit class."
- (Smalltalk classNamed: key) ifNotNil:
- [:optionClass|
- aClass cogitClass ifNotNil:
- [:cogitClass|
- (optionClass includesBehavior: Cogit) ifTrue:
- [^cogitClass includesBehavior: optionClass]].
- aClass objectMemoryClass ifNotNil:
- [:objectMemoryClass|
- ((optionClass includesBehavior: ObjectMemory)
- or: [optionClass includesBehavior: SpurMemoryManager]) ifTrue:
- [^objectMemoryClass includesBehavior: optionClass]]].
- "Lookup options in options, class variables of the defining class, VMBasicConstants, the interpreterClass and the objectMemoryClass"
- {aClass initializationOptions.
- aClass.
- VMBasicConstants.
- aClass interpreterClass.
- aClass objectMemoryClass} do:
- [:scopeOrNil|
- scopeOrNil ifNotNil:
- [:scope|
- (scope bindingOf: key) ifNotNil:
- [:binding|
- binding value ~~ false ifTrue: [^true]]]]].
- ^false].
- ^(aClass >> selector pragmaAt: #doNotGenerate) isNil!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatDivide (in category 'arithmetic float primitives') -----
primitiveSmallFloatDivide
<option: #Spur64BitMemoryManager>
| rcvr arg |
<var: #rcvr type: #double>
<var: #arg type: #double>
rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).
arg := objectMemory loadFloatOrIntFrom: self stackTop.
+ arg = 0.0 ifTrue:
+ [self primitiveFail].
self successful ifTrue:
[self pop: 2 thenPushFloat: rcvr / arg]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveTimesTwoPower (in category 'arithmetic float primitives') -----
primitiveTimesTwoPower
"Multiply the receiver by the power of the argument."
- <option: #Spur64BitMemoryManager>
| rcvr result arg |
<var: #rcvr type: #double>
<var: #result type: #double>
arg := self stackTop.
(objectMemory isIntegerObject: arg) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
arg := objectMemory integerValueOf: arg.
objectMemory bytesPerOop > 4 ifTrue:
[| twiceMaxExponent | "clip arg to at most int range; ldexp's last arg is of type int"
twiceMaxExponent := 2 * (1 << self floatExponentBits).
arg < twiceMaxExponent negated
ifTrue: [arg := twiceMaxExponent negated]
ifFalse: [arg > twiceMaxExponent ifTrue:
[arg := twiceMaxExponent]]].
rcvr := objectMemory floatValueOf: (self stackValue: 1).
result := self cCode: [self ld: rcvr exp: (self cCoerceSimple: arg to: #int)]
inSmalltalk: [rcvr timesTwoPower: arg].
self pop: 2 thenPushFloat: result!
Item was added:
+ ----- Method: ObjectMemory>>hasSixtyFourBitImmediates (in category 'object format') -----
+ hasSixtyFourBitImmediates
+ "The V3 64-bit memory manager has 64-bit oops, but its SmallIntegers only have
+ 31 bits of precision. The Spur 64-bit memory manager has 61-bit immediates."
+ ^false!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>hasSixtyFourBitImmediates (in category 'interpreter access') -----
+ hasSixtyFourBitImmediates
+ "The V3 64-bit memory manager has 64-bit oops, but its SmallIntegers only have
+ 31 bits of precision. The Spur 64-bit memory manager has 61-bit immediates."
+ ^false!
Item was changed:
----- Method: Spur64BitMMLESimulator>>shortAt:put: (in category 'memory access') -----
shortAt: byteAddress put: a16BitValue
"Return the half-word at byteAddress which must be even."
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 2.
lowBits = 0
ifTrue: "storing into LS word"
[long := self long32At: byteAddress.
+ self long32At: byteAddress
- self longAt: byteAddress
put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)]
ifFalse: "storing into MS word"
[longAddress := byteAddress - 2.
long := self long32At: longAddress.
self long32At: longAddress
put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))].
^a16BitValue!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>hasSixtyFourBitImmediates (in category 'interpreter access') -----
+ hasSixtyFourBitImmediates
+ "The V3 64-bit memory manager has 64-bit oops, but its SmallIntegers only have
+ 31 bits of precision. The Spur 64-bit memory manager has 61-bit immediates."
+ ^true!
Item was added:
+ ----- Method: SpurMemoryManager>>hasSixtyFourBitImmediates (in category 'interpreter access') -----
+ hasSixtyFourBitImmediates
+ "The V3 64-bit memory manager has 64-bit oops, but its SmallIntegers only have
+ 31 bits of precision. The Spur 64-bit memory manager has 61-bit immediates."
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in category 'primitive support') -----
+ maybeInlinePositive32BitIntegerFor: integerValue
+ "N.B. will *not* cause a GC.
+ integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:."
+ <notOption: #Spur64BitMemoryManager>
+ | newLargeInteger |
+ self deny: objectMemory hasSixtyFourBitImmediates.
+ (integerValue >= 0
+ and: [objectMemory isIntegerValue: integerValue]) ifTrue:
+ [^objectMemory integerObjectOf: integerValue].
+ newLargeInteger := objectMemory
+ eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
+ format: (objectMemory byteFormatForNumBytes: 4)
+ numSlots: 1.
+ objectMemory
+ storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
+ storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
+ storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF);
+ storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF).
+ ^newLargeInteger!
Item was added:
+ ----- Method: StackInterpreter>>noInlineSigned32BitIntegerFor: (in category 'primitive support') -----
+ noInlineSigned32BitIntegerFor: integerValue
+ "Answer a full 32 bit integer object for the given integer value."
+ <notOption: #Spur64BitMemoryManager>
+ | newLargeInteger value largeClass |
+ <inline: false>
+ (objectMemory isIntegerValue: integerValue) ifTrue:
+ [^objectMemory integerObjectOf: integerValue].
+ self deny: objectMemory hasSixtyFourBitImmediates.
+ integerValue < 0
+ ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
+ value := 0 - integerValue]
+ ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
+ value := integerValue].
+ newLargeInteger := objectMemory
+ eeInstantiateSmallClassIndex: largeClass
+ format: (objectMemory byteFormatForNumBytes: 4)
+ numSlots: 1.
+ objectMemory storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
+ objectMemory storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
+ objectMemory storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
+ objectMemory storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
+ ^newLargeInteger!
Item was changed:
----- Method: StackInterpreter>>positive32BitIntegerFor: (in category 'primitive support') -----
positive32BitIntegerFor: integerValue
+ "integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:.
+ N.B. Returning in each arm separately enables Slang inlining.
+ /Don't/ return the ifTrue:ifFalse: unless Slang inlining of conditionals is fixed."
+ <inline: true>
+ objectMemory hasSixtyFourBitImmediates
+ ifTrue:
+ [^objectMemory integerObjectOf: (integerValue bitAnd: 16rFFFFFFFF)]
+ ifFalse:
+ [^self maybeInlinePositive32BitIntegerFor: integerValue]!
- | newLargeInteger |
- "N.B. will *not* cause a GC.
- integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:."
- (integerValue >= 0
- and: [objectMemory isIntegerValue: integerValue]) ifTrue:
- [^objectMemory integerObjectOf: integerValue].
-
- newLargeInteger := objectMemory
- eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
- format: (objectMemory byteFormatForNumBytes: 4)
- numSlots: 1.
- objectMemory
- storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
- storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
- storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF);
- storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF).
- ^newLargeInteger!
Item was changed:
----- Method: StackInterpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
positive64BitIntegerFor: integerValue
<var: 'integerValue' type: #sqLong>
"Answer a Large Positive Integer object for the given integer value. N.B. will *not* cause a GC."
| newLargeInteger highWord sz |
+ objectMemory hasSixtyFourBitImmediates
- objectMemory wordSize = 8
ifTrue:
[(integerValue >= 0 and: [objectMemory isIntegerValue: integerValue]) ifTrue:
[^objectMemory integerObjectOf: integerValue].
sz := 8]
ifFalse:
[(highWord := integerValue >>> 32) = 0 ifTrue:
[^self positive32BitIntegerFor: integerValue].
sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:
[sz := sz + 1.
(highWord := highWord >> 8) = 0 ifFalse:
[sz := sz + 1.
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1]]]].
newLargeInteger := objectMemory
eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
format: (objectMemory byteFormatForNumBytes: sz)
numSlots: 8 / objectMemory bytesPerOop.
objectMemory
storeByte: 7 ofObject: newLargeInteger withValue: (integerValue >> 56 bitAnd: 16rFF);
storeByte: 6 ofObject: newLargeInteger withValue: (integerValue >> 48 bitAnd: 16rFF);
storeByte: 5 ofObject: newLargeInteger withValue: (integerValue >> 40 bitAnd: 16rFF);
storeByte: 4 ofObject: newLargeInteger withValue: (integerValue >> 32 bitAnd: 16rFF);
storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF);
storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF).
^newLargeInteger
!
Item was added:
+ ----- Method: StackInterpreter>>positiveMachineIntegerFor: (in category 'callback support') -----
+ positiveMachineIntegerFor: value
+ <var: #value type: #'unsigned long'>
+ <inline: true>
+ ^objectMemory wordSize = 8
+ ifTrue: [self positive64BitIntegerFor: value]
+ ifFalse: [self positive32BitIntegerFor: value]!
Item was changed:
----- Method: StackInterpreter>>sendInvokeCallback:Stack:Registers:Jmpbuf: (in category 'callback support') -----
sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr
"Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf:
to Alien class with the supplied args. The arguments are raw C addresses
and are converted to integer objects on the way."
<export: true>
| classTag |
classTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
messageSelector := self splObj: SelectorInvokeCallback.
argumentCount := 4.
(self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse:
[(self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
[^false]].
((self argumentCountOf: newMethod) = 4
and: [primitiveFunctionPointer = 0]) ifFalse:
[^false].
self push: (self splObj: ClassAlien). "receiver"
+ self push: (self positiveMachineIntegerFor: thunkPtr).
+ self push: (self positiveMachineIntegerFor: stackPtr).
+ self push: (self positiveMachineIntegerFor: regsPtr).
+ self push: (self positiveMachineIntegerFor: jmpBufPtr).
- self push: (self positive32BitIntegerFor: thunkPtr).
- self push: (self positive32BitIntegerFor: stackPtr).
- self push: (self positive32BitIntegerFor: regsPtr).
- self push: (self positive32BitIntegerFor: jmpBufPtr).
self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
self justActivateNewMethod.
(self isMachineCodeFrame: framePointer) ifFalse:
[self maybeFlagMethodAsInterpreted: newMethod].
self externalWriteBackHeadFramePointers.
self handleStackOverflow.
self enterSmalltalkExecutiveFromCallback.
"not reached"
^true!
Item was changed:
----- Method: StackInterpreter>>sendInvokeCallbackContext: (in category 'callback support') -----
sendInvokeCallbackContext: vmCallbackContext
"Send the calllback message to Alien class with the supplied arg(s). Use either the
1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf:
message, depending on what selector is installed in the specialObjectsArray.
Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the
vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:).
The arguments are raw C addresses and are converted to integer objects on the way."
<export: true>
<var: #vmCallbackContext type: #'VMCallbackContext *'>
| classTag |
classTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
messageSelector := self splObj: SelectorInvokeCallback.
(self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse:
[(self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
[^false]].
primitiveFunctionPointer ~= 0 ifTrue:
[^false].
self saveCStackStateForCallbackContext: vmCallbackContext.
self push: (self splObj: ClassAlien). "receiver"
+ (self argumentCountOf: newMethod) = 4 ifTrue:
+ [self push: (self positiveMachineIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
+ self push: (self positiveMachineIntegerFor: vmCallbackContext stackp asUnsignedInteger).
+ self push: (self positiveMachineIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
+ self push: (self positiveMachineIntegerFor: vmCallbackContext asUnsignedInteger).
- self cppIf: objectMemory wordSize = 8
- ifTrue:
- [(self argumentCountOf: newMethod) = 4 ifTrue:
- [self push: (self positive64BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
- self push: (self positive64BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
- self push: (self positive64BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
- self push: (self positive64BitIntegerFor: vmCallbackContext asUnsignedInteger)]
- ifFalse:
- [(self argumentCountOf: newMethod) = 4 ifTrue:
- [self push: (self positive32BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
- self push: (self positive32BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
- self push: (self positive32BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
- self push: (self positive32BitIntegerFor: vmCallbackContext asUnsignedInteger)].
self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
self justActivateNewMethod.
(self isMachineCodeFrame: framePointer) ifFalse:
[self maybeFlagMethodAsInterpreted: newMethod].
self externalWriteBackHeadFramePointers.
self handleStackOverflow.
self enterSmalltalkExecutiveFromCallback.
"not reached"
^true!
Item was changed:
----- Method: StackInterpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
signed32BitIntegerFor: integerValue
+ "Answer a full 32 bit integer object for the given integer value.
+ N.B. Returning in each arm separately enables Slang inlining.
+ /Don't/ return the ifTrue:ifFalse: unless Slang inlining of conditionals is fixed."
+ <inline: true>
+ objectMemory hasSixtyFourBitImmediates
+ ifTrue:
+ [^objectMemory integerObjectOf:
+ (self cCode: [self cCoerceSimple: integerValue to: #int]
+ inSmalltalk: [(integerValue bitAnd: 16r7FFFFFFF)
+ - ((integerValue >> 31 anyMask: 1)
+ ifTrue: [-16r100000000]
+ ifFalse: [0])])]
+ ifFalse:
+ [^self noInlineSigned32BitIntegerFor: integerValue]!
- "Answer a full 32 bit integer object for the given integer value."
- | newLargeInteger value largeClass |
- <inline: false>
- (objectMemory isIntegerValue: integerValue) ifTrue:
- [^objectMemory integerObjectOf: integerValue].
- integerValue < 0
- ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
- value := 0 - integerValue]
- ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
- value := integerValue].
- newLargeInteger := objectMemory
- eeInstantiateSmallClassIndex: largeClass
- format: (objectMemory byteFormatForNumBytes: 4)
- numSlots: 1.
- objectMemory storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
- objectMemory storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
- objectMemory storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
- objectMemory storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
- ^newLargeInteger!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
primitiveSlotAt
"Answer a slot in an object. This numbers all slots from 1, ignoring the distinction between
named and indexed inst vars. In objects with both named and indexed inst vars, the named
inst vars preceed the indexed ones. In non-object indexed objects (objects that contain
bits, not object references) this primitive answers the raw integral value at each slot.
e.g. for Strings it answers the character code, not the Character object at each slot."
| index rcvr fmt numSlots |
index := self stackTop.
rcvr := self stackValue: 1.
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
(objectMemory isImmediate: rcvr) ifTrue:
[^self primitiveFailFor: PrimErrBadReceiver].
fmt := objectMemory formatOf: rcvr.
index := (objectMemory integerValueOf: index) - 1.
fmt <= objectMemory lastPointerFormat ifTrue:
[numSlots := objectMemory numSlotsOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[| value numLiveSlots |
(objectMemory isContextNonImm: rcvr)
ifTrue:
[self externalWriteBackHeadFramePointers.
numLiveSlots := (self stackPointerForMaybeMarriedContext: rcvr) + CtxtTempFrameStart.
value := (self asUnsigned: index) < numLiveSlots
ifTrue: [self externalInstVar: index ofContext: rcvr]
ifFalse: [objectMemory nilObject]]
ifFalse:
[value := objectMemory fetchPointer: index ofObject: rcvr].
self pop: argumentCount + 1 thenPush: value.
^0].
^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstByteFormat ifTrue:
[fmt >= objectMemory firstCompiledMethodFormat ifTrue:
[^self primitiveFailFor: PrimErrUnsupported].
numSlots := objectMemory numBytesOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr).
^0].
^self primitiveFailFor: PrimErrBadIndex].
(objectMemory hasSpurMemoryManagerAPI
and: [fmt >= objectMemory firstShortFormat]) ifTrue:
[numSlots := objectMemory num16BitUnitsOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchShort16: index ofObject: rcvr).
^0].
^self primitiveFailFor: PrimErrBadIndex].
fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
[numSlots := objectMemory num64BitUnitsOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[self pop: argumentCount + 1
thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)).
^0].
^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstLongFormat ifTrue:
[numSlots := objectMemory num32BitUnitsOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[self pop: argumentCount + 1
+ thenPush: (self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)).
- thenPush: (objectMemory bytesPerOop = 8
- ifTrue: [objectMemory integerObjectOf: (objectMemory fetchLong32: index ofObject: rcvr)]
- ifFalse: [self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)]).
^0].
^self primitiveFailFor: PrimErrBadIndex].
^self primitiveFailFor: PrimErrBadReceiver!
Item was changed:
----- Method: VMProfileLinuxSupportPlugin>>primitiveDLSymInLibrary (in category 'primitives') -----
primitiveDLSymInLibrary
"Answer the address of the symbol whose name is the first argument
in the library whose name is the second argument, or nil if none."
| nameObj symName libName lib sz addr ok |
<export: true>
<var: #symName type: #'char *'>
<var: #libName type: #'char *'>
<var: #lib type: #'void *'>
<var: #addr type: #'void *'>
nameObj := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: nameObj) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
sz := interpreterProxy byteSizeOf: nameObj.
libName := self malloc: sz+1.
self st: libName rn: (interpreterProxy firstIndexableField: nameObj) cpy: sz.
libName at: sz put: 0.
nameObj := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: nameObj) ifFalse:
[self free: libName.
^interpreterProxy primitiveFailFor: PrimErrBadArgument].
sz := interpreterProxy byteSizeOf: nameObj.
symName := self malloc: sz+1.
self st: symName rn: (interpreterProxy firstIndexableField: nameObj) cpy: sz.
symName at: sz put: 0.
lib := self dl: libName open: (#'RTLD_LAZY' bitOr: #'RTLD_NODELETE').
lib ifNil:
[self free: libName; free: symName.
^interpreterProxy primitiveFailFor: PrimErrInappropriate].
self dlerror. "clear dlerror"
addr := self dl: lib sym: symName.
ok := self dlerror isNil.
self free: symName.
self free: libName.
self dlclose: lib.
ok ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrNotFound].
+ ^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: addr asUnsignedLong)!
- ^interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: addr asUnsignedLong)!
Item was changed:
----- Method: VMProfileLinuxSupportPlugin>>primitiveInterpretAddress (in category 'primitives') -----
primitiveInterpretAddress
"Answer the address of the interpret routine."
<export: true>
| interpret |
<var: #interpret declareC: 'extern void interpret()'>
+ ^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: interpret asUnsignedLong)!
- self touch: interpret.
- ^interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: interpret asUnsignedLong)!
Item was changed:
----- Method: VMProfileMacSupportPlugin>>primitiveDLSym (in category 'primitives') -----
primitiveDLSym
"Answer the address of the argument in the current process or nil if none."
| nameObj name namePtr sz addr |
<export: true>
<var: #name type: #'char *'>
<var: #namePtr type: #'char *'>
<var: #addr type: #'void *'>
nameObj := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: nameObj) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
sz := interpreterProxy byteSizeOf: nameObj.
name := self malloc: sz+1.
namePtr := interpreterProxy firstIndexableField: nameObj.
0 to: sz-1 do:[:i| name at: i put: (namePtr at: i)].
name at: sz put: 0.
addr := self cCode: 'dlsym(RTLD_SELF,name)' inSmalltalk: [0].
self free: name.
^interpreterProxy methodReturnValue: (addr = 0
ifTrue: [interpreterProxy nilObject]
+ ifFalse: [interpreterProxy positiveMachineIntegerFor: addr asUnsignedLong])!
- ifFalse: [interpreterProxy positive32BitIntegerFor: addr asUnsignedLong])!
Item was changed:
----- Method: VMProfileMacSupportPlugin>>primitiveExecutableModulesAndOffsets (in category 'primitives') -----
primitiveExecutableModulesAndOffsets
"Answer an Array of quads for executable modules (the VM executable
and loaded libraries). Each quad is the module's name, its vm address
relocation in memory, the (unrelocated) start address, and the size."
| present nimages resultObj name valueObj nameObjData slide start size h s |
<export: true>
<var: #name type: 'const char *'>
<var: #nameObjData type: #'char *'>
<var: #h type: 'const struct mach_header *'>
<var: #s type: 'const struct section *'>
<var: #start type: 'unsigned long'>
<var: #size type: 'unsigned long'>
present := self cCode: '_dyld_present()' inSmalltalk: [false].
present ifFalse:
[^interpreterProxy primitiveFail].
nimages := self cCode: '_dyld_image_count()' inSmalltalk: [0].
resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: nimages * 4.
resultObj = 0 ifTrue:
[^interpreterProxy primitiveFail].
interpreterProxy pushRemappableOop: resultObj.
0 to: nimages - 1 do:
[:i|
start := size := -1. "impossible start & size"
name := self cCode: '_dyld_get_image_name(i)' inSmalltalk: [0].
slide := self cCode: '_dyld_get_image_vmaddr_slide(i)' inSmalltalk: [0].
h := self cCode: '_dyld_get_image_header(i)' inSmalltalk: [0].
h ~= nil ifTrue:
[s := self cCode: 'getsectbynamefromheader(h,SEG_TEXT,SECT_TEXT)' inSmalltalk: [0].
s ~= nil ifTrue:
[start := self cCode: 's->addr' inSmalltalk: [0].
size := self cCode: 's->size' inSmalltalk: [0]]].
valueObj := interpreterProxy
instantiateClass: interpreterProxy classString
indexableSize: (self strlen: name).
interpreterProxy failed ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFail].
interpreterProxy storePointer: i * 4 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
nameObjData := interpreterProxy arrayValueOf: valueObj.
self mem: nameObjData cp: name y: (self strlen: name).
valueObj := interpreterProxy signed32BitIntegerFor: slide.
interpreterProxy failed ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFail].
interpreterProxy storePointer: i * 4 + 1 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
+ valueObj := interpreterProxy positiveMachineIntegerFor: start.
- valueObj := interpreterProxy positive32BitIntegerFor: start.
interpreterProxy failed ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFail].
interpreterProxy storePointer: i * 4 + 2 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
+ valueObj := interpreterProxy positiveMachineIntegerFor: size.
- valueObj := interpreterProxy positive32BitIntegerFor: size.
interpreterProxy failed ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFail].
interpreterProxy storePointer: i * 4 + 3 ofObject: interpreterProxy topRemappableOop withValue: valueObj].
resultObj := interpreterProxy popRemappableOop.
^interpreterProxy pop: 1 thenPush: resultObj!
1
0
[commit][3255] squeak -help says that the default encoding for external text is UTF-8, make it so.
by commitsï¼ squeakvm.org 13 Feb '15
by commitsï¼ squeakvm.org 13 Feb '15
13 Feb '15
Revision: 3255
Author: lewis
Date: 2015-02-12 19:00:34 -0800 (Thu, 12 Feb 2015)
Log Message:
-----------
squeak -help says that the default encoding for external text is UTF-8, make it so.
Modified Paths:
--------------
trunk/platforms/unix/vm/sqUnixMain.c
Modified: trunk/platforms/unix/vm/sqUnixMain.c
===================================================================
--- trunk/platforms/unix/vm/sqUnixMain.c 2015-02-12 19:20:06 UTC (rev 3254)
+++ trunk/platforms/unix/vm/sqUnixMain.c 2015-02-13 03:00:34 UTC (rev 3255)
@@ -99,7 +99,7 @@
int uxDropFileCount= 0; /* number of dropped items */
char **uxDropFileNames= 0; /* dropped filenames */
- int textEncodingUTF8= 0; /* 1 if copy from external selection uses UTF8 */
+ int textEncodingUTF8= 1; /* 1 if copy from external selection uses UTF8 */
#if defined(IMAGE_DUMP)
static int dumpImageFile= 0; /* 1 after SIGHUP received */
@@ -1082,10 +1082,11 @@
len= strlen(buf);
for (i= 0; i < len; ++i)
buf[i]= toupper(buf[i]);
- if ((!strcmp(buf, "UTF8")) || (!strcmp(buf, "UTF-8")))
- textEncodingUTF8= 1;
- else
- setEncoding(&uxTextEncoding, buf);
+ if (strcmp(buf, "UTF8") && strcmp(buf, "UTF-8"))
+ {
+ textEncodingUTF8= 0;
+ setEncoding(&uxTextEncoding, buf);
+ }
free(buf);
return 2;
}
4
3
13 Feb '15
oops! I made a mistake, can the admin remove this package, please?
thanks!
Esteban
> On 13 Feb 2015, at 11:15, commits(a)source.squeak.org wrote:
>
>
> Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-EstebanLorenzano.1061.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-EstebanLorenzano.1061
> Author: EstebanLorenzano
> Time: 13 February 2015, 12:14:43.362602 pm
> UUID: fc599a22-0090-45e5-b306-08a55d1a46ae
> Ancestors: VMMaker.oscog-EstebanLorenzano.1058, VMMaker.oscog-eem.1060
>
> empty log message
>
> =============== Diff against VMMaker.oscog-eem.1060 ===============
>
> Item was changed:
> + SystemOrganization addCategory: #VMMaker!
> + SystemOrganization addCategory: 'VMMaker-Building'!
> + SystemOrganization addCategory: 'VMMaker-Interpreter'!
> + SystemOrganization addCategory: 'VMMaker-InterpreterSimulation'!
> + SystemOrganization addCategory: 'VMMaker-InterpreterSimulation-Morphic'!
> + SystemOrganization addCategory: 'VMMaker-JIT'!
> + SystemOrganization addCategory: 'VMMaker-JITSimulation'!
> + SystemOrganization addCategory: 'VMMaker-Multithreading'!
> + SystemOrganization addCategory: 'VMMaker-Plugins'!
> + SystemOrganization addCategory: 'VMMaker-Plugins-Alien'!
> + SystemOrganization addCategory: 'VMMaker-Plugins-IOS'!
> + SystemOrganization addCategory: 'VMMaker-PostProcessing'!
> + SystemOrganization addCategory: 'VMMaker-SmartSyntaxPlugins'!
> + SystemOrganization addCategory: 'VMMaker-SpurMemoryManager'!
> + SystemOrganization addCategory: 'VMMaker-SpurMemoryManagerSimulation'!
> + SystemOrganization addCategory: 'VMMaker-Support'!
> + SystemOrganization addCategory: 'VMMaker-Tests'!
> + SystemOrganization addCategory: 'VMMaker-Translation to C'!
> - SystemOrganization addCategory: #'VMMaker-Building'!
> - SystemOrganization addCategory: #'VMMaker-Interpreter'!
> - SystemOrganization addCategory: #'VMMaker-InterpreterSimulation'!
> - SystemOrganization addCategory: #'VMMaker-InterpreterSimulation-Morphic'!
> - SystemOrganization addCategory: #'VMMaker-JIT'!
> - SystemOrganization addCategory: #'VMMaker-JITSimulation'!
> - SystemOrganization addCategory: #'VMMaker-Multithreading'!
> - SystemOrganization addCategory: #'VMMaker-Plugins'!
> - SystemOrganization addCategory: #'VMMaker-Plugins-Alien'!
> - SystemOrganization addCategory: #'VMMaker-Plugins-IOS'!
> - SystemOrganization addCategory: #'VMMaker-PostProcessing'!
> - SystemOrganization addCategory: #'VMMaker-SmartSyntaxPlugins'!
> - SystemOrganization addCategory: #'VMMaker-SpurMemoryManager'!
> - SystemOrganization addCategory: #'VMMaker-SpurMemoryManagerSimulation'!
> - SystemOrganization addCategory: #'VMMaker-Support'!
> - SystemOrganization addCategory: #'VMMaker-Tests'!
> - SystemOrganization addCategory: #'VMMaker-Translation to C'!
>
> Item was changed:
> TestCase subclass: #AbstractInstructionTests
> instanceVariableNames: 'processor opcodes'
> classVariableNames: ''
> poolDictionaries: 'CogRTLOpcodes'
> category: 'VMMaker-Tests'!
> +
> + !AbstractInstructionTests commentStamp: 'BenjaminVanRyseghem 9/27/2011 14:04' prior: 0!
> + Use for a test: ClosureCompilerTest>>#closureCases!
>
> Item was changed:
> ----- Method: CCodeGenerator>>emitCFunctionPrototypes:on: (in category 'C code generator') -----
> emitCFunctionPrototypes: methodList on: aStream
> "Store prototype declarations for all non-inlined methods on the given stream."
> | exporting |
> aStream cr; nextPutAll: '/*** Function Prototypes ***/'; cr.
> "Hmm, this should be in the sqConfig.h files. For now put it here..."
> "Feel free to add equivalents for other compilers"
> vmClass notNil ifTrue:
> [NoRegParmsInAssertVMs ifTrue:
> + [aStream nextPutAll: '\\#if !!PRODUCTION && defined(__GNUC__) && !!(defined(__MINGW32__) || defined(__MINGW64__)) && !!defined(NoDbgRegParms)\# define NoDbgRegParms __attribute__ ((regparm (0)))\#endif' withCRs.
> - [aStream nextPutAll: '\\#if !!PRODUCTION && defined(__GNUC__) && !!defined(NoDbgRegParms)\# define NoDbgRegParms __attribute__ ((regparm (0)))\#endif' withCRs.
> aStream nextPutAll: '\\#if !!defined(NoDbgRegParms)\# define NoDbgRegParms /*empty*/\#endif\\' withCRs].
> aStream nextPutAll: '\\#if defined(__GNUC__) && !!defined(NeverInline)\# define NeverInline __attribute__ ((noinline))\#endif' withCRs.
> aStream nextPutAll: '\\#if !!defined(NeverInline)\# define NeverInline /*empty*/\#endif\\' withCRs].
> exporting := false.
> (methodList select: [:m| m isRealMethod
> and: [self shouldGenerateMethod: m]]) do:
> [:m |
> self emitExportPragma ifTrue:
> [m export
> ifTrue: [exporting ifFalse:
> [aStream nextPutAll: '#pragma export on'; cr.
> exporting := true]]
> ifFalse: [exporting ifTrue:
> [aStream nextPutAll: '#pragma export off'; cr.
> exporting := false]]].
> m emitCFunctionPrototype: aStream generator: self.
> (NoRegParmsInAssertVMs and: [vmClass notNil and: [m export not and: [m isStatic and: [m args notEmpty]]]]) ifTrue:
> [aStream nextPutAll: ' NoDbgRegParms'].
> (vmClass notNil and: [m inline == #never]) ifTrue:
> [aStream nextPutAll: ' NeverInline'].
> aStream nextPut: $; ; cr].
> exporting ifTrue: [aStream nextPutAll: '#pragma export off'; cr].
> aStream cr!
>
> Item was changed:
> ----- Method: CCodeGenerator>>emitGlobalCVariablesOn: (in category 'C code generator') -----
> emitGlobalCVariablesOn: aStream
> "Store the global variable declarations on the given stream."
>
> aStream cr; nextPutAll: '/*** Global Variables ***/'; cr.
> +
> (self sortStrings: (variables select: [:v| vmClass mustBeGlobal: v])) do:
> [:var | | varString decl |
> varString := var asString.
> decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString].
> decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack"
> ifTrue:
> [aStream nextPutAll: decl; cr]
> ifFalse:
> + [
> + ((decl includesSubString: ' private ')
> + or: [decl beginsWith: 'static']) ifFalse: "work-around hack to prevent localization of variables only referenced once."
> + [
> + aStream nextPutAll: 'VM_EXPORT '.
> +
> + (decl includes: $=) ifTrue:
> - [((decl includesSubString: ' private ')
> - "or: [decl beginsWith: 'static']") ifFalse: "work-around hack to prevent localization of variables only referenced once."
> - [(decl includes: $=) ifTrue:
> [decl := decl copyFrom: 1 to: (decl indexOf: $=) - 1].
> aStream
> nextPutAll: decl;
> nextPut: $;;
> cr]]].
> aStream cr!
>
> Item was added:
> + ----- Method: CCodeGenerator>>interpreterVersion (in category 'accessing') -----
> + interpreterVersion
> + | memoryManagerVersion |
> + memoryManagerVersion := (self options at: #ObjectMemory ifAbsent: [ #ObjectMemory ]) asClass memoryManagerVersion.
> + ^ self vmClass interpreterVersion, '[', memoryManagerVersion,']'!
>
> Item was added:
> + ----- Method: CCodeGenerator>>isThreadedVM (in category 'testing') -----
> + isThreadedVM
> + ^ self vmClass isThreadedVM!
>
> Item was changed:
> ----- Method: CCodeGenerator>>nonStructClassesForTranslationClasses: (in category 'utilities') -----
> nonStructClassesForTranslationClasses: classes
> "Answer in superclass order (any superclass precedes any subclass)
> the ancilliaryClasses that are not struct classes for all the given classes."
> | nonStructClasses |
> nonStructClasses := OrderedCollection new.
> classes do:
> [:aTranslationClass|
> ([aTranslationClass ancilliaryClasses: self options]
> on: MessageNotUnderstood
> do: [:ex|
> ex message selector == #ancilliaryClasses:
> ifTrue: [#()]
> ifFalse: [ex pass]]) do:
> [:class|
> (vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class]) ifTrue:
> [(class isStructClass
> or: [(nonStructClasses includes: class)
> or: [classes includes: class]]) ifFalse:
> [nonStructClasses addLast: class]]]].
> + ^Class superclassOrder: nonStructClasses!
> - ^ChangeSet superclassOrder: nonStructClasses!
>
> Item was changed:
> ----- Method: CCodeGenerator>>storeAPIExportHeader:OnFile: (in category 'public') -----
> storeAPIExportHeader: headerName OnFile: fullHeaderPath
> "Store C header code on the given file. Evaluate
> aBlock with the stream to generate its contents."
>
> | header |
> header := String streamContents:
> [:s|
> + "s nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr."
> - s nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr.
> self emitCAPIExportHeaderOn: s].
> (self needToGenerateHeader: headerName file: fullHeaderPath contents: header) ifTrue:
> [self storeHeaderOnFile: fullHeaderPath contents: header]!
>
> Item was changed:
> ----- Method: CCodeGenerator>>storeHeaderOnFile:contents: (in category 'public') -----
> storeHeaderOnFile: fileName contents: contents
> "Store C header code on the given file. Evaluate
> aBlock with the stream to generate its contents."
>
> | aStream |
> aStream := VMMaker forceNewFileNamed: fileName.
> aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
> + ["(contents beginsWith: '/* Automatic') ifFalse:
> + [aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr]".
> - [(contents beginsWith: '/* Automatic') ifFalse:
> - [aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr].
> aStream nextPutAll: contents]
> ensure: [aStream close]!
>
> Item was changed:
> ----- Method: CCodeGenerator>>structClassesForTranslationClasses: (in category 'utilities') -----
> structClassesForTranslationClasses: classes
> "Answer in superclass order (any superclass precedes any subclass)
> the ancilliaryClasses that are struct classes for all the given classes."
> | theStructClasses |
> theStructClasses := OrderedCollection new.
> classes do:
> [:aTranslationClass|
> ([aTranslationClass ancilliaryClasses: self options]
> on: MessageNotUnderstood
> do: [:ex|
> ex message selector == #ancilliaryClasses:
> ifTrue: [#()]
> ifFalse: [ex pass]]) do:
> [:class|
> (class isStructClass
> and: [(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class])
> and: [(theStructClasses includes: class) not]]) ifTrue:
> [theStructClasses addLast: class]]].
> ^ChangeSet superclassOrder: theStructClasses!
>
> Item was changed:
> ----- Method: CoInterpreter class>>declareCVarsIn: (in category 'translation') -----
> declareCVarsIn: aCCodeGenerator
> "Override to avoid repeating StackInterpreter's declarations and add our own extensions"
> +
> - | threaded |
> self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
> - threaded := aCCodeGenerator vmClass isThreadedVM.
> aCCodeGenerator
> addHeaderFile:'"sqCogStackAlignment.h"';
> addHeaderFile:'"cogmethod.h"';
> + addHeaderFile: (aCCodeGenerator isThreadedVM
> + ifTrue: ['"cointerpmt.h"']
> + ifFalse: ['"cointerp.h"']);
> - addHeaderFile: (threaded ifTrue: ['"cointerpmt.h"'] ifFalse: ['"cointerp.h"']);
> addHeaderFile:'"cogit.h"'.
> aCCodeGenerator vmClass
> declareInterpreterVersionIn: aCCodeGenerator
> + defaultName: aCCodeGenerator interpreterVersion.
> - defaultName: (threaded ifTrue: ['Cog MT'] ifFalse: ['Cog']).
> aCCodeGenerator
> var: #heapBase type: #usqInt;
> var: #statCodeCompactionUsecs type: #usqLong;
> var: #maxLiteralCountForCompile
> declareC: 'sqInt maxLiteralCountForCompile = MaxLiteralCountForCompile /* ', MaxLiteralCountForCompile printString, ' */';
> var: #minBackwardJumpCountForCompile
> declareC: 'sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* ', MinBackwardJumpCountForCompile printString, ' */'.
> aCCodeGenerator
> var: #reenterInterpreter
> declareC: 'jmp_buf reenterInterpreter; /* private export */'.
> aCCodeGenerator
> var: #primTraceLogIndex type: #'unsigned char';
> var: #primTraceLog declareC: 'sqInt primTraceLog[256]';
> var: #traceLog
> declareC: 'sqInt traceLog[TraceBufferSize /* ', TraceBufferSize printString, ' */]';
> var: #traceSources type: #'char *' array: TraceSources!
>
> Item was added:
> + ----- Method: CoInterpreter class>>interpreterVersion (in category 'accessing') -----
> + interpreterVersion
> + ^ 'Cog'!
>
> Item was changed:
> ----- Method: CoInterpreter>>initStackPagesAndInterpret (in category 'initialization') -----
> initStackPagesAndInterpret
> "Initialize the stack pages and enter interpret. Use alloca'ed memory so that when
> we have a JIT its stack pointer will be on the native stack since alloca allocates
> memory on the stack. Certain thread systems use the native stack pointer as the
> frame ID so putting the stack anywhere else can confuse the thread system."
>
> "Override to establish the setjmp/longjmp handler for reentering the interpreter
> from machine code, and disable executablity on the heap and stack pages."
>
> "This should be in its own initStackPages method but Slang can't inline
> C code strings."
> | stackPageBytes stackPagesBytes theStackMemory |
> <var: #theStackMemory type: #'char *'>
> stackPageBytes := self stackPageByteSize.
> stackPagesBytes := self computeStackZoneSize.
> theStackMemory := self
> cCode: [self alloca: stackPagesBytes]
> inSmalltalk: [stackPages initializeWithByteSize: stackPagesBytes for: self].
> self cCode: [self me: theStackMemory ms: 0 et: stackPagesBytes].
> + self cppIf: #SPUR_USE_EXECUTABLE_MEMORY
> + ifTrue: [
> + self
> + sqMakeMemoryExecutableFrom: objectMemory startOfMemory asUnsignedInteger
> + To: objectMemory memoryLimit asUnsignedInteger ]
> + ifFalse: [
> + self
> + sqMakeMemoryNotExecutableFrom: objectMemory startOfMemory asUnsignedInteger
> + To: objectMemory memoryLimit asUnsignedInteger ].
> + self
> + sqMakeMemoryNotExecutableFrom: theStackMemory asUnsignedInteger
> - self sqMakeMemoryNotExecutableFrom: objectMemory startOfMemory asUnsignedInteger
> - To: objectMemory memoryLimit asUnsignedInteger.
> - self sqMakeMemoryNotExecutableFrom: theStackMemory asUnsignedInteger
> To: theStackMemory asUnsignedInteger + stackPagesBytes.
> +
> stackPages
> initializeStack: theStackMemory
> numSlots: stackPagesBytes / objectMemory wordSize
> pageSize: stackPageBytes / objectMemory wordSize.
> self assert: self minimumUnusedHeadroom = stackPageBytes.
>
> "Once the stack pages are initialized we can continue to bootstrap the system."
> self loadInitialContext.
> "We're ready for the heartbeat (poll interrupt)"
> self ioInitHeartbeat.
> self initialEnterSmalltalkExecutive.
> ^nil!
>
> Item was added:
> + ----- Method: CoInterpreterMT class>>interpreterVersion (in category 'accessing') -----
> + interpreterVersion
> + ^ 'Cog MT'!
>
> Item was changed:
> ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
> instVarNamesAndTypesForTranslationDo: aBinaryBlock
> "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct."
> "{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do:
> [:c| Transcript print: c; cr. c printTypedefOn: Transcript]"
> | machineCodeBytes |
> machineCodeBytes := self == CogAbstractInstruction
> ifTrue: [0]
> ifFalse: [self basicNew machineCodeBytes].
> (self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do:
> [:ivn|
> ivn ~= 'bcpc' ifTrue:
> [aBinaryBlock
> value: ivn
> value: (ivn caseOf: {
> ['address'] -> ['unsigned long'].
> ['machineCode'] -> [{'unsigned char'. '[', machineCodeBytes printString, ']'}].
> + ['operands'] -> [{'unsigned long'. '[', NumOperands printString, ']'}].
> - ['operands'] -> [{'unsigned long'. '[', NumOperands, ']'}].
> ['dependent'] -> ['struct _AbstractInstruction *']}
> otherwise:
> [#char])]]!
>
> Item was changed:
> ----- Method: CogMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
> alignedByteSize
> ^20 + self baseHeaderSize!
>
> Item was changed:
> ----- Method: CogMethodSurrogate64 class>>alignedByteSize (in category 'accessing') -----
> alignedByteSize
> ^32 + self baseHeaderSize!
>
> Item was changed:
> CoInterpreterMT subclass: #CogVMSimulator
> instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends traceOn myBitBlt displayForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters'
> classVariableNames: ''
> poolDictionaries: ''
> category: 'VMMaker-JITSimulation'!
>
> + !CogVMSimulator commentStamp: 'EstebanLorenzano 10/15/2014 11:45' prior: 0!
> - !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0!
> This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. Remember that you can test the Cogit using its class-side in-image compilation facilities.
>
> To see the thing actually run, you could (after backing up this image and changes), execute
>
> (CogVMSimulator new openOn: Smalltalk imageName) test
>
> and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image.
>
> Here's an example to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff:
>
> (CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit))
> desiredNumStackPages: 8;
> openOn: '/Users/eliot/Cog/startreader.image';
> openAsMorph;
> run
>
> Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out.
>
> | cos proc opts |
> CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)).
> - CogVMSimulator chooseAndInitCogitClassWithOpts: opts.
> cos := CogVMSimulator new.
> "cos initializeThreadSupport." "to test the multi-threaded VM"
> cos desiredNumStackPages: 8. "to set the size of the stack zone"
> "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone"
> cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image"
> "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector"
> proc := cos cogit processor.
> "cos cogit sendTrace: 7." "turn on tracing"
> "set a complex breakpoint at a specific point in machine code"
> "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg| cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1".
> "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit"
> "cos cogit setBreakMethod: 16rB38880."
> cos
> openAsMorph;
> "toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window"
> halt;
> run!
>
> Item was changed:
> ----- Method: CogVMSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
> ioRelinquishProcessorForMicroseconds: microseconds
> "In the simulator give an indication that we're idling and check for input.
> If called from machine code then increment the byte count since the clock
> is derived from it and the clock will not advance otherwise.
> If we're simulating threading we're in difficulties. We need a UI process
> (to run activities such as fill-in-the-blanks) but we also need an independent
> thread of control to run this VM thread. So we need to fork a new UI process."
> Display reverse: (0@0 extent: 16@16).
> Sensor peekEvent ifNotNil:
> [self forceInterruptCheck].
> + Processor activeProcess == UIManager default uiProcess ifTrue:
> - Processor activeProcess == Project uiProcess ifTrue:
> [World doOneCycle].
> microseconds >= 1000
> ifTrue: [self isThreadedVM ifTrue:
> [self forceInterruptCheckFromHeartbeat].
> (Delay forMilliseconds: microseconds + 999 // 1000) wait]
> ifFalse: [Processor yield].
> byteCount := byteCount + microseconds - 1.
> self incrementByteCount!
>
> Item was changed:
> ----- Method: CogVMSimulator>>openAsMorph (in category 'UI') -----
> openAsMorph
> "Open a morphic view on this simulation."
> + | localImageName borderWidth theWindow |
> + localImageName := imageName asFileReference basename.
> + theWindow := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
> - | localImageName borderWidth window |
> - localImageName := imageName
> - ifNotNil: [FileDirectory default localNameFor: imageName]
> - ifNil: [' synthetic image'].
> - window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
>
> + theWindow addMorph: (displayView := ImageMorph new image: displayForm)
> - window addMorph: (displayView := ImageMorph new image: displayForm)
> frame: (0@0 corner: 1(a)0.8).
>
> + transcript := ThreadSafeTranscript new.
> + theWindow addMorph: (PluggableTextMorph
> - transcript := TranscriptStream on: (String new: 10000).
> - window addMorph: (PluggableTextMorph
> on: transcript text: nil accept: nil
> readSelection: nil menu: #codePaneMenu:shifted:)
> frame: (0(a)0.8 corner: 0.7@1).
> + theWindow addMorph: (PluggableTextMorph on: self
> - window addMorph: (PluggableTextMorph on: self
> text: #byteCountText accept: nil
> readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
> frame: (0.7(a)0.8 corner: 1@1).
>
> borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
> on: MessageNotUnderstood
> do: [:ex| 0]. "3.8"
> + borderWidth := borderWidth + theWindow borderWidth.
> + theWindow openInWorldExtent: (self desiredDisplayExtent
> - borderWidth := borderWidth + window borderWidth.
> - window openInWorldExtent: (self desiredDisplayExtent
> + (2 * borderWidth)
> + + (0@theWindow labelHeight)
> + * (1(a)(1/0.8))) rounded!
> - + (0@window labelHeight)
> - * (1(a)(1/0.8))) rounded.
> - ^window!
>
> Item was changed:
> ----- Method: CogVMSimulator>>openAsMorphNoTranscript (in category 'UI') -----
> openAsMorphNoTranscript
> "Open a morphic view on this simulation."
> + | localImageName theWindow |
> + localImageName := imageName asFileReference basename.
> + theWindow := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
> - | localImageName borderWidth window |
> - localImageName := FileDirectory default localNameFor: imageName.
> - window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
>
> + theWindow addMorph: (displayView := ImageMorph new image: displayForm)
> - window addMorph: (displayView := ImageMorph new image: displayForm)
> frame: (0@0 corner: 1(a)0.95).
>
> + theWindow addMorph: (PluggableTextMorph on: self
> - window addMorph: (PluggableTextMorph on: self
> text: #byteCountText accept: nil
> readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
> frame: (0(a)0.95 corner: 1@1).
>
> + theWindow openInWorldExtent: (self desiredDisplayExtent
> + + (2 * theWindow borderWidth)
> + + (0@theWindow labelHeight)
> - borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
> - on: MessageNotUnderstood
> - do: [:ex| 0]. "3.8"
> - borderWidth := borderWidth + window borderWidth.
> - window openInWorldExtent: (self desiredDisplayExtent
> - + (2 * borderWidth)
> - + (0@window labelHeight)
> * (1(a)(1/0.95))) rounded!
>
> Item was changed:
> ----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
> primitiveDirectoryEntry
> | name pathName array result |
> name := self stringOf: self stackTop.
> pathName := self stringOf: (self stackValue: 1).
>
> self successful ifFalse:
> [^self primitiveFail].
>
> + array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
> - array := FileDirectory default primLookupEntryIn: pathName name: name.
> array == nil ifTrue:
> [self pop: 3 thenPush: objectMemory nilObject.
> ^array].
> array == #badDirectoryPath ifTrue:
> [self halt.
> ^self primitiveFail].
>
> + result := self makeDirEntryName: (array at: 1)
> + size: (array at: 1) size
> + createDate: (array at: 2)
> + modDate: (array at: 3)
> + isDir: (array at: 4)
> + fileSize: (array at: 5)
> + posixPermissions: (array at: 6)
> + isSymlink: (array at: 7).
> +
> - result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> - createDate: (array at: 2) modDate: (array at: 3)
> - isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3.
> self push: result!
>
> Item was changed:
> ----- Method: CogVMSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
> primitiveDirectoryLookup
> | index pathName array result |
> index := self stackIntegerValue: 0.
> pathName := (self stringOf: (self stackValue: 1)).
>
> self successful ifFalse:
> [^self primitiveFail].
>
> + array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
> - array := FileDirectory default primLookupEntryIn: pathName index: index.
>
> array == nil ifTrue:
> [self pop: 3 thenPush: objectMemory nilObject.
> ^array].
> array == #badDirectoryPath ifTrue:
> ["self halt."
> ^self primitiveFail].
>
> + result := self makeDirEntryName: (array at: 1)
> + size: (array at: 1) size
> + createDate: (array at: 2)
> + modDate: (array at: 3)
> + isDir: (array at: 4)
> + fileSize: (array at: 5)
> + posixPermissions: (array at: 6)
> + isSymlink: (array at: 7).
> - result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> - createDate: (array at: 2) modDate: (array at: 3)
> - isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3 thenPush: result!
>
> Item was changed:
> ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
> declareCVarsIn: aCCodeGenerator
> #( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
> 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass'
> 'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
> 'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
> 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
> [:simulationVariableNotNeededForRealVM|
> aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
> NewspeakVM ifFalse:
> [#( 'dynSuperEntry' 'dynSuperEntryAlignment' 'dynamicSuperSendTrampolines'
> 'ceImplicitReceiverTrampoline' 'ceEnclosingObjectTrampoline' 'cmDynSuperEntryOffset'
> 'numIRCs' 'indexOfIRC' 'theIRCs') do:
> [:variableNotNeededInNormalVM|
> aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
> aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
> aCCodeGenerator
> addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
> + addHeaderFile:'<setjmp.h>';
> addHeaderFile:'"sqCogStackAlignment.h"';
> addHeaderFile:'"dispdbg.h"'; "must preceed cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
> addHeaderFile:'"cogmethod.h"';
> addHeaderFile:'#if COGMTVM';
> addHeaderFile:'"cointerpmt.h"';
> addHeaderFile:'#else';
> addHeaderFile:'"cointerp.h"';
> addHeaderFile:'#endif';
> addHeaderFile:'"cogit.h"'.
> aCCodeGenerator
> var: #ceGetSP
> declareC: 'unsigned long (*ceGetSP)(void)';
> var: #ceCaptureCStackPointers
> declareC: 'void (*ceCaptureCStackPointers)(void)';
> var: #ceEnterCogCodePopReceiverReg
> declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
> var: #realCEEnterCogCodePopReceiverReg
> declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
> var: #ceCallCogCodePopReceiverReg
> declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
> var: #realCECallCogCodePopReceiverReg
> declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
> var: #ceCallCogCodePopReceiverAndClassRegs
> declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
> var: #realCECallCogCodePopReceiverAndClassRegs
> declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
> var: #ceFlushICache
> declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
> var: #ceCheckFeaturesFunction
> declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
> var: #ceTryLockVMOwner
> declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
> var: #ceUnlockVMOwner
> declareC: 'void (*ceUnlockVMOwner)(void)';
> var: #postCompileHook
> declareC: 'void (*postCompileHook)(CogMethod *, void *)';
> var: #openPICList declareC: 'CogMethod *openPICList = 0';
> var: #maxMethodBefore type: #'CogBlockMethod *'.
> aCCodeGenerator
> declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
> var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
> var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel';
> var: #primInvokeLabel type: #'AbstractInstruction *'.
> self declareC: #(abstractOpcodes stackCheckLabel
> blockEntryLabel blockEntryNoContextSwitch
> stackOverflowCall sendMiss entry noCheckEntry dynSuperEntry
> picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1)
> as: #'AbstractInstruction *'
> in: aCCodeGenerator.
> aCCodeGenerator
> declareVar: #annotations type: #'InstructionAnnotation *';
> declareVar: #blockStarts type: #'BlockStart *';
> declareVar: #fixups type: #'BytecodeFixup *'.
> aCCodeGenerator
> var: #sendTrampolines
> declareC: 'sqInt sendTrampolines[NumSendTrampolines]';
> var: #superSendTrampolines
> declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
> var: #dynamicSuperSendTrampolines
> declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
> var: #trampolineAddresses
> declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
> var: #objectReferencesInRuntime
> declareC: 'static sqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
> var: #labelCounter
> type: #int;
> var: #traceFlags
> declareC: 'int traceFlags = 8 /* prim trace log on by default */';
> var: #cStackAlignment
> declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
> aCCodeGenerator
> declareVar: #CFramePointer type: #'void *';
> declareVar: #CStackPointer type: #'void *';
> declareVar: #minValidCallAddress type: #'unsigned long';
> declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
> aCCodeGenerator vmClass generatorTable ifNotNil:
> [:bytecodeGenTable|
> aCCodeGenerator
> var: #generatorTable
> + declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
> - declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
> (self tableInitializerFor: bytecodeGenTable
> in: aCCodeGenerator);
> var: #primitiveGeneratorTable
> declareC: 'static PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]',
> (self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
> in: aCCodeGenerator)].
> "In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
> Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic
> sugar to avoid the clash."
> (self organization listAtCategoryNamed: #'abstract instructions') do:
> [:s|
> aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
> aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!
>
> Item was changed:
> ----- Method: Cogit>>genCallEnilopmartFor:and:called: (in category 'initialization') -----
> genCallEnilopmartFor: regArg1 and: regArg2 called: trampolineName
> "An enilopmart (the reverse of a trampoline) is a piece of code that makes
> the system-call-like transition from the C runtime into generated machine
> code. This version is for entering code as if from a call. The desired
> arguments and entry-point are pushed on a stackPage's stack, and beneath
> them is the call's return address. The enilopmart pops off the values to be
> loaded into registers, and on CISCs then executes a return instruction to pop
> off the entry-point and jump to it. On RISCs the enilopmart pops off the values
> to be loaded into registers, pops the entry-point into a scratch register, pops
> the return address into the LinkReg and then jumps to the entry point.
>
> BEFORE AFTER (stacks grow down)
> whatever stackPointer -> whatever
> call return pc
> target address => reg1 = reg1val, etc
> reg1val LinkReg = call return pc
> stackPointer -> reg2val pc = target address
>
> C.F. genEnilopmartFor:and:and:called:"
> <returnTypeC: 'void (*genCallEnilopmartForandcalled(sqInt regArg1, sqInt regArg2, char *trampolineName))(void)'>
> | size endAddress enilopmart |
> opcodeIndex := 0.
> backEnd genLoadStackPointers.
> self PopR: regArg2.
> self PopR: regArg1.
> backEnd hasLinkRegister
> ifTrue:
> [self PopR: TempReg.
> self PopR: LinkReg.
> self JumpR: TempReg]
> ifFalse:
> [self RetN: 0].
> self computeMaximumSizes.
> size := self generateInstructionsAt: methodZoneBase.
> endAddress := self outputInstructionsAt: methodZoneBase.
> self assert: methodZoneBase + size = endAddress.
> enilopmart := methodZoneBase.
> methodZoneBase := self alignUptoRoutineBoundary: endAddress.
> backEnd nopsFrom: endAddress to: methodZoneBase - 1.
> self recordGeneratedRunTime: trampolineName address: enilopmart.
> ^self cCoerceSimple: enilopmart to: #'void (*)(void)'!
>
> Item was changed:
> ----- Method: Cogit>>genCallEnilopmartFor:called: (in category 'initialization') -----
> genCallEnilopmartFor: regArg1 called: trampolineName
> "An enilopmart (the reverse of a trampoline) is a piece of code that makes
> the system-call-like transition from the C runtime into generated machine
> code. This version is for entering code as if from a call. The desired
> arguments and entry-point are pushed on a stackPage's stack, and beneath
> them is the call's return address. The enilopmart pops off the values to be
> loaded into registers, and on CISCs then executes a return instruction to pop
> off the entry-point and jump to it. On RISCs the enilopmart pops off the values
> to be loaded into registers, pops the entry-point into a scratch register, pops
> the return address into the LinkReg and then jumps to the entry point.
>
> BEFORE AFTER (stacks grow down)
> whatever stackPointer -> whatever
> call return pc reg1 = reg1val
> target address => LinkReg = call return pc
> stackPointer -> reg1val pc = target address
>
> C.F. genEnilopmartFor:and:and:called:"
> <returnTypeC: 'void (*genCallEnilopmartForcalled(sqInt regArg1, char *trampolineName))(void)'>
> | size endAddress enilopmart |
> opcodeIndex := 0.
> backEnd genLoadStackPointers.
> self PopR: regArg1.
> backEnd hasLinkRegister
> ifTrue:
> [self PopR: TempReg.
> self PopR: LinkReg.
> self JumpR: TempReg]
> ifFalse:
> [self RetN: 0].
> self computeMaximumSizes.
> size := self generateInstructionsAt: methodZoneBase.
> endAddress := self outputInstructionsAt: methodZoneBase.
> self assert: methodZoneBase + size = endAddress.
> enilopmart := methodZoneBase.
> methodZoneBase := self alignUptoRoutineBoundary: endAddress.
> backEnd nopsFrom: endAddress to: methodZoneBase - 1.
> self recordGeneratedRunTime: trampolineName address: enilopmart.
> ^self cCoerceSimple: enilopmart to: #'void (*)(void)'!
>
> Item was changed:
> ----- Method: Cogit>>print: (in category 'printing') -----
> print: aString
> + <cmacro: '(aString) printf("%s", aString)'>
> - <cmacro: '(aString) printf(aString)'>
> coInterpreter transcript print: aString!
>
> Item was changed:
> ----- Method: CrossPlatformVMMaker>>validatePlugin:in: (in category 'generate sources') -----
> validatePlugin: plName in: listOfPlugins
> "Check that the class for the plugin exists, and answer that class.
> No longer check that if the plugin requires platform files that at least
> one platform subdirectory exists, not producing the source is not helpful."
> | plugin |
> plName isString
> ifTrue: [(listOfPlugins includes: plName)
> ifTrue: [plugin := Smalltalk classNamed: plName]]
> ifFalse: [((plName isBehavior
> and: [plName inheritsFrom: InterpreterPlugin])
> and: [listOfPlugins includes: plName name])
> ifTrue: [plugin := plName]].
> plugin ifNil: [^ self couldNotFindPluginClass: plName].
> plugin shouldBeTranslated ifFalse:
> + [self error: 'untranslateable plugin class ', plugin name].
> - [self error: 'untranslateable plugin class ', plName].
> ^plugin!
>
> Item was changed:
> ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation>>compactClassIndexOfClass: (in category 'accessing') -----
> compactClassIndexOfClass: classOop
> "Ugh, can't reply on the host. Spur doesn't have compact classes"
> | aClass |
> aClass := self objectForOop: classOop.
> ^false
> ifTrue: [aClass indexIfCompact]
> ifFalse:
> [aClass caseOf: {
> [CompiledMethod] -> [1].
> [Array] -> [3].
> [LargeNegativeInteger] -> [4].
> [LargePositiveInteger] -> [5].
> [Float] -> [6].
> [Association] -> [8].
> [Point] -> [9].
> [Rectangle] -> [10].
> [ByteString] -> [11].
> + [Context] -> [14].
> - [MethodContext] -> [14].
> [Bitmap] -> [16]
> }
> otherwise: [0]]!
>
> Item was removed:
> - ----- Method: DetailedInstructionPrinter class>>on: (in category 'instance creation') -----
> - on: method
> - "Answer an instance of me on the argument, method."
> -
> - ^self new method: method pc: method initialPC!
>
> Item was added:
> + SmartSyntaxInterpreterPlugin subclass: #DisplayPlugin
> + instanceVariableNames: ''
> + classVariableNames: ''
> + poolDictionaries: ''
> + category: 'VMMaker-Plugins'!
>
> Item was removed:
> - ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'directory primitives') -----
> - makeDirEntryName: entryName size: entryNameSize
> - createDate: createDate modDate: modifiedDate
> - isDir: dirFlag fileSize: fileSize
> -
> - | modDateOop createDateOop nameString results stringPtr fileSizeOop |
> - <var: 'entryName' type: 'char *'>
> - <var: 'stringPtr' type:'char *'>
> - <var: 'fileSize' type:'squeakFileOffsetType '>
> -
> - "allocate storage for results, remapping newly allocated
> - oops in case GC happens during allocation"
> - interpreterProxy pushRemappableOop:
> - (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 5).
> - interpreterProxy pushRemappableOop:
> - (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
> - interpreterProxy pushRemappableOop:
> - (interpreterProxy positive32BitIntegerFor: createDate).
> - interpreterProxy pushRemappableOop:
> - (interpreterProxy positive32BitIntegerFor: modifiedDate).
> - interpreterProxy pushRemappableOop:
> - (interpreterProxy positive64BitIntegerFor: fileSize).
> -
> - fileSizeOop := interpreterProxy popRemappableOop.
> - modDateOop := interpreterProxy popRemappableOop.
> - createDateOop := interpreterProxy popRemappableOop.
> - nameString := interpreterProxy popRemappableOop.
> - results := interpreterProxy popRemappableOop.
> -
> - "copy name into Smalltalk string"
> - stringPtr := interpreterProxy firstIndexableField: nameString.
> - 0 to: entryNameSize - 1 do: [ :i |
> - stringPtr at: i put: (entryName at: i).
> - ].
> -
> - interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
> - interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
> - interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
> - dirFlag
> - ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
> - ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
> - interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
> - ^ results!
>
> Item was added:
> + ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'directory primitives') -----
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: fileSize
> + posixPermissions: posixPermissions
> + isSymlink: symlinkFlag
> +
> + | modDateOop createDateOop nameString results stringPtr posixPermissionsOop fileSizeOop |
> + <var: 'entryName' type: 'char *'>
> + <var: 'stringPtr' type: 'char *'>
> + <var: 'fileSize' type: 'squeakFileOffsetType '>
> +
> + "allocate storage for results, remapping newly allocated
> + oops in case GC happens during allocation"
> + interpreterProxy pushRemappableOop:
> + (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 7).
> + interpreterProxy pushRemappableOop:
> + (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
> + interpreterProxy pushRemappableOop:
> + (interpreterProxy positive32BitIntegerFor: createDate).
> + interpreterProxy pushRemappableOop:
> + (interpreterProxy positive32BitIntegerFor: modifiedDate).
> + interpreterProxy pushRemappableOop:
> + (interpreterProxy positive64BitIntegerFor: fileSize).
> + interpreterProxy pushRemappableOop:
> + (interpreterProxy positive32BitIntegerFor: posixPermissions).
> +
> + posixPermissionsOop := interpreterProxy popRemappableOop.
> + fileSizeOop := interpreterProxy popRemappableOop.
> + modDateOop := interpreterProxy popRemappableOop.
> + createDateOop := interpreterProxy popRemappableOop.
> + nameString := interpreterProxy popRemappableOop.
> + results := interpreterProxy popRemappableOop.
> +
> + "copy name into Smalltalk string"
> + stringPtr := interpreterProxy firstIndexableField: nameString.
> + 0 to: entryNameSize - 1 do: [ :i |
> + stringPtr at: i put: (entryName at: i).
> + ].
> +
> + interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
> + interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
> + interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
> + dirFlag
> + ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
> + ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
> + interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
> + interpreterProxy storePointer: 5 ofObject: results withValue: posixPermissionsOop.
> + symlinkFlag
> + ifTrue: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy trueObject ]
> + ifFalse: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy falseObject ].
> + ^ results!
>
> Item was changed:
> ----- Method: FilePlugin>>primitiveDirectoryEntry (in category 'directory primitives') -----
> primitiveDirectoryEntry
>
> "Two arguments - directory path, and simple file name;
> returns an array (see primitiveDirectoryLookup) describing the file or directory,
> or nil if it does not exist.
> Primitive fails if the outer path does not identify a readable directory.
> (This is a lookup-by-name variant of primitiveDirectoryLookup.)"
>
> + | requestedName pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag posixPermissions symlinkFlag fileSize okToList reqNameIndex reqNameSize |
> - | requestedName pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag fileSize okToList reqNameIndex reqNameSize |
> <var: 'entryName' declareC: 'char entryName[256]'>
> <var: 'pathNameIndex' type: 'char *'>
> <var: 'reqNameIndex' type: 'char *'>
> <var: 'fileSize' type: 'squeakFileOffsetType'>
> <export: true>
>
> requestedName := interpreterProxy stackValue: 0.
> pathName := interpreterProxy stackValue: 1.
> (interpreterProxy isBytes: pathName)
> ifFalse: [^interpreterProxy primitiveFail].
>
> "Outbound string parameters"
> pathNameIndex := interpreterProxy firstIndexableField: pathName.
> pathNameSize := interpreterProxy byteSizeOf: pathName.
>
> reqNameIndex := interpreterProxy firstIndexableField: requestedName.
> reqNameSize := interpreterProxy byteSizeOf: requestedName.
>
> "If the security plugin can be loaded, use it to check for permission.
> If not, assume it's ok"
> sCLPfn ~= 0
> ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)']
> ifFalse: [okToList := true].
> okToList
> + ifTrue: [status := self cCode: 'dir_EntryLookup(
> + pathNameIndex,
> + pathNameSize,
> + reqNameIndex,
> + reqNameSize,
> + entryName,
> + &entryNameSize,
> + &createDate,
> + &modifiedDate,
> + &dirFlag,
> + &fileSize,
> + &posixPermissions,
> + &symlinkFlag)']
> - ifTrue: [status := self cCode: 'dir_EntryLookup(pathNameIndex, pathNameSize, reqNameIndex, reqNameSize,
> - entryName, &entryNameSize, &createDate,
> - &modifiedDate, &dirFlag, &fileSize)']
> ifFalse: [status := DirNoMoreEntries].
>
> interpreterProxy failed
> ifTrue: [^nil].
> status = DirNoMoreEntries
> ifTrue: ["no entry; return nil"
> interpreterProxy pop: 3 "pop pathName, index, rcvr"
> thenPush: interpreterProxy nilObject.
> ^nil].
> status = DirBadPath
> ifTrue: [^interpreterProxy primitiveFail]."bad path"
>
> interpreterProxy pop: 3 "pop pathName, fName, rcvr"
> thenPush: (self
> makeDirEntryName: entryName
> size: entryNameSize
> createDate: createDate
> modDate: modifiedDate
> isDir: dirFlag
> + fileSize: fileSize
> + posixPermissions: posixPermissions
> + isSymlink: symlinkFlag)!
> - fileSize: fileSize)!
>
> Item was changed:
> ----- Method: FilePlugin>>primitiveDirectoryLookup (in category 'directory primitives') -----
> primitiveDirectoryLookup
>
> + | index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag symlinkFlag posixPermissions fileSize okToList |
> - | index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag fileSize okToList |
> <var: 'entryName' declareC: 'char entryName[256]'>
> <var: 'pathNameIndex' type: 'char *'>
> <var: 'fileSize' type: 'squeakFileOffsetType'>
> <export: true>
>
> index := interpreterProxy stackIntegerValue: 0.
> pathName := interpreterProxy stackValue: 1.
> (interpreterProxy isBytes: pathName)
> ifFalse: [^interpreterProxy primitiveFail].
> pathNameIndex := interpreterProxy firstIndexableField: pathName.
> pathNameSize := interpreterProxy byteSizeOf: pathName.
> "If the security plugin can be loaded, use it to check for permission.
> If not, assume it's ok"
> sCLPfn ~= 0
> ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)']
> ifFalse: [okToList := true].
> okToList
> + ifTrue: [status := self cCode: 'dir_Lookup(
> + pathNameIndex,
> + pathNameSize,
> + index,
> + entryName,
> + &entryNameSize,
> + &createDate,
> + &modifiedDate,
> + &dirFlag,
> + &fileSize,
> + &posixPermissions,
> + &symlinkFlag)']
> - ifTrue: [status := self cCode: 'dir_Lookup(pathNameIndex, pathNameSize, index,
> - entryName, &entryNameSize, &createDate,
> - &modifiedDate, &dirFlag, &fileSize)']
> ifFalse: [status := DirNoMoreEntries].
> interpreterProxy failed
> ifTrue: [^nil].
> status = DirNoMoreEntries
> ifTrue: ["no more entries; return nil"
> interpreterProxy pop: 3 "pop pathName, index, rcvr"
> thenPush: interpreterProxy nilObject.
> ^nil].
> status = DirBadPath
> ifTrue: [^interpreterProxy primitiveFail]."bad path"
>
> interpreterProxy pop: 3 "pop pathName, index, rcvr"
> thenPush: (self
> makeDirEntryName: entryName
> size: entryNameSize
> createDate: createDate
> modDate: modifiedDate
> isDir: dirFlag
> + fileSize: fileSize
> + posixPermissions: posixPermissions
> + isSymlink: symlinkFlag)!
> - fileSize: fileSize)!
>
> Item was removed:
> - ----- Method: FilePluginSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'simulation') -----
> - makeDirEntryName: entryName size: entryNameSize
> - createDate: createDate modDate: modifiedDate
> - isDir: dirFlag fileSize: fileSize
> -
> - ^interpreterProxy
> - makeDirEntryName: entryName size: entryNameSize
> - createDate: createDate modDate: modifiedDate
> - isDir: dirFlag fileSize: fileSize
> - !
>
> Item was added:
> + ----- Method: FilePluginSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'file primitives') -----
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: fileSize
> + posixPermissions: posixPermissions
> + isSymlink: symlinkFlag
> +
> + ^interpreterProxy
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: fileSize
> + posixPermissions: posixPermissions
> + isSymlink: symlinkFlag
> + !
>
> Item was changed:
> ----- Method: Integer>>asUnsignedInteger (in category '*VMMaker-interpreter simulator') -----
> asUnsignedInteger
> self assert: self >= 0.
> ^self!
>
> Item was changed:
> ----- Method: Interpreter class>>requiredMethodNames: (in category 'translation') -----
> requiredMethodNames: options
> "return the list of method names that should be retained for export or other support reasons"
> | requiredList |
> requiredList := Set new: 400.
> "A number of methods required by VM support code, jitter, specific platforms etc"
> requiredList addAll: #(fullDisplayUpdate interpret printCallStack printAllStacks printOop: readImageFromFile:HeapSize:StartingAt: success: readableFormat: getCurrentBytecode characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: loadInitialContext nullCompilerHook primitiveFlushExternalPrimitives setCompilerInitialized: getFullScreenFlag getInterruptCheckCounter getInterruptKeycode getInterruptPending getNextWakeupTick getSavedWindowSize setFullScreenFlag: setInterruptCheckCounter: setInterruptKeycode: setInterruptPending: setNextWakeupTick: setSavedWindowSize: forceInterruptCheck getThisSessionID).
>
> "Nice to actually have all the primitives available"
> requiredList addAll: self primitiveTable.
>
> "InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
> InterpreterProxy organization categories do: [:cat |
> + ((cat ~= 'initialize')
> + and: [ cat ~= 'private' ]
> + and: [ cat ~= '-- all --' ]) ifTrue: [
> - ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [
> requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
>
> ^requiredList!
>
> Item was changed:
> ----- Method: Interpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
> readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
> "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
> "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
> "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
>
> | swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
> <var: #f type: 'sqImageFile '>
> <var: #desiredHeapSize type: 'usqInt'>
> <var: #headerStart type: 'squeakFileOffsetType '>
> <var: #dataSize type: 'size_t '>
> <var: #imageOffset type: 'squeakFileOffsetType '>
>
> metaclassSizeBits := 6 * self wordSize. "guess (Metaclass instSize * BPW)"
> swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
> headerStart := (self sqImageFilePosition: f) - self wordSize. "record header start position"
>
> headerSize := self getLongFromFile: f swap: swapBytes.
> dataSize := self getLongFromFile: f swap: swapBytes.
> oldBaseAddr := self getLongFromFile: f swap: swapBytes.
> specialObjectsOop := self getLongFromFile: f swap: swapBytes.
> lastHash := self getLongFromFile: f swap: swapBytes.
> savedWindowSize := self getLongFromFile: f swap: swapBytes.
> fullScreenFlag := self getLongFromFile: f swap: swapBytes.
> extraVMMemory := self getLongFromFile: f swap: swapBytes.
>
> lastHash = 0 ifTrue: [
> "lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
> lastHash := 999].
>
> "decrease Squeak object heap to leave extra memory for the VM"
> heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
>
> "compare memory requirements with availability".
> minimumMemory := dataSize + 100000. "need at least 100K of breathing room"
> heapSize < minimumMemory ifTrue: [
> self insufficientMemorySpecifiedError].
>
> "allocate a contiguous block of memory for the Squeak heap"
> memory := self cCode: 'sqAllocateMemory(minimumMemory, heapSize)'.
> memory = nil ifTrue: [self insufficientMemoryAvailableError].
>
> memStart := self startOfMemory.
> self setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
> self setEndOfMemory: memStart + dataSize.
>
> "position file after the header"
> self sqImageFile: f Seek: headerStart + headerSize.
>
> "read in the image in bulk, then swap the bytes if necessary"
> + bytesRead := self cCode: 'sqImageFileReadEntireImage(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
> - bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
> bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
>
> swapBytes ifTrue: [self reverseBytesInImage].
>
> "compute difference between old and new memory base addresses"
> bytesToShift := memStart - oldBaseAddr.
> self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
> ^ dataSize
> !
>
> Item was changed:
> ----- Method: InterpreterPlugin class>>shouldBeTranslated (in category 'translation') -----
> shouldBeTranslated
> "is this class intended to be translated as a plugin? Most subclasses should answer true, but some such as:-
> TestInterpreterPlugin
> FlippArrayPlugin2
> InflatePlugin
> should answer false for various reasons."
> ^true!
>
> Item was changed:
> ----- Method: InterpreterPlugin class>>shouldBeTranslatedFor: (in category 'translation') -----
> shouldBeTranslatedFor: platformName
> "Is this class intended to be translated as a plugin, perhaps specific to a platform?
> Most subclasses should answer true, but some such as simulation-only versions
> should answer false for various reasons."
> ^self shouldBeTranslated!
>
> Item was changed:
> ----- Method: InterpreterPlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
> translateInDirectory: directory doInlining: inlineFlag
> "This is the default method for writing out sources for a plugin. Several classes need special handling, so look at all implementors of this message"
> | cg fname fstat |
> fname := self moduleName, '.c'.
>
> "don't translate if the file is newer than my timeStamp"
> fstat := directory entryAt: fname ifAbsent:[nil].
> fstat ifNotNil:
> [((self pluginClassesUpTo: self) allSatisfy:
> + [:aPluginClass| aPluginClass timeStamp < fstat modificationTime asSeconds ]) ifTrue:
> - [:aPluginClass| aPluginClass timeStamp < fstat modificationTime]) ifTrue:
> [^nil]].
>
> self initialize.
> cg := self buildCodeGeneratorUpTo: self.
> cg inferTypesForImplicitlyTypedVariablesAndMethods.
> self pruneUnusedInterpreterPluginMethodsIn: cg.
> cg storeCodeOnFile: (directory fullNameFor: fname) doInlining: inlineFlag.
> ^cg exportedPrimitiveNames asArray!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveGetNextEvent (in category 'I/O primitives') -----
> primitiveGetNextEvent
> "Primitive. Return the next input event from the VM event queue."
> + | evtBuf arg value eventTypeIs |
> - | evtBuf arg value |
> <var: #evtBuf declareC:'int evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'>
> self cCode:'' inSmalltalk:[evtBuf := CArrayAccessor on: (IntegerArray new: 8)].
> arg := self stackTop.
> ((objectMemory isArray: arg) and:[(objectMemory slotSizeOf: arg) = 8]) ifFalse:[^self primitiveFail].
>
> self ioGetNextEvent: (self cCoerce: evtBuf to: 'sqInputEvent*').
> self successful ifFalse:[^nil].
>
> "Event type"
> + eventTypeIs := evtBuf at: 0.
> self storeInteger: 0 ofObject: arg withValue: (evtBuf at: 0).
> self successful ifFalse:[^nil].
>
> + "Event is Complex, assume evtBuf is populated correctly and return"
> + eventTypeIs = 6
> + ifTrue: [
> + 1 to: 7 do: [:i |
> + value := evtBuf at: i.
> + self storePointer: i ofObject: arg withValue: value]]
> + ifFalse: [
> + "Event time stamp"
> + self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
> + self successful ifFalse:[^nil].
> - "Event time stamp"
> - self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
> - self successful ifFalse:[^nil].
>
> + "Event arguments"
> + 2 to: 7 do:[:i|
> + value := evtBuf at: i.
> + (objectMemory isIntegerValue: value)
> + ifTrue:[self storeInteger: i ofObject: arg withValue: value]
> + ifFalse:[
> + value := self positive32BitIntegerFor: value.
> + objectMemory storePointer: i ofObject: arg withValue: value] ] ].
> - "Event arguments"
> - 2 to: 7 do:[:i|
> - value := evtBuf at: i.
> - (objectMemory isIntegerValue: value)
> - ifTrue:[self storeInteger: i ofObject: arg withValue: value]
> - ifFalse:[value := self positive32BitIntegerFor: value.
> - objectMemory storePointer: i ofObject: arg withValue: value]].
>
> self successful ifFalse:[^nil].
> self pop: 1!
>
> Item was added:
> + ----- Method: InterpreterPrimitives>>primitiveImageFormatVersion (in category 'other primitives') -----
> + primitiveImageFormatVersion
> + "Answer an integer identifying the type of image. The image version number may
> + identify the format of the image (e.g. 32 or 64-bit word size) or specific requirements
> + of the image (e.g. block closure support required).
> +
> + This is a named (not numbered) primitive in the null module (ie the VM)"
> +
> + <export: true>
> + self pop: 1 thenPush: (self positive32BitIntegerFor: self imageFormatVersion)
> + !
>
> Item was changed:
> ----- Method: InterpreterProxy>>callbackLeave: (in category 'callback support') -----
> callbackLeave: cbID
> "Leave from a previous callback"
> + "<var: #callbackID type: #'sqInt *'>"
> - <var: #callbackID type: #'sqInt *'>
> ^self notYetImplementedError!
>
> Item was changed:
> ----- Method: InterpreterProxy>>isImmediate: (in category 'testing') -----
> isImmediate: anObject
> <option: #(atLeastVMProxyMajor:minor: 1 13)>
> ^StackInterpreter objectMemoryClass isImmediate: anObject!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
> initialize
> "Initialize the InterpreterSimulator when running the interpreter inside
> Smalltalk. The primary responsibility of this method is to allocate
> Smalltalk Arrays for variables that will be declared as statically-allocated
> global arrays in the translated code."
>
> "Note: we must initialize ConstMinusOne differently for simulation,
> due to the fact that the simulator works only with +ve 32-bit values"
> ConstMinusOne := self integerObjectOf: -1.
>
> methodCache := Array new: MethodCacheSize.
> atCache := Array new: AtCacheTotalSize.
> self flushMethodCache.
> rootTable := Array new: RootTableSize.
> weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
> remapBuffer := Array new: RemapBufferSize.
> gcSemaphoreIndex := 0.
> semaphoresUseBufferA := true.
> semaphoresToSignalA := Array new: SemaphoresToSignalSize.
> semaphoresToSignalB := Array new: SemaphoresToSignalSize.
> externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
> primitiveTable := self class primitiveTable.
> pluginList := {'' -> self }.
> mappedPluginEntries := #().
>
> "initialize InterpreterSimulator variables used for debugging"
> byteCount := 0.
> sendCount := 0.
> quitBlock := [^ self].
> traceOn := true.
> printSends := "printReturns := printBytecodeAtEachStep :=" false.
> myBitBlt := BitBltSimulator new setInterpreter: self.
> headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes.
> transcript := Transcript.
> + displayForm := 'Display has not yet been installed' asMorph imageForm.
> - displayForm := 'Display has not yet been installed' asDisplayText form.
> !
>
> Item was removed:
> - ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
> - makeDirEntryName: entryName size: entryNameSize
> - createDate: createDate modDate: modifiedDate
> - isDir: dirFlag fileSize: fileSize
> -
> - | modDateOop createDateOop nameString results |
> - <var: 'entryName' type: 'char *'>
> -
> - "allocate storage for results, remapping newly allocated
> - oops in case GC happens during allocation"
> - self pushRemappableOop:
> - (self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
> - self pushRemappableOop:
> - (self instantiateClass: (self splObj: ClassByteString) indexableSize: entryNameSize).
> - self pushRemappableOop: (self positive32BitIntegerFor: createDate).
> - self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
> -
> - modDateOop := self popRemappableOop.
> - createDateOop := self popRemappableOop.
> - nameString := self popRemappableOop.
> - results := self popRemappableOop.
> -
> - 1 to: entryNameSize do: [ :i |
> - self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
> - ].
> -
> - self storePointer: 0 ofObject: results withValue: nameString.
> - self storePointer: 1 ofObject: results withValue: createDateOop.
> - self storePointer: 2 ofObject: results withValue: modDateOop.
> - dirFlag
> - ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
> - ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
> - self storePointer: 4 ofObject: results
> - withValue: (self integerObjectOf: fileSize).
> - ^ results
> - !
>
> Item was added:
> + ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: posixPermissions
> + posixPermissions: fileSize
> +
> + | modDateOop createDateOop nameString results |
> + <var: 'entryName' type: 'char *'>
> +
> + "allocate storage for results, remapping newly allocated
> + oops in case GC happens during allocation"
> + self pushRemappableOop:
> + (self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
> + self pushRemappableOop:
> + (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize)..
> + self pushRemappableOop: (self positive32BitIntegerFor: createDate).
> + self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
> +
> + modDateOop := self popRemappableOop.
> + createDateOop := self popRemappableOop.
> + nameString := self popRemappableOop.
> + results := self popRemappableOop.
> +
> + 1 to: entryNameSize do: [ :i |
> + self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
> + ].
> +
> + self storePointer: 0 ofObject: results withValue: nameString.
> + self storePointer: 1 ofObject: results withValue: createDateOop.
> + self storePointer: 2 ofObject: results withValue: modDateOop.
> + dirFlag
> + ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
> + ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
> + self storePointer: 4
> + ofObject: results
> + withValue: (self integerObjectOf: fileSize).
> + self storePointer: 5
> + ofObject: results
> + withValue: (self integerObjectOf: posixPermissions).
> +
> + ^ results
> + !
>
> Item was added:
> + ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: posixPermissions
> + posixPermissions: fileSize
> + isSymlink: symlinkFlag
> +
> + | modDateOop createDateOop nameString results |
> + <var: 'entryName' type: 'char *'>
> +
> + "allocate storage for results, remapping newly allocated
> + oops in case GC happens during allocation"
> + self pushRemappableOop:
> + (self instantiateClass: (self splObj: ClassArray) indexableSize: 6).
> + self pushRemappableOop:
> + (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize)..
> + self pushRemappableOop: (self positive32BitIntegerFor: createDate).
> + self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
> +
> + modDateOop := self popRemappableOop.
> + createDateOop := self popRemappableOop.
> + nameString := self popRemappableOop.
> + results := self popRemappableOop.
> +
> + 1 to: entryNameSize do: [ :i |
> + self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
> + ].
> +
> + self storePointer: 0 ofObject: results withValue: nameString.
> + self storePointer: 1 ofObject: results withValue: createDateOop.
> + self storePointer: 2 ofObject: results withValue: modDateOop.
> + dirFlag
> + ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
> + ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
> + self storePointer: 4
> + ofObject: results
> + withValue: (self integerObjectOf: fileSize).
> + self storePointer: 5
> + ofObject: results
> + withValue: (self integerObjectOf: posixPermissions).
> + dirFlag
> + ifTrue: [ self storePointer: 6 ofObject: results withValue: trueObj ]
> + ifFalse: [ self storePointer: 6 ofObject: results withValue: falseObj ].
> +
> + ^ results
> + !
>
> Item was changed:
> ----- Method: InterpreterSimulator>>openAsMorph (in category 'UI') -----
> openAsMorph
> "Open a morphic view on this simulation."
> | window localImageName |
> + localImageName := imageName asFileReference basename.
> - localImageName := imageName
> - ifNotNil: [FileDirectory default localNameFor: imageName]
> - ifNil: [' synthetic image'].
> window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
>
> window addMorph: (displayView := ImageMorph new image: displayForm)
> frame: (0@0 corner: 1(a)0.8).
>
> + transcript := ThreadSafeTranscript new.
> - transcript := TranscriptStream on: (String new: 10000).
> window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil
> readSelection: nil menu: #codePaneMenu:shifted:)
> frame: (0(a)0.8 corner: 0.7@1).
>
> window addMorph: (PluggableTextMorph on: self
> text: #byteCountText accept: nil) hideScrollBarsIndefinitely
> frame: (0.7(a)0.8 corner: 1@1).
>
> + window openInWorld!
> - window openInWorld.
> - ^window!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
> primitiveDirectoryEntry
> | name pathName array result |
> name := self stringOf: self stackTop.
> pathName := self stringOf: (self stackValue: 1).
>
> successFlag ifFalse:
> [^self primitiveFail].
>
> + array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
> - array := FileDirectory default primLookupEntryIn: pathName name: name.
> array == nil ifTrue:
> [self pop: 3 thenPush: nilObj.
> ^array].
> array == #badDirectoryPath ifTrue:
> [self halt.
> ^self primitiveFail].
>
> + result := self makeDirEntryName: (array at: 1)
> + size: (array at: 1) size
> + createDate: (array at: 2)
> + modDate: (array at: 3)
> + isDir: (array at: 4)
> + fileSize: (array at: 5)
> + posixPermissions: (array at: 6)
> + isSymlink: (array at: 7).
> - result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> - createDate: (array at: 2) modDate: (array at: 3)
> - isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3.
> self push: result!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
> primitiveDirectoryLookup
> | index pathName array result |
> index := self stackIntegerValue: 0.
> pathName := (self stringOf: (self stackValue: 1)).
>
> successFlag ifFalse: [
> ^self primitiveFail.
> ].
>
> + array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
> - array := FileDirectory default primLookupEntryIn: pathName index: index.
>
> array == nil ifTrue: [
> self pop: 3.
> self push: nilObj.
> ^array.
> ].
> array == #badDirectoryPath ifTrue: [self halt.
> ^self primitiveFail.
> ].
>
> + result := self makeDirEntryName: (array at: 1)
> + size: (array at: 1) size
> + createDate: (array at: 2)
> + modDate: (array at: 3)
> + isDir: (array at: 4)
> + fileSize: (array at: 5)
> + posixPermissions: (array at: 6)
> + isSymlink: (array at: 7).
> - result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> - createDate: (array at: 2) modDate: (array at: 3)
> - isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3.
> self push: result.
> !
>
> Item was changed:
> InterpreterPlugin subclass: #MiscPrimitivePlugin
> instanceVariableNames: ''
> classVariableNames: ''
> poolDictionaries: ''
> category: 'VMMaker-Plugins'!
>
> + !MiscPrimitivePlugin commentStamp: 'dtl 12/2/2009 11:28' prior: 0!
> + This plugin pulls together a number of translatable methods with no particularly meaningful home. See class>translatedPrimitives for the list.
> +
> + The primitives in this plugin consist of various methods in the image that can benefit greatly from translation to C, but that do not inherently require translation. These may be thought of not as traditional primitives, but as methods that have been annotated for translation to C by this plugin. This approach allows performance critical methods to be written entirely in Smalltalk, then marked for translation as needed to achieve improved performance.!
> - !MiscPrimitivePlugin commentStamp: 'tpr 5/5/2003 12:18' prior: 0!
> - This plugin pulls together a number of translatable methods with no particularly meaningful home. See class>translatedPrimitives for the list!
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
> translateInDirectory: directory doInlining: inlineFlag
> "handle a special case code string rather than normal generated code."
> | cg fname fstat |
> fname := self moduleName, '.c'.
>
> "don't translate if the file is newer than my timeStamp"
> fstat := directory entryAt: fname ifAbsent:[nil].
> + fstat ifNotNil:[self timeStamp < fstat modificationTime asSeconds ifTrue:[^nil]].
> - fstat ifNotNil:[self timeStamp < fstat modificationTime ifTrue:[^nil]].
>
> self initialize.
> cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
> cg addMethodsForPrimitives: self translatedPrimitives.
> self pruneUnusedInterpreterPluginMethodsIn: cg.
> self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: fname).
> ^cg exportedPrimitiveNames asArray
> !
>
> Item was changed:
> ----- Method: MiscPrimitivePlugin class>>translatedPrimitives (in category 'translation') -----
> translatedPrimitives
> "an assorted list of various primitives"
> ^#(
> (Bitmap compress:toByteArray:)
> (Bitmap decompress:fromByteArray:at:)
> (Bitmap encodeBytesOf:in:at:)
> (Bitmap encodeInt:in:at:)
> (ByteString compare:with:collated:)
> (ByteString translate:from:to:table:)
> (ByteString findFirstInString:inSet:startingAt:)
> (ByteString indexOfAscii:inString:startingAt:)
> + (String findSubstringViaPrimitive:in:startingAt:matchTable:)
> - (ByteString findSubstring:in:startingAt:matchTable:)
> (ByteArray hashBytes:startingWith:)
> (SampledSound convert8bitSignedFrom:to16Bit:)
> )
>
> "| tps |
> 'This opens a list browser on all translated primitives in the image'.
> tps := (SystemNavigation default allImplementorsOf: #translatedPrimitives)
> inject: Set new
> into: [:tp :mr|
> tp addAll: (mr actualClass theNonMetaClass translatedPrimitives collect:
> [:pair|
> MethodReference
> class: (((Smalltalk at: pair first) canUnderstand: pair last)
> ifTrue: [Smalltalk at: pair first]
> ifFalse: [(Smalltalk at: pair first) class])
> selector: pair last]);
> yourself].
> SystemNavigation default browseMessageList: tps asArray sort name: 'Translated Primitives' "!
>
> Item was changed:
> ----- Method: NewspeakInterpreter class>>requiredMethodNames: (in category 'translation') -----
> requiredMethodNames: options
> "return the list of method names that should be retained for export or other support reasons"
> | requiredList |
> requiredList := self exportAPISelectors: options.
> "A number of methods required by VM support code, jitter, specific platforms etc"
> requiredList addAll: #(fullDisplayUpdate interpret printCallStack printAllStacks printOop: readImageFromFile:HeapSize:StartingAt: success: readableFormat: getCurrentBytecode characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: loadInitialContext primitiveFlushExternalPrimitives getFullScreenFlag getInterruptCheckCounter getInterruptKeycode getInterruptPending getNextWakeupTick getSavedWindowSize setFullScreenFlag: setInterruptCheckCounter: setInterruptKeycode: setInterruptPending: setNextWakeupTick: setSavedWindowSize: forceInterruptCheck getThisSessionID getDeferDisplayUpdates validInstructionPointer:inMethod:).
>
> "Nice to actually have all the primitives available"
> requiredList addAll: self primitiveTable.
>
> "InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
> InterpreterProxy organization categories do: [:cat |
> + ((cat ~= 'initialize')
> + and: [ cat ~= 'private' ]
> + and: [ cat ~= '-- all --' ]) ifTrue: [
> - ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [
> requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
>
> ^requiredList!
>
> Item was added:
> + ----- Method: NewspeakInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: posixPermissions
> + posixPermissions: fileSize
> +
> + | modDateOop createDateOop nameString results |
> + <var: 'entryName' type: 'char *'>
> +
> + "allocate storage for results, remapping newly allocated
> + oops in case GC happens during allocation"
> + self pushRemappableOop:
> + (self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
> + self pushRemappableOop:
> + (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize).
> + self pushRemappableOop: (self positive32BitIntegerFor: createDate).
> + self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
> +
> + modDateOop := self popRemappableOop.
> + createDateOop := self popRemappableOop.
> + nameString := self popRemappableOop.
> + results := self popRemappableOop.
> +
> + 1 to: entryNameSize do: [ :i |
> + self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
> + ].
> +
> + self storePointer: 0 ofObject: results withValue: nameString.
> + self storePointer: 1 ofObject: results withValue: createDateOop.
> + self storePointer: 2 ofObject: results withValue: modDateOop.
> + dirFlag
> + ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
> + ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
> + self storePointer: 4 ofObject: results
> + withValue: (self integerObjectOf: fileSize).
> + self storePointer: 5 ofObject: results
> + withValue: (self integerObjectOf: posixPermissions).
> + ^ results
> + !
>
> Item was added:
> + ----- Method: NewspeakInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: posixPermissions
> + posixPermissions: fileSize
> + isSymlink: symlinkFlag
> +
> + | modDateOop createDateOop nameString results |
> + <var: 'entryName' type: 'char *'>
> +
> + "allocate storage for results, remapping newly allocated
> + oops in case GC happens during allocation"
> + self pushRemappableOop:
> + (self instantiateClass: (self splObj: ClassArray) indexableSize: 6).
> + self pushRemappableOop:
> + (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize).
> + self pushRemappableOop: (self positive32BitIntegerFor: createDate).
> + self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
> +
> + modDateOop := self popRemappableOop.
> + createDateOop := self popRemappableOop.
> + nameString := self popRemappableOop.
> + results := self popRemappableOop.
> +
> + 1 to: entryNameSize do: [ :i |
> + self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
> + ].
> +
> + self storePointer: 0 ofObject: results withValue: nameString.
> + self storePointer: 1 ofObject: results withValue: createDateOop.
> + self storePointer: 2 ofObject: results withValue: modDateOop.
> + dirFlag
> + ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
> + ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
> + self storePointer: 4 ofObject: results
> + withValue: (self integerObjectOf: fileSize).
> + self storePointer: 5 ofObject: results
> + withValue: (self integerObjectOf: posixPermissions).
> + symlinkFlag
> + ifTrue: [ self storePointer: 6 ofObject: results withValue: trueObj ]
> + ifFalse: [ self storePointer: 6 ofObject: results withValue: falseObj ].
> +
> + ^ results
> + !
>
> Item was changed:
> ----- Method: NewspeakInterpreterSimulator>>openAsMorph (in category 'UI') -----
> openAsMorph
> "Open a morphic view on this simulation."
> | window localImageName |
> + localImageName := imageName asFileReference basename.
> - localImageName := imageName
> - ifNotNil: [FileDirectory default localNameFor: imageName]
> - ifNil: [' synthetic image'].
> window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
>
> window addMorph: (displayView := ImageMorph new image: displayForm)
> frame: (0@0 corner: 1(a)0.8).
>
> + transcript := ThreadSafeTranscript new.
> - transcript := TranscriptStream on: (String new: 10000).
> window addMorph: (PluggableTextMorph
> on: transcript text: nil accept: nil
> readSelection: nil menu: #codePaneMenu:shifted:)
> frame: (0(a)0.8 corner: 0.7@1).
>
> window addMorph: (PluggableTextMorph on: self
> text: #byteCountText accept: nil
> readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
> frame: (0.7(a)0.8 corner: 1@1).
>
> window openInWorldExtent: (self desiredDisplayExtent
> + (2 * window borderWidth)
> + (0@window labelHeight)
> + * (1(a)(1/0.8))) rounded!
> - * (1(a)(1/0.8))) rounded.
> - ^window!
>
> Item was changed:
> ----- Method: NewspeakInterpreterSimulator>>openAsMorphNoTranscript (in category 'UI') -----
> openAsMorphNoTranscript
> "Open a morphic view on this simulation."
> | window localImageName |
> + localImageName := imageName asFileReference basename.
> - localImageName := FileDirectory default localNameFor: imageName.
> window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
>
> window addMorph: (displayView := ImageMorph new image: displayForm)
> frame: (0@0 corner: 1(a)0.95).
>
> window addMorph: (PluggableTextMorph on: self
> text: #byteCountText accept: nil) hideScrollBarsIndefinitely
> frame: (0(a)0.95 corner: 1@1).
>
> window openInWorldExtent: (self desiredDisplayExtent
> + (2 * window borderWidth)
> + (0@window labelHeight)
> * (1(a)(1/0.95))) rounded!
>
> Item was changed:
> ----- Method: NewspeakInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
> primitiveDirectoryEntry
> | name pathName array result |
> name := self stringOf: self stackTop.
> pathName := self stringOf: (self stackValue: 1).
>
> self successful ifFalse:
> [^self primitiveFail].
>
> + array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
> - array := FileDirectory default primLookupEntryIn: pathName name: name.
> array == nil ifTrue:
> [self pop: 3 thenPush: nilObj.
> ^array].
> array == #badDirectoryPath ifTrue:
> [self halt.
> ^self primitiveFail].
>
> + result := self makeDirEntryName: (array at: 1)
> + size: (array at: 1) size
> + createDate: (array at: 2)
> + modDate: (array at: 3)
> + isDir: (array at: 4)
> + fileSize: (array at: 5)
> + posixPermissions: (array at: 6)
> + isSymlink: (array at: 7).
> - result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> - createDate: (array at: 2) modDate: (array at: 3)
> - isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3.
> self push: result!
>
> Item was changed:
> ----- Method: NewspeakInterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
> primitiveDirectoryLookup
> | index pathName array result |
> index := self stackIntegerValue: 0.
> pathName := (self stringOf: (self stackValue: 1)).
>
> self successful ifFalse: [
> ^self primitiveFail.
> ].
>
> + array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
> - array := FileDirectory default primLookupEntryIn: pathName index: index.
>
> array == nil ifTrue: [
> self pop: 3.
> self push: nilObj.
> ^array.
> ].
> array == #badDirectoryPath ifTrue: [self halt.
> ^self primitiveFail.
> ].
>
> + result := self makeDirEntryName: (array at: 1)
> + size: (array at: 1) size
> + createDate: (array at: 2)
> + modDate: (array at: 3)
> + isDir: (array at: 4)
> + fileSize: (array at: 5)
> + posixPermissions: (array at: 6)
> + isSymlink: (array at: 7).
> - result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> - createDate: (array at: 2) modDate: (array at: 3)
> - isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3.
> self push: result.
> !
>
> Item was changed:
> ----- Method: ObjectMemory class>>initializeObjectHeaderConstants (in category 'initialization') -----
> initializeObjectHeaderConstants
>
> BytesPerWord ifNil: [BytesPerWord := 4]. "May get called on fileIn, so supply default"
> BaseHeaderSize := BytesPerWord.
> + BytesPerOop := BytesPerWord.
> WordMask := (1 bitShift: BytesPerWord*8) - 1.
>
> "masks for type field"
> TypeMask := 3.
> AllButTypeMask := WordMask - TypeMask.
>
> "type field values"
> HeaderTypeSizeAndClass := 0.
> HeaderTypeClass := 1.
> HeaderTypeFree := 2.
> HeaderTypeShort := 3.
> HeaderTypeExtraBytes := { BytesPerWord * 2. BytesPerWord. 0. 0 }.
>
> "type field values used during the mark phase of GC"
> HeaderTypeGC := 2.
> GCTopMarker := 3. "neither an oop, nor an oop+1, this value signals that we have crawled back up to the top of the marking phase."
>
> "Base header word bit fields"
> HashBits := 16r1FFE0000.
> HashBitsOffset := 17.
> HashMaskUnshifted := 16rFFF.
> self assert: (HashMaskUnshifted bitShift: HashBitsOffset) = HashBits.
> AllButHashBits := WordMask - HashBits.
> SizeMask := 16rFC.
> Size4Bit := 0.
> BytesPerWord = 8 ifTrue:
> [SizeMask := 16rF8. "Lose the 4 bit in temp 64-bit chunk format"
> Size4Bit := 4]. "But need it for ST size"
> "Note SizeMask + Size4Bit gives the mask needed for size fits of format word in classes.
> This is used in instantiateClass:indexableSize: "
> LongSizeMask := WordMask - 16rFF + SizeMask.
> LongSizeNumBits := 30. "30 bits of size info in long size filed."
> CompactClassMask := 16r1F000.
>
> "masks for root and mark bits"
> MarkBit := 1 bitShift: BytesPerWord*8 - 1. "Top bit"
> RootBit := 1 bitShift: BytesPerWord*8 - 2. "Next-to-Top bit"
> AllButMarkBit := WordMask - MarkBit.
> AllButRootBit := WordMask - RootBit.
>
> AllButMarkBitAndTypeMask := AllButTypeMask - MarkBit.
>
> ImmutabilityBit := 1 bitShift: BytesPerWord*8 - 3. "Next-to-Next-To-Top bit"
> AllButImmutabilityBit := WordMask - ImmutabilityBit!
>
> Item was added:
> + ----- Method: ObjectMemory class>>memoryManagerVersion (in category 'accessing') -----
> + memoryManagerVersion
> + ^ 'Blue Book'!
>
> Item was changed:
> ----- Method: ObjectMemory>>finalizeReference: (in category 'finalization') -----
> finalizeReference: oop
> "During sweep phase we have encountered a weak reference. Check if its object
> has gone away (or is about to) and if so, signal a semaphore. Do *not* inline
> this in sweepPhase - it is quite an unlikely case to run into a weak reference"
> | weakOop oopGone chunk numFields firstField lastField |
> <inline: false>
> <var: #oop type: #usqInt>
> <var: #weakOop type: #usqInt>
> numFields := self nonWeakFieldsOf: oop. "so nonWeakFieldsOf: may be inlined"
> firstField := self baseHeaderSize + (numFields << self shiftForWord).
> lastField := self lastPointerOf: oop.
> firstField to: lastField by: self wordSize do:
> [:i|
> weakOop := self longAt: oop + i.
> "ar 1/18/2005: Added oop < youngStart test to make sure we're not testing
> objects in non-GCable region. This could lead to a forward reference in
> old space with the oop pointed to not being marked and thus treated as free."
> (weakOop = nilObj or: [(self isIntegerObject: weakOop) or:[weakOop < youngStart]]) ifFalse:
> ["Check if the object is being collected.
> If the weak reference points
> * backward: check if the weakOops chunk is free
> * forward: check if the weakOoop has been marked by GC"
> weakOop < oop
> ifTrue: [chunk := self chunkFromOop: weakOop.
> oopGone := ((self longAt: chunk) bitAnd: TypeMask) = HeaderTypeFree]
> ifFalse: [oopGone := (self isMarked: weakOop) not].
> oopGone ifTrue: "Store nil in the pointer and signal the interpreter"
> [self longAt: oop + i put: nilObj.
> + numFields >= 2 ifTrue: [ self weakFinalizerCheck: oop ].
> self signalFinalization: oop]]]!
>
> Item was added:
> + ----- Method: ObjectMemory>>getHeapGrowthToSizeGCRatio (in category 'accessing') -----
> + getHeapGrowthToSizeGCRatio
> + "For compatibility with spur object memory"
> + <returnTypeC: #float>
> + ^ 0!
>
> Item was added:
> + ----- Method: ObjectMemory>>isInFinalizationList:head: (in category 'finalization') -----
> + isInFinalizationList: oop head: listHead
> + "it is known that oop's first fixed slot points to an instance of special object - ClassWeakFinalizer ,
> + so it is safe to assume that we can iterate over it to figure out if oop is already in that list"
> + | listItem |
> +
> + listItem := listHead.
> +
> + [ listItem == self nilObject ] whileFalse: [
> + listItem == oop ifTrue: [ ^ true ].
> + listItem := self fetchPointer: 1 ofObject: listItem.
> + ].
> + ^ false
> + !
>
> Item was changed:
> ----- Method: ObjectMemory>>readHeapFromImageFile:dataBytes: (in category 'image save/restore') -----
> readHeapFromImageFile: f dataBytes: numBytes
> "Read numBytes of image data from f into memory at memoryBaseForImageRead.
> Answer the number of bytes written."
> <var: #f type: #sqImageFile>
> ^self cCode:
> [self
> sq: (self pointerForOop: self memoryBaseForImageRead)
> Image: (self sizeof: #char)
> File: numBytes
> + ReadEntireImage: f]
> - Read: f]
> inSmalltalk:
> [(f readInto: memory
> startingAt: self memoryBaseForImageRead // 4 + 1
> count: numBytes // 4)
> * 4]!
>
> Item was added:
> + ----- Method: ObjectMemory>>setHeapGrowthToSizeGCRatio: (in category 'accessing') -----
> + setHeapGrowthToSizeGCRatio: aDouble
> + "For compatibility with spur object memory"
> + <var: #aDouble type: #double>
> + !
>
> Item was removed:
> - ----- Method: RelativeDetailedInstructionPrinter class>>on: (in category 'instance creation') -----
> - on: method
> - "Answer an instance of me on the argument, method."
> -
> - ^self new method: method pc: method initialPC!
>
> Item was added:
> + ----- Method: SerialPlugin>>primitiveSerialPortOpenByName:baudRate:stopBitsType:parityType:dataBits:inFlowControlType:outFlowControlType:xOnByte:xOffByte: (in category 'primitives') -----
> + primitiveSerialPortOpenByName: portName baudRate: baudRate stopBitsType: stopBitsType parityType: parityType dataBits: dataBits inFlowControlType: inFlowControl outFlowControlType: outFlowControl xOnByte: xOnChar xOffByte: xOffChar
> + <var: #port type: 'char *'>
> +
> + | port portNameSize |
> +
> + self primitive: 'primitiveSerialPortOpenByName'
> + parameters: #(String SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger ).
> +
> + portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
> + port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
> + self cCode: 'memcpy(port, portName, portNameSize)'.
> +
> + self cCode: 'serialPortOpenByName(
> + port, baudRate, stopBitsType, parityType, dataBits,
> + inFlowControl, outFlowControl, xOnChar, xOffChar)'.
> +
> + self free: port.!
>
> Item was added:
> + ----- Method: SerialPlugin>>primitiveSerialPortReadByName:into:startingAt:count: (in category 'primitives') -----
> + primitiveSerialPortReadByName: portName into: array startingAt: startIndex count: count
> + <var: #port type: 'char *'>
> +
> + | port portNameSize bytesRead arrayPtr |
> +
> + self primitive: 'primitiveSerialPortReadByName'
> + parameters: #(String ByteArray SmallInteger SmallInteger ).
> +
> + interpreterProxy success: (startIndex >= 1 and: [startIndex + count - 1 <= (interpreterProxy byteSizeOf: array cPtrAsOop)]).
> + "adjust for zero-origin indexing"
> +
> + portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
> + port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
> + self cCode: 'memcpy(port, portName, portNameSize)'.
> +
> + arrayPtr := array asInteger + startIndex - 1.
> + bytesRead := self cCode: 'serialPortReadIntoByName( port, count, arrayPtr)'.
> +
> + self free: port.
> +
> + ^ bytesRead asSmallIntegerObj!
>
> Item was added:
> + ----- Method: SerialPlugin>>primitiveSerialPortWriteByName:from:startingAt:count: (in category 'primitives') -----
> + primitiveSerialPortWriteByName: portName from: array startingAt: startIndex count: count
> + <var: #port type: 'char *'>
> +
> + | bytesWritten arrayPtr portNameSize port |
> +
> + self primitive: 'primitiveSerialPortWriteByName'
> + parameters: #(String ByteArray SmallInteger SmallInteger ).
> +
> + portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
> + port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
> + self cCode: 'memcpy(port, portName, portNameSize)'.
> +
> + interpreterProxy success: (startIndex >= 1 and: [startIndex + count - 1 <= (interpreterProxy byteSizeOf: array cPtrAsOop)]).
> + interpreterProxy failed
> + ifFalse: [arrayPtr := array asInteger + startIndex - 1.
> + bytesWritten := self cCode: 'serialPortWriteFromByName(port, count, arrayPtr)' ].
> +
> + self free: port.
> +
> + ^ bytesWritten asSmallIntegerObj!
>
> Item was changed:
> ----- Method: SimpleStackBasedCogit>>genPushEnclosingObjectAt: (in category 'bytecode generators') -----
> genPushEnclosingObjectAt: level
> "Uncached push enclosing object"
> self MoveCq: level R: SendNumArgsReg.
> self CallRT: ceEnclosingObjectTrampoline.
> self PushR: ReceiverResultReg.
> ^0!
>
> Item was changed:
> ----- Method: SocketPlugin>>primitiveSocketCreateRaw:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
> primitiveSocketCreateRaw: netType type: protoType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
> + "New IPV6 implementation removes this... and nobody is using (and it wont compile)"
> + <doNotGenerate>
> | socketOop s okToCreate |
> <var: #s type: 'SocketPtr '>
> self primitive: 'primitiveSocketCreateRAW' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ).
> "If the security plugin can be loaded, use it to check for permission.
> If not, assume it's ok"
> sCCSOTfn ~= 0
> ifTrue: [okToCreate := self cCode: ' ((int (*) (int, int)) sCCSOTfn)(netType, protoType)'.
> okToCreate
> ifFalse: [^ interpreterProxy primitiveFail]].
> socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize.
> s := self socketValueOf: socketOop.
> self
> sqSocket: s
> CreateRaw: netType
> ProtoType: protoType
> RecvBytes: recvBufSize
> SendBytes: sendBufSize
> SemaID: semaIndex
> ReadSemaID: aReadSema
> WriteSemaID: aWriteSema.
> ^ socketOop!
>
> Item was removed:
> - ----- Method: Spur32BitCoMemoryManager class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
> - objectRepresentationClass
> - ^CogObjectRepresentationFor32BitSpur!
>
> Item was changed:
> ----- Method: Spur32BitCoMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
> assimilateNewSegment: segInfo
> "Update after adding a segment.
> Here we make sure the new segment is not executable."
> <var: #segInfo type: #'SpurSegmentInfo *'>
> super assimilateNewSegment: segInfo.
> + self
> + cppIf: #SPUR_USE_EXECUTABLE_MEMORY
> + ifTrue: [ coInterpreter sqMakeMemoryExecutableFrom: segInfo segStart To: segInfo segLimit ]
> + ifFalse: [ coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segLimit ]
> + !
> - coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segLimit!
>
> Item was added:
> + ----- Method: Spur32BitMemoryManager class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
> + objectRepresentationClass
> + ^CogObjectRepresentationFor32BitSpur!
>
> Item was added:
> + ----- Method: SpurMemoryManager class>>memoryManagerVersion (in category 'accessing') -----
> + memoryManagerVersion
> + ^ 'Spur'!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>isForwarded: (in category 'object testing') -----
> isForwarded: objOop
> "Answer if objOop is that if a forwarder. Take advantage of isForwardedObjectClassIndexPun
> being a power of two to generate a more efficient test than the straight-forward
> (self classIndexOf: objOop) = self isForwardedObjectClassIndexPun
> at the cost of this being ambiguous with free chunks. So either never apply this to free chunks
> or guard with (self isFreeObject: foo) not. So far the idiom has been to guard with isFreeObject:"
> <api>
> <inline: true>
> "self assert: (self isFreeObject: objOop) not."
> ^(self longAt: objOop) noMask: self classIndexMask - self isForwardedObjectClassIndexPun!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>setHiddenRootsObj: (in category 'class table') -----
> setHiddenRootsObj: anOop
> hiddenRootsObj := anOop.
> self cCode: [self assert: self validClassTableRootPages]
> inSmalltalk: [numClassTablePages ifNotNil:
> [self assert: self validClassTableRootPages]]..
> classTableFirstPage := self fetchPointer: 0 ofObject: hiddenRootsObj.
> self assert: (self numSlotsOf: classTableFirstPage) - 1 = self classTableMinorIndexMask.
> "Set classTableIndex to the start of the last used page (excepting first page).
> Set numClassTablePages to the number of used pages."
> numClassTablePages := self classTableRootSlots.
> 2 to: numClassTablePages - 1 do:
> [:i|
> (self fetchPointer: i ofObject: hiddenRootsObj) = nilObj ifTrue:
> [numClassTablePages := i.
> classTableIndex := (numClassTablePages - 1 max: 1) << self classTableMajorIndexShift.
> ^self]].
> "no unused pages; set it to the start of the second page."
> classTableIndex := 1 << self classTableMajorIndexShift!
>
> Item was removed:
> - InterpreterPlugin subclass: #SqueakSSLPlugin
> - instanceVariableNames: ''
> - classVariableNames: ''
> - poolDictionaries: ''
> - category: 'VMMaker-Plugins'!
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin class>>hasHeaderFile (in category 'translation') -----
> - hasHeaderFile
> - ^true!
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin class>>moduleName (in category 'translation') -----
> - moduleName
> - ^'SqueakSSL'!
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveAccept (in category 'primitives') -----
> - primitiveAccept
> - "Primitive. Starts or continues a server handshake using the current session.
> - Will eventually produce output to be sent to the client. Requires the host
> - and cert name to be set for the session. Returns a code indicating the sate
> - of the connection:
> - > 0 - Number of bytes to be sent to the client.
> - 0 - Success. The connection is established.
> - -1 - More input is required.
> - < -1 - Other errors.
> - "
> - | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
> - <var: #srcPtr type: 'char *'>
> - <var: #dstPtr type: 'char *'>
> - <export: true>
> - interpreterProxy methodArgumentCount = 5
> - ifFalse:[^interpreterProxy primitiveFail].
> - dstOop := interpreterProxy stackObjectValue: 0.
> - srcLen := interpreterProxy stackIntegerValue: 1.
> - start := interpreterProxy stackIntegerValue: 2.
> - srcOop := interpreterProxy stackObjectValue: 3.
> - handle := interpreterProxy stackIntegerValue: 4.
> - interpreterProxy failed ifTrue:[^nil].
> - ((start > 0 and:[srcLen >= 0])
> - and:[(interpreterProxy isBytes: srcOop)
> - and:[(interpreterProxy isBytes: dstOop)
> - and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
> - ifFalse:[^interpreterProxy primitiveFail].
> - srcPtr := interpreterProxy firstIndexableField: srcOop.
> - dstPtr := interpreterProxy firstIndexableField: dstOop.
> - srcPtr := srcPtr + start - 1.
> - dstLen := interpreterProxy byteSizeOf: dstOop.
> - result := self cCode: 'sqAcceptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
> - inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
> - interpreterProxy failed ifTrue:[^nil].
> - interpreterProxy pop: interpreterProxy methodArgumentCount+1.
> - interpreterProxy pushInteger: result.!
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveConnect (in category 'primitives') -----
> - primitiveConnect
> - "Primitive. Starts or continues a client handshake using the provided data.
> - Will eventually produce output to be sent to the server. Requires the host
> - name to be set for the session.
> - Returns:
> - > 0 - Number of bytes to be sent to the server
> - 0 - Success. The connection is established.
> - -1 - More input is required.
> - < -1 - Other errors.
> - "
> - | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
> - <var: #srcPtr type: 'char *'>
> - <var: #dstPtr type: 'char *'>
> - <export: true>
> - interpreterProxy methodArgumentCount = 5
> - ifFalse:[^interpreterProxy primitiveFail].
> - dstOop := interpreterProxy stackObjectValue: 0.
> - srcLen := interpreterProxy stackIntegerValue: 1.
> - start := interpreterProxy stackIntegerValue: 2.
> - srcOop := interpreterProxy stackObjectValue: 3.
> - handle := interpreterProxy stackIntegerValue: 4.
> - interpreterProxy failed ifTrue:[^nil].
> - ((start > 0 and:[srcLen >= 0])
> - and:[(interpreterProxy isBytes: srcOop)
> - and:[(interpreterProxy isBytes: dstOop)
> - and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
> - ifFalse:[^interpreterProxy primitiveFail].
> - srcPtr := interpreterProxy firstIndexableField: srcOop.
> - dstPtr := interpreterProxy firstIndexableField: dstOop.
> - srcPtr := srcPtr + start - 1.
> - dstLen := interpreterProxy byteSizeOf: dstOop.
> - result := self cCode: 'sqConnectSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
> - inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
> - interpreterProxy failed ifTrue:[^nil].
> - interpreterProxy pop: interpreterProxy methodArgumentCount+1.
> - interpreterProxy pushInteger: result.!
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveCreate (in category 'primitives') -----
> - primitiveCreate
> - "Primitive. Creates a new SSL session and returns its handle."
> - | handle |
> - <export: true>
> - interpreterProxy methodArgumentCount = 0
> - ifFalse:[^interpreterProxy primitiveFail].
> - handle := self cCode: 'sqCreateSSL()' inSmalltalk:[0].
> - handle = 0 ifTrue:[^interpreterProxy primitiveFail].
> - interpreterProxy pop: interpreterProxy methodArgumentCount+1.
> - interpreterProxy pushInteger: handle.
> - !
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveDecrypt (in category 'primitives') -----
> - primitiveDecrypt
> - "Primitive. Decrypts a buffer sent via the connection.
> - Requires the session to be established.
> - Returns:
> - >=0 - Number of bytes decrypted in the result buffer
> - < -1 - Other errors.
> - "
> - | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
> - <var: #srcPtr type: 'char *'>
> - <var: #dstPtr type: 'char *'>
> - <export: true>
> - interpreterProxy methodArgumentCount = 5
> - ifFalse:[^interpreterProxy primitiveFail].
> - dstOop := interpreterProxy stackObjectValue: 0.
> - srcLen := interpreterProxy stackIntegerValue: 1.
> - start := interpreterProxy stackIntegerValue: 2.
> - srcOop := interpreterProxy stackObjectValue: 3.
> - handle := interpreterProxy stackIntegerValue: 4.
> - interpreterProxy failed ifTrue:[^nil].
> - ((start > 0 and:[srcLen >= 0])
> - and:[(interpreterProxy isBytes: srcOop)
> - and:[(interpreterProxy isBytes: dstOop)
> - and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
> - ifFalse:[^interpreterProxy primitiveFail].
> - srcPtr := interpreterProxy firstIndexableField: srcOop.
> - dstPtr := interpreterProxy firstIndexableField: dstOop.
> - srcPtr := srcPtr + start - 1.
> - dstLen := interpreterProxy byteSizeOf: dstOop.
> - result := self cCode: 'sqDecryptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
> - inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
> - interpreterProxy failed ifTrue:[^nil].
> - interpreterProxy pop: interpreterProxy methodArgumentCount+1.
> - interpreterProxy pushInteger: result.!
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveDestroy (in category 'primitives') -----
> - primitiveDestroy
> - "Primitive. Destroys an SSL session."
> -
> - | handle result |
> - <export: true>
> - interpreterProxy methodArgumentCount = 1
> - ifFalse:[^interpreterProxy primitiveFail].
> - handle := interpreterProxy stackIntegerValue: 0.
> - interpreterProxy failed ifTrue:[^nil].
> - result := self cCode: 'sqDestroySSL(handle)' inSmalltalk:[handle. 0].
> - result = 0 ifTrue:[^interpreterProxy primitiveFail].
> - interpreterProxy pop: interpreterProxy methodArgumentCount.
> -
> - !
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveEncrypt (in category 'primitives') -----
> - primitiveEncrypt
> - "Primitive. Encrypts a buffer to be sent to the via the connection.
> - Requires the session to be established.
> - Returns:
> - >=0 - Number of bytes encrypted in the result buffer
> - < -1 - Other errors.
> - "
> - | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
> - <var: #srcPtr type: 'char *'>
> - <var: #dstPtr type: 'char *'>
> - <export: true>
> - interpreterProxy methodArgumentCount = 5
> - ifFalse:[^interpreterProxy primitiveFail].
> - dstOop := interpreterProxy stackObjectValue: 0.
> - srcLen := interpreterProxy stackIntegerValue: 1.
> - start := interpreterProxy stackIntegerValue: 2.
> - srcOop := interpreterProxy stackObjectValue: 3.
> - handle := interpreterProxy stackIntegerValue: 4.
> - interpreterProxy failed ifTrue:[^nil].
> - ((start > 0 and:[srcLen >= 0])
> - and:[(interpreterProxy isBytes: srcOop)
> - and:[(interpreterProxy isBytes: dstOop)
> - and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
> - ifFalse:[^interpreterProxy primitiveFail].
> - srcPtr := interpreterProxy firstIndexableField: srcOop.
> - dstPtr := interpreterProxy firstIndexableField: dstOop.
> - srcPtr := srcPtr + start - 1.
> - dstLen := interpreterProxy byteSizeOf: dstOop.
> - result := self cCode: 'sqEncryptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
> - inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
> - interpreterProxy failed ifTrue:[^nil].
> - interpreterProxy pop: interpreterProxy methodArgumentCount+1.
> - interpreterProxy pushInteger: result.!
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveGetIntProperty (in category 'primitives') -----
> - primitiveGetIntProperty
> - "Primitive. Returns an integer property for the session"
> -
> - | propID handle value |
> - <export: true>
> - interpreterProxy methodArgumentCount = 2
> - ifFalse:[^interpreterProxy primitiveFail].
> - propID := interpreterProxy stackIntegerValue: 0.
> - handle := interpreterProxy stackIntegerValue: 1.
> - interpreterProxy failed ifTrue:[^nil].
> - value := self cCode: 'sqGetIntPropertySSL(handle, propID)'
> - inSmalltalk:[handle. propID. 0].
> - interpreterProxy failed ifTrue:[^nil].
> - interpreterProxy
> - pop: interpreterProxy methodArgumentCount + 1
> - thenPush: (interpreterProxy signed32BitIntegerFor: value)
> - !
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveGetStringProperty (in category 'primitives') -----
> - primitiveGetStringProperty
> - "Primitive. Returns a string property for the session"
> -
> - | stringLen stringOop propID handle stringPtr oopPtr |
> - <var: #stringPtr type: 'char *'>
> - <var: #oopPtr type: 'char *'>
> - <export: true>
> - interpreterProxy methodArgumentCount = 2
> - ifFalse:[^interpreterProxy primitiveFail].
> - propID := interpreterProxy stackIntegerValue: 0.
> - handle := interpreterProxy stackIntegerValue: 1.
> - interpreterProxy failed ifTrue:[^nil].
> - stringPtr := self cCode: 'sqGetStringPropertySSL(handle, propID)'
> - inSmalltalk:[handle. propID. nil].
> - interpreterProxy failed ifTrue:[^nil].
> - stringPtr == nil ifTrue:[
> - stringOop := interpreterProxy nilObject.
> - ] ifFalse:[
> - stringLen := self strlen: stringPtr.
> - stringOop := interpreterProxy
> - instantiateClass: (interpreterProxy classString)
> - indexableSize: stringLen.
> - oopPtr := interpreterProxy firstIndexableField: stringOop.
> - 0 to: stringLen-1 do:[:i| oopPtr at: i put: (stringPtr at: i)].
> - ].
> - interpreterProxy
> - pop: interpreterProxy methodArgumentCount + 1
> - thenPush: stringOop.
> - !
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveSetIntProperty (in category 'primitives') -----
> - primitiveSetIntProperty
> - "Primitive. Sets a integer property for the session"
> -
> - | propID handle result value |
> - <export: true>
> - interpreterProxy methodArgumentCount = 3
> - ifFalse:[^interpreterProxy primitiveFail].
> - value := interpreterProxy signed32BitValueOf: (interpreterProxy stackValue: 0).
> - propID := interpreterProxy stackIntegerValue: 1.
> - handle := interpreterProxy stackIntegerValue: 2.
> - interpreterProxy failed ifTrue:[^nil].
> - result := self cCode: 'sqSetIntPropertySSL(handle, propID, value)'
> - inSmalltalk:[handle. propID. value. false].
> - result ifFalse:[^interpreterProxy primitiveFail].
> - interpreterProxy failed ifTrue:[^nil].
> - interpreterProxy pop: interpreterProxy methodArgumentCount.
> - !
>
> Item was removed:
> - ----- Method: SqueakSSLPlugin>>primitiveSetStringProperty (in category 'primitives') -----
> - primitiveSetStringProperty
> - "Primitive. Sets a string property for the session"
> -
> - | srcLen srcOop propID handle srcPtr result |
> - <var: #srcPtr type: 'char *'>
> - <export: true>
> - interpreterProxy methodArgumentCount = 3
> - ifFalse:[^interpreterProxy primitiveFail].
> - srcOop := interpreterProxy stackObjectValue: 0.
> - propID := interpreterProxy stackIntegerValue: 1.
> - handle := interpreterProxy stackIntegerValue: 2.
> - interpreterProxy failed ifTrue:[^nil].
> - (interpreterProxy isBytes: srcOop)
> - ifFalse:[^interpreterProxy primitiveFail].
> - srcPtr := interpreterProxy firstIndexableField: srcOop.
> - srcLen := interpreterProxy byteSizeOf: srcOop.
> - result := self cCode: 'sqSetStringPropertySSL(handle, propID, srcPtr, srcLen)'
> - inSmalltalk:[handle. srcPtr. propID. srcLen. false].
> - result ifFalse:[^interpreterProxy primitiveFail].
> - interpreterProxy failed ifTrue:[^nil].
> - interpreterProxy pop: interpreterProxy methodArgumentCount.
> - !
>
> Item was added:
> + ----- Method: StackInterpreter class>>interpreterVersion (in category 'accessing') -----
> + interpreterVersion
> + ^ 'Stack'!
>
> Item was changed:
> ----- Method: StackInterpreter class>>requiredMethodNames: (in category 'translation') -----
> requiredMethodNames: options
> "return the list of method names that should be retained for export or other support reasons"
> | requiredList |
> requiredList := self exportAPISelectors: options.
> requiredList addAll: (NewObjectMemory requiredMethodNames: options).
> "A number of methods required by VM support code, jitter, specific platforms etc"
> requiredList addAll: #(
> assertValidExecutionPointe:r:s:
> characterForAscii:
> findClassOfMethod:forReceiver: findSelectorOfMethod:
> forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate
> getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending
> getSavedWindowSize getThisSessionID
> interpret
> loadInitialContext
> primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext:
> printExternalHeadFrame printFramesInPage: printFrame: printHeadFrame printMemory printOop:
> printStackPages printStackPageList printStackPagesInUse printStackPageListInUse
> readableFormat: readImageFromFile:HeapSize:StartingAt:
> setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain:
> setSavedWindowSize: success:
> validInstructionPointer:inMethod:framePointer:).
>
> "Nice to actually have all the primitives available"
> requiredList addAll: (self primitiveTable select: [:each| each isSymbol]).
>
> "InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
> InterpreterProxy organization categories do:
> [:cat |
> + ((cat ~= 'initialize')
> + and: [ cat ~= 'private'
> + and: [ cat ~= '-- all --' ] ]) ifTrue:
> - ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue:
> [requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
>
> ^requiredList!
>
> Item was changed:
> ----- Method: StackInterpreter>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') -----
> codeGeneratorToComputeAccessorDepth
> ^VMMaker new
> buildCodeGeneratorForInterpreter: self class primitivesClass
> includeAPIMethods: false
> initializeClasses: false!
>
> Item was changed:
> ----- Method: StackInterpreter>>primitiveIndexOfMethod:header: (in category 'compiled methods') -----
> primitiveIndexOfMethod: theMethod header: methodHeader
> "Note: With the Squeak V0 format we now have 10 bits of primitive index, but they are in
> two places for temporary backward compatibility. The time to unpack is negligible,
> since the derived primitive function pointer is stored in the method cache. With the new
> format we assume a 3-byte CallPrimitive with a little-endian 16-bit primitive index."
> <api>
> <inline: true>
> | firstBytecode |
> ^objectMemory hasSpurMemoryManagerAPI
> ifTrue:
> [(self alternateHeaderHasPrimitiveFlag: methodHeader)
> ifTrue:
> [firstBytecode := self firstBytecodeOfAlternateHeader: methodHeader method: theMethod.
> (objectMemory byteAt: firstBytecode + 1) + ((objectMemory byteAt: firstBytecode + 2) << 8)]
> ifFalse:
> [0]]
> ifFalse:
> [MULTIPLEBYTECODESETS
> ifTrue:
> [(self headerIndicatesAlternateBytecodeSet: methodHeader)
> ifTrue:
> [(self alternateHeaderHasPrimitiveFlag: methodHeader)
> ifTrue:
> [firstBytecode := self firstBytecodeOfAlternateHeader: methodHeader method: theMethod.
> (objectMemory byteAt: firstBytecode + 1) + ((objectMemory byteAt: firstBytecode + 2) << 8)]
> ifFalse:
> [0]]
> ifFalse:
> [| primBits |
> primBits := objectMemory integerValueOf: methodHeader.
> (primBits bitAnd: 16r1FF) + (primBits >> 19 bitAnd: 16r200)]]
> ifFalse:
> [| primBits |
> primBits := objectMemory integerValueOf: methodHeader.
> (primBits bitAnd: 16r1FF) + (primBits >> 19 bitAnd: 16r200)]]!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
> initialize
> "Initialize the StackInterpreterSimulator when running the interpreter
> inside Smalltalk. The primary responsibility of this method is to allocate
> Smalltalk Arrays for variables that will be declared as statically-allocated
> global arrays in the translated code."
> super initialize.
>
> bootstrapping := false.
> transcript := Transcript.
>
> objectMemory ifNil:
> [objectMemory := self class objectMemoryClass simulatorClass new].
> objectMemory coInterpreter: self.
>
> "Note: we must initialize ConstMinusOne differently for simulation,
> due to the fact that the simulator works only with +ve 32-bit values"
> ConstMinusOne := objectMemory integerObjectOf: -1.
>
> methodCache := Array new: MethodCacheSize.
> atCache := Array new: AtCacheTotalSize.
> self flushMethodCache.
> gcSemaphoreIndex := 0.
> externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
> externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
> externalPrimitiveTableFirstFreeIndex := 0.
> primitiveTable := self class primitiveTable copy.
> mappedPluginEntries := OrderedCollection new.
> objectMemory hasSpurMemoryManagerAPI
> ifTrue:
> [primitiveAccessorDepthTable := Array new: primitiveTable size.
> pluginList := {}.
> self loadNewPlugin: '']
> ifFalse:
> [pluginList := {'' -> self }].
> desiredNumStackPages := desiredEdenBytes := 0.
> "This is initialized on loading the image, but convenient for testing stack page values..."
> numStackPages := self defaultNumStackPages.
> startMicroseconds := Time totalSeconds * 1000000.
>
> "initialize InterpreterSimulator variables used for debugging"
> byteCount := sendCount := lookupCount := 0.
> quitBlock := [^self].
> traceOn := true.
> printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
> myBitBlt := BitBltSimulator new setInterpreter: self.
> + displayForm := (ImageMorph fromString: 'Display has not yet been installed') form.
> - displayForm := 'Display has not yet been installed' asDisplayText form.
> eventQueue := SharedQueue new.
> suppressHeartbeatFlag := false.
> systemAttributes := Dictionary new.
> extSemTabSize := 256.
> disableBooleanCheat := false.
> assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"!
>
> Item was added:
> + ----- Method: StackInterpreterSimulator>>initializeInterpreter: (in category 'initialization') -----
> + initializeInterpreter: bytesToShift
> + super initializeInterpreter: bytesToShift.
> + "self initStackPages.
> + self loadInitialContext"!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
> ioRelinquishProcessorForMicroseconds: microseconds
> "In the simulator give an indication that we're idling and check for input."
> Display reverse: (0@0 extent: 16@16).
> Sensor peekEvent ifNotNil:
> [self forceInterruptCheck].
> + Processor activeProcess == UIManager default uiProcess ifTrue:
> - Processor activeProcess == Project uiProcess ifTrue:
> [World doOneCycle].
> microseconds >= 1000
> ifTrue: [(Delay forMilliseconds: microseconds + 999 // 1000) wait]
> ifFalse: [Processor yield].
> "And increase the byteCount form which the microsecond clock is derived..."
> byteCount := byteCount + microseconds - 1.
> self incrementByteCount!
>
> Item was added:
> + ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: posixPermissions
> + posixPermissions: fileSize
> +
> + | modDateOop createDateOop nameString results |
> + <var: 'entryName' type: 'char *'>
> +
> + results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 5.
> + nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
> + createDateOop := self positive32BitIntegerFor: createDate.
> + modDateOop := self positive32BitIntegerFor: modifiedDate.
> +
> + 1 to: entryNameSize do:
> + [ :i |
> + objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
> +
> + objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
> + objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
> + objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
> + dirFlag
> + ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
> + ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
> + objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
> + objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions).
> + ^ results!
>
> Item was added:
> + ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
> + makeDirEntryName: entryName
> + size: entryNameSize
> + createDate: createDate
> + modDate: modifiedDate
> + isDir: dirFlag
> + fileSize: posixPermissions
> + posixPermissions: fileSize
> + isSymlink: symlinkFlag
> +
> + | modDateOop createDateOop nameString results |
> + <var: 'entryName' type: 'char *'>
> +
> + results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 7.
> + nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
> + createDateOop := self positive32BitIntegerFor: createDate.
> + modDateOop := self positive32BitIntegerFor: modifiedDate.
> +
> + 1 to: entryNameSize do:
> + [ :i |
> + objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
> +
> + objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
> + objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
> + objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
> + dirFlag
> + ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
> + ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
> + objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
> + objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions).
> + symlinkFlag
> + ifTrue: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory trueObject ]
> + ifFalse: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory falseObject ].
> +
> + ^ results!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>openAsMorph (in category 'UI') -----
> openAsMorph
> "Open a morphic view on this simulation."
> + | window localImageName |
> + localImageName := imageName asFileReference basename.
> - | localImageName borderWidth window |
> - localImageName := imageName
> - ifNotNil: [FileDirectory default localNameFor: imageName]
> - ifNil: [' synthetic image'].
> window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
>
> window addMorph: (displayView := ImageMorph new image: displayForm)
> frame: (0@0 corner: 1(a)0.8).
>
> + transcript := ThreadSafeTranscript new.
> - transcript := TranscriptStream on: (String new: 10000).
> window addMorph: (PluggableTextMorph
> on: transcript text: nil accept: nil
> readSelection: nil menu: #codePaneMenu:shifted:)
> frame: (0(a)0.8 corner: 0.7@1).
> +
> window addMorph: (PluggableTextMorph on: self
> text: #byteCountText accept: nil
> readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
> frame: (0.7(a)0.8 corner: 1@1).
>
> - borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
> - on: MessageNotUnderstood
> - do: [:ex| 0]. "3.8"
> - borderWidth := borderWidth + window borderWidth.
> window openInWorldExtent: (self desiredDisplayExtent
> + + (2 * window borderWidth)
> - + (2 * borderWidth)
> + (0@window labelHeight)
> + * (1(a)(1/0.8))) rounded!
> - * (1(a)(1/0.8))) rounded.
> - ^window!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>openAsMorphNoTranscript (in category 'UI') -----
> openAsMorphNoTranscript
> "Open a morphic view on this simulation."
> + | window localImageName |
> + localImageName := imageName asFileReference basename.
> - | localImageName borderWidth window |
> - localImageName := FileDirectory default localNameFor: imageName.
> window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
>
> window addMorph: (displayView := ImageMorph new image: displayForm)
> frame: (0@0 corner: 1(a)0.95).
>
> window addMorph: (PluggableTextMorph on: self
> + text: #byteCountText accept: nil) hideScrollBarsIndefinitely
> - text: #byteCountText accept: nil
> - readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
> frame: (0(a)0.95 corner: 1@1).
>
> - borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
> - on: MessageNotUnderstood
> - do: [:ex| 0]. "3.8"
> - borderWidth := borderWidth + window borderWidth.
> window openInWorldExtent: (self desiredDisplayExtent
> + + (2 * window borderWidth)
> - + (2 * borderWidth)
> + (0@window labelHeight)
> * (1(a)(1/0.95))) rounded!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
> primitiveDirectoryEntry
> | name pathName array result |
> name := self stringOf: self stackTop.
> pathName := self stringOf: (self stackValue: 1).
>
> self successful ifFalse:
> [^self primitiveFail].
>
> + array := FileSystem disk store basicEntryAt: (pathName asFileReference / name) path.
> - array := FileDirectory default primLookupEntryIn: pathName name: name.
> array == nil ifTrue:
> [self pop: 3 thenPush: objectMemory nilObject.
> ^array].
> array == #badDirectoryPath ifTrue:
> + [
> - [self halt.
> ^self primitiveFail].
>
> + result := self makeDirEntryName: (array at: 1)
> + size: (array at: 1) size
> + createDate: (array at: 2)
> + modDate: (array at: 3)
> + isDir: (array at: 4)
> + fileSize: (array at: 5)
> + posixPermissions: (array at: 6)
> + isSymlink: (array at: 7).
> - result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> - createDate: (array at: 2) modDate: (array at: 3)
> - isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3.
> self push: result!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
> primitiveDirectoryLookup
> | index pathName array result |
> index := self stackIntegerValue: 0.
> pathName := (self stringOf: (self stackValue: 1)).
>
> self successful ifFalse:
> [^self primitiveFail].
>
> + array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
> - array := FileDirectory default primLookupEntryIn: pathName index: index.
>
> array == nil ifTrue:
> [self pop: 3 thenPush: objectMemory nilObject.
> ^array].
> array == #badDirectoryPath ifTrue:
> ["self halt."
> ^self primitiveFail].
>
> + result := self
> + makeDirEntryName: (array at: 1)
> + size: (array at: 1) size
> + createDate: (array at: 2)
> + modDate: (array at: 3)
> + isDir: (array at: 4)
> + fileSize: (array at: 5)
> + posixPermissions: (array at: 6)
> + isSymlink: (array at: 7).
> - result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> - createDate: (array at: 2) modDate: (array at: 3)
> - isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3 thenPush: result!
>
> Item was added:
> + ----- Method: StackInterpreterSimulator>>redirectTranscriptToHost (in category 'debug support') -----
> + redirectTranscriptToHost
> + "Sometimes you need the capability to see the transcript output of the image into the
> + local transcript (for debugging when bootstrapping, for example). "
> + transcript := Transcript!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>runAtEachStep: (in category 'testing') -----
> runAtEachStep: aBlock
> self initStackPages.
> self loadInitialContext.
> self internalizeIPandSP.
> self fetchNextBytecode.
> [true] whileTrue:
> [self assertValidExecutionPointers.
> aBlock value: currentBytecode.
> self dispatchOn: currentBytecode in: BytecodeTable.
> self incrementByteCount].
> localIP := localIP - 1.
> "undo the pre-increment of IP before returning"
> self externalizeIPandSP!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>runForNBytes: (in category 'testing') -----
> runForNBytes: nBytecodes
> "Do nByteCodes more bytecode dispatches.
> Keep byteCount up to date.
> This can be run repeatedly."
> | endCount |
> self initStackPages.
> + self loadInitialContext.
> - self loadInitialContext.
> endCount := byteCount + nBytecodes.
> self internalizeIPandSP.
> self fetchNextBytecode.
> [byteCount < endCount] whileTrue:
> [self dispatchOn: currentBytecode in: BytecodeTable.
> self incrementByteCount].
> localIP := localIP - 1.
> "undo the pre-increment of IP before returning"
> self externalizeIPandSP!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') -----
> runWithBreakCount: theBreakCount
> "Just run, halting when byteCount is reached"
> quitBlock := [displayView ifNotNil:
> [displayView containingWindow ifNotNil:
> [:topWindow|
> ((World submorphs includes: topWindow)
> and: [UIManager default confirm: 'close?']) ifTrue:
> [topWindow delete]]].
> ^self].
> breakCount := theBreakCount.
> self initStackPages.
> + self loadInitialContext.
> - self loadInitialContext.
> self internalizeIPandSP.
> self fetchNextBytecode.
> [true] whileTrue:
> [self assertValidExecutionPointers.
> self dispatchOn: currentBytecode in: BytecodeTable.
> self incrementByteCount].
> localIP := localIP - 1.
> "undo the pre-increment of IP before returning"
> self externalizeIPandSP!
>
> Item was changed:
> ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') -----
> initializeBytecodeTableForNewspeakV4
> "StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV4"
>
> numPushNilsFunction := #v4:Num:Push:Nils:.
> pushNilSizeFunction := #v4PushNilSize:.
> NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit"
> FirstSpecialSelector := 80.
> self flag:
> 'Special selector send class must be inlined to agree with the interpreter, which
> inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
> class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
> have identical semantics. We get away with not hardwiring the other special
> selectors either because in the Cointerpreter they are not inlined or because they
> are inlined only to instances of classes for which there will always be a method.'.
> self generatorTableFrom: #(
> "1 byte bytecodes"
> (1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1)
> (1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
> (1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
> (1 64 75 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
> (1 76 76 genPushReceiverBytecode needsFrameNever: 1)
> (1 77 77 genExtPushPseudoVariableOrOuterBytecode needsFrameIfExtBGT2: 1)
> (1 78 78 genPushConstantZeroBytecode needsFrameNever: 1)
> (1 79 79 genPushConstantOneBytecode needsFrameNever: 1)
>
> (1 80 80 genSpecialSelectorArithmetic isMapped AddRR)
> (1 81 81 genSpecialSelectorArithmetic isMapped SubRR)
> (1 82 82 genSpecialSelectorComparison isMapped JumpLess)
> (1 83 83 genSpecialSelectorComparison isMapped JumpGreater)
> (1 84 84 genSpecialSelectorComparison isMapped JumpLessOrEqual)
> (1 85 85 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
> (1 86 86 genSpecialSelectorComparison isMapped JumpZero)
> (1 87 87 genSpecialSelectorComparison isMapped JumpNonZero)
> (1 88 93 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //"
> (1 94 94 genSpecialSelectorArithmetic isMapped AndRR)
> (1 95 95 genSpecialSelectorArithmetic isMapped OrRR)
> (1 96 101 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
> (1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
> (1 103 103 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
> (1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
>
> (1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
> (1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
> (1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
> (1 160 175 genSendAbsentImplicit0ArgsBytecode isMapped hasIRC)
>
> (1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
> (1 184 191 genStoreAndPopTemporaryVariableBytecode)
>
> (1 192 199 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
> (1 200 207 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
> v3:ShortForward:Branch:Distance:)
> (1 208 215 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
> v3:ShortForward:Branch:Distance:)
>
> (1 216 216 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
> (1 217 217 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
> (1 218 218 genExtReturnTopFromBlock return needsFrameNever: -1)
>
> (1 219 219 duplicateTopBytecode needsFrameNever: 1)
> (1 220 220 genPopStackBytecode needsFrameNever: -1)
> (1 221 221 genExtNopBytecode needsFrameNever: 0)
> (1 222 223 unknownBytecode)
>
> "2 byte bytecodes"
> (2 224 224 extABytecode extension needsFrameNever: 0)
> (2 225 225 extBBytecode extension needsFrameNever: 0)
> (2 226 226 genExtPushReceiverVariableBytecode)
> (2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1)
> (2 228 228 genExtPushLiteralBytecode needsFrameNever: 1)
> (2 229 229 genExtPushIntegerBytecode needsFrameNever: 1)
> (2 230 230 genLongPushTemporaryVariableBytecode)
> (2 231 231 genPushNewArrayBytecode)
> (2 232 232 genExtStoreReceiverVariableBytecode)
> (2 233 233 genExtStoreLiteralVariableBytecode)
> (2 234 234 genLongStoreTemporaryVariableBytecode)
> (2 235 235 genExtStoreAndPopReceiverVariableBytecode)
> (2 236 236 genExtStoreAndPopLiteralVariableBytecode)
> (2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
>
> (2 238 238 genExtSendBytecode isMapped)
> (2 239 239 genExtSendSuperBytecode isMapped)
> (2 240 240 genExtSendAbsentImplicitBytecode isMapped hasIRC)
> (2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped)
>
> (2 242 242 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
> (2 243 243 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
> (2 244 244 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
>
> (2 245 245 genExtSendAbsentSelfBytecode isMapped)
>
> (2 246 248 unknownBytecode)
>
> "3 byte bytecodes"
> (3 249 249 callPrimitiveBytecode)
> (3 250 250 genPushRemoteTempLongBytecode)
> (3 251 251 genStoreRemoteTempLongBytecode)
> (3 252 252 genStoreAndPopRemoteTempLongBytecode)
> (3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:)
> (3 254 254 genExtSendAbsentOuterBytecode isMapped)
>
> (3 255 255 unknownBytecode))!
>
> Item was added:
> + SmartSyntaxInterpreterPlugin subclass: #SystemInfoPlugin
> + instanceVariableNames: ''
> + classVariableNames: ''
> + poolDictionaries: 'VMBasicConstants'
> + category: 'VMMaker-Plugins'!
> +
> + !SystemInfoPlugin commentStamp: '<historical>' prior: 0!
> + I'm a symple plugin who answers some information about the system.
> + My main purpose is to provide identifiers that can be used for security reasons (to forbid an application to run in different machines)
> + !
>
> Item was added:
> + ----- Method: SystemInfoPlugin class>>declareCVarsIn: (in category 'translation') -----
> + declareCVarsIn: codeGenerator
> + codeGenerator addHeaderFile: '"SystemInfo.h"'.!
>
> Item was added:
> + ----- Method: SystemInfoPlugin>>primitivePrimaryMACAddress (in category 'primitives') -----
> + primitivePrimaryMACAddress
> + | identifier size resultOop resultPtr |
> +
> + <export: true>
> + <var: #identifier type: 'char *'>
> + <var: #resultPtr type: 'char *'>
> +
> + self primitive: #primitivePrimaryMACAddress parameters: #().
> +
> + interpreterProxy failed ifTrue: [ ^self ].
> +
> + identifier := self sqPrimaryMACAddress.
> + size := self strlen: identifier.
> + resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: size.
> + resultPtr := interpreterProxy firstIndexableField: resultOop.
> + 0 to: (size - 1) do: [ :i |
> + resultPtr at: i put: (identifier at: i) ].
> +
> + ^resultOop!
>
> Item was added:
> + ----- Method: SystemInfoPlugin>>primitiveUniqueIdentifier (in category 'primitives') -----
> + primitiveUniqueIdentifier
> + | identifier size resultOop resultPtr |
> +
> + <export: true>
> + <var: #identifier type: 'char *'>
> + <var: #resultPtr type: 'char *'>
> +
> + self primitive: #primitiveUniqueIdentifier parameters: #().
> +
> + interpreterProxy failed ifTrue: [ ^self ].
> +
> + identifier := self sqUniqueIdentifier.
> + size := self strlen: identifier.
> + resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: size.
> + resultPtr := interpreterProxy firstIndexableField: resultOop.
> + 0 to: (size - 1) do: [ :i |
> + resultPtr at: i put: (identifier at: i) ].
> +
> + ^resultOop!
>
> Item was changed:
> ----- Method: TAssignmentNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
> emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
> aStream nextPut: $(.
> self emitCCodeOn: aStream level: level generator: aCodeGen.
> aStream nextPut: $)!
>
> Item was changed:
> ----- Method: TMethod>>buildCaseStmt:in: (in category 'transformations') -----
> buildCaseStmt: aSendNode in: aCodeGen
> "Build a case statement node for the given send of dispatchOn:in:."
> "Note: the first argument is the variable to be dispatched on. The second argument is a constant node holding an array of unary selectors, which will be turned into sends to self."
>
> | unimplemented errorMessage |
> (aSendNode args size >= 2
> and: [aSendNode args second isConstant
> and: [aSendNode args second value isArray]]) ifFalse:
> [self error: 'wrong node structure for a case statement'].
>
> unimplemented := aSendNode args second value select: [:s| (aCodeGen methodNamed: s) isNil].
> unimplemented isEmpty ifFalse:
> [errorMessage := 'The following selectors in case statement "', (aSendNode printString copyUpTo: $#), '..." are unimplemented: ',
> (String streamContents: [:s| unimplemented do: [:sel| s crtab; store: sel]]).
> aCodeGen logger nextPutAll: errorMessage; cr; flush.
> + "(self confirm: errorMessage
> - (self confirm: errorMessage
> orCancel: aCodeGen abortBlock) ifFalse:
> + [self halt]"].
> - [self halt]].
>
> ^TCaseStmtNode new
> setExpression: aSendNode args first
> selectors: aSendNode args second value
> arguments: (aSendNode args copyFrom: 3 to: aSendNode args size)!
>
> Item was changed:
> ----- Method: TMethod>>emitCCodeOn:generator: (in category 'C code generation') -----
> emitCCodeOn: aStream generator: aCodeGen
> "Emit C code for this method onto the given stream.
> All calls to inlined methods should already have been expanded."
>
> aCodeGen currentMethod: self.
> self emitCCommentOn: aStream. "place method comment before function"
> aStream cr.
> self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
> aStream cr; nextPut: ${.
> + aStream cr; tab;
> + nextPutAll: '// '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self selector.
> self emitCLocalsOn: aStream generator: aCodeGen.
> aCodeGen
> pushScope: declarations
> while: [parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen].
> aStream nextPut: $}; cr!
>
> Item was changed:
> ----- Method: TParseNode>>emitCCodeAsArgumentOn:level:generator: (in category 'C code generation') -----
> emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen
> ^self emitCCodeOn: aStream level: level generator: aCodeGen!
>
> Item was changed:
> ----- Method: TParseNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
> emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
> ^self emitCCodeOn: aStream level: level generator: aCodeGen!
>
> Item was changed:
> ----- Method: TSendNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
> emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
> ^self emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen!
>
> Item was changed:
> ----- Method: TestOSAPlugin class>>declareCVarsIn: (in category 'as yet unclassified') -----
> declareCVarsIn: cg
> + cg addHeaderFile: '<Carbon/Carbon.h>'.
> + !
> -
> - cg addHeaderFile: '<AppleEvents.h>'.
> - cg addHeaderFile: '<AppleScript.h>'.
> - cg addHeaderFile: '<OSA.h>'.
> - cg addHeaderFile: '<OSAGeneric.h>'.
> - cg addHeaderFile: '<Script.h>'.!
>
> Item was removed:
> - ----- Method: ThreadedIA32FFIPlugin class>>moduleName (in category 'translation') -----
> - moduleName
> - ^'IA32FFIPlugin'!
>
> Item was changed:
> ----- Method: VMClass class>>declareInterpreterVersionIn:defaultName: (in category 'translation') -----
> declareInterpreterVersionIn: aCCodeGenerator defaultName: defaultName
> + NewspeakVM
> + ifTrue: [
> + "Newspeak as of mid 2011 derives SystemScope systemName from the interpreterVersion
> + (via system attribute 1004) by copying up to but not including the last space, provided the
> + string ends with a digit. So spaces must be eliminated from the Monitcello version string,
> + and we can't surround it with square brackets."
> + (aCCodeGenerator shortMonticelloDescriptionForClass: self) last isDigit
> + ifFalse: [ self error: 'Newspeak expects interpreterVersion ends with a digit' ].
> +
> + aCCodeGenerator
> + var: #interpreterVersion
> + declareC: 'const char *interpreterVersion = "Newspeak Virtual Machine ',
> + ((aCCodeGenerator shortMonticelloDescriptionForClass: self) copyReplaceAll: ' ' with: '_'),
> + '"'.
> + ^self].
> - NewspeakVM ifTrue:
> - ["Newspeak as of mid 2011 derives SystemScope systemName from the interpreterVersion
> - (via system attribute 1004) by copying up to but not including the last space, provided the
> - string ends with a digit. So spaces must be eliminated from the Monitcello version string,
> - and we can't surround it with square brackets."
> - (aCCodeGenerator shortMonticelloDescriptionForClass: self) last isDigit ifFalse:
> - [self error: 'Newspeak expects interpreterVersion ends with a digit'].
> - aCCodeGenerator
> - var: #interpreterVersion
> - declareC: 'const char *interpreterVersion = "Newspeak Virtual Machine ',
> - ((aCCodeGenerator shortMonticelloDescriptionForClass: self) copyReplaceAll: ' ' with: '_'),
> - '"'.
> - ^self].
>
> aCCodeGenerator
> var: #interpreterVersion
> + declareC: 'const char *interpreterVersion = "', defaultName, '"'.!
> - declareC: 'const char *interpreterVersion = "Croquet Closure ', defaultName, ' VM [',
> - (aCCodeGenerator shortMonticelloDescriptionForClass: self),']"'.!
>
> Item was changed:
> ----- Method: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') -----
> initializePrimitiveErrorCodes
> "Define the VM's primitive error codes. N.B. these are
> replicated in platforms/Cross/vm/sqVirtualMachine.h."
> "VMClass initializePrimitiveErrorCodes"
> | pet |
> PrimErrTableIndex := 51. "Zero-relative"
> "See SmalltalkImage>>recreateSpecialObjectsArray for the table definition.
> If the table exists and is large enough the corresponding entry is returned as
> the primitive error, otherwise the error is answered numerically."
> pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()].
> pet isArray ifFalse: [pet := #()].
> PrimNoErr := 0. "for helper methods that need to answer success or an error code."
> PrimErrGenericFailure := pet indexOf: nil ifAbsent: 1.
> PrimErrBadReceiver := pet indexOf: #'bad receiver' ifAbsent: 2.
> PrimErrBadArgument := pet indexOf: #'bad argument' ifAbsent: 3.
> PrimErrBadIndex := pet indexOf: #'bad index' ifAbsent: 4.
> PrimErrBadNumArgs := pet indexOf: #'bad number of arguments' ifAbsent: 5.
> PrimErrInappropriate := pet indexOf: #'inappropriate operation' ifAbsent: 6.
> PrimErrUnsupported := pet indexOf: #'unsupported operation' ifAbsent: 7.
> PrimErrNoModification := pet indexOf: #'no modification' ifAbsent: 8.
> PrimErrNoMemory := pet indexOf: #'insufficient object memory' ifAbsent: 9.
> PrimErrNoCMemory := pet indexOf: #'insufficient C memory' ifAbsent: 10.
> PrimErrNotFound := pet indexOf: #'not found' ifAbsent: 11.
> PrimErrBadMethod := pet indexOf: #'bad method' ifAbsent: 12.
> PrimErrNamedInternal := pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
> PrimErrObjectMayMove := pet indexOf: #'object may move' ifAbsent: 14.
> PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15.
> PrimErrObjectIsPinned := pet indexOf: #'object is pinned' ifAbsent: 16.
> PrimErrWritePastObject := pet indexOf: #'primitive write beyond end of object' ifAbsent: 17!
>
> Item was added:
> + ----- Method: VMClass class>>interpreterVersion (in category 'accessing') -----
> + interpreterVersion
> + ^ self subclassResponsibility!
>
> Item was added:
> + ----- Method: VMClass class>>memoryManagerVersion (in category 'accessing') -----
> + memoryManagerVersion
> + ^ self subclassResponsibility!
>
> Item was changed:
> ----- Method: VMClass class>>writeVMHeaderTo:bytesPerWord: (in category 'translation') -----
> writeVMHeaderTo: aStream bytesPerWord: bytesPerWord
> "Generate the contents of interp.h on aStream. Specific Interpreter subclasses
> override to add more stuff."
> aStream
> nextPutAll: '#define VM_PROXY_MAJOR '; print: self vmProxyMajorVersion; cr;
> nextPutAll: '#define VM_PROXY_MINOR '; print: self vmProxyMinorVersion; cr;
> cr;
> nextPutAll: '#define SQ_VI_BYTES_PER_WORD '; print: bytesPerWord; cr;
> cr.
>
> "The most basic constants must be defined here, not in e.g. the plugin sources, so allow those
> other sources to be shared between different builds (Spur vs SqueakV3, 32-bit vs 64-bit, etc)"
> VMBasicConstants mostBasicConstantNames asSet asArray sort do:
> [:constName|
> (VMBasicConstants classPool at: constName ifAbsent: []) ifNotNil:
> [:const|
> aStream nextPutAll: '#define '; nextPutAll: constName; space; print: const; cr]].
> aStream cr.
>
> ((VMBasicConstants classPool associations select: [:a| a key beginsWith: 'PrimErr'])
> asSortedCollection: [:a1 :a2| a1 value <= a2 value])
> do: [:a|
> aStream nextPutAll: '#define '; nextPutAll: a key; space; print: a value; cr].
> aStream cr.
>
> aStream
> + nextPutAll: '#define MinSmallInteger '; print: self objectMemoryClass new minSmallInteger; cr;
> + nextPutAll: '#define MaxSmallInteger '; print: self objectMemoryClass new maxSmallInteger; cr;
> - nextPutAll: '#define MinSmallInteger '; print: self objectMemoryClass minSmallInteger; cr;
> - nextPutAll: '#define MaxSmallInteger '; print: self objectMemoryClass maxSmallInteger; cr;
> cr.!
>
> Item was changed:
> ----- Method: VMClass>>doOrDefer: (in category 'simulation support') -----
> doOrDefer: aBlock
> <doNotGenerate>
> "Either evaluate aBlock immediately if in the uiProcess or defer aBlock as a UI message"
> + Processor activeProcess == UIManager default uiProcess
> - Processor activeProcess == Project uiProcess
> ifTrue: [aBlock value]
> ifFalse: [WorldState addDeferredUIMessage: aBlock]!
>
> Item was changed:
> ----- Method: VMMaker>>needsToRegenerateCogitFile (in category 'generate sources') -----
> needsToRegenerateCogitFile
> "Check the timestamp for the relevant classes and then the timestamp for the main source file (e.g. interp.c)
> file if it already exists. Answer if the file needs regenerating."
>
> | cogitClass cogitClasses tStamp |
> cogitClasses := (cogitClass := self interpreterClass cogitClass) withAllSuperclasses copyUpThrough: Cogit.
> cogitClasses addAllLast: (cogitClass ancilliaryClasses: self options).
> tStamp := cogitClasses inject: 0 into: [:tS :cl| tS max: cl timeStamp].
>
> "don't translate if the file is newer than my timeStamp"
> (self coreVMDirectory entryAt: cogitClass sourceFileName ifAbsent: [nil]) ifNotNil:
> [:fstat|
> + tStamp < fstat modificationTime asSeconds ifTrue:
> - tStamp < fstat modificationTime ifTrue:
> [^self confirm: 'The ', self configurationNameIfAny, cogitClass printString, ' classes have not been modified since\ the source file was last generated.\Do you still want to regenerate it?' withCRs]].
> ^true
> !
>
> Item was changed:
> ----- Method: VMMaker>>needsToRegenerateInterpreterFile (in category 'initialize') -----
> needsToRegenerateInterpreterFile
> "Check the timestamp for the relevant classes and then the timestamp for the main
> source file (e.g. interp.c) if it already exists. Answer if the file needs regenerating."
>
> | classes tStamp |
> classes := self interpreterClass withAllSuperclasses copyUpTo: VMClass.
> self interpreterClass objectMemoryClass ifNotNil:
> [:objectMemoryClass|
> classes addAllLast: (objectMemoryClass withAllSuperclasses copyUpTo: VMClass)].
> classes copy do:
> [:class| classes addAllLast: (class ancilliaryClasses: self options)].
> tStamp := classes inject: 0 into: [:tS :cl| tS max: cl timeStamp].
>
> "don't translate if the file is newer than my timeStamp"
> (self coreVMDirectory entryAt: self interpreterFilename ifAbsent: [nil]) ifNotNil:
> [:fstat|
> + tStamp < fstat modificationTime asSeconds ifTrue:
> - tStamp < fstat modificationTime ifTrue:
> [^self confirm: 'The ', self configurationNameIfAny, 'interpreter classes have not been modified since\ the interpreter file was last generated.\Do you still want to regenerate the source file?' withCRs]].
> ^true
> !
>
> Item was changed:
> ----- Method: VMMakerTool class>>initialize (in category 'instance creation') -----
> initialize
>
> + Smalltalk at: #TheWorldMenu ifPresent: [ :class |
> + class class methodDict at: #registerOpenCommand: ifPresent: [ :method |
> + (method sendsSelector: #deprecated:)
> + ifFalse: [ class registerOpenCommand: (Array with: 'VMMaker' with: (Array with: self with: #openInWorld)) ] ] ]
> + !
> - (TheWorldMenu respondsTo: #registerOpenCommand:)
> -
> - ifTrue: [TheWorldMenu registerOpenCommand: {'VMMaker'. {self. #openInWorld}. 'The VM making tool'}].!
>
2
2
13 Feb '15
Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-EstebanLorenzano.1061.mcz
==================== Summary ====================
Name: VMMaker.oscog-EstebanLorenzano.1061
Author: EstebanLorenzano
Time: 13 February 2015, 12:14:43.362602 pm
UUID: fc599a22-0090-45e5-b306-08a55d1a46ae
Ancestors: VMMaker.oscog-EstebanLorenzano.1058, VMMaker.oscog-eem.1060
empty log message
=============== Diff against VMMaker.oscog-eem.1060 ===============
Item was changed:
+ SystemOrganization addCategory: #VMMaker!
+ SystemOrganization addCategory: 'VMMaker-Building'!
+ SystemOrganization addCategory: 'VMMaker-Interpreter'!
+ SystemOrganization addCategory: 'VMMaker-InterpreterSimulation'!
+ SystemOrganization addCategory: 'VMMaker-InterpreterSimulation-Morphic'!
+ SystemOrganization addCategory: 'VMMaker-JIT'!
+ SystemOrganization addCategory: 'VMMaker-JITSimulation'!
+ SystemOrganization addCategory: 'VMMaker-Multithreading'!
+ SystemOrganization addCategory: 'VMMaker-Plugins'!
+ SystemOrganization addCategory: 'VMMaker-Plugins-Alien'!
+ SystemOrganization addCategory: 'VMMaker-Plugins-IOS'!
+ SystemOrganization addCategory: 'VMMaker-PostProcessing'!
+ SystemOrganization addCategory: 'VMMaker-SmartSyntaxPlugins'!
+ SystemOrganization addCategory: 'VMMaker-SpurMemoryManager'!
+ SystemOrganization addCategory: 'VMMaker-SpurMemoryManagerSimulation'!
+ SystemOrganization addCategory: 'VMMaker-Support'!
+ SystemOrganization addCategory: 'VMMaker-Tests'!
+ SystemOrganization addCategory: 'VMMaker-Translation to C'!
- SystemOrganization addCategory: #'VMMaker-Building'!
- SystemOrganization addCategory: #'VMMaker-Interpreter'!
- SystemOrganization addCategory: #'VMMaker-InterpreterSimulation'!
- SystemOrganization addCategory: #'VMMaker-InterpreterSimulation-Morphic'!
- SystemOrganization addCategory: #'VMMaker-JIT'!
- SystemOrganization addCategory: #'VMMaker-JITSimulation'!
- SystemOrganization addCategory: #'VMMaker-Multithreading'!
- SystemOrganization addCategory: #'VMMaker-Plugins'!
- SystemOrganization addCategory: #'VMMaker-Plugins-Alien'!
- SystemOrganization addCategory: #'VMMaker-Plugins-IOS'!
- SystemOrganization addCategory: #'VMMaker-PostProcessing'!
- SystemOrganization addCategory: #'VMMaker-SmartSyntaxPlugins'!
- SystemOrganization addCategory: #'VMMaker-SpurMemoryManager'!
- SystemOrganization addCategory: #'VMMaker-SpurMemoryManagerSimulation'!
- SystemOrganization addCategory: #'VMMaker-Support'!
- SystemOrganization addCategory: #'VMMaker-Tests'!
- SystemOrganization addCategory: #'VMMaker-Translation to C'!
Item was changed:
TestCase subclass: #AbstractInstructionTests
instanceVariableNames: 'processor opcodes'
classVariableNames: ''
poolDictionaries: 'CogRTLOpcodes'
category: 'VMMaker-Tests'!
+
+ !AbstractInstructionTests commentStamp: 'BenjaminVanRyseghem 9/27/2011 14:04' prior: 0!
+ Use for a test: ClosureCompilerTest>>#closureCases!
Item was changed:
----- Method: CCodeGenerator>>emitCFunctionPrototypes:on: (in category 'C code generator') -----
emitCFunctionPrototypes: methodList on: aStream
"Store prototype declarations for all non-inlined methods on the given stream."
| exporting |
aStream cr; nextPutAll: '/*** Function Prototypes ***/'; cr.
"Hmm, this should be in the sqConfig.h files. For now put it here..."
"Feel free to add equivalents for other compilers"
vmClass notNil ifTrue:
[NoRegParmsInAssertVMs ifTrue:
+ [aStream nextPutAll: '\\#if !!PRODUCTION && defined(__GNUC__) && !!(defined(__MINGW32__) || defined(__MINGW64__)) && !!defined(NoDbgRegParms)\# define NoDbgRegParms __attribute__ ((regparm (0)))\#endif' withCRs.
- [aStream nextPutAll: '\\#if !!PRODUCTION && defined(__GNUC__) && !!defined(NoDbgRegParms)\# define NoDbgRegParms __attribute__ ((regparm (0)))\#endif' withCRs.
aStream nextPutAll: '\\#if !!defined(NoDbgRegParms)\# define NoDbgRegParms /*empty*/\#endif\\' withCRs].
aStream nextPutAll: '\\#if defined(__GNUC__) && !!defined(NeverInline)\# define NeverInline __attribute__ ((noinline))\#endif' withCRs.
aStream nextPutAll: '\\#if !!defined(NeverInline)\# define NeverInline /*empty*/\#endif\\' withCRs].
exporting := false.
(methodList select: [:m| m isRealMethod
and: [self shouldGenerateMethod: m]]) do:
[:m |
self emitExportPragma ifTrue:
[m export
ifTrue: [exporting ifFalse:
[aStream nextPutAll: '#pragma export on'; cr.
exporting := true]]
ifFalse: [exporting ifTrue:
[aStream nextPutAll: '#pragma export off'; cr.
exporting := false]]].
m emitCFunctionPrototype: aStream generator: self.
(NoRegParmsInAssertVMs and: [vmClass notNil and: [m export not and: [m isStatic and: [m args notEmpty]]]]) ifTrue:
[aStream nextPutAll: ' NoDbgRegParms'].
(vmClass notNil and: [m inline == #never]) ifTrue:
[aStream nextPutAll: ' NeverInline'].
aStream nextPut: $; ; cr].
exporting ifTrue: [aStream nextPutAll: '#pragma export off'; cr].
aStream cr!
Item was changed:
----- Method: CCodeGenerator>>emitGlobalCVariablesOn: (in category 'C code generator') -----
emitGlobalCVariablesOn: aStream
"Store the global variable declarations on the given stream."
aStream cr; nextPutAll: '/*** Global Variables ***/'; cr.
+
(self sortStrings: (variables select: [:v| vmClass mustBeGlobal: v])) do:
[:var | | varString decl |
varString := var asString.
decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString].
decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack"
ifTrue:
[aStream nextPutAll: decl; cr]
ifFalse:
+ [
+ ((decl includesSubString: ' private ')
+ or: [decl beginsWith: 'static']) ifFalse: "work-around hack to prevent localization of variables only referenced once."
+ [
+ aStream nextPutAll: 'VM_EXPORT '.
+
+ (decl includes: $=) ifTrue:
- [((decl includesSubString: ' private ')
- "or: [decl beginsWith: 'static']") ifFalse: "work-around hack to prevent localization of variables only referenced once."
- [(decl includes: $=) ifTrue:
[decl := decl copyFrom: 1 to: (decl indexOf: $=) - 1].
aStream
nextPutAll: decl;
nextPut: $;;
cr]]].
aStream cr!
Item was added:
+ ----- Method: CCodeGenerator>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion
+ | memoryManagerVersion |
+ memoryManagerVersion := (self options at: #ObjectMemory ifAbsent: [ #ObjectMemory ]) asClass memoryManagerVersion.
+ ^ self vmClass interpreterVersion, '[', memoryManagerVersion,']'!
Item was added:
+ ----- Method: CCodeGenerator>>isThreadedVM (in category 'testing') -----
+ isThreadedVM
+ ^ self vmClass isThreadedVM!
Item was changed:
----- Method: CCodeGenerator>>nonStructClassesForTranslationClasses: (in category 'utilities') -----
nonStructClassesForTranslationClasses: classes
"Answer in superclass order (any superclass precedes any subclass)
the ancilliaryClasses that are not struct classes for all the given classes."
| nonStructClasses |
nonStructClasses := OrderedCollection new.
classes do:
[:aTranslationClass|
([aTranslationClass ancilliaryClasses: self options]
on: MessageNotUnderstood
do: [:ex|
ex message selector == #ancilliaryClasses:
ifTrue: [#()]
ifFalse: [ex pass]]) do:
[:class|
(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class]) ifTrue:
[(class isStructClass
or: [(nonStructClasses includes: class)
or: [classes includes: class]]) ifFalse:
[nonStructClasses addLast: class]]]].
+ ^Class superclassOrder: nonStructClasses!
- ^ChangeSet superclassOrder: nonStructClasses!
Item was changed:
----- Method: CCodeGenerator>>storeAPIExportHeader:OnFile: (in category 'public') -----
storeAPIExportHeader: headerName OnFile: fullHeaderPath
"Store C header code on the given file. Evaluate
aBlock with the stream to generate its contents."
| header |
header := String streamContents:
[:s|
+ "s nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr."
- s nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr.
self emitCAPIExportHeaderOn: s].
(self needToGenerateHeader: headerName file: fullHeaderPath contents: header) ifTrue:
[self storeHeaderOnFile: fullHeaderPath contents: header]!
Item was changed:
----- Method: CCodeGenerator>>storeHeaderOnFile:contents: (in category 'public') -----
storeHeaderOnFile: fileName contents: contents
"Store C header code on the given file. Evaluate
aBlock with the stream to generate its contents."
| aStream |
aStream := VMMaker forceNewFileNamed: fileName.
aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
+ ["(contents beginsWith: '/* Automatic') ifFalse:
+ [aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr]".
- [(contents beginsWith: '/* Automatic') ifFalse:
- [aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr].
aStream nextPutAll: contents]
ensure: [aStream close]!
Item was changed:
----- Method: CCodeGenerator>>structClassesForTranslationClasses: (in category 'utilities') -----
structClassesForTranslationClasses: classes
"Answer in superclass order (any superclass precedes any subclass)
the ancilliaryClasses that are struct classes for all the given classes."
| theStructClasses |
theStructClasses := OrderedCollection new.
classes do:
[:aTranslationClass|
([aTranslationClass ancilliaryClasses: self options]
on: MessageNotUnderstood
do: [:ex|
ex message selector == #ancilliaryClasses:
ifTrue: [#()]
ifFalse: [ex pass]]) do:
[:class|
(class isStructClass
and: [(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class])
and: [(theStructClasses includes: class) not]]) ifTrue:
[theStructClasses addLast: class]]].
^ChangeSet superclassOrder: theStructClasses!
Item was changed:
----- Method: CoInterpreter class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
"Override to avoid repeating StackInterpreter's declarations and add our own extensions"
+
- | threaded |
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
- threaded := aCCodeGenerator vmClass isThreadedVM.
aCCodeGenerator
addHeaderFile:'"sqCogStackAlignment.h"';
addHeaderFile:'"cogmethod.h"';
+ addHeaderFile: (aCCodeGenerator isThreadedVM
+ ifTrue: ['"cointerpmt.h"']
+ ifFalse: ['"cointerp.h"']);
- addHeaderFile: (threaded ifTrue: ['"cointerpmt.h"'] ifFalse: ['"cointerp.h"']);
addHeaderFile:'"cogit.h"'.
aCCodeGenerator vmClass
declareInterpreterVersionIn: aCCodeGenerator
+ defaultName: aCCodeGenerator interpreterVersion.
- defaultName: (threaded ifTrue: ['Cog MT'] ifFalse: ['Cog']).
aCCodeGenerator
var: #heapBase type: #usqInt;
var: #statCodeCompactionUsecs type: #usqLong;
var: #maxLiteralCountForCompile
declareC: 'sqInt maxLiteralCountForCompile = MaxLiteralCountForCompile /* ', MaxLiteralCountForCompile printString, ' */';
var: #minBackwardJumpCountForCompile
declareC: 'sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* ', MinBackwardJumpCountForCompile printString, ' */'.
aCCodeGenerator
var: #reenterInterpreter
declareC: 'jmp_buf reenterInterpreter; /* private export */'.
aCCodeGenerator
var: #primTraceLogIndex type: #'unsigned char';
var: #primTraceLog declareC: 'sqInt primTraceLog[256]';
var: #traceLog
declareC: 'sqInt traceLog[TraceBufferSize /* ', TraceBufferSize printString, ' */]';
var: #traceSources type: #'char *' array: TraceSources!
Item was added:
+ ----- Method: CoInterpreter class>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion
+ ^ 'Cog'!
Item was changed:
----- Method: CoInterpreter>>initStackPagesAndInterpret (in category 'initialization') -----
initStackPagesAndInterpret
"Initialize the stack pages and enter interpret. Use alloca'ed memory so that when
we have a JIT its stack pointer will be on the native stack since alloca allocates
memory on the stack. Certain thread systems use the native stack pointer as the
frame ID so putting the stack anywhere else can confuse the thread system."
"Override to establish the setjmp/longjmp handler for reentering the interpreter
from machine code, and disable executablity on the heap and stack pages."
"This should be in its own initStackPages method but Slang can't inline
C code strings."
| stackPageBytes stackPagesBytes theStackMemory |
<var: #theStackMemory type: #'char *'>
stackPageBytes := self stackPageByteSize.
stackPagesBytes := self computeStackZoneSize.
theStackMemory := self
cCode: [self alloca: stackPagesBytes]
inSmalltalk: [stackPages initializeWithByteSize: stackPagesBytes for: self].
self cCode: [self me: theStackMemory ms: 0 et: stackPagesBytes].
+ self cppIf: #SPUR_USE_EXECUTABLE_MEMORY
+ ifTrue: [
+ self
+ sqMakeMemoryExecutableFrom: objectMemory startOfMemory asUnsignedInteger
+ To: objectMemory memoryLimit asUnsignedInteger ]
+ ifFalse: [
+ self
+ sqMakeMemoryNotExecutableFrom: objectMemory startOfMemory asUnsignedInteger
+ To: objectMemory memoryLimit asUnsignedInteger ].
+ self
+ sqMakeMemoryNotExecutableFrom: theStackMemory asUnsignedInteger
- self sqMakeMemoryNotExecutableFrom: objectMemory startOfMemory asUnsignedInteger
- To: objectMemory memoryLimit asUnsignedInteger.
- self sqMakeMemoryNotExecutableFrom: theStackMemory asUnsignedInteger
To: theStackMemory asUnsignedInteger + stackPagesBytes.
+
stackPages
initializeStack: theStackMemory
numSlots: stackPagesBytes / objectMemory wordSize
pageSize: stackPageBytes / objectMemory wordSize.
self assert: self minimumUnusedHeadroom = stackPageBytes.
"Once the stack pages are initialized we can continue to bootstrap the system."
self loadInitialContext.
"We're ready for the heartbeat (poll interrupt)"
self ioInitHeartbeat.
self initialEnterSmalltalkExecutive.
^nil!
Item was added:
+ ----- Method: CoInterpreterMT class>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion
+ ^ 'Cog MT'!
Item was changed:
----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
instVarNamesAndTypesForTranslationDo: aBinaryBlock
"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct."
"{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do:
[:c| Transcript print: c; cr. c printTypedefOn: Transcript]"
| machineCodeBytes |
machineCodeBytes := self == CogAbstractInstruction
ifTrue: [0]
ifFalse: [self basicNew machineCodeBytes].
(self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do:
[:ivn|
ivn ~= 'bcpc' ifTrue:
[aBinaryBlock
value: ivn
value: (ivn caseOf: {
['address'] -> ['unsigned long'].
['machineCode'] -> [{'unsigned char'. '[', machineCodeBytes printString, ']'}].
+ ['operands'] -> [{'unsigned long'. '[', NumOperands printString, ']'}].
- ['operands'] -> [{'unsigned long'. '[', NumOperands, ']'}].
['dependent'] -> ['struct _AbstractInstruction *']}
otherwise:
[#char])]]!
Item was changed:
----- Method: CogMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
alignedByteSize
^20 + self baseHeaderSize!
Item was changed:
----- Method: CogMethodSurrogate64 class>>alignedByteSize (in category 'accessing') -----
alignedByteSize
^32 + self baseHeaderSize!
Item was changed:
CoInterpreterMT subclass: #CogVMSimulator
instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends traceOn myBitBlt displayForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-JITSimulation'!
+ !CogVMSimulator commentStamp: 'EstebanLorenzano 10/15/2014 11:45' prior: 0!
- !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0!
This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. Remember that you can test the Cogit using its class-side in-image compilation facilities.
To see the thing actually run, you could (after backing up this image and changes), execute
(CogVMSimulator new openOn: Smalltalk imageName) test
and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image.
Here's an example to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff:
(CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit))
desiredNumStackPages: 8;
openOn: '/Users/eliot/Cog/startreader.image';
openAsMorph;
run
Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out.
| cos proc opts |
CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)).
- CogVMSimulator chooseAndInitCogitClassWithOpts: opts.
cos := CogVMSimulator new.
"cos initializeThreadSupport." "to test the multi-threaded VM"
cos desiredNumStackPages: 8. "to set the size of the stack zone"
"cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone"
cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image"
"cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector"
proc := cos cogit processor.
"cos cogit sendTrace: 7." "turn on tracing"
"set a complex breakpoint at a specific point in machine code"
"cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg| cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1".
"[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit"
"cos cogit setBreakMethod: 16rB38880."
cos
openAsMorph;
"toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window"
halt;
run!
Item was changed:
----- Method: CogVMSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
ioRelinquishProcessorForMicroseconds: microseconds
"In the simulator give an indication that we're idling and check for input.
If called from machine code then increment the byte count since the clock
is derived from it and the clock will not advance otherwise.
If we're simulating threading we're in difficulties. We need a UI process
(to run activities such as fill-in-the-blanks) but we also need an independent
thread of control to run this VM thread. So we need to fork a new UI process."
Display reverse: (0@0 extent: 16@16).
Sensor peekEvent ifNotNil:
[self forceInterruptCheck].
+ Processor activeProcess == UIManager default uiProcess ifTrue:
- Processor activeProcess == Project uiProcess ifTrue:
[World doOneCycle].
microseconds >= 1000
ifTrue: [self isThreadedVM ifTrue:
[self forceInterruptCheckFromHeartbeat].
(Delay forMilliseconds: microseconds + 999 // 1000) wait]
ifFalse: [Processor yield].
byteCount := byteCount + microseconds - 1.
self incrementByteCount!
Item was changed:
----- Method: CogVMSimulator>>openAsMorph (in category 'UI') -----
openAsMorph
"Open a morphic view on this simulation."
+ | localImageName borderWidth theWindow |
+ localImageName := imageName asFileReference basename.
+ theWindow := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
- | localImageName borderWidth window |
- localImageName := imageName
- ifNotNil: [FileDirectory default localNameFor: imageName]
- ifNil: [' synthetic image'].
- window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
+ theWindow addMorph: (displayView := ImageMorph new image: displayForm)
- window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0@0 corner: 1(a)0.8).
+ transcript := ThreadSafeTranscript new.
+ theWindow addMorph: (PluggableTextMorph
- transcript := TranscriptStream on: (String new: 10000).
- window addMorph: (PluggableTextMorph
on: transcript text: nil accept: nil
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0(a)0.8 corner: 0.7@1).
+ theWindow addMorph: (PluggableTextMorph on: self
- window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0.7(a)0.8 corner: 1@1).
borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
on: MessageNotUnderstood
do: [:ex| 0]. "3.8"
+ borderWidth := borderWidth + theWindow borderWidth.
+ theWindow openInWorldExtent: (self desiredDisplayExtent
- borderWidth := borderWidth + window borderWidth.
- window openInWorldExtent: (self desiredDisplayExtent
+ (2 * borderWidth)
+ + (0@theWindow labelHeight)
+ * (1(a)(1/0.8))) rounded!
- + (0@window labelHeight)
- * (1(a)(1/0.8))) rounded.
- ^window!
Item was changed:
----- Method: CogVMSimulator>>openAsMorphNoTranscript (in category 'UI') -----
openAsMorphNoTranscript
"Open a morphic view on this simulation."
+ | localImageName theWindow |
+ localImageName := imageName asFileReference basename.
+ theWindow := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
- | localImageName borderWidth window |
- localImageName := FileDirectory default localNameFor: imageName.
- window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
+ theWindow addMorph: (displayView := ImageMorph new image: displayForm)
- window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0@0 corner: 1(a)0.95).
+ theWindow addMorph: (PluggableTextMorph on: self
- window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0(a)0.95 corner: 1@1).
+ theWindow openInWorldExtent: (self desiredDisplayExtent
+ + (2 * theWindow borderWidth)
+ + (0@theWindow labelHeight)
- borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
- on: MessageNotUnderstood
- do: [:ex| 0]. "3.8"
- borderWidth := borderWidth + window borderWidth.
- window openInWorldExtent: (self desiredDisplayExtent
- + (2 * borderWidth)
- + (0@window labelHeight)
* (1(a)(1/0.95))) rounded!
Item was changed:
----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
primitiveDirectoryEntry
| name pathName array result |
name := self stringOf: self stackTop.
pathName := self stringOf: (self stackValue: 1).
self successful ifFalse:
[^self primitiveFail].
+ array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
- array := FileDirectory default primLookupEntryIn: pathName name: name.
array == nil ifTrue:
[self pop: 3 thenPush: objectMemory nilObject.
^array].
array == #badDirectoryPath ifTrue:
[self halt.
^self primitiveFail].
+ result := self makeDirEntryName: (array at: 1)
+ size: (array at: 1) size
+ createDate: (array at: 2)
+ modDate: (array at: 3)
+ isDir: (array at: 4)
+ fileSize: (array at: 5)
+ posixPermissions: (array at: 6)
+ isSymlink: (array at: 7).
+
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3.
self push: result!
Item was changed:
----- Method: CogVMSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
primitiveDirectoryLookup
| index pathName array result |
index := self stackIntegerValue: 0.
pathName := (self stringOf: (self stackValue: 1)).
self successful ifFalse:
[^self primitiveFail].
+ array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
- array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue:
[self pop: 3 thenPush: objectMemory nilObject.
^array].
array == #badDirectoryPath ifTrue:
["self halt."
^self primitiveFail].
+ result := self makeDirEntryName: (array at: 1)
+ size: (array at: 1) size
+ createDate: (array at: 2)
+ modDate: (array at: 3)
+ isDir: (array at: 4)
+ fileSize: (array at: 5)
+ posixPermissions: (array at: 6)
+ isSymlink: (array at: 7).
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3 thenPush: result!
Item was changed:
----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
#( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass'
'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
[:simulationVariableNotNeededForRealVM|
aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
NewspeakVM ifFalse:
[#( 'dynSuperEntry' 'dynSuperEntryAlignment' 'dynamicSuperSendTrampolines'
'ceImplicitReceiverTrampoline' 'ceEnclosingObjectTrampoline' 'cmDynSuperEntryOffset'
'numIRCs' 'indexOfIRC' 'theIRCs') do:
[:variableNotNeededInNormalVM|
aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
aCCodeGenerator
addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
+ addHeaderFile:'<setjmp.h>';
addHeaderFile:'"sqCogStackAlignment.h"';
addHeaderFile:'"dispdbg.h"'; "must preceed cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
addHeaderFile:'"cogmethod.h"';
addHeaderFile:'#if COGMTVM';
addHeaderFile:'"cointerpmt.h"';
addHeaderFile:'#else';
addHeaderFile:'"cointerp.h"';
addHeaderFile:'#endif';
addHeaderFile:'"cogit.h"'.
aCCodeGenerator
var: #ceGetSP
declareC: 'unsigned long (*ceGetSP)(void)';
var: #ceCaptureCStackPointers
declareC: 'void (*ceCaptureCStackPointers)(void)';
var: #ceEnterCogCodePopReceiverReg
declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
var: #realCEEnterCogCodePopReceiverReg
declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
var: #ceCallCogCodePopReceiverReg
declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
var: #realCECallCogCodePopReceiverReg
declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
var: #ceCallCogCodePopReceiverAndClassRegs
declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
var: #realCECallCogCodePopReceiverAndClassRegs
declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
var: #ceFlushICache
declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
var: #ceCheckFeaturesFunction
declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
var: #ceTryLockVMOwner
declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
var: #ceUnlockVMOwner
declareC: 'void (*ceUnlockVMOwner)(void)';
var: #postCompileHook
declareC: 'void (*postCompileHook)(CogMethod *, void *)';
var: #openPICList declareC: 'CogMethod *openPICList = 0';
var: #maxMethodBefore type: #'CogBlockMethod *'.
aCCodeGenerator
declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel';
var: #primInvokeLabel type: #'AbstractInstruction *'.
self declareC: #(abstractOpcodes stackCheckLabel
blockEntryLabel blockEntryNoContextSwitch
stackOverflowCall sendMiss entry noCheckEntry dynSuperEntry
picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1)
as: #'AbstractInstruction *'
in: aCCodeGenerator.
aCCodeGenerator
declareVar: #annotations type: #'InstructionAnnotation *';
declareVar: #blockStarts type: #'BlockStart *';
declareVar: #fixups type: #'BytecodeFixup *'.
aCCodeGenerator
var: #sendTrampolines
declareC: 'sqInt sendTrampolines[NumSendTrampolines]';
var: #superSendTrampolines
declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
var: #dynamicSuperSendTrampolines
declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
var: #trampolineAddresses
declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
var: #objectReferencesInRuntime
declareC: 'static sqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
var: #labelCounter
type: #int;
var: #traceFlags
declareC: 'int traceFlags = 8 /* prim trace log on by default */';
var: #cStackAlignment
declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
aCCodeGenerator
declareVar: #CFramePointer type: #'void *';
declareVar: #CStackPointer type: #'void *';
declareVar: #minValidCallAddress type: #'unsigned long';
declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
aCCodeGenerator vmClass generatorTable ifNotNil:
[:bytecodeGenTable|
aCCodeGenerator
var: #generatorTable
+ declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
- declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
(self tableInitializerFor: bytecodeGenTable
in: aCCodeGenerator);
var: #primitiveGeneratorTable
declareC: 'static PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]',
(self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
in: aCCodeGenerator)].
"In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic
sugar to avoid the clash."
(self organization listAtCategoryNamed: #'abstract instructions') do:
[:s|
aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!
Item was changed:
----- Method: Cogit>>genCallEnilopmartFor:and:called: (in category 'initialization') -----
genCallEnilopmartFor: regArg1 and: regArg2 called: trampolineName
"An enilopmart (the reverse of a trampoline) is a piece of code that makes
the system-call-like transition from the C runtime into generated machine
code. This version is for entering code as if from a call. The desired
arguments and entry-point are pushed on a stackPage's stack, and beneath
them is the call's return address. The enilopmart pops off the values to be
loaded into registers, and on CISCs then executes a return instruction to pop
off the entry-point and jump to it. On RISCs the enilopmart pops off the values
to be loaded into registers, pops the entry-point into a scratch register, pops
the return address into the LinkReg and then jumps to the entry point.
BEFORE AFTER (stacks grow down)
whatever stackPointer -> whatever
call return pc
target address => reg1 = reg1val, etc
reg1val LinkReg = call return pc
stackPointer -> reg2val pc = target address
C.F. genEnilopmartFor:and:and:called:"
<returnTypeC: 'void (*genCallEnilopmartForandcalled(sqInt regArg1, sqInt regArg2, char *trampolineName))(void)'>
| size endAddress enilopmart |
opcodeIndex := 0.
backEnd genLoadStackPointers.
self PopR: regArg2.
self PopR: regArg1.
backEnd hasLinkRegister
ifTrue:
[self PopR: TempReg.
self PopR: LinkReg.
self JumpR: TempReg]
ifFalse:
[self RetN: 0].
self computeMaximumSizes.
size := self generateInstructionsAt: methodZoneBase.
endAddress := self outputInstructionsAt: methodZoneBase.
self assert: methodZoneBase + size = endAddress.
enilopmart := methodZoneBase.
methodZoneBase := self alignUptoRoutineBoundary: endAddress.
backEnd nopsFrom: endAddress to: methodZoneBase - 1.
self recordGeneratedRunTime: trampolineName address: enilopmart.
^self cCoerceSimple: enilopmart to: #'void (*)(void)'!
Item was changed:
----- Method: Cogit>>genCallEnilopmartFor:called: (in category 'initialization') -----
genCallEnilopmartFor: regArg1 called: trampolineName
"An enilopmart (the reverse of a trampoline) is a piece of code that makes
the system-call-like transition from the C runtime into generated machine
code. This version is for entering code as if from a call. The desired
arguments and entry-point are pushed on a stackPage's stack, and beneath
them is the call's return address. The enilopmart pops off the values to be
loaded into registers, and on CISCs then executes a return instruction to pop
off the entry-point and jump to it. On RISCs the enilopmart pops off the values
to be loaded into registers, pops the entry-point into a scratch register, pops
the return address into the LinkReg and then jumps to the entry point.
BEFORE AFTER (stacks grow down)
whatever stackPointer -> whatever
call return pc reg1 = reg1val
target address => LinkReg = call return pc
stackPointer -> reg1val pc = target address
C.F. genEnilopmartFor:and:and:called:"
<returnTypeC: 'void (*genCallEnilopmartForcalled(sqInt regArg1, char *trampolineName))(void)'>
| size endAddress enilopmart |
opcodeIndex := 0.
backEnd genLoadStackPointers.
self PopR: regArg1.
backEnd hasLinkRegister
ifTrue:
[self PopR: TempReg.
self PopR: LinkReg.
self JumpR: TempReg]
ifFalse:
[self RetN: 0].
self computeMaximumSizes.
size := self generateInstructionsAt: methodZoneBase.
endAddress := self outputInstructionsAt: methodZoneBase.
self assert: methodZoneBase + size = endAddress.
enilopmart := methodZoneBase.
methodZoneBase := self alignUptoRoutineBoundary: endAddress.
backEnd nopsFrom: endAddress to: methodZoneBase - 1.
self recordGeneratedRunTime: trampolineName address: enilopmart.
^self cCoerceSimple: enilopmart to: #'void (*)(void)'!
Item was changed:
----- Method: Cogit>>print: (in category 'printing') -----
print: aString
+ <cmacro: '(aString) printf("%s", aString)'>
- <cmacro: '(aString) printf(aString)'>
coInterpreter transcript print: aString!
Item was changed:
----- Method: CrossPlatformVMMaker>>validatePlugin:in: (in category 'generate sources') -----
validatePlugin: plName in: listOfPlugins
"Check that the class for the plugin exists, and answer that class.
No longer check that if the plugin requires platform files that at least
one platform subdirectory exists, not producing the source is not helpful."
| plugin |
plName isString
ifTrue: [(listOfPlugins includes: plName)
ifTrue: [plugin := Smalltalk classNamed: plName]]
ifFalse: [((plName isBehavior
and: [plName inheritsFrom: InterpreterPlugin])
and: [listOfPlugins includes: plName name])
ifTrue: [plugin := plName]].
plugin ifNil: [^ self couldNotFindPluginClass: plName].
plugin shouldBeTranslated ifFalse:
+ [self error: 'untranslateable plugin class ', plugin name].
- [self error: 'untranslateable plugin class ', plName].
^plugin!
Item was changed:
----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation>>compactClassIndexOfClass: (in category 'accessing') -----
compactClassIndexOfClass: classOop
"Ugh, can't reply on the host. Spur doesn't have compact classes"
| aClass |
aClass := self objectForOop: classOop.
^false
ifTrue: [aClass indexIfCompact]
ifFalse:
[aClass caseOf: {
[CompiledMethod] -> [1].
[Array] -> [3].
[LargeNegativeInteger] -> [4].
[LargePositiveInteger] -> [5].
[Float] -> [6].
[Association] -> [8].
[Point] -> [9].
[Rectangle] -> [10].
[ByteString] -> [11].
+ [Context] -> [14].
- [MethodContext] -> [14].
[Bitmap] -> [16]
}
otherwise: [0]]!
Item was removed:
- ----- Method: DetailedInstructionPrinter class>>on: (in category 'instance creation') -----
- on: method
- "Answer an instance of me on the argument, method."
-
- ^self new method: method pc: method initialPC!
Item was added:
+ SmartSyntaxInterpreterPlugin subclass: #DisplayPlugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was removed:
- ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'directory primitives') -----
- makeDirEntryName: entryName size: entryNameSize
- createDate: createDate modDate: modifiedDate
- isDir: dirFlag fileSize: fileSize
-
- | modDateOop createDateOop nameString results stringPtr fileSizeOop |
- <var: 'entryName' type: 'char *'>
- <var: 'stringPtr' type:'char *'>
- <var: 'fileSize' type:'squeakFileOffsetType '>
-
- "allocate storage for results, remapping newly allocated
- oops in case GC happens during allocation"
- interpreterProxy pushRemappableOop:
- (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 5).
- interpreterProxy pushRemappableOop:
- (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: createDate).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: modifiedDate).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive64BitIntegerFor: fileSize).
-
- fileSizeOop := interpreterProxy popRemappableOop.
- modDateOop := interpreterProxy popRemappableOop.
- createDateOop := interpreterProxy popRemappableOop.
- nameString := interpreterProxy popRemappableOop.
- results := interpreterProxy popRemappableOop.
-
- "copy name into Smalltalk string"
- stringPtr := interpreterProxy firstIndexableField: nameString.
- 0 to: entryNameSize - 1 do: [ :i |
- stringPtr at: i put: (entryName at: i).
- ].
-
- interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
- interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
- interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
- dirFlag
- ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
- ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
- interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
- ^ results!
Item was added:
+ ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'directory primitives') -----
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: fileSize
+ posixPermissions: posixPermissions
+ isSymlink: symlinkFlag
+
+ | modDateOop createDateOop nameString results stringPtr posixPermissionsOop fileSizeOop |
+ <var: 'entryName' type: 'char *'>
+ <var: 'stringPtr' type: 'char *'>
+ <var: 'fileSize' type: 'squeakFileOffsetType '>
+
+ "allocate storage for results, remapping newly allocated
+ oops in case GC happens during allocation"
+ interpreterProxy pushRemappableOop:
+ (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 7).
+ interpreterProxy pushRemappableOop:
+ (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
+ interpreterProxy pushRemappableOop:
+ (interpreterProxy positive32BitIntegerFor: createDate).
+ interpreterProxy pushRemappableOop:
+ (interpreterProxy positive32BitIntegerFor: modifiedDate).
+ interpreterProxy pushRemappableOop:
+ (interpreterProxy positive64BitIntegerFor: fileSize).
+ interpreterProxy pushRemappableOop:
+ (interpreterProxy positive32BitIntegerFor: posixPermissions).
+
+ posixPermissionsOop := interpreterProxy popRemappableOop.
+ fileSizeOop := interpreterProxy popRemappableOop.
+ modDateOop := interpreterProxy popRemappableOop.
+ createDateOop := interpreterProxy popRemappableOop.
+ nameString := interpreterProxy popRemappableOop.
+ results := interpreterProxy popRemappableOop.
+
+ "copy name into Smalltalk string"
+ stringPtr := interpreterProxy firstIndexableField: nameString.
+ 0 to: entryNameSize - 1 do: [ :i |
+ stringPtr at: i put: (entryName at: i).
+ ].
+
+ interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
+ interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
+ interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
+ dirFlag
+ ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
+ ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
+ interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
+ interpreterProxy storePointer: 5 ofObject: results withValue: posixPermissionsOop.
+ symlinkFlag
+ ifTrue: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy trueObject ]
+ ifFalse: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy falseObject ].
+ ^ results!
Item was changed:
----- Method: FilePlugin>>primitiveDirectoryEntry (in category 'directory primitives') -----
primitiveDirectoryEntry
"Two arguments - directory path, and simple file name;
returns an array (see primitiveDirectoryLookup) describing the file or directory,
or nil if it does not exist.
Primitive fails if the outer path does not identify a readable directory.
(This is a lookup-by-name variant of primitiveDirectoryLookup.)"
+ | requestedName pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag posixPermissions symlinkFlag fileSize okToList reqNameIndex reqNameSize |
- | requestedName pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag fileSize okToList reqNameIndex reqNameSize |
<var: 'entryName' declareC: 'char entryName[256]'>
<var: 'pathNameIndex' type: 'char *'>
<var: 'reqNameIndex' type: 'char *'>
<var: 'fileSize' type: 'squeakFileOffsetType'>
<export: true>
requestedName := interpreterProxy stackValue: 0.
pathName := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: pathName)
ifFalse: [^interpreterProxy primitiveFail].
"Outbound string parameters"
pathNameIndex := interpreterProxy firstIndexableField: pathName.
pathNameSize := interpreterProxy byteSizeOf: pathName.
reqNameIndex := interpreterProxy firstIndexableField: requestedName.
reqNameSize := interpreterProxy byteSizeOf: requestedName.
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
sCLPfn ~= 0
ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)']
ifFalse: [okToList := true].
okToList
+ ifTrue: [status := self cCode: 'dir_EntryLookup(
+ pathNameIndex,
+ pathNameSize,
+ reqNameIndex,
+ reqNameSize,
+ entryName,
+ &entryNameSize,
+ &createDate,
+ &modifiedDate,
+ &dirFlag,
+ &fileSize,
+ &posixPermissions,
+ &symlinkFlag)']
- ifTrue: [status := self cCode: 'dir_EntryLookup(pathNameIndex, pathNameSize, reqNameIndex, reqNameSize,
- entryName, &entryNameSize, &createDate,
- &modifiedDate, &dirFlag, &fileSize)']
ifFalse: [status := DirNoMoreEntries].
interpreterProxy failed
ifTrue: [^nil].
status = DirNoMoreEntries
ifTrue: ["no entry; return nil"
interpreterProxy pop: 3 "pop pathName, index, rcvr"
thenPush: interpreterProxy nilObject.
^nil].
status = DirBadPath
ifTrue: [^interpreterProxy primitiveFail]."bad path"
interpreterProxy pop: 3 "pop pathName, fName, rcvr"
thenPush: (self
makeDirEntryName: entryName
size: entryNameSize
createDate: createDate
modDate: modifiedDate
isDir: dirFlag
+ fileSize: fileSize
+ posixPermissions: posixPermissions
+ isSymlink: symlinkFlag)!
- fileSize: fileSize)!
Item was changed:
----- Method: FilePlugin>>primitiveDirectoryLookup (in category 'directory primitives') -----
primitiveDirectoryLookup
+ | index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag symlinkFlag posixPermissions fileSize okToList |
- | index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag fileSize okToList |
<var: 'entryName' declareC: 'char entryName[256]'>
<var: 'pathNameIndex' type: 'char *'>
<var: 'fileSize' type: 'squeakFileOffsetType'>
<export: true>
index := interpreterProxy stackIntegerValue: 0.
pathName := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: pathName)
ifFalse: [^interpreterProxy primitiveFail].
pathNameIndex := interpreterProxy firstIndexableField: pathName.
pathNameSize := interpreterProxy byteSizeOf: pathName.
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
sCLPfn ~= 0
ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)']
ifFalse: [okToList := true].
okToList
+ ifTrue: [status := self cCode: 'dir_Lookup(
+ pathNameIndex,
+ pathNameSize,
+ index,
+ entryName,
+ &entryNameSize,
+ &createDate,
+ &modifiedDate,
+ &dirFlag,
+ &fileSize,
+ &posixPermissions,
+ &symlinkFlag)']
- ifTrue: [status := self cCode: 'dir_Lookup(pathNameIndex, pathNameSize, index,
- entryName, &entryNameSize, &createDate,
- &modifiedDate, &dirFlag, &fileSize)']
ifFalse: [status := DirNoMoreEntries].
interpreterProxy failed
ifTrue: [^nil].
status = DirNoMoreEntries
ifTrue: ["no more entries; return nil"
interpreterProxy pop: 3 "pop pathName, index, rcvr"
thenPush: interpreterProxy nilObject.
^nil].
status = DirBadPath
ifTrue: [^interpreterProxy primitiveFail]."bad path"
interpreterProxy pop: 3 "pop pathName, index, rcvr"
thenPush: (self
makeDirEntryName: entryName
size: entryNameSize
createDate: createDate
modDate: modifiedDate
isDir: dirFlag
+ fileSize: fileSize
+ posixPermissions: posixPermissions
+ isSymlink: symlinkFlag)!
- fileSize: fileSize)!
Item was removed:
- ----- Method: FilePluginSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'simulation') -----
- makeDirEntryName: entryName size: entryNameSize
- createDate: createDate modDate: modifiedDate
- isDir: dirFlag fileSize: fileSize
-
- ^interpreterProxy
- makeDirEntryName: entryName size: entryNameSize
- createDate: createDate modDate: modifiedDate
- isDir: dirFlag fileSize: fileSize
- !
Item was added:
+ ----- Method: FilePluginSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'file primitives') -----
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: fileSize
+ posixPermissions: posixPermissions
+ isSymlink: symlinkFlag
+
+ ^interpreterProxy
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: fileSize
+ posixPermissions: posixPermissions
+ isSymlink: symlinkFlag
+ !
Item was changed:
----- Method: Integer>>asUnsignedInteger (in category '*VMMaker-interpreter simulator') -----
asUnsignedInteger
self assert: self >= 0.
^self!
Item was changed:
----- Method: Interpreter class>>requiredMethodNames: (in category 'translation') -----
requiredMethodNames: options
"return the list of method names that should be retained for export or other support reasons"
| requiredList |
requiredList := Set new: 400.
"A number of methods required by VM support code, jitter, specific platforms etc"
requiredList addAll: #(fullDisplayUpdate interpret printCallStack printAllStacks printOop: readImageFromFile:HeapSize:StartingAt: success: readableFormat: getCurrentBytecode characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: loadInitialContext nullCompilerHook primitiveFlushExternalPrimitives setCompilerInitialized: getFullScreenFlag getInterruptCheckCounter getInterruptKeycode getInterruptPending getNextWakeupTick getSavedWindowSize setFullScreenFlag: setInterruptCheckCounter: setInterruptKeycode: setInterruptPending: setNextWakeupTick: setSavedWindowSize: forceInterruptCheck getThisSessionID).
"Nice to actually have all the primitives available"
requiredList addAll: self primitiveTable.
"InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
InterpreterProxy organization categories do: [:cat |
+ ((cat ~= 'initialize')
+ and: [ cat ~= 'private' ]
+ and: [ cat ~= '-- all --' ]) ifTrue: [
- ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [
requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
^requiredList!
Item was changed:
----- Method: Interpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
<var: #f type: 'sqImageFile '>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
metaclassSizeBits := 6 * self wordSize. "guess (Metaclass instSize * BPW)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - self wordSize. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
specialObjectsOop := self getLongFromFile: f swap: swapBytes.
lastHash := self getLongFromFile: f swap: swapBytes.
savedWindowSize := self getLongFromFile: f swap: swapBytes.
fullScreenFlag := self getLongFromFile: f swap: swapBytes.
extraVMMemory := self getLongFromFile: f swap: swapBytes.
lastHash = 0 ifTrue: [
"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
lastHash := 999].
"decrease Squeak object heap to leave extra memory for the VM"
heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
"compare memory requirements with availability".
minimumMemory := dataSize + 100000. "need at least 100K of breathing room"
heapSize < minimumMemory ifTrue: [
self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap"
memory := self cCode: 'sqAllocateMemory(minimumMemory, heapSize)'.
memory = nil ifTrue: [self insufficientMemoryAvailableError].
memStart := self startOfMemory.
self setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
self setEndOfMemory: memStart + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
+ bytesRead := self cCode: 'sqImageFileReadEntireImage(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
- bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
swapBytes ifTrue: [self reverseBytesInImage].
"compute difference between old and new memory base addresses"
bytesToShift := memStart - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
^ dataSize
!
Item was changed:
----- Method: InterpreterPlugin class>>shouldBeTranslated (in category 'translation') -----
shouldBeTranslated
"is this class intended to be translated as a plugin? Most subclasses should answer true, but some such as:-
TestInterpreterPlugin
FlippArrayPlugin2
InflatePlugin
should answer false for various reasons."
^true!
Item was changed:
----- Method: InterpreterPlugin class>>shouldBeTranslatedFor: (in category 'translation') -----
shouldBeTranslatedFor: platformName
"Is this class intended to be translated as a plugin, perhaps specific to a platform?
Most subclasses should answer true, but some such as simulation-only versions
should answer false for various reasons."
^self shouldBeTranslated!
Item was changed:
----- Method: InterpreterPlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
translateInDirectory: directory doInlining: inlineFlag
"This is the default method for writing out sources for a plugin. Several classes need special handling, so look at all implementors of this message"
| cg fname fstat |
fname := self moduleName, '.c'.
"don't translate if the file is newer than my timeStamp"
fstat := directory entryAt: fname ifAbsent:[nil].
fstat ifNotNil:
[((self pluginClassesUpTo: self) allSatisfy:
+ [:aPluginClass| aPluginClass timeStamp < fstat modificationTime asSeconds ]) ifTrue:
- [:aPluginClass| aPluginClass timeStamp < fstat modificationTime]) ifTrue:
[^nil]].
self initialize.
cg := self buildCodeGeneratorUpTo: self.
cg inferTypesForImplicitlyTypedVariablesAndMethods.
self pruneUnusedInterpreterPluginMethodsIn: cg.
cg storeCodeOnFile: (directory fullNameFor: fname) doInlining: inlineFlag.
^cg exportedPrimitiveNames asArray!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveGetNextEvent (in category 'I/O primitives') -----
primitiveGetNextEvent
"Primitive. Return the next input event from the VM event queue."
+ | evtBuf arg value eventTypeIs |
- | evtBuf arg value |
<var: #evtBuf declareC:'int evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'>
self cCode:'' inSmalltalk:[evtBuf := CArrayAccessor on: (IntegerArray new: 8)].
arg := self stackTop.
((objectMemory isArray: arg) and:[(objectMemory slotSizeOf: arg) = 8]) ifFalse:[^self primitiveFail].
self ioGetNextEvent: (self cCoerce: evtBuf to: 'sqInputEvent*').
self successful ifFalse:[^nil].
"Event type"
+ eventTypeIs := evtBuf at: 0.
self storeInteger: 0 ofObject: arg withValue: (evtBuf at: 0).
self successful ifFalse:[^nil].
+ "Event is Complex, assume evtBuf is populated correctly and return"
+ eventTypeIs = 6
+ ifTrue: [
+ 1 to: 7 do: [:i |
+ value := evtBuf at: i.
+ self storePointer: i ofObject: arg withValue: value]]
+ ifFalse: [
+ "Event time stamp"
+ self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
+ self successful ifFalse:[^nil].
- "Event time stamp"
- self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
- self successful ifFalse:[^nil].
+ "Event arguments"
+ 2 to: 7 do:[:i|
+ value := evtBuf at: i.
+ (objectMemory isIntegerValue: value)
+ ifTrue:[self storeInteger: i ofObject: arg withValue: value]
+ ifFalse:[
+ value := self positive32BitIntegerFor: value.
+ objectMemory storePointer: i ofObject: arg withValue: value] ] ].
- "Event arguments"
- 2 to: 7 do:[:i|
- value := evtBuf at: i.
- (objectMemory isIntegerValue: value)
- ifTrue:[self storeInteger: i ofObject: arg withValue: value]
- ifFalse:[value := self positive32BitIntegerFor: value.
- objectMemory storePointer: i ofObject: arg withValue: value]].
self successful ifFalse:[^nil].
self pop: 1!
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveImageFormatVersion (in category 'other primitives') -----
+ primitiveImageFormatVersion
+ "Answer an integer identifying the type of image. The image version number may
+ identify the format of the image (e.g. 32 or 64-bit word size) or specific requirements
+ of the image (e.g. block closure support required).
+
+ This is a named (not numbered) primitive in the null module (ie the VM)"
+
+ <export: true>
+ self pop: 1 thenPush: (self positive32BitIntegerFor: self imageFormatVersion)
+ !
Item was changed:
----- Method: InterpreterProxy>>callbackLeave: (in category 'callback support') -----
callbackLeave: cbID
"Leave from a previous callback"
+ "<var: #callbackID type: #'sqInt *'>"
- <var: #callbackID type: #'sqInt *'>
^self notYetImplementedError!
Item was changed:
----- Method: InterpreterProxy>>isImmediate: (in category 'testing') -----
isImmediate: anObject
<option: #(atLeastVMProxyMajor:minor: 1 13)>
^StackInterpreter objectMemoryClass isImmediate: anObject!
Item was changed:
----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the InterpreterSimulator when running the interpreter inside
Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := self integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
rootTable := Array new: RootTableSize.
weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
remapBuffer := Array new: RemapBufferSize.
gcSemaphoreIndex := 0.
semaphoresUseBufferA := true.
semaphoresToSignalA := Array new: SemaphoresToSignalSize.
semaphoresToSignalB := Array new: SemaphoresToSignalSize.
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
primitiveTable := self class primitiveTable.
pluginList := {'' -> self }.
mappedPluginEntries := #().
"initialize InterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := "printReturns := printBytecodeAtEachStep :=" false.
myBitBlt := BitBltSimulator new setInterpreter: self.
headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes.
transcript := Transcript.
+ displayForm := 'Display has not yet been installed' asMorph imageForm.
- displayForm := 'Display has not yet been installed' asDisplayText form.
!
Item was removed:
- ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
- makeDirEntryName: entryName size: entryNameSize
- createDate: createDate modDate: modifiedDate
- isDir: dirFlag fileSize: fileSize
-
- | modDateOop createDateOop nameString results |
- <var: 'entryName' type: 'char *'>
-
- "allocate storage for results, remapping newly allocated
- oops in case GC happens during allocation"
- self pushRemappableOop:
- (self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
- self pushRemappableOop:
- (self instantiateClass: (self splObj: ClassByteString) indexableSize: entryNameSize).
- self pushRemappableOop: (self positive32BitIntegerFor: createDate).
- self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
-
- modDateOop := self popRemappableOop.
- createDateOop := self popRemappableOop.
- nameString := self popRemappableOop.
- results := self popRemappableOop.
-
- 1 to: entryNameSize do: [ :i |
- self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
- ].
-
- self storePointer: 0 ofObject: results withValue: nameString.
- self storePointer: 1 ofObject: results withValue: createDateOop.
- self storePointer: 2 ofObject: results withValue: modDateOop.
- dirFlag
- ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
- ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
- self storePointer: 4 ofObject: results
- withValue: (self integerObjectOf: fileSize).
- ^ results
- !
Item was added:
+ ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: posixPermissions
+ posixPermissions: fileSize
+
+ | modDateOop createDateOop nameString results |
+ <var: 'entryName' type: 'char *'>
+
+ "allocate storage for results, remapping newly allocated
+ oops in case GC happens during allocation"
+ self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
+ self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize)..
+ self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
+
+ modDateOop := self popRemappableOop.
+ createDateOop := self popRemappableOop.
+ nameString := self popRemappableOop.
+ results := self popRemappableOop.
+
+ 1 to: entryNameSize do: [ :i |
+ self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
+ ].
+
+ self storePointer: 0 ofObject: results withValue: nameString.
+ self storePointer: 1 ofObject: results withValue: createDateOop.
+ self storePointer: 2 ofObject: results withValue: modDateOop.
+ dirFlag
+ ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
+ ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
+ self storePointer: 4
+ ofObject: results
+ withValue: (self integerObjectOf: fileSize).
+ self storePointer: 5
+ ofObject: results
+ withValue: (self integerObjectOf: posixPermissions).
+
+ ^ results
+ !
Item was added:
+ ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: posixPermissions
+ posixPermissions: fileSize
+ isSymlink: symlinkFlag
+
+ | modDateOop createDateOop nameString results |
+ <var: 'entryName' type: 'char *'>
+
+ "allocate storage for results, remapping newly allocated
+ oops in case GC happens during allocation"
+ self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassArray) indexableSize: 6).
+ self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize)..
+ self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
+
+ modDateOop := self popRemappableOop.
+ createDateOop := self popRemappableOop.
+ nameString := self popRemappableOop.
+ results := self popRemappableOop.
+
+ 1 to: entryNameSize do: [ :i |
+ self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
+ ].
+
+ self storePointer: 0 ofObject: results withValue: nameString.
+ self storePointer: 1 ofObject: results withValue: createDateOop.
+ self storePointer: 2 ofObject: results withValue: modDateOop.
+ dirFlag
+ ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
+ ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
+ self storePointer: 4
+ ofObject: results
+ withValue: (self integerObjectOf: fileSize).
+ self storePointer: 5
+ ofObject: results
+ withValue: (self integerObjectOf: posixPermissions).
+ dirFlag
+ ifTrue: [ self storePointer: 6 ofObject: results withValue: trueObj ]
+ ifFalse: [ self storePointer: 6 ofObject: results withValue: falseObj ].
+
+ ^ results
+ !
Item was changed:
----- Method: InterpreterSimulator>>openAsMorph (in category 'UI') -----
openAsMorph
"Open a morphic view on this simulation."
| window localImageName |
+ localImageName := imageName asFileReference basename.
- localImageName := imageName
- ifNotNil: [FileDirectory default localNameFor: imageName]
- ifNil: [' synthetic image'].
window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0@0 corner: 1(a)0.8).
+ transcript := ThreadSafeTranscript new.
- transcript := TranscriptStream on: (String new: 10000).
window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0(a)0.8 corner: 0.7@1).
window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil) hideScrollBarsIndefinitely
frame: (0.7(a)0.8 corner: 1@1).
+ window openInWorld!
- window openInWorld.
- ^window!
Item was changed:
----- Method: InterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
primitiveDirectoryEntry
| name pathName array result |
name := self stringOf: self stackTop.
pathName := self stringOf: (self stackValue: 1).
successFlag ifFalse:
[^self primitiveFail].
+ array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
- array := FileDirectory default primLookupEntryIn: pathName name: name.
array == nil ifTrue:
[self pop: 3 thenPush: nilObj.
^array].
array == #badDirectoryPath ifTrue:
[self halt.
^self primitiveFail].
+ result := self makeDirEntryName: (array at: 1)
+ size: (array at: 1) size
+ createDate: (array at: 2)
+ modDate: (array at: 3)
+ isDir: (array at: 4)
+ fileSize: (array at: 5)
+ posixPermissions: (array at: 6)
+ isSymlink: (array at: 7).
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3.
self push: result!
Item was changed:
----- Method: InterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
primitiveDirectoryLookup
| index pathName array result |
index := self stackIntegerValue: 0.
pathName := (self stringOf: (self stackValue: 1)).
successFlag ifFalse: [
^self primitiveFail.
].
+ array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
- array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue: [
self pop: 3.
self push: nilObj.
^array.
].
array == #badDirectoryPath ifTrue: [self halt.
^self primitiveFail.
].
+ result := self makeDirEntryName: (array at: 1)
+ size: (array at: 1) size
+ createDate: (array at: 2)
+ modDate: (array at: 3)
+ isDir: (array at: 4)
+ fileSize: (array at: 5)
+ posixPermissions: (array at: 6)
+ isSymlink: (array at: 7).
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3.
self push: result.
!
Item was changed:
InterpreterPlugin subclass: #MiscPrimitivePlugin
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-Plugins'!
+ !MiscPrimitivePlugin commentStamp: 'dtl 12/2/2009 11:28' prior: 0!
+ This plugin pulls together a number of translatable methods with no particularly meaningful home. See class>translatedPrimitives for the list.
+
+ The primitives in this plugin consist of various methods in the image that can benefit greatly from translation to C, but that do not inherently require translation. These may be thought of not as traditional primitives, but as methods that have been annotated for translation to C by this plugin. This approach allows performance critical methods to be written entirely in Smalltalk, then marked for translation as needed to achieve improved performance.!
- !MiscPrimitivePlugin commentStamp: 'tpr 5/5/2003 12:18' prior: 0!
- This plugin pulls together a number of translatable methods with no particularly meaningful home. See class>translatedPrimitives for the list!
Item was changed:
----- Method: MiscPrimitivePlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
translateInDirectory: directory doInlining: inlineFlag
"handle a special case code string rather than normal generated code."
| cg fname fstat |
fname := self moduleName, '.c'.
"don't translate if the file is newer than my timeStamp"
fstat := directory entryAt: fname ifAbsent:[nil].
+ fstat ifNotNil:[self timeStamp < fstat modificationTime asSeconds ifTrue:[^nil]].
- fstat ifNotNil:[self timeStamp < fstat modificationTime ifTrue:[^nil]].
self initialize.
cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
cg addMethodsForPrimitives: self translatedPrimitives.
self pruneUnusedInterpreterPluginMethodsIn: cg.
self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: fname).
^cg exportedPrimitiveNames asArray
!
Item was changed:
----- Method: MiscPrimitivePlugin class>>translatedPrimitives (in category 'translation') -----
translatedPrimitives
"an assorted list of various primitives"
^#(
(Bitmap compress:toByteArray:)
(Bitmap decompress:fromByteArray:at:)
(Bitmap encodeBytesOf:in:at:)
(Bitmap encodeInt:in:at:)
(ByteString compare:with:collated:)
(ByteString translate:from:to:table:)
(ByteString findFirstInString:inSet:startingAt:)
(ByteString indexOfAscii:inString:startingAt:)
+ (String findSubstringViaPrimitive:in:startingAt:matchTable:)
- (ByteString findSubstring:in:startingAt:matchTable:)
(ByteArray hashBytes:startingWith:)
(SampledSound convert8bitSignedFrom:to16Bit:)
)
"| tps |
'This opens a list browser on all translated primitives in the image'.
tps := (SystemNavigation default allImplementorsOf: #translatedPrimitives)
inject: Set new
into: [:tp :mr|
tp addAll: (mr actualClass theNonMetaClass translatedPrimitives collect:
[:pair|
MethodReference
class: (((Smalltalk at: pair first) canUnderstand: pair last)
ifTrue: [Smalltalk at: pair first]
ifFalse: [(Smalltalk at: pair first) class])
selector: pair last]);
yourself].
SystemNavigation default browseMessageList: tps asArray sort name: 'Translated Primitives' "!
Item was changed:
----- Method: NewspeakInterpreter class>>requiredMethodNames: (in category 'translation') -----
requiredMethodNames: options
"return the list of method names that should be retained for export or other support reasons"
| requiredList |
requiredList := self exportAPISelectors: options.
"A number of methods required by VM support code, jitter, specific platforms etc"
requiredList addAll: #(fullDisplayUpdate interpret printCallStack printAllStacks printOop: readImageFromFile:HeapSize:StartingAt: success: readableFormat: getCurrentBytecode characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: loadInitialContext primitiveFlushExternalPrimitives getFullScreenFlag getInterruptCheckCounter getInterruptKeycode getInterruptPending getNextWakeupTick getSavedWindowSize setFullScreenFlag: setInterruptCheckCounter: setInterruptKeycode: setInterruptPending: setNextWakeupTick: setSavedWindowSize: forceInterruptCheck getThisSessionID getDeferDisplayUpdates validInstructionPointer:inMethod:).
"Nice to actually have all the primitives available"
requiredList addAll: self primitiveTable.
"InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
InterpreterProxy organization categories do: [:cat |
+ ((cat ~= 'initialize')
+ and: [ cat ~= 'private' ]
+ and: [ cat ~= '-- all --' ]) ifTrue: [
- ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [
requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
^requiredList!
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: posixPermissions
+ posixPermissions: fileSize
+
+ | modDateOop createDateOop nameString results |
+ <var: 'entryName' type: 'char *'>
+
+ "allocate storage for results, remapping newly allocated
+ oops in case GC happens during allocation"
+ self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
+ self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize).
+ self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
+
+ modDateOop := self popRemappableOop.
+ createDateOop := self popRemappableOop.
+ nameString := self popRemappableOop.
+ results := self popRemappableOop.
+
+ 1 to: entryNameSize do: [ :i |
+ self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
+ ].
+
+ self storePointer: 0 ofObject: results withValue: nameString.
+ self storePointer: 1 ofObject: results withValue: createDateOop.
+ self storePointer: 2 ofObject: results withValue: modDateOop.
+ dirFlag
+ ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
+ ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
+ self storePointer: 4 ofObject: results
+ withValue: (self integerObjectOf: fileSize).
+ self storePointer: 5 ofObject: results
+ withValue: (self integerObjectOf: posixPermissions).
+ ^ results
+ !
Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: posixPermissions
+ posixPermissions: fileSize
+ isSymlink: symlinkFlag
+
+ | modDateOop createDateOop nameString results |
+ <var: 'entryName' type: 'char *'>
+
+ "allocate storage for results, remapping newly allocated
+ oops in case GC happens during allocation"
+ self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassArray) indexableSize: 6).
+ self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize).
+ self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
+
+ modDateOop := self popRemappableOop.
+ createDateOop := self popRemappableOop.
+ nameString := self popRemappableOop.
+ results := self popRemappableOop.
+
+ 1 to: entryNameSize do: [ :i |
+ self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
+ ].
+
+ self storePointer: 0 ofObject: results withValue: nameString.
+ self storePointer: 1 ofObject: results withValue: createDateOop.
+ self storePointer: 2 ofObject: results withValue: modDateOop.
+ dirFlag
+ ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
+ ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
+ self storePointer: 4 ofObject: results
+ withValue: (self integerObjectOf: fileSize).
+ self storePointer: 5 ofObject: results
+ withValue: (self integerObjectOf: posixPermissions).
+ symlinkFlag
+ ifTrue: [ self storePointer: 6 ofObject: results withValue: trueObj ]
+ ifFalse: [ self storePointer: 6 ofObject: results withValue: falseObj ].
+
+ ^ results
+ !
Item was changed:
----- Method: NewspeakInterpreterSimulator>>openAsMorph (in category 'UI') -----
openAsMorph
"Open a morphic view on this simulation."
| window localImageName |
+ localImageName := imageName asFileReference basename.
- localImageName := imageName
- ifNotNil: [FileDirectory default localNameFor: imageName]
- ifNil: [' synthetic image'].
window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0@0 corner: 1(a)0.8).
+ transcript := ThreadSafeTranscript new.
- transcript := TranscriptStream on: (String new: 10000).
window addMorph: (PluggableTextMorph
on: transcript text: nil accept: nil
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0(a)0.8 corner: 0.7@1).
window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0.7(a)0.8 corner: 1@1).
window openInWorldExtent: (self desiredDisplayExtent
+ (2 * window borderWidth)
+ (0@window labelHeight)
+ * (1(a)(1/0.8))) rounded!
- * (1(a)(1/0.8))) rounded.
- ^window!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>openAsMorphNoTranscript (in category 'UI') -----
openAsMorphNoTranscript
"Open a morphic view on this simulation."
| window localImageName |
+ localImageName := imageName asFileReference basename.
- localImageName := FileDirectory default localNameFor: imageName.
window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0@0 corner: 1(a)0.95).
window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil) hideScrollBarsIndefinitely
frame: (0(a)0.95 corner: 1@1).
window openInWorldExtent: (self desiredDisplayExtent
+ (2 * window borderWidth)
+ (0@window labelHeight)
* (1(a)(1/0.95))) rounded!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
primitiveDirectoryEntry
| name pathName array result |
name := self stringOf: self stackTop.
pathName := self stringOf: (self stackValue: 1).
self successful ifFalse:
[^self primitiveFail].
+ array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
- array := FileDirectory default primLookupEntryIn: pathName name: name.
array == nil ifTrue:
[self pop: 3 thenPush: nilObj.
^array].
array == #badDirectoryPath ifTrue:
[self halt.
^self primitiveFail].
+ result := self makeDirEntryName: (array at: 1)
+ size: (array at: 1) size
+ createDate: (array at: 2)
+ modDate: (array at: 3)
+ isDir: (array at: 4)
+ fileSize: (array at: 5)
+ posixPermissions: (array at: 6)
+ isSymlink: (array at: 7).
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3.
self push: result!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
primitiveDirectoryLookup
| index pathName array result |
index := self stackIntegerValue: 0.
pathName := (self stringOf: (self stackValue: 1)).
self successful ifFalse: [
^self primitiveFail.
].
+ array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
- array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue: [
self pop: 3.
self push: nilObj.
^array.
].
array == #badDirectoryPath ifTrue: [self halt.
^self primitiveFail.
].
+ result := self makeDirEntryName: (array at: 1)
+ size: (array at: 1) size
+ createDate: (array at: 2)
+ modDate: (array at: 3)
+ isDir: (array at: 4)
+ fileSize: (array at: 5)
+ posixPermissions: (array at: 6)
+ isSymlink: (array at: 7).
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3.
self push: result.
!
Item was changed:
----- Method: ObjectMemory class>>initializeObjectHeaderConstants (in category 'initialization') -----
initializeObjectHeaderConstants
BytesPerWord ifNil: [BytesPerWord := 4]. "May get called on fileIn, so supply default"
BaseHeaderSize := BytesPerWord.
+ BytesPerOop := BytesPerWord.
WordMask := (1 bitShift: BytesPerWord*8) - 1.
"masks for type field"
TypeMask := 3.
AllButTypeMask := WordMask - TypeMask.
"type field values"
HeaderTypeSizeAndClass := 0.
HeaderTypeClass := 1.
HeaderTypeFree := 2.
HeaderTypeShort := 3.
HeaderTypeExtraBytes := { BytesPerWord * 2. BytesPerWord. 0. 0 }.
"type field values used during the mark phase of GC"
HeaderTypeGC := 2.
GCTopMarker := 3. "neither an oop, nor an oop+1, this value signals that we have crawled back up to the top of the marking phase."
"Base header word bit fields"
HashBits := 16r1FFE0000.
HashBitsOffset := 17.
HashMaskUnshifted := 16rFFF.
self assert: (HashMaskUnshifted bitShift: HashBitsOffset) = HashBits.
AllButHashBits := WordMask - HashBits.
SizeMask := 16rFC.
Size4Bit := 0.
BytesPerWord = 8 ifTrue:
[SizeMask := 16rF8. "Lose the 4 bit in temp 64-bit chunk format"
Size4Bit := 4]. "But need it for ST size"
"Note SizeMask + Size4Bit gives the mask needed for size fits of format word in classes.
This is used in instantiateClass:indexableSize: "
LongSizeMask := WordMask - 16rFF + SizeMask.
LongSizeNumBits := 30. "30 bits of size info in long size filed."
CompactClassMask := 16r1F000.
"masks for root and mark bits"
MarkBit := 1 bitShift: BytesPerWord*8 - 1. "Top bit"
RootBit := 1 bitShift: BytesPerWord*8 - 2. "Next-to-Top bit"
AllButMarkBit := WordMask - MarkBit.
AllButRootBit := WordMask - RootBit.
AllButMarkBitAndTypeMask := AllButTypeMask - MarkBit.
ImmutabilityBit := 1 bitShift: BytesPerWord*8 - 3. "Next-to-Next-To-Top bit"
AllButImmutabilityBit := WordMask - ImmutabilityBit!
Item was added:
+ ----- Method: ObjectMemory class>>memoryManagerVersion (in category 'accessing') -----
+ memoryManagerVersion
+ ^ 'Blue Book'!
Item was changed:
----- Method: ObjectMemory>>finalizeReference: (in category 'finalization') -----
finalizeReference: oop
"During sweep phase we have encountered a weak reference. Check if its object
has gone away (or is about to) and if so, signal a semaphore. Do *not* inline
this in sweepPhase - it is quite an unlikely case to run into a weak reference"
| weakOop oopGone chunk numFields firstField lastField |
<inline: false>
<var: #oop type: #usqInt>
<var: #weakOop type: #usqInt>
numFields := self nonWeakFieldsOf: oop. "so nonWeakFieldsOf: may be inlined"
firstField := self baseHeaderSize + (numFields << self shiftForWord).
lastField := self lastPointerOf: oop.
firstField to: lastField by: self wordSize do:
[:i|
weakOop := self longAt: oop + i.
"ar 1/18/2005: Added oop < youngStart test to make sure we're not testing
objects in non-GCable region. This could lead to a forward reference in
old space with the oop pointed to not being marked and thus treated as free."
(weakOop = nilObj or: [(self isIntegerObject: weakOop) or:[weakOop < youngStart]]) ifFalse:
["Check if the object is being collected.
If the weak reference points
* backward: check if the weakOops chunk is free
* forward: check if the weakOoop has been marked by GC"
weakOop < oop
ifTrue: [chunk := self chunkFromOop: weakOop.
oopGone := ((self longAt: chunk) bitAnd: TypeMask) = HeaderTypeFree]
ifFalse: [oopGone := (self isMarked: weakOop) not].
oopGone ifTrue: "Store nil in the pointer and signal the interpreter"
[self longAt: oop + i put: nilObj.
+ numFields >= 2 ifTrue: [ self weakFinalizerCheck: oop ].
self signalFinalization: oop]]]!
Item was added:
+ ----- Method: ObjectMemory>>getHeapGrowthToSizeGCRatio (in category 'accessing') -----
+ getHeapGrowthToSizeGCRatio
+ "For compatibility with spur object memory"
+ <returnTypeC: #float>
+ ^ 0!
Item was added:
+ ----- Method: ObjectMemory>>isInFinalizationList:head: (in category 'finalization') -----
+ isInFinalizationList: oop head: listHead
+ "it is known that oop's first fixed slot points to an instance of special object - ClassWeakFinalizer ,
+ so it is safe to assume that we can iterate over it to figure out if oop is already in that list"
+ | listItem |
+
+ listItem := listHead.
+
+ [ listItem == self nilObject ] whileFalse: [
+ listItem == oop ifTrue: [ ^ true ].
+ listItem := self fetchPointer: 1 ofObject: listItem.
+ ].
+ ^ false
+ !
Item was changed:
----- Method: ObjectMemory>>readHeapFromImageFile:dataBytes: (in category 'image save/restore') -----
readHeapFromImageFile: f dataBytes: numBytes
"Read numBytes of image data from f into memory at memoryBaseForImageRead.
Answer the number of bytes written."
<var: #f type: #sqImageFile>
^self cCode:
[self
sq: (self pointerForOop: self memoryBaseForImageRead)
Image: (self sizeof: #char)
File: numBytes
+ ReadEntireImage: f]
- Read: f]
inSmalltalk:
[(f readInto: memory
startingAt: self memoryBaseForImageRead // 4 + 1
count: numBytes // 4)
* 4]!
Item was added:
+ ----- Method: ObjectMemory>>setHeapGrowthToSizeGCRatio: (in category 'accessing') -----
+ setHeapGrowthToSizeGCRatio: aDouble
+ "For compatibility with spur object memory"
+ <var: #aDouble type: #double>
+ !
Item was removed:
- ----- Method: RelativeDetailedInstructionPrinter class>>on: (in category 'instance creation') -----
- on: method
- "Answer an instance of me on the argument, method."
-
- ^self new method: method pc: method initialPC!
Item was added:
+ ----- Method: SerialPlugin>>primitiveSerialPortOpenByName:baudRate:stopBitsType:parityType:dataBits:inFlowControlType:outFlowControlType:xOnByte:xOffByte: (in category 'primitives') -----
+ primitiveSerialPortOpenByName: portName baudRate: baudRate stopBitsType: stopBitsType parityType: parityType dataBits: dataBits inFlowControlType: inFlowControl outFlowControlType: outFlowControl xOnByte: xOnChar xOffByte: xOffChar
+ <var: #port type: 'char *'>
+
+ | port portNameSize |
+
+ self primitive: 'primitiveSerialPortOpenByName'
+ parameters: #(String SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger ).
+
+ portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
+ port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
+ self cCode: 'memcpy(port, portName, portNameSize)'.
+
+ self cCode: 'serialPortOpenByName(
+ port, baudRate, stopBitsType, parityType, dataBits,
+ inFlowControl, outFlowControl, xOnChar, xOffChar)'.
+
+ self free: port.!
Item was added:
+ ----- Method: SerialPlugin>>primitiveSerialPortReadByName:into:startingAt:count: (in category 'primitives') -----
+ primitiveSerialPortReadByName: portName into: array startingAt: startIndex count: count
+ <var: #port type: 'char *'>
+
+ | port portNameSize bytesRead arrayPtr |
+
+ self primitive: 'primitiveSerialPortReadByName'
+ parameters: #(String ByteArray SmallInteger SmallInteger ).
+
+ interpreterProxy success: (startIndex >= 1 and: [startIndex + count - 1 <= (interpreterProxy byteSizeOf: array cPtrAsOop)]).
+ "adjust for zero-origin indexing"
+
+ portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
+ port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
+ self cCode: 'memcpy(port, portName, portNameSize)'.
+
+ arrayPtr := array asInteger + startIndex - 1.
+ bytesRead := self cCode: 'serialPortReadIntoByName( port, count, arrayPtr)'.
+
+ self free: port.
+
+ ^ bytesRead asSmallIntegerObj!
Item was added:
+ ----- Method: SerialPlugin>>primitiveSerialPortWriteByName:from:startingAt:count: (in category 'primitives') -----
+ primitiveSerialPortWriteByName: portName from: array startingAt: startIndex count: count
+ <var: #port type: 'char *'>
+
+ | bytesWritten arrayPtr portNameSize port |
+
+ self primitive: 'primitiveSerialPortWriteByName'
+ parameters: #(String ByteArray SmallInteger SmallInteger ).
+
+ portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
+ port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
+ self cCode: 'memcpy(port, portName, portNameSize)'.
+
+ interpreterProxy success: (startIndex >= 1 and: [startIndex + count - 1 <= (interpreterProxy byteSizeOf: array cPtrAsOop)]).
+ interpreterProxy failed
+ ifFalse: [arrayPtr := array asInteger + startIndex - 1.
+ bytesWritten := self cCode: 'serialPortWriteFromByName(port, count, arrayPtr)' ].
+
+ self free: port.
+
+ ^ bytesWritten asSmallIntegerObj!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPushEnclosingObjectAt: (in category 'bytecode generators') -----
genPushEnclosingObjectAt: level
"Uncached push enclosing object"
self MoveCq: level R: SendNumArgsReg.
self CallRT: ceEnclosingObjectTrampoline.
self PushR: ReceiverResultReg.
^0!
Item was changed:
----- Method: SocketPlugin>>primitiveSocketCreateRaw:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
primitiveSocketCreateRaw: netType type: protoType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
+ "New IPV6 implementation removes this... and nobody is using (and it wont compile)"
+ <doNotGenerate>
| socketOop s okToCreate |
<var: #s type: 'SocketPtr '>
self primitive: 'primitiveSocketCreateRAW' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ).
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
sCCSOTfn ~= 0
ifTrue: [okToCreate := self cCode: ' ((int (*) (int, int)) sCCSOTfn)(netType, protoType)'.
okToCreate
ifFalse: [^ interpreterProxy primitiveFail]].
socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize.
s := self socketValueOf: socketOop.
self
sqSocket: s
CreateRaw: netType
ProtoType: protoType
RecvBytes: recvBufSize
SendBytes: sendBufSize
SemaID: semaIndex
ReadSemaID: aReadSema
WriteSemaID: aWriteSema.
^ socketOop!
Item was removed:
- ----- Method: Spur32BitCoMemoryManager class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
- objectRepresentationClass
- ^CogObjectRepresentationFor32BitSpur!
Item was changed:
----- Method: Spur32BitCoMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
assimilateNewSegment: segInfo
"Update after adding a segment.
Here we make sure the new segment is not executable."
<var: #segInfo type: #'SpurSegmentInfo *'>
super assimilateNewSegment: segInfo.
+ self
+ cppIf: #SPUR_USE_EXECUTABLE_MEMORY
+ ifTrue: [ coInterpreter sqMakeMemoryExecutableFrom: segInfo segStart To: segInfo segLimit ]
+ ifFalse: [ coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segLimit ]
+ !
- coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segLimit!
Item was added:
+ ----- Method: Spur32BitMemoryManager class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
+ objectRepresentationClass
+ ^CogObjectRepresentationFor32BitSpur!
Item was added:
+ ----- Method: SpurMemoryManager class>>memoryManagerVersion (in category 'accessing') -----
+ memoryManagerVersion
+ ^ 'Spur'!
Item was changed:
----- Method: SpurMemoryManager>>isForwarded: (in category 'object testing') -----
isForwarded: objOop
"Answer if objOop is that if a forwarder. Take advantage of isForwardedObjectClassIndexPun
being a power of two to generate a more efficient test than the straight-forward
(self classIndexOf: objOop) = self isForwardedObjectClassIndexPun
at the cost of this being ambiguous with free chunks. So either never apply this to free chunks
or guard with (self isFreeObject: foo) not. So far the idiom has been to guard with isFreeObject:"
<api>
<inline: true>
"self assert: (self isFreeObject: objOop) not."
^(self longAt: objOop) noMask: self classIndexMask - self isForwardedObjectClassIndexPun!
Item was changed:
----- Method: SpurMemoryManager>>setHiddenRootsObj: (in category 'class table') -----
setHiddenRootsObj: anOop
hiddenRootsObj := anOop.
self cCode: [self assert: self validClassTableRootPages]
inSmalltalk: [numClassTablePages ifNotNil:
[self assert: self validClassTableRootPages]]..
classTableFirstPage := self fetchPointer: 0 ofObject: hiddenRootsObj.
self assert: (self numSlotsOf: classTableFirstPage) - 1 = self classTableMinorIndexMask.
"Set classTableIndex to the start of the last used page (excepting first page).
Set numClassTablePages to the number of used pages."
numClassTablePages := self classTableRootSlots.
2 to: numClassTablePages - 1 do:
[:i|
(self fetchPointer: i ofObject: hiddenRootsObj) = nilObj ifTrue:
[numClassTablePages := i.
classTableIndex := (numClassTablePages - 1 max: 1) << self classTableMajorIndexShift.
^self]].
"no unused pages; set it to the start of the second page."
classTableIndex := 1 << self classTableMajorIndexShift!
Item was removed:
- InterpreterPlugin subclass: #SqueakSSLPlugin
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'VMMaker-Plugins'!
Item was removed:
- ----- Method: SqueakSSLPlugin class>>hasHeaderFile (in category 'translation') -----
- hasHeaderFile
- ^true!
Item was removed:
- ----- Method: SqueakSSLPlugin class>>moduleName (in category 'translation') -----
- moduleName
- ^'SqueakSSL'!
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveAccept (in category 'primitives') -----
- primitiveAccept
- "Primitive. Starts or continues a server handshake using the current session.
- Will eventually produce output to be sent to the client. Requires the host
- and cert name to be set for the session. Returns a code indicating the sate
- of the connection:
- > 0 - Number of bytes to be sent to the client.
- 0 - Success. The connection is established.
- -1 - More input is required.
- < -1 - Other errors.
- "
- | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
- <var: #srcPtr type: 'char *'>
- <var: #dstPtr type: 'char *'>
- <export: true>
- interpreterProxy methodArgumentCount = 5
- ifFalse:[^interpreterProxy primitiveFail].
- dstOop := interpreterProxy stackObjectValue: 0.
- srcLen := interpreterProxy stackIntegerValue: 1.
- start := interpreterProxy stackIntegerValue: 2.
- srcOop := interpreterProxy stackObjectValue: 3.
- handle := interpreterProxy stackIntegerValue: 4.
- interpreterProxy failed ifTrue:[^nil].
- ((start > 0 and:[srcLen >= 0])
- and:[(interpreterProxy isBytes: srcOop)
- and:[(interpreterProxy isBytes: dstOop)
- and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
- ifFalse:[^interpreterProxy primitiveFail].
- srcPtr := interpreterProxy firstIndexableField: srcOop.
- dstPtr := interpreterProxy firstIndexableField: dstOop.
- srcPtr := srcPtr + start - 1.
- dstLen := interpreterProxy byteSizeOf: dstOop.
- result := self cCode: 'sqAcceptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
- inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- interpreterProxy pushInteger: result.!
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveConnect (in category 'primitives') -----
- primitiveConnect
- "Primitive. Starts or continues a client handshake using the provided data.
- Will eventually produce output to be sent to the server. Requires the host
- name to be set for the session.
- Returns:
- > 0 - Number of bytes to be sent to the server
- 0 - Success. The connection is established.
- -1 - More input is required.
- < -1 - Other errors.
- "
- | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
- <var: #srcPtr type: 'char *'>
- <var: #dstPtr type: 'char *'>
- <export: true>
- interpreterProxy methodArgumentCount = 5
- ifFalse:[^interpreterProxy primitiveFail].
- dstOop := interpreterProxy stackObjectValue: 0.
- srcLen := interpreterProxy stackIntegerValue: 1.
- start := interpreterProxy stackIntegerValue: 2.
- srcOop := interpreterProxy stackObjectValue: 3.
- handle := interpreterProxy stackIntegerValue: 4.
- interpreterProxy failed ifTrue:[^nil].
- ((start > 0 and:[srcLen >= 0])
- and:[(interpreterProxy isBytes: srcOop)
- and:[(interpreterProxy isBytes: dstOop)
- and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
- ifFalse:[^interpreterProxy primitiveFail].
- srcPtr := interpreterProxy firstIndexableField: srcOop.
- dstPtr := interpreterProxy firstIndexableField: dstOop.
- srcPtr := srcPtr + start - 1.
- dstLen := interpreterProxy byteSizeOf: dstOop.
- result := self cCode: 'sqConnectSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
- inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- interpreterProxy pushInteger: result.!
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveCreate (in category 'primitives') -----
- primitiveCreate
- "Primitive. Creates a new SSL session and returns its handle."
- | handle |
- <export: true>
- interpreterProxy methodArgumentCount = 0
- ifFalse:[^interpreterProxy primitiveFail].
- handle := self cCode: 'sqCreateSSL()' inSmalltalk:[0].
- handle = 0 ifTrue:[^interpreterProxy primitiveFail].
- interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- interpreterProxy pushInteger: handle.
- !
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveDecrypt (in category 'primitives') -----
- primitiveDecrypt
- "Primitive. Decrypts a buffer sent via the connection.
- Requires the session to be established.
- Returns:
- >=0 - Number of bytes decrypted in the result buffer
- < -1 - Other errors.
- "
- | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
- <var: #srcPtr type: 'char *'>
- <var: #dstPtr type: 'char *'>
- <export: true>
- interpreterProxy methodArgumentCount = 5
- ifFalse:[^interpreterProxy primitiveFail].
- dstOop := interpreterProxy stackObjectValue: 0.
- srcLen := interpreterProxy stackIntegerValue: 1.
- start := interpreterProxy stackIntegerValue: 2.
- srcOop := interpreterProxy stackObjectValue: 3.
- handle := interpreterProxy stackIntegerValue: 4.
- interpreterProxy failed ifTrue:[^nil].
- ((start > 0 and:[srcLen >= 0])
- and:[(interpreterProxy isBytes: srcOop)
- and:[(interpreterProxy isBytes: dstOop)
- and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
- ifFalse:[^interpreterProxy primitiveFail].
- srcPtr := interpreterProxy firstIndexableField: srcOop.
- dstPtr := interpreterProxy firstIndexableField: dstOop.
- srcPtr := srcPtr + start - 1.
- dstLen := interpreterProxy byteSizeOf: dstOop.
- result := self cCode: 'sqDecryptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
- inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- interpreterProxy pushInteger: result.!
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveDestroy (in category 'primitives') -----
- primitiveDestroy
- "Primitive. Destroys an SSL session."
-
- | handle result |
- <export: true>
- interpreterProxy methodArgumentCount = 1
- ifFalse:[^interpreterProxy primitiveFail].
- handle := interpreterProxy stackIntegerValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- result := self cCode: 'sqDestroySSL(handle)' inSmalltalk:[handle. 0].
- result = 0 ifTrue:[^interpreterProxy primitiveFail].
- interpreterProxy pop: interpreterProxy methodArgumentCount.
-
- !
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveEncrypt (in category 'primitives') -----
- primitiveEncrypt
- "Primitive. Encrypts a buffer to be sent to the via the connection.
- Requires the session to be established.
- Returns:
- >=0 - Number of bytes encrypted in the result buffer
- < -1 - Other errors.
- "
- | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
- <var: #srcPtr type: 'char *'>
- <var: #dstPtr type: 'char *'>
- <export: true>
- interpreterProxy methodArgumentCount = 5
- ifFalse:[^interpreterProxy primitiveFail].
- dstOop := interpreterProxy stackObjectValue: 0.
- srcLen := interpreterProxy stackIntegerValue: 1.
- start := interpreterProxy stackIntegerValue: 2.
- srcOop := interpreterProxy stackObjectValue: 3.
- handle := interpreterProxy stackIntegerValue: 4.
- interpreterProxy failed ifTrue:[^nil].
- ((start > 0 and:[srcLen >= 0])
- and:[(interpreterProxy isBytes: srcOop)
- and:[(interpreterProxy isBytes: dstOop)
- and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
- ifFalse:[^interpreterProxy primitiveFail].
- srcPtr := interpreterProxy firstIndexableField: srcOop.
- dstPtr := interpreterProxy firstIndexableField: dstOop.
- srcPtr := srcPtr + start - 1.
- dstLen := interpreterProxy byteSizeOf: dstOop.
- result := self cCode: 'sqEncryptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
- inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- interpreterProxy pushInteger: result.!
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveGetIntProperty (in category 'primitives') -----
- primitiveGetIntProperty
- "Primitive. Returns an integer property for the session"
-
- | propID handle value |
- <export: true>
- interpreterProxy methodArgumentCount = 2
- ifFalse:[^interpreterProxy primitiveFail].
- propID := interpreterProxy stackIntegerValue: 0.
- handle := interpreterProxy stackIntegerValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- value := self cCode: 'sqGetIntPropertySSL(handle, propID)'
- inSmalltalk:[handle. propID. 0].
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy
- pop: interpreterProxy methodArgumentCount + 1
- thenPush: (interpreterProxy signed32BitIntegerFor: value)
- !
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveGetStringProperty (in category 'primitives') -----
- primitiveGetStringProperty
- "Primitive. Returns a string property for the session"
-
- | stringLen stringOop propID handle stringPtr oopPtr |
- <var: #stringPtr type: 'char *'>
- <var: #oopPtr type: 'char *'>
- <export: true>
- interpreterProxy methodArgumentCount = 2
- ifFalse:[^interpreterProxy primitiveFail].
- propID := interpreterProxy stackIntegerValue: 0.
- handle := interpreterProxy stackIntegerValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- stringPtr := self cCode: 'sqGetStringPropertySSL(handle, propID)'
- inSmalltalk:[handle. propID. nil].
- interpreterProxy failed ifTrue:[^nil].
- stringPtr == nil ifTrue:[
- stringOop := interpreterProxy nilObject.
- ] ifFalse:[
- stringLen := self strlen: stringPtr.
- stringOop := interpreterProxy
- instantiateClass: (interpreterProxy classString)
- indexableSize: stringLen.
- oopPtr := interpreterProxy firstIndexableField: stringOop.
- 0 to: stringLen-1 do:[:i| oopPtr at: i put: (stringPtr at: i)].
- ].
- interpreterProxy
- pop: interpreterProxy methodArgumentCount + 1
- thenPush: stringOop.
- !
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveSetIntProperty (in category 'primitives') -----
- primitiveSetIntProperty
- "Primitive. Sets a integer property for the session"
-
- | propID handle result value |
- <export: true>
- interpreterProxy methodArgumentCount = 3
- ifFalse:[^interpreterProxy primitiveFail].
- value := interpreterProxy signed32BitValueOf: (interpreterProxy stackValue: 0).
- propID := interpreterProxy stackIntegerValue: 1.
- handle := interpreterProxy stackIntegerValue: 2.
- interpreterProxy failed ifTrue:[^nil].
- result := self cCode: 'sqSetIntPropertySSL(handle, propID, value)'
- inSmalltalk:[handle. propID. value. false].
- result ifFalse:[^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy pop: interpreterProxy methodArgumentCount.
- !
Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveSetStringProperty (in category 'primitives') -----
- primitiveSetStringProperty
- "Primitive. Sets a string property for the session"
-
- | srcLen srcOop propID handle srcPtr result |
- <var: #srcPtr type: 'char *'>
- <export: true>
- interpreterProxy methodArgumentCount = 3
- ifFalse:[^interpreterProxy primitiveFail].
- srcOop := interpreterProxy stackObjectValue: 0.
- propID := interpreterProxy stackIntegerValue: 1.
- handle := interpreterProxy stackIntegerValue: 2.
- interpreterProxy failed ifTrue:[^nil].
- (interpreterProxy isBytes: srcOop)
- ifFalse:[^interpreterProxy primitiveFail].
- srcPtr := interpreterProxy firstIndexableField: srcOop.
- srcLen := interpreterProxy byteSizeOf: srcOop.
- result := self cCode: 'sqSetStringPropertySSL(handle, propID, srcPtr, srcLen)'
- inSmalltalk:[handle. srcPtr. propID. srcLen. false].
- result ifFalse:[^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy pop: interpreterProxy methodArgumentCount.
- !
Item was added:
+ ----- Method: StackInterpreter class>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion
+ ^ 'Stack'!
Item was changed:
----- Method: StackInterpreter class>>requiredMethodNames: (in category 'translation') -----
requiredMethodNames: options
"return the list of method names that should be retained for export or other support reasons"
| requiredList |
requiredList := self exportAPISelectors: options.
requiredList addAll: (NewObjectMemory requiredMethodNames: options).
"A number of methods required by VM support code, jitter, specific platforms etc"
requiredList addAll: #(
assertValidExecutionPointe:r:s:
characterForAscii:
findClassOfMethod:forReceiver: findSelectorOfMethod:
forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate
getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending
getSavedWindowSize getThisSessionID
interpret
loadInitialContext
primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext:
printExternalHeadFrame printFramesInPage: printFrame: printHeadFrame printMemory printOop:
printStackPages printStackPageList printStackPagesInUse printStackPageListInUse
readableFormat: readImageFromFile:HeapSize:StartingAt:
setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain:
setSavedWindowSize: success:
validInstructionPointer:inMethod:framePointer:).
"Nice to actually have all the primitives available"
requiredList addAll: (self primitiveTable select: [:each| each isSymbol]).
"InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
InterpreterProxy organization categories do:
[:cat |
+ ((cat ~= 'initialize')
+ and: [ cat ~= 'private'
+ and: [ cat ~= '-- all --' ] ]) ifTrue:
- ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue:
[requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
^requiredList!
Item was changed:
----- Method: StackInterpreter>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') -----
codeGeneratorToComputeAccessorDepth
^VMMaker new
buildCodeGeneratorForInterpreter: self class primitivesClass
includeAPIMethods: false
initializeClasses: false!
Item was changed:
----- Method: StackInterpreter>>primitiveIndexOfMethod:header: (in category 'compiled methods') -----
primitiveIndexOfMethod: theMethod header: methodHeader
"Note: With the Squeak V0 format we now have 10 bits of primitive index, but they are in
two places for temporary backward compatibility. The time to unpack is negligible,
since the derived primitive function pointer is stored in the method cache. With the new
format we assume a 3-byte CallPrimitive with a little-endian 16-bit primitive index."
<api>
<inline: true>
| firstBytecode |
^objectMemory hasSpurMemoryManagerAPI
ifTrue:
[(self alternateHeaderHasPrimitiveFlag: methodHeader)
ifTrue:
[firstBytecode := self firstBytecodeOfAlternateHeader: methodHeader method: theMethod.
(objectMemory byteAt: firstBytecode + 1) + ((objectMemory byteAt: firstBytecode + 2) << 8)]
ifFalse:
[0]]
ifFalse:
[MULTIPLEBYTECODESETS
ifTrue:
[(self headerIndicatesAlternateBytecodeSet: methodHeader)
ifTrue:
[(self alternateHeaderHasPrimitiveFlag: methodHeader)
ifTrue:
[firstBytecode := self firstBytecodeOfAlternateHeader: methodHeader method: theMethod.
(objectMemory byteAt: firstBytecode + 1) + ((objectMemory byteAt: firstBytecode + 2) << 8)]
ifFalse:
[0]]
ifFalse:
[| primBits |
primBits := objectMemory integerValueOf: methodHeader.
(primBits bitAnd: 16r1FF) + (primBits >> 19 bitAnd: 16r200)]]
ifFalse:
[| primBits |
primBits := objectMemory integerValueOf: methodHeader.
(primBits bitAnd: 16r1FF) + (primBits >> 19 bitAnd: 16r200)]]!
Item was changed:
----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the StackInterpreterSimulator when running the interpreter
inside Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
super initialize.
bootstrapping := false.
transcript := Transcript.
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
objectMemory coInterpreter: self.
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := objectMemory integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
[pluginList := {'' -> self }].
desiredNumStackPages := desiredEdenBytes := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := Time totalSeconds * 1000000.
"initialize InterpreterSimulator variables used for debugging"
byteCount := sendCount := lookupCount := 0.
quitBlock := [^self].
traceOn := true.
printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
+ displayForm := (ImageMorph fromString: 'Display has not yet been installed') form.
- displayForm := 'Display has not yet been installed' asDisplayText form.
eventQueue := SharedQueue new.
suppressHeartbeatFlag := false.
systemAttributes := Dictionary new.
extSemTabSize := 256.
disableBooleanCheat := false.
assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"!
Item was added:
+ ----- Method: StackInterpreterSimulator>>initializeInterpreter: (in category 'initialization') -----
+ initializeInterpreter: bytesToShift
+ super initializeInterpreter: bytesToShift.
+ "self initStackPages.
+ self loadInitialContext"!
Item was changed:
----- Method: StackInterpreterSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
ioRelinquishProcessorForMicroseconds: microseconds
"In the simulator give an indication that we're idling and check for input."
Display reverse: (0@0 extent: 16@16).
Sensor peekEvent ifNotNil:
[self forceInterruptCheck].
+ Processor activeProcess == UIManager default uiProcess ifTrue:
- Processor activeProcess == Project uiProcess ifTrue:
[World doOneCycle].
microseconds >= 1000
ifTrue: [(Delay forMilliseconds: microseconds + 999 // 1000) wait]
ifFalse: [Processor yield].
"And increase the byteCount form which the microsecond clock is derived..."
byteCount := byteCount + microseconds - 1.
self incrementByteCount!
Item was added:
+ ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: posixPermissions
+ posixPermissions: fileSize
+
+ | modDateOop createDateOop nameString results |
+ <var: 'entryName' type: 'char *'>
+
+ results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 5.
+ nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
+ createDateOop := self positive32BitIntegerFor: createDate.
+ modDateOop := self positive32BitIntegerFor: modifiedDate.
+
+ 1 to: entryNameSize do:
+ [ :i |
+ objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
+
+ objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
+ objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
+ objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
+ dirFlag
+ ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
+ ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
+ objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
+ objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions).
+ ^ results!
Item was added:
+ ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName
+ size: entryNameSize
+ createDate: createDate
+ modDate: modifiedDate
+ isDir: dirFlag
+ fileSize: posixPermissions
+ posixPermissions: fileSize
+ isSymlink: symlinkFlag
+
+ | modDateOop createDateOop nameString results |
+ <var: 'entryName' type: 'char *'>
+
+ results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 7.
+ nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
+ createDateOop := self positive32BitIntegerFor: createDate.
+ modDateOop := self positive32BitIntegerFor: modifiedDate.
+
+ 1 to: entryNameSize do:
+ [ :i |
+ objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
+
+ objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
+ objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
+ objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
+ dirFlag
+ ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
+ ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
+ objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
+ objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions).
+ symlinkFlag
+ ifTrue: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory trueObject ]
+ ifFalse: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory falseObject ].
+
+ ^ results!
Item was changed:
----- Method: StackInterpreterSimulator>>openAsMorph (in category 'UI') -----
openAsMorph
"Open a morphic view on this simulation."
+ | window localImageName |
+ localImageName := imageName asFileReference basename.
- | localImageName borderWidth window |
- localImageName := imageName
- ifNotNil: [FileDirectory default localNameFor: imageName]
- ifNil: [' synthetic image'].
window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0@0 corner: 1(a)0.8).
+ transcript := ThreadSafeTranscript new.
- transcript := TranscriptStream on: (String new: 10000).
window addMorph: (PluggableTextMorph
on: transcript text: nil accept: nil
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0(a)0.8 corner: 0.7@1).
+
window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0.7(a)0.8 corner: 1@1).
- borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
- on: MessageNotUnderstood
- do: [:ex| 0]. "3.8"
- borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent
+ + (2 * window borderWidth)
- + (2 * borderWidth)
+ (0@window labelHeight)
+ * (1(a)(1/0.8))) rounded!
- * (1(a)(1/0.8))) rounded.
- ^window!
Item was changed:
----- Method: StackInterpreterSimulator>>openAsMorphNoTranscript (in category 'UI') -----
openAsMorphNoTranscript
"Open a morphic view on this simulation."
+ | window localImageName |
+ localImageName := imageName asFileReference basename.
- | localImageName borderWidth window |
- localImageName := FileDirectory default localNameFor: imageName.
window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0@0 corner: 1(a)0.95).
window addMorph: (PluggableTextMorph on: self
+ text: #byteCountText accept: nil) hideScrollBarsIndefinitely
- text: #byteCountText accept: nil
- readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0(a)0.95 corner: 1@1).
- borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
- on: MessageNotUnderstood
- do: [:ex| 0]. "3.8"
- borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent
+ + (2 * window borderWidth)
- + (2 * borderWidth)
+ (0@window labelHeight)
* (1(a)(1/0.95))) rounded!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
primitiveDirectoryEntry
| name pathName array result |
name := self stringOf: self stackTop.
pathName := self stringOf: (self stackValue: 1).
self successful ifFalse:
[^self primitiveFail].
+ array := FileSystem disk store basicEntryAt: (pathName asFileReference / name) path.
- array := FileDirectory default primLookupEntryIn: pathName name: name.
array == nil ifTrue:
[self pop: 3 thenPush: objectMemory nilObject.
^array].
array == #badDirectoryPath ifTrue:
+ [
- [self halt.
^self primitiveFail].
+ result := self makeDirEntryName: (array at: 1)
+ size: (array at: 1) size
+ createDate: (array at: 2)
+ modDate: (array at: 3)
+ isDir: (array at: 4)
+ fileSize: (array at: 5)
+ posixPermissions: (array at: 6)
+ isSymlink: (array at: 7).
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3.
self push: result!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
primitiveDirectoryLookup
| index pathName array result |
index := self stackIntegerValue: 0.
pathName := (self stringOf: (self stackValue: 1)).
self successful ifFalse:
[^self primitiveFail].
+ array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
- array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue:
[self pop: 3 thenPush: objectMemory nilObject.
^array].
array == #badDirectoryPath ifTrue:
["self halt."
^self primitiveFail].
+ result := self
+ makeDirEntryName: (array at: 1)
+ size: (array at: 1) size
+ createDate: (array at: 2)
+ modDate: (array at: 3)
+ isDir: (array at: 4)
+ fileSize: (array at: 5)
+ posixPermissions: (array at: 6)
+ isSymlink: (array at: 7).
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3 thenPush: result!
Item was added:
+ ----- Method: StackInterpreterSimulator>>redirectTranscriptToHost (in category 'debug support') -----
+ redirectTranscriptToHost
+ "Sometimes you need the capability to see the transcript output of the image into the
+ local transcript (for debugging when bootstrapping, for example). "
+ transcript := Transcript!
Item was changed:
----- Method: StackInterpreterSimulator>>runAtEachStep: (in category 'testing') -----
runAtEachStep: aBlock
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self assertValidExecutionPointers.
aBlock value: currentBytecode.
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
localIP := localIP - 1.
"undo the pre-increment of IP before returning"
self externalizeIPandSP!
Item was changed:
----- Method: StackInterpreterSimulator>>runForNBytes: (in category 'testing') -----
runForNBytes: nBytecodes
"Do nByteCodes more bytecode dispatches.
Keep byteCount up to date.
This can be run repeatedly."
| endCount |
self initStackPages.
+ self loadInitialContext.
- self loadInitialContext.
endCount := byteCount + nBytecodes.
self internalizeIPandSP.
self fetchNextBytecode.
[byteCount < endCount] whileTrue:
[self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
localIP := localIP - 1.
"undo the pre-increment of IP before returning"
self externalizeIPandSP!
Item was changed:
----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') -----
runWithBreakCount: theBreakCount
"Just run, halting when byteCount is reached"
quitBlock := [displayView ifNotNil:
[displayView containingWindow ifNotNil:
[:topWindow|
((World submorphs includes: topWindow)
and: [UIManager default confirm: 'close?']) ifTrue:
[topWindow delete]]].
^self].
breakCount := theBreakCount.
self initStackPages.
+ self loadInitialContext.
- self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self assertValidExecutionPointers.
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
localIP := localIP - 1.
"undo the pre-increment of IP before returning"
self externalizeIPandSP!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') -----
initializeBytecodeTableForNewspeakV4
"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV4"
numPushNilsFunction := #v4:Num:Push:Nils:.
pushNilSizeFunction := #v4PushNilSize:.
NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit"
FirstSpecialSelector := 80.
self flag:
'Special selector send class must be inlined to agree with the interpreter, which
inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
have identical semantics. We get away with not hardwiring the other special
selectors either because in the Cointerpreter they are not inlined or because they
are inlined only to instances of classes for which there will always be a method.'.
self generatorTableFrom: #(
"1 byte bytecodes"
(1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1)
(1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
(1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
(1 64 75 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
(1 76 76 genPushReceiverBytecode needsFrameNever: 1)
(1 77 77 genExtPushPseudoVariableOrOuterBytecode needsFrameIfExtBGT2: 1)
(1 78 78 genPushConstantZeroBytecode needsFrameNever: 1)
(1 79 79 genPushConstantOneBytecode needsFrameNever: 1)
(1 80 80 genSpecialSelectorArithmetic isMapped AddRR)
(1 81 81 genSpecialSelectorArithmetic isMapped SubRR)
(1 82 82 genSpecialSelectorComparison isMapped JumpLess)
(1 83 83 genSpecialSelectorComparison isMapped JumpGreater)
(1 84 84 genSpecialSelectorComparison isMapped JumpLessOrEqual)
(1 85 85 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
(1 86 86 genSpecialSelectorComparison isMapped JumpZero)
(1 87 87 genSpecialSelectorComparison isMapped JumpNonZero)
(1 88 93 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //"
(1 94 94 genSpecialSelectorArithmetic isMapped AndRR)
(1 95 95 genSpecialSelectorArithmetic isMapped OrRR)
(1 96 101 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
(1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
(1 103 103 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
(1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
(1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
(1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
(1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
(1 160 175 genSendAbsentImplicit0ArgsBytecode isMapped hasIRC)
(1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
(1 184 191 genStoreAndPopTemporaryVariableBytecode)
(1 192 199 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
(1 200 207 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(1 208 215 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(1 216 216 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
(1 217 217 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
(1 218 218 genExtReturnTopFromBlock return needsFrameNever: -1)
(1 219 219 duplicateTopBytecode needsFrameNever: 1)
(1 220 220 genPopStackBytecode needsFrameNever: -1)
(1 221 221 genExtNopBytecode needsFrameNever: 0)
(1 222 223 unknownBytecode)
"2 byte bytecodes"
(2 224 224 extABytecode extension needsFrameNever: 0)
(2 225 225 extBBytecode extension needsFrameNever: 0)
(2 226 226 genExtPushReceiverVariableBytecode)
(2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1)
(2 228 228 genExtPushLiteralBytecode needsFrameNever: 1)
(2 229 229 genExtPushIntegerBytecode needsFrameNever: 1)
(2 230 230 genLongPushTemporaryVariableBytecode)
(2 231 231 genPushNewArrayBytecode)
(2 232 232 genExtStoreReceiverVariableBytecode)
(2 233 233 genExtStoreLiteralVariableBytecode)
(2 234 234 genLongStoreTemporaryVariableBytecode)
(2 235 235 genExtStoreAndPopReceiverVariableBytecode)
(2 236 236 genExtStoreAndPopLiteralVariableBytecode)
(2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
(2 238 238 genExtSendBytecode isMapped)
(2 239 239 genExtSendSuperBytecode isMapped)
(2 240 240 genExtSendAbsentImplicitBytecode isMapped hasIRC)
(2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped)
(2 242 242 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
(2 243 243 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
(2 244 244 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
(2 245 245 genExtSendAbsentSelfBytecode isMapped)
(2 246 248 unknownBytecode)
"3 byte bytecodes"
(3 249 249 callPrimitiveBytecode)
(3 250 250 genPushRemoteTempLongBytecode)
(3 251 251 genStoreRemoteTempLongBytecode)
(3 252 252 genStoreAndPopRemoteTempLongBytecode)
(3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:)
(3 254 254 genExtSendAbsentOuterBytecode isMapped)
(3 255 255 unknownBytecode))!
Item was added:
+ SmartSyntaxInterpreterPlugin subclass: #SystemInfoPlugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: 'VMBasicConstants'
+ category: 'VMMaker-Plugins'!
+
+ !SystemInfoPlugin commentStamp: '<historical>' prior: 0!
+ I'm a symple plugin who answers some information about the system.
+ My main purpose is to provide identifiers that can be used for security reasons (to forbid an application to run in different machines)
+ !
Item was added:
+ ----- Method: SystemInfoPlugin class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: codeGenerator
+ codeGenerator addHeaderFile: '"SystemInfo.h"'.!
Item was added:
+ ----- Method: SystemInfoPlugin>>primitivePrimaryMACAddress (in category 'primitives') -----
+ primitivePrimaryMACAddress
+ | identifier size resultOop resultPtr |
+
+ <export: true>
+ <var: #identifier type: 'char *'>
+ <var: #resultPtr type: 'char *'>
+
+ self primitive: #primitivePrimaryMACAddress parameters: #().
+
+ interpreterProxy failed ifTrue: [ ^self ].
+
+ identifier := self sqPrimaryMACAddress.
+ size := self strlen: identifier.
+ resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: size.
+ resultPtr := interpreterProxy firstIndexableField: resultOop.
+ 0 to: (size - 1) do: [ :i |
+ resultPtr at: i put: (identifier at: i) ].
+
+ ^resultOop!
Item was added:
+ ----- Method: SystemInfoPlugin>>primitiveUniqueIdentifier (in category 'primitives') -----
+ primitiveUniqueIdentifier
+ | identifier size resultOop resultPtr |
+
+ <export: true>
+ <var: #identifier type: 'char *'>
+ <var: #resultPtr type: 'char *'>
+
+ self primitive: #primitiveUniqueIdentifier parameters: #().
+
+ interpreterProxy failed ifTrue: [ ^self ].
+
+ identifier := self sqUniqueIdentifier.
+ size := self strlen: identifier.
+ resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: size.
+ resultPtr := interpreterProxy firstIndexableField: resultOop.
+ 0 to: (size - 1) do: [ :i |
+ resultPtr at: i put: (identifier at: i) ].
+
+ ^resultOop!
Item was changed:
----- Method: TAssignmentNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
aStream nextPut: $(.
self emitCCodeOn: aStream level: level generator: aCodeGen.
aStream nextPut: $)!
Item was changed:
----- Method: TMethod>>buildCaseStmt:in: (in category 'transformations') -----
buildCaseStmt: aSendNode in: aCodeGen
"Build a case statement node for the given send of dispatchOn:in:."
"Note: the first argument is the variable to be dispatched on. The second argument is a constant node holding an array of unary selectors, which will be turned into sends to self."
| unimplemented errorMessage |
(aSendNode args size >= 2
and: [aSendNode args second isConstant
and: [aSendNode args second value isArray]]) ifFalse:
[self error: 'wrong node structure for a case statement'].
unimplemented := aSendNode args second value select: [:s| (aCodeGen methodNamed: s) isNil].
unimplemented isEmpty ifFalse:
[errorMessage := 'The following selectors in case statement "', (aSendNode printString copyUpTo: $#), '..." are unimplemented: ',
(String streamContents: [:s| unimplemented do: [:sel| s crtab; store: sel]]).
aCodeGen logger nextPutAll: errorMessage; cr; flush.
+ "(self confirm: errorMessage
- (self confirm: errorMessage
orCancel: aCodeGen abortBlock) ifFalse:
+ [self halt]"].
- [self halt]].
^TCaseStmtNode new
setExpression: aSendNode args first
selectors: aSendNode args second value
arguments: (aSendNode args copyFrom: 3 to: aSendNode args size)!
Item was changed:
----- Method: TMethod>>emitCCodeOn:generator: (in category 'C code generation') -----
emitCCodeOn: aStream generator: aCodeGen
"Emit C code for this method onto the given stream.
All calls to inlined methods should already have been expanded."
aCodeGen currentMethod: self.
self emitCCommentOn: aStream. "place method comment before function"
aStream cr.
self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
aStream cr; nextPut: ${.
+ aStream cr; tab;
+ nextPutAll: '// '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self selector.
self emitCLocalsOn: aStream generator: aCodeGen.
aCodeGen
pushScope: declarations
while: [parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen].
aStream nextPut: $}; cr!
Item was changed:
----- Method: TParseNode>>emitCCodeAsArgumentOn:level:generator: (in category 'C code generation') -----
emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen
^self emitCCodeOn: aStream level: level generator: aCodeGen!
Item was changed:
----- Method: TParseNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
^self emitCCodeOn: aStream level: level generator: aCodeGen!
Item was changed:
----- Method: TSendNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
^self emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen!
Item was changed:
----- Method: TestOSAPlugin class>>declareCVarsIn: (in category 'as yet unclassified') -----
declareCVarsIn: cg
+ cg addHeaderFile: '<Carbon/Carbon.h>'.
+ !
-
- cg addHeaderFile: '<AppleEvents.h>'.
- cg addHeaderFile: '<AppleScript.h>'.
- cg addHeaderFile: '<OSA.h>'.
- cg addHeaderFile: '<OSAGeneric.h>'.
- cg addHeaderFile: '<Script.h>'.!
Item was removed:
- ----- Method: ThreadedIA32FFIPlugin class>>moduleName (in category 'translation') -----
- moduleName
- ^'IA32FFIPlugin'!
Item was changed:
----- Method: VMClass class>>declareInterpreterVersionIn:defaultName: (in category 'translation') -----
declareInterpreterVersionIn: aCCodeGenerator defaultName: defaultName
+ NewspeakVM
+ ifTrue: [
+ "Newspeak as of mid 2011 derives SystemScope systemName from the interpreterVersion
+ (via system attribute 1004) by copying up to but not including the last space, provided the
+ string ends with a digit. So spaces must be eliminated from the Monitcello version string,
+ and we can't surround it with square brackets."
+ (aCCodeGenerator shortMonticelloDescriptionForClass: self) last isDigit
+ ifFalse: [ self error: 'Newspeak expects interpreterVersion ends with a digit' ].
+
+ aCCodeGenerator
+ var: #interpreterVersion
+ declareC: 'const char *interpreterVersion = "Newspeak Virtual Machine ',
+ ((aCCodeGenerator shortMonticelloDescriptionForClass: self) copyReplaceAll: ' ' with: '_'),
+ '"'.
+ ^self].
- NewspeakVM ifTrue:
- ["Newspeak as of mid 2011 derives SystemScope systemName from the interpreterVersion
- (via system attribute 1004) by copying up to but not including the last space, provided the
- string ends with a digit. So spaces must be eliminated from the Monitcello version string,
- and we can't surround it with square brackets."
- (aCCodeGenerator shortMonticelloDescriptionForClass: self) last isDigit ifFalse:
- [self error: 'Newspeak expects interpreterVersion ends with a digit'].
- aCCodeGenerator
- var: #interpreterVersion
- declareC: 'const char *interpreterVersion = "Newspeak Virtual Machine ',
- ((aCCodeGenerator shortMonticelloDescriptionForClass: self) copyReplaceAll: ' ' with: '_'),
- '"'.
- ^self].
aCCodeGenerator
var: #interpreterVersion
+ declareC: 'const char *interpreterVersion = "', defaultName, '"'.!
- declareC: 'const char *interpreterVersion = "Croquet Closure ', defaultName, ' VM [',
- (aCCodeGenerator shortMonticelloDescriptionForClass: self),']"'.!
Item was changed:
----- Method: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') -----
initializePrimitiveErrorCodes
"Define the VM's primitive error codes. N.B. these are
replicated in platforms/Cross/vm/sqVirtualMachine.h."
"VMClass initializePrimitiveErrorCodes"
| pet |
PrimErrTableIndex := 51. "Zero-relative"
"See SmalltalkImage>>recreateSpecialObjectsArray for the table definition.
If the table exists and is large enough the corresponding entry is returned as
the primitive error, otherwise the error is answered numerically."
pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()].
pet isArray ifFalse: [pet := #()].
PrimNoErr := 0. "for helper methods that need to answer success or an error code."
PrimErrGenericFailure := pet indexOf: nil ifAbsent: 1.
PrimErrBadReceiver := pet indexOf: #'bad receiver' ifAbsent: 2.
PrimErrBadArgument := pet indexOf: #'bad argument' ifAbsent: 3.
PrimErrBadIndex := pet indexOf: #'bad index' ifAbsent: 4.
PrimErrBadNumArgs := pet indexOf: #'bad number of arguments' ifAbsent: 5.
PrimErrInappropriate := pet indexOf: #'inappropriate operation' ifAbsent: 6.
PrimErrUnsupported := pet indexOf: #'unsupported operation' ifAbsent: 7.
PrimErrNoModification := pet indexOf: #'no modification' ifAbsent: 8.
PrimErrNoMemory := pet indexOf: #'insufficient object memory' ifAbsent: 9.
PrimErrNoCMemory := pet indexOf: #'insufficient C memory' ifAbsent: 10.
PrimErrNotFound := pet indexOf: #'not found' ifAbsent: 11.
PrimErrBadMethod := pet indexOf: #'bad method' ifAbsent: 12.
PrimErrNamedInternal := pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
PrimErrObjectMayMove := pet indexOf: #'object may move' ifAbsent: 14.
PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15.
PrimErrObjectIsPinned := pet indexOf: #'object is pinned' ifAbsent: 16.
PrimErrWritePastObject := pet indexOf: #'primitive write beyond end of object' ifAbsent: 17!
Item was added:
+ ----- Method: VMClass class>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion
+ ^ self subclassResponsibility!
Item was added:
+ ----- Method: VMClass class>>memoryManagerVersion (in category 'accessing') -----
+ memoryManagerVersion
+ ^ self subclassResponsibility!
Item was changed:
----- Method: VMClass class>>writeVMHeaderTo:bytesPerWord: (in category 'translation') -----
writeVMHeaderTo: aStream bytesPerWord: bytesPerWord
"Generate the contents of interp.h on aStream. Specific Interpreter subclasses
override to add more stuff."
aStream
nextPutAll: '#define VM_PROXY_MAJOR '; print: self vmProxyMajorVersion; cr;
nextPutAll: '#define VM_PROXY_MINOR '; print: self vmProxyMinorVersion; cr;
cr;
nextPutAll: '#define SQ_VI_BYTES_PER_WORD '; print: bytesPerWord; cr;
cr.
"The most basic constants must be defined here, not in e.g. the plugin sources, so allow those
other sources to be shared between different builds (Spur vs SqueakV3, 32-bit vs 64-bit, etc)"
VMBasicConstants mostBasicConstantNames asSet asArray sort do:
[:constName|
(VMBasicConstants classPool at: constName ifAbsent: []) ifNotNil:
[:const|
aStream nextPutAll: '#define '; nextPutAll: constName; space; print: const; cr]].
aStream cr.
((VMBasicConstants classPool associations select: [:a| a key beginsWith: 'PrimErr'])
asSortedCollection: [:a1 :a2| a1 value <= a2 value])
do: [:a|
aStream nextPutAll: '#define '; nextPutAll: a key; space; print: a value; cr].
aStream cr.
aStream
+ nextPutAll: '#define MinSmallInteger '; print: self objectMemoryClass new minSmallInteger; cr;
+ nextPutAll: '#define MaxSmallInteger '; print: self objectMemoryClass new maxSmallInteger; cr;
- nextPutAll: '#define MinSmallInteger '; print: self objectMemoryClass minSmallInteger; cr;
- nextPutAll: '#define MaxSmallInteger '; print: self objectMemoryClass maxSmallInteger; cr;
cr.!
Item was changed:
----- Method: VMClass>>doOrDefer: (in category 'simulation support') -----
doOrDefer: aBlock
<doNotGenerate>
"Either evaluate aBlock immediately if in the uiProcess or defer aBlock as a UI message"
+ Processor activeProcess == UIManager default uiProcess
- Processor activeProcess == Project uiProcess
ifTrue: [aBlock value]
ifFalse: [WorldState addDeferredUIMessage: aBlock]!
Item was changed:
----- Method: VMMaker>>needsToRegenerateCogitFile (in category 'generate sources') -----
needsToRegenerateCogitFile
"Check the timestamp for the relevant classes and then the timestamp for the main source file (e.g. interp.c)
file if it already exists. Answer if the file needs regenerating."
| cogitClass cogitClasses tStamp |
cogitClasses := (cogitClass := self interpreterClass cogitClass) withAllSuperclasses copyUpThrough: Cogit.
cogitClasses addAllLast: (cogitClass ancilliaryClasses: self options).
tStamp := cogitClasses inject: 0 into: [:tS :cl| tS max: cl timeStamp].
"don't translate if the file is newer than my timeStamp"
(self coreVMDirectory entryAt: cogitClass sourceFileName ifAbsent: [nil]) ifNotNil:
[:fstat|
+ tStamp < fstat modificationTime asSeconds ifTrue:
- tStamp < fstat modificationTime ifTrue:
[^self confirm: 'The ', self configurationNameIfAny, cogitClass printString, ' classes have not been modified since\ the source file was last generated.\Do you still want to regenerate it?' withCRs]].
^true
!
Item was changed:
----- Method: VMMaker>>needsToRegenerateInterpreterFile (in category 'initialize') -----
needsToRegenerateInterpreterFile
"Check the timestamp for the relevant classes and then the timestamp for the main
source file (e.g. interp.c) if it already exists. Answer if the file needs regenerating."
| classes tStamp |
classes := self interpreterClass withAllSuperclasses copyUpTo: VMClass.
self interpreterClass objectMemoryClass ifNotNil:
[:objectMemoryClass|
classes addAllLast: (objectMemoryClass withAllSuperclasses copyUpTo: VMClass)].
classes copy do:
[:class| classes addAllLast: (class ancilliaryClasses: self options)].
tStamp := classes inject: 0 into: [:tS :cl| tS max: cl timeStamp].
"don't translate if the file is newer than my timeStamp"
(self coreVMDirectory entryAt: self interpreterFilename ifAbsent: [nil]) ifNotNil:
[:fstat|
+ tStamp < fstat modificationTime asSeconds ifTrue:
- tStamp < fstat modificationTime ifTrue:
[^self confirm: 'The ', self configurationNameIfAny, 'interpreter classes have not been modified since\ the interpreter file was last generated.\Do you still want to regenerate the source file?' withCRs]].
^true
!
Item was changed:
----- Method: VMMakerTool class>>initialize (in category 'instance creation') -----
initialize
+ Smalltalk at: #TheWorldMenu ifPresent: [ :class |
+ class class methodDict at: #registerOpenCommand: ifPresent: [ :method |
+ (method sendsSelector: #deprecated:)
+ ifFalse: [ class registerOpenCommand: (Array with: 'VMMaker' with: (Array with: self with: #openInWorld)) ] ] ]
+ !
- (TheWorldMenu respondsTo: #registerOpenCommand:)
-
- ifTrue: [TheWorldMenu registerOpenCommand: {'VMMaker'. {self. #openInWorld}. 'The VM making tool'}].!
1
0