"======================================================================
|
|   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!
