version 1.7, 2000/08/21 08:31:20 |
version 1.35, 2015/08/07 01:25:39 |
|
|
* shall be made on your publication or presentation in any form of the |
* shall be made on your publication or presentation in any form of the |
* results obtained by use of the SOFTWARE. |
* results obtained by use of the SOFTWARE. |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
* e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification |
* e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification |
* for such modification or the source code of the modified part of the |
* for such modification or the source code of the modified part of the |
* SOFTWARE. |
* SOFTWARE. |
* |
* |
|
|
* 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.6 2000/03/16 04:55:20 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.34 2015/08/06 10:01:52 fujimoto Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
#if INET && !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) || defined(__MINGW32__) || defined(__MINGW64__) |
|
#include <direct.h> |
|
#include <stdlib.h> |
|
#include <windows.h> |
|
#else |
|
#include <unistd.h> |
|
#include <sys/param.h> |
|
#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 Pgetenv(); |
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); |
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}, |
{"null_command",Pnull_command,-99999}, |
{"null_command",Pnull_command,-99999}, |
{"getenv",Pgetenv,1}, |
{"getenv",Pgetenv,1}, |
{"end",Pquit,0}, |
{"end",Pquit,0}, |
Line 71 struct ftab misc_tab[] = { |
|
Line 101 struct ftab misc_tab[] = { |
|
{"debug",Pdebug,0}, |
{"debug",Pdebug,0}, |
{"shell",Pshell,-2}, |
{"shell",Pshell,-2}, |
{"heap",Pheap,-1}, |
{"heap",Pheap,-1}, |
{"version",Pversion,0}, |
{"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}, |
{"batch",Pbatch,2}, |
{"batch",Pbatch,2}, |
{"send_progress",Psend_progress,-2}, |
{"send_progress",Psend_progress,-2}, |
#if INET && !defined(VISUAL) && DO_PLOT |
{"get_addr",Pget_addr,1}, |
|
{"hex_dump",Phex_dump,2}, |
|
{"peek",Ppeek,1}, |
|
{"poke",Ppoke,2}, |
|
#if !defined(VISUAL) && defined(DO_PLOT) |
{"xpause",Pxpause,0}, |
{"xpause",Pxpause,0}, |
#endif |
#endif |
#if 0 |
#if 0 |
Line 91 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__) || defined(__MINGW64__) |
|
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__) || defined(__MINGW64__) |
|
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; |
|
{ |
|
int ms; |
|
|
|
ms = QTOS((Q)ARG0(arg)); |
|
#if defined(VISUAL) || defined(__MINGW32__) || defined(__MINGW64__) |
|
Sleep(ms); |
|
#else |
|
usleep(ms*1000); |
|
#endif |
|
*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 176 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 *get_asir_distribution(); |
|
|
void Pversion(rp) |
void Pversion(arg,rp) |
Q *rp; |
NODE arg; |
|
Obj *rp; |
{ |
{ |
unsigned int version; |
unsigned int version; |
|
char *distribution; |
|
Q q; |
|
STRING str; |
|
NODE n; |
|
LIST l; |
|
|
version = get_asir_version(); |
version = get_asir_version(); |
STOQ(version,*rp); |
distribution = get_asir_distribution(); |
|
UTOQ(version,q); |
|
if ( !argc(arg) ) |
|
*rp = (Obj)q; |
|
else { |
|
MKSTR(str,distribution); |
|
n = mknode(2,q,str); |
|
MKLIST(l,n); |
|
*rp = (Obj)l; |
|
} |
} |
} |
|
|
|
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; |
{ |
{ |
char s[BUFSIZ]; |
|
int code; |
int code; |
char *reason,*action; |
char *reason,*action; |
|
|
|
|
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__) || defined(__MINGW64__) |
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 INET && !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; |
Line 395 void Psend_progress(NODE arg,Q *rp) |
|
Line 642 void Psend_progress(NODE arg,Q *rp) |
|
msg = ""; |
msg = ""; |
send_progress(per,msg); |
send_progress(per,msg); |
#endif |
#endif |
|
*rp = 0; |
|
} |
|
|
|
void Pget_addr(arg,rp) |
|
NODE arg; |
|
Q *rp; |
|
{ |
|
pointer obj; |
|
unsigned int u,l; |
|
N n; |
|
|
|
obj = ARG0(arg); |
|
if ( sizeof(pointer) == sizeof(unsigned int) ) { |
|
UTOQ((unsigned int)obj,*rp); |
|
} else { |
|
/* a pointer must fit in long */ |
|
u = ((unsigned long)obj)>>32; |
|
l = ((unsigned long)obj)&(unsigned long)0xffffffff; |
|
if ( u ) { |
|
n = NALLOC(2); PL(n) = 2; BD(n)[0] = l; BD(n)[1] = u; |
|
NTOQ(n,1,*rp); |
|
} else { |
|
UTOQ(l,*rp); |
|
} |
|
} |
|
} |
|
|
|
unsigned char *qtoaddr(q) |
|
Q q; |
|
{ |
|
unsigned char *addr; |
|
N n; |
|
|
|
if ( !q ) |
|
return 0; |
|
n = NM(q); |
|
if ( (sizeof(pointer) == sizeof(unsigned int)) || (PL(n) == 1) ) |
|
addr = (char *)BD(n)[0]; |
|
else { |
|
/* a pointer must fit in long */ |
|
addr = (char *)((((unsigned long)BD(n)[1])<<32) |
|
| ((unsigned long)BD(n)[0])); |
|
} |
|
return addr; |
|
} |
|
|
|
void Phex_dump(arg,rp) |
|
NODE arg; |
|
Q *rp; |
|
{ |
|
unsigned char *start; |
|
int len,i; |
|
|
|
*rp = 0; |
|
start = qtoaddr((Q)ARG0(arg)); |
|
len = QTOS((Q)ARG1(arg)); |
|
for ( i = 0; i < len; i++ ) { |
|
if ( !(i%16) ) |
|
fprintf(asir_out,"%08x: ",start+i); |
|
fprintf(asir_out,"%02x",start[i]); |
|
if ( !((i+1)%16) ) |
|
fprintf(asir_out,"\n"); |
|
else if ( !((i+1)%4) ) |
|
fprintf(asir_out," "); |
|
} |
|
if ( i%16 ) |
|
fprintf(asir_out,"\n"); |
|
} |
|
|
|
void Ppeek(arg,rp) |
|
NODE arg; |
|
Q *rp; |
|
{ |
|
unsigned int b; |
|
unsigned char *a; |
|
|
|
a = qtoaddr((Q)ARG0(arg)); |
|
b = (unsigned int) (*a); |
|
UTOQ(b,*rp); |
|
} |
|
|
|
void Ppoke(arg,rp) |
|
NODE arg; |
|
Q *rp; |
|
{ |
|
unsigned char *addr; |
|
|
|
addr = qtoaddr((Q)ARG0(arg)); |
|
*addr = (unsigned char)QTOS((Q)ARG1(arg)); |
*rp = 0; |
*rp = 0; |
} |
} |
|
|