mcgrew@dartagnan.rutgers.edu (Charles Mcgrew) (09/15/89)
Submitted-by: apctrc!zmls04@uunet.uu.net (Martin L. Smith)
Posting-number: Volume 1, Issue 69
Archive-name: hype/part09
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# src
# This archive created: Thu Sep 14 20:59:32 1989
export PATH; PATH=/bin:$PATH
if test ! -d 'src'
then
echo shar: creating directory "'src'"
mkdir 'src'
fi
echo shar: entering directory "'src'"
cd 'src'
echo shar: extracting "'iam.c'" '(53762 characters)'
if test -f 'iam.c'
then
echo shar: will not over-write existing file "'iam.c'"
else
sed 's/^ X//' << \SHAR_EOF > 'iam.c'
X#include <stdio.h>
X#include <ctype.h>
X#include "util.h"
X#include "scripter.h"
X#include "../archives/container/container.h"
X#include "../archives/mfile/mfile.h"
X#include "itemmod.h"
X#include "tlmod.h"
X#include "objmod.h"
X#include "pathname.h"
X#include "visual.h"
X#include "handler.h"
X#include "sighandler.h"
X#include "clipboard.h"
X#include "select.h"
X#include "info.h"
X
X#define STACK_SIZE (1000)
X
Xextern char *glob_recognizer;
X
Xtypedef struct am {
X int numlocals;
X Container *locals;
X int pc;
X char *stack[STACK_SIZE];
X int stackcntr;
X OBPtr ref;
X Container retval;
X Container param;
X Container self;
X char *otarg;
X int status;
X ObjectCode code;
X} AM;
X
Xextern int sigq_non_empty;
X
Xextern int errno;
X
Xextern int superuser;
X
Xstatic double atof();
X
Xstatic char buff[4096];
X
Xstatic int numargs;
X
Xstatic int global_abort = 0;
X
X#define SIGPROCESS {if (sigq_non_empty) sigprocess();}
X#define GETNUMARGS (numargs = (int) am->code[am->pc++])
X#define CHECKNUMARGS(x) if (x != numargs) { \
X mywarning("wrong number of arguments!\n");\
X while (numargs > 0) { \
X free(pop(am)); \
X numargs--; \
X } \
X push(mystrcpy(""),am); \
X return; \
X}
X
X
X#define STAT_IN_LOOP (1<<0)
X#define STAT_BREAK (1<<1)
X#define STAT_CONT (1<<2)
X#define STAT_RETURN (1<<3)
X
XAM *new_am(p,ref,param,otarget,self)
XOBPtr ref;
XObjectCode p;
XContainer param;
Xchar *otarget;
XContainer self;
X{
X AM *temp;
X int i;
X temp = (AM *) malloc(sizeof(AM) * 1);
X temp->numlocals = (int) *p;
X temp->code = p;
X temp->pc = 1;
X temp->stackcntr = 0;
X temp->ref = ref;
X temp->param = param;
X temp->otarg = otarget;
X temp->self = self;
X
X/* get number of local variable and alloc space for them */
X temp->locals = (Container *) malloc(sizeof(Container) * temp->numlocals);
X for (i = 0; i < temp->numlocals; i++) {
X temp->locals[i] = cnew_con();
X }
X temp->status = 0;
X temp->retval = cnew_con();
X return temp;
X}
X
Xvoid dealloc_am(am)
XAM *am;
X{
X int i;
X for (i = 0; i < am->numlocals; i++) {
X cdestroy(am->locals[i]);
X }
X for (i = 0; i < am->stackcntr; i++) {
X free(am->stack[i]);
X }
X free(am);
X}
Xvoid push(str,am)
Xchar *str;
XAM *am;
X{
X am->stack[am->stackcntr] = str;
X am->stackcntr++;
X}
Xchar *pop(am)
XAM *am;
X{
X if (am->stackcntr-- <= 0) {
X fprintf(stderr,"expression stack empty\n");
X global_abort = 1;
X return mystrcpy("");
X }
X return am->stack[am->stackcntr];
X}
Xint execute(am,pc,status)
XAM *am;
Xint pc;
Xint status;
X{
X am->pc = pc;
X
X while ((am->code[am->pc] != HALT) && (global_abort != 1)) {
X am->status = (am->status & STAT_RETURN) | (am->status | status);
X if ((am->status & STAT_RETURN) || ((am->status & STAT_IN_LOOP) &&
X ((am->status & STAT_BREAK) || (am->status & STAT_CONT)))) {
X push(mystrcpy(""),am);
X return am->pc;
X }
X SIGPROCESS;
X (am->code[am->pc++])(am);
X }
X return am->pc;
X}
XContainer executescript(p,ref,param,otarget,self)
XContainer param;
XObjectCode p;
XOBPtr ref;
Xchar *otarget;
XContainer self;
X{
X AM *am;
X Container cont;
X am = new_am(p,ref,param,otarget,self);
X global_abort = 0;
X execute(am,am->pc,0);
X cont = am->retval;
X dealloc_am(am);
X return cont;
X}
Xint qstring(am)
XAM *am;
X{
X int i,n;
X int numinsts;
X char *str;
X n = (int) am->code[am->pc++];
X numinsts = (n/4) + 1;
X str = (char *) malloc(sizeof(char) * (n+1));
X
X for (i = 0; i < n; i++) {
X str[i] = *((char *) (i + (char *) &am->code[am->pc]));
X }
X str[n] = '\0';
X am->pc += numinsts;
X push(str,am);
X}
Xint numstring(am)
XAM *am;
X{
X int i,n;
X int numinsts;
X char *str,str2[40];
X n = (int) am->code[am->pc];
X am->pc++;
X numinsts = (n/4) + 1;
X str = (char *) malloc(sizeof(char) * (n+1));
X for (i = 0; i < n; i++) {
X str[i] = *((char *) (i + (char *) &am->code[am->pc]));
X }
X str[n] = '\0';
X sprintf(str2,"%g",atof(str));
X am->pc += numinsts;
X free(str);
X push(mystrcpy(str2),am);
X}
Xint nop(am)
XAM *am;
X{
X
X}
Xmysystemtl(str)
Xchar *str;
X{
X int i,j,x;
X char *argv[5];
X argv[0] = "sh";
X argv[1] = "-c";
X argv[2] = str;
X argv[3] = NULL;
X if ((i = fork()) == 0) {
X close_all();
X execv("/bin/sh",argv);
X } else {
X runpid = i;
X/* j = wait(&x);*/
X }
X return runpid;
X}
Xint mysystem(str)
Xchar *str;
X{
X int i,j,x;
X char *argv[5];
X argv[0] = "sh";
X argv[1] = "-c";
X argv[2] = str;
X argv[3] = NULL;
X if ((i = fork()) == 0) {
X close_all();
X execv("/bin/sh",argv);
X } else {
X runpid = i;
X j = wait(&x);
X }
X
X}
Xint unixbg(am)
XAM *am;
X{
X int n;
X char *str;
X int pid;
X Container cont;
X char x[256];
X GETNUMARGS;
X CHECKNUMARGS(1);
X
X str = pop(am);
X
X gsigflag = RUNNINGJOB;
X setjmp(sigbuff[1]);
X
X if (gsigflag == INSCRIPT) {
X push(str,am);
X return;
X }
X
X pid = mysystemtl(str);
X cont = cnew_constring(str);
X crewind(cont);
X sprintf(x,"%d,\0",pid);
X mfinsert(cont,x,strlen(x));
X
X broadcast(get_master(),"jobStartedBg",cont);
X
X gsigflag = INSCRIPT;
X
X push(str,am);
X
X}
Xint myexit(am)
XAM *am;
X{
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(0);
X if (superuser) {
X save_public(get_master(),get_public());
X }
X obj = (OBPtr) get_distinguished();
X save_obj(obj,get_state());
X exit(0);
X}
Xint myabort(am)
XAM *am;
X{
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(0);
X if (vis_dialogue("Exit WITHOUT saving changes\n"))
X exit(0);
X else {
X push(mystrcpy(""),am);
X }
X}
Xint mysavestate(am)
XAM *am;
X{
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(0);
X if (superuser) {
X save_public(get_master(),get_public());
X }
X obj = (OBPtr) get_distinguished();
X save_obj(obj,get_state());
X push(mystrcpy(get_state()),am);
X}
Xint mysaveobj(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj != NULL) {
X mywarning("object not found");
X free(str1);
X free(str2);
X push(mystrcpy(""),am);
X }
X save_obj(obj,str2);
X free(str2);
X push(mystrcpy(str1),am);
X}
Xint myloadbelow(am)
XAM *am;
X{
X char *str1,*str2;
X int n;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(2);
X
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj != NULL) {
X mywarning("object not found");
X free(str1);
X free(str2);
X push(mystrcpy(""),am);
X }
X n = object_get_numchild(obj);
X load_below(str2,obj,n,NULL);
X free(str2);
X push(mystrcpy(str1),am);
X}
Xint myloadover(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj != NULL) {
X mywarning("object not found");
X free(str1);
X free(str2);
X push(mystrcpy(""),am);
X }
X load_over(str2,obj,NULL);
X free(str2);
X push(mystrcpy(str1),am);
X}
Xint exectext(am)
XAM *am;
X{
X char *str1,*str2;
X Container res,script;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X script = cnew_constring(str1);
X res = (Container) execute_source(script,am->ref,am->param,am->otarg,am->self);
X free(str1);
X push(cflatten(res),am);
X cdestroy(res);
X cdestroy(script);
X}
Xint mygetcwd(am)
XAM *am;
X{
X GETNUMARGS;
X CHECKNUMARGS(0);
X getcwd(buff,4000);
X push(mystrcpy(buff),am);
X}
Xint mykill(am)
XAM *am;
X{
X char *str1,*str2;
X int pid,sig;
X int ret;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X sig = atoi(str2);
X pid = atoi(str1);
X ret = kill(pid,sig);
X push(int_to_string(ret),am);
X free(str1);
X free(str2);
X}
Xint mychdir(am)
XAM *am;
X{
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X if (!chdir(str)) {
X free(str);
X push(mystrcpy("0"),am);
X } else {
X sprintf(buff,"%g\n\0",(float) errno);
X free(str);
X push(mystrcpy(buff),am);
X }
X}
Xint mypwrite(am)
XAM *am;
X{
X char *str1,*str2;
X int n,cc,i,x,j;
X FILE *pfd;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str1 = pop(am);
X str2 = pop(am);
X n = strlen(str1);
X pfd = popen(str2,"w");
X fprintf(pfd,"%s",str1);
X pclose(pfd);
X push(str1,am);
X
X}
Xint mypread(am)
XAM *am;
X{
X char *str1,*str2;
X int n,cc,i,x,j;
X FILE *pfd;
X Container res;
X char c;
X GETNUMARGS;
X CHECKNUMARGS(1);
X res = cnew_con();
X str1 = pop(am);
X pfd = popen(str1,"r");
X c = getc(pfd);
X while (c != EOF) {
X mfputc(res,c);
X c = getc(pfd);
X }
X pclose(pfd);
X mfputc(res,'\0');
X push(cflatten(res),am);
X}
Xint unixcom(am)
XAM *am;
X{
X int n;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X/* handler(am->ref,NULL,NULL,
X "jobStarted",cnew_constring(str),
X gen_absolute_pname(am->ref));
X*/
X gsigflag = RUNNINGJOB;
X setjmp(sigbuff[1]);
X
X if (gsigflag == INSCRIPT) {
X fprintf(stderr,"jump made and detected\n");
X push(str,am);
X return;
X }
X svsignal(SIGCHLD,SIG_DFL);
X mysystem(str);
X svsignal(SIGCHLD,onsigchild);
X svsignal(SIGALRM,onsigalarm);
X gsigflag = INSCRIPT;
X/*
X handler(am->ref,NULL,NULL,
X "jobEnded",cnew_constring(str),
X gen_absolute_pname(am->ref));
X*/
X push(str,am);
X
X}
Xint opencom(am)
XAM *am;
X{
X char *str;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str,am->ref);
X if (obj != NULL) {
X show_obj(obj);
X }
X push(str,am);
X
X}
Xint myrefresh(am)
XAM *am;
X{
X char *str;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str,am->ref);
X if (obj != NULL) {
X if (object_open(obj)) {
X close_obj(obj);
X show_obj(obj);
X }
X }
X push(str,am);
X}
Xint closecom(am)
XAM *am;
X{
X char *str;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str,am->ref);
X if (obj != NULL) {
X close_obj(obj);
X }
X push(str,am);
X
X}
Xint concat(am)
XAM *am;
X{
X char *str1,*str2;
X char x[2024];
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X x[0] = '\0';
X strcpy(x,str1);
X strcat(x,str2);
X free(str1);
X free(str2);
X push(mystrcpy(x),am);
X}
Xint numchildren(am)
XAM *am;
X{
X char *str1;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj != NULL){
X sprintf(buff,"%d\0",object_get_numchild(obj));
X }
X free(str1);
X push(mystrcpy(buff),am);
X}
Xint numtls(am)
XAM *am;
X{
X char *str1;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj == NULL) {
X push(mystrcpy(""),am);
X free(str1);
X return;
X }
X sprintf(buff,"%d\0",object_get_numtls(obj));
X free(str1);
X push(mystrcpy(buff),am);
X}
Xint setobjcolor(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj == NULL) {
X push(mystrcpy(""),am);
X free(str1);
X free(str2);
X return;
X }
X object_set_color(obj,cnew_constring(str2));
X free( str1);
X push(str2,am);
X}
Xint setobjscript(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj == NULL) {
X push(mystrcpy(""),am);
X free(str1);
X free(str2);
X return;
X }
X object_set_script(obj,cnew_constring(str2));
X compile_object_script(obj,NO_REPORT);
X free( str1);
X push(str2,am);
X}
Xint setobjlabel(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj == NULL) {
X push(mystrcpy(""),am);
X free(str1);
X free(str2);
X return;
X }
X object_set_label(obj,cnew_constring(str2));
X free( str1);
X push(str2,am);
X}
Xint setobjname(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj == NULL) {
X push(mystrcpy(""),am);
X free(str1);
X free(str2);
X return;
X }
X object_set_name(obj,mystrcpy(str2));
X free( str1);
X push(str2,am);
X}
Xint numpanes(am)
XAM *am;
X{
X char *str1;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj == NULL) {
X push(mystrcpy(""),am);
X free(str1);
X return;
X }
X sprintf(buff,"%d\0",object_get_numtemps(obj));
X free(str1);
X push(mystrcpy(buff),am);
X}
Xint numitems(am)
XAM *am;
X{
X char *str1;
X TLPtr tl1;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X tl1 = tl_ofpname(str1,am->ref);
X if (tl1 == NULL) {
X tl1 = temptl_ofpname(str1,am->ref);
X }
X sprintf(buff,"%d\0",tl_get_numitems(tl1));
X free(str1);
X push(mystrcpy(buff),am);
X}
Xint settlcolor(am)
XAM *am;
X{
X char *str1,*str2;
X TLPtr tl1;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X tl1 = tl_ofpname(str1,am->ref);
X if (tl1 == NULL) {
X tl1 = temptl_ofpname(str1,am->ref);
X }
X tl_set_color(tl1,cnew_constring(str2));
X free(str1);
X push(str2,am);
X}
Xint getnthobject(am)
XAM *am;
X{
X char *str1;
X char *str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X sprintf(buff,"%s/%d\0",str1,atoi(str2));
X free(str1);
X free(str2);
X push(mystrcpy(buff),am);
X}
Xint getnthitem(am)
XAM *am;
X{
X char *str1;
X char *str2;
X OBPtr obj;
X TLPtr tl1;
X int n,i;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X tl1 = tl_ofpname(str1,am->ref);
X if (tl1 == NULL) {
X tl1 = temptl_ofpname(str1,am->ref);
X }
X n = tl_get_numitems(tl1);
X i = atoi(str2);
X if (i >= n)
X i = (n-1);
X sprintf(buff,"%s#%d\0",str1,atoi(str2));
X free(str1);
X free(str2);
X if (n == 0) {
X push(mystrcpy(""),am);
X }
X push(mystrcpy(buff),am);
X}
Xint getnthpane(am)
XAM *am;
X{
X char *str1;
X char *str2;
X OBPtr obj;
X TLPtr tl1;
X int n,i;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X n = object_get_numtls(obj);
X i = atoi(str2);
X if (i >= n)
X i = (n-1);
X sprintf(buff,"%s!%d\0",str1,atoi(str2));
X free(str1);
X free(str2);
X if (n == 0) {
X push(mystrcpy(""),am);
X }
X push(mystrcpy(buff),am);
X}
Xint getnthtl(am)
XAM *am;
X{
X char *str1;
X char *str2;
X OBPtr obj;
X TLPtr tl1;
X int n,i;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X n = object_get_numtls(obj);
X i = atoi(str2);
X if (i >= n)
X i = (n-1);
X sprintf(buff,"%s!%d\0",str1,atoi(str2));
X free(str1);
X free(str2);
X if (n == 0) {
X push(mystrcpy(""),am);
X }
X push(mystrcpy(buff),am);
X}
Xint mynegate(am)
XAM *am;
X{
X char *str1;
X double x;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X x = 0.0 - atof(str1);
X sprintf(buff,"%g\0",x);
X free(str1);
X push(mystrcpy(buff),am);
X}
Xint plus(am)
XAM *am;
X{
X char *str1,*str2;
X double x,atof();
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X x = atof(str1) + atof(str2);
X sprintf(buff,"%g\0",x);
X free(str1);
X free(str2);
X push(mystrcpy(buff),am);
X}
Xint times(am)
XAM *am;
X{
X char *str1,*str2;
X double x,atof();
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X x = atof(str1) * atof(str2);
X sprintf(buff,"%g\0",x);
X free(str1);
X free(str2);
X push(mystrcpy(buff),am);
X}
Xint minus(am)
XAM *am;
X{
X char *str1,*str2;
X double x,atof();
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X x = atof(str1) - atof(str2);
X sprintf(buff,"%g\0",x);
X free(str1);
X free(str2);
X push(mystrcpy(buff),am);
X}
Xint divide(am)
XAM *am;
X{
X char *str1,*str2;
X double x,atof();
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X x = atof(str1) / atof(str2);
X sprintf(buff,"%g\0",x);
X free(str1);
X free(str2);
X push(mystrcpy(buff),am);
X}
Xint setitemname(am)
XAM *am;
X{
X ITPtr it;
X TLPtr tl;
X char *str1,*str2,*old;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X tl = tl_ofpname(str1,am->ref);
X if (tl == NULL) {
X tl = temptl_ofpname(str1,am->ref);
X if (tl == NULL) {
X mywarning("item parent not found\n");
X push(mystrcpy(""),am);
X return;
X }
X }
X old = item_get_name(it);
X item_set_name(it,mystrcpy(str2));
X tl_change_item_name(tl,it,old);
X free(str1);
X push(str2,am);
X}
Xint setitemtype(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X str2 = pop(am);
X str1 = pop(am);
X GETNUMARGS;
X CHECKNUMARGS(2);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_type(it,atoi(str2));
X push(str2,am);
X}
Xint setitemmin(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X str2 = pop(am);
X str1 = pop(am);
X GETNUMARGS;
X CHECKNUMARGS(2);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_min(it,cnew_constring(str2));
X push(str2,am);
X}
X
Xint setitemmax(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_max(it,cnew_constring(str2));
X push(str2,am);
X}
Xint setitemtoggles(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_labels(it,cnew_constring(str2));
X push(str2,am);
X}
Xint getitemtoggles(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X str2 = cflatten(item_get_labels(it));
X push(str2,am);
X}
Xint setitemicon(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_icon(it,cnew_constring(str2));
X push(str2,am);
X}
Xint setitemscript(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_script(it,cnew_constring(str2));
X compile_item_script(it,NO_REPORT);
X
X push(str2,am);
X}
Xint settlscript(am)
XAM *am;
X{
X TLPtr tl;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X tl = tl_ofpname(str1,am->ref);
X if (tl == NULL) {
X tl = temptl_ofpname(str1,am->ref);
X if (tl == NULL) {
X mywarning("tl not found\n");
X push(mystrcpy(""),am);
X return;
X }
X }
X free(str1);
X tl_set_script(tl,cnew_constring(str2));
X compile_tl_script(tl,NO_REPORT);
X push(str2,am);
X}
Xint settlbgtext(am)
XAM *am;
X{
X TLPtr tl;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X tl = tl_ofpname(str1,am->ref);
X if (tl == NULL) {
X tl = temptl_ofpname(str1,am->ref);
X if (tl == NULL) {
X mywarning("tl not found\n");
X push(mystrcpy(""),am);
X return;
X }
X }
X free(str1);
X fill_pane_with_text(tl,tl_get_bgtext(tl),0);
X tl_set_bgtext(tl,cnew_constring(str2));
X fill_pane_with_text(tl,tl_get_bgtext(tl),1);
X push(str2,am);
X}
Xint setitemlabel(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_label(it,mystrcpy(str2));
X push(str2,am);
X}
Xint setitemform(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_form(it,cnew_constring(str2));
X push(str2,am);
X}
Xint setitemval(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X OBPtr obj;
X char *cur;
X Container val;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X obj = obj_ofpname(str1,am->ref);
X val = cnew_constring(str2);
X object_set_info(obj,
X info_add_data(object_get_info(obj),gen_absolute_itempname(it),val));
X refresh_item_val(it,obj,val);
X push(str2,am);
X free(str1);
X}
Xint refreshitem(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X OBPtr obj;
X char *cur;
X Container val;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X obj = obj_ofpname(str1,am->ref);
X val = info_look(object_get_info(obj),gen_absolute_itempname(it));
X if (val != NULL) {
X refresh_item_val(it,obj,val);
X }
X push(str1,am);
X}
X
Xint setitemdef(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_def(it,cnew_constring(str2));
X push(str2,am);
X}
Xint setitemlux(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_lux(it,atoi(str2));
X push(str2,am);
X}
Xint setitemluy(am)
XAM *am;
X{
X ITPtr it;
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str1);
X item_set_luy(it,atoi(str2));
X push(str2,am);
X}
X
Xint getitemmin(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(item_get_min(it)),am);
X}
Xint getitemmax(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(item_get_max(it)),am);
X}
Xint getitemlabels(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(item_get_labels(it)),am);
X}
X
Xint getitemicon(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(item_get_icon(it)),am);
X}
Xint getitemscript(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(item_get_script(it)),am);
X}
Xint gettlscript(am)
XAM *am;
X{
X TLPtr tl;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X mywarning("tl not found\n");
X push(mystrcpy(""),am);
X return;
X }
X }
X free(str);
X push(cflatten(tl_get_script(tl)),am);
X}
Xint gettlbgtext(am)
XAM *am;
X{
X TLPtr tl;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X mywarning("tl not found\n");
X push(mystrcpy(""),am);
X return;
X }
X }
X free(str);
X push(cflatten(tl_get_bgtext(tl)),am);
X}
Xint gettlcolor(am)
XAM *am;
X{
X TLPtr tl;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X mywarning("tl not found\n");
X push(mystrcpy(""),am);
X return;
X }
X }
X free(str);
X push(cflatten(tl_get_color(tl)),am);
X}
Xint getobjcolor(am)
XAM *am;
X{
X OBPtr obj;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str,am->ref);
X if (obj == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(object_get_color(obj)),am);
X}
Xint getobjscript(am)
XAM *am;
X{
X OBPtr obj;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str,am->ref);
X if (obj == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(object_get_script(obj)),am);
X}
Xint getobjlabel(am)
XAM *am;
X{
X OBPtr obj;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str,am->ref);
X if (obj == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(object_get_label(obj)),am);
X}
Xint getobjname(am)
XAM *am;
X{
X OBPtr obj;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str,am->ref);
X if (obj == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(mystrcpy(object_get_name(obj)),am);
X}
Xint getitemform(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(item_get_form(it)),am);
X}
Xint getitemlabel(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(item_get_label(it)),am);
X}
Xint getitemdef(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(cflatten(item_get_def(it)),am);
X}
Xint getitemlux(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(int_to_string(item_get_lux(it)),am);
X}
Xint getitemluy(am)
XAM *am;
X{
X ITPtr it;
X char *str;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X free(str);
X push(int_to_string(item_get_luy(it)),am);
X}
X
X/*
X** FIX 8/16/88 declaration for itemval_ofitem
X*/
XContainer itemval_ofitem();
X
Xint getitemval(am)
XAM *am;
X{
X int n;
X char *str1;
X Container val;
X ITPtr it;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X it = item_ofpname(str1,am->ref);
X if (it == NULL) {
X mywarning("item not found");
X push(mystrcpy(""),am);
X return;
X }
X val = itemval_ofitem(am->ref,it);
X free(str1);
X if (val == NULL) {
X val = cnew_con();
X }
X push(cflatten(val),am);
X}
Xint getitemname(am)
XAM *am;
X{
X char *str;
X ITPtr it;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X push(mystrcpy(item_get_name(it)),am);
X}
Xint getitemtype(am)
XAM *am;
X{
X char *str;
X ITPtr it;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X it = item_ofpname(str,am->ref);
X if (it == NULL) {
X mywarning("item not found\n");
X push(mystrcpy(""),am);
X return;
X }
X push(int_to_string(item_get_type(it)),am);
X}
Xint returnval(am)
XAM *am;
X{
X int n;
X char *str1;
X GETNUMARGS;
X CHECKNUMARGS(1);
X am->status = (am->status | STAT_RETURN);
X str1 = pop(am);
X crewind(am->retval);
X cins_cur_chars(am->retval,str1,strlen(str1));
X push(mystrcpy(""),am);
X free(str1);
X}
Xint ask(am)
XAM *am;
X{
X int n;
X char *str1;
X char *str2;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X str2 = vis_dialogue(mystrcpy(str1));
X free(str1);
X if (str2 == NULL) {
X str2 = mystrcpy("");
X }
X push(mystrcpy(str2),am);
X}
Xint choose(am)
XAM *am;
X{
X int n;
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(3);
X str1 = pop(am);
X str2 = pop(am);
X str3 = pop(am);
X if (vis_choose(str3,str2,str1) == 0) {
X free(str1);
X push(str2,am);
X } else {
X free(str2);
X push(str1,am);
X }
X free(str3);
X}
X
Xint my_menu(am)
XAM *am;
X{
X int n;
X char *str1;
X char *str2;
X Container c1,c2;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X c1 = cnew_constring(str1);
X c2 = (show_recur_menu(cnew_constring(str1)));
X cdestroy(c1);
X free(str1);
X str2 = cflatten(c2);
X cdestroy(c2);
X if (str2 == NULL) {
X str2 = mystrcpy("");
X }
X push(mystrcpy(str2),am);
X}
X/*
X** FIX declaration for show_multi_selec
X*/
XContainer show_multi_selec();
X
Xint my_multi_select(am)
XAM *am;
X{
X int n;
X char *str1;
X char *str2;
X Container c1,c2;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X c1 = cnew_constring(str1);
X c2 = (show_multi_selec(cnew_constring(str1)));
X cdestroy(c1);
X free(str1);
X str2 = cflatten(c2);
X cdestroy(c2);
X if (str2 == NULL) {
X str2 = mystrcpy("");
X }
X push(mystrcpy(str2),am);
X}
Xint truestring(str)
Xchar *str;
X{
X if ((strlen(str) == 0) || (strcmp(str,"false") == 0)) {
X return 0;
X } else {
X return 1;
X }
X}
Xint ifcode(am)
XAM *am;
X{
X char *str;
X int tpc,fpc,npc;
X tpc = (int) am->code[am->pc++];
X fpc = (int) am->code[am->pc++];
X npc = (int) am->code[am->pc++];
X execute(am,am->pc,am->status);
X str = pop(am);
X
X if (truestring(str)) {
X execute(am,tpc,am->status);
X am->pc = npc;
X free(str);
X return;
X } else {
X if (fpc != 0) {
X execute(am,fpc,am->status);
X }
X am->pc = npc;
X free(str);
X return;
X }
X}
X
Xint popoff(am)
XAM *am;
X{
X free(pop(am));
X}
Xint breakcode(am)
XAM *am;
X{
X if (am->status & STAT_IN_LOOP) {
X am->status = am->status | STAT_BREAK;
X }
X}
Xint contcode(am)
XAM *am;
X{
X if (am->status & STAT_IN_LOOP) {
X am->status = am->status | STAT_CONT;
X }
X}
Xint forcode(am)
XAM *am;
X{
X char *str;
X int initpc,exprpc,updatepc,bodypc,exitpc;
X initpc = am->pc;
X exprpc = (int) am->code[am->pc++];
X updatepc = (int) am->code[am->pc++];
X bodypc = (int) am->code[am->pc++];
X exitpc = (int) am->code[am->pc++];
X execute(am,initpc+4,am->status);
X execute(am,exprpc,am->status);
X str = pop(am);
X while (truestring(str)) {
X am->status = am->status | STAT_IN_LOOP;
X execute(am,bodypc,am->status | STAT_IN_LOOP);
X am->status = am->status & ~STAT_CONT;
X if (am->status & STAT_BREAK) {
X break;
X }
X execute(am,updatepc,am->status);
X free(pop(am));
X execute(am,exprpc,am->status);
X free(str);
X str = pop(am);
X }
X am->status = am->status & STAT_RETURN;
X am->pc = exitpc;
X free(str);
X return;
X}
Xint whilecode(am)
XAM *am;
X{
X char *str;
X int blpc,spc,npc;
X blpc = (int) am->code[am->pc++];
X npc = (int) am->code[am->pc++];
X spc = am->pc;
X am->status = am->status | STAT_IN_LOOP;
X execute(am,spc,am->status);
X str = pop(am);
X while (truestring(str)) {
X am->status = am->status | STAT_IN_LOOP;
X execute(am,blpc,am->status | STAT_IN_LOOP);
X am->status = am->status & ~STAT_CONT;
X if (am->status & STAT_BREAK) {
X break;
X }
X execute(am,spc,am->status);
X free(str);
X str = pop(am);
X }
X am->status = 0;
X am->pc = npc;
X free(str);
X return;
X}
X
Xint assign(am)
XAM *am;
X{
X char *str;
X int index;
X index = (int) am->code[am->pc++];
X str = pop(am);
X crewind(am->locals[index]);
X ctrunc(am->locals[index]);
X cins_cur_chars(am->locals[index],str,strlen(str));
X push(str,am);
X}
Xint preincr(am)
XAM *am;
X{
X char *str;
X int index;
X double x,atof();
X
X index = (int) am->code[am->pc++];
X str = cflatten(am->locals[index]);
X x = atof(str) + 1;
X free(str);
X sprintf(buff,"%g\0",x);
X str = mystrcpy(buff);
X cdestroy(am->locals[index]);
X am->locals[index] = cnew_constring(str);
X push(str,am);
X}
Xint predecr(am)
XAM *am;
X{
X char *str;
X int index;
X double x,atof();
X
X index = (int) am->code[am->pc++];
X str = cflatten(am->locals[index]);
X x = atof(str) - 1;
X free(str);
X sprintf(buff,"%g\0",x);
X str = mystrcpy(buff);
X cdestroy(am->locals[index]);
X am->locals[index] = cnew_constring(str);
X push(str,am);
X}
Xint postincr(am)
XAM *am;
X{
X char *str;
X int index;
X double x,atof();
X
X index = (int) am->code[am->pc++];
X str = cflatten(am->locals[index]);
X push(str,am);
X x = atof(str) + 1;
X sprintf(buff,"%g\0",x);
X cdestroy(am->locals[index]);
X str = mystrcpy(buff);
X am->locals[index] = cnew_constring(str);
X free(str);
X}
Xint postdecr(am)
XAM *am;
X{
X char *str;
X int index;
X double x,atof();
X
X index = (int) am->code[am->pc++];
X str = cflatten(am->locals[index]);
X push(str,am);
X x = atof(str) - 1;
X sprintf(buff,"%g\0",x);
X cdestroy(am->locals[index]);
X str = mystrcpy(buff);
X am->locals[index] = cnew_constring(str);
X free(str);
X}
X
Xint varvalue(am)
XAM *am;
X{
X char *str;
X int index;
X index = (int) am->code[am->pc++];
X str = cflatten(am->locals[index]);
X push(str,am);
X}
Xint numval(am)
XAM *am;
X{
X char *str;
X float f;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X f = atof(str);
X sprintf(buff,"%g\0",f);
X push(mystrcpy(buff),am);
X}
Xint andcmp(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X if (truestring(str2) && truestring(str1)) {
X str3 = "true";
X } else {
X str3 = "false";
X }
X free(str1);
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint orcmp(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X if (truestring(str2) || truestring(str1)) {
X str3 = "true";
X } else {
X str3 = "false";
X }
X free(str1);
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint mystrcmp(x,y)
Xchar *x,*y;
X{
X float f1,f2;
X if (is_a_number(x) && is_a_number(y)) {
X f1 = atof(x);
X f2 = atof(y);
X if ( f1 > f2)
X return 1;
X else if (f1 == f2)
X return 0;
X else if (f1 < f2)
X return -1;
X } else {
X return strcmp(x,y);
X }
X return strcmp(x,y);
X}
Xint ceqcmp(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X float f1,f2;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X if (mystrcmp(str1,str2) == 0) {
X str3 = "true";
X } else {
X str3 = "false";
X }
X free(str1);
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint neqcmp(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X if (mystrcmp(str2,str1) == 0) {
X str3 = "false";
X } else {
X str3 = "true";
X }
X free(str1);
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint ltcmp(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X if (mystrcmp(str1,str2) < 0) {
X str3 = "true";
X } else {
X str3 = "false";
X }
X free(str1);
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint gtcmp(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X if (mystrcmp(str1,str2) > 0) {
X str3 = "true";
X } else {
X str3 = "false";
X }
X free(str1);
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint ltoreqcmp(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X if (mystrcmp(str1,str2) <= 0) {
X str3 = "true";
X } else {
X str3 = "false";
X }
X free(str1);
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint gtoreqcmp(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X if (mystrcmp(str1,str2) >= 0) {
X str3 = "true";
X } else {
X str3 = "false";
X }
X free(str1);
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint notcmp(am)
XAM *am;
X{
X char *str1,*str3;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X if (!truestring(str1)) {
X str3 = "true";
X } else {
X str3 = "false";
X }
X free(str1);
X push(mystrcpy(str3),am);
X}
Xint stderrcom(am)
XAM *am;
X{
X char *str1;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X fprintf(stderr,"%s\n",str1);
X push(str1,am);
X}
Xint stdoutcom(am)
XAM *am;
X{
X char *str1;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X fprintf(stdout,"%s\n",str1);
X push(str1,am);
X}
Xint param(am)
XAM *am;
X{
X GETNUMARGS;
X CHECKNUMARGS(0);
X push(cflatten(am->param),am);
X}
Xint target(am)
XAM *am;
X{
X GETNUMARGS;
X CHECKNUMARGS(0);
X push(mystrcpy(am->otarg),am);
X}
Xint self(am)
XAM *am;
X{
X GETNUMARGS;
X CHECKNUMARGS(0);
X push(cflatten(am->self),am);
X}
Xint pass(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X OBPtr obj;
X TLPtr tl;
X ITPtr it;
X char *cur;
X char *target;
X Container cont,retval;
X GETNUMARGS;
X CHECKNUMARGS(0);
X str3 = pop(am);
X str2 = pop(am);
X str1 = pop(am);
X cont = cnew_constring(str3);
X obj = obj_ofpname(str2,am->ref);
X tl = temptl_ofpname(str2,am->ref);
X it = item_ofpname(str2,am->ref);
X if (obj == NULL) {
X free(str1);
X free(str2);
X free(str3);
X push(mystrcpy(""));
X return;
X }
X target = gen_itempname(it,obj,tl);
X retval = handler(obj,tl,it,str1,cont,target);
X free(str1);
X free(str2);
X free(str3);
X push(cflatten(retval),am);
X}
Xint delitem(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X item = item_ofpname(str,am->ref);
X if (item == NULL) {
X push(mystrcpy(""),am);
X mywarning("item not found\n");
X return;
X }
X tl_delete_item(tl,item);
X push(str,am);
X}
Xint copyitemtoCB(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X item = item_ofpname(str,am->ref);
X if (item == NULL) {
X push(mystrcpy(""),am);
X mywarning("item not found\n");
X return;
X }
X put_item_clipboard(item,NOT_ONLY_REF);
X push(str,am);
X}
Xint copytltoCB(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X put_tl_clipboard(tl,NOT_ONLY_REF);
X push(str,am);
X}
Xint copyobjtoCB(am)
XAM *am;
X{
X char *str;
X OBPtr obj;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str);
X if (obj == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X }
X put_object_clipboard(obj,NOT_ONLY_REF);
X push(str,am);
X}
Xint pasteitemfromCB(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X int n;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X item = (get_item_clipboard());
X if (item == NULL) {
X push(mystrcpy(""),am);
X return;
X }
X item = item_copy(item);
X n = tl_get_numitems(tl);
X tl_add_item(tl,item,n);
X push(mystrcpy(gen_itempname(item,tl_get_owner(tl),tl)),am);
X}
Xint pastetlfromCB(am)
XAM *am;
X{
X char *str;
X OBPtr obj;
X TLPtr tl;
X int n;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X obj = obj_ofpname(str);
X if (obj == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X }
X tl = (get_tl_clipboard());
X if (tl == NULL) {
X push(mystrcpy(""),am);
X return;
X }
X tl = tl_copy(tl);
X n = object_get_numtls(tl);
X object_add_tl(n,tl,obj);
X push(gen_absolute_tlpname(tl),am);
X}
Xint pastetreefromCB(am)
XAM *am;
X{
X char *str;
X OBPtr father;
X OBPtr obj;
X int n;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X father = obj_ofpname(str);
X if (father == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X }
X obj = (get_object_clipboard());
X if (obj == NULL) {
X push(mystrcpy(""),am);
X return;
X }
X obj = copy_tree(obj);
X n = object_get_numchild(father);
X object_add(obj,father,n);
X push(gen_absolute_pname(obj),am);
X}
Xint pasteobjfromCB(am)
XAM *am;
X{
X char *str;
X OBPtr father;
X OBPtr obj;
X int n;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X father = obj_ofpname(str);
X if (father == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X }
X obj = (get_object_clipboard());
X if (obj == NULL) {
X push(mystrcpy(""),am);
X return;
X }
X obj = copy_object(obj);
X n = object_get_numchild(father);
X object_add(obj,father,n);
X push(gen_absolute_pname(obj),am);
X}
Xint addbutton(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X item = new_item(HYPE_BUTTON,cnew_con(),tl);
X tl_add_item(tl,item,0);
X free(str);
X push(mystrcpy(gen_itempname(item,tl_get_owner(tl),tl)),am);
X}
Xint addtextsw(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X item = new_item(HYPE_TEXTSW,cnew_con(),tl);
X tl_add_item(tl,item,0);
X free(str);
X push(mystrcpy(gen_itempname(item,tl_get_owner(tl),tl)),am);
X}
Xint addtext(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X item = new_item(HYPE_TEXT,cnew_con(),tl);
X tl_add_item(tl,item,0);
X free(str);
X push(mystrcpy(gen_itempname(item,tl_get_owner(tl),tl)),am);
X}
Xint addslider(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X item = new_item(HYPE_SLIDER,cnew_con(),tl);
X tl_add_item(tl,item,0);
X free(str);
X push(mystrcpy(gen_itempname(item,tl_get_owner(tl),tl)),am);
X}
Xint addtoggle(am)
XAM *am;
X{
X char *str;
X TLPtr tl;
X ITPtr item;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X tl = temptl_ofpname(str,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str,am->ref);
X if (tl == NULL) {
X push(mystrcpy(""),am);
X mywarning("tl not found\n");
X return;
X }
X }
X item = new_item(HYPE_TOGGLE,cnew_con(),tl);
X tl_add_item(tl,item,0);
X free(str);
X push(mystrcpy(gen_itempname(item,tl_get_owner(tl),tl)),am);
X}
Xint makenewchild(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj,father;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X father = obj_ofpname(str1,am->ref);
X if (father == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X return;
X }
X str2 = mystrcat("newobj",obj_number());
X obj = new_object(str2,father);
X object_add(obj,father,0);
X push(str2,am);
X}
Xint makenewsibling(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj,father;
X int n;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X return;
X }
X father = object_get_owner(obj);
X n = object_get_numchild(obj);
X obj = copy_object(obj);
X object_set_name(obj,mystrcat("copyof",object_get_name(obj)));
X object_add(obj,father,n);
X push(gen_absolute_pname(obj),am);
X}
Xint delobject(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj,father;
X int i,n;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X obj = obj_ofpname(str1,am->ref);
X if (obj == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X return;
X }
X n = object_get_numchild(obj);
X delete_object(obj);
X push(str1,am);
X}
Xint copyobjecttoCB(am)
XAM *am;
X{
X char *str1,*str2;
X OBPtr obj,father;
X int i,n;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X father = obj_ofpname(str1,am->ref);
X if (father == NULL) {
X mywarning("obj not found\n");
X push(mystrcpy(""),am);
X return;
X }
X put_object_clipboard(father,NOT_ONLY_REF);
X push(str1,am);
X}
Xint iamnumchars(am)
XAM *am;
X{
X char *str;
X Container cont;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X cont = cnew_constring(str);
X sprintf(buff,"%g\0",(float) clength(cont));
X push(mystrcpy(buff),am);
X}
Xint iamnumwords(am)
XAM *am;
X{
X char *str;
X Container cont;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X cont = cnew_constring(str);
X sprintf(buff,"%g\0",(float) cget_numwords(cont));
X push(mystrcpy(buff),am);
X}
Xint iamnumlines(am)
XAM *am;
X{
X char *str;
X Container cont;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X cont = cnew_constring(str);
X sprintf(buff,"%g\0",(float) cget_numlines(cont));
X push(mystrcpy(buff),am);
X}
Xint iamnumclauses(am)
XAM *am;
X{
X char *str;
X Container cont;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X cont = cnew_constring(str);
X sprintf(buff,"%g\0",(float) cget_numitems(cont));
X push(mystrcpy(buff),am);
X}
Xint nthword(am)
XAM *am;
X{
X char *str,*str2;
X Container bs;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str = pop(am);
X bs = cnew_constring(str);
X push(cget_nth_word(bs,atoi(str2)),am);
X free(str2);
X cdestroy(bs);
X}
Xint nthchar(am)
XAM *am;
X{
X char *str,*str2;
X int n;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str = pop(am);
X n = atoi(str2);
X if (n >= strlen(str)) {
X n = strlen(str)-1;
X }
X buff[0] = str[n];
X buff[1] = '\0';
X push(mystrcpy(buff),am);
X free(str2);
X}
Xint nthitem(am)
XAM *am;
X{
X char *str,*str2;
X Container bs;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str = pop(am);
X bs = cnew_constring(str);
X push(cget_nth_item(bs,atoi(str2)),am);
X free( str2 );
X cdestroy(bs);
X}
Xint nthline(am)
XAM *am;
X{
X char *str,*str2;
X Container bs;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str = pop(am);
X bs = cnew_constring(str);
X push(cget_nth_line(bs,atoi(str2)),am);
X free(str2);
X cdestroy(bs);
X}
Xint mysubstring(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X int first,last,n,i;
X char x[4096*4];
X GETNUMARGS;
X CHECKNUMARGS(3);
X str3 = pop(am);
X str2 = pop(am);
X str1 = pop(am);
X first = atoi(str2);
X last = atoi(str3);
X n = strlen(str1);
X if ((last < first) || (last > n)) {
X push(mystrcpy(""),am);
X return;
X }
X for (i = first; i <= last; i++) {
X x[i-first] = str1[i];
X }
X x[last+1] = '\0';
X free(str1);
X free(str2);
X free(str3);
X push(mystrcpy(x),am);
X}
Xint iamstrlen(am)
XAM *am;
X{
X char *str;
X float f;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str = pop(am);
X f = (float) strlen(str);
X sprintf(buff,"%g\0",f);
X push(mystrcpy(buff),am);
X}
Xint fillinformat(aptr,fptr,dptr)
Xchar *aptr,**fptr,*dptr;
X{
X char x[256];
X int i;
X i = 0;
X while (!(isalpha(**fptr)) || (**fptr == 'l')) {
X x[i] = (**fptr);
X i++;
X (*fptr)++;
X }
X x[i] = (**fptr);
X
X/* for now we will only allow the s coded format */
X x[i] = 's';
X i++;
X (*fptr)++;
X x[i++] = '%';
X x[i++] = 'c';
X x[i++] = '\0';
X sprintf(aptr,x,dptr,'\0');
X return strlen(aptr);
X}
Xint sformat(am)
XAM *am;
X{
X char *format,*data;
X char answer[256];
X char *aptr;
X int i;
X int micro;
X int safe;
X GETNUMARGS;
X safe = numargs;
X if (numargs == 0) {
X mywarning("not enough args to sprintf\n");
X push(mystrcpy(""),am);
X return;
X }
X aptr = answer;
X micro = am->stackcntr - numargs;
X numargs--;
X format = am->stack[micro++];
X while (*format != '\0') {
X if (*format == '%') {
X if (numargs == 0) {
X mywarning("not enough args to sprintf\n");
X push(mystrcpy(""),am);
X return;
X }
X data = am->stack[am->stackcntr - numargs--];
X i = fillinformat(aptr,&format,data);
X aptr += i;
X
X } else {
X *aptr = *format;
X aptr++;
X format++;
X }
X }
X *aptr = '\0';
X for (i = 0; i <safe; i++) {
X free(pop(am));
X }
X push(mystrcpy(answer),am);
X}
Xint mygetenv(am)
XAM *am;
X{
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X str2 = (char *) getenv(str1);
X free(str1);
X if (str2 == NULL) {
X str2 = "";
X }
X push(mystrcpy(str2),am);
X}
Xint getglob(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X str2 = mystrcat(glob_recognizer,str1);
X str3 = (char *) getenv(str2);
X free(str1);
X if (str3 == NULL) {
X str3 = "";
X }
X free(str2);
X push(mystrcpy(str3),am);
X}
Xint mysetenv(am)
XAM *am;
X{
X char *str1,*str2;
X GETNUMARGS;
X CHECKNUMARGS(1);
X str1 = pop(am);
X putenv(str1);
X push(str1,am);
X}
Xint setglob(am)
XAM *am;
X{
X char *str1,*str2,*str3,*str4;
X GETNUMARGS;
X CHECKNUMARGS(2);
X str2 = pop(am);
X str1 = pop(am);
X str3 = mystrcat(glob_recognizer,str1);
X str4 = mystrcat(str3,"=");
X free(str3);
X str3 = mystrcat(str4,str2);
X putenv(str3);
X push(str2,am);
X free(str1);
X free(str4);
X}
Xint send(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X OBPtr obj;
X TLPtr tl;
X ITPtr it;
X char *cur;
X char *target;
X Container cont,retval;
X GETNUMARGS;
X CHECKNUMARGS(3);
X str3 = pop(am);
X str2 = pop(am);
X str1 = pop(am);
X cont = cnew_constring(str3);
X obj = obj_ofpname(str2,am->ref);
X if (obj == NULL) {
X free(str1);
X free(str2);
X free(str3);
X push(mystrcpy(""),am);
X return;
X }
X tl = temptl_ofpname(str2,am->ref);
X if (tl == NULL) {
X tl = tl_ofpname(str2,am->ref);
X }
X it = item_ofpname(str2,am->ref);
X target = gen_itempname(it,obj,tl);
X retval = handler(obj,tl,it,str1,cont,target);
X free(str1);
X free(str2);
X free(str3);
X push(cflatten(retval),am);
X}
Xint broadsend(am)
XAM *am;
X{
X char *str1,*str2,*str3;
X OBPtr obj;
X TLPtr tl;
X ITPtr it;
X char *cur;
X char *target;
X Container cont,retval;
X GETNUMARGS;
X CHECKNUMARGS(3);
X str3 = pop(am);
X str2 = pop(am);
X str1 = pop(am);
X cont = cnew_constring(str3);
X obj = obj_ofpname(str2,am->ref);
X if (obj == NULL) {
X free(str1);
X free(str2);
X free(str3);
X push(mystrcpy(""),am);
X return;
X }
X broadcast(obj,str1,cont);
X free(str1);
X free(str2);
X free(str3);
X cdestroy(cont);
X push(mystrcpy(""),am);
X}
X
SHAR_EOF
if test 53762 -ne "`wc -c < 'iam.c'`"
then
echo shar: error transmitting "'iam.c'" '(should have been 53762 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'iam.h'" '(676 characters)'
if test -f 'iam.h'
then
echo shar: will not over-write existing file "'iam.h'"
else
sed 's/^ X//' << \SHAR_EOF > 'iam.h'
X
X
X
Xint numstring();
Xint qstring();
Xint ifcode();
Xint unixcom();
Xint opencom();
Xint popoff();
Xint whilecode();
Xint forcode();
Xint assign();
Xint varvalue();
Xint objectget();
Xint andcmp();
Xint orcmp();
Xint ceqcmp();
Xint notcmp();
Xint neqcmp();
Xint ltcmp();
Xint gtcmp();
Xint ltoreqcmp();
Xint gtoreqcmp();
Xint stderrcom();
Xint returnval();
Xint param();
Xint nop();
Xint concat();
Xint plus();
Xint minus();
Xint mynegate();
Xint times();
Xint divide();
Xint numval();
Xint nthword();
Xint nthchar();
Xint nthitem();
Xint nhtline();
Xint getitemscript();
Xint setitemscript();
Xint breakcode();
Xint contcode();
Xint postincr();
Xint preincr();
Xint postdecr();
Xint predecr();
X
Xvoid *executescript();
SHAR_EOF
if test 676 -ne "`wc -c < 'iam.h'`"
then
echo shar: error transmitting "'iam.h'" '(should have been 676 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'map.c'" '(1715 characters)'
if test -f 'map.c'
then
echo shar: will not over-write existing file "'map.c'"
else
sed 's/^ X//' << \SHAR_EOF > 'map.c'
X#include "util.h"
X
X#define MAP_QUANTA 5
X
X
Xtypedef struct pmapnode {
X int numalloc;
X int num;
X void **map;
X} Map,*MapPtr;
X
X
XMapPtr make_map()
X{
X MapPtr temp;
X temp = (MapPtr) malloc(sizeof(Map) * 1);
X temp->numalloc = 0;
X temp->num = 0;
X temp->map = NULL;
X return temp;
X}
X
Xvoid unmake_map(map)
XMapPtr map;
X{
X if (map->map != NULL) {
X free(map->map);
X }
X free(map);
X}
X
Xint map_get_size(map)
XMapPtr map;
X{
X return map->num;
X}
X
Xvoid *map_get_nth(n,map)
Xint n;
XMapPtr map;
X{
X if (n >= map->num) {
X mywarning("asked for one to big\n");
X return NULL;
X }
X return map->map[n];
X}
Xvoid add_to_map(ord,ptr,map)
XMapPtr map;
Xint ord;
Xvoid *ptr;
X{
X void **temp;
X int i;
X if (ord > map->num) {
X ord = map->num;
X }
X map->num++;
X
X/* if needed, stuff map into a new, larger segment */
X if (map->num > map->numalloc) {
X map->numalloc += MAP_QUANTA;
X temp = (void **) malloc(sizeof(char **) * map->numalloc);
X for (i = 0; i < map->numalloc - MAP_QUANTA; i++) {
X temp[i] = map->map[i];
X }
X for (i = map->numalloc - MAP_QUANTA; i < map->numalloc; i++) {
X temp[i] = NULL;
X }
X if (map->map != NULL) {
X free(map->map);
X }
X map->map = temp;
X }
X
X/* insert data at point specified by ord */
X for (i = map->num - 2; i >= ord; i--) {
X map->map[i+1] = map->map[i];
X }
X map->map[ord] = ptr;
X}
X
X
Xvoid del_from_map(ord,imap)
Xint ord;
XMapPtr imap;
X{
X int i;
X
X if (ord >= imap->num) {
X mywarning("Tried to delete non-existent item\n");
X ord = imap->num-1;
X }
X
X/* delete and reorder map */
X for (i = ord + 1; i <= imap->num-1; i++) {
X imap->map[i-1] = imap->map[i];
X }
X imap->num--;
X imap->map[imap->num] = NULL;
X}
SHAR_EOF
if test 1715 -ne "`wc -c < 'map.c'`"
then
echo shar: error transmitting "'map.c'" '(should have been 1715 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'map.h'" '(105 characters)'
if test -f 'map.h'
then
echo shar: will not over-write existing file "'map.h'"
else
sed 's/^ X//' << \SHAR_EOF > 'map.h'
X
Xtypedef void *MapPtr;
X
XMapPtr make_map();
X
Xvoid unmake_map();
X
Xvoid add_to_map();
X
Xvoid del_from_map();
SHAR_EOF
if test 105 -ne "`wc -c < 'map.h'`"
then
echo shar: error transmitting "'map.h'" '(should have been 105 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'mfile.c'" '(5663 characters)'
if test -f 'mfile.c'
then
echo shar: will not over-write existing file "'mfile.c'"
else
sed 's/^ X//' << \SHAR_EOF > 'mfile.c'
X#include <stdio.h>
X#include "../../src/util.h"
X#define MAGIC 327
X#define BUFFSIZE 32
X#define CHECK_MAGIC(x) if (x->magic != MAGIC) { \
X char *y; \
X y = (char *) 57; \
X fprintf(stderr,"Bad magic number to mfile.\n"); \
X fprintf(stderr,"%s\n",y); \
X}
X
Xtypedef struct blk {
X char contents[BUFFSIZE];
X struct blk *next;
X} Block,*BlockPtr;
X
Xtypedef struct mfile {
X int magic;
X long length;
X long curr;
X BlockPtr firstbloc;
X BlockPtr curbloc;
X BlockPtr lastbloc;
X} MFILE;
X
X
XBlockPtr new_bloc()
X{
X BlockPtr temp;
X temp = (BlockPtr) malloc(sizeof(Block) * 1);
X if (temp == NULL) {
X fprintf(stderr,"Out of memory for memory file.\n");
X }
X temp->next = NULL;
X}
X
XMFILE *mfopen()
X{
X MFILE *temp;
X temp = (MFILE *) malloc(sizeof(MFILE) * 1);
X if (temp == NULL) {
X fprintf(stderr,"Out of memory for memory file.\n");
X }
X temp->length = 0;
X temp->magic = MAGIC;
X temp->curr = 0;
X temp->firstbloc = NULL;
X temp->curbloc= NULL;
X temp->lastbloc= NULL;
X return temp;
X}
Xlong mflength(file)
XMFILE *file;
X{
X CHECK_MAGIC(file);
X return file->length;
X}
Xstatic void dealloc_blocs(bloc)
XBlockPtr bloc;
X{
X if (bloc == NULL) {
X return;
X } else {
X dealloc_blocs(bloc->next);
X free(bloc);
X }
X}
Xvoid mfclose(file)
XMFILE *file;
X{
X CHECK_MAGIC(file);
X dealloc_blocs(file->firstbloc);
X free(file);
X}
X
Xint mfgetc(file)
XMFILE *file;
X{
X int c;
X CHECK_MAGIC(file);
X if (file->curr == file->length) {
X return EOF;
X }
X c = file->curbloc->contents[file->curr % BUFFSIZE];
X file->curr++;
X if (file->curr % BUFFSIZE == 0) {
X file->curbloc = file->curbloc->next;
X }
X return c;
X}
Xint mfungetc(file)
XMFILE *file;
X{
X mfseek(file,-1,1);
X}
Xint mfputc(file,c)
XMFILE *file;
Xchar c;
X{
X CHECK_MAGIC(file);
X if (file->lastbloc == NULL) {
X file->firstbloc = new_bloc();
X file->lastbloc = file->firstbloc;
X file->curbloc = file->firstbloc;
X }
X if (file->curbloc == NULL) {
X file->lastbloc->next = new_bloc();
X file->lastbloc = file->lastbloc->next;
X file->curbloc = file->lastbloc;
X }
X file->curbloc->contents[file->curr % BUFFSIZE] = (char) c;
X file->curr++;
X if ((file->curr % BUFFSIZE) == 0) {
X file->curbloc = file->curbloc->next;
X }
X if (file->curr > file->length) {
X file->length = file->curr;
X }
X return c;
X}
Xint mfinsert(file,ptr,bytes)
XMFILE *file;
Xchar *ptr;
Xint bytes;
X{
X char *temp;
X long buffsize;
X long curspot;
X CHECK_MAGIC(file);
X curspot = mfseek(file,0,1);
X buffsize = mfseek(file,0,2) - curspot;
X temp = (char *) malloc(sizeof(char) * buffsize);
X mfseek(file,curspot,0);
X mfread(file,temp,buffsize);
X mfseek(file,curspot,0);
X mfwrite(file,ptr,bytes);
X mfwrite(file,temp,buffsize);
X free(temp);
X return bytes;
X}
Xvoid mftrunc(file)
XMFILE *file;
X{
X CHECK_MAGIC(file);
X if (file->curbloc == NULL) {
X return;
X }
X dealloc_blocs(file->curbloc->next);
X file->curbloc->next = NULL;
X file->lastbloc = file->curbloc;
X file->length = file->curr;
X}
Xint mfdelete(file,bytes)
XMFILE *file;
Xint bytes;
X{
X char *temp;
X long buffsize;
X long curspot;
X CHECK_MAGIC(file);
X curspot = mfseek(file,0,1);
X buffsize = mfseek(file,0,2) - curspot - bytes;
X temp = (char *) malloc(sizeof(char) * buffsize);
X mfseek(file,curspot+bytes,0);
X mfread(file,temp,buffsize);
X mfseek(file,curspot,0);
X mfwrite(file,temp,buffsize);
X mfseek(file,curspot+buffsize,0);
X mftrunc(file);
X return bytes;
X}
Xint mfwrite(file,ptr,bytes)
XMFILE *file;
Xchar *ptr;
Xint bytes;
X{
X int written;
X CHECK_MAGIC(file);
X written = 0;
X if (bytes <= 0) {
X return 0;
X }
X if (file->lastbloc == NULL) {
X file->firstbloc = new_bloc();
X file->lastbloc = file->firstbloc;
X file->curbloc = file->firstbloc;
X file->curbloc->contents[file->curr++] = ptr[written++];
X }
X while (written != bytes) {
X if (file->curbloc == NULL) {
X file->lastbloc->next = new_bloc();
X file->lastbloc = file->lastbloc->next;
X file->curbloc = file->lastbloc;
X }
X file->curbloc->contents[file->curr % BUFFSIZE] = ptr[written++];
X file->curr++;
X if (file->curr % BUFFSIZE == 0) {
X file->curbloc = file->curbloc->next;
X }
X }
X if (file->length < file->curr) {
X file->length = file->curr;
X }
X return written;
X}
X
Xint mfread(file,ptr,bytes)
XMFILE *file;
Xchar *ptr;
Xint bytes;
X{
X int read = 0;
X CHECK_MAGIC(file);
X if (bytes <= 0) {
X return read;
X }
X while (read != bytes) {
X if ((file->curbloc == NULL) || (file->curr == file->length)){
X return read;
X }
X ptr[read++] = file->curbloc->contents[file->curr % BUFFSIZE];
X file->curr++;
X if ((file->curr % BUFFSIZE) == 0) {
X file->curbloc = file->curbloc->next;
X }
X }
X return read;
X}
X
X
Xlong mfseek(file,offset,origin)
XMFILE *file;
Xlong offset;
Xint origin;
X{
X long newval;
X int i;
X CHECK_MAGIC(file);
X switch (origin) {
X case 0:
X file->curr = offset;
X break;
X case 1:
X file->curr = file->curr + offset;
X break;
X case 2:
X file->curr = file->length + offset;
X break;
X }
X if (file->curr < 0) {
X file->curr = 0;
X }
X file->curbloc = file->firstbloc;
X if (file->lastbloc == NULL) {
X file->firstbloc = new_bloc();
X file->lastbloc = file->firstbloc;
X file->curbloc = file->firstbloc;
X }
X for (i = 0; i < (file->curr / BUFFSIZE); i++) {
X if (file->curbloc == NULL) {
X file->lastbloc->next = new_bloc();
X file->curbloc = file->lastbloc->next;
X file->lastbloc = file->lastbloc->next;
X }
X file->curbloc = file->curbloc->next;
X }
X if (file->curr > file->length) {
X file->length = file->curr;
X }
X return file->curr;
X}
SHAR_EOF
if test 5663 -ne "`wc -c < 'mfile.c'`"
then
echo shar: error transmitting "'mfile.c'" '(should have been 5663 characters)'
fi
fi # end of overwriting check
echo shar: done with directory "'src'"
cd ..
# End of shell archive
exit 0