Win32OperatingSystem.st
changeset 23257 7aaf6920019d
parent 23150 047b878c8123
child 23264 d31e473458a3
equal deleted inserted replaced
23256:966ae73cc387 23257:7aaf6920019d
  1017     "Modified: 22.4.1996 / 13:10:43 / cg"
  1017     "Modified: 22.4.1996 / 13:10:43 / cg"
  1018     "Created: 15.6.1996 / 15:22:37 / cg"
  1018     "Created: 15.6.1996 / 15:22:37 / cg"
  1019     "Modified: 7.1.1997 / 19:36:11 / stefan"
  1019     "Modified: 7.1.1997 / 19:36:11 / stefan"
  1020 ! !
  1020 ! !
  1021 
  1021 
  1022 
       
  1023 !Win32OperatingSystem class methodsFor:'OS signal constants'!
  1022 !Win32OperatingSystem class methodsFor:'OS signal constants'!
  1024 
  1023 
  1025 sigABRT
  1024 sigABRT
  1026     "return the signal number for SIGABRT - 0 if not supported by OS
  1025     "return the signal number for SIGABRT - 0 if not supported by OS
  1027      (the numeric value is not the same across unix-systems)"
  1026      (the numeric value is not the same across unix-systems)"
  1664     ^self primIsClipboardFormatAvailable: aCfConstant
  1663     ^self primIsClipboardFormatAvailable: aCfConstant
  1665 !
  1664 !
  1666 
  1665 
  1667 closeClipboard
  1666 closeClipboard
  1668     | result |
  1667     | result |
       
  1668 
  1669     result := self primCloseClipboard.
  1669     result := self primCloseClipboard.
  1670     result ifFalse: [ ^self error].
  1670     result ifFalse: [
  1671     ^result
  1671         self error:'Clipboard close failed'
       
  1672     ].
       
  1673     ^ result
       
  1674 
       
  1675     "Modified: / 03-08-2018 / 11:15:15 / Stefan Vogel"
  1672 !
  1676 !
  1673 
  1677 
  1674 emptyClipboard
  1678 emptyClipboard
  1675 	"Private - empty the clipboard. Note: it must be opened first."
  1679         "Private - empty the clipboard. Note: it must be opened first."
  1676     | result |
  1680     | result |
  1677     result := self primEmptyClipboard.
  1681     result := self primEmptyClipboard.
  1678     result ifFalse: [ ^self error].
  1682     result ifFalse: [
       
  1683         self error:'Clipboard empty failed'
       
  1684     ].
  1679     ^result
  1685     ^result
       
  1686 
       
  1687     "Modified: / 03-08-2018 / 11:15:47 / Stefan Vogel"
  1680 !
  1688 !
  1681 
  1689 
  1682 getDesktopWindow
  1690 getDesktopWindow
  1683 
  1691 
  1684     ^self primGetDesktopWindow
  1692     ^self primGetDesktopWindow
  1689     ^self openClipboard: self getDesktopWindow
  1697     ^self openClipboard: self getDesktopWindow
  1690 !
  1698 !
  1691 
  1699 
  1692 openClipboard: aHwnd
  1700 openClipboard: aHwnd
  1693     | result |
  1701     | result |
       
  1702 
  1694     result := self primOpenClipboard: aHwnd.
  1703     result := self primOpenClipboard: aHwnd.
  1695     result ifFalse: [ ^self error].
  1704     result ifFalse: [
  1696     ^result
  1705         self error:'Clipboard open failed'
       
  1706     ].
       
  1707     ^ result
       
  1708 
       
  1709     "Modified: / 03-08-2018 / 11:16:08 / Stefan Vogel"
  1697 !
  1710 !
  1698 
  1711 
  1699 primCloseClipboard
  1712 primCloseClipboard
  1700 
  1713 
  1701     <apicall: bool "CloseClipboard" () module: "user32.dll" >
  1714     <apicall: bool "CloseClipboard" () module: "user32.dll" >
  1731     <apicall: ulongReturn "SetClipboardData" (ulong ulong) module: "user32.dll" >
  1744     <apicall: ulongReturn "SetClipboardData" (ulong ulong) module: "user32.dll" >
  1732     ^self primitiveFailed
  1745     ^self primitiveFailed
  1733 !
  1746 !
  1734 
  1747 
  1735 setBitmapToClipboard: aBitmap
  1748 setBitmapToClipboard: aBitmap
  1736 	"Copy aBitmap to the clipboard."
  1749     "Copy aBitmap to the clipboard."
       
  1750 
  1737     | handle |
  1751     | handle |
       
  1752 
  1738     aBitmap isNil ifTrue:[ ^nil ].
  1753     aBitmap isNil ifTrue:[ ^nil ].
  1739     aBitmap id isNil ifTrue:[aBitmap onDevice: Screen current].
  1754     aBitmap id isNil ifTrue:[aBitmap onDevice: Screen current].
  1740     handle := aBitmap id.
  1755     handle := aBitmap id.
  1741     handle isNil ifTrue: [ ^nil ].
  1756     handle isNil ifTrue: [ ^ nil ].
  1742     self openClipboard ifFalse: [ ^nil ].
  1757     self openClipboard ifFalse: [ ^ nil ].
  1743     self emptyClipboard.
  1758     self emptyClipboard.
  1744     self setClipboardData: 2 "CfBitmap" hMem: handle.
  1759     self setClipboardData: 2 "CfBitmap" hMem: handle.
  1745     self closeClipboard
  1760     self closeClipboard
  1746 
  1761 
  1747     "
  1762     "
  1748 	self setBitmapToClipboard: Image fromUser
  1763         Win32OperatingSystem setBitmapToClipboard: Image fromUser
  1749     "
  1764     "
  1750 !
  1765 
  1751 
  1766     "Modified (format): / 03-08-2018 / 11:24:11 / Stefan Vogel"
  1752 setClipboardData: aCfConstant hMem: aMemHandle
  1767 !
       
  1768 
       
  1769 setClipboardData:aCfConstant hMem:aMemHandle
  1753     |result|
  1770     |result|
       
  1771 
  1754     result := self primSetClipboardData: aCfConstant hMem: aMemHandle address.
  1772     result := self primSetClipboardData: aCfConstant hMem: aMemHandle address.
  1755     result = 0 ifTrue: [ ^self error ].
  1773     result = 0 ifTrue: [
       
  1774         self error:'Set clipboard data failed'
       
  1775     ].
       
  1776     ^ result.
       
  1777 
       
  1778     "Modified: / 03-08-2018 / 11:21:11 / Stefan Vogel"
  1756 ! !
  1779 ! !
  1757 
  1780 
  1758 !Win32OperatingSystem class methodsFor:'debugging'!
  1781 !Win32OperatingSystem class methodsFor:'debugging'!
  1759 
  1782 
  1760 verbose:aBoolean
  1783 verbose:aBoolean
  7566    ^ (aNumber == self sigSEGV)
  7589    ^ (aNumber == self sigSEGV)
  7567      or:[aNumber == self sigILL
  7590      or:[aNumber == self sigILL
  7568      or:[aNumber == self sigBUS]]
  7591      or:[aNumber == self sigBUS]]
  7569 !
  7592 !
  7570 
  7593 
  7571 killProcess:processId
  7594 killProcess:processHandleOrPid
  7572     "kill a process.
  7595     "kill a process.
  7573      The process terminates immediately and has no chance to perform any cleanup actions.
  7596      The process terminates immediately and has no chance to perform any cleanup actions.
  7574 
  7597 
  7575      WARNING: in order to avoid zombie processes (on unix),
  7598      WARNING: in order to avoid zombie processes (on unix),
  7576 	      you have to fetch the processes exitstatus with
  7599               you have to fetch the processes exitstatus with
  7577 	      OperatingSystem>>getStatusOfProcess:aProcessId."
  7600               OperatingSystem>>getStatusOfProcess:aProcessId."
  7578 
  7601 
  7579     self terminateProcess:processId
  7602     self killProcess:processHandleOrPid exitCode:0.
  7580 !
  7603 
  7581 
  7604     "Modified (format): / 03-08-2018 / 09:42:03 / Stefan Vogel"
  7582 killProcessGroup:processGroupId
  7605 !
       
  7606 
       
  7607 killProcess:processHandleOrPid exitCode:exitCode
       
  7608     "kill a process.
       
  7609      The process terminates immediately and has no chance to perform any cleanup actions."
       
  7610 
       
  7611 %{
       
  7612     if (__isExternalAddressLike(processHandleOrPid) ) {
       
  7613         HANDLE hProcess = _HANDLEVal(processHandleOrPid);
       
  7614 
       
  7615         if (hProcess != 0) {
       
  7616             TerminateProcess( hProcess, __intVal(exitCode) );
       
  7617         }
       
  7618         RETURN( true );
       
  7619     } else if( __isSmallInteger(processHandleOrPid) ) {
       
  7620         HANDLE hProcess = OpenProcess(PROCESS_TERMINATE, 0, __smallIntegerVal(processHandleOrPid));
       
  7621 
       
  7622         if( hProcess != 0 ) {
       
  7623             TerminateProcess( hProcess, __intVal(exitCode) );
       
  7624             CloseHandle(hProcess);
       
  7625         }
       
  7626         RETURN( true );
       
  7627     }
       
  7628 %}.
       
  7629     self primitiveFailed:#invalidParameter.
       
  7630 
       
  7631     "Created: / 03-08-2018 / 09:38:02 / Stefan Vogel"
       
  7632 !
       
  7633 
       
  7634 killProcessGroup:processGroupHandleOrPid
  7583     "kill a process group.
  7635     "kill a process group.
  7584      The process(es) terminate immediately and has no chance to perform any cleanup actions.
  7636      The process(es) terminate immediately and has no chance to perform any cleanup actions.
       
  7637      Here we kill any offspring of the process identified by processGroupHandleOrPid.
  7585 
  7638 
  7586      WARNING: in order to avoid zombie processes (on unix),
  7639      WARNING: in order to avoid zombie processes (on unix),
  7587 	      you have to fetch the processes exitstatus with
  7640               you have to fetch the processes exitstatus with
  7588 	      OperatingSystem>>getStatusOfProcess:aProcessId."
  7641               OperatingSystem>>getStatusOfProcess:aProcessId."
  7589 
  7642 
  7590     self terminateProcessGroup:processGroupId
  7643     | pid processList groupsToTerminate anyMore |
       
  7644 
       
  7645     processGroupHandleOrPid isInteger ifTrue:[
       
  7646         pid := processGroupHandleOrPid
       
  7647     ] ifFalse:[
       
  7648         pid := processGroupHandleOrPid pid.
       
  7649     ].
       
  7650     groupsToTerminate := Set with:pid.
       
  7651     processList := self getAllProcesses asSet.
       
  7652 
       
  7653     "/ Transcript show:'terminate group '; showCR:pid.
       
  7654     anyMore := true.
       
  7655     [anyMore] whileTrue:[
       
  7656         anyMore := false.
       
  7657         processList doWithExit:[:anOSProcess :exit |
       
  7658             |pid|
       
  7659 
       
  7660             (groupsToTerminate includes:anOSProcess parentPid) ifTrue:[
       
  7661                 pid := anOSProcess pid.
       
  7662                 groupsToTerminate add:pid.
       
  7663                 "/ Transcript show:'terminate '; showCR:pid.
       
  7664                 self killProcess:pid.
       
  7665                 processList remove:anOSProcess.
       
  7666                 anyMore := true.
       
  7667                 "/ need to restart: we have removed an element inside the loop
       
  7668                 exit value:nil
       
  7669             ].
       
  7670         ].
       
  7671     ].
       
  7672 
       
  7673     "Modified: / 03-08-2018 / 09:58:21 / Stefan Vogel"
  7591 !
  7674 !
  7592 
  7675 
  7593 microsecondSleep:micros
  7676 microsecondSleep:micros
  7594     "cease ANY action for some time.
  7677     "cease ANY action for some time.
  7595      This suspends the whole smalltalk (unix/windows-) process for some time.
  7678      This suspends the whole smalltalk (unix/windows-) process for some time.
  7684 
  7767 
  7685 terminateProcess:processHandleOrPid exitCode:exitCode
  7768 terminateProcess:processHandleOrPid exitCode:exitCode
  7686     "terminate a process.
  7769     "terminate a process.
  7687 
  7770 
  7688      ATTENTION WIN32:
  7771      ATTENTION WIN32:
  7689 	 Under unix, we have terminateProcess, which does a soft
  7772          Under unix, we have terminateProcess, which does a soft
  7690 	 terminate (giving the process a chance to cleanup) and
  7773          terminate (giving the process a chance to cleanup) and
  7691 	 killProcess, which does a hard terminate.
  7774          killProcess, which does a hard terminate.
  7692 	 Under WIN32, both (currently) use the TerminateProcess
  7775          Under WIN32, both (currently) use the TerminateProcess
  7693 	 function, which unconditionally causes a process to exit.
  7776          function, which unconditionally causes a process to exit.
  7694 	 I.e. under WIN32, the process has no chance to perform cleanup.
  7777          I.e. under WIN32, the process has no chance to perform cleanup.
  7695 	 Use it only in extreme circumstances. The state of
  7778          Use it only in extreme circumstances. The state of
  7696 	 global data maintained by dynamic-link libraries (DLLs)
  7779          global data maintained by dynamic-link libraries (DLLs)
  7697 	 may be compromised if TerminateProcess is used.
  7780          may be compromised if TerminateProcess is used.
  7698 
  7781 
  7699      TODO: send a WM_QUIT instead, to allow for proper shutdown."
  7782      TODO: send a WM_QUIT instead, to allow for proper shutdown."
  7700 
  7783 
  7701 %{
  7784      self killProcess:processHandleOrPid exitCode:exitCode
  7702     if (__isExternalAddressLike(processHandleOrPid) ) {
  7785 
  7703 	HANDLE hProcess = _HANDLEVal(processHandleOrPid);
  7786     "Modified: / 28-12-1995 / 15:05:37 / stefan"
  7704 
  7787     "Modified: / 27-01-1998 / 20:05:47 / cg"
  7705 	if (hProcess != 0) {
  7788     "Modified: / 03-08-2018 / 09:40:01 / Stefan Vogel"
  7706 	    TerminateProcess( hProcess, __intVal(exitCode) );
       
  7707 	}
       
  7708 	RETURN( true );
       
  7709     } else if( __isSmallInteger(processHandleOrPid) ) {
       
  7710 	HANDLE hProcess = OpenProcess(PROCESS_TERMINATE, 0, __smallIntegerVal(processHandleOrPid));
       
  7711 
       
  7712 	if( hProcess != 0 ) {
       
  7713 	    TerminateProcess( hProcess, __intVal(exitCode) );
       
  7714 	    CloseHandle(hProcess);
       
  7715 	}
       
  7716 	RETURN( true );
       
  7717     }
       
  7718 %}.
       
  7719     self primitiveFailed:#invalidParameter.
       
  7720 
       
  7721 
       
  7722     "Modified: / 28.12.1995 / 15:05:37 / stefan"
       
  7723     "Modified: / 27.1.1998 / 20:05:47 / cg"
       
  7724 !
  7789 !
  7725 
  7790 
  7726 terminateProcessGroup:processGroupHandleOrPid
  7791 terminateProcessGroup:processGroupHandleOrPid
  7727     "terminate a process group (that is all subprocesses of a process).
  7792     "terminate a process group (that is all subprocesses of a process).
  7728 
  7793 
  7729      ATTENTION WIN32:
  7794      ATTENTION WIN32:
  7730 	 Under unix, we have terminateProcess, which does a soft
  7795          Under unix, we have terminateProcess, which does a soft
  7731 	 terminate (giving the process a chance to cleanup) and
  7796          terminate (giving the process a chance to cleanup) and
  7732 	 killProcess, which does a hard terminate.
  7797          killProcess, which does a hard terminate.
  7733 	 Under WIN32, both (currently) use the TerminateProcess
  7798          Under WIN32, both (currently) use the TerminateProcess
  7734 	 function, which unconditionally causes a process to exit.
  7799          function, which unconditionally causes a process to exit.
  7735 	 I.e. under WIN32, the process has no chance to perform cleanup.
  7800          I.e. under WIN32, the process has no chance to perform cleanup.
  7736 	 Use it only in extreme circumstances. The state of
  7801          Use it only in extreme circumstances. The state of
  7737 	 global data maintained by dynamic-link libraries (DLLs)
  7802          global data maintained by dynamic-link libraries (DLLs)
  7738 	 may be compromised if TerminateProcess is used.
  7803          may be compromised if TerminateProcess is used.
  7739      TODO: send a WM_QUIT instead, to allow for proper shutdown."
  7804      TODO: send a WM_QUIT instead, to allow for proper shutdown."
  7740 
  7805 
  7741     | pid list groupsToTerminate anyMore |
  7806     self killProcessGroup:processGroupHandleOrPid.
  7742 
  7807 
  7743     list := self getAllProcesses.
  7808     "Modified: / 03-08-2018 / 09:36:16 / Stefan Vogel"
  7744     list size == 0 ifTrue:[^ self ].
       
  7745 
       
  7746     processGroupHandleOrPid isInteger ifTrue:[
       
  7747 	pid := processGroupHandleOrPid
       
  7748     ] ifFalse:[
       
  7749 	pid := processGroupHandleOrPid pid.
       
  7750     ].
       
  7751     groupsToTerminate := Set with:pid.
       
  7752     list := list asSet.
       
  7753 
       
  7754     "/ Transcript show:'terminate group '; showCR:pid.
       
  7755     anyMore := true.
       
  7756     [anyMore] whileTrue:[
       
  7757 	anyMore := false.
       
  7758 	list doWithExit:[:anOSProcess :exit |
       
  7759 	    |pid|
       
  7760 
       
  7761 	    (groupsToTerminate includes:anOSProcess parentPid) ifTrue:[
       
  7762 		pid := anOSProcess pid.
       
  7763 		groupsToTerminate add:pid.
       
  7764 		"/ Transcript show:'terminate '; showCR:pid.
       
  7765 		self terminateProcess:pid.
       
  7766 		list remove:anOSProcess.
       
  7767 		anyMore := true.
       
  7768 		"/ need to restart: we have removed an element inside the loop
       
  7769 		exit value:nil
       
  7770 	    ].
       
  7771 	].
       
  7772     ].
       
  7773 ! !
  7809 ! !
  7774 
  7810 
  7775 !Win32OperatingSystem class methodsFor:'ipc support'!
  7811 !Win32OperatingSystem class methodsFor:'ipc support'!
  7776 
  7812 
  7777 makePipe
  7813 makePipe