[Squeak-Commits] squeak/platforms/win32/extras FontPlugin.st,NONE,1.1 RePlugin.st,NONE,1.1 Win32StandardVMConfigurationTest.st,NONE,1.1

[Andreas R. <and...@us...>]

Update of /cvsroot/squeak/squeak/platforms/win32/extras
In directory sc8-pr-cvs1:/tmp/cvs-serv9662

Added Files:
	FontPlugin.st RePlugin.st Win32StandardVMConfigurationTest.st 
Log Message:
keep st plugin sources for reference

--- NEW FILE: FontPlugin.st ---
'From TeaSqueak3.2 of 19 September 2002 [latest update: #292] on 25 October 2002 at 12:17:06 am'!
InterpreterPlugin subclass: #FontPlugin
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Squeak-Plugins'!

!FontPlugin commentStamp: '<historical>' prior: 0!
FontPlugin translate.!


!FontPlugin methodsFor: 'initialize' stamp: 'ar 6/4/2000 19:18'!
initialiseModule
	"Initialise the module"
	self export: true.
	^self cCode: 'ioFontInit()' inSmalltalk:[true]! !

!FontPlugin methodsFor: 'initialize' stamp: 'ar 6/4/2000 19:18'!
shutdownModule
	"Initialise the module"
	self export: true.
	^self cCode: 'ioFontShutdown()' inSmalltalk:[true]! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 6/4/2000 23:11'!
primitiveCreateFont
	| fontName fontFlags fontSize fontNameLength fontNameIndex fontID |
	self export: true.
	interpreterProxy methodArgumentCount = 3
		ifFalse:[^interpreterProxy primitiveFail].
	fontFlags _ interpreterProxy stackIntegerValue: 0.
	fontSize _ interpreterProxy stackIntegerValue: 1.
	fontName _ interpreterProxy stackObjectValue: 2.
	interpreterProxy failed ifTrue:[^nil].
	(interpreterProxy isBytes: fontName)
		ifFalse:[^interpreterProxy primitiveFail].
	fontNameLength _ interpreterProxy byteSizeOf: fontName.
	fontNameIndex _ self cCoerce: (interpreterProxy firstIndexableField: fontName) to:'int'.
	fontID _ self cCode:'ioCreateFont(fontNameIndex, fontNameLength, fontSize, fontFlags)' inSmalltalk:[-1].
	fontID < 0 ifTrue:[^interpreterProxy primitiveFail].
	interpreterProxy pop: 4.
	interpreterProxy pushInteger: fontID.! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 6/4/2000 20:57'!
primitiveDestroyFont
	| fontIndex |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	fontIndex _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil].
	(self ioDestroyFont: fontIndex)
		ifFalse:[^interpreterProxy primitiveFail].
	^interpreterProxy pop: 1! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 6/4/2000 22:24'!
primitiveFontAscent
	| fontIndex ascent |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	fontIndex _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil].
	ascent _ self ioFontAscent: fontIndex.
	ascent >= 0
		ifFalse:[^interpreterProxy primitiveFail].
	interpreterProxy pop: 2.
	^interpreterProxy pushInteger: ascent.! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 2/18/2001 19:33'!
primitiveFontDataSize
	| fontIndex size |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	fontIndex _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil].
	size _ self ioGetFontDataSize: fontIndex.
	interpreterProxy pop: 2.
	^interpreterProxy pushInteger: size.! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 6/4/2000 22:25'!
primitiveFontDescent
	| fontIndex descent |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	fontIndex _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil].
	descent _ self ioFontDescent: fontIndex.
	descent >= 0
		ifFalse:[^interpreterProxy primitiveFail].
	interpreterProxy pop: 2.
	^interpreterProxy pushInteger: descent.! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 2/18/2001 19:57'!
primitiveFontEmbeddingFlags
	| fontIndex flags |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	fontIndex _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil].
	flags _ self ioFontEmbeddingFlags: fontIndex.
	interpreterProxy pop: 2.
	^interpreterProxy pushInteger: flags! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 6/4/2000 21:08'!
primitiveFontEncoding
	| fontIndex encoding |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	fontIndex _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil].
	encoding _ self ioFontEncoding: fontIndex.
	encoding >= 0
		ifFalse:[^interpreterProxy primitiveFail].
	interpreterProxy pop: 2.
	^interpreterProxy pushInteger: encoding.! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 8/28/2000 17:31'!
primitiveFontFullWidthOfChar
	| fontIndex charIndex array fullWidth |
	self var: #fullWidth declareC:'int fullWidth[3]'.
	self export: true.
	interpreterProxy methodArgumentCount = 2
		ifFalse:[^interpreterProxy primitiveFail].
	charIndex _ interpreterProxy stackIntegerValue: 0.
	fontIndex _ interpreterProxy stackIntegerValue: 1.
	interpreterProxy failed ifTrue:[^nil].
	(self cCode: 'ioFontFullWidthOfChar(fontIndex, charIndex, fullWidth)' inSmalltalk:[false])
		ifFalse:[^interpreterProxy primitiveFail].
	array _ interpreterProxy 
					instantiateClass: interpreterProxy classArray 
					indexableSize: 3.
	0 to: 2 do:[:i|
		interpreterProxy storeInteger: i ofObject: array withValue: (fullWidth at: i).
	].
	interpreterProxy pop: 3.
	^interpreterProxy push: array! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 8/28/2000 17:31'!
primitiveFontGetKernPair
	| fontIndex kernIndex array kernPair |
	self var: #kernPair declareC:'int kernPair[3]'.
	self export: true.
	interpreterProxy methodArgumentCount = 2
		ifFalse:[^interpreterProxy primitiveFail].
	kernIndex _ interpreterProxy stackIntegerValue: 0.
	fontIndex _ interpreterProxy stackIntegerValue: 1.
	interpreterProxy failed ifTrue:[^nil].
	(self cCode: 'ioFontGetKernPair(fontIndex, kernIndex, kernPair)' inSmalltalk:[false])
		ifFalse:[^interpreterProxy primitiveFail].
	array _ interpreterProxy 
					instantiateClass: interpreterProxy classArray 
					indexableSize: 3.
	0 to: 2 do:[:i|
		interpreterProxy storeInteger: i ofObject: array withValue: (kernPair at: i).
	].
	interpreterProxy pop: 3.
	^interpreterProxy push: array! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 6/4/2000 21:11'!
primitiveFontGlyphOfChar
	| fontIndex charIndex formOop formBits formWidth formHeight formDepth ppw pitch |
	self export: true.
	interpreterProxy methodArgumentCount = 3
		ifFalse:[^interpreterProxy primitiveFail].
	formOop _ interpreterProxy stackObjectValue: 0.
	charIndex _ interpreterProxy stackIntegerValue: 1.
	fontIndex _ interpreterProxy stackIntegerValue: 2.
	interpreterProxy failed ifTrue:[^nil].
	((interpreterProxy isPointers: formOop) and:[
		(interpreterProxy slotSizeOf: formOop) >= 4])
			ifFalse:[^interpreterProxy primitiveFail].
	formBits _ interpreterProxy fetchPointer: 0 ofObject: formOop.
	formWidth _ interpreterProxy fetchInteger: 1 ofObject: formOop.
	formHeight _ interpreterProxy fetchInteger: 2 ofObject: formOop.
	formDepth _ interpreterProxy fetchInteger: 3 ofObject: formOop.
	(formWidth > 0 and:[formHeight > 0 and:[formDepth > 0]])
		ifFalse:[^interpreterProxy primitiveFail].
	ppw _ 32 // formDepth.
	pitch _ formWidth + (ppw-1) // ppw * 4.
	((interpreterProxy fetchClassOf: formBits) == interpreterProxy classBitmap
		and:[(interpreterProxy byteSizeOf: formBits) = (pitch * formHeight)])
			ifFalse:[^interpreterProxy primitiveFail].
	formBits _ self cCoerce: (interpreterProxy firstIndexableField: formBits) to: 'int'.
	(self cCode:'ioFontGlyphOfChar(fontIndex, charIndex, formBits, formWidth, formHeight, formDepth)' inSmalltalk:[false])
		ifFalse:[^interpreterProxy primitiveFail].
	^interpreterProxy pop: 3.! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 8/28/2000 16:06'!
primitiveFontNumKernPairs
	| fontIndex nKernPairs |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	fontIndex _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil].
	nKernPairs _ self ioFontNumKernPairs: fontIndex.
	nKernPairs >= 0
		ifFalse:[^interpreterProxy primitiveFail].
	interpreterProxy pop: 2.
	^interpreterProxy pushInteger: nKernPairs.! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 6/4/2000 21:08'!
primitiveFontWidthOfChar
	| fontIndex charIndex charWidth |
	self export: true.
	interpreterProxy methodArgumentCount = 2
		ifFalse:[^interpreterProxy pr
imitiveFail].
	charIndex _ interpreterProxy stackIntegerValue: 0.
	fontIndex _ interpreterProxy stackIntegerValue: 1.
	interpreterProxy failed ifTrue:[^nil].
	charWidth _ self ioFont: fontIndex WidthOfChar: charIndex.
	(charWidth >= 0)
		ifFalse:[^interpreterProxy primitiveFail].
	interpreterProxy pop: 3.
	^interpreterProxy pushInteger: charWidth! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 2/18/2001 19:39'!
primitiveGetFontData
	| fontIndex buffer bufSize bufPtr result |
	self export: true.
	self var: #bufPtr type:'char *'.
	interpreterProxy methodArgumentCount = 2
		ifFalse:[^interpreterProxy primitiveFail].
	buffer _ interpreterProxy stackObjectValue: 0.
	fontIndex _ interpreterProxy stackIntegerValue: 1.
	interpreterProxy failed ifTrue:[^nil].
	(interpreterProxy isBytes: buffer) 
		ifFalse:[^interpreterProxy primitiveFail].
	bufSize _ interpreterProxy byteSizeOf: buffer.
	bufPtr _ interpreterProxy firstIndexableField: buffer.
	result _ self cCode: 'ioGetFontData(fontIndex, bufPtr, bufSize)'.
	interpreterProxy pop: 3.
	^interpreterProxy pushInteger: result.! !

!FontPlugin methodsFor: 'primitives' stamp: 'ar 6/4/2000 19:23'!
primitiveListFont
	| fontIndex fontName fontNameLen fontOop fontPtr |
	self export: true.
	self var: #fontName type:'char *'.
	self var: #fontPtr type:'char *'.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	fontIndex _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil].
	fontName _ self ioListFont: fontIndex.
	fontName == nil ifTrue:[
		interpreterProxy pop: 2.
		^interpreterProxy push: interpreterProxy nilObject].
	fontNameLen _ fontName strlen.
	fontOop _ interpreterProxy 
					instantiateClass: interpreterProxy classString 
					indexableSize: fontNameLen.
	fontPtr _ interpreterProxy firstIndexableField: fontOop.
	0 to: fontNameLen-1 do:[:i| fontPtr at: i put: (fontName at: i)].
	interpreterProxy pop: 2.
	interpreterProxy push: fontOop.! !


!FontPlugin class methodsFor: 'translation' stamp: 'ar 2/18/2001 19:58'!
headerFile
^'/* FontPlugin header file */

char *ioListFont(int fontIndex);
int ioCreateFont(int fontNameIndex, int fontNameLength, int pixelSize, int flags);
int ioDestroyFont(int fontIndex);
int ioFontWidthOfChar(int fontIndex, int characterIndex);
int ioFontFullWidthOfChar(int fontIndex, int characterIndex, int width[3]);
int ioFontNumKernPairs(int fontIndex);
int ioFontGetKernPair(int fontIndex, int kernIndex, int kernPair[3]);

int ioFontGlyphOfChar(int fontIndex, int characterIndex, 
					  int formBitsIndex, int formWidth, int formHeight, int formDepth);
int ioFontEncoding(int fontIndex);
int ioFontAscent(int fontIndex);
int ioFontDescent(int fontIndex);

int ioFontEmbeddingFlags(int fontIndex);
int ioGetFontDataSize(int fontIndex);
int ioGetFontData(int fontIndex, char *buffer, int bufSize);

'! !

--- NEW FILE: RePlugin.st ---
'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 8 April 2003 at 11:09:18 pm'!
TestInterpreterPlugin subclass: #RePlugin
	instanceVariableNames: 'netMemory numAllocs numFrees lastAlloc patternStr rcvr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags patternStrPtr errorStrBuffer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Werdna-Re'!
!RePlugin commentStamp: '<historical>' prior: 0!
/*	Regular Expression Plugin (This class comment becomes part of rePlugin.c)

	RePlugin translate: 'RePlugin.c' doInlining: true.

See documentation and source code for the PCRE C Library Code.  This plugin is designed to serve an object such as RePattern:

	patternStr		A 0-terminated string comprising the pattern to be compiled.
	compileFlags	An Integer representing re compiler options
	PCREBuffer		A ByteArray of regular expression bytecodes
	extraPtr			A ByteArray of match optimization data (or nil)
	errorString		A String Object For Holding an Error Message (when compile failed)
	errorOffset		The index in patternStr (0-based) where the error ocurred (when compile failed)
	matchFlags		An Integer representing re matcher options
	matchSpaceObj	An Integer array for match results and workspace during matching.

The instance variables must appear in the preceding order.  MatchSpaceObj must be allocated by the calling routine and contain at least 6*(numGroups+1) bytes.
*/
#include "pcre.h"
#include "internal.h"

/* Slight machine-specific hack for MacOS Memory Management */
#ifdef TARGET_OS_MAC
#define	malloc(ptr) NewPtr(ptr)
#define free(ptr) DisposePtr(aPointer)
#endif

/* Adjust malloc and free routines as used by PCRE */
void rePluginFree(void * aPointer);
void * rePluginMalloc(size_t anInteger);
void *(*pcre_malloc)(size_t) = rePluginMalloc;
void  (*pcre_free)(void *) = rePluginFree;
!


!RePlugin methodsFor: 're primitives' stamp: 'acg 3/12/1999 23:36'!
primPCRECompile

"<rcvr primPCRECompile>, where rcvr is an object with instance variables:

	'patternStr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags'	

Compile the regular expression in patternStr, and if the compilation is successful, attempt to optimize the compiled expression.  Store the results in <pcrePtr> and <extratr>, or fill errorStr with a meaningful errorString and errorOffset with an indicator where the error was found, applying compileFlags throughout.  Answer nil with a clean compile (regardless of whether an optimization is possible, and answer with the string otherwise."


	self export: true.
	self loadRcvrFromStackAt: 0.
	patternStrPtr _ self rcvrPatternStrPtr.
	compileFlags _ self rcvrCompileFlags.
	interpreterProxy failed ifTrue:[^ nil].

	pcrePtr _ self cCode: '(int) pcre_compile(patternStrPtr, compileFlags, 
					&errorStrBuffer, &errorOffset, NULL)'.
	pcrePtr
		ifTrue: [
			self allocateByteArrayAndSetRcvrPCREPtrFromPCRE: pcrePtr.
			extraPtr _ self cCode: '(int) pcre_study((pcre *)pcrePtr, compileFlags, &errorStrBuffer)'.
			self allocateByteArrayAndSetRcvrExtraPtrFrom: extraPtr.
			self rePluginFree: (self cCoerce: pcrePtr to: 'void *').
			extraPtr ifTrue: [self rePluginFree: (self cCoerce: extraPtr to: 'void *')].
			interpreterProxy failed ifTrue:[^ nil].
			interpreterProxy pop: 1 thenPush: interpreterProxy nilObject]
		ifFalse: [
			errorStr _ self allocateStringAndSetRcvrErrorStrFromCStr: errorStrBuffer.
			self rcvrErrorOffsetFrom: errorOffset.
			interpreterProxy failed ifTrue:[^ nil].
			interpreterProxy pop: 1 thenPush: errorStr].! !

!RePlugin methodsFor: 're primitives' stamp: 'acg 8/17/2002 16:12'!
primPCREExec

"<rcvr primPCREExec: searchObject>, where rcvr is an object with instance variables:

	'patternStr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags'	

Apply the regular expression (stored in <pcrePtr> and <extratr>, generated from calls to primPCRECompile), to smalltalk String searchObject using <matchOptions>.  If there is no match, answer nil.  Otherwise answer a ByteArray of offsets representing the results of the match."

	| searchObject searchBuffer length  result matchSpacePtr matchSpaceSize |
	self export: true.
	self var:#searchBuffer	declareC: 'char *searchBuffer'.
	self var:#matchSpacePtr	declareC: 'int *matchSpacePtr'.
	self var:#result			declareC: 'int result'.
	
	"Load Parameters"
	searchObject _ interpreterProxy stackObjectValue: 0.	
	searchBuffer _ interpreterProxy arrayValueOf: searchObject.
	length _ interpreterProxy byteSizeOf: searchObject.
	self loadRcvrFromStackAt: 1.
	"Load Instance Variables"
	pcrePtr _ self rcvrPCREBufferPtr.
	extraPtr _ self rcvrExtraPtr.
	matchFlags _ self rcvrMatchFlags.
	matchSpacePtr _ self rcvrMatchSpacePtr.
	matchSpaceSize _ self rcvrMatchSpaceSize.

	interpreterProxy failed ifTrue:[^ nil].
	
	result _ self 
		cCode: 'pcre_exec((pcre *)pcrePtr, (pcre_extra *)extraPtr, 
				searchBuffer, length, 0, matchFlags, matchSpacePtr, matchSpaceSize)'.

	interpreterProxy pop: 2; pushInteger: result.

	"empty call so compiler doesn't bug me about variables not used"
	self touch: searchBuffer; touch: matchSpacePtr; touch: matchSpaceSize; touch: length
! !

!RePlugin methodsFor: 're primitives' stamp: 'acg 8/17/2002 16:13'!
primPCREExecfromto

"<rcvr primPCREExec: searchObject> from: fromInteger to: toInteger>, where rcvr is an object with instance variables:

	'patternStr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags'	

Apply the regular expression (stored in <pcrePtr> and <extratr>, generated from calls to primPCRECompile), to smalltalk String searchObject using <matchOptions>, beginning at offset <fromInteger> and continuing until offset <toInteger>.  If there is no match, answer nil.  Otherwise answer a ByteArray of offsets representing the results of the match."

	| searchObject searchBuffer length  result matchSpacePtr matchSpaceSize fromInteger toInteger |
	self export: true.
	self var:#searchBuffer	declareC: 'char *searchBuffer'.
	self var:#fromInteger declareC: 'int fromInteger'.
	self var:#toInteger declareC: 'int toInteger'.
	self var:#matchSpacePtr	declareC: 'int *matchSpacePtr'.
	self var:#result			declareC: 'int result'.
	
	"Load Parameters"
	toInteger _ interpreterProxy stackIntegerValue: 0.
	fromInteger _ interpreterProxy stackIntegerValue: 1.
	searchObject _ interpreterProxy stackObjectValue: 2.	
	searchBuffer _ interpreterProxy arrayValueOf: searchObject.
	length _ interpreterProxy byteSizeOf: searchObject.
	self loadRcvrFromStackAt: 3.

	"Validate parameters"
	interpreterProxy success: (1 <= fromInteger).
	interpreterProxy success: (toInteger<=length).
	fromInteger _ fromInteger - 1. "Smalltalk offsets are 1-based"
	interpreterProxy success: (fromInteger<=toInteger).

	"adjust length, searchBuffer"
	length _ toInteger - fromInteger.
	searchBuffer _ searchBuffer + fromInteger.

	"Load Instance Variables"
	pcrePtr _ self rcvrPCREBufferPtr.
	extraPtr _ self rcvrExtraPtr.
	matchFlags _ self rcvrMatchFlags.
	matchSpacePtr _ self rcvrMatchSpacePtr.
	matchSpaceSize _ self rcvrMatchSpaceSize.
	interpreterProxy failed ifTrue:[^ nil].
	
	result _ self 
		cCode: 'pcre_exec((pcre *)pcrePtr, (pcre_extra *)extraPtr, 
				searchBuffer, length, 0, matchFlags, matchSpacePtr, matchSpaceSize)'.
	interpreterProxy pop: 2; pushInteger: result.

	"empty call so compiler doesn't bug me about variables not used"
	self touch: searchBuffer; touch: matchSpacePtr; touch: matchSpaceSize; touch: length
! !

!RePlugin methodsFor: 're primitives' stamp: 'acg 3/12/1999 23:32'!
primPCRENumSubPatterns

"<rcvr primPCRENumSubPatterns>, where rcvr is an object with instance variables:

	'patternStr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags'	

Return the number of subpatterns captured by the compiled pattern."

	self export: true.
	
	"Load Parameters"
	self loadRcvrFromStackAt: 0.
	"Load Instance Variables"
	pcrePtr _ self rcvrPCREBufferPtr.
	interpreterProxy pop: 1; pushInteger: (self cCode: 'pcre_info((pcre *)pcrePtr, NULL, NULL)').
! !


!RePlugin methodsFor: 'memory management' stamp: 'acg 2/25/1999 08:36'!
primLastAlloc
	
	self export: true.
	interpreterProxy pop:1; pushInteger: lastAlloc
! !

!RePlugin methodsFor: 'memory management' stamp: 'a
cg 2/21/1999 23:20'!
primNetMemory 
	
	self export: true.
	interpreterProxy pop:1; pushInteger: netMemory
! !

!RePlugin methodsFor: 'memory management' stamp: 'acg 2/21/1999 23:20'!
primNumAllocs

	self export: true.
	interpreterProxy pop:1; pushInteger: numAllocs
! !

!RePlugin methodsFor: 'memory management' stamp: 'acg 2/21/1999 23:20'!
primNumFrees 
	
	self export: true.
	interpreterProxy pop:1; pushInteger: numFrees
! !

!RePlugin methodsFor: 'memory management' stamp: 'acg 3/5/1999 09:18'!
rePluginFree: aPointer
	"Free a block of fixed memory allocated with rePluginMalloc.  Instrumented version of C free() to facilitate leak analysis from Smalltalk.   OS-specific variations on malloc/free, such as with MacOS, are handled by adding a C macro to the header file redefining malloc/free -- see the class comment"

	self inline: true.
	self var: #aPointer declareC: 'void * aPointer'.
	self returnTypeC: 'void'.

	numFrees _ numFrees + 1.
	(aPointer)
		ifTrue: [self cCode: 'free(aPointer)']	! !

!RePlugin methodsFor: 'memory management' stamp: 'acg 3/5/1999 09:19'!
rePluginMalloc: anInteger
	"Allocate a block of fixed memory using C calls to malloc().  Instrumented to facilitate leak analysis from Smalltalk.  Set global lastAlloc to anInteger.  OS-specific variations on malloc/free, such as with MacOS, are handled by adding a C macro to the header file redefining malloc/free -- see the class comment"

	| aPointer |
	self inline: true.
	self var: #anInteger declareC: 'size_t anInteger'.
	self var: #aPointer declareC: 'void *aPointer'.
	self returnTypeC: 'void *'.
	numAllocs _ numAllocs + 1.
	(aPointer _ self cCode: 'malloc(anInteger)')
		ifTrue: [lastAlloc _ anInteger].
	^aPointer
! !


!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/27/1999 23:22'!
allocateByteArrayAndSetRcvrExtraPtrFrom: anExtraPtr

	| extraObject extraByteArrayPtr |
	self var: #extraByteArrayPtr declareC: 'void *extraByteArrayPtr'.

	anExtraPtr
		ifFalse: [extraObject _ interpreterProxy nilObject]
		ifTrue: [
			"Allocate a Smalltalk ByteArray -- lastAlloc contains the length"
			extraObject _ interpreterProxy
						instantiateClass: (interpreterProxy classByteArray) 
						indexableSize: (self cCode: 'sizeof(real_pcre_extra)').
			self loadRcvrFromStackAt: 0. "Assume garbage collection after instantiation"

			"Copy from the C bytecode buffer to the Smalltalk ByteArray"
			extraByteArrayPtr _ interpreterProxy arrayValueOf: extraObject.	
			self cCode:'memcpy(extraByteArrayPtr, (void *) anExtraPtr, sizeof(real_pcre_extra))'].
 
	"Set rcvrErrorStr from errorStr and Return"
	self rcvrExtraPtrFrom: extraObject.
	self touch: extraByteArrayPtr.	
	^extraObject.
! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/27/1999 22:57'!
allocateByteArrayAndSetRcvrPCREPtrFromPCRE: aPCREPtr

	| patObject patByteArrayPtr |
	self var: #patByteArrayPtr declareC: 'void *patByteArrayPtr'.

	"Allocate a Smalltalk ByteArray -- lastAlloc contains the length"
	patObject _ interpreterProxy
				instantiateClass: (interpreterProxy classByteArray) 
				indexableSize: lastAlloc.
	self loadRcvrFromStackAt: 0. "Assume garbage collection after instantiation"

	"Copy from the C bytecode buffer to the Smalltalk ByteArray"
	patByteArrayPtr _ interpreterProxy arrayValueOf: patObject.	
	self cCode:'memcpy(patByteArrayPtr, (void *) aPCREPtr, lastAlloc)'.
 
	"Set rcvrErrorStr from errorStr and Return"
	self rcvrPCREBufferFrom: patObject.
	self touch: patByteArrayPtr.	
	^patObject.
! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'tpr 8/17/2002 18:01'!
allocateStringAndSetRcvrErrorStrFromCStr: aCStrBuffer

	|length errorStrObj errorStrObjPtr |
	self var: #aCStrBuffer declareC: 'const char *aCStrBuffer'.
	self var: #errorStrObjPtr declareC: 'void *errorStrObjPtr'.
	"Allocate errorStrObj"
	length _ self cCode: 'strlen(aCStrBuffer)'.
	errorStrObj _ interpreterProxy
				instantiateClass: (interpreterProxy classString) 
				indexableSize: length.
	self loadRcvrFromStackAt: 0. "Assume garbage collection after instantiation"

	"Copy aCStrBuffer to errorStrObj's buffer"
	errorStrObjPtr _ interpreterProxy arrayValueOf: errorStrObj.	
	self cCode:'memcpy(errorStrObjPtr,aCStrBuffer,length)'.
	self touch: errorStrObjPtr; touch: errorStrObj.
	"Set rcvrErrorStr from errorStrObj and Return"
	self rcvrErrorStrFrom: errorStrObj.
	^errorStrObj.! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/21/1999 22:58'!
loadRcvrFromStackAt: stackInteger

	self inline:true.
	rcvr _ interpreterProxy stackObjectValue: stackInteger.
! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/21/1999 21:20'!
rcvrCompileFlags

	self inline:true.
	^interpreterProxy fetchInteger: 1 ofObject: rcvr.
! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/21/1999 22:46'!
rcvrErrorOffsetFrom: anInteger

	self inline: true.
	interpreterProxy storeInteger: 5 ofObject: rcvr withValue: anInteger.
! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/24/1999 20:53'!
rcvrErrorStrFrom: aString

	self inline: true.
	interpreterProxy 
		storePointer: 4
		ofObject: rcvr 
		withValue: aString.
! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'ikp 8/21/2002 22:40'!
rcvrExtraPtr

	|extraObj|
	self inline: true.
	extraObj _ interpreterProxy fetchPointer: 3 ofObject: rcvr.
	(extraObj = (interpreterProxy nilObject))
		ifTrue: [^ self cCode: '(int) NULL'].
	^self 
		cCoerce:(interpreterProxy arrayValueOf: extraObj)
		to: 'int'.! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/27/1999 23:42'!
rcvrExtraPtrFrom: aByteArrayOrNilObject

	self inline: true.
	interpreterProxy 
		storePointer: 3 
		ofObject: rcvr 
		withValue: aByteArrayOrNilObject! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/21/1999 21:19'!
rcvrMatchFlags

	self inline: true.
	^interpreterProxy fetchInteger: 6 ofObject: rcvr.
! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/25/1999 00:49'!
rcvrMatchSpacePtr

	self inline: true.
	self returnTypeC: 'int *'.
	^self
		cCoerce: (interpreterProxy fetchArray: 7 ofObject: rcvr)
		to: 'int *'.! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/25/1999 00:52'!
rcvrMatchSpaceSize

	self inline: true.
	^(interpreterProxy byteSizeOf: (interpreterProxy fetchPointer: 7 ofObject: rcvr))//4.! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/24/1999 21:33'!
rcvrPCREBufferFrom: aByteArray

	self inline: true.
	interpreterProxy 
		storePointer: 2 
		ofObject: rcvr 
		withValue: aByteArray! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/24/1999 21:33'!
rcvrPCREBufferPtr

	self inline: true.
	^self
		cCoerce: (interpreterProxy fetchArray: 2 ofObject: rcvr)
		to: 'int'.! !

!RePlugin methodsFor: 'rcvr linkage' stamp: 'acg 2/24/1999 21:34'!
rcvrPatternStrPtr

	self inline: true.
	self returnTypeC: 'char *'.
	^self 
		cCoerce: (interpreterProxy fetchArray: 0 ofObject: rcvr) 
		to: 'char *'.! !


!RePlugin methodsFor: 'private' stamp: 'acg 3/12/1999 23:32'!
touch: anOop
	"Do nothing but fool the compiler into thinking my parameter was used.  Since I am inlined, I add no overhead whatsoever."

	self inline: true.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

RePlugin class
	instanceVariableNames: ''!

!RePlugin class methodsFor: 'plugin code generation' stamp: 'tpr 8/17/2002 18:02'!
declareCVarsIn: cg

	cg addHeaderFile:'"rePlugin.h"'.

	"Memory Managament Error Checking"
	cg var: 'netMemory' 	declareC: 'int netMemory = 0'.
	cg var: 'numAllocs' 	declareC: 'int numAllocs = 0'.
	cg var: 'numFrees' 		declareC: 'int numFrees = 0'.
	cg var: 'lastAlloc'		declareC: 'int lastAlloc = 0'.

	"The receiver Object Pointer"
	cg var: 'rcvr'			declareC: 'int rcvr'.

	"Instance Variables of Receiver Object"
	cg var: 'patternStr'		declareC: 'int patternStr'.
	cg var: 'compileFlags'	declareC: 'int compileFlags'.
	cg var: 'pcrePtr'		declareC: 'int pcrePtr'.
	cg var: 'extraPtr'		declareC: 'int extraPtr'.
	cg var: 'errorStr'		declareC: 'int errorStr'.
	cg var: 'errorOffset'	declareC: 'int errorOffset'.
	cg var: 'matchFlags'	declareC: 'int matchFlags'.

	"Support Variables for Access to Receiver Instance Variables"
	cg var: 'patternStrPtr' declareC: 'const char * patternStrPtr'.
	cg var: 'errorStrBuffer'	declareC: 'const char * errorStrBuffer
'.! !

!RePlugin class methodsFor: 'plugin code generation' stamp: 'acg 8/16/2002 22:51'!
hasHeaderFile
	"If there is a single intrinsic header file to be associated with the plugin, here is where you want to flag"
	^true! !

!RePlugin class methodsFor: 'plugin code generation' stamp: 'nk 11/21/2002 15:54'!
moduleName

	^'RePlugin'! !

!RePlugin class methodsFor: 'plugin code generation' stamp: 'acg 7/27/2002 20:09'!
requiresCrossPlatformFiles
	"default is ok for most, any plugin needing cross platform files must say so"
	^true! !
--- NEW FILE: Win32StandardVMConfigurationTest.st ---
'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 9 March 2003 at 1:59:33 am'!
TestCase subclass: #Win32StandardVMConfigurationTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tests-Win32-VM'!
!Win32StandardVMConfigurationTest commentStamp: 'ar 3/9/2003 01:58' prior: 0!
Win32StandardVMConfigurationTest consists of a series of tests for determining whether the current system runs the "standard" configuration for Win32 VMs. "Standard" is rather loosely defined as of now and essentially means what is contained in this test. The test case can be used for two purposes:

* Determining if a VM build adheres to the standard configuration, e.g., figuring out if you (or rather _I_) forgot to include a plugin or made a mistake wrt. to internal vs. external plugins. In this sense, this test is the ultimate reference for what is considered standard and what isn't.

* Determining if a running system adheres to the standard configuration, e.g., validating that in particular none of the internal plugins get "shadowed" by an external one (this can lead to crashes). In this sense, this tests serves the purpose of identifying "non-conforming" configurations.

The configuration tests have been written in a way that allows them to pass if they're run on any other platform.!


!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 01:26'!
externalPlugin: pluginName
	"see if the plugin with the given name is present as a plugin"
	| pluginString theMethod spec result |
	Smalltalk platformName = 'Win32' ifFalse:[^self].
	pluginString := Smalltalk listBuiltinModules
		detect:[:any| any beginsWith: pluginName,' ']
		ifNone:[nil].
	self assert: pluginString isNil.

	"try loading the plugin"
	theMethod _ self class lookupSelector: #tryNamedPrimitive.
	self assert: theMethod notNil.
	theMethod ifNil:[^self].
	spec _ theMethod literalAt: 1.
	spec at: 1 put: pluginName asSymbol.
	spec at: 2 put: #''.
	spec at: 3 put: 0.
	spec at: 4 put: 0.
	theMethod flushCache.
	result := self tryNamedPrimitive.
	self assert: (result == ContextPart primitiveFailToken).

	pluginString := Smalltalk listLoadedModules
		detect:[:any| any beginsWith: pluginName,' ']
		ifNone:[nil].
	self assert: pluginString notNil.
	pluginString ifNil:[^self].
	self assert: (pluginString endsWith: ' (e)').
! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 01:26'!
internalPlugin: pluginName
	"see if the plugin with the given name is present as a plugin"
	| pluginString theMethod spec result |
	Smalltalk platformName = 'Win32' ifFalse:[^self].
	pluginString := Smalltalk listBuiltinModules
		detect:[:any| any beginsWith: pluginName,' ']
		ifNone:[nil].
	self assert: pluginString notNil.
	pluginString ifNil:[^self].

	"try loading the plugin"
	theMethod _ self class lookupSelector: #tryNamedPrimitive.
	self assert: theMethod notNil.
	theMethod ifNil:[^self].
	spec _ theMethod literalAt: 1.
	spec at: 1 put: pluginName asSymbol.
	spec at: 2 put: #''.
	spec at: 3 put: 0.
	spec at: 4 put: 0.

	theMethod flushCache.
	result := self tryNamedPrimitive.
	self assert: (result == ContextPart primitiveFailToken).

	pluginString := Smalltalk listLoadedModules
		detect:[:any| any beginsWith: pluginName,' ']
		ifNone:[nil].
	self assert: pluginString notNil.
	pluginString ifNil:[^self].
	self assert: (pluginString endsWith: ' (i)').
! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:40'!
testADPCMCodecPlugin
	self internalPlugin: 'ADPCMCodecPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:40'!
testAsynchFilePlugin
	self internalPlugin: 'AsynchFilePlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:40'!
testB3DAcceleratorPlugin
	self internalPlugin: 'B3DAcceleratorPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:41'!
testBMPReadWriterPlugin
	self internalPlugin: 'BMPReadWriterPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:41'!
testDropPlugin
	self internalPlugin: 'DropPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:41'!
testFFTPlugin
	self internalPlugin: 'FFTPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:41'!
testFilePlugin
	self internalPlugin: 'FilePlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:42'!
testFloatArrayPlugin
	self internalPlugin: 'FloatArrayPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:42'!
testFontPlugin
	self internalPlugin: 'FontPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:42'!
testGeniePlugin
	self internalPlugin: 'GeniePlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:42'!
testIntegerPokerPlugin
	self internalPlugin: 'IntegerPokerPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:42'!
testJPEGReadWriter2Plugin
	self internalPlugin: 'JPEGReadWriter2Plugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:43'!
testJPEGReaderPlugin
	self internalPlugin: 'JPEGReaderPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:43'!
testJoystickTabletPlugin
	self internalPlugin: 'JoystickTabletPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:43'!
testKlattPlugin
	self internalPlugin: 'Klatt'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:43'!
testLargeIntegersPlugin
	self internalPlugin: 'LargeIntegers'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:43'!
testMIDIPlugin
	self internalPlugin: 'MIDIPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:43'!
testMatrix2x3Plugin
	self internalPlugin: 'Matrix2x3Plugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:44'!
testMiscPrimitivePlugin
	self internalPlugin: 'MiscPrimitivePlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:44'!
testMpeg3Plugin
	self internalPlugin: 'Mpeg3Plugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:44'!
testRePlugin
	self internalPlugin: 'RePlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:44'!
testSecurityPlugin
	self internalPlugin: 'SecurityPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:44'!
testSerialPlugin
	self internalPlugin: 'SerialPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:44'!
testSocketPlugin
	self internalPlugin: 'SocketPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:45'!
testSoundCodecPrims
	self internalPlugin: 'SoundCodecPrims'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:45'!
testSoundGenerationPlugin
	self internalPlugin: 'SoundGenerationPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:45'!
testSoundPlugin
	self internalPlugin: 'SoundPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:41'!
testSqueak3DPlugin
	self internalPlugin: 'Squeak3D'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:46'!
testSqueakFFIPrims
	self externalPlugin: 'SqueakFFIPrims'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:45'!
testStarSqueakPlugin
	self internalPlugi
n: 'StarSqueakPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:45'!
testSurfacePlugin
	self internalPlugin: 'SurfacePlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 01:12'!
testUUIDPlugin
	self internalPlugin: 'UUIDPlugin'.! !

!Win32StandardVMConfigurationTest methodsFor: 'as yet unclassified' stamp: 'ar 3/9/2003 00:41'!
testZipPlugin
	self internalPlugin: 'ZipPlugin'.! !