hg/stx-libbasic: comparison OpenVMSOperatingSystem.st

equal deleted inserted replaced

-:34418449c41c
+:3dc78835e119
 };
 /* ST/X maintained per-process information */
 struct procInfo {
 long  returnStatus;
 long  pid;
 char  eventFlag;
 char  finished;
 struct procInfo *nextProc;
 };
 /*
 * notice: although many systems' include files
 * already block against multiple inclusion, some
 * do not. Therefore, this is done here again.
 * (it does not hurt)
 */
 #ifdef WANT_SHM
 extern int shmctl(), shmget(), shmdt();
 extern char * shmat();
 #  include <locale.h>
 #  define _LOCALE_H_INCLUDED_
 # endif
 #endif
 /*
 * posix systems should define these ...
 * but on some (older) systems, they are not.
 */
 #ifndef S_IXUSR
 # ifdef S_IEXEC
 #  define S_IXUSR S_IEXEC
 /*
 * some (old ?) systems do not define this ...
 */
 #if !defined(R_OK) && !defined(_AIX)
 # define R_OK    4       /* Test for Read permission */
 # define W_OK    2       /* Test for Write permission */
 # define X_OK    1       /* Test for eXecute permission */
 # define F_OK    0       /* Test for existence of File */
 #endif
 		printf("===> stat('%s') - retry\n", t);
 # endif
 		do {
 		    ret = stat(t, buffP);
 		} while ((ret < 0) && (errno == EINTR));
 		if (ret >= 0)
 		    return ret;
 	    }
 	    /*
 	     * try with appended '.DIR';
 # define stat(__path__, __buffP__)      __vms_stat__(__path__, __buffP__)
 /*
 * same for access
 */
 int
 __vms_access__(path, mode)
 char *path;
 int mode;
 {
 	int ret;
 /* #define WAITDEBUG /* */
 /* #define PROCESSDEBUG /* */
 void
 __vms_ASTChildWithInfo(pInfo)
 struct procInfo *pInfo;
 {
 #ifdef WAITDEBUG
 	printf("__vms_ASTChildWithInfo pI=%x\n", pInfo);
 #endif
 documentation
 "
 this class realizes access to most (all ?) required operating system services;
 some of it is very specific for unix, so do not depend on
 things available here in your applications
 - some may not be found in other OS's or be slightly different ...
 (On the other hand: I do not want to hide all features
 from you - in some situations it MAY be interesting to be
 able to get down to a select or fork system call easily (at least on Unix systems).
 examples
 "
 various queries
 								[exBegin]
 Transcript
 	showCR:'hello ' , (OperatingSystem getLoginName)
 								[exEnd]
 								[exBegin]
 OperatingSystem isUNIXlike ifTrue:[
 	Transcript showCR:'this OS is not UNIX-like'
 ]
 								[exEnd]
 								[exBegin]
 Transcript
 	showCR:'this machine is called ' , OperatingSystem getHostName
 								[exEnd]
 								[exBegin]
 Transcript
 	showCR:('this machine is in the '
 	       , OperatingSystem getDomainName
 	       , ' domain')
 								[exEnd]
 								[exBegin]
 Transcript
 	showCR:('this machine''s CPU is a '
 	       , OperatingSystem getCPUType
 	       )
 								[exEnd]
 Transcript showCR:'executing ls command ...'.
 OperatingSystem executeCommand:'ls'.
 Transcript showCR:'... done.'.
 								[exEnd]
 locking a file
 (should be executed on two running smalltalks - not in two threads):
 								[exBegin]
 |f|
 f := 'testFile' asFilename readWriteStream.
 10 timesRepeat:[
 	'about to lock ...' printCR.
 	[
 	  OperatingSystem
 	    lockFD:(f fileDescriptor)
 	    shared:false
 	    blocking:false
 	] whileFalse:[
 	    'process ' print. OperatingSystem getProcessId print. ' is waiting' printCR.
 	    Delay waitForSeconds:1
 	].
 	'LOCKED ...' printCR.
 	Delay waitForSeconds:10.
 	'unlock ...' printCR.
 	(OperatingSystem
 	    unlockFD:(f fileDescriptor)) printCR.
 	Delay waitForSeconds:3.
 ]
 								[exBegin]
 "
 %}.
 ^ -1
 !
 errorSymbolAndTextForNumber:errNr
 "return an array consisting of symbol &  message string from a unix errorNumber
 (as returned by a system call).
 The returned message is in english (as found in /usr/include/errno.h)
 and should be replaced by a resource lookup before being presented to the user."
 |sym text|
 	    out_mbxdsc.dsc$b_dtype   = DSC$K_DTYPE_T;
 	    out_mbxdsc.dsc$b_class   = DSC$K_CLASS_S;
 	    out_mbxdsc.dsc$a_pointer = out_mbxname.body;
 	}
 	/*
 	 * Build descriptor for command line
 	 */
 	cmddsc.dsc$w_length  = strlen(fullCmdLine);
 	cmddsc.dsc$b_dtype   = DSC$K_DTYPE_T;
 	cmddsc.dsc$b_class   = DSC$K_CLASS_S;
 	flags = CLI$M_NOWAIT;
 	if (doFork == true) {
 # ifdef NOTDEF
 	    /*
 	     * Allocate an event flag to signal process termination
 	     */
 	    status = LIB$GET_EF(&siop->event_flag);
 	    if (status != SS$_NORMAL) {
 		vaxc$errno = status;
 			       (in_channel ? &in_mbxdsc : 0),
 			       (out_channel ? &out_mbxdsc : 0),
 			       &flags,
 			       0,               /* process name */
 			       &(pInfo->pid),
 			       &(pInfo->returnStatus),
 			       &procEventFlag,
 			       __vms_ASTChildWithInfo,
 			       pInfo,           /* AST argument */
 			       0,               /* prompt */
 			       (cli ? &clidsc : 0)
 |pid exitStatus sema|
 sema := Semaphore new name:'OS command wait'.
 pid := Processor
 		monitor:[
 		    self
 			startProcess:aCommandString
 			inputFrom:anExternalInStream
 			outputTo:anExternalOutStream
 			errorTo:anExternalErrStream.
 		]
 		action:[:status |
 		    status stillAlive ifFalse:[
 			exitStatus := status.
 			self closePid:pid.
 			sema signal
 |pid exitStatus sema|
 sema := Semaphore new name:'OS command wait'.
 pid := Processor
 		monitor:[self startProcess:aCommandString]
 		action:[:status |
 			status stillAlive ifFalse:[
 			    exitStatus := status.
 			    self closePid:pid.
 			    sema signal
 	^ aBlock value:exitStatus
 ].
 ^ true.
 "
 OperatingSystem executeCommand:'sleep 30' onError:[].
 OperatingSystem executeCommand:'pwd' onError:[:status|status inspect].
 OperatingSystem executeCommand:'ls -l' onError:[].
 OperatingSystem executeCommand:'invalidCommand' onError:[:status| status inspect].
 OperatingSystem executeCommand:'rm /tmp/foofoofoofoo'onError:[:status | status inspect].
 "
 "Created: 22.12.1995 / 14:49:59 / stefan"
 "Modified: 25.3.1997 / 11:06:43 / stefan"
 "Modified: 19.4.1997 / 18:14:41 / cg"
 	^ aBlock value:exitStatus
 ].
 ^ true.
 "
 OperatingSystem executeCommand:'sleep 30' onError:[].
 OperatingSystem executeCommand:'pwd' onError:[:status|status inspect].
 OperatingSystem executeCommand:'ls -l' onError:[].
 OperatingSystem executeCommand:'invalidCommand' onError:[:status| status inspect].
 OperatingSystem executeCommand:'rm /tmp/foofoofoofoo'onError:[:status | status inspect].
 "
 "Created: 28.1.1998 / 14:12:15 / md"
 !
 fork
 "fork a new (HEAVY-weight) unix process.
 Not supported with MSDOS & VMS systems.
 Dont confuse this with Block>>fork, which creates
 lightweight smalltalk processes. This method will return
 0 to the child process, and a non-zero number (which is the childs
 unix-process-id) to the parent (original) process.
 In normal situations, you dont need to use this low level entry; see
 err := 'err' asFilename writeStream.
 sema := Semaphore new.
 pid := OperatingSystem startProcess:'sleep 10; grep drw' inputFrom:in outputTo:out errorTo:err.
 The following will no longer work. monitorPid has disappeared
 pid notNil ifTrue:[
 	 Processor monitorPid:pid action:[:OSstatus | sema signal ].
 ].
 in close.
 "/    ^ self executeCommand:('mkdir ', newPathName)
 self primitiveFailed
 "
 OperatingSystem createDirectory:'foo'
 "
 "Modified: 20.12.1995 / 11:24:13 / stefan"
 "Modified: 29.6.1996 / 14:06:54 / cg"
 !
 (oldPath isString not or:[newPath isString not]) ifTrue:[
 	"/
 	"/ bad argument(s) given
 	"/
 	^ self primitiveFailed
 ].
 "/
 "/ this OperatingSystem does not support links
 "/
 "Modified: 7.3.1996 / 15:26:30 / cg"
 !
 removeDirectory:fullPathName
 "remove the directory named 'fullPathName'.
 The directory must be empty and you must have appropriate access rights.
 Return true if successful, false if directory is not empty or no permission.
 This is a lowLevel entry - use Filename protocol for compatibility."
 %{
 %}.
 ^ self primitiveFailed
 !
 renameFile:oldPath to:newPath
 "rename the file 'oldPath' to 'newPath'.
 Someone else has to care for the names to be correct and
 correct for the OS used - therefore, this should not be called
 directlt. Instead, use Filename protocol to rename; this cares for
 any invalid names.
 Returns true if successful, false if not"
 	} while (fd < 0 && errno == EINTR);
 	if (fd < 0) {
 	    @global(LastErrorNumber) = __MKSMALLINT(errno);
 	    RETURN ( false );
 	}
 	ret = ftruncate(fd, __intVal(newSize));
 	close(fd);
 	if (ret < 0) {
 	    @global(LastErrorNumber) = __MKSMALLINT(errno);
 	    RETURN ( false );
 	}
 	RETURN (true);
 }
 # endif /* using FTRUNCATE */
 #endif
 %}.
 ! !
 !OpenVMSOperatingSystem class methodsFor:'file access rights'!
 accessMaskFor:aSymbol
 "return the access bits mask for numbers as returned by
 OperatingSystem>>accessModeOf:
 and expected by OperatingSystem>>changeAccessModeOf:to:.
 Since these numbers are OS dependent, always use the mask
 (never hardcode 8rxxx into your code)."
 !
 accessModeOf:aPathName
 "return a number representing access rights rwxrwxrwx for owner,
 group and others. Return nil if such a file does not exist.
 Notice that the returned number is OS dependent - use the
 modeMasks as returned by OperatingSystem>>accessMaskFor:"
 "
 this could have been implemented as:
 	(self infoOf:aPathName) at:#mode
 !
 changeAccessModeOf:aPathName to:modeBits
 "change the access rights of aPathName to the OS dependent modeBits.
 You should construct this mask using accessMaskFor, to be OS
 independent. Return true if changed,
 false if such a file does not exist or change was not allowd."
 %{
 int ret;
 lockFD:aFileDescriptor shared:isSharedReadLock blocking:blockIfLocked
 "set a lock on the file represented by aFileDescriptor.
 (such as returned by ExternalStream>>fileDescriptor).
 On some systems, only advisory locks are available -
 these depends on other accessors to also perform the locking operation.
 If they do not, they may still access the file
 (on some systems, locks are mandatory, on others, they are advisory).
 The isSharedReadLock argument (if true) specifies if multiple readers
 are to be allowed - if false, they are not.
 On some systems, all locks are non-exclusive locks.
 Returns true, if the lock was aquired, false otherwise.
 Notice, that not all OS's support these locks;
 on some, this may simply be a no-op.
 Also notice, that some systems block the process, to wait for the lock.
 This can (again: on some systems) be avoided by passing a false blockIfLocked
 argument."
 if (__isSmallInteger(aFileDescriptor)) {
 	int fd = __intVal(aFileDescriptor);
 	int lockArg;
 	/*
 	 * claus: sigh - each one has a different interface ...
 	 */
 #if defined(F_SETLK)
 	{
 	    /*
 	     * new fcntl(SETLK) interface;
 	     * available on SYSV4 and Linux
 	     */
 	    struct flock flock;
 	}
 #else /* no F_SETLK available */
 # if defined(LOCK_EX) && defined(LOCK_UN)
 	/*
 	 * BSD 4.3 advisory locks
 	 */
 	lockArg = LOCK_EX;
 #  if defined(LOCK_SH)
 	if (isSharedReadLock == true) {
 	}
 # else /* no flock available */
 #  if defined(F_LOCK) && defined(F_UNLOCK)
 	/*
 	 * SYSV3 advisory locks
 	 */
 	if (lockf(fd, F_LOCK, 0) != -1) {
 	    RETURN (true);
 	}
 !
 unlockFD:aFileDescriptor
 "clear a file lock on the file represented by aFileDescriptor,
 which was previously aquired by #lockFD:.
 Return false, if the unlock failed
 (which may happens when a wrong fd is passed,
 no lock was set previously, or the systsem does not support locks).
 Notice, that not all OS's support file locks;
 on some, this may simply be a no-op."
 %{
 if (__isSmallInteger(aFileDescriptor)) {
 	int fd = __intVal(aFileDescriptor);
 	/*
 	}
 # else /* no flock available */
 #  if defined(F_LOCK) && defined(F_UNLOCK)
 	/*
 	 * SYSV3 advisory locks
 	 */
 	if (lockf(fd, F_UNLOCK, 0) != -1) {
 	    RETURN (true);
 	}
 !OpenVMSOperatingSystem class methodsFor:'file queries'!
 caseSensitiveFilenames
 "return true, if the OS has caseSensitive file naming.
 On MSDOS, this will return false;
 on a real OS, we return true."
 ^ false
 !
 return the true pathName and is therefore used as a fallback
 if realPath and popen failed."
 |names n "{ Class: SmallInteger }" |
 names := pathName
 		asCollectionOfSubstringsSeparatedBy:self fileSeparator.
 names := names asOrderedCollection.
 "
 cut off initial double-slashes
 "
 ].
 "
 cut off parent-dirs at end
 "
 [(n > 2)
 and:[(names endsWith:#('..'))
 and:[((names at:(n - 1)) startsWith:'.') not ]]] whileTrue:[
 	names removeLast; removeLast.
 	n := n - 2.
 ].
 ^ names asStringWith:self fileSeparator
 		    from:1
 		    to:n
 		    compressTabs:false final:nil
 "
 OperatingSystem compressPath:'./..'
 OperatingSystem compressPath:'/foo/bar/baz/..'
 OperatingSystem compressPath:'foo/bar/baz/..'
 OperatingSystem compressPath:'foo/bar/baz/../'
 OperatingSystem compressPath:'foo/bar/baz/..///'
 OperatingSystem compressPath:'///foo/bar/baz/..///'
 "
 "Modified: 1.11.1996 / 20:13:48 / cg"
 !
 ^ $/
 !
 getDriveList
 "return a list of volumes in the system.
 On unix, no such thing like a volume exists
 - there, a syntetic list with root, home & current is returned.
 On MSDOS, a list of drive letters is (eventually) returned.
 On VMS, a list of volumes is (eventually) returned."
 |list|
 %}.
 "/
 "/ default: retrurn array filled with
 "/ root, home and current directories.
 "/
 ^ Array
 	with:'/'
 	with:(self getHomeDirectory)
 	with:(Filename currentDirectory pathName)
 !
 infoOf:aPathName
 "return some object filled with info for the file 'aPathName';
 the info (for which corresponding access methods are understood by
 the returned object) is:
 	 type            - a symbol giving the files type
 	 mode            - numeric access mode
 	 uid             - owners user id
 	 gid             - owners group id
 	 size            - files size
 	 id              - files number (i.e. inode number)
 	 accessed        - last access time (as Timestamp)
 	 fixedHeaderSize     - (VMS only:) fixed header size in a variable record format
 	 recordSize          - (VMS only:) record size.
 Some of the fields may be returned as nil on systems which do not provide
 all of the information.
 Return nil if such a file does not exist.
 For symbolic links (if supported by the OS),
 the info of the pointed-to-file (i.e. the target) is returned;
 use #linkInfoOf: to get info about the link itself.
 "
 |info type mode uid gid size id
 atime mtime ctime
 aOStime mOStime cOStime
 aYr aMon aDay aHr aMin aSec aMS
 mYr mMon mDay mHr mMin mSec mMS
 cYr cMon cDay cHr cMin cSec cMS
 name2
 recordFormat recordAttribs fixedHeaderSize recordSize
 recordFormatNumeric|
 %{
 struct stat buf;
 	cOStime = __MKUINT(buf.st_ctime);
 }
 %}.
 mode notNil ifTrue:[
 	aOStime notNil ifTrue:[
-	    atime := AbsoluteTime fromOSTime:(aOStime * 1000).
+	    atime := Timestamp fromOSTime:(aOStime * 1000).
-	    mtime := AbsoluteTime fromOSTime:(mOStime * 1000).
+	    mtime := Timestamp fromOSTime:(mOStime * 1000).
-	    ctime := AbsoluteTime fromOSTime:(cOStime * 1000).
+	    ctime := Timestamp fromOSTime:(cOStime * 1000).
 	] ifFalse:[
-	    atime := AbsoluteTime day:aDay month:aMon year:aYr hour:aHr minutes:aMin seconds:aSec milliseconds:aMS.
+	    atime := Timestamp day:aDay month:aMon year:aYr hour:aHr minutes:aMin seconds:aSec milliseconds:aMS.
-	    mtime := AbsoluteTime day:mDay month:mMon year:mYr hour:mHr minutes:mMin seconds:mSec milliseconds:mMS.
+	    mtime := Timestamp day:mDay month:mMon year:mYr hour:mHr minutes:mMin seconds:mSec milliseconds:mMS.
-	    ctime := AbsoluteTime day:cDay month:cMon year:cYr hour:cHr minutes:cMin seconds:cSec milliseconds:cMS.
+	    ctime := Timestamp day:cDay month:cMon year:cYr hour:cHr minutes:cMin seconds:cSec milliseconds:cMS.
 	].
 	info := FileStatusInfo
 		    type:type
 		    mode:mode
 		    uid:uid
 		    gid:gid
 		    size:size
 		    id:id
 		    accessed:atime
 		    modified:mtime
 		    statusChanged:ctime
 		    path:nil.
 	recordFormat notNil ifTrue:[
 	    "/ additional VMS info
 ^ (self linkInfoOf:aPathName) notNil
 "
 OperatingSystem isSymbolicLink:'Make.proto'
 OperatingSystem isSymbolicLink:'Makefile'
 "
 !
 isValidPath:aPathName
 "return true, if 'aPathName' is a valid path name
 ^ self primitiveFailed
 !
 linkInfoOf:aPathName
 "return a dictionary filled with info for the file 'aPathName',
 IFF aPathName is a symbolic link.
 If aPathName is invalid, or its NOT a symbolic link, nil is returned.
 (which means, that systems like VMS or MSDOS always return nil here.)
 The contents of the dictionary gives info about the link itself,
 on contrast to #infoOf:, which returns the info of the pointed to file
 in case of a symbolic link."
 ^ nil
 !
 parentDirectoryName
 "return the name used to refer to parent directories.
 "
 OperatingSystem pathNameOf:'.'
 OperatingSystem pathNameOf:'../smalltalk/../smalltalk'
 OperatingSystem pathNameOf:'../../..'
 OperatingSystem pathNameOf:'..'
 OperatingSystem pathNameOf:'/tmp////'
 OperatingSystem pathNameOf:'/foo/bar'
 OperatingSystem pathNameOf:'/foo/bar/'
 OperatingSystem pathNameOf:'/foo/bar//'
 "
 "Modified: 29.11.1996 / 18:02:12 / stefan"
 %{  /* STACK: 16000 */
 if (__isString(pathName)) {
 #ifdef HAS_GETCWD
 	if (strcmp(__stringVal(pathName), "[]") == 0)
 	{
 	    char nameBuffer[MAXPATHLEN + 1];
 	    if (@global(CurrentDirectory) == nil) {
 		if (getcwd(nameBuffer, MAXPATHLEN)) {
 timeOfLastAccess:aPathName
 "return the time, when the file was last accessed.
 For nonexistent files, nil is returned."
 "could be implemented as:
 	(self infoOf:aPathName) accessed
 "
 |osSeconds i|
 %{
 #if !defined(WIN32) && !defined(__VMS__)
 	}
 	osSeconds = __MKUINT(buf.st_atime);
 }
 #endif
 %}.
-osSeconds notNil ifTrue:[^ AbsoluteTime fromOSTime:(osSeconds * 1000)].
+osSeconds notNil ifTrue:[^ Timestamp fromOSTime:(osSeconds * 1000)].
 i := self infoOf:aPathName.
 i notNil ifTrue:[^ i accessed].
 ^ nil.
 OperatingSystem timeOfLastAccess:'/'
 "
 !
 timeOfLastChange:aPathName
 "return the time, when the file was last changed.
 For nonexistent files, nil is returned."
 "could be implemented as:
 	(self infoOf:aPathName) modified
 "
 	}
 	osSeconds = __MKUINT(buf.st_mtime);
 }
 #endif
 %}.
-osSeconds notNil ifTrue:[^ AbsoluteTime fromOSTime:(osSeconds * 1000)].
+osSeconds notNil ifTrue:[^ Timestamp fromOSTime:(osSeconds * 1000)].
 i := self infoOf:aPathName.
 i notNil ifTrue:[^ i modified].
 ^ nil.
 |i|
 "
 this could have been implemented as:
 	(self infoOf:aPathName) type
 but for huge directory searches the code below is faster
 "
 %{
 struct stat buf;
 i := self infoOf:aPathName.
 i notNil ifTrue:[^ i type].
 ^ nil.
 "
 OperatingSystem typeOf:'/'
 OperatingSystem typeOf:'.'
 OperatingSystem typeOf:'Make.proto'
 OperatingSystem typeOf:'resources/motif.style'
 "
 !
 volumeNameOf:aPathString
 "return the volumeName of the argument, aPath
 "
 !
 disableTimer
 "disable timer interrupts.
 WARNING:
 	the system will not operate correctly with timer interrupts
 	disabled, because no scheduling or timeouts are possible."
 %{  /* NOCONTEXT */
 %}.
 ^ false
 !
 enableChildSignalInterrupts
 "enable childSignal interrupts
 (SIGCHLD, if the architecture supports it).
 After enabling, these signals will send the message
 'childSignalInterrupt' to the ChildSignalInterruptHandler object."
 %{
 extern void __vmsEnableChildInterrupts();
 	struct itimerval dt;
 	dt.it_interval.tv_sec = 0;
 	dt.it_interval.tv_usec = 0;
 	dt.it_value.tv_sec = millis / 1000;
 	dt.it_value.tv_usec = (millis % 1000) * 1000;
 	setitimer(ITIMER_REAL, &dt, 0);
 	RETURN (true);
 }
 #else /* no ITIMER_REAL */
 "trigger a spyInterrupt, to be signalled after some short (virtual) time.
 This is used by the old MessageTally for profiling.
 Should be changed to use real profiling timer if available.
 On systems, where no virtual timer is available, use the real timer
 (which is of course less correct).
 OBSOLETE: the new messageTally runs as a high prio process, not using
 	       spy interrupts."
 %{  /* NOCONTEXT */
 #ifndef __spyInterrupt
 ^ false
 !
 stopSpyTimer
 "stop spy timing - disable spy timer.
 OBSOLETE: the new messageTally runs as a high prio process, not using
 	       spy interrupts."
 %{  /* NOCONTEXT */
 #if defined(ITIMER_VIRTUAL) && !defined(NO_SETITIMER)
 in isNil ifTrue:[
 	^ nil
 ].
 out := self createMailBox.
 out isNil ifTrue:[
 	self destroyMailBox:in.
 	^ nil
 ].
 ^ Array with:in with:out
 !
 	hostName notNil ifTrue:[
 	    idx := hostName indexOf:$..
 	    idx ~~ 0 ifTrue:[
 		name := hostName copyFrom:idx+1.
 	    ]
 	].
 	name isNil ifTrue:[
 	    'OpenVMSOperatingSystem [warning]: cannot find out domainname' errorPrintCR.
 	    name := 'unknown'.
 	]
 ].
 }
 # else
 #  if defined(HAS_SYSINFO) && defined(SI_HOSTNAME)
 char buffer[256];
 int ret;
 if ((ret = sysinfo(SI_HOSTNAME, buffer, sizeof(buffer))) >= 0 && ret <= sizeof(buffer)) {
 	name = __MKSTRING(buffer);
 }
 #  endif
 # endif
 	positiveSignSeparatedBySpaceFromCurrencySymbol  <Boolean>
 	negativeSignSeparatedBySpaceFromCurrencySymbol  <Boolean>
 	positiveSignPosition                            <Symbol>
 							one of: #parenthesesAround,
 								#signPrecedes,
 								#signSuceeds,
 								#signPrecedesCurrencySymbol,
 								#signSuceedsCurrencySymbol
 	negativeSignPosition                            <like above>
 	monThousandsSep = conf->mon_thousands_sep;
 	positiveSign = conf->positive_sign;
 	negativeSign = conf->negative_sign;
 	intFractDigits = conf->int_frac_digits;
 	fractDigits = conf->frac_digits;
 	csPosPrecedes = conf->p_cs_precedes;
 	csNegPrecedes = conf->n_cs_precedes;
 	csPosSepBySpace = conf->p_sep_by_space;
 	csNegSepBySpace = conf->n_sep_by_space;
 	csPosSignPosition = conf->p_sign_posn;
 	csNegSignPosition = conf->n_sign_posn;
 }
 #else
 decimalPoint = (char *)0;
 monThousandsSep = (char *)0;
 positiveSign =  (char *)0;
 negativeSign =(char *)0;
 intFractDigits = -1;
 fractDigits = -1;
 csPosPrecedes = -1;
 csNegPrecedes = -1;
 csPosSepBySpace = -1;
 csNegSepBySpace = -1;
 csPosSignPosition = -1;
 csNegSignPosition = -1;
 #endif
 if (decimalPoint) {
 	val = __MKSTRING(decimalPoint);
 getSystemInfo
 "return info on the system weare running on.
 If the system supports the uname system call, that info is returned;
 otherwise, some simulated info is returned.
 WARNING:
 Do not depend on the amount and contents of the returned information, some
 systems may return more/less than others. Also, the contents depends on the
 OS, for example, linux returns 'ix86', while WIN32 returns 'x86'.
 This method is mainly provided to augment error reports with some system
 information.
 (in case of system/version specific OS errors, conditional workarounds and patches
 	may be based upon this info).
 Your application should NOT depend upon this in any way.
 The returned info may (or may not) contain:
 	#system -> some operating system identification (irix, Linux, nt, win32s ...)
 	#version -> OS version (some os version identification)
 	#release -> OS release (3.5, 1.2.1 ...)
 	#node   -> some host identification (hostname)
 	#domain  -> domain name (hosts domain)
 	#machine -> type of machine (i586, mips ...)
 	 We return a somewhat conservative number here.
 	 Another entry, to query for volume specific max
 	 will be added in the future."
 %{  /* NOCONTEXT */
 /*
 * TODO: newer systems provide a query function for this ... use it
 */
 #   ifdef __VMS__
 %{  /* NOCONTEXT */
 RETURN ( __MKSMALLINT(MAXPATHLEN) );
 %}
 "
 OperatingSystem maxPathLength
 "
 !
 pathSeparator
 "return the character which separates items in the PATH variable"
 through interrupts (i.e. SIGCHILD)"
 ^ true
 "
 OperatingSystem supportsChildInterrupts
 "
 !
 supportsIOInterrupts
 "return true, if the OS supports IO availability interrupts
 (i.e. SIGPOLL/SIGIO).
 Currently, this mechanism does not work on all
 systems ...
 "
 ^ false
 "
 OperatingSystem supportsIOInterrupts
 "
 !
 supportsNonBlockingIO
 "return true, if the OS supports nonblocking IO."
 #endif
 %}.
 ^ false
 "
 OperatingSystem supportsNonBlockingIO
 "
 !
 supportsSelect
 "return true, if the OS supports selecting on multiple
 filedescriptors via select.
 If false is returned, ProcessorScheduler will poll in 50ms
 intervals for I/O becoming ready."
 ^ false "/ for now ...
 "
 OperatingSystem supportsSelect
 "
 !
 supportsVolumes
 "return true, if the OS supports disk volumes.
 ]
 "
 !
 computeOSTimeFromYear:y month:m day:d hour:h minute:min seconds:s millis:millis
 "return the OS-dependent time for the given time and day.
 The arguments are assumed to be in localtime including
 any daylight saving adjustings."
 |osSeconds|
 %{
 struct tm tm;
 TIME_T t;
 if (__bothSmallInteger(y, m)
 && __bothSmallInteger(d, h)
 && __bothSmallInteger(min, s)) {
 	tm.tm_hour = __intVal(h);
 	tm.tm_min = __intVal(min);
 	tm.tm_sec = __intVal(s);
 	osSeconds = __MKUINT((INT)t);
 }
 %}.
 osSeconds notNil ifTrue:[
 	^ osSeconds * 1000 + millis
 ].
 ^ self primitiveFailed
 "
 OperatingSystem computeOSTimeFromYear:1970 month:1 day:1 hour:0 minute:0 seconds:0 millis:0
 "
 containing (full-) year, month, day, hour, minute and seconds,
 offset to UTC, daylight savings time flag, milliseconds,
 dayInYear (1..) and dayInWeek (1..).
 Conversion is to localtime including any daylight saving adjustments."
 |low hi year month day hours minutes seconds millis utcOffset
 dst yDay wDay osSeconds ret|
 millis := osTime \\ 1000.
 osSeconds := osTime // 1000.
 %{
 OperatingSystem computeTimeAndDateFrom:0
 "
 !
 computeTimePartsOf:osTime for:aBlock
 "compute hours, minutes, seconds and milliseconds from the osTime
 and evaluate the argument, a 4-arg block with these.
 Conversion is to localtime including any daylight saving adjustments."
 |hours minutes seconds millis osSeconds|
 containing year, month, day, hour, minute and seconds,
 offset to UTC, daylight savings time flag, milliseconds,
 dayInYear (1..) and dayInWeek (1..).
 Conversion is to UTC."
 |low hi year month day hours minutes seconds millis utcOffset
 dst yDay wDay osSeconds ret|
 millis := osTime \\ 1000.
 osSeconds := osTime // 1000.
 %{
 OperatingSystem computeUTCTimeAndDateFrom:0
 "
 !
 computeUTCTimePartsOf:osTime for:aBlock
 "compute hours, minutes, seconds and milliseconds from the osTime
 and evaluate the argument, a 4-arg block with these.
 Conversion is to UTC."
 |hours minutes seconds millis osSeconds|
 ]
 "
 !
 getMillisecondTime
 "This returns the millisecond timers value.
 The range is limited to 0..1fffffff (i.e. the SmallInteger range) to avoid
 LargeInteger arithmetic when doing timeouts and delays.
 Since this value is wrapping around in regular intervals, this can only be used for
 short relative time deltas.
 Use the millisecondTimeXXX:-methods to compare and add time deltas - these know about the wrap.
 BAD DESIGN:
 	This should be changed to return some instance of RelativeTime,
 #   define HAVE_TIME
 # endif
 # ifndef HAVE_TIME
 #  if defined(SYSV) && defined(HZ)
 /*
 * sys5 time
 */
 long ticks;
 struct tms tb;
 # endif
 #endif
 #ifndef HAVE_TIME
 /* assume HAS_GETTIMEOFDAY
 * - will result in a linkage error
 * if not fixed.
 */
 /*
 getOSTime
 "This returns the OS time.
 The base of the returned value is not consistent across
 different OS's - some return the number of millis since jan, 1st 1970;
 others since 1900. The Time classes are prepared for this, and
 converts as appropriate (by using my fromOSTime: conversion methods).
 Dont use this method in application code since it is an internal (private)
 interface. For compatibility with ST-80, use Time>>millisecondClockValue.
-or use instances of Time, Date or AbsoluteTime to work with.
+or use instances of Time, Date or Timestamp to work with.
 "
 |seconds millis|
 %{
 long t;
 #if !defined(HAS_GETTIMEOFDAY)
 # if defined(HAS_FTIME)
 struct timeb timebuffer;
 ftime(&timebuffer);
 seconds = __MKUINT(timebuffer.time);
 #   define HAVE_TIME
 # endif
 # ifndef HAVE_TIME
 #  if defined(SYSV) && defined(HZ)
 /*
 * sys5 time; we have to fake the information
 * the returned value is inexact.
 */
 int now;
 long ticks;
 #  endif
 # endif
 #endif
 #ifndef HAVE_TIME
 /* assume HAS_GETTIMEOFDAY
 * - will result in a linkage error
 * if not fixed.
 */
 /*
 * bsd time
 struct timeval tb;
 struct timezone tzb;
 gettimeofday(&tb, &tzb);
 /*
 * mhmh long-long stuff seems not to work correctly
 * on all machines (sparc)
 * being conservative here ...
 */
 # if defined(__GNUC__) && (__GNUC__ >= 2) && defined(i386) && defined(LINUX)
 !
 millisecondDelay:millis
 "delay execution for millis milliseconds or until the next event
 arrives.
 All lower priority threads will also sleep for the duration,
 interrupts (and therefore, higher prio processes) are
 still handled.
 Better use a Delay, to only delay the calling thread.
 (however, a delay cannot be used in the event handler or scheduler)"
 |now then delta|
 }
 RETURN(self);
 # endif
 #endif
 %}.
 now := OpenVMSOperatingSystem getMillisecondTime.
 then := OpenVMSOperatingSystem millisecondTimeAdd:now and:millis.
 [OpenVMSOperatingSystem millisecondTime:then isAfter:now] whileTrue:[
 	delta := OpenVMSOperatingSystem millisecondTimeDeltaBetween:then and:now.
 	^ gecos
 ].
 ^ self getUserNameFromID:userID
 "
 OperatingSystem getFullUserNameFromID:0
 OperatingSystem getFullUserNameFromID:(OperatingSystem getUserID)
 OperatingSystem getUserNameFromID:(OperatingSystem getUserID)
 "
 "Modified: 15.7.1996 / 12:44:21 / cg"
 !
 ^ '? (' , aNumber printString , ')'
 "
 OperatingSystem getUserNameFromID:0
 OperatingSystem getUserNameFromID:100
 OperatingSystem getUserNameFromID:9991
 "
 !
 userInfoOf:aNameOrID
 "{ Pragma: +optSpace }"
 "return a dictionary filled with userinfo. The argument can be either
 a string with the users name or its numeric id.
 Notice, that not all systems provide (all of) this info;
 DOS systems return nothing;
 non-SYSV4 systems have no age/comment.
 Portable applications may want to check the systemType and NOT depend
 on all keys to be present in the returned dictionary.
 Another notice: on some systems (SYSV4), the gecos field includes multiple
 entries (i.e. not just the name), separated by commas. You may want to
 ^ info
 "
 OperatingSystem userInfoOf:'root'
 OperatingSystem userInfoOf:1
 OperatingSystem userInfoOf:'claus'
 OperatingSystem userInfoOf:'fooBar'
 OperatingSystem userInfoOf:(OperatingSystem getUserID)
 "
 ! !
 !OpenVMSOperatingSystem class methodsFor:'waiting for events'!
 childProcessWait:blocking pid:pidToWait
 "{ Pragma: +optSpace }"
 "get status changes from child processes.
 Return an OSProcessStatus or nil, if no process has terminated.
 If blocking is true, we wait until a process changed state,
 otherwise we return immediately.
 Note that win32 needs to know the HANDLE of the process on which
 it waits.  In case of an error, THIS ALWAYS WAITS and then times out."
 |pid status code core|
 %{
 #ifdef __VMS__
 %}.
 ^ (self readCheck:fd) ifTrue:[1] ifFalse:[0]
 !
 readCheck:fd
 "return true, if data is available on a filedescriptor
 (i.e. read is possible without blocking).
 This depends on a working select or FIONREAD to be provided by the OS."
 %{
 #ifdef NOTDEF   /* does not work ... */
 ^ super readCheck:fd
 !
 selectOnAnyReadable:readFdArray writable:writeFdArray exception:exceptFdArray withTimeOut:millis
 "wait for any fd in readFdArray (an Array of integers) to become ready for
 reading, writeFdArray to become ready for writing, or exceptFdArray to
 arrive exceptional data (i.e. out-of-band data).
 Timeout after t milliseconds or, if the timeout time is 0, immediately..
 Empty fd-sets will always wait. Zero time can be used to poll file-
 descriptors (i.e. to check if I/O possible without blocking).
 Return first ready fd if I/O ok, nil if timed-out or interrupted."
 	FD_ZERO(&eset);
 	maxF = -1;
 	if (__isNonNilObject(readFdArray)) {
 	    if (! __isArrayLike(readFdArray)) {
 		goto fail;
 	    }
 	    count = __arraySize(readFdArray);
 	    for (i=0; i<count;i++) {
 		fd = __ArrayInstPtr(readFdArray)->a_element[i];
 	    }
 	}
 	if (__isNonNilObject(writeFdArray)) {
 	    if (! __isArrayLike(writeFdArray)) {
 		goto fail;
 	    }
 	    count = __arraySize(writeFdArray);
 	    for (i=0; i<count;i++) {
 		fd = __ArrayInstPtr(writeFdArray)->a_element[i];
 		if (fd != nil) {
 		    f = __intVal(fd);
 		    if ((unsigned)f < FD_SETSIZE) {
 			FD_SET(f, &wset);
 			if (f > maxF) maxF = f;
 			numFds++;
 		    }
 		}
 	    }
 	}
 	if (__isNonNilObject(exceptFdArray)) {
 	    if (! __isArrayLike(exceptFdArray)) {
 		goto fail;
 	    }
 	    count = __arraySize(exceptFdArray);
 	    for (i=0; i<count;i++) {
 		fd = __ArrayInstPtr(exceptFdArray)->a_element[i];
 		if (fd != nil) {
 		    f = __intVal(fd);
 		    if ((unsigned)f < FD_SETSIZE) {
 			FD_SET(f, &eset);
 			if (f > maxF) maxF = f;
 			numFds++;
 		    }
 		}
 	    }
 	 */
 	__BEGIN_INTERRUPTABLE__
 	errno = 0;
 	if (t == 0) {
 	    /*
 	     * if there is no timeout time, we can stay here interruptable.
 	     */
 	    do {
 		ret = select(maxF+1, &rset, &wset, &eset, &wt);
 	    } while ((ret < 0) && (errno == EINTR));
 	} else {
 	    do {
 		ret = select(maxF+1, &rset, &wset, &eset, &wt);
 		/*
 		 * for now: dont loop; if we did, we had to adjust the vt-timeval;
 		 * could otherwise stay in this loop forever ...
 		 * Premature return (before the time expired) must be handled by the caller.
 		 * A good solution is to update the wt-timeval and redo the select.
 		 */
 ^ self primitiveFailed
 ! !
 !OpenVMSOperatingSystem::FileStatusInfo class methodsFor:'instance creation'!
 type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP
 ^ self basicNew
 	type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP
 ! !
 !OpenVMSOperatingSystem::FileStatusInfo methodsFor:'accessing'!
 accessed
 recordAttributes := ra.
 fixedHeaderSize := hs.
 recordSize := rs
 !
 type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP
 type := t.
 mode := m.
 uid := u.
 gid := g.
 size := s.
 ! !
 !OpenVMSOperatingSystem class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/OpenVMSOperatingSystem.st,v 1.12 2003-02-27 14:49:24 stefan Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/OpenVMSOperatingSystem.st,v 1.13 2004-03-20 19:23:29 stefan Exp $'
 ! !
 OpenVMSOperatingSystem initialize!

changeset 8266	3dc78835e119
parent 7080	a82683bc1843
child 8901	824a89d0b5c7