From: Ilya Zakharevich Date: Sat, 11 Jul 1998 18:21:21 +0000 (-0400) Subject: Update os2's OS2::Process X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7f61b687036bb8a098a2e70b387919a448b7bd62;p=p5sagit%2Fp5-mst-13.2.git Update os2's OS2::Process Message-Id: <199807112221.SAA03221@monk.mps.ohio-state.edu> p4raw-id: //depot/perl@1441 --- diff --git a/os2/OS2/Process/Makefile.PL b/os2/OS2/Process/Makefile.PL index b7a295f..d324063 100644 --- a/os2/OS2/Process/Makefile.PL +++ b/os2/OS2/Process/Makefile.PL @@ -3,9 +3,12 @@ use ExtUtils::MakeMaker; # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'OS2::Process', - 'VERSION' => '0.1', + VERSION_FROM=> 'Process.pm', MAN3PODS => ' ', # Pods will be built by installman. 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' + IMPORTS => { _16_DosSmSetTitle => 'sesmgr.DOSSMSETTITLE', + # _16_Win16SetTitle => 'pmshapi.93', + }, ); diff --git a/os2/OS2/Process/Process.pm b/os2/OS2/Process/Process.pm index 9216bb1..88de2bf 100644 --- a/os2/OS2/Process/Process.pm +++ b/os2/OS2/Process/Process.pm @@ -1,8 +1,10 @@ package OS2::Process; +$VERSION = 0.2; + require Exporter; require DynaLoader; -require AutoLoader; +#require AutoLoader; @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default. Note: do not export @@ -28,6 +30,22 @@ require AutoLoader; P_UNRELATED P_WAIT P_WINDOWED + my_type + file_type + T_NOTSPEC + T_NOTWINDOWCOMPAT + T_WINDOWCOMPAT + T_WINDOWAPI + T_BOUND + T_DLL + T_DOS + T_PHYSDRV + T_VIRTDRV + T_PROTDLL + T_32BIT + process_entry + set_title + get_title ); sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() @@ -56,6 +74,8 @@ bootstrap OS2::Process; # Preloaded methods go here. +sub get_title () { (process_entry())[0] } + # Autoload methods go after __END__, and are processed by the autosplit program. 1; @@ -101,9 +121,170 @@ and optionally add PM and session option bits: P_TILDE = MKS argument passing convention P_UNRELATED = do not kill child when father terminates +=head2 Access to process properties + +Additionaly, subroutines my_type(), process_entry() and +C, get_title() and C are implemented. +my_type() returns the type of the current process (one of +"FS", "DOS", "VIO", "PM", "DETACH" and "UNKNOWN"), or C on error. + +=over + +=item C + +returns the type of the executable file C, or +dies on error. The bits 0-2 of the result contain one of the values + +=over + +=item C (0) + +Application type is not specified in the executable header. + +=item C (1) + +Application type is not-window-compatible. + +=item C (2) + +Application type is window-compatible. + +=item C (3) + +Application type is window-API. + +=back + +The remaining bits should be masked with the following values to +determine the type of the executable: + +=over + +=item C (8) + +Set to 1 if the executable file has been "bound" (by the BIND command) +as a Family API application. Bits 0, 1, and 2 still apply. + +=item C (0x10) + +Set to 1 if the executable file is a dynamic link library (DLL) +module. Bits 0, 1, 2, 3, and 5 will be set to 0. + +=item C (0x20) + +Set to 1 if the executable file is in PC/DOS format. Bits 0, 1, 2, 3, +and 4 will be set to 0. + +=item C (0x40) + +Set to 1 if the executable file is a physical device driver. + +=item C (0x80) + +Set to 1 if the executable file is a virtual device driver. + +=item C (0x100) + +Set to 1 if the executable file is a protected-memory dynamic link +library module. + +=item C (0x4000) + +Set to 1 for 32-bit executable files. + +=back + +file_type() may croak with one of the strings C<"Invalid EXE +signature"> or C<"EXE marked invalid"> to indicate typical error +conditions. If given non-absolute path, will look on C, will +add extention F<.exe> if no extension is present (add extension F<.> +to suppress). + +=item process_entry() + +returns a list of the following data: + +=over + +=item + +Title of the process (in the C list); + +=item + +window handle of switch entry of the process (in the C list); + +=item + +window handle of the icon of the process; + +=item + +process handle of the owner of the entry in C list; + +=item + +process id of the owner of the entry in C list; + +=item + +session id of the owner of the entry in C list; + +=item + +whether visible in C list; + +=item + +whether item cannot be switched to (note that it is not actually +grayed in the C list)); + +=item + +whether participates in jump sequence; + +=item + +program type. Possible values are: + + PROG_DEFAULT 0 + PROG_FULLSCREEN 1 + PROG_WINDOWABLEVIO 2 + PROG_PM 3 + PROG_VDM 4 + PROG_WINDOWEDVDM 7 + +Although there are several other program types for WIN-OS/2 programs, +these do not show up in this field. Instead, the PROG_VDM or +PROG_WINDOWEDVDM program types are used. For instance, for +PROG_31_STDSEAMLESSVDM, PROG_WINDOWEDVDM is used. This is because all +the WIN-OS/2 programs run in DOS sessions. For example, if a program +is a windowed WIN-OS/2 program, it runs in a PROG_WINDOWEDVDM +session. Likewise, if it's a full-screen WIN-OS/2 program, it runs in +a PROG_VDM session. + + +=back + +=item C + +- does not work with some windows (if the title is set from the start). +This is a limitation of OS/2, in such a case $^E is set to 372 (type + + help 372 + +for a funny - and wrong - explanation ;-). + +=item get_title() + +is a shortcut implemented via process_entry(). + +=back + =head1 AUTHOR -Andreas Kaiser . +Andreas Kaiser , +Ilya Zakharevich . =head1 SEE ALSO diff --git a/os2/OS2/Process/Process.xs b/os2/OS2/Process/Process.xs index bdb2ece..c16d15d 100644 --- a/os2/OS2/Process/Process.xs +++ b/os2/OS2/Process/Process.xs @@ -3,6 +3,9 @@ #include "XSUB.h" #include +#define INCL_DOS +#define INCL_DOSERRORS +#include static int not_here(s) @@ -133,6 +136,73 @@ int arg; #else goto not_there; #endif + } else if (name[0] == 'T' && name[1] == '_') { + if (strEQ(name, "FAPPTYP_NOTSPEC")) +#ifdef FAPPTYP_NOTSPEC + return FAPPTYP_NOTSPEC; +#else + goto not_there; +#endif + if (strEQ(name, "T_NOTWINDOWCOMPAT")) +#ifdef FAPPTYP_NOTWINDOWCOMPAT + return FAPPTYP_NOTWINDOWCOMPAT; +#else + goto not_there; +#endif + if (strEQ(name, "T_WINDOWCOMPAT")) +#ifdef FAPPTYP_WINDOWCOMPAT + return FAPPTYP_WINDOWCOMPAT; +#else + goto not_there; +#endif + if (strEQ(name, "T_WINDOWAPI")) +#ifdef FAPPTYP_WINDOWAPI + return FAPPTYP_WINDOWAPI; +#else + goto not_there; +#endif + if (strEQ(name, "T_BOUND")) +#ifdef FAPPTYP_BOUND + return FAPPTYP_BOUND; +#else + goto not_there; +#endif + if (strEQ(name, "T_DLL")) +#ifdef FAPPTYP_DLL + return FAPPTYP_DLL; +#else + goto not_there; +#endif + if (strEQ(name, "T_DOS")) +#ifdef FAPPTYP_DOS + return FAPPTYP_DOS; +#else + goto not_there; +#endif + if (strEQ(name, "T_PHYSDRV")) +#ifdef FAPPTYP_PHYSDRV + return FAPPTYP_PHYSDRV; +#else + goto not_there; +#endif + if (strEQ(name, "T_VIRTDRV")) +#ifdef FAPPTYP_VIRTDRV + return FAPPTYP_VIRTDRV; +#else + goto not_there; +#endif + if (strEQ(name, "T_PROTDLL")) +#ifdef FAPPTYP_PROTDLL + return FAPPTYP_PROTDLL; +#else + goto not_there; +#endif + if (strEQ(name, "T_32BIT")) +#ifdef FAPPTYP_32BIT + return FAPPTYP_32BIT; +#else + goto not_there; +#endif } errno = EINVAL; @@ -143,6 +213,138 @@ not_there: return 0; } +const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" }; + +static char * +my_type() +{ + int rc; + TIB *tib; + PIB *pib; + + if (!(_emx_env & 0x200)) return (char*)ptypes[1]; /* not OS/2. */ + if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) + return NULL; + + return (pib->pib_ultype <= 4 ? (char*)ptypes[pib->pib_ultype] : "UNKNOWN"); +} + +static ULONG +file_type(char *path) +{ + int rc; + ULONG apptype; + + if (!(_emx_env & 0x200)) + croak("file_type not implemented on DOS"); /* not OS/2. */ + if (CheckOSError(DosQueryAppType(path, &apptype))) { + if (rc == ERROR_INVALID_EXE_SIGNATURE) + croak("Invalid EXE signature"); + else if (rc == ERROR_EXE_MARKED_INVALID) { + croak("EXE marked invalid"); + } + croak("DosQueryAppType err %ld", rc); + } + + return apptype; +} + +static void +fill_swcntrl(SWCNTRL *swcntrlp) +{ + int rc; + PTIB ptib; + PPIB ppib; + HSWITCH hSwitch; + HWND hwndMe; + + if (!(_emx_env & 0x200)) + croak("switch_entry not implemented on DOS"); /* not OS/2. */ + if (CheckOSError(DosGetInfoBlocks(&ptib, &ppib))) + croak("DosGetInfoBlocks err %ld", rc); + if (CheckWinError(hSwitch = + WinQuerySwitchHandle(NULLHANDLE, + (PID)ppib->pib_ulpid))) + croak("WinQuerySwitchHandle err %ld", Perl_rc); + if (CheckOSError(WinQuerySwitchEntry(hSwitch, swcntrlp))) + croak("WinQuerySwitchEntry err %ld", rc); +} + +/* static ULONG (* APIENTRY16 pDosSmSetTitle)(ULONG, PSZ); */ +ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ); + +#if 0 /* Does not work. */ +static ULONG (*pDosSmSetTitle)(ULONG, PSZ); + +static void +set_title(char *s) +{ + SWCNTRL swcntrl; + static HMODULE hdosc = 0; + BYTE buf[20]; + long rc; + + fill_swcntrl(&swcntrl); + if (!pDosSmSetTitle || !hdosc) { + if (CheckOSError(DosLoadModule(buf, sizeof buf, "sesmgr", &hdosc))) + croak("Cannot load SESMGR: no `%s'", buf); + if (CheckOSError(DosQueryProcAddr(hdosc, 0, "DOSSMSETTITLE", + (PFN*)&pDosSmSetTitle))) + croak("Cannot load SESMGR.DOSSMSETTITLE, err=%ld", rc); + } +/* (pDosSmSetTitle)(swcntrl.idSession,s); */ + rc = ((USHORT) + (_THUNK_PROLOG (2+4); + _THUNK_SHORT (swcntrl.idSession); + _THUNK_FLAT (s); + _THUNK_CALLI (*pDosSmSetTitle))); + if (CheckOSError(rc)) + warn("*DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x, *paddr=%x", + rc, swcntrl.idSession, &_THUNK_FUNCTION(DosSmSetTitle), + pDosSmSetTitle); +} + +#else /* !0 */ + +static bool +set_title(char *s) +{ + SWCNTRL swcntrl; + static HMODULE hdosc = 0; + BYTE buf[20]; + long rc; + + fill_swcntrl(&swcntrl); + rc = ((USHORT) + (_THUNK_PROLOG (2+4); + _THUNK_SHORT (swcntrl.idSession); + _THUNK_FLAT (s); + _THUNK_CALL (DosSmSetTitle))); +#if 0 + if (CheckOSError(rc)) + warn("DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x", + rc, swcntrl.idSession, _THUNK_FUNCTION(DosSmSetTitle)); +#endif + return !CheckOSError(rc); +} +#endif /* !0 */ + +#if 0 /* Does not work. */ +USHORT _THUNK_FUNCTION(Win16SetTitle) (); + +static void +set_title2(char *s) +{ + long rc; + + rc = ((USHORT) + (_THUNK_PROLOG (4); + _THUNK_FLAT (s); + _THUNK_CALL (Win16SetTitle))); + if (CheckWinError(rc)) + warn("Win16SetTitle: err=%ld", rc); +} +#endif MODULE = OS2::Process PACKAGE = OS2::Process @@ -152,3 +354,33 @@ constant(name,arg) char * name int arg +char * +my_type() + +U32 +file_type(path) + char *path + +U32 +process_entry() + PPCODE: + { + SWCNTRL swcntrl; + + fill_swcntrl(&swcntrl); + EXTEND(sp,9); + PUSHs(sv_2mortal(newSVpv(swcntrl.szSwtitle, 0))); + PUSHs(sv_2mortal(newSVnv(swcntrl.hwnd))); + PUSHs(sv_2mortal(newSVnv(swcntrl.hwndIcon))); + PUSHs(sv_2mortal(newSViv(swcntrl.hprog))); + PUSHs(sv_2mortal(newSViv(swcntrl.idProcess))); + PUSHs(sv_2mortal(newSViv(swcntrl.idSession))); + PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility != SWL_INVISIBLE))); + PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility == SWL_GRAYED))); + PUSHs(sv_2mortal(newSViv(swcntrl.fbJump == SWL_JUMPABLE))); + PUSHs(sv_2mortal(newSViv(swcntrl.bProgType))); + } + +bool +set_title(s) + char *s diff --git a/pp_hot.c b/pp_hot.c index 9de5ece..42720a5 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1447,7 +1447,11 @@ PP(pp_iter) STRLEN maxlen; char *max = SvPV((SV*)av, maxlen); if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { - sv_setsv(*cx->blk_loop.itervar, cur); + /* we need a fresh SV every time so that loop body sees a + * completely new SV for closures/references to work as they + * used to */ + SvREFCNT_dec(*cx->blk_loop.itervar); + *cx->blk_loop.itervar = newSVsv(cur); if (strEQ(SvPVX(cur), max)) sv_setiv(cur, 0); /* terminate next time */ else @@ -1459,7 +1463,12 @@ PP(pp_iter) /* integer increment */ if (cx->blk_loop.iterix > cx->blk_loop.itermax) RETPUSHNO; - sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++); + + /* we need a fresh SV every time so that loop body sees a + * completely new SV for closures/references to work as they + * used to */ + SvREFCNT_dec(*cx->blk_loop.itervar); + *cx->blk_loop.itervar = newSViv(cx->blk_loop.iterix++); RETPUSHYES; }