"====================================================================== | | Smalltalk in Smalltalk compiler symbol table | | $Revision: 1.7.5$ | $Date: 2000/05/28 16:56:52$ | $Author: pb$ | ======================================================================" "====================================================================== | | Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc. | Written by Paolo Bonzini. | | 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 2, 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | ======================================================================" Object subclass: #STLiteralsTable instanceVariableNames: 'map array' classVariableNames: 'UseUndeclared' poolDictionaries: '' category: 'System-Compiler' ! !STLiteralsTable class methodsFor: 'instance creation'! new: aSize ^self new initialize: aSize ! ! !STLiteralsTable methodsFor: 'accessing'! addLiteral: anObject "Answers the index of the given literal. If the literal is already present in the literals, returns the index of that one." ^map at: anObject ifAbsentPut: [ | newArray | "Grow the array when full" array size = map size ifTrue: [ (newArray := Array new: map size * 2) replaceFrom: 1 to: map size with: array startingAt: 1. array become: newArray ]. array at: map size + 1 put: anObject. map size ]. ! literals ^array ! trim array become: (array copyFrom: 1 to: map size). ! ! !STLiteralsTable methodsFor: 'private'! initialize: aSize map := Dictionary new: aSize. array := Array new: aSize. ! ! Object subclass: #STVariable instanceVariableNames: 'id scope canStore' classVariableNames: '' poolDictionaries: '' category: 'System-Compiler' ! !STVariable class methodsFor: 'instance creation'! id: id scope: scope canStore: canStore ^self new id: id scope: scope canStore: canStore ! ! !STVariable methodsFor: 'accessing'! canStore ^canStore ! id ^id ! id: anObject scope: scopeIndex canStore: aBoolean id := anObject. scope := scopeIndex. canStore := aBoolean ! scope ^scope ! ! Object subclass: #STSymbolTable instanceVariableNames: 'variables tempCount litTable pools instVars environment scopes' classVariableNames: 'UseUndeclared' poolDictionaries: '' category: 'System-Compiler' ! !STSymbolTable class methodsFor: 'accessing'! initialize UseUndeclared := 0 ! insideFilein ^UseUndeclared > 0 ! nowInsideFileIn UseUndeclared := UseUndeclared + 1 ! nowOutsideFileIn UseUndeclared := UseUndeclared - 1 ! !STSymbolTable class methodsFor: 'instance creation'! new ^super new init ! ! !STSymbolTable methodsFor: 'declaring'! addPool: poolDictionary pools addAll: poolDictionary withAllSuperspaces. ! declareEnvironment: aBehavior | i | environment := aBehavior. i := 0. aBehavior allInstVarNames do: [ :iv | instVars at: iv asSymbol put: (i := i + 1). ]. self declareGlobals ! declareGlobals | behavior | behavior := environment. "Find a suitable Class object from the given behavior" behavior isMetaclass ifTrue: [ behavior := behavior instanceClass ]. [ behavior isClass ] whileFalse: [ behavior := behavior superclass. behavior isNil ifTrue: [ ^self ] ]. behavior withAllSuperclassesDo: [ :class | self addPool: behavior environment. class classPool isEmpty ifFalse: [ pools add: class classPool ] ]. behavior allSharedPools do: [ :sp | self addPool: (Smalltalk at: sp) ]. ! declareTemporary: tempName canStore: canStore for: stCompiler | ok symbol | symbol := tempName asSymbol. ok := variables includesKey: symbol. variables at: symbol put: (STVariable id: tempCount scope: scopes size canStore: canStore ). ok ifFalse: [ stCompiler compileWarning: 'duplicate variable name ', tempName ]. tempCount := tempCount + 1. ^tempCount - 1 ! scopeEnter scopes add: tempCount. tempCount := 0. ! scopeLeave "Answer whether we are in a `clean' scope (no return from method, no references to variable in an outer scope)." tempCount := scopes removeLast. ! undeclareTemporary: tempName variables removeKey: tempName asSymbol ifAbsent: [ ]. ! addLiteral: aLiteral "Answers the index of the given literal. If the literal is already present in the litTable, returns the index of that one." ^litTable addLiteral: aLiteral ! ! !STSymbolTable methodsFor: 'accessing'! canStore: aName variables at: aName asSymbol ifPresent: [ :var | ^var canStore ]. ^true ! numTemps ^tempCount ! isTemporary: aName ^variables includesKey: aName asSymbol ! isReceiver: aName ^instVars includesKey: aName asSymbol ! outerScopes: aName | value | value := variables at: aName asSymbol. ^scopes size - value scope. ! lookupName: aName "Answers a value for the name" | symbol value | (Symbol isSymbolString: aName) ifTrue: [ symbol := aName asSymbol. value := variables at: symbol ifAbsent: [ nil ]. value isNil ifFalse: [ ^value id ]. value := instVars at: symbol ifAbsent: [ nil ]. value isNil ifFalse: [ ^value - 1 ]. pools do: [ :pool | | assoc | assoc := pool associationAt: symbol ifAbsent: [ nil ]. assoc isNil ifFalse: [ ^self addLiteral: assoc ] ] ]. self class insideFilein ifFalse: [ ^nil ]. (aName at: 1) isUppercase ifFalse: [ ^nil ]. symbol := aName asSymbol. value := Undeclared associationAt: symbol ifAbsent: [ Undeclared add: symbol -> nil ]. ^self addLiteral: value ! finish litTable trim ! literals ^litTable literals ! ! !STSymbolTable methodsFor: 'private'! init variables := Dictionary new: 5. litTable := STLiteralsTable new: 13. instVars := Dictionary new: 7. scopes := OrderedCollection new: 5. pools := IdentitySet new: 7. tempCount := 0. ! ! STSymbolTable initialize!