1 /* VMS::DCLsym - manipulate DCL symbols
4 * Author: Charles Bailey bailey@newman.upenn.edu
10 * 1.0 17-Aug-1995 Charles Bailey bailey@newman.upenn.edu
11 * original production version
15 #include <lib$routines.h>
16 #include <libclidef.h>
23 MODULE = VMS::DCLsym PACKAGE = VMS::DCLsym
30 struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
31 valdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
34 unsigned long int retsts;
35 SETERRNO(0,SS$_NORMAL);
37 PUSHs(sv_newmortal());
38 SETERRNO(EINVAL,LIB$_INVARG);
41 namdsc.dsc$a_pointer = SvPV(name,namlen);
42 namdsc.dsc$w_length = (unsigned short int) namlen;
43 retsts = lib$get_symbol(&namdsc,&valdsc,0,&tbltype);
45 PUSHs(sv_2mortal(newSVpv(valdsc.dsc$w_length ?
46 valdsc.dsc$a_pointer : "",valdsc.dsc$w_length)));
48 EXTEND(sp,2); /* just in case we're at the end of the stack */
49 if (tbltype == LIB$K_CLI_LOCAL_SYM)
50 PUSHs(sv_2mortal(newSVpv("LOCAL",5)));
52 PUSHs(sv_2mortal(newSVpv("GLOBAL",6)));
54 _ckvmssts(lib$sfree1_dd(&valdsc));
57 ST(0) = &PL_sv_undef; /* error - we're returning undef, if anything */
60 break; /* nobody home */;
61 case LIB$_INVSYMNAM: /* user errors; set errno return undef */
65 set_vaxc_errno(retsts);
67 default: /* bail out */
68 { _ckvmssts(retsts); }
75 _setsym(name,val,typestr="LOCAL")
81 struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
82 valdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
85 unsigned long int retsts;
86 SETERRNO(0,SS$_NORMAL);
88 SETERRNO(EINVAL,LIB$_INVARG);
91 namdsc.dsc$a_pointer = SvPV(name,slen);
92 namdsc.dsc$w_length = (unsigned short int) slen;
93 valdsc.dsc$a_pointer = SvPV(val,slen);
94 valdsc.dsc$w_length = (unsigned short int) slen;
95 type = strNE(typestr,"GLOBAL") ?
96 LIB$K_CLI_LOCAL_SYM : LIB$K_CLI_GLOBAL_SYM;
97 retsts = lib$set_symbol(&namdsc,&valdsc,&type);
98 if (retsts & 1) { XSRETURN_YES; }
101 case LIB$_AMBSYMDEF: /* user errors; set errno and return */
106 set_vaxc_errno(retsts);
108 break; /* NOTREACHED */
109 default: /* bail out */
110 { _ckvmssts(retsts); }
117 _delsym(name,typestr="LOCAL")
122 struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
125 unsigned long int retsts;
126 SETERRNO(0,SS$_NORMAL);
127 if (!name || !typestr) {
128 SETERRNO(EINVAL,LIB$_INVARG);
131 namdsc.dsc$a_pointer = SvPV(name,slen);
132 namdsc.dsc$w_length = (unsigned short int) slen;
133 type = strNE(typestr,"GLOBAL") ?
134 LIB$K_CLI_LOCAL_SYM : LIB$K_CLI_GLOBAL_SYM;
135 retsts = lib$delete_symbol(&namdsc,&type);
136 if (retsts & 1) { XSRETURN_YES; }
139 case LIB$_INVSYMNAM: /* user errors; set errno and return */
143 set_vaxc_errno(retsts);
145 break; /* NOTREACHED */
146 default: /* bail out */
147 { _ckvmssts(retsts); }