Craig A. Berry wrote:
At 8:42 PM +0100 3/4/06, Abe Timmerman wrote:

>fp = Perl_vms_start_glob(tmpglob, io);
>>^
>>%CC-W-PTRMISMATCH, In this statement, the referenced type of the pointer value
>>"tmpglob" is "struct sv", which is not compatible with "struct interpreter".
>>at line number 2326 in file USER5:[abeltje.PERL-CURRENT]DIC;1

Looks like #27239 broke this. I think we need an aTHX_ in that argument list.

Yes, I missed that and did not do a threaded build since then. I did
put the argument in the prototype though.

I just started a threaded build and test of 27375@blead with this change.
-John
wb8tyw (AT) qsl (DOT) net
Personal

/rsync_root/perl/doio.cMon Feb 27 06:06:55 2006
./doio.cSat Mar 4 18:11:15 2006
@@ -2323,7 +2323,7 @@
(pTHX_ SV *tmpglob,
I *io);
- fp = Perl_vms_start_glob(tmpglob, io);
+ fp = Perl_vms_start_glob(aTHX_ tmpglob, io);

#else /* !VMS */
#ifdef MACS_TRADITINAL

Craig A. Berry wrote:
At 6:29 PM -0500 3/4/06, John E. Malmberg wrote:

Thanks, applied as #27376.

It is not going to be enough. I found another case in vms.c that needs
fixing, and then miniperl died with an access violation when I restarted
the MMK build.

So I just did a MMK realclean and started the build over.
-John
wb8tyw (AT) qsl (DOT) net
Personal

John E. Malmberg wrote:
Craig A. Berry wrote:

>At 6:29 PM -0500 3/4/06, John E. Malmberg wrote:
>
>Thanks, applied as #27376.

It is not going to be enough. I found another case in vms.c that needs
fixing, and then miniperl died with an access violation when I restarted
the MMK build.

Here is what vms.c needs to get it to build with threads. I have not
yet run it through the tests.

Also, building threaded with -Dunlink_all_versions is still broken.
This should be a run time option anyway.

The routine vms_split_path() needs to have the pTHX_ on the declaration
and the aTHX_ where it is called.

The access violation was from the Newx() routine being present just
before the PerlMem_malloc() that was suppose to replace it.

Newx()/Safefree() can not be called by any path taken by the
vms_image_init() and need to be replace with PerlMem_malloc() and
PerlMem_free()

I am starting the tests now, and will check the results tomorrow.
-John
wb8tyw (AT) qsl (DOT) net
Personal

/rsync_root/perl/vms/vms.cSat Mar 4 01:53:09 2006
vms/vms.cSat Mar 4 23:34:07 2006
@@ -395,7 +395,7 @@
* path.
*/
static int vms_split_path
- (const char * path,
+ (pTHX_ const char * path,
char * * volume,
int * vol_len,
char * * root,
@@ -5420,7 +5420,7 @@
int tunix_len;
int nl_flag;
- Newx(tunix, VMS_MAXRSS + 1,char);
+ tunix = (char *) PerlMem_malloc(VMS_MAXRSS);
strcpy(tunix, spec);
tunix_len = strlen(tunix);
nl_flag = 0;
@@ -5431,7 +5431,7 @@
nl_flag = 1;
}
uspec = decc$translate_vms(tunix);
- Safefree(tunix);
+ PerlMem_free(tunix);
if ((int)uspec 0) {
strcpy(rslt,uspec);
if (nl_flag) {
@@ -5532,7 +5532,7 @@
#else
cmp_rslt = strncasecmp(spec,"SYS$SCRATCH:", 12);
#endif
- Newx(tmp, VMS_MAXRSS, char);
+ tmp = (char *) PerlMem_malloc(VMS_MAXRSS);
if (cmp_rslt == 0) {
int islnm;

@@ -5556,13 +5556,13 @@
cp2++;
if (*cp2 == ']' || *cp2 == '>') {
*(cp1++) = '.'; *(cp1++) = '/'; *(cp1++) = '\0';
- Safefree(tmp);
+ PerlMem_free(tmp);
return rslt;
}
else if ( *cp2 != '^' && *cp2 != '.' && *cp2 != '-') { /* add the implied device */
if (getcwd(tmp, VMS_MAXRSS-1 ,1) == NULL) {
if (ts) Safefree(rslt);
-Safefree(tmp);
+PerlMem_free(tmp);
return NULL;
}
trnlnm_iter_count = 0;
@@ -5585,7 +5585,7 @@
while (*cp3) {
*(cp1++) = *(cp3++);
if (cp1 - rslt (VMS_MAXRSS - 1) && !ts && !buf) {
- Safefree(tmp);
+ PerlMem_free(tmp);
return NULL; /* No room */
}
}
@@ -5604,7 +5604,7 @@
else cp2++;
}
}
- Safefree(tmp);
+ PerlMem_free(tmp);
for (; cp2 <= dirend; cp2++) {
if ((*cp2 == '^')) {
/* EFS file escape, pass the next character as is */
@@ -5713,7 +5713,7 @@
vmspath[vmspath_len] = 0;
if (unixpath[unixlen - 1] == '/')
dir_flag = 1;
- Newx(esa, VMS_MAXRSS, char);
+ esa = (char *) PerlMem_malloc(VMS_MAXRSS);
myfab.fab$l_fna = vmspath;
myfab.fab$b_fns = strlen(vmspath);
myfab.fab$l_naml = &mynam;
@@ -5732,7 +5732,7 @@

/* It failed! Try again as a UNIX filespec */
if (!(sts & 1)) {
- Safefree(esa);
+ PerlMem_free(esa);
return sts;
}

@@ -5740,7 +5740,7 @@
sts = sys$search(&myfab);
/* on any failure, returned the PSIX ^UP^ filespec */
if (!(sts & 1)) {
- Safefree(esa);
+ PerlMem_free(esa);
return sts;
}
specdsc.dsc$a_pointer = vmspath;
@@ -5814,7 +5814,7 @@
}
}
}
- Safefree(esa);
+ PerlMem_free(esa);
return sts;
}

@@ -5963,7 +5963,7 @@
* here that are a VMS device name or concealed logical name instead.
* So to make things work, this procedure must be tolerant.
*/
- Newx(esa, vmspath_len, char);
+ esa = (char *) PerlMem_malloc(vmspath_len);

sts = SS$_NRMAL;
nextslash = strchr(&unixptr[1],'/');
@@ -6077,7 +6077,7 @@
}

} /* non-PSIX translation */
- Safefree(esa);
+ PerlMem_free(esa);
} /* End of relative/absolute path handling */

while ((*unixptr) && (vmslen < vmspath_len)){
@@ -6434,7 +6434,7 @@
}
while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
*cp1 = '\0';
- Newx(trndev, VMS_MAXRSS, char);
+ trndev = (char *) PerlMem_malloc(VMS_MAXRSS);
islnm = my_trnlnm(rslt,trndev,0);

/* DECC special handling */
@@ -6499,7 +6499,7 @@
}
}
}
- Safefree(trndev);
+ PerlMem_free(trndev);
}
else {
*(cp1++) = '[';
@@ -6969,7 +6969,6 @@
* Allocate and fill in the new argument vector, Some Unix's terminate
* the list with an extra null pointer.
*/
- Newx(argv, item_count+1, char *);
argv = (char **) PerlMem_malloc((item_count+1) * sizeof(char *));
*av = argv;
for (j = 0; j < item_count; ++j, list_head = list_head->next)
@@ -7127,7 +7126,7 @@
resultspec.dsc$b_dtype = DSC$K_DTYPE_T;
resultspec.dsc$b_class = DSC$K_CLASS_D;
resultspec.dsc$a_pointer = NULL;
- Newx(vmsspec, VMS_MAXRSS, char);
+ vmsspec = (char *) PerlMem_malloc(VMS_MAXRSS);
if ((isunix = (int) strchr(item,'/')) != (int) NULL)
filespec.dsc$a_pointer = do_tovmsspec(item,vmsspec,0);
if (!isunix || !filespec.dsc$a_pointer)
@@ -7150,7 +7149,7 @@
char *string;
char *c;
-Newx(string,resultspec.dsc$w_length+1,char);
+string = (char *) PerlMem_malloc(resultspec.dsc$w_length+1);
strncpy(string, resultspec.dsc$a_pointer, resultspec.dsc$w_length);
string[resultspec.dsc$w_length] = '\0';
if (NULL == had_version)
@@ -7174,7 +7173,7 @@
add_item(head, tail, string, count);
++expcount;
}
- Safefree(vmsspec);
+ PerlMem_free(vmsspec);
if (sts != RMS$_NMF)
{
set_vaxc_errno(sts);
@@ -7413,7 +7412,7 @@
break;
}
}
- if (mask != rlst) Safefree(mask);
+ if (mask != rlst) PerlMem_free(mask);
}

/* When Perl is in decc_filename_unix_report mode and is run from a concealed
@@ -7527,12 +7526,12 @@
*template, *base, *end, *cp1, *cp2;
register int tmplen, reslen = 0, dirs = 0;
- Newx(unixwild, VMS_MAXRSS, char);
+ unixwild = (char *) PerlMem_malloc(VMS_MAXRSS);
if (!wildspec || !fspec) return 0;
template = unixwild;
if (strpbrk(wildspec,"]>:") != NULL) {
if (do_tounixspec(wildspec,unixwild,0) == NULL) {
-Safefree(unixwild);
+ PerlMem_free(unixwild);
return 0;
}
}
@@ -7540,11 +7539,11 @@
strncpy(unixwild, wildspec, VMS_MAXRSS-1);
unixwild[VMS_MAXRSS-1] = 0;
}
- Newx(unixified, VMS_MAXRSS, char);
+ unixified = (char *) PerlMem_malloc(VMS_MAXRSS);
if (strpbrk(fspec,"]>:") != NULL) {
if (do_tounixspec(fspec,unixified,0) == NULL) {
-Safefree(unixwild);
-Safefree(unixified);
+ PerlMem_free(unixwild);
+ PerlMem_free(unixified);
return 0;
}
else base = unixified;
@@ -7556,19 +7555,19 @@

/* No prefix or absolute path on wildcard, so nothing to remove */
if (!*template || *template == '/') {
- Safefree(unixwild);
+ PerlMem_free(unixwild);
if (base == fspec) {
-Safefree(unixified);
+ PerlMem_free(unixified);
return 1;
}
tmplen = strlen(unixified);
if (tmplen reslen) {
-Safefree(unixified);
+ PerlMem_free(unixified);
return 0; /* not enough space */
}
/* Copy unixified resultant, including trailing NUL */
memmove(fspec,unixified,tmplen+1);
- Safefree(unixified);
+ PerlMem_free(unixified);
return 1;
}

@@ -7579,8 +7578,8 @@
if ((*cp1 == '/') && !dirs--) /* postdec so we get front of rel path */
{ cp1++; break; }
if (cp1 != fspec) memmove(fspec,cp1, end - cp1 + 1);
- Safefree(unixified);
- Safefree(unixwild);
+ PerlMem_free(unixified);
+ PerlMem_free(unixwild);
return 1;
}
else {
@@ -7593,7 +7592,7 @@
while ((cp1 = strstr(ellipsis+4,"/")) != NULL) {ellipsis = cp1; ells++;}
totells = ells;
for (cp1 = ellipsis+4; *cp1; cp1++) if (*cp1 == '/') dirs++;
- Newx(tpl, VMS_MAXRSS, char);
+ tpl = PerlMem_malloc(VMS_MAXRSS);
if (ellipsis == template && opts & 1) {
/* Template begins with an ellipsis. Since we can't tell how many
* directory names at the front of the resultant to keep for an
@@ -7604,9 +7603,9 @@
* could match template).
*/
if (getcwd(tpl, (VMS_MAXRSS - 1),0) == NULL) {
- Safefree(tpl);
- Safefree(unixified);
- Safefree(unixwild);
+ PerlMem_free(tpl);
+ PerlMem_free(unixified);
+ PerlMem_free(unixwild);
return 0;
}
if (!decc_efs_case_preserve) {
@@ -7617,9 +7616,9 @@
for (front = cp2+1; *front; front++) if (*front == '/') segdirs--;
if (*cp1 == '\0' && *cp2 == '/' && segdirs < 1) {
memmove(fspec,cp2+1,end - cp2);
-Safefree(unixified);
-Safefree(unixwild);
-Safefree(tpl);
+PerlMem_free(tpl);
+PerlMem_free(unixified);
+PerlMem_free(unixwild);
return 1;
}
}
@@ -7628,7 +7627,7 @@
for (front = end ; front >= base; front--)
if (*front == '/' && !dirs--) { front++; break; }
}
- Newx(lcres, VMS_MAXRSS, char);
+ lcres = (char *) PerlMem_malloc(VMS_MAXRSS);
for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + (VMS_MAXRSS - 1);
cp1++,cp2++) {
if (!decc_efs_case_preserve) {
@@ -7639,10 +7638,9 @@
}
}
if (cp1 != '\0') {
-Safefree(unixified);
-Safefree(unixwild);
-Safefree(lcres);
-Safefree(tpl);
+PerlMem_free(tpl);
+PerlMem_free(unixified);
+PerlMem_free(unixwild);
return 0; /* Path too long. */
}
lcend = cp2;
@@ -7675,10 +7673,10 @@
if (*cp2 == '/') segdirs++;
}
if (cp1 != ellipsis - 1) {
- Safefree(unixified);
- Safefree(unixwild);
- Safefree(lcres);
- Safefree(tpl);
+ PerlMem_free(tpl);
+ PerlMem_free(unixified);
+ PerlMem_free(unixwild);
+ PerlMem_free(lcres);
return 0; /* Path too long */
}
/* Back up at least as many dirs as in template before matching */
@@ -7693,10 +7691,10 @@
for ( ; cp1 >= lcres; cp1--) if (*cp1 == '/') { cp1++; break; }
}
if (!match) {
-Safefree(unixified);
-Safefree(unixwild);
-Safefree(lcres);
-Safefree(tpl);
+PerlMem_free(tpl);
+PerlMem_free(unixified);
+PerlMem_free(unixwild);
+PerlMem_free(lcres);
return 0; /* Can't find prefix ? */
}
if (match 1 && opts & 1) {
@@ -7725,20 +7723,20 @@
for (st = cp2+1; *st; st++) if (*st == '/') segdirs--;
if (*cp1 == '\0' && *cp2 == '/') {
memmove(fspec,cp2+1,end - cp2);
- Safefree(lcres);
- Safefree(unixified);
- Safefree(unixwild);
- Safefree(tpl);
+ PerlMem_free(tpl);
+ PerlMem_free(unixified);
+ PerlMem_free(unixwild);
+ PerlMem_free(lcres);
return 1;
}
/* Nope -- stick with lcfront from above and keep going. */
}
}
memmove(fspec,base + (lcfront - lcres), lcend - lcfront + 1);
- Safefree(unixified);
- Safefree(unixwild);
- Safefree(lcres);
- Safefree(tpl);
+ PerlMem_free(tpl);
+ PerlMem_free(unixified);
+ PerlMem_free(unixwild);
+ PerlMem_free(lcres);
return 1;
ellipsis = nextell;
}
@@ -7988,7 +7986,7 @@

/* Skip any directory component and just copy the name. */
sts = vms_split_path
- (buff,
+ (aTHX_ buff,
&v_spec,
&v_len,
&r_spec,
@@ -11101,7 +11099,7 @@

/* Find where all the components are */
v_sts = vms_split_path
- (rstr,
+ (aTHX_ rstr,
&v_spec,
&v_len,
&r_spec,

John E. Malmberg wrote:
John E. Malmberg wrote:

>Craig A. Berry wrote:
>>
At 6:29 PM -0500 3/4/06, John E. Malmberg wrote:

Thanks, applied as #27376.
>>
>It is not going to be enough. I found another case in vms.c that
>needs fixing, and then miniperl died with an access violation when I
>restarted the MMK build.

Here is what vms.c needs to get it to build with threads. I have not
yet run it through the tests.

Also, building threaded with -Dunlink_all_versions is still broken. This
should be a run time option anyway.

The routine vms_split_path() needs to have the pTHX_ on the declaration
and the aTHX_ where it is called.

The access violation was from the Newx() routine being present just
before the PerlMem_malloc() that was suppose to replace it.

Newx()/Safefree() can not be called by any path taken by the
vms_image_init() and need to be replace with PerlMem_malloc() and
PerlMem_free()

I am starting the tests now, and will check the results tomorrow.

EAGLEsearch thread_test.log failed
leader found
at test 2
leader found
at test 2
at test 7
at test 4
5 tests, saw 3
at test 21
102 tests, saw 6
Failed 9 test scripts out of 1116, 99.19% okay.

The t/op/threads test hung as it has done for me on all previous runs of
the test suite.
-John
wb8tyw (AT) qsl (DOT) net
Personal

John E. Malmberg wrote:
John E. Malmberg wrote:

>John E. Malmberg wrote:
>>
Craig A. Berry wrote:

At 6:29 PM -0500 3/4/06, John E. Malmberg wrote:

Thanks, applied as #27376.

It is not going to be enough. I found another case in vms.c that
needs fixing, and then miniperl died with an access violation when I
restarted the MMK build.
>>
>
>Here is what vms.c needs to get it to build with threads. I have not
>yet run it through the tests.
>>
>Also, building threaded with -Dunlink_all_versions is still broken.
>This should be a run time option anyway.
>>
>The routine vms_split_path() needs to have the pTHX_ on the
>declaration and the aTHX_ where it is called.
>>
>The access violation was from the Newx() routine being present just
>before the PerlMem_malloc() that was suppose to replace it.
>>
>Newx()/Safefree() can not be called by any path taken by the
>vms_image_init() and need to be replace with PerlMem_malloc() and
>PerlMem_free()
>>
>I am starting the tests now, and will check the results tomorrow.

EAGLEsearch thread_test.log failed
leader found

This was caused by access violations because Newx() is being used to
allocate memory in a path taken by vms_image_init.

I changed the Newx calls to PerlMem_malloc to get around the problem,
and now I am trying to find the cause of:

MCR perl_build_root:[000000]miniperl.exe "-I[]" "-I[]"
"-MExtUtils::Command" -e mv Descrip.MMS Descrip.MMS_old
panic: free from wrong pool.
Scalars leaked: 1
%SYSTEM-F-ABRT, abort

Unfortunately that one is not reproducible on demand, but this more
complex case is:

Making Time/HiRes (dynamic)
Configuring Time::HiRes
No syscall()
Looking for gettimeofday() found.
Looking for setitimer() found.
Looking for getitimer() found.
You have interval timers (both setitimer and getitimer).
Looking for ualarm() found.
Looking for usleep() found.
Looking for nanosleep() believing $Config{d_nanosleep} found.
You can mix subsecond sleeps with signals, if you want to.
(It's still not portable, though.)
panic: free from wrong pool at makefile.pl line 135.
Scalars leaked: 1
Looking for clock_gettime()
%SYSTEM-F-ABRT, abort
%SYSTEM-F-ABRT, abort
%MMK-F-ERRUPD, error status %X0000002C occurred when updating target DYNEXT

The command that invokes this is:
EAGLEset def PRJECT_RT:[PERL-BLEAD.ext.Time.hires]
EAGLEMCR []dbgminiperl.exe "-I[]" "-I[]" -
Makefile.PL "INST_LIB=[]" "INST_ARCHLIB=[]" "PERL_CRE=1"

Unfortunately the VMS debugger is not telling me who allocated the
memory incorrectly, as it is the Perl interpret that is calling the free
command, not one of the routines in VMS.C.

As I write this, some progress: The bug appears when the perl script
invokes the system() call to compile a program, so now I know where to
set the breakpoints and verify what I did wrong.

I have also found a few memory leaks in this investigation.
setup_argstr() allocates memory for the command string, and expects the
caller to eventually free it.
-John
wb8tyw (AT) qsl (DOT) net
Personal

John E. Malmberg wrote:
John E. Malmberg wrote:

>Craig A. Berry wrote:
>>
At 12:32 AM -0500 3/5/06, John E. Malmberg wrote:

Here is what vms.c needs to get it to build with threads.

Thanks, applied as #27385.

I just did a full build with that vms.c patch previously submitted and blead
27473 with threads enabled.

This includes Change 27467 to vms/vms.c

Test 4 of t/op/threads was disabled because it has aways hung when I ran it.

at test 4 (intentional)
at test 3
at test 3
at test 4
102 tests, saw 6
55 tests, saw 13
at test 26
at test 92
at test 6
at test 5
at test 6
46 tests, saw 8
18 tests, saw 4
12 tests, saw 1
at test 13
11 tests, saw 0
at test 2
Failed 17 test scripts out of 1142, 98.51% okay.
-John
wb8tyw (AT) qsl (DOT) net
Personal