=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/miscf.c,v retrieving revision 1.16 retrieving revision 1.25 diff -u -p -r1.16 -r1.25 --- OpenXM_contrib2/asir2000/builtin/miscf.c 2003/03/07 06:39:55 1.16 +++ OpenXM_contrib2/asir2000/builtin/miscf.c 2004/11/16 01:47:31 1.25 @@ -45,11 +45,11 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.15 2003/03/07 03:12:23 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.24 2004/10/27 08:21:47 noro Exp $ */ #include "ca.h" #include "parse.h" -#if !defined(VISUAL) +#if !defined(VISUAL) && defined(DO_PLOT) #include #include #endif @@ -59,8 +59,11 @@ #include #endif +void Pset_secure_mode(); +void Pset_secure_flag(); void Pquit(), Pdebug(), Pnmono(), Pnez(), Popt(), Pshell(), Pheap(); -void Perror(), Perror3(), Pversion(), Pflist(), Pdelete_history(), Ppause(), Pxpause(); +void Ptoplevel(); +void Perror(), Perror3(), Pversion(), Pcopyright(), Pflist(), Pdelete_history(), Ppause(), Pxpause(); void Pr2g(), Pread_cmo(), Pwrite_cmo(); void Pgc(),Pbatch(),Psend_progress(); void Pnull_command(); @@ -68,10 +71,19 @@ void Pgetenv(); void Pget_addr(),Phex_dump(); void Ppeek(),Ppoke(); void Psleep(); +void Premove_module(); +void Pmodule_list(); +void Pmodule_definedp(); +void Ptest(); void delete_history(int,int); struct ftab misc_tab[] = { + {"set_secure_mode",Pset_secure_mode,-1}, + {"set_secure_flag",Pset_secure_flag,-2}, + {"module_list",Pmodule_list,0}, + {"remove_module",Premove_module,1}, + {"module_definedp",Pmodule_definedp,1}, {"sleep",Psleep,1}, {"null_command",Pnull_command,-99999}, {"getenv",Pgetenv,1}, @@ -81,11 +93,13 @@ struct ftab misc_tab[] = { {"shell",Pshell,-2}, {"heap",Pheap,-1}, {"version",Pversion,-99999}, + {"copyright",Pcopyright,0}, {"nmono",Pnmono,1}, + {"toplevel",Ptoplevel,-1}, {"error",Perror,1}, {"error3",Perror3,3}, {"nez",Pnez,1}, - {"flist",Pflist,0}, + {"flist",Pflist,-1}, {"delete_history",Pdelete_history,-2}, {"pause",Ppause,0}, {"gc",Pgc,0}, @@ -104,6 +118,55 @@ struct ftab misc_tab[] = { {0,0,0}, }; +void Pset_secure_mode(NODE arg,Q *rp) +{ + int s; + if ( argc(arg) ) + setsecuremode(QTOS((Q)ARG0(arg))); + s = getsecuremode(); + STOQ(s,*rp); +} + +void Pset_secure_flag(NODE arg,Q *rp) +{ + int ac,s,status; + Obj f; + char *fname; + + ac = argc(arg); + if ( !ac ) + error("set_secure_flag : a function name must be specified"); + if ( ac == 2 ) + s = QTOS((Q)ARG1(arg)); + else + s = 1; + f = ARG0(arg); + if ( !f ) + error("set_secure_flag : invalid argument"); + switch ( OID(f) ) { + case O_STR: + fname = BDY((STRING)f); break; + case O_P: + fname = NAME(VR((P)f)); break; + default: + error("set_secure_flag : invalid argument"); break; + } + status = setsecureflag(fname,s); + if ( status < 0 ) + error("set_secure_flag : function not found"); + STOQ(s,*rp); +} + +void Ptest(arg,rp) +NODE arg; +Q *rp; +{ + int r; + + r = equalr(CO,ARG0(arg),ARG1(arg)); + STOQ(r,*rp); +} + void Psleep(arg,rp) NODE arg; Q *rp; @@ -119,6 +182,61 @@ Q *rp; *rp = ONE; } +void Pmodule_list(rp) +LIST *rp; +{ + char *name; + NODE r,r1,m; + STRING s; + + r = 0; + for ( m = MODULE_LIST; m; m = NEXT(m) ) { + MKSTR(s,((MODULE)BDY(m))->name); + MKNODE(r1,s,r); r = r1; + } + MKLIST(*rp,r); +} + +void Premove_module(arg,rp) +NODE arg; +Q *rp; +{ + NODE pm,m; + char *name; + + asir_assert(ARG0(arg),O_STR,"remove_module"); + name = BDY((STRING)ARG0(arg)); + for ( pm = 0, m = MODULE_LIST; m; pm = m, m = NEXT(m) ) + if ( !strcmp(name,((MODULE)BDY(m))->name) ) { + if ( !pm ) + MODULE_LIST = NEXT(MODULE_LIST); + else + NEXT(pm) = NEXT(m); + *rp = ONE; + return; + } + *rp = 0; +} + +void Pmodule_definedp(arg,rp) +NODE arg; +Q *rp; +{ + NODE m; + char *name; + + asir_assert(ARG0(arg),O_STR,"module_definedp"); + name = BDY((STRING)ARG0(arg)); + /* bug: the linear search is used here. The list of module shoud be sorted + and cashed, and binary search should be used. */ + for (m = MODULE_LIST; m; m = NEXT(m) ) + if ( !strcmp(name,((MODULE)BDY(m))->name) ) { + *rp = ONE; + return ; + } + *rp = 0; +} + void Pgetenv(arg,rp) NODE arg; STRING *rp; @@ -244,6 +362,14 @@ Obj *rp; } } +char *scopyright(); + +void Pcopyright(rp) +STRING *rp; +{ + MKSTR(*rp,scopyright()); +} + extern int nez; void Pnez(arg,rp) @@ -267,6 +393,20 @@ Q *rp; *rp = 0; } +void Ptoplevel(arg,rp) +NODE arg; +Q *rp; +{ + char *s; + + if ( !arg || !ARG0(arg) || (OID((Obj)ARG0(arg)) != O_STR) ) + s = ""; + else + s = BDY((STRING)ARG0(arg)); + toplevel(s); + *rp = 0; +} + void Perror3(arg,rp) NODE arg; Q *rp; @@ -287,29 +427,48 @@ Q *rp; *rp = 0; } -void Pflist(rp) +void Pflist(arg,rp) +NODE arg; LIST *rp; { char *n; STRING name; - NODE t,r,r0; + char *mname; + NODE t,r,r0,m; LIST l; - for ( t = usrf, r0 = 0; t; t = NEXT(t) ) - if ( ((FUNC)BDY(t))->id != A_UNDEF ) { - n = NAME((FUNC)BDY(t)); MKSTR(name,n); - MKNODE(r,name,r0); r0 = r; + if ( argc(arg) ) { + /* module name is specified */ + asir_assert(ARG0(arg),O_STR,"flist"); + mname = BDY((STRING)ARG0(arg)); + r0 = 0; + for ( m = MODULE_LIST; m; m = NEXT(m) ) { + if ( !strcmp(mname,((MODULE)BDY(m))->name) ) { + t = ((MODULE)BDY(m))->usrf_list; + for ( r0 = 0; t; t = NEXT(t) ) + if ( ((FUNC)BDY(t))->id != A_UNDEF ) { + n = NAME((FUNC)BDY(t)); MKSTR(name,n); + MKNODE(r,name,r0); r0 = r; + } + } } - for ( t = ubinf; t; t = NEXT(t) ) - if ( ((FUNC)BDY(t))->id != A_UNDEF ) { - n = NAME((FUNC)BDY(t)); MKSTR(name,n); - MKNODE(r,name,r0); r0 = r; - } - for ( t = sysf; t; t = NEXT(t) ) - if ( ((FUNC)BDY(t))->id != A_UNDEF ) { - n = NAME((FUNC)BDY(t)); MKSTR(name,n); - MKNODE(r,name,r0); r0 = r; - } + } else { + for ( t = usrf, r0 = 0; t; t = NEXT(t) ) + if ( ((FUNC)BDY(t))->id != A_UNDEF ) { + n = NAME((FUNC)BDY(t)); MKSTR(name,n); + MKNODE(r,name,r0); r0 = r; + } + for ( t = ubinf; t; t = NEXT(t) ) + if ( ((FUNC)BDY(t))->id != A_UNDEF ) { + n = NAME((FUNC)BDY(t)); MKSTR(name,n); + MKNODE(r,name,r0); r0 = r; + } + for ( t = sysf; t; t = NEXT(t) ) + if ( ((FUNC)BDY(t))->id != A_UNDEF ) { + n = NAME((FUNC)BDY(t)); MKSTR(name,n); + MKNODE(r,name,r0); r0 = r; + } + } MKLIST(l,r0); *rp = l; }