"Smalltalk built in methods. These are read in by the system initially, to prepare the execution environment." "====================================================================== | | Copyright (C) 1990, 1991 Free Software Foundation, Inc. | Written by Steve Byrne. | | This file is part of GNU Smalltalk. | | GNU Smalltalk is free software; you can redistribute it and/or modify it | under the terms of the GNU General Public License as published by the Free | Software Foundation; either version 1, or (at your option) any later version. | | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more | details. | | You should have received a copy of the GNU General Public License along with | GNU Smalltalk; see the file COPYING. If not, write to the Free Software | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ======================================================================" " | Change Log | ============================================================================ | Author Date Change | sbyrne 20 Apr 90 Added SystemDictionary debug to help out with | DBX level debugging. | | sbyrne 15 Apr 90 Added sqrt primitive (I'm sure this was here before) | must have got lost during breaking out from builtins. | | sbyrne 7 Apr 90 Added declare tracing primitive. | | sbyrne 13 Jan 90 Experimental Class self-definition. | | sbyrne 19 Dec 89 Added filein primitive. | | sbyrne 12 Aug 89 Added process and semaphore builtins. | | sbyrne 6 Feb 89 Created. | " !Integer methodsFor: 'built ins'! + arg ^self retry: #+ coercing: arg ! - arg ^self retry: #- coercing: arg ! < arg ^self retry: #< coercing: arg ! > arg ^self retry: #> coercing: arg ! <= arg ^self retry: #<= coercing: arg ! >= arg ^self retry: #>= coercing: arg ! = arg ^self retry: #= coercing: arg ! ~= arg ^self retry: #~= coercing: arg ! * arg ^self retry: #* coercing: arg ! / arg ^self retry: #/ coercing: arg ! \\ arg ^self retry: #\\ coercing: arg ! // arg ^self retry: #// coercing: arg ! quo: arg ^self retry: #quo: coercing: arg ! bitAnd: arg ! bitOr: arg ! bitXor: arg ! bitShift: arg ! asFloat ! asObject self primitiveFailed ! asObjectNoFail !! !Float methodsFor: 'built ins'! + arg ^self retry: #+ coercing: arg ! - arg ^self retry: #- coercing: arg ! < arg ^self retry: #< coercing: arg ! > arg ^self retry: #> coercing: arg ! <= arg ^self retry: #<= coercing: arg ! >= arg ^self retry: #>= coercing: arg ! = arg ^self retry: #= coercing: arg ! ~= arg ^self retry: #~= coercing: arg ! * arg ^self retry: #* coercing: arg ! / arg ^self retry: #/ coercing: arg ! truncated ! fractionPart ! exponent ! timesTwoPower: arg ! exp ! ln ! raisedTo: aNumber ^self retry: #raisedTo: coercing: aNumber ! sqrt ^self error: 'Primitive Sqrt failed!!!' ! ceiling ! floor ! sin ! cos ! tan ! arcSin ! arcCos ! arcTan !! !Object methodsFor: 'built ins'! at: index ! basicAt: index ! at: index put: value ! basicAt: index put: value ! size ! basicSize ! become: otherObject ! instVarAt: index ^self primitiveFailed ! instVarAt: index put: value ^self primitiveFailed ! asOop ! hash ! nextInstance ^nil ! perform: selector ! perform: selector with: arg1 ! perform: selector with: arg1 with: arg2 ! perform: selector with: arg1 with: arg2 with: arg3 ! perform: selector withArguments: argumentsArray ! == arg ! = arg "The equality test is by default the same as that for equal objects" ! class self primitiveFailed ! doesNotUnderstand: message ! error: message ! basicPrint ! "### look these messages up to be sure" primitiveFailed self error: 'primitive operation failed' ! shouldNotImplement self error: 'should not implement' ! subclassResponsibility self error: 'the method is the responsibility of the subclass' ! notYetImplemented self error: 'not yet implemented' !! !SystemDictionary methodsFor: 'builtins'! quitPrimitive self primitiveFailed ! monitor: aBoolean self primitiveFailed ! backtrace "Prints the method invocation stack backtrace, as an aid to debugging" self primitiveFailed ! executionTrace: aBoolean self primitiveFailed ! declarationTrace: aBoolean self primitiveFailed ! snapshot ! snapshot: aString ! gcMessage: aBoolean ! debug "for DBX. Set breakpoint in debug() and invoke this primitive near where you want to stop" ! verboseTrace: aBoolean !! !Behavior methodsFor: 'built ins'! new ! basicNew ! new: numInstanceVariables ! basicNew: numInstanceVariables ! someInstance ^nil "return nil on failure" ! makeDescriptorFor: funcNameString returning: returnTypeSymbol withArgs: argsArray ^self primitiveFailed ! compileString: aString ^self primitiveFailed !! !CompiledMethod class methodsFor: 'built ins'! newMethod: numBytecodes header: anInteger ^self primitiveFailed !! !CompiledMethod methodsFor: 'built ins'! objectAt: index ^self primitiveFailed ! objectAt: index put: value ^self primitiveFailed !! !MethodContext methodsFor: 'built ins'! " Note: the name for this class in the book is 'ContextPart' " blockCopy: block !! !BlockContext methodsFor: 'built ins'! blockCopy: block ! value ! value: arg1 ! value: arg1 value: arg2 ! value: arg1 value: arg2 value: arg3 ! valueWithArguments: argArray !! !ArrayedCollection methodsFor: 'built ins'! size !! !String methodsFor: 'built ins'! size ! at: index ! basicAt: index ! at: index put: value ! basicAt: index put: value !! !Symbol class methodsFor: 'built ins'! intern: aString ^self error: 'Attempted to intern non-string' !! !Symbol methodsFor: 'built ins'! hash !! !Character class methodsFor: 'built ins'! value: anInteger "Returns the character object corresponding to anInteger. Error if anInteger is not an integer, or not in 0..255." ^self error: 'invalid argument type or integer out of range' !! !Character methodsFor: 'built ins'! = char "Boolean return value; true if the characters are equal" ! asciiValue "Returns the integer value corresponding to self" !! !Dictionary class methodsFor: 'built ins'! new !! !Dictionary methodsFor: 'built ins'! at: key ! at: key put: value !! !FileStream methodsFor: 'built ins'! fileOp: ioFuncIndex ^self error: 'FileStream primitive operation failed' ! fileOp: ioFuncIndex with: arg1 ^self error: 'FileStream primitive operation failed' ! fileOp: ioFuncIndex with: arg1 with: arg2 ^self error: 'FileStream primitive operation failed' ! fileIn ^self error: 'fileIn failed!!!' !! !Memory class methodsFor: 'basic'! addressOfOOP: anObject "Returns the address of the OOP for anObject" ! addressOf: anObject "Returns the address of the actual object that anObject references" !! !ByteMemory class methodsFor: 'basic'! at: address "Returns the byte at address as an integer" ! at: address put: value "Sets the byte at ADDRESS (an integer) to be VALUE (INTEGER 0..255)" !! !Time class methodsFor: 'builtins'! secondClock ^self primitiveFailed ! millisecondClock ^self primitiveFailed !! !Process methodsFor: 'builtins'! resume ^self primitiveFailed ! suspend ^self primitiveFailed !! !Semaphore methodsFor: 'builtins'! "communication" signal ^self primitiveFailed ! wait ^self primitiveFailed !! !ClassDescription methodsFor: 'builtins'! comment: aString "This method is present so that comment declarations can always work, even before the real method is defined." !! !Class methodsFor: 'builtins'! "These are stubs...they will be replaced with the appropriate class from Class.st. These allow for Smalltalk type class declarations of the built-in classes, so that they may be edited and modified. This mostly present to allow for future enhancement in which the Smalltalk source files take a more active role in the definition of the system, and the C definition of the classes diminishes in importance." subclass: classNameString instanceVariableNames: stringInstVarNames classVariableNames: stringOfClassVarNames poolDictionaries: stringOfPoolNames category: categoryNameString ^nil ! variableSubclass: classNameString instanceVariableNames: stringInstVarNames classVariableNames: stringOfClassVarNames poolDictionaries: stringOfPoolNames category: categoryNameString ^nil ! variableWordSubclass: classNameString instanceVariableNames: stringInstVarNames classVariableNames: stringOfClassVarNames poolDictionaries: stringOfPoolNames category: categoryNameString ^nil ! variableByteSubclass: classNameString instanceVariableNames: stringInstVarNames classVariableNames: stringOfClassVarNames poolDictionaries: stringOfPoolNames category: categoryNameString ^nil !!