This is procvars.m in view mode; [Download] [Up]
/* This file contains stuff about user procedure calls and
* variable assignment and lookup.
*
* Copyright (C) 1979, The Children's Museum, Boston, Mass.
* Written by Douglas B. Klunder
*/
#include "logo.h"
extern struct plist *pcell;
extern int *stkbase;
extern int stkbi;
extern int *newstk;
extern int newsti;
extern int argno;
extern int yylval;
extern int yychar;
extern short yyerrflag;
static struct alist *globvars;
extern struct stkframe *fbr;
extern struct plist *proclist;
extern struct alist *locptr;
extern struct alist *newloc;
struct alist *loclk1();
struct alist *look1();
struct object *look();
go(linenum) /* LOGO go */
register struct object *linenum;
{
register struct lincell *lptr;
register numline;
if (pcell==NULL) { /* not in procedure */
printf("Go can only be used within a procedure.\n");
errhand();
}
linenum = numconv(linenum,"Go");
if (!intp(linenum)) ungood("Go",linenum);
numline = linenum->obint;
mfree(linenum);
/* Search for saved line no. */
for (lptr=pcell->plines;lptr;lptr=lptr->nextline) {
if (lptr->linenum==numline)
{ /* line found, so adjust pseudo-code
* pointers to continue execution at
* right place
*/
stkbase=lptr->base;
stkbi=lptr->index;
return;
}
}
/* no match */
printf("There is no line %d.\n",numline);
errhand();
}
char *lowcase(name)
register char *name;
{
static char result[100];
register char c,*str;
str = result;
while (c = *name++) {
if (c >= 'A' && c <= 'Z') c += 040;
*str++ = c;
}
*str = '\0';
return(result);
}
struct object *lnamep(name) /* namep */
register struct object *name;
{ /* check for both local and global definitions */
register char *nstr;
if (!stringp(name)) ungood("Namep",name);
nstr = lowcase(name->obstr);
if (loclk1(nstr) || look1(nstr)) {
mfree(name);
return(true());
}
mfree(name);
return(false());
}
loccreate(varname,lptr) /* create new local variable cell, with name
* but without value */
register struct object *varname;
register struct alist **lptr;
{
register struct alist *temp1,*temp2;
char ch,*str;
if (pcell==NULL) { /* not in procedure */
printf("Local can only be used within a procedure.\n");
errhand();
}
if (!stringp(varname)) ungood("Local",varname);
str = lowcase(varname->obstr);
if ((ch = str[0]) == '\0') {
printf("Variable name can't be empty.\n");
errhand();
}
if (ch<'a' || ch>'z') {
printf("Variable name %s must start with a letter.\n",
varname->obstr);
errhand();
}
if (*lptr==NULL) { /* first cell */
*lptr=(temp1=(struct alist *)ckzmalloc(sizeof(*temp1)));
} else {
for (temp1= *lptr;temp1;temp1=temp1->next) {
if (!strcmp(temp1->name->obstr,str))
{ /* name already present */
nputs(varname->obstr);
printf(" is already defined as a local variable.\n");
errhand();
}
temp2=temp1;
}
/* create new cell at end of string */
temp2->next=(struct alist *)ckzmalloc(sizeof(*temp2));
temp1=temp2->next;
}
temp1->next=NULL;
temp1->name=globcopy(objcpstr(str));
temp1->val=(struct object *)-1;
lfree(varname);
}
struct object *cmlocal(arg)
struct object *arg;
{
loccreate(globcopy(arg),&locptr);
mfree(arg);
return ((struct object *)(-1));
}
struct alist *loclk2(str,lap) /* look for local definition of variable
* return cell pointer if found */
/* BH 5/19/81 was loclk1 but now subprocedure */
register char *str;
register struct alist *lap;
{
while (lap) {
if (!strcmp(str,lap->name->obstr)) return(lap);
lap=lap->next;
}
return(NULL);
}
struct alist *loclk1(str) /* look for local definition of variable
* WITH DYNAMIC SCOPE!! BH 5/19/81 */
register char *str;
{
register struct stkframe *skp;
register struct alist *lap;
if (lap = loclk2(str,locptr)) return(lap);
/* found in innermost active procedure */
for (skp = fbr; skp; skp = skp->prevframe) {
/* else try other active procedures */
if (skp->loclist)
if ((lap = loclk2(str,skp->loclist)) != NULL)
return(lap);
}
return(NULL);
}
struct object *alllk(str) /* return value of variable */
register struct object *str;
{ /* look both locally and globally */
register struct alist *ap;
register char *strnm;
if (!stringp(str)) ungood("Thing",str);
strnm = lowcase(str->obstr);
if ((ap=loclk1(strnm))==NULL) return(look(str));
if (ap->val==(struct object *)-1) {
nputs(strnm);
puts(" has no value.");
errhand();
}
mfree(str);
return(localize(ap->val));
}
newfr() /* create new stack frame to accommodate procedure */
{
register int *temp;
temp=(int *)ckmalloc(PSTKSIZ*sizeof(int));
*temp=(int)newstk;
*(newstk+PSTKSIZ-1)=(int)temp;
newstk=temp;
newsti=1;
}
struct plist *proclook(name) /* check if procedure already in memory */
register char *name;
{
register struct plist *here;
for (here=proclist;here;here=here->after)
if (!strcmp(name,here->procname->obstr)) return(here);
return(NULL);
}
argassign(argval) /* assign value to next unfilled input */
register struct object *argval;
{
register struct alist *temp1;
for (temp1=newloc;temp1->val!=(struct object *)-1;temp1=temp1->next) {
if (!stringp(temp1->name)) {
printf("Argassign bug trap, newloc messed up.\n");
return;
}
}
temp1->val=globcopy(argval);
mfree(argval);
if (--argno==0) { /* all inputs filled, so save unparsed token */
fbr->oldyyl=yylval;
fbr->oldyyc=yychar;
if (yyerrflag) return;
yychar= -1;
}
}
assign(name,val) /* make */
register struct object *name,*val;
{
register struct alist *ap;
register char *namestr;
char *tmp,ch;
if (!stringp(name)) ungood("Make",name);
namestr = lowcase(name->obstr);
for(tmp=namestr;*tmp;tmp++){
if((*tmp<'a' || *tmp>'z') && (*tmp <'0' || *tmp>'9')
&& (*tmp != '.') && (*tmp != '_')) {
pf1("Cannot assign value to %l\n",name);
errhand();
}
}
if ((ap=loclk1(namestr))) { /* local definition */
if (ap->val != (struct object *)-1) lfree(ap->val);
mfree(name);
ap->val=globcopy(val);
mfree(val);
return;
}
else if ((ap=look1(namestr))==0)
{ /* new variable, so allocate cell */
if ((ch = namestr[0]) == '\0') {
printf("Variable name can't be empty.\n");
errhand();
}
if (ch<'a' || ch>'z') {
printf("Variable name %s must start with a letter.\n",
namestr);
errhand();
}
ap=(struct alist *)ckmalloc(sizeof(*ap));
ap->name = globcopy(objcpstr(namestr));
ap->next=globvars;
globvars=ap;
mfree(name);
} else { /* old global definition */
lfree(ap->val);
mfree(name);
}
ap->val=globcopy(val);
mfree(val);
}
struct object *look(str) /* return value of globally defined variable */
register struct object *str;
{
register struct alist *ap;
register char *strtxt;
if (!stringp(str)) ungood("Thing",str);
strtxt = lowcase(str->obstr);
ap=look1(strtxt);
if (ap==NULL) {
nputs(strtxt);
printf(" has no value.\n");
errhand();
}
mfree(str);
return(localize(ap->val));
}
struct alist *look1(str) /* return pointer to right variable cell */
register char *str;
{
register struct alist *ap;
for(ap=globvars; ap != 0; ap=ap->next)
if (!strcmp(str,ap->name->obstr)) return(ap);
return(0);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.