!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: reposit.gs,v 1.87.2.1 2008-03-10 17:47:53 bretlb Exp $
!
! Superclass Hierarchy:
!   Repository, Collection, Object.
!
!=========================================================================

removeallmethods Repository
removeallclassmethods Repository

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

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

txt := (GsDocText new) details:
'A Repository is an object that represents a virtual storage into which users
 can place their data.  Each Repository includes an Array of Segments,
 which represent authorization regions for the data.  
 Repositories are described in the GemStone Programming Guide.'.
doc documentClassWith: txt.

txt := (GsDocText new) details:
'A Symbol; the user-supplied logical name for the Repository.'.
doc documentInstVar: #name with: txt.

txt := (GsDocText new) details:
'A dictionary that describes the logical entry points to data in this
 Repository; a convenient mechanism for remembering and accessing the objects
 in the Repository, similar to a file system directory. (Reserved for future
 use.)'.
doc documentInstVar: #dataDictionary with: txt.

txt := (GsDocText new) details:
'Backups and restoration are ordinarily performed while using the GemStone
 DataCurator login.  It is possible to use another login that also has the
 FileControl privilege.  However, for restorations, it is recommended that you
 use only the DataCurator or the SystemUser logins.  If you use another login,
 and that login disappears as a result of the restoration, you will see a
 fatal error.

 The GemStone System Administration Guide discusses backups and restoration
 in more detail.'.
doc documentCategory: #'Backup and Restore' with: 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 documentCategory: #'Backward Compatibility' with: txt.

self description: doc.
%

expectvalue %String
run
| reposCls |
reposCls := Globals at:#Repository .
reposCls superClass == Array ifTrue:[
  reposCls changeNameTo: #OldRepository .
  Globals at: #Repository put: nil .
  Globals at:#OldRepository put: reposCls .
  ^  Collection _newKernelIndexableSubclass: 'Repository' 
    instVarNames:#( name dataDictionary )
    classVars: #()
    classInstVars: #()
    poolDictionaries: #[]
    inDictionary: Globals 
    constraints: #[ #[ #name, Symbol ],
                    #[ #dataDictionary, AbstractDictionary ],
                     "the elements"  Segment ]
    instancesInvariant: false
    isModifiable: false
    reservedOop: 973  
] ifFalse:[
  reposCls superClass == Collection ifTrue:[
    ^ 'class already exists as subclass of Collection'
  ] ifFalse:[
    ^ -1 "error, invalid super class"
  ].
]
%
run
Repository _disallowGciCreateStore .
Segment _disallowGciCreateStore .
^ true
%

category: 'Accessing'
method: Repository
dataDictionary

"Accesses the user-defined data dictionary.  (Not for use
 in this product release.)"

^ dataDictionary
%

category: 'Accessing'
method: Repository
name

"Returns the logical name of the receiver (a Symbol)."

^ name
%

category: 'Accessing'
method: Repository
fileNames

  <primitive: 429>

"Returns an Array containing the filenames for the extents
 of the receiver.

 Each element within the returned Array contains a String representing
 the filename of the Nth extent (where N is the index into the
 returned Array)."

  self _primitiveFailed: #fileNames.
  self _uncontinuableError
%

category: 'Updating'
method: Repository
name: aString

"Redefines the logical name of the receiver to be aString."

name := aString asSymbol
%

category: 'Updating'
method: Repository
_setVersion

"This method writes the Stone executable version string to the receiver.

 If the Repository was in conversion from 4.1 to 5.0, this clears
 the Repository conversion flag in the Repository root page and re-enables
 automatic startup of the GcGem."

<primitive: 289>

self _primitiveFailed: #_setVersion .
self _uncontinuableError
%

! fix 33706
category: 'Clustering'
method: Repository
extentForPage: aPageId

"Returns a SmallInteger specifying an offset into the result from the
 fileNames method.  

 The argument aPageId is an Integer, such as the result from the Object | page
 method, specifying a page in the receiver."

^ (aPageId bitShift: -31 ) + 1
%


category: 'Repository Usage Reporting'
method: Repository
_dbfStatistics: extentFilename

"Returns an Array of size 2 containing the number of bytes the given extent
 requires for physical size and the number of bytes of free space in the
 extent."

<primitive: 283>

extentFilename _validateClass: String .
^ self _primitiveFailed: #_dbfStatistics: .
%

category: 'Repository Usage Reporting'
method: Repository
_extentStatistics: extentIndex

"Returns an Array of size 2 containing the number of bytes the
 given extent requires for physical size and the number of bytes of
 free space in the extent."

<primitive: 286>

(extentIndex _isSmallInteger)
  ifTrue:[ ^ self _errorIndexOutOfRange: extentIndex]
  ifFalse:[ extentIndex _validateClass: SmallInteger ].
^ self _primitiveFailed: #_extentStatistics: .
%

category: 'Transaction Logging'
method: Repository
_logInfo: logDirId

"If logDirId is within the range of 1 to number of log directories, returns an
 Array containing the following instance variables.  Otherwise returns nil.

 1: logDirId (SmallInteger)
 2: numLogDirs (SmallInteger)
 3: isActiveLog (Boolean)
 4: fileId (SmallInteger) (if active log )
 5: fileSize (SmallInteger) in units of MBytes (if active log)
 6: maxFileSize (SmallInteger) in units of MBytes
 7: logOriginTime (Integer)  (if active log)
 8: fileName (String) (fileOrDevice if active log, else directoryOrDevice)
 9: replicateName (String) (fileOrDevice if active log, else directoryOrDevice)
10: fileId of begin record of oldest transaction in current checkpoint,
	 if active log, otherwise nil"

<primitive: 397>

logDirId _validateClass: SmallInteger.
^ self _primitiveFailed: #_logInfo: .
%

category: 'Transaction Logging'
method: Repository
_currentLogInfo

"Returns the result specified for Repository | _logInfo: for the
 currently active transaction log."

| numLogs logInfo |

numLogs := (System configurationAt: #STN_TRAN_LOG_DIRECTORIES) size .
2 timesRepeat:[ "cope with changing to the next log"
  1 to: numLogs do:[ :j |
    logInfo := self _logInfo: j .
    (logInfo at: 3) == true ifTrue:[
      ^ logInfo 
      ].
    ].
  ].
self _halt:'Unable to determine the current log'.
^ #[ ]
%

! fix bug 11283
category: 'Transaction Logging'
method: Repository
currentTranlogSizeMB

"Returns an Integer that is the size of the currently active transaction log in
 units of Megabytes."

^ self _currentLogInfo at: 5
%

category: 'Repository Usage Reporting'
method: Repository
freeSpaceInExtent: extentFilename

"Returns the number of bytes of free space in the extent with the given name.
 This quantity is equal to the number of free pages in the extent times the
 size of a page.

 If the given file is not an active member of the logical Repository
 represented by the receiver, then this method generates an error."

^(self _dbfStatistics: extentFilename) at: 2
%

category: 'Repository Usage Reporting'
method: Repository
fileSizeOfExtent: extentFilename

"Returns the physical size, in bytes, of the extent with the given name.

 If the given file is not an active member of the logical Repository
 represented by the receiver, then this method generates an error."

^(self _dbfStatistics: extentFilename) at: 1
%

category: 'Repository Usage Reporting'
method: Repository
fileSizeReport

"Returns a string which reports on the name, size, and amount of free space
 for each extent and the size and free space of the entire logical Repository."

| result lf stats repositoryFiles extentFile |

    "Initialize"

result := String new.
lf := Character lf.

    "For each extent, add the information about it."

repositoryFiles := self fileNames.
1 to: self numberOfExtents do: [:i |
    stats := self _extentStatistics: i.
    extentFile := repositoryFiles at: i.
    result addAll: 'Extent #';
           addAll: i asString; add: lf.
    result addAll: '-----------'; add: lf.
    result addAll: '   Filename = ';
           addAll: extentFile; add: lf.
    result addAll: lf  ;
           addAll: '   File size =       ';
           addAll: (self numToMByteString:(stats at: 1)) ; add: lf;
           addAll: '   Space available = ';
           addAll: (self numToMByteString:(stats at: 2)) ; add: lf;
           add: lf .
    ].

    "Add totals"

result addAll: 'Totals'; add: lf.
result addAll: '------'; add: lf.
result addAll: '   Repository size = ';
       addAll: (self numToMByteString: self fileSize) ; add: lf;
       addAll: '   Free Space =      ';
       addAll: (self numToMByteString: self freeSpace ) ; add: lf .

^result
%

category: 'Repository Usage Reporting'
method: Repository
numToMByteString: aNumber

"Convert a number representing a file size in bytes to a formatted
 string reporting the size in megabytes."

| result |
result := String new .
result addAll:
  ((aNumber asFloat / 1048576) asStringUsingFormat:#(3 2 false));
  addAll: ' Megabytes' .
^ result
%

category: 'Repository Usage Reporting'
method: Repository
freeSpace

"Returns an integer that gives the number of bytes of free space in the logical
 Repository.  This quantity is equal to the number of free pages in the
 Repository times the size of a page."

| total |

total := 0.
1 to: self numberOfExtents do:[:j |
   total := total + ((self _extentStatistics: j) at: 2)
   ].
^total
%

category: 'Repository Usage Reporting'
method: Repository
fileSize

"Returns an integer giving the total physical size, in bytes, of all
 of the physical extents that compose the logical Repository."

| total |

total := 0.
1 to: self numberOfExtents do:[:j |
   total := total + ((self _extentStatistics: j) at: 1)
   ].
^total
%

! fixed 33546
category: 'Repository Usage Reporting'
method: Repository
pageSize

"Returns size in bytes of a disk page in the Repository."

^ System _zeroArgPrim:50
%

category: 'Transaction Logging'
method: Repository
startNewLog

"Causes the most current transaction log to be closed and a new transaction log
 to be opened for writing.  The location of the new log is controlled by the
 STN_TRAN_LOG_DIRECTORIES configuration file parameter.

 If GemStone is running in partial logging mode, then a preceding transaction
 log may be deleted.  See documentation on the STN_TRAN_FULL_LOGGING
 configuration parameter for more details.

 If a checkpoint is in progress the operation is NOT performed and a -1
 is returned.  If it is successful the fileId of the new log is returned.

 This method requires the FileControl privilege."

<primitive: 432>

self _primitiveFailed: #startNewLog.
self _uncontinuableError
%

! deleted replicate argument from addTransactionLog
method: Repository
addTransactionLog: deviceOrDirectory  replicate: replicateSpec size: aSize

"Obsolete, replicate arguments is ignored"

^ self addTransactionLog: deviceOrDirectory size: aSize
%

category: 'Transaction Logging'
method: Repository
addTransactionLog: deviceOrDirectory  size: aSize
 
"Add deviceOrDirectory to the configuration parameter STN_TRAN_LOG_DIRECTORIES.
 
 The aSize argument must be a positive SmallInteger; it is added to the value
 of the STN_TRAN_LOG_SIZES configuration parameter.

 This method requires the FileControl privilege."

<primitive: 337>

deviceOrDirectory _validateClass: String .
aSize _validateClass: SmallInteger .
aSize > 0 ifFalse:[ aSize _error: #rtErrArgOutOfRange ] .
^ self _primitiveFailed: #addTransactionLog:size: .
%

category: 'Transaction Logging'
method: Repository
currentLogFile

"Returns a String containing the file name of the transaction log file to which
 log records are being appended.  If the result is of size 0, then a log has
 failed and a replicate is being used."

 ^ System stoneConfigurationAt:#StnCurrentTranLogNames
%

category: 'Transaction Logging'
method: Repository
currentLogDirectoryId

"Returns a positive SmallInteger, which is the one-based offset specifying the
 element of the configuration list STN_TRAN_LOG_DIRECTORIES for the current
 transaction log.  (See also the currentLogFile method.)"

^ (System stoneConfigurationAt:#StnCurrentTranLogDirId) + 1 
%

category: 'Transaction Logging'
method: Repository
currentLogFileId

"Returns a positive SmallInteger, which is the internal fileId of 
 the current transaction log."

^ (self _logInfo: (self currentLogDirectoryId)) at: 4
%

category: 'Transaction Logging'
method: Repository
oldestLogFileIdForRecovery

"Returns a positive SmallInteger, which is the internal fileId of the oldest
 transaction log needed to recover from the most recent checkpoint, if the
 Stone were to fail right now."

^ self _currentLogInfo at: 10
%

category: 'Transaction Logging'
method: Repository
logOriginTime

"Returns the log origin time of the receiver. This is the time when a Stone
 started a new sequence of log files for the receiver. A new sequence of
 logs is started if one of the following occurs:

 * Stone is started using extents that were cleanly shutdown, and without
   any log files being present.

 * Stone is started using extents and no existing logs 
   using the 'startstone -N' command.

 * The commitRestore method is executed, and during preceding 
   restore operations we restored a log file with fileId greater
   than the fileId of the log file being written to during the restore."

^ System stoneConfigurationAt:#StnTranLogOriginTime 
%

category: 'Backup and Restore'
method: Repository
fullBackupTo: fileOrDevice MBytes: mByteLimit

"Produces a full backup file containing the most recently committed version of
 the receiver as of the time the method is executed.

 The argument fileOrDevice (a kind of String) specifies the file or device
 where the backup is to be created.  

 If fileOrDevice does not specify a file on some file system, then it may be a
 device name specifying either a raw disk partition or a tape device.  The
 fileOrDevice argument may use GemStone Network Resource String syntax.  For
 example, this may be used to access a tape device on another machine, provided
 a GemStone NetLDI process is running on the remote machine.  

 If fileOrDevice specifies a file that already exists on a fileSystem, or if it
 specifies a raw disk partition that already contains a GemStone extent,
 transaction log, or backup file, then an error is generated.  Use the removedbf
 utility to erase raw disk partitions.

 The mByteLimit argument, which specifies the maximum size of fileOrDevice in
 units of megabytes, must be a SmallInteger.  The value 0 means that there is
 no limit on the size of the resulting fileOrDevice.  A mByteLimit less than 0
 or greater than 4096000 will generate an error.

 If the backup requires more bytes than you specified in mByteLimit, this method
 returns a message (a String) stating that a partial backup file was created.
 In this case, further commits in this session are disallowed until
 you either complete the full backup with continueFullBackupTo:MBytes: or
 cancel the backup with abortFullBackup.  To continue the backup, you can
 execute the method continueFullBackupTo:MBytes:, which creates the next file
 in the backup sequence.

 If fileOrDevice runs out of space, such as off the end of a tape, the backup
 will terminate with a system I/O error at that point.  The backup will be
 unusable.  To avoid having to repeat the entire backup, make sure the device
 has sufficient space or set mByteLimit appropriately.

 When the size of your GemStone repository exceeds the capacity of a backup
 tape, file system, or raw disk partition, you can use mByteLimit
 (a SmallInteger) to control the maximum number of bytes to be written to the
 backup file.  

 This method puts the session into auto-begin transaction mode and aborts
 the current transaction.  If the repository is not in restore state,
 then this method commits a record of the start of the backup
 to UserGlobals at: #BackupLog;  this commit is done as a checkpoint.
 Then the transaction mode is changed to manual begin, and the remainder of
 the backup operation executes outside of a transaction so that it does not
 cause excessive repository growth.  A varying number of aborts are done while
 outside of a transaction, depending on the time required to execute the backup.

 When the backup completes, the session is always left outside of a transaction
 so that it does not retain a commit record that would cause the repository to
 grow.

 Returns true if the backup was completed.  Returns a message (a String) if
 continueFullBackupTo:MBytes: should be run to complete the backup.

 This method requires the FileControl privilege.

 A GciHardBreak during this method will terminate the session."

  ^ self fullBackupTo: fileOrDevice MBytes: mByteLimit compressed: false
%

category: 'Private'
method: Repository
fullBackupTo: fileOrDevice MBytes: mByteLimit compressed: comprBool

  | logObj uGlobals |

  "check arguments before we bother with a checkpoint"
  fileOrDevice _validateClass: String.
  mByteLimit _validateClass: SmallInteger.

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

  System transactionMode: #autoBegin .
  System beginTransaction.

  (SystemRepository _restoreStatusInfo at: 2) == nil ifTrue:[
    "Repository is not in restore state, so record the start of 
     the backup in the log object."
    uGlobals := (GsSession currentSession resolveSymbol: #UserGlobals) value .
    logObj := uGlobals at:#BackupLog ifAbsent:[
      uGlobals at:#BackupLog put: String new 
      ] .
    logObj add: 'fullBackup to ' + fileOrDevice + ' started at ';
         add: (DateTime now asStringUsingFormat: #[2,1,3,$/,2,1,$:,true,false,false]);
         add: Character lf .

    "with tranlog/replay of dead, commit here, and abort to checkpoint in C."

    System commitTransaction ifFalse:[ ^ self _error: #rtErrMaxCommitRetry ] .
    ].

  ^ self _fullBackupTo: fileOrDevice
        backupId: nil MBytes: mByteLimit firstFile: true compressed: comprBool .
%

category: 'Backup and Restore'
method: Repository
fullBackupCompressedTo: fileOrDevice MBytes: mByteLimit

"Same as fullBackupTo:MBytes: , except that the output file is 
 written compressed in gzip format, and cannot be written to a raw device.
 The output file must be on a local file system; a pgsvr will not be used.

 Backup files written to a file system in compressed mode will have 
 the suffix '.gz' appended to the file name if the specified file name does
 not end with that suffix."

  ^ self fullBackupTo: fileOrDevice MBytes: mByteLimit compressed: true
%

category: 'Backup and Restore'
method: Repository
fullBackupTo: fileOrDevice

"Backup the receiver to a single backup file or tape.  See
 fullBackupTo:MBytes: for further documentation.

 This method requires the FileControl privilege.

 A GciHardBreak during this method will terminate the session."

^ self fullBackupTo: fileOrDevice MBytes: 0
%
category: 'Backup and Restore'
method: Repository
fullBackupCompressedTo: fileOrDevice

"Backup the receiver to a single backup file or tape in gzip format.  See
 fullBackupCompressedTo:MBytes: for further documentation.

 Backup files written to a file system in compressed mode will have 
 the suffix '.gz' appended to the file name if the specified file name does
 not end with that suffix."

^ self fullBackupTo: fileOrDevice MBytes: 0 compressed: true
%

category: 'Backup and Restore'
method: Repository
continueFullBackupTo: fileOrDevice MBytes: mByteLimit

"Continue a full backup by writing a second or subsequent backup file
 as specified by fileOrDevice, with a size limit specified by mByteLimit.

 This method operates outside of a transaction, and leaves the session
 outside of a transaction.  The session may do one or more aborts during
 the execution of the backup to avoid causing excessive repository growth.

 See fullBackupTo:MBytes: for additional description of the arguments.

 Returns true if the backup was completed.  Returns a message (a String) if
 continueFullBackupTo:MBytes: should be run to complete the backup.

 This method requires the FileControl privilege.

 A GciHardBreak during this method will terminate the session."

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

^ self _fullBackupTo: fileOrDevice
    backupId: nil MBytes: mByteLimit
    firstFile: false compressed: false .
%

category: 'Backup and Restore'
method: Repository
continueFullBackupCompressedTo: fileOrDevice MBytes: mByteLimit

"Same as continueFullBackupTo:MBytes:, except that the output file is
 written compressed in gzip format, and cannot be written to a raw device.
 The output file must be on a local file system; a pgsvr will not be used.

 Backup files written to a file system in compressed mode will have 
 the suffix '.gz' appended to the file name if the specified file name does
 not end with that suffix."

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

^ self _fullBackupTo: fileOrDevice
    backupId: nil MBytes: mByteLimit
    firstFile: false compressed: true .
%

category: 'Backup and Restore'
method: Repository
abortFullBackup

 <primitive: 474>

"Cancel a full backup that is in progress.  If fullBackupTo: has been used to
 start a multi-file backup, but continueFullBackupTo:MBytes: has not been
 executed to completion of the backup, you can use abortFullBackup to cancel
 the full backup and permit this session to commit and abort.

 This method requires no privileges.  If a backup is not in progress, this
 has no effect."

  self _primitiveFailed: #abortFullBackup.
  self _uncontinuableError
%

category: 'Private'
method: Repository
_fullBackupTo: fileOrDevice
  backupId: backupIdOrNil
  MBytes: mByteLimit
  firstFile: firstFileBool
  compressed: compressBool

"Private.  Provides implementation of backup methods.

 Returns true if the backup was completed.  Returns a message (a String) if
 continueFullBackupTo:MBytes: should be run to complete the backup.

 A GciHardBreak during this method will terminate the session."

  <primitive: 394>

  fileOrDevice _validateClass: String.
  backupIdOrNil _validateClass: SmallInteger.  "should be positive"
  mByteLimit _validateClass: SmallInteger.
  firstFileBool _validateClass: Boolean .
  compressBool _validateClass: Boolean .
  self _primitiveFailed: #_fullBackupTo:backupId:MBytes:firstFile:compressed: .
%

! fix bug 11451, comments re: bug 12266
category: 'Backup and Restore'
method: Repository
restoreFromBackup: fileOrDevice

"If a restore is not in progress, starts a full restore of the receiver by
 initializing a shadow object space and reading the first backup file into that
 space.  Normal commits are disallowed while a restore is in progress.

 If a restore is in progress, continues the restore by reading a second or
 subsequent backup file from a multi-file backup set.

 Unless an error occurs during the start of the restore, such as
 invalid file name, this method will end by generating a fatal error
 which terminates the current session.  A new session must be logged in
 after each successful restore operation, to see the new state of
 persistent object space .
 
 Use the method restoreStatus to determine whether a restore is in progress
 or not, and the next file expected in a multiple file restore.   Use the
 method abortRestore to cancel a restore that stopped prematurely due to
 fileOrDevice being truncated or corrupt, before attempting the restore
 with a good copy of fileOrDevice.

 If the fileOrDevice is the last backup file in a backup set, the shadow object
 space is automatically made visible to GemStone Smalltalk at the completion of
 this method, and if GemStone was in full-logging mode at the time of the
 backup, the object server is made ready for restore from tranlogs.  
 This installation of the restored object table terminates GemStone Smalltalk 
 execution AND TERMINATES THE CURRENT SESSION.  
 You must do a fresh login to see the results of the restore.
 Once the last file backup file in a backup set has been restored, the
 restore status of the Repository will persist across sessions and shutdowns of
 the Stone.

 If the fileOrDevice is the last backup file in a backup set and GemStone
 was in partial logging mode at the time of the backup, then the Repository
 is ready for normal use after the restore of the file.

 If the last file of a backup set has not yet been restored, the shadow object
 space is thrown away if this session logs out, or if abortRestore is executed.
 After a fresh login the restore would have to be restarted with the first
 backup file again.

 After restoring the last file in a series of backups, this method terminates
 GemStone Smalltalk execution and does an automatic logout and you need
 to relogin to continue.   If it is not the last file in the backup, then 
 the result is either a String  describing the success of the operation 
 (in which case the Topaz result (obj **)  may be nil), or an error message.  

 The backup file must have been previously created with one of the following:
 fullBackupTo:,  fullBackupTo:MBytes:, continueFullBackupTo:MBytes:,
 fullBackupCompressedTo:, fullBackupCompressedTo:MBytes:, or
 continueFullBackupCompressedTo:MBytes: .  The restore operation will
 automatically attempt to open a file in compressed mode with and without
 appending a '.gz' suffix if reading the file as uncompressed does not
 succeed.

 Restored objects will be clustered in a manner that is similar, but not
 necessarily identical, to the clustering organization at the time the backup
 file was created.  

 If the Repository being restored into has the same number of extents as the
 Repository from which the full backup was made, then distribution of objects
 within extents is preserved.  In this case the DBF_ALLOCATION_MODE
 configuration parameter is ignored during the restore, unless an extent hits a
 size limit specified by DBF_EXTENT_SIZES.  If the number of extents differs,
 then the DBF_ALLOCATION_MODE configuration parameter at the time of the restore
 will control distribution of objects across the extents.  The number of extents
 recorded in the backup file is the number of extents as of the start of the
 full backup.   

 You must be the only user logged in, otherwise an error is generated.  This
 method suspends logins.  Logins will be reenabled when one of the following
 occurs:

 1) this session logs out.
 2) the last backup files(s) of a backup have been restored, and the backup was
    made when in partial logging mode.
 3) commitRestore succeeds.

 It is recommended that the Stone be restarted on a copy of the initial
 Repository, $GEMSTONE/bin/*.dbf, before executing this method, in order to
 minimize the size of the restored Repository.

 The Gc Gems and Symbol Creation Gems are shutdown at the start of
 this method.  If this method succeeds, then these Gems remain shut down
 until restoreFromCurrentLogs has been successfully executed, otherwise
 the they will be restarted.

 This method requires the FileControl privilege.  It is recommended that you
 run as either DataCurator or SystemUser.

 A GciHardBreak during this method will terminate the session.

 If the session is using a shared page cache, then the asynchronous I/O function
 of the Stone's page server process is made more aggressive.  The following
 settings are automatically active for the duration of this method:

   System configurationAt:#StnMntMaxAioRate put: 1000 .
   System configurationAt:#ShrPcTargetPercentDirty put: 5 ."

self _waitForGcStartup .
^ self _restoreFrom: fileOrDevice opcode: 0
%

! fix bug 9480
category: 'Backup and Restore'
method: Repository
restoreFromBackups: arrayOfFilesOrDevices

"Restore multiple backup files.  Equivalent to executing restoreFromBackup:
 once for each element of arrayOfFilesOrDevices.  The arrayOfFilesOrDevices
 argument must be an Array not larger than 200 elements.

 When executed using Topaz, the result is either a String describing the success
 of the operation (in which case the Topaz result (obj **) may be nil), or an
 error message.  

 This method requires the FileControl privilege.  It is recommended that you
 run as either DataCurator or SystemUser.

 A GciHardBreak during this method terminates the session.

 See restoreFromBackup: for further documentation."

self _waitForGcStartup .
^ self _restoreFrom: arrayOfFilesOrDevices opcode: 7
%

category: 'Backup and Restore'
method: Repository
abortRestore

"If a restore from backups is in progress, this method
 cancels the restore, and reenables logins.  The Repository reverts to the
 state prior to starting the restore.

 If the last file of a backup has been successfully restored, or a restore from
 a multifile backup is not in progress, this method has no effect.

 Note that this method has no effect if a restore from backup has completed
 and restore from transaction logs is in progress.  To stop restoring
 transaction logs you must use commitRestore.

 Returns true.

 This method requires the FileControl privilege.  It is recommended that you
 run as either DataCurator or SystemUser.

 If a backup file read with restoreFromBackup: is truncated or corrupt, 
 it may be necessary to execute abortRestore before restoreFromBackup:
 can be used to restart the restore from a good copy of the backup file."

^ self _restoreFrom: nil opcode: 1
%

category: 'Backup and Restore'
method: Repository
restoreFromCurrentLogs

"After a restoreFromBackup: returns true, this method may be executed to redo
 transactions which occurred since the backup was made.  This method re-does
 all transactions contained in the log files that are in Stone's current log
 directories or devices as defined by the STN_TRAN_LOG_DIRECTORIES
 configuration file parameter.

 When executed using Topaz, the result is either a String describing the success
 of the operation (in which case the Topaz result (obj **) may be nil), or an
 error message.

 At the completion of this method, the CURRENT SESSION IS TERMINATED.
 You must do a fresh login after each tranlog restore operation.

 If some log files written since the restored backup file(s) were generated are
 no longer on-line, those off-line logs must be processed using the
 restoreFromArchiveLogs method before this method can be used.

 When opening a log file on a file system, if the filename ends in '.gz',
 the file is expected to be in gzip compressed format, and will be
 opened as such.  Restoring a compressed tranlog from a raw 
 partition is not supported.

 If GemStone was using partial-logging mode at the time restored backup
 file(s) were written then restoreFromCurrentLogs is not allowed.

 You must be the only user logged in, otherwise an error is generated.

 This method requires the FileControl privilege.  It is recommended that you
 run as either DataCurator or SystemUser.  This method puts the session into
 #manualBegin transaction mode.

 Note that restore status is an attribute of the Repository, not of a
 session, so the required preceding restoreFromBackup: could have been
 executed in some preceding session."

System transactionMode: #manualBegin .
System abortTransaction .

^ self _restoreFrom: nil opcode: 4 .
%

! fix bug 8824
category: 'Backup and Restore'
method: Repository
restoreToEndOfLog: aFileId

"After a restoreFromBackup: returns true, this method may be
 executed to redo transactions which occurred since the backup was made.
 This method re-does all transactions up to the end of the specified log file.

 aFileId must be a positive SmallInteger.

 If a setArchiveLogDirectories... or restoreFromArchiveLogs... method
 has been executed since the previous startstone, then
 log files are read from those archive logs directories. Otherwise
 log files are read from directories specified by stone's STN_TRAN_LOG_DIRECTORIES
 configuration file parameter.

 When executed using Topaz, the result is either a String describing the success
 of the operation (in which case the Topaz result (obj **) may be nil), or an
 error message.  

 At the completion of this method, the CURRENT SESSION IS TERMINATED.
 You must do a fresh login after each tranlog restore operation.
 
 Log files must be restored in time-sequence starting from the log file
 that was active at the time backup was made.

 When opening a log file on a file system, if the filename ends in '.gz',
 the file is expected to be in gzip compressed format, and will be
 opened as such.  Restoring a compressed tranlog from a raw 
 partition is not supported.

 Use the restoreStatus method to determine the next file required for a restore
 operation.  Note that restore status is an attribute of the Repository, not of
 a session, so the required preceding restoreFromBackup: could have been
 executed in some preceding session.

 If GemStone was using partial-logging mode at the time restored backup
 file(s) were written then this method is not allowed.

 You must be the only user logged in, otherwise an error is generated.

 This method requires the FileControl privilege.  It is recommended
 that you run as either DataCurator or SystemUser.  This method puts the
 session into #manualBegin transaction mode."

aFileId _validateClass: SmallInteger.
aFileId > 0 ifFalse:[ aFileId _error: #rtErrArgNotPositive ].
System transactionMode: #manualBegin .
System abortTransaction .

^ self _restoreFrom: aFileId opcode: 5 .
%

! gemstone64 , v1.1  restoreStatus no longer requires FileControl privilege.
category: 'Backup and Restore'
method: Repository
restoreStatus

"Returns a String describing the current restore status of the Repository,
 including the next transaction log file or backup file required to continue
 the restore, and the oldest transaction log file that must be present
 for a restore from log.

 Restore status is an attribute of the Repository, not of the session, 
 and persists across logout/login and stopstone/startstone."

^ self _restoreStatusInfo at: 1
%

category: 'Backup and Restore'
method: Repository
restoreStatusNextFileId

"Returns a SmallInteger, the fileId of the next transaction log or backup that
 should be restored, or nil if restore not active.

 Restore status is an attribute of the Repository, not of the session, 
 and persists across logout/login and stopstone/startstone."

^ self _restoreStatusInfo at: 3 .
%

category: 'Backup and Restore'
method: Repository
restoreStatusOldestFileId

"Returns a SmallInteger, the fileId of the oldest transaction log 
 that needs to be present for the next restore from log operation,
 or nil if restore not active.

 Restore status is an attribute of the Repository, not of the session, 
 and persists across logout/login and stopstone/startstone."

^ self _restoreStatusInfo at: 8 .
%

! gemstone64 , v1.1  restoreStatus no longer requires FileControl privilege.
category: 'Backup and Restore'
method: Repository
_restoreStatusInfo

"Returns an Array describing the current restore status of the Repository,
 including the next transaction log file or backup file required to continue
 the restore.  The Array contains the following elements:

   1: a String describing the restore status.
   2: a SmallInteger, 1 = active from backup, 2 = active from log
   3: a SmallInteger, next fileId to restore 
   4: a SmallInteger, next blockId to restore
   5: an Integer,  firstStartupTime of the repository
   6: an Integer,  commitSequence.high of the repository
   7: an Integer,  commitSequence.low of the repository
   8: a SmallInteger, fileId of oldest tranlog that must be present for restore.

 If restore is not active, the elements 2 to 8 are nil.

 Restore status is an attribute of the Repository, not of the session, 
 and persists across logout/login and stopstone/startstone."

^ self _restoreFrom: nil opcode: 6 .
%

category: 'Backup and Restore'
method: Repository
commitRestore

"Terminates a restore operation and permits normal commits.  Returns true if the
 commit of the restores succeeded.  Otherwise, either returns a String
 describing a warning or generates an error.

 The restore operation must have been started with restoreFromBackup:.
 Otherwise, this method generates an error.

 If restoreFromCurrentLogs was not the immediately preceding restore operation,
 then a warning is issued, but the termination of restore will succeed.  Such
 use of commitRestore can result in failure to restore all previously committed
 transactions.  However, this allows a Repository to be restored as far as
 practical when some log files are lost or corrupted.

 If GemStone was using partial-logging mode at the time restored backup file(s)
 were written, or if GemStone is currently in partial-logging mode
 (STN_TRAN_FULL_LOGGING is false in the Stone's configuration file), then
 commitRestore is not needed, since the last restoreFromBackup: will have
 committed the restore.

 You must be the only user logged in, otherwise an error is generated.
 The restoreFromBackup: that started the restore process will have
 suspended logins, and a successful commitRestore will reenable logins.

 The session is put into #manualBegin transaction mode, and is left outside
 of a transaction after this method executes.

 This method requires the FileControl privilege.  It is recommended
 that you run as either DataCurator or SystemUser."

^ self _restoreFrom: nil opcode: 2 .
%

category: 'Backup and Restore'
method: Repository
_destroyOtAndRestoreFrom: fileOrDevice

"Private.  Use this method at your own peril.

 Delete all existing objects and then do a full restore from the specified file.
 You must be the only user logged in and you must be SystemUser.  Logins are
 suspended during the execution of this method.  This commits the restore
 automatically and kills your session.

 This is used to create the smallest possible resulting Repository from a
 restore, and is intended for use during filein of kernel classes or of a
 schema, such as to generate a master Repository for distributing with a
 packaged application.

 This method requires the #FileControl privilege."

^ self _restoreFrom: fileOrDevice opcode: 3
%

category: 'Backup and Restore'
method: Repository
_waitForGcStartup

"Private .
 
 Used prior to restore from backup files 
 to wait for completion of any gc gem startups 
 that are in progress, such as after a previous commitRestore ,
 before we attempt another restore."

(SystemRepository _restoreStatusInfo at: 2) == nil ifTrue:[
  "no restore active, so wait 5 seconds for gc gem startups to complete."
  (System waitForAllGcGemsToStartForUpToSeconds:5 ) ifFalse:[
    GsFile gciLogClient:'--- missing some Gc Gems before restore'. 
  ].
].
%

category: 'Backup and Restore'
method: Repository
_restoreFrom: fileOrDevice opcode: anInt

"Private.  GemStone internal use only.  Use this method at your own peril.

 opcodes: 0 = restoreFromBackup.  Shuts down the GcGem.
          1 = abortRestore
          2 = commitRestore
          3 = destroy existing objects prior to restore; this requires that you
              be SystemUser, that you be the only user, and that the backup
              being restored be in a single file.  This commits the restore
              automatically and kills your session, and is used to create the
              smallest possible resulting Repository.  Shuts down the GcGem.
          4 = restore from current logs.
          5 = restore to end of log with specified fileId.
          6 = _restoreStatusInfo 
          7 = restore multiple backup files.  fileOrDevice is an Array of
	      files or devices.
          8 = timeToRestoreTo: aGmtTime (SmallInteger). 
          9 = restore from archive logs.
         10 = restore multiple backup files without creating shadow pages." 

<primitive: 395>
| argArray |
anInt _validateClass: SmallInteger.
anInt >= 8 ifTrue:[
  anInt == 8 
    ifTrue:[ fileOrDevice _validateClass: SmallInteger ]
    ifFalse:[ 
      anInt == 9 ifTrue:[fileOrDevice _validateClass: UndefinedObject ]
                 ifFalse:[ anInt _error: #rtErrArgOutOfRange "bad opcode" ].
      ].
  ]
ifFalse:[
  anInt <= 6 
    ifTrue:[ argArray := #[ fileOrDevice ] ]
    ifFalse:[ fileOrDevice _validateClass: Array .
	      argArray := fileOrDevice .
	    ].
  argArray _validateClass: Array .
  argArray size <= 0 ifTrue:[ argArray _error: #objErrCollectionEmpty ] .
  argArray size > 200 ifTrue:[ argArray _error: #rtErrArgOutOfRange ].
  argArray do:[ :aFileSpec | | argSize |
    aFileSpec _validateClass: String .
    argSize := aFileSpec size .
    (argSize < 1 _or:[ argSize > 1000]) 
	 ifTrue:[ aFileSpec _error: #rtErrArgOutOfRange ] .
    ] .
  ].
self _primitiveFailed: #_restoreFrom:opcode: .
self _uncontinuableError
%

! convertFrom deleted

category: 'Backup and Restore'
method: Repository
timeToRestoreTo: aDateTime

"Sets the time at which restoreFromCurrentLogs , restoreFromArchiveLogs,
 and restoreToEndOfLog: will stop.
 The restore will stop at the first checkpoint which originally occurred at or
 after aDateTime.  If timeToRestoreTo: has not been used since
 restoreFromBackup: completed, then restores will proceed to the end of the
 specified transaction log(s).

 An error is generated if aDateTime precedes the time of the last restored
 checkpoint, as shown by restoreStatus.  An error is generated if the receiver
 is not in restore-from-log state.

 Execution of restoreFromBackup: or commitRestore will cancel the effect of any
 previous execution of timeToRestoreTo:.

 If restore has stopped at a time specified by this method, then a subsequent
 restore may be used to continue restoring past the time specified by the last 
 timeToRestoreTo:.  Alternatively, timeToRestoreTo: can be used to specify 
 another point in time before continuing the restore.

 This method requires the FileControl privilege."

| aTimeT t0seconds localToGmtSeconds|

aDateTime _validateClass: DateTime .
t0seconds := (DateTime fromString:'01/01/1970 00:00:00') asSeconds .
localToGmtSeconds := 
  System timeGmt - (DateTime now asSeconds - t0seconds) .

aTimeT := aDateTime asSeconds - t0seconds + localToGmtSeconds .
(aTimeT < 0 _or:[ aTimeT > 16r7fffffff]) ifTrue:[
  aDateTime _error: #rtErrArgOutOfRange 
  ].

^ self _restoreFrom: aTimeT opcode: 8
%

! lastBackup - deleted
! lastRestore - deleted
category: 'Private'
method: Repository
_writeFdcArray: anArray toFile: aFileNameString
"Given an array of objects produced by the one of the _findDisconnectedObjectsAndWriteToFile:
 methods, write the array of objects to a file which can be loaded by the
 markGcCandidatesFromFile: method.

 anArray must be an array object and contain objects sorted by object ID.
 aFileNameString must be an instance of String that refers to a file which
 does not yet exist."

<primitive: 557>
anArray _validateClass: Array.
aFileNameString _validateClass: String.
self _primitiveFailed: #_writeFdcArray:toFile: .
self _uncontinuableError.
%

category: 'Garbage Collection'
method: Repository
writeFdcArrayToFile: aFileNameString
"Write the array of dead objects found by the last findDisconnectedObjects
 (FDC) to the specified file.  The file is created by this method and
 must not exist when it is called.

 anArray must be an array object and contain objects sorted by object ID.
 The primitive will fail if the objects are not in order.

 aFileNameString must be an instance of String that refers to a file which
 does not yet exist.

 Returns true if successful, false if the entire file could not be written,
 or nil if the results of the last FDC could not be found."

 |array theSize result|
 array := Globals at: #FdcResults otherwise: nil.
 (array == nil)
  ifTrue:[^nil].
 (array size < 3)
  ifTrue:[^nil].
 array := array at: 3.
 (array class == Array)
    ifFalse:[^nil].
 theSize := array size.
 (theSize == 0)
   ifTrue:[^nil].
 result := self _writeFdcArray: array toFile: aFileNameString.
 ^result == theSize.
%


! added abort before cleanupMgcResultsForMgc to fix 32001
category: 'Garbage Collection'
method: Repository
basicFindDisconnectedObjectsAndWriteToFile: aFileNameString pageBufferSize: anInt saveToRepository: saveToRep numCacheWarmers: numWarmers
"Perform a markForCollection on the system and write the list of
 dead objects to given file.  If saveToRep is true, also store the results
 in the array under the key #FdcResults in Globals.

 To save the dead objects to an array but not write them to a file, set
 aFileNameString to nil and saveToRep to true.  It is illegal for 
 aFileNameString to be nil and for saveToRep to be false.

 This method aborts the current transaction.

 This method will return an error if the repository is in restore mode.

 If numWarmers is greater than zero, then this number of GC cache warmer
 gems will be automatically started.  GC cache warming gems will
 read pages needed by the FDC gem into the shared page cache before 
 the pages are needed, thus reducing the duration of the FDC.  Using
 GC cache warming gems causes this method to run in transaction
 (and can cause a commit record backlog).  

 *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
 Care should be taken when running in cache warming mode as the GC cache
 warmer sessions and the FDC session may consume all available 
 CPU and disk I/O system resources.

 See also the comments in the method
  Repository>> _findDisconnectedObjectsAndWriteToFile: aFileNameString
               pageBufferSize: anInt
               resultArray: aCommittedArray
               numCacheWarmers: numWarmers.

 for a desciption of the result array and a more detailed description of
 this method."

|fdcResults arrayOfDead inRestoreMode|

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

(System transactionMode == #autoBegin)
  ifFalse:[System transactionMode: #autoBegin].

inRestoreMode := (SystemRepository _restoreStatusInfo at: 2) ~~ nil.
inRestoreMode
  ifTrue:[^self _error: #rtErrCommitDbInRestore].

System abortTransaction.
self cleanupMgcResultsForMgc: false.
System commitTransaction
  ifFalse:[^self _error: #rtErrGcCommitFailure].
self cleanupFdcResultsForMgc: false.
fdcResults := Globals at: #FdcResults.

arrayOfDead := fdcResults at: 3.
saveToRep
  ifTrue:[
    (arrayOfDead == nil)
        ifTrue:[fdcResults at: 3 put: Array new].]
  ifFalse:[fdcResults at: 3 put: nil].

System commitTransaction
  ifFalse:[^self _error: #rtErrGcCommitFailure].

^self _findDisconnectedObjectsAndWriteToFile: aFileNameString
      pageBufferSize: anInt
      resultArray: fdcResults
      numCacheWarmers: numWarmers.
%

category: 'Garbage Collection'
method: Repository
findDisconnectedObjectsAndWriteToFile: aFileNameString pageBufferSize: anInt saveToRepository: saveToRep
"Perform a markForCollection on the system and write the list of
 dead objects to given file.  If saveToRep is true, also store the results
 in the array under the key #FdcResults in Globals.

 To save the dead objects to an array but not write them to a file, set
 aFileNameString to nil and saveToRep to true.  It is illegal for 
 aFileNameString to be nil and for saveToRep to be false.

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

 This method will return an error if the repository is in restore mode.

 See the comments in the method
  Repository>> _findDisconnectedObjectsAndWriteToFile: aFileNameString
               pageBufferSize: anInt
               resultArray: aCommittedArray
               numCacheWarmers: numWarmers.

 for a desciption of the result array and a more detailed description of
 this method."
^ self basicFindDisconnectedObjectsAndWriteToFile: aFileNameString 
       pageBufferSize: anInt 
       saveToRepository: saveToRep 
       numCacheWarmers: 0
%

category: 'Garbage Collection'
method: Repository
findDisconnectedObjectsAndWriteToFile: aFileNameString pageBufferSize: anInt saveToRepository: saveToRep numCacheWarmers: numWarmers
"Perform a markForCollection on the system and write the list of
 dead objects to given file.  If saveToRep is true, also store the results
 in the array under the key #FdcResults in Globals.

 To save the dead objects to an array but not write them to a file, set
 aFileNameString to nil and saveToRep to true.  It is illegal for 
 aFileNameString to be nil and for saveToRep to be false.

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

 If numWarmers is greater than zero, then this number of GC cache warmer
 gems will be automatically started.  GC cache warming gems will
 read pages needed by the FDC gem into the shared page cache before 
 the pages are needed, thus reducing the duration of the FDC.  Using
 GC cache warming gems causes this method to run in transaction
 (and can cause a commit record backlog).  

 The page buffer size (expressed in pages) used by the mark sweep
 algorithm is specified by anInt, which must be a SmallInteger greater
 than or equal to 16.

 *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
 Care should be taken when running in cache warming mode as the GC cache
 warmer sessions and the FDC session may consume all available 
 CPU and disk I/O system resources.

 This method will return an error if the repository is in restore mode.

 See the comments in the method
  Repository>> _findDisconnectedObjectsAndWriteToFile: aFileNameString
               pageBufferSize: anInt
               resultArray: aCommittedArray
               numCacheWarmers: numWarmers.

 for a desciption of the result array and a more detailed description of
 this method."

^ self basicFindDisconnectedObjectsAndWriteToFile: aFileNameString 
       pageBufferSize: anInt 
       saveToRepository: saveToRep 
       numCacheWarmers: numWarmers
%

category: 'Garbage Collection'
method: Repository
findDisconnectedObjectsAndWriteToFileUsingCacheWarmers: aFileNameString

"Run an FDC operation using n GC cache warmer gems where n is equal to
 the number of extents in the repository.   This method aborts the current 
 transaction; if an abort would cause unsaved changes to be lost, it 
 signals an error, #rtErrAbortWouldLoseData. It runs in transaction for
 its entire duration.
        
 Requires the #GarbageCollection privilege.

 For important warnings and more information, refer to the comments
 in the method:

  Repository>> _findDisconnectedObjectsAndWriteToFile: aFileNameString
               pageBufferSize: anInt
               resultArray: aCommittedArray
               numCacheWarmers: numWarmers. "

   
^ self basicFindDisconnectedObjectsAndWriteToFile: aFileNameString 
       pageBufferSize: 3000 
       saveToRepository: false 
       numCacheWarmers: self numberOfExtents.
%

category: 'Private'
method: Repository
_findDisconnectedObjectsAndWriteToFile: aFileNameString pageBufferSize: anInt resultArray: aCommittedArray numCacheWarmers: numWarmers


"Run a markForCollection on the repository but do not report the dead
 objects to the stone.  The dead objects are instead stored to an 
 Array, a file, or both.  This is method never causes any objects to
 be deleted.

 If aFileNameString is not nil, create this file and write the list of 
 dead object identifiers to the file in a binary format.  The file
 specified in aFileNameString is created by this method and must not
 exist when the method is called.  aFileNameString must be an instance
 or subclass of String.  The resulting file may be used by the
 _markGcCandidatesFromFile method in this class.  The size of the
 file in bytes will be approximately 4 times the number of dead objects
 found. 

 Be careful to ensure there is sufficient disk space to write
 the entire list of dead objects when using this method with large
 repositories.

 aCommittedArray is expected to be a committed array object of size 4.
 If successful, this method stores the following values in aCommitted array:

	1 - anInteger representing the number of live objects found.
	2 - anInteger representing the number of dead objects found.
	3 - anArray containing the dead objects, false if a commit failed,
            or nil if the list of dead objects is not stored in the repository.
	4 - a Boolean or nil indicating if the dead objects were successfully 
            written to the file.

 Element 3 will be false if a commit conflict occurred while storing dead
 objects into the array.  Setting element 3 to nil indicates that the dead
 objects are to be written to the file only and not stored in the repository.
 Otherwise the array in element 3 will contain the list of dead objects when
 the method completes.

 Element 4 of the result array will be nil if aFileNameString is nil, indicating 
 the dead objects were only be stored in aCommittedArray.  Element 4 will be
 false if an error was detected while writing to the file.   Usually this
 condition is caused by insufficient file system space.  If this condition
 occurs and element 3 was not nil, the method will continue to store the dead
 objects in the array.  If no error occurs writing the dead object identifiers
 to the file, element 4 will be true when the method completes.

 Either aFileNameString or aCommittedArray may be nil but it is an error
 if both are nil.

 The page buffer size (expressed in pages) used by the mark sweep
 algorithm is specified by anInt, which must be a SmallInteger greater
 than or equal to 16.

 If numWarmers is greater than zero, then this number of GC cache warmer
 gems will be automatically started.  GC cache warming gems will
 read pages needed by the FDC gem into the shared page cache before 
 the pages are needed, thus reducing the duration of the FDC.  Using
 GC cache warming gems causes this method to run in transaction
 (and can cause a commit record backlog).  

 *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
 Care should be taken when running in cache warming mode as the GC cache
 warmer sessions and the FDC session may consume all available 
 CPU and disk I/O system resources.

 This method requires the GarbageCollection privilege.

 This method aborts the current transaction.

 This method acquires the GC lock from the stone.  No other garbage
 collection operations may be started or in progress while this method
 is running.  There also must be no outstanding possible dead objects
 on the system or else the GC lock will not be granted.

 Pre-existing dead objects (i.e., objects which reside in the stone's
 deadNotReclaimed set) are ignored and are not returned by this method.

 The output file will be deleted if this method encounters an error."

<primitive: 430>

aCommittedArray _validateClass: Array.
anInt _validateClass: SmallInteger.
numWarmers _validateClass: SmallInteger.
(aCommittedArray size == 4)
  ifFalse:[aCommittedArray _error: #rtErrArgOutOfRange ].
((aCommittedArray at: 3)== nil)
  ifTrue:[aFileNameString _validateClass: String].
(aFileNameString == nil) 
  ifTrue:[(aCommittedArray at: 3) _validateClass: Array].
self _primitiveFailed: #_findDisconnectedObjectsAndWriteToFile:pageBufferSize:resultArray:numCacheWarmers: .
self _uncontinuableError
%

category: 'Private'
method: Repository
_markGcCandidatesFromFile: aFileNameString forceOnError: aBoolean resultArray: aCommittedArray errorLimit: errLim readOnly: aBool

"Performs a garbage collection analysis on the objects in the given file by
 scanning the Repository for other references to them.  Objects are marked for
 subsequent reclaiming of storage space if the only references to candidate
 objects are from other candidates.

 aFileNameString is expected to be a String contaning the full path to a file
 containing dead objects.  This file is produced by the method:

 Repository>>findDisconnectedObjectsAndWriteToFile:
             pageBufferSize:
             saveToRepository: 

 If aFileNameString is nil, no file is loaded and the list of candidates
 is instead assumed to reside in the GcCandidates hidden set.

 All candidate objects are first validated.  A candidate object is valid if
 the following conditions are all true:
   -the object is not a reserved object (not part of the GemStone kernel).
   -the object exists in the object table.
   -the object is not in the stone's list of dead not reclaimed objects.

 If aBoolean is true, then the markGcCandidates method is run even if one
 or more objects fail validation.  If aBoolean is false, then the
 markGcCandidates operation is not run unless all objects are successfully
 validated.

 Setting aBoolean to true also causes the MGC to proceed with the second
 phase of the MGC if any objects were found to be not dead in the first
 phase.  This will happen if any candidate object is referenced by any
 other object that is not a candidate.  If aBoolean is false, the MGC
 will exit if any candidate object is found to be not dead in the first
 phase.  In this case, no dead objects sent to the stone.

 If aBool is true, the MGC runs in read-only mode.  In this mode, 
 the candidates determined to be dead objects are not sent to stone and
 no objects will be reclaimed as a result of this operation.  
 All other MGC functions are performed as described.  In read-only
 mode, the MGC stores the dead objects that would have been passed to the
 stone into hidden set 34 (GcCandidates).

 aCommittedArray must be a committed instance of Array with a size of 7.
 Elements 4 and 7 must be committed instances of Array, both with a size of
 zero.  When the method completes successfully, aCommittedArray is returned
 and will contain the following values:

	Array[1] = number of candidate objects.
	Array[2] = number of candidates objects that passed validation.
	Array[3] = number of candidates objects that failed validation.
	Array[4] = array of Integer objects.  These are the object ID's
                   of candidate objects that failed validation (subject
                   to errLim; see below).
	Array[5] = number of candidates objects that were recorded dead.
                   This is the number of possible dead objects reported
                   to the stone.
	Array[6] = number of candidates objects that were determined to be
                   not dead because they were referenced by an object which
                   was not a candidate object.  This is the number of not
                   dead candidate objects found during the first phase of
                   the MGC.
	Array[7] = array of not dead candidates objects found during the
                   first phase of the MGC (subject to errLim; see below).
                   Objects in this array are candidate objects directly
                   referenced by one or more objects that are not
                   candidates.
		
 The maximum number of candidate objects returned in elements 3 and 7 is
 determined by the value of errLim.  For example, to store no more than
 100 error objects, set errLim to be 100.  To enable returning all objects,
 set the errLim arg to -1.  A setting of zero will prevent any error
 objects from being stored in the arrays.

 This method may fail with an error if a markForCollection or
 other garbage caCommittedArrayollection operation is in progress.  It will also fail if
 outstanding possible dead objects from previous garbage collection operations
 exist.  If this happens the markGcCandidates should be retried later.

 This method requires the GarbageCollection privilege.

 This method aborts the current transaction.
	
 A GciHardBreak during this method will terminate the session."

<primitive: 324>
(aFileNameString == nil)
  ifFalse:[aFileNameString _validateClass: String].
aBoolean _validateClass: Boolean.
aBool _validateClass: Boolean.
aCommittedArray _validateClass: Array.
errLim _validateClass: SmallInteger.
(aCommittedArray size == 7)
  ifFalse:[aCommittedArray _error: #rtErrArgOutOfRange ].
(aCommittedArray at: 4)  _validateClass: Array.
(aCommittedArray at: 7)  _validateClass: Array.
self _primitiveFailed: #_markGcCandidatesFromFile:forceOnError:resultArray:errorLimit: .
self _uncontinuableError
%

category: 'Private'
method: Repository
cleanupFdcResultsForMgc: forMgc
"Delete the results produced by a previous markGcCandidates operation.
 If the caller intends to run a markGcCandidates, then forMgc should
 be true."

|t |
t := Globals at: #FdcResults otherwise: nil.
(t == nil)
  ifTrue:[
	t := Array new: 4.
        t at: 3 put: Array new.
        Globals at: #FdcResults put: t.
  ].

t at: 1 put: 0.
t at: 2 put: 0.
self cleanupBigArray: (t at: 3) forMgc: forMgc.
t at: 4 put: false.
^true
%

! changes to fix 31955 
category: 'Private'
method: Repository
cleanupBigArray: array forMgc: forMgc

"Empty the array.  If forMgc is true, we must set every 
 element to nil to avoid stray references in the 
 repository.  Otherwise we can just size the array to
 zero."

| maxTempBytes elemPerCommit count |
(array == nil) ifFalse:[
  forMgc ifTrue:[
     maxTempBytes := System _tempObjSpaceMax .

        " maxTempBytes * 0.30 / (8 bytes per in-memory element) "
     elemPerCommit := ((maxTempBytes // 10) * 3) // 8 .

     count := 0 .
     1 to: array size do:[:n|
        array at: n put: nil.
        count := count + 1 .
        count >= elemPerCommit ifTrue:[
          System commitTransaction ifFalse:[ self _error: #rtErrGcCommitFailure ].
          count := 0 .
        ]
     ].
     count > 0 ifTrue:[
       System commitTransaction ifFalse:[ self _error: #rtErrGcCommitFailure ].
     ].
  ].
  array size: 0.
].
%

category: 'Private'
method: Repository
cleanupMgcResultsForMgc: forMgc

|t|
t := Globals at: #MgcResults otherwise: nil.
(t == nil)
  ifTrue:[
	t := Array new: 7.
        t at: 4 put: Array new.
        t at: 7 put: Array new.
        Globals at: #MgcResults put: t.].

t at: 1 put: 0.
t at: 2 put: 0.
t at: 3 put: 0.
self cleanupBigArray: (t at: 4) forMgc: forMgc.
t at: 5 put: 0.
t at: 6 put: 0.
self cleanupBigArray: (t at: 7) forMgc: forMgc.
^true.
%

category: 'Garbage Collection'
method: Repository
basicMarkGcCandidatesFromFile: aFileNameString forceOnError: aBoolean readOnly: aBool
"Performs a garbage collection analysis on the objects in the given file by
 scanning the Repository for other references to them.  Objects are marked for
 subsequent reclaiming of storage space if the only references to candidate
 objects are from other candidates.

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

 See the method Repository>>_markGcCandidatesFromFile: aFileNameString
                            forceOnError: aBoolean
                            resultArray: aCommittedArray
                            errorLimit: errLim
                            readOnly: aBool

 for more information on this method."

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

(System transactionMode == #autoBegin)
  ifFalse:[System transactionMode: #autoBegin].

self cleanupMgcResultsForMgc: true.
System commitTransaction
  ifFalse:[^self _error: #rtErrGcCommitFailure].
self cleanupFdcResultsForMgc: true.
System commitTransaction
  ifFalse:[^self _error: #rtErrGcCommitFailure].

^self _markGcCandidatesFromFile: aFileNameString
      forceOnError: aBoolean
      resultArray: (Globals at: #MgcResults)
      errorLimit: 100
      readOnly: aBool.
%

category: 'Garbage Collection'
method: Repository
markGcCandidatesFromFile: aFileNameString forceOnError: aBoolean
"Performs a garbage collection analysis on the objects in the given file by
 scanning the Repository for other references to them.  Objects are marked for
 subsequent reclaiming of storage space if the only references to candidate
 objects are from other candidates.

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

 See the method Repository>>_markGcCandidatesFromFile: aFileNameString
                            forceOnError: aBoolean
                            resultArray: aCommittedArray
                            errorLimit: errLim
                            readOnly: aBool

 for more information on this method."

^self basicMarkGcCandidatesFromFile: aFileNameString forceOnError: aBoolean readOnly: false.
%

category: 'Garbage Collection'
method: Repository
markGcCandidatesReadOnlyFromFile: aFileNameString
"Perform a markGcCandidates operation, but do not send the resultant
 collection of dead objects to the stone for reclamation.  In read-only
 mode, the MGC stores the dead objects that would have been passed to the
 stone in hidden set 34 (GcCandidates).
 
 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData.         

 For more information on this method, see the comments in the method:
 Repository>>_markGcCandidatesFromFile:
             forceOnError:
             resultArray:
             errorLimit:
             readOnly:
"

^self basicMarkGcCandidatesFromFile: aFileNameString forceOnError: true readOnly: true.
%

category: 'Garbage Collection'
method: Repository
markGcCandidatesFromFile: aFileNameString
"Performs a garbage collection analysis on the objects in the given file by
 scanning the Repository for other references to them.  Objects are marked for
 subsequent reclaiming of storage space if the only references to candidate
 objects are from other candidates.

 Does not proceed if any candidate objects fail validation or were found
 to be not dead in the first phase of the MGC.


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

 See the method Repository>>_markGcCandidatesFromFile: aFileNameString
                            forceOnError: aBoolean
                            resultArray: aCommittedArray
                            errorLimit: errLim
                            readOnly: aBool

 for more information on this method."

 ^self markGcCandidatesFromFile: aFileNameString forceOnError: false.
%

category: 'Garbage Collection'
method: Repository
pagesWithPercentFree: aPercent

"This method returns an Array containing the following statistics:

 1.  The total number of data pages processed.
 2.  The sum in bytes of unused space in all data pages.  This quantity is a
     measure of data fragmentation in the receiver.
 3.  The number of bytes in a page.
 4.  The number of data pages that have at least the specified percentage of
     unused space.
 5.  The number of data pages that have at least the specified percentage of
     unused space and contain only 1 object.
 6.  The number of data pages that contain only 1 object.

 Do not confuse unused space on a page with free space (unused pages) in a
 Repository or Extent.  See the freeSpace and freeSpaceInExtent: methods
 for more information.

 This method requires the GarbageCollection privilege.

 A GciHardBreak during this method will terminate the session."

^ self _pagesWithPercentFree: aPercent doScavenge: false
%

category: 'Garbage Collection'
method: Repository
_pagesWithPercentFree: aPercent doScavenge: aBoolean

"This method returns an Array containing the following statistics:

 1.  The total number of data pages processed.
 2.  The sum in bytes of unused space in all data pages.  This quantity is a
     measure of data fragmentation in the receiver.
 3.  The number of bytes in a page.
 4.  The number of data pages that have at least the specified percentage of
     unused space.
 5.  The number of data pages that have at least the specified percentage of
     unused space and contain only 1 object.
 6.  The number of data pages that contain only 1 object.

 If aBoolean is true, then the primitive will FAIL .  (Gs 64 v2.2 and above)

 Do not confuse unused space on a page with free space (unused pages) in a
 Repository or Extent.  See the 'freeSpace' and 'freeSpaceInExtent:' methods
 for more information.

 In order to execute this method you must have the GarbageCollection
 privilege.

 A GciHardBreak during this method terminates the session."

<primitive: 390>
aPercent _validateClass: SmallInteger .
aBoolean _validateClass: Boolean .
^ self _primitiveFailed: #_pagesWithPercentFree:doScavenge
%

category: 'Garbage Collection'
method: Repository
_setGcConfigAt: aSymbol put: aValue

"try 10 times to change the value of the specified GC configuration
 parameter.  If cannot successfully commit within 10 tries, raises an error. 
 Aborts current transaction . Returns the previous
 value of the parameter.  aSymbol must be resolvable in the UserGlobals
 for GcUser. "

| triesLeft commitResult oldVal gcUserUg |

triesLeft := 10 .
commitResult := false .
gcUserUg := ((AllUsers userWithId:'GcUser' ) resolveSymbol:#UserGlobals ) value.
[triesLeft > 0 _and:[commitResult == false] ] whileTrue:[
  System beginTransaction .
  oldVal := gcUserUg at: aSymbol .
  gcUserUg at: aSymbol put: aValue .

  commitResult := System commitTransaction  .
  triesLeft := triesLeft - 1.
  commitResult 
    ifFalse:[ System abortTransaction .  System sleep: 2 . ]
    ifTrue:[ GsFile gciLogClient:'--setGcConfig: set ' + aSymbol + ' to ' + 
		aValue asString 
    ].
].
commitResult ifFalse:[ ^ self error:'Unable to modify Gc configuration'].
^ oldVal
%

category: 'Garbage Collection'
method: Repository
reclaimAll

"Explicitly triggers the reclamation of all shadowed and dead objects.  
 The caller can disable the reclamation of dead objects by adjusting
 the Gc configuration parameter #reclaimDeadEnabled .

 Returns an Array of saved Gc configuration values, and the caller
 must pass this array to postReclaimAll: after the operation which
 requires reclaimAll is done.

 Each extent must have a reclaim gem assigned to it when this method
 is called.  The Admin GC session must also be running if there are any 
 possible dead objects in the system.  If not, this method will invoke 
 error #rtErrReclaimAllMissingGcGem.  This method may also hang 
 indefinitely if there are sessions logged in that do not vote. 

 This method acquires the GC lock and returns with the lock held.
 The postReclaimAll: method releases the GC lock.

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

 This method requires the GarbageCollection and SystemControl privileges."

| gcUserUg saveMinPages saveMode saveCrBacklog newMinPages newCrBacklog
  saveGcConfigs includeDead scCount done voteSt extentsNoReclaim 
  lockGcResult haveGcLock|

System myUserProfile _validatePrivilegeName:#SystemControl .
System myUserProfile _validatePrivilegeName:#GarbageCollection .

"All extents must have a reclaim gems"
extentsNoReclaim := System numberOfExtentsWithoutGC.
(extentsNoReclaim > 0)
  ifTrue:[self _error: #rtErrReclaimAllMissingGcGem].

"Admin gem must be present if voteState is not 0"
((System voteState ~~ 0) _and:[System adminGcGemSessionId == 0])
  ifTrue:[self _error: #rtErrReclaimAllMissingGcGem].

gcUserUg := ((AllUsers userWithId:'GcUser' ) resolveSymbol:#UserGlobals ) value.

"Get the GC lock to ensure epoch not in progress.  We might not get it if
 voting is in progress so we will try after voting is finished if
 necessary."
haveGcLock := (System _lockGc: true) == true.

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

saveMode := System transactionMode.
System transactionMode: #manualBegin .

saveCrBacklog := System stoneConfigurationAt:#StnSignalAbortCrBacklog .
newCrBacklog := 3 .
System stoneConfigurationAt:#StnSignalAbortCrBacklog put: newCrBacklog .
GsFile gciLogClient:'--reclaimAll: changed StnSignalAbortCrBacklog from ' 
	+ saveCrBacklog asString + ' to ' + newCrBacklog asString.

newMinPages := 1 .
saveMinPages := self _setGcConfigAt: #reclaimMinPages put: newMinPages .
GsFile gciLogClient:'--reclaimAll: changed reclaimMinPages from ' 
	+ saveMinPages asString + ' to ' + newMinPages asString .

saveGcConfigs := #[ saveMinPages ].

gcUserUg := ((AllUsers userWithId:'GcUser' ) resolveSymbol:#UserGlobals ) value.
includeDead := gcUserUg at:#reclaimDeadEnabled .
GsFile gciLogClient:'--reclaimAll: using reclaimDeadEnabled ' + includeDead asString .

" wait for GC voting to complete , since possibleDead are 
  not counted as dead objects that need reclaiming. "
scCount := 0 .
done := false .
[ done ] whileFalse:[
  voteSt := System voteState .
  voteSt == 0 ifTrue:[ 
     done := true  "voteState == VOTE_IDLE, so we are done"  
  ] ifFalse:[ 
    (scCount \\ 10) == 0  ifTrue:[ 
      GsFile gciLogClient:
	 '--reclaimAll: waiting for Gc Voting, voteState ' + voteSt asString 
    ].
    System abortTransaction .
    System sleep: 2 .
  ].
  scCount := scCount + 1 .
].

"Get the GC lock to ensure epoch not in progress"
haveGcLock ifFalse:[
  scCount := 0.
  [(lockGcResult := System _lockGc: true) == true] whileFalse:[
     System sleep: 1.
     System abortTransaction.
     scCount := scCount + 1.
    (scCount \\ 10) == 0  ifTrue:[ 
      GsFile gciLogClient:
	 '--reclaimAll: waiting for GC lock.  reason: ' + lockGcResult asString 
    ].
     (scCount > 60)
       ifTrue:[self postReclaimAll: saveGcConfigs.
               ^lockGcResult _error: #abortErrGarbageCollection args: #[0]].
  ].
].

" do simple commits to ensure CRs are disposed and reclaim completes"
scCount := 0 .
done := false .
[ done ] whileFalse:[
  System abortTransaction .
  System sleep: 2 .
  done := System _simpleCommitForReclaim: includeDead .
  scCount := scCount + 1 .
  (scCount \\ 10) == 0  ifTrue:[ 
    GsFile gciLogClient:
     '--reclaimAll: simpleCommit loopCount ' + scCount asString
  ].
].

System stoneConfigurationAt:#StnSignalAbortCrBacklog put: saveCrBacklog .
System transactionMode: saveMode .

^ saveGcConfigs 
%

category: 'Garbage Collection'
method: Repository
postReclaimAll: savedGcConfigsArray

"This method should be executed after a reclaimAll to restore
 GC configuration values. The argument should be the result
 from reclaimAll ."
 
| saveMinPages |

System myUserProfile _validatePrivilegeName:#GarbageCollection .

saveMinPages := savedGcConfigsArray at: 1 .
self _setGcConfigAt: #reclaimMinPages put: saveMinPages .
GsFile gciLogClient:'--postReclaimAll: restored reclaimMinPages to ' +
		saveMinPages asString .
"release GC lock"
System _lockGc: false.
%

category: 'Garbage Collection'
method: Repository
objectAudit

"Checks all objects in GemStone for consistency.

 This method is equivalent to the message auditWithLimit: 100000.

 See auditWithLimit: for further documentation.

 This method should be executed from topaz -l (the linked version of Topaz).

 This method attempts to complete reclaiming of all shadowed and dead
 objects before doing the audit. If there are shadowed or dead objects, 
 and any Reclaim GcGem/s and Admin GcGem are not running, this method will 
 return the error #rtErrReclaimAllMissingGcGem.  If other gems are running that 
 do not vote, this method may hang indefinitely waiting for reclaim to complete.

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

 A GciHardBreak during this method will terminate the session.

 This method raises the error #3022 if audit detects problems, otherwise
 returns true."

^ self auditWithLimit:100000 reclaimAll:true 
%

category: 'Garbage Collection'
method: Repository
objectAuditNoReclaim

" Same as objectAudit, but does not attempt to complete reclaiming of all 
  shadowed and dead objects before the audit.

  This method requires GarbageCollection privilege but does not require
  SystemControl privilege."

^ self auditWithLimit:100000 reclaimAll:false
%


category: 'Garbage Collection'
method: Repository
auditWithLimit: sizeLimit

"provided for compatibility"

^ self auditWithLimit: sizeLimit reclaimAll: true

%

! fixes for bug 9444
category: 'Garbage Collection'
method: Repository
auditWithLimit: sizeLimit reclaimAll: reclArg

"Checks all objects in GemStone for consistency.  (Compare with Repository's
 instance method repairWithLimit:.)  A description of errors found is written to
 standard output, along with statistics about the Repository.  The
 statistics report will not include any objects smaller than the specified
 sizeLimit (number of bytes or OOPs).  The statistics report prints sizes
 of objects and names of the objects' classes without regard to 
 Segment attributes which might prevent normal read access to the objects
 or classes.

 This method should be executed from topaz -l (the linked version of Topaz).

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

 This method requires the GarbageCollection and SystemControl privileges.

 If reclArg is true, this session waits for reclaiming of all dead
 and shadowed objects to be completed by the GC Gems, and additional
 consistency checks are made during the audit.  If there are any dead or 
 shadowed objects and any Reclaim GcGem/s and Admin GcGem are not running, 
 this method will return with the error #rtErrReclaimAllMissingGcGem.  If 
 other gems are running that do not vote, this method may hang indefinitely 
 waiting for reclaim to complete.

 A GciHardBreak during this method terminates the session.

 This method raises the error 3022 if audit detects problems, otherwise
 it returns true."

| savedGcConfig errCount |

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

reclArg ifTrue:[ savedGcConfig := self reclaimAll ].
errCount := self _objectAuditWithLimit: sizeLimit .
reclArg ifTrue:[ self postReclaimAll: savedGcConfig ].
errCount == 0 ifFalse:[
  self _error: #abortErrObjAuditFail args:#[ errCount] .
  self _uncontinuableError
].
^ true.
%

category: 'Garbage Collection'
method: Repository
repairWithLimit: sizeLimit

"Checks all objects in GemStone for consistency and repairs any errors found.
 A description of errors found and repaired is written to standard
 output, along with statistics about the Repository.  The statistics report does
 not include any objects smaller than the specified sizeLimit (number of bytes
 or OOPs).

 This method should be executed from topaz -l (the linked version of Topaz).

 This method requires the GarbageCollection privilege.  
 In addition, you must be the only user logged into GemStone.

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

 The Garbage Collector session is shut down for the duration of this method.

 A GciHardBreak during this method will terminate the session.

 The result of this method is error 3021, which Topaz will process specially
 to determine whether or not the repair found errors.  The Topaz command
   expectvalue true
 will match the result of a repair which found no errors."

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

self _objectRepairWithLimit: sizeLimit destroyIndexes: false
%

category: 'Garbage Collection'
method: Repository
markForCollection

"Performs a garbage collection analysis of all permanent objects on disk.  
 Every object in the receiver that cannot be reached from AllUsers is marked 
 for subsequent reclaiming of storage space. 

 This method aborts the current transaction, empties the GcCandidates queue 
 and commits, runs the analysis while outside of a transaction and then reenters
 a transaction if the session was in a transaction at the start of this method.
 If an abort would cause unsaved changes to be lost, it does not execute and 
 signals an error, #rtErrAbortWouldLoseData.

 When this method completes successfully, it generates an error message of
 the following form:

   Successful completion of Garbage Collection
     found <anInt> live objects,
     found <anInt> dead objects, occupying <anInt> bytes

 After this method completes, the GcGem process automatically reclaims the space
 occupied by the dead objects.  Space is not reclaimed until other sessions have
 either committed or aborted the transactions that were concurrent with this
 method.

 This method may fail with an error if another garbage collection is
 in progress.  This method waits up to 2 minutes for the other garbage
 collection to finish before issuing the error.
 Another garbage collection can be in progress because:
   1) an epoch garbage collection is in progress in a gc gem.
   2) a markGcCandidates is in progress in another session
   3) a markForCollection is in progress in another session
   4) a previous epoch, markGcCandidates or markForCollection completed the
     mark phase, but the voting on the possibly dead objects has
     not completed. Note that an admin GcGem must be running for the
     voting to complete.  Also, long running sessions that are idle and
     never aborting will prevent voting from completing.

 This method requires the GarbageCollection privilege.
 A GciHardBreak during this method terminates the session."

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

self _buildWeakRefSet.
^self _primMarkForCollection: 120
%

category: 'Garbage Collection'
method: Repository
markForCollectionWait: waitTimeSeconds

"Perform a markForCollection, waiting up to waitTimeSeconds for any
 garbage collection in progress in another session to complete.

 To wait as long as necessary for the other gc to finish, pass the argument -1.
 This should be done with caution, however, as under certain conditions
 the session could appear to wait forever.  To avoid this you need to:

 1.  Make sure that other sessions are committing/aborting to allow
     voting on possible dead to complete.

 2.  Make sure that the Admin Gc gem and at least one Reclaim Gc gem are
     is running to complete processing of dead objects once the vote is
     completed.

 For further documentation see markForCollection. "

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

self _buildWeakRefSet.
^self _primMarkForCollection: waitTimeSeconds
%

category: 'Garbage Collection'
method: Repository
_primMarkForCollection: waitTimeSeconds

<primitive: 431>
waitTimeSeconds _validateClass: SmallInteger.
self _primitiveFailed: #_primMarkForCollection.
self _uncontinuableError
%

category: 'Private'
method: Repository
_buildWeakRefSet

"HAS NO EFFECT in this release, weak references not implemented.

 Build the hiddenSet containing the objects that contain weak references.  Each
 object referenced in the global GcWeakReferences is sent the message so that it
 can add its components that contain weak references to the hiddenSet."

" System _hiddenSetReinit: 35. "
" GcWeakReferences do: [:each | each _buildWeakRefSet]. "

^self
%

category: 'Garbage Collection'
method: Repository
_objectRepairWithLimit: statsLimit destroyIndexes: aBoolean

"Performs an object audit on all objects in GemStone.  This audit is to be
 done after the garbage collection, shrink and page audit have completed
 successfully.

 The following checks are done on each object:

 1.  Object reference consistency - no object should contain any reference to a
     non-existent object.
 2.  All OOPs not found in the object table should be in the freeOopList.
 3.  The physical implementation of each object is consistent with its class.

 The following repairs are done:

 1.  Free OOPs found in the Object Table are removed and inserted into the
     FreeOopList (if they are not already there).
 2.  Store OopClassString for class field of byte Objects, OopClassArray for
     pointer objects, and OopClassBag for NSC objects.  If the object has a
     dependency tag, store OopNil in the tag to dereference the dependency
     list.

 If aBoolean is true, all indexes in GemStone are removed.

 All errors found and any repairs done are reported in the file AUDIT_LOG in
 the logical directory GEMSTONE.

 A GciHardBreak during this method will terminate the session."

<primitive: 388>
^ self _primitiveFailed: #_objectRepairWithLimit:destroyIndexes: .
%

category: 'Garbage Collection'
method: Repository
_objectAuditWithLimit: statsLimit

"Similar to Repository | objectRepairWithLimit:destroyIndexes:,
 except that any errors found are not repaired.

 A GciHardBreak during this method will terminate the session.

 The primitive returns the number of errors detected."
<primitive: 389>
^ self _primitiveFailed: #_objectAuditWithLimit:
%

! deleted scavengePagesWithPercentFree: 

! fix 31566
category: 'Extent Operations
method: Repository
shrinkExtents

"Truncate all Extents of the Repository to remove internal free space between
 the last used page in each extent and the end of the file containing the
 extent.  Has no effect for extents on a raw disk partition.

 WARNING, you should take a full backup of your extents before 
 executing shrinkExtents.  If the machine crashes (such as a power failure)
 while shrinkExtents is executing, the repository may be unusable.

 Requires that no other user sessions be logged in.
 Stops and restarts the symbol creation session and all gc sessions .
 Because it stops the symbol creation session, this method can only
 be run as SystemUser .

 If DBF_PRE_GROW is enabled in the configuration file then this the extents
 will be grown again the next time Stone is restarted, thus cancelling the
 effect of this method. 

 Returns receiver if successful, otherwise returns a String describing
 sessions that prevented the shrink."

<primitive: 901> "enter protected mode"

| result symStopped gcStopped errCount finallyBlock oldRemoveThresh 
  pagesNeedRemoveOfs removalThreshSym |
symStopped := false .
gcStopped := false .
errCount := 0 .
removalThreshSym := #StnPageRemovalThreshold .
oldRemoveThresh := System stoneConfigurationAt: removalThreshSym .
System stoneConfigurationAt: removalThreshSym put: 1 .
pagesNeedRemoveOfs := System cacheStatisticsDescription indexOf: 'PagesWaitingForRemovalInStoneCount'.

finallyBlock := [
    System stoneConfigurationAt: removalThreshSym put: oldRemoveThresh .    
    symStopped ifTrue:[ 					" fix 31630"
      GsFile gciLogClient:'--shrink: restarting symbol creation session'.
      System startSymbolCreationSession .
      symStopped := false .
    ].
    gcStopped ifTrue:[ 
      GsFile gciLogClient:'--shrink: restarting gc sessions'.
      System startAllGcSessions .
      System waitForAllGcGemsToStartForUpToSeconds:10 .
      gcStopped := false .
    ].
    System _disableProtectedMode . "exit protected mode"
].
Exception category: nil number:nil do:[ :ex :cat :num :exargs |
  errCount := errCount + 1 .
  " GsFile gciLogClient:'--shrink: error count ' + errCount asString . "
  errCount == 1 ifTrue:[ finallyBlock value ] .
  symStopped := false .
  gcStopped := false .
  ex resignal: GemStoneError number: num args: exargs . 
  ^ self _uncontinuableError .
].
[ | done sesList count otherSes |
  GsFile gciLogClient:'--shrink: stopping symbol creation session'.
  symStopped := true .
  System stopSymbolCreationSession .   "stop first to fix 31606"
  GsFile gciLogClient:'--shrink: stopping gc sessions'.
  gcStopped := true .
  System stopAllGcSessions .
  done := false .
  count := 1 .
  [ done ] whileFalse:[
    sesList := System currentSessions .
    sesList size == 1 ifTrue:[ 
      done := true .
    ] ifFalse:[
      count <= 10 ifTrue:[
        count := count + 1 .
        System sleep: 1 .
      ] ifFalse:[
        otherSes := System otherSessionNames .
        done := true
      ].
    ].
  ].
  otherSes == nil ifTrue:[ | needRemove |
    GsFile gciLogClient:'--shrink: doing simple commits'.
    3 timesRepeat:[
      System _simpleCommitForReclaim: false .
      System abortTransaction .
      System sleep: 3 .
      System abortTransaction .
      System sleep: 3 .
    ].
    GsFile gciLogClient:'--shrink: attempting startCheckpointSync '.
    System startCheckpointSync ifFalse:[
      result := 'ERROR, false from startCheckpointSync. ' .
    ].  
    System abortTransaction .
    System sleep: 15 . 
    needRemove := 1 .
    count := 0 .
    GsFile gciLogClient:'--shrink: waiting for pagesNeedRemove=0 ' .
    [ needRemove > 0 and:[count < 10]] whileTrue:[ 
      System sleep: 3 .
      needRemove := (System cacheStatistics: 1) at: pagesNeedRemoveOfs .
      count := count + 1
    ].
    needRemove > 0 ifTrue:[
      result == nil ifTrue:[ result := String new ].
      result addAll: ' ERROR, pagesNeedRemove = ' + needRemove asString .
    ].
    self _shrinkExtents .
    result == nil ifTrue:[ result := self ].
  ] ifFalse:[
    result := 'ERROR, sessions preventing shrink:' + otherSes .
  ].
] ensure: finallyBlock .
^ result
%

category: 'Private'
method: Repository
_shrinkExtents

<protected primitive: 427>

self _primitiveFailed: #shrinkExtents.
self _uncontinuableError
%


category: 'Extent Operations'
method: Repository
createExtent: extentFilename

"Creates a new Extent with a file named extentFilename (a String).  The new
 Extent has no maximum size.

 This method updates the DBF_EXTENT_NAMES Stone option.  It does not require
 the system to be in single-user mode.

 If the given file already exists, then this method generates an error and the
 given Extent is not added to the logical Repository.

 Creating an extent with this method bypasses any setting the user may have
 specified for the DBF_PRE_GROW option at system startup.  As extents created
 with this method have no maximum size, their files cannot be grown to an
 initial size.

 If GemStone is being run using weighted disk resource allocation, then
 the new Extent will be given a weight equal to the average weight of all
 other extents.

 This method requires the FileControl privilege.  It is recommended that you
 run as either DataCurator or SystemUser."

^ self createExtent: extentFilename withMaxSize: 0
%

! document bug 6384
! fix 33802
category: 'Extent Operations'
method: Repository
createExtent: extentFilename withMaxSize: aSize

"Creates a new Extent with the given extentFilename (aString) and sets the
 maximum size of that Extent to the the given size.

 If aSize == 0 , then the maximum physical size of the extent is limited
 to disk space or 33554G bytes , whichever comes first . If aSize > 0 ,
 it specifies the maximum physical size of the file in megabytes.

 This method updates the DBF_EXTENT_NAMES and DBF_EXTENT_SIZES Stone options.
 It does not require the system to be in single-user mode.

                                  Note:
   The extent is created with the default ownership and permissions of the
   Stone process.  If this is not the same as the ownership and permissions of
   the other extents, then Unix utilities must be used to change the ownership
   or permissions of the new file; such changes may be made without stopping
   the Stone, and should be made a soon as possible, to avoid other sessions
    encountering authorization errors.

 If the given file already exists, then this method generates an error and the
 given Extent is not added to the logical Repository.

 If the Stone option DBF_PRE_GROW is set to true, then this method will cause
 the newly created extent's file to be grown to the given size.  If the grow
 fails, then this method returns an error and the new Extent is not added to the
 logical Repository.

 If GemStone is being run using weighted disk resource allocation, then
 the new Extent will be given a weight equal to the average weight of all
 other Extents.

 This method requires the FileControl privilege.  It is recommended that you
 run as either DataCurator or SystemUser."

<primitive: 284>

extentFilename _validateClass: String.
aSize _validateClass: SmallInteger.
" aSize out of range errors generated in the primitive "
^ self _primitiveFailed: #createExtent: .
%

category: 'Extent Operations'
method: Repository
numberOfExtents

  <primitive: 428>

"Returns the number of active extents."

  self _primitiveFailed: #numberOfExtents.
  self _uncontinuableError
%

category: 'Extent Operations'
method: Repository
validateExtentId: anExtentId

"Returns the argument if it is valid, otherwise generates an error."

| maxExtentId |
anExtentId == nil ifTrue:[ ^ anExtentId ] .
anExtentId _validateClass: SmallInteger.
(anExtentId < 1) ifTrue:
   [anExtentId _error: #rtErrArgOutOfRange .  ^ 1 ].
maxExtentId := self numberOfExtents .
(anExtentId > maxExtentId) ifTrue:
   [anExtentId _error: #rtErrArgOutOfRange .  ^ maxExtentId ].
^ anExtentId .
%

category: 'Private'
method: Repository
_listInstances: anIdentitySet limit: aSmallInt opCode: opCode toDirectory: aStringOrNil

"Private.  Applications should use the Repository>>listInstances: methods.

 aSmallInt is max number of instances to report, or 0 for unlimited.
  
 The behavior of this method is dependent on opCode as follows:

   opCode  Function
   ===========================================================================
     0     Returns an Array.  For each element of anIdentitySet, the result
           Array contains 2 elements: total number of instances and an Array
           of instances (possibly limited in size).
   
     1     Report a single class into the hidden set ListInstancesResult,
           and return the size of the result.  anIdentitySet must be of size 1

     2     Returns an Array of pairs.  The odd numbered elements are classes
           for which instances were listed.  The even number elements are
           the number of instances of the preceeding class that were found and
           written to the binary bitmap file. Bitmaps containing the object 
           ID's of the instances are written to binary bitmap files in the 
           directory specified in aStringOrNil.
   ===========================================================================
 
 This method aborts the current transaction; unsaved changes will be lost.

 The argument anIdentitySet must not be larger than 2030 elements.

 Scans the entire Repository once."

<primitive: 392>

anIdentitySet _validateClass: IdentitySet.
aSmallInt _validateClass: SmallInteger .
aSmallInt >= 0 ifFalse:[ aSmallInt _error: #rtErrArgOutOfRange ].
opCode _validateClass: SmallInteger .
opCode == 1 ifTrue:[ 
  anIdentitySet size == 1 ifFalse:[
    anIdentitySet _error: #rtErrArgOutOfRange
  ].
] ifFalse:[
  (anIdentitySet size > 2030 "virtual machine constant") ifTrue:[ 
    anIdentitySet _error: #rtErrArgOutOfRange  
  ].
].
anIdentitySet do: [:each | each _validateClass: Behavior].
^self _primitiveFailed: #_listInstances:limit:opCode:toDirectory:
%


category: 'Class Management'
method: Repository
listInstancesToHiddenSet: aClass 

"Scans the entire Repository and generates a list of instances of aClass
 into hidden set 1 .  The previous state of hidden set 1 is cleared.

 Returns the number of instances found.

 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData. The entire
 Repository is scanned once."

| aSet |

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

aSet := IdentitySet new .
aSet add: aClass .
^ self _listInstances: aSet limit: 0 opCode: 1 toDirectory: nil
%

category: 'Class Management'
method: Repository
listInstances: anArray toDirectory: aString

"Scan the repository for the instances of classes in anArray and write
 the results to binary bitmap files in the directory specified by
 aString.  Binary bitmap files have an extension of .bm and may be
 loaded into hidden sets using class methods in class System.
 aString must specify a path to a writable directory.

 Bitmap files are named as follows:

 <ClassName>-<classOop>-instances.bm

 where className is the name of the class and classOop is the object
 ID of the class.

 The result is an Array of pairs.  For each element of the argument anArray,
 the result array contains  <aClass>, <numberOfInstancesFound>.
 The numberOfInstances is the total number written to the output bitmap file
 
 Note: the order of classes in the result array may differ from that of 
 the argument anArray.

 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData.  The entire
 Repository is scanned at least once.

 If the argument anArray contains more than 2000 unique elements then
 the entire Repository will be scanned once for each group of 2000 unique
 elements, or fraction thereof."

aString _validateClass: String.
anArray _validateClass: Array.
^self _listInstances: anArray limit: 0 toDirectory: aString
%

category: 'Class Management'
method: Repository
listInstances: anArray limit: aSmallInt

"Returns a list of instances on the receiver that belong to one of the
 classes listed in anArray. .

 aSmallInt is the maximum number of instances to report for each class,
 or 0 for unlimited . 

 The result is an Array of pairs, for each element of the argument anArray,
 the result array contains  <numberOfInstances>, <arrayOfInstances> .
 The numberOfInstances is the total number in the repository .
 The arrayOfInstances will be limited by the argument aSmallInt .

 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData.  The entire        
 Repository is scanned at least once.

 If the argument anArray contains more than 2000 unique elements then
 the entire Repository will be scanned once for each group of 2000 unique
 elements, or fraction thereof."

^self _listInstances: anArray limit: aSmallInt toDirectory: nil
%


category: 'Private'
method: Repository
_listInstances: anArray limit: aSmallInt toDirectory: aStringOrNil

"Private.  Applications should use the Repository>>listInstances: methods."

| inputSet inputSetSize inputIdx resultInSetOrder result inputArraySize
  anObj scanSetThisTime writeToFiles opCode|

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

writeToFiles := aStringOrNil ~~ nil.
writeToFiles ifTrue:[opCode := 2]
             ifFalse:[opCode := 0].

inputSet := IdentitySet withAll: anArray .
inputSetSize := inputSet size .
inputSetSize < 1 ifTrue:[ ^ Array new ] .
inputSet do: [:each | each _validateClass: Behavior].

inputIdx := 1 .
resultInSetOrder := Array new .
[inputIdx <= inputSetSize] whileTrue:[
   scanSetThisTime := IdentitySet new .
   [ scanSetThisTime size < 2000 _and:[inputIdx <= inputSetSize ]] whileTrue:[
      scanSetThisTime add: (inputSet _at: inputIdx) .
      inputIdx := inputIdx + 1 .
      ].
   resultInSetOrder addAll: (self _listInstances: scanSetThisTime
                                  limit: aSmallInt
                                  opCode: opCode 
                                  toDirectory: aStringOrNil) .
   ].

writeToFiles
  ifTrue:[result := resultInSetOrder] "primitive wrote the files, so we are done"
  ifFalse:[
    inputArraySize := anArray size .
    result := Array new: inputArraySize * 2.
    1 to: inputArraySize do:[:j| | soIdx resIdx |
      anObj := anArray at: j .
      soIdx := (inputSet _offsetOf: anObj) * 2 .
      resIdx := j * 2 .
      result at: resIdx - 1 put: ( resultInSetOrder at: soIdx - 1 ) ."totalCount"
      result at: resIdx put: ( resultInSetOrder at: soIdx) . "array of instances"
      ].
].

^ result
%

category: 'Class Management'
method: Repository
listInstances: anArray

"Returns a list of instances on the receiver that belong to one of the
 classes listed in anArray.  The result of this method is an Array of Arrays,
 where the contents of each inner array consists of all instances 
 whose class is equal to the corresponding element in anArray.

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

 If anArray contains multiple occurrences of a class, then the result
 will contain corresponding multiple occurrences of the same Array that lists
 the instances of that class.

 If anArray contains an element that is not a kind of Behavior, an error
 is generated.

 Scans the entire Repository at least once.

 If the argument anArray contains more than 2000 unique elements then
 the entire Repository will be scanned once for each group of 2000 unique
 elements, or fraction thereof."

| reportArr res |
reportArr := self listInstances: anArray limit: 0 .
res := Array new: anArray size .
1 to: anArray size do:[:j |
  res at:j put: (reportArr at: j * 2 ) . "array of instances"
].
^ res
%

category: 'Class Management'
method: Repository
listReferences: anArray 

"Returns a list of instances in the receiver that have a reference to one of
 the objects specified in anArray.  The result of this method is an Array of
 Arrays, where the contents of each inner array consists of all instances 
 that have a reference to the corresponding element in anArray.  

 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.

 This method is very expensive.  It scans the entire Repository and looks
 at every instance variable of every object."

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

^ self _listReferences: anArray withLimit: 0
%
      
category: 'Class Management'
method: Repository
listReferences: anArray withLimit: aSmallInt

"Returns a list of instances in the receiver that have a reference to one of
 the objects specified in anArray.  The result of this method is an Array of
 Arrays, where the contents of each inner array consists of instances 
 that have a reference to the corresponding element in anArray.  
 The number in each inner array is limited to approximately aSmallInt.  

 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.

 This method is very expensive.  It scans the entire Repository and looks
 at every instance variable of every object."

| outerArr innerArr |

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

outerArr := self _listReferences: anArray withLimit: aSmallInt.
aSmallInt > 0 ifTrue:[
  1 to: outerArr size  do:[ :j|
    innerArr := outerArr at: j .
    innerArr size > aSmallInt ifTrue:[ innerArr size: aSmallInt ]. 
  ].
].
^ outerArr.
%
      
category: 'Class Management'
method: Repository
_listReferences: anArray withLimit: aSmallInt

"Private. Returns a list of instances in the receiver that have a reference to 
 one of the objects specified in anArray.  The result of this method is an 
 Array of Arrays, where the contents of each inner array consists 
 of instances that have a reference to the corresponding element in anArray.  

 This method aborts the current transaction.

 The number in inner array is limited to approximately aSmallInt,
 and may exceed aSmallInt by the maximum number of objects in a data page .
 If aSmallInt is <= 0, the result size is unlimited. 

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

 This method is very expensive.  It scans the entire Repository and looks
 at every instance variable of every object."

<primitive: 393>
aSmallInt _validateClass: SmallInteger.
anArray _validateClass: Array.
(anArray size > 2034 "virtual machine constant")
  ifTrue:[ anArray _error: #rtErrArgOutOfRange  ] .
^self _primitiveFailed: #_listReferences:withLimit: .
%

category: 'Repository Analysis'
method: Repository
listObjectsInSegments: anArray 

"Returns a list of objects in the receiver that have the specified segmentIds
 The result of this method is an Array of Arrays, where the contents of each
 inner array consists of objects whose segmentId is the segmentId of
 of the corresponding element in anArray.

 anArray must be an Array of at most 2034 segmentIds 

 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.

 This method is very expensive.  It scans the entire Repository and looks
 at the object header of every object."


^ self listObjectsInSegments: anArray withLimit: 0
%

category: 'Private'
method: Repository
_validateSegmentId: aSegmentId 

"Generates an error if aSegmentId is not a SmallInteger
 >= 0 and <= self size .  
 Note that segmentId 0 specifies world write,
 and does not have an associated Segment . "

aSegmentId _validateClass: SmallInteger .
(aSegmentId < 0 or:[ aSegmentId > self size ]) ifTrue:[
  aSegmentId _error: #rtErrArgOutOfRange
].
% 

category: 'Repository Analysis'
method: Repository
listObjectsInSegmentToHiddenSet: aSegmentId

"Scans the entire Repository and generates a list of objects that have specified 
 segmentId into hidden set 1 .  The previous state of hidden set 1 is cleared.

 Returns the number of instances found.

 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData. The entire
 repository is scanned once."

self _validateSegmentId: aSegmentId .
^ self _listObjectsInSegments: #[ aSegmentId ]  limit: 0 opcode: 1 toDirectory: nil
%

category: 'Repository Analysis'
method: Repository
listObjectsInSegments: anArray toDirectory: aString

"Scan the repository for objects that have the specified segmentIds
 and writes the results to binary bitmap files in the directory specified by
 aString.  Binary bitmap files have an extension of .bm and may be
 loaded into hidden sets using class methods in class System.
 aString must specify a path to a writable directory.

 anArray must be an Array of at most 2034 segmentIds. 

 Bitmap files are named as follows:  
   segment<segmentId>-objects.bm
 where segmentId is an element of anArray .

 The result is an Array of pairs.  For each element of the argument anArray,
 the result array contains  <segmentId>, <numberOfInstancesFound>.
 The numberOfInstances is the total number written to the output bitmap file.

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

aString _validateClass: String .
^ self _listObjectsInSegments: anArray limit: 0 opcode: 2 toDirectory: aString
%

category: 'Repository Analysis'
method: Repository
listObjectsInSegments: anArray withLimit:  aSmallInt

"Returns a list of objects in the receiver that have the specified segmentIds.
 The result of this method is an Array of Arrays, where the contents of each 
 inner array consists of objects whose segmentId is the segmentId of
 of the corresponding element in anArray.  
 The number in each inner array is limited to approximately aSmallInt.  

 anArray must be an Array of at most 2034 segmentIds

 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.

 This method is very expensive.  It scans the entire Repository and looks
 at the object header of every object."

^ self _listObjectsInSegments: anArray limit: aSmallInt opcode: 0 toDirectory: nil
%

category: 'Private'
method: Repository
_listObjectsInSegments: anArray limit: aLimit opcode: opCode toDirectory: aStringOrNil

 "aLimit is a SmallInteger, max number of objects to report, or 0 for unlimited.

 anArray must be an Array of at most 2034 segmentIds.
 
 The behavior of this method is dependent on opCode as follows:

   opCode  Function
   ===========================================================================
     0     Returns an Array.  For each element of anArray, the result
           Array contains 2 elements: total number of objects and an Array
           of objects (possibly limited in size).
 
     1     Report a single class into the hidden set ListInstancesResult,
           and return the size of the result.  anArray must be of size 1

     2     Returns an Array of pairs.  The odd numbered elements are Segments
           for which objects were listed.  The even number elements are
           the number of objects in the preceeding Segment that were found and
           written to the binary bitmap file. Bitmaps containing the object
           ID's of the instances are written to binary bitmap files in the
           directory specified in aStringOrNil.
   ===========================================================================
 "

| sortedSegIds inputSegIds primResult primResultOfs result |

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

sortedSegIds := SortedCollection new .
inputSegIds := Array new .
anArray _validateClass: Array .
anArray size > 2034 ifTrue:[ anArray _error: #rtErrArgOutOfRange ].
1 to: anArray size do:[ :k | |segId |
  segId := anArray at: k .
  self _validateSegmentId:  segId .
  inputSegIds add: segId .
  sortedSegIds add: segId
].
primResult := self _primlistObjectsInSegments: sortedSegIds 
      withLimit:  aLimit opcode: opCode toDirectory: aStringOrNil .

opCode == 0 ifFalse:[ ^ primResult ].
result := Array new: anArray size * 2 .

primResultOfs := 1 .
1 to: sortedSegIds size do:[:segIdOfs | | inOfs |
  inOfs := inputSegIds _indexOfIdentical: (sortedSegIds at: segIdOfs) .
  result at: (inOfs * 2) -1  put: (primResult at: primResultOfs ) .
  result at: (inOfs * 2)   put: (primResult at: primResultOfs + 1) .
  primResultOfs := primResultOfs + 2 .
].
^ result
%


category: 'Private'
method: Repository
_primlistObjectsInSegments: aColl withLimit:  aSmallInt opcode: opCode
toDirectory: aStringOrNil

"Private.

 aSmallInt is max number of objects to report, or 0 for unlimited.

 aColl must be an OrderedCollection of SmallIntegers which are
 segmentIds sorted in ascending order
 
 The behavior of this method is dependent on opCode as follows:

   opCode  Function
   ===========================================================================
     0     Returns an Array.  For each element of aColl, the result
           Array contains 2 elements: total number of objects and an Array
           of objects (possibly limited in size).
 
     1     Report a single class into the hidden set ListInstancesResult,
           and return the size of the result.  aColl must be of size 1

     2     Returns an Array pairs.  The odd numbered elements are Segments
           for which objects were listed.  The even number elements are
           the number of objects in the preceeding Segment that were found and
           written to the binary bitmap file. Bitmaps containing the object
           ID's of the instances are written to binary bitmap files in the
           directory specified in aStringOrNil.
   ===========================================================================
 "

<primitive: 596>
aSmallInt _validateClass: SmallInteger.
aColl _validateClass: OrderedCollection.
(aColl size > 2034 "virtual machine constant")
  ifTrue:[ aColl _error: #rtErrArgOutOfRange  ] .
^self _primitiveFailed: #_primlistObjectsInSegments:withLimit:opcode:toDirectory: 
%

! _replaceAllObsSym deleted

category: 'Storing and Loading'
method: Repository
writeTo: aPassiveObject

"Instances of Repository cannot be converted to passive form.  This method
 writes nil to aPassiveObject and stops GemStone Smalltalk execution with a
 notifier."

aPassiveObject writeObject: nil.
self _error: #rtErrAttemptToPassivateInvalidObject
%

category: 'Formatting'
method: Repository
printOn: aStream

"Puts a displayable representation of the receiver on the given stream."

"Copy the implementation from Object so we don't inherit it from Collection."

aStream nextPutAll: self asString
%

category: 'Private'  
method: Repository 
_contentsOfPage: aPage
 
"If aPage is an invalid page ID, then the primitive fails.  Returns an Array of
 size at least 5 for all kinds of pages.  For data pages, the Array size is at
 least 15 and varies depending upon the number of objects in the page.

 The aPage argument should be a positive Integer specifying a valid page ID.
  
 The contents of the returned Array are as follows:

    index       description
     1.         pageKind
     2.         sessionId for user that wrote the page.
     3.         low beginId  (transaction begin ID)
     4.         high beginId
     5.         bytesUsed
                     (elements 6 and above are only present for data pages )
     6.         nil  (was approx page creation time (a DateTime) in gs64v1.0)
     7.         clusterId
     8.         freeBytes
     9.         numFreeChunks  
    10.         sizeLargestFree
    11.         numUsedBytes   
    12.         numberOfObjects
    13.         maxObjSize
    14.         minObjSize
    15.         numberOfValidObjects  
    16.         numberOfInvalidObjects
    (17.. 17 + numberOfValidObjects - 1) list of valid objects  
    (17 + numberOfValidObjects ...)  list of OOPs of invalid objects.  "

<primitive: 399>
self _primitiveFailed: #_contentsOfPage: .
%

category: 'Backup and Restore'
method: Repository
restoreFromArchiveLogs

"Given a Repository already in restore mode from a previous restore operation,
 restores all available transaction logs contained in the directories specified
 by the last preceding invocation of either 

    Repository>>setArchiveLogDirectories:...

  or

    Repository>>restoreFromArchiveLogDirectories:...

 Determines the restore status's current fileId by doing the equivalent of
 SystemRepository restoreStatus.  Then attempts to restore contents of any log
 file whose current fileId is beyond the end of the last restore, if the log
 file can be found when searching the directories previously specified.

 Generates an error if neither setArchiveLogDirectories:... nor
 restoreFromArchiveLogDirectories:... has been executed since the last 
 startstone of this Repository.

 When opening a log file on a file system, if the filename ends in '.gz',
 the file is expected to be in gzip compressed format, and will be
 opened as such.  Restoring a compressed tranlog from a raw 
 partition is not supported.

 When executed using Topaz, the result is either a String describing the success
 of the operation (in which case the Topaz result (obj **) may be nil), or an
 error message.

 This method terminates GemStone Smalltalk execution and does an automatic
 abort.  All GemStone Smalltalk temporary objects present at the start of this
 method are destroyed by this method, so it can only be executed from Topaz.

 You must be the only user logged in, otherwise an error is generated.

 This method requires the FileControl privilege.  It is recommended that you
 run as either DataCurator or SystemUser.  This method puts the session into
 #manualBegin transaction mode.

 Note that restore status is an attribute of the Repository, not of a
 session, so the required preceding restore operation could have been
 executed in some preceding session."

System transactionMode: #manualBegin .
System abortTransaction .

^ self _restoreFrom: nil opcode: 9
%

category: 'Private'
method: Repository
_primSetArchiveLogDirectories: arrayOfDirectorySpecs
tranlogPrefix: tranlogPrefixString

"Private."

"Send archive log directories specification to Stone.  Sender has
 done class kind checks of all the arguments.  Stone will check for
 existence of each directory.  arrayOfDirectorySpecs should be non-empty.
 The other arguments may be nil.  If tranlogPrefixString or replicPrefixString
 are nil, the applicable configuration file parameter is substituted."

<primitive: 469>
self _primitiveFailed: #_primSetArchiveLogDirectories: .
%

category: 'Backup and Restore'
method: Repository
setArchiveLogDirectories: arrayOfDirectorySpecs
tranlogPrefix: tranlogPrefixString
replicateDirectories: arrayOfReplicateDirSpecs
replicatePrefix:  replicPrefixString

"Obsolete,  replicate arguments ignored"

^ self setArchiveLogDirectories: arrayOfDirectorySpecs
    tranlogPrefix: tranlogPrefixString
%

category: 'Backup and Restore'
method: Repository
setArchiveLogDirectories: arrayOfDirectorySpecs

"Specify file system directories or raw device 
 to be used by subsequent invocation(s) of restoreFromArchiveLogs
 or restoreToEndOfLog: .

 see also setArchiveLogDirectories:tranlogPrefix:
"
 
 ^ self setArchiveLogDirectories: arrayOfDirectorySpecs tranlogPrefix: 'tranlog'

%

category: 'Backup and Restore'
method: Repository
setArchiveLogDirectory: aDirectorySpec

"Specify a single file system directory or raw device 
 to be used by subsequent invocation(s) of restoreFromArchiveLogs
 or restoreToEndOfLog: .

 see also setArchiveLogDirectories:tranlogPrefix:
"

 ^ self setArchiveLogDirectories: #[ aDirectorySpec ] tranlogPrefix: 'tranlog'
%

category: 'Backup and Restore'
method: Repository
setArchiveLogDirectory: aDirectorySpec tranlogPrefix: aPrefix

"Specify a single file system directory or raw device 
 and prefix for file names
 to be used by subsequent invocation(s) of restoreFromArchiveLogs
 or restoreToEndOfLog: .

 see also setArchiveLogDirectories:tranlogPrefix:
"

 ^ self setArchiveLogDirectories: #[ aDirectorySpec ] tranlogPrefix: aPrefix
%

category: 'Backup and Restore'
method: Repository
setArchiveLogDirectories: arrayOfDirectorySpecs
tranlogPrefix: tranlogPrefixString

"Specifies the directories and raw partitions to be searched by subsequent
 invocation(s) of restoreFromArchiveLogs or restoreToEndOfLog: .

 The argument arrayOfDirectorySpecs must be an Array of one or more Strings.
 Each String must name a file system directory or raw device specification.
 An error is generated if any of the directories or devices does not exist.
 It is not an error if they exist but do not yet contain any transaction logs.

 The argument tranlogPrefixString must be a String, the file prefix to be used 
 when searching for transaction logs in file systems specified in
 arrayOfDirectorySpecs.  The argument may be nil, in which case the value for
 STN_TRAN_LOG_PREFIX in the Stone's configuration file is used.

 Does not require privileges.  Does not require that you be the only user
 logged in.  However, a subsequent restore operation to use the state set by
 this method will require that the Repository be in restore state, and that you
 have FileControl privilege and that you then be the only user logged in."
 
| validateStringBlk |
validateStringBlk := [:aString | 
  (aString class isSubclassOf: String) ifFalse:[ 
    aString _errorExpectedClass: String 
    ].
  aString size > 1023 ifTrue:[ aString _error: #rtErrArgOutOfRange ].
  ].
arrayOfDirectorySpecs _validateClass: Array .
arrayOfDirectorySpecs size < 1 ifTrue:[
  arrayOfDirectorySpecs _error: #errArgTooSmall args:#[ 1 ].
  ].
arrayOfDirectorySpecs do:[ :aString | validateStringBlk value: aString  ].
tranlogPrefixString ~~ nil ifTrue:[
  validateStringBlk value: tranlogPrefixString .
  ].

^ self _primSetArchiveLogDirectories: arrayOfDirectorySpecs
	tranlogPrefix: tranlogPrefixString
%

category: 'Backup and Restore'
method: Repository
restoreFromArchiveLogDirectories: arrayOfDirectorySpecs
tranlogPrefix: tranlogPrefixString
replicateDirectories: arrayOfReplicateDirSpecs
replicatePrefix:  replicPrefixString

"This method is equivalent to invoking 
 setArchiveLogDirectories:tranlogPrefix:replicateDirectories:replicatePrefix:
 followed by restoreFromArchiveLogs.

 Please see those two methods for complete descriptions."

self setArchiveLogDirectories: arrayOfDirectorySpecs
  tranlogPrefix: tranlogPrefixString
  replicateDirectories: arrayOfReplicateDirSpecs
  replicatePrefix:  replicPrefixString .

^ self restoreFromArchiveLogs
%

category: 'Repository Conversion'
method: Repository
transformAllObsSym: obsSymSet

"Private. Attempts to transform all the ObsoleteSymbols contained in obsSymSet
 to Symbols without changing their identities.

 Returns a three-element Array whose contents are as follows:

 (1) The first element contains a list of all the ObsoleteSymbols that could
 be successfully transformed. 

 (2) The second element contains an Array of all the ObsoleteSymbols that
 could not be transformed. 

 (3) The third element contains an Array of Symbols whose contents are the
 corresponding ObsoleteSymbol contained in the Array returned in (2) above.
 
 The Arrays in second and third elements can be used for replacing the 
 ObsoleteSymbols with Symbols."

| convertedArray oldSymArray newSymArray |

convertedArray := Array new.
oldSymArray := Array new.
newSymArray := Array new.

obsSymSet do: [ :oldSym | | newSym |
  newSym := oldSym transformIntoSymbol.
  (newSym == oldSym) 
    ifTrue: [ 
      "Transformation was successful."
      convertedArray add: newSym 
      ]
    ifFalse: [
      oldSymArray add: oldSym.
      newSymArray add: newSym.
      ]
  ].

^ #[ convertedArray, oldSymArray, newSymArray ].
%

! category: 'Repository Conversion'
! method: Repository
! createObjListFrom: fileName ofKind: className
! 
! "Private. Returns an Array of (valid) objects based on the list of
! OOPs contained in the text file fileName. The objects must all be of
! kind className."
! 
! <primitive: 478>
! self _primitiveFailed: #createObjListFrom:ofKind: .
! self _uncontinuableError
! %

! category: 'Repository Conversion'
! method: Repository
! createObjListFrom: fileName ofClass: className
! 
! "Private. Returns an Array of (valid) objects based on the list of
! OOPs contained in the text file fileName. The objects must all be of 
! class className."
! 
! <primitive: 481>
! self _primitiveFailed: #createObjListFrom:ofClass: .
! self _uncontinuableError
! %

! deleted _getContainerList: obsSymSet result: anArray

! deleted _replaceAllSymIn: containerList obsSymList: oldSymList mappingDict: mappingDict

category: 'Private'
method: Repository
_shadowPagesByExtent

"This method aborts the current transaction."

< primitive: 526 >
self _primitiveFailed: #_shadowPagesByExtent .
%

category: 'Private'
method: Repository
_shadowPagesCount

"This method aborts the current transaction."

< primitive: 527 >
self _primitiveFailed: #_shadowPagesCount .
%

category: 'Private'
method: Repository
_deadNotReclaimedCount

"Return the number of dead objects pending reclamation"

^System _deadNotReclaimedCount
%

category: 'Private'
method: Repository
_scanForParentObjects

"Scan the entire repository to find all objects that reference any object
contained in hidden set 26 and place them in hidden set 27.

This method aborts the current transaction."

< primitive: 529 >
self _primitiveFailed: #_scanForParentObjects .
%

category: 'Private'
method: Repository
findObjsConnectedTo: anArray
"Return an array of all objects reachable from the objects in the given 
 array.  Objects implicitly referenced from the header like the class are 
 not included in the sweep.

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

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

System _hiddenSetReinit: 26.
System _addAll: anArray to: 26.
^self _findConnectedObjs.
%
category: 'Private'
method: Repository
_findConnectedObjs
"This method aborts the current transaction."
<primitive: 560>
^ self _primitiveFailed: #_findConnectedObjs .
%
category: 'Private'
method: Repository
_findOopsOnPages: anArrayOfPageIds
"Scan the object table and collect all OOPs that reference any page
 in the input array of page IDs."
< primitive: 561 >
self _primitiveFailed: #_findOopsOnPages: .
%
category: 'Private'
method: Repository
_pageForOop: anInteger
"Returns the page ID for the given object ID by looking in the
 object table.  A result of -1 indicates the object ID is a 
 free oop, or the object ID is not in the object table."
< primitive: 562 >
self _primitiveFailed: #_pageForOop: .
%
category: 'Private'
method: Repository
_findPagesContainingOops: anArrayOfInts
"Returns an array of page ID's that contain the oops in the input
 array.  The input array must contain the oop as a SmallInteger or
 LargePositiveInteger, not the object itself.  

 This method does not look at the object table, rather is scans
 the data pages directly from the extents.  Note that the object
 may appear on more than 1 page if it is shadowed."
< primitive: 563 >
self _primitiveFailed: #_findPagesContainingOops: .
%
category: 'Private'
method: Repository
_oopIsDead: anInteger
"Returns a boolean indicating if the given oop is present in the
 stone's dead object set.  Primitive fails if the integer is not
 a valid disk oop value."

< primitive: 564 >
self _primitiveFailed: #_oopIsDead: .
%

category: 'Garbage Collection'
method: Repository
quickObjectAuditWithLevel: anInt

" Does an optimized object audit.  If anInt is 1, only data pages are 
  audited.  If anInt is 2, object table entries are also audited.

  Requires that this session be the only non-gc session logged in. 
  If other sessions are logged in and do not vote, may hang indefinitely
  in reclaim. 

  Requires that all GC sessions be running; if not, will signal error
  #rtErrReclaimAllMissingGcGem.

  Returns true if audit was clean otherwise generates an error."

| numUserSessions errCount saveGcConfig |

System myUserProfile _validatePrivilegeName:#SystemControl .
System myUserProfile _validatePrivilegeName:#GarbageCollection .

numUserSessions := System currentUserSessionCount.
(numUserSessions == 1)
  ifFalse:[^self _errorNotOnlyUser: numUserSessions ].

saveGcConfig := self reclaimAll .

GsFile gciLogClient:'-- calling quickObjectAudit primitive' .
errCount := self _quickObjectAuditWithLevel: anInt .

self postReclaimAll: saveGcConfig .

errCount == 0 ifFalse:[
  self _error: #abortErrObjAuditFail args:#[ errCount] .
  self _uncontinuableError
].
^ true
%
 

category: 'Garbage Collection'
method: Repository
_quickObjectAuditWithLevel: anInt

" Private "

" does an object audit by scanning only data pages. Requires that
  this session be the only non-gc session logged in, and that
  all shadow pages have been reclaimed.
 
  Returns an Integer, the number of errors"

<primitive: 556>

self _primitiveFailed: #quickObjectAuditWithLevel: .
self _uncontinuableError.
%

category: 'Backup and Restore'
method: Repository
restoreFromBackupsNoShadows: arrayOfFilesOrDevices

"Same as restoreFromBackups, only no shadow pages are created."

self _waitForGcStartup .
^ self _restoreFrom: arrayOfFilesOrDevices opcode: 10
%
! changes to fix 32188
category: 'Repository Analysis'
method: Repository
buildLimitSetForRefPathScan

"Build a list of objects to server as the limit set for a reference path scan.
 The reference path scan will end when a reference from any objects
 returned by this method is found during the scan."

|set symUser |

set := IdentitySet new.
set addAll: SystemRepository. "Add all segments"
"Get all symbol list dictionaries and all versions of all classes from all user profiles.
 Using a set prevents duplicates."
AllUsers do:[:aUserPro| |symbolList|
  set add: aUserPro .
  symbolList := aUserPro symbolList.
  1 to: symbolList size do:[:n| |eachSymbolListDictionary|
    eachSymbolListDictionary := symbolList at: n.
    (set includes: eachSymbolListDictionary) ifFalse:[ 
      set add: eachSymbolListDictionary.
      eachSymbolListDictionary keysAndValuesDo:[:k :v|
        v isBehavior ifTrue:[
          1 to: v classHistory size do:[:p| |class|
            class := v classHistory at: p.
	    set add: class.
	    set add: class class
          ]
        ].
      ].
    ].
  ].
].
set add: (Globals at: #SharedDependencyLists).

	"gemstone64, AllSymbols is now in SymbolUser's UserGlobals . "
symUser := AllUsers userWithId:'SymbolUser' .
set add: (symUser resolveSymbol: #AllSymbols) value .

^set asArray
%
category: 'Repository Analysis'
method: Repository
findReferencePathToObject: anObject

"Finds a reference path to a single object.  See the comments in method
 Repository>>findReferencePathToObjects:findAllRefs:printToLog: for more
 information.

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

|result limitArray|
limitArray := self buildLimitSetForRefPathScan.
result := self findReferencePathToObjs: (Array with: anObject) limitObjArray: limitArray
                findAllRefs: true printToLog: true.
result == nil
	ifTrue:[^nil].
^result first.
%
category: 'Repository Analysis'
method: Repository
findReferencePathToObjects: anArray findAllRefs: findAllRefs printToLog: printToLog

"Finds a reference path to an array of objects.  Returns an array of arrays showing how each
 object is connected to the repository by reference.  The first element of a reference path will
 usually (see below) be one of the objects in the limit set, which is computed by the method
 Repository>>buildLimitSetForRefPathScan.   The last object in a reference path
 will be anObject.

 Only a single reference path to each object is returned. It's possible for any object to be
 connected to the repository through multiple reference paths.

 Objects in the stone's list of dead objects are excluded from the scan.  It is an error if
 any input object is in the stone's dead objects set, in which case this method will return nil.

 It is an error if any input object is not committed.  It is also an error if any object is in
 both the search array and the limit set.  nil will be returned in both of these cases.

 It is possible for an object to be disonnected from the repository and therefore have no reference path.
 In this case, the second element of the result array will be false, indicating the reference path was not
 found.

 If findAllRefs is false, the scan will return when the first complete reference path is found or all objects
 are determined to be dead.  If it is true, the scan will continue until all reference paths are found.

 If printToLog is true, messages showing progress of the scan will be printed to the stdout of the gem
 calling this method.  

 The progressCount statistic indicates how many objects have been processed for each scan and is reset
 to zero at the end of each scan.

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

 This method operates in a transaction and will begin one if necessary.  This method may run
 for long periods of time and should not be called in production repositories.

 A reference path scan for an object will be terminated and considered completed if any class
 object is found in the reference path, even if the class is present in
 the limit set.  Normally all classes are connected to the repository and will be included in
 the limit set.  However, for garbage collection purposes, disconnected classes are
 considered live objects if any other object references them.  In other words, a class is a live object
 if any live instances of that class exist in the repository.

 Returns an array of arrays, or nil on error.  Each element of the returned array corresponds to 
 an object in the input array and has the following format:
 1 - the search object
 2 - aBoolean - true if the reference path was found, false if not.
 (reference path follows only if element 2 is true)
 3 - first element of the reference path (this object will be normally be in the limit set)
 4 - second element of the reference path.
 ...
 n - last element of the reference path, which will be the search object."

| limitArray |
limitArray := self buildLimitSetForRefPathScan.
^self findReferencePathToObjs: anArray limitObjArray: limitArray findAllRefs: findAllRefs printToLog: printToLog.
%
category: 'Repository Analysis'
method: Repository
findReferencePathToObjs: anArray limitObjArray: limitArray findAllRefs: findAllRefs printToLog: printToLog

 "Finds an array of reference paths to objects.  See the comments in method
 Repository>>findReferencePathToObjects:findAllRefs:printToLog: for more
 information.

 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData."
System needsCommit
  ifTrue: [ self _error: #rtErrAbortWouldLoseData ] .

^self _findReferencePathToObjs: anArray limitObjArray: limitArray findAllRefs: findAllRefs printToLog: printToLog
%
category: 'Repository Analysis'
method: Repository
_findReferencePathToObjs: anArray limitObjArray: limitArray findAllRefs: aBoolean printToLog: anotherBoolean

 "Finds an array of reference paths to objects.  See the comments in method
 Repository>>findReferencePathToObjects:findAllRefs:printToLog: for more
 information.

 This method aborts the current transaction."

<primitive: 568>
anArray _validateClass: Array.
limitArray _validateClass: Array.
aBoolean _validateClass: Boolean.
anotherBoolean _validateClass: Boolean.
(anArray size ==  0)
  ifTrue:[ ^anArray  _error: #rtErrArgOutOfRange  ] .
(limitArray size ==  0)
  ifTrue:[ ^limitArray _error: #rtErrArgOutOfRange  ] .
^self _primitiveFailed: #_findReferencePathToObjs:limitObjArray:findAllRefs:printToLog: .
%

category: 'Cache Preloading'
method: Repository
readObjectTableForGem: gemNum of: totalGems useSharedCache: aBoolean cacheFullLimit: fullLimit
"See the method
   Repository>>_readObjectTableFromOopNum: anInt toOopNum: aBiggerInt
               useSharedCache: aBoolean loadDataPagesOpCode: opCode cacheFullLimit: fullLimit
 for more information."

^self readObjectTableForGem: gemNum of: totalGems useSharedCache: aBoolean loadDataPagesOpCode: 0 cacheFullLimit: fullLimit
%

category: 'Cache Preloading'
method: Repository
readObjectTableAndDataPagesForGem: gemNum of: totalGems useSharedCache: aBoolean cacheFullLimit: fullLimit
"See the method
   Repository>>_readObjectTableFromOopNum: anInt toOopNum: aBiggerInt
               useSharedCache: aBoolean loadDataPagesOpCode: opCode cacheFullLimit: fullLimit
 for more information."

^self readObjectTableForGem: gemNum of: totalGems useSharedCache: aBoolean loadDataPagesOpCode: 1 cacheFullLimit: fullLimit
%

category: 'Cache Preloading'
method: Repository
readObjectTableForGem: gemNum of: totalGems useSharedCache: aBoolean loadDataPagesOpCode: opCode cacheFullLimit: fullLimit
"See the method
   Repository>>_readObjectTableFromOopNum: anInt toOopNum: aBiggerInt
               useSharedCache: aBoolean loadDataPagesOpCode: opCode cacheFullLimit: fullLimit
 for more information."

|hwMark delta start end|

hwMark := System _oopNumberHighWaterMark - 1.

delta := hwMark // totalGems.
start := (delta * (gemNum - 1)) + 1.

gemNum == totalGems
	ifTrue:[end := hwMark]
	ifFalse: [end := gemNum * delta].

^self _readObjectTableFromOopNum: start
      toOopNum: end
      useSharedCache: aBoolean
      loadDataPagesOpCode: opCode
      cacheFullLimit: fullLimit
%

category: 'Cache Preloading'
method: Repository
_readObjectTableFromOopNum: anInt toOopNum: aBiggerInt useSharedCache: aBoolean loadDataPagesOpCode: opCode cacheFullLimit: fullLimit

"Read a section of the object table from anInt up to aBiggerInt -1.  Both these arguments
 must either be SmallIntegers or LargePositiveIntegers.

 If useSharedCache is true, the object table pages are read into the shared cache.  If
 it's false, only the top 64 pages of the object table are placed in the shared cache.

 Data pages may also be read from disk after the object table load has completed.  Data
 page loading is controlled by the value of opCode as follows:
   opCode == 0 means do not load data pages.
   opCode == 1 means load data pages into the shared page cache.
   opCode == 2 means load data pages into the file buffer cache only.

 The session will run outside of transaction and respond to SigAborts unless
 opCode is 1.  In that case it must run in transaction until completed.

 If the any shared page cache loading is enabled (aBoolean is true and/or opCode is 1),
 and the shared page cache becomes full before all pages have been read, this method
 will return and print a warning message to the log file.  The shared cache is
 determined to be full if the number of free frames in the cache falls below
 fullLimit.  If fullLimit is negative, a default value based on the size of
 the shared cache is used to determine if the cache is full.  Setting fullLimit
 to 0 will cause cache warming to run to completion no matter how full the
 shared cache becomes."

<primitive: 571>
(anInt _isSmallInteger)
  ifFalse:[anInt _validateClass: LargePositiveInteger].
(aBiggerInt _isSmallInteger)
  ifFalse:[aBiggerInt _validateClass: LargePositiveInteger].
(anInt < aBiggerInt)
  ifFalse:[anInt _error: #rtErrArgOutOfRange].
aBoolean  _validateClass: Boolean.
opCode _validateClass: SmallInteger.
((opCode < 0) _or:[opCode > 2])
  ifTrue:[opCode _error: #rtErrArgOutOfRange].
fullLimit _validateClass: SmallInteger.
self _primitiveFailed: #readObjectTableFromOopNum:toOopNum:useSharedCache:loadDataPagesOpCode:cacheFullLimit: .
%

category: 'Cache Preloading'
method: Repository
readPageRangeForGem: gemNum of: totalGems pageBufSize: numPages

"Read a portion of the allocated pages in the repository.  Pages are not placed in the shared
 cache, instead they are placed in a private buffer which is allocated to hold numPages pages.

 This method is used to warm up large disk buffer caches.

 The current transaction is aborted and this method is run outside of a transaction
 and will respond to SigAborts from the stone.

 Text information messages are also printed to stdout of the gem calling this
 method."

<primitive: 572>
self _primitiveFailed: #readPageRangeForGem:of:pageBufSize: .
%

category: 'Private'
method: Repository
_makePageWithIdScavengable: anInt

"Private, this method should only be used when instructed to do so by
 VMware Inc personnel.

 Add the page ID represented by anInt to the stone's list of scavengable
 pages.  anInt must be either a SmallInteger or LargePositiveInteger
 representing a valid data page ID.

 Returns true if the page was successfully added.  Returns false if the
 page is already on the scavengable pages list.  Returns nil if the page
 does not exist or is not a valid data page ID.  This method causes the
 system to do 2 or more commits and a checkpoint.  

 Only SystemUser is allowed to execute this method.
 After executing this method ,   SystemRepository reclaimAll
 should be used to wait for the page to be reclaimed. 

 This method will fail if another session holds the commitToken,
 or if checkpoints are suspended. "

<primitive: 569>
self _primitiveFailed: #_makePageWithIdScavengable: .
%

category: 'Class Membership'
method: Repository
species

"Returns a class similar to, or the same as, the receiver's class which
 can be used for containing derived copies of the receiver."

^ Array 
%

category: 'Class Membership'
method: Repository
speciesForSelect

"Returns a class similar to, or the same as, the receiver's class which
 can be used for containing derived copies of the receiver for select:
 and reject: queries."

^ Array
%
category: 'Class Membership'
method: Repository
speciesForCollect

"Returns a Class, an instance of which should be used as the result of
 collect: or other projections applied to the receiver."

^ Array
%

category: 'Repository Conversion'
method: Repository
_migrateGroups

"Migrates group collections in all the Segments of the receiver."

self do:[ :aSegment | aSegment ~~ nil ifTrue:[ aSegment _migrateGroups] ]
%

category: 'Searching'
method: Repository
indexOf: anObject

"Returns the index of the first element in the receiver that is equivalent to
 the argument. If the receiver does not have any elements equivalent to the
 argument, returns, zero.

 Since Segments are canonicalized by the segment creation methods, and
 only referenced from SystemRepository, this is implemented with
 indexOfIdentical:
"

^ self indexOfIdentical: anObject
%

category: 'Searching'
method: Repository
indexOfIdentical: anObject

"Returns the index of the first element in the receiver that is identical to
 the argument. If the receiver does not have any elements identical to the
 argument, returns, zero."

<primitive: 494>
self _primitiveFailed: #indexOfIdentical:
%

category: 'Searching'
method: Repository
indexOf: anObject ifAbsent: anExceptionBlock

"Returns the index of the first element in the receiver that is equivalent to
 the argument. If the receiver does not have any elements equivalent to the
 argument, returns the value of evaluating anExceptionBlock."

| ofs |
ofs := self indexOfIdentical: anObject .
ofs > 0 ifTrue:[ ^ ofs ].

^ anExceptionBlock value.
%

category: 'conversion'
method: Segment
_setSegmentId: anInt

self _unsafeAt: 7 put: anInt
%

! ------------ conversion of pre-v2.2  SystemRepository
expectvalue %SmallInteger
run
 "Check number of old segments needing conversion"
 | oldRep |
 oldRep := Globals at:#SystemRepository .
 oldRep class superClass == Array ifTrue:[ | oldSize maxSegId |
   oldSize := oldRep size .
   maxSegId := 16rFFFE .
   oldSize <= maxSegId ifTrue:[
      ^ oldSize 
   ] ifFalse:[
     ^ 'old SystemRepository too big, only the first ' , maxSegId asString ,
	' out of ' , oldSize asString , ' will be converted.' 
   ]
 ] ifFalse:[
   ^ 0 "no conversion needed"
 ]
%

expectvalue %String 
run
 "Now convert or initialize the segments in the repository."
|  oldRep inConversion 
   rep count report seg sysUser installSegBlock |
report := String new .
oldRep := Globals at:#SystemRepository .
oldRep class superClass == Array ifTrue:[ | newSize newRep |
   inConversion := true .
   newSize := oldRep size min: 16rFFFE .  "note message above"
   newSize < 2 ifTrue:[ | dcSeg |
     dcSeg := Globals at:#DataCuratorSegment otherwise: nil  .
     dcSeg ~~ nil ifTrue:[
       "looks like a 2.0 or 2.1 repository, need to fixup DataCuratorSegment"
       newSize := 2.
       oldRep at:2 put: DataCuratorSegment .
       #[ #GsIndexingSegment , #PublishedSegment , #GsTimeZoneSegment ,
          #SecurityDataSegment ] do:[ :aKey | | aSeg |
          aSeg := Globals at: aKey otherwise: nil .
          aSeg == (oldRep at: 1) ifTrue:[
            "delete this ref to SystemSegment"  
            Globals removeKey: aKey . 
          ]. 
        ]
     ].
   ].
   newRep := Repository new: newSize .   "new: not yet disallowed"
   newRep instVarAt:1 put: (oldRep instVarAt:1) "name"  .
   newRep instVarAt:2 put: (oldRep instVarAt:2) "dataDictionary" .
   newRep _unsafeSetOop: 240641 .

   Segment _constraints _unsafeAt: 1 put: newRep class  .
   Segment _constraints _unsafeAt: 7 put: SmallInteger .
   1 to: newSize do:[:segId| | aSegment |
     aSegment := oldRep at: segId .
     aSegment _unsafeAt:1 put: newRep .
     aSegment _unsafeAt:7 put: segId  "segmentId" .
   ].
   1 to: newSize do:[:segId| | aSegment |
     aSegment := oldRep at: segId .
     newRep _basicAt:segId put: aSegment .
     aSegment assignToSegment: DataCuratorSegment .
   ].
   newRep assignToSegment: DataCuratorSegment .
   Globals at:#SystemRepository put: newRep .
   Globals at:#OldSystemRepository put: oldRep .
   report addAll: 'converted ' ; addAll: newSize asString ;
     addAll: ' segments. '
] ifFalse:[
   inConversion := false .
   report addAll: 'conversion of SystemRepository not needed. '
].

"Ensure all Segments from a virgin 2.2 exist . 
 Gs64 v2.2 bom.c only creates the first 2 . "

rep := Globals at:#SystemRepository .
count := 0 .
rep size < 8 ifTrue:[
  [ rep size < 8 ] whileTrue:[
    count := count + 1 .
    Segment newInRepository: rep . 
  ].
  report addAll:'created '; addAll: count asString ; addAll: ' segments. '
].
sysUser := AllUsers userWithId:'SystemUser' .
rep := Globals at:#SystemRepository .

installSegBlock := [ :aKey :aSeg | | oldSeg |
  oldSeg := Globals at: aKey otherwise: nil .
  oldSeg == nil ifTrue:[
    Globals at: aKey put: aSeg
  ] ifFalse:[
    oldSeg == aSeg ifFalse:[
      nil error:'invalid segment reference in Globals'
    ]
  ]
].

seg := rep at: 1 .		"repeats bom work, needed for conversion"
installSegBlock value:#SystemSegment value: seg .
seg  owner: sysUser ;
  ownerAuthorization: #write  ;
  worldAuthorization: #read  .

seg := rep at: 2 .		"repeats bom work, needed for conversion"
installSegBlock value:#DataCuratorSegment value: seg .
seg owner: (AllUsers userWithId:'DataCurator') ;
  ownerAuthorization: #write  ;
  worldAuthorization: #read  .

				"remaining not done in bom"
seg := rep at: 3 .	"GsTimeZoneSegment no longer used"	

seg := rep at: 4 .
installSegBlock value:#GsIndexingSegment value: seg .
seg isInvariant ifFalse:[
  seg owner: sysUser ; ownerAuthorization: #write  ;
    worldAuthorization: #write  ; immediateInvariant .
].

seg := rep at: 5 .
installSegBlock value:#SecurityDataSegment value: seg .
seg isInvariant ifFalse:[
  seg owner: sysUser ; ownerAuthorization: #write  ;
    worldAuthorization: #none  ;  immediateInvariant; _unsafeSetOop: 235777 .
].

seg := rep at: 6 .
installSegBlock value:#PublishedSegment value: seg .
seg isInvariant ifFalse:[
  seg owner: sysUser ;   "group authorizations done later in bomlast"
    ownerAuthorization: #write ;
  worldAuthorization: #none .
].

"Segment 7 , owned by GcUser , fixed up later"
"Segment 8, owned by Nameless, fixed up later"

inConversion ifTrue:[
  "converting from a pre-Gs64 v2.2 repository.
   Fix 35966 , repositories from Gs64 v2.0.x and v2.1.x  may 
   have segmentId == OOP_NIL (10r20) in disk object headers ,
   so preallocate a segment for segmentId 20 that is world read-write "
   rep size < 20 ifTrue:[ | newSeg |
     "Possibly a Gs64 v2.0.x or v2.1.x  repository "
     newSeg := Segment newInRepository: rep .  
     newSeg owner: sysUser; ownerAuthorization: #write;
            worldAuthorization:#write ; immediateInvariant  .
     newSeg segmentId >= 20 ifTrue:[
        nil error:'invalid segmentId' 
     ].
     newSeg _setSegmentId: 20. 		"fix 38084"
     rep size: 20 .
     rep at: 20 put: newSeg .
     report addAll: ' created segment 20 .'.
   ]
].

^ report 
%

expectvalue true
run
Segment removeSelector: #_setSegmentId: .
^ true
%

! ------- instance creation methods disallowed
category: 'Instance Creation'
classmethod: Repository
new

"Disallowed."
self shouldNotImplement: #new
%

category: 'Instance Creation'
classmethod: Repository
new: anInteger

"Disallowed."

self shouldNotImplement: #new:
%


! with:...  disallowed because new: disallowed

!--------------- methods inherited from Object that are disallowed
set class Repository

category: 'Updating'
method
at: offset put: aValue
"Disallowed"
self shouldNotImplement: #at:put:
%

method
basicAt: offset put: aValue
"Disallowed"
self shouldNotImplement: #basicAt:put:
%

method
instVarAt: offset put: aValue 
"Disallowed"
self shouldNotImplement: #instVarAt:put:
%

method
nilFields
"Disallowed"
self shouldNotImplement: #nilFields
%

method
size: aSize
"Disallowed"
self shouldNotImplement: #size:
%

method
_at: offset put: aValue
"Disallowed"
self shouldNotImplement: #_at:put:
%

method
_basicAt: offset put: aValue
"Disallowed"
self shouldNotImplement: #_basicAt:put:
%

method
_basicSize: aSize
"Disallowed"
self shouldNotImplement: #_basicSize:
%

method
_primitiveAt: offset put: aValue
"Disallowed"
self shouldNotImplement: #_primitiveAt:put:
%

method
_unsafeAt: offset put: aValue
"Disallowed"
self shouldNotImplement: #_unsafeAt:put:
%

method
_changeToSegment: aSeg
"Disallowed"
self shouldNotImplement: #_changeToSegment:
%

method
changeToSegment: aSeg
"Disallowed"
self shouldNotImplement: #changeToSegment:
%

category: 'Storing and Loading'

method
basicLoadFrom: passiveObj
"Disallowed."
self shouldNotImplement: #basicLoadFrom:
%

method
basicLoadFrom: passiveObj size: aSize
"Disallowed"
self shouldNotImplement: #basicLoadFrom:size:
%

method
basicLoadFromNoRead: passiveObj
"Disallowed"
self shouldNotImplement: #basicLoadFromNoRead:
%

method
basicLoadFromNoRead: passiveObj size: aSize
"Disallowed"
self shouldNotImplement: #basicLoadFromNoRead:size:
%

method
basicLoadFromOld: passiveObj
"Disallowed"
self shouldNotImplement: #basicLoadFromOld:
%

method
loadFrom: passiveObj
"Disallowed"
self shouldNotImplement: #loadFrom:
%

method
loadNamedIVsFrom: passiveObj
"Disallowed"
self shouldNotImplement: #loadNamedIVsFrom:
%

method
loadVaryingFrom: passiveObj
"Disallowed"
self shouldNotImplement: #loadVaryingFrom:
%

method
loadVaryingFrom: passiveObj size: aSize
"Disallowed"
self shouldNotImplement: #loadVaryingFrom:size:
%

category: 'Instance migration'

method
become: anObj
"Disallowed"
self shouldNotImplement: #become:
%

method
_become: anObject fullChecks: aBoolean
"Disallowed"
self shouldNotImplement: #_become:fullChecks:
%
method

_primitiveBecome: anObj
"Disallowed"
self shouldNotImplement: #_primitiveBecome:
%

method
migrate
"Disallowed"
self shouldNotImplement: #migrate
%

method
migrateFrom: anObj
"Disallowed"
self shouldNotImplement: #migrateFrom:
%

method
migrateFrom: anObj instVarMap: aDict
"Disallowed"
self shouldNotImplement: #migrateFrom:instVarMap:
%

method
migrateIndexable: anObj myClass: aCls otherClass: secondCls
"Disallowed"
self shouldNotImplement: #migrateIndexable:myClass:otherClass:
%

method
changeClassTo: aCls
"Disallowed"
self shouldNotImplement: #changeClassTo:
%

category: 'Copying
method
copy
"Disallowed"
self shouldNotImplement: #copy
%

method
deepCopy
"Disallowed"
self shouldNotImplement: #deepCopy
%

method
shallowCopy
"Disallowed"
self shouldNotImplement: #shallowCopy
%


! --------------  methods inherited from Collection  that are disallowed 
method
add: anObj
"Disallowed"
self shouldNotImplement: #add:
%

method
addAll: aCollection
"Disallowed"
self shouldNotImplement: #addAll:
%

method
remove: anObj
"Disallowed"
self shouldNotImplement: #remove:
%

method
remove: anObj ifAbsent: aBlock
"Disallowed"
self shouldNotImplement: #remove:ifAbsent:
%

method
removeAll: aCollection
"Disallowed"
self shouldNotImplement: #removeAll:
%

method
removeAllIdentical: aCollection
"Disallowed"
self shouldNotImplement: #removeAllIdentical:
%

method
removeIdentical: anObj
"Disallowed"
self shouldNotImplement: #removeIdentical:
%

method
removeIdentical: anObj ifAbsent: aBlock
"Disallowed"
self shouldNotImplement: #removeIdentical:ifAbsent:
%

category: 'Garbage Collection'
method: Repository
loadGcCandidatesFromFile: aString intoHiddenSet: hiddenSetId

"Given a file which is binary list of dead objects (produced
 by one of the #findDisconnectedObjectsAndWriteToFile: methods),
 load the objects into the hidden set with the given ID.

 No validation of any kind is performed on the object 
 identifiers loaded."

<primitive: 597>
self _primitiveFailed: #loadGcCandidatesFromFile:intoHiddenSet: .
%

