count++;
scnt = strspn(inspec, "0123456789ABCDEFabcdef");
if (scnt == 4) {
- scnt = sscanf(inspec, "%2x%2x", outspec, &outspec[1]);
+ unsigned int c1, c2;
+ scnt = sscanf(inspec, "%2x%2x", &c1, &c2);
+ outspec[0] == c1 & 0xff;
+ outspec[1] == c2 & 0xff;
if (scnt > 1) {
(*output_cnt) += 2;
count += 4;
scnt = strspn(inspec, "0123456789ABCDEFabcdef");
if (scnt == 2) {
/* Hex encoded */
- scnt = sscanf(inspec, "%2x", outspec);
+ unsigned int c1;
+ scnt = sscanf(inspec, "%2x", &c1);
+ outspec[0] = c1 & 0xff;
if (scnt > 0) {
(*output_cnt++);
count += 2;
* path.
*/
static int vms_split_path
- (const char * path,
+ (pTHX_ const char * path,
char * * volume,
int * vol_len,
char * * root,
/* Expand the input spec using RMS, since the CRTL remove() and
* system services won't do this by themselves, so we may miss
* a file "hiding" behind a logical name or search list. */
- Newx(vmsname, NAM$C_MAXRSS+1, char);
- if (do_tovmsspec(name,vmsname,0) == NULL) {
- Safefree(vmsname);
+ vmsname = PerlMem_malloc(NAM$C_MAXRSS+1);
+ if (vmsname == NULL) _ckvmssts(SS$_INSFMEM);
+
+ if (do_rmsexpand(name, vmsname, 0, NULL, PERL_RMSEXPAND_M_VMS) == NULL) {
+ PerlMem_free(vmsname);
return -1;
}
remove_name = (char *)name;
}
else {
- Newx(rspec, NAM$C_MAXRSS+1, char);
- if (do_rmsexpand(vmsname, rspec, 1, NULL, PERL_RMSEXPAND_M_VMS) == NULL) {
- Safefree(rspec);
- Safefree(vmsname);
+ rspec = PerlMem_malloc(NAM$C_MAXRSS+1);
+ if (rspec == NULL) _ckvmssts(SS$_INSFMEM);
+ if (do_rmsexpand(vmsname, rspec, 0, NULL, PERL_RMSEXPAND_M_VMS) == NULL) {
+ PerlMem_free(rspec);
+ PerlMem_free(vmsname);
return -1;
}
- Safefree(vmsname);
+ PerlMem_free(vmsname);
remove_name = rspec;
}
#if defined(__CRTL_VER) && __CRTL_VER >= 70000000
if (dirflag != 0) {
if (decc_dir_barename && decc_posix_compliant_pathnames) {
- Newx(remove_name, NAM$C_MAXRSS+1, char);
+ remove_name = PerlMem_malloc(NAM$C_MAXRSS+1);
+ if (remove_name == NULL) _ckvmssts(SS$_INSFMEM);
+
do_pathify_dirspec(name, remove_name, 0);
if (!rmdir(remove_name)) {
- Safefree(remove_name);
- Safefree(rspec);
+ PerlMem_free(remove_name);
+ PerlMem_free(rspec);
return 0; /* Can we just get rid of it? */
}
}
else {
if (!rmdir(remove_name)) {
- Safefree(rspec);
+ PerlMem_free(rspec);
return 0; /* Can we just get rid of it? */
}
}
else
#endif
if (!remove(remove_name)) {
- Safefree(rspec);
+ PerlMem_free(rspec);
return 0; /* Can we just get rid of it? */
}
/* If not, can changing protections help? */
if (vaxc$errno != RMS$_PRV) {
- Safefree(rspec);
+ PerlMem_free(rspec);
return -1;
}
_ckvmssts(aclsts);
}
set_vaxc_errno(aclsts);
- Safefree(rspec);
+ PerlMem_free(rspec);
return -1;
}
/* Grab any existing ACEs with this identifier in case we fail */
#if defined(__CRTL_VER) && __CRTL_VER >= 70000000
if (dirflag != 0)
if (decc_dir_barename && decc_posix_compliant_pathnames) {
- Newx(remove_name, NAM$C_MAXRSS+1, char);
+ remove_name = PerlMem_malloc(NAM$C_MAXRSS+1);
+ if (remove_name == NULL) _ckvmssts(SS$_INSFMEM);
+
do_pathify_dirspec(name, remove_name, 0);
rmsts = rmdir(remove_name);
- Safefree(remove_name);
+ PerlMem_free(remove_name);
}
else {
rmsts = rmdir(remove_name);
if (!(aclsts & 1)) {
set_errno(EVMSERR);
set_vaxc_errno(aclsts);
- Safefree(rspec);
+ PerlMem_free(rspec);
return -1;
}
- Safefree(rspec);
+ PerlMem_free(rspec);
return rmsts;
} /* end of kill_file() */
int
Perl_kill_file(pTHX_ const char *name)
{
- char vmsname[NAM$C_MAXRSS+1], rspec[NAM$C_MAXRSS+1];
+ char rspec[NAM$C_MAXRSS+1];
+ char *tspec;
unsigned long int jpicode = JPI$_UIC, type = ACL$C_FILE;
unsigned long int cxt = 0, aclsts, fndsts, rmsts = -1;
struct dsc$descriptor_s fildsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
/* Expand the input spec using RMS, since the CRTL remove() and
* system services won't do this by themselves, so we may miss
* a file "hiding" behind a logical name or search list. */
- if (do_tovmsspec(name,vmsname,0) == NULL) return -1;
- if (do_rmsexpand(vmsname,rspec,1,NULL,0) == NULL) return -1;
+ tspec = do_rmsexpand(name, rspec, 0, NULL, PERL_RMSEXPAND_M_VMS);
+ if (tspec == NULL) return -1;
if (!remove(rspec)) return 0; /* Can we just get rid of it? */
/* If not, can changing protections help? */
if (vaxc$errno != RMS$_PRV) return -1;
if ((fp = tmpfile())) return fp;
- Newx(cp,L_tmpnam+24,char);
+ cp = PerlMem_malloc(L_tmpnam+24);
+ if (cp == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+
if (decc_filename_unix_only == 0)
strcpy(cp,"Sys$Scratch:");
else
tmpnam(cp+strlen(cp));
strcat(cp,".Perltmp");
fp = fopen(cp,"w+","fop=dlt");
- Safefree(cp);
+ PerlMem_free(cp);
return fp;
}
/*}}}*/
/* the . directory from @INC comes last */
p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
+ if (p == NULL) _ckvmssts(SS$_INSFMEM);
p->next = head_PLOC;
head_PLOC = p;
strcpy(p->dir,"./");
/* get the directory from $^X */
+ unixdir = PerlMem_malloc(VMS_MAXRSS);
+ if (unixdir == NULL) _ckvmssts(SS$_INSFMEM);
+
#ifdef PERL_IMPLICIT_CONTEXT
if (aTHX && PL_origargv && PL_origargv[0]) { /* maybe nul if embedded Perl */
#else
temp[1] = '\0';
}
- if ((unixdir = tounixpath(temp, Nullch)) != Nullch) {
+ if ((tounixpath(temp, unixdir)) != Nullch) {
p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
+ if (p == NULL) _ckvmssts(SS$_INSFMEM);
p->next = head_PLOC;
head_PLOC = p;
strncpy(p->dir,unixdir,sizeof(p->dir)-1);
p->dir[NAM$C_MAXRSS] = '\0';
- }
+ }
}
/* reverse order of @INC entries, skip "." since entered above */
if (SvROK(dirsv)) continue;
dir = SvPVx(dirsv,n_a);
if (strcmp(dir,".") == 0) continue;
- if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
+ if ((tounixpath(dir, unixdir)) == Nullch)
continue;
p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
/* most likely spot (ARCHLIB) put first in the list */
#ifdef ARCHLIB_EXP
- if ((unixdir = tounixpath(ARCHLIB_EXP, Nullch)) != Nullch) {
+ if ((tounixpath(ARCHLIB_EXP, unixdir)) != Nullch) {
p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
+ if (p == NULL) _ckvmssts(SS$_INSFMEM);
p->next = head_PLOC;
head_PLOC = p;
strncpy(p->dir,unixdir,sizeof(p->dir)-1);
p->dir[NAM$C_MAXRSS] = '\0';
}
#endif
+ PerlMem_free(unixdir);
}
pPLOC p = head_PLOC;
while (p) {
+ char * exp_res;
strcpy(file, p->dir);
strncat(file, "vmspipe.com",NAM$C_MAXRSS);
file[NAM$C_MAXRSS] = '\0';
p = p->next;
- if (!do_tovmsspec(file,vmspipe_file,0)) continue;
+ exp_res = do_rmsexpand
+ (file, vmspipe_file, 0, NULL, PERL_RMSEXPAND_M_VMS);
+ if (!exp_res) continue;
if (cando_by_name(S_IRUSR, 0, vmspipe_file)
&& cando_by_name(S_IXUSR, 0, vmspipe_file)) {
static char __rmsexpand_retbuf[NAML$C_MAXRSS+1];
char * vmsfspec, *tmpfspec;
char * esa, *cp, *out = NULL;
+ char * tbuf;
char * esal;
char * outbufl;
struct FAB myfab = cc$rms_fab;
outbufl = NULL;
isunix = is_unix_filespec(filespec);
if (isunix) {
- Newx(vmsfspec, VMS_MAXRSS, char);
+ vmsfspec = PerlMem_malloc(VMS_MAXRSS);
+ if (vmsfspec == NULL) _ckvmssts(SS$_INSFMEM);
if (do_tovmsspec(filespec,vmsfspec,0) == NULL) {
- Safefree(vmsfspec);
+ PerlMem_free(vmsfspec);
if (out)
Safefree(out);
return NULL;
int t_isunix;
t_isunix = is_unix_filespec(defspec);
if (t_isunix) {
- Newx(tmpfspec, VMS_MAXRSS, char);
+ tmpfspec = PerlMem_malloc(VMS_MAXRSS);
+ if (tmpfspec == NULL) _ckvmssts(SS$_INSFMEM);
if (do_tovmsspec(defspec,tmpfspec,0) == NULL) {
- Safefree(tmpfspec);
+ PerlMem_free(tmpfspec);
if (vmsfspec != NULL)
- Safefree(vmsfspec);
+ PerlMem_free(vmsfspec);
if (out)
Safefree(out);
return NULL;
rms_set_dna(myfab, mynam, (char *)defspec, strlen(defspec)); /* cast ok */
}
- Newx(esa, NAM$C_MAXRSS + 1, char);
+ esa = PerlMem_malloc(NAM$C_MAXRSS + 1);
+ if (esa == NULL) _ckvmssts(SS$_INSFMEM);
#if !defined(__VAX) && defined(NAML$C_MAXRSS)
- Newx(esal, NAML$C_MAXRSS + 1, char);
+ esal = PerlMem_malloc(NAML$C_MAXRSS + 1);
+ if (esal == NULL) _ckvmssts(SS$_INSFMEM);
#endif
rms_set_esal(mynam, esa, NAM$C_MAXRSS, esal, NAML$C_MAXRSS);
}
else {
#if !defined(__VAX) && defined(NAML$C_MAXRSS)
- Newx(outbufl, VMS_MAXRSS, char);
+ outbufl = PerlMem_malloc(VMS_MAXRSS);
+ if (outbufl == NULL) _ckvmssts(SS$_INSFMEM);
rms_set_rsal(mynam, outbuf, NAM$C_MAXRSS, outbufl, (VMS_MAXRSS - 1));
#else
rms_set_rsa(mynam, outbuf, NAM$C_MAXRSS);
sts = rms_free_search_context(&myfab); /* Free search context */
if (out) Safefree(out);
if (tmpfspec != NULL)
- Safefree(tmpfspec);
+ PerlMem_free(tmpfspec);
if (vmsfspec != NULL)
- Safefree(vmsfspec);
- Safefree(esa);
- Safefree(esal);
+ PerlMem_free(vmsfspec);
+ if (outbufl != NULL)
+ PerlMem_free(outbufl);
+ PerlMem_free(esa);
+ PerlMem_free(esal);
set_vaxc_errno(retsts);
if (retsts == RMS$_PRV) set_errno(EACCES);
else if (retsts == RMS$_DEV) set_errno(ENODEV);
sts = rms_free_search_context(&myfab); /* Free search context */
if (out) Safefree(out);
if (tmpfspec != NULL)
- Safefree(tmpfspec);
+ PerlMem_free(tmpfspec);
if (vmsfspec != NULL)
- Safefree(vmsfspec);
- Safefree(esa);
- Safefree(esal);
+ PerlMem_free(vmsfspec);
+ if (outbufl != NULL)
+ PerlMem_free(outbufl);
+ PerlMem_free(esa);
+ PerlMem_free(esal);
set_vaxc_errno(retsts);
if (retsts == RMS$_PRV) set_errno(EACCES);
else set_errno(EVMSERR);
* downcase the result for compatibility with Unix-minded code. */
expanded:
if (!decc_efs_case_preserve) {
- for (out = rms_get_fna(myfab, mynam); *out; out++)
- if (islower(*out)) { haslower = 1; break; }
+ for (tbuf = rms_get_fna(myfab, mynam); *tbuf; tbuf++)
+ if (islower(*tbuf)) { haslower = 1; break; }
}
/* Is a long or a short name expected */
/*------------------------------------*/
if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
if (rms_nam_rsll(mynam)) {
- out = outbuf;
+ tbuf = outbuf;
speclen = rms_nam_rsll(mynam);
}
else {
- out = esal; /* Not esa */
+ tbuf = esal; /* Not esa */
speclen = rms_nam_esll(mynam);
}
}
else {
if (rms_nam_rsl(mynam)) {
- out = outbuf;
+ tbuf = outbuf;
speclen = rms_nam_rsl(mynam);
}
else {
- out = esa; /* Not esal */
+ tbuf = esa; /* Not esal */
speclen = rms_nam_esl(mynam);
}
}
if (trimver || trimtype) {
if (defspec && *defspec) {
char *defesal = NULL;
- Newx(defesal, NAML$C_MAXRSS + 1, char);
+ defesal = PerlMem_malloc(NAML$C_MAXRSS + 1);
if (defesal != NULL) {
struct FAB deffab = cc$rms_fab;
rms_setup_nam(defnam);
trimtype = !rms_is_nam_fnb(defnam, NAM$M_EXP_TYPE);
}
}
- Safefree(defesal);
+ PerlMem_free(defesal);
}
}
if (trimver) {
if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
if (*(rms_nam_verl(mynam)) != '\"')
- speclen = rms_nam_verl(mynam) - out;
+ speclen = rms_nam_verl(mynam) - tbuf;
}
else {
if (*(rms_nam_ver(mynam)) != '\"')
- speclen = rms_nam_ver(mynam) - out;
+ speclen = rms_nam_ver(mynam) - tbuf;
}
}
if (trimtype) {
/* If we didn't already trim version, copy down */
if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
- if (speclen > rms_nam_verl(mynam) - out)
+ if (speclen > rms_nam_verl(mynam) - tbuf)
memmove
(rms_nam_typel(mynam),
rms_nam_verl(mynam),
- speclen - (rms_nam_verl(mynam) - out));
+ speclen - (rms_nam_verl(mynam) - tbuf));
speclen -= rms_nam_verl(mynam) - rms_nam_typel(mynam);
}
else {
- if (speclen > rms_nam_ver(mynam) - out)
+ if (speclen > rms_nam_ver(mynam) - tbuf)
memmove
(rms_nam_type(mynam),
rms_nam_ver(mynam),
- speclen - (rms_nam_ver(mynam) - out));
+ speclen - (rms_nam_ver(mynam) - tbuf));
speclen -= rms_nam_ver(mynam) - rms_nam_type(mynam);
}
}
/* Done with these copies of the input files */
/*-------------------------------------------*/
if (vmsfspec != NULL)
- Safefree(vmsfspec);
+ PerlMem_free(vmsfspec);
if (tmpfspec != NULL)
- Safefree(tmpfspec);
+ PerlMem_free(tmpfspec);
/* If we just had a directory spec on input, $PARSE "helpfully"
* adds an empty name and type for us */
if (rms_nam_namel(mynam) == rms_nam_typel(mynam) &&
rms_nam_verl(mynam) == rms_nam_typel(mynam) + 1 &&
!(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME)))
- speclen = rms_nam_namel(mynam) - out;
+ speclen = rms_nam_namel(mynam) - tbuf;
}
else {
if (rms_nam_name(mynam) == rms_nam_type(mynam) &&
rms_nam_ver(mynam) == rms_nam_ver(mynam) + 1 &&
!(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME)))
- speclen = rms_nam_name(mynam) - out;
+ speclen = rms_nam_name(mynam) - tbuf;
}
/* Posix format specifications must have matching quotes */
- if (decc_posix_compliant_pathnames && (out[0] == '\"')) {
- if ((speclen > 1) && (out[speclen-1] != '\"')) {
- out[speclen] = '\"';
+ if (decc_posix_compliant_pathnames && (tbuf[0] == '\"')) {
+ if ((speclen > 1) && (tbuf[speclen-1] != '\"')) {
+ tbuf[speclen] = '\"';
speclen++;
}
}
- out[speclen] = '\0';
- if (haslower && !decc_efs_case_preserve) __mystrtolower(out);
+ tbuf[speclen] = '\0';
+ if (haslower && !decc_efs_case_preserve) __mystrtolower(tbuf);
/* Have we been working with an expanded, but not resultant, spec? */
/* Also, convert back to Unix syntax if necessary. */
if (!rms_nam_rsll(mynam)) {
if (isunix) {
if (do_tounixspec(esa,outbuf,0) == NULL) {
- Safefree(esal);
- Safefree(esa);
+ if (out) Safefree(out);
+ PerlMem_free(esal);
+ PerlMem_free(esa);
+ if (outbufl != NULL)
+ PerlMem_free(outbufl);
return NULL;
}
}
else strcpy(outbuf,esa);
}
else if (isunix) {
- Newx(tmpfspec, VMS_MAXRSS, char);
+ tmpfspec = PerlMem_malloc(VMS_MAXRSS);
+ if (tmpfspec == NULL) _ckvmssts(SS$_INSFMEM);
if (do_tounixspec(outbuf,tmpfspec,0) == NULL) {
- Safefree(esa);
- Safefree(esal);
- Safefree(tmpfspec);
+ if (out) Safefree(out);
+ PerlMem_free(esa);
+ PerlMem_free(esal);
+ PerlMem_free(tmpfspec);
+ if (outbufl != NULL)
+ PerlMem_free(outbufl);
return NULL;
}
strcpy(outbuf,tmpfspec);
- Safefree(tmpfspec);
+ PerlMem_free(tmpfspec);
}
rms_set_rsal(mynam, NULL, 0, NULL, 0);
sts = rms_free_search_context(&myfab); /* Free search context */
- Safefree(esa);
- Safefree(esal);
+ PerlMem_free(esa);
+ PerlMem_free(esal);
+ if (outbufl != NULL)
+ PerlMem_free(outbufl);
return outbuf;
}
#endif
set_errno(ENAMETOOLONG); set_vaxc_errno(RMS$_SYN);
return NULL;
}
- Newx(trndir, VMS_MAXRSS + 1, char);
+ trndir = PerlMem_malloc(VMS_MAXRSS + 1);
+ if (trndir == NULL) _ckvmssts(SS$_INSFMEM);
if (!strpbrk(dir+1,"/]>:") &&
(!decc_posix_compliant_pathnames && decc_disable_posix_root)) {
strcpy(trndir,*dir == '/' ? dir + 1: dir);
}
}
- Newx(vmsdir, VMS_MAXRSS + 1, char);
+ vmsdir = PerlMem_malloc(VMS_MAXRSS + 1);
+ if (vmsdir == NULL) _ckvmssts(SS$_INSFMEM);
cp1 = strpbrk(trndir,"]:>");
if (hasfilename || !cp1) { /* Unix-style path or filename */
if (trndir[0] == '.') {
if (trndir[1] == '\0' || (trndir[1] == '/' && trndir[2] == '\0')) {
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return do_fileify_dirspec("[]",buf,ts);
}
else if (trndir[1] == '.' &&
(trndir[2] == '\0' || (trndir[2] == '/' && trndir[3] == '\0'))) {
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return do_fileify_dirspec("[-]",buf,ts);
}
}
if (*(cp1+2) == '/' || *(cp1+2) == '\0') {
char * ret_chr;
if (do_tovmsspec(trndir,vmsdir,0) == NULL) {
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return NULL;
}
if (strchr(vmsdir,'/') != NULL) {
* the time to check this here only so we avoid a recursion
* loop; otherwise, gigo.
*/
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
set_errno(EINVAL); set_vaxc_errno(RMS$_SYN);
return NULL;
}
if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) {
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return NULL;
}
ret_chr = do_tounixspec(trndir,buf,ts);
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return ret_chr;
}
cp1++;
trndir[dirlen] = '/'; trndir[dirlen+1] = '\0';
if (do_tovmsspec(trndir,vmsdir,0) == NULL) {
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return NULL;
}
if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) {
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return NULL;
}
ret_chr = do_tounixspec(trndir,buf,ts);
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return ret_chr;
}
else {
(*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.') ||
(*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
(ver || *cp3)))))) {
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
(*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.') ||
(*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
(ver || *cp3)))))) {
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
strcat(retspec,".dir;1");
else
strcat(retspec,".DIR;1");
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
return retspec;
}
else { /* VMS-style directory spec */
rms_setup_nam(savnam);
rms_setup_nam(dirnam);
- Newx(esa, VMS_MAXRSS + 1, char);
+ esa = PerlMem_malloc(VMS_MAXRSS + 1);
+ if (esa == NULL) _ckvmssts(SS$_INSFMEM);
rms_set_fna(dirfab, dirnam, trndir, strlen(trndir));
rms_bind_fab_nam(dirfab, dirnam);
rms_set_dna(dirfab, dirnam, ".DIR;1", 6);
sts = sys$parse(&dirfab) & STS$K_SUCCESS;
}
if (!sts) {
- Safefree(esa);
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(esa);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
set_errno(EVMSERR);
set_vaxc_errno(dirfab.fab$l_sts);
return NULL;
else { /* No; just work with potential name */
if (dirfab.fab$l_sts == RMS$_FNF) dirnam = savnam;
else {
- Safefree(esa);
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(esa);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
set_errno(EVMSERR); set_vaxc_errno(dirfab.fab$l_sts);
sts = rms_free_search_context(&dirfab);
return NULL;
if (strncmp(rms_nam_typel(dirnam), ".DIR;1", cmplen)) {
/* Something other than .DIR[;1]. Bzzt. */
sts = rms_free_search_context(&dirfab);
- Safefree(esa);
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(esa);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
else retspec = __fileify_retbuf;
strcpy(retspec,esa);
sts = rms_free_search_context(&dirfab);
- Safefree(trndir);
- Safefree(esa);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(esa);
+ PerlMem_free(vmsdir);
return retspec;
}
if ((cp1 = strstr(esa,".][000000]")) != NULL) {
if ((cp1 = strrchr(esa,']')) == NULL) cp1 = strrchr(esa,'>');
if (cp1 == NULL) { /* should never happen */
sts = rms_free_search_context(&dirfab);
- Safefree(trndir);
- Safefree(esa);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(esa);
+ PerlMem_free(vmsdir);
return NULL;
}
term = *cp1;
#endif
if (!(sys$parse(&dirfab) & STS$K_SUCCESS)) {
sts = rms_free_search_context(&dirfab);
- Safefree(esa);
- Safefree(trndir);
- Safefree(vmsdir);
+ PerlMem_free(esa);
+ PerlMem_free(trndir);
+ PerlMem_free(vmsdir);
set_errno(EVMSERR);
set_vaxc_errno(dirfab.fab$l_sts);
return NULL;
/* $PARSE may have upcased filespec, so convert output to lower
* case if input contained any lowercase characters. */
if (haslower && !decc_efs_case_preserve) __mystrtolower(retspec);
- Safefree(trndir);
- Safefree(esa);
- Safefree(vmsdir);
+ PerlMem_free(trndir);
+ PerlMem_free(esa);
+ PerlMem_free(vmsdir);
return retspec;
}
} /* end of do_fileify_dirspec() */
set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
}
- Newx(trndir, VMS_MAXRSS, char);
+ trndir = PerlMem_malloc(VMS_MAXRSS);
+ if (trndir == NULL) _ckvmssts(SS$_INSFMEM);
if (*dir) strcpy(trndir,dir);
else getcwd(trndir,VMS_MAXRSS - 1);
else retpath = __pathify_retbuf;
strcpy(retpath,dir);
strcat(retpath,":[000000]");
- Safefree(trndir);
+ PerlMem_free(trndir);
return retpath;
}
}
(*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.') ||
(*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
(ver || *cp3)))))) {
- Safefree(trndir);
+ PerlMem_free(trndir);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
(*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.') ||
(*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
(ver || *cp3)))))) {
- Safefree(trndir);
+ PerlMem_free(trndir);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
(*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.') ||
(*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
(ver || *cp3)))))) {
- Safefree(trndir);
+ PerlMem_free(trndir);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
(*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.') ||
(*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
(ver || *cp3)))))) {
- Safefree(trndir);
+ PerlMem_free(trndir);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
else if (ts) Newx(retpath,strlen(trndir)+1,char);
else retpath = __pathify_retbuf;
strcpy(retpath,trndir);
- Safefree(trndir);
+ PerlMem_free(trndir);
return retpath;
}
rms_set_fna(dirfab, dirnam, trndir, dirlen);
- Newx(esa, VMS_MAXRSS, char);
+ esa = PerlMem_malloc(VMS_MAXRSS);
+ if (esa == NULL) _ckvmssts(SS$_INSFMEM);
rms_set_dna(dirfab, dirnam, ".DIR;1", 6);
rms_bind_fab_nam(dirfab, dirnam);
rms_set_esa(dirfab, dirnam, esa, VMS_MAXRSS - 1);
sts = sys$parse(&dirfab) & STS$K_SUCCESS;
}
if (!sts) {
- Safefree(trndir);
- Safefree(esa);
+ PerlMem_free(trndir);
+ PerlMem_free(esa);
set_errno(EVMSERR);
set_vaxc_errno(dirfab.fab$l_sts);
return NULL;
if (dirfab.fab$l_sts != RMS$_FNF) {
int sts1;
sts1 = rms_free_search_context(&dirfab);
- Safefree(trndir);
- Safefree(esa);
+ PerlMem_free(trndir);
+ PerlMem_free(esa);
set_errno(EVMSERR);
set_vaxc_errno(dirfab.fab$l_sts);
return NULL;
int sts2;
/* Something other than .DIR[;1]. Bzzt. */
sts2 = rms_free_search_context(&dirfab);
- Safefree(trndir);
- Safefree(esa);
+ PerlMem_free(trndir);
+ PerlMem_free(esa);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
else if (ts) Newx(retpath,retlen,char);
else retpath = __pathify_retbuf;
strcpy(retpath,esa);
- Safefree(esa);
+ PerlMem_free(esa);
sts = rms_free_search_context(&dirfab);
/* $PARSE may have upcased filespec, so convert output to lower
* case if input contained any lowercase characters. */
if (haslower && !decc_efs_case_preserve) __mystrtolower(retpath);
}
- Safefree(trndir);
+ PerlMem_free(trndir);
return retpath;
} /* end of do_pathify_dirspec() */
/*}}}*/
static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts)
{
static char __tounixspec_retbuf[VMS_MAXRSS];
- char *dirend, *rslt, *cp1, *cp3, tmp[VMS_MAXRSS];
+ char *dirend, *rslt, *cp1, *cp3, *tmp;
const char *cp2;
int devlen, dirlen, retlen = VMS_MAXRSS;
int expand = 1; /* guarantee room for leading and trailing slashes */
int tunix_len;
int nl_flag;
- Newx(tunix, VMS_MAXRSS + 1,char);
+ tunix = PerlMem_malloc(VMS_MAXRSS);
+ if (tunix == NULL) _ckvmssts(SS$_INSFMEM);
strcpy(tunix, spec);
tunix_len = strlen(tunix);
nl_flag = 0;
nl_flag = 1;
}
uspec = decc$translate_vms(tunix);
- Safefree(tunix);
+ PerlMem_free(tunix);
if ((int)uspec > 0) {
strcpy(rslt,uspec);
if (nl_flag) {
#else
cmp_rslt = strncasecmp(spec,"SYS$SCRATCH:", 12);
#endif
+ tmp = PerlMem_malloc(VMS_MAXRSS);
+ if (tmp == NULL) _ckvmssts(SS$_INSFMEM);
if (cmp_rslt == 0) {
int islnm;
cp2++;
if (*cp2 == ']' || *cp2 == '>') {
*(cp1++) = '.'; *(cp1++) = '/'; *(cp1++) = '\0';
+ PerlMem_free(tmp);
return rslt;
}
else if ( *cp2 != '^' && *cp2 != '.' && *cp2 != '-') { /* add the implied device */
- if (getcwd(tmp,sizeof tmp,1) == NULL) {
+ if (getcwd(tmp, VMS_MAXRSS-1 ,1) == NULL) {
if (ts) Safefree(rslt);
+ PerlMem_free(tmp);
return NULL;
}
trnlnm_iter_count = 0;
*(cp1++) = '/';
while (*cp3) {
*(cp1++) = *(cp3++);
- if (cp1 - rslt > NAM$C_MAXRSS && !ts && !buf) return NULL; /* No room */
+ if (cp1 - rslt > (VMS_MAXRSS - 1) && !ts && !buf) {
+ PerlMem_free(tmp);
+ return NULL; /* No room */
+ }
}
*(cp1++) = '/';
}
else cp2++;
}
}
+ PerlMem_free(tmp);
for (; cp2 <= dirend; cp2++) {
if ((*cp2 == '^')) {
/* EFS file escape, pass the next character as is */
vmspath[vmspath_len] = 0;
if (unixpath[unixlen - 1] == '/')
dir_flag = 1;
- Newx(esa, VMS_MAXRSS, char);
+ esa = PerlMem_malloc(VMS_MAXRSS);
+ if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
myfab.fab$l_fna = vmspath;
myfab.fab$b_fns = strlen(vmspath);
myfab.fab$l_naml = &mynam;
/* It failed! Try again as a UNIX filespec */
if (!(sts & 1)) {
- Safefree(esa);
+ PerlMem_free(esa);
return sts;
}
sts = sys$search(&myfab);
/* on any failure, returned the POSIX ^UP^ filespec */
if (!(sts & 1)) {
- Safefree(esa);
+ PerlMem_free(esa);
return sts;
}
specdsc.dsc$a_pointer = vmspath;
}
}
}
- Safefree(esa);
+ PerlMem_free(esa);
return sts;
}
* 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 = PerlMem_malloc(vmspath_len);
+ if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
sts = SS$_NORMAL;
nextslash = strchr(&unixptr[1],'/');
}
} /* non-POSIX translation */
- Safefree(esa);
+ PerlMem_free(esa);
} /* End of relative/absolute path handling */
while ((*unixptr) && (vmslen < vmspath_len)){
}
while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
*cp1 = '\0';
- Newx(trndev, VMS_MAXRSS, char);
+ trndev = PerlMem_malloc(VMS_MAXRSS);
+ if (trndev == NULL) _ckvmssts(SS$_INSFMEM);
islnm = my_trnlnm(rslt,trndev,0);
/* DECC special handling */
}
}
}
- Safefree(trndev);
+ PerlMem_free(trndev);
}
else {
*(cp1++) = '[';
char *pathified, *vmsified, *cp;
if (path == NULL) return NULL;
- Newx(pathified, VMS_MAXRSS, char);
+ pathified = PerlMem_malloc(VMS_MAXRSS);
+ if (pathified == NULL) _ckvmssts(SS$_INSFMEM);
if (do_pathify_dirspec(path,pathified,0) == NULL) {
- Safefree(pathified);
+ PerlMem_free(pathified);
return NULL;
}
- Newx(vmsified, VMS_MAXRSS, char);
- if (do_tovmsspec(pathified,buf ? buf : vmsified,0) == NULL) {
- Safefree(pathified);
- Safefree(vmsified);
+
+ vmsified = NULL;
+ if (buf == NULL)
+ Newx(vmsified, VMS_MAXRSS, char);
+ if (do_tovmsspec(pathified, buf ? buf : vmsified, 0) == NULL) {
+ PerlMem_free(pathified);
+ if (vmsified) Safefree(vmsified);
return NULL;
}
- Safefree(pathified);
+ PerlMem_free(pathified);
if (buf) {
- Safefree(vmsified);
return buf;
}
else if (ts) {
char *pathified, *unixified, *cp;
if (path == NULL) return NULL;
- Newx(pathified, VMS_MAXRSS, char);
+ pathified = PerlMem_malloc(VMS_MAXRSS);
+ if (pathified == NULL) _ckvmssts(SS$_INSFMEM);
if (do_pathify_dirspec(path,pathified,0) == NULL) {
- Safefree(pathified);
+ PerlMem_free(pathified);
return NULL;
}
- Newx(unixified, VMS_MAXRSS, char);
+
+ unixified = NULL;
+ if (buf == NULL) {
+ Newx(unixified, VMS_MAXRSS, char);
+ }
if (do_tounixspec(pathified,buf ? buf : unixified,0) == NULL) {
- Safefree(pathified);
- Safefree(unixified);
+ PerlMem_free(pathified);
+ if (unixified) Safefree(unixified);
return NULL;
}
- Safefree(pathified);
+ PerlMem_free(pathified);
if (buf) {
- Safefree(unixified);
return buf;
}
else if (ts) {
* 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 *));
+ if (argv == NULL) _ckvmssts_noperl(SS$_INSFMEM);
*av = argv;
for (j = 0; j < item_count; ++j, list_head = list_head->next)
argv[j] = list_head->value;
if (*head == 0)
{
*head = (struct list_item *) PerlMem_malloc(sizeof(struct list_item));
+ if (head == NULL) _ckvmssts_noperl(SS$_INSFMEM);
*tail = *head;
}
else {
(*tail)->next = (struct list_item *) PerlMem_malloc(sizeof(struct list_item));
+ if ((*tail)->next == NULL) _ckvmssts_noperl(SS$_INSFMEM);
*tail = (*tail)->next;
}
(*tail)->value = value;
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 = PerlMem_malloc(VMS_MAXRSS);
+ if (vmsspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
if ((isunix = (int) strchr(item,'/')) != (int) NULL)
filespec.dsc$a_pointer = do_tovmsspec(item,vmsspec,0);
if (!isunix || !filespec.dsc$a_pointer)
char *string;
char *c;
- Newx(string,resultspec.dsc$w_length+1,char);
+ string = PerlMem_malloc(resultspec.dsc$w_length+1);
+ if (string == NULL) _ckvmssts_noperl(SS$_INSFMEM);
strncpy(string, resultspec.dsc$a_pointer, resultspec.dsc$w_length);
string[resultspec.dsc$w_length] = '\0';
if (NULL == had_version)
add_item(head, tail, string, count);
++expcount;
}
- Safefree(vmsspec);
+ PerlMem_free(vmsspec);
if (sts != RMS$_NMF)
{
set_vaxc_errno(sts);
}
if (jpilist[1].bufadr != rlst) PerlMem_free(jpilist[1].bufadr);
jpilist[1].bufadr = mask = (unsigned long int *) PerlMem_malloc(rsz * sizeof(unsigned long int));
+ if (mask == NULL) _ckvmssts_noperl(SS$_INSFMEM);
jpilist[1].buflen = rsz * sizeof(unsigned long int);
_ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,&jpilist[1],iosb,NULL,NULL));
_ckvmssts_noperl(iosb[0]);
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
char **newargv, **oldargv;
oldargv = *argvp;
newargv = (char **) PerlMem_malloc(((*argcp)+2) * sizeof(char *));
+ if (newargv == NULL) _ckvmssts_noperl(SS$_INSFMEM);
newargv[0] = oldargv[0];
- newargv[1] = (char *) PerlMem_malloc(3 * sizeof(char));
+ newargv[1] = PerlMem_malloc(3 * sizeof(char));
+ if (newargv[1] == NULL) _ckvmssts_noperl(SS$_INSFMEM);
strcpy(newargv[1], "-T");
Copy(&oldargv[1],&newargv[2],(*argcp)-1,char **);
(*argcp)++;
for (tabidx = 0;
len = my_trnlnm("PERL_ENV_TABLES",eqv,tabidx);
tabidx++) {
- if (!tabidx) tabvec = (struct dsc$descriptor_s **) PerlMem_malloc(tabct * sizeof(struct dsc$descriptor_s *));
+ if (!tabidx) {
+ tabvec = (struct dsc$descriptor_s **)
+ PerlMem_malloc(tabct * sizeof(struct dsc$descriptor_s *));
+ if (tabvec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+ }
else if (tabidx >= tabct) {
tabct += 8;
tabvec = (struct dsc$descriptor_s **) PerlMem_realloc(tabvec, tabct * sizeof(struct dsc$descriptor_s *));
+ if (tabvec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
}
tabvec[tabidx] = (struct dsc$descriptor_s *) PerlMem_malloc(sizeof(struct dsc$descriptor_s));
+ if (tabvec[tabidx] == NULL) _ckvmssts_noperl(SS$_INSFMEM);
tabvec[tabidx]->dsc$w_length = 0;
tabvec[tabidx]->dsc$b_dtype = DSC$K_DTYPE_T;
tabvec[tabidx]->dsc$b_class = DSC$K_CLASS_D;
*template, *base, *end, *cp1, *cp2;
register int tmplen, reslen = 0, dirs = 0;
- Newx(unixwild, VMS_MAXRSS, char);
+ unixwild = PerlMem_malloc(VMS_MAXRSS);
+ if (unixwild == NULL) _ckvmssts(SS$_INSFMEM);
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;
}
}
strncpy(unixwild, wildspec, VMS_MAXRSS-1);
unixwild[VMS_MAXRSS-1] = 0;
}
- Newx(unixified, VMS_MAXRSS, char);
+ unixified = PerlMem_malloc(VMS_MAXRSS);
+ if (unixified == NULL) _ckvmssts(SS$_INSFMEM);
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;
/* 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;
}
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 {
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 (tpl == NULL) _ckvmssts(SS$_INSFMEM);
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
* 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) {
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;
}
}
for (front = end ; front >= base; front--)
if (*front == '/' && !dirs--) { front++; break; }
}
- Newx(lcres, VMS_MAXRSS, char);
+ lcres = PerlMem_malloc(VMS_MAXRSS);
+ if (lcres == NULL) _ckvmssts(SS$_INSFMEM);
for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + (VMS_MAXRSS - 1);
cp1++,cp2++) {
if (!decc_efs_case_preserve) {
}
}
if (cp1 != '\0') {
- 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. */
}
lcend = cp2;
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 */
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) {
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;
}
/* Skip any directory component and just copy the name. */
sts = vms_split_path
- (buff,
+ (aTHX_ buff,
&v_spec,
&v_len,
&r_spec,
{
if (vmscmd) {
if (vmscmd->dsc$a_pointer) {
- Safefree(vmscmd->dsc$a_pointer);
+ PerlMem_free(vmscmd->dsc$a_pointer);
}
- Safefree(vmscmd);
+ PerlMem_free(vmscmd);
}
}
cmdlen += rlen ? rlen + 1 : 0;
}
}
- Newx(PL_Cmd,cmdlen+1,char);
+ Newx(PL_Cmd, cmdlen+1, char);
if (tmps && *tmps) {
strcpy(PL_Cmd,tmps);
int cmdlen;
register int isdcl;
- Newx(vmscmd,sizeof(struct dsc$descriptor_s),struct dsc$descriptor_s);
+ vmscmd = PerlMem_malloc(sizeof(struct dsc$descriptor_s));
+ if (vmscmd == NULL) _ckvmssts(SS$_INSFMEM);
/* Make a copy for modification */
cmdlen = strlen(incmd);
- Newx(cmd, cmdlen+1, char);
+ cmd = PerlMem_malloc(cmdlen+1);
+ if (cmd == NULL) _ckvmssts(SS$_INSFMEM);
strncpy(cmd, incmd, cmdlen);
cmd[cmdlen] = 0;
image_name[0] = 0;
if (suggest_quote) *suggest_quote = 0;
if (strlen(cmd) > MAX_DCL_LINE_LENGTH) {
+ PerlMem_free(cmd);
return CLI$_BUFOVF; /* continuation lines currently unsupported */
- Safefree(cmd);
}
s = cmd;
if (check_img && isdcl) return RMS$_FNF;
if (cando_by_name(S_IXUSR,0,resspec)) {
- Newx(vmscmd->dsc$a_pointer, MAX_DCL_LINE_LENGTH ,char);
+ vmscmd->dsc$a_pointer = PerlMem_malloc(MAX_DCL_LINE_LENGTH);
+ if (vmscmd->dsc$a_pointer == NULL) _ckvmssts(SS$_INSFMEM);
if (!isdcl) {
strcpy(vmscmd->dsc$a_pointer,"$ MCR ");
if (image_name[0] != 0) {
retsts = CLI$_BUFOVF;
}
vmscmd->dsc$w_length = strlen(vmscmd->dsc$a_pointer);
- Safefree(cmd);
+ PerlMem_free(cmd);
return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts);
}
- else retsts = RMS$_PRV;
+ else
+ retsts = RMS$_PRV;
}
}
/* It's either a DCL command or we couldn't find a suitable image */
vmscmd->dsc$w_length = strlen(cmd);
-/* if (cmd == PL_Cmd) {
- vmscmd->dsc$a_pointer = PL_Cmd;
- if (suggest_quote) *suggest_quote = 1;
- }
- else */
- vmscmd->dsc$a_pointer = savepvn(cmd,vmscmd->dsc$w_length);
- Safefree(cmd);
+ vmscmd->dsc$a_pointer = PerlMem_malloc(vmscmd->dsc$w_length);
+ strncpy(vmscmd->dsc$a_pointer,cmd,vmscmd->dsc$w_length);
+ vmscmd->dsc$a_pointer[vmscmd->dsc$w_length];
+
+ PerlMem_free(cmd);
/* check if it's a symbol (for quoting purposes) */
if (suggest_quote && !*suggest_quote) {
bool
Perl_vms_do_aexec(pTHX_ SV *really,SV **mark,SV **sp)
{
+bool exec_sts;
+char * cmd;
+
if (sp > mark) {
if (vfork_called) { /* this follows a vfork - act Unixish */
vfork_called--;
else return do_aexec(really,mark,sp);
}
/* no vfork - act VMSish */
- return vms_do_exec(setup_argstr(aTHX_ really,mark,sp));
-
+ cmd = setup_argstr(aTHX_ really,mark,sp);
+ exec_sts = vms_do_exec(cmd);
+ Safefree(cmd); /* Clean up from setup_argstr() */
+ return exec_sts;
}
return FALSE;
unsigned long int
Perl_do_aspawn(pTHX_ void *really,void **mark,void **sp)
{
- if (sp > mark) return do_spawn(setup_argstr(aTHX_ (SV *)really,(SV **)mark,(SV **)sp));
+unsigned long int sts;
+char * cmd;
+ if (sp > mark) {
+ cmd = setup_argstr(aTHX_ (SV *)really,(SV **)mark,(SV **)sp);
+ sts = do_spawn(cmd);
+ /* pp_sys will clean up cmd */
+ return sts;
+ }
return SS$_ABORT;
} /* end of do_aspawn() */
/*}}}*/
{
unsigned long int sts, substs;
+ /* The caller of this routine expects to Safefree(PL_Cmd) */
+ Newx(PL_Cmd,10,char);
+
TAINT_ENV();
TAINT_PROPER("spawn");
if (!cmd || !*cmd) {
if (!fname || !*fname) return FALSE;
/* Make sure we expand logical names, since sys$check_access doesn't */
- Newx(fileified, VMS_MAXRSS, char);
+ fileified = PerlMem_malloc(VMS_MAXRSS);
if (!strpbrk(fname,"/]>:")) {
strcpy(fileified,fname);
trnlnm_iter_count = 0;
}
fname = fileified;
}
- if (!do_rmsexpand(fname, vmsname, 1, NULL, PERL_RMSEXPAND_M_VMS)) {
- Safefree(fileified);
+ if (!do_rmsexpand(fname, vmsname, 0, NULL, PERL_RMSEXPAND_M_VMS)) {
+ PerlMem_free(fileified);
return FALSE;
}
retlen = namdsc.dsc$w_length = strlen(vmsname);
case S_IDUSR: case S_IDGRP: case S_IDOTH:
access = ARM$M_DELETE; break;
default:
- Safefree(fileified);
+ PerlMem_free(fileified);
return FALSE;
}
&usrprodsc.dsc$w_length,0));
/* allocate space for the profile and get it filled in */
- Newx(usrprodsc.dsc$a_pointer,usrprodsc.dsc$w_length,char);
+ usrprodsc.dsc$a_pointer = PerlMem_malloc(usrprodsc.dsc$w_length);
+ if (usrprodsc.dsc$a_pointer == NULL) _ckvmssts(SS$_INSFMEM);
_ckvmssts(sys$create_user_profile(&usrdsc,&usrprolst,0,usrprodsc.dsc$a_pointer,
&usrprodsc.dsc$w_length,0));
/* use the profile to check access to the file; free profile & analyze results */
retsts = sys$check_access(&objtyp,&namdsc,0,armlst,0,0,0,&usrprodsc);
- Safefree(usrprodsc.dsc$a_pointer);
+ PerlMem_free(usrprodsc.dsc$a_pointer);
if (retsts == SS$_NOCALLPRIV) retsts = SS$_NOPRIV; /* not really 3rd party */
#else
if (retsts == SS$_NOPRIV) set_errno(EACCES);
else if (retsts == SS$_INVFILFOROP) set_errno(EINVAL);
else set_errno(ENOENT);
- Safefree(fileified);
+ PerlMem_free(fileified);
return FALSE;
}
if (retsts == SS$_NORMAL || retsts == SS$_ACCONFLICT) {
- Safefree(fileified);
+ PerlMem_free(fileified);
return TRUE;
}
_ckvmssts(retsts);
- Safefree(fileified);
+ PerlMem_free(fileified);
return FALSE; /* Should never get here */
} /* end of cando_by_name() */
struct XABRDT xabrdt;
struct XABSUM xabsum;
- Newx(vmsin, VMS_MAXRSS, char);
- Newx(vmsout, VMS_MAXRSS, char);
+ vmsin = PerlMem_malloc(VMS_MAXRSS);
+ if (vmsin == NULL) _ckvmssts(SS$_INSFMEM);
+ vmsout = PerlMem_malloc(VMS_MAXRSS);
+ if (vmsout == NULL) _ckvmssts(SS$_INSFMEM);
if (!spec_in || !*spec_in || !do_tovmsspec(spec_in,vmsin,1) ||
!spec_out || !*spec_out || !do_tovmsspec(spec_out,vmsout,1)) {
- Safefree(vmsin);
- Safefree(vmsout);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
return 0;
}
- Newx(esa, VMS_MAXRSS, char);
+ esa = PerlMem_malloc(VMS_MAXRSS);
+ if (esa == NULL) _ckvmssts(SS$_INSFMEM);
nam = cc$rms_naml;
fab_in = cc$rms_fab;
fab_in.fab$l_fna = (char *) -1;
fab_in.fab$l_naml = &nam;
fab_in.fab$l_xab = (void *) &xabdat;
- Newx(rsa, VMS_MAXRSS, char);
+ rsa = PerlMem_malloc(VMS_MAXRSS);
+ if (rsa == NULL) _ckvmssts(SS$_INSFMEM);
nam.naml$l_rsa = NULL;
nam.naml$b_rss = 0;
nam.naml$l_long_result = rsa;
xabsum = cc$rms_xabsum; /* To get key and area information */
if (!((sts = sys$open(&fab_in)) & 1)) {
- Safefree(vmsin);
- Safefree(vmsout);
- Safefree(esa);
- Safefree(rsa);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
+ PerlMem_free(esa);
+ PerlMem_free(rsa);
set_vaxc_errno(sts);
switch (sts) {
case RMS$_FNF: case RMS$_DNF:
nam.naml$l_long_name ?
nam.naml$l_long_name_size + nam.naml$l_long_type_size : 0;
- Newx(esa_out, VMS_MAXRSS, char);
+ esa_out = PerlMem_malloc(VMS_MAXRSS);
+ if (esa_out == NULL) _ckvmssts(SS$_INSFMEM);
nam_out.naml$l_rsa = NULL;
nam_out.naml$b_rss = 0;
nam_out.naml$l_long_result = NULL;
nam_out.naml$b_nop |= NAM$M_SYNCHK;
fab_out.fab$l_xab = NULL; /* Don't disturb data from input file */
if (!((sts = sys$parse(&fab_out)) & 1)) {
- Safefree(vmsin);
- Safefree(vmsout);
- Safefree(esa);
- Safefree(rsa);
- Safefree(esa_out);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
+ PerlMem_free(esa);
+ PerlMem_free(rsa);
+ PerlMem_free(esa_out);
set_errno(sts == RMS$_SYN ? EINVAL : EVMSERR);
set_vaxc_errno(sts);
return 0;
if (!(preserve_dates & 1)) fab_out.fab$l_xab = (void *) &xabfhc;
if (!((sts = sys$create(&fab_out)) & 1)) {
- Safefree(vmsin);
- Safefree(vmsout);
- Safefree(esa);
- Safefree(rsa);
- Safefree(esa_out);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
+ PerlMem_free(esa);
+ PerlMem_free(rsa);
+ PerlMem_free(esa_out);
set_vaxc_errno(sts);
switch (sts) {
case RMS$_DNF:
fab_out.fab$l_xab = (void *) &xabrdt;
}
- Newx(ubf, 32256, char);
+ ubf = PerlMem_malloc(32256);
+ if (ubf == NULL) _ckvmssts(SS$_INSFMEM);
rab_in = cc$rms_rab;
rab_in.rab$l_fab = &fab_in;
rab_in.rab$l_rop = RAB$M_BIO;
rab_in.rab$w_usz = 32256;
if (!((sts = sys$connect(&rab_in)) & 1)) {
sys$close(&fab_in); sys$close(&fab_out);
- Safefree(vmsin);
- Safefree(vmsout);
- Safefree(esa);
- Safefree(ubf);
- Safefree(rsa);
- Safefree(esa_out);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
+ PerlMem_free(esa);
+ PerlMem_free(ubf);
+ PerlMem_free(rsa);
+ PerlMem_free(esa_out);
set_errno(EVMSERR); set_vaxc_errno(sts);
return 0;
}
rab_out.rab$l_rbf = ubf;
if (!((sts = sys$connect(&rab_out)) & 1)) {
sys$close(&fab_in); sys$close(&fab_out);
- Safefree(vmsin);
- Safefree(vmsout);
- Safefree(esa);
- Safefree(ubf);
- Safefree(rsa);
- Safefree(esa_out);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
+ PerlMem_free(esa);
+ PerlMem_free(ubf);
+ PerlMem_free(rsa);
+ PerlMem_free(esa_out);
set_errno(EVMSERR); set_vaxc_errno(sts);
return 0;
}
rab_out.rab$w_rsz = rab_in.rab$w_rsz;
if (!(sts & 1) || !((sts = sys$write(&rab_out)) & 1)) {
sys$close(&fab_in); sys$close(&fab_out);
- Safefree(vmsin);
- Safefree(vmsout);
- Safefree(esa);
- Safefree(ubf);
- Safefree(rsa);
- Safefree(esa_out);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
+ PerlMem_free(esa);
+ PerlMem_free(ubf);
+ PerlMem_free(rsa);
+ PerlMem_free(esa_out);
set_errno(EVMSERR); set_vaxc_errno(sts);
return 0;
}
sys$close(&fab_in); sys$close(&fab_out);
sts = (fab_in.fab$l_sts & 1) ? fab_out.fab$l_sts : fab_in.fab$l_sts;
if (!(sts & 1)) {
- Safefree(vmsin);
- Safefree(vmsout);
- Safefree(esa);
- Safefree(ubf);
- Safefree(rsa);
- Safefree(esa_out);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
+ PerlMem_free(esa);
+ PerlMem_free(ubf);
+ PerlMem_free(rsa);
+ PerlMem_free(esa_out);
set_errno(EVMSERR); set_vaxc_errno(sts);
return 0;
}
- Safefree(vmsin);
- Safefree(vmsout);
- Safefree(esa);
- Safefree(ubf);
- Safefree(rsa);
- Safefree(esa_out);
+ PerlMem_free(vmsin);
+ PerlMem_free(vmsout);
+ PerlMem_free(esa);
+ PerlMem_free(ubf);
+ PerlMem_free(rsa);
+ PerlMem_free(esa_out);
return 1;
} /* end of rmscopy() */
/* Find where all the components are */
v_sts = vms_split_path
- (rstr,
+ (aTHX_ rstr,
&v_spec,
&v_len,
&r_spec,
projects / p5sagit/p5-mst-13.2.git / blobdiff