Oakland CPM Archive/oakcpm.iso/cpm/misc/smc203.ark/CC21.C

Text File | 1983-07-28 | 6.1 KB | 334 lines

junk() {
  if(an(inbyte())) while(an(ch)) gch();
  else while(an(ch)==0) {
    if(ch==0) break;
    gch();
    }
  blanks();
  }

endst() {
  blanks();
  return ((streq(lptr,";")|(ch==0)));
  }

illname() {
  error("illegal symbol");
  junk();
  }

multidef(sname)  char *sname; {
  error("already defined");
  }

needtoken(str)  char *str; {
  if (match(str)==0) error("missing token");
  }

needlval() {
  error("must be lvalue");
  }

findglb(sname)  char *sname; {

#ifdef HASH
  if(search(sname, STARTGLB, SYMMAX, ENDGLB, NUMGLBS, NAME))
    return cptr;
#else /* HASH */
  cptr=STARTGLB;
  while(cptr < glbptr) {
    if(astreq(sname, cptr+NAME, NAMEMAX)) return cptr;
    cptr=nextsym(cptr);
    }
#endif /* HASH */

  return 0;
  }

findloc(sname)  char *sname;  {
  cptr = locptr - 1;  /* search backward for block locals */
  while(cptr > STARTLOC) {
    cptr = cptr - *cptr;
    if(astreq(sname, cptr, NAMEMAX)) return (cptr - NAME);
    cptr = cptr - NAME - 1;
    }
  return 0;
  }

addsym(sname, id, typ, value, lgptrptr, class)
  char *sname, id, typ;  int value, *lgptrptr, class; {
  if(lgptrptr == &glbptr) {
    if(cptr2=findglb(sname)) return cptr2;

#ifdef HASH
    if(cptr==0) {
      error("global symbol table overflow");
      return 0;
      }

#else /* HASH */

#ifndef DYNAMIC
    if(glbptr >= ENDGLB) {
      error("global symbol table overflow");
      return 0;
      }
#endif /* DYNAMIC */

    cptr = *lgptrptr;
#endif /* HASH */

    }
  else {
    if(locptr > (ENDLOC-SYMMAX)) {
      error("local symbol table overflow");
      abort(ERRCODE);
      }
    cptr = *lgptrptr;
    }
  cptr[IDENT]=id;
  cptr[TYPE]=typ;
  cptr[CLASS]=class;
  putint(value, cptr+OFFSET, OFFSIZE);
  cptr3 = cptr2 = cptr + NAME;
  while(an(*sname)) *cptr2++ = *sname++;

#ifdef HASH
  if(lgptrptr == &locptr) {
    *cptr2 = cptr2 - cptr3;         /* set length */
    *lgptrptr = ++cptr2;
    }
#else /* HASH */
  *cptr2 = cptr2 - cptr3;         /* set length */
  *lgptrptr = ++cptr2;

#ifdef DYNAMIC
  if(lgptrptr == &glbptr) alloc(cptr2 - cptr);
  /*  gets allocation error if no more memory  */
#endif /* DYNAMIC */

#endif /* HASH */

  return cptr;
  }

nextsym(entry) char *entry; {
  entry = entry + NAME;
  while(*entry++ >= ' '); /* find length byte */
  return entry;
  }

/*
** get integer of length len from address addr
** (byte sequence set by "putint")
*/
getint(addr, len) char *addr; int len; {
  int i;
  i = *(addr + --len);  /* high order byte sign extended */
  while(len--) i = (i << 8) | *(addr+len)&255;
  return i;
  }

/*
** put integer i of length len into address addr
** (low byte first)
*/
putint(i, addr, len) char *addr; int i, len; {
  while(len--) {
    *addr++ = i;
    i = i>>8;
    }
  }

/*
** test if next input string is legal symbol name
*/
symname(sname, ucase) char *sname; int ucase; {
  int k;char c;
  blanks();
  if(alpha(ch)==0) return 0;
  k=0;
  while(an(ch)) {

#ifdef UPPER
    if(ucase)
      sname[k]=upper(gch());
    else
#endif /* UPPER */

      sname[k]=gch();
    if(k<NAMEMAX) ++k;
    }
  sname[k]=0;
  return 1;
  }

/*
** force upper case alphabetics
*/
upper(c)  char c; {
  if((c >= 'a') & (c <= 'z')) return (c - 32);
  else return c;
  }

/*
** return next avail internal label number
*/
getlabel() {
  return(++nxtlab);
  }

/*
** post a label in the program
*/
postlabel(label) int label; {
  printlabel(label);
  col();
  nl();
  }

/*
** print specified number as a label
*/
printlabel(label)  int label; {
  outstr("CC");
  outdec(label);
  }

/*
** test if given character is alphabetic
*/
alpha(c)  char c; {
  return (((c>='a')&(c<='z'))|((c>='A')&(c<='Z'))|(c=='_'));
  }

/*
** test if given character is numeric
*/
numeric(c)  char c; {
  return((c>='0')&(c<='9'));
  }

/*
** test if given character is alphanumeric
*/
an(c)  char c; {
  return ((alpha(c))|(numeric(c)));
  }

addwhile(ptr)  int ptr[]; {
  int k;
  ptr[WQSP]=csp;           /* and stk ptr */
  ptr[WQLOOP]=getlabel();  /* and looping label */
  ptr[WQEXIT]=getlabel();   /* and exit label */
  if (wqptr==WQMAX) {
    error("too many active loops");
    abort(ERRCODE);
    }
  k=0;
  while (k<WQSIZ) *wqptr++ = ptr[k++];
  }

delwhile() {
  /*
  ** patched per DDJ
  */
  if(wqptr > wq) wqptr=wqptr-WQSIZ;
  }

readwhile(ptr)  int *ptr; {
  /*
  ** patched per DDJ
  */
  if (ptr <= wq) {
    error("out of context");
    return 0;
    }
  else return (ptr-WQSIZ);
 }

white() {
  /* test for stack/program overlap */
  /* primary -> symname -> blanks -> white */

#ifdef DYNAMIC
  /* CCAVAIL();   abort on stack/symbol table overflow */
#endif /* DYNAMIC */

  if(*lptr==' ') return 1;
  if(*lptr==9)   return 1;
  return 0;
  }

gch() {
  int c;
  if(c=ch) bump(1);
  return c;
  }

bump(n) int n; {
  if(n) lptr=lptr+n;
  else  lptr=line;
  if(ch = nch = *lptr) nch = *(lptr+1);
  }

kill() {
  *line=0;
  bump(0);
  }

inbyte()  {
  while(ch==0) {
    if (eof) return 0;
    preprocess();
    }
  return gch();
  }

inline() {
  int k,unit;
#ifdef FULLC
  char *xgets();
#endif  /* FULLC */

#ifdef POLL
  CCPOLL(1);  /* allow program interruption */
#endif /* POLL */

  while(1) {
    if (input == EOF) openin();
    if(eof) return;
    if((unit=input2) == EOF) unit=input;
    if(xgets(line, LINEMAX, unit)==NULL) {
      fclose(unit);
      if(input2 != EOF) input2 = EOF;
      else input = EOF;
      }
    else {
      bump(0);
      return;
      }
    }
  }

/*
 * special version of 'fgets' that deletes trailing '\n'
 */
#ifdef FULLC
char *
xgets(string, len, fd) char *string; int len, fd; {
#else  /* FULLC */
xgets(string, len, fd) char *string; int len, fd; {
#endif  /* FULLC */

  char c, *strptr;
  strptr = string;
  while ((((c = getc(fd)) ) != '\n') && (--len)) {
    if (c == EOF) return NULL;
    else *string++ = c ;  /* mask parity off */
    }
  *string = NULL;
  return strptr;
  }
σσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσ