[Vm-dev] VM Maker: VMMaker-oscog-golubovsky.135.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Jan 1 03:12:49 UTC 2012


Dmitry Golubovsky uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-oscog-golubovsky.135.mcz

==================== Summary ====================

Name: VMMaker-oscog-golubovsky.135
Author: golubovsky
Time: 31 December 2011, 10:09:43 pm
UUID: 960c38bd-0efc-433e-8f7f-4e4e2a341d02
Ancestors: VMMaker-oscog-golubovsky.133

Added primClipboardString: obtains a string from Android clipboard if there is any. Returns an empty string if nothing is available.

=============== Diff against VMMaker-oscog-IgorStasenko.123 ===============

Item was changed:
  SystemOrganization addCategory: #'VMMaker-Building'!
  SystemOrganization addCategory: #'VMMaker-JIT'!
  SystemOrganization addCategory: #'VMMaker-Interpreter'!
  SystemOrganization addCategory: #'VMMaker-InterpreterSimulation'!
  SystemOrganization addCategory: #'VMMaker-JITSimulation'!
  SystemOrganization addCategory: #'VMMaker-Translation to C'!
  SystemOrganization addCategory: #'VMMaker-Support'!
  SystemOrganization addCategory: #'VMMaker-PostProcessing'!
  SystemOrganization addCategory: #'VMMaker-MemoryManager'!
  SystemOrganization addCategory: #'VMMaker-MemoryManagerSimulation'!
  SystemOrganization addCategory: #'VMMaker-Multithreading'!
  SystemOrganization addCategory: #'VMMaker-Tests'!
  SystemOrganization addCategory: #'VMMaker-Plugins'!
  SystemOrganization addCategory: #'VMMaker-SmartSyntaxPlugins'!
+ SystemOrganization addCategory: #'VMMaker-Plugins-Android'!
  SystemOrganization addCategory: #'VMMaker-Plugins-Alien'!

Item was added:
+ InterpreterPlugin subclass: #AndroidPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'CogEnv CogVM'
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins-Android'!
+ 
+ !AndroidPlugin commentStamp: 'golubovsky 9/3/2011 21:20' prior: 0!
+ This is a plugin for the Android port of Cog providing generic interface to Android Java runtime.!

Item was added:
+ ----- Method: AndroidPlugin class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ 
+ 	aCCodeGenerator addHeaderFile: '<jni.h>'.
+ 
+ !

Item was added:
+ ----- Method: AndroidPlugin>>primBriefMessage (in category 'system primitives') -----
+ primBriefMessage
+ 	| msg vmcls vmobj bmmeth jmsg |
+ 	<var: 'msg' type: 'char *'>
+ 	<var: 'vmcls' type: 'jclass'>
+ 	<var: 'vmobj' type: 'jobject'>
+ 	<var: 'bmmeth' type: 'jmethodID'>
+ 	<var: 'jmsg' type: 'jstring'>
+ 	<export: true>
+ 	msg :=  self stringArgumentAt: 0.
+ 	vmcls := self getVMClass.
+ 	vmcls ifNil: [^ interpreterProxy primitiveFail].
+ 	vmobj := self getVMObject.
+ 	vmobj ifNil: [^ interpreterProxy primitiveFail].
+ 	bmmeth := self getMethod: 'briefMessage' withSig: '(Ljava/lang/String;)V' inClass: vmcls.
+ 	bmmeth ifNil: [^ interpreterProxy primitiveFail].
+ 	jmsg := self asJavaString: msg.
+ 	jmsg ifNil: [^ interpreterProxy primitiveFail].
+ 	self callVoidMethod: bmmeth On: vmobj with:jmsg.
+ 	interpreterProxy pop: 1. "leave rcvr on stack"
+ !

Item was added:
+ ----- Method: AndroidPlugin>>primGetClipboardString (in category 'system primitives') -----
+ primGetClipboardString
+ 	| vmcls vmobj bmmeth jmsg res size oop ptr |
+ 	<var: 'res' type: 'char *'>
+ 	<var: 'vmcls' type: 'jclass'>
+ 	<var: 'vmobj' type: 'jobject'>
+ 	<var: 'bmmeth' type: 'jmethodID'>
+ 	<export: true>
+ 	vmcls := self getVMClass.
+ 	vmcls ifNil: [^ interpreterProxy primitiveFail].
+ 	vmobj := self getVMObject.
+ 	vmobj ifNil: [^ interpreterProxy primitiveFail].
+ 	bmmeth := self getMethod: 'getClipboardString' withSig: '()Ljava/lang/String;' inClass: vmcls.
+ 	bmmeth ifNil: [^ interpreterProxy primitiveFail].
+ 	res := self callStringMethod: bmmeth On: vmobj with: 0.
+ 	size := self strlen: res.
+ 	oop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: size.
+ 	ptr := interpreterProxy firstIndexableField: oop.
+ 	self memc: ptr p: res y: size.
+ 	self free: res.
+ 	interpreterProxy pop: 1.
+ 	interpreterProxy push: oop.
+ !

Item was added:
+ ----- Method: AndroidPlugin>>primInAndroid (in category 'system primitives') -----
+ primInAndroid
+ 	"return true if running in Android. outside Android this primitive fails"
+ 
+ 	<export: true>
+ 	interpreterProxy pop: 1; pushBool: true.!

Item was added:
+ ----- Method: AndroidPlugin>>primSetPitch (in category 'system primitives') -----
+ primSetPitch
+ 	| pitch vmcls vmobj bmmeth jmsg res |
+ 	<var: 'pitch' type: 'float'>
+ 	<var: 'vmcls' type: 'jclass'>
+ 	<var: 'vmobj' type: 'jobject'>
+ 	<var: 'bmmeth' type: 'jmethodID'>
+ 	<export: true>
+ 	pitch :=  interpreterProxy stackFloatValue: 0.
+ 	vmcls := self getVMClass.
+ 	vmcls ifNil: [^ interpreterProxy primitiveFail].
+ 	vmobj := self getVMObject.
+ 	vmobj ifNil: [^ interpreterProxy primitiveFail].
+ 	bmmeth := self getMethod: 'setPitch' withSig: '(F)I' inClass: vmcls.
+ 	bmmeth ifNil: [^ interpreterProxy primitiveFail].
+ 	res := self callIntMethod: bmmeth On: vmobj with: pitch.
+ 	interpreterProxy pop: 2.
+ 	interpreterProxy pushInteger: res.
+ !

Item was added:
+ ----- Method: AndroidPlugin>>primSetSpeechRate (in category 'system primitives') -----
+ primSetSpeechRate
+ 	| rate vmcls vmobj bmmeth jmsg res |
+ 	<var: 'rate' type: 'float'>
+ 	<var: 'vmcls' type: 'jclass'>
+ 	<var: 'vmobj' type: 'jobject'>
+ 	<var: 'bmmeth' type: 'jmethodID'>
+ 	<export: true>
+ 	rate :=  interpreterProxy stackFloatValue: 0.
+ 	vmcls := self getVMClass.
+ 	vmcls ifNil: [^ interpreterProxy primitiveFail].
+ 	vmobj := self getVMObject.
+ 	vmobj ifNil: [^ interpreterProxy primitiveFail].
+ 	bmmeth := self getMethod: 'setSpeechRate' withSig: '(F)I' inClass: vmcls.
+ 	bmmeth ifNil: [^ interpreterProxy primitiveFail].
+ 	res := self callIntMethod: bmmeth On: vmobj with: rate.
+ 	interpreterProxy pop: 2.
+ 	interpreterProxy pushInteger: res.
+ !

Item was added:
+ ----- Method: AndroidPlugin>>primShortCut (in category 'system primitives') -----
+ primShortCut
+ 	"path label cmd width height bits"
+ 	| vmcls vmobj meth imgpath jpath imglabel jlabel cmd jcmd width height bits bitlen bitptr jbits |
+ 	<var: 'imgpath' type: 'char *'>
+ 	<var: 'vmcls' type: 'jclass'>
+ 	<var: 'vmobj' type: 'jobject'>
+ 	<var: 'meth' type: 'jmethodID'>
+ 	<var: 'jpath' type: 'jstring'>
+ 	<export: true>
+ 	imgpath :=  self stringArgumentAt: 5.
+ 	jpath := self asJavaString: imgpath.
+ 	jpath ifNil: [^ interpreterProxy primitiveFail].
+ 	imglabel :=  self stringArgumentAt: 4.
+ 	jlabel := self asJavaString: imglabel.
+ 	jlabel ifNil: [^ interpreterProxy primitiveFail].
+ 	cmd :=  self stringArgumentAt: 3.
+ 	jcmd := self asJavaString: cmd.
+ 	jcmd ifNil: [^ interpreterProxy primitiveFail].
+ 	width :=  interpreterProxy stackIntegerValue: 2.
+ 	height :=  interpreterProxy stackIntegerValue: 1.
+ 	bits := interpreterProxy stackValue: 0.
+ 	bits ifNotNil: [
+ 		(interpreterProxy isBytes: bits) ifFalse: [^ interpreterProxy primitiveFail].
+ 		bitlen := interpreterProxy byteSizeOf: bits.
+ 		bitptr := interpreterProxy firstIndexableField: bits.
+ 		jbits := self asJavaByte: bitptr Array: bitlen.
+ 		jbits ifNil: [^ interpreterProxy primitiveFail].
+ 	] ifNil: [
+ 		jbits := nil.
+ 	].
+ 	vmcls := self getVMClass.
+ 	vmcls ifNil: [^ interpreterProxy primitiveFail].
+ 	vmobj := self getVMObject.
+ 	vmobj ifNil: [^ interpreterProxy primitiveFail].
+ 	meth := self getMethod: 'imageShortCut' withSig: '(Ljava/lang/String;Ljava/lang/String;Ljava/lang/String;II[B)V'
+ 				 inClass: vmcls.
+ 	meth ifNil: [^ interpreterProxy primitiveFail].
+       self callVoidMethod: meth On: vmobj with: jpath m: jlabel a: jcmd n: width y: height args: jbits.
+ 	interpreterProxy pop: 6. "leave rcvr on stack"
+ !

Item was added:
+ ----- Method: AndroidPlugin>>primSpeak (in category 'system primitives') -----
+ primSpeak
+ 	| msg vmcls vmobj bmmeth jmsg res |
+ 	<var: 'msg' type: 'char *'>
+ 	<var: 'vmcls' type: 'jclass'>
+ 	<var: 'vmobj' type: 'jobject'>
+ 	<var: 'bmmeth' type: 'jmethodID'>
+ 	<var: 'jmsg' type: 'jstring'>
+ 	<export: true>
+ 	msg :=  self stringArgumentAt: 0.
+ 	vmcls := self getVMClass.
+ 	vmcls ifNil: [^ interpreterProxy primitiveFail].
+ 	vmobj := self getVMObject.
+ 	vmobj ifNil: [^ interpreterProxy primitiveFail].
+ 	bmmeth := self getMethod: 'speak' withSig: '(Ljava/lang/String;)I' inClass: vmcls.
+ 	bmmeth ifNil: [^ interpreterProxy primitiveFail].
+ 	jmsg := self asJavaString: msg.
+ 	jmsg ifNil: [^ interpreterProxy primitiveFail].
+ 	res := self callIntMethod: bmmeth On: vmobj with:jmsg.
+ 	interpreterProxy pop: 2.
+ 	interpreterProxy pushInteger: res.
+ !

Item was added:
+ ----- Method: AndroidPlugin>>stringArgumentAt: (in category 'accessing') -----
+ stringArgumentAt: anOffset
+ 	"To be inlined: common operations to obtain a string argument value at given stack offset.
+ 	 The string returned is null-terminated, and alloca-d, so will be freed automatically"
+ 	|  pointer index size alc |
+ 	<inline: true>
+ 	<var: 'alc' type: 'void *'>
+ 	<returnTypeC: #'void *'>
+ 	pointer := interpreterProxy stackValue: anOffset.
+ 	(interpreterProxy isBytes: pointer)
+ 		ifFalse: [^ interpreterProxy primitiveFail].
+ 	index := interpreterProxy firstIndexableField: pointer.
+ 	size := interpreterProxy byteSizeOf: pointer.
+ 	alc := self alloca: (size + 1).
+ 	self mem: alc se: 0 t: (size + 1).
+ 	self mem: alc cp: index y: size.
+ 	^alc.
+ !

Item was added:
+ ----- Method: CoInterpreter>>cePushActiveContext (in category 'trampolines') -----
+ cePushActiveContext
+ 	<api>
+ 	"Since the trampoline checks for marriage we should only be here for a single frame."
+ 	self assert: (self isMachineCodeFrame: framePointer).
+ 	self assert: (self frameHasContext: framePointer) not.
+ 	"Do *not* include the return pc in the stack contents; hence + BytesPerWord"
+ 	^self marryFrame: framePointer SP: stackPointer + BytesPerWord!

Item was added:
+ ----- Method: CoInterpreter>>mframeReceiverExport (in category 'frame access') -----
+ mframeReceiverExport
+ 	<api>
+ 	^stackPages longAt: framePointer + FoxMFReceiver!

Item was added:
+ ----- Method: CoInterpreter>>noInlineTemporary:in: (in category 'internal interpreter access') -----
+ noInlineTemporary: offset in: theFP
+ 	<var: #theFP type: #'char *'>
+ 	<inline: false>
+ 	^self temporary: offset in: theFP!

Item was added:
+ ----- Method: CogVMSimulator>>endPCOf: (in category 'debug printing') -----
+ endPCOf: aMethod
+ 	| pc end latestContinuation prim |
+ 	pc := latestContinuation := self startPCOfMethod: aMethod.
+ 	(prim := self primitiveIndexOf: aMethod) > 0 ifTrue:
+ 		[(self isQuickPrimitiveIndex: prim) ifTrue:
+ 			[^pc - 1]].
+ 	end := objectMemory byteSizeOf: aMethod.
+ 	[pc <= end] whileTrue:
+ 		[| byte byte2 byte3 byte4 type offset jumpTarget |
+ 		 byte := objectMemory fetchByte: pc ofObject: aMethod.
+ 		 type := byte // 16.
+ 		 offset := byte \\ 16.  
+ 		 (type =7 and: [offset >= 8 and: [pc >= latestContinuation]]) ifTrue:"Return bytecodes (possible lastPC here)"
+ 			[end := pc].
+ 		 (type = 8 and: [offset = 15]) ifTrue: "closure creation; update latest continuation"
+ 			[byte3 := objectMemory fetchByte: pc + 2 ofObject: aMethod.
+ 			 byte4 := objectMemory fetchByte: pc + 3 ofObject: aMethod.
+ 			 jumpTarget := (byte3 * 256) + byte4 + pc + 4.
+ 			 jumpTarget > latestContinuation ifTrue: [latestContinuation := jumpTarget]].
+ 		 type=9 ifTrue: "Short jumps (need to update latest continuation"
+ 			[jumpTarget := (offset < 8 ifTrue: [offset] ifFalse: [offset - 8]) + pc + 2.
+ 			jumpTarget > latestContinuation ifTrue: [latestContinuation := jumpTarget]].
+ 		 type=10 ifTrue: "Long jumps (need to update latest continuation)"
+ 			[byte2 := objectMemory fetchByte: pc + 1 ofObject: aMethod.
+ 			 jumpTarget := (offset < 8 ifTrue: [offset - 4] ifFalse: [offset bitAnd: 3]) * 256 + byte2 + pc + 2.
+ 			 jumpTarget > latestContinuation ifTrue: [latestContinuation := jumpTarget]].
+ 		"Note we cannot skip by going to the latestContinuation because that may jump over jumps."
+ 		pc := type = 8 "extensions"
+ 				ifTrue: [pc + (#(2 2 2 2 3 2 2 1 1 1 2 1 3 3 3 4) at: byte \\ 16 + 1)]
+ 				ifFalse: [type = 10 "long jumps"
+ 							ifTrue: [pc + 2]
+ 							ifFalse: [pc + 1]]].
+ 	^end!

Item was added:
+ ----- Method: Cogit>>ceImplicitReceiverFor: (in category 'in-line cacheing') -----
+ ceImplicitReceiverFor: selector
+ 	"Cached implicit receiver implementation.  Caller looks like
+ 		mov selector, ClassReg
+ 				call ceImplicitReceiver
+ 				br continue
+ 		Lclass	.word
+ 		Lmixin:	.word
+ 		continue:
+ 	 If class matches class of receiver then mixin contains either 0 or the implicit receiver.
+ 	 If mixin is 0, answer the actual receiver, otherwise mixin."
+ 
+ 	| receiver retpc classpc mixinpc rcvrClass mixin |
+ 	receiver := coInterpreter mframeReceiverExport.
+ 	retpc := coInterpreter stackTop.
+ 	classpc := retpc + backEnd jumpShortByteSize.
+ 	mixinpc := retpc + backEnd jumpShortByteSize + BytesPerOop.
+ 	rcvrClass := objectMemory fetchClassOf: receiver.
+ 	rcvrClass ~= (backEnd unalignedLongAt: classpc) ifTrue:
+ 		[mixin := coInterpreter
+ 					implicitReceiverFor: receiver
+ 					mixin: coInterpreter mMethodClass
+ 					implementing: selector.
+ 		 backEnd unalignedLongAt: classpc put: rcvrClass.
+ 		 backEnd unalignedLongAt: mixinpc put: (mixin = receiver ifTrue: [0] ifFalse: [mixin]).
+ 		 ^mixin].
+ 	self breakOnImplicitReceiver ifTrue:
+ 		[self sendBreak: selector + BaseHeaderSize
+ 			point: (objectMemory lengthOf: selector)
+ 			receiver: nil].
+ 	mixin := backEnd unalignedLongAt: mixinpc.
+ 	^mixin = 0 ifTrue: [receiver] ifFalse: [mixin]!

Item was added:
+ ----- Method: Cogit>>genPushActiveContextTrampoline (in category 'initialization') -----
+ genPushActiveContextTrampoline
+ 	"Short-circuit the trampoline if a frame is already married."
+ 	| jumpSingle |
+ 	<var: #jumpSingle type: #'AbstractInstruction *'>
+ 	opcodeIndex := 0.
+ 	self MoveMw: FoxMethod r: FPReg R: TempReg.
+ 	self AndCq: MFMethodFlagHasContextFlag R: TempReg.
+ 	jumpSingle := self JumpZero: 0.
+ 	self MoveMw: FoxThisContext r: FPReg R: ReceiverResultReg.
+ 	self RetN: 0.
+ 	jumpSingle jmpTarget: self Label.
+ 	^self genTrampolineFor: #cePushActiveContext asSymbol
+ 		called: 'cePushActiveContextTrampoline'
+ 		callJumpBar: true
+ 		numArgs: 0
+ 		arg: nil
+ 		arg: nil
+ 		arg: nil
+ 		arg: nil
+ 		saveRegs: false
+ 		resultReg: ReceiverResultReg
+ 		appendOpcodes: true!

Item was added:
+ StackEvtInterpreter subclass: #StackEvtAndroidInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Interpreter'!
+ 
+ !StackEvtAndroidInterpreter commentStamp: 'golubovsky 7/31/2011 13:19' prior: 0!
+ Unfortunately this class has not been documented yet. The class comment should describe the purpose of the class, its collaborations and its variables. We encourage you to fill up the following template.
+ 
+ This is a subclass of the Stack Event Cog implementing Android-specific things.!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>cr (in category 'debug printing') -----
+ cr
+ 	"In Android, prints the carriage return to the JNI debug log file."
+ 	<inline: true>
+ 	self print: '\n'!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>flush (in category 'debug printing') -----
+ flush
+ !

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>isBigEnder (in category 'memory access') -----
+ isBigEnder
+ 	"Ported from the classic VM as it works well on Android"
+ 	"Answer true (non-zero) if running on a big endian machine."
+ 	| endianness anInt cString len i |
+ 	<var: 'cString' type: 'char *'>
+ 	<var: 'endianness' declareC: 'static sqInt endianness = -1'>
+ 	(endianness == -1) ifFalse: [^ endianness]. "answer cached value"
+ 	len := self cCode: 'sizeof(anInt)'
+ 			inSmalltalk: [^ (Smalltalk endianness == #little) not].
+ 	cString := self cCode: '(char *) &anInt' inSmalltalk: [].
+ 	i := 0.
+ 	[i < len] whileTrue:
+ 		[cString at: i put: i.
+ 		i := i + 1].
+ 	endianness :=  anInt bitAnd: 255.
+ 	^ endianness
+ !

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>methodArg: (in category 'debug printing') -----
+ methodArg: index
+ 	"Like #stackValue: but access method arguments left-to-right"
+ 	index > argumentCount + 1 ifTrue:[
+ 		self cCode: 'jprintf("[VM]: Attempt to access method args beyond range\n")'.
+ 		self printCallStack.
+ 		self primitiveFail.
+ 		^0].
+ 	^self stackValue: argumentCount - index!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>noInlineTemporary:in: (in category 'indexing primitive support') -----
+ noInlineTemporary: offset in: theFP
+ 	<var: #theFP type: #'char *'>
+ 	<inline: false>
+ 	^self temporary: offset in: theFP!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>preambleCCode (in category 'translation support') -----
+ preambleCCode
+ 	^	
+ 'void printCallStack(void);
+ 
+ /* Disable Intel compiler inlining of warning which is used for breakpoints */
+ #pragma auto_inline off
+ void
+ warning(char *s) { /* Print an error message but don''t exit. */
+ 	dprintf(4, "\n%s\n", s);
+ }
+ #pragma auto_inline on
+ 
+ void
+ invalidCompactClassError(char *s) { /* Print a compact class index error message and exit. */
+ 	static sqInt printingStack = true; /* not running at this point */
+ 
+ 	dprintf(3, "\nClass %s does not have the required compact class index\n", s);
+ 	exit(-1);
+ }
+ 
+ /*
+  * Define sigsetjmp and siglongjmp to be the most minimal setjmp/longjmp available on the platform.
+  */
+ #if WIN32
+ # define sigsetjmp(jb,ssmf) setjmp(jb)
+ # define siglongjmp(jb,v) longjmp(jb,v)
+ #else
+ # define sigsetjmp(jb,ssmf) _setjmp(jb)
+ # define siglongjmp(jb,v) _longjmp(jb,v)
+ #endif
+ '!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>print: (in category 'debug printing') -----
+ print: s
+ 	"In Android, prints the given string to the JNI debug log file."
+ 	<api>
+ 	<var: #s type: #'char *'>
+ 	self cCode: 'jniputstr(s)'.!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>printChar: (in category 'debug printing') -----
+ printChar: aByte
+ 	<api>
+ 	"In Android, prints the given character to the JNI debug log file."
+ 	self jniputchar: aByte.!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>printFloat: (in category 'debug printing') -----
+ printFloat: f
+ 	"For testing in Smalltalk, this method should be overridden in a subclass."
+ 	<cmacro: '(f) jprintf("%g", f)'>
+ 	self print: f!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>printHex: (in category 'debug printing') -----
+ printHex: n
+ 	"Print n in hex,  in the form '    0x1234', padded to a width of 10 characters
+ 	 in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles)"
+ 	<api>
+ 	| len buf |
+ 	<var: #buf declareC: 'char buf[35]'> "large enough for a 64-bit value in hex plus the null plus 16 spaces"
+ 	self cCode: 'memset(buf,'' '',34)' inSmalltalk: [buf := 'doh!!'].
+ 	len := self cCode: 'sprintf(buf + 2 + 2 * BytesPerWord, "0x%lx", (unsigned long)(n))'.
+ 	self cCode: 'jprintf("%s", buf + len)'.
+ 	len touch: buf!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>printNum: (in category 'debug printing') -----
+ printNum: n
+ 	"For testing in Smalltalk, this method should be overridden in a subclass."
+ 
+ 	self cCode: 'jprintf("%ld", (long) n)'.!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>printOop: (in category 'debug printing') -----
+ printOop: oop
+ 	| cls fmt lastIndex startIP bytecodesPerLine |
+ 	<inline: false>
+ 	self printHex: oop.
+ 	(objectMemory isIntegerObject: oop) ifTrue:
+ 		[^self
+ 			cCode: 'jprintf("=%ld\n", integerValueOf(oop))'
+ 			inSmalltalk: [self print: (self shortPrint: oop); cr]].
+ 	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
+ 		[self printHex: oop; print: ' is not on the heap'; cr.
+ 		 ^nil].
+ 	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
+ 		[self printHex: oop; print: ' is misaligned'; cr.
+ 		 ^nil].
+ 	(objectMemory isFreeObject: oop) ifTrue:
+ 		[self print: ' free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr.
+ 		 ^nil].
+ 	self print: ': a(n) '.
+ 	self printNameOfClass: (cls := objectMemory fetchClassOfNonInt: oop) count: 5.
+ 	cls = (objectMemory splObj: ClassFloat) ifTrue:
+ 		[self cr; printFloat: (self dbgFloatValueOf: oop); cr.
+ 		 ^nil].
+ 	fmt := objectMemory formatOf: oop.
+ 	fmt > 4 ifTrue:
+ 		[self print: ' nbytes '; printNum: (objectMemory byteSizeOf: oop)].
+ 	self cr.
+ 	(fmt > 4 and: [fmt < 12]) ifTrue:
+ 		["This will answer false if splObj: ClassAlien is nilObject"
+ 		 (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
+ 			[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
+ 			self print: ((self isIndirectAlien: oop)
+ 							ifTrue: [' indirect @ ']
+ 							ifFalse:
+ 								[(self isPointerAlien: oop)
+ 									ifTrue: [' pointer @ ']
+ 									ifFalse: [' direct @ ']]).
+ 			 self printHex: (self startOfAlienData: oop); cr.
+ 			 ^nil].
+ 		 (objectMemory isWords: oop) ifTrue:
+ 			[lastIndex := 64 min: ((objectMemory byteSizeOf: oop) / BytesPerWord).
+ 			 lastIndex > 0 ifTrue:
+ 				[1 to: lastIndex do:
+ 					[:index|
+ 					self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
+ 					(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
+ 						[self cr]].
+ 				(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
+ 					[self cr]].
+ 			^nil].
+ 		^self printStringOf: oop; cr].
+ 	lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
+ 	lastIndex > 0 ifTrue:
+ 		[1 to: lastIndex do:
+ 			[:index|
+ 			self cCode: 'printHex(fetchPointerofObject(index - 1, oop)); putchar('' '')'
+ 				inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
+ 							 self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
+ 			(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
+ 				[self cr]].
+ 		(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
+ 			[self cr]].
+ 	(objectMemory isCompiledMethod: oop)
+ 		ifFalse:
+ 			[startIP > 64 ifTrue: [self print: '...'; cr]]
+ 		ifTrue:
+ 			[startIP := startIP * BytesPerWord + 1.
+ 			 lastIndex := objectMemory lengthOf: oop.
+ 			 lastIndex - startIP > 100 ifTrue:
+ 				[lastIndex := startIP + 100].
+ 			 bytecodesPerLine := 10.
+ 			 startIP to: lastIndex do:
+ 				[:index| | byte |
+ 				byte := objectMemory fetchByte: index - 1 ofObject: oop.
+ 				self cCode: 'jprintf(" %02x/%-3d", byte,byte)'
+ 					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
+ 				((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
+ 					[self cr]].
+ 			((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 ifFalse:
+ 				[self cr]]!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>printOopShortInner: (in category 'debug printing') -----
+ printOopShortInner: oop
+ 	| classOop name nameLen |
+ 	<var: #name type: #'char *'>
+ 	<inline: true>
+ 	self printChar: $=.
+ 	(objectMemory isIntegerObject: oop) ifTrue:
+ 		[self printNum: (objectMemory integerValueOf: oop);
+ 			printChar: $(;
+ 			printHex: (objectMemory integerValueOf: oop);
+ 			printChar: $).
+ 		 ^nil].
+ 	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
+ 		[self printHex: oop; print: ' is not on the heap'.
+ 		 ^nil].
+ 	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
+ 		[self printHex: oop; print: ' is misaligned'.
+ 		 ^nil].
+ 	(self isFloatObject: oop) ifTrue:
+ 		[self printFloat: (self dbgFloatValueOf: oop).
+ 		 ^nil].
+ 	classOop := objectMemory fetchClassOfNonInt: oop.
+ 	(objectMemory addressCouldBeObj: classOop) ifFalse:
+ 		[self print: 'a ??'. ^nil].
+ 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
+ 		[self printNameOfClass: oop count: 5.
+ 		 ^nil].
+ 	oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
+ 	oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
+ 	oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
+ 	nameLen := self lengthOfNameOfClass: classOop.
+ 	nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
+ 	name := self nameOfClass: classOop.
+ 	nameLen = 10 ifTrue:
+ 		[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
+ 			[self printChar: $"; printStringOf: oop; printChar: $".
+ 			 ^nil].
+ 		 (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
+ 			[self printChar: $#; printStringOf: oop.
+ 			 ^nil]].
+ 	(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
+ 		[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
+ 		 ^nil].
+ 	self cCode: [self dpri: 9 n: 'a(n) %.*s' t: nameLen f: name]
+ 		inSmalltalk: [self print: 'a(n) '; print: name]!

Item was added:
+ ----- Method: StackEvtAndroidInterpreter>>shortPrintOop: (in category 'debug printing') -----
+ shortPrintOop: oop
+ 	<inline: false>
+ 	self printNum: oop.
+ 	(objectMemory isIntegerObject: oop) ifTrue:
+ 		[^self cCode: 'jprintf("=%ld\n", integerValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]].
+ 	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
+ 		[self printHex: oop; print: ' is not on the heap'; cr.
+ 		 ^nil].
+ 	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
+ 		[self printHex: oop; print: ' is misaligned'; cr.
+ 		 ^nil].
+ 	self print: ': a(n) '.
+ 	self printNameOfClass: (objectMemory fetchClassOf: oop) count: 5.
+ 	self cr!

Item was added:
+ StackInterpreterPrimitives subclass: #StackEvtInterpreter
+ 	instanceVariableNames: 'jmpBufExit'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Interpreter'!
+ 
+ !StackEvtInterpreter commentStamp: 'golubovsky 7/9/2011 21:24' prior: 0!
+ This is a subclass of the StackInterpreter which implements the specifics of the Event-driven Cog Stack VM!

Item was added:
+ ----- Method: StackEvtInterpreter class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ 	"define the jmpbuf for bailing out of the interpreter: its definition will be added
+ 	to the definitions made by the parent classes - no super call is necessary"
+ 	aCCodeGenerator var: #jmpBufExit declareC: 'jmp_buf jmpBufExit'.
+ 	
+ 	!

Item was added:
+ ----- Method: StackEvtInterpreter>>callbackEnter: (in category 'callback support') -----
+ callbackEnter: callbackID
+ 	"Callbacks are disabled in Event VM"
+ 	<export: true>
+ 	<var: #callbackID type: #'sqInt *'>
+ 		[^false].!

Item was added:
+ ----- Method: StackEvtInterpreter>>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."
+ 	
+ 	"This method overrides its parent so that heartbeat is not initialized: EventVM does not
+ 	have hartbeat."
+ 	
+ 	"This method overrides its parent so that stack pages are malloc-ed rather than
+ 	alloca-ed so they are retained intact when interpreter exits to wait for an event."
+ 
+ 	"This should be in its own initStackPages method but Slang can't inline
+ 	 C code strings."
+ 	| stackPageBytes stackPagesBytes theStackMemory |
+ 	<var: #theStackMemory type: #'void *'>
+ 	stackPageBytes := self stackPageByteSize.
+ 	stackPagesBytes := self computeStackZoneSize.
+ 	theStackMemory := self
+ 						cCode: 'malloc(stackPagesBytes)'
+ 						inSmalltalk:
+ 							[stackPages := self stackPagesClass new.
+ 							 stackPages initializeWithByteSize: stackPagesBytes for: self].
+ 	stackPages
+ 		initializeStack: theStackMemory
+ 		numSlots: stackPagesBytes / BytesPerWord
+ 		pageSize: stackPageBytes / BytesPerWord
+ 		stackLimitOffset: self stackLimitOffset
+ 		stackPageHeadroom: self stackPageHeadroom.
+ 
+ 	"Once the stack pages are initialized we can continue to bootstrap the system."
+ 	self loadInitialContext.
+ 	self interpret.
+ 	^nil!

Item was added:
+ ----- Method: StackEvtInterpreter>>interpret (in category 'interpreter shell') -----
+ interpret
+ 	"This is the main interpreter loop. It normally loops forever, fetching and executing bytecodes. When running in the context of a browser plugin VM, however, it must return control to the browser periodically. This should done only when the state of the currently running Squeak thread is safely stored in the object heap. Since this is the case at the moment that a check for interrupts is performed, that is when we return to the browser if it is time to do so. Interrupt checks happen quite frequently. The EventVM version of interpreter also has a special jmp_buf used to bail out of the interpreter once no processes are ready to run. If returned for no events available, return value is 0, and if returned as normal VM termination, return value is 1. The host program may use this information to determine when to loop"
+ 
+ 	| result |
+ 	<inline: false>
+ 	"If stacklimit is zero then the stack pages have not been initialized."
+ 	stackLimit = 0 ifTrue:
+ 		[^self initStackPagesAndInterpret].
+ 	"record entry time when running as a browser plug-in"
+ 	self browserPluginInitialiseIfNeeded.
+ 	"set up a jmp_buf to bail out when no processes are ready to run"
+ 	result := self cCode: 'setjmp(jmpBufExit)' 
+ 				inSmalltalk:[jmpBufExit := [^self]. 0].
+ 	result = 0 ifFalse:[^0].	"return 0 when suspended for an event"
+ 	self internalizeIPandSP.
+ 	self fetchNextBytecode.
+ 	[true] whileTrue: [self dispatchOn: currentBytecode in: BytecodeTable].
+ 	localIP := localIP - 1.  "undo the pre-increment of IP before returning"
+ 	self externalizeIPandSP.
+ 	^1	"return 1 if normal VM termination"
+ !

Item was added:
+ ----- Method: StackEvtInterpreter>>primitiveRelinquishProcessor (in category 'process primitive support') -----
+ primitiveRelinquishProcessor
+ 	"This is a special version of the primitive used in an event-driven VM. It does not call host's
+ 	ioRelinquishProcessor at all; instead it long jumps to the interpreter's jump target and
+ 	exits to the host program. The interpreter will be reentered on the next event either
+ 	user-induced or by timer"
+ 
+ 	| microSecs |
+ 	microSecs := self stackIntegerValue: 0.
+ 	"DO NOT allow relinquishing the processor while we are profiling since this
+ 	may skew the time base for our measures (it may reduce processor speed etc).
+ 	Instead we go full speed, therefore measuring the precise time we spend in the
+ 	inner idle loop as a busy loop."
+ 	nextProfileTick = 0 ifTrue:[
+ 		self pop: 1.  "microSecs; leave rcvr on stack"
+ 		self cCode:'longjmp(jmpBufExit, 1)' 
+ 				inSmalltalk:[jmpBufExit value].
+ 	].
+ 	self pop: 1.  "microSecs; leave rcvr on stack"
+ !



More information about the Vm-dev mailing list