'From Squeak 2.5 of August 6, 1999 on 4 October 1999 at 12:51:42 pm'! Object subclass: #ExternalUnixProcess instanceVariableNames: 'pid ppid runState exitStatus ' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! Object subclass: #IOHandle instanceVariableNames: 'file sessionID writable fileSize lastOp ' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! Object subclass: #OSPipe instanceVariableNames: 'reader writer ' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! Object subclass: #OSProcess instanceVariableNames: 'processAccessor pid ' classVariableNames: 'SystemType ThisOSProcess ' poolDictionaries: '' category: 'OS-Support'! OSProcess subclass: #MacProcess instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! InterpreterPlugin subclass: #OSProcessAccessor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! OSProcessAccessor subclass: #MacOSProcessAccessor instanceVariableNames: 'externalStringRegistry ' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! Object subclass: #ShellProxy instanceVariableNames: 'childPid input output error ' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! Object subclass: #ShellWindow instanceVariableNames: 'shellProxy windowStream stdOutProcess stdErrProcess windowView windowName ' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! StandardFileStream subclass: #AttachableFileStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! AttachableFileStream subclass: #OSPipeStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! OSProcessAccessor subclass: #UnixOSProcessAccessor instanceVariableNames: 'externalStringRegistry sigChldHandler semaIndexForThisOSProcessAccessor ' classVariableNames: 'ThisOSProcessAccessor ' poolDictionaries: '' category: 'OS-Support'! OSProcess subclass: #UnixProcess instanceVariableNames: 'sessionID ppid stdIn stdOut stdErr environment path programName arguments allMyChildren sigChldSemaphore semaIndex grimReaper ' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! OSProcessAccessor subclass: #WindowsOSProcessAccessor instanceVariableNames: 'externalStringRegistry ' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! OSProcess subclass: #WindowsProcess instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OS-Support'! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:53'! fileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:53'! isAFileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:54'! newFileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:55'! oldFileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:56'! readOnlyFileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'instance creation' stamp: 'dtl 9/29/1999 18:38'! name: aSymbolOrString attachTo: anIOHandle "Create a new instance attached to anIOHandle, where anIOHandle represents an already open file. For write streams, this represents two Smalltalk streams which write to the same OS file or output stream, presumably with interleaved output." ^super new name: aSymbolOrString attachTo: anIOHandle! ! !ExternalUnixProcess commentStamp: '' prior: 0! I represent an OSProcess other than the process in which this Squeak is executing. I maintain information about the state of the external process during and after the lifetime of the process. In particular, I hold the exit status of the process after it completes execution.! !ExternalUnixProcess methodsFor: 'setting run state' stamp: 'dtl 7/3/1999 12:40'! complete "Process has exited and has been reaped. It no longer exists in the external operating system." self runState: #complete! ! !ExternalUnixProcess methodsFor: 'setting run state' stamp: 'dtl 7/3/1999 12:39'! running "Process is actively running." self runState: #running! ! !ExternalUnixProcess methodsFor: 'testing' stamp: 'dtl 7/3/1999 12:40'! isComplete ^self runState = #complete! ! !ExternalUnixProcess methodsFor: 'testing' stamp: 'dtl 7/3/1999 12:36'! isRunning ^self runState = #running! ! !ExternalUnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:34'! exitStatus ^exitStatus ! ! !ExternalUnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:34'! exitStatus: anInteger ^exitStatus _ anInteger ! ! !ExternalUnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:51'! pid ^pid ! ! !ExternalUnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:52'! pid: aPid ^pid _ aPid ! ! !ExternalUnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:33'! ppid ^ppid ! ! !ExternalUnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:33'! ppid: aPid ^ppid _ aPid ! ! !ExternalUnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:35'! runState ^runState ! ! !ExternalUnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:35'! runState: aSymbol ^runState _ aSymbol ! ! !ExternalUnixProcess methodsFor: 'printing' stamp: 'dtl 7/3/1999 19:31'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' on pid '. self pid printOn: aStream. self isComplete ifTrue: [ aStream nextPutAll: ' (', self runState, ' with status ', self exitStatus printString, ')' ] ifFalse: [ aStream nextPutAll: ' (', self runState, ')' ]! ! !ExternalUnixProcess class methodsFor: 'instance creation' stamp: 'dtl 7/3/1999 12:56'! newChildOf: aPPid withPid: aPid | child | child _ self newWithPid: aPid. child ppid: aPPid. ^child ! ! !ExternalUnixProcess class methodsFor: 'instance creation' stamp: 'dtl 7/3/1999 12:55'! newWithPid: aPid | process | process _ super new. process running. process pid: aPid. ^process ! ! Smalltalk renameClassNamed: #OSFileHandle as: #IOHandle! !IOHandle commentStamp: 'dtl 9/19/1999 10:50' prior: 0! I represent a descriptor for an operating system input/output channel, typically a file. I correspond to an SQFile data structure in the Squeak virtual machine.! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 15:30'! file ^ file! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 15:52'! file: aByteArray ((aByteArray species = ByteArray) and: [ aByteArray size = 4 ]) ifFalse: [ self error: 'invalid argument' ]. ^ file _ aByteArray! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 10:53'! fileSize ^ fileSize! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 10:58'! fileSize: anInteger ^ fileSize _ anInteger ! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 10:53'! lastOp ^ lastOp! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 10:58'! lastOp: anInteger "lastOp is an integer code representing IO operations such as READ and WRITE." ^ lastOp _ anInteger! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 10:53'! sessionID ^ sessionID! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 15:57'! sessionID: aByteArray ((aByteArray species = ByteArray) and: [ aByteArray size = 4 ]) ifFalse: [ self error: 'invalid argument' ]. ^ sessionID _ aByteArray! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 10:53'! writable ^ writable! ! !IOHandle methodsFor: 'accessing' stamp: 'dtl 9/19/1999 11:01'! writable: aBoolean "True if this IO channel is writable, false if read-only. In the SQFile data structure, this is represented as integer 1 for true or integer 0 for false." ^ writable _ aBoolean! ! !IOHandle methodsFor: 'converting' stamp: 'dtl 9/19/1999 15:48'! asSQFileStruct "Answer a ByteArray which can be treated as a struct SQFile by the virtual machine." | accessor struct | accessor _ OSProcess forThisOSProcess processAccessor. struct _ ByteArray new: self class structureSize. struct replaceFrom: 1 to: 4 with: self file. struct replaceFrom: 5 to: 8 with: self sessionID. struct replaceFrom: 9 to: 12 with: (accessor byteArrayFromInteger: (self writable ifTrue: [1] ifFalse: [0])). struct replaceFrom: 13 to: 16 with: (accessor byteArrayFromInteger: self fileSize). struct replaceFrom: 17 to: 20 with: (accessor byteArrayFromInteger: self lastOp). ^ struct ! ! !IOHandle methodsFor: 'printing' stamp: 'dtl 9/29/1999 17:58'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' for file ID ('. self file inject: true into: [ :first :e | first ifFalse: [ aStream nextPut: Character space ]. e printOn: aStream. false ]. aStream nextPutAll: ')' ! ! !IOHandle class methodsFor: 'constants' stamp: 'dtl 9/19/1999 12:53'! structureSize "Answer the size in bytes of an SQFile data structure." ^20! ! !IOHandle class methodsFor: 'instance creation' stamp: 'dtl 9/19/1999 15:54'! newFrom: aByteArray | handle accessor | accessor _ OSProcess forThisOSProcess processAccessor. ((aByteArray species = ByteArray) and: [ aByteArray size = self structureSize ]) ifFalse: [ self error: 'invalid argument' ] ifTrue: [ handle _ super new. handle file: (aByteArray copyFrom: 1 to: 4). handle sessionID: (aByteArray copyFrom: 5 to: 8). handle writable: ((accessor integerFromByteArray: (aByteArray copyFrom: 9 to: 12)) ~= 0). handle fileSize: (accessor integerFromByteArray: (aByteArray copyFrom: 13 to: 16)). handle lastOp: (accessor integerFromByteArray: (aByteArray copyFrom: 17 to: 20)) ]. ^ handle! ! !InterpreterSupportCode class methodsFor: 'source file exporting' stamp: 'dtl 9/13/1999 19:50'! writeSupportFiles "Store into this image's folder the C sources files required to support the interpreter on all platforms. This method also generates the code for the sound synthesis and other primitives translated from Smalltalk to C. 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 writeSupportFiles" self storeString: self readmeFile onFileNamed: 'readme'. self storeString: self squeakHeaderFile onFileNamed: 'sq.h'. self storeString: self squeakConfigFile onFileNamed: 'sqConfig.h'. self storeString: self squeakPlatSpecFile onFileNamed: 'sqPlatformSpecific.h'. self storeString: self squeakVirtualMachineHeaderFile onFileNamed: 'sqVirtualMachine.h'. self storeString: self squeakVirtualMachineFile onFileNamed: 'sqVirtualMachine.c'. self storeString: self squeakSQFileHeaderFile onFileNamed: 'sqFile.h'. self storeString: self squeakADPCMCodecPrimsFile onFileNamed: 'sqADPCMPrims.c'. self storeString: self squeakFilePrimsFile onFileNamed: 'sqFilePrims.c'. self storeString: self squeakGSMCodecPluginFile onFileNamed: 'sqGSMCodecPlugin.c'. Smalltalk at: #AbstractSound ifPresent: [:abstractSound | self storeString: abstractSound cCodeForSoundPrimitives onFileNamed: 'sqSoundPrims.c']. self storeString: self cCodeForMiscPrimitives onFileNamed: 'sqMiscPrims.c'. self storeString: self squeakOldSoundPrimsFile onFileNamed: 'sqOldSoundPrims.c'. ! ! !InterpreterSupportCode class methodsFor: 'source files' stamp: 'dtl 9/13/1999 04:07'! squeakFilePrimsFile ^ '#include "sq.h" /*** The state of a file is kept in the following structure, which is stored directly in a Squeak bytes object. NOTE: The Squeak side is responsible for creating an object with enough room to store sizeof(SQFile) bytes. The session ID is used to detect stale file objects-- files that were still open when an image was written. The file pointer of such files is meaningless. Files are always opened in binary mode; Smalltalk code does (or someday will do) line-end conversion if needed. Writeable files are opened read/write. The stdio spec requires that a positioning operation be done when switching between reading and writing of a read/write filestream. The lastOp field records whether the last operation was a read or write operation, allowing this positioning operation to be done automatically if needed. typedef struct { File *file; int sessionID; int writable; int fileSize; int lastOp; // 0 = uncommitted, 1 = read, 2 = write // } SQFile; ***/ /*** Variables ***/ int thisSession = 0; int sqFileAtEnd(SQFile *f) { /* Return true if the file''s read/write head is at the end of the file. */ if (!!sqFileValid(f)) return success(false); return ftell(f->file) == f->fileSize; } int sqFileClose(SQFile *f) { /* Close the given file. */ if (!!sqFileValid(f)) return success(false); fclose(f->file); f->file = NULL; f->sessionID = 0; f->writable = false; f->fileSize = 0; f->lastOp = UNCOMMITTED; } int sqFileDeleteNameSize(int sqFileNameIndex, int sqFileNameSize) { char cFileName[1000]; int i, err; if (sqFileNameSize >= 1000) { return success(false); } /* copy the file name into a null-terminated C string */ for (i = 0; i < sqFileNameSize; i++) { cFileName[i] = *((char *) (sqFileNameIndex + i)); } cFileName[sqFileNameSize] = 0; err = remove(cFileName); if (err) { return success(false); } } int sqFileGetPosition(SQFile *f) { /* Return the current position of the file''s read/write head. */ int position; if (!!sqFileValid(f)) return success(false); position = ftell(f->file); if (position < 0) return success(false); return position; } int sqFileInit(void) { /* Create a session ID that is unlikely to be repeated. Zero is never used for a valid session number. Should be called once at startup time. */ thisSession = clock() + time(NULL); if (thisSession == 0) thisSession = 1; /* don''t use 0 */ } int sqFileOpen(SQFile *f, int sqFileNameIndex, int sqFileNameSize, int writeFlag) { /* Opens the given file using the supplied sqFile structure to record its state. Fails with no side effects if f is already open. Files are always opened in binary mode; Squeak must take care of any line-end character mapping. */ char cFileName[1001]; int i; /* don''t open an already open file */ if (sqFileValid(f)) return success(false); /* copy the file name into a null-terminated C string */ if (sqFileNameSize > 1000) { return success(false); } for (i = 0; i < sqFileNameSize; i++) { cFileName[i] = *((char *) (sqFileNameIndex + i)); } cFileName[sqFileNameSize] = 0; if (writeFlag) { /* First try to open an existing file read/write: */ f->file = fopen(cFileName, "r+b"); if (f->file == NULL) { /* Previous call fails if file does not exist. In that case, try opening it in write mode to create a new, empty file. */ f->file = fopen(cFileName, "w+b"); if (f->file !!= NULL) { /* set the type and creator of newly created Mac files */ dir_SetMacFileTypeAndCreator(cFileName, strlen(cFileName), "TEXT", "R*ch"); } } f->writable = true; } else { f->file = fopen(cFileName, "rb"); f->writable = false; } if (f->file == NULL) { f->sessionID = 0; f->fileSize = 0; return success(false); } else { f->sessionID = thisSession; /* compute and cache file size */ fseek(f->file, 0, SEEK_END); f->fileSize = ftell(f->file); fseek(f->file, 0, SEEK_SET); } f->lastOp = UNCOMMITTED; } int sqFileReadIntoAt(SQFile *f, int count, int byteArrayIndex, int startIndex) { /* Read count bytes from the given file into byteArray starting at startIndex. byteArray is the address of the first byte of a Squeak bytes object (e.g. String or ByteArray). startIndex is a zero-based index; that is a startIndex of 0 starts writing at the first byte of byteArray. */ char *dst; int bytesRead; if (!!sqFileValid(f)) return success(false); if (f->writable && (f->lastOp == WRITE_OP)) fseek(f->file, 0, SEEK_CUR); /* seek between writing and reading */ dst = (char *) (byteArrayIndex + startIndex); bytesRead = fread(dst, 1, count, f->file); f->lastOp = READ_OP; return bytesRead; } int sqFileRenameOldSizeNewSize(int oldNameIndex, int oldNameSize, int newNameIndex, int newNameSize) { char cOldName[1000], cNewName[1000]; int i, err; if ((oldNameSize >= 1000) || (newNameSize >= 1000)) { return success(false); } /* copy the file names into null-terminated C strings */ for (i = 0; i < oldNameSize; i++) { cOldName[i] = *((char *) (oldNameIndex + i)); } cOldName[oldNameSize] = 0; for (i = 0; i < newNameSize; i++) { cNewName[i] = *((char *) (newNameIndex + i)); } cNewName[newNameSize] = 0; err = rename(cOldName, cNewName); if (err) { return success(false); } } int sqFileSetPosition(SQFile *f, int position) { /* Set the file''s read/write head to the given position. */ if (!!sqFileValid(f)) return success(false); fseek(f->file, position, SEEK_SET); f->lastOp = UNCOMMITTED; } int sqFileSize(SQFile *f) { /* Return the length of the given file. */ if (!!sqFileValid(f)) return success(false); return f->fileSize; } int sqFileValid(SQFile *f) { return ( (f !!= NULL) && (f->file !!= NULL) && (f->sessionID == thisSession)); } int sqFileWriteFromAt(SQFile *f, int count, int byteArrayIndex, int startIndex) { /* Write count bytes to the given writable file starting at startIndex in the given byteArray. (See comment in sqFileReadIntoAt for interpretation of byteArray and startIndex). */ char *src; int bytesWritten, position; if (!!(sqFileValid(f) && f->writable)) return success(false); if (f->lastOp == READ_OP) fseek(f->file, 0, SEEK_CUR); /* seek between reading and writing */ src = (char *) (byteArrayIndex + startIndex); bytesWritten = fwrite(src, 1, count, f->file); position = ftell(f->file); if (position > f->fileSize) { f->fileSize = position; /* update file size */ } if (bytesWritten !!= count) { success(false); } f->lastOp = WRITE_OP; return bytesWritten; } ' ! ! !InterpreterSupportCode class methodsFor: 'source files' stamp: 'dtl 9/13/1999 04:01'! squeakHeaderFile ^ '#include #include #include #include #include #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) #define sqAllocateMemory(minHeapSize, desiredHeapSize) malloc(desiredHeapSize) /* 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 /* this include file may redefine earlier definitions and macros: */ #include "sqPlatformSpecific.h" /* squeak file record; see sqFilePrims.c for details */ #include "sqFile.h" /* 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 ioMicroMSecs(void); int ioMSecs(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); /* cheap clock with coarse resolution (about 17 msecs on Mac). ar 9/6/1999: ''cheap'' on the Mac does not mean cheap on all platforms so put the following in an #ifdef to allow a redefinition in sqPlatformSpecific.h */ #ifndef ioLowResMSecs # define ioLowResMSecs() ((1000 * clock()) / CLOCKS_PER_SEC) #endif /* optional millisecond clock macro */ #ifdef USE_CLOCK_MSECS # define ioMSecs() ((1000 * clock()) / CLOCKS_PER_SEC) #endif /* 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); /* netscape plug-in support */ 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); '. ! ! !InterpreterSupportCode class methodsFor: 'source files' stamp: 'dtl 9/13/1999 21:09'! squeakSQFileHeaderFile ^ '/* 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; /*** Constants ***/ #define UNCOMMITTED 0 #define READ_OP 1 #define WRITE_OP 2 #ifndef SEEK_SET #define SEEK_SET 0 #define SEEK_CUR 1 #define SEEK_END 2 #endif '! ! !InterpreterSupportCode class methodsFor: 'source files' stamp: 'dtl 9/14/1999 05:02'! squeakVirtualMachineFile ^'#include #include #include #include #include #include "sqVirtualMachine.h" /*** Function prototypes ***/ /* InterpreterProxy methodsFor: ''stack access'' */ int pop(int nItems); int popthenPush(int nItems, int oop); int push(int object); int pushBool(int trueOrFalse); int pushFloat(double f); int pushInteger(int integerValue); double stackFloatValue(int offset); int stackIntegerValue(int offset); int stackObjectValue(int offset); int stackValue(int offset); /*** variables ***/ extern int (*compilerHooks[])(); extern int setCompilerInitialized(int flagValue); /* InterpreterProxy methodsFor: ''object access'' */ int argumentCountOf(int methodPointer); void * arrayValueOf(int oop); int byteSizeOf(int oop); void * fetchArrayofObject(int fieldIndex, int objectPointer); int fetchClassOf(int oop); double fetchFloatofObject(int fieldIndex, int objectPointer); int fetchIntegerofObject(int fieldIndex, int objectPointer); int fetchPointerofObject(int index, int oop); int fetchWordofObject(int fieldIndex, int oop); void * firstFixedField(int oop); void * firstIndexableField(int oop); int literalofMethod(int offset, int methodPointer); int literalCountOf(int methodPointer); int methodArgumentCount(void); int methodPrimitiveIndex(void); int primitiveIndexOf(int methodPointer); int sizeOfSTArrayFromCPrimitive(void *cPtr); int slotSizeOf(int oop); int stObjectat(int array, int index); int stObjectatput(int array, int index, int value); int stSizeOf(int oop); int storeIntegerofObjectwithValue(int index, int oop, int integer); int storePointerofObjectwithValue(int index, int oop, int valuePointer); /* InterpreterProxy methodsFor: ''file primitives'' */ int fileRecordSize(void); void * fileValueOf(int); /* InterpreterProxy methodsFor: ''testing'' */ int isKindOf(int oop, char *aString); int isMemberOf(int oop, char *aString); int isBytes(int oop); int isFloatObject(int oop); int isIndexable(int oop); int isIntegerObject(int objectPointer); int isIntegerValue(int intValue); int isPointers(int oop); int isWeak(int oop); int isWords(int oop); int isWordsOrBytes(int oop); /* InterpreterProxy methodsFor: ''converting'' */ int booleanValueOf(int obj); int checkedIntegerValueOf(int intOop); int floatObjectOf(double aFloat); double floatValueOf(int oop); int integerObjectOf(int value); int integerValueOf(int oop); int positive32BitIntegerFor(int integerValue); int positive32BitValueOf(int oop); /* InterpreterProxy methodsFor: ''special objects'' */ int characterTable(void); int displayObject(void); int falseObject(void); int nilObject(void); int trueObject(void); /* InterpreterProxy methodsFor: ''special classes'' */ int classArray(void); int classBitmap(void); int classByteArray(void); int classCharacter(void); int classFloat(void); int classLargePositiveInteger(void); int classPoint(void); int classSemaphore(void); int classSmallInteger(void); int classString(void); /* InterpreterProxy methodsFor: ''instance creation'' */ int clone(int oop); int instantiateClassindexableSize(int classPointer, int size); int makePointwithxValueyValue(int xValue, int yValue); int popRemappableOop(void); int pushRemappableOop(int oop); /* InterpreterProxy methodsFor: ''other'' */ int becomewith(int array1, int array2); int byteSwapped(int w); int failed(void); int fullDisplayUpdate(void); int fullGC(void); int incrementalGC(void); int primitiveFail(void); int showDisplayBitsLeftTopRightBottom(int aForm, int l, int t, int r, int b); int signalSemaphoreWithIndex(int semaIndex); int success(int aBoolean); int superclassOf(int classPointer); /* InterpreterProxy methodsFor: ''BitBlt support'' */ int loadBitBltFrom(int bbOop); int copyBits(void); int copyBitsFromtoat(int leftX, int rightX, int yValue); struct VirtualMachine *VM = NULL; static int majorVersion(void) { return VM_PROXY_MAJOR; } static int minorVersion(void) { return VM_PROXY_MINOR; } static CompilerHook *compilerHookVector(void) { return compilerHooks; } struct VirtualMachine* sqGetInterpreterProxy(void) { if(VM) return VM; VM = (struct VirtualMachine *) calloc(1, sizeof(VirtualMachine)); /* Initialize Function pointers */ VM->majorVersion = majorVersion; VM->minorVersion = minorVersion; /* InterpreterProxy methodsFor: ''stack access'' */ VM->pop = pop; VM->popthenPush = popthenPush; VM->push = push; VM->pushBool = pushBool; VM->pushFloat = pushFloat; VM->pushInteger = pushInteger; VM->stackFloatValue = stackFloatValue; VM->stackIntegerValue = stackIntegerValue; VM->stackObjectValue = stackObjectValue; VM->stackValue = stackValue; /* InterpreterProxy methodsFor: ''object access'' */ VM->argumentCountOf = argumentCountOf; VM->arrayValueOf = arrayValueOf; VM->byteSizeOf = byteSizeOf; VM->fetchArrayofObject = fetchArrayofObject; VM->fetchClassOf = fetchClassOf; VM->fetchFloatofObject = fetchFloatofObject; VM->fetchIntegerofObject = fetchIntegerofObject; VM->fetchPointerofObject = fetchPointerofObject; VM->fetchWordofObject = fetchWordofObject; VM->firstFixedField = firstFixedField; VM->firstIndexableField = firstIndexableField; VM->literalofMethod = literalofMethod; VM->literalCountOf = literalCountOf; VM->methodArgumentCount = methodArgumentCount; VM->methodPrimitiveIndex = methodPrimitiveIndex; VM->primitiveIndexOf = primitiveIndexOf; VM->sizeOfSTArrayFromCPrimitive = sizeOfSTArrayFromCPrimitive; VM->slotSizeOf = slotSizeOf; VM->stObjectat = stObjectat; VM->stObjectatput = stObjectatput; VM->stSizeOf = stSizeOf; VM->storeIntegerofObjectwithValue = storeIntegerofObjectwithValue; VM->storePointerofObjectwithValue = storePointerofObjectwithValue; /* InterpreterProxy methodsFor: ''file primitives'' */ VM->fileRecordSize = fileRecordSize; VM->fileValueOf = fileValueOf; /* InterpreterProxy methodsFor: ''testing'' */ VM->isKindOf = isKindOf; VM->isMemberOf = isMemberOf; VM->isBytes = isBytes; VM->isFloatObject = isFloatObject; VM->isIndexable = isIndexable; VM->isIntegerObject = isIntegerObject; VM->isIntegerValue = isIntegerValue; VM->isPointers = isPointers; VM->isWeak = isWeak; VM->isWords = isWords; VM->isWordsOrBytes = isWordsOrBytes; /* InterpreterProxy methodsFor: ''converting'' */ VM->booleanValueOf = booleanValueOf; VM->checkedIntegerValueOf = checkedIntegerValueOf; VM->floatObjectOf = floatObjectOf; VM->floatValueOf = floatValueOf; VM->integerObjectOf = integerObjectOf; VM->integerValueOf = integerValueOf; VM->positive32BitIntegerFor = positive32BitIntegerFor; VM->positive32BitValueOf = positive32BitValueOf; /* InterpreterProxy methodsFor: ''special objects'' */ VM->characterTable = characterTable; VM->displayObject = displayObject; VM->falseObject = falseObject; VM->nilObject = nilObject; VM->trueObject = trueObject; /* InterpreterProxy methodsFor: ''special classes'' */ VM->classArray = classArray; VM->classBitmap = classBitmap; VM->classByteArray = classByteArray; VM->classCharacter = classCharacter; VM->classFloat = classFloat; VM->classLargePositiveInteger = classLargePositiveInteger; VM->classPoint = classPoint; VM->classSemaphore = classSemaphore; VM->classSmallInteger = classSmallInteger; VM->classString = classString; /* InterpreterProxy methodsFor: ''instance creation'' */ VM->clone = clone; VM->instantiateClassindexableSize = instantiateClassindexableSize; VM->makePointwithxValueyValue = makePointwithxValueyValue; VM->popRemappableOop = popRemappableOop; VM->pushRemappableOop = pushRemappableOop; /* InterpreterProxy methodsFor: ''other'' */ VM->becomewith = becomewith; VM->byteSwapped = byteSwapped; VM->failed = failed; VM->fullDisplayUpdate = fullDisplayUpdate; VM->fullGC = fullGC; VM->incrementalGC = incrementalGC; VM->primitiveFail = primitiveFail; VM->showDisplayBitsLeftTopRightBottom = showDisplayBitsLeftTopRightBottom; VM->signalSemaphoreWithIndex = signalSemaphoreWithIndex; VM->success = success; VM->superclassOf = superclassOf; VM->compilerHookVector= compilerHookVector; VM->setCompilerInitialized= setCompilerInitialized; /* InterpreterProxy methodsFor: ''BitBlt support'' */ VM->loadBitBltFrom = loadBitBltFrom; VM->copyBits = copyBits; VM->copyBitsFromtoat = copyBitsFromtoat; return VM; } '! ! !InterpreterSupportCode class methodsFor: 'source files' stamp: 'dtl 9/13/1999 20:05'! squeakVirtualMachineHeaderFile ^ '#ifndef _SqueakVM_H #define _SqueakVM_H /* Increment the following number if you change the order of functions listed or if you remove functions */ #define VM_PROXY_MAJOR 1 /* Increment the following number if you add functions at the end */ #define VM_PROXY_MINOR 3 typedef int (*CompilerHook)(); struct VirtualMachine* sqGetInterpreterProxy(void); typedef struct VirtualMachine { int (*minorVersion) (void); int (*majorVersion) (void); /* InterpreterProxy methodsFor: ''stack access'' */ int (*pop)(int nItems); int (*popthenPush)(int nItems, int oop); int (*push)(int object); int (*pushBool)(int trueOrFalse); int (*pushFloat)(double f); int (*pushInteger)(int integerValue); double (*stackFloatValue)(int offset); int (*stackIntegerValue)(int offset); int (*stackObjectValue)(int offset); int (*stackValue)(int offset); /* InterpreterProxy methodsFor: ''object access'' */ int (*argumentCountOf)(int methodPointer); void * (*arrayValueOf)(int oop); int (*byteSizeOf)(int oop); void * (*fetchArrayofObject)(int fieldIndex, int objectPointer); int (*fetchClassOf)(int oop); double (*fetchFloatofObject)(int fieldIndex, int objectPointer); int (*fetchIntegerofObject)(int fieldIndex, int objectPointer); int (*fetchPointerofObject)(int index, int oop); int (*fetchWordofObject)(int fieldIndex, int oop); void * (*firstFixedField)(int oop); void * (*firstIndexableField)(int oop); int (*literalofMethod)(int offset, int methodPointer); int (*literalCountOf)(int methodPointer); int (*methodArgumentCount)(void); int (*methodPrimitiveIndex)(void); int (*primitiveIndexOf)(int methodPointer); int (*sizeOfSTArrayFromCPrimitive)(void *cPtr); int (*slotSizeOf)(int oop); int (*stObjectat)(int array, int index); int (*stObjectatput)(int array, int index, int value); int (*stSizeOf)(int oop); int (*storeIntegerofObjectwithValue)(int index, int oop, int integer); int (*storePointerofObjectwithValue)(int index, int oop, int valuePointer); /* InterpreterProxy methodsFor: ''testing'' */ int (*isKindOf)(int oop, char *aString); int (*isMemberOf)(int oop, char *aString); int (*isBytes)(int oop); int (*isFloatObject)(int oop); int (*isIndexable)(int oop); int (*isIntegerObject)(int objectPointer); int (*isIntegerValue)(int intValue); int (*isPointers)(int oop); int (*isWeak)(int oop); int (*isWords)(int oop); int (*isWordsOrBytes)(int oop); /* InterpreterProxy methodsFor: ''converting'' */ int (*booleanValueOf)(int obj); int (*checkedIntegerValueOf)(int intOop); int (*floatObjectOf)(double aFloat); double (*floatValueOf)(int oop); int (*integerObjectOf)(int value); int (*integerValueOf)(int oop); int (*positive32BitIntegerFor)(int integerValue); int (*positive32BitValueOf)(int oop); /* InterpreterProxy methodsFor: ''special objects'' */ int (*characterTable)(void); int (*displayObject)(void); int (*falseObject)(void); int (*nilObject)(void); int (*trueObject)(void); /* InterpreterProxy methodsFor: ''special classes'' */ int (*classArray)(void); int (*classBitmap)(void); int (*classByteArray)(void); int (*classCharacter)(void); int (*classFloat)(void); int (*classLargePositiveInteger)(void); int (*classPoint)(void); int (*classSemaphore)(void); int (*classSmallInteger)(void); int (*classString)(void); /* InterpreterProxy methodsFor: ''instance creation'' */ int (*clone)(int oop); int (*instantiateClassindexableSize)(int classPointer, int size); int (*makePointwithxValueyValue)(int xValue, int yValue); int (*popRemappableOop)(void); int (*pushRemappableOop)(int oop); /* InterpreterProxy methodsFor: ''other'' */ int (*becomewith)(int array1, int array2); int (*byteSwapped)(int w); int (*failed)(void); int (*fullDisplayUpdate)(void); int (*fullGC)(void); int (*incrementalGC)(void); int (*primitiveFail)(void); int (*showDisplayBitsLeftTopRightBottom)(int aForm, int l, int t, int r, int b); int (*signalSemaphoreWithIndex)(int semaIndex); int (*success)(int aBoolean); int (*superclassOf)(int classPointer); /* InterpreterProxy methodsFor: ''compiler'' */ CompilerHook *(*compilerHookVector)(void); int (*setCompilerInitialized)(int initFlag); /* InterpreterProxy methodsFor: ''BitBlt support'' */ int (*loadBitBltFrom)(int bbOop); int (*copyBits)(void); int (*copyBitsFromtoat)(int leftX, int rightX, int yValue); /* InterpreterProxy methodsFor: ''file primitives'' */ int (*fileRecordSize)(void); void * (*fileValueOf)(int); } VirtualMachine; #endif /* _SqueakVM_H */ '! ! !OSPipe commentStamp: '' prior: 0! I represent a pipe provided by the underlying operating system, such as a Unix pipe. I have a reader stream and a writer stream which behave similarly to a read-only FileStream and a writeable FileStream.! !OSPipe methodsFor: 'accessing' stamp: 'dtl 6/2/1999 05:40'! reader "Answer a stream on the read end of the pipe." ^reader! ! !OSPipe methodsFor: 'accessing' stamp: 'dtl 6/2/1999 05:42'! reader: aReadStream reader _ aReadStream! ! !OSPipe methodsFor: 'accessing' stamp: 'dtl 6/2/1999 05:41'! writer "Answer a stream on the write end of the pipe." ^writer! ! !OSPipe methodsFor: 'accessing' stamp: 'dtl 6/2/1999 05:41'! writer: aWriteStream writer _ aWriteStream! ! !OSPipe class methodsFor: 'instance creation' stamp: 'dtl 6/2/1999 05:48'! reader: aReadStream writer: aWriteStream ^super new reader: aReadStream; writer: aWriteStream! ! !OSPipe class methodsFor: 'examples' stamp: 'dtl 7/4/1999 08:36'! testPipe "OSPipe testPipe inspect" | p pipe | p _ OSProcess forThisOSProcess. pipe _ p makePipe. pipe writer nextPutAll: 'this is a test'; close. ^pipe reader next: 14 ! ! !OSProcess commentStamp: '' prior: 0! I am an abstract class representing an operating system process, such as the process in which the Squeak VM is currently running. My subclasses implement system specific features for Unix, Windows, MacOS, or other operating systems by collaborating with corresponding subclasses of OSProcessAccessor to provide primitive access to the external operating system. ! !OSProcess methodsFor: 'accessing' stamp: 'dtl 6/20/1999 12:26'! pid ^pid _ self processAccessor getPid ! ! !OSProcess methodsFor: 'accessing' stamp: 'dtl 7/4/1999 08:32'! processAccessor processAccessor isNil ifTrue: [ processAccessor _ (OSProcessAccessor concreteClassForSystem: self class systemType) forThisOSProcess ]. ^processAccessor! ! !OSProcess methodsFor: 'initialize' stamp: 'dtl 5/31/1999 13:54'! initialize self subclassResponsibility! ! !OSProcess methodsFor: 'printing' stamp: 'dtl 6/26/1999 06:27'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' on pid '. self pid printOn: aStream! ! !MacProcess commentStamp: '' prior: 0! I represent a Macintosh operating system process, such as the process in which the Squeak VM is currently running. I collaborate with an instance of MacOSProcessAccessor to provide primitive access to the external operating system. My instance variables are maintained as a convenience to allow inspection of an OSProcess. Access to these variables should always be done with my accessor methods, which update the instance variables by querying my MacOSProcessAccessor.! !OSProcess class methodsFor: 'instance creation' stamp: 'dtl 7/4/1999 16:05'! forThisOSProcess "Answer a single instance of the class corresponding to the OS process in which this Smalltalk image is executing." "OSProcess forThisOSProcess" ThisOSProcess ifNil: [ ThisOSProcess _ self concreteClass basicNew ]. ^ThisOSProcess initialize. ! ! !OSProcess class methodsFor: 'instance creation' stamp: 'dtl 5/31/1999 12:45'! new self notify: 'use OSProcess>>thisOsProcess to create or obtain the OSProcess instance for this Smalltalk session.'. ^nil! ! !OSProcess class methodsFor: 'accessing' stamp: 'dtl 6/19/1999 10:16'! systemType ^SystemType! ! !OSProcess class methodsFor: 'accessing' stamp: 'dtl 5/31/1999 12:43'! systemType: aSymbol SystemType _ aSymbol! ! !OSProcess class methodsFor: 'initialize-release' stamp: 'dtl 6/19/1999 10:21'! initialize "FIXME: For the time being, this is hard coded to assume we are using a sensible operating system. Change this later when other operating systems are supported." "OSProcess initialize" ThisOSProcess _ nil. self systemType: #unix "self systemType: #mac" "self systemType: #windows"! ! !OSProcess class methodsFor: 'subclass creation' stamp: 'dtl 5/31/1999 13:06'! concreteClass self systemType isNil ifTrue: [ self initialize ]. self systemType = #unix ifTrue: [ ^UnixProcess ]. "Add other system types here..." ^self notify: self printString, ': No concrete class implementation available for system type ', self systemType printString! ! !OSProcess class methodsFor: 'examples' stamp: 'dtl 7/4/1999 08:36'! helloStdErr "Write a message on the standard error stream of the OS process, normally the terminal or window from which Squeak is being run. Most operating systems implement stdin, stdout, and stderr in some manner, so this shown as an OSProcess example even though the implemention is in my subclasses." "OSProcess helloStdErr" ^self forThisOSProcess stdErr nextPutAll: 'Hello stderr'; nextPut: (Character lf); yourself! ! !OSProcess class methodsFor: 'examples' stamp: 'dtl 7/4/1999 08:36'! helloWorld "Write a message on the standard output stream of the OS process, normally the terminal or window from which Squeak is being run. Most operating systems implement stdin, stdout, and stderr in some manner, so this shown as an OSProcess example even though the implemention is in my subclasses." "OSProcess helloWorld" ^self forThisOSProcess stdOut nextPutAll: 'Hello world'; nextPut: Character lf; yourself! ! !OSProcess class methodsFor: 'examples' stamp: 'dtl 9/19/1999 23:23'! readFromStdIn "Type some text on the standard input terminal, followed by or , then call this method. Any available input text in the stdin stream will be read. This method sets standard input for the Squeak OS process for non-blocking reads in order to prevent the Smalltalk image from blocking on the read. After the read, standard input is set back to its normal blocking I/O mode. Most operating systems implement stdin, stdout, and stderr in some manner, so this is shown as an OSProcess example even though the implemention is in my subclasses." "OSProcess readFromStdIn inspect" | ioHandle resultString | ioHandle _ IOHandle newFrom: (self forThisOSProcess stdIn fileID). self forThisOSProcess processAccessor setNonBlocking: ioHandle. resultString _ self forThisOSProcess stdIn next: 10000. self forThisOSProcess processAccessor setBlocking: ioHandle. ^ resultString ! ! !OSProcess class methodsFor: 'examples' stamp: 'dtl 7/4/1999 08:44'! thisSqueakOSProcess "There is one instance of the concrete class for OSProcess, which may be accessed through OSProcess>>forThisOSProcess. After an image restart, the single instance should be initialized with OSProcess>>thisOSProcess>>initialize." "OSProcess thisSqueakOSProcess inspect" ^self forThisOSProcess! ! !OSProcessAccessor commentStamp: '' prior: 0! I am an abstract class whose subclasses provide access to an operating system process, such as the process in which the Squeak VM is currently running. My subclasses collaborate with instances of OSProcess subclasses.! !MacOSProcessAccessor commentStamp: '' prior: 0! I provide access to an operating system process, such as the process in which the Squeak VM is currently running. I am based on the Macintosh process model.! !OSProcessAccessor class methodsFor: 'subclass creation' stamp: 'dtl 5/31/1999 13:15'! concreteClassForSystem: aSymbol aSymbol = #unix ifTrue: [ ^UnixOSProcessAccessor ]. "Add other system types here..." ^self notify: self printString, ': No concrete class implementation available for system type ', aSymbol printString! ! !PluggableCodeGenerator methodsFor: 'C code generator' stamp: 'dtl 9/13/1999 21:43'! emitCHeaderOn: aStream "Write a C file header onto the given stream." aStream nextPutAll: '/* Automatically generated from Squeak on '. aStream nextPutAll: Time dateAndTimeNow printString. aStream nextPutAll: ' */';cr. aStream nextPutAll:' #include #include #include #include #include /* Default EXPORT macro that does nothing (see comment in sq.h): */ #define EXPORT(returnType) returnType /* Do not include the entire sq.h file but just those parts needed. */ /* The virtual machine proxy definition */ #include "sqVirtualMachine.h" /* Configuration options */ #include "sqConfig.h" /* Platform specific definitions */ #include "sqPlatformSpecific.h" /* squeak file record; see sqFilePrims.c for details */ #include "sqFile.h" #define true 1 #define false 0 #define null 0 /* using ''null'' because nil is predefined in Think C */ '. "Additional header files" headerFiles do:[:hdr| aStream nextPutAll:'#include '; nextPutAll: hdr; cr]. aStream nextPutAll: ' /* memory access macros */ #define byteAt(i) (*((unsigned char *) (i))) #define byteAtput(i, val) (*((unsigned char *) (i)) = val) #define longAt(i) (*((int *) (i))) #define longAtput(i, val) (*((int *) (i)) = val) '. aStream cr.! ! !ShellProxy commentStamp: 'dtl 9/18/1999 18:25' prior: 0! I am a proxy for a Unix shell. I communicate to the shell using my input, output and error streams. I know how to start a shell running in an OS process, how to pass lines of text to the shell for processing, and how to terminate the shell when processing is complete.! !ShellProxy methodsFor: 'accessing' stamp: 'dtl 9/18/1999 22:50'! childPid ^ childPid! ! !ShellProxy methodsFor: 'accessing' stamp: 'dtl 9/18/1999 22:50'! childPid: anInteger ^ childPid _ anInteger! ! !ShellProxy methodsFor: 'accessing' stamp: 'dtl 9/18/1999 22:27'! error ^ error! ! !ShellProxy methodsFor: 'accessing' stamp: 'dtl 9/18/1999 22:27'! error: aStream ^ error _ aStream! ! !ShellProxy methodsFor: 'accessing' stamp: 'dtl 9/18/1999 22:27'! input ^ input! ! !ShellProxy methodsFor: 'accessing' stamp: 'dtl 9/18/1999 22:28'! input: aStream ^ input _ aStream! ! !ShellProxy methodsFor: 'accessing' stamp: 'dtl 9/18/1999 22:27'! output ^ output! ! !ShellProxy methodsFor: 'accessing' stamp: 'dtl 9/18/1999 22:28'! output: aStream ^ output _ aStream! ! !ShellProxy methodsFor: 'command processing' stamp: 'dtl 9/29/1999 19:06'! exec: aString "Pass aString to the shell for execution." self input nextPutAll: aString; nextPut: Character lf; flush ! ! !ShellProxy methodsFor: 'close' stamp: 'dtl 9/19/1999 09:15'! close "Clean up everything, and close all pipes to child." self closeChild. output ifNotNil: [ output close. output _ nil]. error ifNotNil: [ error close. error _ nil] ! ! !ShellProxy methodsFor: 'close' stamp: 'dtl 9/29/1999 19:50'! closeChild "Close input pipe to child. Give the child some time to clean up and exit, then send it a termination signal to make sure that it dies. Only the input stream is closed, so objects may remain in the output and error streams." | pidToKill | input ifNotNil: [ input close. input _ nil]. childPid ifNotNil: [ pidToKill _ childPid. [(Delay forSeconds: 5) wait. "Grace period for child to finish any processing" OSProcess forThisOSProcess processAccessor primSendSigpipeTo: pidToKill.] forkAt: Processor userBackgroundPriority. childPid _ nil]. ! ! !ShellProxy class reorganize! ('private' setNonBlocking: setUnbuffered:) ('instance creation' new newShell newShell1 newShell2 newShell3) ('shells' bashShellPath defaultShellPath) ! !ShellProxy class methodsFor: 'private' stamp: 'dtl 9/21/1999 22:31'! setNonBlocking: anIOStream "stdout and stderr for the shell should be set for non-blocking reads." OSProcess forThisOSProcess processAccessor setNonBlocking: (IOHandle newFrom: anIOStream fileID) ! ! !ShellProxy class methodsFor: 'private' stamp: 'dtl 9/21/1999 22:31'! setUnbuffered: anIOStream "stdout and stderr for the shell should be set for non-blocking reads." OSProcess forThisOSProcess processAccessor setUnbuffered: (IOHandle newFrom: anIOStream fileID) ! ! !ShellProxy class methodsFor: 'instance creation' stamp: 'dtl 9/19/1999 23:55'! new "ShellProxy new" ^ self newShell ! ! !ShellProxy class methodsFor: 'instance creation' stamp: 'dtl 9/19/1999 09:28'! newShell "Answer a new instance with only standard input connected." "ShellProxy newShell" ^ self newShell1! ! !ShellProxy class methodsFor: 'instance creation' stamp: 'dtl 9/22/1999 06:09'! newShell1 "Answer an instance with standard input connected. Standard output and standard error for the shell remain connected to their default streams, normally stdout and stderr for the process in which this Squeak instances is running." "ShellProxy newShell1" | this proxy inputPipe desc | this _ OSProcess forThisOSProcess. proxy _ super new. inputPipe _ this makePipe. self setUnbuffered: inputPipe writer. proxy input: inputPipe writer. desc _ Array with: inputPipe reader with: nil with: nil. proxy childPid: (OSProcess concreteClass forkJob: (self defaultShellPath) arguments: nil environment: nil descriptors: desc). ^ proxy ! ! !ShellProxy class methodsFor: 'instance creation' stamp: 'dtl 9/22/1999 06:15'! newShell2 "Answer an instance with standard input and standard output connected. Standard error for the shell remains connected to its default stream, normally stderr for the process in which this Squeak instances is running." "ShellProxy newShell2" | this proxy inputPipe outputPipe desc | this _ OSProcess forThisOSProcess. proxy _ super new. inputPipe _ this makePipe. outputPipe _ this makePipe. self setUnbuffered: inputPipe writer. self setNonBlocking: outputPipe reader. proxy input: inputPipe writer. proxy output: outputPipe reader. desc _ Array with: inputPipe reader with: outputPipe writer with: nil. proxy childPid: (OSProcess concreteClass forkJob: (self defaultShellPath) arguments: nil environment: nil descriptors: desc). ^ proxy ! ! !ShellProxy class methodsFor: 'instance creation' stamp: 'dtl 9/22/1999 06:10'! newShell3 "Answer an instance with standard input, output and error connected." "ShellProxy newShell3" | this proxy inputPipe outputPipe errorPipe desc | this _ OSProcess forThisOSProcess. proxy _ super new. inputPipe _ this makePipe. outputPipe _ this makePipe. errorPipe _ this makePipe. self setUnbuffered: inputPipe writer. self setNonBlocking: outputPipe reader. self setNonBlocking: errorPipe reader. proxy input: inputPipe writer. proxy output: outputPipe reader. proxy error: errorPipe reader. desc _ Array with: inputPipe reader with: outputPipe writer with: errorPipe writer. proxy childPid: (OSProcess concreteClass forkJob: (self defaultShellPath) arguments: nil environment: nil descriptors: desc). ^ proxy ! ! !ShellProxy class methodsFor: 'shells' stamp: 'dtl 9/18/1999 18:31'! bashShellPath "A more full-featured shell from the Free Software Foundation" ^ '/usr/bin/bash'! ! !ShellProxy class methodsFor: 'shells' stamp: 'dtl 9/29/1999 18:59'! defaultShellPath "Default shell to run" ^ '/bin/sh'! ! !ShellWindow commentStamp: 'dtl 10/4/1999 11:07' prior: 0! I represent a window on a shell process. Standard output from a command is displayed in my window. This is just a quick hack to get the idea across.! !ShellWindow reorganize! ('accessing' shellProxy shellProxy: stdErrProcess stdErrProcess: stdOutProcess stdOutProcess: windowName windowName: windowStream windowStream: windowView windowView:) ('initialize - release' close initialize open) ('command processing' exec:) ('private' errorReader outputReader) ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/20/1999 20:20'! shellProxy ^ shellProxy! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/20/1999 20:22'! shellProxy: aShellProxy ^ shellProxy _ aShellProxy! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/29/1999 19:29'! stdErrProcess "Answer a process which copies standard error from the shell to the window view. Start the process if it does not yet exist." stdErrProcess ifNil: [stdErrProcess _ self errorReader forkAt: Processor userInterruptPriority ]. ^ stdErrProcess ! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/29/1999 19:26'! stdErrProcess: aProcess ^ stdErrProcess _ aProcess! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/22/1999 05:33'! stdOutProcess "Answer a process which copies output from the shell to the window view. Start the process if it does not yet exist." stdOutProcess ifNil: [stdOutProcess _ self outputReader forkAt: Processor userInterruptPriority ]. ^ stdOutProcess ! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/20/1999 20:22'! stdOutProcess: aProcess ^ stdOutProcess _ aProcess! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/20/1999 20:26'! windowName ^ windowName! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/20/1999 20:26'! windowName: aString ^ windowName _ aString! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/20/1999 20:21'! windowStream ^ windowStream! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/20/1999 20:22'! windowStream: aTranscriptStream ^ windowStream _ aTranscriptStream! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/22/1999 05:19'! windowView ^ windowView! ! !ShellWindow methodsFor: 'accessing' stamp: 'dtl 9/22/1999 05:19'! windowView: aSystemWindow ^ windowView _ aSystemWindow! ! !ShellWindow methodsFor: 'initialize - release' stamp: 'dtl 9/29/1999 19:34'! close self stdOutProcess terminate. self stdErrProcess terminate. self shellProxy close. self windowView delete ! ! !ShellWindow methodsFor: 'initialize - release' stamp: 'dtl 9/29/1999 19:27'! initialize windowName _ 'shell transcript'. shellProxy _ ShellProxy newShell3. windowStream _ TranscriptStream new. windowView _ windowStream openLabel: windowName. self stdOutProcess. self stdErrProcess ! ! !ShellWindow methodsFor: 'initialize - release' stamp: 'dtl 9/21/1999 04:52'! open! ! !ShellWindow methodsFor: 'command processing' stamp: 'dtl 9/22/1999 05:13'! exec: aString "Pass aString to the shell for execution." shellProxy exec: aString ! ! !ShellWindow methodsFor: 'private' stamp: 'dtl 9/29/1999 19:32'! errorReader "Answer a block which may be run as a process to copy standard error from the shell to the window view." | d s | d _ Delay forMilliseconds: 200. ^ [ [true] whileTrue: [ [s _ shellProxy error next: 1024. s size > 0] whileTrue: [ s replaceAll: Character lf with: Character cr. windowStream nextPutAll: s; endEntry]. d wait]]! ! !ShellWindow methodsFor: 'private' stamp: 'dtl 10/4/1999 11:12'! outputReader "Answer a block which may be run as a process to copy standard output from the shell to the window view." | d s | d _ Delay forMilliseconds: 120. ^ [ [true] whileTrue: [ [s _ shellProxy output next: 1024. s size > 0] whileTrue: [ s replaceAll: Character lf with: Character cr. windowStream nextPutAll: s; endEntry]. d wait]]! ! !ShellWindow class methodsFor: 'examples' stamp: 'dtl 10/4/1999 11:15'! example "Note: Move the mouse over the transcript window to activate output, otherwise you will just see a blank window." "ShellWindow example" |w| w _ ShellWindow new. w exec: 'ls -l /etc'. (Delay forSeconds: 5) wait. w close ! ! !ShellWindow class methodsFor: 'instance creation' stamp: 'dtl 10/4/1999 11:04'! new ^ super new initialize ! ! !StandardFileStream methodsFor: 'access' stamp: 'dtl 10/3/1999 15:06'! fileID "Answer the ByteArray which represents the file ID. This is a SQFile data structure in the virtual machine. This method is used to support pluggable primitives which may need low level access to the SQFile structure -dtl." ^ fileID! ! !AttachableFileStream commentStamp: '' prior: 0! I am a stream on an input or output device which may be provided by the underlying operating system. I behave like an ordinary file stream, except that I can attach myself to an input or output stream which has already been opened by the underlying operating system.! !AttachableFileStream methodsFor: 'private' stamp: 'dtl 6/15/1999 21:40'! isFileID: anObject "Answer true if anObject can be used as a fileID (an SQFile data structure in the Squeak virtual machine C code)." ^(anObject species = ByteArray) and: [anObject size = 20]! ! !AttachableFileStream methodsFor: 'attaching' stamp: 'dtl 9/29/1999 18:37'! name: aSymbolOrString attachTo: anIOHandle "Attach to an existing file handle, assumed to have been previously opened by the underlying operating system." name _ aSymbolOrString. fileID _ anIOHandle asSQFileStruct. anIOHandle writable ifTrue: [ self readWrite ] ifFalse: [ self readOnly ]. self ascii. self register! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:00'! ensureOpen self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:00'! open self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:01'! open: fileName forWrite: writeMode self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:02'! openReadOnly self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:02'! reopen self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'read, write, position' stamp: 'dtl 10/3/1999 14:11'! flush "Flush the external OS stream (the one in the C library)." OSProcess thisSqueakOSProcess processAccessor flushExternalStream: (IOHandle newFrom: self fileID) ! ! Smalltalk renameClassNamed: #OSPipeFileStream as: #OSPipeStream! !OSPipeStream commentStamp: '' prior: 0! I know how to properly close a pipe stream.! !OSPipeStream methodsFor: 'primitives' stamp: 'dtl 9/29/1999 19:40'! primClose: aFileID "Overridden to force a file descriptor close on the pipe. This may be entirely useless; I'm trying to find a way to cause the child process at the end of a pipe to terminate when no more input is available." ^nil! ! !UnixOSProcessAccessor commentStamp: '' prior: 0! I provide access to an operating system process, such as the process in which the Squeak VM is currently running. I am based on the Unix process model. There is only one instance of me, and this instance is normally associated with an instance ofUnixOSProcess with which I collaborate. I make use of a semaphore to signal death of child processes, and creation of more than one instance of me is likely to confuse the process responsible for cleaning up after child processes. ! !UnixOSProcessAccessor reorganize! ('private' cFileStructFrom: dupToStdErr: dupToStdIn: dupToStdOut: environmentPutCString: fileDescriptorFrom: primGetStdErrHandle primGetStdInHandle primGetStdOutHandle primSQFileFlush: primSQFileSetBlocking: primSQFileSetNonBlocking: primSQFileSetUnbuffered: reapChildProcess: setSigChldHandler) ('accessing' registeredStrings setSemaIndex:) ('printing' printOn:) ('initialize - release' initialize) ('external process access' argumentAt: environmentAt: environmentAt:put: environmentAtIndex: environmentPut: environmentPutWithMalloc: getPPid getPid getSession getStdErrHandle getStdInHandle getStdOutHandle putPath:) ('fork and exec' forkAndExec:withArgs:argCount:withEnv:envCount:stdIn:stdOut:stdErr: forkHeadlessSqueak forkSqueak getChildExitStatus:) ('pipe open' makePipeHandles primMakePipe) ('display handling' killDisplay) ('OS signal sending' primSendSigabrtTo: primSendSigalrmTo: primSendSigchldTo: primSendSigcontTo: primSendSighupTo: primSendSigintTo: primSendSigkillTo: primSendSigpipeTo: primSendSigquitTo: primSendSigstopTo: primSendSigtermTo: primSendSigusr1To: primSendSigusr2To:) ('file control' flushExternalStream: setBlocking: setNonBlocking: setUnbuffered:) ('utilities' byteArrayFromInteger: integerFromByteArray:) ('primitives - files' primitiveGetStdErrHandle primitiveGetStdInHandle primitiveGetStdOutHandle primitiveSQFileFlush primitiveSQFileSetBlocking primitiveSQFileSetNonBlocking primitiveSQFileSetUnbuffered) ('primitives - pipes' primitiveClosePipeStream primitiveMakePipe) ('primitives - OS signals' primitiveSendSigabrtTo: primitiveSendSigalrmTo: primitiveSendSigchldTo: primitiveSendSigcontTo: primitiveSendSighupTo: primitiveSendSigintTo: primitiveSendSigkillTo: primitiveSendSigpipeTo: primitiveSendSigquitTo: primitiveSendSigstopTo: primitiveSendSigtermTo: primitiveSendSigusr1To: primitiveSendSigusr2To:) ('primitives - fork and exec' primitiveForkAndExec primitiveForkHeadlessSqueak primitiveForkSqueak) ('primitives - OS process access' primitiveGetArgByIndex primitiveGetEnv primitiveGetEnvByIndex primitiveGetPPid primitiveGetPid primitiveGetSession primitivePutEnv primitivePutEnvWithMalloc primitiveReapChildProcess primitiveSetSemaIndex) ('primitives - other' primitiveConvertFourBytesToInteger primitiveConvertIntegerToFourBytes primitiveKillDisplay) ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 6/14/1999 22:30'! cFileStructFrom: aFileHandle "Answer the Unix FILE stream, as a C *FILE struct, from a SQFile ByteArray file handle; or answer NULL if unable to obtain the result (probably due to receiving an incorrect type of object as aFileHandle). This method may be called from a primitive, and is not intended to be called from Smalltalk." | sqFile osFileStream | self returnTypeC: 'FILE *'. self var: 'sqFile' declareC: 'SQFile *sqFile'. self var: 'osFileStream' declareC: 'FILE *osFileStream'. sqFile _ interpreterProxy fileValueOf: aFileHandle. sqFile = 0 ifTrue: [ ^0 ] "Something is wrong, bail out before we core dump." ifFalse: [ ^osFileStream _ self cCode: 'sqFile->file' ] ! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 6/14/1999 22:32'! dupToStdErr: anSQFileDataStructure "Dup a file descriptor to allow it to be attached as the standard error when we exec() a new executable. This is Unix specific, in that it assumes that file descriptor 0 is stdin, 1 is stdout, and 2 is stderr. The dup2() call is used to copy the open file descriptors into file descriptors 0, 1 and 2 so that the image which we execute will use them as stdin, stdout, and stderr. This should be called only from within a primitive. It is not intended to be called as a Smalltalk method." | filenoToDup | filenoToDup _ self fileDescriptorFrom: anSQFileDataStructure. (filenoToDup < 0) ifFalse: [ (filenoToDup = 2) ifFalse: [ self cCode: 'fflush(stderr)'. self cCode: 'dup2(filenoToDup, 2)' ]]! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 6/14/1999 22:32'! dupToStdIn: anSQFileDataStructure "Dup a file descriptor to allow it to be attached as the standard input when we exec() a new executable. This is Unix specific, in that it assumes that file descriptor 0 is stdin, 1 is stdout, and 2 is stderr. The dup2() call is used to copy the open file descriptors into file descriptors 0, 1 and 2 so that the image which we execute will use them as stdin, stdout, and stderr. This should be called only from within a primitive. It is not intended to be called as a Smalltalk method." | filenoToDup | filenoToDup _ self fileDescriptorFrom: anSQFileDataStructure. (filenoToDup < 0) ifFalse: [ (filenoToDup = 0) ifFalse: [ self cCode: 'fflush(stdin)'. self cCode: 'dup2(filenoToDup, 0)'. self cCode: 'rewind(stdin)' ]] "Set stream positioning for stdin."! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 6/14/1999 22:32'! dupToStdOut: anSQFileDataStructure "Dup a file descriptor to allow it to be attached as the standard output when we exec() a new executable. This is Unix specific, in that it assumes that file descriptor 0 is stdin, 1 is stdout, and 2 is stderr. The dup2() call is used to copy the open file descriptors into file descriptors 0, 1 and 2 so that the image which we execute will use them as stdin, stdout, and stderr. This should be called only from within a primitive. It is not intended to be called as a Smalltalk method." | filenoToDup | filenoToDup _ self fileDescriptorFrom: anSQFileDataStructure. (filenoToDup < 0) ifFalse: [ (filenoToDup = 1) ifFalse: [ self cCode: 'fflush(stdout)'. self cCode: 'dup2(filenoToDup, 1)' ]] ! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/18/1999 17:59'! environmentPutCString: aString "Add or update an environment variable in the external OS process using a 'KEY=value' string. The string is expected to be null terminated (that is, its last element is Character value: 0), and should be registered as an external object (SystemDictionary>>registerExternalObject) to protect it from the garbage collector." ^nil! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 6/14/1999 22:31'! fileDescriptorFrom: aFileHandle "Answer the OS file descriptor, an integer value, from a SQFile data structure, or answer -1 if unable to obtain the file descriptor (probably due to receiving an incorrect type of object as aFileHandle). This method may be called from a primitive, and is not intended to be called from Smalltalk." | sqFile osFileStream | self var: 'sqFile' declareC: 'SQFile *sqFile'. self var: 'osFileStream' declareC: 'FILE *osFileStream'. sqFile _ interpreterProxy fileValueOf: aFileHandle. sqFile = 0 ifTrue: [ ^ -1 ] "Something is wrong, bail out before we core dump." ifFalse: [ osFileStream _ self cCode: 'sqFile->file'. ^self cCode: 'fileno(osFileStream)' ] ! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/29/1999 18:22'! primGetStdErrHandle "Answer the handle (a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing." ^nil! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/29/1999 18:22'! primGetStdInHandle "Answer the handle (a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing." ^nil! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/29/1999 18:23'! primGetStdOutHandle "Answer the handle (a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing." ^nil! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/22/1999 05:52'! primSQFileFlush: aSQFileStruct "Pass a struct SQFile on the stack, flush the external file stream." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/19/1999 23:01'! primSQFileSetBlocking: aSQFileStruct "Pass a struct SQFile on the stack, and call fcntl() to set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/19/1999 22:55'! primSQFileSetNonBlocking: aSQFileStruct "Pass a struct SQFile on the stack, and call fcntl() to set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/21/1999 22:29'! primSQFileSetUnbuffered: aSQFileStruct "Pass a struct SQFile on the stack, set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 9/16/1999 13:09'! reapChildProcess: sigNum "This is a signal handler for SIGCHLD. It is not meant to be called from Smalltalk, and should only be called indirectly as a result of a death of child signal in C. Child processes must be cleaned up by the parent, otherwise they continue to exist as zombies until the parent exits. This handler resets the signal handler to catch the next SIGCHLD signal, then calls wait() to acknowledge the SIGCHLD signal and clean up the child process. Note: If child processes die faster than we can clean them up, signals will be lost and child processes will remain as zombies." self returnTypeC: 'void'. self cCode: 'setSigChldHandler()'. "Reset handler" (semaIndexForThisOSProcessAccessor > 0) ifTrue: [ self signalSemaphoreWithIndex: semaIndexForThisOSProcessAccessor ] ifFalse: [ "Semaphore has not been set up yet, so do nothing" ] ! ! !UnixOSProcessAccessor methodsFor: 'private' stamp: 'dtl 6/28/1999 22:23'! setSigChldHandler (sigChldHandler = 0) ifTrue: [ self cCode: 'sigChldHandler = reapChildProcess'. self cCode: 'if (signal(SIGCHLD, sigChldHandler) == SIG_ERR) { perror("signal"); }' ] ! ! !UnixOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 9/18/1999 17:58'! registeredStrings "Answer a dictionary of strings and their registry index values, for special objects registered by the SystemDictionary>>registerExteralObject: method. The name of this method does not match the instance variable name in order to avoid conflicting global declarations in the translated C code." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ externalStringRegistry isNil ifTrue: [ externalStringRegistry _ Dictionary new ]. ^externalStringRegistry ]! ! !UnixOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 7/3/1999 11:36'! setSemaIndex: anInteger "Tell the virtual machine what semaphore to use when handling a death of child signal." ^anInteger! ! !UnixOSProcessAccessor methodsFor: 'printing' stamp: 'dtl 9/18/1999 17:57'! printOn: aStream "In English, say 'a Unix' rather than 'an Unix'. Therefore do not use super printOn, which treats $U as a vowel." self cCode: '/* This method called only from Smalltalk. */' inSmalltalk: [ aStream nextPutAll: 'a '; nextPutAll: self class name; nextPutAll: ' on pid '; nextPutAll: self getPid printString ] ! ! !UnixOSProcessAccessor methodsFor: 'initialize - release' stamp: 'dtl 9/18/1999 17:57'! initialize "Call this method once prior to setting any environment variables with the environmentPut: method. This cleans up in the event that this object is left over from a previous session." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ externalStringRegistry _ nil ]! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 9/18/1999 17:50'! argumentAt: index "Answer the argument string in the argument OS process argument list at position index. In Unix, the first element of the list is the program name, and any additional elements of the list are optional command line arguments passed to the program. This convention may be simulated by the C runtime libraries on other operating systems, but argument list handling should be assumed to be operating system dependent." ^nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 6/19/1999 23:24'! environmentAt: aSymbol "Answer the value of an environment variable in the external OS process." ^nil ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 9/18/1999 17:51'! environmentAt: aSymbolOrString put: aString "Add or update an environment variable in the external OS process. Convert aSymbol and aString into a KEY=value string and pass this to the OS process environment. Standard C libraries provide a putenv() function for this purpose, with a parameter in the form KEY=value. Note: Maintain a reference to the return value, see note in primitivePutEnv." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ ^self environmentPut: (aSymbolOrString asString, '=', aString) ] ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 9/18/1999 17:51'! environmentAtIndex: index "Answer the environment string at index position in the OS process environment list. This returns a 'KEY=value' string, which the caller is expected to parse into #KEY and 'value' to be stored an environment dictionary." ^nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 9/18/1999 17:52'! environmentPut: aString "Add or update an environment variable in the external OS process using a 'KEY=value' string. Create a null terminated string for use by the external putenv() call in a pluggable primitive, and register it with the SystemDictionary to protect it from the garbage collection. The string will be automatically unregistered when the Smalltalk image is restarted." "WARNING: I am not entirely certain that registering strings in the system dictionary actually prevents them from being moved. If they do get moved, then the environment will be invalid. For now, this seems to work, but if there is a problem, try using the environmentPutWithMalloc version of this method. - dtl" "anOSProcessAccessor environmentPut: 'SHELL=/bin/sh'" | cString stringIndex | self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ cString _ aString, (Character value: 0) asString. stringIndex _ Smalltalk registerExternalObject: cString. self registeredStrings at: cString put: stringIndex. ^self environmentPutCString: cString ] ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 9/18/1999 17:52'! environmentPutWithMalloc: aString "Add or update an environment variable in the external OS process using a 'KEY=value' string." ^nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 9/18/1999 17:52'! getPPid "Answer the OS process ID for the parent process of the OS process in which I am currently executing." ^nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 6/19/1999 23:23'! getPid "Answer the OS process ID for the OS process in which I am currently executing." ^nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 6/19/1999 23:26'! getSession "Answer the unique identifier for this session of Smalltalk running in this OS Process." ^nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 10/2/1999 13:28'! getStdErrHandle "Answer the handle (a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ ^ IOHandle newFrom: self primGetStdErrHandle] ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 10/2/1999 13:29'! getStdInHandle "Answer the handle (a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ ^ IOHandle newFrom: self primGetStdInHandle] ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 10/2/1999 13:29'! getStdOutHandle "Answer the handle (a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ ^ IOHandle newFrom: self primGetStdOutHandle] ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 5/30/1999 12:30'! putPath: aString "Convenience method. Set the environment PATH variable to aString." | pathString | self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ pathString _ 'PATH=', aString, ((Character value: 0) asString). ^self environmentPut: pathString ] ! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 6/19/1999 23:28'! forkAndExec: executableFile withArgs: anArrayOfArgumentStrings argCount: numberOfArgumentStrings withEnv: anArrayOfEnvironmentStrings envCount: numberOfEnvironmentStrings stdIn: inputFileHandle stdOut: outputFileHandle stdErr: errorFileHandle "Parameters are expected to have been properly prepared by the caller, including string values which are to be null terminated strings. In other words, all strings should have (Character value: 0) as the last element in the string. Parameters should be: executableFile: a string with the name of a file to execute args: a possibly empty array of strings env: either nil, or an array of 'KEY=value' strings stdIn: either nil, or a fileID ByteArray (struct SQFile in C) to be used as standard input stdOut: either nil, or fileID ByteArray to be used as standard output stdErr: either nil, or a fileID ByteArray to be used as standard error Parameters with nil value indicate that current values for this process should be used." ^nil ! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 10/4/1999 12:35'! forkHeadlessSqueak "Clone this Squeak Smalltalk image in a child OSProcess. The child is the same as the parent, except for its new X session connection, and the return value of this method, which is zero for the child process, and a positive integer equal to the pid of the child for the parent process. The child will not have access to the X display. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." ^nil! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 10/4/1999 12:35'! forkSqueak "Clone this Squeak Smalltalk image in a child OSProcess. The child is the same as the parent, except for its new X session connection, and the return value of this method, which is zero for the child process, and a positive integer equal to the pid of the child for the parent process. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." ^nil! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 7/3/1999 12:15'! getChildExitStatus: childPid "Clean up after the death of a child process, and answer the exit status of the child process." ^ -1! ! !UnixOSProcessAccessor methodsFor: 'pipe open' stamp: 'dtl 10/2/1999 13:29'! makePipeHandles "Create a pipe, and answer an array of two IOHandles for the pipe reader and writer." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ ^ self primMakePipe collect: [:e | IOHandle newFrom: e]] ! ! !UnixOSProcessAccessor methodsFor: 'pipe open' stamp: 'dtl 9/29/1999 17:37'! primMakePipe "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^nil! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 9/18/1999 13:06'! killDisplay "Call an internal function which will disconnect the X display session." "OSProcess forThisOSProcess processAccessor killDisplay" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:08'! primSendSigabrtTo: anIntegerPid "Send SIGABRT (abort) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:08'! primSendSigalrmTo: anIntegerPid "Send SIGALRM (alarm) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:11'! primSendSigchldTo: anIntegerPid "Send SIGCHLD (child status has changed, usually death of child) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:12'! primSendSigcontTo: anIntegerPid "Send SIGCONT (continue) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:13'! primSendSighupTo: anIntegerPid "Send SIGHUP (hangup) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:13'! primSendSigintTo: anIntegerPid "Send SIGINT (interrupt) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:14'! primSendSigkillTo: anIntegerPid "Send SIGKILL (kill, unblockable) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:18'! primSendSigpipeTo: anIntegerPid "Send SIGPIPE (broken pipe) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:19'! primSendSigquitTo: anIntegerPid "Send SIGQUIT (quit) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:19'! primSendSigstopTo: anIntegerPid "Send SIGSTOP (stop, unblockable) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:19'! primSendSigtermTo: anIntegerPid "Send SIGTERM (termination) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:38'! primSendSigusr1To: anIntegerPid "Send SIGUSR1 (User-defined signal 1) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 9/17/1999 14:38'! primSendSigusr2To: anIntegerPid "Send SIGUSR2 (User-defined signal 2) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 10/2/1999 13:31'! flushExternalStream: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to flush the external I/O stream." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ (anIOHandle species = IOHandle) ifFalse: [ self error: 'invalid argument' ]. ^ self primSQFileFlush: anIOHandle asSQFileStruct ] ! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 10/2/1999 13:32'! setBlocking: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set for blocking I/O." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ (anIOHandle species = IOHandle) ifFalse: [ self error: 'invalid argument' ]. ^ self primSQFileSetBlocking: anIOHandle asSQFileStruct ] ! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 10/2/1999 13:32'! setNonBlocking: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set it non-blocking." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ (anIOHandle species = IOHandle) ifFalse: [ self error: 'invalid argument' ]. ^ self primSQFileSetNonBlocking: anIOHandle asSQFileStruct ] ! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 10/2/1999 13:33'! setUnbuffered: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set unbuffered I/O." self cCode: '/* This method is not called directly from VM code. */' inSmalltalk: [ (anIOHandle species = IOHandle) ifFalse: [ self error: 'invalid argument' ]. ^ self primSQFileSetUnbuffered: anIOHandle asSQFileStruct ] ! ! !UnixOSProcessAccessor methodsFor: 'utilities' stamp: 'dtl 9/19/1999 13:17'! byteArrayFromInteger: anInteger "Convert anInteger to a ByteArray of size four, using machine dependent byte ordering." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'utilities' stamp: 'dtl 9/19/1999 13:19'! integerFromByteArray: aByteArray "Convert a four byte ByteArray to an integer, using machine dependent byte ordering." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'primitives - files' stamp: 'dtl 9/18/1999 17:42'! primitiveGetStdErrHandle "Answer the file handle for standard error of my OS process" | file thisSession fileOop | self var: 'file' declareC: 'SQFile *file'. self var: 'thisSession' declareC: 'extern int thisSession'. fileOop _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: interpreterProxy fileRecordSize. file _ interpreterProxy fileValueOf: fileOop. self cCode: 'file->file = stderr'. self cCode: 'file->sessionID = thisSession'. self cCode: 'file->writable = 1'. self cCode: 'file->lastOp = 0'. interpreterProxy pop: 1; push: fileOop ! ! !UnixOSProcessAccessor methodsFor: 'primitives - files' stamp: 'dtl 9/18/1999 17:43'! primitiveGetStdInHandle "Answer the file handle for standard input of my OS process" | file thisSession fileOop | self var: 'file' declareC: 'SQFile *file'. self var: 'thisSession' declareC: 'extern int thisSession'. fileOop _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: interpreterProxy fileRecordSize. file _ interpreterProxy fileValueOf: fileOop. self cCode: 'file->file = stdin'. self cCode: 'file->sessionID = thisSession'. self cCode: 'file->writable = 0'. self cCode: 'file->lastOp = 0'. interpreterProxy pop: 1; push: fileOop ! ! !UnixOSProcessAccessor methodsFor: 'primitives - files' stamp: 'dtl 9/18/1999 17:43'! primitiveGetStdOutHandle "Answer the file handle for standard output of my OS process" | file thisSession fileOop | self var: 'file' declareC: 'SQFile *file'. self var: 'thisSession' declareC: 'extern int thisSession'. fileOop _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: interpreterProxy fileRecordSize. file _ interpreterProxy fileValueOf: fileOop. self cCode: 'file->file = stdout'. self cCode: 'file->sessionID = thisSession'. self cCode: 'file->writable = 1'. self cCode: 'file->lastOp = 0'. interpreterProxy pop: 1; push: fileOop ! ! !UnixOSProcessAccessor methodsFor: 'primitives - files' stamp: 'dtl 9/21/1999 20:27'! primitiveSQFileFlush "Take a struct SQFile from the stack, and call fflush() to flush the OS stream. This flushes the file stream in the C library, not the stream in Smalltalk. For output streams, consider setting the OS stream (C library) to unbuffered output, and letting Smalltalk do all the buffering." | thisSession sqFile retVal | self var: 'sqFile' declareC: 'SQFile *sqFile'. self var: 'thisSession' declareC: 'extern int thisSession'. sqFile _ interpreterProxy fileValueOf: (interpreterProxy stackValue: 0). (thisSession = (self cCode: 'sqFile->sessionID' inSmalltalk: [-1])) ifFalse: [interpreterProxy primitiveFail; pop: 2; pushInteger: -1] ifTrue: [retVal _ self cCode: 'fflush(sqFile->file)'. interpreterProxy pop: 2; pushInteger: retVal] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - files' stamp: 'dtl 9/19/1999 23:00'! primitiveSQFileSetBlocking "Take a struct SQFile from the stack, and call fcntl() to set the file for blocking I/O." | thisSession sqFile sqFileOop descriptor flags retVal | self var: 'sqFile' declareC: 'SQFile *sqFile'. self var: 'thisSession' declareC: 'extern int thisSession'. sqFileOop _ interpreterProxy stackValue: 0. sqFile _ interpreterProxy fileValueOf: sqFileOop. (thisSession = (self cCode: 'sqFile->sessionID' inSmalltalk: [-1])) ifFalse: [ interpreterProxy primitiveFail; pop: 2; pushInteger: -1 ] ifTrue: [ descriptor _ self fileDescriptorFrom: sqFileOop. flags _ self cCode: 'fcntl(descriptor, F_GETFL)'. retVal _ self cCode: 'fcntl(descriptor, F_SETFL, flags & ~O_NONBLOCK)'. interpreterProxy pop: 2; pushInteger: retVal ] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - files' stamp: 'dtl 9/19/1999 22:54'! primitiveSQFileSetNonBlocking "Take a struct SQFile from the stack, and call fcntl() to set the file non-blocking." | thisSession sqFile sqFileOop descriptor flags retVal | self var: 'sqFile' declareC: 'SQFile *sqFile'. self var: 'thisSession' declareC: 'extern int thisSession'. sqFileOop _ interpreterProxy stackValue: 0. sqFile _ interpreterProxy fileValueOf: sqFileOop. (thisSession = (self cCode: 'sqFile->sessionID' inSmalltalk: [-1])) ifFalse: [ interpreterProxy primitiveFail; pop: 2; pushInteger: -1 ] ifTrue: [ descriptor _ self fileDescriptorFrom: sqFileOop. flags _ self cCode: 'fcntl(descriptor, F_GETFL)'. retVal _ self cCode: 'fcntl(descriptor, F_SETFL, flags | O_NONBLOCK)'. interpreterProxy pop: 2; pushInteger: retVal ] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - files' stamp: 'dtl 9/21/1999 20:40'! primitiveSQFileSetUnbuffered "Take a struct SQFile from the stack, and call setbuf() to set the OS file stream (implemented in the C library) for unbuffered I/O. Answers the result of a fflush() call, not the result of the setbuf() call (which is type void). This is nearly useless, but may at least provide an indicator that we are operating on a valid file stream." | thisSession sqFile retVal | self var: 'sqFile' declareC: 'SQFile *sqFile'. self var: 'thisSession' declareC: 'extern int thisSession'. sqFile _ interpreterProxy fileValueOf: (interpreterProxy stackValue: 0). (thisSession = (self cCode: 'sqFile->sessionID' inSmalltalk: [-1])) ifFalse: [interpreterProxy primitiveFail; pop: 2; pushInteger: -1] ifTrue: [retVal _ self cCode: 'fflush(sqFile->file)'. self cCode: 'setbuf(sqFile->file, NULL)'. interpreterProxy pop: 2; pushInteger: retVal] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - pipes' stamp: 'dtl 9/29/1999 04:07'! primitiveClosePipeStream "Close an open pipe stream and answer the exit status of the child process using the pipe. This is the pclose() call to close a child process which was opened with popen(). The caller is responsible to ensure that this is a pipe stream and not an ordinary file stream." | sqFile sqFilePtr descriptor exitStatus | interpreterProxy var: 'sqFilePtr' declareC: 'SQFile *sqFilePtr'. sqFile _ interpreterProxy stackObjectValue: 0. sqFilePtr _ interpreterProxy fileValueOf: sqFile. (self sqFileValid: sqFilePtr) ifTrue: [ " (sqFilePtr = 0) ifFalse: [" "exitStatus _ self cCode: 'pclose(sqFilePtr->file)'." descriptor _ self fileDescriptorFrom: sqFile. self cCode: 'fflush(sqFilePtr->file)'. self cCode: 'fclose(sqFilePtr->file)'. self cCode: 'close(descriptor)'. self cCode: 'sqFilePtr->file = NULL'. self cCode: 'sqFilePtr->sessionID = 0'. self cCode: 'sqFilePtr->writable = false'. self cCode: 'sqFilePtr->lastOp = UNCOMMITTED' ]. interpreterProxy pop: 1 "interpreterProxy pop: 2; pushInteger: exitStatus"! ! !UnixOSProcessAccessor methodsFor: 'primitives - pipes' stamp: 'dtl 9/18/1999 17:30'! primitiveMakePipe "Create a pipe, and answer an array of two file handles for the pipe writer and reader." | reader writer readerPtr writerPtr filedes thisSession arrayResult | self var: 'readerPtr' declareC: 'SQFile *readerPtr'. self var: 'writerPtr' declareC: 'SQFile *writerPtr'. self var: 'arrayPtr' declareC: 'int *arrayPtr'. self var: 'filedes' declareC: 'int filedes[2]'. self var: 'thisSession' declareC: 'extern int thisSession'. self setSigChldHandler. arrayResult _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. reader _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: interpreterProxy fileRecordSize. readerPtr _ interpreterProxy fileValueOf: reader. writer _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: interpreterProxy fileRecordSize. writerPtr _ interpreterProxy fileValueOf: writer. ((self cCode: 'pipe(filedes)') = -1) "Create a pipe." ifTrue: [ interpreterProxy primitiveFail] "Error on the pipe() call" ifFalse: [ "Pipe successfully created" self cCode: 'readerPtr->file = (FILE *) fdopen (filedes[0], "r")'. "Read stream on the reader end of pipe" self cCode: 'readerPtr->sessionID = thisSession'. self cCode: 'readerPtr->writable = 0'. self cCode: 'readerPtr->lastOp = 0'. self cCode: 'writerPtr->file = (FILE *) fdopen (filedes[1], "a")'. "Write stream on the writer end of pipe" self cCode: 'writerPtr->sessionID = thisSession'. self cCode: 'writerPtr->writable = 1'. self cCode: 'writerPtr->lastOp = 0'. interpreterProxy stObject: arrayResult at: 1 put: reader. interpreterProxy stObject: arrayResult at: 2 put: writer. interpreterProxy pop: 1; push: arrayResult ] "Answer array of handles" ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 14:02'! primitiveSendSigabrtTo: anIntegerPid "Send SIGALRM (abort) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGABRT)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:49'! primitiveSendSigalrmTo: anIntegerPid "Send SIGALRM (alarm clock) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGALRM)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 14:10'! primitiveSendSigchldTo: anIntegerPid "Send SIGCHLD (child status has changed, usually death of child) to the OS process identified by anIntegerPid." | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGCHLD)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:52'! primitiveSendSigcontTo: anIntegerPid "Send SIGCONT (continue) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGCONT)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:36'! primitiveSendSighupTo: anIntegerPid "Send SIGHUP (hangup) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGHUP)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:39'! primitiveSendSigintTo: anIntegerPid "Send SIGINT (interrupt) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGINT)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:42'! primitiveSendSigkillTo: anIntegerPid "Send SIGKILL (kill, unblockable) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGKILL)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:47'! primitiveSendSigpipeTo: anIntegerPid "Send SIGPIPE (broken pipe) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGPIPE)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:40'! primitiveSendSigquitTo: anIntegerPid "Send SIGQUIT (quit) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGQUIT)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:53'! primitiveSendSigstopTo: anIntegerPid "Send SIGSTOP (stop, unblockable) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGSTOP)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:49'! primitiveSendSigtermTo: anIntegerPid "Send SIGTERM (termination) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGTERM)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:47'! primitiveSendSigusr1To: anIntegerPid "Send SIGUSR1 (User-defined signal 1) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGUSR1)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS signals' stamp: 'dtl 9/17/1999 13:47'! primitiveSendSigusr2To: anIntegerPid "Send SIGUSR2 (User-defined signal 2) to the OS process identified by anIntegerPid" | result pidToSignal | pidToSignal _ interpreterProxy stackIntegerValue: 0. result _ self cCode: 'kill(pidToSignal, SIGUSR2)' inSmalltalk: [ -1 ]. interpreterProxy pop: 2; pushInteger: result ! ! !UnixOSProcessAccessor methodsFor: 'primitives - fork and exec' stamp: 'dtl 9/18/1999 17:39'! primitiveForkAndExec "Fork a child OS process, and do an exec in the child. The parent continues on in Smalltalk, and this method answers the pid of the child which was created." | pid stdErr stdOut stdIn env argCount args progName progNamePtr argsPtr envPtr envHolder idx argHolder intervalTimer saveIntervalTimer inputStream envVec envCount | self var: 'progNamePtr' declareC: 'char *progNamePtr'. self var: 'argsPtr' declareC: 'char **argsPtr'. self var: 'envPtr' declareC: 'char **envPtr'. self var: 'intervalTimer' declareC: 'struct itimerval intervalTimer'. self var: 'saveIntervalTimer' declareC: 'struct itimerval saveIntervalTimer'. self var: 'inputStream' declareC: 'FILE *inputStream'. self var: 'envVec' declareC: 'extern char **envVec'. self setSigChldHandler. "Turn off the interval timer. If this is not done, then the program which we exec in the child process will receive a timer interrupt, and will not know how to handle it." self cCode: 'intervalTimer.it_interval.tv_sec = 0'. self cCode: 'intervalTimer.it_interval.tv_usec = 0'. self cCode: 'intervalTimer.it_value.tv_sec = 0'. self cCode: 'intervalTimer.it_value.tv_usec = 0'. self cCode: 'setitimer (ITIMER_REAL, &intervalTimer, &saveIntervalTimer)'. ((pid _ self cCode: 'vfork()') = 0) ifFalse: [ "Normal return to Smalltalk - this is the old parent process." "Enable the timer again before resuming Smalltalk." self cCode: 'setitimer (ITIMER_REAL, &saveIntervalTimer, 0L)'. interpreterProxy pop: 9; pushInteger: pid ] "Pop 8 arguments plus receiver, push pid." ifTrue: [ "This is the new child process" stdErr _ interpreterProxy stackObjectValue: 0. stdOut _ interpreterProxy stackObjectValue: 1. stdIn _ interpreterProxy stackObjectValue: 2. envCount _ interpreterProxy stackIntegerValue: 3. env _ interpreterProxy stackObjectValue: 4. argCount _ interpreterProxy stackIntegerValue: 5. args _ interpreterProxy stackObjectValue: 6. progName _ interpreterProxy stackObjectValue: 7. progNamePtr _ interpreterProxy arrayValueOf: progName. "Dup the file handles to attach the new child process to the right streams." (stdIn = interpreterProxy nilObject) ifFalse: [ inputStream _ self cFileStructFrom: stdIn. self dupToStdIn: stdIn ]. (stdOut = interpreterProxy nilObject) ifFalse: [ self dupToStdOut: stdOut ]. (stdErr = interpreterProxy nilObject) ifFalse: [ self dupToStdErr: stdErr ]. "Set up the environment, a C array of pointers to C strings, where each string is of the form 'KEY=value'" env = (interpreterProxy nilObject) ifTrue: [ envPtr _ envVec ] ifFalse: [ "Allocate space for a C array of pointers to strings. Use object memory rather than a call to malloc()." envHolder _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: (envCount + 1) * 4. envPtr _ interpreterProxy arrayValueOf: envHolder. idx _ 0. [ idx < envCount ] whileTrue: [ envPtr at: idx put: (interpreterProxy arrayValueOf: (interpreterProxy stObject: env at: idx + 1)). idx _ idx + 1 ]. envPtr at: idx put: 0. "Null terminate the list of pointers to strings" ]. "Set up the argument array. Allocate space for a C array of pointers to strings. Use object memory rather than a call to malloc()." argHolder _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: (argCount + 1) * 4. argsPtr _ interpreterProxy arrayValueOf: argHolder. idx _ 0. [ idx < argCount ] whileTrue: [ argsPtr at: idx put: (interpreterProxy arrayValueOf: (interpreterProxy stObject: args at: idx + 1)). idx _ idx + 1 ]. argsPtr at: idx put: 0. "Null terminate the list of pointers to strings". "Clean things up before clobbering the running image." "Release shared memory for bitmap, if any. This is specific to the Unix/X version of Squeak." self cCode: ' #ifdef USE_XSHM (void *) shmExit(); #endif /* Extra semicolon here is an artifact of Squeak C translation */ '. "Note: If any file descriptors, signal handlers, or other references to external resources need to be cleaned up, do it here." "Do the exec to overlay the new program on this child address space. This is he end of the world as we know it." (self cCode: 'execve(progNamePtr, argsPtr, envPtr)' ) = -1 ifTrue: [ self cCode: 'perror("execve")'; cCode: 'exit(-1)' "exec() error, child exits" ] ifFalse: [ self cCode: '/* Can''t get here from there */' ]] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - fork and exec' stamp: 'dtl 10/4/1999 12:36'! primitiveForkHeadlessSqueak "Fork a child process, and continue running squeak in the child process. Leave the X session connected to the parent process, but close its file descriptor for the child process. Do not open another X session for the child. The child is expected to avoid any further interaction with the screen, otherwise the child process will fail. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." | pid intervalTimer saveIntervalTimer | self var: 'intervalTimer' declareC: 'struct itimerval intervalTimer'. self var: 'saveIntervalTimer' declareC: 'struct itimerval saveIntervalTimer'. "Turn off the interval timer. If this is not done, then the program which we exec in the child process will receive a timer interrupt, and will not know how to handle it." self cCode: 'intervalTimer.it_interval.tv_sec = 0'. self cCode: 'intervalTimer.it_interval.tv_usec = 0'. self cCode: 'intervalTimer.it_value.tv_sec = 0'. self cCode: 'intervalTimer.it_value.tv_usec = 0'. self cCode: 'setitimer (ITIMER_REAL, &intervalTimer, &saveIntervalTimer)'. self setSigChldHandler. pid _ self cCode: 'fork()'. pid = 0 ifTrue: [ "I am the child process" self cCode: 'forgetXDisplay()'. self cCode: '/* Child process does not yet have its own window, so we just */'. self cCode: '/* need to forget about the parent''s window here. */' ]. "Enable the timer again before resuming Smalltalk." self cCode: 'setitimer (ITIMER_REAL, &saveIntervalTimer, 0L)'. interpreterProxy pop: 1; pushInteger: pid ! ! !UnixOSProcessAccessor methodsFor: 'primitives - fork and exec' stamp: 'dtl 10/4/1999 12:36'! primitiveForkSqueak "Fork a child process, and continue running squeak in the child process. After calling fork(), two OS processes exist, one of which is the child of the other. On systems which implement copy-on-write memory management, and which support the fork() system call, both processes will be running Smalltalk images, and will be sharing the same memory space. In the original OS process, the resulting value of pid is the process id of the child process (a non-zero integer). In the child process, the value of pid is zero. The child recreates sufficient external resources to continue running. This is done by attaching to a new X session. The child is otherwise a copy of the parent process, and will continue executing the Smalltalk image at the same point as its parent. The return value of this primitive may be used by the two running Smalltalk images to determine which is the parent and which is the child. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits. The new child image does not start itself from the image in the file system; rather it is a clone of the parent image as it existed at the time of primitiveForkSqueak. For this reason, the parent and child should agree in advance as to whom is allowed to save the image to the file system, otherwise one Smalltalk may overwrite the image of the other. This is a simple call to fork(), rather than the more common idiom of vfork() followed by exec(). The vfork() call cannot be used here because it is designed to be followed by an exec(), and its semantics require the parent process to wait for the child to exit. See the BSD programmers documentation for details." | pid intervalTimer saveIntervalTimer | self var: 'intervalTimer' declareC: 'struct itimerval intervalTimer'. self var: 'saveIntervalTimer' declareC: 'struct itimerval saveIntervalTimer'. "Turn off the interval timer. If this is not done, then the program which we exec in the child process will receive a timer interrupt, and will not know how to handle it." self cCode: 'intervalTimer.it_interval.tv_sec = 0'. self cCode: 'intervalTimer.it_interval.tv_usec = 0'. self cCode: 'intervalTimer.it_value.tv_sec = 0'. self cCode: 'intervalTimer.it_value.tv_usec = 0'. self cCode: 'setitimer (ITIMER_REAL, &intervalTimer, &saveIntervalTimer)'. self setSigChldHandler. pid _ self cCode: 'fork()'. pid = 0 ifTrue: [ "I am the child process" self cCode: 'openXDisplay()' ]. "Enable the timer again before resuming Smalltalk." self cCode: 'setitimer (ITIMER_REAL, &saveIntervalTimer, 0L)'. interpreterProxy pop: 1; pushInteger: pid ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 9/18/1999 17:40'! primitiveGetArgByIndex "Answer a string containing the OS process argument at index in the argument list." | index aString start argVec argCnt len argStrLen | self var: 'start' declareC: 'unsigned char *start'. self var: 'argCnt' declareC: 'extern int argCnt'. self var: 'argVec' declareC: 'extern char **argVec'. index _ interpreterProxy stackIntegerValue: 0. ((index > argCnt) | (index < 1)) ifTrue: [ interpreterProxy primitiveFail ] ifFalse: [ index := index - 1. "Map to C convention where array index starts at 0." argStrLen _ self cCode: 'strlen(argVec[index])'. aString _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: argStrLen. start _ interpreterProxy arrayValueOf: aString. len _ interpreterProxy sizeOfSTArrayFromCPrimitive: start. self cCode: '(char *)strncpy(start, argVec[index], len)'. interpreterProxy pop: 2; push: aString ] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 9/18/1999 17:41'! primitiveGetEnv "Answer the value of an environment variable" | key keyPtr keyLen keyCString keyCStringPtr val valPtr getenvResult resultLength | self var: 'keyPtr' declareC: 'char *keyPtr'. self var: 'keyCStringPtr' declareC: 'char *keyCStringPtr'. self var: 'valPtr' declareC: 'char *valPtr'. self var: 'getenvResult' declareC: 'char * getenvResult'. key _ interpreterProxy stackObjectValue: 0. "Copy the key string into a null terminated C string, stored inside a Smalltalk String object." keyPtr _ interpreterProxy arrayValueOf: key. keyLen _ interpreterProxy sizeOfSTArrayFromCPrimitive: keyPtr. "Allow space for a null terminated C string." keyCString _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: keyLen + 1. keyCStringPtr _ interpreterProxy arrayValueOf: keyCString. "Point to the actual C string." self cCode: '(char *)strncpy(keyCStringPtr, keyPtr, keyLen)'. "Make a copy of the string." keyCStringPtr at: (keyLen) put: 0. "Null terminate the C string." getenvResult _ self cCode: 'getenv(keyCStringPtr)'. (getenvResult = 0) ifTrue: [ interpreterProxy primitiveFail ] ifFalse: [ resultLength _ self cCode: 'strlen(getenvResult)'. val _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: resultLength. valPtr _ interpreterProxy arrayValueOf: val. self cCode: 'strncpy(valPtr, getenvResult, resultLength)'. interpreterProxy pop: 2; push: val ] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 9/18/1999 17:41'! primitiveGetEnvByIndex "Answer a string containing the OS process environment string at index in the environment list." | index aString start envVec len p envStrLen envCnt | self var: 'p' declareC: 'char **p'. self var: 'start' declareC: 'unsigned char *start'. self var: 'envVec' declareC: 'extern char **envVec'. self var: 'envCnt' declareC: 'static int envCnt = 0'. "Count number of environment variables the first time this method is called." (envCnt = 0) ifTrue: [ p _ envVec. self cCode: 'while (*p++) envCnt++' ]. index _ interpreterProxy stackIntegerValue: 0. ((index > envCnt) | (index < 1)) ifTrue: [ interpreterProxy primitiveFail ] ifFalse: [ index := index - 1. "Map to C convention where array index starts at 0." envStrLen _ self cCode: 'strlen(envVec[index])'. aString _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: envStrLen. start _ interpreterProxy arrayValueOf: aString. len _ interpreterProxy sizeOfSTArrayFromCPrimitive: start. self cCode: '(char *)strncpy(start, envVec[index], len)'. interpreterProxy pop: 2; push: aString ] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 5/23/1999 17:40'! primitiveGetPPid "Answer the process ID of the parent process of my OS process" | ppid | ppid := self cCode: 'getppid()'. interpreterProxy pop: 1. interpreterProxy pushInteger: ppid! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 5/23/1999 17:40'! primitiveGetPid "Answer the process ID of my OS process" | pid | pid := self cCode: 'getpid()'. interpreterProxy pop: 1. interpreterProxy pushInteger: pid! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 9/19/1999 13:55'! primitiveGetSession "Answer the unique session identifier for this Smalltalk instance running in this OS process. The C integer value is coerced into a four byte Smalltalk ByteArray to preserve the full 32 bit range of possible values." | sessionOop sessionByteArrayPointer thisSession u idx | self var: 'u' declareC: 'union {int i; unsigned char c[4];} u'. self var: 'sessionByteArrayPointer' declareC: 'char *sessionByteArrayPointer'. self var: 'thisSession' declareC: 'extern int thisSession'. sessionOop _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: 4. sessionByteArrayPointer _ interpreterProxy arrayValueOf: sessionOop. self cCode: 'u.i = thisSession'. self cCode: 'for (idx=0; idx<4; idx++) *(sessionByteArrayPointer + idx) = u.c[idx]'. interpreterProxy pop: 1; push: sessionOop ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 9/18/1999 17:44'! primitivePutEnv "Set an environment variable using a string of the form 'KEY=value'. The setenv() call assumes that the 'KEY=value' string will not be deallocated, otherwise the environment is indeterminate. The caller of this primitive is therefore expected to pass a null terminated C string which has been registered in the SystemDictionary as an external object. This is done by registering the string using SystemDictionary>>registerExternalObject, which keeps a reference to the string for the lifetime of this Smalltalk session. The reference is automatically unregistered when the Smalltalk image is restarted. This implementation uses Smalltalk object memory for the environment string in order to avoid using of a malloc() call in the primitive. See primitivePutEnvWithMalloc for an alternative implemention using malloc()." | keyValueString sPtr len | self var: 'sPtr' declareC: 'char *sPtr'. self var: 'cStringPtr' declareC: 'char *cStringPtr'. keyValueString _ interpreterProxy stackObjectValue: 0. sPtr _ interpreterProxy arrayValueOf: keyValueString. len _ interpreterProxy sizeOfSTArrayFromCPrimitive: sPtr. (sPtr at: len) = 0 ifFalse: [ self primitiveFail "String is not null terminated" ] ifTrue: [ ((self cCode: 'putenv(sPtr)') = 0) "Set environment variable." ifTrue: [ interpreterProxy pop: 2; push: keyValueString ] ifFalse: [ interpreterProxy primitiveFail "putenv() call failed" ]] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 9/18/1999 17:46'! primitivePutEnvWithMalloc "Set an environment variable using a string of the form 'KEY=value'. Use malloc() to allocate a string independent of Smalltalk object memory to prevent the string from being garbage collected. This is expected to be a trivial memory leak, and avoids the need to maintain a reference to the Smalltalk string in order to prevent it from being garbage collected and thereby invalidating the environment string. See primitivePutEnv for an alternative implemention using object memory rather than a call to malloc()." | keyValueString sPtr len cStringPtr | self var: 'sPtr' declareC: 'char *sPtr'. self var: 'cStringPtr' declareC: 'char *cStringPtr'. keyValueString _ interpreterProxy stackObjectValue: 0. "Copy string to a null terminated C string, contained within another Smalltalk String object." sPtr _ interpreterProxy arrayValueOf: keyValueString. len _ interpreterProxy sizeOfSTArrayFromCPrimitive: sPtr. cStringPtr _ self cCode: '(char *) calloc (len+1, 1)'. "Space for a null terminated C string." self cCode: '(char *) strncpy (cStringPtr, sPtr, len)'. "Copy the string." ((self cCode: 'putenv(cStringPtr)') = 0) "Set environment variable." ifTrue: [ interpreterProxy pop: 2; push: keyValueString ] ifFalse: [ interpreterProxy primitiveFail ] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 9/18/1999 17:48'! primitiveReapChildProcess "Clean up after the death of a child, and answer the exit status of the child process." | pidToHandle pidResult exitStatus resultArray arrayPtr | self var: 'arrayPtr' declareC: 'int *arrayPtr'. pidToHandle _ interpreterProxy stackIntegerValue: 0. pidResult _ self cCode: 'waitpid ( pidToHandle, &exitStatus, WNOHANG )' inSmalltalk: [ exitStatus _ -1 ]. pidResult <= 0 ifTrue: [ interpreterProxy pop: 2; push: interpreterProxy nilObject ] ifFalse: [ "Answer an array with pid and result status " resultArray _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. arrayPtr _ interpreterProxy firstIndexableField: resultArray. self cCode: 'arrayPtr[0] = integerObjectOf(pidResult)' inSmalltalk: [resultArray at: 1 put: pidResult]. self cCode: 'arrayPtr[1] = integerObjectOf(exitStatus)' inSmalltalk: [resultArray at: 2 put: exitStatus]. interpreterProxy pop: 2; push: resultArray ] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - OS process access' stamp: 'dtl 9/18/1999 17:48'! primitiveSetSemaIndex "Set the index of the semaphore used by the OSProcess with which I collaborate. My OSProcess should set this value so that I can use it when handling SIGCHLD signals (death of child). In the C translation this is a static int which would be shared by all instances of UnixOSProcessAccessor, which is expected to be a singleton. Answer the value of the semaphore index." semaIndexForThisOSProcessAccessor _ interpreterProxy stackIntegerValue: 0. interpreterProxy pop: 2; pushInteger: semaIndexForThisOSProcessAccessor ! ! !UnixOSProcessAccessor methodsFor: 'primitives - other' stamp: 'dtl 9/19/1999 15:17'! primitiveConvertFourBytesToInteger "Convert a four byte ByteArray to an integer, using machine dependent byte ordering. This should be moved to ObjectMemory if it is of general interest." | u byteArray byteArrayPointer intObj idx | self var: 'u' declareC: 'union {int i; unsigned char c[4];} u'. self var: 'byteArrayPointer' declareC: 'unsigned char *byteArrayPointer'. byteArray _ interpreterProxy stackValue: 0. ((interpreterProxy byteSizeOf: byteArray) = 4) ifFalse: [ interpreterProxy primitiveFail; pop: 2; push: interpreterProxy nilObject ] ifTrue: [ byteArrayPointer _ interpreterProxy arrayValueOf: byteArray. self cCode: 'for (idx=0; idx<4; idx++) u.c[idx] = *(byteArrayPointer + idx)'. self cCode: 'intObj = u.i'. interpreterProxy pop: 2; pushInteger: intObj ]! ! !UnixOSProcessAccessor methodsFor: 'primitives - other' stamp: 'dtl 9/19/1999 15:17'! primitiveConvertIntegerToFourBytes "Convert anInteger to a ByteArray of size four, using machine dependent byte ordering. This should be moved to ObjectMemory if it is of general interest." | u intValue byteArray byteArrayPointer idx | self var: 'u' declareC: 'union {int i; unsigned char c[4];} u'. self var: 'byteArrayPointer' declareC: 'unsigned char *byteArrayPointer'. (interpreterProxy isIntegerValue: (interpreterProxy stackValue: 0)) ifFalse: [ interpreterProxy primitiveFail; pop: 2; push: interpreterProxy nilObject ] ifTrue: [ intValue _ interpreterProxy stackIntegerValue: 0. byteArray _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: 4. byteArrayPointer _ interpreterProxy arrayValueOf: byteArray. self cCode: 'u.i = intValue'. self cCode: 'for (idx=0; idx<4; idx++) *(byteArrayPointer + idx) = u.c[idx]'. interpreterProxy pop: 2; push: byteArray ] ! ! !UnixOSProcessAccessor methodsFor: 'primitives - other' stamp: 'dtl 9/18/1999 13:07'! primitiveKillDisplay "Call an internal function which will disconnect the X display session." self cCode: 'disconnectXDisplay()' ! ! !UnixOSProcessAccessor class methodsFor: 'translation' stamp: 'dtl 9/13/1999 22:12'! moduleName ^ 'UnixOSProcessAccessor'! ! !UnixOSProcessAccessor class methodsFor: 'translation' stamp: 'dtl 9/13/1999 22:11'! translate: fileName doInlining: inlineFlag "This is a convenience method which simply documents that the C source code file may be generated as shown below." "UnixOSProcessAccessor translate: UnixOSProcessAccessor moduleName,'.c' doInlining: true" ^ super translate: fileName doInlining: inlineFlag! ! !UnixOSProcessAccessor class methodsFor: 'translation' stamp: 'dtl 9/13/1999 22:18'! translateDoInlining: inlineFlag "Translate to C source code file." "UnixOSProcessAccessor translateDoInlining: true" ^ super translate: UnixOSProcessAccessor moduleName,'.c' doInlining: inlineFlag! ! !UnixOSProcessAccessor class methodsFor: 'class initialization' stamp: 'dtl 9/19/1999 18:20'! declareCVarsIn: cg cg addHeaderFile: ''. cg addHeaderFile: ''. cg addHeaderFile: ''. cg addHeaderFile: ''. cg addHeaderFile: ''. cg addHeaderFile: ''. cg var: 'semaIndexForThisOSProcessAccessor' declareC: 'static int semaIndexForThisOSProcessAccessor'. cg var: 'sigChldHandler' declareC: 'static void (*sigChldHandler)() = NULL'! ! !UnixOSProcessAccessor class methodsFor: 'instance creation' stamp: 'dtl 9/18/1999 18:00'! forThisOSProcess "Answer a single instance corresponding to the OS process in which this Smalltalk image is executing." "UnixOSProcessAccessor forThisOSProcess" ThisOSProcessAccessor ifNil: [ ThisOSProcessAccessor _ super new initialize ]. ^ThisOSProcessAccessor ! ! !UnixOSProcessAccessor class methodsFor: 'instance creation' stamp: 'dtl 9/18/1999 18:00'! new self notify: 'use UnixOSProcessAccessor>>forThisOSProcess to create or obtain the OSProcess instance for this Smalltalk session.'. ^nil! ! !UnixProcess commentStamp: '' prior: 0! I represent the Unix operating system process in which this Squeak session is running. I collaborate with an instance of UnixOSProcessAccessor to provide primitive access to the external operating system. My instance variables are updated to allow access to this OS process in a Smalltalk inspector. My accessor methods update my instance variables by querying my UnixOSProcessAccessor, and my #printOn: method causes me to be updated whenever Squeak is restarted in a new OS process.! !UnixProcess reorganize! ('private' argumentListFrom: environmentDictionaryFrom: needsInitialize pathString programNameFrom: setStdErr setStdIn setStdOut) ('initialize - release' initialize release) ('accessing environment' environmentAt: environmentAt:put:) ('accessing' allMyChildren allMyChildren: arguments environment grimReaper path path: pid ppid programName semaIndex sessionID sigChldSemaphore sigChldSemaphore: stdErr stdIn stdOut) ('pipe creation' makePipe) ('child process creation' clone forkAndExec:arguments:environment:descriptors: forkHeadlessSqueak forkSqueak) ('printing' printOn:) ('child process management' activeChildren childPids discardExitedChildren exitedChildren registerChild: updateAllMyChildren) ! !UnixProcess methodsFor: 'private' stamp: 'dtl 5/28/1999 18:30'! argumentListFrom: anOSProcessPlugin "Answer an argument list using anOSProcessPlugin. For Unix, the first element of the list would be the program name. This element will not be treated as an argument; rather, it is stored as the programName instance variable." | index val list | list _ OrderedCollection new. index _ 2. [(val _ anOSProcessPlugin argumentAt: index) notNil] whileTrue: [ list add: val. index _ index + 1]. ^list asArray ! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 6/13/1999 00:50'! environmentDictionaryFrom: anOSProcessPlugin "Answer an environment dictionary using anOSProcessPlugin." | index str key val env | env _ Dictionary new. index _ 1. [(str _ anOSProcessPlugin environmentAtIndex: index) notNil] whileTrue: [ key _ (str copyUpTo: $=) asSymbol. val _ (str copyFrom: ((str indexOf: $=) + 1) to: (str size)). env at: key put: val. index _ index + 1]. ^env ! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 7/4/1999 16:20'! needsInitialize "Answer true if the sessionID variable is out of date with respect to the running OS Process." ^((sessionID ~= (self processAccessor getSession)) | (pid ~= (self processAccessor getPid))) ! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 6/27/1999 15:29'! pathString "Answer the path string from the environment. Assume Unix convention in which the path name is a colon delimited string stored in the PATH environment variable." ^self environment at: #PATH ifAbsent: [nil]! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 5/22/1999 07:08'! programNameFrom: anOSProcessPlugin "Answer the name of the program which is being run by this OS process. Assume the Unix convention where the first element of (char **)argv is the program name." ^programName _ anOSProcessPlugin argumentAt: 1 ! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 9/29/1999 18:39'! setStdErr | stdErrHandle | stdErrHandle _ self processAccessor getStdErrHandle. stdErrHandle ifNotNil: [stdErr _ AttachableFileStream new name: 'stderr' attachTo: stdErrHandle]. ^stdErr! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 9/29/1999 18:39'! setStdIn | stdInHandle | stdInHandle _ self processAccessor getStdInHandle. stdInHandle ifNotNil: [ stdIn _ AttachableFileStream new name: 'stdin' attachTo: stdInHandle]. ^stdIn! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 9/29/1999 18:39'! setStdOut | stdOutHandle | stdOutHandle _ self processAccessor getStdOutHandle. stdOutHandle ifNotNil: [ stdOut _ AttachableFileStream new name: 'stdout' attachTo: stdOutHandle]. ^stdOut! ! !UnixProcess methodsFor: 'initialize - release' stamp: 'dtl 7/4/1999 15:55'! initialize "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." self needsInitialize ifTrue: [ self release. self processAccessor. sessionID _ processAccessor getSession. pid _ processAccessor getPid. ppid _ processAccessor getPPid. self setStdIn. self setStdOut. self setStdErr. programName _ self programNameFrom: processAccessor. arguments _ self argumentListFrom: processAccessor. environment _ self environmentDictionaryFrom: processAccessor. path _ self pathString. self allMyChildren. self sigChldSemaphore. processAccessor setSemaIndex: semaIndex ] ! ! !UnixProcess methodsFor: 'initialize - release' stamp: 'dtl 7/4/1999 15:48'! release "Use this to release any external resources prior to reinitializing." processAccessor release. stdIn release. stdOut release. stdErr release. super release. sessionID _ nil. ppid _ nil. stdIn _ nil. stdOut _ nil. stdErr _ nil. programName _ nil. arguments _ nil. path _ nil. environment _ nil. allMyChildren _ nil. processAccessor _ nil. semaIndex ifNotNil: [ Smalltalk unregisterExternalObject: sigChldSemaphore. sigChldSemaphore _ nil. semaIndex _ nil ]. grimReaper ifNotNil: [ grimReaper terminate. grimReaper _ nil ] ! ! !UnixProcess methodsFor: 'accessing environment' stamp: 'dtl 6/27/1999 15:34'! environmentAt: aSymbol "Answer an environment variable for the external OS process, and update the dictionary in this Smalltalk object." ^environment at: aSymbol ! ! !UnixProcess methodsFor: 'accessing environment' stamp: 'dtl 6/27/1999 15:33'! environmentAt: aSymbol put: aString "Set an environment variable for the external OS process, and update the dictionary in this Smalltalk object." | s | self initialize. s _ self processAccessor environmentAt: aSymbol put: aString. s ifNotNil: [ self environment at: aSymbol put: aString ]. ^s ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 23:48'! allMyChildren self initialize. allMyChildren ifNil: [ allMyChildren _ Dictionary new ]. ^allMyChildren! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/30/1999 21:28'! allMyChildren: aCollection ^allMyChildren _ aCollection! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:31'! arguments self initialize. ^arguments ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:30'! environment self initialize. ^environment ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 7/4/1999 15:54'! grimReaper "This is a process which waits for the death of a child OSProcess, then polls the known children to update the dictionary of child processes, and release the soul of the zombie child." grimReaper ifNil: [grimReaper _ [[true] whileTrue: [ OSProcess forThisOSProcess sigChldSemaphore wait. OSProcess forThisOSProcess updateAllMyChildren ]] fork]. ^grimReaper ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:29'! path self initialize. ^path _ self pathString ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:27'! path: aPathString self initialize. self environmentAt: #PATH put: aPathString. ^path _ self pathString! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:39'! pid self needsInitialize ifTrue: [ pid _ super pid ]. ^pid! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:27'! ppid self initialize. ^ppid ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:27'! programName self initialize. ^programName ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 7/2/1999 19:04'! semaIndex semaIndex ifNil: [ self sigChldSemaphore ]. ^semaIndex! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:26'! sessionID self initialize. ^sessionID! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 09:14'! sigChldSemaphore sigChldSemaphore ifNil: [ sigChldSemaphore _ Semaphore new. semaIndex _ Smalltalk registerExternalObject: sigChldSemaphore. self processAccessor setSemaIndex: semaIndex ]. ^sigChldSemaphore! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/30/1999 20:35'! sigChldSemaphore: aSemaphore ^sigChldSemaphore _ aSemaphore! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:25'! stdErr self initialize. ^stdErr! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:25'! stdIn self initialize. ^stdIn! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 6/27/1999 15:25'! stdOut self initialize. ^stdOut! ! !UnixProcess methodsFor: 'pipe creation' stamp: 'dtl 9/29/1999 18:39'! makePipe "Create a pipe and answer an OSPipe with reader and writer streams. Collaborates with UnixOSProcessAccessor>>makePipeHandles to create the OSPipe." | reader writer handleArray | handleArray _ self processAccessor makePipeHandles. handleArray isNil ifTrue: [ ^nil ] ifFalse: [ reader _ OSPipeStream new name: 'pipeReader' attachTo: (handleArray at: 1). writer _ OSPipeStream new name: 'pipeWriter' attachTo: (handleArray at: 2)]. ^OSPipe reader: reader writer: writer ! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 10/4/1999 12:35'! clone "Fork a child and continue running this Squeak image in both the parent and the child. Parent and child are distinguished by the pid returned. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." | childPid | self initialize. self stdOut flush. self stdErr flush. childPid _ self processAccessor forkSqueak. childPid = 0 ifFalse: [ self registerChild: childPid ]. ^childPid! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 10/3/1999 14:09'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Call Unix vfork() and execve() to create a child process, and answer the pid of the child process. This method is expected to be called by class side methods. Prepare the arguments before calling the primitive, including null termination of all strings." | progName args argCount env envCount in out err nullString childPid | self initialize. nullString _ (Character value: 0) asString. progName _ executableFile, nullString. "Null terminated string" arrayOfStrings isNil "Should be a (possibly empty) array" ifTrue: [ args _ Array with: progName ] "First argument is always the program name (Unix convention)" ifFalse: [ args _ (OrderedCollection new: arrayOfStrings size + 2) add: progName; addAll: (arrayOfStrings collect: [ :e | e, nullString ]); "Null terminate each string" yourself; asArray ]. argCount _ args size. stringDictionary notNil ifTrue: [ stringDictionary = (self environment) ifTrue: [ env _ nil ] "Same as current environment, so just pass nil." ifFalse: [ env _ (stringDictionary keys collect: [ :e | (e asString), '=', (stringDictionary at: e), nullString]) asArray ]]. env isNil ifTrue: [ envCount _ 0 ] ifFalse: [ envCount _ env size ]. arrayOf3Streams isNil ifTrue: [ in _ self stdIn fileID. out _ self stdOut fileID. err _ self stdErr fileID ] ifFalse: [ (arrayOf3Streams at: 1) isNil ifTrue: [ in _ self stdIn fileID ] ifFalse: [ in _ (arrayOf3Streams at: 1) fileID ]. (arrayOf3Streams at: 2) isNil ifTrue: [ out _ self stdOut fileID ] ifFalse: [ out _ (arrayOf3Streams at: 2) fileID ]. (arrayOf3Streams at: 3) isNil ifTrue: [ err _ self stdErr fileID ] ifFalse: [ err _ (arrayOf3Streams at: 3) fileID ]]. childPid _ self processAccessor forkAndExec: progName withArgs: args argCount: argCount withEnv: env envCount: envCount stdIn: in stdOut: out stdErr: err. childPid = 0 ifFalse: [ self registerChild: childPid ]. ^childPid ! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 10/3/1999 14:08'! forkHeadlessSqueak | childPid | self initialize. self stdOut flush. self stdErr flush. childPid _ self processAccessor forkHeadlessSqueak. childPid = 0 ifFalse: [ self registerChild: childPid ]. ^childPid! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 10/4/1999 12:25'! forkSqueak ^ self clone! ! !UnixProcess methodsFor: 'printing' stamp: 'dtl 7/4/1999 16:11'! printOn: aStream "In English, say 'a Unix' rather than 'an Unix'. Therefore do not use super printOn, which treats $U as a vowel." self initialize. "Make sure we are attached to the current OS process (not left over from a previous session)." aStream nextPutAll: 'a '; nextPutAll: self class name; nextPutAll: ' on pid '; nextPutAll: self pid printString ! ! !UnixProcess methodsFor: 'child process management' stamp: 'dtl 7/4/1999 16:35'! activeChildren "Answer child processes which are currently believed to be running." "OSProcess forThisOSProcess activeChildren inspect" ^self allMyChildren select: [ :p | p isRunning ] ! ! !UnixProcess methodsFor: 'child process management' stamp: 'dtl 7/3/1999 13:23'! childPids ^self allMyChildren keys asArray ! ! !UnixProcess methodsFor: 'child process management' stamp: 'dtl 7/4/1999 16:32'! discardExitedChildren "Remove entries for completed child processed from dictionary." ^allMyChildren _ self allMyChildren select: [ :p | p isComplete not ] ! ! !UnixProcess methodsFor: 'child process management' stamp: 'dtl 7/4/1999 16:34'! exitedChildren "Answer child processes which have exited and are no longer running." "OSProcess forThisOSProcess exitedChildren inspect" ^self allMyChildren select: [ :p | p isComplete ] ! ! !UnixProcess methodsFor: 'child process management' stamp: 'dtl 7/4/1999 15:56'! registerChild: anInteger self initialize grimReaper. "Start the reaper process if it is not already running." self allMyChildren at: anInteger put: (ExternalUnixProcess newChildOf: self pid withPid: anInteger) ! ! !UnixProcess methodsFor: 'child process management' stamp: 'dtl 7/3/1999 19:17'! updateAllMyChildren "Test each child for its completion status and update runState and exitStatus accordingly. This method may be called when a semaphore is set indicating that some child OSProcess has died. A better approach would be to use an event queue for death of child events; however, until event queues are part of the base Squeak image, this polling mechanism will be sufficient." | statusArray osProc | self allMyChildren associationsDo: [ :each | osProc _ each value. osProc isRunning ifTrue: [ statusArray _ self processAccessor getChildExitStatus: each key. statusArray notNil ifTrue: [ osProc complete exitStatus: (statusArray at: 2) ]]. ] ! ! !UnixProcess class methodsFor: 'instance creation' stamp: 'dtl 7/4/1999 12:04'! forThisOSProcess "Since we know we are a Unix system, thisOSProcess will be an instance of myself. Check to see if thisOSProcess is up to date (not left over from a previous Squeak session), and initialize it if necessary." ^super forThisOSProcess initialize ! ! !UnixProcess class methodsFor: 'instance creation' stamp: 'dtl 10/4/1999 12:33'! forkHeadlessSqueakAndDo: aBlock "Start a new instance of Squeak running in a child OS process, and execute aBlock in the child instance. The new instance is a clone of this image, but without a connection to the X display. The child instance executes aBlock, which hopefully does not involve interaction with the X display; and the parent continues normally. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." | pid | pid _ self forThisOSProcess forkHeadlessSqueak. pid = 0 ifTrue: [ aBlock value ]. "Child process" ^pid! ! !UnixProcess class methodsFor: 'instance creation' stamp: 'dtl 10/4/1999 12:33'! forkHeadlessSqueakAndDoThenQuit: aBlock "Start a new instance of Squeak running in a child OS process, and execute aBlock in the child instance. The new instance is a clone of this image, but without a connection to the X display. The child instance executes aBlock, which hopefully does not involve interaction with the X display; and the parent continues normally. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." | pid | pid _ self forThisOSProcess forkHeadlessSqueak. pid = 0 ifTrue: [ aBlock value. Smalltalk snapshot: false andQuit: true ]. "Child process" ^pid! ! !UnixProcess class methodsFor: 'instance creation' stamp: 'dtl 7/4/1999 08:50'! forkJob: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Call Unix vfork() and execve() to create a child process, and answer the pid of the child process. Delegate this to the singleton OSProcess>>forThisOSProcess." | pid | pid _ self forThisOSProcess forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams. ^pid ! ! !UnixProcess class methodsFor: 'instance creation' stamp: 'dtl 10/4/1999 12:34'! forkSqueak "Start a new instance of Squeak running in a child OS process. The new instance is a clone of this image except for the return value of this method. It does not reload the image file from disk. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." ^ self forThisOSProcess forkSqueak. ! ! !UnixProcess class methodsFor: 'instance creation' stamp: 'dtl 7/4/1999 08:38'! squeak "Start a new instance of Squeak running in a child OS process. The new instance will restart from the image file, so it is a clone of this image as it existed at the most recent image save." | t squeak args desc | t _ self forThisOSProcess initialize. squeak _ t programName. args _ t arguments. desc _ Array with: t stdIn with: t stdOut with: t stdErr. ^self forkJob: squeak arguments: args environment: nil descriptors: desc ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 9/19/1999 08:31'! decapitate "Become headless by closing the X session. All subsequent processing should involve no further display interaction." "UnixProcess decapitate" OSProcess forThisOSProcess processAccessor killDisplay ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 9/18/1999 15:12'! quitAndRestart "Save image, start a new instance from the saved image, and quit this instance." "UnixProcess quitAndRestart" | firstPid | firstPid _ OSProcess thisSqueakOSProcess pid. Smalltalk saveSession. "Value of firstPid gets saved in the image" (OSProcess thisSqueakOSProcess pid = firstPid) ifTrue: [UnixProcess squeak ifNotNil: [ Smalltalk quitPrimitive ]] ifFalse: ["This is the new instance in a child process with a new pid"] ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 9/17/1999 15:53'! restartVirtualMachine "Fork a new instance and quit this one. This is useful if the VM has been recompiled or if a new pluggable primitive has been added." "UnixProcess restartVirtualMachine" | thisPid newPid | thisPid _ self forThisOSProcess pid. newPid _ self forkSqueak. (newPid == 0) ifFalse: [Smalltalk quitPrimitive]. ^newPid ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 6/17/1999 20:34'! catAFile "Copy contents of a file to standard output. This demonstrates reassigning stdin to an open FileStream." "UnixProcess catAFile" | in pid | in _ FileStream readOnlyFileNamed: '/etc/hosts'. pid _ UnixProcess forkJob: '/bin/cat' arguments: nil environment: nil descriptors: (Array with: in with: nil with: nil). in close. ^pid! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 6/17/1999 20:36'! catFromFileToFiles "Copy contents of a file to another file, with any error messages going to a third file." "UnixProcess catFromFileToFiles" | in out err pid | in _ FileStream readOnlyFileNamed: '/etc/hosts'. out _ FileStream newFileNamed: '/tmp/deleteMe.out'. err _ FileStream newFileNamed: '/tmp/deleteMe.err'. pid _ UnixProcess forkJob: '/bin/cat' arguments: nil environment: nil descriptors: (Array with: in with: out with: err). in close. out close. err close. ^pid! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 10/2/1999 13:38'! cloneSqueak "Start a new instance of Squeak running in a child OS process. The new instance is a nearly identical copy of its parent, resuming execution at the same point as the parent, and differentiated only by the return value of this method." "UnixProcess cloneSqueak inspect" ^self forkSqueak ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 10/2/1999 23:23'! eightLeafSqueakTree "Clone this squeak three times, resulting in a total of (2 raisedTo: 3) nearly identical squeaks. Have a look at the pidArray inspectors and to the debug messages on stdout in order to see what is going on. The tree of processes looks like this: 111 +--------+--------+ | | | 011 101 110 +---+ | | | 100 010 001 | 000 " "UnixProcess eightLeafSqueakTree" | depth this pidArray debugString | depth _ 3. this _ OSProcess forThisOSProcess initialize. pidArray _ Array new: depth. (1 to: depth) do: [ :e | pidArray at: e put: this clone ]. debugString _ 'pid ', (this pid printString), ' ppid ', (this ppid printString), ' ', (pidArray printString), (Character lf asString). this stdOut nextPutAll: debugString. pidArray inspect! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 10/2/1999 14:06'! headlessChild "Start a new instance of Squeak running in a child OS process. The new instance is a nearly identical copy of its parent, resuming execution at the same point as the parent, and differentiated only by the return value of this method. The child squeak will write a message to standard output, then exit." "UnixProcess headlessChild inspect" | childBlock | childBlock _ [ OSProcess forThisOSProcess stdOut nextPutAll: 'hello world from child process '. OSProcess forThisOSProcess pid printOn: OSProcess forThisOSProcess stdOut. OSProcess forThisOSProcess stdOut nextPut: Character lf ]. ^self forkHeadlessSqueakAndDoThenQuit: childBlock ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 9/29/1999 18:48'! listDirectory "Execute a simple command, sending output to standard output." "UnixProcess listDirectory" ^UnixProcess forkJob: '/bin/ls' arguments: nil environment: nil descriptors: nil. ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 10/2/1999 13:39'! spawnTenHeadlessChildren "Spawn ten Squeak children, each of which writes a message to standard output, then exits. Answer an array of pid values for the child processes." "UnixProcess spawnTenHeadlessChildren inspect" | childBlock count children | count _ 10. children _ Array new: count. childBlock _ [ OSProcess forThisOSProcess stdOut nextPutAll: 'hello world from child process '. OSProcess forThisOSProcess pid printOn: OSProcess forThisOSProcess stdOut. OSProcess forThisOSProcess stdOut nextPut: Character lf ]. (1 to: count) do: [ :e | children at: e put: (self forkHeadlessSqueakAndDoThenQuit: childBlock) ]. ^children ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 6/27/1999 13:06'! squeakSqueak "Start a new instance of Squeak running in a child OS process. The new instance will restart from the image file, so it is a clone of this image as it existed at the most recent image save. See cloneSqueak for an example of how to clone the running image without going back to the saved image file." "UnixProcess squeakSqueak" ^self squeak ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 6/19/1999 10:36'! testEnvSet "Set up a new environment for a child process. Exec a shell to show the environment variables on the terminal standard output. Note that many shells will set other environment variables in addition to those which we set up prior to executing the shell." "UnixProcess testEnvSet" | e | e _ Dictionary new. e at: #KEY1 put: 'value1'; at: #KEY2 put: 'value2'; at: #KEY3 put: 'value3'. ^UnixProcess forkJob: '/bin/sh' arguments: #('-c' 'env') environment: e descriptors: nil. ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/4/1999 08:38'! testPipe "Create an OS pipe, write some text to it, and read the text back from the other end of the pipe." "UnixProcess testPipe inspect" | s p r | s _ 'this is some text to write into the pipe'. p _ OSProcess forThisOSProcess makePipe. p writer nextPutAll: s. p writer close. r _ p reader next: (s size). p reader close. ^r ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 10/2/1999 13:41'! testPipeLine "Create two OS pipes, and a child OS process with its input connected to one pipe and its output connected to the other pipe. Write some text to the input pipe, and read the resulting output (just echoed back by the Unix cat command) back through the output pipe. Send a SIGHUP signal to the child process to tell it to exit. This test verifies the ability of Squeak to send text to an external OS process through a pipe, and read the output text back from another pipe." "UnixProcess testPipeLine inspect" | testString pipe1 pipe2 input output src dest desc result this childPid | this _ OSProcess forThisOSProcess. testString _ 'This is the text to write out through one pipe, copy through an external cat command, and then read back in through another pipe.'. pipe1 _ this makePipe. pipe2 _ this makePipe. input _ pipe1 reader. output _ pipe2 writer. src _ pipe1 writer. dest _ pipe2 reader. desc _ Array with: input with: output with: nil. childPid _ self forkJob: '/bin/cat' arguments: nil environment: nil descriptors: desc. input close. output close. src nextPutAll: testString. src close. result _ dest next: (testString size). dest close. this processAccessor primSendSigtermTo: childPid. "Tell the child to exit" ^result! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 6/17/1999 20:41'! testRunCommand "Run the command 'ls -l /etc /etc/noSuchFile'. The output of the command will be in the file '/tmp/deleteMe.out', and the error output will be in '/tmp/deleteMe.err'." "UnixProcess testRunCommand" | out err desc args pid | out _ FileStream newFileNamed: '/tmp/deleteMe.out'. err _ FileStream newFileNamed: '/tmp/deleteMe.err'. desc _ Array with: nil with: out with: err. args _ Array with: '-l' with: '/etc' with: '/etc/noSuchFile' with: '/etc/anotherNonexistentFile'. pid _ self forkJob: '/bin/ls' arguments: args environment: nil descriptors: desc. out close. err close. ^pid! ! !WindowsOSProcessAccessor commentStamp: '' prior: 0! I provide access to an operating system process, such as the process in which the Squeak VM is currently running. I am based on the Win32 process model for Windows and Windows NT.! !WindowsProcess commentStamp: '' prior: 0! I represent a Windows operating system process, such as the process in which the Squeak VM is currently running. I collaborate with an instance of WindowsOSProcessAccessor to provide primitive access to the external operating system. My instance variables are maintained as a convenience to allow inspection of an OSProcess. Access to these variables should always be done with my accessor methods, which update the instance variables by querying my WindowsOSProcessAccessor.! AttachableFileStream class removeSelector: #name:attachTo:forWrite:! AttachableFileStream class removeSelector: #name:attachToIOHandle:! AttachableFileStream class removeSelector: #name:clonedFrom:forWrite:! IOHandle removeSelector: #sessionIDwritablefileSizelastOp! IOHandle class removeSelector: #stuctureSize! OSProcess initialize! ShellProxy removeSelector: #flushExternalStream:! ShellProxy class removeSelector: #newShellWithInputFrom:outputTo:errorTo:! ShellProxy class removeSelector: #bashShell! ShellProxy class removeSelector: #defaultShell! ShellProxy class removeSelector: #XnewShell! ShellWindow removeSelector: #shellProxywindowStreamstdoutProcess! ShellWindow removeSelector: #stdoutProcess! StandardFileStream removeSelector: #fileID:! AttachableFileStream removeSelector: #name:attachTo:forWrite:! AttachableFileStream removeSelector: #name:attachToIOHandle:! OSPipeStream removeSelector: #flush! UnixOSProcessAccessor removeSelector: #primSQFileReplaceExternalStream:! UnixOSProcessAccessor removeSelector: #replaceExternalStream:! UnixOSProcessAccessor removeSelector: #primitiveSetSQFileNonBlocking! UnixOSProcessAccessor removeSelector: #primitiveSendSigpipe:! UnixOSProcessAccessor removeSelector: #primitiveSendSigusrTwoTo:! UnixOSProcessAccessor removeSelector: #primSetSQFileNonBlocking:! UnixOSProcessAccessor removeSelector: #primSQFileFFlush:! UnixOSProcessAccessor removeSelector: #primitiveSendSigAbrtTo:! UnixOSProcessAccessor removeSelector: #primitiveSendSigusrOneTo:! UnixOSProcessAccessor removeSelector: #convertIntegerToFourBytes! UnixOSProcessAccessor removeSelector: #primitiveSQFileReplaceExternalStream! UnixOSProcessAccessor removeSelector: #primitiveSendSigPipe:! UnixOSProcessAccessor removeSelector: #primitiveSQFileFFlush! UnixOSProcessAccessor removeSelector: #primitiveSetSQFileNonBlocking:! UnixProcess removeSelector: #replaceStdOutStream! UnixProcess class removeSelector: #simpleCatAFile!