home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume10 / logo / part02 / procvars.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-23  |  6.9 KB  |  309 lines
  1.  
  2. /*    This file contains stuff about user procedure calls and
  3. * variable assignment and lookup.
  4. *
  5. *    Copyright (C) 1979, The Children's Museum, Boston, Mass.
  6. *    Written by Douglas B. Klunder
  7. */
  8.  
  9. #include "logo.h"
  10. extern struct plist *pcell;
  11. extern int *stkbase;
  12. extern int stkbi;
  13. extern int *newstk;
  14. extern int newsti;
  15. extern int argno;
  16. extern int yylval;
  17. extern int yychar;
  18. extern short yyerrflag;
  19. static struct alist *globvars;
  20. extern struct stkframe *fbr;
  21. extern struct plist *proclist;
  22. extern struct alist *locptr;
  23. extern struct alist *newloc;
  24.  
  25. struct alist *loclk1();
  26. struct alist *look1();
  27. struct object *look();
  28.  
  29. go(linenum)    /* LOGO go */
  30. register struct object *linenum;
  31. {
  32.     register struct lincell *lptr;
  33.     register numline;
  34.  
  35.     if (pcell==NULL) {    /* not in procedure */
  36.         printf("Go can only be used within a procedure.\n");
  37.         errhand();
  38.     }
  39.     linenum = numconv(linenum,"Go");
  40.     if (!intp(linenum)) ungood("Go",linenum);
  41.     numline = linenum->obint;
  42.     mfree(linenum);
  43. /*    Search for saved line no. */
  44.     for (lptr=pcell->plines;lptr;lptr=lptr->nextline) {
  45.         if (lptr->linenum==numline)
  46.         {    /* line found, so adjust pseudo-code
  47.             * pointers to continue execution at
  48.             * right place
  49.             */
  50.             stkbase=lptr->base;
  51.             stkbi=lptr->index;
  52.             return;
  53.         }
  54.     }
  55.     /* no match */
  56.     printf("There is no line %d.\n",numline);
  57.     errhand();
  58. }
  59.  
  60. char *lowcase(name)
  61. register char *name;
  62. {
  63.     static char result[100];
  64.     register char c,*str;
  65.  
  66.     str = result;
  67.     while (c = *name++) {
  68.         if (c >= 'A' && c <= 'Z') c += 040;
  69.         *str++ = c;
  70.     }
  71.     *str = '\0';
  72.     return(result);
  73. }
  74.  
  75. struct object *lnamep(name)    /* namep */
  76. register struct object *name;
  77. {    /* check for both local and global definitions */
  78.     register char *nstr;
  79.  
  80.     if (!stringp(name)) ungood("Namep",name);
  81.     nstr = lowcase(name->obstr);
  82.     if (loclk1(nstr) || look1(nstr)) {
  83.         mfree(name);
  84.         return(true());
  85.     }
  86.     mfree(name);
  87.     return(false());
  88. }
  89.  
  90. loccreate(varname,lptr)        /* create new local variable cell, with name
  91.                 * but without value */
  92. register struct object *varname;
  93. register struct alist **lptr;
  94. {
  95.     register struct alist *temp1,*temp2;
  96.     char ch,*str;
  97.  
  98.     if (pcell==NULL) {    /* not in procedure */
  99.         printf("Local can only be used within a procedure.\n");
  100.         errhand();
  101.     }
  102.     if (!stringp(varname)) ungood("Local",varname);
  103.     str = lowcase(varname->obstr);
  104.     if ((ch = str[0]) == '\0') {
  105.         printf("Variable name can't be empty.\n");
  106.         errhand();
  107.     }
  108.     if (ch<'a' || ch>'z') {
  109.         printf("Variable name %s must start with a letter.\n",
  110.                 varname->obstr);
  111.         errhand();
  112.     }
  113.     if (*lptr==NULL) {    /* first cell */
  114.         *lptr=(temp1=(struct alist *)ckzmalloc(sizeof(*temp1)));
  115.     } else {
  116.         for (temp1= *lptr;temp1;temp1=temp1->next) {
  117.             if (!strcmp(temp1->name->obstr,str))
  118.             {    /* name already present */
  119.                 nputs(varname->obstr);
  120.                 printf(" is already defined as a local variable.\n");
  121.                 errhand();
  122.             }
  123.             temp2=temp1;
  124.         }
  125.         /* create new cell at end of string */
  126.         temp2->next=(struct alist *)ckzmalloc(sizeof(*temp2));
  127.         temp1=temp2->next;
  128.     }
  129.     temp1->next=NULL;
  130.     temp1->name=globcopy(objcpstr(str));
  131.     temp1->val=(struct object *)-1;
  132.     lfree(varname);
  133. }
  134.  
  135. struct object *cmlocal(arg)
  136. struct object *arg;
  137. {
  138.     loccreate(globcopy(arg),&locptr);
  139.     mfree(arg);
  140.     return ((struct object *)(-1));
  141. }
  142.  
  143. struct alist *loclk2(str,lap)    /* look for local definition of variable
  144.                 * return cell pointer if found */
  145.         /* BH 5/19/81 was loclk1 but now subprocedure */
  146. register char *str;
  147. register struct alist *lap;
  148. {
  149.     while (lap) {
  150.         if (!strcmp(str,lap->name->obstr)) return(lap);
  151.         lap=lap->next;
  152.     }
  153.     return(NULL);
  154. }
  155.  
  156. struct alist *loclk1(str)    /* look for local definition of variable
  157.                  * WITH DYNAMIC SCOPE!! BH 5/19/81 */
  158. register char *str;
  159. {
  160.     register struct stkframe *skp;
  161.     register struct alist *lap;
  162.  
  163.     if (lap = loclk2(str,locptr)) return(lap);
  164.         /* found in innermost active procedure */
  165.     for (skp = fbr; skp; skp = skp->prevframe) {
  166.         /* else try other active procedures */
  167.         if (skp->loclist)
  168.             if ((lap = loclk2(str,skp->loclist)) != NULL)
  169.                 return(lap);
  170.     }
  171.     return(NULL);
  172. }
  173.  
  174. struct object *alllk(str)    /* return value of variable */
  175. register struct object *str;
  176. {    /* look both locally and globally */
  177.     register struct alist *ap;
  178.     register char *strnm;
  179.  
  180.     if (!stringp(str)) ungood("Thing",str);
  181.     strnm = lowcase(str->obstr);
  182.     if ((ap=loclk1(strnm))==NULL) return(look(str));
  183.     if (ap->val==(struct object *)-1) {
  184.         nputs(strnm);
  185.         puts(" has no value.");
  186.         errhand();
  187.     }
  188.     mfree(str);
  189.     return(localize(ap->val));
  190. }
  191.  
  192. newfr()        /* create new stack frame to accommodate procedure */
  193. {
  194.     register int *temp;
  195.  
  196.     temp=(int *)ckmalloc(PSTKSIZ*sizeof(int));
  197.     *temp=(int)newstk;
  198.     *(newstk+PSTKSIZ-1)=(int)temp;
  199.     newstk=temp;
  200.     newsti=1;
  201. }
  202.  
  203. struct plist *proclook(name)    /* check if procedure already in memory */
  204. register char *name;
  205. {
  206.     register struct plist *here;
  207.  
  208.     for (here=proclist;here;here=here->after)
  209.         if (!strcmp(name,here->procname->obstr)) return(here);
  210.     return(NULL);
  211. }
  212.  
  213. argassign(argval)    /* assign value to next unfilled input */
  214. register struct object *argval;
  215. {
  216.     register struct alist *temp1;
  217.  
  218.     for (temp1=newloc;temp1->val!=(struct object *)-1;temp1=temp1->next) {
  219.         if (!stringp(temp1->name)) {
  220.             printf("Argassign bug trap, newloc messed up.\n");
  221.             return;
  222.         }
  223.     }
  224.     temp1->val=globcopy(argval);
  225.     mfree(argval);
  226.     if (--argno==0) {    /* all inputs filled, so save unparsed token */
  227.         fbr->oldyyl=yylval;
  228.         fbr->oldyyc=yychar;
  229.         if (yyerrflag) return;
  230.         yychar= -1;
  231.     }
  232. }
  233.  
  234. assign(name,val)    /* make */
  235. register struct object *name,*val;
  236. {
  237.     register struct alist *ap;
  238.     register char *namestr;
  239.     char *tmp,ch;
  240.  
  241.     if (!stringp(name)) ungood("Make",name);
  242.     namestr = lowcase(name->obstr);
  243.     for(tmp=namestr;*tmp;tmp++){
  244.         if((*tmp<'a' || *tmp>'z') && (*tmp <'0' || *tmp>'9')
  245.                 && (*tmp != '.') && (*tmp != '_')) {
  246.             pf1("Cannot assign value to %l\n",name);
  247.             errhand();
  248.         }
  249.     }
  250.     if ((ap=loclk1(namestr))) {    /* local definition */
  251.         if (ap->val != (struct object *)-1) lfree(ap->val);
  252.         mfree(name);
  253.         ap->val=globcopy(val);
  254.         mfree(val);
  255.         return;
  256.     }
  257.     else if ((ap=look1(namestr))==0)
  258.     {    /* new variable, so allocate cell */
  259.         if ((ch = namestr[0]) == '\0') {
  260.             printf("Variable name can't be empty.\n");
  261.             errhand();
  262.         }
  263.         if (ch<'a' || ch>'z') {
  264.             printf("Variable name %s must start with a letter.\n",
  265.                     namestr);
  266.             errhand();
  267.         }
  268.         ap=(struct alist *)ckmalloc(sizeof(*ap));
  269.         ap->name = globcopy(objcpstr(namestr));
  270.         ap->next=globvars;
  271.         globvars=ap;
  272.         mfree(name);
  273.     } else {    /* old global definition */
  274.         lfree(ap->val);
  275.         mfree(name);
  276.     }
  277.     ap->val=globcopy(val);
  278.     mfree(val);
  279. }
  280.  
  281. struct object *look(str)    /* return value of globally defined variable */
  282. register struct object *str;
  283. {
  284.     register struct alist *ap;
  285.     register char *strtxt;
  286.  
  287.     if (!stringp(str)) ungood("Thing",str);
  288.     strtxt = lowcase(str->obstr);
  289.     ap=look1(strtxt);
  290.     if (ap==NULL) {
  291.         nputs(strtxt);
  292.         printf(" has no value.\n");
  293.         errhand();
  294.     }
  295.     mfree(str);
  296.     return(localize(ap->val));
  297. }
  298.  
  299. struct alist *look1(str)    /* return pointer to right variable cell */
  300. register char *str;
  301. {
  302.     register struct alist *ap;
  303.  
  304.     for(ap=globvars; ap != 0; ap=ap->next)
  305.         if (!strcmp(str,ap->name->obstr)) return(ap);
  306.     return(0);
  307. }
  308.  
  309.