version 1.15, 2003/03/07 03:12:23 |
version 1.36, 2015/08/14 13:51:54 |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* |
* |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.14 2003/02/14 22:29:07 ohara Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.35 2015/08/07 01:25:39 fujimoto Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
#if !defined(VISUAL) |
#include <string.h> |
|
#if !defined(VISUAL) && defined(DO_PLOT) |
#include <X11/Xlib.h> |
#include <X11/Xlib.h> |
#include <X11/cursorfont.h> |
#include <X11/cursorfont.h> |
#endif |
#endif |
|
|
#if defined(VISUAL) |
#if defined(VISUAL) || defined(__MINGW32__) |
|
#include <direct.h> |
#include <stdlib.h> |
#include <stdlib.h> |
#include <windows.h> |
#include <windows.h> |
|
#else |
|
#include <unistd.h> |
|
#include <sys/param.h> |
#endif |
#endif |
|
|
|
void Pgetcwd(), Pchdir(); |
|
void Pset_secure_mode(); |
|
void Pset_secure_flag(); |
void Pquit(), Pdebug(), Pnmono(), Pnez(), Popt(), Pshell(), Pheap(); |
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 Pr2g(), Pread_cmo(), Pwrite_cmo(); |
void Pgc(),Pbatch(),Psend_progress(); |
void Pgc(),Pbatch(),Psend_progress(); |
void Pnull_command(); |
void Pnull_command(); |
|
|
void Pget_addr(),Phex_dump(); |
void Pget_addr(),Phex_dump(); |
void Ppeek(),Ppoke(); |
void Ppeek(),Ppoke(); |
void Psleep(); |
void Psleep(); |
|
void Premove_module(); |
|
void Pmodule_list(); |
|
void Pmodule_definedp(); |
|
void Ptest(); |
|
|
void delete_history(int,int); |
void delete_history(int,int); |
|
void grab_pointer(); |
|
|
struct ftab misc_tab[] = { |
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}, |
{"sleep",Psleep,1}, |
{"null_command",Pnull_command,-99999}, |
{"null_command",Pnull_command,-99999}, |
{"getenv",Pgetenv,1}, |
{"getenv",Pgetenv,1}, |
Line 81 struct ftab misc_tab[] = { |
|
Line 102 struct ftab misc_tab[] = { |
|
{"shell",Pshell,-2}, |
{"shell",Pshell,-2}, |
{"heap",Pheap,-1}, |
{"heap",Pheap,-1}, |
{"version",Pversion,-99999}, |
{"version",Pversion,-99999}, |
|
{"copyright",Pcopyright,0}, |
{"nmono",Pnmono,1}, |
{"nmono",Pnmono,1}, |
|
{"toplevel",Ptoplevel,-1}, |
{"error",Perror,1}, |
{"error",Perror,1}, |
{"error3",Perror3,3}, |
{"error3",Perror3,3}, |
{"nez",Pnez,1}, |
{"nez",Pnez,1}, |
{"flist",Pflist,0}, |
{"flist",Pflist,-1}, |
{"delete_history",Pdelete_history,-2}, |
{"delete_history",Pdelete_history,-2}, |
{"pause",Ppause,0}, |
{"pause",Ppause,0}, |
{"gc",Pgc,0}, |
{"gc",Pgc,0}, |
Line 95 struct ftab misc_tab[] = { |
|
Line 118 struct ftab misc_tab[] = { |
|
{"hex_dump",Phex_dump,2}, |
{"hex_dump",Phex_dump,2}, |
{"peek",Ppeek,1}, |
{"peek",Ppeek,1}, |
{"poke",Ppoke,2}, |
{"poke",Ppoke,2}, |
#if !defined(VISUAL) && DO_PLOT |
#if !defined(VISUAL) && defined(DO_PLOT) |
{"xpause",Pxpause,0}, |
{"xpause",Pxpause,0}, |
#endif |
#endif |
#if 0 |
#if 0 |
Line 104 struct ftab misc_tab[] = { |
|
Line 127 struct ftab misc_tab[] = { |
|
{0,0,0}, |
{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) |
void Psleep(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
|
|
int ms; |
int ms; |
|
|
ms = QTOS((Q)ARG0(arg)); |
ms = QTOS((Q)ARG0(arg)); |
#if defined(VISUAL) |
#if defined(VISUAL) || defined(__MINGW32__) |
Sleep(ms); |
Sleep(ms); |
#else |
#else |
usleep(ms*1000); |
usleep(ms*1000); |
|
|
*rp = ONE; |
*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) |
void Pgetenv(arg,rp) |
NODE arg; |
NODE arg; |
STRING *rp; |
STRING *rp; |
{ |
{ |
char *e,*f; |
char *e,*f; |
int len; |
size_t len; |
|
|
e = (char *)getenv(BDY((STRING)ARG0(arg))); |
e = (char *)getenv(BDY((STRING)ARG0(arg))); |
if ( e ) { |
if ( e ) { |
|
|
void Pquit(rp) |
void Pquit(rp) |
pointer *rp; |
pointer *rp; |
{ |
{ |
if ( !NEXT(asir_infile) ) |
if ( asir_infile && NEXT(asir_infile) && asir_infile->ready_for_longjmp ) |
asir_terminate(2); |
LONGJMP(asir_infile->jmpbuf,1); |
else { |
else { |
closecurrentinput(); |
closecurrentinput(); |
if ( !asir_infile->fp && strcmp(asir_infile->name,"string") ) |
asir_terminate(2); |
asir_terminate(2); |
|
} |
} |
*rp = 0; |
*rp = 0; |
} |
} |
Line 204 void Pheap(arg,rp) |
|
Line 356 void Pheap(arg,rp) |
|
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
int h0,h; |
size_t h0,h; |
|
unsigned int u,l; |
|
N n; |
void GC_expand_hp(int); |
void GC_expand_hp(int); |
|
|
h0 = get_heapsize(); |
h0 = get_heapsize(); |
|
|
GC_expand_hp(h-h0); |
GC_expand_hp(h-h0); |
} |
} |
h = get_heapsize(); |
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(); |
unsigned int get_asir_version(); |
|
|
} |
} |
} |
} |
|
|
|
char *scopyright(); |
|
|
|
void Pcopyright(rp) |
|
STRING *rp; |
|
{ |
|
MKSTR(*rp,scopyright()); |
|
} |
|
|
extern int nez; |
extern int nez; |
|
|
void Pnez(arg,rp) |
void Pnez(arg,rp) |
|
|
*rp = 0; |
*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) |
void Perror3(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
|
|
code = QTOS((Q)ARG0(arg)); |
code = QTOS((Q)ARG0(arg)); |
reason = BDY((STRING)ARG1(arg)); |
reason = BDY((STRING)ARG1(arg)); |
action = BDY((STRING)ARG2(arg)); |
action = BDY((STRING)ARG2(arg)); |
#if defined(VISUAL) |
#if defined(VISUAL) || defined(__MINGW32__) |
set_error(code,reason,action); |
set_error(code,reason,action); |
#endif |
#endif |
error(""); |
error(""); |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
void Pflist(rp) |
void Pflist(arg,rp) |
|
NODE arg; |
LIST *rp; |
LIST *rp; |
{ |
{ |
char *n; |
char *n; |
STRING name; |
STRING name; |
NODE t,r,r0; |
char *mname; |
|
NODE t,r,r0,m; |
LIST l; |
LIST l; |
|
|
for ( t = usrf, r0 = 0; t; t = NEXT(t) ) |
if ( argc(arg) ) { |
if ( ((FUNC)BDY(t))->id != A_UNDEF ) { |
/* module name is specified */ |
n = NAME((FUNC)BDY(t)); MKSTR(name,n); |
asir_assert(ARG0(arg),O_STR,"flist"); |
MKNODE(r,name,r0); r0 = r; |
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) ) |
} else { |
if ( ((FUNC)BDY(t))->id != A_UNDEF ) { |
for ( t = usrf, r0 = 0; t; t = NEXT(t) ) |
n = NAME((FUNC)BDY(t)); MKSTR(name,n); |
if ( ((FUNC)BDY(t))->id != A_UNDEF ) { |
MKNODE(r,name,r0); r0 = r; |
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 ) { |
for ( t = ubinf; t; t = NEXT(t) ) |
n = NAME((FUNC)BDY(t)); MKSTR(name,n); |
if ( ((FUNC)BDY(t))->id != A_UNDEF ) { |
MKNODE(r,name,r0); r0 = r; |
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; |
MKLIST(l,r0); *rp = l; |
} |
} |
|
|
|
|
STOQ(ret,*rp); |
STOQ(ret,*rp); |
} |
} |
|
|
#if !defined(VISUAL) && DO_PLOT |
#if !defined(VISUAL) && defined(DO_PLOT) |
void Pxpause(rp) |
void Pxpause(rp) |
Q *rp; |
Q *rp; |
{ |
{ |
|
|
rootwin = RootWindow(display,DefaultScreen(display)); |
rootwin = RootWindow(display,DefaultScreen(display)); |
} |
} |
|
|
grab_pointer() |
void grab_pointer() |
{ |
{ |
XEvent ev; |
XEvent ev; |
static Cursor cursor; |
static Cursor cursor; |