[ENH] Building under MPW

Jesse Welton jwelton at pacific.mps.ohio-state.edu
Fri Mar 3 15:59:17 UTC 2000


I've updated Andrew Greenberg's changeset for compiling Squeak on MacOS
under MPW (see http://www.gate.net/~werdna/SqueakMPW.html) to Squeak
2.8alpha.  The last set or two of updates have not been applied, so any
changes to building in that time may not be accounted for.  Another issue
is that I never had any luck building an optimized VM under MPW 3.5, so
the makefile is changed to ask for an unoptimized build. (The
"optimized" VM exhibited numerous display anomalies, then crashed quite
rapidly.)  I also haven't tried using this to reconstruct the Balloon3D
plugin.  At least it does what I need.

On the positive side, I modified the resource file to include some nicer
(to my eye, anyway) icons, taken from or based on the icons from a
resource file that I no longer have a reference to the source of.  Perhaps
someone will appreciate these.  And perhaps, just perhaps, someone will
find the changeset as a whole useful.

Great heaping gobs of thanks are due to Andrew Greenberg for the original
changeset, and to Javier Diaz, Bruce O'Neel, and John Maloney for their
tips on getting things working.  (I hope you fellows will find great
heaping gobs to be an acceptable packaging arrangement.)

-Jesse
-------------- next part --------------
'From Squeak2.8alpha of 23 February 2000 [latest update: #1852] on 29 February 2000 at 9:34:38 pm'!

!CCodeGenerator methodsFor: 'inlining' stamp: 'TPR 7/28/1999 15:17'!
pruneUnreachableMethods
	"Remove any methods that are not reachable. Retain methods needed by the BitBlt operation table, primitives, plug-ins, or interpreter support code."
 
	| retain |
	"Build a set of selectors for methods that should be output even though they have no apparent callers. Some of these are stored in tables for indirect lookup, some are called by the C support code or by primitives."
	retain _ BitBltSimulation opTable asSet.
	#(checkedLongAt: fullDisplayUpdate interpret nullCompilerHook printCallStack readImageFromFile:HeapSize:StartingAt: setCompilerInitialized: success: 
		"Windows needs the following two for startup and debug"
		readableFormat: getCurrentBytecode
		"Acorn needs this for display setup"
		splObj:)
		do: [:sel | retain add: sel].
	InterpreterProxy organization categories do: [:cat |
		((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [
			retain addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].

	"Remove all the unreachable methods that aren't retained for the reasons above."
	self unreachableMethods do: [:sel |
		(retain includes: sel) ifFalse: [
			methods removeKey: sel ifAbsent: []]].
! !


!Interpreter class methodsFor: 'translation' stamp: 'acg 5/20/1999 00:31'!
patchInterp: fileName
	"Interpreter patchInterp: 'Squeak VM PPC'"
	"This will patch out the unneccesary range check (a compare
	 and branch) in the inner interpreter dispatch loop."
	"NOTE: You must edit in the Interpeter file name, and the
	 number of instructions (delta) to count back to find the compare
	 and branch that we want to get rid of."

	| delta f code len remnant i |
	delta _ (SelectionMenu 
				labels: #('CodeWarrior' 'MPW MrC') 
				selections: #(6 5)) 
			startUpWithCaption: 'Which Compiler Did You Use?'.
	f _ FileStream fileNamed: fileName.
	f binary.
	code _ Bitmap new: (len _ f size) // 4.
	f nextInto: code.
	remnant _ f next: len - (code size * 4).
	i _ 0.
	["Look for a BCTR instruction"
	(i _ code indexOf: 16r4E800420 startingAt: i + 1 ifAbsent: [0]) > 0] whileTrue: [
		"Look for a CMPLWI FF, 6 instrs back"
	       ((code at: i - delta) bitAnd: 16rFFE0FFFF) = 16r280000FF ifTrue: [
	       	"Copy dispatch instrs back over the compare"
			SelectionMenu notify: 'Patching at ', i hex.
			0 to: delta - 2 do: [ :j |
				code at: (i - delta) + j put: (code at: (i - delta) + j + 2).
			].
		].
	].
	f position: 0; nextPutAll: code; nextPutAll: remnant.
	f close.
! !


!InterpreterSupportCode commentStamp: '<historical>' prior: 0!
This class is a shell that includes all the ancillary C code for supporting Squeak in the Macintosh operating environment.  Executing

	InterpreterSupportCode writeMacSourceFiles

for Codewarrior sources and project files, and

	InterpreterSupportCode writeMacMPWSourceFiles

for Apple MPW sources and project files.

Each will cause the creation of a number of files in your working directory which, together with the one large interpreter file (see CCodeGenerator) should be adequate to compile a complete running interpreter with the respective development systems.!

!InterpreterSupportCode class methodsFor: 'source file exporting' stamp: 'jm 1/19/2000 14:01'!
compareWithFilesInFolder: folderName
	"InterpreterSupportCode compareWithFilesInFolder: 'Tosh:Desktop Folder:Squeak VM Project'"

	| dir |
	dir _ FileDirectory on: folderName.

	(dir readOnlyFileNamed: 'projectArchive.sit') binary contentsOfEntireFile =
	InterpreterSupportCode archiveBinaryFileBytes
		ifFalse: [self inform: 'File projectArchive.sit differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'readme') contentsOfEntireFile =
	InterpreterSupportCode readmeFile
		ifFalse: [self inform: 'File readme differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sq.h') contentsOfEntireFile =
	InterpreterSupportCode squeakHeaderFile
		ifFalse: [self inform: 'File sq.h differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqConfig.h') contentsOfEntireFile =
	InterpreterSupportCode squeakConfigFile
		ifFalse: [self inform: 'File sqConfig.h differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqPlatformSpecific.h') contentsOfEntireFile =
	InterpreterSupportCode squeakPlatSpecFile
		ifFalse: [self inform: 'File sqPlatformSpecific.h differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqADPCMPrims.c') contentsOfEntireFile =
	InterpreterSupportCode squeakADPCMCodecPrimsFile
		ifFalse: [self inform: 'File sqADPCMPrims.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqFilePrims.c') contentsOfEntireFile =
	InterpreterSupportCode squeakFilePrimsFile
		ifFalse: [self inform: 'File sqFilePrims.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqGSMCodecPlugin.c') contentsOfEntireFile =
	InterpreterSupportCode squeakGSMCodecPluginFile
		ifFalse: [self inform: 'File sqGSMCodecPlugin.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacAsyncFilePrims.c') contentsOfEntireFile =
	InterpreterSupportCode macAsyncFilePrimsFile
		ifFalse: [self inform: 'File sqMacAsyncFilePrims.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacDirectory.c') contentsOfEntireFile =
	InterpreterSupportCode macDirectoryFile
		ifFalse: [self inform: 'File sqMacDirectory.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacExternalPrims.c') contentsOfEntireFile =
	InterpreterSupportCode macExternalPrimsFile
		ifFalse: [self inform: 'File sqMacExternalPrims.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacJoystickAndTablet.c') contentsOfEntireFile =
	InterpreterSupportCode macJoystickAndTabletFile
		ifFalse: [self inform: 'File sqMacJoystickAndTablet.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacMinimal.c') contentsOfEntireFile =
	InterpreterSupportCode macMinimal
		ifFalse: [self inform: 'File sqMacMinimal.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacNetwork.c') contentsOfEntireFile =
	InterpreterSupportCode macNetworkFile
		ifFalse: [self inform: 'File sqMacNetwork.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacSerialAndMIDIPort.c') contentsOfEntireFile =
	InterpreterSupportCode macSerialAndMIDIPortFile
		ifFalse: [self inform: 'File sqMacSerialAndMIDIPort.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacSound.c') contentsOfEntireFile =
	InterpreterSupportCode macSoundFile
		ifFalse: [self inform: 'File sqMacSound.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqMacWindow.c') contentsOfEntireFile =
	InterpreterSupportCode macWindowFile
		ifFalse: [self inform: 'File sqMacWindow.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqOldSoundPrims.c') contentsOfEntireFile =
	InterpreterSupportCode squeakOldSoundPrimsFile
		ifFalse: [self inform: 'File sqOldSoundPrims.c differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqVirtualMachine.h') contentsOfEntireFile =
	InterpreterSupportCode squeakVirtualMachineHeaderFile
		ifFalse: [self inform: 'File sqVirtualMachine.h differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'sqVirtualMachine.c') contentsOfEntireFile =
	InterpreterSupportCode squeakVirtualMachineFile
		ifFalse: [self inform: 'File sqVirtualMachine.c differs from the version stored in this image.'].

	dir _ dir directoryNamed: 'MacTCP'.
	(dir readOnlyFileNamed: 'MacTCP.h') contentsOfEntireFile =
	InterpreterSupportCode macTCPFile
		ifFalse: [self inform: 'File MacTCP.h differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'AddressXlation.h') contentsOfEntireFile =
	InterpreterSupportCode macAddressXlationFile
		ifFalse: [self inform: 'File AddressXlation.h differs from the version stored in this image.'].

	(dir readOnlyFileNamed: 'dnr.c') contentsOfEntireFile =
	InterpreterSupportCode macDNRFile
		ifFalse: [self inform: 'File dnr.c differs from the version stored in this image.'].
! !

!InterpreterSupportCode class methodsFor: 'source file exporting' stamp: 'acg 6/4/1999 19:50'!
storeStringForMPWMakeFile: s onFileNamed: fileName
	"Store the given string in a file of the given name."

	| f |
	f _ CrLfFileStream newFileNamed: fileName.

	f 
		nextPutAll: 'SqueakSources	= ';
		nextPutAll: FileDirectory default pathName;
		nextPut: $:; 
		cr.
	f 
		nextPutAll: 'SqueakFolder	= ';
		nextPutAll: FileDirectory default pathName;
		nextPut: $:; 
		cr.
	f nextPutAll: s.
	f close.! !

!InterpreterSupportCode class methodsFor: 'source file exporting' stamp: 'acg 6/5/1999 14:54'!
writeMacMPWSourceFiles
	"Store into this image's folder the C sources files required to support the interpreter on PowerPC Macintoshes for compilation under Apple MPW and MrC. It also generates the code for the sound synthesis primitives. However, because generating code for the interpreter itself takes several minutes, that is not done automatically by this method. To generate that code, use the method 'translate:doInlining:' in Interpreter class."
	"InterpreterSupportCode writeMacMPWSourceFiles"

	self writeSupportFiles.

	self storeString: self macAsyncFilePrimsFile	onFileNamed: 'sqMacAsyncFilePrims.c'.
	self storeString: self macDirectoryFile	onFileNamed: 'sqMacDirectory.c'.
	self storeString: self macJoystickAndTabletFile  onFileNamed: 'sqMacJoystickAndTablet.c'.
	self storeString: self macMinimal		onFileNamed: 'sqMacMinimal.c'.
	self storeString: self macNetworkFile		onFileNamed: 'sqMacNetwork.c'.
	self storeString: self macSerialAndMIDIPortFile	onFileNamed: 'sqMacSerialAndMIDIPort.c'.
	self storeString: self macSoundFile		onFileNamed: 'sqMacSound.c'.
	self storeString: self macWindowFile		onFileNamed: 'sqMacWindow.c'.
	self storeString: self macTCPFile			onFileNamed: 'MacTCP.h'.
	self storeString: self macAddressXlationFile		onFileNamed: 'AddressXlation.h'.
	self storeString: self macDNRFile					onFileNamed: 'dnr.c'.
	self storeString: self macExternalPrimsFile		onFileNamed: 'sqMacExternalPrims.c'.
	self storeString: self macMPWResourceFile	onFileNamed: 'MPWsqueak.r'.

	self storeStringForMPWMakeFile: self macMPWMakeFile onFileNamed: 'MPWsqueak.make'.
	self 
		storeStringForMPWMakeFile: self macMPWSqueak3DMakeFile 
		onFileNamed: 'MPWsqueak3D.make'.
! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'JW 2/23/2000 09:02'!
macExternalPrimsFile

	^ '#include <CodeFragments.h>
#include <Strings.h>
#include "sq.h"

/*** Functions Exported to sqVirtualMachine.c ***/
int ioLoadModuleOfLength(int moduleNameIndex, int moduleNameLength);
int ioLoadSymbolOfLengthFromModule(int functionNameIndex, int functionNameLength, int moduleHandle);

/*** Variables ***/
CFragConnectionID squeakVMLib = nil;  /* connection to the VM itself as a shared library */

/*** Function Type Declaration ***/
typedef int (*RecordVMProxyProc)(struct VirtualMachine *interpreterProxy);

CFragConnectionID FindOrLoadLib(char *libName, int loadFlag);
CFragConnectionID FindOrLoadLib(char *libName, int loadFlag) {
	CFragLoadOptions action;
	CFragConnectionID libHandle;
	Ptr mainAddr;
	Str255 errorMsg;
	OSErr err;

	action = loadFlag ? kLoadCFrag : kFindCFrag;
#ifdef SQUEAKMPW
	err = GetSharedLibrary(
		c2pstr(libName), kPowerPCCFragArch, action, &libHandle, &mainAddr, errorMsg);
#elif
	 err = GetSharedLibrary(
		c2pstr(libName), kCurrentCFragArch, action, &libHandle, &mainAddr, errorMsg);
#endif
	p2cstr((unsigned char *) libName);  /* undo C to Pascal conversion */
	if (err) {
		return null;
	}
	return libHandle;
}

int ioLoadExternalFunctionOfLengthFromModuleOfLength(
  int functionNameIndex, int functionNameLength, int moduleNameIndex, int moduleNameLength) {
	Str255 functionName, moduleName;
	CFragConnectionID libHandle;
	CFragSymbolClass ignored;
	Ptr functionPtr;
	OSErr err;
	int i, ok;

	/* copy function and module names into C strings */
	for (i = 0; i < functionNameLength; i++) {
		functionName[i] = ((char *) functionNameIndex)[i];
	}
	functionName[functionNameLength] = 0;
	for (i = 0; i < moduleNameLength; i++) {
		moduleName[i] = ((char *) moduleNameIndex)[i];
	}
	moduleName[moduleNameLength] = 0;

	/* find the library */
	if (moduleNameLength > 0) {
		/* look for the primitive in named library */
		/* first try to find it */
		libHandle = FindOrLoadLib((char *) moduleName, false);
		if (!!libHandle) {
			/* then try to load it */
			libHandle = FindOrLoadLib((char *) moduleName, true);
		}
	} else {
		/* look for the primitive in the Squeak VM itself */
		if (!!squeakVMLib) {
			/* try to get a handle on the Squeak VM itself, viewed as a library */
			squeakVMLib = FindOrLoadLib("SqueakVMPrims", false);
		}
		libHandle = squeakVMLib;
	}

	if (!!libHandle) return success(false);  /* could not open the library */

	/* if library is external, initialize its VMProxy pointer */
	if (libHandle !!= squeakVMLib) {
		/* get the setInterpreter() function */
		err = FindSymbol(libHandle, "\psetInterpreter", &functionPtr, &ignored);
		if (err) return success(false);

		/* call setInterpreter() */
		ok = ((RecordVMProxyProc) functionPtr)(sqGetInterpreterProxy());
		if(!!ok) return success(false);
	}

	/* get the address of the desired primitive function */
	c2pstr((char *) functionName);
	err = FindSymbol(libHandle, functionName, &functionPtr, &ignored);
	if (err) return success(false);

	return (int) functionPtr;
}

int ioLoadModuleOfLength(int moduleNameIndex, int moduleNameLength) {
	Str255 moduleName;
	CFragConnectionID libHandle;
	int i;

	/* copy module name into C string */
	for (i = 0; i < moduleNameLength; i++) {
		moduleName[i] = ((char *) moduleNameIndex)[i];
	}
	moduleName[moduleNameLength] = 0;

	/* find the library */
	if (moduleNameLength > 0) {
		/* look for the named library */
		/* first try to find it */
		libHandle = FindOrLoadLib((char *) moduleName, false);
		if (!!libHandle) {
			/* then try to load it */
			libHandle = FindOrLoadLib((char *) moduleName, true);
		}
	} else {
		/* look for the Squeak VM itself */
		if (!!squeakVMLib) {
			/* try to get a handle on the Squeak VM itself, viewed as a library */
			squeakVMLib = FindOrLoadLib("SqueakVMPrims", false);
		}
		libHandle = squeakVMLib;
	}

	if (!!libHandle) {  /* could not open the library */
		success(false);
		return nil;
	}
	return (int) libHandle;
}

int ioLoadSymbolOfLengthFromModule(int functionNameIndex, int functionNameLength, int moduleHandle) {
	Str255 functionName;
	CFragConnectionID libHandle;
	CFragSymbolClass ignored;
	Ptr functionPtr;
	OSErr err;
	int i;

	/* copy function and module names into C strings */
	for (i = 0; i < functionNameLength; i++) {
		functionName[i] = ((char *) functionNameIndex)[i];
	}
	functionName[functionNameLength] = 0;

	/* get the address of the desired primitive function */
	if (!!moduleHandle) moduleHandle = ioLoadModuleOfLength(0, 0);
	libHandle = (CFragConnectionID) moduleHandle;
	if (libHandle == nil) {
		if (squeakVMLib !!= nil) {
			libHandle = squeakVMLib;
		} else {  /* no module handle */
			success(false);
			return nil;
		}
	}

	c2pstr((char *) functionName);
	err = FindSymbol(libHandle, functionName, &functionPtr, &ignored);
	
	if (err) {  /* could not find the given function */
		success(false);
		return nil;
	}
	return (int) functionPtr;
}
'! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'JW 2/24/2000 09:25'!
macMPWMakeFile

	^ '#Must define SqueakSources and SqueakFolder for this to work.
MAKEFILE     = MPWsqueak.make
?MondoBuild? = # Change to "{MAKEFILE}" if you want complete rebuild after makefile edit
Includes     =
Sym?PPC      = 
ObjDir?PPC   =
PPCC		 = MrC
PPCCOptions  = {Includes} {Sym?PPC} -d SQUEAKMPW -opt local  -w 6,29,30,35

Objects?PPC  = ?
		"{ObjDir?PPC}dnr.c.x" ?
		"{ObjDir?PPC}interp.c.x" ?
		"{ObjDir?PPC}sqADPCMPrims.c.x" ?
		"{ObjDir?PPC}sqFilePrims.c.x" ?
		"{ObjDir?PPC}sqGSMCodecPlugin.c.x" ?
		"{ObjDir?PPC}sqMacAsyncFilePrims.c.x" ?
		"{ObjDir?PPC}sqMacDirectory.c.x" ?
		"{ObjDir?PPC}sqMacExternalPrims.c.x" ?
		"{ObjDir?PPC}sqMacJoystickAndTablet.c.x" ?
		"{ObjDir?PPC}sqMacNetwork.c.x" ?
		"{ObjDir?PPC}sqMacSerialAndMIDIPort.c.x" ?
		"{ObjDir?PPC}sqMacSound.c.x" ?
		"{ObjDir?PPC}sqMacWindow.c.x" ?
		"{ObjDir?PPC}sqMiscPrims.c.x" ?
		"{ObjDir?PPC}sqOldSoundPrims.c.x" ?
		"{ObjDir?PPC}sqSoundPrims.c.x" ?
		"{ObjDir?PPC}sqVirtualMachine.c.x"


MPWsqueak ?? {?MondoBuild?} {Objects?PPC}
	PPCLink ?
		-o {Targ} {Sym?PPC} ?
		{Objects?PPC} ?
		-t ''APPL'' ?
		-c ''FAST'' ?
		"{SharedLibraries}InterfaceLib" ?
		"{SharedLibraries}StdCLib" ?
		"{SharedLibraries}MathLib" ?
		"{SharedLibraries}QuickTimeLib" ?
		"{PPCLibraries}StdCRuntime.o" ?
		"{PPCLibraries}PPCCRuntime.o" ?
		"{PPCLibraries}PPCToolLibs.o"
	Rez "{SqueakSources}MPWsqueak.r" -o {Targ} {Includes} -append
	ModPef -renamefrag MPWsqueak=SqueakVMPrims -o {Targ}.out {Targ}
	duplicate -y {Targ}.out {Targ}
	duplicate {Targ}.out "{SqueakFolder}{Targ}"
	delete -y {Targ}.out

"{ObjDir?PPC}dnr.c.x" ? {?MondoBuild?} "{SqueakSources}dnr.c"
	{PPCC} "{SqueakSources}dnr.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}interp.c.x" ? {?MondoBuild?} "{SqueakSources}interp.c"
	{PPCC} "{SqueakSources}interp.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqADPCMPrims.c.x" ? {?MondoBuild?} "{SqueakSources}sqADPCMPrims.c"
	{PPCC} "{SqueakSources}sqADPCMPrims.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqFilePrims.c.x" ? {?MondoBuild?} "{SqueakSources}sqFilePrims.c"
	{PPCC} "{SqueakSources}sqFilePrims.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqGSMCodecPlugin.c.x" ? {?MondoBuild?} "{SqueakSources}sqGSMCodecPlugin.c"
	{PPCC} "{SqueakSources}sqGSMCodecPlugin.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMacAsyncFilePrims.c.x" ? {?MondoBuild?} "{SqueakSources}sqMacAsyncFilePrims.c"
	{PPCC} "{SqueakSources}sqMacAsyncFilePrims.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMacDirectory.c.x" ? {?MondoBuild?} "{SqueakSources}sqMacDirectory.c"
	{PPCC} "{SqueakSources}sqMacDirectory.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMacExternalPrims.c.x" ? {?MondoBuild?} "{SqueakSources}sqMacExternalPrims.c"
	{PPCC} "{SqueakSources}sqMacExternalPrims.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMacJoystickAndTablet.c.x" ? {?MondoBuild?} "{SqueakSources}sqMacJoystickAndTablet.c"
	{PPCC} "{SqueakSources}sqMacJoystickAndTablet.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMacNetwork.c.x" ? {?MondoBuild?} "{SqueakSources}sqMacNetwork.c"
	{PPCC} "{SqueakSources}sqMacNetwork.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMacSerialAndMIDIPort.c.x" ? {?MondoBuild?} "{SqueakSources}sqMacSerialAndMIDIPort.c"
	{PPCC} "{SqueakSources}sqMacSerialAndMIDIPort.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMacSound.c.x" ? {?MondoBuild?} "{SqueakSources}sqMacSound.c"
	{PPCC} "{SqueakSources}sqMacSound.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMacWindow.c.x" ? {?MondoBuild?} "{SqueakSources}sqMacWindow.c"
	{PPCC} "{SqueakSources}sqMacWindow.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqMiscPrims.c.x" ? {?MondoBuild?} "{SqueakSources}sqMiscPrims.c"
	{PPCC} "{SqueakSources}sqMiscPrims.c" -o {Targ} -d SQUEAKMPW -opt local  -w 6,29,30,35
			# -opt local due to compiler bug

"{ObjDir?PPC}sqOldSoundPrims.c.x" ? {?MondoBuild?} "{SqueakSources}sqOldSoundPrims.c"
	{PPCC} "{SqueakSources}sqOldSoundPrims.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqSoundPrims.c.x" ? {?MondoBuild?} "{SqueakSources}sqSoundPrims.c"
	{PPCC} "{SqueakSources}sqSoundPrims.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}sqVirtualMachine.c.x" ? {?MondoBuild?} "{SqueakSources}sqVirtualMachine.c"
	{PPCC} "{SqueakSources}sqVirtualMachine.c" -o {Targ} {PPCCOptions}

'.

! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'JW 2/24/2000 09:12'!
macMPWResourceFile

	^ '#include "SysTypes.r"
#include "Types.r"

resource ''SIZE'' (-1) {
	reserved,
	acceptSuspendResumeEvents,
	reserved,
	canBackground,				/* we can background; we don''t currently, but our sleep value */
								/* guarantees we don''t hog the Mac while we are in the background */
	multiFinderAware,			/* this says we do our own activate/deactivate; don''t fake us out */
	backgroundAndForeground,	/* this is definitely not a background-only application!! */
	getFrontClicks,				/* "do first click" behavior like the Finder */
	ignoreChildDiedEvents,		/* essentially, I''m not a debugger (sub-launching) */
	is32BitCompatible,			/* this app should be run in 32-bit address space */
	isHighLevelEventAware,
	localAndRemoteHLEvents,
	notStationeryAware,
	dontUseTextEditServices,
	reserved,
	reserved,
	reserved,
	20*1024*1000,
	2*1024*1000
};
resource ''SIZE'' (0) {
	reserved,
	acceptSuspendResumeEvents,
	reserved,
	canBackground,				/* we can background; we don''t currently, but our sleep value */
								/* guarantees we don''t hog the Mac while we are in the background */
	multiFinderAware,			/* this says we do our own activate/deactivate; don''t fake us out */
	backgroundAndForeground,	/* this is definitely not a background-only application!! */
	getFrontClicks,				/* "do first click" behavior like the Finder */
	ignoreChildDiedEvents,		/* essentially, I''m not a debugger (sub-launching) */
	is32BitCompatible,			/* this app should be run in 32-bit address space */
	isHighLevelEventAware,
	localAndRemoteHLEvents,
	notStationeryAware,
	dontUseTextEditServices,
	reserved,
	reserved,
	reserved,
	20*1024*1000,
	2*1024*1000
};
resource ''SIZE'' (1) {
	reserved,
	acceptSuspendResumeEvents,
	reserved,
	canBackground,				/* we can background; we don''t currently, but our sleep value */
								/* guarantees we don''t hog the Mac while we are in the background */
	multiFinderAware,			/* this says we do our own activate/deactivate; don''t fake us out */
	backgroundAndForeground,	/* this is definitely not a background-only application!! */
	getFrontClicks,				/* "do first click" behavior like the Finder */
	ignoreChildDiedEvents,		/* essentially, I''m not a debugger (sub-launching) */
	is32BitCompatible,			/* this app should be run in 32-bit address space */
	isHighLevelEventAware,
	localAndRemoteHLEvents,
	notStationeryAware,
	dontUseTextEditServices,
	reserved,
	reserved,
	reserved,
	20*1024*1000,
	2*1024*1000
};
resource ''ics8'' (128) {
	$"0000 0000 0000 0000 0000 0000 0000 0000"
	$"00FF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
	$"00FF 0101 0101 0101 0101 0101 0101 01FF"
	$"00FF F5F6 F601 0101 0101 0101 01F7 01FF"
	$"00FF 2B01 F6F5 0101 0101 0101 F701 F5FF"
	$"00FF F701 012B 0101 0101 01F7 F501 F7FF"
	$"00FF 2B01 01F5 F501 0101 01F7 0101 F7FF"
	$"00FF 2B01 0101 0101 0101 0101 0101 2BFF"
	$"00FF 012B 0101 FDF8 012B 81F6 0101 F6FF"
	$"00FF 01F5 0101 FD81 01F8 FF2B 01F5 01FF"
	$"00FF 0101 F5F5 0101 0101 F5F5 F5F5 01FF"
	$"00FF 2BF7 F8F8 F8F7 FD81 F8F8 F8F8 2BFF"
	$"00FF 2BF6 2B2B 2BF6 FAF8 2B2B 2BF6 2BFF"
	$"00FF 01F6 0101 0101 0101 0101 01F6 01FF"
	$"00FF 0101 0101 0101 0101 0101 0101 01FF"
	$"00FF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
};

resource ''ics8'' (129) {
	$"0000 0000 0000 0000 0000 0000 0000 0000"
	$"0000 FFFF FFFF FFFF FFFF FF00 0000 0000"
	$"0000 FFF5 F600 0000 0000 FFFF 0000 0000"
	$"0000 FF2B F6F5 0000 0000 FF00 FF00 0000"
	$"0000 FFF7 002B 0000 0000 FF00 00FF 0000"
	$"0000 FF2B 00F5 F500 0000 FFFF FFFF FF00"
	$"0000 FF2B 0000 0000 0000 0000 002B FF00"
	$"0000 FF00 0000 FDF8 002B 81F6 00F6 FF00"
	$"0000 FF00 0000 FD81 00F8 FF2B F500 FF00"
	$"0000 FF00 F5F5 0000 0000 F5F5 F500 FF00"
	$"0000 FF2B F8F8 F8F7 FD81 F8F8 F82B FF00"
	$"0000 FF2B 2B2B 2BF6 FAF8 2B2B F62B FF00"
	$"0000 FF00 0000 0000 0000 0000 F600 FF00"
	$"0000 FF00 0000 0000 0000 0000 0000 FF00"
	$"0000 FF00 0000 0000 0000 0000 0000 FF00"
	$"0000 FFFF FFFF FFFF FFFF FFFF FFFF FF00"
};

resource ''ics4'' (128) {
	$"0000 0000 0000 0000 0FFF FFFF FFFF FFFF"
	$"0F11 1111 1111 111F 0F1C C111 1111 1C1F"
	$"0FC1 C111 1111 C11F 0FC1 1C11 111C 11CF"
	$"0FC1 1111 111C 11CF 0FC1 1111 1111 11CF"
	$"0F1C 11AC 1CDC 11CF 0F11 11AD 1CFC 111F"
	$"0F11 1111 1111 111F 0FCC CCCC ADCC CCCF"
	$"0FCC CCCC DCCC CCCF 0F1C 1111 1111 1C1F"
	$"0F11 1111 1111 111F 0FFF FFFF FFFF FFFF"
};

resource ''ics4'' (129) {
	$"0000 0000 0000 0000 00FF FFFF FFF0 0000"
	$"00F0 C000 00FF 0000 00FC C000 00F0 F000"
	$"00FC 0C00 00F0 0F00 00FC 00C0 00FF FFF0"
	$"00FC 0000 0000 0CF0 00F0 00AC 0CDC 00F0"
	$"00F0 00EE 0CFC 00F0 00F0 0C00 00C0 C0F0"
	$"00FC CCDC FDCD CCF0 00FC CC0C DCCC C0F0"
	$"00F0 0000 0000 00F0 00F0 0000 0000 00F0"
	$"00F0 0000 0000 00F0 00FF FFFF FFFF FFF0"
};

resource ''ics#'' (128) {
	{	/* array: 2 elements */
		/* [1] */
		$"0000 7FFF 4001 4001 4403 5009 4201 5003"
		$"4221 4331 4001 54E5 4211 4001 4001 7FFF",
		/* [2] */
		$"0000 7FFF 7FFF 7FFF 7FFF 7FFF 7FFF 7FFF"
		$"7FFF 7FFF 7FFF 7FFF 7FFF 7FFF 7FFF 7FFF"
	}
};

resource ''ics#'' (129) {
	{	/* array: 2 elements */
		/* [1] */
		$"0000 3FE0 2030 2028 2024 203E 2002 2222"
		$"2332 2002 34E6 2212 2002 2002 2002 3FFE",
		/* [2] */
		$"0000 3FE0 3FF0 3FF8 3FFC 3FFE 3FFE 3FFE"
		$"3FFE 3FFE 3FFE 3FFE 3FFE 3FFE 3FFE 3FFE"
	}
};

resource ''ICN#'' (128) {
	{	/* array: 2 elements */
		/* [1] */
		$"FFFF FFFF 8000 0001 8000 0003 8000 0003"
		$"8000 0003 8100 0053 8800 0003 8080 010B"
		$"8840 0003 8000 020B 8800 0003 8010 000B"
		$"8800 0003 8000 0003 840C 1813 801A 3403"
		$"801E 3C03 801E 3C03 800C 1803 8000 0003"
		$"8000 0103 9551 CA57 82AB E483 8801 C813"
		$"A090 1147 8200 0003 8000 0003 8000 0003"
		$"8000 0003 8000 0003 BFFF FFFF FFFF FFFF",
		/* [2] */
		$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
		$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
		$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
		$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
		$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
		$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
		$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
		$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
	}
};

resource ''ICN#'' (129) {
	{	/* array: 2 elements */
		/* [1] */
		$"1FFF FE00 1000 0300 1000 0380 1000 02C0"
		$"1000 0260 1000 0230 1000 03F8 1000 0008"
		$"1040 0808 1080 1008 1080 2008 1088 0008"
		$"1080 4008 1000 0408 1000 0408 1044 4408"
		$"104C C008 100C C008 1000 0008 1078 3C08"
		$"107B B808 10F9 7A08 1000 0408 1000 0008"
		$"1000 0008 1000 0008 1000 0008 1000 0008"
		$"1000 0008 1000 0008 1000 0008 1FFF FFF8",
		/* [2] */
		$"1FFF FE00 1FFF FF00 1FFF FF80 1FFF FFC0"
		$"1FFF FFE0 1FFF FFF0 1FFF FFF8 1FFF FFF8"
		$"1FFF FFF8 1FFF FFF8 1FFF FFF8 1FFF FFF8"
		$"1FFF FFF8 1FFF FFF8 1FFF FFF8 1FFF FFF8"
		$"1FFF FFF8 1FFF FFF8 1FFF FFF8 1FFF FFF8"
		$"1FFF FFF8 1FFF FFF8 1FFF FFF8 1FFF FFF8"
		$"1FFF FFF8 1FFF FFF8 1FFF FFF8 1FFF FFF8"
		$"1FFF FFF8 1FFF FFF8 1FFF FFF8 1FFF FFF8"
	}
};

resource ''icl8'' (128) {
	$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
	$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
	$"FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
	$"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 FBFF"
	$"FFF5 0101 0101 0101 0101 0101 0101 0101"
	$"0101 0101 0101 0101 0101 0101 0101 FBFF"
	$"FFF5 0101 0101 0101 0101 0101 0101 0101"
	$"0101 0101 0101 0101 0101 0101 0101 FBFF"
	$"FFF5 0101 0101 0101 0101 0101 0101 0101"
	$"0101 0101 0101 0101 0101 0101 0101 FBFF"
	$"FFF5 0101 2BF9 2B01 0101 0101 0101 0101"
	$"0101 0101 0101 0101 0156 FAF6 0101 FBFF"
	$"FFF5 01F5 81F6 FAF8 0101 0101 0101 0101"
	$"0101 0101 0101 01F5 81F7 F581 0101 FBFF"
	$"FFF5 01F8 F701 01F9 F701 0101 0101 0101"
	$"0101 0101 0101 0181 F601 01FA F501 FBFF"
	$"FFF5 01F9 F601 0101 81F6 0101 0101 0101"
	$"0101 0101 0101 56F7 0101 01F9 F601 FBFF"
	$"FFF5 01F9 F601 0101 F581 0101 0101 0101"
	$"0101 0101 01F6 FA01 0101 0156 F601 FBFF"
	$"FFF5 0156 2B01 0101 01F8 F801 0101 0101"
	$"0101 0101 0181 F501 0101 01FA F501 FBFF"
	$"FFF5 01F7 F701 0101 0101 81F5 0101 0101"
	$"0101 0101 F756 0101 0101 0181 0101 FBFF"
	$"FFF5 01F6 F901 0101 0101 F6F5 0101 0101"
	$"0101 0101 2B01 0101 0101 0181 0101 FBFF"
	$"FFF5 0101 8101 0101 0101 0101 0101 0101"
	$"0101 0101 0101 0101 0101 0181 0101 FBFF"
	$"FFF5 0101 8101 0101 0101 01F6 F7F5 0101"
	$"0101 0101 0101 0101 0101 2B56 0101 FBFF"
	$"FFF5 0101 F9F6 0101 0101 F6FE FFFC 0101"
	$"0101 FBFF FA01 0101 0101 F9F6 0101 FBFF"
	$"FFF5 0101 2B56 0101 0101 F9FF 8181 2B01"
	$"01F8 FFAC FB2B 0101 0101 8101 0101 FBFF"
	$"FFF5 0101 01F8 0101 0101 F9FF ACFC F701"
	$"01F9 FFFB FAF8 0101 0101 F701 0101 FBFF"
	$"FFF5 0101 0101 0101 0101 F6FE FFAC 0101"
	$"012B FFFF FEF6 0101 0101 0101 0101 FBFF"
	$"FFF5 0101 0101 0101 0101 01F6 F8F5 0101"
	$"0101 F8FB F701 0101 0101 0101 0101 FBFF"
	$"FFF5 0101 01F6 F7F7 F72B F601 0101 01F6"
	$"F601 0101 0101 0101 0101 0101 0101 FBFF"
	$"FFF5 FA81 FAF9 F8F8 F856 F981 FA01 FBFF"
	$"FFFC F556 8181 FA81 8181 8181 F92B FBFF"
	$"FFF5 F500 002B 56FA 81FA 81FA 56F7 FFFF"
	$"FFFF 56F8 F7F8 F8F8 2BF5 0000 F656 FBFF"
	$"FFF5 F556 8156 2B00 0000 0000 F5F5 FDFF"
	$"FFFE F6F8 F8F7 F7F7 F8FA 81F9 F501 FBFF"
	$"FFF5 FB2B 0101 F6FA 8181 FA81 5601 F556"
	$"56F5 0156 FA81 FAFA 2B00 00F6 81F9 FBFF"
	$"FFF5 0101 01F9 FAF5 0101 0101 0101 0101"
	$"0101 01F5 0101 01F5 5681 F601 012B FBFF"
	$"FFF5 0101 F6F7 0101 0101 0101 0101 0101"
	$"0101 0101 0101 0101 01F5 81F5 0101 FBFF"
	$"FFF5 0101 0101 0101 0101 0101 0101 0101"
	$"0101 0101 0101 0101 0101 0101 0101 FBFF"
	$"FFF5 0101 0101 0101 0101 0101 0101 0101"
	$"0101 0101 0101 0101 0101 0101 0101 FBFF"
	$"FFF5 0101 0101 0101 0101 0101 0101 0101"
	$"0101 0101 0101 0101 0101 0101 0101 FBFF"
	$"FFF5 FBFB FBFB FBFB FBFB FBFB FBFB FBFB"
	$"FBFB FBFB FBFB FBFB FBFB FBFB FBFB FBFF"
	$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
	$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
};

resource ''icl8'' (129) {
	$"0000 00FA FAFA FAFA FAFA FAFA FAFA FAFA"
	$"FAFA FAFA FAFA FA00 0000 0000 0000 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 FAFF 0000 0000 0000 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 FAFA FF00 0000 0000 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 FAF7 FAFF 0000 0000 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 FA00 F7FA FF00 0000 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 FA00 00F7 FAFF 0000 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 FAFF FFFF FFFF FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 00FA F700 0000 0000"
	$"0000 0000 FAF7 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 FAF7 F7F7 0000 0000"
	$"0000 00FA F7F7 F700 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 FA00 00F7 F700 0000"
	$"0000 FFF7 00F7 F700 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 FA00 00F7 FF00 0000"
	$"00F7 F700 00F7 F700 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 FA00 0000 F7F7 0000"
	$"00FF F700 00F7 F700 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 F7F7 0000 0000 0000"
	$"0000 0000 00FA 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 F7F7 0000 0000 0000"
	$"0000 0000 F7FF 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 F7FF 0000 F7FF 0000"
	$"F7FF 0000 F7FA 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 00FA 0000 FFFF F700"
	$"FFFF F700 F7F7 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 FFFF 0000"
	$"FFFF 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 F7F7 0000"
	$"00F7 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 F7FA FAFF FA00 00F7"
	$"00F7 FAFF FAFA 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 F7FA FFFF FFF7 FFFF"
	$"FFF7 FFFF FFF7 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 00F7 FAFA FFFF FA00 F7FA"
	$"00FA FFFA FAF7 FA00 0000 00F7 FF00 0000"
	$"0000 00FA 0000 00F7 F7F7 0000 0000 0000"
	$"0000 0000 F7FA F700 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA 0000 0000 0000 0000 0000 0000"
	$"0000 0000 0000 0000 0000 00F7 FF00 0000"
	$"0000 00FA F7F7 F7F7 F7F7 F7F7 F7F7 F7F7"
	$"F7F7 F7F7 F7F7 F7F7 F7F7 F7F7 FF00 0000"
	$"0000 00FF FFFF FFFF FFFF FFFF FFFF FFFF"
	$"FFFF FFFF FFFF FFFF FFFF FFFF FF00 0000"
};

resource ''icl4'' (128) {
	$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
	$"FCCC CCCC CCCC CCCC CCCC CCCC CCCC CCCF"
	$"FC11 1111 1111 1111 1111 1111 1111 11EF"
	$"FC11 1111 1111 1111 1111 1111 1111 11EF"
	$"FC11 1111 1111 1111 1111 1111 1111 11EF"
	$"FC11 CDC1 1111 1111 1111 1111 1DDC 11EF"
	$"FC11 DCDC 1111 1111 1111 1111 DC1D 11EF"
	$"FC1C C11D C111 1111 1111 111D C11D 11EF"
	$"FC1D C111 DC11 1111 1111 11DC 111D C1EF"
	$"FC1D C111 1D11 1111 1111 1CD1 111D C1EF"
	$"FC1D C111 1CC1 1111 1111 1D11 111D 11EF"
	$"FC1C C111 11D1 1111 1111 CD11 111D 11EF"
	$"FC1C D111 11C1 1111 1111 C111 111D 11EF"
	$"FC11 D111 1111 1111 1111 1111 111D 11EF"
	$"FC11 D111 111C C111 1111 1111 11CD 11EF"
	$"FC11 DC11 11CF FE11 11EF D111 11DC 11EF"
	$"FC11 CD11 11DF DDC1 1CFE EC11 11D1 11EF"
	$"FC11 1C11 11DF EEC1 1DFE DC11 11C1 11EF"
	$"FC11 1111 11CF FE11 1CFF FC11 1111 11EF"
	$"FC11 1111 111C C111 11CE C111 1111 11EF"
	$"FC11 1CCC CCC1 111C C111 1111 1111 11EF"
	$"FCDD DDCC CDDD D1EF FE1D DDDD DDDD DCEF"
	$"FC11 0CDD DDDD DCFF FFDC CCCC C010 CDEF"
	$"FC1D DDC1 1111 11AF FFCC CCCC CDDD 11EF"
	$"FCEC 11CD DDDD D11D D11D DDDD C01C DDEF"
	$"FC11 1DD1 1111 1111 1111 1111 DDC1 1CEF"
	$"FC11 CC11 1111 1111 1111 1111 11D1 11EF"
	$"FC11 1111 1111 1111 1111 1111 1111 11EF"
	$"FC11 1111 1111 1111 1111 1111 1111 11EF"
	$"FC11 1111 1111 1111 1111 1111 1111 11EF"
	$"FCEE EEEE EEEE EEEE EEEE EEEE EEEE EEEF"
	$"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
};

resource ''icl4'' (129) {
	$"000D DDDD DDDD DDDD DDDD DDD0 0000 0000"
	$"000D 0000 0000 0000 0000 00DF 0000 0000"
	$"000D 0000 0000 0000 0000 00DD F000 0000"
	$"000D 0000 0000 0000 0000 00DC DF00 0000"
	$"000D 0000 0000 0000 0000 00D0 CDF0 0000"
	$"000D 0000 0000 0000 0000 00D0 0CDF 0000"
	$"000D 0000 0000 0000 0000 00DF FFFF F000"
	$"000D 0000 0000 0000 0000 0000 000C F000"
	$"000D 0000 0DC0 0000 0000 DC00 000C F000"
	$"000D 0000 DCCC 0000 000D CCC0 000C F000"
	$"000D 0000 D00C C000 00FC 0CC0 000C F000"
	$"000D 0000 D00C F000 0CC0 0CC0 000C F000"
	$"000D 0000 D000 CC00 0FC0 0CC0 000C F000"
	$"000D 0000 CC00 0000 0000 0D00 000C F000"
	$"000D 0000 CC00 0000 0000 CF00 000C F000"
	$"000D 0000 CF00 CF00 CF00 CD00 000C F000"
	$"000D 0000 0D00 FFC0 FFC0 CC00 000C F000"
	$"000D 0000 0000 FF00 FF00 0000 000C F000"
	$"000D 0000 0000 CC00 0C00 0000 000C F000"
	$"000D 0000 CDDF D00C 0CDF DD00 000C F000"
	$"000D 0000 CDFF FCFF FCFF FC00 000C F000"
	$"000D 000C DDFF D0CD 0DFD DCD0 000C F000"
	$"000D 000C CC00 0000 0000 CDC0 000C F000"
	$"000D 0000 0000 0000 0000 0000 000C F000"
	$"000D 0000 0000 0000 0000 0000 000C F000"
	$"000D 0000 0000 0000 0000 0000 000C F000"
	$"000D 0000 0000 0000 0000 0000 000C F000"
	$"000D 0000 0000 0000 0000 0000 000C F000"
	$"000D 0000 0000 0000 0000 0000 000C F000"
	$"000D 0000 0000 0000 0000 0000 000C F000"
	$"000D CCCC CCCC CCCC CCCC CCCC CCCC F000"
	$"000F FFFF FFFF FFFF FFFF FFFF FFFF F000"
};

resource ''FREF'' (128) {
	''APPL'',
	0,
	""
};

resource ''FREF'' (129) {
	''STim'',
	1,
	""
};

type ''FAST'' as ''STR '';

resource ''FAST'' (0, "Owner resource") {
	"Squeak Smalltalk"
};

resource ''BNDL'' (128) {
	''FAST'',
	0,
	{	/* array TypeArray: 2 elements */
		/* [1] */
		''FREF'',
		{	/* array IDArray: 2 elements */
			/* [1] */
			0, 128,
			/* [2] */
			1, 129
		},
		/* [2] */
		''ICN#'',
		{	/* array IDArray: 2 elements */
			/* [1] */
			0, 128,
			/* [2] */
			1, 129
		}
	}
};

'.
! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'acg 6/5/1999 16:16'!
macMPWSqueak3DMakeFile

	^ 'MAKEFILE     = # Change to "{MAKEFILE}" if you want complete rebuild after makefile edit
?MondoBuild? = 
Includes     =
Sym?PPC      = 
ObjDir?PPC   =

PPCCOptions  = {Includes} {Sym?PPC} -opt speed,nointer -w 6,7,29,30,35

Objects?PPC  = ?
		"{ObjDir?PPC}b3dAlloc.c.x" ?
		"{ObjDir?PPC}b3dDraw.c.x" ?
		"{ObjDir?PPC}b3dInit.c.x" ?
		"{ObjDir?PPC}b3dMain.c.x" ?
		"{ObjDir?PPC}b3dRemap.c.x" ?
		"{ObjDir?PPC}Squeak3D.c.x"


MPWSqueak3D ?? {?MondoBuild?} {Objects?PPC}
	PPCLink ?
		-o {Targ} {Sym?PPC} ?
		{Objects?PPC} ?
		-t ''shlb'' ?
		-c ''????'' ?
		-xm s ?
		"{SharedLibraries}InterfaceLib" ?
		"{SharedLibraries}StdCLib" ?
		"{SharedLibraries}MathLib" ?
		"{PPCLibraries}StdCRuntime.o" ?
		"{PPCLibraries}PPCCRuntime.o" ?
		"{PPCLibraries}PPCToolLibs.o"
	ModPef -renamefrag MPWSqueak3D=Squeak3D -o {Targ}.out {Targ}
	duplicate {Targ} "{SqueakFolder}{Targ}"


"{ObjDir?PPC}b3dAlloc.c.x" ? {?MondoBuild?} "{SqueakSources}b3dAlloc.c"
	{PPCC} "{SqueakSources}b3dAlloc.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}b3dDraw.c.x" ? {?MondoBuild?} "{SqueakSources}b3dDraw.c"
	{PPCC} "{SqueakSources}b3dDraw.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}b3dInit.c.x" ? {?MondoBuild?} "{SqueakSources}b3dInit.c"
	{PPCC} "{SqueakSources}b3dInit.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}b3dMain.c.x" ? {?MondoBuild?} "{SqueakSources}b3dMain.c"
	{PPCC} "{SqueakSources}b3dMain.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}b3dRemap.c.x" ? {?MondoBuild?} "{SqueakSources}b3dRemap.c"
	{PPCC} "{SqueakSources}b3dRemap.c" -o {Targ} {PPCCOptions}

"{ObjDir?PPC}Squeak3D.c.x" ? {?MondoBuild?} "{SqueakSources}Squeak3D.c"
	{PPCC} "{SqueakSources}Squeak3D.c" -o {Targ} {PPCCOptions}

'.

! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'acg 6/4/1999 17:49'!
macMinimal

	^ '/* sqMacMinimal.c

	This file includes the minimal support code to build a Macintosh virtual machine.
	Many primitives are "stubbed-out", meaning that if they are invoked from the
	image they will return a "primitive failed" error. Among the stubbed out primitives
	are those that support sound input and output, serial and MIDI ports, networking,
	joystick, and file directory operations. The basic file read/write operations are
	NOT stubbed out, although they could be as long as the image loading mechanism
	still works. In this case, you''ll need to modify the method "openSourceFiles"
	in the image to skip opening the changes and sources files at startup time.

	The purpose of this file is to provide an implementation roadmap when bootstrapping
	Squeak on a new platform. Once all the non-stubbed-out functions in this file have
	been implemented, you will have a working, usable Squeak virtual machine!!

*** Implementation Notes ***

  I/O Functions
	The following are essential for display and user interaction:
		ioScreenSize()
		ioShowDisplay()
		ioGetButtonState()
		ioGetKeystroke()
		ioMousePoint()
		ioPeekKeystroke()

	The following can be made no-ops:
		ioProcessEvents() 	-- poll for input events on some platforms
		ioSetCursor()		-- install a 16x16 black and white hardware cursor
		ioSetCursorWithMask() -- install a masked cursor
		ioBeep()			-- make a short beep through the speaker
		ioExit()			-- exit the VM: quit the application, reboot, power down, or
							-- some other behavior appropriate to this platform
							-- (if this is a noop you won''t be able to quit from Squeak)
		ioRelinquishProcessorForMicroseconds()
							-- called when Squeak is idle to return time to the OS

  File Naming

	The virtual machine keeps track of the full path name of the Squeak image
	file and the path to the directory containing the virtual machine. In this
	minimal implementation, the VM path is the empty string and the image name is
	hardwired to "squeak.image". It is assumed that the image file, the changes
	file, the Squeak application, and the system sources file are all in the
	the same directory, and that that directory is the default working directory
	for file operations. The "shortImageName" is used to display the image file
	name (but not its full path) in the title bar of the Macintosh window.

  Time Functions

		ioMSecs(), ioMicroMSecs()
							-- both return a millisecond clock value, but historically
							-- ioMicroMSecs() used a higher resolution timer; the
							-- ideal implementation is an inexpensive clock with 1
							-- millisecond accuracy, but both functions can use a
							-- clock with much coarser accuracy (e.g., 50-100 mSecs)
							-- if necessary
		ioSeconds()			-- return the number of seconds since Jan 1, 1901
	   						-- may return 0, but then the current date and time
	   						-- will be wrong

*** Linking ***

	To build a Macintosh VM using this file, link together:

		interp.c		-- automatically generated interpreter file
		sqFilePrims.c	-- file primitives (can be stubbed out)
		sqMacMinimal.c	-- this file
		sqMiscPrims.c	-- automatically generated primitives (optional)

	plus the appropriate support libraries. To build a PowerPC
	virtual machine using CodeWarrior 8, these are:

		ANSI C.PPC.Lib
		SIOUX.PPC.Lib
		InterfaceLib
		MathLib
		MWCRuntime.Lib

*/

#ifndef SQUEAKMPW
#include <MacHeaders.h>
#endif
#include <Dialogs.h>
#include <Devices.h>
#include <Files.h>
#include <Fonts.h>
#include <Strings.h>
#include <Timer.h>
#include <ToolUtils.h>

#include "sq.h"

#define STUBBED_OUT { success(false); }

/*** Enumerations ***/
enum { appleID = 1, fileID, editID };
enum { quitItem = 1 };

/*** Variables -- Imported from Virtual Machine ***/
extern int fullScreenFlag;
extern int interruptCheckCounter;
extern int interruptKeycode;
extern int interruptPending;  /* set to true by recordKeystroke if interrupt key is pressed */
extern unsigned char *memory;
extern int savedWindowSize;   /* set from header when image file is loaded */

/*** Variables -- image and path names ***/
#define IMAGE_NAME_SIZE 300
char imageName[IMAGE_NAME_SIZE + 1];  /* full path to image */

#define SHORTIMAGE_NAME_SIZE 100
char shortImageName[SHORTIMAGE_NAME_SIZE + 1];  /* just the image file name */

#define VMPATH_SIZE 300
char vmPath[VMPATH_SIZE + 1];  /* full path to interpreter''s directory */

/*** Variables -- Mac Related ***/
MenuHandle		appleMenu = nil;
MenuHandle		editMenu = nil;
MenuHandle		fileMenu = nil;
CTabHandle		stColorTable = nil;
PixMapHandle	stPixMap = nil;
WindowPtr		stWindow = nil;

/*** Variables -- Event Recording ***/
#define KEYBUF_SIZE 64
int keyBuf[KEYBUF_SIZE];	/* circular buffer */
int keyBufGet = 0;			/* index of next item of keyBuf to read */
int keyBufPut = 0;			/* index of next item of keyBuf to write */
int keyBufOverflows = 0;	/* number of characters dropped */

int buttonState = 0;		/* mouse button and modifier state when mouse
							   button went down or 0 if not pressed */

Point savedMousePosition;	/* mouse position when window is inactive */
int windowActive = true;	/* true if the Squeak window is the active window */

/* This table maps the 5 Macintosh modifier key bits to 4 Squeak modifier
   bits. (The Mac shift and caps lock keys are both mapped to the single
   Squeak shift bit).
		Mac bits: <control><option><caps lock><shift><command>
		ST bits:  <command><option><control><shift>
*/
char modifierMap[32] = {
	0,  8, 1,  9, 1,  9, 1,  9, 4, 12, 5, 13, 5, 13, 5, 13,
	2, 10, 3, 11, 3, 11, 3, 11, 6, 14, 7, 15, 7, 15, 7, 15
};

/*** Functions ***/
void AdjustMenus(void);
char * GetAttributeString(int id);
int  HandleEvents(void);
void HandleMenu(int mSelect);
void HandleMouseDown(EventRecord *theEvent);
void InitMacintosh(void);
void SetColorEntry(int index, int red, int green, int blue);
void SetUpMenus(void);
void SetUpPixmap(void);
void SetUpWindow(void);
void SetWindowTitle(char *title);

/* event capture */
int recordKeystroke(EventRecord *theEvent);
int recordModifierButtons(EventRecord *theEvent);
int recordMouseDown(EventRecord *theEvent);

/*** VM Home Directory Path ***/

int vmPathSize(void) {
	return strlen(vmPath);
}

int vmPathGetLength(int sqVMPathIndex, int length) {
	char *stVMPath = (char *) sqVMPathIndex;
	int count, i;

	count = strlen(vmPath);
	count = (length < count) ? length : count;

	/* copy the file name into the Squeak string */
	for (i = 0; i < count; i++) {
		stVMPath[i] = vmPath[i];
	}
	return count;
}

/*** Mac-related Functions ***/

void AdjustMenus(void) {
	WindowPeek		wp;
	int				isDeskAccessory;

	wp = (WindowPeek) FrontWindow();
	if (wp !!= NULL) {
		isDeskAccessory = (wp->windowKind < 0);
	} else {
		isDeskAccessory = false;
	}

	if (isDeskAccessory) {
		/* Enable items in the Edit menu */
		EnableItem(editMenu, 1);
		EnableItem(editMenu, 3);
		EnableItem(editMenu, 4);
		EnableItem(editMenu, 5);
		EnableItem(editMenu, 6);
	} else {
		/* Disable items in the Edit menu */
		DisableItem(editMenu, 1);
		DisableItem(editMenu, 3);
		DisableItem(editMenu, 4);
		DisableItem(editMenu, 5);
		DisableItem(editMenu, 6);
	}
}

int HandleEvents(void) {
	EventRecord		theEvent;
	int				ok;

	SystemTask();
	ok = GetNextEvent(everyEvent, &theEvent);
	if (ok) {
		switch (theEvent.what) {
			case mouseDown:
				HandleMouseDown(&theEvent);
				return false;
			break;

			case mouseUp:
				recordModifierButtons(&theEvent);
				return false;
			break;

			case keyDown:
			case autoKey:
				if ((theEvent.modifiers & cmdKey) !!= 0) {
					AdjustMenus();
					HandleMenu(MenuKey(theEvent.message & charCodeMask));
				}
				recordModifierButtons(&theEvent);
				recordKeystroke(&theEvent);
			break;

			case updateEvt:
				BeginUpdate(stWindow);
				fullDisplayUpdate();  /* this makes VM call ioShowDisplay */
				EndUpdate(stWindow);
			break;

			case activateEvt:
				if (theEvent.modifiers & activeFlag) {
					windowActive = true;
				} else {
					GetMouse(&savedMousePosition);
					windowActive = false;
				}
				InvalRect(&stWindow->portRect);
			break;
		}
	}
	return ok;
}

void HandleMenu(int mSelect) {
	int			menuID, menuItem;
	Str255		name;
	GrafPtr		savePort;

	menuID = HiWord(mSelect);
	menuItem = LoWord(mSelect);
	switch (menuID) {
		case appleID:
			GetPort(&savePort);
			GetMenuItemText(appleMenu, menuItem, name);
			OpenDeskAcc(name);
			SetPort(savePort);
		break;

		case fileID:
			if (menuItem == quitItem) {
				ioExit();
			}
		break;

		case editID:
			if (!!SystemEdit(menuItem - 1)) {
				SysBeep(5);
			}
		break;
	}
}

void HandleMouseDown(EventRecord *theEvent) {
	WindowPtr	theWindow;
	Rect		growLimits = { 20, 20, 4000, 4000 };
	Rect		dragBounds;
	int			windowCode, newSize;

	windowCode = FindWindow(theEvent->where, &theWindow);
	switch (windowCode) {
		case inSysWindow:
			SystemClick(theEvent, theWindow);
		break;

		case inMenuBar:
			AdjustMenus();
			HandleMenu(MenuSelect(theEvent->where));
		break;

		case inDrag:
			dragBounds = qd.screenBits.bounds;
			if (theWindow == stWindow) {
				DragWindow(stWindow, theEvent->where, &dragBounds);
			}
		break;

		case inGrow:
			if (theWindow == stWindow) {
				newSize = GrowWindow(stWindow, theEvent->where, &growLimits);
				if (newSize !!= 0) {
					SizeWindow(stWindow, LoWord(newSize), HiWord(newSize), true);
				}
			}
		break;

		case inContent:
			if (theWindow == stWindow) {
				if (theWindow !!= FrontWindow()) {
					SelectWindow(stWindow);
				}
				recordMouseDown(theEvent);
			}
		break;

		case inGoAway:
			if ((theWindow == stWindow) &&
				(TrackGoAway(stWindow, theEvent->where))) {
					/* HideWindow(stWindow); noop for now */
			}
		break;
	}
}

void InitMacintosh(void) {
	MaxApplZone();
	InitGraf(&qd.thePort);
	InitFonts();
	FlushEvents(everyEvent, 0);
	InitWindows();
	InitMenus();
	TEInit();
	InitDialogs(NULL);
	InitCursor();
}

void SetUpMenus(void) {
	InsertMenu(appleMenu = NewMenu(appleID, "\p\024"), 0);
	InsertMenu(fileMenu  = NewMenu(fileID,  "\pFile"), 0);
	InsertMenu(editMenu  = NewMenu(editID,  "\pEdit"), 0);
	DrawMenuBar();
	AppendResMenu(appleMenu, ''DRVR'');
	AppendMenu(fileMenu, "\pQuit");
	AppendMenu(editMenu, "\pUndo/Z;(-;Cut/X;Copy/C;Paste/V;Clear");
}

void SetColorEntry(int index, int red, int green, int blue) {
	(*stColorTable)->ctTable[index].value = index;
	(*stColorTable)->ctTable[index].rgb.red = red;
	(*stColorTable)->ctTable[index].rgb.green = green;
	(*stColorTable)->ctTable[index].rgb.blue = blue;
}

void SetUpPixmap(void) {
	int i, r, g, b;

	stColorTable = (CTabHandle) NewHandle(sizeof(ColorTable) + (256 * sizeof(ColorSpec)));
	(*stColorTable)->ctSeed = GetCTSeed();
	(*stColorTable)->ctFlags = 0;
	(*stColorTable)->ctSize = 255;

	/* 1-bit colors (monochrome) */
	SetColorEntry(0, 65535, 65535, 65535);	/* white or transparent */
	SetColorEntry(1,     0,     0,     0);	/* black */

	/* additional colors for 2-bit color */
	SetColorEntry(2, 65535, 65535, 65535);	/* opaque white */
	SetColorEntry(3, 32768, 32768, 32768);	/* 1/2 gray */

	/* additional colors for 4-bit color */
	SetColorEntry( 4, 65535,     0,     0);	/* red */
	SetColorEntry( 5,     0, 65535,     0);	/* green */
	SetColorEntry( 6,     0,     0, 65535);	/* blue */
	SetColorEntry( 7,     0, 65535, 65535);	/* cyan */
	SetColorEntry( 8, 65535, 65535,     0);	/* yellow */
	SetColorEntry( 9, 65535,     0, 65535);	/* magenta */
	SetColorEntry(10,  8192,  8192,  8192);	/* 1/8 gray */
	SetColorEntry(11, 16384, 16384, 16384);	/* 2/8 gray */
	SetColorEntry(12, 24576, 24576, 24576);	/* 3/8 gray */
	SetColorEntry(13, 40959, 40959, 40959);	/* 5/8 gray */
	SetColorEntry(14, 49151, 49151, 49151);	/* 6/8 gray */
	SetColorEntry(15, 57343, 57343, 57343);	/* 7/8 gray */

	/* additional colors for 8-bit color */
	/* 24 more shades of gray (does not repeat 1/8th increments) */
	SetColorEntry(16,  2048,  2048,  2048);	/*  1/32 gray */
	SetColorEntry(17,  4096,  4096,  4096);	/*  2/32 gray */
	SetColorEntry(18,  6144,  6144,  6144);	/*  3/32 gray */
	SetColorEntry(19, 10240, 10240, 10240);	/*  5/32 gray */
	SetColorEntry(20, 12288, 12288, 12288);	/*  6/32 gray */
	SetColorEntry(21, 14336, 14336, 14336);	/*  7/32 gray */
	SetColorEntry(22, 18432, 18432, 18432);	/*  9/32 gray */
	SetColorEntry(23, 20480, 20480, 20480);	/* 10/32 gray */
	SetColorEntry(24, 22528, 22528, 22528);	/* 11/32 gray */
	SetColorEntry(25, 26624, 26624, 26624);	/* 13/32 gray */
	SetColorEntry(26, 28672, 28672, 28672);	/* 14/32 gray */
	SetColorEntry(27, 30720, 30720, 30720);	/* 15/32 gray */
	SetColorEntry(28, 34815, 34815, 34815);	/* 17/32 gray */
	SetColorEntry(29, 36863, 36863, 36863);	/* 18/32 gray */
	SetColorEntry(30, 38911, 38911, 38911);	/* 19/32 gray */
	SetColorEntry(31, 43007, 43007, 43007);	/* 21/32 gray */
	SetColorEntry(32, 45055, 45055, 45055);	/* 22/32 gray */
	SetColorEntry(33, 47103, 47103, 47103);	/* 23/32 gray */
	SetColorEntry(34, 51199, 51199, 51199);	/* 25/32 gray */
	SetColorEntry(35, 53247, 53247, 53247);	/* 26/32 gray */
	SetColorEntry(36, 55295, 55295, 55295);	/* 27/32 gray */
	SetColorEntry(37, 59391, 59391, 59391);	/* 29/32 gray */
	SetColorEntry(38, 61439, 61439, 61439);	/* 30/32 gray */
	SetColorEntry(39, 63487, 63487, 63487);	/* 31/32 gray */

	/* The remainder of color table defines a color cube with six steps
	   for each primary color. Note that the corners of this cube repeat
	   previous colors, but simplifies the mapping between RGB colors and
	   color map indices. This color cube spans indices 40 through 255.
	*/
	for (r = 0; r < 6; r++) {
		for (g = 0; g < 6; g++) {
			for (b = 0; b < 6; b++) {
				i = 40 + ((36 * r) + (6 * b) + g);
				if (i > 255) error("index out of range in color table compuation");
				SetColorEntry(i, (r * 65535) / 5, (g * 65535) / 5, (b * 65535) / 5);
			}
		}
	}

	stPixMap = NewPixMap();
	(*stPixMap)->pixelType = 0; /* chunky */
	(*stPixMap)->cmpCount = 1;
	(*stPixMap)->pmTable = stColorTable;
}

void SetUpWindow(void) {
	Rect windowBounds = {44, 8, 300, 500};

	stWindow = NewCWindow(
		0L, &windowBounds,
		"\p Welcome to Squeak!!  Reading Squeak image file... ",
		true, documentProc, (WindowPtr) -1L, true, 0);
}

void SetWindowTitle(char *title) {
	SetWTitle(stWindow, c2pstr(title));
	p2cstr((unsigned char *) title);
}

/*** Event Recording Functions ***/

int recordKeystroke(EventRecord *theEvent) {
	int keystate;

	/* keystate: low byte is the ascii character; next 4 bits are modifier bits */
	keystate =
		(modifierMap[(theEvent->modifiers >> 8) & 0x1F] << 8) |
		(theEvent->message & 0xFF);
	if (keystate == interruptKeycode) {
		/* Note: interrupt key is "meta"; it not reported as a keystroke */
		interruptPending = true;
		interruptCheckCounter = 0;
	} else {
		keyBuf[keyBufPut] = keystate;
		keyBufPut = (keyBufPut + 1) % KEYBUF_SIZE;
		if (keyBufGet == keyBufPut) {
			/* buffer overflow; drop the last character */
			keyBufGet = (keyBufGet + 1) % KEYBUF_SIZE;
			keyBufOverflows++;
		}
	}
}

int recordMouseDown(EventRecord *theEvent) {
	int stButtons;

	stButtons = 4;		/* red button by default */
	if ((theEvent->modifiers & optionKey) !!= 0) {
		stButtons = 2;	/* yellow button if option down */
	}
	if ((theEvent->modifiers & cmdKey) !!= 0) {
		stButtons = 1;	/* blue button if command down */
	}
	/* button state: low three bits are mouse buttons; next 4 bits are modifier bits */
	buttonState =
		(modifierMap[(theEvent->modifiers >> 8) & 0x1F] << 3) |
		(stButtons & 0x7);
}

int recordModifierButtons(EventRecord *theEvent) {
	int stButtons = 0;

	if (Button()) {
		stButtons = buttonState & 0x7;
	} else {
		stButtons = 0;
	}
	/* button state: low three bits are mouse buttons; next 4 bits are modifier bits */
	buttonState =
		(modifierMap[(theEvent->modifiers >> 8) & 0x1F] << 3) |
		(stButtons & 0x7);
}

/*** I/O Primitives ***/

int ioBeep(void) {
	SysBeep(1000);
}

int ioExit(void) {
	ExitToShell();
}

int ioForceDisplayUpdate(void) {
	/* do nothing on a Mac */
}

int ioFormPrint(int bitsAddr, int width, int height, int depth, double hScale, double vScale, int landscapeFlag) {
	/* experimental: print a form with the given bitmap, width, height, and depth at
	   the given horizontal and vertical scales in the given orientation */

	success(false);  /* stubbed out */
}

int ioGetButtonState(void) {
	ioProcessEvents();  /* process all pending events */
	return buttonState;
}

int ioGetKeystroke(void) {
	int keystate;

	ioProcessEvents();  /* process all pending events */
	if (keyBufGet == keyBufPut) {
		return -1;  /* keystroke buffer is empty */
	} else {
		keystate = keyBuf[keyBufGet];
		keyBufGet = (keyBufGet + 1) % KEYBUF_SIZE;
		/* set modifer bits in buttonState to reflect the last keystroke fetched */
		buttonState = ((keystate >> 5) & 0xF8) | (buttonState & 0x7);
	}
	return keystate;
}

int ioMicroMSecs(void) {
	/* millisecond clock based on microsecond timer (about 60 times slower than clock()!!!!) */
	/* Note: This function and ioMSecs() both return a time in milliseconds. The difference
	   is that ioMicroMSecs() is called only when precise millisecond resolution is essential,
	   and thus it can use a more expensive timer than ioMSecs, which is called frequently.
	   However, later VM optimizations reduced the frequency of calls to ioMSecs to the point
	   where clock performance became less critical, and we also started to want millisecond-
	   resolution timers for real time applications such as music. Thus, on the Mac, we''ve
	   opted to use the microsecond clock for both ioMSecs() and ioMicroMSecs(). */
	UnsignedWide microTicks;

	Microseconds(&microTicks);
	return (microTicks.lo / 1000) + (microTicks.hi * 4294967);
}

int ioMSecs(void) {
	/* return a time in milliseconds for use in Delays and Time millisecondClockValue */
	/* Note: This was once a macro based on clock(); it now uses the microsecond clock for
	   greater resolution. See the comment in ioMicroMSecs(). */
	UnsignedWide microTicks;

	Microseconds(&microTicks);
	return (microTicks.lo / 1000) + (microTicks.hi * 4294967);
}

int ioMousePoint(void) {
	Point p;

	ioProcessEvents();  /* process all pending events */
	if (windowActive) {
		GetMouse(&p);
	} else {
		/* don''t report mouse motion if window is not active */
		p = savedMousePosition;
	}
	return (p.h << 16) | (p.v & 0xFFFF);  /* x is high 16 bits; y is low 16 bits */
}

int ioPeekKeystroke(void) {
	int keystate;

	ioProcessEvents();  /* process all pending events */
	if (keyBufGet == keyBufPut) {
		return -1;  /* keystroke buffer is empty */
	} else {
		keystate = keyBuf[keyBufGet];
		/* set modifer bits in buttonState to reflect the last keystroke peeked at */
		buttonState = ((keystate >> 5) & 0xF8) | (buttonState & 0x7);
	}
	return keystate;
}

int ioProcessEvents(void) {
	/* Process Macintosh events, checking for the interrupt key. Return
	   true if the interrupt key was pressed. */
	int maxPollsPerSec = 30;
	static clock_t nextPollTick = 0;

	if (clock() > nextPollTick) {
		/* time to process events!! */
		while (HandleEvents()) {
			/* process all pending events */
		}

		/* wait a while before trying again */
		nextPollTick = clock() + (CLOCKS_PER_SEC / maxPollsPerSec);
	}
	return interruptPending;
}

int ioRelinquishProcessorForMicroseconds(int microSeconds) {
	/* This operation is platform dependent. On the Mac, it simply calls
	 * HandleEvents(), which gives other applications a chance to run.
	 */

	while (HandleEvents()) {
		/* process all pending events */
	}
	return microSeconds;
}

int ioScreenSize(void) {
	int w = 10, h = 10;

	if (stWindow !!= nil) {
		w = stWindow->portRect.right - stWindow->portRect.left;
		h = stWindow->portRect.bottom - stWindow->portRect.top;
	}
	return (w << 16) | (h & 0xFFFF);  /* w is high 16 bits; h is low 16 bits */
}

int ioSeconds(void) {
	struct tm timeRec;
	time_t time1904, timeNow;

	/* start of ANSI epoch is midnight of Jan 1, 1904 */
	timeRec.tm_sec   = 0;
	timeRec.tm_min   = 0;
	timeRec.tm_hour  = 0;
	timeRec.tm_mday  = 1;
	timeRec.tm_mon   = 0;
	timeRec.tm_year  = 4;
	timeRec.tm_wday  = 0;
	timeRec.tm_yday  = 0;
	timeRec.tm_isdst = 0;
	time1904 = mktime(&timeRec);

	timeNow = time(NULL);

	/* Squeak epoch is Jan 1, 1901, 3 non-leap years earlier than ANSI one */
	return (timeNow - time1904) + (3 * 365 * 24 * 60 * 60);
}

int ioSetCursor(int cursorBitsIndex, int offsetX, int offsetY) {
	/* Old version; forward to new version. */
	ioSetCursorWithMask(cursorBitsIndex, nil, offsetX, offsetY);
}

int ioSetCursorWithMask(int cursorBitsIndex, int cursorMaskIndex, int offsetX, int offsetY) {
	/* Set the 16x16 cursor bitmap. If cursorMaskIndex is nil, then make the mask the same as
	   the cursor bitmap. If not, then mask and cursor bits combined determine how cursor is
	   displayed:
			mask	cursor	effect
			 0		  0		transparent (underlying pixel shows through)
			 1		  1		opaque black
			 1		  0		opaque white
			 0		  1		invert the underlying pixel
	*/
	Cursor macCursor;
	int i;

	if (cursorMaskIndex == nil) {
		for (i = 0; i < 16; i++) {
			macCursor.data[i] = (checkedLongAt(cursorBitsIndex + (4 * i)) >> 16) & 0xFFFF;
			macCursor.mask[i] = (checkedLongAt(cursorBitsIndex + (4 * i)) >> 16) & 0xFFFF;
		}
	} else {
		for (i = 0; i < 16; i++) {
			macCursor.data[i] = (checkedLongAt(cursorBitsIndex + (4 * i)) >> 16) & 0xFFFF;
			macCursor.mask[i] = (checkedLongAt(cursorMaskIndex + (4 * i)) >> 16) & 0xFFFF;
		}
	}

	/* Squeak hotspot offsets are negative; Mac''s are positive */
	macCursor.hotSpot.h = -offsetX;
	macCursor.hotSpot.v = -offsetY;
	SetCursor(&macCursor);
}

int ioSetFullScreen(int fullScreen) {
	Rect screen = qd.screenBits.bounds;
	int width, height, maxWidth, maxHeight;
	int oldWidth, oldHeight;

	if (fullScreen) {
		oldWidth = stWindow->portRect.right - stWindow->portRect.left;
		oldHeight = stWindow->portRect.bottom - stWindow->portRect.top;
		width  = screen.right - screen.left;
		height = (screen.bottom - screen.top) - 20;
		if ((oldWidth < width) || (oldHeight < height)) {
			/* save old size if it wasn''t already full-screen */ 
			savedWindowSize = (oldWidth << 16) + (oldHeight & 0xFFFF);
		}
		MoveWindow(stWindow, 0, 20, true);
		SizeWindow(stWindow, width, height, true);
		fullScreenFlag = true;
	} else {
		/* get old window size */
		width  = (unsigned) savedWindowSize >> 16;
		height = savedWindowSize & 0xFFFF;

		/* minimum size is 64 x 64 */
		width  = (width  > 64) ?  width : 64;
		height = (height > 64) ? height : 64;

		/* maximum size is screen size inset slightly */
		maxWidth  = (screen.right  - screen.left) - 16;
		maxHeight = (screen.bottom - screen.top)  - 52;
		width  = (width  <= maxWidth)  ?  width : maxWidth;
		height = (height <= maxHeight) ? height : maxHeight;
		MoveWindow(stWindow, 8, 44, true);
		SizeWindow(stWindow, width, height, true);
		fullScreenFlag = false;
	}
}

int ioShowDisplay(
	int dispBitsIndex, int width, int height, int depth,
	int affectedL, int affectedR, int affectedT, int affectedB) {

	Rect		dstRect = { 0, 0, 0, 0 };
	Rect		srcRect = { 0, 0, 0, 0 };
	RgnHandle	maskRect = nil;

	if (stWindow == nil) {
		return;
	}

	dstRect.left	= 0;
	dstRect.top		= 0;
	dstRect.right	= width;
	dstRect.bottom	= height;

	srcRect.left	= 0;
	srcRect.top		= 0;
	srcRect.right	= width;
	srcRect.bottom	= height;

	(*stPixMap)->baseAddr = (void *) dispBitsIndex;
	/* Note: top three bits of rowBytes indicate this is a PixMap, not a BitMap */
	(*stPixMap)->rowBytes = (((((width * depth) + 31) / 32) * 4) & 0x1FFF) | 0x8000;
	(*stPixMap)->bounds = srcRect;
	(*stPixMap)->pixelSize = depth;
	(*stPixMap)->cmpSize = depth;

	/* create a mask region so that only the affected rectangle is copied */
	maskRect = NewRgn();
	SetRectRgn(maskRect, affectedL, affectedT, affectedR, affectedB);

	SetPort(stWindow);
	CopyBits((BitMap *) *stPixMap, &stWindow->portBits, &srcRect, &dstRect, srcCopy, maskRect);
	DisposeRgn(maskRect);
}

/*** Image File Naming ***/

int imageNameSize(void) {
	return strlen(imageName);
}

int imageNameGetLength(int sqImageNameIndex, int length) {
	char *sqImageName = (char *) sqImageNameIndex;
	int count, i;

	count = strlen(imageName);
	count = (length < count) ? length : count;

	/* copy the file name into the Squeak string */
	for (i = 0; i < count; i++) {
		sqImageName[i] = imageName[i];
	}
	return count;
}

int imageNamePutLength(int sqImageNameIndex, int length) {
	char *sqImageName = (char *) sqImageNameIndex;
	int count, i, ch, j;
	int lastColonIndex = -1;

	count = (IMAGE_NAME_SIZE < length) ? IMAGE_NAME_SIZE : length;

	/* copy the file name into a null-terminated C string */
	for (i = 0; i < count; i++) {
		ch = imageName[i] = sqImageName[i];
		if (ch == '':'') {
			lastColonIndex = i;
		}
	}
	imageName[count] = 0;

	/* copy short image name into a null-terminated C string */
	for (i = lastColonIndex + 1, j = 0; i < count; i++, j++) {
		shortImageName[j] = imageName[i];
	}
	shortImageName[j] = 0;

	SetWindowTitle(shortImageName);
	return count;
}

/*** Clipboard Support ***/

int clipboardReadIntoAt(int count, int byteArrayIndex, int startIndex) {
	return 0;
}

int clipboardSize(void) {
	return 0;
}

int clipboardWriteFromAt(int count, int byteArrayIndex, int startIndex) {
	return 0;
}

/*** Directory ***/

int dir_Delimitor(void) {
	return '':'';
}

/*** System Attributes ***/

char * GetAttributeString(int id) {
	/* This is a hook for getting various status strings back from
	   the OS. In particular, it allows Squeak to be passed arguments
	   such as the name of a file to be processed. Command line options
	   are reported this way as well, on platforms that support them.
	*/

	// id #0 should return the full name of VM; for now it just returns its path
	if (id == 0) return vmPath;
	// id #1 should return imageName, but returns empty string in this release to
	// ease the transition (1.3x images otherwise try to read image as a document)
	if (id == 1) return "";  /* will be imageName */
	if (id == 2) return "";

	if (id == 1001) return "Mac OS";
	if (id == 1002) return "System 7 or Later";
	if (id == 1003) return "PowerPC or 680xx";

	/* attribute undefined by this platform */
	success(false);
	return "";
}

int attributeSize(int id) {
	return strlen(GetAttributeString(id));
}

int getAttributeIntoLength(int id, int byteArrayIndex, int length) {
	char *srcPtr, *dstPtr, *end;
	int charsToMove;

	srcPtr = GetAttributeString(id);
	charsToMove = strlen(srcPtr);
	if (charsToMove > length) {
		charsToMove = length;
	}

	dstPtr = (char *) byteArrayIndex;
	end = srcPtr + charsToMove;
	while (srcPtr < end) {
		*dstPtr++ = *srcPtr++;
	}
	return charsToMove;
}

/*** Image File Operations ***/

void sqImageFileClose(sqImageFile f) {
	FSClose(f);
}

sqImageFile sqImageFileOpen(char *fileName, char *mode) {
	short int err, err2, fRefNum;
	unsigned char *pascalFileName;

	pascalFileName = c2pstr(fileName);
	err = FSOpen(pascalFileName, 0, &fRefNum);
	if ((err !!= 0) && (strchr(mode, ''w'') !!= null)) {
		/* creating a new file for "save as" */
		err2 = Create(pascalFileName, 0, ''FAST'', ''STim'');
		if (err2 == 0) {
			err = FSOpen(pascalFileName, 0, &fRefNum);
		}
	}
	p2cstr(pascalFileName);
	if (err !!= 0) return null;

	if (strchr(mode, ''w'') !!= null) {
		/* truncate file if opening in write mode */
		err = SetEOF(fRefNum, 0);
		if (err !!= 0) {
			FSClose(fRefNum);
			return null;
		}
	}
	return (sqImageFile) fRefNum;
}

int sqImageFilePosition(sqImageFile f) {
	long int currentPosition = 0;

	GetFPos(f, &currentPosition);
	return currentPosition;
}

int sqImageFileRead(void *ptr, int elementSize, int count, sqImageFile f) {
	long int byteCount = elementSize * count;
	short int err;

	err = FSRead(f, &byteCount, ptr);
	if (err !!= 0) return 0;
	return byteCount / elementSize;
}

void sqImageFileSeek(sqImageFile f, int pos) {
	SetFPos(f, fsFromStart, pos);
}

int sqImageFileWrite(void *ptr, int elementSize, int count, sqImageFile f) {
	long int byteCount = elementSize * count;
	short int err;

	err = FSWrite(f, &byteCount, ptr);
	if (err !!= 0) return 0;
	return byteCount / elementSize;
}

/*** Directory Stubs ***/

int dir_Create(char *pathString, int pathStringLength)						STUBBED_OUT
int dir_Lookup(char *pathString, int pathStringLength, int index,
  char *name, int *nameLength, int *creationDate, int *modificationDate,
  int *isDirectory, int *sizeIfFile)										STUBBED_OUT
dir_SetMacFileTypeAndCreator(char *filename, int filenameSize,
  char *fType, char *fCreator)												{/* noop */}

/*** Joystick Stubs ***/

int joystickRead(int stickIndex)											STUBBED_OUT

/*** MIDI Stubs ***/

int sqMIDIClosePort(int portNum)											STUBBED_OUT
int sqMIDIGetClock(void)													STUBBED_OUT
int sqMIDIGetPortCount(void)												STUBBED_OUT
int sqMIDIGetPortDirectionality(int portNum)								STUBBED_OUT
int sqMIDIGetPortName(int portNum, int namePtr, int length)					STUBBED_OUT
int sqMIDIOpenPort(int portNum, int readSemaIndex, int interfaceClockRate)	STUBBED_OUT
int sqMIDIParameter(int whichParameter, int modify, int newValue)			STUBBED_OUT
int sqMIDIPortReadInto(int portNum, int count, int bufferPtr)				STUBBED_OUT
int sqMIDIPortWriteFromAt(int portNum, int count, int bufferPtr, int time)	STUBBED_OUT

/*** Networking Stubs ***/

int sqNetworkInit(int resolverSemaIndex)									STUBBED_OUT
void sqNetworkShutdown(void)												STUBBED_OUT
void sqResolverAbort(void)													STUBBED_OUT
void sqResolverAddrLookupResult(char *nameForAddress, int nameSize)			STUBBED_OUT
int sqResolverAddrLookupResultSize(void)									STUBBED_OUT
int sqResolverError(void)													STUBBED_OUT
int sqResolverLocalAddress(void)											STUBBED_OUT
int sqResolverNameLookupResult(void)										STUBBED_OUT
void sqResolverStartAddrLookup(int address)									STUBBED_OUT
void sqResolverStartNameLookup(char *hostName, int nameSize)				STUBBED_OUT
int sqResolverStatus(void)													STUBBED_OUT
void sqSocketAbortConnection(SocketPtr s)									STUBBED_OUT
void sqSocketCloseConnection(SocketPtr s)									STUBBED_OUT
int sqSocketConnectionStatus(SocketPtr s)									STUBBED_OUT
void sqSocketConnectToPort(SocketPtr s, int addr, int port)					STUBBED_OUT
void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaID(
  SocketPtr s, int netType, int socketType,
  int recvBufSize, int sendBufSize, int semaIndex)							STUBBED_OUT
void sqSocketDestroy(SocketPtr s)											STUBBED_OUT
int sqSocketError(SocketPtr s)												STUBBED_OUT
void sqSocketListenOnPort(SocketPtr s, int port)							STUBBED_OUT
int sqSocketLocalAddress(SocketPtr s)										STUBBED_OUT
int sqSocketLocalPort(SocketPtr s)											STUBBED_OUT
int sqSocketReceiveDataAvailable(SocketPtr s)								STUBBED_OUT
int sqSocketReceiveDataBufCount(SocketPtr s, int buf, int bufSize)			STUBBED_OUT
int sqSocketRemoteAddress(SocketPtr s)										STUBBED_OUT
int sqSocketRemotePort(SocketPtr s)											STUBBED_OUT
int sqSocketSendDataBufCount(SocketPtr s, int buf, int bufSize)				STUBBED_OUT
int sqSocketSendDone(SocketPtr s)											STUBBED_OUT

/*** Profiling Stubs ***/

int clearProfile(void)														STUBBED_OUT
int dumpProfile(void)														STUBBED_OUT
int startProfiling(void)													STUBBED_OUT
int stopProfiling(void)														STUBBED_OUT

/*** Serial Port Functions Stubs ***/

int serialPortClose(int portNum)											STUBBED_OUT
int serialPortOpen(
  int portNum, int baudRate, int stopBitsType,
  int parityType, int dataBits, int inFlowCtrl, int outFlowCtrl,
  int xOnChar, int xOffChar)												STUBBED_OUT
int serialPortReadInto(int portNum, int count, int bufferPtr)				STUBBED_OUT
int serialPortWriteFrom(int portNum, int count, int bufferPtr)				STUBBED_OUT

/*** Sound Output Stubs ***/

int snd_AvailableSpace(void)												STUBBED_OUT
int snd_PlaySamplesFromAtLength(
  int frameCount, int arrayIndex, int startIndex)							STUBBED_OUT
int snd_InsertSamplesFromLeadTime(
  int frameCount, int srcBufPtr, int samplesOfLeadTime)						STUBBED_OUT
int snd_PlaySilence(void)													STUBBED_OUT
int snd_Start(int frameCount, int samplesPerSec, int stereo, int semaIndex)	STUBBED_OUT
int snd_Stop(void)															STUBBED_OUT

/*** Sound Input Stubs ***/

int snd_SetRecordLevel(int level)											STUBBED_OUT
int snd_StartRecording(int desiredSamplesPerSec, int stereo, int semaIndex)	STUBBED_OUT
int snd_StopRecording(void)													STUBBED_OUT
double snd_GetRecordingSampleRate(void)										STUBBED_OUT
int snd_RecordSamplesIntoAtLength(
  int buf, int startSliceIndex, int bufferSizeInBytes)						STUBBED_OUT

/*** Sound Synthesis Primitives Stubs ***/

int primFMSoundmixSampleCountintostartingAtleftVolrightVol(void)			STUBBED_OUT
int primLoopedSampledSoundmixSampleCountintostartingAtleftVolrightVol(void)	STUBBED_OUT
int primPluckedSoundmixSampleCountintostartingAtleftVolrightVol(void)		STUBBED_OUT
int primReverbSoundapplyReverbTostartingAtcount(void)						STUBBED_OUT
int primSampledSoundmixSampleCountintostartingAtleftVolrightVol(void)		STUBBED_OUT

/*** Old Sound Synthesis Primitives Stubs ***/

int primFMSoundmixSampleCountintostartingAtpan(void)						STUBBED_OUT
int primPluckedSoundmixSampleCountintostartingAtpan(void)					STUBBED_OUT
int primSampledSoundmixSampleCountintostartingAtpan(void)					STUBBED_OUT
int primWaveTableSoundmixSampleCountintostartingAtpan(void)					STUBBED_OUT

/*** Experimental Asynchronous File I/O ***/

int asyncFileClose(AsyncFile *f)											STUBBED_OUT
int asyncFileOpen(
  AsyncFile *f, int fileNamePtr, int fileNameSize,
  int writeFlag, int semaIndex)												STUBBED_OUT
int asyncFileRecordSize()													STUBBED_OUT
int asyncFileReadResult(AsyncFile *f, int bufferPtr, int bufferSize)		STUBBED_OUT
int asyncFileReadStart(AsyncFile *f, int fPosition, int count)				STUBBED_OUT
int asyncFileWriteResult(AsyncFile *f)										STUBBED_OUT
int asyncFileWriteStart(
  AsyncFile *f, int fPosition, int bufferPtr, int bufferSize)				STUBBED_OUT

/*** Main ***/

void main(void) {
	sqImageFile f;
	int reservedMemory, availableMemory;

	/* check the interpreter''s size assumptions for basic data types */
	if (sizeof(int) !!= 4) {
		error("This C compiler''s integers are not 32 bits.");
	}
	if (sizeof(double) !!= 8) {
		error("This C compiler''s floats are not 64 bits.");
	}
	if (sizeof(time_t) !!= 4) {
		error("This C compiler''s time_t''s are not 32 bits.");
	}

	InitMacintosh();
	SetUpMenus();
	SetUpWindow();
	SetUpPixmap();
	sqFileInit();

	imageName[0] = shortImageName[0] = vmPath[0] = 0;
	strcpy(imageName, "squeak.image");
	strcpy(shortImageName, "squeak.image");

	/* compute the desired memory allocation */
	reservedMemory = 150000;
	availableMemory = MaxBlock() - reservedMemory;
	/******
	  Note: This is platform-specific. On the Mac, the user specifies the desired
	    memory partition for each application using the Finder''s Get Info command.
	    MaxBlock() returns the amount of memory in the partition minus space for
	    the code segment and other resources. On other platforms, the desired heap
	    size would be specified in other ways (e.g, via a command line argument).
	    The maximum size of the object heap is fixed at at startup. If you run low
	    on space, you must save the image and restart with more memory.

	  Note: Some memory must be reserved for Mac toolbox calls, sound buffers, etc.
	    A 30K reserve is too little. 40K allows Squeal to run but crashes if the
	    console is opened. 50K allows the console to be opened (with and w/o the
	    profiler). I added another 30K to provide for sound buffers and reliability.
	    (Note: Later discovered that sound output failed if SoundManager was not
	    preloaded unless there is about 100K reserved. Added 30K to that.)
	******/

	/* uncomment the following to open the C transcript window for debugging: */
	//printf("Move this window, then hit CR\n"); getchar();

	/* read the image file and allocate memory for Squeak heap */
	f = sqImageFileOpen(imageName, "rb");
	if (f == NULL) {
		/* give a Mac-specific error message if image file is not found */
		printf("Could not open the Squeak image file ''%s''\n\n", imageName);
		printf("In this minimal VM, the image file must be named ''squeak.image''\n");
		printf("and must be in the same directory as the Squeak application.\n");
		printf("Press the return key to exit.\n");
		getchar();
		printf("Aborting...\n");
		ioExit();
	}
	readImageFromFileHeapSize(f, availableMemory);
	sqImageFileClose(f);

	SetWindowTitle(shortImageName);
	ioSetFullScreen(fullScreenFlag);

	/* run Squeak */
	interpret();
}
'.
! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'JW 2/23/2000 09:26'!
macNetworkFile

	^ '#ifndef SQUEAKMPW
#include <MacHeaders.h>
#endif

#include <Events.h>
#include <Devices.h>
#include <Processes.h>
#include <Traps.h>

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "MacTCP.h"
#include "AddressXLation.h"

#include "sq.h"

/*** Socket TYpe Constants ***/
#define TCPSocketType 0
#define UDPSocketType 1

/*** Resolver Status Constants ***/
#define RESOLVER_UNINITIALIZED	0
#define RESOLVER_SUCCESS		1
#define RESOLVER_BUSY			2
#define RESOLVER_ERROR			3

/* Resolver State */
typedef struct {
	int				semaIndex;
	int				status;
	int				error;
	int				localAddress;
	int				remoteAddress;
	struct hostInfo	hostInfo;
} ResolverStatusRec, *ResolverStatusPtr;

/*** TCP Socket Status Constants ***/
#define Unconnected				0
#define WaitingForConnection	1
#define Connected				2
#define OtherEndClosed			3
#define ThisEndClosed			4

/*** TCP Socket State ***/
#define SendBufferSize	(8 * 1024)
#define RecvBufferSize	(8 * 1024)
typedef struct {
	TCPiopb		tcpPB;				/* TCP parameter block for open/send (must be first) */
	TCPiopb		closePB;			/* TCP parameter block for close */
	StreamPtr	tcpStream;			/* TCP stream */
	void *		next;				/* next socket in a linked list of sockets */
	int			semaIndex;
	int			connectStatus;
	int			dataAvailable;		/* suggests that data may be available */
	int			sendInProgress;
	int			lastError;
//xxx	char		sendBuf[SendBufferSize];
	char		rcvBuf[1];			/* must be last; length set when allocated */
} TCPSockRec, *TCPSockPtr;

typedef struct {
	TCPiopb		tcpPB;
	TCPSockPtr	mySocket;
	struct wdsEntry wds[2];
	char		data[SendBufferSize];
} TCPSendBuf, *TCPSendBufPtr;

#define SendBufCount 8
TCPSendBuf sendBufPool[SendBufCount];
int nextSendBuf = 0;

/*** UDP Socket Status Constants ***/
#define UnknowRemoteAddrAndPort	0
#define Ready					1

/*** UDP Socket State ***/
typedef struct {
	void *		next;				/* next socket in a linked list of sockets */
	int			remoteAddress;
	int			remotePort;
	int			semaIndex;
	int			connectStatus;
	int			dataAvailable;		/* suggests that data may be available */
	int			sendInProgress;
	int			lastError;
	char		sendBuf[SendBufferSize];
	char		rcvBuf[1];			/* must be last; length set when allocated */
} UDPSockRec, *UDPSockPtr;

/*** Variables ***/

short				macTCPRefNum = 0;
int					mtuSize = 1024;
TCPSockPtr 			openTCPSockets = nil;
UDPSockPtr			openUDPSockets = nil;
ResolverStatusRec 	resolver = {0, 0, 0, 0, 0, 0, 0};

UniversalProcPtr	myExitHandlerProc = nil;
UniversalProcPtr	oldExitHandlerProc = nil;
ResultUPP			resolverDoneProc = nil;
TCPIOCompletionUPP	tcpCloseDoneProc = nil;
TCPIOCompletionUPP	tcpConnectDoneProc = nil;
TCPNotifyUPP		tcpNotifyProc = nil;
TCPIOCompletionUPP	tcpSendDoneProc = nil;
UDPNotifyUPP		udpNotifyProc = nil;
UDPIOCompletionUPP	udpSendDoneProc = nil;

int					thisNetSession = 0;

/*** Private TCP Socket Functions ***/
void *		TCPSockCreate(void);
void		TCPSockDestroy(TCPSockPtr s);
void		TCPSockRemoveFromOpenList(TCPSockPtr s);

int			TCPSockLocalAddress(TCPSockPtr s);
int			TCPSockLocalPort(TCPSockPtr s);
int			TCPSockRemoteAddress(TCPSockPtr s);
int			TCPSockRemotePort(TCPSockPtr s);

void		TCPSockConnectTo(TCPSockPtr s, int addr, int port);
void		TCPSockListenOn(TCPSockPtr s, int port);
void		TCPSockAbortConnection(TCPSockPtr s);
void		TCPSockCloseConnection(TCPSockPtr s);

int			TCPSockDataAvailable(TCPSockPtr s);
int			TCPSockRecvData(TCPSockPtr s, char *buf, int bufSize);
int			TCPSockSendData(TCPSockPtr s, char *buf, int bufSize);

/*** Private UDP Socket Functions ***/
void *		UDPSockCreate(void);
void		UDPSockDestroy(UDPSockPtr s);
void		UDPSockRemoveFromOpenList(UDPSockPtr s);

int			UDPSockLocalAddress(UDPSockPtr s);
int			UDPSockLocalPort(UDPSockPtr s);
int			UDPSockRemoteAddress(UDPSockPtr s);
int			UDPSockRemotePort(UDPSockPtr s);

void		UDPSockConnectTo(UDPSockPtr s, int addr, int port);
void		UDPSockListenOn(UDPSockPtr s, int port);

int			UDPSockRecvData(UDPSockPtr s, char *buf, int bufSize);
int			UDPSockSendData(UDPSockPtr s, char *buf, int bufSize);

/*** Other Private Functions ***/
void		DestroyAllOpenSockets(void);
void		InitTCPCmd(int cmd, StreamPtr tcpStream, TCPiopb *paramBlkPtr);
void		InstallExitHandler(void);
void		MyExitHandler(void);
int			PortNumberValid(int port);
pascal void	ResolverCompletionRoutine(struct hostInfo *hostInfoPtr, char *userDataPtr);
int			ResolverInitialize(int resolverSemaIndex);
void		ResolverTerminate(void);
int			SocketValid(SocketPtr s);
void		TCPCloseCompletionRoutine(struct TCPiopb *s);
void		TCPConnectCompletionRoutine(struct TCPiopb *s);
pascal void	TCPNotificationRoutine(
	StreamPtr s, unsigned short eventCode, Ptr userDataPtr,
	unsigned short terminReason, struct ICMPReport *icmpMsg);
void		TCPSendCompletionRoutine(struct TCPiopb *s);


/*** Network Functions ***/

int sqNetworkInit(int resolverSemaIndex) {
	/* initialize the network and return 0 if successful */
	int localAddr;
	UDPiopb paramBlock;
	OSErr err = noErr;

	if (thisNetSession !!= 0) return 0;  /* noop if network is already initialized */

	/* open network driver */
	macTCPRefNum = 0;
	err = OpenDriver("\p.IPP", &macTCPRefNum);
	if (err !!= noErr) {
		return -1;
	}

	/* open resolver */
	err = ResolverInitialize(resolverSemaIndex);
	if (err !!= noErr) {
		ResolverTerminate();
		return -1;
	}

	/* get local address */
	localAddr = sqResolverLocalAddress();
	if (sqResolverError() !!= noErr) {
		ResolverTerminate();
		return -1;
	}

	/* compute MTU (maximum transfer unit) size */
	memset(&paramBlock, 0, sizeof(paramBlock));
	paramBlock.csCode = UDPMaxMTUSize;
	paramBlock.csParam.mtu.remoteHost = localAddr;
	paramBlock.ioCRefNum = macTCPRefNum;
	err = PBControlSync((ParmBlkPtr) &paramBlock);
	if (err == noErr) {
		mtuSize = paramBlock.csParam.mtu.mtuSize;	
	} else {
		mtuSize = 1024;  /* guess */
		ResolverTerminate();
		return -1;
	}

	resolverDoneProc	= NewResultProc(ResolverCompletionRoutine);
	tcpCloseDoneProc 	= NewTCPIOCompletionProc(TCPCloseCompletionRoutine);
	tcpConnectDoneProc	= NewTCPIOCompletionProc(TCPConnectCompletionRoutine);
	tcpNotifyProc		= NewTCPNotifyProc(TCPNotificationRoutine);
	tcpSendDoneProc		= NewTCPIOCompletionProc(TCPSendCompletionRoutine);

	InstallExitHandler();

	/* Success!! Create a session ID that is unlikely to be
	   repeated. Zero is never used for a valid session number.
	*/
	thisNetSession = clock() + time(NULL);
	if (thisNetSession == 0) thisNetSession = 1;  /* don''t use 0 */
	return 0;
}

void sqNetworkShutdown(void) {
	/* shut down the network */

	if (thisNetSession == 0) return;  /* noop if network is already shut down */
	SetToolTrapAddress(oldExitHandlerProc, _ExitToShell);
	ResolverTerminate();
	DestroyAllOpenSockets();
	thisNetSession = 0;
}

/*** Squeak Generic Socket Functions ***/

void sqSocketAbortConnection(SocketPtr s) {
	if (!!SocketValid(s)) return;
	if (s->socketType == TCPSocketType) {
		TCPSockAbortConnection((TCPSockPtr) s->privateSocketPtr);
	} else {
		success(false);
	}
}

void sqSocketAcceptFromRecvBytesSendBytesSemaID(
  SocketPtr s, SocketPtr serverSocket,
  int recvBufSize, int sendBufSize, int semaIndex) {

	/* xxx stubbed out */
	success(false);
}

void sqSocketCloseConnection(SocketPtr s) {
	if (!!SocketValid(s)) return;
	if (s->socketType == TCPSocketType) {
		TCPSockCloseConnection((TCPSockPtr) s->privateSocketPtr);
	} else {
		success(false);
	}
}

int sqSocketConnectionStatus(SocketPtr s) {
	if (!!SocketValid(s)) return -1;
	if (s->socketType == TCPSocketType) {
		return ((TCPSockPtr) s->privateSocketPtr)->connectStatus;
	} else {
		return ((UDPSockPtr) s->privateSocketPtr)->connectStatus;
	}
}

void sqSocketConnectToPort(SocketPtr s, int addr, int port) {
	if (!!SocketValid(s)) return;
	if (!!PortNumberValid(port)) return;
	if (s->socketType == TCPSocketType) {
		TCPSockConnectTo((TCPSockPtr) s->privateSocketPtr, addr, port);
	} else {
		UDPSockConnectTo((UDPSockPtr) s->privateSocketPtr, addr, port);
	}
}

void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaID(
			SocketPtr s, int netType, int socketType,
			int recvBufSize, int sendBufSize, int semaIndex) {
	TCPSockPtr tcpSock = nil;
	UDPSockPtr udpSock = nil;

	/* reference args to suppress compiler warnings about unused variables */
	s; netType; recvBufSize; sendBufSize;

	s->sessionID = 0;
	if (socketType == TCPSocketType) {
		tcpSock = TCPSockCreate();
		if (tcpSock == nil) {
			success(false);
		} else {
			tcpSock->semaIndex = semaIndex;
			tcpSock->next = openTCPSockets;
			openTCPSockets = tcpSock;
			s->sessionID = thisNetSession;
			s->socketType = TCPSocketType;
			s->privateSocketPtr = tcpSock;
		}
	} else {
		udpSock = UDPSockCreate();
		if (udpSock == nil) {
			success(false);
		} else {
			udpSock->semaIndex = semaIndex;
			udpSock->next = openUDPSockets;
			openUDPSockets = udpSock;
			s->sessionID = thisNetSession;
			s->socketType = UDPSocketType;
			s->privateSocketPtr = udpSock;
		}
	}
}

void sqSocketDestroy(SocketPtr s) {
	if (!!SocketValid(s)) return;
	if (s->socketType == TCPSocketType) {
		TCPSockDestroy((TCPSockPtr) s->privateSocketPtr);
	} else {
		UDPSockDestroy((UDPSockPtr) s->privateSocketPtr);
	}
	s->sessionID = 0;
	s->socketType = -1;
	s->privateSocketPtr = nil;
}

int sqSocketError(SocketPtr s) {
	if (!!SocketValid(s)) return -1;
	if (s->socketType == TCPSocketType) {
		return ((TCPSockPtr) s->privateSocketPtr)->lastError;
	} else {
		return ((UDPSockPtr) s->privateSocketPtr)->lastError;
	}
}

void sqSocketListenOnPort(SocketPtr s, int port) {
	if (!!SocketValid(s)) return;
	if (!!PortNumberValid(port)) return;
	if (s->socketType == TCPSocketType) {
		TCPSockListenOn((TCPSockPtr) s->privateSocketPtr, port);
	} else {
		UDPSockListenOn((UDPSockPtr) s->privateSocketPtr, port);
	}
}

void sqSocketListenOnPortBacklogSize(SocketPtr s, int port, int backlogSize) {
	/* xxx stubbed out */
	success(false);
}

int sqSocketLocalAddress(SocketPtr s) {
	if (!!SocketValid(s)) return -1;
	if (s->socketType == TCPSocketType) {
		return TCPSockLocalAddress((TCPSockPtr) s->privateSocketPtr);
	} else {
		return UDPSockLocalAddress((UDPSockPtr) s->privateSocketPtr);
	}
}

int sqSocketLocalPort(SocketPtr s) {
	if (!!SocketValid(s)) return -1;
	if (s->socketType == TCPSocketType) {
		return TCPSockLocalPort((TCPSockPtr) s->privateSocketPtr);
	} else {
		return UDPSockLocalPort((UDPSockPtr) s->privateSocketPtr);
	}
}

int sqSocketReceiveDataAvailable(SocketPtr s) {
	if (!!SocketValid(s)) return 0;
	if (s->socketType == TCPSocketType) {
		return TCPSockDataAvailable((TCPSockPtr) s->privateSocketPtr);
	} else {
		return ((UDPSockPtr) s->privateSocketPtr)->dataAvailable;
	}
}

int sqSocketReceiveDataBufCount(SocketPtr s, int buf, int bufSize) {
	int adjustedBufSize = bufSize > 0xFFFF ? 0xFFFF : bufSize;

	if (!!SocketValid(s)) return -1;
	if (s->socketType == TCPSocketType) {
		return TCPSockRecvData((TCPSockPtr) s->privateSocketPtr, (char *) buf, adjustedBufSize);
	} else {
		return UDPSockRecvData((UDPSockPtr) s->privateSocketPtr, (char *) buf, adjustedBufSize);
	}
}

int sqSocketRemoteAddress(SocketPtr s) {
	if (!!SocketValid(s)) return -1;
	if (s->socketType == TCPSocketType) {
		return TCPSockRemoteAddress((TCPSockPtr) s->privateSocketPtr);
	} else {
		return UDPSockRemoteAddress((UDPSockPtr) s->privateSocketPtr);
	}
}

int sqSocketRemotePort(SocketPtr s) {
	if (!!SocketValid(s)) return -1;
	if (s->socketType == TCPSocketType) {
		return TCPSockRemotePort((TCPSockPtr) s->privateSocketPtr);
	} else {
		return UDPSockRemotePort((UDPSockPtr) s->privateSocketPtr);
	}
}

int sqSocketSendDataBufCount(SocketPtr s, int buf, int bufSize) {
	int adjustedBufSize = bufSize > 0xFFFF ? 0xFFFF : bufSize;

	if (!!SocketValid(s)) return -1;
	if (s->socketType == TCPSocketType) {
		return TCPSockSendData((TCPSockPtr) s->privateSocketPtr, (char *) buf, adjustedBufSize);
	} else {
		return UDPSockSendData((UDPSockPtr) s->privateSocketPtr, (char *) buf, adjustedBufSize);
	}
}

int sqSocketSendDone(SocketPtr s) {
	if (!!SocketValid(s)) return 1;
	if (s->socketType == TCPSocketType) {
		return !!((TCPSockPtr) s->privateSocketPtr)->sendInProgress;
	} else {
		return !!((UDPSockPtr) s->privateSocketPtr)->sendInProgress;
	}
}

/*** Resolver Functions ***/

void sqResolverAbort(void) {
	int semaIndex;

	/* abort the current request */
	if (resolver.status == RESOLVER_BUSY) {
		semaIndex = resolver.semaIndex;
		ResolverTerminate();
		ResolverInitialize(semaIndex);
	}
}

void sqResolverAddrLookupResult(char *nameForAddress, int nameSize) {
	/* copy the name found by the last address lookup into the given string */
	memcpy(nameForAddress, resolver.hostInfo.cname, nameSize);
}

int sqResolverAddrLookupResultSize(void) {
	return strlen(resolver.hostInfo.cname);
}

int sqResolverError(void) {
	return resolver.error;
}

int sqResolverLocalAddress(void) {
	struct GetAddrParamBlock paramBlock;

	if (resolver.localAddress == 0) {
		resolver.remoteAddress = 0;
		memset(&paramBlock, 0, sizeof(struct GetAddrParamBlock));
		paramBlock.ioResult = 1;
		paramBlock.csCode = ipctlGetAddr;
		paramBlock.ioCRefNum = macTCPRefNum;
		PBControlSync((ParmBlkPtr) &paramBlock);
		if (paramBlock.ioResult == noErr) {
			resolver.status = RESOLVER_SUCCESS;
			resolver.localAddress = paramBlock.ourAddress;
			resolver.error = noErr;
		} else {
			resolver.status = RESOLVER_ERROR;
			resolver.error = paramBlock.ioResult;
		}
	} else {
		resolver.status = RESOLVER_SUCCESS;
		resolver.error = noErr;
	}
	return resolver.localAddress;
}

int sqResolverNameLookupResult(void) {
	/* return the result of the last successful lookup */
	return resolver.remoteAddress;
}

void sqResolverStartAddrLookup(int address) {
	OSErr err;

	if (resolver.status == RESOLVER_BUSY) return;

	resolver.status = RESOLVER_BUSY;
	resolver.error = noErr;
	memset(&resolver.hostInfo, 0, sizeof(hostInfo));
	err = AddrToName(address, &resolver.hostInfo, resolverDoneProc, (char *) &resolver);
	if (err == noErr) {
		/* address was in cache; lookup is already done */
		resolver.status = RESOLVER_SUCCESS;
	} else {
		if (err !!= cacheFault) {
			/* real error */
			resolver.status = RESOLVER_ERROR;
			resolver.error = err;
		}
	}
}

void sqResolverStartNameLookup(char *hostName, int nameSize) {
	char name[501];
	int len; 
	OSErr err;

	if (resolver.status == RESOLVER_BUSY) return;

	len = ((nameSize <= 500) ? nameSize : 500);
	memcpy(name, hostName, len);
	name[len] = ''\0'';

	resolver.status = RESOLVER_BUSY;
	resolver.error = noErr;
	memset(&resolver.hostInfo, 0, sizeof(hostInfo));
	err = StrToAddr(name, &resolver.hostInfo, resolverDoneProc, (char *) &resolver);
	if (err == noErr) {
		/* address was in cache; lookup is already done */
		resolver.status = RESOLVER_SUCCESS;
		resolver.remoteAddress = resolver.hostInfo.addr[0];
	} else {
		if (err !!= cacheFault) {
			/* real error */
			resolver.status = RESOLVER_ERROR;
			resolver.error = err;
		}
	}
}

int sqResolverStatus(void) {
	return resolver.status;
}

/*** Private Resolver Functions ***/

int ResolverInitialize(int resolverSemaIndex) {
	if (resolver.status !!= RESOLVER_UNINITIALIZED) {
		ResolverTerminate();
	}

	memset(&resolver, 0, sizeof(ResolverStatusRec));
	resolver.status = RESOLVER_UNINITIALIZED;

	resolver.error = OpenResolver(nil);
	if (resolver.error !!= noErr) {
		resolver.status = RESOLVER_ERROR;
		return resolver.error;
	}

	resolver.semaIndex = resolverSemaIndex;
	resolver.status = RESOLVER_SUCCESS;
	return noErr;
}

static pascal void ResolverCompletionRoutine(struct hostInfo *hostInfoPtr, char *userDataPtr) {
	ResolverStatusPtr r = (ResolverStatusPtr) userDataPtr;

	if ((r == null) || (r->status !!= RESOLVER_BUSY)) return;

	/* completion routine */
	if (r->hostInfo.rtnCode == noErr) {
		r->status = RESOLVER_SUCCESS;
		r->remoteAddress = hostInfoPtr->addr[0];
	} else {
		r->status = RESOLVER_ERROR;
		r->error = hostInfoPtr->rtnCode;
	}
	signalSemaphoreWithIndex(r->semaIndex);
}

void ResolverTerminate(void) {
	CloseResolver();
	memset(&resolver, 0, sizeof(ResolverStatusRec));
	resolver.status = RESOLVER_UNINITIALIZED;
}

/*** Private TCP Socket Functions ***/

void * TCPSockCreate(void) {
	TCPiopb paramBlock;
	TCPSockPtr s = nil;
	int minRcvBufSize, rcvBufSize;
	OSErr err = noErr;

	rcvBufSize = RecvBufferSize;
	minRcvBufSize = (4 * mtuSize) + 1024;
	if (rcvBufSize < minRcvBufSize) rcvBufSize = minRcvBufSize;
	
	s = (TCPSockPtr) malloc(sizeof(TCPSockRec) + rcvBufSize);
	if (s == nil) return nil;  /* allocation failed */
	memset(s, 0, sizeof(TCPSockRec) + rcvBufSize);

	InitTCPCmd(TCPCreate, nil, &paramBlock);
	paramBlock.csParam.create.rcvBuff = s->rcvBuf;
	paramBlock.csParam.create.rcvBuffLen = rcvBufSize;
	paramBlock.csParam.create.notifyProc = tcpNotifyProc;
	paramBlock.csParam.create.userDataPtr = (Ptr) s;
	err = PBControlSync((ParmBlkPtr) &paramBlock);
	if (err !!= noErr) {
		free(s);
		return nil;
	}
	s->tcpStream = paramBlock.tcpStream;
	return s;
}

int TCPSockDataAvailable(TCPSockPtr s) {
	TCPiopb paramBlock;
	OSErr err = noErr;

	if ((s == nil) || (s->tcpStream == nil)) {
		return false;  /* already destroyed */
	}

	InitTCPCmd(TCPStatus, s->tcpStream, &paramBlock);
	err = PBControlSync((ParmBlkPtr) &paramBlock);
	if (err !!= noErr) {
		return 0;
	}
	return paramBlock.csParam.status.amtUnreadData > 0;
}

void TCPSockDestroy(TCPSockPtr s) {
	TCPiopb paramBlock;
	OSErr err = noErr;

	if ((s == nil) || (s->tcpStream == nil)) {
		return;  /* already destroyed */
	}

	InitTCPCmd(TCPRelease, s->tcpStream, &paramBlock);
	err = PBControlSync((ParmBlkPtr) &paramBlock);
	TCPSockRemoveFromOpenList(s);
	s->tcpStream = nil;
	free(s);
}

int TCPSockLocalAddress(TCPSockPtr s) {
	TCPiopb paramBlock;

	if ((s == nil) || (s->tcpStream == nil)) {
		return 0;  /* already destroyed */
	}

	InitTCPCmd(TCPStatus, s->tcpStream, &paramBlock);
	s->lastError = PBControlSync((ParmBlkPtr) &paramBlock);
	if (s->lastError !!= noErr) {
		return 0;
	}
	return paramBlock.csParam.status.localHost;
}

int TCPSockLocalPort(TCPSockPtr s) {
	TCPiopb paramBlock;

	if ((s == nil) || (s->tcpStream == nil)) {
		return 0;  /* already destroyed */
	}

	InitTCPCmd(TCPStatus, s->tcpStream, &paramBlock);
	s->lastError = PBControlSync((ParmBlkPtr) &paramBlock);
	if (s->lastError !!= noErr) {
		return 0;
	}
	return paramBlock.csParam.status.localPort;
}

int TCPSockRemoteAddress(TCPSockPtr s) {
	TCPiopb paramBlock;

	if ((s == nil) || (s->tcpStream == nil)) {
		return 0;  /* already destroyed */
	}

	InitTCPCmd(TCPStatus, s->tcpStream, &paramBlock);
	s->lastError = PBControlSync((ParmBlkPtr) &paramBlock);
	if (s->lastError !!= noErr) {
		return 0;
	}
	return paramBlock.csParam.status.remoteHost;
}

int TCPSockRemotePort(TCPSockPtr s) {
	TCPiopb paramBlock;

	if ((s == nil) || (s->tcpStream == nil)) {
		return 0;  /* already destroyed */
	}

	InitTCPCmd(TCPStatus, s->tcpStream, &paramBlock);
	s->lastError = PBControlSync((ParmBlkPtr) &paramBlock);
	if (s->lastError !!= noErr) {
		return 0;
	}
	return paramBlock.csParam.status.remotePort;
}

void TCPSockRemoveFromOpenList(TCPSockPtr s) {
	TCPSockPtr thisSock, nextSock, previousSock;

	previousSock = nil;
	for (thisSock = openTCPSockets; thisSock !!= nil; thisSock = nextSock) {
		nextSock = thisSock->next;
		if (thisSock == s) {
			if (previousSock == nil) {
				openTCPSockets = nextSock;
			} else {
				previousSock->next = nextSock;
			}
			break;
		}
		previousSock = thisSock;
	}
}

void TCPSockConnectTo(TCPSockPtr s, int addr, int port) {
	if ((s == nil) || (s->tcpStream == nil)) return;  /* socket destroyed */

	InitTCPCmd(TCPActiveOpen, s->tcpStream, &s->tcpPB);
	s->tcpPB.csParam.open.remoteHost = addr;
	s->tcpPB.csParam.open.remotePort = port;
	s->connectStatus = WaitingForConnection;
	s->tcpPB.ioCompletion = tcpConnectDoneProc;
	s->lastError = PBControlAsync((ParmBlkPtr) &s->tcpPB);
	if (s->lastError !!= noErr) {
		s->connectStatus = Unconnected;
	}
}

void TCPSockListenOn(TCPSockPtr s, int port) {
	if ((s == nil) || (s->tcpStream == nil)) return;  /* socket destroyed */

	InitTCPCmd(TCPPassiveOpen, s->tcpStream, &s->tcpPB);
	s->tcpPB.csParam.open.localPort = port;
	s->connectStatus = WaitingForConnection;
	s->tcpPB.ioCompletion = tcpConnectDoneProc;
	s->lastError = PBControlAsync((ParmBlkPtr) &s->tcpPB);
	if (s->lastError !!= noErr) {
		s->connectStatus = Unconnected;
	}
}

void TCPSockCloseConnection(TCPSockPtr s) {
	/* Note: This operation uses a dedicated parameter block so that it
	   can be invoked even in the previous send is not yet complete.
	   It will eventually use a completion routine to delete the
	   socket automatically. For now, this is the client''s responsibility.
	*/
	if ((s == nil) || (s->tcpStream == nil)) return;  /* socket destroyed */

	InitTCPCmd(TCPClose, s->tcpStream, &s->closePB);
//	s->closePB.ioCompletion = tcpCloseDoneProc;
	s->connectStatus = ThisEndClosed; // xxx remove when making this async
	s->lastError = PBControlSync((ParmBlkPtr) &s->closePB);
}

void TCPSockAbortConnection(TCPSockPtr s) {
	TCPiopb paramBlock;

	if ((s == nil) || (s->tcpStream == nil)) return;  /* socket destroyed */

	InitTCPCmd(TCPAbort, s->tcpStream, &paramBlock);
	s->lastError = PBControlSync((ParmBlkPtr) &paramBlock);
	s->connectStatus = Unconnected;
}

int TCPSockRecvData(TCPSockPtr s, char *buf, int bufSize) {
	TCPiopb paramBlock;  /* use local parameter block since send may be using one in socket */
	OSErr err = noErr;
	int bytesRead;

	if ((s->connectStatus == Unconnected) || (s->connectStatus == WaitingForConnection)) {
		success(false);
		return 0;  /* fail if not connected */
	}
	if (!!TCPSockDataAvailable(s)) return 0;  /* no data available */

	InitTCPCmd(TCPRcv, s->tcpStream, &paramBlock);
	paramBlock.csParam.receive.commandTimeoutValue = 1; /* finish in one second, data or not */
	paramBlock.csParam.receive.rcvBuff = buf;
	paramBlock.csParam.receive.rcvBuffLen = bufSize;
	s->lastError = noErr;
	err = PBControlSync((ParmBlkPtr) &paramBlock);  /* synchronous */
	if (err == noErr) {
		bytesRead = paramBlock.csParam.receive.rcvBuffLen;
	} else {
		/* if err == commandTimeout, no data was available */
		bytesRead = 0;
		if (!!((err == commandTimeout) || (err == connectionClosing))) {
			s->lastError = err;
		}
	}
	s->dataAvailable = (bytesRead !!= 0);  /* if we got data, there may be more */
	return bytesRead;
}

int xxxGOODTCPSockSendData(TCPSockPtr s, char *buf, int bufSize);
int xxxGOODTCPSockSendData(TCPSockPtr s, char *buf, int bufSize) {
	int sendCount;
	struct wdsEntry wds[2];

	buf;  /* xxx avoid compiler complaint about unreferenced vars */

	/* copy client data into sendBuf to allow asynchronous send */
	sendCount = (bufSize <= SendBufferSize) ? bufSize : SendBufferSize;
//xxx	memcpy(s->sendBuf, buf, sendCount);

	/* set up WDS entry; zero length marks end of chunk list */
	wds[0].length = sendCount;
//xxx		wds[0].ptr = s->sendBuf;
	wds[1].length = 0;

	InitTCPCmd(TCPSend, s->tcpStream, &s->tcpPB);
	s->tcpPB.csParam.send.wdsPtr = (Ptr) &wds;
	s->tcpPB.csParam.send.pushFlag = true;
	s->sendInProgress = true;
	s->tcpPB.ioCompletion = tcpSendDoneProc;
	s->lastError = PBControlAsync((ParmBlkPtr) &s->tcpPB);
	if (s->lastError !!= noErr) {
		s->sendInProgress = false;
		return 0;
	}
	return sendCount;
}

int TCPSockSendData(TCPSockPtr s, char *buf, int bufSize) {
	TCPSendBufPtr sendBuf;
	int sendCount;

	if ((s->connectStatus == Unconnected) || (s->connectStatus == WaitingForConnection)) {
		success(false);
		return 0;  /* fail if not connected */
	}

	sendBuf = &sendBufPool[nextSendBuf++];
	if (nextSendBuf >= SendBufCount) nextSendBuf = 0;
	sendBuf->mySocket = s;
	
	/* copy client data into sendBuf to allow asynchronous send */
	sendCount = (bufSize <= SendBufferSize) ? bufSize : SendBufferSize;
	memcpy(sendBuf->data, buf, sendCount);

	/* set up WDS entry; zero length marks end of chunk list */
	sendBuf->wds[0].length = sendCount;
	sendBuf->wds[0].ptr = sendBuf->data;
	sendBuf->wds[1].length = 0;

	InitTCPCmd(TCPSend, s->tcpStream, &sendBuf->tcpPB);
	sendBuf->tcpPB.csParam.send.wdsPtr = (Ptr) &sendBuf->wds;
	sendBuf->tcpPB.csParam.send.pushFlag = true;
	sendBuf->tcpPB.ioCompletion = tcpSendDoneProc;
	s->sendInProgress = true;
	s->lastError = PBControlAsync((ParmBlkPtr) &sendBuf->tcpPB);
	if (s->lastError !!= noErr) {
		s->sendInProgress = false;
		return 0;
	}
	return sendCount;
}

/*** Private General Utilities ***/

void DestroyAllOpenSockets(void) {
	while (openTCPSockets !!= nil) {
		TCPSockDestroy(openTCPSockets);  /* removes socket from the list */
	}
	while (openUDPSockets !!= nil) {
		UDPSockDestroy(openUDPSockets);  /* removes socket from the list */
	}
}

void InstallExitHandler(void) {
	/* Install a handler to release all open sockets when terminating this
	   application. The handler will be called even if you type ''es'' to
	   MacsBug or use Command-Option-Escape for force the program to exit.
	   The handler is only installed the first time the network is initialized.
	*/

	if (oldExitHandlerProc == nil) {
		oldExitHandlerProc = GetToolTrapAddress(_ExitToShell);
		myExitHandlerProc = 
			NewRoutineDescriptor((ProcPtr) MyExitHandler, kPascalStackBased, GetCurrentISA());
		SetToolTrapAddress(myExitHandlerProc, _ExitToShell);
	}
}

void MyExitHandler(void) {
	SetCurrentA5();
	SetToolTrapAddress(oldExitHandlerProc, _ExitToShell);
	ResolverTerminate();
	DestroyAllOpenSockets();
	ExitToShell();
}

int PortNumberValid(int port) {
	if (port < 0xFFFF) {
		return true;
	}
	success(false);
	return false;
}

int SocketValid(SocketPtr s) {
	if ((s !!= NULL) &&
		(s->privateSocketPtr !!= NULL) &&
		(s->sessionID == thisNetSession)) {
			if (s->socketType == TCPSocketType) {
				if (((TCPSockPtr) s->privateSocketPtr)->tcpStream !!= nil) {
					return true;
				}
			}
	}
	success(false);
	return false;
}

/*** Private TCP Utilities ***/

void InitTCPCmd(int cmd, StreamPtr tcpStream, TCPiopb *paramBlkPtr) {
	memset(paramBlkPtr, 0, sizeof(TCPiopb));
	paramBlkPtr->csCode = cmd;
	paramBlkPtr->tcpStream = tcpStream;
	paramBlkPtr->ioCRefNum = macTCPRefNum;
	paramBlkPtr->ioResult = 1;
}

void TCPCloseCompletionRoutine(struct TCPiopb *pbPtr) {
	TCPSockPtr s = (TCPSockPtr) pbPtr;

	s->lastError = s->tcpPB.ioResult;
	if (s->lastError == noErr) {
		if (s->connectStatus == OtherEndClosed) {
			s->connectStatus = Unconnected;
		} else {
			s->connectStatus = ThisEndClosed;
		}
	}
	signalSemaphoreWithIndex(s->semaIndex);
}

void TCPConnectCompletionRoutine(struct TCPiopb *pbPtr) {
	TCPSockPtr s = (TCPSockPtr) pbPtr;

	s->lastError = s->tcpPB.ioResult;
	if (s->lastError == noErr) {
		s->connectStatus = Connected;
	} else {
		s->connectStatus = Unconnected;
	}
	signalSemaphoreWithIndex(s->semaIndex);
}

pascal void TCPNotificationRoutine(
	StreamPtr s, unsigned short eventCode, Ptr userDataPtr,
	unsigned short terminReason, struct ICMPReport *icmpMsg) {
	/* called when data arrives or stream status changes */

	/* reference args to suppress compiler warnings about unused variables */
	s; terminReason; icmpMsg;
	
	if (eventCode == TCPDataArrival) {
		TCPSockPtr tcpSock = (TCPSockPtr) userDataPtr;
		tcpSock->dataAvailable = true;
		signalSemaphoreWithIndex(tcpSock->semaIndex);
		return;
	}
	if (eventCode == TCPClosing) {
		TCPSockPtr tcpSock = (TCPSockPtr) userDataPtr;
		if (tcpSock->connectStatus == ThisEndClosed) {
			tcpSock->connectStatus = Unconnected;
		} else {
			tcpSock->connectStatus = OtherEndClosed;
		}
		signalSemaphoreWithIndex(tcpSock->semaIndex);
		return;
	}
	if (eventCode == TCPTerminate) {
		TCPSockPtr tcpSock = (TCPSockPtr) userDataPtr;
		tcpSock->connectStatus = Unconnected;
		signalSemaphoreWithIndex(tcpSock->semaIndex);
		return;
	}
}

void TCPSendCompletionRoutine(struct TCPiopb *pbPtr) {
//xxx	TCPSockPtr s = (TCPSockPtr) pbPtr;
TCPSockPtr s = ((TCPSendBufPtr) pbPtr)->mySocket;
	
	s->lastError = s->tcpPB.ioResult;
	s->sendInProgress = false;
	signalSemaphoreWithIndex(s->semaIndex);
}

/*** Private UDP Socket Functions ***/

void *		UDPSockCreate(void) {
	// xxx
	return nil;
}

void		UDPSockDestroy(UDPSockPtr s) {
	// xxx
	s;
}

int			UDPSockLocalAddress(UDPSockPtr s) {
	// xxx
	s;
}

int			UDPSockLocalPort(UDPSockPtr s) {
	// xxx
	s;
}

int			UDPSockRemoteAddress(UDPSockPtr s) {
	// xxx
	s;
}

int			UDPSockRemotePort(UDPSockPtr s) {
	// xxx
	s;
}

void		UDPSockConnectTo(UDPSockPtr s, int addr, int port) {
	// xxx
	s; addr; port;
}

void		UDPSockListenOn(UDPSockPtr s, int port) {
	// xxx
	s; port;
}

int			UDPSockRecvData(UDPSockPtr s, char *buf, int bufSize) {
	// xxx
	s; buf; bufSize;
}

int			UDPSockSendData(UDPSockPtr s, char *buf, int bufSize) {
	// xxx
	s; buf; bufSize;
}
'
! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'JW 2/23/2000 09:31'!
macSoundFile

	^ '#include <Sound.h>
#include <SoundInput.h>
#include "sq.h"

/******
  Mac Sound Output Notes:

	The Squeak sound code produces 16-bit, stereo sound buffers. The was
	arrived at after experimentation on a PPC 601 at 110 MHz on which I
	found that:
	  a. using 16-bit sound only slightly increased the background CPU burden and
	  b. 16-bit sound yielded vastly superior sound quality.

	My understanding is that SoundManager 3.0 or later supports the 16-bit
	sound interface an all Macs, even if the hardware only supports 8-bits.
	If this is not true, however, change BYTES_PER_SAMPLE to 1. Then, either
	the Squeak code will need to be changed to use 8-bit sound buffers,
	or (preferrably) snd_PlaySamplesFromAtLength will need to do the conversion
	from 16 to 8 bits. I plan to cross that bridge if and when we need to.
	The code as currently written was to support Squeak code that generated
	8-bit sound buffers.

	In earlier versions, I experimented with other sound buffer formats. Here
	are all the sound buffer formats that were used at one point or another:
		1. mono,    8-bits -- packed array of bytes (not currently used)
		2. stereo,  8-bits -- as above, with L and R channels in alternate bytes (not currently used)
		3. stereo, 16-bits -- array of 32-bit words; with L and R channels in high and low half-words

	Note:  8-bit samples are encoded with 0x80 as the center (zero) value
	Note: 16-bit samples are encoded as standard, signed integers (i.e., 2''s-complement)
	Note: When the sound drive is operating in "mono", the two stereo channels are mixed
	      together. This feature was added in January, 1998.

	-- John Maloney, July 28, 1996
	-- edited: John Maloney, January 5, 1998

  Mac Sound Input Notes:

	Squeak sound input is currently defined to provide a single (mono) stream
	of signed 16-bit samples for all platforms. Platforms that only support
	8-bit sound input should convert samples to signed 16 bit values, leaving
	the low order bits zero. Since the available sampling rates differ from
	platform to platform, the client may not get the requested sampling rate;
	however, the call snd_GetRecordingSampleRate returns the sampling rate.
	On many platforms, simultaneous record and playback is permitted only if
	the input and output sampling rates are the same.

	-- John Maloney, Aug 22, 1997

******/

#define BYTES_PER_SAMPLE 2

/*** double-buffer state record ***/

typedef struct {
	int open;
	int stereo;
	int frameCount;
	int sampleRate;
	int lastFlipTime;
	int playSemaIndex;
	int bufSizeInBytes;
	int bufState0;
	int bufState1;
	int done;
} PlayStateRec;

/*** possible buffer states ***/

#define BUF_EMPTY	0
#define BUF_FULL	1
#define BUF_PLAYING	2

/*** record buffer state record ***/

/* Note: RECORD_BUFFER_SIZE should be a multiple of 4096 bytes to avoid clicking.
   (The clicking was observed on a Mac 8100; the behavior of other Macs could differ.)
   Note: G3 Series Powerbook requires minimum of 4 * 4096 buffer size for stereo.
*/
#define RECORD_BUFFER_SIZE (4096 * 2)
typedef struct {
	SPB paramBlock;
	int stereo;
	int bytesPerSample;
	int recordSemaIndex;
	int readIndex;  /* index of the next sample to read */
	char samples[RECORD_BUFFER_SIZE];
} RecordBufferRec, *RecordBuffer;

/*** sound output variables ***/

SndChannelPtr chan;
PlayStateRec bufState = {false, false, 0, 0, 0, 0, 0, 0, 0, true};
SndDoubleBufferHeader dblBufHeader;

/*** sound input variables ***/

RecordBufferRec recordBuffer1, recordBuffer2;
int recordingInProgress;
long soundInputRefNum;

/*** local functions ***/

pascal void DoubleBack(SndChannelPtr chan, SndDoubleBufferPtr buf);
int FillBufferWithSilence(SndDoubleBufferPtr buf);
pascal void FlipRecordBuffers(SPBPtr pb);
int MixInSamples(int count, char *srcBufPtr, int srcStartIndex, char *dstBufPtr, int dstStartIndex);

pascal void DoubleBack(SndChannelPtr chan, SndDoubleBufferPtr buf) {
  /* Switch buffers (at interrupt time). The given buffer just finished playing. */

	PlayStateRec *state;

	chan;  /* reference argument to avoid compiler warnings */

	state = (PlayStateRec *) buf->dbUserInfo[0];
	if (buf->dbUserInfo[1] == 0) {
		state->bufState0 = BUF_EMPTY;
		state->bufState1 = BUF_PLAYING;
	} else {
		state->bufState0 = BUF_PLAYING;
		state->bufState1 = BUF_EMPTY;
	}

	buf->dbNumFrames = state->frameCount;
	buf->dbFlags = buf->dbFlags | dbBufferReady;
	if (state->done) {
		buf->dbFlags = buf->dbFlags | dbLastBuffer;
	} else {
		signalSemaphoreWithIndex(state->playSemaIndex);
	}
	state->lastFlipTime = ioMicroMSecs();
	FillBufferWithSilence(buf);  /* avoids ugly stutter if not filled in time */
}

int FillBufferWithSilence(SndDoubleBufferPtr buf) {
	unsigned int *sample, *lastSample;

	sample		= (unsigned int *) &buf->dbSoundData[0];
	lastSample	= (unsigned int *) &buf->dbSoundData[bufState.bufSizeInBytes];

	/* word-fill buffer with silence */
	if (BYTES_PER_SAMPLE == 1) {
		while (sample < lastSample) {
			*sample++ = 0x80808080;  /* Note: 0x80 is zero value for 8-bit samples */
		}
	} else {
		while (sample < lastSample) {
			*sample++ = 0;
		}
	}
}

pascal void FlipRecordBuffers(SPBPtr pb) {
	/* called at interrupt time to exchange the active and inactive record buffers */
	RecordBuffer thisBuffer = (RecordBuffer) pb;
	RecordBuffer nextBuffer = (RecordBuffer) pb->userLong;

	if (pb->error == 0) {
		/* restart recording using the other buffer */
		SPBRecord(&nextBuffer->paramBlock, true);

		/* reset the read pointer for the buffer that has just been filled */
		thisBuffer->readIndex = 0;
		signalSemaphoreWithIndex(nextBuffer->recordSemaIndex);
	}
}

/*** exported sound output functions ***/

int snd_AvailableSpace(void) {
	if (!!bufState.open) return -1;
	if ((bufState.bufState0 == BUF_EMPTY) ||
		(bufState.bufState1 == BUF_EMPTY)) {
			return bufState.bufSizeInBytes;
	}
	return 0;
}

int snd_PlaySamplesFromAtLength(int frameCount, int arrayIndex, int startIndex) {
	SndDoubleBufferPtr buf;
	int framesWritten;

	if (!!bufState.open) return -1;

	if (bufState.bufState0 == BUF_EMPTY) {
		buf = dblBufHeader.dbhBufferPtr[0];
		bufState.bufState0 = BUF_FULL;
	} else {
		if (bufState.bufState1 == BUF_EMPTY) {
			buf = dblBufHeader.dbhBufferPtr[1];
			bufState.bufState1 = BUF_FULL;
		} else {
			return 0;  /* neither buffer is available */
		}
	}

	if (bufState.frameCount < frameCount) {
		framesWritten = bufState.frameCount;
	} else {
		framesWritten = frameCount;
	}

	if (BYTES_PER_SAMPLE == 1) {  /* 8-bit samples */
		unsigned char *src, *dst, *end;
		src = (unsigned char *) (arrayIndex + startIndex);
		end = (unsigned char *) src + (framesWritten * (bufState.stereo ? 2 : 1));
		dst = (unsigned char *) &buf->dbSoundData[0];
		while (src < end) {
			*dst++ = *src++;
		}
	} else {  /* 16-bit samples */
		short int *src, *dst, *end;
		src = (short int *) (arrayIndex + (startIndex * 4));
		end = (short int *) (arrayIndex + ((startIndex + framesWritten) * 4));
		dst = (short int *) &buf->dbSoundData[0];
		if (bufState.stereo) {  /* stereo */
			while (src < end) {
				*dst++ = *src++;
			}
		} else {  /* mono */
			/* if mono, average the left and right channels of the source */
			while (src < end) {
				*dst++ = (*src++ + *src++) / 2;
			}
		}
	}
	return framesWritten;
}

int MixInSamples(int count, char *srcBufPtr, int srcStartIndex, char *dstBufPtr, int dstStartIndex) {
	int sample;

	if (BYTES_PER_SAMPLE == 1) {  /* 8-bit samples */
		unsigned char *src, *dst, *end;
		src = (unsigned char *) srcBufPtr + srcStartIndex;
		end = (unsigned char *) srcBufPtr + (count * (bufState.stereo ? 2 : 1));
		dst = (unsigned char *) dstBufPtr + dstStartIndex;
		while (src < end) {
			sample = *dst + (*src++ - 128);
			if (sample > 255) sample = 255;
			if (sample < 0) sample = 0;
			*dst++ = sample;
		}
	} else {  /* 16-bit samples */
		short int *src, *dst, *end;
		src = (short int *) (srcBufPtr + (srcStartIndex * 4));
		end = (short int *) (srcBufPtr + ((srcStartIndex + count) * 4));
		if (bufState.stereo) {  /* stereo */
			dst = (short int *) (dstBufPtr + (dstStartIndex * 4));
			while (src < end) {
				sample = *dst + *src++;
				if (sample > 32767) sample = 32767;
				if (sample < -32767) sample = -32767;
				*dst++ = sample;
			}
		} else {  /* mono */
			/* if mono, average the left and right channels of the source */
			dst = (short int *) (dstBufPtr + (dstStartIndex * 2));
			while (src < end) {
				sample = *dst + ((*src++ + *src++) / 2);
				if (sample > 32767) sample = 32767;
				if (sample < -32767) sample = -32767;
				*dst++ = sample;
			}
		}
	}
}

int snd_InsertSamplesFromLeadTime(int frameCount, int srcBufPtr, int samplesOfLeadTime) {
	SndDoubleBufferPtr bufPlaying, otherBuf;
	int samplesInserted, startSample, count;

	if (!!bufState.open) return -1;

	if (bufState.bufState0 == BUF_PLAYING) {
		bufPlaying = dblBufHeader.dbhBufferPtr[0];
		otherBuf = dblBufHeader.dbhBufferPtr[1];
	} else {
		bufPlaying = dblBufHeader.dbhBufferPtr[1];
		otherBuf = dblBufHeader.dbhBufferPtr[0];
	}

	samplesInserted = 0;

	/* mix as many samples as can fit into the remainder of the currently playing buffer */
	startSample =
		((bufState.sampleRate * (ioMicroMSecs() - bufState.lastFlipTime)) / 1000) + samplesOfLeadTime;
	if (startSample < bufState.frameCount) {
		count = bufState.frameCount - startSample;
		if (count > frameCount) count = frameCount;
		MixInSamples(count, (char *) srcBufPtr, 0, (char *) &bufPlaying->dbSoundData[0], startSample);
		samplesInserted = count;
	}

	/* mix remaining samples into the inactive buffer */
	count = bufState.frameCount;
	if (count > (frameCount - samplesInserted)) {
		count = frameCount - samplesInserted;
	}
	MixInSamples(count, (char *) srcBufPtr, samplesInserted, (char *) &otherBuf->dbSoundData[0], 0);
	return samplesInserted + count;
}

int snd_PlaySilence(void) {
	if (!!bufState.open) return -1;

	if (bufState.bufState0 == BUF_EMPTY) {
		FillBufferWithSilence(dblBufHeader.dbhBufferPtr[0]);
		bufState.bufState0 = BUF_FULL;
	} else {
		if (bufState.bufState1 == BUF_EMPTY) {
			FillBufferWithSilence(dblBufHeader.dbhBufferPtr[1]);
			bufState.bufState1 = BUF_FULL;
		} else {
			return 0;  /* neither buffer is available */
		}
	}
	return bufState.bufSizeInBytes;
}

int snd_Start(int frameCount, int samplesPerSec, int stereo, int semaIndex) {
	OSErr				err;
	SndDoubleBufferPtr	buffer;
	int					bytesPerFrame, bufferBytes, i;

	bytesPerFrame			= stereo ? 2 * BYTES_PER_SAMPLE : BYTES_PER_SAMPLE;
	bufferBytes				= ((frameCount * bytesPerFrame) / 8) * 8;
		/* Note: Must round bufferBytes down to an 8-byte boundary to avoid clicking!!!!!! */

	if (bufState.open) {
		/* still open from last time; clean up before continuing */
		snd_Stop();
	}

	bufState.open			= false;  /* set to true if successful */
	bufState.stereo			= stereo;
	bufState.frameCount		= bufferBytes / bytesPerFrame;
	bufState.sampleRate		= samplesPerSec;
	bufState.lastFlipTime	= ioMicroMSecs();
	bufState.playSemaIndex	= semaIndex;
	bufState.bufSizeInBytes	= bufferBytes;
	bufState.bufState0		= BUF_EMPTY;
	bufState.bufState1		= BUF_EMPTY;
	bufState.done			= false;

	dblBufHeader.dbhNumChannels		= stereo ? 2 : 1;
	dblBufHeader.dbhSampleSize		= BYTES_PER_SAMPLE * 8;
	dblBufHeader.dbhCompressionID	= 0;
	dblBufHeader.dbhPacketSize		= 0;
	dblBufHeader.dbhSampleRate		= samplesPerSec << 16; /* convert to fixed point */
	dblBufHeader.dbhDoubleBack		= NewSndDoubleBackProc(DoubleBack);

	chan = NULL;
	err = SndNewChannel(&chan, sampledSynth, 0, NULL);
	if (err !!= noErr) return false; /* could not open sound channel */

	for (i = 0; i < 2; i++) {
		buffer = (SndDoubleBufferPtr) NewPtrClear(sizeof(SndDoubleBuffer) + bufState.bufSizeInBytes);
		if (buffer == NULL) return false; /* could not allocate memory for a buffer */
		buffer->dbNumFrames		= bufState.frameCount;
		buffer->dbFlags			= dbBufferReady;
		buffer->dbUserInfo[0]	= (long) &bufState;
		buffer->dbUserInfo[1]	= i;
		FillBufferWithSilence(buffer);

		dblBufHeader.dbhBufferPtr[i] = buffer;
	}

	err = SndPlayDoubleBuffer(chan, &dblBufHeader);
	if (err !!= noErr) return false; /* could not play double buffer */

	bufState.open = true;
	return true;
}

int snd_Stop(void) {
	OSErr				err;
	SndDoubleBufferPtr	buffer;
	SCStatus			status;
#ifdef SQUEAKMPW
	long                i;
	unsigned long       junk;
#elif
	long                i, junk;
#endif

	if (!!bufState.open) return;
	bufState.open = false;

	bufState.done = true;
	while (true) {
		err = SndChannelStatus(chan, sizeof(status), &status);
		if (err !!= noErr) break; /* could not get channel status */
		if (!!status.scChannelBusy) break;
		Delay(1, &junk);
	}
	SndDisposeChannel(chan, true);
	DisposeRoutineDescriptor(dblBufHeader.dbhDoubleBack);

	for (i = 0; i < 2; i++) {
		buffer = dblBufHeader.dbhBufferPtr[i];
		if (buffer !!= NULL) {
			DisposePtr((char *) buffer);
		}
		dblBufHeader.dbhBufferPtr[i] = NULL;
	}
	bufState.open = false;
}

/*** exported sound input functions ***/

int snd_SetRecordLevel(int level) {
	/* set the recording level to a value between 0 (minimum gain) and 1000. */
	Fixed inputGainArg;
	int err;

	if (!!recordingInProgress || (level < 0) || (level > 1000)) {
		success(false);
		return;  /* noop if not recording */
	}

	inputGainArg = ((500 + level) << 16) / 1000;  /* gain is Fixed between 0.5 and 1.5 */
	err = SPBSetDeviceInfo(soundInputRefNum, siInputGain, &inputGainArg);
	/* don''t fail on error; hardware may not support setting the gain */
}

int snd_StartRecording(int desiredSamplesPerSec, int stereo, int semaIndex) {
	/* turn on sound recording, trying to use a sampling rate close to
	   the one specified. semaIndex is the index in the exportedObject
	   array of a semaphore to be signalled when input data is available. */
	Str255 deviceName = "";
	short automaticGainControlArg;
	Fixed inputGainArg;
	long  compressionTypeArg;
	short continuousArg;
	short sampleSizeArg;
	short channelCountArg;
	UnsignedFixed sampleRateArg;
	int err;

	err = SPBOpenDevice(deviceName, siWritePermission, &soundInputRefNum);
	if (err !!= noErr) {
		success(false);
		return;
	}

	/* try to initialize some optional parameters, but don''t fail if we can''t */
	automaticGainControlArg = false;
	SPBSetDeviceInfo(soundInputRefNum, siAGCOnOff, &automaticGainControlArg);
	inputGainArg = 1 << 16;  /* 1.0 in Fixed */
	SPBSetDeviceInfo(soundInputRefNum, siInputGain, &inputGainArg);
	compressionTypeArg = ''NONE'';
	SPBSetDeviceInfo(soundInputRefNum, siCompressionType, &compressionTypeArg);

	continuousArg = true;
	err = SPBSetDeviceInfo(soundInputRefNum, siContinuous, &continuousArg);
	if (err !!= noErr) {
		success(false);
		SPBCloseDevice(soundInputRefNum);
		return;
	}

	sampleSizeArg = 16;
	err = SPBSetDeviceInfo(soundInputRefNum, siSampleSize, &sampleSizeArg);
	if (err !!= noErr) {
		/* use 8-bit samples */
		sampleSizeArg = 8;
		err = SPBSetDeviceInfo(soundInputRefNum, siSampleSize, &sampleSizeArg);
		if (err !!= noErr) {
			success(false);
			SPBCloseDevice(soundInputRefNum);
			return;
		}
	}

	channelCountArg = stereo ? 2 : 1;
	err = SPBSetDeviceInfo(soundInputRefNum, siNumberChannels, &channelCountArg);
	if (err !!= noErr) {
		success(false);
		SPBCloseDevice(soundInputRefNum);
		return;
	}

	/* try to set the client''s desired sample rate */
	sampleRateArg = desiredSamplesPerSec << 16;
	err = SPBSetDeviceInfo(soundInputRefNum, siSampleRate, &sampleRateArg);
	if (err !!= noErr) {
		/* if client''s rate fails, try the nearest common sampling rates in {11025, 22050, 44100} */
		if (desiredSamplesPerSec <= 16538) {
			sampleRateArg = 11025 << 16;
		} else {
			if (desiredSamplesPerSec <= 33075) {
				sampleRateArg = 22050 << 16;
			} else {
				sampleRateArg = 44100 << 16;
			}
		}
		/* even if following fails, recording can go on at the default sample rate */
		SPBSetDeviceInfo(soundInputRefNum, siSampleRate, &sampleRateArg);
	}

	recordBuffer1.paramBlock.inRefNum = soundInputRefNum;
	recordBuffer1.paramBlock.count = RECORD_BUFFER_SIZE;
	recordBuffer1.paramBlock.milliseconds = 0;
	recordBuffer1.paramBlock.bufferLength = RECORD_BUFFER_SIZE;
	recordBuffer1.paramBlock.bufferPtr = recordBuffer1.samples;
	recordBuffer1.paramBlock.completionRoutine = NewSICompletionProc(FlipRecordBuffers);
	recordBuffer1.paramBlock.interruptRoutine = nil;
	recordBuffer1.paramBlock.userLong = (long) &recordBuffer2;  /* pointer to other buffer */
	recordBuffer1.paramBlock.error = noErr;
	recordBuffer1.paramBlock.unused1 = 0;
	recordBuffer1.stereo = stereo;
	recordBuffer1.bytesPerSample = sampleSizeArg == 8 ? 1 : 2;
	recordBuffer1.recordSemaIndex = semaIndex;
	recordBuffer1.readIndex = RECORD_BUFFER_SIZE;

	recordBuffer2.paramBlock.inRefNum = soundInputRefNum;
	recordBuffer2.paramBlock.count = RECORD_BUFFER_SIZE;
	recordBuffer2.paramBlock.milliseconds = 0;
	recordBuffer2.paramBlock.bufferLength = RECORD_BUFFER_SIZE;
	recordBuffer2.paramBlock.bufferPtr = recordBuffer2.samples;
	recordBuffer2.paramBlock.completionRoutine = NewSICompletionProc(FlipRecordBuffers);
	recordBuffer2.paramBlock.interruptRoutine = nil;
	recordBuffer2.paramBlock.userLong = (long) &recordBuffer1;  /* pointer to other buffer */
	recordBuffer2.paramBlock.error = noErr;
	recordBuffer2.paramBlock.unused1 = 0;
	recordBuffer2.stereo = stereo;
	recordBuffer2.bytesPerSample = sampleSizeArg == 8 ? 1 : 2;
	recordBuffer2.recordSemaIndex = semaIndex;
	recordBuffer2.readIndex = RECORD_BUFFER_SIZE;

	err = SPBRecord(&recordBuffer1.paramBlock, true);
	if (err !!= noErr) {
		success(false);
		SPBCloseDevice(soundInputRefNum);
		return;
	}

	recordingInProgress = true;
}

int snd_StopRecording(void) {
	/* turn off sound recording */
	int err;

	if (!!recordingInProgress) return;  /* noop if not recording */

	err = SPBStopRecording(soundInputRefNum);
	if (err !!= noErr) success(false);
	SPBCloseDevice(soundInputRefNum);

	DisposeRoutineDescriptor(recordBuffer1.paramBlock.completionRoutine);
	recordBuffer1.paramBlock.completionRoutine = nil;
	DisposeRoutineDescriptor(recordBuffer2.paramBlock.completionRoutine);
	recordBuffer2.paramBlock.completionRoutine = nil;

	recordBuffer1.recordSemaIndex = 0;
	recordBuffer2.recordSemaIndex = 0;
	recordingInProgress = false;
}

double snd_GetRecordingSampleRate(void) {
	/* return the actual recording rate; fail if not currently recording */
	UnsignedFixed sampleRateArg;
	int err;

	if (!!recordingInProgress) {
		success(false);
		return 0.0;
	}

	err = SPBGetDeviceInfo(soundInputRefNum, siSampleRate, &sampleRateArg);
	if (err !!= noErr) {
		success(false);
		return 0.0;
	}
	return  (double) ((sampleRateArg >> 16) & 0xFFFF) +
			((double) (sampleRateArg & 0xFFFF) / 65536.0);
}

int snd_RecordSamplesIntoAtLength(int buf, int startSliceIndex, int bufferSizeInBytes) {
	/* if data is available, copy as many sample slices as possible into the
	   given buffer starting at the given slice index. do not write past the
	   end of the buffer, which is buf + bufferSizeInBytes. return the number
	   of slices (not bytes) copied. a slice is one 16-bit sample in mono
	   or two 16-bit samples in stereo. */
	int bytesPerSlice = (recordBuffer1.stereo ? 4 : 2);
	char *nextBuf = (char *) buf + (startSliceIndex * bytesPerSlice);
	char *bufEnd = (char *) buf + bufferSizeInBytes;
	char *src, *srcEnd;
	RecordBuffer recBuf = nil;
	int bytesCopied;

	if (!!recordingInProgress) {
		success(false);
		return 0;
	}

	/* select the buffer with unread samples, if any */
	recBuf = nil;
	if (recordBuffer1.readIndex < RECORD_BUFFER_SIZE) recBuf = &recordBuffer1;
	if (recordBuffer2.readIndex < RECORD_BUFFER_SIZE) recBuf = &recordBuffer2;
	if (recBuf == nil) return 0;  /* no samples available */

	/* copy samples into the client''s buffer */
	src = &recBuf->samples[0] + recBuf->readIndex;
	srcEnd = &recBuf->samples[RECORD_BUFFER_SIZE];
	if (recBuf->bytesPerSample == 1) {
		while ((src < srcEnd) && (nextBuf < bufEnd)) {
			/* convert 8-bit sample to 16-bit sample */
			*nextBuf++ = (*src++) - 128;  /* convert from [0-255] to [-128-127] */
			*nextBuf++ = 0;  /* low-order byte is zero */
		}
	} else {
		while ((src < srcEnd) && (nextBuf < bufEnd)) {
			*nextBuf++ = *src++;
		}
	}
	recBuf->readIndex = src - &recBuf->samples[0];  /* update read index */

	/* return the number of slices copied */
	bytesCopied = (int) nextBuf - (buf + (startSliceIndex * bytesPerSlice));
	return bytesCopied / bytesPerSlice;
}
'
! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'JW 2/23/2000 09:33'!
macWindowFile

	^ '#ifndef SQUEAKMPW
#include <MacHeaders.h>
#endif

#include <AppleEvents.h>
#include <Dialogs.h>
#include <Devices.h>
#include <Files.h>
#include <Fonts.h>
#include <Gestalt.h>
#include <LowMem.h>
#include <Memory.h>
#include <Menus.h>
#include <OSUtils.h>
#include <Power.h>
#include <QuickDraw.h>
#include <Scrap.h>
#include <Strings.h>
#include <Timer.h>
#include <ToolUtils.h>
#include <Windows.h>
#ifndef SQUEAKMPW
#include <profiler.h>
#endif

#ifdef SQUEAKMPW
	static QDGlobals    qd;
#endif

#include "sq.h"

/*** Compilation Options:
*
*	define PLUGIN		to compile code for Netscape Plug-in
*	define MAKE_PROFILE	to compile code for profiling
*
***/

//#define PLUGIN
//#define MAKE_PROFILE

/*** Enumerations ***/
enum { appleID = 1, fileID, editID };
enum { quitItem = 1 };

/*** Variables -- Imported from Virtual Machine ***/
extern int fullScreenFlag;
extern int interruptCheckCounter;
extern int interruptKeycode;
extern int interruptPending;  /* set to true by recordKeystroke if interrupt key is pressed */
extern unsigned char *memory;
extern int savedWindowSize;   /* set from header when image file is loaded */

/*** Variables -- image and path names ***/
#define IMAGE_NAME_SIZE 300
char imageName[IMAGE_NAME_SIZE + 1];  /* full path to image */

#define SHORTIMAGE_NAME_SIZE 100
char shortImageName[SHORTIMAGE_NAME_SIZE + 1];  /* just the image file name */

#define DOCUMENT_NAME_SIZE 300
char documentName[DOCUMENT_NAME_SIZE + 1];  /* full path to document or image file */

#define SHORTDOCUMENT_NAME_SIZE 100
char shortDocumentName[SHORTDOCUMENT_NAME_SIZE + 1];  /* just the document file name */

#define VMPATH_SIZE 300
char vmPath[VMPATH_SIZE + 1];  /* full path to interpreter''s directory */

/*** Variables -- Mac Related ***/
MenuHandle		appleMenu = nil;
Handle			clipboardBuffer = nil;
MenuHandle		editMenu = nil;
int				menuBarHeight = 20;
RgnHandle		menuBarRegion = nil;  /* if non-nil, then menu bar has been hidden */
MenuHandle		fileMenu = nil;
CTabHandle		stColorTable = nil;
PixMapHandle	stPixMap = nil;
WindowPtr		stWindow = nil;


/*** Variables -- Event Recording ***/
#define KEYBUF_SIZE 64
int keyBuf[KEYBUF_SIZE];	/* circular buffer */
int keyBufGet = 0;			/* index of next item of keyBuf to read */
int keyBufPut = 0;			/* index of next item of keyBuf to write */
int keyBufOverflows = 0;	/* number of characters dropped */

int buttonState = 0;		/* mouse button and modifier state when mouse
							   button went down or 0 if not pressed */

Point savedMousePosition;	/* mouse position when window is inactive */
int windowActive = true;	/* true if the Squeak window is the active window */

/* This table maps the 5 Macintosh modifier key bits to 4 Squeak modifier
   bits. (The Mac shift and caps lock keys are both mapped to the single
   Squeak shift bit).
		Mac bits: <control><option><caps lock><shift><command>
		ST bits:  <command><option><control><shift>
*/
char modifierMap[32] = {
	0,  8, 1,  9, 1,  9, 1,  9, 4, 12, 5, 13, 5, 13, 5, 13,
	2, 10, 3, 11, 3, 11, 3, 11, 6, 14, 7, 15, 7, 15, 7, 15
};

/*** Functions ***/
void AdjustMenus(void);
void FreeClipboard(void);
void FreePixmap(void);
char * GetAttributeString(int id);
int  HandleEvents(void);
void HandleMenu(int mSelect);
void HandleMouseDown(EventRecord *theEvent);
void InitMacintosh(void);
void InstallAppleEventHandlers(void);
int  IsImageName(char *name);
void MenuBarHide(void);
void MenuBarRestore(void);
void SetColorEntry(int index, int red, int green, int blue);
void SetUpClipboard(void);
void SetUpMenus(void);
void SetUpPixmap(void);
void SetUpWindow(void);
void SetWindowTitle(char *title);
void StoreFullPathForLocalNameInto(char *shortName, char *fullName, int length);

/* event capture */
int recordKeystroke(EventRecord *theEvent);
int recordModifierButtons(EventRecord *theEvent);
int recordMouseDown(EventRecord *theEvent);

/*** Apple Event Handlers ***/
static pascal OSErr HandleOpenAppEvent(AEDescList *aevt, AEDescList *reply, int refCon);
static pascal OSErr HandleOpenDocEvent(AEDescList *aevt, AEDescList *reply, int refCon);
static pascal OSErr HandlePrintDocEvent(AEDescList *aevt, AEDescList *reply, int refCon);
static pascal OSErr HandleQuitAppEvent(AEDescList *aevt, AEDescList *reply, int refCon);

/*** Apple Event Handling ***/

void InstallAppleEventHandlers() {
	OSErr	err;
	long	result;

	shortImageName[0] = 0;
	err = Gestalt(gestaltAppleEventsAttr, &result);
	if (err == noErr) {
		AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, NewAEEventHandlerProc(HandleOpenAppEvent),  0, false);
		AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments,   NewAEEventHandlerProc(HandleOpenDocEvent),  0, false);
		AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments,  NewAEEventHandlerProc(HandlePrintDocEvent), 0, false);
		AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, NewAEEventHandlerProc(HandleQuitAppEvent),  0, false);
	}
}

pascal OSErr HandleOpenAppEvent(AEDescList *aevt, AEDescList *reply, int refCon) {
	/* User double-clicked application; look for "squeak.image" in same directory */

	aevt; reply; refCon;  /* reference args to avoid compiler warnings */

	/* record path to VM''s home folder */
	dir_PathToWorkingDir(vmPath, VMPATH_SIZE);

	/* use default image name in same directory as the VM */
	strcpy(shortImageName, "squeak.image");
	return noErr;
}

pascal OSErr HandleOpenDocEvent(AEDescList *aevt, AEDescList *reply, int refCon) {
	/* User double-clicked an image file. Record the path to the VM''s directory,
	   then set the default directory to the folder containing the image and
	   record the image name. Fail if mullitple image files were selected. */

	OSErr		err;
	AEDesc		fileList = {''NULL'', NULL};
	long		numFiles, size;
	DescType	type;
	AEKeyword	keyword;
	FSSpec		fileSpec;
	WDPBRec		pb;

	reply; refCon;  /* reference args to avoid compiler warnings */

	/* record path to VM''s home folder */
	dir_PathToWorkingDir(vmPath, VMPATH_SIZE);

	/* copy document list */
	err = AEGetKeyDesc(aevt, keyDirectObject, typeAEList, &fileList);
	if (err) goto done;

	/* count list elements */
	err = AECountItems( &fileList, &numFiles);
	if (err) goto done;
	if (numFiles !!= 1) {
		error("You may only open one Squeak image or document file at a time.");
	}

	/* get image name */
	err = AEGetNthPtr(&fileList, 1, typeFSS,
					  &keyword, &type, (Ptr) &fileSpec, sizeof(fileSpec), &size);
	if (err) goto done;
	strcpy(shortImageName, p2cstr(fileSpec.name));

	if (!!IsImageName(shortImageName)) {
		/* record the document name, but run the default image in VM directory */
		strcpy(shortDocumentName, shortImageName);
		strcpy(shortImageName, "squeak.image");
		StoreFullPathForLocalNameInto(shortImageName, imageName, IMAGE_NAME_SIZE);
	}
	/* make the image or document directory the working directory */
	pb.ioNamePtr = NULL;
	pb.ioVRefNum = fileSpec.vRefNum;
	pb.ioWDDirID = fileSpec.parID;
	PBHSetVolSync(&pb);

	if (shortDocumentName[0] !!= 0) {
		/* record the document''s full name */
		StoreFullPathForLocalNameInto(shortDocumentName, documentName, DOCUMENT_NAME_SIZE);
	}

done:
	AEDisposeDesc(&fileList);
	return err;
}

pascal OSErr HandlePrintDocEvent(AEDescList *aevt, AEDescList *reply, int refCon) {
	aevt; reply; refCon;  /* reference args to avoid compiler warnings */
	return errAEEventNotHandled;
}

pascal OSErr HandleQuitAppEvent(AEDescList *aevt, AEDescList *reply, int refCon) {
	aevt; reply; refCon;  /* reference args to avoid compiler warnings */
	return errAEEventNotHandled;
}

/*** VM Home Directory Path ***/

int vmPathSize(void) {
	return strlen(vmPath);
}

int vmPathGetLength(int sqVMPathIndex, int length) {
	char *stVMPath = (char *) sqVMPathIndex;
	int count, i;

	count = strlen(vmPath);
	count = (length < count) ? length : count;

	/* copy the file name into the Squeak string */
	for (i = 0; i < count; i++) {
		stVMPath[i] = vmPath[i];
	}
	return count;
}

/*** Mac-related Functions ***/

void AdjustMenus(void) {
	WindowPeek		wp;
	int				isDeskAccessory;

	wp = (WindowPeek) FrontWindow();
	if (wp !!= NULL) {
		isDeskAccessory = (wp->windowKind < 0);
	} else {
		isDeskAccessory = false;
	}

	if (isDeskAccessory) {
		/* Enable items in the Edit menu */
		EnableItem(editMenu, 1);
		EnableItem(editMenu, 3);
		EnableItem(editMenu, 4);
		EnableItem(editMenu, 5);
		EnableItem(editMenu, 6);
	} else {
		/* Disable items in the Edit menu */
		DisableItem(editMenu, 1);
		DisableItem(editMenu, 3);
		DisableItem(editMenu, 4);
		DisableItem(editMenu, 5);
		DisableItem(editMenu, 6);
	}
}

int HandleEvents(void) {
	EventRecord		theEvent;
	int				ok;

	SystemTask();
	ok = GetNextEvent(everyEvent, &theEvent);
	if (ok) {
		switch (theEvent.what) {
			case mouseDown:
				HandleMouseDown(&theEvent);
				return false;
			break;

			case mouseUp:
				recordModifierButtons(&theEvent);
				return false;
			break;

			case keyDown:
			case autoKey:
				if ((theEvent.modifiers & cmdKey) !!= 0) {
					AdjustMenus();
					HandleMenu(MenuKey(theEvent.message & charCodeMask));
				}
				recordModifierButtons(&theEvent);
				recordKeystroke(&theEvent);
			break;

			case updateEvt:
				BeginUpdate(stWindow);
				fullDisplayUpdate();  /* this makes VM call ioShowDisplay */
				EndUpdate(stWindow);
			break;

			case activateEvt:
				if (theEvent.modifiers & activeFlag) {
					windowActive = true;
				} else {
					GetMouse(&savedMousePosition);
					windowActive = false;
				}
				InvalRect(&stWindow->portRect);
			break;

			case kHighLevelEvent:
				AEProcessAppleEvent(&theEvent);
			break;
		}
	}
	return ok;
}

void HandleMenu(int mSelect) {
	int			menuID, menuItem;
	Str255		name;
	GrafPtr		savePort;

	menuID = HiWord(mSelect);
	menuItem = LoWord(mSelect);
	switch (menuID) {
		case appleID:
			GetPort(&savePort);
			GetMenuItemText(appleMenu, menuItem, name);
			OpenDeskAcc(name);
			SetPort(savePort);
		break;

		case fileID:
			if (menuItem == quitItem) {
				ioExit();
			}
		break;

		case editID:
			if (!!SystemEdit(menuItem - 1)) {
				SysBeep(5);
			}
		break;
	}
}

void HandleMouseDown(EventRecord *theEvent) {
	WindowPtr	theWindow;
	Rect		growLimits = { 20, 20, 4000, 4000 };
	Rect		dragBounds;
	int			windowCode, newSize;

	windowCode = FindWindow(theEvent->where, &theWindow);
	switch (windowCode) {
		case inSysWindow:
			SystemClick(theEvent, theWindow);
		break;

		case inMenuBar:
			AdjustMenus();
			HandleMenu(MenuSelect(theEvent->where));
		break;

		case inDrag:
			dragBounds = qd.screenBits.bounds;
			if (theWindow == stWindow) {
				DragWindow(stWindow, theEvent->where, &dragBounds);
			}
		break;

		case inGrow:
			if (theWindow == stWindow) {
				newSize = GrowWindow(stWindow, theEvent->where, &growLimits);
				if (newSize !!= 0) {
					SizeWindow(stWindow, LoWord(newSize), HiWord(newSize), true);
				}
			}
		break;

		case inContent:
			if (theWindow == stWindow) {
				if (theWindow !!= FrontWindow()) {
					SelectWindow(stWindow);
				}
				recordMouseDown(theEvent);
			}
		break;

		case inGoAway:
			if ((theWindow == stWindow) &&
				(TrackGoAway(stWindow, theEvent->where))) {
					/* HideWindow(stWindow); noop for now */
			}
		break;
	}
}

void InitMacintosh(void) {
	MaxApplZone();
	InitGraf(&qd.thePort);
	InitFonts();
	FlushEvents(everyEvent, 0);
	InitWindows();
	InitMenus();
	TEInit();
	InitDialogs(NULL);
	InitCursor();
}

void MenuBarHide(void) {
  /* Remove the menu bar, saving its old state. */
  /* Many thanks to John McIntosh for this code!! */
	Rect screenRect, mBarRect;

	if (menuBarRegion !!= nil) return;  /* saved state, so menu bar is already hidden */
	screenRect = (**GetMainDevice()).gdRect;
	menuBarHeight = GetMBarHeight();
	SetRect(&mBarRect, screenRect.left, screenRect.top, screenRect.right, screenRect.top + menuBarHeight);
	menuBarRegion = NewRgn();
	if (menuBarRegion !!= nil) {
		LMSetMBarHeight(0);
		RectRgn(menuBarRegion, &mBarRect);
		UnionRgn(LMGetGrayRgn(), menuBarRegion, LMGetGrayRgn());
	}
}

void MenuBarRestore(void) {
  /* Restore the menu bar from its saved state. Do nothing if it isn''t hidden. */
  /* Many thanks to John McIntosh for this code!! */
 
	if (menuBarRegion == nil) return;  /* no saved state, so menu bar is not hidden */
	DiffRgn(LMGetGrayRgn(), menuBarRegion, LMGetGrayRgn());
	LMSetMBarHeight(menuBarHeight);
	DisposeRgn(menuBarRegion);
	menuBarRegion = nil;
	DrawMenuBar();
}

void SetUpMenus(void) {
	InsertMenu(appleMenu = NewMenu(appleID, "\p\024"), 0);
	InsertMenu(fileMenu  = NewMenu(fileID,  "\pFile"), 0);
	InsertMenu(editMenu  = NewMenu(editID,  "\pEdit"), 0);
	DrawMenuBar();
	AppendResMenu(appleMenu, ''DRVR'');
	AppendMenu(fileMenu, "\pQuit");
	AppendMenu(editMenu, "\pUndo/Z;(-;Cut/X;Copy/C;Paste/V;Clear");
}

void SetColorEntry(int index, int red, int green, int blue) {
	(*stColorTable)->ctTable[index].value = index;
	(*stColorTable)->ctTable[index].rgb.red = red;
	(*stColorTable)->ctTable[index].rgb.green = green;
	(*stColorTable)->ctTable[index].rgb.blue = blue;
}

void FreePixmap(void) {
	if (stPixMap !!= nil) {
		DisposePixMap(stPixMap);
		stPixMap = nil;
	}

	if (stColorTable !!= nil) {
		DisposeHandle((void *) stColorTable);
		stColorTable = nil;
	}
}

void SetUpPixmap(void) {
	int i, r, g, b;

	stColorTable = (CTabHandle) NewHandle(sizeof(ColorTable) + (256 * sizeof(ColorSpec)));
	(*stColorTable)->ctSeed = GetCTSeed();
	(*stColorTable)->ctFlags = 0;
	(*stColorTable)->ctSize = 255;

	/* 1-bit colors (monochrome) */
	SetColorEntry(0, 65535, 65535, 65535);	/* white or transparent */
	SetColorEntry(1,     0,     0,     0);	/* black */

	/* additional colors for 2-bit color */
	SetColorEntry(2, 65535, 65535, 65535);	/* opaque white */
	SetColorEntry(3, 32768, 32768, 32768);	/* 1/2 gray */

	/* additional colors for 4-bit color */
	SetColorEntry( 4, 65535,     0,     0);	/* red */
	SetColorEntry( 5,     0, 65535,     0);	/* green */
	SetColorEntry( 6,     0,     0, 65535);	/* blue */
	SetColorEntry( 7,     0, 65535, 65535);	/* cyan */
	SetColorEntry( 8, 65535, 65535,     0);	/* yellow */
	SetColorEntry( 9, 65535,     0, 65535);	/* magenta */
	SetColorEntry(10,  8192,  8192,  8192);	/* 1/8 gray */
	SetColorEntry(11, 16384, 16384, 16384);	/* 2/8 gray */
	SetColorEntry(12, 24576, 24576, 24576);	/* 3/8 gray */
	SetColorEntry(13, 40959, 40959, 40959);	/* 5/8 gray */
	SetColorEntry(14, 49151, 49151, 49151);	/* 6/8 gray */
	SetColorEntry(15, 57343, 57343, 57343);	/* 7/8 gray */

	/* additional colors for 8-bit color */
	/* 24 more shades of gray (does not repeat 1/8th increments) */
	SetColorEntry(16,  2048,  2048,  2048);	/*  1/32 gray */
	SetColorEntry(17,  4096,  4096,  4096);	/*  2/32 gray */
	SetColorEntry(18,  6144,  6144,  6144);	/*  3/32 gray */
	SetColorEntry(19, 10240, 10240, 10240);	/*  5/32 gray */
	SetColorEntry(20, 12288, 12288, 12288);	/*  6/32 gray */
	SetColorEntry(21, 14336, 14336, 14336);	/*  7/32 gray */
	SetColorEntry(22, 18432, 18432, 18432);	/*  9/32 gray */
	SetColorEntry(23, 20480, 20480, 20480);	/* 10/32 gray */
	SetColorEntry(24, 22528, 22528, 22528);	/* 11/32 gray */
	SetColorEntry(25, 26624, 26624, 26624);	/* 13/32 gray */
	SetColorEntry(26, 28672, 28672, 28672);	/* 14/32 gray */
	SetColorEntry(27, 30720, 30720, 30720);	/* 15/32 gray */
	SetColorEntry(28, 34815, 34815, 34815);	/* 17/32 gray */
	SetColorEntry(29, 36863, 36863, 36863);	/* 18/32 gray */
	SetColorEntry(30, 38911, 38911, 38911);	/* 19/32 gray */
	SetColorEntry(31, 43007, 43007, 43007);	/* 21/32 gray */
	SetColorEntry(32, 45055, 45055, 45055);	/* 22/32 gray */
	SetColorEntry(33, 47103, 47103, 47103);	/* 23/32 gray */
	SetColorEntry(34, 51199, 51199, 51199);	/* 25/32 gray */
	SetColorEntry(35, 53247, 53247, 53247);	/* 26/32 gray */
	SetColorEntry(36, 55295, 55295, 55295);	/* 27/32 gray */
	SetColorEntry(37, 59391, 59391, 59391);	/* 29/32 gray */
	SetColorEntry(38, 61439, 61439, 61439);	/* 30/32 gray */
	SetColorEntry(39, 63487, 63487, 63487);	/* 31/32 gray */

	/* The remainder of color table defines a color cube with six steps
	   for each primary color. Note that the corners of this cube repeat
	   previous colors, but simplifies the mapping between RGB colors and
	   color map indices. This color cube spans indices 40 through 255.
	*/
	for (r = 0; r < 6; r++) {
		for (g = 0; g < 6; g++) {
			for (b = 0; b < 6; b++) {
				i = 40 + ((36 * r) + (6 * b) + g);
				if (i > 255) error("index out of range in color table compuation");
				SetColorEntry(i, (r * 65535) / 5, (g * 65535) / 5, (b * 65535) / 5);
			}
		}
	}

	stPixMap = NewPixMap();
	(*stPixMap)->pixelType = 0; /* chunky */
	(*stPixMap)->cmpCount = 1;
	(*stPixMap)->pmTable = stColorTable;
}

void SetUpWindow(void) {
	Rect windowBounds = {44, 8, 300, 500};

	stWindow = NewCWindow(
		0L, &windowBounds,
		"\p Welcome to Squeak!!  Reading Squeak image file... ",
		true, documentProc, (WindowPtr) -1L, true, 0);
}

void SetWindowTitle(char *title) {
	SetWTitle(stWindow, c2pstr(title));
	p2cstr((unsigned char *) title);
}

/*** Event Recording Functions ***/

int recordKeystroke(EventRecord *theEvent) {
	int asciiChar, modifierBits, keystate;

	/* keystate: low byte is the ascii character; next 4 bits are modifier bits */
	asciiChar = theEvent->message & 0xFF;
	modifierBits = modifierMap[(theEvent->modifiers >> 8) & 0x1F];
	if ((modifierBits & 0x9) == 0x9) {  /* command and shift */
		if ((asciiChar >= 97) && (asciiChar <= 122)) {
			/* convert ascii code of command-shift-letter to upper case */
			asciiChar = asciiChar - 32;
		}
	}

	keystate = (modifierBits << 8) | asciiChar;
	if (keystate == interruptKeycode) {
		/* Note: interrupt key is "meta"; it not reported as a keystroke */
		interruptPending = true;
		interruptCheckCounter = 0;
	} else {
		keyBuf[keyBufPut] = keystate;
		keyBufPut = (keyBufPut + 1) % KEYBUF_SIZE;
		if (keyBufGet == keyBufPut) {
			/* buffer overflow; drop the last character */
			keyBufGet = (keyBufGet + 1) % KEYBUF_SIZE;
			keyBufOverflows++;
		}
	}
}

int recordMouseDown(EventRecord *theEvent) {
	int stButtons;

	stButtons = 4;		/* red button by default */
	if ((theEvent->modifiers & optionKey) !!= 0) {
		stButtons = 2;	/* yellow button if option down */
	}
	if ((theEvent->modifiers & cmdKey) !!= 0) {
		stButtons = 1;	/* blue button if command down */
	}
	/* button state: low three bits are mouse buttons; next 4 bits are modifier bits */
	buttonState =
		(modifierMap[(theEvent->modifiers >> 8) & 0x1F] << 3) |
		(stButtons & 0x7);
}

int recordModifierButtons(EventRecord *theEvent) {
	int stButtons = 0;

	if (Button()) {
		stButtons = buttonState & 0x7;
	} else {
		stButtons = 0;
	}
	/* button state: low three bits are mouse buttons; next 4 bits are modifier bits */
	buttonState =
		(modifierMap[(theEvent->modifiers >> 8) & 0x1F] << 3) |
		(stButtons & 0x7);
}

/*** I/O Primitives ***/

int ioBeep(void) {
	SysBeep(1000);
}

int ioExit(void) {
	serialPortClose(0);
	serialPortClose(1);
	sqNetworkShutdown();
	MenuBarRestore();
	ExitToShell();
}

int ioForceDisplayUpdate(void) {
	/* do nothing on a Mac */
}

int ioFormPrint(int bitsAddr, int width, int height, int depth, double hScale, double vScale, int landscapeFlag) {
	/* experimental: print a form with the given bitmap, width, height, and depth at
	   the given horizontal and vertical scales in the given orientation */
	printf("ioFormPrint width %d height %d depth %d hScale %f vScale %f landscapeFlag %d\n",
		width, height, depth, hScale, vScale, landscapeFlag);
	bitsAddr;
	return true;
}

int ioGetButtonState(void) {
	ioProcessEvents();  /* process all pending events */
	return buttonState;
}

int ioGetKeystroke(void) {
	int keystate;

	ioProcessEvents();  /* process all pending events */
	if (keyBufGet == keyBufPut) {
		return -1;  /* keystroke buffer is empty */
	} else {
		keystate = keyBuf[keyBufGet];
		keyBufGet = (keyBufGet + 1) % KEYBUF_SIZE;
		/* set modifer bits in buttonState to reflect the last keystroke fetched */
		buttonState = ((keystate >> 5) & 0xF8) | (buttonState & 0x7);
	}
	return keystate;
}

int ioHasDisplayDepth(int depth) {
	/* Return true if this platform supports the given color display depth. */

	switch (depth) {
	case 1:
	case 2:
	case 4:
	case 8:
	case 16:
	case 32:
		return true;
	}
	return false;
}

int ioMicroMSecs(void) {
	/* millisecond clock based on microsecond timer (about 60 times slower than clock()!!!!) */
	/* Note: This function and ioMSecs() both return a time in milliseconds. The difference
	   is that ioMicroMSecs() is called only when precise millisecond resolution is essential,
	   and thus it can use a more expensive timer than ioMSecs, which is called frequently.
	   However, later VM optimizations reduced the frequency of calls to ioMSecs to the point
	   where clock performance became less critical, and we also started to want millisecond-
	   resolution timers for real time applications such as music. Thus, on the Mac, we''ve
	   opted to use the microsecond clock for both ioMSecs() and ioMicroMSecs(). */
	UnsignedWide microTicks;

	Microseconds(&microTicks);
	return (microTicks.lo / 1000) + (microTicks.hi * 4294967);
}

int ioMSecs(void) {
	/* return a time in milliseconds for use in Delays and Time millisecondClockValue */
	/* Note: This was once a macro based on clock(); it now uses the microsecond clock for
	   greater resolution. See the comment in ioMicroMSecs(). */
	UnsignedWide microTicks;

	Microseconds(&microTicks);
	return (microTicks.lo / 1000) + (microTicks.hi * 4294967);
}

int ioMousePoint(void) {
	Point p;

	ioProcessEvents();  /* process all pending events */
	if (windowActive) {
		GetMouse(&p);
	} else {
		/* don''t report mouse motion if window is not active */
		p = savedMousePosition;
	}
	return (p.h << 16) | (p.v & 0xFFFF);  /* x is high 16 bits; y is low 16 bits */
}

int ioPeekKeystroke(void) {
	int keystate;

	ioProcessEvents();  /* process all pending events */
	if (keyBufGet == keyBufPut) {
		return -1;  /* keystroke buffer is empty */
	} else {
		keystate = keyBuf[keyBufGet];
		/* set modifer bits in buttonState to reflect the last keystroke peeked at */
		buttonState = ((keystate >> 5) & 0xF8) | (buttonState & 0x7);
	}
	return keystate;
}

int ioProcessEvents(void) {
	/* This is a noop when running as a plugin; the browser handles events. */
	int maxPollsPerSec = 30;
	static clock_t nextPollTick = 0;

#ifndef PLUGIN
	if (clock() > nextPollTick) {
		/* time to process events!! */
		while (HandleEvents()) {
			/* process all pending events */
		}

		/* wait a while before trying again */
		nextPollTick = clock() + (CLOCKS_PER_SEC / maxPollsPerSec);
	}
#endif
	return interruptPending;
}

int ioRelinquishProcessorForMicroseconds(int microSeconds) {
	/* This operation is platform dependent. On the Mac, it simply calls
	 * ioProcessEvents(), which gives other applications a chance to run.
	 */

	ioProcessEvents();  /* process all pending events */
}

int ioScreenSize(void) {
	int w = 10, h = 10;

	if (stWindow !!= nil) {
		w = stWindow->portRect.right - stWindow->portRect.left;
		h = stWindow->portRect.bottom - stWindow->portRect.top;
	}
	return (w << 16) | (h & 0xFFFF);  /* w is high 16 bits; h is low 16 bits */
}

int ioSeconds(void) {
	struct tm timeRec;
	time_t time1904, timeNow;

	/* start of ANSI epoch is midnight of Jan 1, 1904 */
	timeRec.tm_sec   = 0;
	timeRec.tm_min   = 0;
	timeRec.tm_hour  = 0;
	timeRec.tm_mday  = 1;
	timeRec.tm_mon   = 0;
	timeRec.tm_year  = 4;
	timeRec.tm_wday  = 0;
	timeRec.tm_yday  = 0;
	timeRec.tm_isdst = 0;
	time1904 = mktime(&timeRec);

	timeNow = time(NULL);

	/* Squeak epoch is Jan 1, 1901, 3 non-leap years earlier than ANSI one */
	return (timeNow - time1904) + (3 * 365 * 24 * 60 * 60);
}

int ioSetCursor(int cursorBitsIndex, int offsetX, int offsetY) {
	/* Old version; forward to new version. */
	ioSetCursorWithMask(cursorBitsIndex, nil, offsetX, offsetY);
}

int ioSetCursorWithMask(int cursorBitsIndex, int cursorMaskIndex, int offsetX, int offsetY) {
	/* Set the 16x16 cursor bitmap. If cursorMaskIndex is nil, then make the mask the same as
	   the cursor bitmap. If not, then mask and cursor bits combined determine how cursor is
	   displayed:
			mask	cursor	effect
			 0		  0		transparent (underlying pixel shows through)
			 1		  1		opaque black
			 1		  0		opaque white
			 0		  1		invert the underlying pixel
	*/
	Cursor macCursor;
	int i;

	if (cursorMaskIndex == nil) {
		for (i = 0; i < 16; i++) {
			macCursor.data[i] = (checkedLongAt(cursorBitsIndex + (4 * i)) >> 16) & 0xFFFF;
			macCursor.mask[i] = (checkedLongAt(cursorBitsIndex + (4 * i)) >> 16) & 0xFFFF;
		}
	} else {
		for (i = 0; i < 16; i++) {
			macCursor.data[i] = (checkedLongAt(cursorBitsIndex + (4 * i)) >> 16) & 0xFFFF;
			macCursor.mask[i] = (checkedLongAt(cursorMaskIndex + (4 * i)) >> 16) & 0xFFFF;
		}
	}

	/* Squeak hotspot offsets are negative; Mac''s are positive */
	macCursor.hotSpot.h = -offsetX;
	macCursor.hotSpot.v = -offsetY;
	SetCursor(&macCursor);
}

int ioSetDisplayMode(int width, int height, int depth, int fullscreenFlag) {
	/* Set the window to the given width, height, and color depth. Put the window
	   into the full screen mode specified by fullscreenFlag. */
	/* Note: Changing display depth is not yet, and may never be, implemented
	   on the Macintosh, where (a) it is considered inappropriate and (b) it may
	   not even be a well-defined operation if the Squeak window spans several
	   displays (which display''s depth should be changed?). */

	ioSetFullScreen(fullscreenFlag);
	if (!!fullscreenFlag) {
		SizeWindow(stWindow, width, height, true);
	}
}

int ioSetFullScreen(int fullScreen) {
	Rect screen = qd.screenBits.bounds;
	int width, height, maxWidth, maxHeight;
	int oldWidth, oldHeight;

	if (fullScreen) {
		MenuBarHide();
		oldWidth = stWindow->portRect.right - stWindow->portRect.left;
		oldHeight = stWindow->portRect.bottom - stWindow->portRect.top;
		width  = screen.right - screen.left;
		height = (screen.bottom - screen.top);
		if ((oldWidth < width) || (oldHeight < height)) {
			/* save old size if it wasn''t already full-screen */ 
			savedWindowSize = (oldWidth << 16) + (oldHeight & 0xFFFF);
		}
		MoveWindow(stWindow, 0, 0, true);
		SizeWindow(stWindow, width, height, true);
		fullScreenFlag = true;
	} else {
		MenuBarRestore();

		/* get old window size */
		width  = (unsigned) savedWindowSize >> 16;
		height = savedWindowSize & 0xFFFF;

		/* minimum size is 64 x 64 */
		width  = (width  > 64) ?  width : 64;
		height = (height > 64) ? height : 64;

		/* maximum size is screen size inset slightly */
		maxWidth  = (screen.right  - screen.left) - 16;
		maxHeight = (screen.bottom - screen.top)  - 52;
		width  = (width  <= maxWidth)  ?  width : maxWidth;
		height = (height <= maxHeight) ? height : maxHeight;
		MoveWindow(stWindow, 8, 44, true);
		SizeWindow(stWindow, width, height, true);
		fullScreenFlag = false;
	}
}

int ioShowDisplay(
	int dispBitsIndex, int width, int height, int depth,
	int affectedL, int affectedR, int affectedT, int affectedB) {

	Rect		dstRect = { 0, 0, 0, 0 };
	Rect		srcRect = { 0, 0, 0, 0 };
	RgnHandle	maskRect = nil;

	if (stWindow == nil) {
		return;
	}

	dstRect.left	= 0;
	dstRect.top		= 0;
	dstRect.right	= width;
	dstRect.bottom	= height;

	srcRect.left	= 0;
	srcRect.top		= 0;
	srcRect.right	= width;
	srcRect.bottom	= height;

	(*stPixMap)->baseAddr = (void *) dispBitsIndex;
	/* Note: top three bits of rowBytes indicate this is a PixMap, not a BitMap */
	(*stPixMap)->rowBytes = (((((width * depth) + 31) / 32) * 4) & 0x1FFF) | 0x8000;
	(*stPixMap)->bounds = srcRect;
	(*stPixMap)->pixelSize = depth;
	(*stPixMap)->cmpSize = depth;

	/* create a mask region so that only the affected rectangle is copied */
	maskRect = NewRgn();
	SetRectRgn(maskRect, affectedL, affectedT, affectedR, affectedB);

	SetPort(stWindow);
	CopyBits((BitMap *) *stPixMap, &stWindow->portBits, &srcRect, &dstRect, srcCopy, maskRect);
	DisposeRgn(maskRect);
}

/*** Image File Naming ***/

void StoreFullPathForLocalNameInto(char *shortName, char *fullName, int length) {
	int offset, sz, i;

	offset = dir_PathToWorkingDir(fullName, length);

	/* copy the file name into a null-terminated C string */
	sz = strlen(shortName);
	for (i = 0; i <= sz; i++) {
		/* append shortName to fullName, including terminator */
		fullName[i + offset] = shortName[i];
	}
}

int imageNameSize(void) {
	return strlen(imageName);
}

int imageNameGetLength(int sqImageNameIndex, int length) {
	char *sqImageName = (char *) sqImageNameIndex;
	int count, i;

	count = strlen(imageName);
	count = (length < count) ? length : count;

	/* copy the file name into the Squeak string */
	for (i = 0; i < count; i++) {
		sqImageName[i] = imageName[i];
	}
	return count;
}

int imageNamePutLength(int sqImageNameIndex, int length) {
	char *sqImageName = (char *) sqImageNameIndex;
	int count, i, ch, j;
	int lastColonIndex = -1;

	count = (IMAGE_NAME_SIZE < length) ? IMAGE_NAME_SIZE : length;

	/* copy the file name into a null-terminated C string */
	for (i = 0; i < count; i++) {
		ch = imageName[i] = sqImageName[i];
		if (ch == '':'') {
			lastColonIndex = i;
		}
	}
	imageName[count] = 0;

	/* copy short image name into a null-terminated C string */
	for (i = lastColonIndex + 1, j = 0; i < count; i++, j++) {
		shortImageName[j] = imageName[i];
	}
	shortImageName[j] = 0;

	SetWindowTitle(shortImageName);
	return count;
}

/*** Clipboard Support (text only for now) ***/

void SetUpClipboard(void) {
	/* allocate clipboard in the system heap to support really big copy/paste */
	THz oldZone;

	oldZone = GetZone();
	SetZone(SystemZone());
	clipboardBuffer = NewHandle(0);
	SetZone(oldZone);
}

void FreeClipboard(void) {
	if (clipboardBuffer !!= nil) {
		DisposeHandle(clipboardBuffer);
		clipboardBuffer = nil;
	}
}

int clipboardReadIntoAt(int count, int byteArrayIndex, int startIndex) {
	long clipSize, charsToMove;
	char *srcPtr, *dstPtr, *end;

	clipSize = clipboardSize();
	charsToMove = (count < clipSize) ? count : clipSize;

	srcPtr = (char *) *clipboardBuffer;
	dstPtr = (char *) byteArrayIndex + startIndex;
	end = srcPtr + charsToMove;
	while (srcPtr < end) {
		*dstPtr++ = *srcPtr++;
	}
	return charsToMove;
}

int clipboardSize(void) {
	long count, offset;

	count = GetScrap(clipboardBuffer, ''TEXT'', &offset);
	if (count < 0) {
		return 0;
	} else {
		return count;
	}
}

int clipboardWriteFromAt(int count, int byteArrayIndex, int startIndex) {
	ZeroScrap();
	PutScrap(count, ''TEXT'', (char *) (byteArrayIndex + startIndex));
}

/*** Profiling ***/

int clearProfile(void) {
#ifdef MAKE_PROFILE
	ProfilerClear();
#endif
}

int dumpProfile(void) {
#ifdef MAKE_PROFILE
	ProfilerDump("\pProfile.out");
#endif
}

int startProfiling(void) {
#ifdef MAKE_PROFILE
	ProfilerSetStatus(true);
#endif
}

int stopProfiling(void) {
#ifdef MAKE_PROFILE
	ProfilerSetStatus(false);
#endif
}

/*** Plugin Support ***/

int plugInInit(char *fullImagePath) {
	if (memory == nil) {
		return;	/* failed to read image */
	}

	/* check the interpreter''s size assumptions for basic data types */
	if (sizeof(int) !!= 4) {
		error("This C compiler''s integers are not 32 bits.");
	}
	if (sizeof(double) !!= 8) {
		error("This C compiler''s floats are not 64 bits.");
	}
	if (sizeof(time_t) !!= 4) {
		error("This C compiler''s time_t''s are not 32 bits.");
	}

	strcpy(imageName, fullImagePath);
	dir_PathToWorkingDir(vmPath, VMPATH_SIZE);

	SetUpClipboard();
	SetUpPixmap();
	sqFileInit();
	joystickInit();
}

int plugInShutdown(void) {
	snd_Stop();
	FreeClipboard();
	FreePixmap();
	if (memory !!= nil) {
		DisposePtr((void *) memory);
		memory = nil;
	}
}

#ifndef PLUGIN
int plugInAllowAccessToFilePath(char *pathString, int pathStringLength) {
  /* Grant permission to all files. */
	return true;
}
#endif

/*** System Attributes ***/

int IsImageName(char *name) {
	char *suffix;

	suffix = strrchr(name, ''.'');  /* pointer to last period in name */
	if (suffix == NULL) return false;
	if (strcmp(suffix, ".ima") == 0) return true;
	if (strcmp(suffix, ".image") == 0) return true;
	if (strcmp(suffix, ".IMA") == 0) return true;
	if (strcmp(suffix, ".IMAGE") == 0) return true;
	return false;
}

char * GetAttributeString(int id) {
	/* This is a hook for getting various status strings back from
	   the OS. In particular, it allows Squeak to be passed arguments
	   such as the name of a file to be processed. Command line options
	   are reported this way as well, on platforms that support them.
	*/

	// id #0 should return the full name of VM; for now it just returns its path
	if (id == 0) return vmPath;
	// id #1 should return imageName, but returns empty string in this release to
	// ease the transition (1.3x images otherwise try to read image as a document)
	if (id == 1) return "";  /* will be imageName */
	if (id == 2) return documentName;

	if (id == 1001) return "Mac OS";
	if (id == 1002) return "System 7 or Later";
	if (id == 1003) return "PowerPC or 68K";

	/* attribute undefined by this platform */
	success(false);
	return "";
}

int attributeSize(int id) {
	return strlen(GetAttributeString(id));
}

int getAttributeIntoLength(int id, int byteArrayIndex, int length) {
	char *srcPtr, *dstPtr, *end;
	int charsToMove;

	srcPtr = GetAttributeString(id);
	charsToMove = strlen(srcPtr);
	if (charsToMove > length) {
		charsToMove = length;
	}

	dstPtr = (char *) byteArrayIndex;
	end = srcPtr + charsToMove;
	while (srcPtr < end) {
		*dstPtr++ = *srcPtr++;
	}
	return charsToMove;
}

/*** Image File Operations ***/

void sqImageFileClose(sqImageFile f) {
	FSClose(f);
}

sqImageFile sqImageFileOpen(char *fileName, char *mode) {
	short int err, err2, fRefNum;
	unsigned char *pascalFileName;

	pascalFileName = c2pstr(fileName);
	err = FSOpen(pascalFileName, 0, &fRefNum);
	if ((err !!= 0) && (strchr(mode, ''w'') !!= null)) {
		/* creating a new file for "save as" */
		err2 = Create(pascalFileName, 0, ''FAST'', ''STim'');
		if (err2 == 0) {
			err = FSOpen(pascalFileName, 0, &fRefNum);
		}
	}
	p2cstr(pascalFileName);
	if (err !!= 0) return null;

	if (strchr(mode, ''w'') !!= null) {
		/* truncate file if opening in write mode */
		err = SetEOF(fRefNum, 0);
		if (err !!= 0) {
			FSClose(fRefNum);
			return null;
		}
	}
	return (sqImageFile) fRefNum;
}

int sqImageFilePosition(sqImageFile f) {
	long int currentPosition = 0;

	GetFPos(f, &currentPosition);
	return currentPosition;
}

int sqImageFileRead(void *ptr, int elementSize, int count, sqImageFile f) {
	long int byteCount = elementSize * count;
	short int err;

	err = FSRead(f, &byteCount, ptr);
	if (err !!= 0) return 0;
	return byteCount / elementSize;
}

void sqImageFileSeek(sqImageFile f, int pos) {
	SetFPos(f, fsFromStart, pos);
}

int sqImageFileWrite(void *ptr, int elementSize, int count, sqImageFile f) {
	long int byteCount = elementSize * count;
	short int err;

	err = FSWrite(f, &byteCount, ptr);
	if (err !!= 0) return 0;
	return byteCount / elementSize;
}

#ifdef PLUGIN
void * sqAllocateMemory(int minHeapSize, int desiredHeapSize) {
	/* Plugin allocates Squeak object heap memory from the system heap. */
	MaxBlockSys();
	return NewPtrSys(desiredHeapSize);
}
#else
void * sqAllocateMemory(int minHeapSize, int desiredHeapSize) {
	/* Application allocates Squeak object heap memory from its own heap. */
	MaxBlock();
	return NewPtr(desiredHeapSize);
}
#endif

/*** Main ***/

#ifndef PLUGIN
void main(void) {
	EventRecord theEvent;
	sqImageFile f;
	int reservedMemory, availableMemory;

	InitMacintosh();
	SetUpMenus();
	SetUpClipboard();
	SetUpWindow();
	SetUpPixmap();
	sqFileInit();
	joystickInit();

	/* install apple event handlers and wait for open event */
	imageName[0] = shortImageName[0] = documentName[0] = vmPath[0] = 0;
	InstallAppleEventHandlers();
	while (shortImageName[0] == 0) {
		GetNextEvent(everyEvent, &theEvent);
		if (theEvent.what == kHighLevelEvent) {
			AEProcessAppleEvent(&theEvent);
		}
	}
	if (imageName[0] == 0) {
		StoreFullPathForLocalNameInto(shortImageName, imageName, IMAGE_NAME_SIZE);
	}

	/* check the interpreter''s size assumptions for basic data types */
	if (sizeof(int) !!= 4) {
		error("This C compiler''s integers are not 32 bits.");
	}
	if (sizeof(double) !!= 8) {
		error("This C compiler''s floats are not 64 bits.");
	}
	if (sizeof(time_t) !!= 4) {
		error("This C compiler''s time_t''s are not 32 bits.");
	}

#ifdef MAKE_PROFILE
	ProfilerInit(collectDetailed, bestTimeBase, 1000, 50);
	ProfilerSetStatus(false);
	ProfilerClear();
#endif

	/* compute the desired memory allocation */
	reservedMemory = 150000;
	availableMemory = MaxBlock() - reservedMemory;
	/******
	  Note: This is platform-specific. On the Mac, the user specifies the desired
	    memory partition for each application using the Finder''s Get Info command.
	    MaxBlock() returns the amount of memory in the partition minus space for
	    the code segment and other resources. On other platforms, the desired heap
	    size would be specified in other ways (e.g, via a command line argument).
	    The maximum size of the object heap is fixed at at startup. If you run low
	    on space, you must save the image and restart with more memory.

	  Note: Some memory must be reserved for Mac toolbox calls, sound buffers, etc.
	    A 30K reserve is too little. 40K allows Squeal to run but crashes if the
	    console is opened. 50K allows the console to be opened (with and w/o the
	    profiler). I added another 30K to provide for sound buffers and reliability.
	    (Note: Later discovered that sound output failed if SoundManager was not
	    preloaded unless there is about 100K reserved. Added 30K to that.)
	******/

	/* uncomment the following when using the C transcript window for debugging: */
	//printf("Move this window, then hit CR\n"); getchar();

	/* read the image file and allocate memory for Squeak heap */
	f = sqImageFileOpen(imageName, "rb");
	if (f == NULL) {
		/* give a Mac-specific error message if image file is not found */
		printf("Could not open the Squeak image file ''%s''\n\n", imageName);
		printf("There are several ways to open a Squeak image file. You can:\n");
		printf("  1. Double-click on the desired image file.\n");
		printf("  2. Drop the image file icon onto the Squeak application or an alias to it.\n");
		printf("  3. Name your image ''squeak.image'' and put it in the same folder as the\n");
		printf("     Squeak application, then double-click on the Squeak application.\n\n");
		printf("Press the return key to exit.\n");
		getchar();
		printf("Aborting...\n");
		ioExit();
	}
	readImageFromFileHeapSize(f, availableMemory);
	sqImageFileClose(f);

	SetWindowTitle(shortImageName);
	ioSetFullScreen(fullScreenFlag);

	/* run Squeak */
	interpret();
}
#endif
'
! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'acg 6/4/1999 20:08'!
readmeFile

	^ 'Building the Squeak Virtual Machine

The Macintosh virtual machine is built from five header and fourteen source files:

	sq.h				-- shared definitions included in all .c files
	sqConfig.h			-- platform configuration settings
	sqMachDep.h		-- machine dependent macros to support threaded code
	sqPlatformSpecific.h -- platform specific macros and definitions
	sqVirtualMachine.h	-- support for dynamic primitives
	sqFilePrims.c		-- file primitives
	sqMacAsyncFilePrims.c -- Mac asynchronous file I/O
	sqMacDirectory.c	-- Mac directory enumerations
	sqMacExternalPrims.c  -- support for dynamic primitives
	sqMacJoystick.c		-- Mac primitives to support Gravis MouseStickII joystick
	sqMacNetwork.c		-- Mac networking primitives
	sqMacSerialAndMIDIPort.c -- Mac serial and MIDI port primitives
	sqMacSound.c		-- Mac audio output primitives
	sqMacWindow.c		-- Mac window and event handling; main program
	sqMiscPrims.c		-- miscellaneous automatically generated primitives
	sqSoundPrims.c		-- automatically generated sound synthesis primitives
	sqOldSoundPrims.c	-- old versions of sound primitives for backward compatibility
	sqVirtualMachine.c	-- support for dynamic primitives
	interp.c				-- automatically generated code for the virtual machine

The platform specific files are sqMacXXX.c, totaling about 2000 lines of code when this document was written. All other code is written to standard ANSI libraries and should port easily to other C environments.

The file sqMacMinimal.c can be used a porting guide. This ~1100 line file stubs out all non-essential support functions and, together with sqFilePrims.c, allows one to build a functioning virtual machine that only lacks non-essential I/O functions (including support for file directory enumeration, which is not really essential!!). The small size of this file demonstrates how little code is really needed to get Squeak running on a new platform.

Thanks to Ian Piumarta, the C header files are identical across all the major Squeak platforms.

The code assumes that C ints and pointers are 4 bytes and double floats are 8 bytes; these assumptions are checked at start up time. Float objects in the image are stored in the IEEE standard byte ordering for double-precision floats on all platforms; macros in sq.h can be defined to swap bytes into and out of the platform native float format if necessary. (To ensure proper word alignment, one typically has to copy a Squeak Float object into a C "double" variable before operating on it; byte swapping can be done while doing this copy for little or no additional cost.)

The files interp.c, sqSoundPrims.c, and sqMiscPrims.c are generated automatically, so changes to these files will be lost when they are next generated. It is fine to make ephemeral changes to these file for the purpose of debugging or statistics gathering. To generate the interpreter, see the "translation" category in Interpreter class. To generate sqSoundPrims.c, see the class method "cCodeForSoundPrimitives" in AbstractSound.

BUILDING UNDER CODEWARRIOR

The current VM was compiled with Metrowerks CodeWarrior 11. Earlier, I used Semantec Think C 6.0, but discovered a few bugs in their libraries having to do with 8-byte versus 4-byte integers. These bugs have probably been fixed by now.

The virtual machine uses the following libraries in Codewarrior:

	Libraries for 68K Project:
		dnr.c
		InterfaceLib
		MathLibCFM68K (4i/8d).Lib
		MSL C.CFM68K Far(4i/8d).Lib
		MWCFM68KRuntime.Lib
		Profiler68kCFM.lib

	Libraries for PowerPC Project:
		dnr.c
		InterfaceLib
		MathLib
		MSL C.PPC.Lib
		MWCRuntime.Lib
		profilerPPC.lib

The Mac networking code also requires three files from Apple''s MacTCP developer''s kit:

	MacTCP.h
	AddressXlation.h
	dnr.c

For convenience, these files are included.

To build a fat binary, build the 68K version first, and make sure that the file "Squeak VM 68K" is included in the PowerPC project. Then build the PowerPC version. CodeWarrior will include the 68K interpreter in the resource fork of the output file, resulting in an interpreter that runs on either 68K or PowerPC Macs.

Note: I have not been able to build a fat binary since converting to the Code Fragement Manager. Until this problem is resolved, there will be separate executables for PPC and 68K.

To get an additional speedup, the object code for the bytecode dispatch loop of the PPC version can be patched using the method "patchInterp:" in Interpreter class.

Note: In The release, we''ve updated the CodeWarrior project files to release 11 of CodeWarrior. If you have a current version of CodeWarrior, you will should be able to automatically convert these project files to your release. If you have a release of CodeWarrior earlier than release 11 (which is quite old), you will need to either build new project files from scratch, start with the release 8 project files included with Squeak 2.2 and bring them up to date by hand, or update to a newer version of CodeWarrior.

Note: In order to support dynamically loaded primitives, we have switched to using Code Fragement Manager model for the 68K VM. This has several ramifications:

  1. You now need to use the CFM versions of the library files. The 68K project file has been updated accordingly.
  2. You cannot run the 68K VM under the emulator on the PowerPC (Apple doesn''t support CFM apps under the 68K emulator).
  3. You need to be sure that version 4.0 or later of "CFM-68K Runtime Enabler" is in the Extensions folder of the system folder on your 68K Mac. *** Warning: Older versions of "CFM-68K Runtime Enabler" had bugs that will probably prevent Squeak from even starting!! ***.
  4. You will need to figure out how to make a CFM68K shared library project if you wish to build dynamic primitives that can be run on the 68K. Ideally, one would create a "fat" library containing both 68K and PPC versions of the dynamically loadable primitives. So far, I have not tried doing that.
 
BUILDING UNDER MPW

This code has also been compiled under the MPW "Mr. C" Macintosh compiler by Hans-Martin Mosner (hmm at heeg.de) with only one minor change: you will need to create an empty "MacHeaders.h" file. You may get some harmless compiler warnings and, for peak performance, the method that patches the dispatch loop must also be changed. Hans-Martin says: "The whole VM seems to be marginally slower than the delivered VM, but it is significantly smaller."

The code was further compiled under MPW "Mr. C" Macintosh with recent changes provided by John Maloney and Andrew Greenberg, so that it can now be compiled using Mr. C''s global optimiziation capabilities.  Andy relates that the result is that the VM is almost exactly the same size as the delivered VM, but is substantially faster.  To build under MPW, generate the support routines with the doIt:

	InterpreterSupportCode writeMacMPWSourceFiles

and then copy the file MPWSqueak.make into your MPW folder.  In addition to the headers and files described above, the MPW package also include a file named "MPWSqueak.r."  

To build, start up MPW, and type Command-B, type "MPWSqueak."  If all goes well, you should have a perfect executable named MPWSqueak in both the MPW folder and your Squeak Folder.  The MPW folder version won''t run meaningfully unless you place an image and appropriate support files in the MPW folder, as you would with any Squeak executable.  The version in the Squeak folder should startup with the standard image.

If you want to keep files elsewhere, simply modify "MPWSqueak.make" to suit your tastes.  To get an additional speedup, the object code for the bytecode dispatch loop of the PPC version can be patched using the method "patchInterp:" in Interpreter class.  Simply select "MPW Compiler" from the menu when asked after executing the following doIt:

	Interpreter patchInterp: ''MPWSqueak''

	-- John Maloney, Jan 12, 1999; 
	-- (updated for MPW) Andrew C. Greenberg, June 4, 1999
'.
! !

!InterpreterSupportCode class methodsFor: 'source files' stamp: 'JW 2/24/2000 08:00'!
squeakHeaderFile

	^ '#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>

#include "sqConfig.h"
#include "sqVirtualMachine.h"

#define true 1
#define false 0
#define null 0  /* using "null" because nil is predefined in Think C */

/* pluggable primitives macros */
/* Note: All pluggable primitives are defined as
	EXPORT(int) somePrimitive(void)
   If the platform requires special declaration modifiers
   the EXPORT macro can be redefined
*/
#define EXPORT(returnType) returnType

/* image save/restore macros */
/* Note: The image file save and restore code uses these macros; they
   can be redefined in sqPlatformSpecific.h if desired. These default
   versions are defined in terms of the ANSI Standard C libraries.
*/
#define sqImageFile FILE *
#define sqImageFileClose(f)                  fclose(f)
#define sqImageFileOpen(fileName, mode)      fopen(fileName, mode)
#define sqImageFilePosition(f)               ftell(f)
#define sqImageFileRead(ptr, sz, count, f)   fread(ptr, sz, count, f)
#define sqImageFileSeek(f, pos)              fseek(f, pos, SEEK_SET)
#define sqImageFileWrite(ptr, sz, count, f)  fwrite(ptr, sz, count, f)
#ifdef SQUEAKMPW
#define sqAllocateMemory(minHeapSize, desiredHeapSize)   NewPtr(desiredHeapSize)
#else
#define sqAllocateMemory(minHeapSize, desiredHeapSize)   malloc(desiredHeapSize)
#endif

/* platform-dependent float conversion macros */
/* Note: Second argument must be a variable name, not an expression!! */
/* Note: Floats in image are always in PowerPC word order; change
   these macros to swap words if necessary. This costs no extra and
   obviates sometimes having to word-swap floats when reading an image.
*/
#if defined(DOUBLE_WORD_ALIGNMENT) || defined(DOUBLE_WORD_ORDER)
# ifdef DOUBLE_WORD_ORDER
/* word-based copy with swapping for non-PowerPC order */
#   define storeFloatAtfrom(i, floatVarName) \
	*((int *) (i) + 0) = *((int *) &(floatVarName) + 1); \
	*((int *) (i) + 1) = *((int *) &(floatVarName) + 0);
#   define fetchFloatAtinto(i, floatVarName) \
	*((int *) &(floatVarName) + 0) = *((int *) (i) + 1); \
	*((int *) &(floatVarName) + 1) = *((int *) (i) + 0);
# else /*!!DOUBLE_WORD_ORDER*/
/* word-based copy for machines with alignment restrictions */
#   define storeFloatAtfrom(i, floatVarName) \
	*((int *) (i) + 0) = *((int *) &(floatVarName) + 0); \
	*((int *) (i) + 1) = *((int *) &(floatVarName) + 1);
#   define fetchFloatAtinto(i, floatVarName) \
	*((int *) &(floatVarName) + 0) = *((int *) (i) + 0); \
	*((int *) &(floatVarName) + 1) = *((int *) (i) + 1);
# endif /*!!DOUBLE_WORD_ORDER*/
#else /*!!(DOUBLE_WORD_ORDER||DOUBLE_WORD_ALIGNMENT)*/
/* for machines that allow doubles to be on any word boundary */
# define storeFloatAtfrom(i, floatVarName) \
	*((double *) (i)) = (floatVarName);
# define fetchFloatAtinto(i, floatVarName) \
	(floatVarName) = *((double *) (i));
#endif

/* platform-dependent memory size adjustment macro */
/* Note: This macro can be redefined to allows platforms with a
   fixed application memory partition (notably, the Macintosh)
   to reserve extra C heap memory for special applications that need
   it (e.g., for a 3D graphics library). Since most platforms can
   extend their application memory partition at run time if needed,
   this macro is defined as a noop here and redefined if necessary
   in sqPlatformSpecific.h.
*/

#define reserveExtraCHeapBytes(origHeapSize, bytesToReserve) origHeapSize

/* platform-dependent millisecond clock macros */
/* Note: The Squeak VM uses three different clocks functions for
   timing. The primary one, ioMSecs(), is used to implement Delay
   and Time millisecondClockValue. The resolution of this clock
   determines the resolution of these basic timing functions. For
   doing real-time control of music and MIDI, a clock with resolution
   down to one millisecond is preferred, but a coarser clock (say,
   1/60th second) can be used in a pinch. The VM calls a different
   clock function, ioLowResMSecs(), in order to detect long-running
   primitives. This function must be inexpensive to call because when
   a Delay is active it is polled twice per primitive call. On several
   platforms (Mac, Win32), the high-resolution system clock used in
   ioMSecs() would incur enough overhead in this case to slow down the
   the VM significantly. Thus, a cheaper clock with low resolution is
   used to implement ioLowResMSecs() on these platforms. Finally, the
   function ioMicroMSecs() is used only to collect timing statistics
   for the garbage collector and other VM facilities. (The function
   name is meant to suggest that the function is based on a clock
   with microsecond accuracy, even though the times it returns are
   in units of milliseconds.) This clock must have enough precision to
   provide accurate timings, and normally isn''t called frequently
   enough to slow down the VM. Thus, it can use a more expensive clock
   that ioMSecs(). By default, all three clock functions are defined
   here as macros based on the standard C library function clock().
   Any of these macros can be overridden in sqPlatformSpecific.h.
*/

int ioMSecs(void);
int ioLowResMSecs(void);
int ioMicroMSecs(void);

#define ioMSecs()		((1000 * clock()) / CLOCKS_PER_SEC)
#define ioLowResMSecs()	((1000 * clock()) / CLOCKS_PER_SEC)
#define ioMicroMSecs()	((1000 * clock()) / CLOCKS_PER_SEC)

/* this include file may redefine earlier definitions and macros: */
#include "sqPlatformSpecific.h"

/* squeak file record; see sqFilePrims.c for details */
typedef struct {
	FILE	*file;
	int		sessionID;
	int		writable;
	int		fileSize;
	int		lastOp;  /* 0 = uncommitted, 1 = read, 2 = write */
} SQFile;

/* file i/o */
int sqFileAtEnd(SQFile *f);
int sqFileClose(SQFile *f);
int sqFileDeleteNameSize(int sqFileNameIndex, int sqFileNameSize);
int sqFileGetPosition(SQFile *f);
int sqFileInit(void);
int sqFileOpen(SQFile *f, int sqFileNameIndex, int sqFileNameSize, int writeFlag);
int sqFileReadIntoAt(SQFile *f, int count, int byteArrayIndex, int startIndex);
int sqFileRenameOldSizeNewSize(int oldNameIndex, int oldNameSize, int newNameIndex, int newNameSize);
int sqFileSetPosition(SQFile *f, int position);
int sqFileSize(SQFile *f);
int sqFileValid(SQFile *f);
int sqFileWriteFromAt(SQFile *f, int count, int byteArrayIndex, int startIndex);

/* directories */
int dir_Create(char *pathString, int pathStringLength);
int dir_Delete(char *pathString, int pathStringLength);
int dir_Delimitor(void);
int dir_Lookup(char *pathString, int pathStringLength, int index,
	/* outputs: */
	char *name, int *nameLength, int *creationDate, int *modificationDate,
	int *isDirectory, int *sizeIfFile);
int dir_PathToWorkingDir(char *pathName, int pathNameMax);
int dir_SetMacFileTypeAndCreator(char *filename, int filenameSize, char *fType, char *fCreator);

/* interpreter entry points */
void error(char *s);
int checkedByteAt(int byteAddress);
int checkedByteAtput(int byteAddress, int byte);
int checkedLongAt(int byteAddress);
int checkedLongAtput(int byteAddress, int a32BitInteger);
int fullDisplayUpdate(void);
int initializeInterpreter(int bytesToShift);
int interpret(void);
int primitiveFail(void);
int signalSemaphoreWithIndex(int index);
int success(int);

/* display, mouse, keyboard, time i/o */
int ioBeep(void);
int ioExit(void);
int ioForceDisplayUpdate(void);
int ioFormPrint(
	int bitsAddr, int width, int height, int depth,
	double hScale, double vScale, int landscapeFlag);
int ioSetFullScreen(int fullScreen);
int ioGetButtonState(void);
int ioGetKeystroke(void);
int ioMousePoint(void);
int ioPeekKeystroke(void);
int ioProcessEvents(void);
int ioRelinquishProcessorForMicroseconds(int microSeconds);
int ioScreenSize(void);
int ioSeconds(void);
int ioSetCursor(int cursorBitsIndex, int offsetX, int offsetY);
int ioSetCursorWithMask(int cursorBitsIndex, int cursorMaskIndex, int offsetX, int offsetY);
int ioShowDisplay(
	int dispBitsIndex, int width, int height, int depth,
	int affectedL, int affectedR, int affectedT, int affectedB);
int ioHasDisplayDepth(int depth);
int ioSetDisplayMode(int width, int height, int depth, int fullscreenFlag);

/* image file and VM path names */
extern char imageName[];
int imageNameGetLength(int sqImageNameIndex, int length);
int imageNamePutLength(int sqImageNameIndex, int length);
int imageNameSize(void);
int vmPathSize(void);
int vmPathGetLength(int sqVMPathIndex, int length);

/* save/restore */
/* Read the image from the given file starting at the given image offset */
int readImageFromFileHeapSizeStartingAt(sqImageFile f, int desiredHeapSize, int imageOffset);
/* NOTE: The following is obsolete - it is only provided for compatibility */
#define readImageFromFileHeapSize(f, s) readImageFromFileHeapSizeStartingAt(f,s,0)

/* clipboard (cut/copy/paste) */
int clipboardSize(void);
int clipboardReadIntoAt(int count, int byteArrayIndex, int startIndex);
int clipboardWriteFromAt(int count, int byteArrayIndex, int startIndex);

/* sound output */
int snd_AvailableSpace(void);
int snd_InsertSamplesFromLeadTime(int frameCount, int srcBufPtr, int samplesOfLeadTime);
int snd_PlaySamplesFromAtLength(int frameCount, int arrayIndex, int startIndex);
int snd_PlaySilence(void);
int snd_Start(int frameCount, int samplesPerSec, int stereo, int semaIndex);
int snd_Stop(void);

/* sound input */
int snd_SetRecordLevel(int level);
int snd_StartRecording(int desiredSamplesPerSec, int stereo, int semaIndex);
int snd_StopRecording(void);
double snd_GetRecordingSampleRate(void);
int snd_RecordSamplesIntoAtLength(int buf, int startSliceIndex, int bufferSizeInBytes);

/* joystick support */
int joystickInit(void);
int joystickRead(int stickIndex);

/* browser plug-in support */
int plugInAllowAccessToFilePath(char *pathString, int pathStringLength);
int plugInInit(char *imageName);
int plugInShutdown(void);
int plugInInterpretCycles(int cycleCount);

/* interpreter entry points needed by compiled primitives */
void * arrayValueOf(int arrayOop);
int checkedIntegerValueOf(int intOop);
void * fetchArrayofObject(int fieldIndex, int objectPointer);
double fetchFloatofObject(int fieldIndex, int objectPointer);
int fetchIntegerofObject(int fieldIndex, int objectPointer);
double floatValueOf(int floatOop);
int pop(int nItems);
int pushInteger(int integerValue);
int sizeOfSTArrayFromCPrimitive(void *cPtr);
int storeIntegerofObjectwithValue(int fieldIndex, int objectPointer, int integerValue);

/* sound generation primitives (old, for backward compatibility) */
int primWaveTableSoundmixSampleCountintostartingAtpan(void);
int primFMSoundmixSampleCountintostartingAtpan(void);
int primPluckedSoundmixSampleCountintostartingAtpan(void);
int primSampledSoundmixSampleCountintostartingAtpan(void);
int oldprimSampledSoundmixSampleCountintostartingAtleftVolrightVol(void);

/* sound generation primitives */
int primFMSoundmixSampleCountintostartingAtleftVolrightVol(void);
int primLoopedSampledSoundmixSampleCountintostartingAtleftVolrightVol(void);
int primPluckedSoundmixSampleCountintostartingAtleftVolrightVol(void);
int primReverbSoundapplyReverbTostartingAtcount(void);
int primSampledSoundmixSampleCountintostartingAtleftVolrightVol(void);

/* squeak socket record; see sqMacNetwork.c for details */
typedef struct {
	int		sessionID;
	int		socketType;  /* 0 = TCP, 1 = UDP */
	void	*privateSocketPtr;
}  SQSocket, *SocketPtr;

/* networking primitives */
int		sqNetworkInit(int resolverSemaIndex);
void	sqNetworkShutdown(void);
void	sqResolverAbort(void);
void	sqResolverAddrLookupResult(char *nameForAddress, int nameSize);
int		sqResolverAddrLookupResultSize(void);
int		sqResolverError(void);
int		sqResolverLocalAddress(void);
int		sqResolverNameLookupResult(void);
void	sqResolverStartAddrLookup(int address);
void	sqResolverStartNameLookup(char *hostName, int nameSize);
int		sqResolverStatus(void);
void	sqSocketAbortConnection(SocketPtr s);
void	sqSocketCloseConnection(SocketPtr s);
int		sqSocketConnectionStatus(SocketPtr s);
void	sqSocketConnectToPort(SocketPtr s, int addr, int port);
void	sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaID(
			SocketPtr s, int netType, int socketType,
			int recvBufSize, int sendBufSize, int semaIndex);
void	sqSocketDestroy(SocketPtr s);
int		sqSocketError(SocketPtr s);
void	sqSocketListenOnPort(SocketPtr s, int port);
int		sqSocketLocalAddress(SocketPtr s);
int		sqSocketLocalPort(SocketPtr s);
int		sqSocketReceiveDataAvailable(SocketPtr s);
int		sqSocketReceiveDataBufCount(SocketPtr s, int buf, int bufSize);
int		sqSocketRemoteAddress(SocketPtr s);
int		sqSocketRemotePort(SocketPtr s);
int		sqSocketSendDataBufCount(SocketPtr s, int buf, int bufSize);
int		sqSocketSendDone(SocketPtr s);
/* 	ar 7/16/1999: New primitives for accept().
	Note: If accept() calls are not supported simply make the calls fail
	and the old connection style will be used */
void	sqSocketListenOnPortBacklogSize(SocketPtr s, int port, int backlogSize);
void	sqSocketAcceptFromRecvBytesSendBytesSemaID(
			SocketPtr s, SocketPtr serverSocket,
			int recvBufSize, int sendBufSize, int semaIndex);

/* profiling */
int clearProfile(void);
int dumpProfile(void);
int startProfiling(void);
int stopProfiling(void);

/* system attributes */
int attributeSize(int id);
int getAttributeIntoLength(int id, int byteArrayIndex, int length);

/* miscellaneous primitives */
int primBitmapcompresstoByteArray(void);
int primBitmapdecompressfromByteArrayat(void);
int primSampledSoundconvert8bitSignedFromto16Bit(void);
int primStringcomparewithcollated(void);
int primStringfindFirstInStringinSetstartingAt(void);
int primStringfindSubstringinstartingAtmatchTable(void);
int primStringindexOfAsciiinStringstartingAt(void);
int primStringtranslatefromtotable(void);

/* serial port primitives */
int serialPortClose(int portNum);
int serialPortOpen(
  int portNum, int baudRate, int stopBitsType, int parityType, int dataBits,
  int inFlowCtrl, int outFlowCtrl, int xOnChar, int xOffChar);
int serialPortReadInto(int portNum, int count, int bufferPtr);
int serialPortWriteFrom(int portNum, int count, int bufferPtr);

/* MIDI primitives */
int sqMIDIGetClock(void);
int sqMIDIGetPortCount(void);
int sqMIDIGetPortDirectionality(int portNum);
int sqMIDIGetPortName(int portNum, int namePtr, int length);
int sqMIDIClosePort(int portNum);
int sqMIDIOpenPort(int portNum, int readSemaIndex, int interfaceClockRate);
int sqMIDIParameter(int whichParameter, int modify, int newValue);
int sqMIDIPortReadInto(int portNum, int count, int bufferPtr);
int sqMIDIPortWriteFromAt(int portNum, int count, int bufferPtr, int time);

/*** Experimental Asynchronous File I/O ***/
typedef struct {
	int			sessionID;
	void		*state;
} AsyncFile;

int asyncFileClose(AsyncFile *f);
int asyncFileOpen(AsyncFile *f, int fileNamePtr, int fileNameSize, int writeFlag, int semaIndex);
int asyncFileRecordSize();
int asyncFileReadResult(AsyncFile *f, int bufferPtr, int bufferSize);
int asyncFileReadStart(AsyncFile *f, int fPosition, int count);
int asyncFileWriteResult(AsyncFile *f);
int asyncFileWriteStart(AsyncFile *f, int fPosition, int bufferPtr, int bufferSize);

/*** pluggable primitive support ***/
int ioLoadExternalFunctionOfLengthFromModuleOfLength(
  int functionNameIndex, int functionNameLength,
  int moduleNameIndex, int moduleNameLength);

/*** sound compression primitives ***/
int primADPCMCodecprivateDecodeMono(void);
int primADPCMCodecprivateDecodeStereo(void);
int primADPCMCodecprivateEncodeMono(void);
int primADPCMCodecprivateEncodeStereo(void);

/*** tablet support ***/
int tabletGetParameters(int cursorIndex, int result[]);
int tabletRead(int cursorIndex, int result[]);
int tabletResultSize(void);


/* The Squeak version this interpreter was generated from */
extern const char *interpreterVersion;
'
! !




More information about the Squeak-dev mailing list