version 1.16, 2003/03/07 06:39:55 |
version 1.39, 2020/10/04 03:14:07 |
|
|
* 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.15 2003/03/07 03:12:23 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.38 2019/02/26 02:48:12 noro 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(); |
|
int equalr(VL,Obj,Obj); |
|
int init_display(); |
|
void goto_toplevel(char *s); |
|
|
struct ftab misc_tab[] = { |
struct ftab misc_tab[] = { |
{"sleep",Psleep,1}, |
{"pwd",Pgetcwd,0}, |
{"null_command",Pnull_command,-99999}, |
{"chdir",Pchdir,1}, |
{"getenv",Pgetenv,1}, |
{"set_secure_mode",Pset_secure_mode,-1}, |
{"end",Pquit,0}, |
{"set_secure_flag",Pset_secure_flag,-2}, |
{"quit",Pquit,0}, |
{"module_list",Pmodule_list,0}, |
{"debug",Pdebug,0}, |
{"remove_module",Premove_module,1}, |
{"shell",Pshell,-2}, |
{"module_definedp",Pmodule_definedp,1}, |
{"heap",Pheap,-1}, |
{"sleep",Psleep,1}, |
{"version",Pversion,-99999}, |
{"null_command",Pnull_command,-99999}, |
{"nmono",Pnmono,1}, |
{"getenv",Pgetenv,1}, |
{"error",Perror,1}, |
{"end",Pquit,0}, |
{"error3",Perror3,3}, |
{"quit",Pquit,0}, |
{"nez",Pnez,1}, |
{"debug",Pdebug,0}, |
{"flist",Pflist,0}, |
{"shell",Pshell,-2}, |
{"delete_history",Pdelete_history,-2}, |
{"heap",Pheap,-1}, |
{"pause",Ppause,0}, |
{"version",Pversion,-99999}, |
{"gc",Pgc,0}, |
{"copyright",Pcopyright,0}, |
{"batch",Pbatch,2}, |
{"nmono",Pnmono,1}, |
{"send_progress",Psend_progress,-2}, |
{"toplevel",Ptoplevel,-1}, |
{"get_addr",Pget_addr,1}, |
{"error",Perror,1}, |
{"hex_dump",Phex_dump,2}, |
{"error3",Perror3,3}, |
{"peek",Ppeek,1}, |
{"nez",Pnez,1}, |
{"poke",Ppoke,2}, |
{"flist",Pflist,-1}, |
|
{"delete_history",Pdelete_history,-2}, |
|
{"pause",Ppause,0}, |
|
{"gc",Pgc,0}, |
|
{"batch",Pbatch,2}, |
|
{"send_progress",Psend_progress,-2}, |
|
{"get_addr",Pget_addr,1}, |
|
{"hex_dump",Phex_dump,2}, |
|
{"peek",Ppeek,1}, |
|
{"poke",Ppoke,2}, |
#if !defined(VISUAL) && defined(DO_PLOT) |
#if !defined(VISUAL) && defined(DO_PLOT) |
{"xpause",Pxpause,0}, |
{"xpause",Pxpause,0}, |
#endif |
#endif |
#if 0 |
#if 0 |
{"opt",Popt,1}, |
{"opt",Popt,1}, |
#endif |
#endif |
{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); |
#endif |
#endif |
*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 ) { |
len = strlen(e); |
len = strlen(e); |
f = (char *)MALLOC_ATOMIC(len+1); |
f = (char *)MALLOC_ATOMIC(len+1); |
strcpy(f,e); |
strcpy(f,e); |
MKSTR(*rp,f); |
MKSTR(*rp,f); |
} else |
} else |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
void Pnull_command(arg,rp) |
void Pnull_command(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
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; |
|
} |
} |
|
|
void Pdebug(rp) |
void Pdebug(rp) |
pointer *rp; |
pointer *rp; |
{ |
{ |
debug(0); *rp = 0; |
debug(0); *rp = 0; |
} |
} |
|
|
void Pshell(arg,rp) |
void Pshell(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
char *com = 0; |
char *com = 0; |
char *pstr = 0; |
char *pstr = 0; |
int status; |
int status; |
|
|
if ( arg ) { |
if ( arg ) { |
asir_assert(ARG0(arg),O_STR,"shell"); |
asir_assert(ARG0(arg),O_STR,"shell"); |
com = BDY((STRING)ARG0(arg)); |
com = BDY((STRING)ARG0(arg)); |
if ( NEXT(arg) ) |
if ( NEXT(arg) ) |
pstr = BDY((STRING)ARG1(arg)); |
pstr = BDY((STRING)ARG1(arg)); |
} |
} |
status = system(com); |
status = system(com); |
STOQ(status,*rp); |
STOQ(status,*rp); |
} |
} |
|
|
void Pnmono(arg,rp) |
void Pnmono(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
Obj obj; |
Obj obj; |
int n; |
int n; |
|
|
obj = (Obj)ARG0(arg); |
obj = (Obj)ARG0(arg); |
if ( !obj || OID(obj) > O_R ) |
if ( !obj || OID(obj) > O_R ) |
*rp = 0; |
*rp = 0; |
else |
else |
switch (OID(obj)) { |
switch (OID(obj)) { |
case O_N: case O_P: |
case O_N: case O_P: |
n = nmonop((P)obj); STOQ(n,*rp); break; |
n = nmonop((P)obj); STOQ(n,*rp); break; |
case O_R: |
case O_R: |
n = nmonop(NM((R)obj)) + nmonop(DN((R)obj)); |
n = nmonop(NM((R)obj)) + nmonop(DN((R)obj)); |
STOQ(n,*rp); break; |
STOQ(n,*rp); break; |
} |
} |
} |
} |
|
|
void Pheap(arg,rp) |
void Pheap(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
int h0,h; |
size_t h0,h; |
void GC_expand_hp(int); |
unsigned int u,l; |
|
N n; |
h0 = get_heapsize(); |
void GC_expand_hp(int); |
if ( arg ) { |
|
h = QTOS((Q)ARG0(arg)); |
h0 = get_heapsize(); |
if ( h > h0 ) |
if ( arg ) { |
GC_expand_hp(h-h0); |
h = QTOS((Q)ARG0(arg)); |
} |
if ( h > h0 ) |
h = get_heapsize(); |
GC_expand_hp(h-h0); |
STOQ(h,*rp); |
} |
|
h = get_heapsize(); |
|
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(); |
Line 224 void Pversion(arg,rp) |
|
Line 390 void Pversion(arg,rp) |
|
NODE arg; |
NODE arg; |
Obj *rp; |
Obj *rp; |
{ |
{ |
unsigned int version; |
unsigned int version; |
char *distribution; |
char *distribution; |
Q q; |
Q q; |
STRING str; |
STRING str; |
NODE n; |
NODE n; |
LIST l; |
LIST l; |
|
|
version = get_asir_version(); |
version = get_asir_version(); |
distribution = get_asir_distribution(); |
distribution = get_asir_distribution(); |
UTOQ(version,q); |
UTOQ(version,q); |
if ( !argc(arg) ) |
if ( !argc(arg) ) |
*rp = (Obj)q; |
*rp = (Obj)q; |
else { |
else { |
MKSTR(str,distribution); |
MKSTR(str,distribution); |
n = mknode(2,q,str); |
/* 0 means the old version */ |
MKLIST(l,n); |
n = mknode(3,q,str,0); |
*rp = (Obj)l; |
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) |
NODE arg; |
NODE arg; |
pointer *rp; |
pointer *rp; |
{ |
{ |
nez = ARG0(arg) ? 1 : 0; *rp = 0; |
nez = ARG0(arg) ? 1 : 0; *rp = 0; |
} |
} |
|
|
void Perror(arg,rp) |
void Perror(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
char *s; |
char *s; |
|
|
if ( !arg || !ARG0(arg) || (OID((Obj)ARG0(arg)) != O_STR) ) |
if ( !arg || !ARG0(arg) || (OID((Obj)ARG0(arg)) != O_STR) ) |
s = ""; |
s = ""; |
else |
else |
s = BDY((STRING)ARG0(arg)); |
s = BDY((STRING)ARG0(arg)); |
error(s); |
error(s); |
*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; |
{ |
{ |
int code; |
int code; |
char *reason,*action; |
char *reason,*action; |
|
|
asir_assert(ARG0(arg),O_N,"error3"); |
asir_assert(ARG0(arg),O_N,"error3"); |
asir_assert(ARG1(arg),O_STR,"error3"); |
asir_assert(ARG1(arg),O_STR,"error3"); |
asir_assert(ARG2(arg),O_STR,"error3"); |
asir_assert(ARG2(arg),O_STR,"error3"); |
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; |
LIST l; |
NODE t,r,r0,m; |
|
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 ( t = ubinf; t; t = NEXT(t) ) |
for ( m = MODULE_LIST; m; m = NEXT(m) ) { |
if ( ((FUNC)BDY(t))->id != A_UNDEF ) { |
if ( !strcmp(mname,((MODULE)BDY(m))->name) ) { |
n = NAME((FUNC)BDY(t)); MKSTR(name,n); |
t = ((MODULE)BDY(m))->usrf_list; |
MKNODE(r,name,r0); r0 = r; |
for ( r0 = 0; t; t = NEXT(t) ) |
} |
if ( ((FUNC)BDY(t))->id != A_UNDEF ) { |
for ( t = sysf; 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; |
} |
} |
} |
MKLIST(l,r0); *rp = l; |
} 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; |
} |
} |
|
|
void Pdelete_history(arg,rp) |
void Pdelete_history(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
switch ( argc(arg) ) { |
switch ( argc(arg) ) { |
case 0: default: |
case 0: default: |
delete_history(0,(int)APVS->n); |
delete_history(0,(int)APVS->n); |
break; |
break; |
case 1: |
case 1: |
delete_history(QTOS((Q)ARG0(arg)),1); |
delete_history(QTOS((Q)ARG0(arg)),1); |
break; |
break; |
} |
} |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
void delete_history(start,n) |
void delete_history(start,n) |
int start,n; |
int start,n; |
{ |
{ |
int i,max; |
int i,max; |
|
|
max = APVS->n; |
max = APVS->n; |
if ( start < 0 || start >= max ) |
if ( start < 0 || start >= max ) |
return; |
return; |
if ( start + n > max ) |
if ( start + n > max ) |
n = max - start; |
n = max - start; |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
APVS->va[start+i].priv = 0; |
APVS->va[start+i].priv = 0; |
} |
} |
|
|
void Ppause(rp) |
void Ppause(rp) |
LIST *rp; |
LIST *rp; |
{ |
{ |
char buf[BUFSIZ]; |
char buf[BUFSIZ]; |
|
|
fgets(buf,BUFSIZ,stdin); |
fgets(buf,BUFSIZ,stdin); |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
void Pgc(rp) |
void Pgc(rp) |
LIST *rp; |
LIST *rp; |
{ |
{ |
GC_gcollect(); |
GC_gcollect(); |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
int exec_file(char *,char *); |
int exec_file(char *,char *); |
Line 364 void Pbatch(arg,rp) |
|
Line 572 void Pbatch(arg,rp) |
|
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
int ret; |
int ret; |
|
|
ret = exec_file(BDY((STRING)ARG0(arg)),BDY((STRING)ARG1(arg))); |
ret = exec_file(BDY((STRING)ARG0(arg)),BDY((STRING)ARG1(arg))); |
STOQ(ret,*rp); |
STOQ(ret,*rp); |
} |
} |
|
|
#if !defined(VISUAL) && defined(DO_PLOT) |
#if !defined(VISUAL) && defined(DO_PLOT) |
void Pxpause(rp) |
void Pxpause(rp) |
Q *rp; |
Q *rp; |
{ |
{ |
if ( !init_display() ) |
if ( !init_display() ) |
*rp = 0; |
*rp = 0; |
else { |
else { |
grab_pointer(); *rp = ONE; |
grab_pointer(); *rp = ONE; |
} |
} |
} |
} |
|
|
static Display *display; |
static Display *display; |
Line 386 static Window rootwin; |
|
Line 594 static Window rootwin; |
|
|
|
init_display() |
init_display() |
{ |
{ |
char *dname; |
char *dname; |
unsigned int tmp; |
unsigned int tmp; |
static int initialized; |
static int initialized; |
int argc; |
int argc; |
char *argv[1]; |
char *argv[1]; |
|
|
if ( initialized ) |
if ( initialized ) |
return 1; |
return 1; |
else |
else |
initialized = 1; |
initialized = 1; |
dname = (char *)getenv("DISPLAY"); |
dname = (char *)getenv("DISPLAY"); |
|
|
display = XOpenDisplay(dname); |
display = XOpenDisplay(dname); |
if ( !display ) { |
if ( !display ) { |
fprintf(stderr,"Can't open display\n"); |
fprintf(stderr,"Can't open display\n"); |
return 0; |
return 0; |
} |
} |
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; |
|
|
if ( !cursor ) |
if ( !cursor ) |
cursor = XCreateFontCursor(display,XC_leftbutton); |
cursor = XCreateFontCursor(display,XC_leftbutton); |
XGrabPointer(display,rootwin,True,ButtonPressMask,GrabModeAsync,GrabModeAsync,None,cursor,CurrentTime); |
XGrabPointer(display,rootwin,True,ButtonPressMask,GrabModeAsync,GrabModeAsync,None,cursor,CurrentTime); |
while ( 1 ) { |
while ( 1 ) { |
XNextEvent(display,&ev); |
XNextEvent(display,&ev); |
if ( ev.xany.type == ButtonPress ) |
if ( ev.xany.type == ButtonPress ) |
break; |
break; |
} |
} |
XUngrabPointer(display,CurrentTime); |
XUngrabPointer(display,CurrentTime); |
XSync(display,False); |
XSync(display,False); |
return; |
return; |
} |
} |
#endif |
#endif |
|
|
void Psend_progress(NODE arg,Q *rp) |
void Psend_progress(NODE arg,Q *rp) |
{ |
{ |
#if defined(VISUAL) |
#if defined(VISUAL) |
short per; |
short per; |
char *msg; |
char *msg; |
|
|
per = (short)QTOS((Q)BDY(arg)); arg = NEXT(arg); |
per = (short)QTOS((Q)BDY(arg)); arg = NEXT(arg); |
if ( arg ) |
if ( arg ) |
msg = BDY((STRING)BDY(arg)); |
msg = BDY((STRING)BDY(arg)); |
else |
else |
msg = ""; |
msg = ""; |
send_progress(per,msg); |
send_progress(per,msg); |
#endif |
#endif |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
void Pget_addr(arg,rp) |
void Pget_addr(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
pointer obj; |
pointer obj; |
unsigned int u,l; |
unsigned int u,l; |
N n; |
N n; |
|
|
obj = ARG0(arg); |
obj = ARG0(arg); |
if ( sizeof(pointer) == sizeof(unsigned int) ) { |
if ( sizeof(pointer) == sizeof(unsigned int) ) { |
UTOQ((unsigned int)obj,*rp); |
UTOQ((unsigned int)obj,*rp); |
} else { |
} else { |
/* a pointer must fit in long */ |
/* a pointer must fit in long */ |
u = ((unsigned long)obj)>>32; |
u = ((unsigned long)obj)>>32; |
l = ((unsigned long)obj)&(unsigned long)0xffffffff; |
l = ((unsigned long)obj)&(unsigned long)0xffffffff; |
if ( u ) { |
if ( u ) { |
n = NALLOC(2); PL(n) = 2; BD(n)[0] = l; BD(n)[1] = u; |
n = NALLOC(2); PL(n) = 2; BD(n)[0] = l; BD(n)[1] = u; |
NTOQ(n,1,*rp); |
NTOQ(n,1,*rp); |
} else { |
} else { |
UTOQ(l,*rp); |
UTOQ(l,*rp); |
} |
} |
} |
} |
} |
} |
|
|
unsigned char *qtoaddr(q) |
unsigned char *qtoaddr(q) |
Q q; |
Q q; |
{ |
{ |
unsigned char *addr; |
unsigned char *addr; |
N n; |
N n; |
|
|
if ( !q ) |
if ( !q ) |
return 0; |
return 0; |
n = NM(q); |
n = NM(q); |
if ( (sizeof(pointer) == sizeof(unsigned int)) || (PL(n) == 1) ) |
if ( (sizeof(pointer) == sizeof(unsigned int)) || (PL(n) == 1) ) |
addr = (char *)BD(n)[0]; |
addr = (char *)BD(n)[0]; |
else { |
else { |
/* a pointer must fit in long */ |
/* a pointer must fit in long */ |
addr = (char *)((((unsigned long)BD(n)[1])<<32) |
addr = (char *)((((unsigned long)BD(n)[1])<<32) |
| ((unsigned long)BD(n)[0])); |
| ((unsigned long)BD(n)[0])); |
} |
} |
return addr; |
return addr; |
} |
} |
|
|
void Phex_dump(arg,rp) |
void Phex_dump(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
unsigned char *start; |
unsigned char *start; |
int len,i; |
int len,i; |
|
|
*rp = 0; |
*rp = 0; |
start = qtoaddr((Q)ARG0(arg)); |
start = qtoaddr((Q)ARG0(arg)); |
len = QTOS((Q)ARG1(arg)); |
len = QTOS((Q)ARG1(arg)); |
for ( i = 0; i < len; i++ ) { |
for ( i = 0; i < len; i++ ) { |
if ( !(i%16) ) |
if ( !(i%16) ) |
fprintf(asir_out,"%08x: ",start+i); |
fprintf(asir_out,"%08x: ",start+i); |
fprintf(asir_out,"%02x",start[i]); |
fprintf(asir_out,"%02x",start[i]); |
if ( !((i+1)%16) ) |
if ( !((i+1)%16) ) |
fprintf(asir_out,"\n"); |
fprintf(asir_out,"\n"); |
else if ( !((i+1)%4) ) |
else if ( !((i+1)%4) ) |
fprintf(asir_out," "); |
fprintf(asir_out," "); |
} |
} |
if ( i%16 ) |
if ( i%16 ) |
fprintf(asir_out,"\n"); |
fprintf(asir_out,"\n"); |
} |
} |
|
|
void Ppeek(arg,rp) |
void Ppeek(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
unsigned int b; |
unsigned int b; |
unsigned char *a; |
unsigned char *a; |
|
|
a = qtoaddr((Q)ARG0(arg)); |
a = qtoaddr((Q)ARG0(arg)); |
b = (unsigned int) (*a); |
b = (unsigned int) (*a); |
UTOQ(b,*rp); |
UTOQ(b,*rp); |
} |
} |
|
|
void Ppoke(arg,rp) |
void Ppoke(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
{ |
{ |
unsigned char *addr; |
unsigned char *addr; |
|
|
addr = qtoaddr((Q)ARG0(arg)); |
addr = qtoaddr((Q)ARG0(arg)); |
*addr = (unsigned char)QTOS((Q)ARG1(arg)); |
*addr = (unsigned char)QTOS((Q)ARG1(arg)); |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
#if 0 |
#if 0 |
Line 540 void Popt(arg,rp) |
|
Line 748 void Popt(arg,rp) |
|
NODE arg; |
NODE arg; |
pointer *rp; |
pointer *rp; |
{ |
{ |
optimize = ARG0(arg) ? 1 : 0; *rp = 0; |
optimize = ARG0(arg) ? 1 : 0; *rp = 0; |
} |
} |
|
|
|
|
void sz_init() { |
void sz_init() { |
int i; |
int i; |
Q t; |
Q t; |
|
|
for ( i = 1; i < 1000; i++ ) { |
for ( i = 1; i < 1000; i++ ) { |
oPSN[i].p = 1; oPSN[i].b[0] = i; |
oPSN[i].p = 1; oPSN[i].b[0] = i; |
t = &oPSZ[i]; |
t = &oPSZ[i]; |
OID(t) = O_N; NID(t) = N_Q; SGN(t) = 1; NM(t) = &oPSN[i]; DN(t) = 0; |
OID(t) = O_N; NID(t) = N_Q; SGN(t) = 1; NM(t) = &oPSN[i]; DN(t) = 0; |
t = &oMSZ[i]; |
t = &oMSZ[i]; |
OID(t) = O_N; NID(t) = N_Q; SGN(t) = -1; NM(t) = &oPSN[i]; DN(t) = 0; |
OID(t) = O_N; NID(t) = N_Q; SGN(t) = -1; NM(t) = &oPSN[i]; DN(t) = 0; |
} |
} |
szinit = 1; |
szinit = 1; |
} |
} |
|
|
optobj(p) |
optobj(p) |
Obj *p; |
Obj *p; |
{ |
{ |
Obj t; |
Obj t; |
int n; |
int n; |
DCP dc; |
DCP dc; |
|
|
if ( t = *p ) |
if ( t = *p ) |
switch ( OID(t) ) { |
switch ( OID(t) ) { |
case O_N: |
case O_N: |
if ( (NID(t)==N_Q) && INT(t) && (PL(NM((Q)t))==1) ) { |
if ( (NID(t)==N_Q) && INT(t) && (PL(NM((Q)t))==1) ) { |
n = QTOS((Q)t); |
n = QTOS((Q)t); |
if ( !szinit ) |
if ( !szinit ) |
sz_init(); |
sz_init(); |
if ( n < 1000 ) |
if ( n < 1000 ) |
*p = (Obj)(SGN((Q)t)>0?&oPSZ[n]:&oMSZ[n]); |
*p = (Obj)(SGN((Q)t)>0?&oPSZ[n]:&oMSZ[n]); |
} |
} |
break; |
break; |
case O_P: |
case O_P: |
for ( dc = DC((P)t); dc; dc = NEXT(dc) ) { |
for ( dc = DC((P)t); dc; dc = NEXT(dc) ) { |
optobj(&DEG(dc)); optobj(&COEF(dc)); |
optobj(&DEG(dc)); optobj(&COEF(dc)); |
} |
} |
break; |
break; |
case O_R: |
case O_R: |
optobj(&NM((R)t)); optobj(&DN((R)t)); break; |
optobj(&NM((R)t)); optobj(&DN((R)t)); break; |
default: |
default: |
break; |
break; |
} |
} |
} |
} |
#endif |
#endif |