!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: system.gs,v 1.126.2.1 2008-03-21 23:46:03 bretlb Exp $
!
! Superclass Hierarchy:
!   System, Object.
!
!=========================================================================

removeallmethods System
removeallclassmethods System
set class System

category: 'For Documentation Installation only'
classmethod: System
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'System is an abstract class that has no instances.  It implements class
 methods for object locking and for operations that are usually found in
 traditional operating systems.  The data curator may restrict user access to
 these messages.  For an explanation of the role of the data curator, refer to
 your GemStone System Administration Guide.'.
doc documentClassWith: txt.

txt := (GsDocText new) details:
'Methods in this category are obsolete and are provided only for compatibility
 with earlier releases of GemStone.  They will be removed in a future release.'.
doc documentClassCategory: #'Backward Compatibility' with: txt.

txt := (GsDocText new) details:
'These methods are used in managing cluster buckets, the streams of disk pages
 in which objects are congregated during clustering.  Clustering is explained
 in the GemStone Programming Guide.'.
doc documentClassCategory: #Clustering with: txt.

txt := (GsDocText new) details:
'In each of these file system access methods, it is best to specify the full
 path name of the server text file in the method''s argument.

 Under Unix, be sure that the case of the argument matches the case of the Unix
 file name; Unix is case-sensitive.

 Also note that under Unix, each of these methods inherits environment
 variables from the GemStone session process, rather than from your user
 session.  In addition, the method performOnServer: invokes the Bourne shell,
 even if you use a different login shell.  For these reasons, you might want to
 avoid using environment variables in the arguments to these methods.'.
doc documentClassCategory: #'Host System Access' with: txt.

txt := (GsDocText new) details:
'GemStone maintains two sets of objects that you can manipulate with methods in
 this category.  The commit release locks set contains locked objects whose
 locks will be released as part of the next successful commit operation.  The
 commit-or-abort release locks set contains locked objects whose locks will be
 released as part of the next successful commit operation or abort operation.
 To gain complete control over the automatic releasing of locks at the end of a
 transaction, use these methods during the transaction to govern the membership
 of objects in these sets.'.
doc documentClassCategory: #'Releasing Locks' with: txt.

txt := (GsDocText new) details:
'Transactions are discussed in detail in the GemStone Programming Guide.'.
doc documentClassCategory: #'Transaction Control' with: txt.

self description: doc.
%

! method comments re: 33533
category: 'Backward Compatibility'
classmethod: System
deleteServerFile: aFileSpec

"Obsolete as of GemStone 5.0.  Use the GsFile>>removeServerFile: method instead.

 Gs64 v2.0, wild cards '*' and '?' no longer supported in aFileSpec."

<primitive: 346>
aFileSpec _validateClass: String.
aFileSpec _error: #hostErrFileDelete args:  #()
%

category: 'Host System Access'
classmethod: System
performOnServer: aString

"This method causes the operating system commands in aString to be executed as
 a spawned subprocess.  Generates an error if aString cannot be executed by the
 operating system.

 Under Unix, commands in aString can have exactly the same form as a shell
 script.  For example, newlines or semicolons can separate commands, and a
 backslash can be used as an escape Character."

<primitive: 347>
aString _validateClass: String.
^ aString _error: #hostErrPerform args:  #() 
%

category: 'Error Handling'
classmethod: System
signal: anInteger args: anArray signalDictionary: anErrorDict

"This method generates the specified signal (or error), along with its
 associated arguments.  If an Exception is available to field the error, the
 Exception is invoked, otherwise returns control to the
 controlling GemBuilder for C (GCI) interface."

"GciContinueWith() depends upon this implementation and selector."

| ex |
ex := Exception _exceptionFor: anInteger signalDictionary: anErrorDict .
ex ~~ nil ifTrue:[
  ^ ex _signal: anErrorDict number: anInteger args: anArray .
  ] .
^ self _signalGciError: anInteger args: anArray signalDictionary: anErrorDict
%

category: 'Error Handling'
classmethod: System
_signalGciError: anInteger args: anArray signalDictionary: anErrorDict

"This method generates the specified signal (or error), along
 with its associated arguments and returns control to GemBuilder for C."

"GciContinueWith() depends upon this implementation."

<primitive:907>

anInteger _validateClass: SmallInteger.
anInteger < 1 ifTrue: [ ^ self _error: #rtErrBadErr
                 args: #[ anInteger, anArray, anErrorDict]].
anArray _validateClass: Array.
anArray size > 10 ifTrue: [ ^ self _error: #rtErrTooManyErrArgs
                args: #[ anArray size]].

anErrorDict _validateClass: SymbolDictionary. 

self _primitiveFailed: #signal:args:signalDictionary: .
self _uncontinuableError
%

category: 'Error Handling'
classmethod: System
genericSignal: errIdentifier text: aString

"Raise a user-defined signal with no arguments.

 The argument errIdentifier is a user-defined object, to distinguish user
 errors, and may be nil.  The argument aString appears in GemStone's error
 message for this error, and may be nil."

self genericSignal: errIdentifier text: aString args: #[]
%

category: 'Error Handling'
classmethod: System
genericSignal: errIdentifier text: aString arg: anArg

"Raise a user-defined signal with one argument.

 The argument errIdentifier is a user-defined object, to distinguish user
 errors, and may be nil.  The argument aString appears in GemStone's error
 message for this error, and may be nil.  The argument anArg appears as the
 third argument to the error."

| errorNumber allArgs |
allArgs := #[ errIdentifier, aString, anArg ] .
errorNumber := self _errorSymbolToNumber: #genericError args: allArgs .

self signal: errorNumber args: allArgs signalDictionary: GemStoneError
%

category: 'Error Handling'
classmethod: System
genericSignal: errIdentifier text: aString args: anArray

"Raise a user-defined signal.

 The argument errIdentifier is a user-defined object, to distinguish user
 errors, and may be nil.  The argument aString appears in GemStone's error
 message for this error, and may be nil.  The argument anArray appears as the
 third argument to the error."

| errorNumber allArgs |
allArgs := #[ errIdentifier, aString ] .
allArgs addAll: anArray .
errorNumber := self _errorSymbolToNumber: #genericError args: allArgs .

self signal: errorNumber args: allArgs signalDictionary: GemStoneError
%

! stackLimit removed

category: 'Debugging Support'
classmethod: System
stackLimit

"Returns the approximate limit on the depth of the GemStone Smalltalk stack.
 The stack size is determined by the configuration file parameter
 GEM_MAX_SMALLTALK_STACK_DEPTH."

^ self _zeroArgPrim: 1
%

category: 'System Control'
classmethod: System
_deadNotReclaimedCount

"Return the number of dead not reclaimed objects in the system.
 The result has a resolution of 1K objects and units of objects."
^ self _zeroArgPrim: 69
%

category: 'System Control'
classmethod: System
_scavengablePagesCount

"Return the number of scavengable pages in the system."
^ self _zeroArgPrim: 70
%

category: 'System Control'
classmethod: System
_possibleDeadSize

"Return the number of possible dead objects in the system."
^ self _zeroArgPrim: 71
%

category: 'System Control'
classmethod: System
_commitRecordBacklog

"Return the number of commit records in the system."
^ self _zeroArgPrim: 72
%

category: 'System Control'
classmethod: System
_totalSessionsCount

"Return the number of sessions logged into the system."
^ self _zeroArgPrim: 73
%

category: 'System Control'
classmethod: System
_remoteSharedCacheCount
"Return the number of remote shared page caches on the system."
^ self _zeroArgPrim: 74
%

category: 'Debugging Support'
classmethod: System
_enableTraceNewPomObjs
"Causes all newly committed objects to be added to hidden set 4
 immediately after they are committed.  Also causes hidden set 4
 to be cleared if tracing was previously disabled when this method
 is called."
^ self _zeroArgPrim: 75
%

category: 'Debugging Support'
classmethod: System
_disableTraceNewPomObjs
"Causes the system to discontinue adding newly committed objects 
 to hidden set 4 immediately after they are committed.  Does not
 modify the state of hidden set 4."
^ self _zeroArgPrim: 76
%


category: 'Debugging Support'
classmethod: System
stackLimit: anInteger

"Has no effect in this release.  Provided for compatibility."

anInteger _validateClass: SmallInteger .
(anInteger < 0) ifTrue: [ anInteger _error: #rtErrArgNotPositive ].
^ self
%

category: 'Debugging Support'
classmethod: System
stackDepth

"Returns current depth of the GemStone Smalltalk stack."

^ self _zeroArgPrim: 26
%

category: 'Debugging Support'
classmethod: System
stackDepthHighwater

"Returns largest depth of the GemStone Smalltalk stack since session login."

^ self _zeroArgPrim: 27
%

! _addBreak:  deleted
! _breakLimit deleted
! _breakpointReport deleted
! _clearAllBreaks deleted
! _clearBreakAt: deleted
! _setStepping: deleted
! _updateDebuggerCache deleted
! _breakReportArray deleted
! _breakReportAt: deleted

category: 'Instance Creation'
classmethod: System
new

"Disallowed.  You may not create new instances of System."

self shouldNotImplement: #new
%

category: 'Clustering'
classmethod: System
clusterAllSymbols

"This method clusters the AllSymbols hash dictionary and all of the symbols to
 which it refers.
 The clustering is performed by the Symbol Creation Gem, and other
 sessions may see a long latency on symbol creation requests while
 the clustering is in progress."

| result |
GsFile gciLogClient:'-- sending clusterAllSymbols to Symbol Creation gem'.
result := self _zeroArgCateg2Prim: 6 .
GsFile gciLogClient:'-- waiting 10 seconds for Symbol Creation gem commit'.
self sleep: 10 .
^ result
%

category: 'Clustering'
classmethod: System
_clusterImage

"For all classes in Globals, clusters behavior and descriptions "

| classes nonClasses behaviorBucket descriptionBucket otherBucket |
behaviorBucket := AllClusterBuckets at: 4 .
descriptionBucket := AllClusterBuckets at: 5 .
otherBucket := AllClusterBuckets at: 6  .

classes := Globals select:[:i| i isKindOf: Behavior ] .
nonClasses := Globals reject:[:i| i isKindOf: Behavior ] .
nonClasses removeAssociation: (Globals associationAt: #Globals ).

self clusterBucket: behaviorBucket.
classes associationsDo: [ :each |
    each value _alias . "for debugging"
    each value clusterBehavior.
    ].

self clusterBucket: descriptionBucket.
classes associationsDo: [ :each | 
    each value clusterDescription.
    ] .
^ true
%

category: 'Clustering'
classmethod: System
_clusterUserClassesVisibleFromUserProfile: aUserProfile

"Cluster all classes contained in symbol list dictionaries for the
 given user profile.  Kernel classes in Globals are not clustered;
 the _clusterImage method should be used to cluster kernel classes."

|behaviorBucket descriptionBucket symbolList|

symbolList := aUserProfile symbolList copy.
symbolList remove: Globals.
symbolList removeDictionaryNamed: #Published ifAbsent: [ ].
 
"Identify cluster buckets for class and method objects"
behaviorBucket := AllClusterBuckets at: 4.
descriptionBucket := AllClusterBuckets at: 5.
self clusterBucket: behaviorBucket.
symbolList do:[:eachSymbolDictionary|
  eachSymbolDictionary rebuildIfNeeded.
  eachSymbolDictionary cluster.
  eachSymbolDictionary associationsDo:[ :eachAssociation |
    eachAssociation cluster.	
    (eachAssociation value isKindOf: Behavior)
      ifTrue:[eachAssociation value clusterBehavior.].
  ].
].

self clusterBucket: descriptionBucket.
symbolList do:[:eachSymbolDictionary|
  eachSymbolDictionary associationsDo:[ :eachAssociation | |val|
  val := eachAssociation value.
  (val isKindOf: Behavior)
    ifTrue:[val clusterDescription.].
  ].
].
%

category: 'Clustering'
classmethod: System
currentClusterBucket

"Returns the instance of ClusterBucket that is the current default."

^ AllClusterBuckets at: self currentClusterId
%

category: 'Clustering'
classmethod: System
currentClusterId

"This method returns a SmallInteger that is the ID of the ClusterBucket that
 is the current default bucket."

<primitive: 96>
self _primitiveFailed: #currentClusterId .
self _uncontinuableError
%

category: 'Clustering'
classmethod: System
clusterBucket: aClusterBucketOrId

"This method sets the current default ClusterBucket to the ClusterBucket with
 the specified clusterId.  The argument may be an instance of ClusterBucket, or
 a positive SmallInteger which specifies an instance of ClusterBucket."

<primitive: 348>
self _primitiveFailed: #clusterBucket: .
self _uncontinuableError
%

category: 'Clustering'
classmethod: System
maxClusterBucket

"Returns the maximum legal clusterId as a SmallInteger."

^ AllClusterBuckets size
%

category: 'Backward Compatibility'
classmethod: System
contentsOfServerDirectory: aSpecString

"Obsolete in GemStone 5.0.  Use the GsFile>>contentsOfDirectory: onClient:
 method instead."

<primitive: 345>

aSpecString _validateClass: String.
^ aSpecString _error: #hostErrFileDirectory args:  #()
%

category: 'Private'
classmethod: System
_initMap: aMap

"Initializes the underlying data structures used to perform the mapping
 of passivated objects.  The argument aMap must be in the range 1 - 4."

<primitive: 319>
self _primitiveFailed: #_initMap:.
%

category: 'Private'
classmethod: System
_inMap: aMap at: anOop putIfAbsent: newValue

"If there is no current value at anOop in the passive object map aMap,
 (that is, it is absent), then this method stores newValue and returns newValue.
 If the current value at anOop is valid however, it returns the value and does
 not store the newValue in the map.  

 The argument aMap must be in the range 1 - 4
 and newValue must be a positive SmallInteger.

 anOop must not be a special object."

<primitive: 320>
aMap _validateClass: SmallInteger .
(aMap < 1 _or:[ aMap > 4]) ifTrue:[ aMap _halt:'argument out of range' ].
anOop isSpecial ifTrue:[ anOop _halt:'special object not allowed' ].
newValue _validateClass: SmallInteger .
newValue < 1 ifTrue:[ newValue _error: #rtErrArgNotPositive ].
self _primitiveFailed: #_inMap:at:putIfAbsent: .
%

category: 'Private'
classmethod: System
_updateNoRollback: anyObj add: aBoolean

"Add or remove anyObj from the no-rollback set.  If an object is in the
 no-rollback set, then it is treated as a temporary and does not get rolled
 back on aborts."

aBoolean ifTrue: [self _add: anyObj to: 2]
         ifFalse: [self _remove: anyObj from: 2].
^System
%

category: 'Disk Space Management'
classmethod: System
_findObjectsLargerThan: aSize limit: aLimit

"Searches GemStone for objects larger than aSize, and returns an Array of
 any such objects.  The search continues until all such objects have been
 found, or until the size of the result reaches the specified maximum aLimit.
 Both aSize and aLimit must be positive SmallIntegers.
 If aLimit == 0, the result size is unlimited.
 The result size may be larger than aLimit by the number of objects in a data page.

 This method aborts the current transaction; unsaved changes will be lost.

 The result contains both permanent and temporary objects.  The temporary
 objects found may vary from run to run.

 Note that this method may take a considerable length of time to execute."

<primitive: 398>
aSize _validateClass: SmallInteger.
(aSize < 0) ifTrue: [aSize _error: #rtErrArgNotPositive .  ^ Array new ].
aLimit _validateClass: SmallInteger.
(aLimit < 0) ifTrue: [aLimit _error: #rtErrArgNotPositive.  ^ Array new ].
^ self _primitiveFailed: #findObjectsLargerThan:Limit:
%

category: 'Disk Space Management'
classmethod: System
findObjectsLargerThan: aSize limit: aLimit
 
"Searches GemStone for objects larger than aSize, and returns an Array of
 any such objects.  The search continues until all such objects have been
 found, or until the size of the result reaches the specified maximum aLimit.
 Both aSize and aLimit must be positive SmallIntegers.
 If aLimit == 0, the result size is unlimited.

 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData.    

 The result contains both permanent and temporary objects.  The temporary
 objects found may vary from run to run.

 Note that this method may take a considerable length of time to execute."

| res |

self needsCommit
  ifTrue: [ self _error: #rtErrAbortWouldLoseData ] .

res := self _findObjectsLargerThan: aSize limit: aLimit .
aLimit > 0 ifTrue:[
  res size > aLimit ifTrue:[ res size: aLimit ].
].
^res
%


category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol

"Invokes the user-defined action represented by aSymbol.  Generates an error if
 the user action is not installed in this session, or if it expects any
 arguments.

 A maximum of 47 user actions may be active at any one time on the current
 GemStone Smalltalk stack."

<primitive: 200>
^ self _primitiveFailed: #userAction:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol with: anArg

"Invokes the user-defined action represented by aSymbol, passing it the argument
 anArg.  Generates an error if the user action is not installed in this session,
 or if the number of arguments expected by the user action is not 1.

 A maximum of 47 user actions may be active at any one time on the current
 GemStone Smalltalk stack."

<primitive: 200>
^ self _primitiveFailed: #userAction:with:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol with: firstArg with: secondArg

"Invokes the user-defined action represented by aSymbol, passing it the
 arguments firstArg and secondArg.  Generates an error if the user action is not
 installed in this session, or if the number of arguments expected by the user
 action is not 2.

 A maximum of 47 user actions may be active at any one time on the current
 GemStone Smalltalk stack."

<primitive: 200>
^ self _primitiveFailed: #userAction:with:with:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol with: firstArg with: secondArg with: thirdArg

"Invokes the user-defined action represented by aSymbol, passing it the
 arguments firstArg, secondArg, and thirdArg.  Generates an error if the user
 action is not installed in this session, or if the number of arguments expected
 by the user action is not 3.

 A maximum of 47 user actions may be active at any one time on the current
 GemStone Smalltalk stack."

<primitive: 200>
^ self _primitiveFailed: #userAction:with:with:with:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol withArgs: anArray

"Invokes the user-defined action represented by aSymbol, passing it the elements
 of anArray as arguments.  Generates an error if the user action is not
 installed in this session, or if the number of arguments expected by the user
 action is not the same as the number of elements in anArray.

 A maximum of 47 user actions may be active at any one time on the current
 GemStone Smalltalk stack."

<primitive: 201>
^ self _primitiveFailed: #userAction:withArgs:
%

category: 'User-Defined Actions'
classmethod: System
userActionReport

"Returns a SymbolDictionary that provides information about all user actions
 installed in this GemStone session.  In that SymbolDictionary, the keys are
 the symbolic names of the user actions, and the values are Booleans (true if
 the user action is linked with your application, false if the user action is
 linked with the current GemStone session)."

 | anArray result |
 anArray :=  self _zeroArgCateg2Prim: 7 . "get an Array of SymbolAssociations"
 result := SymbolDictionary new .
 1 to: anArray size do:[:j | result addAssociation: (anArray at: j ) ].
 ^ result

%

category: 'User-Defined Actions'
classmethod: System
systemUserActionReport

"Returns a SymbolDictionary that provides information about GemStone system user
 actions.  These are user actions that are automatically installed in every
 GemStone session to support classes such as GsFile and GsSocket.

 In the resulting SymbolDictionary, the keys are the symbolic names of the user
 actions, and the values are Booleans.  A values is true if the user action is
 linked with your application, and false if the user action is linked with the
 current GemStone session."

| anArray result |

anArray :=  self _zeroArgCateg2Prim: 9 . "get an Array of SymbolAssociations"
result := SymbolDictionary new .
1 to: anArray size do:[:j | result addAssociation: (anArray at: j ) ].
^ result
%

category: 'User-Defined Actions'
classmethod: System
hasUserAction: aSymbol

"Returns true if the user action named aSymbol is installed in this GemStone
 session.  Returns false otherwise."

<primitive: 105>
aSymbol _validateClass: String.
^ self _primitiveFailed: #hasUserAction:
%

category: 'User-Defined Actions'
classmethod: System
loadUserActionLibrary: aString

"Loads the session user action library specified by aString.
 This method always returns the receiver (System)."

<primitive: 426>
^ self _primitiveFailed: #loadUserActionLibrary:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol with: firstArg with: secondArg with: thirdArg
  with: fourthArg

"Invokes the user-defined action represented by aSymbol, passing it the
 arguments firstArg, secondArg, thirdArg, and fourthArg.  Generates an error if
 the user action is not installed in this session, or if the number of
 arguments expected by the user action is not 4."

<primitive: 200>
^ self _primitiveFailed: #userAction:with:with:with:with:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol with: firstArg with: secondArg with: thirdArg
  with: fourthArg with: fifthArg

"Invokes the user-defined action represented by aSymbol, passing it the
 arguments firstArg, secondArg, thirdArg, fourthArg, and fifthArg.  Generates
 an error if the user action is not installed in this session, or if the number
 of arguments expected by the user action is not 5."

<primitive: 200>
^ self _primitiveFailed: #userAction:with:with:with:with:with:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol with: firstArg with: secondArg with: thirdArg
  with: fourthArg with: fifthArg with: sixthArg

"Invokes the user-defined action represented by aSymbol, passing it the
 arguments firstArg, secondArg, thirdArg, fourthArg, fifthArg, and sixthArg.
 Generates an error if the user action is not installed in this session, or if
 the number of arguments expected by the user action is not 6."

<primitive: 200>
^ self _primitiveFailed: #userAction:with:with:with:with:with:with:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol with: firstArg with: secondArg with: thirdArg
  with: fourthArg with: fifthArg with: sixthArg with: seventhArg

"Invokes the user-defined action represented by aSymbol, passing it the
 arguments firstArg, secondArg, thirdArg, fourthArg, fifthArg, sixthArg, and
 seventhArg.  Generates an error if the user action is not installed in this
 session, or if the number of arguments expected by the user action is not 7."

<primitive: 200>
^ self _primitiveFailed: #userAction:with:with:with:with:with:with:with:
%

category: 'User-Defined Actions'
classmethod: System
userAction: aSymbol with: firstArg with: secondArg with: thirdArg
  with: fourthArg with: fifthArg with: sixthArg with: seventhArg
  with: eighthArg

"Invokes the user-defined action represented by aSymbol, passing it the
 arguments firstArg, secondArg, thirdArg, fourthArg, fifthArg, sixthArg,
 seventhArg, and eighthArg.  Generates an error if the user action is not
 installed in this session, or if the number of arguments expected by the
 user action is not 8."

<primitive: 200>
^ self _primitiveFailed: #userAction:with:with:with:with:with:with:with:with:
%

category: 'Version Management'
classmethod: System
_version

"Returns a String describing the versions of the pieces of the running GemStone
 system."

| result |
result := String new .
result addAll: 'GEMSTONE: ' ; addAll: self _gemVersion ; 
	addAll: '; IMAGE: ' ; addAll: self _imageVersion .
^ result
%

category: 'Version Management'
classmethod: System
_gemVersion

"Private."

^ self _zeroArgCateg2Prim: 3 
%

category: 'Version Management'
classmethod: System
_imageVersion

"Returns a String, which contains the history of the image."

^Globals at: #DbfHistory.
%

category: 'System Control'
classmethod: System
activeRepositories

"Returns an Array containing references to the repositories that are
 attached at the time the message is sent."

^ self _zeroArgCateg2Prim: 0
%

category: 'System Control'
classmethod: System
resumeLogins

"Allows new sessions to be initiated.  (Enables users to login.)  Logins are
 enabled when the GemStone system is started.  This message reverses the effect
 of System | suspendLogins.  Requires the SystemControl privilege."

self configurationAt: #StnLoginsSuspended put: 0
%

category: 'System Control'
classmethod: System
shutDown

"Aborts all current sessions, then terminates them.  Finally, the GemStone
 system is shut down.  The session issuing this message terminates with a
 broken connection.  Requires the SystemControl privilege."

^ self _zeroArgPrim: 8
%

category: 'System Control'
classmethod: System
suspendLogins

"Prevents any new sessions from being initiated.  That is, no new user is
 allowed to login.  However, users already active will be allowed to continue
 processing.

 To reenable logins, send the message System | resumeLogins.  (If you fail to do
 so, GemStone automatically reenables logins when the last user logs out.)

 Requires the SystemControl privilege."

self configurationAt: #StnLoginsSuspended put: 1 
%

category: 'System Control'
classmethod: System
concurrencyMode

"This method is obsolete, concurrency mode is always #NO_RW_CHECKS"

^ #NO_RW_CHECKS
%

!  _gciDirtyObjsInitialized deleted

! edited to fix 36577
category: 'Private'
classmethod: System
_primitiveCommit: commitMode

"Do not call this method directly; it is private to GemStone.  You must use
 commitTransaction or commitAndReleaseLocks.  Otherwise Gem Builder breaks.

 The argument commitMode is a SmallInteger: 
    0 for normal, 
    1 for release locks,
    2 for checkpoint and release locks.
    3  value not used , primitive will fail
    4 checkpoint and start dpNsUnion (used by full backup)

 The result of this primitive is a SmallInteger: 
      -2 promote to checkpoint requested but checkpoints are suspended,  
           commit succeeded but did not promote
      -1 read-only  (there were no modified objects to commit),
       0 success, 
       1 rcFailure  (replay of changes to instances of Rc classes failed),
       2 dependencyMap failure  (concurrency conflict on dependencyMap),
       3 validationFailure  (concurrency conflict),
       4 retryFailure,   (previous commit attempt failed with an rcFailure)
       5 commitDisallowed (disallowed due to other error),
       6 retry limit exceeded "

<primitive: 336>
commitMode _validateClass: SmallInteger .

(commitMode < 0 _or:[ commitMode > 2 ])
  ifTrue:[ commitMode _error: #rtErrArgOutOfRange .  ^ 1 "failure" ] .

self _primitiveFailed: #_primitiveCommit: .
self _uncontinuableError
%

category: 'Private'
classmethod: System
_primitiveAbort

"Do not call this method directly; it is private to GemStone.  You must use
 abortTransaction.  Otherwise the transparent GemStone Smalltalk interface will
 break.

 This method rolls back all modifications made to committed GemStone objects
 (connected to the root) and provides the session with a new view of the most
 current committed state.  These operations are performed whether or not the
 session was previously in a transaction.  If the transactionMode is set to
 #autoBegin, then a new transaction is started.  If the transactionMode is set
 to #manualBegin or #transactionless, then a new transaction is not started, 
 but the session's view of the database is updated.
 This method always returns the receiver (System)."

<primitive: 335>
self _primitiveFailed: #_primitiveAbort .
self _uncontinuableError
%

category: 'Transaction Control'
classmethod: System
startCheckpointSync
"Starts a synchronous checkpoint.  If a checkpoint is already
 in progress, this method will not start another.  Instead, it
 will block until the current checkpoint completes.
 
 If successful, this method returns after the a checkpoint has
 completed.  To start a new checkpoint and return before it
 completes, use the startCheckpointAsync method instead
 of this one.

 This method does not commit (or otherwise modify) the current
 transaction.

 Requires the SystemControl privilege.

 A result of true means a checkpoint was successfully finished.
 A result of false means a checkpoint could not be started.  This
 usually happens because checkpoints are suspended or no tranlog
 space is available, or the repository is in restore-from-log mode.
 It can also happen if more than one session
 calls this method at the same time."

 ^self _zeroArgPrim: 62
%

category: 'Transaction Control'
classmethod: System
startCheckpointAsync
"Starts an asynchronous checkpoint.  If a checkpoint is already
 in progress, this method will not start another.  Instead, it
 will return 'true', indicating a checkpoint is in progress.   If a
 checkpoint is not in progress, a new checkpoint is started and
 this method returns immediately.   To block until the checkpoint
 completes, use the startCheckpointSync method instead.

 Unlike the commitTransactionWithCheckpoint method, this method
 does not commit (or otherwise modify) the current transaction.

 Requires the SystemControl privilege.

 A result of true means a checkpoint was successfully started.
 A result of false means a checkpoint could not be started.  This
 usually happens because checkpoints are suspended or no tranlog
 space is available, or the repository is in restore-from-log state.
 It can also happen if more than one session
 calls this method at the same time."

 ^self _zeroArgPrim: 63
%

! commitTransactionWithCheckpoint deleted

category: 'Transaction Control'
classmethod: System
commitAndReleaseLocks

"Attempt to commit the transaction for the current session.

 This method is the same as 'commitTransaction' except for the handling of
 locks.  If the commit succeeds, this method releases all locks for the session
 and returns true.  Otherwise, it returns false and does not release locks.

 This method also clears the commit release locks and commit-or-abort release
 locks sets.  See the 'Releasing Locks' method category for more
 information.

 Returns true if commit was read-only or succeeded ,
 false if there was a failure.  "

^ self _commit: 1 "release locks if successful"
%

! fixed 31184
category: 'Transaction Control'
classmethod: System
transactionConflicts

"Returns a SymbolDictionary that contains an Association whose key is
 #commitResult and whose value is one of the following Symbols: #success,
 #failure, #retryFailure, #commitDisallowed, or #rcFailure .

 The remaining Associations in the dictionary are used to report the conflicts
 found.  Each Association's key indicates the kind of conflict detected; its
 associated value is an Array of OOPs for the objects that are conflicting.
 If there are no conflicts for the transaction, the returned SymbolDictionary
 has no additional Associations.

 The conflict sets are cleared at the beginning of a commit or abort and
 therefore may be examined until the next commit, continue or abort.

 The keys for the conflicts are as follows:

     Key                Conflicts
 Read-Write          StrongReadSet and WriteSetUnion conflicts.
 Write-Write         WriteSet and WriteSetUnion conflicts.
 Write-Dependency    WriteSet and DependencyChangeSetUnion conflicts.
 Write-WriteLock     WriteSet and WriteLockSet conflicts.
 Write-ReadLock      WriteSet and ReadLockSet conflicts.
 Rc-Write-Write      Logical write-write conflict on reduced conflict object.

 The Read-Write conflict set has already had RcReadSet subtracted from it.
 The Write-Write conflict set does not have RcReadSet subtracted .

 Beginning with Gemstone64 v1.1 , the WriteSet no longer includes 
 objects newly committed by this transaction.  Thus a 
 conflict between a lock and a newly committed object in prior
 releases will no longer show up as a conflict.

 The Write-Dependency conflict set contains objects modified (including DependencyMap
 operations) in the current transaction that were either added to, removed from, 
 or changed in the DependencyMap by another transaction. Objects in the 
 Write-Dependency conflict set may be in the Write-Write conflict set.

 Note: You should be sure to disconnect conflict sets before committing to
 avoid making them persistent."

| symbolDict rcObject sess resultSymbol assoc symAssocCls |

resultSymbol := #( #readOnly  		"must agree with _commitResult method"
		 #success 
		 #rcFailure 
	         #dependencyFailure 
                 #failure 
		 #retryFailure
                 #commitDisallowed
                 #retryLimitExceeded ) at:  (self _commitResult + 2 ) .
		   
symAssocCls := SymbolAssociation .
assoc := symAssocCls newWithKey: #commitResult value: resultSymbol.
symbolDict := SymbolDictionary new.
symbolDict add: assoc.

(self _hiddenSetSize: 13) > 0 ifTrue: [   "StrongRead - Write conflicts"
  symbolDict add: (symAssocCls newWithKey: #'Read-Write' 
                                     value: (self _hiddenSetAsArray: 13)) ].

(self _hiddenSetSize: 15) > 0 ifTrue: [
  symbolDict add: (symAssocCls newWithKey: #'Write-Write' 
                                     value: (self _hiddenSetAsArray: 15)) ].

(self _hiddenSetSize: 16) > 0 ifTrue: [
  symbolDict add: (symAssocCls newWithKey: #'Write-Dependency' 
                                     value: (self _hiddenSetAsArray: 16)) ].

(self _hiddenSetSize: 17) > 0 ifTrue: [
  symbolDict add: (symAssocCls newWithKey: #'Write-ReadLock' 
                                     value: (self _hiddenSetAsArray: 17)) ].
(self _hiddenSetSize: 18) > 0 ifTrue: [
  symbolDict add: (symAssocCls newWithKey: #'Write-WriteLock' 
                                     value: (self _hiddenSetAsArray: 18)) ].

rcObject := self rcValueCacheAt: #'Rc-Write-Write' for: self otherwise: nil.
rcObject ~~ nil
  ifTrue: [
    symbolDict add:
      (symAssocCls newWithKey: #'Rc-Write-Write' value: #[ rcObject ])
  ].

sess := self rcValueCacheAt: #'Synchronized-Commit' for: self otherwise: nil.
sess ~~ nil
  ifTrue: [
    assoc value: #synchronizedCommitFailure.
    symbolDict add:
      (symAssocCls newWithKey: #'Synchronized-Commit' value: #[ sess ])
  ].

^symbolDict
%

category: 'Transaction Control'
classmethod: System
abortTransaction

"Rolls back all modifications made to committed GemStone objects and provides
 the session with a new view of the most recently committed GemStone state.

 These operations are performed whether or not the session was previously in a
 transaction.  If the transaction mode is set to #autoBegin, then a new
 transaction is started.  If the transaction mode is set to #manualBegin, then
 a new transaction is not started."

| coordinator |

^ (coordinator := self _commitCoordinator) == nil
  ifTrue: [ self _localAbort ]
  ifFalse: [ coordinator abort ].
%

category: 'Transaction Control'
classmethod: System
_localAbort

"Rolls back all modifications made to committed GemStone objects and provides
 the session with a new view of the most recently committed GemStone state.

 These operations are performed whether or not the session was previously in a
 transaction.  If the transaction mode is set to #autoBegin, then a new
 transaction is started.  If the transaction mode is set to #manualBegin, then
 a new transaction is not started."

self _pendingCommitAbort .  "Signal error to application if appropriate"

^ self _primitiveAbort "Abort the current transaction"
%

category: 'Transaction Control'
classmethod: System
_localBeginTransaction

"Starts a new transaction for the session."

self _pendingCommitAbort .  "Signal error to application if appropriate"
self _primitiveBegin: false  "Begin a transaction without dpnsunion "
%

category: 'Private'
classmethod: System
_localBeginTransactionStartDpnsu

"Starts a new transaction for the session, and starts tracking dpnsunion"

"Used by full backup code."

self _pendingCommitAbort .  "Signal error to application if appropriate"
self _primitiveBegin: true  "Begin a transaction with dpnsunion "
%

category: 'Transaction Control'
classmethod: System
beginTransaction

"Starts a new transaction for the session.  An abort is done before the new
 transaction is started - giving the session a new snapshot of the repository.

 If any permanent objects had been written by the session, their
 state is aborted.  This method returns the receiver (System)."

| coordinator |
^ (coordinator := self _commitCoordinator) == nil
  ifTrue: [ self _localBeginTransaction ]
  ifFalse: [ coordinator beginTransaction ].
%

! deleted System | _beginTransactionStartDpnsu in 2.2.4

category: 'Transaction Control'
classmethod: System
continueTransaction

"Updates the session's view to the most recently committed GemStone state.

 If the session is in a transaction, this method preserves modifications 
 made to committed GemStone objects.  The read and write sets of the session 
 are carried forward and continue to accumulate until the session either 
 commits or aborts.  

 If the session is not in a transaction, this method performs an abort,
 discarding any accumulated changes to committed objects.

 If in a transaction and a previous attempt to commit the transaction
 failed due to conflicts, then continueTransaction will generate 
 error 2409.  After a failed attempt to commit, you must abort before
 continueTransaction can be used again.

 Returns true if accumulated modifications to the committed objects would not
 cause concurrency conflicts; otherwise returns false.  If the method 
 returns false, you can call the transactionConflicts method to determine
 the nature of the conflicts.

 This method can be used whether or not the session is outside of a transaction.
 Of course, the session cannot commit accumulated changes unless it is
 inside a transaction.

 If transaction mode is #manualBegin, then continueTransaction does not alter
 the inside/outside of transaction state of the session.

 Modifications made by other committed transactions are accumulated for
 retrieval by GciDirtyObjs() and GciDirtySavedObjs() just as they are
 accumulated for commitTransaction or abortTransaction.

 This method has no effect on object locks.  Locks in the release locks sets 
 are not released."

| continueResult |

continueResult := self _zeroArgPrim: 9.

continueResult <= 0 ifTrue: [ 
  continueResult >= -1 ifTrue:[
    ^ true  "read only or success"
  ].
] ifFalse: [
  continueResult == 1 ifTrue: [ 
    self _resolveRcConflicts ifTrue:[ 
      ^true 
    ] ifFalse: [ 
      self _disallowSubsequentCommits.
      ^false "RC validation failed" 
    ]
  ] ifFalse: [
    ^ false "validation failure"
    "3 means validation failure,
    4 means maximum number of commit retries was reached,
    5 means commit disallowed (usually because of indexes),
    -2 means promote to checkpoint failed"
  ]
].
self _uncontinuableError "logic error if we get here"
%

category: 'Private'
classmethod: System
_primitiveBegin: aBoolean

"Starts a new transaction for the session.  If the session is already
 in a transaction, aborts the transaction and starts a new transaction.

 aBoolean specifies whether to start tracking dpNsUnion

 If any permanent objects had been written by the session, their
 state is aborted.  This method returns the receiver (System)."

<primitive: 362>
aBoolean _validateClass: Boolean .
self _primitiveFailed: #primitiveBegin: .
self _uncontinuableError
%

category: 'Transaction Control'
classmethod: System
commitTransaction

"Attempts to update the persistent state of the Repository to include changes
 made by this transaction.

 If the commit operation succeeds, then this method returns true, and the
 current transaction's changes, if any, become a part of the persistent
 Repository.  After the repository update, the session exits the current
 transaction.  If the transaction mode is #autoBegin, then the session enters
 a new transaction.  If the transaction mode is #manualBegin, then the session
 remains outside of a transaction.

 If conflicts prevent the repository update, then this method returns false.
 Call the transactionConflicts method to determine the nature of the
 conflicts.  If the session is outside of a transaction, then this method
 raises the error #rtErrPrimOutsideTrans. 

 This method also updates the session's view of GemStone.  If the commit
 operation succeeds, then all objects in the session's view are consistent with
 the current state of GemStone.  If the commit fails, then this method retains
 all the changes that were made to objects within the current transaction.
 However, commits made by other sessions are visible to the extent that changes
 in this transaction do not conflict with them.

 Returns true if commit was read-only or succeeded ,
 false if there was a failure.  "

^ self _commit: 0 "don't release locks"
%

category: 'Transaction Control'
classmethod: System
disableSignaledAbortError

"Disables the generation of an error when Stone signals the Gem session that it
 should abort when running outside of a transaction."

self _updateSignalErrorStatus: 2 toState: false
%

category: 'Transaction Control'
classmethod: System
enableSignaledAbortError

"Enables the generation of an error when the Stone has signaled that the Gem
 process should abort to connect to a more current GemStone root. 

 This method must be invoked after each delivery of the signal-abort error, to 
 reenable generation of the error. 

 If invoked when in a tranaction, the new state will take effect
 after the next commit or abort which exits the transaction.
 "

self _updateSignalErrorStatus: 2 toState: true
%

category: 'Transaction Control'
classmethod: System
disableSignaledFinishTransactionError

"Disables the generation of the FinishTransactionError ."

self _updateSignalErrorStatus: 4 toState: false
%

category: 'Transaction Control'
classmethod: System
enableSignaledFinishTransactionError

"Enables the generation of an error when the Stone has signaled that a Gem
 process which is in-transaction should abort, commit, or continueTransaction 
 to move to a newer transactional view.

 This method must be invoked after each delivery of the FinishTransactionError to 
 reenable generation of the error."

self _updateSignalErrorStatus: 4 toState: true
%

category: 'Signals'
classmethod: System
signalAlmostOutOfMemoryThreshold: anInteger

"Controls the generation of an error when session's temporary object memory
 is almost full .
 anInteger = -1, disable the generation of the error, resets threshold to 85% .
 anInteger = 0,  enable generation of the error with previous threshold,
		default threshold after session login is 85% .
 0 < anInteger < 100 , enable generation of the error with specified threshold.

 The error is generated at the end of an in-memory markSweep, 
 when the amount of memory used exceeds the specified threshold.  
 If the session is executing a user action, or in index maintenance, 
 the error is deferred and generated when execution returns to the 
 bottom-level Smalltalk or GCI portion of the stack.

 This method or enableAlmostOutOfMemoryError must be invoked after 
 each delivery of the AlmostOutOfMemory error to reenable generation 
 of the error."

self _updateSignalErrorStatus: 5 toState: anInteger
%

category: 'Signals'
classmethod: System
enableAlmostOutOfMemoryError

"Enables or reenables error when session's temporary object memory
 is almost full , with previous threshold .  

 See signalAlmostOutOfMemoryThreshold:  for more details.

 This method or  signalAlmostOutOfMemoryThreshold:  must be
 invoked after each delivery of the 
 AlmostOutOfMemory error to reenable generation of the error.
 "

self _updateSignalErrorStatus: 5 toState: 0
%

category: 'Transaction Control'
classmethod: System
signaledAbortErrorStatus

"Returns true to indicate that the system generates an error when it receives
 the abort signal from Stone.  (In other words, verify that
 enableSignaledAbortError has been called to activate detection of the
 RT_ERR_SIGNAL_ABORT signal.)  Returns false otherwise.

 If in transaction, the result reflects what will happen to abort signals
 after the next commit or abort which exits the transaction.
 "

^self _signalErrorStatus: 2
%

category: 'Transaction Control'
classmethod: System
signaledFinishTransactionErrorStatus

"Returns true to indicate that the system generates an error when it receives
 the finishTranaction signal from Stone.  (In other words, verify that
 enableSignaledFinishTransactionError has been called ).  Returns false otherwise."

^self _signalErrorStatus: 4
%
category: 'Signals'
classmethod: System
almostOutOfMemoryErrorThreshold

"Returns a positive percentage of memory full at which the AlmostOutOfMemory
 error will be raised, or -1  if the error is not enabled. "

^self _signalErrorStatus: 5
%
category: 'Notification'
classmethod: System
signalTranlogsFullStatus

"Returns true to indicate that the the session will get an error when
 stone detects a tranlogs full condition.  Returns false otherwise." 

^self _signalErrorStatus: 6
%
category: 'Notification'
classmethod: System
enableSignalTranlogsFull

"Enables generation of error 2339 to this session when stone detects
 a tranlogs full condition."

self _updateSignalErrorStatus: 6 toState: true
%
category: 'Notification'
classmethod: System
disableSignalTranlogsFull

"Disables generation of error 2339 to this session when stone detects
 a tranlogs full condition."

self _updateSignalErrorStatus: 6 toState: false
%

category: 'Transaction Control'
classmethod: System
inTransaction

"Returns true to indicate that the session is in a transaction, false
 otherwise."

^ self _zeroArgPrim: 5
%

category: 'Transaction Control'
classmethod: System
transactionMode

"Returns the current transaction mode for the current GemStone session, either
 #autoBegin, #manualBegin or #transactionless.  The default is #autoBegin."

^ self _zeroArgPrim: 4
%

category: 'Transaction Control'
classmethod: System
_localTransactionMode: newMode

"Sets a new transaction mode for the current GemStone session and exits the
 previous mode by aborting the current transaction.  Valid arguments are
 #autoBegin, #manualBegin and #transactionless."

self _pendingCommitAbort .
^ self _primTransactionMode: newMode
%

category: 'Transaction Control'
classmethod: System
transactionMode: newMode

"Sets a new transaction mode for the current GemStone session and exits the
 previous mode by aborting the current transaction.  Valid arguments are
 #autoBegin, #manualBegin and #transactionless.
 The mode transactionless is intended primarily for idle sessions. Users
 may scan database objects, but are at risk of obtaining inconsistent views.
"

| coordinator |
^ (coordinator := self _commitCoordinator) == nil
  ifTrue: [ self _localTransactionMode: newMode ]
  ifFalse: [ coordinator transactionMode: newMode ].
%

category: 'Transaction Control'
classmethod: System
_primTransactionMode: newMode

""

<primitive: 368>
self _primitiveFailed: #_primTransactionMode: .
self _uncontinuableError
%

category: 'Reduced Conflict Support'
classmethod: System
_addEntireObjectToRcReadSet: anObject

"Adds anObject to the reduced-conflict read set (RcReadSet).  
 If the object is a large object, all nodes of the object are added.

 See also documentation for _addToRcReadSet:includingAllNodes: "

self _addToRcReadSet: anObject includingAllNodes: true.
%

category: 'Reduced Conflict Support'
classmethod: System
_addRootObjectToRcReadSet: anObject

"Adds anObject to the reduced-conflict read set (RcReadSet).  
 Only the root object is added (even if the object is a large object).

 See also documentation for _addToRcReadSet:includingAllNodes: "

self _addToRcReadSet: anObject includingAllNodes: false.
%

! System (C) >> _addToRcReadSet:includingAllNodes:
category: 'Reduced Conflict Support'
classmethod: System
_addToRcReadSet: anObject includingAllNodes: aBoolean

"Adds anObject to the reduced-conflict read set (RcReadSet).  
 All objects that are part of composite used to represent a reduced 
 conflict object should be added to this set to avoid unnecessary 
 conflict handling.  
 If aBoolean is true, the entire object (including all interior nodes 
 of a large object) are added.  If aBoolean is false, only the root object 
 is added.
 
 The RcReadSet is used as follows during a commit attempt .
   readWriteConflicts =   (strongReadSet * writeSetUnion) - RcReadSet .
   writeWriteConflicts = (writeSet * writeSetUnion) .
 If there are readWriteConflicts, the commit always fails.
 If writeWriteConflicts is not empty, 
 but (writeWriteConflicts - RcReadSet ) is empty , 
 then RC replay is executed and the commit is reattempted once .
 "

<primitive: 116>
aBoolean _validateClass: Boolean.
self _primitiveFailed: #_addToRcReadSet:includingAllNodes: .
self _uncontinuableError
%

category: 'Transaction Control'
classmethod: System
_pendingCommitAbort

""

| commitAction |
commitAction := self _sessionStateAt: 7 .
commitAction ~~ nil ifTrue:[
  commitAction _isSmallInteger
    ifTrue:[
      "Signal commit-abort pending error"
      self signal: commitAction "ErrorSymbols at:#rtErrCommitAbortPending"
           args: #[]
           signalDictionary: GemStoneError.
      "expect the application to continue with GciContinue"
    ]
    ifFalse: [ self userAction: commitAction ]
].
%

category: 'Private'
classmethod: System
_processDeferredGciUpdates

"Process deferred GemBuilder for C updates and return the number of objects that
 had deferred updates."

"The deferred updates are stored in _sessionStateAt: 12.  These
 are updates to objects that do not allow direct structural update such
 as AbstractDictionary, Bag, and Set ."

<primitive: 901>  "enter protected mode to disable adding to dirtys set..."
| arr count |

arr := self _sessionStateAt: 13 "virtual machine constant".
(count := arr size) > 0 ifTrue:[
  1 to: count by: 2 do:[ :j |
    (arr at: j) _deferredGciUpdateWith: (arr at: j + 1).
    ].
  arr size: 0 .
  "reinitialize the identity dictionary"
  (self _sessionStateAt: 12 "virtual machine constant") 
      initialize: 751"a prime number for a large small object"
  ].
self _disableProtectedMode.
^ count // 2 
%

category: 'Reduced Conflict Support'
classmethod: System
_commit: commitMode

"commitMode is a SmallInteger:

 0 for normal,
 1 for release locks,
 2 for checkpoint and release locks.

 Returns true if commit was read-only or succeeded ,
 false if there was a failure.  See also _localCommit: .  "

| coordinator |

^ (coordinator := self _commitCoordinator) == nil
  ifTrue: [ self _localCommit: commitMode ]
  ifFalse: [ coordinator commit: commitMode ].
%

category: 'Reduced Conflict Support'
classmethod: System
_localCommit: commitMode

"commitMode is a SmallInteger:

 0 for normal,
 1 for release locks,
 2 for checkpoint and release locks,
 3 for normal commit called from GciCommit .

 Returns true if commit was read-only or succeeded , 
 false if there was a failure.   

 For commitMode == 2 (request for checkpoint) will return true
 if the commit succeeded, regardless of whether promotion to
 checkpoint succeeded."

| commitResult actualMode |

self _processDeferredGciUpdates .

commitMode == 3 ifTrue:[
  "called from GciCommit, no pending commit action."
  actualMode := 0
  ]
ifFalse:[
  self _pendingCommitAbort .
  actualMode := commitMode
] .

commitResult := self __commit: actualMode.

commitResult <= 0 ifTrue: [ 
  ^ true 
] ifFalse: [
  commitResult == 1 ifTrue: [ 
    "Execute RC replay and then retry the commit."
    ^ self _resolveRcConflictsForCommit: actualMode 
  ].
].
^ false
%

category: 'Reduced Conflict Support'
classmethod: System
__commit: commitMode

"This method is provided to facilitate reimplementation of commit
 in Gem Builder.

 See  _primitiveCommit:   for the return values."

^ self _primitiveCommit: commitMode.
%

category: 'Reduced Conflict Support'
classmethod: System
clearRcValueCache

"Clears the cache of calculated values for reduced conflict classes by setting
 the temporary session state slot to nil."

self _sessionStateAt: 5 put: nil
%

category: 'Reduced Conflict Support'
classmethod: System
clearRedoLog

"Clear the redo log by setting the temporary session state slot to nil.

                            Warning:
 Clearing the redo log will probably prevent Reduced Conflict
 classes from resolving conflicts.  Sending this message negates this
 capability for the current transaction.

 This is a protected method."

< protected >

self _sessionStateAt: 4 put: nil
%

category: 'Reduced Conflict Support'
classmethod: System
rcValueCache

"Returns the cache dictionary that is stored in temporary session state
 used to hold calculated values for reduced conflict classes.  If it does
 not exist, create it."

| dict |
dict := self _sessionStateAt: 5.
dict == nil
    ifTrue: [
        dict := IdentityKeyValueDictionary new: 47.
        self _sessionStateAt: 5 put: dict
    ].
^ dict
%

category: 'Reduced Conflict Support'
classmethod: System
_rcValueCache

"Returns the cache dictionary that is stored in temporary session state
 used to hold calculated values for reduced conflict classes. "

^ self _sessionStateAt: 5
%

category: 'Reduced Conflict Support'
classmethod: System
rcValueCacheAt: aKey for: anObject ifAbsent: aBlock

"Returns the associated value at the given key for anObject.
 If the key is not present, execute the zero-argument block."

| valueArray cache |
cache := self _rcValueCache.
" if the cache does not exist, then the key is not present "
cache == nil
  ifTrue: [ ^ aBlock value ].

valueArray := cache at: anObject ifAbsent: [ ^ aBlock value ].

1 to: valueArray size by: 2 do: [ :i |
    aKey == (valueArray at: i)
        ifTrue: [ ^ valueArray at: (i + 1) ]
].

^ aBlock value
%

category: 'Reduced Conflict Support'
classmethod: System
rcValueCacheAt: aKey for: anObject otherwise: aValue

"Returns the associated value at the given key for anObject.
 If the key is not present, returns aValue."

| valueArray cache |
cache := self _rcValueCache.
" if the cache does not exist, then the key is not present "
cache == nil
  ifTrue: [ ^ aValue ].

valueArray := cache at: anObject otherwise: nil.

valueArray == nil
    ifTrue: [ ^ aValue ].

1 to: valueArray size by: 2 do: [ :i |
    aKey == (valueArray at: i)
        ifTrue: [ ^ valueArray at: (i + 1) ]
].

^ aValue
%

category: 'Reduced Conflict Support'
classmethod: System
rcValueCacheAt: aKey otherwise: aValue

"Returns the associated value at the given key for anObject.
 If the key is not present, returns aValue."

| cache |
cache := self _rcValueCache.
" if the cache does not exist, then the key is not present "
cache == nil
  ifTrue: [ ^ aValue ].

^ cache at: aKey otherwise: aValue.
%

category: 'Reduced Conflict Support'
classmethod: System
rcValueCacheAt: aKey put: aValue for: anObject

"Adds the given key/value pair for anObject.  Returns the receiver."

| valueArray |
valueArray := self rcValueCache at: anObject otherwise: nil.
valueArray == nil
  ifTrue: [
    valueArray := Array new.
    self rcValueCache at: anObject put: valueArray.
  ].

1 to: valueArray size by: 2 do: [ :i |
    aKey == (valueArray at: i)
        ifTrue: [
            valueArray at: (i + 1) put: aValue.
            ^ self
        ]
].

"add a new entry"
valueArray addLast: aKey; addLast: aValue
%

category: 'Reduced Conflict Support'
classmethod: System
_redoLog

"Returns the redo log that is stored in the temporary session state."

^ self _sessionStateAt: 4
%

category: 'Reduced Conflict Support'
classmethod: System
redoLog

"Returns the redo log that is stored in the temporary session state.
 Create it if it does not exist."

| redoLog |
redoLog := self _sessionStateAt: 4.
redoLog == nil
    ifTrue: [
        redoLog := RedoLog new.
        self _sessionStateAt: 4 put: redoLog
    ].
^ redoLog
%

category: 'Reduced Conflict Support'
classmethod: System
_resolveRcConflictsForCommit: commitMode

""

| lockResult result |

self _processDeferredGciUpdates .

lockResult :=self _acquireRcLock.
(lockResult == 1 _or: [ lockResult == 2074 ]) ifFalse: [
	self error: 'RC Lock not granted: ', lockResult printString.
	^ false
].

"GsFile gciLogServer:'---- RedoLog: ' , System _redoLog printString ."
self _resolveRcConflicts ifFalse: [ 
  self _disallowSubsequentCommits.
  System _releaseRcLock.
  ^ false 
].

result := self __commit: commitMode.

result == 4 ifTrue: [ 
  System _releaseRcLock.
  ^ false
] ifFalse: [ 
  result < 0 ifTrue:[ 
    System _releaseRcLock.
    "readonly commit, means that no pyhsical changes required by rc replay"
    ^true
  ] ifFalse:[ 
    result == 1 "rcFailure"
      ifTrue: [ 
        "Will recurse to WORK_COMMIT_RETRY_LIMIT (currently 15 total trys)
         Keep rcLock until we succeed or fail."
        ^self _resolveRcConflictsForCommit: commitMode 
    ].
    System _releaseRcLock.
    ^ (result == 0) 
  ]
]
%

category: 'Reduced Conflict Support'
classmethod: System class
_acquireRcLock

| rcLock |
rcLock := System _rcLockObject.
rcLock ~~ nil
  ifTrue: [ ^System waitForRcWriteLock: rcLock ].
^1 "granted"
%

category: 'Reduced Conflict Support'
classmethod: System
_releaseRcLock

| rcLock |
rcLock := System _rcLockObject.
rcLock ~~ nil
  ifTrue: [
    System removeLock:  rcLock.
  ].
%

category: 'Reduced Conflict Support'
classmethod: System
_disallowSubsequentCommits

"Disallows subsequent attempts to commit due to RC retry failure."

^ self _zeroArgPrim: 22
%

category: 'Modifying Classes'
classmethod: System
_disallowCommitClassModFailure

"Disallows subsequent attempts due to failure during class modification."
^ self _zeroArgPrim: 37
%

category: 'Removing Locks'
classmethod: System
removeLock: anObject

"Removes the lock held by the current session on anObject.
 Returns the receiver."

self removeLockAll: #[ anObject ].
^self
%

category: 'Private'
classmethod: System
_numPagesInSharedOt

"Returns the number of pages in the shared object table.
 This method aborts the current transaction."

^self _zeroArgPrim: 55
%

category: 'Private'
classmethod: System
flushAllExtents

"Calls the UNIX function fsync() for all extents.  fsync() forces
 all data written to the file system buffer cache to be flushed 
 to the underlying disk device.  Refer to the UNIX documentation on
 fsync() for further information.

 This method has no effect for extents which use raw partitions
 since raw partitions do not use buffer caches.  

 Requires the SystemControl privilege.  This method returns true."

^self _zeroArgPrim: 56
%

category: 'Private'
classmethod: System
_cpuClockTicksPerSecond

"Calls the UNIX function sysconf(_SC_CLK_TCK) to determine the number
 of clock ticks in a second.  Returns zero if the call is not supported."

^self _zeroArgPrim: 57
%


category: 'Removing Locks'
classmethod: System
removeLocksForSession

"Removes all locks held by this session.  Returns the receiver.
 This method succeeds even if the session no longer has
 read authorization for one or more of its locked objects."

^ self _zeroArgPrim: 0
%

category: 'Private'
classmethod: System
_zeroArgPrim: opcode

"Private."

"opcode 0 = removeLocksForSession
        1 = stackLimit
        2 = pageReads
        3 = pageWrites 
        4 = transactionMode   (also sent by GsCurrentSession)
        5 = inTransaction   (also sent by GsCurrentSession)
        6 = maxSessionId
        7 = myCacheProcessSlot
        8 = shutDown
        9 = continueTransaction
       10 = _readClock   (get CPU time used)
       11 = stoneName
       12 = _timeMs  
       13 = _timeGmtFloat
       14 = _generationScavenge
       15 = NOT USED,  was  _enableTraceObjs
       16 = NOT USED,  was _disableTraceObjs
       17 = voteState  (gets GC voteState from stone)
       18 = startAllGcSessions
       19 = voteStateString
       20 = clientIsRemote
       21 = sessionsReferencingOldestCr
       22 = _disallowSubsequentCommits  (Rc failure)
       23 = _approxOopHighWaterMark
       24 = _sharedAttached
       25 = _hostCallDebugger
       26 = stackDepth
       27 = stackDepthHighwater
       28 = writtenObjects
       29 = _vmMarkSweep   was _flushConnectedToPom
       30 = _commitResult
       31 = _deadNotReclaimed
       32 = _validateTransaction
       33 = session
       34 = _writeLockWriteSubset
       35 = _removeLockWriteSubset
       36 = _approxOopNumberHighWaterMark
       37 = _disallowCommitClassModFailure
       38 = clearEpochGcState
       39 = _clearDeadObjects
       40 = stopAllGcSessions
       41 = forceEpochGc
       42 = stopAdminGcSession
       43 = stopAllReclaimGcSessions
       44 = stopSymbolCreationSession,   was _abortTransactionAndKeepAttached
       45 = startSymbolCreationSession, was _beginTransactionAndKeepAttached
       46 = symbolCreationSessionId,    was _doRecordDead
       47 = _lastGsErrorNumber
       48 = currentUserSessionCount
       49 = currentSessionCount
       50 = Repository pageSize
       51 = NOT USED, was weakDictionaryEnableDebugging
       52 = NOT USED, was weakDictionaryDumpContent
       53 = getHighAllocatedOopNum
       54 = _numPersistentObjsModified
       55 = _numPagesInSharedOt 
       56 = flushAllExtents
       57 = _cpuClockTicksPerSecond
       58 = _dumpFrameData
       59 = myPageServerProcessId
       60 = resumeCheckpoints
       61 = checkpointStatus
       62 = startCheckpointSync
       63 = startCheckpointAsync
       64 = adminGcGemSessionId
       65 = reclaimGcSessionCount
       66 = currentGcReclaimSessionsByExtent
       67 = startAdminGcSesssion
       68 = startAllReclaimGcSessions
       69 = _deadNotReclaimedCount
       70 = _scavengablePagesCount
       71 = _possibleDeadSize
       72 = _commitRecordBacklog
       73 = _totalSessionsCount
       74 = _remoteSharedCacheCount
       75 = _enableTraceNewPomObjs
       76 = _disableTraceNewPomObjs
       77 = _tempObjSpaceUsed
       78 = _tempObjSpaceMax
       79 = _tempObjSpacePercentUsed
       80 = prvLogPrint
       81 = shrLogPrint
       82 = hstLogStatus
       83 = shrLogLockHold (no method)
       84 = _protectedMode
       85 = currentSessions
       86 = _tempObjSpacePercentUsedLastMark
       87 = _comPrintOpcodesEmitted
       88 = _comPrintOpcodesNotEmitted
       89 = _printCHeap
       90 = _locale
       91 = _maxClusterId
       92 = _comClearOpcodesEmitted
       93 = _oopHighWaterMark
       94 = _oopNumberHighWaterMark
       95 = timeNs
       96 = _updateObjectsRead
       97 = _disableTraceObjectsRead
       98 = _resumeTraceObjectsRead
       99 = _enableTraceObjectsRead
      100 = _numSharedCounters
      101 = _startGcCacheWarmer
      102 = _setPrintStackAtError 
      103 = _timeUs
      104 = logout
      105 = inContinueTransaction
      106 = gemIsBigEndian
      107 = stoneIsBigEndian
      108 = latestCommitRecordPageId
"

<primitive: 98>

self _primitiveFailed: #_zeroArgPrim: .
self _uncontinuableError
%

category: 'Version Management'
classmethod: System
gemVersionAt: aString

"Returns information about the Gem process of the current session. 
 aString must be equal to a key in VersionParameterDict, otherwise nil
 is returned.  The semantics of these keys are:

 aString              meaning
 -------              -------
 cpuKind             detailed CPU type obtained at runtime: 'sun4m', '486'.
 cpuArchitecture     target CPU for which GemStone was compiled:
                      'SPARC', 'X86'.
 gsBuildArchitecture operating system name and CPU for which GemStone 
                      was compiled: 'SunOS SPARC', 'NT Intel'.
 gsBuildDate         time at which the Gem executable was compiled (a String).
 gsRelease           major and minor version of GemStone, such as '5.0.0'.
 gsVersion           major version of GemStone, such as '5.0'.
 imageKind           a Symbol: #server.
 nodeName            network node name: 'speedy'.
 osName              operating system name: 'SunOS', 'NT'.
 osRelease           release number of the operating system: '4.1.3', '3.5'.
 osVersion           vendor defined major version of the OS: '3'.
 processId           operating system process identifier (an Integer): 13529.
 processorCount      number of processors on the machine running the process."

| verId |
aString = 'imageKind' ifTrue:[ ^ self imageVersionAt: aString ] .
verId := VersionParameterDict at: aString ifAbsent:[ ^ nil ].

^ self _configurationAt: verId isStone: false kind: $V 
%

category: 'Private'
classmethod: System
_dumpFrameData

"Private.  Prints out shared page cache frame data to the session log file."

^ self _zeroArgPrim: 58
%

category: 'Version Management'
classmethod: System
stoneVersionAt: aString

"Returns version information about the Stone (repository monitor) process.

 See System (C) | gemVersionAt: for further details.
 aSymbol = 'imageKind' returns nil for the Stone."

| verId |

aString = 'imageKind' ifTrue:[ ^ nil "image not applicable to Stone"].

verId := VersionParameterDict at: aString ifAbsent:[ ^ nil ].
  
^ self _configurationAt: verId isStone: true kind: $V 
%

category: 'Version Management'
classmethod: System
clientVersionAt: aString

"Returns version information about the client GemBuilder for C process.  If the
 client is a session using the linkable GemBuilder for C login, this method is
 equivalent to gemVersionAt:.

 See System(C) | gemVersionAt: for further details."

| verId |
verId := VersionParameterDict at: aString ifAbsent:[ ^ nil ].
^ GsFile _clientVersionAt: verId 
%

category: 'Version Management'
classmethod: System
imageVersionAt: aSymbol

"Returns information about the GemStone kernel class image where aSymbol is one
 of the following:

 #gsBuildDate  DateTime of last kernel class filein or upgrade.
 #gsRelease    Version String of last kernel class filein or upgrade: '5.0.0'.
 #gsVersion    Major version of image, such as '5.0' .
 #imageKind    A Symbol: #server.

 If aSymbol is not one of the above, returns nil."

^ ImageVersion at: aSymbol otherwise: nil
%

category: 'Version Management'
classmethod: System
_serverVersionReport: isStone

"Private, returns a StringKeyValueDictionary."

| result |
result := StringKeyValueDictionary new .
VersionParameterDict keysAndValuesDo:[ :aName :anId | | aVal |
  aVal := self _configurationAt: anId isStone: isStone kind: $V .
  aVal ~~ nil ifTrue:[ 
    result at: aName put: aVal
    ].
  ].
^ result 
%

category: 'Version Management'
classmethod: System
gemVersionReport

"Return a SymbolDictionary whose keys are the names of operating system,
 hardware, or GemStone version attributes, and whose values are the
 current values of those attributes in the Gem process."

^ self _serverVersionReport: false
%

category: 'Version Management'
classmethod: System
stoneVersionReport

"Return a StringKeyValueDictionary whose keys are the names of operating system,
 hardware, or GemStone version attributes, and whose values are the
 current values of those attributes in the Gem process."

^ self _serverVersionReport: true
%

category: 'Version Management'
classmethod: System
clientVersionReport

"Return a StringKeyValueDictionary whose keys are the names of operating system,
 hardware, or GemStone version attributes, and whose values are the
 current values of those attributes in the client GemBuilder for C process."

| result |
result := StringKeyValueDictionary new .
VersionParameterDict keysAndValuesDo:[ :aName :anId | | aVal |
  aVal := GsFile _clientVersionAt: anId . 
  aVal ~~ nil ifTrue:[ 
    result at: aName put: aVal
    ].
  ].
^ result 
%

category: 'Private'
classmethod: System
_versionParameterDict

"Returns a Dictionary of names for version information parameters.  The
 dictionary keys are Strings.  Its values are SmallInteger parameter IDs."

"gemstone64 changed  result keys from Symbols to Strings, to reduce creation
  of new Symbols at runtime. "

| result cfgId cfgName |
result := StringKeyValueDictionary new .
cfgId := 0 .
[
  cfgName := self _configParameterName: cfgId kind: $V .
  cfgName == nil ifFalse:[
    result at: cfgName put: cfgId .
    cfgId := cfgId + 1 .
    ] .
  cfgName == nil 
  ] untilTrue .

^ result
%

category: 'Private GC'
classmethod: System
_generationScavenge_vmMarkSweep

"Execute an in-memory scavenge and an in-memory markSweep. 
 Should only be used when debugging internal problems. Frequent use
 can degrade performance."

self _generationScavenge ifTrue:[
  self _vmMarkSweep
  ].
%
 

category: 'Private GC'
classmethod: System
_generationScavenge

"Returns true if the scavenge succeeded, false if it got promoted
 to a markSweep 

 Explicitly triggers in-memory scavenge collection of temporary objects.
 Should only be used when debugging internal problems. Frequent use
 can degrade performance."

^ self _zeroArgPrim: 14 
%

category: 'Private GC'
classmethod: System
_vmMarkSweep

"Explicitly triggers in-memory markSweep collection of temporary objects.
 Should only be used when debugging internal problems. Frequent use
 can degrade performance."

^ self _zeroArgPrim: 29 
%

category: 'Private GC'
classmethod: System
_vmInstanceCounts: anInt

<primitive: 652> 
anInt _validateClass: SmallInteger.
(anInt < 0 _or:[ anInt > 5 ])
  ifTrue:[ anInt _error: #rtErrArgOutOfRange ].

%
category: 'Private GC'
classmethod: System
_vmPrintInstanceCounts: anInt

"Print to VM's stdout or  topaz -l  output file 
 a report about how many instances of each in-memory class 
 are present in the specified portion of temporary object memory. 

   anInt = 0   all of object memory
           1   new generation (young temporary objects)
           2   pom generation (copies of committed objects)
           3   old generation (old temporary objects)
           4   perm generation (loaded classes)
           5   code generation (loaded methods)

   If printing all of object memory , also prints those classes
   which have zero instances in memory , otherwise classes with
   zero instances are not printed.  The printout contains one
   line per class, with className, number of instances, and total
   bytes occupied by the instances.
"
<primitive: 153> 
anInt _validateClass: SmallInteger.
(anInt < 0 _or:[ anInt > 5 ])
  ifTrue:[ anInt _error: #rtErrArgOutOfRange ].

%

! deleted  _reclaimAll
! deleted _reclaimAllParallel
category: 'Private'
classmethod: System
_simpleCommitForReclaim: includeDeadBool

  "Calls stone to request a simple commit be performed.
   if includeDeadBool==true, returns true if both the
   number of dead objects and number of shadow pages needing reclaiming
   are zero .
   if includeDeadBool==false, returns true if 
   the number of shadow pages needing reclaiming is zero .

   Has no effect on this session's transactional view."

<primitive: 290> 

self _primitiveFailed: #_simpleCommitForReclaim: .
self _uncontinuableError
%

category: 'Private'
classmethod: System
_clearDeadObjects

^ self _zeroArgPrim: 39 
%

category: 'Private'
classmethod: System
_zeroArgCateg2Prim: opcode

"Private."

"opcode 0 = activeRepositories
        1 = NOT used, was gemStatistics
        2 = NOT used, was stoneStatistics
        3 = gemVersion
        4 = logStoneStatistics
        5 = clearStoneStatistics
        6 = clusterAllSymbols
        7 = userActionReport - returns an Array of SymbolAssociations
        8 = configConstantsArray - returns an Array of Assocations
        9 = systemUserActionReport
       10 = _committedDataPages
       11 = _uncommittedDataPages"

<primitive: 325> 

self _primitiveFailed: #_zeroArgCateg2Prim: .
self _uncontinuableError
%

category: 'Removing Locks'
classmethod: System
removeLockAll: aCollection

"Removes all locks held by the current session on the objects in aCollection.
 If an object in aCollection is not locked by the current session, that
 object is ignored. Returns the receiver."

<primitive: 99>
| anArray |
anArray := aCollection asArray.
anArray == aCollection ifFalse:[
  ^ self removeLockAll: anArray .
  ] .
aCollection _validateClass: Collection.
self _primitiveFailed: #removeLockAll: .
self _uncontinuableError
%

category: 'Session Control'
classmethod: System
clientIsRemote

"Returns true if the GemBuilder for C client for this session is in a different
 process than the Gem, otherwise returns false."

^ self _zeroArgPrim: 20
%

category: 'Session Control'
classmethod: System
currentSegment

"Returns the Segment in which objects created in the current session are
 stored.    The result can be nil, in which case objects are
 being created with World write  permission.

 At login, the current segment is the default segment of the
 UserProfile for the session of the sender."

<primitive: 341>
self _primitiveFailed: #currentSegment .
self _uncontinuableError
%

category: 'Session Control'
classmethod: System
currentSegment: aSegment

"Redefines the Segment in which subsequent objects created in the
 current session will be stored.  Returns the receiver.

 If the argument is nil , subsequent objects are created
 with World write permission.

 The argument must be a committed Segment and you must have
 writeAuthorization to that segment, otherwise an error is generated.
"

<primitive: 339>
aSegment _validateClass: Segment.
self _primitiveFailed: #currentSegment: .
self _uncontinuableError
%

category: 'Private'
classmethod: System
_sessionProfilesStartingAt: startSessionId 

"Returns an Array containing pairs of sessionId, UserProfile , 
 for some sessions currently logged in, beginning at the specified sessionId. 
 Some sessionIds may have a userProfile of nil
 if that UserProfile is not visible in the transactional view of 
 the current session.
 The size of the Array is limited by number of sessions logged in
 and/or gem to stone communication buffer sizes.  If there are
 no more valid sessionIds beginning with startSessionId, an
 Array of size 0 is returned. 

 This method requires SessionAccess privilege if there is more
 than one session logged in."

<primitive: 329>
startSessionId _validateClass: SmallInteger .
startSessionId _error: #rtErrArgOutOfRange .
^ self _primitiveFailed: #_sessionProfilesFrom:to:
%

! fixed 34878
category: 'Private'
classmethod: System
_currentSessionProfiles

"Returns an Array containing pairs of sessionId, UserProfile
 for all sessions currently logged in.
 Some sessionIds may have a userProfile of nil

 This method requires SessionAccess privilege if there is more
 than one session logged in."

| sessId result batch |
sessId := 1 .
result := Array new .
[ sessId > 0 ] whileTrue:[
  batch := self _sessionProfilesStartingAt: sessId .
  batch size > 0 ifTrue:[
    result addAll: batch .
    sessId := (batch at: (batch size - 1)) + 1 .
  ] ifFalse:[
    sessId := -1 . "done"
  ].
].
^ result
%

category: 'Session Control'
classmethod: System
currentSessionNames

"Returns a formatted String containing, for each current GemStone session, the
 session number and userId.

 This method requires SessionAccess privilege if there is more
 than one session logged in."

| lf result profiles |

result := String new.  
profiles := self _currentSessionProfiles.  "sessId, userProfile pairs"
lf := Character lf.

1 to: profiles size by: 2 do:[:j| | aSessionNumber aUserProfile |
   aSessionNumber := profiles at: j .
   aUserProfile := profiles at: j + 1 .
   aUserProfile ~~ nil ifTrue: [
     result add: lf;
        addAll: 'session number: ';
        addAll: (aSessionNumber asString);
        addAll: '    UserId: ';
        addAll: (aUserProfile userId).
   ].
].
^ result
%
category: 'Session Control'
classmethod: System
otherSessionNames

"Returns a formatted String containing, for each current GemStone session
  other than the session executing this method, the
 session number and userId.

 This method requires SessionAccess privilege."

| lf result mySessNum profiles |

result := String new.  " string to return "
lf := Character lf.
mySessNum := self session .

profiles := self _currentSessionProfiles.  "sessId, userProfile pairs"
1 to: profiles size by: 2 do:[:j| | aSessionNumber aUserProfile |
   aSessionNumber := profiles at: j .
   aSessionNumber == mySessNum ifFalse:[
     aUserProfile := profiles at: j+ 1 .
     aUserProfile ~~ nil ifTrue: [
       result add: lf;
	  addAll: 'session number: ';
	  addAll: (aSessionNumber asString);
	  addAll: '    UserId: ';
	  addAll: (aUserProfile userId).
     ].
   ].
].
^result 
%

category: 'Session Control'
classmethod: System
currentSessions

"Returns an Array of SmallIntegers corresponding to all of the sessions
 currently running on the GemStone system."

^self _zeroArgPrim: 85
%

category: 'Session Control'
classmethod: System
currentUserSessionCount

"Return a SmallInteger which is the number of user sessions present in the system.
 Garbage collection sessions, the Symbol Gem, and the Page Manager Gem are not 
 included in the count."

^self _zeroArgPrim: 48
%

category: 'Session Control'
classmethod: System
currentSessionCount

"Return a SmallInteger which is the number of sessions present in the system,
 including the Symbol Gem, garbage collection sessions, but not the page manager
 session."

^self _zeroArgPrim: 49
%


category: 'Session Control'
classmethod: System
myUserProfile

"Returns the UserProfile of the current session."

"Implemented as a primitive to handle image bootstrap problems."

<primitive: 318>
^ self _primitiveFailed: #myUserProfile
%

category: 'Session Control'
classmethod: System
session

"Returns a SmallInteger representing the session of the sender."

^self _zeroArgPrim: 33
%

category: 'Session Control'
classmethod: System
stopUserSessions

"Prevents any new sessions from being initiated; then, for each
 active user session other than the session of the user executing this
 method, aborts the transaction and terminates that session.

 This method does not stop Gc Gem sessions nor does it stop 
 the Symbol Creation Gem .

 To reenable logins, send the message System resumeLogins.  Otherwise,
 logins are automatically reenabled when this session logs out.

 To execute this method, you must have explicit privilege for
 SessionAccess and SystemControl in your UserProfile."


"Performs a System | suspendLogins, then
 performs a System | stopSession."

| anArrayOfSessions mySession myPrivs |

myPrivs := self myUserProfile privileges.
((myPrivs includesValue: #SystemControl) _and:
   [myPrivs includesValue: #SessionAccess])
   ifFalse: [ self _error: #rtErrNoPriv .  ^ self "do nothing" ].
self suspendLogins.  " Prevent anyone from logging in "

anArrayOfSessions := self currentSessions.  " All Session running "
mySession := self session.  " My Session number "

anArrayOfSessions do: " Loop all session and log then off if not me "
   [:aSessionNumber | (aSessionNumber == mySession )
                         ifFalse:[self stopSession: aSessionNumber].
   ].
%

category: 'Session Control'
classmethod: System
stopSession: aSessionId

"Aborts the transaction of the specified session (a SmallInteger), then
 terminates that session.  Returns the receiver.  If the indicated
 session is not active, no operation is performed.

 Implemented by sending a stopSession out-of-band byte to the session's
 gem process.   If the session is not responsive to this request,
 it will eventually be killed per STN_GEM_TIMEOUT in stone's config file.
 
 Does not stop Garbage Collector or Symbol Creation Gem sessions.

 To execute this method, you must have explicit privilege from your
 system data curator."

| serialNum |

aSessionId _validateClass: SmallInteger.
serialNum := GsSession serialOfSession: aSessionId .
self _stopSession: serialNum kind: 16r0 timeout: -1
%

category: 'Session Control'
classmethod: System
stopGcSession: aSessionId

"Aborts the transaction of the specified session (a SmallInteger), then
 terminates that session.  Returns the receiver.  If the indicated
 session is not active, no operation is performed.
 
 Will stop Garbage Collector sessions but will not stop the
 Symbol Creation Gem session .

 To execute this method, you must have explicit privilege from your
 system data curator."

| serialNum |

aSessionId _validateClass: SmallInteger.
serialNum := GsSession serialOfSession: aSessionId .
self _stopSession: serialNum kind: 16r1 timeout: -1
%

category: 'Session Control'
classmethod: System
stopSymbolCreationSession: aSessionId

"Aborts the transaction of the specified session (a SmallInteger), then
 terminates that session.  Returns the receiver.  If the indicated
 session is not active, no operation is performed.
 
 Will stop any session including garbage Collector and 
 Symbol Creation Gem sessions. 

 Only SystemUser may execute this method, otherwise an error is generated."

| serialNum |

aSessionId _validateClass: SmallInteger.
serialNum := GsSession serialOfSession: aSessionId .
self _stopSession: serialNum kind: 16r3  timeout: -1
%

category: 'Session Control'
classmethod: System
terminateSymbolCreationSession: aSessionId timeout: aSeconds

"Will stop normal sessions, Garbage Collector Gem sessions,
 and  Symbol Creation Gem .

 Only SystemUser may use this method.
 Does not prevent auto-restart of Symbol Creation Gem sessions
 stopped by this method.

 Otherwise same as terminateSession:timeout:"

| serialNum |
aSessionId _validateClass: SmallInteger.
serialNum := GsSession serialOfSession: aSessionId .
self _stopSession: serialNum kind: 16r13 timeout: aSeconds.
%

! edits to fix 36706
category: 'Session Control'
classmethod: System
terminateSession: aSessionId timeout: aSeconds

"Supports faster termination of the specified session than is
 possible with   stopSession:   .

 Sends a stopSession out-of-band byte to the specified session's gem
 process.
 The argument aSeconds is a SmallInteger. aSeconds >= 0 specifies number of
 seconds to wait after sending the stopSession out-of-band byte 
 before killing specified session's gem process by sending
 it a SIGTERM.  aSeconds < 0 means move the session to after_logout state
 immediately, but don't kill .  

 If the stone config file specifies non-default STN_GEM_TIMEOUT , 
 the actual timeout will be limited by    aSeconds min: STN_GEM_TIMEOUT*60  ,  
 otherwise timeout is limited in stone by     aSeconds min: 300 .

 If the current session is not logged in as SystemUser,
 this method requires the SystemControl privilege .

 Will stop normal sessions and Garbage Collector Gem sessions.
 Does not prevent auto-restart of Garbage Collector Gem sessions
 that are stopped by this method.

 Will not stop the Symbol Creation Gem."

| serialNum |
aSessionId _validateClass: SmallInteger.
serialNum := GsSession serialOfSession: aSessionId .
self _stopSession: serialNum kind: 16r11 timeout: aSeconds.
%

category: 'Session Control'
classmethod: System
_stopSession: aSerialNumber  kind: aKind timeout: aSeconds

"Aborts the transaction of the specified session (a SmallInteger), then
 terminates that session.  Returns the receiver.  If the indicated session is
 not active, no operation is performed.

 aKind has the following bits
   16r1  include GcGem sessions
   16r2  include SymbolCreation session

   16r10  timeout aSeconds per terminateSession:timeout: ,
	  and do not inhibit   restart of gc gems or symbol gem

 To execute this method, you must have explicit privilege from your system
 data curator."

<primitive: 332>  
aSerialNumber _validateClass: SmallInteger.
aSeconds _validateClass: SmallInteger.
aKind _validateClass: SmallInteger.
aKind _error: #rtErrArgOutOfRange .
^ self _primitiveFailed: #_stopSession:kind:timeout:
%

category: 'Session Control'
classmethod: System
userProfileForSession: aSessionId

"Returns the UserProfile attached to the specified session (a SmallInteger).
 If the indicated session is not active, returns nil.

 Requires SessionAccess privilege if aSessionId is not the current session."

^ ( self descriptionOfSession: aSessionId) at: 1
%

category: 'Session Control'
classmethod: System
users

"Returns a Set of UserProfiles for all users known to the system."

^ AllUsers
%

category: 'Session Control'
classmethod: System
maxSessionId

"Returns a SmallInteger representing the maximum number of sessions
 allowed on the system based upon the Stone configuration parameter."

^ self _zeroArgPrim: 6
%

category: 'Session Control'
classmethod: System
__sleepMs: milliSecondsToSleep

"Sleep for the number of milliseconds specified by milliSecondsToSleep.
 The argument milliSecondsToSleep must be a positive SmallInteger.
 If milliSecondsToSleep is zero, this method has no effect.
 Returns time left to sleep , which will be > 0 if interrupted."

<primitive: 344>
milliSecondsToSleep _validateClass: SmallInteger.
milliSecondsToSleep < 0 
   ifTrue: [ milliSecondsToSleep _error: #rtErrArgOutOfRange ] .
^ self _primitiveFailed: #_sleepMs:
%

! Gs64 v2.1 ,  _sleepMs: is interruptable by soft-break and sigAbort 
category: 'Session Control'
classmethod: System
_sleepMs: milliSecondsToSleep

"Sleep for the number of milliseconds specified by milliSecondsToSleep.
 The argument milliSecondsToSleep must be a positive SmallInteger.
 If milliSecondsToSleep is zero, this method has no effect.
 Returns the receiver."

| timeLeft |
milliSecondsToSleep _isSmallInteger ifFalse:[ 
  milliSecondsToSleep _validateClass: SmallInteger 
].
milliSecondsToSleep < 0 ifTrue: [ milliSecondsToSleep _error: #rtErrArgOutOfRange ] .
timeLeft := milliSecondsToSleep .
[ timeLeft > 0 ] whileTrue:[
  timeLeft := self __sleepMs: timeLeft  
]
%

category: 'Session Control'
classmethod: System
_sleep: aTime

"Sleep for aTime seconds.  aTime must be a positive SmallInteger.  
 If aTime is zero, this method has no effect.

 Returns time left to sleep , which will be > 0 if interrupted."
 
<primitive: 370>
aTime _validateClass: SmallInteger .
aTime < 0 ifTrue: [ aTime _error: #rtErrArgOutOfRange ] .
^ self _primitiveFailed: #sleep:
%

! Gs64 v2.1 ,  sleep: is interruptable by soft-break
category: 'Session Control'
classmethod: System
sleep: aTime

"Sleep for aTime seconds.  aTime must be a positive SmallInteger.
 If aTime is zero, this method has no effect. 
 Returns the receiver."

| timeLeft |
aTime _isSmallInteger ifFalse:[ aTime _validateClass: SmallInteger ].
aTime < 0 ifTrue: [ aTime _error: #rtErrArgOutOfRange ] .
timeLeft := aTime .
[ timeLeft > 0 ] whileTrue:[
  timeLeft := self _sleep: timeLeft  
]
%

category: 'Session Control'
classMethod: System
sessionsReferencingOldestCr

"Returns an Array containing the sessionIds of the sessions that are
 currently referencing the oldest commit record.  Sessions both inside and outside
 of a transaction will be returned.  Because a session can update its commit
 record without committing a transaction, it is possible that no session
 actually references the oldest commit record.  Therefore, this method
 may return an empty Array."
       
^self _zeroArgPrim: 21
%

category: 'Session Control'
classmethod: System
descriptionOfSession: aSessionId

"Returns an eleven-element Array describing the session.

 1.  The UserProfile of the session, or nil if the UserProfile is recently
     created and not visible from this session's transactional view ,
     or the session is no longer active .
 2.  The process ID of the Gem process of the session (an Integer).
 3.  The hostname of the machine running the Gem process
     (a String, limited to 127 bytes).
 4.  Primitive number in which the Gem is executing, or 0 if it is not executing
     in a long primitive.
 5.  Time of the session's most recent beginTransaction, commitTransaction, or
     abortTransaction (from System timeGmt).
 6.  The session state (a SmallInteger).
 7.  A SmallInteger whose value is -1 if the session is in transactionless mode,
     0 if it is not in a transaction and 1 if it is in a transaction.
 8.  A Boolean whose value is true if the session is currently referencing the
     oldest commit record, and false if it is not.
 9.  The session's serial number (a SmallInteger).
 10. The session's sessionId (a SmallInteger).
 11. A String containing the ip address of host running the GCI process.
     If the GCI application is linked (using libgcilnk*.so or gcilnk*.dll) 
     this ip address is the address of the machine running the gem process .

 Because a session can update its commit record without committing a
 transaction, it is possible that no session actually references the oldest
 commit record.  Therefore, the eighth element may be false for all current
 sessions.

 To execute this method for any session other than your current session, you
 must have the SessionAccess privilege."

^ self _descriptionOfSessionSerialNum: 0 sessionId: aSessionId
%

category: 'Session Control'
classmethod: System
descriptionOfSessionSerialNum: aSerialNumber

"Returns an eleven-element Array describing the session identified by aSerialNumber.

 See System (C) | descriptionOfSession: for documentation on the contents of the
 result Array.

 Requires SessionAccess privilege if aSerialNumber is not the current session."

^ self _descriptionOfSessionSerialNum: aSerialNumber sessionId: -1
%

category: 'Session Control'
classmethod: System
_descriptionOfSessionSerialNum: serialNum sessionId: aSessionId

"Returns an eleven-element Array describing the session identified by the arguments.   
 The session is looked up by serial number if serialNum is > 0.  Otherwise
 it is looked up by sessionId.

 See System (C) | descriptionOfSession: for documentation on the contents of the
 result Array.
 Requires SessionAccess privilege if the session being looked up is not 
 the current session."

<primitive: 334>
aSessionId _validateClass: SmallInteger.
^ self _primitiveFailed: #_descriptionOfSessionSerialNum:sessionId:
%

category: 'Setting Locks'
classmethod: System
_lockError: errNum obj: anObj args: argList

"Translate from SmallInteger to Symbol, for error reporting."
"Ugh."

(errNum == 2071) ifTrue: [^anObj _error: #lockErrUndefinedLock args: argList].
(errNum == 2073) ifTrue: [^anObj _error: #lockErrIncomplete args: argList].
(errNum == 2074) ifTrue: [^anObj _error: #lockErrObjHasChanged
                                  args: argList].
(errNum == 2075) ifTrue: [^anObj _error: #lockErrDenied args: argList].
(errNum == 2418) ifTrue: [^anObj _error: #lockErrDeadlock args: argList].
(errNum == 2419) ifTrue: [^anObj _error: #lockErrTimeout args: argList].

"desperate, now"
^self signal: errNum args: argList signalDictionary: GemStoneError
%

category: 'Setting Locks'
classmethod: System
readLock: anObject

"This method grants a read lock on anObject if another session already holds
 a read lock, but grants no lock if another session already holds a write
lock to anObject."

| result |
result := self _lock: anObject kind: 2 autoRelease: false .
(result == 1)
  ifTrue: [^self].
self _lockError: result obj: anObject args: #[#read]
%

category: 'Setting Locks'
classmethod: System
readLock: anObject ifDenied: denyBlock ifChanged: changeBlock

"Requests a read lock on anObject.  This method denies a read lock
 on anObject under any one of the following circumstances:

 * Another session has a write lock on the object.

 * The object is special.

 Returns the receiver if the requested lock was granted and was not dirty.

 If the requested lock is otherwise denied, it returns the value of
 the zero-argument block denyBlock.  If it grants a dirty lock, then it
 returns the value of the zero-argument block changeBlock.  In that case the
 lock remains, even after the transaction is aborted."

| result |

result := self _lock: anObject kind: 2 autoRelease: false .
(result == 1) ifTrue: [^self].
^ self _lockEvaluateErr: result denied: denyBlock changed: changeBlock
%

category: 'Setting Locks'
classmethod: System
readLockAll: aCollection

"Requests a read lock on each object in aCollection.  This method denies
 a read lock on an object under the following circumstances:

 * Another session already holds a write lock on the object.

 This method grants a read lock on an object whenever it finds no reason
 to deny it.  However, a lock that it grants may be dirty.  One session's
 lock is dirty if another session has committed a change to the locked object
 since the beginning of the first session's current transaction.  A session
 that holds a dirty lock cannot commit its transaction.  To clean its locks,
 it must abort the transaction and obtain updated values for each object whose
 lock is dirty.

 If a lock was acquired for every element of aCollection, and no locks are
 dirty, returns the receiver.

 This method generates an error if it is unable to acquire a lock for every
 element of aCollection, or if any lock that it acquires is dirty.  However,
 all the locks that it acquires remain in place, even after the current
 transaction is aborted."


| result |
result := self _lockAll: aCollection kind: 2 .
(result == self )
  ifTrue: [^self]
  ifFalse: " else we generate the error lock incomplete "
           [^ (result at: 1) _error: #lockErrIncomplete
                             args: #[(result at:2), (result at:3)]].
%

category: 'Setting Locks'
classmethod: System
readLockAll: aCollection ifIncomplete: incompleteBlock

"Requests a read lock on each object in aCollection.  This method denies
 a read lock on an object in the collection under any one of the following
 circumstances:

 * Another session already holds a write lock an object.

 * The object is special.

 If all requested locks were granted and none of the locks are 'dirty',
 returns the receiver.

 This method grants a read lock on an object whenever it finds no reason
 to deny it.  However, a lock that it grants may be dirty.  One session's
 lock is dirty if another session has committed a change to the locked object
 since the beginning of the first session's current transaction.  A session
 that holds a dirty lock cannot commit its transaction.  To clean its locks,
 it must abort the transaction and obtain updated values for each object whose
 lock is dirty.

 If this method is unable to acquire a lock for every element of aCollection,
 or if any lock that it acquires is dirty, then it returns the value of the
 three-argument block incompleteBlock.  The arguments to the block are:

 1.  An Array of objects that could not be locked.

 2.  An Array of objects that were locked but whose locks are dirty.

 3.  An empty Array, retained for backward compatibility with GemStone version
     3.2.  It was used formerly to hold uncommitted objects, which could not
     then be locked.

 All the locks that it acquires remain in place, even after the current
 transaction is aborted."

| result |
result := self _lockAll: aCollection kind: 2 .
(result == System)
  ifTrue: [^self]
  ifFalse: " else we execute the incomplete block with 3 arguments "
          [^incompleteBlock value: (result at: 1)
                            value: (result at:2)
                            value: (result at:3)].
%


category: 'Setting Locks'
classmethod: System
writeLock: anObject

"Analogous to System | readLock:.  However, this method requests and
 grants write locks."

| result |

result := self _lock: anObject kind: 3 autoRelease: false .
(result == 1)
  ifTrue: [^self].
self _lockError: result obj: anObject args: #[#write]
%

category: 'Setting Locks'
classmethod: System
writeLock: anObject ifDenied: denyBlock ifChanged: changeBlock

"Analogous to System | readLock:ifDenied:ifChanged:.  However,
 this method requests and grants write locks."

| result |
result := self _lock: anObject kind: 3 autoRelease: false .
(result == 1) ifTrue: [^self].
^ self _lockEvaluateErr: result denied: denyBlock changed: changeBlock
%

category: 'Setting Locks'
classmethod: System
writeLockAll: aCollection

"Analogous to System | readLockAll:.  However, this method requests and
 grants write locks."

| result |
result := self _lockAll: aCollection kind: 3 .
(result == System)
  ifTrue: [^self]
  ifFalse: " else we generate the error lock incomplete "
           [^ (result at: 1) _error: #lockErrIncomplete
                             args: #[(result at:2), (result at:3)]].
%

category: 'Setting Locks'
classmethod: System
writeLockAll: aCollection ifIncomplete: incompleteBlock

"Analogous to System | readLockAll:ifIncomplete:.  However, this method
 requests and grants write locks."

| result |
result := self _lockAll: aCollection kind: 3 .
(result == System)
  ifTrue: [^self]
  ifFalse: " else we execute the incomplete block with 3 arguments "
          [^incompleteBlock value: (result at: 1)
                            value: (result at:2)
                            value: (result at:3)].
%

category: 'Setting Locks'
classmethod: System
waitForRcWriteLock: rcLockObject 

"Waits for the RcWriteLock using the specified object and
 returns a SmallInteger, one of 
   1  granted
   2074  dirty (object written by other session since start of this transaction)
   2075  denied (locked by another session)
   2418  deadlock
   2419  timeout  (per STN_OBJ_LOCK_TIMEOUT config parameter)

 All calls must use a persistent rcLockObject which is identical during the
 life of a stone process .
 If result is 1 or 2074, the rcLockObject is added to both 
 the CommitReleaseLocksSet and CommitOrAbortReleaseLocksSet 
 hidden sets of this session.

 Error 2418 deadlock  is returned if
   the requesting session already holds a readLock on rcLockObject
 or if 
  the session would have to wait for the lock on rcLockObject, but doing
  so would create a cycle in the graph of locks being waited for, i.e:

    the session already holds a read or write lock on some object X
      and some other session is waiting in an invocation of
        waitForRcWriteLock: X
      or
        waitForApplicationWriteLock: X ...
    and this session's attempt at
       waitForRcWriteLock: rcLockObject
    would have to wait to get the lock on rcLockObject
"

^ self _lock: rcLockObject kind: 4 autoRelease: true
%

category: 'Setting Locks'
classmethod: System
waitForApplicationWriteLock: lockObject queue: lockIdx autoRelease: aBoolean

"Waits for a write lock using the specified object and
 the Application lock queue specifed by lockIdx .

 lockIdx must be a SmallInteger,  >= 1  and  <= 10

 returns a SmallInteger, one of 
   1  granted
   2071  undefined lock (lockIdx out of range or lockObject is special object)
   2074  dirty (object written by other session since start of this transaction)
   2418  deadlock
   2419  timeout  (per STN_OBJ_LOCK_TIMEOUT config parameter)

 For a given value of lockIdx, all calls must use a persistent lockObject  
 which is identical during the life of a stone process .

 If result is 1 or 2074 and aBoolean == true,  the lockObject is added to both 
 the CommitReleaseLocksSet and CommitOrAbortReleaseLocksSet 
 hidden sets of this session.

 The result 2418 (deadlock)   is returned if
   the requesting session already holds a readLock on lockObject
 or if 
  the session would have to wait for the lock on lockObject, but doing
  so would create a cycle in the graph of locks being waited for, i.e:

    the session already holds a read or write lock on some object X
      and some other session is waiting in an invocation of
        waitForRcWriteLock: X
      or
        waitForApplicationWriteLock: X ...
    and this session's attempt at
       waitForApplicationWriteLock: lockObject
    would have to wait to get the lock on lockObject
"

lockIdx < 1 ifTrue:[ ^ 2071 "lockIdx out of range"].
^ self _lock: lockObject kind: lockIdx + 4 autoRelease: aBoolean
%

category: 'Setting Locks'
classmethod: System
_lockEvaluateErr: errNum denied: denyBlock changed: changeBlock

"Private."

(errNum == 2074) ifTrue:[ ^ changeBlock value ]. "object  written by other session"
(errNum == 2075) ifTrue:[ ^ denyBlock value ]. " lock denied "

" at this point we have an unexpected error"
^self signal: errNum args: #[] signalDictionary: GemStoneError
%

category: 'Setting Locks'
classmethod: System
_lockAll: aCollection kind: lockKind

"Attempts to lokd all the objects in aCollection.

 The lockKind argument specified the kind of lock and 
 must be a SmallInteger, one of 
    2  read
    3  write 

 An error is generated and no locks are obtained
 if aCollection is a byte format object.

 An error is generated and no locks are obtained if any element
 of aCollection is identical to AllSymbols .

 Returns the receiver if all locks were granted and not dirty .
 Otherwise returns an Array of size 3 with elements :
   1.  An Array of objects that could not be locked.
   2.  An Array of objects that were locked but whose locks are dirty.
   3.  An empty Array, retained for backward compatibility with GemStone version
     3.2.  It was used formerly to hold uncommitted objects, which could not
     then be locked.
"

<primitive: 100>
"primitive fails if aCollection is not a kind of SequenceableCollection
 or IdentityBag "
| anArray |
anArray := aCollection asArray.
anArray == aCollection ifFalse:[
  ^ self _lockAll: anArray kind: lockKind
  ] .
aCollection _validateClass: Collection.
lockKind _validateClass: SmallInteger .
self _primitiveFailed: #_lockAll:kind: .
self _uncontinuableError
%

category: 'Setting Locks'
classmethod: System
_lock: anObject kind: lockKind  autoRelease: autoReleaseBoolean

"Attempt to lock a single object.  
 lockKind argument must be a SmallInteger , one of
    2  read
    3  write 
    4  wait for RcRetry write lock
    5  wait for Application write lock 1
    ... 
   14  wait for Application write lock 10

 lockKinds 4..14  may be used with only one unique persistent object 
 during the life of a stone process .  The first use of that lockKind 
 registers anObject with that transient queue in the stone process, and 
 subsequent uses of that lockKind with an object not identical to anObject 
 will generate an error.  An error will be generated if anObject is
 not committed.  The queues are reinitialized each time stone process restarts.

 Any attempt to lock AllSymbols generates an error.

 This method returns a SmallInteger.
 Attempt to lock a special object always returns  2075  denied .
 If lockKind is < 2 or > 14 ,   returns 2071 .

 read and write requests return one of  
   1  granted
   2074  dirty (object written by other session since start of this transaction)
   2075  denied (locked by another session)

 'wait for' requests return one of 
   2074  dirty (object written by other session since start of this transaction)
   2075  denied (locked by another session)
   2418  deadlock 
   2419  timeout  (per STN_OBJ_LOCK_TIMEOUT config parameter)

 If autoReleaseBoolean == true and result is either 1 or 2074 ,
 then the object is added to  both the CommitReleaseLocksSet
 and CommitOrAbortReleaseLocksSet  hidden sets .
"

<primitive: 97>
self _primitiveFailed: #_lock:kind:autoRelease: .
self _uncontinuableError
%

category: 'Lock Status'
classmethod: System
lockKind: anObject

"Returns a Symbol (#none, #read, or #write) representing the kind
 of lock held on anObject by any session in the system."

| anArray |

anArray := self lockStatus: anObject.
^anArray at: 1.
%

category: 'Lock Status'
classmethod: System
lockOwners: anObject

"Returns an Array of session numbers (SmallIntegers) representing the sessions
 that hold a lock on anObject.  If the object is not locked by any session, the
 result Array is empty.  Note that a write lock can have only one owner."

| anArray |

anArray := self lockStatus: anObject.
^anArray at: 2.
%

category: 'Lock Status'
classmethod: System
lockStatus: anObject

"Returns a two-element Array, where the first element is a Symbol representing
 the kind of lock held on anObject (#none, #read or #write) and
 the second element is an Array of session numbers (SmallIntegers) representing
 the sessions that hold the lock.

 If there are no locks on anObject, the first element is the Symbol #none and
 the second element is an empty Array.

 Only locks on permanent objects are reported."

<primitive: 351>
self _primitiveFailed: #lockStatus: .
self _uncontinuableError
%

category: 'Lock Status'
classmethod: System
sessionLocks

"Returns a three-element Array describing the locks held by the current
 session.  The first element is an Array of all read-locked objects, the second
 is an Array of all write-locked objects, and the third is empty array (which
 held exclusive-locked objects in older releases).  If the current session holds
 no locks of a particular kind (read, write), then the corresponding Array is
 empty.  If the current session holds no locks at all, then all three of these
 Arrays are empty."

<primitive: 352>
self _primitiveFailed: #sessionLocks .
self _uncontinuableError
%

category: 'Private'
classmethod: System
_systemLocksPrim

"For use in implementation of System(C) | systemLocks.  Returns an Array of
 Associations, with key sessionId."

<primitive: 353>

self _primitiveFailed: #_systemLocksPrim .
self _uncontinuableError
%

category: 'Lock Status'
classmethod: System
systemLocks

"Returns a Dictionary describing all objects that are currently locked.  For
 each Association in the result Dictionary, the key is a SmallInteger (the
 session number of a GemStone session that holds locks) and the value is the
 three-element Array described in the sessionLocks method.  If no sessions hold
 any locks, the result Dictionary is empty.

 The Arrays in the result Dictionary contain only those objects that are
 visible to the current session.  This method does not return locks that the
 current session cannot see (objects that have been committed since the
 beginning of the current transaction, uncommitted objects from other sessions,
 or locks on objects for which this session has no read authorization).

 Locks on temporary objects in other sessions are not reported."

| anArray result |
anArray := self _systemLocksPrim  .
result := Dictionary new .
anArray do:[ :assoc | result add: assoc ].
^ result
%

category: 'Performance Monitoring'
classmethod: System
_approxOopHighWaterMark

"Returns an Integer that gives the approximate highest oop allocated in GemStone.
 Resolution of this value is to the nearest 1K oops"


^self _zeroArgPrim: 23
%

category: 'Performance Monitoring'
classmethod: System
_oopHighWaterMark

"Returns an Integer that gives the highest oop allocated in GemStone."

^self _zeroArgPrim: 93
%

category: 'Performance Monitoring'
classmethod: System
_oopNumberHighWaterMark

"Returns an Integer that gives the highest oop number allocated in GemStone."

^self _zeroArgPrim: 94
%

category: 'Performance Monitoring'
classmethod: System
_tempObjSpaceUsed

"Returns the approximate number of bytes of temporary object memory being used
 to store objects."

^self _zeroArgPrim: 77
%

category: 'Performance Monitoring'
classmethod: System
_tempObjSpaceMax

"Returns the approximate maximum number of bytes of temporary object memory which is
 usable for storing objects."

^self _zeroArgPrim: 78
%

category: 'Performance Monitoring'
classmethod: System
_tempObjSpacePercentUsed

"Returns the approximate percentage of temporary object memory which is
 in use to store temporary objects.  This is equivalent to the 
 expression:

 (self _tempObjSpaceUsed * 100) // self _tempObjSpaceMax.

 Note that it is possible for the result to be slightly greater than 100%.
 This result indicates temporary memory is almost completely full."

^self _zeroArgPrim: 79
%

category: 'Performance Monitoring'
classmethod: System
_tempObjSpacePercentUsedLastMark

"Returns the approximate percentage of temporary object memory which is
 in use to store temporary objects, as of the last MarkSweep."

^self _zeroArgPrim: 86
%

category: 'Performance Monitoring'
classmethod: System
_approxOopNumberHighWaterMark

"Returns an Integer that gives the approximate highest oop number allocated in GemStone.
 Resolution of this value is to the nearest 1K oops"


^self _zeroArgPrim: 36
%


category: 'Performance Monitoring'
classmethod: System
millisecondsToRun: aBlock

"Returns the number of CPU milliseconds used while evaluating aBlock.
 The argument aBlock must be a zero-argument block.

 Note that resolution of _readClock is on the order of 10ms so 
 this method should not be used to time operations that take 
 less than 50ms."

| startTime endTime |

startTime := self _readClock.
aBlock value.
endTime := self _readClock.
(endTime >= startTime) ifTrue: [
  ^ endTime - startTime
] ifFalse: [
  ^ endTime + (16rffffffff - startTime)
]
%

category: 'Performance Monitoring'
classmethod: System
_clearStoneStatistics

"Clear Stone statistics after printing them in the log."

^ self _zeroArgCateg2Prim: 5
%

category: 'Performance Monitoring'
classmethod: System
_logStoneStatistics

"Write Stone process statistics to gemsys.log."

^ self _zeroArgCateg2Prim: 4
%

category: 'Performance Monitoring'
classmethod: System
pageReads

"Returns the number of Repository page read operations performed since the start
 of the Gem process.  If the Gem is remote, this corresponds to reads performed
 in the current session.  If the Gem is linked, it corresponds to reads
 performed since the application was invoked."

^ self _zeroArgPrim: 2
%

category: 'Performance Monitoring'
classmethod: System
pageWrites

"Returns the number of Repository page write operations performed since the
 start of the Gem process.  If the Gem is remote, this corresponds to writes
 performed in the current session.  If the Gem is linked, it corresponds to
 writes performed since the application was invoked."

^ self _zeroArgPrim: 3
%

category: 'Performance Monitoring'
classmethod: System
_readClock

"Returns an Integer indicating the amount of CPU time used by the current
 process, in units of milliseconds.  The resolution of the result is operating
 system dependent; typical resolution is 10 to 50 milliseconds."

^ self _zeroArgPrim: 10
%

category: 'Performance Monitoring'
classmethod: System
myCacheProcessSlot

"Returns the process slot in the SharedPageCache that corresponds
 to my process.  If the SharedPageCache is not in use, returns -1."

^ self _zeroArgPrim: 7
%	

category: 'Performance Monitoring'
classmethod: System
cacheStatisticsDescription

"Returns an Array of Strings describing the result of the method
 cacheStatistics: . 

 A new Array of new Strings is created every
 time this primitive is called, so the application may wish to
 cache the result."

<primitive: 580>

%

category: 'Performance Monitoring'
classmethod: System
cacheStatisticsForSessionId: aSessionId

"Same as the cacheStatistics: method except the argument is the session ID
 of a session currently connected to the shared memory cache.  In systems
 that use multiple shared memory caches, the session must exist on the same
 cache as the session invoking this method.

 nil is returned if the session cannot be located."

 ^self _cacheStatsForSlotOrSession: aSessionId negated.
%

category: 'Performance Monitoring'
classmethod: System
cacheStatistics: aProcessSlot

"Returns an Array whose contents are described by the result of the
 cacheStatisticsDescription method.  The Array contains statistics for the
 specified slot in the GemStone shared memory cache to which this session is
 attached.

 The argument aProcessSlot should be a SmallInteger between 0 and the number of
 process slots in the shared cache minus 1, inclusive.  If aProcessSlot is 
 outside the range of valid process slots, or the session executing this
 method is not using a shared cache, generate an error.  If the slot specified
 by aProcessSlot is an inactive slot, returns nil.  The method
 cacheSlotForSessionId: may be used to determine the process slot of a session
 on the same shared cache.
 
 The process slots that are predefined are:

    slot 0: The shared page cache monitor.

    slot 1: The Stone if the cache is on the same machine as the Stone.
            Otherwise, a page server that is used to monitor the cache for
            the Stone.

 No other slots are guaranteed.  However, slot 2 is the often the page server
 and slot 3 is often the GcGem.  These depend to some extent on the relative
 speed of the processes during startup.  In addition, the GcGem can be 
 shut down, and when it is restarted, it is unlikely to end up at the same
 position."

 ^self _cacheStatsForSlotOrSession: aProcessSlot
%

category: 'Performance Monitoring'
classmethod: System
cacheSlotForSessionId: aSessionId

"Return the cache process slot number (a SmallInteger) for the given session
 ID.  The session must be connected to the same shared page cache as the 
 session invoking this method.  

 A return of nil indicates the session could not be located."

<primitive: 567>
aSessionId _validateClass: SmallInteger.
self _error: #rtErrArgOutOfRange args: #[ aSessionId ] .
^ self _primitiveFailed: #cacheSlotForSessionId:
%

category: 'Performance Monitoring'
classmethod: System
cacheStatsForGemWithName: aStringOrSymbol

"This method does a case-sensitive search for the gem with the given cache
 name and returns an array of cache statistics for the gem if found.

 Returns nil if the gem could not be located."

<primitive: 565>
aStringOrSymbol _validateClass: String.
^ self _primitiveFailed: #cacheStatsForGemWithName: .
%

category: 'Private'
classmethod: System
_cacheStatsForSlotOrSession: aProcessSlotOrSessionId

"The argument must be an instance of SmallInteger.
 A positive argument means it is a cache process slot number.
 A negative argument means it is a gem session ID. "

<primitive: 220>
aProcessSlotOrSessionId _validateClass: SmallInteger.
self _error: #rtErrArgOutOfRange args: #[ aProcessSlotOrSessionId ] .
^ self _primitiveFailed: #_cacheStatsForSlotOrSession:
%

category: 'Performance Monitoring'
classmethod: System
_sharedAttached

"This method returns the number of pages that are attached by this session
 and at least one other session.  It used to be reported in the cache
 statistics, but was removed because the computation was too costly
 for large numbers of users."

^self _zeroArgPrim: 24
%

category: 'Authorization'
classmethod: System
canRead: anObject

"In Gemstone64 , an object must be faulted into memory before
 it can be passed as an argument to a method.  Thus by definition
 if you enter this method you can read the argument. "

^ true
%

category: 'Authorization'
classmethod: System
canWrite: anObject

"This method tests whether the user has authorization to write anObject without
 adding it to write set and returns a Boolean result."

<primitive: 103>
self _primitiveFailed: #canWrite:
self _uncontinuableError
%

category: 'Time'
classmethod: System
_timeMs

"Returns a SmallInteger representing the current relative time in milliseconds.
 The result is a SmallInteger equivalent to
    (System _timeGmtFloat * 1000) asInteger 

 The result is computed locally in the session process, using the offset 
 from Stone's time that was cached in the session at login.

 Gs64 v2.2, changed to no longer rollover to zero after 524287999 "
 
<primitive: 651>
^ self _primitiveFailed: #_timeMs
%
category: 'Time'
classmethod: System
_timeMsLegacy

"Returns a SmallInteger representing the current relative time in milliseconds.
 The result is a SmallInteger equivalent to
    (System _timeGmtFloat * 1000) asInteger \\ 524288000
 
 The result is computed locally in the session process, using the offset 
 from Stone's time that was cached in the session at login."

^ self _zeroArgPrim: 12
%

! edited to fix 37020
category: 'Time'
classmethod: System
_timeGmtFloat

"Returns a Float representing the time since January 1, 1970 in units
 of seconds, to microsecond resolution, or such resolution as provided
 by the operating system's gettimeofday() call.  This time is computed locally
 in the session process, using the offset from Stone's time that was
 cached in the session at login."

^ self _zeroArgPrim: 13 
%

category: 'Time'
classmethod: System
_timeGmt: aBoolean

"Returns a SmallInteger, the time since January 1, 1970, in seconds.
 aBoolean is true, call Stone and update our offset from Stone's clock,
 otherwise compute the current time locally using the offset from Stone's time
 that was cached in the session at login."

<primitive: 371>
^ self _primitiveFailed: #_timeGmt:
%

category: 'Time'
classmethod: System
_timeGmt95: aBoolean

"Obsolete - use timeGmt2005 instead of this method.

 Returns a SmallInteger, the time since January 1, 1995, in seconds.
 aBoolean is true, call Stone and update our offset from Stone's clock,
 otherwise compute the current time locally using the offset from Stone's time
 that was cached in the session at login."

<primitive: 381>
^ self _primitiveFailed: #_timeGmt95:
%

category: 'Time'
classmethod: System
timeGmt

"Returns a SmallInteger, the time since January 1, 1970, in seconds.
 The time is computed from the clock of the machine on which the session is 
 running, using the offset from the clock on the Stone's (GemStone repository 
 monitor process) machine which is cached in the session at login."

^ self _timeGmt: false
%

category: 'Time'
classmethod: System
timeGmt95

"Obsolete - use timeGmt2005 instead of this method.

 Returns a SmallInteger, the time since January 1, 1995, in seconds.
 The time is computed from the clock of the machine on which the session is 
 running, using the offset from the clock on the Stone's (GemStone repository 
 monitor process) machine which is cached in the session at login."

^ self _timeGmt95: false
%

category: 'Backward Compatibility'
classmethod: System
clusterBucket

"Obsolete in GemStone 3.2."

^ self currentClusterId
%

category: 'Private'
classmethod: System
_signalErrorStatus: aSignal

"Returns status of the specified signal .
 Signals are specified by SmallIntegers, the following are defined:

 1.  SignaledObjects 
 2.  SignaledAbort (if in transaction, reflects status after transation finishes)
 3.  SignaledGemStoneSession 
 4.  SignaledFinishTransaction
 5.  SignalAlmostOutOfMemory 
 6   SignalTranlogsFull"

<primitive: 366>
self _primitiveFailed: #_signalErrorStatus: .
self _uncontinuableError
%

category: 'Private'
classmethod: System
_updateSignalErrorStatus: aSignal toState: newState

"This method changes the generation of the error for the specified signal
 generation is disabled.  Signals are specified by SmallIntegers, and the
 following are defined:

 1.  SignaledObjects
 2.  SignaledAbort       (delayed effect if currently in transaction)
 3.  SignaledGemStoneSession
 4.  SignaledFinishTransaction
 5.  SignalAlmostOutOfMemory .
 6   SignalTranlogsFull"

<primitive: 367>
self _primitiveFailed: #_updateSignalErrorStatus:toState .
self _uncontinuableError
%

category: 'Notification'
classmethod: System
disableSignaledGemStoneSessionError

"Set the current GemStone session so that it cannot receive signals from
 other GemStone sessions."

self _updateSignalErrorStatus: 3 toState: false
%

category: 'Signals'
classmethod: System
sendSignal: aSignal to: aSessionId withMessage: aString

"Sends a signal (a SmallInteger) to the specified session (a SmallInteger) with
 aString as a message.  The aString argument is currently limited to 1023
 bytes."

aSessionId _validateClass: SmallInteger.
aSessionId < 1 ifTrue:[ aSessionId _error: #rtErrArgNotPositive  ].
self _sendSignal: aSignal toSess: aSessionId negated withMessage: aString
%

category: 'Signals'
classmethod: System
_sendSignal: aSignal toSess: sessionIdOrSerial withMessage: aString

"Sends a signal (a SmallInteger) to the specified session with aString as a
 message.  The aString argument is currently limited to 1023 bytes.

 The sessionIdOrSerial argument is a SmallInteger specifying a session.  A
 positive value is interpreted as a serialNumber.  A negative value is
 interpreted as a negated sessionId."

<primitive: 330>
aSignal _validateClass: SmallInteger.
sessionIdOrSerial _validateClass: SmallInteger.
aString _validateClass: String.
self _primitiveFailed: #_sendSignal:toSerialNum:withMessage: .
self _uncontinuableError
%

category: 'Backward Compatibility'
classmethod: System
signalFromGemStoneSession

"Obsolete in GemStone 5.0."

"Returns a three-element Array containing information about a signal from
 another GemStone session:

 1.  An instance of GsSession representing the session that sent the signal.
 2.  The signal value (a SmallInteger).
 3.  A signal message (a String).

 If there is no signal in the queue, returns an empty Array."

| result |
result := self _signalFromGemStoneSession .
result == nil ifTrue:[ ^ #[] ].
result at: 1 put: (GsSession sessionWithSerialNumber: (result at: 1)).
^ result
%

category: 'Private'
classmethod: System
_signalFromGemStoneSession

"Returns a three-element Array containing information about a signal from
 another GemStone session:

 1.  The sessionSerialNumber of the session that sent the signal.
 2.  The signal value (a SmallInteger).
 3.  A signal message (a String).

 If there is no signal in the queue, returns nil."

<primitive: 369>
self _primitiveFailed: #signalFromGemStoneSession .
self _uncontinuableError
%

category: 'Notification'
classmethod: System
addToNotifySet: anObject

"Add anObject to the notify set.  The argument anObject cannot be a special
 object nor an uncommitted object, since neither can be modified by other
 sessions."

self _updateNotifySet: #[ anObject ]  add: true
%

category: 'Notification'
classmethod: System
addAllToNotifySet: aCollection

"Add all the elements of aCollection to the notify set.  Special objects and
 uncommitted objects are not permitted, since neither of these can be modified
 by other sessions."

self _updateNotifySet: aCollection add: true
%

category: 'Notification'
classmethod: System
clearNotifySet

"Remove all of the objects that are currently in the notify set."

self removeAllFromNotifySet: (self notifySet)
%

category: 'Notification'
classmethod: System
disableSignaledObjectsError

"Disable the generation of an error when a member of the notify set
 is added to the signaled objects set."

self _updateSignalErrorStatus: 1 toState: false
%

category: 'Notification'
classmethod: System
enableSignaledObjectsError

"Enable the generation of an error when a member of the notify set is added to
 the signaled objects set.  When this error (RT_ERR_SIGNAL_COMMIT) is signaled,
 it is also disabled to allow the exception handler to run without receiving 
 another interrupt.  Therefore, the exception handler should re-enable 
 the condition."

self _updateSignalErrorStatus: 1 toState: true
%

category: 'Notification'
classmethod: System
notifySet

"Returns an Array of the objects that the user has registered for notification
 when a new state is committed."

^self _hiddenSetAsArray: 25
%

category: 'Notification'
classmethod: System
removeFromNotifySet: anObject

"Removes anObject from the notify set.  Does not generate an error if anObject
 is not in the notify set."

self _updateNotifySet: #[ anObject ] add: false
%

category: 'Notification'
classmethod: System
removeAllFromNotifySet: aCollection

"Removes all elements of aCollection from the notify set.  Does not generate an
 error if any of the elements are not in the notify set."

self _updateNotifySet: aCollection add: false
%

category: 'Notification'
classmethod: System
signaledObjects

"Returns an Array containing the objects that have been signaled since the last
 time this method was executed.  The elements in the Array are a subset of the
 notify set.  Clear the set of signaled objects."

<primitive: 365>
self _primitiveFailed: #signaledObjects .
self _uncontinuableError
%

category: 'Notification'
classmethod: System
signaledObjectsErrorStatus

"Returns true to indicate that the system generates errors when objects are
 added to the signaled objects set.  Returns false otherwise."

^self _signalErrorStatus: 1
%

! fixed bug 13621, 14253
category: 'Notification'
classmethod: System
_updateNotifySet: aCollection add: aBoolean

"Update the notify set by adding or removing the elements of the anArray to or
 from the set.  If aBoolean is true, the elements are added, otherwise they are
 removed."

<primitive: 363>
| anArray |
anArray := aCollection asArray.
anArray == aCollection ifFalse:[
  ^ self _updateNotifySet: anArray add: aBoolean
  ] .
aCollection _validateClasses: #[ Array, IdentityBag ].
self _primitiveFailed: #_updateNotifySet:add: .
self _uncontinuableError
%

category: 'Notification'
classmethod: System
enableSignaledGemStoneSessionError

"Enable the current GemStone session to receive signals from other GemStone
 sessions.  One GemStone session receives a signal from another session when a
 RT_ERR_SIGNAL_GEMSTONE_SESSION exception is raised.

 The receiving session processes the signal with an exception handler.  When
 GemStone raises one signal exception, it also disables further signal
 exceptions, to allow the exception handler to run without receiving another
 interrupt.  The exception handler should therefore re-enable signal exceptions
 when it is done with its other processing.

 A signal is not exactly an interrupt, and it does not automatically awaken an
 idle session.  Both the GemStone Smalltalk virtual machine and GemBuilder for C
 can raise the signal exception.  But the process of the session must activate
 the virtual machine or interface before the signal can be received."

self _updateSignalErrorStatus: 3 toState: true
%

category: 'Notification'
classmethod: System
signaledGemStoneSessionErrorStatus

"Returns true to indicate that the current GemStone session can receive signals
 from other GemStone sessions.  Returns false otherwise."

^self _signalErrorStatus: 3
%

!  removed EpochGcSignal methods

category: 'Transient Session State'
classmethod: System
_sessionStateAt: anIndex

"Returns an indexed instance variable of the Transient Session State object.
 This object is a temporary instance of Array created after each GciLogin.

 If the specified instance variable of the Session State has not been stored
 into during this session, the result is nil.  This is different from
 Array>>at: semantics, where accessing beyond the end of an Array
 generates an error.

 Users of this method must observe the following instance variable allocations
 for this Array.

    anIndex      assignedUse
    -------      -----------
    1            Reserved for SymbolDictionary of Temporaries
    2            Reserved for GemORB.
    3            Topaz session state
    4            Reduced Conflict classes logging info
    5            Cache for Reduced Conflict values
    6            The one instance of GsCurrentSession 
    7            Pending commit/abort errorNumber or userAction 
    8            Reserved for GemStone federation support
    9            Other known sessions (a dictionary keyed on sessionSerialNum)
    10           Reserved for GemStone relational support
    11           Reserved for GemStone IndexManager support
    12           GemBuilder for C (GCI) deferred update Dictionary.
    13           GemBuilder for C (GCI) deferred update Array.
    14           Commit coordinator.
    15           Reserved for GemStone ProcessorScheduler support.
    16           Reserved for GemStone Locale support. 
    17           Reserved for timezone support.
    18           Reserved for GemStone GsFile support.
    19           Reserved for future use by VMware Inc.
    20..         Available for customer use ."

<primitive: 111>

(anIndex _isSmallInteger)
  ifTrue: [self _errorIndexOutOfRange: anIndex .  ^ nil ]
  ifFalse: [self _errorNonIntegerIndex: anIndex .  ^ nil ].
self _primitiveFailed: #_sessionStateAt: .
self _uncontinuableError
%

category: 'Transient Session State'
classmethod: System
_sessionStateSize

"Return the current size of the Session State Array."

<primitive: 214>
self _primitiveFailed: #_sessionStateSize .
self _uncontinuableError
%

category: 'Transient Session State'
classmethod: System
_sessionStateAt: anIndex put: aValue

"Modifies an indexed instance variable of the Transient Session State Array.
 The Session State Array will be grown as required to accommodate a store
 into the specified instance variable.

 See additional important documentation in the method #_sessionStateAt:"

<primitive: 372>
(anIndex _isSmallInteger)
  ifTrue: [self _errorIndexOutOfRange: anIndex]
  ifFalse: [self _errorNonIntegerIndex: anIndex].
self _primitiveFailed: #_sessionStateAt:put: .
self _uncontinuableError
%

category: 'Transient Session State'
classmethod: System
_sessionCacheStatAt: anIndex 

"Returns the value of the session statistic at the specified index 
 (should be in the range 0 to 47)."

<primitive: 477>
anIndex _validateClass: SmallInteger.
self _primitiveFailed: #_sessionCacheStatAt: .
%

category: 'Transient Session State'
classmethod: System
_sessionCacheStatAt: anIndex put: i

"This method sets the session statistic at the specified index (which should be
 in the range 0 to 47) to the specified value i, which must be a positive
 SmallInteger."

<primitive: 476>
anIndex _validateClass: SmallInteger.
i _validateClass: SmallInteger.
self _primitiveFailed: #_sessionCacheStatAt:put: .
%


category: 'Global Session Statistics'
classmethod: System
_updateGlobalSessionStat: index by: i overwrite: aBool

"Global session statistics are similar to session statistics except that global 
 statistics are accessible by every logged in session on every host.  Global
 sessions statistics are not transactional.  Therefore every session will see the
 same value in a given statistic regardless of its transactional view.  Reads and
 updates to these statistics are guaranteed to be atomic.

 This method updates the global session statistic at the specified index (which must be
 in the range 0 to 47) by the specified value i, which must be a SmallInteger in the range
 of -2147483648 to 2147483647.  If overwrite is true, then the current value of the 
 statistic is replaced by i.  If overwrite is false, then the current value of the 
 statistic is incremented by i.  

 Returns the new value of the statistic."

<primitive: 518>
index _validateClass: SmallInteger.
i _validateClass: SmallInteger.
aBool _validateClass: Boolean.
self _primitiveFailed: #_updateGlobalSessionStat:by:overwrite: .
%

category: 'Global Session Statistics'
classmethod: System
globalSessionStatAt: index
"Returns the current value of a global session statistic.
 See the method System>>_updateGlobalSessionStat: index by: i overwrite: aBool
 for more information on global session statistics."

^self _updateGlobalSessionStat: index by: 0 overwrite: false
%

category: 'Global Session Statistics'
classmethod: System
incrementGlobalSessionStatAt: index by: value
"Increments the value of the given global session statistic by newVal 
 and returns the new value.  See the method 
 System>>_updateGlobalSessionStat: index by: i overwrite: aBool
 for more information on global session statistics."

^self _updateGlobalSessionStat: index by: value overwrite: false
%


category: 'Global Session Statistics'
classmethod: System
globalSessionStatAt: index put: newVal
"Overwrites the value of the given global session statistic with newVal 
 and returns the new value.  See the method 
 System>>_updateGlobalSessionStat: index by: i overwrite: aBool
 for more information on global session statistics."

^self _updateGlobalSessionStat: index by: newVal overwrite: true
%

! _hasBreakpoints deleted

category: 'Transient Session State'
classmethod: System
_sessionCacheStatsForProcessSlot: aProcessSlot

"Return an array containing the 48 session statistics for the given
 process slot.  

 Returns nil if the given process slot is not found or
 if the slot is not in use by a gem process.

 See additional information in the method #_sessionCacheStatAt: put:"

^self _sessionCacheStatsForSlotOrSessionId: aProcessSlot
%

category: 'Transient Session State'
classmethod: System
_sessionCacheStatsForSessionId: aSessionId

"Return an array containing the 48 session statistics for the given
 session ID.  

 Returns nil if the given session is not found or if the slot is not
 in use by a gem process.

 See additional information in the method #_sessionCacheStatAt: put:"

^self _sessionCacheStatsForSlotOrSessionId: aSessionId negated.
%

category: 'Transient Session State'
classmethod: System
_sessionCacheStatsForSlotOrSessionId: aProcessSlotOrSessionId

"Return an array containing the 48 session statistics for the given
 session ID or process slot number.  If the argument is positive
 it is assumed to be a process slot.  If it is negative it is assumed
 to be a negated session ID. 

 Returns nil if the given session or cache slot is not found or
 if the slot is not in use by a gem process.

 See additional information in the method #_sessionCacheStatAt: put:"

<primitive: 566>
aProcessSlotOrSessionId _validateClass: SmallInteger.
self _error: #rtErrArgOutOfRange args: #[ aProcessSlotOrSessionId ].
^self _primitiveFailed: #_sessionCacheStatsForSlotOrSessionId: .
%

category: 'Backward Compatibility'
classmethod: System
myUserGlobals

"Obsolete in GemStone 5.0."

"Returns the current user's UserGlobals dictionary.  If the user does not have
 one, an error is flagged."

| assn |

(assn := self myUserProfile resolveSymbol: #UserGlobals) == nil ifTrue: [
  ^self _error: #rtErrKeyNotFound args: #(#UserGlobals)
].
^assn value.
%

category: 'Debugging Support'
classmethod: System
_enableTraceObjectsRead

"Enables tracing of object read-faults, i.e. committed objects that are copied
 into the VM's memory.  

 Object read-faults are accumulated in internal buffers, which 
 are flushed to hidden set 5  each time the PomGenScavCount 
 statistic increments . 
 Use the method _updateObjectsRead to explicitly flush buffers into 
 hidden set 5 . 

 If tracing was previously enabled, this method clears hidden set 5 .  

 Note that hidden set 5 is an identity set, and if the same object
 is read multiple times during an interval defined by _enableTraceObjectsRead,
 _disableTraceObjectsRead, due to wraparound of the memory area holding 
 committed objects , that object will only show up once in the set .  
 Changes in the statistic ObjectsRead  can be compared to changes in the 
 set size to detect multiple reads of objects.
 Also note the statistic ObjectsRefreshed , which represents re-reads
 of objects to obtain new views after crossing transaction boundaries;
 re-reads.

 Hidden set 5 is in C heap memory ; this process could run out of C heap memory
 if this tracing is left enabled for a very long time on a large repository.
 Memory consumption varys from approximately 8 bytes per object for small sets 
 to 1 bit per object for sets spanning the entire shared object table.

 Returns self."

^ self _zeroArgPrim: 99
%

category: 'Debugging Support'
classmethod: System
_updateObjectsRead

"If tracing of object read-faults has been enabled by executing
 _enableTraceObjectsRead ,   flushes internal tracing buffers into
 hidden set 5 .  
 Returns the size of hidden set 5, after flushing the buffers.

 If tracing of object read-faults is not enabled, returns 0 ."


^ self _zeroArgPrim: 96
%

category: 'Debugging Support'
classmethod: System
_disableTraceObjectsRead

"Disables tracing of object read-faults , if it is enabled, and flushes
 any remaining trace buffers into hidden set 5 .
 Returns the size of hidden set 5 after flushing the buffers.

 If tracing of object read-faults was not enabled, returns 0 ."


^ self _zeroArgPrim: 97
%

category: 'Debugging Support'
classmethod: System
_resumeTraceObjectsRead

"Resumes tracing of object read-faults .

 Same as _enableTraceObjectsRead, but does not clear hidden set 5 .  
 If tracing of object read-faults was already enabled, flushes the
 trace buffers into hidden set 5 .

 Returns the current size of hidden set 5."

^ self _zeroArgPrim: 98
%



category: 'Hidden Set Support'
classmethod: System
HiddenSetSpecifiers

"Returns a list of the hiddenSet specifiers."

^#(
" 1"   'ListInstancesResult'
" 2"   'Reserved for GemStone'
" 3"   'Reserved for GemStone'
" 4"   'SaveNewPomObjs' "See method #_enableTraceNewPomObjs"
" 5"   'ObjectsRead'    "See method #_enableTraceObjectsRead"
" 6"   'Reserved for GemStone'
" 7"   'RcReadSet'
" 8"   'DepMapWriteSet'
" 9"   'PomWriteSet'  "Empty except after flush for commit, so only useful
		       after you get a transaction conflict."
"10"   'SaveDepMapChangedObjs'
"11"   'SaveWriteSetUnion'
"12"   'SaveWrittenObjs'
"13"   'ReadWriteConflicts'  "StrongRead-Write conflicts "
"14"   'SaveDepMapChangedUnion'
"15"   'WriteWriteconflicts'
"16"   'WriteDependencyConflicts'
"17"   'WriteReadLockConflicts'
"18"   'WriteWriteLockConflicts'
"19"   'Reserved for GemStone'
"20"   'AllocatedGciOops'
"21"   'Reserved for GemStone'
"22"   'ExportedDirtyObjs'
"23"   'TrackedDirtyObjs'
"24"   'enumeration of ReferencedSet'
"25"   'NotifySet'
"26"   'Reserved1'
"27"   'Reserved2'
"28"   'Reserved3'
"29"   'CommitReleaseLocksSet'
"30"   'CommitOrAbortReleaseLocksSet'
"31"   'Reserved for GemStone'
"32"   'Reserved for GemStone'
"33"   'Reserved for GemStone'
"34"   'GcCandidates'
"35"   'ObjsWithWeakRefs'
"36"   'WriteLockWriteSubset'
"37"   'NewDataPages'
"38"   'StrongReadSet'
"39"   'PureExportSet'
"40"   'GciTrackedObjs'
"41"   'For Customer Use'
"42"   'For Customer Use'
"43"   'For Customer Use'
"44"   'For Customer Use'
"45"   'For Customer Use'
)
%

category: 'Hidden Set Support'
classmethod: System
_add: anObject to: hiddenSetSpecifier

"Adds anObject to the hiddenSet."
<primitive: 168>
hiddenSetSpecifier _validateClass: SmallInteger.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
self _primitiveFailed: #_add:to:  .
self _uncontinuableError
%

category: 'Private'
classmethod: System
_lockGc: aBool

"result is true for success, or a String with reason for failure"

<primitive: 525>
self _primitiveFailed: #_lockGc:.
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_addAll: anArray to: hiddenSetSpecifier

"Adds contents of anArray to the hiddenSet (anArray not added to hiddenSet)."
<primitive: 520>
hiddenSetSpecifier _validateClass: SmallInteger.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
self _primitiveFailed: #_addAll:to:  .
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_removeAll: anArray from: hiddenSetSpecifier

"Removes the contents of anArray from the hiddenSet (anArray is not removed from 
 the hiddenSet).  Objects in the array which are not in the hidden set are ignored.
 Returns a SmallInteger or LargePositiveInteger indicating the number of elements 
 successfully removed from the hidden set."

<primitive: 41>
hiddenSetSpecifier _validateClass: SmallInteger.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
^self _primitiveFailed: #_removeAll:from:  .
%


category: 'Hidden Set Support'
classmethod: System
_remove: anObject from: hiddenSetSpecifier

"Removes anObject from the hiddenSet."

<primitive: 169>
hiddenSetSpecifier _validateClass: SmallInteger.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
self _primitiveFailed: #_remove:from:  .
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_testIf: anObject isIn: hiddenSetSpecifier

"Returns true if anObject is in the hiddenSet, false otherwise."

<primitive: 170>
hiddenSetSpecifier _validateClass: SmallInteger.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
self _primitiveFailed: #_testif:isIn:.
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_hiddenSetAsArray: hiddenSetSpecifier

"Returns an Array containing the contents of the hiddenSet."

<primitive: 212>
hiddenSetSpecifier _validateClass: SmallInteger.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
self _primitiveFailed: #_hiddenSetAsArray:.
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_primHiddenSetEnumerate: hiddenSetSpecifier limit: maxResultSize storeAsInts: aBool

"Returns an Array containing the first maxResultSize
elements of the hiddenSet.  If the hidden set contains fewer than
maxResultSize elements, returns an array containing
the contents of the hiddenSet.    If maxResultSize = 0,
the result will contain all elements of the hidden set.

All of the returned elements are removed from the hidden set.

If aBool is true, then the object ID's of the hidden set are stored in
the result array as SmallIntegers.  Otherwise the objects themselves 
are stored in the result array."

<primitive: 331>
hiddenSetSpecifier _validateClass: SmallInteger.
aBool _validateClass: Boolean.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
maxResultSize _validateClass: SmallInteger.
maxResultSize < 0 ifTrue:[ maxResultSize _error: #rtErrArgOutOfRange].
self _primitiveFailed: #_primHiddenSetEnumerate:limit:storeInts:
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_hiddenSetEnumerate: hiddenSetSpecifier limit: maxResultSize

"Returns an Array containing the first maxResultSize objects
in the hiddenSet.  If the hidden set contains fewer than
maxResultSize elements, returns an array containing
the contents of the hiddenSet.    If maxResultSize = 0,
the result will contain all elements of the hidden set.

All of the returned elements are removed from the hidden set."

^self _primHiddenSetEnumerate: hiddenSetSpecifier
      limit: maxResultSize 
      storeAsInts: false.
%

category: 'Hidden Set Support'
classmethod: System
_hiddenSetEnumerateAsInts: hiddenSetSpecifier limit: maxResultSize

"Returns an Array containing the numeric object identifiers of the 
first maxResultSize objects in the hiddenSet.  If the hidden set 
contains fewer than maxResultSize elements, returns an array containing
the contents of the hiddenSet.    If maxResultSize = 0,
the result will contain all elements of the hidden set.

All of the returned elements are removed from the hidden set."

^self _primHiddenSetEnumerate: hiddenSetSpecifier
      limit: maxResultSize 
      storeAsInts: true.
%

category: 'Hidden Set Support'
classmethod: System
_hiddenSetSize: hiddenSetSpecifier

"Returns the number of elments in the hiddenSet."

<primitive: 171>
hiddenSetSpecifier _validateClass: SmallInteger.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
self _primitiveFailed: #_hiddenSetSize:.
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_hiddenSetReinit: hiddenSetSpecifier

"Reinitializes the hiddenSet to empty.  Must be system user for all
 hidden sets except the reserved ones."

<primitive: 172>
hiddenSetSpecifier _validateClass: SmallInteger.
(hiddenSetSpecifier < 1 _or:
       [hiddenSetSpecifier > (self HiddenSetSpecifiers size)])
  ifTrue: [hiddenSetSpecifier _error: #rtErrArgOutOfRange].
self _primitiveFailed: #_hiddenSetReinit:.
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_add: anObject toGciSet: hiddenSetSpecifier 

"Add the specified object to a GCI hidden set, where
   hiddenSetSpecifier = 39  specifies PureExportSet
   hiddenSetSpecifier = 40  specifies GciTrackedObjs .
 Other values of hiddenSetSpecifier are not allowed.
 Has no effect if anObject is a special object.

 If hiddenSetSpecifier = 39 and a userAction is 
 active an error is generated, since the PureExportSet
 cannot be modified from within a user action.

 If hiddenSetSpecifier = 40  and you have not
 executed  _gciDirtyInit:23 once since login,
 generates an error."

<primitive: 155>
hiddenSetSpecifier _validateClass: SmallInteger .
(hiddenSetSpecifier < 39 _or:[ hiddenSetSpecifier > 40]) ifTrue:[
  hiddenSetSpecifier _error: #rtErrArgOutOfRange
].
self _primitiveFailed: #_add:toGciSet: .
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_addAll: anArray toGciSet: hiddenSetSpecifier 

"Add contents of anArray to a GCI hidden set, where
   hiddenSetSpecifier = 39  specifies PureExportSet
   hiddenSetSpecifier = 40  specifies GciTrackedObjs .
 Other values of hiddenSetSpecifier are not allowed.

 If hiddenSetSpecifier = 39 and a userAction is 
 active an error is generated, since the PureExportSet
 cannot be modified from within a user action.

 If hiddenSetSpecifier = 40  and you have not
 executed  _gciDirtyInit:23 once since login,
 generates an error."

<primitive: 156>
hiddenSetSpecifier _validateClass: SmallInteger .
(hiddenSetSpecifier < 39 _or:[ hiddenSetSpecifier > 40]) ifTrue:[
  hiddenSetSpecifier _error: #rtErrArgOutOfRange
].
anArray _validateClass: Array .
self _primitiveFailed: #_addAll:toGciSet: .
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_remove: anObject fromGciSet: hiddenSetSpecifier 

"Remove the specified object to a GCI hidden set, where
   hiddenSetSpecifier = 39  specifies PureExportSet
   hiddenSetSpecifier = 40  specifies GciTrackedObjs .
 Other values of hiddenSetSpecifier are not allowed.
 Has no effect if anObject is a special object.

 If hiddenSetSpecifier = 39 and a userAction is 
 active an error is generated, since the PureExportSet
 cannot be modified from within a user action.

 If hiddenSetSpecifier = 40  and you have not
 executed  _gciDirtyInit:23 once since login,
 generates an error."

<primitive: 157>
hiddenSetSpecifier _validateClass: SmallInteger .
(hiddenSetSpecifier < 39 _or:[ hiddenSetSpecifier > 40]) ifTrue:[
  hiddenSetSpecifier _error: #rtErrArgOutOfRange
].
self _primitiveFailed: #_remove:fromGciSet: .
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_removeAll: anArray fromGciSet: hiddenSetSpecifier 

"Remove contents of anArray to a GCI hidden set, where
   hiddenSetSpecifier = 39  specifies PureExportSet
   hiddenSetSpecifier = 40  specifies GciTrackedObjs .
 Other values of hiddenSetSpecifier are not allowed.

 If the argument anArray == true, all objects in
 the specified set are removed from that set .

 If hiddenSetSpecifier = 39 and a userAction is 
 active an error is generated, since the PureExportSet
 cannot be modified from within a user action.

 If hiddenSetSpecifier = 40  and you have not
 executed  _gciDirtyInit:23 once since login,
 generates an error."

<primitive: 158>
hiddenSetSpecifier _validateClass: SmallInteger .
(hiddenSetSpecifier < 39 _or:[ hiddenSetSpecifier > 40]) ifTrue:[
  hiddenSetSpecifier _error: #rtErrArgOutOfRange
].
anArray _validateClass: Array .
self _primitiveFailed: #_removeAll:fromGciSet: .
self _uncontinuableError
%

category: 'Hidden Set Support'
classmethod: System
_gciDirtyInit: hiddenSetSpecifier

"Enable GCI tracking of dirty objects.
   hiddenSetSpecifier = 22, equivalent to GciDirtyObjsInit()
   hiddenSetSpecifier = 23, equivalent GciTrackedObjsInit()
 Other values of hiddenSetSpecifier are not allowed."

<primitive: 164>
hiddenSetSpecifier _validateClass: SmallInteger .
(hiddenSetSpecifier < 22 _or:[ hiddenSetSpecifier > 23]) ifTrue:[
  hiddenSetSpecifier _error: #rtErrArgOutOfRange
].
self _primitiveFailed: #_gciDirtyInit: .
self _uncontinuableError
%


category: 'Hidden Set Support'
classmethod: System
_getAndClearGciDirtySet: hiddenSetSpecifier into: anArray

"Destructively enumerate a GCI hidden set, where
   anInt = 22  specifies ExportedDirtyObjs
   anInt = 23  specifies TrackedDirtyObjs .
 Other values of hiddenSetSpecifier are not allowed .

 Corresponding _gciDirtyInit: must have been sent once during the session
 before this method can be used.  It is intended that either this
 method or Gci calls be used to enumerate these hidden sets, not
 both within one session.  

 If the specified set is empty the result is nil.
 Otherwise the result is an Array containing up to the first 2034 elements 
 of the hidden set, and those element are cleared from the hidden 
 set prior to return from the primitive.   If the set contains
 more than 2034 elements, repeated invocation of this method
 is needed to enumerate the set completely.

 anArray may be nil in which case the result is a newly created Array.
 If anArray is non-nil it is used as the result and is grown as needed.

 For most efficient enumeration use this style:
   [ | arr |
     arr := self _getAndClearGciDirtySet:22 into: arr .
     1 to: arr size do:[:j | |aDirtyObj|
       aDirtyObj := arr at: j .
       aDirtyObj applicationHandleDirtyObj  .
     ].
     arr size == 0 .
   ] untilTrue .
 "

<primitive: 162>
hiddenSetSpecifier _validateClass: SmallInteger .
(hiddenSetSpecifier < 22 _or:[ hiddenSetSpecifier > 23]) ifTrue:[
  hiddenSetSpecifier _error: #rtErrArgOutOfRange
].
anArray ~~ nil ifTrue:[ anArray _validateClass: Array ].
self _primitiveFailed: #_getAndClearGciDirtySet: .
self _uncontinuableError
%



! fixed 13750
category: 'Lock Status'
classmethod: System
myLockKind: anObject

"Returns a Symbol that indicates what kind of lock the current session has on
 anObject: one of #none, #read or #write."

| status |
status := self lockStatus: anObject.
( (status at: 1) ~~ #none _and:
[ (status at: 2) includesIdentical: self session] )
  ifTrue: [ ^status at: 1 ].

^#none
%

! fix 31161
category: 'Indexing Support'
classmethod: System
_disableProtectedMode
 
"Disables the execution of protected methods."
 
"i.e, exit protected mode."
" Was primitive 174, now a special selector optimized by the compiler. This
  method is so perform will work."
 
self _disableProtectedMode
%

category: 'Runtime Configuration Access'
classmethod: System
configurationAt: aName put: aValue

"Change the value of the specified configuration parameter.  

 The changeable parameters all require aValue to be a SmallInteger.

 Configuration parameters should not be changed unless there is a clear
 reason for doing so, since incorrect settings of parameters can
 have serious adverse effects on GemStone performance.

 Configuration parameters for Stone that are transferred to Gem processes
 are only read by the Gem at login, so changes using this method to
 Stone parameters may have no effect on existing sessions.

 Parameters in the Gem with the following names may be changed by any user at
 any time:

   * #GemIOLimit
   * #GemFreeFrameLimit
   * #GemPgsvrUpdateCacheOnRead

 Parameters in the Gem with the following names may be changed only by users
 who have the correct privilege and who follow any other restrictions:

   * #StnLoginsSuspended - Requires SystemControl privilege.
   * #StnLogLoginFailureLimit - Requires OtherPassword privilege.
   * #StnLogLoginFailureTimeLimit - Requires OtherPassword privilege.
   * #StnDisableLoginFailureLimit - Requires OtherPassword privilege.
   * #StnDisableLoginFailureTimeLimit - Requires OtherPassword privilege.
   * #StnNumGcReclaimSessions - Requires GarbageCollection privilege.
   * #StnAdminGcSessionEnabled - Requires GarbageCollection privilege.

   * #StnSignalAbortCrBacklog - Requires GarbageCollection privilege, 
	and minimum value is 2 .

 All other parameters in the Gem that are changeable at run time may be changed
 only by SystemUser, and should not be changed in the course of normal GemStone
 operation."

| cfgId |

cfgId := ConfigurationParameterDict at: aName .
self _atConfigId: cfgId put: aValue .
^ self configurationAt: aName
%

category: 'Runtime Configuration Access'
classmethod: System
_atConfigId: rtConfigId put: aValue

"Change the specified Stone runtime configuration parameter.  The current user
 must be SystemUser to set any configuration parameter except the parameters
 
 Changing a runtime parameter does not alter the configuration file.
 The new value will show up in the result of configuration report methods, 
 but will not be used when Stone next starts up."

<primitive: 355>
rtConfigId _validateClass: SmallInteger .
aValue _validateClass: SmallInteger .
(self _configParameterName: rtConfigId kind: $C ) == nil 
   ifTrue:[ rtConfigId _error: #rtErrArgOutOfRange ].
rtConfigId >= 0 ifTrue:[ 
  (self _configParameterName: rtConfigId kind: $C ) _error: #rtErrConfigReadOnly
  ].
   
self _primitiveFailed: #_atConfigId:put: .
self _uncontinuableError
%

category: 'Configuration File Access'
classmethod: System
_configParameterName: anInt kind: aChar

"Returns a String, which is the name of the configuration parameter whose
 internal identifier is anInt.  Returns nil if anInt is out of range.

 aChar must be one of
   $C - anInt is identifier of a configuration parameter
   $V - anInt is identifier of a version information item
"

<primitive: 342>
anInt _validateClass: SmallInteger .
^ self _primitiveFailed: #_configParameterName:kind:
%

category: 'Configuration File Access'
classmethod: System
_configFileParameterDict

"Returns a Dictionary of names for configuration file parameters.  The
 dictionary keys are Symbols.  Its values are SmallInteger configuration IDs."

| result cfgId cfgName |
result := SymbolKeyValueDictionary new .
cfgId := 0 .
[
  cfgName := self _configParameterName: cfgId kind: $C .
  cfgName == nil ifFalse:[
    result at: cfgName put: cfgId .
    cfgId := cfgId + 1 .
    ] .
  cfgName == nil 
  ] untilTrue .

cfgId := -1 .
[
  cfgName := self _configParameterName: cfgId kind: $C .
  cfgName == nil ifFalse:[
    result at: cfgName put: cfgId .
    cfgId := cfgId - 1 .
    ] .
  cfgName == nil 
  ] untilTrue .

^ result
%

! fixed 31813
category: 'Configuration File Access'
classmethod: System
_configConstantsDict

"Returns a Dictionary of internal configuration constants that
 are fixed at compilation of the gem and stone executables. The dictionary
 keys are Strings.  Its values are SmallInteger configuration constants."


| anArray result |
anArray := self _zeroArgCateg2Prim: 8 .
result := StringKeyValueDictionary new .
1 to: anArray size do:[ :j | | anAssoc |
  anAssoc := anArray at: j .
  result add: anAssoc .
  ].
^ result
%

category: 'Configuration File Access'
classmethod: System
gemConfigurationReport

"Returns a SymbolDictionary whose keys are the names of configuration file
 parameters, and whose values are the current settings of those parameters in
 the current session's Gem process.  Parameters that are not applicable to Gem
 and those that are undefined are not included in the result."

^ self _configurationReport: false 
%

category: 'Configuration File Access'
classmethod: System
stoneConfigurationReport

"Returns a SymbolDictionary whose keys are the names of configuration file
 parameters, and whose values are the current settings of those parameters in
 the repository monitor process (Stone).  Parameters that are not applicable to
 Stone and those that are undefined are not include in the result." 

^ self _configurationReport: true 
%

category: 'Configuration File Access'
classmethod: System
_configurationReport: isStone

"Private."

| result |
result := SymbolDictionary new .
ConfigurationParameterDict keysAndValuesDo:[ :aName :anId | | aVal |
  aVal := self _configurationAt: anId isStone: isStone kind: $C .
  aVal ~~ nil ifTrue:[ 
    result at: aName put: aVal
    ].
  ].
^ result 
%

category: 'Configuration File Access'
classmethod: System
configurationAt: aName 

"Returns the value of the specified configuration file parameter, giving
 preference to the Gem process if the parameter applies to the Gem."
 
| result |
result := self gemConfigurationAt: aName .
result == nil ifTrue:[
  result := self stoneConfigurationAt: aName
  ].
^ result
%

category: 'Configuration File Access'
classmethod: System
stoneConfigurationAt: aName

"Returns the value of the specified configuration file parameter from the
 repository monitor process (Stone).  Returns nil if that parameter is not
 applicable to the Stone."

| cfgId |
cfgId := ConfigurationParameterDict at: aName otherwise: nil .
cfgId == nil ifTrue:[ ^ nil ].
^ self _configurationAt: cfgId isStone: true kind: $C
%

category: 'Configuration File Access'
classmethod: System
stoneConfigurationAt: aName put: aValue

"Changes the value of the specified Stone configuration parameter.

 See comments in the method configurationAt:put: for complete documentation."

^ self configurationAt: aName put: aValue
%

category: 'Runtime Configuration Access'
classmethod: System
gemConfigurationAt: aName put: aValue

"Changes the value of the specified Gem configuration parameter.  

 See comments in the method configurationAt:put: for complete documentation."

^ self configurationAt: aName put: aValue
%

!  removeGemLogOnExit: added to fix 32245
category: 'Runtime Configuration Access'
classmethod: System
removeGemLogOnExit: aBoolean

"Set state in a gem process that overrides the state of the
 GEMSTONE_CHILD_LOG environment variable. See $GEMSTONE/sys/gemnetdebug
 for documentation on GEMSTONE_CHILD_LOG .

 If aBoolean is true, the gem log file will be deleted if the
 gem process exits normally. If aBoolean is false, the
 the gem log file will not be deleted .

 Has no effect in a linked session"

<primitive: 554>
aBoolean _validateClass: Boolean .
^self _primitiveFailed: #removeGemLogOnExit:
%

category: 'Configuration File Access'
classmethod: System
gemConfigurationAt: aName

"Returns the value of the specified configuration file parameter from the
 current session.  Returns nil if that parameter is not applicable to a Gem."

| cfgId |
cfgId := ConfigurationParameterDict at: aName otherwise: nil .
cfgId == nil ifTrue:[ ^ nil ].
^ self _configurationAt: cfgId isStone: false kind: $C
%

category: 'Configuration File Access'
classmethod: System
_configurationAt: cfgId isStone: aBool kind: aKind

"Returns the configuration value specified. If aBool is true, get the
 configuration value from the Stone process, otherwise from the current
 session.

 cfgId must be a SmallInteger; if >= 0, returns the value of the specified
 configuration parameter;  if < 0, returns the value of the specified
 runtime control parameter.

 aKind must be either $C (for configuration info) or $V (for version info)"

<primitive: 338>
aBool _validateClass: Boolean .
cfgId _validateClass: SmallInteger .
aKind == $C ifTrue:[
  ConfigurationParameterDict keyAtValue: cfgId ifAbsent:[
     cfgId _error: #rtErrArgOutOfRange
     ].
  ]
  ifFalse:[
  VersionParameterDict keyAtValue: cfgId ifAbsent:[
     cfgId _error: #rtErrArgOutOfRange
     ].
  ].
self _primitiveFailed: #_configurationAt:isStone:kind: .
self _uncontinuableError
%

! _resolveSym: deleted

! fixed 13750
category: 'Releasing Locks'
classmethod: System
addToCommitReleaseLocksSet: anObject

"Add anObject to the commit release locks set.  If anObject is not locked 
 by the current session, then it is not added to the set."

((self myLockKind: anObject) == #none )
  ifFalse: [self _add: anObject to: 29.].
^self
%

category: 'Releasing Locks'
classmethod: System
addAllToCommitReleaseLocksSet: aCollection

"Add each element of aCollection to the commit release locks set.  If an
 element of aCollection is not locked by the current session, then that
 element is not added to the set."

aCollection do: [:each | self addToCommitReleaseLocksSet: each ].
^self
%

! fixed 13750
category: 'Releasing Locks'
classmethod: System
addToCommitOrAbortReleaseLocksSet: anObject

"Add anObject to to the commit-or-abort release locks set.  If anObject
 is not locked by the current session, then it is not added to the set."

((self myLockKind: anObject) == #none )
  ifFalse: [self _add: anObject to: 30.].
^self
%

category: 'Releasing Locks'
classmethod: System
addAllToCommitOrAbortReleaseLocksSet: aCollection

"Add each element of aCollection to the commit-or-abort release locks set. 
 If an element of aCollection is not locked by the current session, then
 it is not added to the set."

aCollection do: [:each | self addToCommitOrAbortReleaseLocksSet: each ].
^self
%

category: 'Releasing Locks'
classmethod: System
clearCommitReleaseLocksSet

"Remove all objects from the commit release locks set."

self _hiddenSetReinit: 29.
^self
%

category: 'Releasing Locks'
classmethod: System
clearCommitOrAbortReleaseLocksSet

"Remove all objects from the commit-or-abort release locks set."

self _hiddenSetReinit: 30.
^self
%

category: 'Releasing Locks'
classmethod: System
commitReleaseLocksSetIncludes: anObject

"Returns true if anObject is in the commit release locks set. 
 Returns false otherwise."

^self _testIf: anObject isIn: 29
%

category: 'Releasing Locks'
classmethod: System
commitOrAbortReleaseLocksSetIncludes: anObject

"Returns true if anObject is in the commit-or-abort release locks set.
 Returns false otherwise."

^self _testIf: anObject isIn: 30
%

category: 'Releasing Locks'
classmethod: System
removeFromCommitReleaseLocksSet: anObject

"Remove anObject from the commit release locks set.  If anObject is 
 not a member of the set, do nothing."

self _remove: anObject from: 29.
%

category: 'Releasing Locks'
classmethod: System
removeAllFromCommitReleaseLocksSet: aCollection

"Remove all elements of aCollection from the commit release locks set.
 If an element of aCollection is not a member of the set, it is ignored."

aCollection do: [:each | self removeFromCommitReleaseLocksSet: each ].
^self
%

category: 'Releasing Locks'
classmethod: System
removeFromCommitOrAbortReleaseLocksSet: anObject

"Remove anObject from the commit-or-abort release locks set.  If anObject
 is not a member of the set, do nothing."

self _remove: anObject from: 30.
%

category: 'Releasing Locks'
classmethod: System
removeAllFromCommitOrAbortReleaseLocksSet: aCollection

"Remove all the elements of aCollection from the commit-or-abort release
 locks set.  If an element of aCollection is not a member of the set,
 it is ignored."

aCollection do: [:each | self removeFromCommitOrAbortReleaseLocksSet: each ].
^self
%

category: 'Environment Access'
classmethod: System
stoneName

"Returns a Symbol whose value is the full network name of the
 Stone to which this session is logged in."

^ self _zeroArgPrim: 11
%

category: 'Environment Access'
classmethod: System
sessionPerformingBackup

"Returns the session ID of the session that is performing a backup.
 If there is no such session, returns -1."

^ self configurationAt: #SessionInBackup
%

! Deleted:  _obj: anObject isIdenticalTo: anotherObject

! _enableTraceObjs deleted
! _disableTraceObjs deleted
! deleted _markNotConnectedForCollection


category: 'Shared Counters'
classmethod: System
_sharedCounter: n setValue: i

"Shared counters provide a means for multiple sessions on the same host
 to share a common counter value (for creation of unique keys, etc.).
 The number of shared counters is determined by the configuration file
 parameter SHR_PAGE_CACHE_NUM_SHARED_COUNTERS, which has a default of 1900.
 Use the #_numSharedCounters method to determine how many shared counters
 are available on this shared page cache.
 
 Each shared counter is protected with a unique spinlock.

 This method initializes one of the counters (in the range 0 to
 [System _numSharedCounters - 1]) to the  specified value i and 
 returns the receiver.  Both n and i must be positive SmallInteger instances."

<primitive: 350>
n _validateClass: SmallInteger.
i _validateClass: SmallInteger.
(n < 0 _or:[ n >= self _numSharedCounters])
  ifTrue:[n _error: #rtErrArgOutOfRange .] .
(i < 0)
  ifTrue:[i _error: #rtErrArgOutOfRange .] .
self _primitiveFailed: #_sharedCounter:value: .
%

category: 'Shared Counters'
classmethod: System
_sharedCounter: n incrementBy: i

"Shared counters provide a means for multiple sessions on the same host
 to share a common counter value (for creation of unique keys, etc.).
 The number of shared counters is determined by the configuration file
 parameter SHR_PAGE_CACHE_NUM_SHARED_COUNTERS, which has a default of 1900.
 Use the #_numSharedCounters method to determine how many shared counters
 are available on this shared page cache.
 
 Each shared counter is protected with a unique spinlock.

 This method increments one of the counters (in the range 0 to
 [System _numSharedCounters - 1]) by the  specified value i and 
 returns the result.  Both n and i must be positive SmallInteger instances.

 The maximum value of any shared counter is INT_MAX - 1 (2**31 - 1).
 Any attempt to increment a counter larger than this value will result
 in the counter being set to its maximum value."

<primitive: 354>
n _validateClass: SmallInteger.
i _validateClass: SmallInteger.
(n < 0 _or:[ n >= self _numSharedCounters])
  ifTrue:[n _error: #rtErrArgOutOfRange .] .
(i < 0)
  ifTrue:[i _error: #rtErrArgOutOfRange .] .
self _primitiveFailed: #_sharedCounter:incrementBy: .
%

! Request 34022
category: 'Shared Counters'
classmethod: System
_sharedCounter: n decrementBy: i withFloor: f

"Shared counters provide a means for multiple sessions on the same host
 to share a common counter value (for creation of unique keys, etc.).
 The number of shared counters is determined by the configuration file
 parameter SHR_PAGE_CACHE_NUM_SHARED_COUNTERS, which has a default of 1900.
 Use the #_numSharedCounters method to determine how many shared counters
 are available on this shared page cache.

 This method decrements one of the counters (in the range 0 to
 [System _numSharedCounters - 1]) by the  specified value i and 
 returns the result.  Both n and i must be positive SmallInteger instances.
  
 f specifies the minimum final value of the shared counter.  Specifying a floor
 of nil means the minimum value is INT_MIN (-2**31), which is the lowest 
 possible value for any shared counter.  Attempting to decrement any counter
 to a final value less than f will set the counter to floor value f."

<primitive: 551>
n _validateClass: SmallInteger.
i _validateClass: SmallInteger.
(f == nil)
  ifFalse:[f _validateClass: SmallInteger].
(n < 0 _or:[ n >= self _numSharedCounters])
  ifTrue:[n _error: #rtErrArgOutOfRange .] .
(i < 0)
  ifTrue:[i _error: #rtErrArgOutOfRange .] .
self _primitiveFailed: #_sharedCounter:decrementBy:withFloor: .
%

category: 'Shared Counters'
classmethod: System
_numSharedCounters
"Shared counters provide a means for multiple sessions on the same host
 to share a common counter value (for creation of unique keys, etc.).
 The number of shared counters is determined by the configuration file
 parameter SHR_PAGE_CACHE_NUM_SHARED_COUNTERS, which has a default of 1900.

 Answer the number of shared counters configured on this sessions
 shared page cache (SHR_PAGE_CACHE_NUM_SHARED_COUNTERS in the configuration
 file used to the shared page cache)."

  ^self _zeroArgPrim: 100
%

category: 'Debugging'
classmethod: System
_setPrintStackAtError
  "Set a flag in the VM so that a gem process will print error information
   and a Smalltalk stack to the gem log file when any error is generated."

  self _zeroArgPrim:102
%

category: 'Shared Counters'
classmethod: System
_sharedCounterFetchValuesFrom: firstCounter to: lastCounter
"Shared counters provide a means for multiple sessions on the same host
 to share a common counter value (for creation of unique keys, etc.).
 The number of shared counters is determined by the configuration file
 parameter SHR_PAGE_CACHE_NUM_SHARED_COUNTERS, which has a default of 1900.

 Returns an array containing the values from all shared counters starting
 with the counter at index firstCounter, up to and including the value
 from the counter lastCounter.

 It is an error if firstCounter is greater than lastCounter or if
 either value is less than 1.  It is also an error if lastCounter
 is greater than the total number of counters configured (see
 the #_numSharedCounters method to determine this value)."

<primitive: 589>
firstCounter _validateClass: SmallInteger.
lastCounter _validateClass: SmallInteger.
(firstCounter < 0 _or:[ firstCounter > lastCounter])
  ifTrue:[firstCounter _error: #rtErrArgOutOfRange .] .
(lastCounter < 0 _or:[ lastCounter >= self _numSharedCounters])
  ifTrue:[lastCounter _error: #rtErrArgOutOfRange .].
self _primitiveFailed: #_sharedCounterFetchValuesFrom:to: .
%

category: 'Environment Access'
classmethod: System
gemEnvironmentVariable: varName

"Expands the environment variable named varName in the Gem
 process, returning a String. varName should be a kind of String.

 Returns nil if any of the following are true:

 * varName is not a byte format object.
 * There is no environment variable defined with name varName.
 * The value of the environment variable is more than approximately 8000 bytes.
 * The size of varName exceeds approximately 8000 bytes.
 * The NoGsFileOnServer privilege is set in the UserProfile.
"

(System myUserProfile _privileges bitAnd: 16r4000) = 0 ifTrue:[
 ^ GsFile _expandEnvVariable: varName isClient: false
] ifFalse:[
  ^ nil  "NoGsFileOnServer bit is set"
]
%

category: 'Environment Access'
classmethod: System
clientEnvironmentVariable: varName

"Expands the environment variable named varName in the GemBuilder for C client
 process, returning a String.  The varName argument should be a kind of String.

 Returns nil if any of the following are true:

 * varName is not a byte format object.
 * There is no environment variable defined with name varName.
 * The value of the environment variable is more than approximately 8000 bytes.
 * The size of varName exceeds approximately 8000 bytes.
 * The NoGsFileOnClient privilege is set in the UserProfile.
 "

(System myUserProfile _privileges bitAnd: 16r8000) = 0 ifTrue:[
  ^ GsFile _expandEnvVariable: varName isClient: true
] ifFalse:[
  ^ nil  "NoGsFileOnClient bit is set"
]
%

category: 'Private'
classmethod: System
_hostCallDebugger

"Private."

"For debugging.  Allows GemStone Smalltalk access to HostCallDebugger which
 causes a core dump in customer executables and sleeps in non-customer
 executables."

^ self _zeroArgPrim: 25
%

category: 'Private'
classmethod: System
_prepareToCommit

"This is a placeholder for the implementation of voting in a two-phase commit
 protocol.  The current implementation uses 'hasConflicts' to return
 whether the current transaction could commit at this exact point in time;
 however, this does not guarantee that concurrent transactions do not commit
 changes that can cause later attempts to commit to fail.

 Note: See the comment for GsCurrentSession | hasConflicts to get a description of
 the side-effects of hasConflicts."

^ GsSession currentSession hasConflicts not
%

category: 'Private'
classmethod: System
_committedDataPages

"Returns an Array of the committed data pages referenced from the session's
 view of GemStone.  The contents of this Array are invalid after the next
 commit or abort."

^ self _zeroArgCateg2Prim: 10
%

category: 'Private'
classmethod: System
_uncommittedDataPages

"Returns an Array of the data pages referenced from the session's shadowed
 view of GemStone.  After the next commit or abort, the contents of this
 Array are invalid and may be incomplete.  That is, very shortly after the
 commit or abort operation, they may not show all data pages, because more pages
 may be added by the currently running methods.  However, it might be useful to
 check on modified objects (in particular, reclustering) before the transaction
 commits."

^ self _zeroArgCateg2Prim: 11
%

category: 'System Control'
classmethod: System
addAllToStoneLog: aString

"Appends text to the Stone's informational log file.  First, this method writes
 a banner that identifies the session from which aString came.  It then appends
 aString itself.  The argument must be a kind of String or DoubleByteString."

| logicalSize chunkSize offset endOffset |

aString basicSize <= 16272 "virtual machine constant" ifTrue:[
  ^ self _addAllToStoneLog: aString 
  ].
aString _validateClasses:#[ String, DoubleByteString].
logicalSize := aString size .
chunkSize := 16272 "virtual machine constant" .
(aString isKindOf: DoubleByteString) ifTrue:[ chunkSize := 16272 / 2 ].
 
offset := 1.
[offset <= logicalSize] whileTrue:[
  endOffset := offset + chunkSize - 1 .
  endOffset > logicalSize ifTrue:[ endOffset := logicalSize ].
  self _addAllToStoneLog: (aString copyFrom: offset to: endOffset).
  offset := offset + chunkSize
  ].
% 

category: 'System Control'
classmethod: System
_addAllToStoneLog: aString

"Appends text to the Stone's informational log file.  First, this method writes
 a banner that identifies the session from which aString came.  It then appends
 aString itself.  The argument must be a kind of String or DoubleByteString.

 Generates an error if aString is larger than approximately 16000 bytes."

<primitive: 463>

aString _validateClasses:#[ String, DoubleByteString].
self _primitiveFailed: #addAllToStoneLog:
%

category: 'Private'
classmethod: System
changeCacheSlotIoLimit: aSlot to: aValue

"Changes the ioLimit for the process associated with a cache slot to aValue,
 which must be in the range of 1 to 5000 I/Os per second.  The argument aSlot
 should be a SmallInteger between 0 and the number of process slots in the
 shared cache minus 1, inclusive. 

 To execute this method, you must have the SystemControl privilege."

<primitive: 464>

aSlot _validateClasses:#[SmallInteger].
aValue _validateClasses:#[SmallInteger].
self _primitiveFailed: #changeCacheSlotIoLimit:
%
category: 'Private'
classmethod: System
changeCacheSlotFreeFrameLimit: aSlot to: aValue

"Changes the freeFrameLimit for the process associated with a cache slot to 
 aValue, which must be a positive SmallInteger.  The argument aSlot
 should be a SmallInteger between 0 and the number of process slots in the
 shared cache minus 1, inclusive. 

 To execute this method, you must have the SystemControl privilege."

<primitive: 349>

aSlot _validateClasses:#[SmallInteger].
aValue _validateClasses:#[SmallInteger].
self _primitiveFailed: #changeCacheSlotFreeFrameLimit:to:
%

category: 'Private'
classmethod: System
_commitCoordinator

"Returns the commit coordinator stored in temporary session state."

^ self _sessionStateAt: 14
%

category: 'Private'
classmethod: System
_commitCoordinator: aCoordinator

"Sets the commit coordinator stored in temporary session state."

^ self _sessionStateAt: 14 put: aCoordinator
%

category: 'Private'
classmethod: System
_clearAttachedPages

"Detaches the data pages currently attached."

^ self _zeroArgPrim: 28
%

! deleted _flushConnectedToPom

category: 'Private'
classmethod: System
_internalMessageForErrorNum: aNumber 

"Private.  Returns a String describing the error message generated from the
 errmsg.c module for GemStone error numbered aNumber.  Returns nil if no such
 error number or message exists in errmsg.c."

<primitive: 384>
aNumber _validateClass: SmallInteger .
self _primitiveFailed: #_internalMessageForErrorNum:
%

category: 'Private'
classmethod: System
_messageForErrorNum: aNumber 

"Private.  Returns a String describing the error message produced for GemStone 
 error numbered aNumber in native language English, or nil if no such error
 number or language exists."

^ self _messageForErrorNum: aNumber inLanguage: #English
%

category: 'Private'
classmethod: System
_messageForErrorNum: aNumber inLanguage: aSymbol

"Private.  Returns a String describing the error message produced for GemStone 
 error numbered aNumber in native language aSymbol, or nil if no such error
 number or language exists."

 | errArray msgParts result |

 errArray := GemStoneError at: aSymbol otherwise: nil . 
 errArray == nil ifTrue:[ ^ nil ].
 (aNumber < 1 _or:[ aNumber > errArray size]) ifTrue:[ ^ nil ].
 msgParts := errArray at: aNumber .
 msgParts == nil ifTrue:[ ^ nil ].
 result := String new .
 1 to: msgParts size do:[:j | | element |
   element := msgParts at: j .
   element _isSmallInteger 
     ifTrue:[ result addAll: '<arg'; addAll: element asString; add: $> ] 
    ifFalse:[ result addAll: element ].
   ].
 ^ result 
%

category: 'Private'
classmethod: System
_allErrorMessagesReport

"Private."

| errorSymbolsArray symsWithNoMsg msgsWithNoSym report lf line errMsgsArray 
  firstNil last j |

errorSymbolsArray  := Array new .
ErrorSymbols keysAndValuesDo:[:aSym :aNum |
  aNum > errorSymbolsArray size ifTrue:[ errorSymbolsArray size: aNum ].
  (errorSymbolsArray at: aNum) ~~ nil ifTrue:[
    self _halt:'Duplicate symbol for error number ' , aNum asString .
    ].
  errorSymbolsArray at: aNum put: aSym .
  ].
errMsgsArray := GemStoneError at: #English .

msgsWithNoSym := String new .
symsWithNoMsg := String new .
report := String new .
lf := Character lf .

report addAll:'ERROR MESSAGES STORED IN THE REPOSITORY:'; add: lf; add: lf .

1 to: errorSymbolsArray size do:[:j | | aSym msgParts |
  aSym := errorSymbolsArray at: j .
  msgParts := errMsgsArray at: j .
  aSym == nil ifTrue:[
    msgParts ~~ nil ifTrue:[
       msgsWithNoSym addAll: '*** No error symbol for error number ';
		addAll: j asString; add: lf .
       ]
    ]
  ifFalse:[
    msgParts == nil ifTrue:[
       symsWithNoMsg addAll: '*** No message for error symbol #';
		addAll: aSym quoted; add: lf .
       ]
    ifFalse:[
       line := j asString. 
       line addAll: ', #' ; addAll: aSym; addAll: ' :  ' ;
            addAll: (self _messageForErrorNum: j)  .
       report addAll: (line _wrapTo: 80 indentingWith: '    '); add: lf .
       ]
    ].
  ].

report add: lf .
report addAll:
'ERROR MESSAGES FROM errmsg.c, TEXT FROM errmsg.ht '; add: lf ;
addAll: '  (Repository message followed by errmsg.ht message, if any)'; add: lf;
add: lf .

1 to: errorSymbolsArray size do:[:j | | aSym internalMsg msgFN |
  aSym := errorSymbolsArray at: j .
  aSym ~~ nil ifTrue:[
    internalMsg := self _internalMessageForErrorNum: j .
    internalMsg ~~ nil ifTrue:[
      msgFN := self _messageForErrorNum: j .
      msgFN == nil ifTrue:[ msgFN := 'NO MESSAGE FOR NUMBER ' , j asString ].
      line := j asString. 
      line addAll: ', #' ; addAll: aSym; addAll: ' :  ' ;
           addAll: msgFN ; add: lf ;
           addAll: internalMsg .
      report addAll: (line _wrapTo: 80 indentingWith: '    '); add: lf; add: lf.
      ].
    ].
  ].

report add: lf ; addAll:'UNUSED ERROR NUMBERS:'; add: lf .

firstNil := 1 .
j := 1.
last := errorSymbolsArray size .
[j < last] whileTrue:[
  [ (errorSymbolsArray at: j) == nil _and:[j < last] ] whileTrue:[ j := j + 1 ]. 
  j > firstNil ifTrue:[
    report addAll: firstNil asString ; addAll: ' to: '; 
		addAll: (j - 1) asString; add: lf .
    ]
  ifFalse:[
    report addAll: firstNil asString; add: lf .
    ].
  firstNil := nil . 
  [ (errorSymbolsArray at: j) ~~ nil _and:[j < last] ] whileTrue:[ j := j + 1 ]. 
  firstNil := j .
  ].

report add: lf .
msgsWithNoSym size > 0 
  ifTrue:[ report addAll: msgsWithNoSym ]
  ifFalse:[ report addAll:'No messages found without an error symbol.'].
report add: lf .
symsWithNoMsg size > 0 
  ifTrue:[ report addAll: symsWithNoMsg ]
  ifFalse:[ report addAll: 'No error symbols found without a message.'].
report add: lf .
^ report
%

category: 'Private'
classmethod: System
_commitResult

"Private.  Returns a SmallInteger which represents the result of the last 
 commitTransaction or continueTransaction operation.  If abortTransaction was 
 issued since the last commit or continue then it returns SmallInteger 0.  

 See   _primitiveCommit:  for documentation of the return values."

^ self _zeroArgPrim: 30
%

category: 'Private'
classmethod: System
_deadNotReclaimed

"Private.  Returns an Array that contains the current contents of the 
 global set of objects which have been identified as dead but have not 
 yet been reclaimed. Before accessing this set, the user should disable
 the reclaiming of dead (set reclaimDeadEnabled in GcUser's UserGlobals to 
 false).  The user should be sure to reset the size of the Array returned
 to zero when done analyzing the dead objects before re-enabling the
 reclaiming of dead objects."

^ self _zeroArgPrim: 31
%

category: 'Transaction Control'
classmethod: System
needsCommit

"Returns true if the session has made changes to the repository.  Returns false
 otherwise."

^ self _numPersistentObjsModified > 0
%

category: 'Transaction Control'
classmethod: System
_numPersistentObjsModified

"Returns number of persistent objects modified during current transaction. 
 Includes number of objects added/removed to/from depMap."

^ self _zeroArgPrim: 54
%

category: 'Reduced Conflict Support'
classmethod: System
_getRedoAndConflictObjects

"Builds a list of objects that need to be scanned because they need to
 have conflicts resolved.  If the result array is empty, then the transaction
 has conflicts that cannot be resolved because we should only get here if
 some Rc conflicts have been detected."
          
| wwConflicts scanArray redoLog |
     
	" Gs64 v2.0 optimization, access the hidden sets directly 
  	instead of computing complete transaction conflicts info."

" if there are read-write and write-read conflicts, we cannot resolve them "
"check for #'Read-Write' , i.e. strongRead-write conflicts "
(self _hiddenSetSize: 13) > 0 ifTrue:[
  "cannot resolve strongRead-write conflicts. The Read-Write conflict
   has already had RcReadSet subtracted from it by the commit primitive."
  ^ nil  
].
" check for #'Write-Dependency' conflicts"
(self _hiddenSetSize: 16) > 0 ifTrue:[
  "cannot resolve write-depencency conflicts. "
  ^ nil  
].

wwConflicts := self _hiddenSetAsArray: 15. "get #'Write-Write' conflicts"
wwConflicts size == 0 ifTrue: [ 
  "expected to find write-write conflicts to resolve, so fail"
  ^ nil 
].
              
scanArray := Array new.  "expect this be relatively small"

redoLog := self _redoLog.

" make an initial scan to gather objects to be replayed "
redoLog == nil ifTrue: [
  " no redo log, treat objects themselves as the one on which conflicts
        must be resolved "
  1 to: wwConflicts size do: [ :i | | conflictObject |
    conflictObject := wwConflicts at: i.
    (scanArray includesIdentical: conflictObject) ifFalse: [ 
	scanArray add: conflictObject ; add: #[ conflictObject ].
    ].
  ].
] ifFalse: [
  1 to: wwConflicts size do: [ :i | | conflictObject redoObject |
    conflictObject := wwConflicts at: i.
  
    " get the object that has to be replayed due to this conflict "
    redoObject := redoLog getRedoObjectForConflictingObject: conflictObject.
    redoObject == nil ifTrue: [
      " no redo object in the redo log, treat the object itself as
	the one on which conflicts must be resolved "
      (scanArray includesIdentical: conflictObject)  ifFalse: [
	scanArray add: conflictObject ; add: #[ conflictObject ].
      ]
    ] ifFalse: [  | idx |
      idx := scanArray _indexOfIdentical: redoObject.
      idx > 0 ifTrue: [ | argArr |
	argArr := scanArray at: idx + 1.
	argArr add: conflictObject.
      ] ifFalse: [
	scanArray add: redoObject ; add: #[ conflictObject ].
      ].
    ].
  ].
].   
     
^ scanArray
%
 
category: 'Reduced Conflict Support'
classmethod: System
_resolveRcConflicts
        
"Checks for selected conflicts.  If some are found, attempt to resolve those
 conflicts.  If any conflicts could not be resolved, returns false."
  
|  scanArray redoObject commitFailed objsToRefresh conflicts |
              
scanArray := self _getRedoAndConflictObjects.
             
scanArray == nil ifTrue: [ 
  "no redo objects were found, cannot resolve conflicts"
  self _disallowSubsequentCommits.
  ^ false 
].
commitFailed := false.
objsToRefresh := Array new.
1 to: scanArray size by: 2 do: [ :i |
  redoObject := scanArray at: i.
  conflicts := scanArray at: i + 1.
              
  " keep list of objects to selectively abort in case of commit failure "
  redoObject _refreshAfterCommitFailure ifTrue: [ 
    objsToRefresh add: redoObject 
  ].
  commitFailed ifFalse: [
    (redoObject _resolveRcConflictsWith: conflicts) ifFalse: [
      self rcValueCacheAt: #'Rc-Write-Write' put: redoObject for: self.
      commitFailed := true.
    ]
  ]
].      

commitFailed ifTrue: [
  " selectively abort objects that might be logically inconsistent "
  1 to: objsToRefresh size do: [ :i |
    (objsToRefresh at: i) _selectiveAbort  
  ].       
  " force subsequent attempts to commit to fail with retry limit error"
  self _disallowSubsequentCommits.
  ^ false
].      

^ true
%

category: 'Private'
classmethod: System
_validateTransaction

" Determine whether the current transaction could commit.

  See   _primitiveCommit:  for documentation of the return values.

  If the result is > 0 , the current transaction cannot commit and
  the transaction conflict hidden sets have
  been updated to reflect the conflicts preventing commit .  "


^ self _zeroArgPrim: 32
%

! added for 31693
category: 'Transaction Control'
classmethod: System
currentTransactionWWConflicts

"Returns an Array of objects which have write-write conflicts.
 The array is created by building the write set union of all
 commit records created since the session's current transaction
 and intersecting it with the session's write set."

 | status conflictDict wwConflicts |
 status := self _validateTransaction .
 status <= 0 ifTrue:[ 
   ^ #()  "read only or empty conflicts"
 ].
 conflictDict := self transactionConflicts .
 wwConflicts := conflictDict at: #'Write-Write' otherwise: #() .
 ^ wwConflicts .
% 

! added for 31693
category: 'Transaction Control'
classmethod: System
currentTransactionHasWWConflicts

"Returns a Boolean indicating if the current transaction has one or
 more write-write conflicts.  A result of true indicates a commit
 will most likely fail.  However some RC objects have conflict
 resolution mechanisms which could allow a commit to suceed.
 A result of false indicates no write-write conflicts exist.

 It is inefficient to invoke this method and then invoke 
 currentTransactionWWConflicts. If you want conflict details, invoke
 currentTransactionWWConflicts directly. 
 "

 ^ self currentTransactionWWConflicts size > 0
%

category: 'Transaction Control'
classmethod: System
currentTransactionWDConflicts

"Returns an Array of objects which have write-dependency conflicts.
 The array is created by building the union of all dependency 
 change sets from all commit records created since the session's 
 current transaction and intersecting it with the session's write 
 set."

 | status conflictDict wdConflicts |
 status := self _validateTransaction .
 status <= 0 ifTrue:[ 
   ^ #()  "read only or empty conflicts"
 ].
 conflictDict := self transactionConflicts .
 wdConflicts := conflictDict at: #'Write-Dependency' otherwise: #() .
 ^ wdConflicts .
% 

category: 'Transaction Control'
classmethod: System
currentTransactionHasWDConflicts

"Returns a Boolean indicating if the current transaction has one or
 more write-depencency conflicts.  A result of true indicates a commit
 will most likely fail.  A result of false indicates no write-dependency 
 conflicts exist.

 It is inefficient to invoke this method and then invoke 
 currentTransactionWDConflicts. If you want conflict details, invoke
 currentTransactionWDConflicts directly. 
 "

 ^ self currentTransactionWDConflicts size > 0
%


Category 'Private'
classmethod: System
_reloginAsUser: aUserId password: aPassword encrypted: aBoolean
       
"Relogin this session with the specified user identification."

<primitive: 495>
aUserId _validateClass: String.
aPassword _validateClass: String.
aBoolean _validateClass: Boolean.
self _primitiveFailed: #_reloginAsUser:password:encrypted:
%

category: 'Private'
classmethod: System
_publish: server port: port log: logname options: optstr
  "Description:
     Publishes information about a server so that the gslist utility
     can display it. The information will be published on the local machine.
   Input:
     server <String>: name of server to publish.
     port <SmallInteger>: port number of server listening socket.
     logname <String or nil>: name of log file or nil if none.
     optstr <String or nil>: startup options or nil if none.
   Result <Boolean>:
     true if publish was successful.
     false if server was already published.
   Exceptions:
     Illegal input raises various errors.
     Error 2367 raised if low level C code fails with system error.
  "

<primitive: 496>
self _primitiveFailed: #_publish:port:log:options:
%

category: 'Private'
classmethod: System
_unpublish: server on: machine
  "Description:
     Unpublishes information about a server on the given machine.
   Input:
     server <String>: name of server to unpublish.
     machine <String or nil>: name of machine to unplubish on or nil if local.
   Result <Boolean>:
     true if unpublish was successful.
     false if server was not published.
   Exceptions:
     Illegal input raises various errors.
     Error 2367 raised if low level C code fails with system error.
  "

<primitive: 497>
self _primitiveFailed: #_unpublish:on:
%

category: 'Private'
classmethod: System
_findPublished: server on: machine
  "Description:
     Find a published server on the given machine.
   Input:
     server <String>: name of server to findunpublish.
     machine <String or nil>: name of machine to find on or nil if local.
   Result <Array or nil>:
     nil if server was not found.
     instance of Array if server was found. The array contents are:
       1. <String>: the name of the server
       2. <SmallInteger>: the port number of ther servers listening socket.
       3. <Integer>: the proces id of the server's main process.
       4. <Boolean>: true if process exists, false if not.
       5. <String>: type of server: 'Stone', 'NetLDI', 'Cache', 'Broker',
                                    'Agent', 'RCPD', 'Service-Stone',
                                    'Service-NetLDI', or '?'.
       6. <String>: name of user that created the server.
       7. <String>: time server was created.
       8. <String>: name of machine server is running on.
       9. <String or nil>: version of GemStone used by server.
       10.<String or nil>: GemStone product directory.
       11.<String or nil>: log file name of server.
       12.<String or nil>: startup options of server.
       13.<String or nil>: GemStone system configuration file used by server.
       14.<String or nil>: GemStone executable configuration file used by server.
   Exceptions:
     Illegal input raises various errors.
     Error 2367 raised if low level C code fails with system error.
  "

<primitive: 498>
self _primitiveFailed: #_findPublished:on:
%

category: 'Private'
classmethod: System
_findAllPublishedOn: machine
  "Description:
     Find all published servers on the given machine.
   Input:
     machine <String or nil>: name of machine to find on or nil if local.
   Result <Array or nil>:
     nil if no servers were found.
     instance of Array that contains one element for each server found.
     Each element will itself be an Array with the contents described
     for the _findPublished:on: method.
   Exceptions:
     Illegal input raises various errors.
     Error 2367 raised if low level C code fails with system error.
  "

<primitive: 499>
self _primitiveFailed: #_findAllPublishedOn:
%

category: 'System Control'
classmethod: System
sendSigAbortToSession: sessionIdOrSerial

"Sends a sigAbort signal to the specified session.
 To execute this method, you must have the SystemControl privilege.

 The sessionIdOrSerial argument is a SmallInteger specifying a session.  A
 positive value is interpreted as a serialNumber.  A negative value is
 interpreted as a negated sessionId."

self _sendTransactionSignal: sessionIdOrSerial kind: 0 
%

category: 'System Control'
classmethod: System
sendSignalFinishTransactionToSession: sessionIdOrSerial

"Sends a FinishTransaction signal to the specified session.
 To execute this method, you must have the SystemControl privilege.

 The sessionIdOrSerial argument is a SmallInteger specifying a session.  A
 positive value is interpreted as a serialNumber.  A negative value is
 interpreted as a negated sessionId."

self _sendTransactionSignal: sessionIdOrSerial kind: 1 
%

category: 'Private'
classMethod: System
_sendTransactionSignal: sessionIdOrSerial kind: aKind

"send a sigAbort or a finishTransaction signal to the specified
 session.  The signal will be ignored if the session has not enabled
 that specific signal. 

 You must have SystemControl privilege .

 aKind == 0 : sigAbort
 aKind == 1 : finishTransaction "

<primitive: 327>
sessionIdOrSerial _validateClasses:#[SmallInteger].
aKind _validateClasses:#[SmallInteger].
self _primitiveFailed: #sendSigAbortToSession:
%

category: 'Private'
classMethod: System
_writeLockWriteSubset

"Start with the object manager dirty list ,
 and perform filtering of objects already locked, putting the results 
 in a new hidden set (writeLockWriteSubset).  Next, attempt to acquire a 
 write lock on the objects in the hidden set.  If all locks are acquired 
 cleanly, return true.  If all locks acquired but some are dirty, return 
 an array of dirty locked objects.  If not all locks could be acquired, 
 return false (locks that were acquired, including dirty locks are available
 in the writeLockWriteSubset hidden set.  Any locks that are acquired are 
 also put in the CommitOrAbortReleaseLocksSet."

^self _zeroArgPrim: 34
%

! deleted _exclusiveLockWriteSubset

category: 'Private'
classMethod: System
_removeLockWriteSubset

"Removes the locks acquired on any objects that were locked using
 _writeLockWriteSubset and empties the hidden set."

^self _zeroArgPrim: 35

%

category: 'Private'
classmethod: System
_cacheName: aString

"Sets the name the current session is known by in the shared cache
 to 'aString'. Does nothing if the current session is not attached
 to a shared cache. Raises an error if 'aString' is too long.
 Returns self."

<primitive: 509>
self _primitiveFailed: #_cacheName:
%

category: 'Private'
classmethod: System
_parseClientNrs: aString

"aString should be the result of reading a request sent to a netldi
 on a socket. A session reading nrs requests from clients can tell
 that a full request has come in by reading until it gets a zero byte.
 This method raises the error #genericKernelError if something is
 wrong with the input.
 Otherwise it returns a 8 element Array with the following contents:
 1  Symbol describing type of client. It will be one of the following:
      #RpcApplication, #Gem, #PageServer, #Stone, #Unknown
 2  Boolean: true if client is trusted.
 3  String: name of user.
 4  Boolean: true if using kerberos.
 5  Symbol describing type of request. It will be one of the following:
      #invalid, #file, #monitor, #server, #task, #spawn, #cmd, #dbf
 6  String: working directory
 7  String: logfile name
 8  String: body of request
"

<primitive: 515>
| syms |
" make sure we don't have to create new symbols at runtime"
syms := #[ #RpcApplication, #Gem, #PageServer, #Stone, #Unknown ,
	#invalid, #file, #monitor, #server, #task, #spawn, #cmd, #dbf] .
self _primitiveFailed: #_parseClientNrs:
%

category: 'Private'
classmethod: System
_reinitializeSharedCache

"This method shuts down the GcGem process and verifies that this session
 is the only one logged in.  If not the only user, then the primitive fails.
 If it is the only user, all attached pages for this session are detached 
 and the cache is swept.  All dirty pages are written.  All remaining 
 unattached pages are removed from the cache and their frames are put back
 in the free list.
 
 Returns self."

^self _zeroArgPrim: 36
%

category: 'Private'
classmethod: System
_ignoreModTracking

"Private. Disables Modification Tracking."

<primitive: 516>
self _primitiveFailed: #_ignoreModTracking
%

category: 'Private'
classmethod: System
_restoreModTracking

"Private. Enables Modification Tracking. 

 Has no effect in this release"

<primitive: 517>
self _primitiveFailed: #_RestoreModTracking
%
category: 'Private'
classmethod: System
_commitPrintingDiagnostics

    "Commits the current transaction. Answers true if successful,
    otherwise false. If false, it also prints to stderr the OOPs for
    each kind of conflict, ordered by kind. This is used in the
    upgrade scripts."

    | conflicts |
    self commitTransaction 
      ifTrue: [^true]
      ifFalse: [ | gsFil |
        gsFil := GsFile .
	conflicts := self transactionConflicts.
	(conflicts at: #commitResult) == #success ifFalse: [
	gsFil gciLogClient: (conflicts at: #commitResult).
	gsFil gciLogClient: 'Read-Write Conflicts...'.
	(conflicts at: #'Read-Write' ifAbsent: [#()]) 
	    do: [ :each | GsFile gciLogClient: '    ', each asOop asString].

	gsFil gciLogClient: 'Write-Write Conflicts...'.
        (conflicts at: #'Write-Write' ifAbsent: [#()]) 
	    do: [ :each | GsFile gciLogClient: '    ', each asOop asString].
	gsFil gciLogClient: 'Write-Dependency Conflicts...'.
        (conflicts at: #'Write-Dependency' ifAbsent: [#()]) 
	    do: [ :each | GsFile gciLogClient: '    ', each asOop asString].
        gsFil gciLogClient: 'Write-ReadLock Conflicts...'.
        (conflicts at: #'Write-ReadLock' ifAbsent: [#()]) 
	    do: [ :each | GsFile gciLogClient: '    ', each asOop asString].
        gsFil gciLogClient: 'Write-WriteLock Conflicts...'.
        (conflicts at: #'Write-WriteLock' ifAbsent: [#()]) 
	    do: [ :each | GsFile gciLogClient: '    ', each asOop asString].
        gsFil gciLogClient: 'Rc-Write-Write Conflicts...'.
        (conflicts at: #'Rc-Write-Write' ifAbsent: [#()]) 
	    do: [ :each | GsFile gciLogClient: '    ', each asOop asString].
        gsFil gciLogClient: 'Synchronized-Commit Conflicts...'.
        (conflicts at: #'Synchronized-Commit' ifAbsent: [#()]) 
	    do: [ :each | GsFile gciLogClient: '    ', each asOop asString]].
        ^false
      ]
%

category: 'Garbage Collection Management'
classmethod: System
voteState

"Returns an integer, the voteState of the Stone garbage
 collection voting state machine.   
 The states are  0 IDLE, 1 VOTING,
	 2 DONE_VOTING, 3  IN_PDWSU_SWEEP, 4 PDWSU_DONE"

 ^ self _zeroArgPrim: 17
%

category: 'Garbage Collection Management'
classmethod: System
forceEpochGc
"Force an Epoch GC to run as soon as possible, regardless of the setting 
of the GcUser configuration parameters epochGc[Time|Trans]Limit.  
Note that the stone configuration parameter STN_EPOCH_GC_ENABLED must be 
TRUE for this method to have any effect.

This method will fail and return false under the following conditions:
  *Checkpoints are suspended
  *Another garbage collection operation is in progress
  *Unfinalized possible dead objects exist (i.e., System>>voteState 
    returns any value except 0).
  *The system is in restore mode.
  *The Admin GC session is not running.
  *Epoch GC is not enabled (STN_EPOCH_GC_ENABLED is set to FALSE)
  *The system is performing a reclaimAll.
  *A previous forceEpochGc operation was performed and the epoch has
   not yet started or completed.

If successful, this method sets the stone cache statistic EpochForceGc
to 1.  Once the Admin GcGem has started the epoch GC, EpochForceGc 
will return back to 0.

This method returns true if the epoch GC was started, false if not.

You must have GarbageCollection privileges to be able to run this method."

^self _zeroArgPrim: 41
%

category: 'Garbage Collection Management'
classmethod: System
clearEpochGcState

"Resets the epoch GC state which keeps track of objects eligible to be
 marked as possible dead during the next epoch GC operation.  Has no effect
 on objects already marked possible dead by previously completed epochs."
 
^self _zeroArgPrim: 38
%

category: 'Garbage Collection Management'
classmethod: System
disableEpochGc
"Disables epoch garbage collection from running and resets
 the epoch GC state.  Appends the new configuration state
 to the stones configuration file.

 No further epoch GC operations will be run after this method is
 successfully executed.  An epoch GC operation already in progress
 when this method is executed will not be interrupted.  Has no
 effect if epoch GC is already disabled.

 Requires the GarbageCollection privilege."

^self stoneConfigurationAt: #StnEpochGcEnabled put: 0.
%

category: 'Garbage Collection Management'
classmethod: System
enableEpochGc
"Enables epoch garbage collection to run and resets
 the epoch GC state.  Appends the new configuration state
 to the stones configuration file.

 Has no effect if epoch GC is already enabled.

 Requires the GarbageCollection privilege."

^self stoneConfigurationAt: #StnEpochGcEnabled put: 1.
%

category: 'Garbage Collection Management'
classmethod: System
voteStateString

"Returns a String which is the name of the current value of
 the voteState of the Stone garbage collection voting state
 machine. "

 ^ self _zeroArgPrim: 19
%

category: 'Garbage Collection Management'
classmethod: System
startAllGcSessions

"Start all enabled garbage collector gems that are not running.
 Does not start the Symbol Creation Gem.
 Requires the GarbageCollection privilege."

^ self _zeroArgPrim: 18
%

category: 'Garbage Collection Management'
classmethod: System
stopAllGcSessions

"Stop any and all Garbage Collection sessions. 
 Does not stop the Symbol Creation Gem .
 Requires the GarbageCollection privilege."

^self _zeroArgPrim: 40
%

category: 'Garbage Collection Management'
classmethod: System
stopAdminGcSession

"Stop the Admin GC session if it is running.
 Requires the GarbageCollection privilege."

^self _zeroArgPrim: 42
%

category: 'Garbage Collection Management'
classmethod: System
stopSymbolCreationSession

"Stop the Symbol Creation session if it is running.

 This is an extreme action that should never be done in normal
 operation of a system.  Stopping the Symbol Creation session
 can prevent other sessions from being able to commit until
 after the Symbol Creation session restarts and after
 the other sessions logout and login .

 Only SystemUser may execute this method, otherwise an error is generated."

^self _zeroArgPrim: 44
%

category: 'Garbage Collection Management'
classmethod: System
stopAllReclaimGcSessions

"Stop any and all reclaim GC sessions.
 Requires the GarbageCollection privilege."

^self _zeroArgPrim: 43
%

category: 'Garbage Collection Management'
classmethod: System
startAdminGcSession

"Start the Admin GC session if it is not running.
 Returns true if the gem was started and false if
 it could not be started because it is already running
 or logins are suspended.
 Requires the GarbageCollection privilege."

^self _zeroArgPrim: 67
%

category: 'Garbage Collection Management'
classmethod: System
startSymbolCreationSession

"Start the Symbol Creation session if it is not running.
 Returns true if the gem was started and false if
 it could not be started because it is already running
 or logins are suspended.

 Requires the GarbageCollection privilege."

^self _zeroArgPrim: 45
%

category: 'Garbage Collection Management'
classmethod: System
startAllReclaimGcSessions

"Start all recalim GC sessions that are configured to run.
 Returns the number of reclaim sessions started.

 Requires the GarbageCollection privilege."

^self _zeroArgPrim: 68
%


category: 'Garbage Collection Management'
classmethod: System
adminGcGemSessionId

"Return the session ID of the Admin GC session.  Returns
 zero if the Admin GC session is not running."

^self _zeroArgPrim: 64
%

category: 'Garbage Collection Management'
classmethod: System
reclaimGcSessionCount

"Return the number of reclaim GC sessions currently running."

^self _zeroArgPrim: 65
%

category: 'Garbage Collection Management'
classmethod: System
symbolCreationSessionId

"Return the session ID of the SymbolCreation session.  Returns
 zero if the SymbolCreation session is not running."

^self _zeroArgPrim: 46
%


category: 'Garbage Collection Management'
classmethod: System
numberOfExtentsWithoutGC
"Return a SmallInteger indicating the number of extents not subject to
 garbage collection because they have no reclaim gem assigned."

|result reclaimGemsByExtent|

result := 0.
reclaimGemsByExtent := self currentGcReclaimSessionsByExtent.
1 to: reclaimGemsByExtent size do:[:j| | e |
  e := (reclaimGemsByExtent at: j) .
  (e == 0) ifTrue:[result := result + 1].
].

^result
%

category: 'Garbage Collection Management'
classmethod: System
numberOfExtentRangesWithoutGC
"Return a SmallInteger indicating the minimum number of additional
 reclaim gems that would need to be started to have all extents
 covered by a reclaim gem.
 Requires the GarbageCollection privilege."

|result reclaimGemsByExtent startId stopId |

result := 0.
reclaimGemsByExtent := self currentGcReclaimSessionsByExtent.
startId := -1 .
stopId := -1 .
1 to: reclaimGemsByExtent size do:[:j| | e |
  e := (reclaimGemsByExtent at: j) .
  (e == 0) ifTrue:[
    startId < 0 ifTrue:[
      startId := j .
      result := result + 1 .
    ]
  ] ifFalse:[ 
    startId := -1 
  ]
].
^result
%

category: 'Garbage Collection Management'
classmethod: System
hasMissingGcGems
"Return a Boolean indicating if any garbage collection systems are
 missing from the system.  Answers false if the Admin GC session is
 running and each extent has been assigned a reclaim gem.  Answers
 true otherwise."

|reclaimGemsByExtent|

(self adminGcGemSessionId == 0)
  ifTrue:[^true]. "missing the Admin gem"

reclaimGemsByExtent := self currentGcReclaimSessionsByExtent.
reclaimGemsByExtent do:[:e| (e == 0) ifTrue:[^true].].

^false "all GC gems accounted for"
%


category: 'Garbage Collection Management'
classmethod: System
waitForAllGcGemsToStartForUpToSeconds: anInt
"Wait for all GC gems on the system to start for up to anInt
 seconds.  Returns true if all GC gems started, false if they
 did not within the specified amount of time."

|count|

count := 0.
[self hasMissingGcGems] whileTrue:[
  self sleep: 1.
  count := count + 1.
  (count > anInt)
   ifTrue:[^false]. "timeout waiting for GC gems to start"
].
^true "success!"
%


category: 'Garbage Collection Management'
classmethod: System
currentGcReclaimSessionsByExtent

"Return an array where each element represents the session ID
of the reclaim gem for the corresponding extent.  For example,
if the array returned was #[2,3], that means session 2 is the
reclaim gem for extent 1 and session 3 is the reclaim gem for
extent 2.

A zero returned in the result array indicates there is no reclaim
gem for the corresponding extent."

^self _zeroArgPrim: 66
%

category: 'Garbage Collection Management'
classmethod: System
startReclaimGemForExtentRange: startExtent to: endExtent

"Start a reclaim GC gem to reclaim all extents starting with
 startExtent, up to and including endExtent.  The gem is started
 on the same machine as the stone.

 See the method:

 startReclaimGemForExtentRange: startExtent
 to: endExtent
 onHost: aHostNameOrNil
 stoneHost: stoneHostOrNil

 for further details.

 Requires the GarbageCollection privilege."

^self startReclaimGemForExtentRange: startExtent to: endExtent onHost: nil stoneHost: nil
%

category: 'Garbage Collection Management'
classmethod: System
startReclaimGemForExtentRange: startExtent to: endExtent onHost: aHostNameOrNil

"Start a reclaim GC gem to reclaim all extents starting with
 startExtent, up to and including endExtent on a remote host specified by
 aHostNameOrNil. aHostNameOrNil is a string containing a valid host name or IP 
 address where the reclaim gem will be spawned.  A value of nil means to spawn
 the reclaim gem on the stones host.   

 See the method:

 startReclaimGemForExtentRange: startExtent
 to: endExtent
 onHost: aHostNameOrNil
 stoneHost: stoneHostOrNil

 for further details.
 Requires the GarbageCollection privilege."

^self startReclaimGemForExtentRange: startExtent to: endExtent onHost: aHostNameOrNil stoneHost: nil
%

category: 'Garbage Collection Management'
classmethod: System
startReclaimGemForExtentRange: startExtent to: endExtent onHost: aHostNameOrNil stoneHost: stoneHostOrNil

"Start a reclaim GC gem to reclaim all extents starting with
 startExtent, up to and including endExtent.  Both startExtent
 and endExtent must be non-negative SmaallIntegers and 
 endExtent must be greater than or equal to endExtent.

 startExtent and endExtent are 1-based extent IDs, that is
 the first extent is extent 1.

 aHostNameOrNil if the host where the reclaim gem will be spawned.
 It may be a String containing a valid host name or IP address or
 it may be nil, which means the reclaim gem will be created on 
 the same node as the stone.

 stoneHostOrNil is the host name to use for the spawned reclaim
 gem to use to connect with the stone.  Normally this can be nil,
 which means use the default stone host name.  On multi-homed
 systems with more than one network connection between the remote
 host and the stone host, the host name or IP address may need to
 be specified to indicate which connection to use.

 Returns true if the reclaim GC gem was successfully started,
 otherwise returns false.

 The number of configured reclaim gems for the system is not
 altered by this method.  If reclaim gems were previously 
 disabled by exectuing:

 System stoneConfigurationAt: #StnNumGcReclaimSessions put: 0

 then the number of permitted reclaim gems must be changed to a non-zero
 value before this method can succeed.

 There are a number of conditions that will prevent a reclaim gem
 from starting, including:

 -logins are suspended.
 -repository in restore mode.
 -a reclaim gem already exists for any of the extents in the given
  range.
 -a reclaim gem is in the process of starting for any of the extents
  in the given range.
 -starting this reclaim gem would cause the total number of reclaim
  gems on the system to exceed the configured maximum
  (STN_NUM_GC_RECLAIM_SESSIONS).
 -no netldi process is running on the remote machine."

<primitive: 287>
startExtent _validateClass: SmallInteger.
endExtent _validateClass: SmallInteger.
(aHostNameOrNil ~~ nil) ifTrue:[aHostNameOrNil _validateClass: String].
(stoneHostOrNil ~~ nil) ifTrue:[stoneHostOrNil _validateClass: String].
(startExtent < 0) ifTrue:[^startExtent _error: #rtErrArgNotPositive].
(endExtent < 0) ifTrue:[^startExtent _error: #rtErrArgNotPositive].
(endExtent < startExtent) ifTrue:[^endExtent _error: #rtErrArgOutOfRange].
self _primitiveFailed: #startReclaimGemForExtentRange:to:onHost:stoneHost: .
%

! deleted _abortTransactionAndKeepAttached
! deleted _beginTransactionAndKeepAttached
! deleted _intToOopFiltered: array serial: serialNum status: statusArray


category: 'Error Handling'
classmethod: System
_lastGsErrorNumber

"Return the value of the last error number.  Also clears the error number back to zero."
^self _zeroArgPrim: 47
%
! deleted weakDictionaryAt:
! deleted weakDictionaryAt: key put: value toSurvive: anInt
! deleted weakDictionaryEnableDebugging
! deleted weakDictionaryInit
! deleted weakDictionaryLockedAt: key
! deleted weakDictionaryLockedAt: key put: aBoolean
! deleted weakDictionaryRemainingGcsAt: key
! deleted
! deleted weakDictionaryRemoveKeyAt: key
! deleted weakDictionarySize
! deleted weakDictionaryStatistics
! deleted weakDictionarySurvivedGcsAt: key
! deleted weakDictionaryDumpContents
! deleted weakDictionaryAt: key put: value insertOrUpdateToSurvive: anInt

category: 'Hidden Set Support'
classmethod: System
_addEncodedOop: aSmallInt to: hiddenSetSpecifier
"Encoded OOPs are obsolete and were replaced with double encoded OOPs"

^self halt: 'encoded OOPs are no longer supported'.
%

category: 'Private'
classmethod: System
myPageServerProcessId
"Answer an Integer which is the process ID of the page server
for this session.  Returns 0 if the session does not have
a page server."

^ self _zeroArgPrim: 59 
%

category: 'Online Backup Support'
classmethod: System
suspendCheckpointsForMinutes: anInt
"Suspend all checkpoints for the given number of minutes or until the
 resumeCheckpoints method is executed, which ever occurs first.  anInt
 must be a positive SmallInteger.
 
 Requires the SystemControl privilege.

 It is safe to copy the repository extents for backup purposes while
 checkpoints are suspended.

 Checkpoint suspension is not supported in partial tranlog mode.  This
 method will always return false STN_TRAN_FULL_LOGGING is set to FALSE.  

 Certain operations which require checkpoints are not permitted while
 checkpoints are suspended, such as full backups.

 Calling this method while checkpoints are already suspended has
 the effect of changing the duration of the suspension.

 If a checkpoint is in progress when this method is called, the call
 will block until the current checkpoint completes, at which time
 checkpoints will be suspended.  If any session has made this
 call and is waiting for the current checkpoint to complete, calls
 to this method by other sessions will fail.

 Returns true if checkpoints were successfully suspended.  Returns
 false if checkpoints could not be suspended because the repository
 is in partial log mode or is in restore from backup or log mode."

<primitive: 285>
anInt  _validateClass: SmallInteger.
(anInt < 0)
  ifTrue:[ anInt _error: #rtErrArgOutOfRange.] .
^self _primitiveFailed: #suspendCheckpointsForMinutes: .
%

category: 'Online Backup Support'
classmethod: System
resumeCheckpoints
"Resumes regular checkpoints if they were previously suspended by
 the System suspendCheckpointsForMinutes: method.
 
 Requires the SystemControl privilege.

 Returns the previous checkpoint state.  Returns true if checkpoints
 were suspended or false if checkpoints were not suspended."

 ^self _zeroArgPrim: 60
%

category: 'Online Backup Support'
classmethod: System
checkpointStatus
"Returns an array of 2 elements.  The first element is a boolean indicating
 if checkpoints are currently suspended.  The second element is an
 Integer indicating the number of seconds before checkpoints will be
 resumed by the stone."
 

 ^self _zeroArgPrim: 61
%

category: 'Historical Event Logging'
classmethod: System

hstLogStatus
"Prints out status of History Logging 
 Categories on stdout"

 ^self _zeroArgPrim: 82
%

category: 'Historical Event Logging'
classmethod: System

hstLogCategoryEnable: categorySymbol
"Enables the recording/printing of historical events 
 belonging to this category."

 ^self hstLogCategory: categorySymbol setup: true
%

category: 'Historical Event Logging'
classmethod: System

hstLogCategoryDisable: categorySymbol
"Disables the recording/printing of historical events 
 belonging to this category."

^self hstLogCategory: categorySymbol setup: false
%

category: 'Historical Event Logging'
classmethod: System

hstLogOpcodeEnable: opcodeSymbol
"Enables the recording/printing of historical events 
 belonging to this opcode."

 ^self hstLogOpcode: opcodeSymbol setup: true
%

category: 'Historical Event Logging'
classmethod: System

hstLogOpcodeDisable: opcodeSymbol
"Disables the recording/printing of historical events 
 belonging to this opcode."

^self hstLogOpcode: opcodeSymbol setup: false
%

category: 'Historical Event Logging'
classmethod: System

hstLogCategory: categorySymbol setup: aBoolean
"Enable/Disable the recording/printing of historical events 
 belonging to this category."

<primitive: 575>
^self _primitiveFailed: #hstLogCategory:setup:
%

category: 'Historical Event Logging'
classmethod: System

hstLogOpcode: opcodeSymbol setup: aBoolean
"Enable/Disable the recording/printing of historical events 
 belonging to this opcode."

<primitive: 576>
^self _primitiveFailed: #hstLogOpcode:setup:
%

category: 'Historical Event Logging'
classmethod: System

prvLogPrint
"Print out the private historical event log to stdout"

 ^self _zeroArgPrim: 80
%

category: 'Historical Event Logging'
classmethod: System

shrLogPrint
"Print out the private historical event log to stdout"

 ^self _zeroArgPrim: 81
%

category: 'Historical Event Logging'
classmethod: System

prvLogRecordX1: x1 X2: x2 X3: x3

<primitive: 577>
^self _primitiveFailed: #prvLogRecordX1:X2:X3
%

category: 'Historical Event Logging'
classmethod: System

shrLogRecordX1: x1 X2: x2 X3: x3

<primitive: 578>
^self _primitiveFailed: #prvLogRecordX1:X2:X3
%

category: 'Private'
classmethod: System

_protectedMode
"Return protectedMode status"

^self _zeroArgPrim: 84
%

category: 'Version Management'
classmethod: System
_generatePassiveSourceFileTo: fileName
"generate a passivated data structure containing all source code for classes
 in Globals. The file generated by this method can be used by 
 System(C)>>_compareGlobalsWith:writeReportTo:generateFileinTo: to generate
 a report and/or filein script to reconcile kernel class differences between
 two versions of the image. If fileName is nil, file will be given a useful
 name like '1.0.0-sourceStrings.obj'.
"
|ver classes outfile outfilename |
(fileName == nil) ifTrue: [
  ver := self gemVersionReport at: #gsRelease.
  ver := (ver copyReplaceAll: ' ' with: '').
  outfilename := ver, '-sourceStrings.obj'.
] ifFalse: [outfilename := fileName].
classes := Dictionary new.
Globals do: [ :ea | | theArr meths classMeths methSrcDict classMethSrcDict |
  (ea isKindOf: Behavior) ifTrue: [ 
    theArr := Array new: 2.
    methSrcDict := Dictionary new.
    classMethSrcDict := Dictionary new.
    theArr at: 1 put: methSrcDict.
    theArr at: 2 put: classMethSrcDict.
    classes at: ea nameForFileout put: theArr.
    meths := ea _methodDict.
    classMeths := ea class _methodDict.

    meths keysAndValuesDo: [ :k :v | 
      methSrcDict at: k put: v sourceString.
    ].

    classMeths keysAndValuesDo: [ :k :v |
      classMethSrcDict at: k put: v sourceString.
    ]
  ]
].
outfile := GsFile openWriteOnServer: outfilename.
(outfile == nil) ifTrue: [^'error opening outfile', outfilename].
(PassiveObject passivate: classes toStream: outfile) == nil
    ifTrue: ['error writing outfile', outfilename].
outfile close.
^true
%

category: 'Version Management'
classmethod: System
_compareGlobalsWith: passiveSourceFileName 
writeReportTo: reportFileName 
generateFileinTo: fileinFileName
"returns a string, a report on Smalltalk method differences between this
 version and a previous version. 

 If reportFileName is nil, no report file is written. If reportFile is not
 nil, the report string will be written to a file.

 If fileinFileName is nil, no filein file will be generated. If fileinFileName
 is not nil, a topaz filein script will be generated. 

 See also System(C)>>_generatePassiveSourceFileTo:
"
| prevClasses prevClassesFile report reportFile lf addedMeths changedMeths
  deletedMeths addedClasses deletedClasses fileinFile |

lf := Character lf.
report := String new.
addedMeths := Array new.
changedMeths := Array new.
deletedMeths := Array new.
addedClasses := Array new.
deletedClasses := Array new.

(fileinFileName == nil) ifFalse: [
  fileinFile := GsFile openWriteOnServer: fileinFileName.
  (fileinFile == nil) ifTrue: [ 
    ^'Can''t open ', fileinFileName, ' for writing.'
  ].
].

prevClassesFile := GsFile openReadOnServer: passiveSourceFileName.
(prevClassesFile == nil) ifTrue: [
  ^'Can''t open ', passiveSourceFileName, ' for reading.'
].

"read in the prevClasses from passivated object file"
prevClasses := (PassiveObject newOnStream: prevClassesFile) activate.
(prevClasses == nil) ifTrue: [
  ^'Failed to activate source dictionaries from ', passiveSourceFileName, '.'
].

"iterate classes in Globals and compare method source strings"
Globals do: [ :ea | 
  (ea isBehavior) ifTrue: [ | meths classMeths className |
    className := ea nameForFileout.
    (prevClasses includesKey: className) ifFalse: [
      addedClasses add: className.
      (fileinFileName == nil) ifFalse: [
        ea fileOutClassOn: fileinFile.
      ].
    ] ifTrue: [
      meths := ea _methodDict.
      classMeths := ea class _methodDict.
  
      meths keysAndValuesDo: [ :k :v | 
        " check to see if same method exists in prevClasses"
        (((prevClasses at: className) at: 1) includesKey: k) ifFalse: [
          addedMeths add: className, '>>', k.
          (fileinFileName == nil) ifFalse: [
            fileinFile nextPutAll: (ea fileOutMethod: k).
          ].
        ] ifTrue: [
          " method exists in both versions, do a diff."
          (v sourceString = (((prevClasses at: className) at: 1) at: k))
              ifFalse: [
            changedMeths add: className, '>>', k.
            (fileinFileName == nil) ifFalse: [
              fileinFile nextPutAll: (ea fileOutMethod: k).
            ].
          ]
        ]
      ].
  
      classMeths keysAndValuesDo: [ :k :v | 
        " check to see if same method exists in prevClasses"
        (((prevClasses at: className) at: 2) includesKey: k) ifFalse: [
          addedMeths add: className, '(C)>>', k.
          (fileinFileName == nil) ifFalse: [
            fileinFile nextPutAll: (ea class fileOutMethod: k).
          ].
        ] ifTrue: [
          " method exists in both versions, do a diff."
          (v sourceString = (((prevClasses at: className) at: 2) at: k))
              ifFalse: [
            changedMeths add: className, '(C)>>', k.
            (fileinFileName == nil) ifFalse: [
              fileinFile nextPutAll: (ea class fileOutMethod: k).
            ].
          ]
        ]
      ] "classMeths keysAndValuesDo:"
    ] "prevClasses includesKey: className"
  ] "ea isBehavior"
]. "Globals do:"

"Now check to see if there are any deleted methods or classes"
prevClasses keysAndValuesDo: [ :k :v | | meths classMeths |
  ((Globals includesKey: k) _and: [(Globals at: k) isBehavior])
      ifFalse: [
    deletedClasses add: k.
  ] ifTrue: [
    meths := v at: 1.
    classMeths := v at: 2.
    meths keysDo: [ :mk |
      (((Globals at: k) _methodDict) includesKey: mk) ifFalse: [
        deletedMeths add: k, '>>', mk.
        (fileinFileName == nil) ifFalse: [
          fileinFile nextPutAll: 'doit', lf, k, ' removeSelector: #', mk, lf, 
              $%, lf.
        ].
      ]
    ].
    classMeths keysDo: [ :cmk |
      ((((Globals at: k) class) _methodDict) includesKey: cmk) ifFalse: [
        deletedMeths add: k, '(C)>>', cmk.
        (fileinFileName == nil) ifFalse: [
          fileinFile nextPutAll: 'doit', lf, k, ' class removeSelector: #', cmk,
              lf, $%, lf.
        ].
      ]
    ].
  ]
].
fileinFile close.

"put together the report"
report := '====', lf, 'Image change report', lf, '====', lf.
(addedClasses size > 0) ifTrue: [
  report := report, '----', lf, 'Added Classes:', lf, '----', lf.
  (addedClasses sortAscending) do: [ :ea | report := report, ea, lf ].
].
(deletedClasses size > 0) ifTrue: [
  report := report, '----', lf, 'Deleted Classes:', lf, '----', lf.
  (deletedClasses sortAscending) do: [ :ea | report := report, ea, lf ].
].
(addedMeths size > 0) ifTrue: [
  report := report, '----', lf, 'Added Methods:', lf, '----', lf.
  (addedMeths sortAscending) do: [ :ea | report := report, ea, lf ].
].
(deletedMeths size > 0) ifTrue: [
  report := report, '----', lf, 'Deleted Methods', lf, '----', lf.
  (deletedMeths sortAscending) do: [ :ea | report := report, ea, lf ].
].
(changedMeths size > 0) ifTrue: [
  report := report, '----', lf, 'Changed Methods', lf, '----', lf.
  (changedMeths sortAscending) do: [ :ea | report := report, ea, lf ].
].

(reportFileName == nil) ifFalse: [
  reportFile := GsFile openWriteOnServer: reportFileName.
  (reportFile == nil) ifFalse: [
    reportFile nextPutAll: report; close.
  ].
].
^report
%

category: 'Hidden Set Support'
classmethod: System
_loadOrStoreHiddenSet: hiddenSetSpecifier toOrFromFile: aString opCode: anOpCode

"Performs hidden set to bitmap file operations.  If anOpCode is zero, read the
 given bitmap file into the given hidden set.  The file must exist and be readable
 by the gem process.   Also hiddenSetSpecifier must be the index of a hidden set
 that is modifiable by customers.  This check is bypassed if the session is logged in
 as SystemUser.  Extreme caution should be used in this case.  Be sure to call
 System>>_hiddenSetReinit: method first to ensure the hidden is empty.

 If anOpCode is not zero, then the given hidden set is written to the specified 
 bitmap file.  The file must not already exist and the path to the file must
 be in a directory which is writable by the process.  Any valid hidden set
 specifier may be used in this case.

 Returns true if successful, false if an error occurred.  Additional error 
 information may be written stderr for the process (either the terminal
 or the gem log file)."
 
<primitive: 356>
hiddenSetSpecifier _validateClass: SmallInteger.
aString _validateClass: String.
anOpCode _validateClass: SmallInteger.
self _primitiveFailed: #_loadOrStoreHiddenSet:toOrFromFile:opCode: .
%

category: 'Hidden Set Support'
classmethod: System
writeHiddenSet: hiddenSetSpecifier toFile: aString
"Refer to comments in the method
 System>>_loadOrStoreHiddenSet: hiddenSetSpecifier
           toOrFromFile: aString
           opCode: anOpCode"

^self _loadOrStoreHiddenSet: hiddenSetSpecifier toOrFromFile: aString opCode: 1
%

category: 'Hidden Set Support'
classmethod: System
readHiddenSet: hiddenSetSpecifier fromFile: aString
"Refer to comments in the method
 System>>_loadOrStoreHiddenSet: hiddenSetSpecifier
           toOrFromFile: aString
           opCode: anOpCode"

^self _loadOrStoreHiddenSet: hiddenSetSpecifier toOrFromFile: aString opCode: 0
%

category: 'Hidden Set Support'
classmethod: System
_performSetArithmeticOnHiddenSets: first and: second storeResultsInto: third opCode: anOpCode

"Perform a set arithmetic operation on the hidden sets with the specifiers
 given by first and second and possiblly store the results into third.
 The behavior of this primitive is as follows:

 opCode 	Operation	 Result stored in third
 =================================================================
 0		Add		 Not used, third expected to be 0.
 1		Subtract	 Not used, third expected to be 0.
 2		Union 		 result of the union
 3		Difference	 result of difference
 4		Clear from start Not used
 3		Clear from end   Not used
 =================================================================

 The set arithmetic operations are described as follows:

 Add:	For each element in first, add that element to second.  Returns the number
        of elements added to second which were not already present.

 Subtract: For each element in first, remove that element from second.  Returns
           the number of elements removed from second.

 Intersection: Add elements to third which appear in both first and second.
               Returns the size of the intersection contained in third.

 Difference:   Add elements to third which appear in first but not in second.
               Returns the number of elements stored in third.

 Clear from start - remove the first count elements from the hidden set.  Elements
                    are removed in OOP order, from lowest to highest.

 Clear from end - remove the last count elements from the hidden set.  Elements
                    are removed in OOP order, from higest to lowest.
"

<primitive: 357>
first _validateClass: SmallInteger.
second _validateClass: SmallInteger.
third _validateClass: SmallInteger.
anOpCode _validateClass: SmallInteger.
self _primitiveFailed: #_performSetArithmeticOnHiddenSets:and:storeResultsInto:opCode: .
%

category: 'Hidden Set Support'
classmethod: System
addHiddenSet: first to: second
"Add all the objects in hidden set first to hidden set second.  Returns the 
 number of objects added to second hidden set that were not already present.
 User must have permission to modify the second hidden set or be SystemUser."
 
^self _performSetArithmeticOnHiddenSets: first and: second storeResultsInto: 0 opCode: 0.
%

category: 'Hidden Set Support'
classmethod: System
removeContentsOfHiddenSet: first from: second
"Remove all objects in the first hidden  from the second hidden set second.  Returns the 
 number of objects removed from second hidden set.  User must have permission to modify
 the second hidden set or be SystemUser."
 
^self _performSetArithmeticOnHiddenSets: first and: second storeResultsInto: 0 opCode: 1.
%

category: 'Hidden Set Support'
classmethod: System
computeUnionOfHiddenSet: first and: second into: third
"Add every object to the third hidden set that is in both the first and second hidden
 sets.  Returns the number of elements added to the third hidden set.  User must have
 permission to modify the third hidden set or be SystemUser."
 
^self _performSetArithmeticOnHiddenSets: first and: second storeResultsInto: third opCode: 2.
%

category: 'Hidden Set Support'
classmethod: System
computeDifferenceOfHiddenSet: first and: second into: third
"Add every object to the third hidden set that is in the first and but not the second hidden
 set.  Returns the number of elements added to the third hidden set.  User must have
 permission to modify the third hidden set or be SystemUser."
 
^self _performSetArithmeticOnHiddenSets: first and: second storeResultsInto: third opCode: 3.
%

category: 'Hidden Set Support'
classmethod: System
removeFirst: count objectsFromHiddenSet: hiddenSetSpecifier
"Remove the first count objects from the given hidden set.  Objects are removed from
 the beginning, going from lowest to highest object ID.   
 
 Returns the number of objects removed from the hidden set.  User must have permission
 to modify the hidden set or be SystemUser."
 
^self _performSetArithmeticOnHiddenSets: hiddenSetSpecifier and: count storeResultsInto: 0 opCode: 4.
%

category: 'Hidden Set Support'
classmethod: System
truncateHiddenSet: hiddenSetSpecifier toSize: newSize
"Truncate the given hidden set by removing objects from the end of the set until it reaches a
 size of newSize.  Objects are removed in order, going from highest to lowest object ID.   
 
 Returns the number of objects removed from the hidden set.  User must have permission
 to modify the hidden set or be SystemUser."
 
^self _performSetArithmeticOnHiddenSets: hiddenSetSpecifier and: newSize storeResultsInto: 0 opCode: 5.
%

category: 'Private'
classmethod: System
_comClearOpcodesEmitted

^ self _zeroArgPrim: 92
%
category: 'Private'
classmethod: System
_comPrintOpcodesEmitted

^ self _zeroArgPrim: 87
%
category: 'Private'
classmethod: System
_comPrintOpcodesNotEmitted

^ self _zeroArgPrim: 88
%

category: 'Private'
classmethod: System
_printCHeap

"in a slow or fastdebug VM , calls UtlHeapPrint()"
^ self _zeroArgPrim: 89
%

category: 'Private'
classmethod: System
_locale
"Returns a Locale object setup according to the session's Locale configuration."

^ self _zeroArgPrim: 90.
%

! fix 36394 / 36587
! fix 37843/37871: modify category argument to be categorySym
category: 'Private'
classmethod: System
_setCategory: categorySym locale: localeStr

" Set Locale information.  See man page for setlocale( ) for details.

Valid category types include:

   LC_CTYPE        /* locale's ctype handline */
   LC_NUMERIC      /* locale's decimal handling */
   LC_TIME         /* locale's time handling */
   LC_COLLATE      /* locale's collation data */
   LC_MONETARY     /* locale's monetary handling */
   LC_MESSAGES     /* locale's messages handling */
   LC_ALL          /* name of locale's category name */

Applications should not call this directly -- instead use:

  Locale setCategory: <sym> locale: <str>' 

"

< primitive: 661>
categorySym _validateClass: Symbol.
localeStr _validateClass: String.
self _primitiveFailed: #_setCategory:locale:
%

category: 'Private'
classmethod: System
_maxClusterId 

" return the maximum clusterId supported vy the VM."
^ self _zeroArgPrim: 91
%

category: 'Time'
classmethod: System
timeNs

"Returns a SmallInteger representing the current high-resolution
 real time in nanoseconds since some arbitrary time in the past.  The 
 result is not correlated in any way with the time of day."
 
^ self _zeroArgPrim: 95
%
category: 'Private'
classmethod: System
_removePageFromCache: aPageId

"aPageId must be an Integer >= 0 and <= 549755813887  .
 If the specified page is in gem's shared cache, 
 prints the page header and attempts to remove the page
 from the shared cache.   If the gem is running on stone's machine
 will also print the page header from the state of the page on disk.

 Returns true if successfully removed, false otherwise.
 The result will be false if the page was dirty, locked or pinned."
  
<primitive: 590>
aPageId  _validateClass: Integer.
(aPageId < 0 or:[aPageId > 549755813887 ]) ifTrue:[
  aPageId _error: #rtErrArgOutOfRange
] .
^self _primitiveFailed: #_removePageFromCache:
%

category: 'Reduced Conflict Support'
classmethod: System
_rcLockObject

^ System rcValueCacheAt: #rcLockObj otherwise: (Globals at: #GemStoneRCLock ifAbsent: [nil])
%

run
Globals at: #GemStoneRCLock put: Object new.
^true.
%

category: 'System Control'
classmethod: System
_startGcCacheWarmer

"Starts an additional garbage collection cache warmer gem.  
 A garbage collection operation which uses cache warming 
 must be already be in progress for this method to succeed.
 Garbage collection cache warmer gems may not be started if
 a garbage collection operation which does not use cache 
 warming is in progress.

 Requires the GarbageCollection privilege.
 
 Returns true if successful, false otherwise."

^ self _zeroArgPrim: 101
%

category: 'Private'
classmethod: System
_bypassReadAuth: aBoolean

"For use by indexing and query subsystem only.

 If aBoolean is true, subsequent object read-faults will bypass
 read-authorization checks to allow indexed queries and index maintenance
 to execute.  This allows indexing code to execute comparisons on keys
 in btree nodes without regard to read-authorization of the keys.
 Query results will never contain objects for which the current user
 is not read-authorized.

 If aBoolean is false, any in-memory objects which were faulted in 
 while bypass was enabled, and for which a read-authorization error would 
 have otherwise occurred, will be marked not-valid, so that subsequent
 access will get a read-authorization error.

 Has no effect if current user is SystemUser.

 Indexing code should use this method in combination with an ensure: block
 which contains   _bypassReadAuth:false  .

 The bypass is shutoff automatically (equivalent to _bypassReadAuth:false)
 upon return from a userAction, from a recurFromOm, , upon return to the GCI,
 or upon generation of an error which would unwind the VM C stack.
"

<protected primitive: 595>
aBoolean _validateClass: Boolean .
self _primitiveFailed: #_bypassReadAuth:
%

category: 'Backward Compatibility'
classmethod: System
timeGmt2005

"Returns a SmallInteger or a LargePositiveInteger, the time since January 1,
 2005, in seconds.  It will return a SmallInteger until January 5, 2022.
 The time is computed from the clock of the machine on which the session is
 running, using the offset from the clock on the Stone's (GemStone repository
 monitor process) machine which is cached in the session at login."

^ self _timeGmt2005: false
%

category: 'Time'
classmethod: System
_timeGmt2005: aBoolean

"Returns a SmallInteger or a LargePositiveInteger, the time since January 1,
 2005, in seconds.  It will return a SmallInteger until January 5, 2022.
 aBoolean is true, call Stone and update our offset from Stone's clock,
 otherwise compute the current time locally using the offset from Stone's time
 that was cached in the session at login."

<primitive: 598>
^ self _primitiveFailed: #_timeGmt2005:
%

category: 'Time'
classmethod: System
_timeUs

"Returns a SmallInteger between 0 and 999,999 representing the current number
 of microseconds that have passed within the current second."

^ System _zeroArgPrim: 103 .
%
! Request 36492
category: 'Session Control'
classmethod: System
logout

"Immediately logs out the current session and generates a fatal error
 (GS_ERR_GEM_NORMAL_SHUTDOWN).  This method does not return."

self _zeroArgPrim: 104
%

category: 'Transaction Control'
classmethod: System
inContinueTransaction

"Returns a boolean indicating if the current transaction has been 
 continued.  Answers true if System>>continueTransaction has been
 executed and no abort or successful commit has been performed.
 Also answer true if a commit was attempted and failed and no
 abort has been executed.  Otherwise returns false."

^ self _zeroArgPrim: 105
%

category: 'Transaction Control'
classmethod: System
dirtyListId

"Return a SmallInteger identifying the currently active dirtyList"

^ self _zeroArgPrim:28 
%

category: 'Transaction Control'
classmethod: System
setDirtyList: listId

"Change the currently active dirtyList to be the one specified by
 listId .   A subsequent modification to a committed object, that
 is the first modification the object in this transaction,
 will add the object to the dirtyList specified by listId . 

 Returns the listId of the previously active dirtyList."

^ self _dirtyListOp: 0 id: listId 
%

category: 'Private'
classmethod: System
_dirtyListOp: opcode id: listId

"execute an operation on one of the object manager dirty lists
 opcode 0  setDirtyList
 opcode 1  rollbackDirtyList
 opcode 2  enumerateDirtyList ."

<primitive: 276>
self _primitiveFailed: #_dirtyListOp:id: .
self _uncontinuableError
%


category: 'Transaction Control'
classmethod: System
rollbackDirtyList: listId

"For each object in the dirtyList specified by listId,
 rollback the object to its state as of the beginning of the
 current transaction.
 listId = -1  specifies the currently active dirtyList .
 May not be used after a failed commit (i.e. not for use during
 Rc replay operations).

 Returns the number of objects rolled back."

^ self _dirtyListOp: 1 id: listId 
%

category: 'Transaction Control'
classmethod: System
enumerateDirtyList: listId


"Returns an Array which is the result of enumerating
 the dirtyList(s) specified by listId.
 listId = -1  specifies the currently active dirtyList .
 listId = -2  specifies all dirtyLists."

^ self _dirtyListOp: 2 id: listId 
%


category: 'Private' 
classmethod: System
_writtenObjects

"Returns an Array which is the result of enumerating
 all of the object manager's lists of dirty committed objects ."

^ self _dirtyListOp: 2 id: -2
%
category: 'Runtime Configuration Access'
classmethod: System
gemIsBigEndian

" Returns true if the gem process is running
  on a machine using big endian byte ordering "

^ self _zeroArgPrim: 106

%
category: 'Runtime Configuration Access'
classmethod: System
stoneIsBigEndian

" Returns true if the stone process is running
  on a machine using big endian byte ordering "

^ self _zeroArgPrim: 107

%
category: 'Session Control'
classmethod: System
commitRecordPageForSessionId: aSessionId

"Return the page ID of the commit record referenced by the given session ID.
 The result will usually be a SmallInteger but could also be a 
 LargePositiveInteger.
 
 Returns -1 if the session does not exist or if it does not currently reference a
 commit record (such as after a Lost OT root error).

 To execute this method for any session other than your current session, you
 must have the SessionAccess privilege."

<primitive: 663>
aSessionId _validateClass: SmallInteger .
^ self _primitiveFailed: #commitRecordPageForSessionId: .
%
category: 'Session Control'
classmethod: System
latestCommitRecordPageId

"Return the page ID of the most recent (newest) commit record on the system.
 Returns -1 if an error occurs."

^ self _zeroArgPrim: 108
%

category: 'Session Control'
classMethod: System
sessionsReferencingOldestCrInTransaction

"Returns an Array containing the sessionIds of the sessions that are in
 transaction and currently reference the oldest commit record."       
^self _zeroArgPrim: 109
%

category: 'Session Control'
classMethod: System
sessionsReferencingOldestCrNotInTransaction

"Returns an Array containing the sessionIds of the sessions that are not in
 transaction and currently reference the oldest commit record."       
^self _zeroArgPrim: 110
%

