=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/miscf.c,v retrieving revision 1.18 retrieving revision 1.36 diff -u -p -r1.18 -r1.36 --- OpenXM_contrib2/asir2000/builtin/miscf.c 2003/05/16 07:56:14 1.18 +++ OpenXM_contrib2/asir2000/builtin/miscf.c 2015/08/14 13:51:54 1.36 @@ -45,22 +45,31 @@ * 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.17 2003/04/02 06:48:19 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.35 2015/08/07 01:25:39 fujimoto Exp $ */ #include "ca.h" #include "parse.h" +#include #if !defined(VISUAL) && defined(DO_PLOT) #include #include #endif -#if defined(VISUAL) +#if defined(VISUAL) || defined(__MINGW32__) +#include #include #include +#else +#include +#include #endif +void Pgetcwd(), Pchdir(); +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(); @@ -70,12 +79,20 @@ void Ppeek(),Ppoke(); void Psleep(); void Premove_module(); void Pmodule_list(); +void Pmodule_definedp(); +void Ptest(); void delete_history(int,int); +void grab_pointer(); struct ftab misc_tab[] = { + {"pwd",Pgetcwd,0}, + {"chdir",Pchdir,1}, + {"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}, @@ -85,7 +102,9 @@ 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}, @@ -108,6 +127,81 @@ struct ftab misc_tab[] = { {0,0,0}, }; +void Pgetcwd(STRING *rp) +{ + char *r; +#if defined(VISUAL) || defined(__MINGW32__) + char buf[_MAX_PATH]; + _getcwd(buf, _MAX_PATH); +#else + char buf[MAXPATHLEN]; + getcwd(buf, MAXPATHLEN); +#endif + r = (char *)MALLOC_ATOMIC(strlen(buf)+1); + strcpy(r,buf); + MKSTR(*rp,r); +} + +void Pchdir(NODE arg, Q *rp) +{ + char *dir = BDY((STRING)ARG0(arg)); +#if defined(VISUAL) || defined(__MINGW32__) + int status = _chdir(dir); +#else + int status = chdir(dir); +#endif + STOQ(status,*rp); +} + +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; @@ -115,7 +209,7 @@ Q *rp; int ms; ms = QTOS((Q)ARG0(arg)); -#if defined(VISUAL) +#if defined(VISUAL) || defined(__MINGW32__) Sleep(ms); #else usleep(ms*1000); @@ -159,12 +253,31 @@ Q *rp; *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; { char *e,*f; - int len; + size_t len; e = (char *)getenv(BDY((STRING)ARG0(arg))); if ( e ) { @@ -186,12 +299,11 @@ Q *rp; void Pquit(rp) pointer *rp; { - if ( !NEXT(asir_infile) ) - asir_terminate(2); + if ( asir_infile && NEXT(asir_infile) && asir_infile->ready_for_longjmp ) + LONGJMP(asir_infile->jmpbuf,1); else { closecurrentinput(); - if ( !asir_infile->fp && strcmp(asir_infile->name,"string") ) - asir_terminate(2); + asir_terminate(2); } *rp = 0; } @@ -244,7 +356,9 @@ void Pheap(arg,rp) NODE arg; Q *rp; { - int h0,h; + size_t h0,h; + unsigned int u,l; + N n; void GC_expand_hp(int); h0 = get_heapsize(); @@ -254,7 +368,16 @@ Q *rp; GC_expand_hp(h-h0); } h = get_heapsize(); - STOQ(h,*rp); + if(sizeof(size_t)>sizeof(int)) { + u = h>>(sizeof(int)*CHAR_BIT); l = h&(~0); + if ( !u ) UTOQ(l,*rp); + else { + n = NALLOC(2); PL(n)=2; BD(n)[0] = l; BD(n)[1] = u; + NTOQ(n,1,*rp); + } + }else { + UTOQ(h,*rp); + } } unsigned int get_asir_version(); @@ -284,6 +407,14 @@ Obj *rp; } } +char *scopyright(); + +void Pcopyright(rp) +STRING *rp; +{ + MKSTR(*rp,scopyright()); +} + extern int nez; void Pnez(arg,rp) @@ -307,6 +438,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)); + goto_toplevel(s); + *rp = 0; +} + void Perror3(arg,rp) NODE arg; Q *rp; @@ -320,7 +465,7 @@ Q *rp; code = QTOS((Q)ARG0(arg)); reason = BDY((STRING)ARG1(arg)); action = BDY((STRING)ARG2(arg)); -#if defined(VISUAL) +#if defined(VISUAL) || defined(__MINGW32__) set_error(code,reason,action); #endif error(""); @@ -465,7 +610,7 @@ init_display() rootwin = RootWindow(display,DefaultScreen(display)); } -grab_pointer() +void grab_pointer() { XEvent ev; static Cursor cursor;