=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/miscf.c,v retrieving revision 1.20 retrieving revision 1.29 diff -u -p -r1.20 -r1.29 --- OpenXM_contrib2/asir2000/builtin/miscf.c 2003/11/11 06:14:08 1.20 +++ OpenXM_contrib2/asir2000/builtin/miscf.c 2013/06/13 07:45:28 1.29 @@ -45,23 +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.19 2003/10/20 00:21:09 takayama Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.28 2010/12/25 23:10:15 ohara Exp $ */ #include "ca.h" #include "parse.h" +#include #if !defined(VISUAL) && defined(DO_PLOT) #include #include #endif #if defined(VISUAL) +#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 Ptoplevel(); -void Perror(), Perror3(), Pversion(), Pflist(), Pdelete_history(), Ppause(), Pxpause(); +void Perror(), Perror3(), Pversion(), Pcopyright(), Pflist(), Pdelete_history(), Ppause(), Pxpause(); void Pr2g(), Pread_cmo(), Pwrite_cmo(); void Pgc(),Pbatch(),Psend_progress(); void Pnull_command(); @@ -72,10 +80,15 @@ void Psleep(); void Premove_module(); void Pmodule_list(); void Pmodule_definedp(); +void Ptest(); void delete_history(int,int); 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}, @@ -88,6 +101,7 @@ 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}, @@ -112,6 +126,81 @@ struct ftab misc_tab[] = { {0,0,0}, }; +void Pgetcwd(STRING *rp) +{ + char *r; +#if defined(VISUAL) + 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) + 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; @@ -209,12 +298,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; } @@ -267,7 +355,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(); @@ -277,7 +367,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 ) STOQ(l,*rp); + else { + n = NALLOC(2); PL(n)=2; BD(n)[0] = l; BD(n)[1] = u; + NTOQ(n,1,*rp); + } + }else { + STOQ(h,*rp); + } } unsigned int get_asir_version(); @@ -305,6 +404,14 @@ Obj *rp; MKLIST(l,n); *rp = (Obj)l; } +} + +char *scopyright(); + +void Pcopyright(rp) +STRING *rp; +{ + MKSTR(*rp,scopyright()); } extern int nez;