!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: gspackage.gs,v 1.11.2.1 2008-02-20 21:44:06 normg Exp $
!
! Superclass Hierarchy:
!   GsPackage, Object
!
!=========================================================================

! Fix 38326
expectvalue %String
run
| oldClass expectedInstVars newClass |
expectedInstVars := #(#'sessionMethods' #'prereqs' #'symbolDict').
oldClass := Globals at: #GsPackage otherwise: nil.
(oldClass notNil and: [oldClass instVarNames = expectedInstVars]) ifTrue: [
	^'Found expected class'.
].

Globals at: #GsPackage ifAbsent:[
newClass := Object subclass: 'GsPackage'
  instVarNames: #( sessionMethods prereqs symbolDict)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false ].
  ^(oldClass isNil ifTrue: ['Created new class: ']
                   ifFalse: ['Replaced old class with: ']) 
                   , newClass definition.
%

! Remove existing behavior from GsPackage
expectvalue true
doit
GsPackage removeAllMethods.
GsPackage class removeAllMethods.
true
%
! ------------------- Class methods for GsPackage
category: 'Accessing'
classmethod: GsPackage
globalName

	^#GsPackage_Current
%
category: 'Instance Creation'
classmethod: GsPackage
installIn: aSymbolDictionary

	| package |
	package := self new.
	aSymbolDictionary at: self globalName put: package.
    package symbolDict: aSymbolDictionary.
	^package
%
category: 'Instance Creation'
classmethod: GsPackage
new

	^self basicNew initialize
%
! ------------------- Instance methods for GsPackage
category: 'Initialize-Release'
method: GsPackage
initialize

	sessionMethods := Dictionary new.
    prereqs := Array new.
%
category: 'Enumerating'
method: GsPackage
behaviorAndMethodDictDo: aBlock
  self sessionMethods keysAndValuesDo: [:beh :ar |
      aBlock value: beh value: (ar at: 1)
  ].
%
category: 'Compiling'
method: GsPackage
methodAndCategoryDictionaryFor: aBehavior 
do: aBlock

	| methodDict categoryDict ar |
	ar := self sessionInfoFor: aBehavior.
	methodDict := (ar at: 1).
	categoryDict := (ar at: 2).
	^aBlock value: methodDict value: categoryDict value: nil
%
category: 'Compiling'
method: GsPackage
setPragmas: pragmaArray
forBehavior: aBehavior
forMethod: selector

    | ar methodPragmaDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^nil ].
    ar size < 4 ifTrue: [ar at: 4 put: Dictionary new].
    methodPragmaDict := (ar at: 4) at: aBehavior otherwise: nil.
	methodPragmaDict == nil 
		ifTrue: [ 
			methodPragmaDict := Dictionary new.
			(ar at: 4) at: aBehavior put: methodPragmaDict.
		 ].
	pragmaArray == nil
		ifTrue: [ methodPragmaDict removeKey: selector asSymbol ifAbsent: [ nil ] ]
		ifFalse: [ methodPragmaDict at: selector asSymbol put: pragmaArray ].
	^self
%
category: 'Compiling'
method: GsPackage
setStamp: aStamp 
forBehavior: aBehavior
forMethod: selector

    | ar methodStampDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^nil ].
    methodStampDict := (ar at: 3) at: aBehavior otherwise: nil.
	methodStampDict == nil 
		ifTrue: [ 
			methodStampDict := Dictionary new.
			(ar at: 3) at: aBehavior put: methodStampDict.
		 ].
	aStamp == nil
		ifTrue: [ methodStampDict removeKey: selector asSymbol ifAbsent: [] ]
		ifFalse: [ methodStampDict at: selector asSymbol put: aStamp ].
	^self
%
category: 'Compiling'
method: GsPackage
methodPragmaDictFor: aBehavior

    | ar |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^nil ].
    ar size < 4 ifTrue: [ar at: 4 put: Dictionary new].
   ^(ar at: 4) at: aBehavior otherwise: nil
%
category: 'Compiling'
method: GsPackage
methodStampDictFor: aBehavior

    | ar |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^nil ].
   ^(ar at: 3) at: aBehavior otherwise: nil
%
category: 'Accessing'
method: GsPackage
sessionMethods

	^sessionMethods
%
category: 'Categories'
method: GsPackage
addCategory: aSymbol for: aBehavior
    | ar catDict |
	ar := self sessionInfoFor: aBehavior.
    catDict := (ar at: 2).
    catDict add: (SymbolAssociation newWithKey: aSymbol
                                       value: SymbolSet new )
%
category: 'Categories'
method: GsPackage
removeCategory: aSymbol for: aBehavior

    | ar catDict |
	ar := self sessionMethods at: aBehavior ifAbsent: [ ^self ].
	catDict := (ar at: 2).
    catDict removeKey: aSymbol ifAbsent: []
%
category: 'Categories'
method: GsPackage
categoryNamesFor: aBehavior into: anArray

    | ar catDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^self ].
    catDict := (ar at: 2).
    catDict keysAndValuesDo: [:aKey :aValue |
      anArray add: aKey
    ].
%
category: 'Categories'
method: GsPackage
selectorsIn: categoryName for: aBehavior into: anArray

    | ar catDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^self ].
    catDict := (ar at: 2).
    anArray addAll: (catDict at: categoryName asSymbol otherwise: #()).
%
category: 'Methods'
method: GsPackage
copyCategoryDictFor: aBehavior into: aGsMethodDictionary 
 
    | ar catDict | 
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^self ]. 
    catDict := (ar at: 2). 
    catDict keysAndValuesDo: [:key :values | | coll | 
        coll := aGsMethodDictionary at: key otherwise: nil. 
        coll == nil 
          ifTrue:[ 
            coll := SymbolSet new. 
            aGsMethodDictionary at: key put: coll].
        coll canBeWritten
          ifFalse: [ 
            coll := coll copy. 
            aGsMethodDictionary at: key put: coll].  
        coll addAll: values.
    ].
%
category: 'Methods'
method: GsPackage
selectorsFor: aBehavior into: anArray

    | ar methDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^self ].
    methDict := (ar at: 1).
    anArray addAll: methDict keys.
%
category: 'Methods'
method: GsPackage
categoryOfSelector: aSymbol for: aBehavior

    | ar catDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^nil ].
    catDict := (ar at: 2).
    catDict keysAndValuesDo: [:aKey :aValue | 
      (aValue includesIdentical: aSymbol ) ifTrue:[ ^ aKey ].
    ].
    ^ nil
%
category: 'Methods'
method: GsPackage
compiledMethodAt: aSymbol for: aBehavior

    | ar methDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^nil ].
    methDict := (ar at: 1).
    ^methDict at: aSymbol otherwise: nil
%
category: 'Methods'
method: GsPackage
includesSelector: aSymbol for: aBehavior

    | ar methDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^false ].
    methDict := (ar at: 1).
    ^methDict includesKey: aSymbol
%
category: 'Methods'
method: GsPackage
copyMethodDictFor: aBehavior into: aGsMethodDictionary

    | ar methDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^self ].
    methDict := (ar at: 1).
    methDict keysAndValuesDo: [:key :value |
        aGsMethodDictionary at: key put: value
    ].
%
category: 'Accessing'
method: GsPackage
symbolDict

    ^symbolDict
%
category: 'Accessing'
method: GsPackage
symbolDict: aSymDict

    symbolDict := aSymDict
%
category: 'Accessing'
method: GsPackage
prereqs

    ^prereqs
%
category: 'Accessing'
method: GsPackage
addPrereq: aSymbolDict

    prereqs add: aSymbolDict
%
category: 'Methods'
method: GsPackage
removeAllMethodsFor: aBehavior

    self sessionMethods removeKey: aBehavior ifAbsent: [ ^self ]
%
category: 'Methods'
method: GsPackage
removeMethodAt: aSymbol for: aBehavior

	| ar methDict meth catDict stampDict pragmaDict |
	ar := self sessionMethods at: aBehavior ifAbsent: [ ^nil ].
	methDict := (ar at: 1).
	meth := methDict removeKey: aSymbol ifAbsent: [ ^nil ].
    stampDict := (ar at: 3).
    stampDict removeKey: aSymbol ifAbsent: [ nil ].
    ar size == 4
      ifTrue: [
        pragmaDict := (ar at: 4).
        pragmaDict removeKey: aSymbol ifAbsent: [ nil ].
      ].
	catDict := (ar at: 2).
    catDict keysAndValuesDo: [:aKey :aValue | 
		(aValue remove: meth selector ifAbsent: [ nil ] ) ~~ nil  ifTrue:[ ^ meth ].
    	].
    ^nil
%
category: 'Methods'
method: GsPackage
sessionInfoFor: aBehavior

	| ar |
	ar := self sessionMethods at: aBehavior otherwise: nil.
	ar == nil
		ifTrue: [ | methodDict categoryDict stampDict pragmaDict |
			methodDict := GsMethodDictionary new.
			categoryDict := GsMethodDictionary new.
            stampDict := Dictionary new.
            pragmaDict := Dictionary new.
			ar := Array with: methodDict with: categoryDict with: stampDict with: pragmaDict.
			self sessionMethods at: aBehavior put: ar.
		].
    ^ar
%
category: 'Methods'
method: GsPackage
removeAllSubclassCodeFor: aBehavior
    | ar methDict |
    ar := self sessionMethods at: aBehavior ifAbsent: [ ^self ].
    methDict := (ar at: 1).
    methDict keysAndValuesDo: [ :aKey :aMethod |
      methDict at: aKey put: ((methDict at: aKey) _copyToForceRecompilation).
    ].
%
category: 'Categories'
method: GsPackage
removeSelector: aSelector fromCategoriesFor: aBehavior

	| ar catDict |
	ar := self sessionMethods at: aBehavior ifAbsent: [ ^false ].
	catDict := (ar at: 2).
    catDict keysAndValuesDo: [:aKey :aValue | 
		aValue remove: aSelector ifAbsent: [ nil ]].
%
category: 'Categories'
method: GsPackage
addSelector: aSelector toCategory: categoryName for: aBehavior
    "new category is expected to exist"
	| ar catDict |
	ar := self sessionMethods at: aBehavior ifAbsent: [ ^self ].
	catDict := (ar at: 2).
    (catDict at: categoryName) add: aSelector.
%
