lang/basic/src/basic.lex

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  */
   5
   6 #ifndef NORSCID
   7 static char rcs_lex[] = "$Id: basic.lex,v 1.3 1994/06/24 11:30:28 ceriel Exp $" ;
   8 #endif
   9
  10 /* This file contains the new lexical analizer */
  11 typedef struct {
  12         char *name;
  13         int token, classvalue,length;
  14 } Key;
  15
  16 Key keywords [] ={
  17 "abs",          FUNCTION,       ABSSYM,         0,
  18 "and",          ANDSYM,         ANDSYM,         0,
  19 "asc",          FUNCTION,       ASCSYM,         0,
  20 "as",            ASSYM,         0,              0,
  21 "atn",          FUNCTION,       ATNSYM,         0,
  22 "auto",         ILLEGAL,        0,              0,
  23 "base",         BASESYM,        0,              0,
  24 "call",         CALLSYM,        0,              0,
  25 "cdbl",         FUNCTION,       CDBLSYM,        0,
  26 "chain",        ILLEGAL,        0,              0,
  27 "chr",          FUNCTION,       CHRSYM,         0,
  28 "cint",         FUNCTION,       CINTSYM,        0,
  29 "clear",        CLEARSYM,       0,              0,
  30 "cload",        ILLEGAL,        0,              0,
  31 "close",        CLOSESYM,       0,              0,
  32 "common",       ILLEGAL,        0,              0,
  33 "cont",         ILLEGAL,        0,              0,
  34 "cos",          FUNCTION,       COSSYM,         0,
  35 "csng",         FUNCTION,       CSNGSYM,        0,
  36 "csave",        ILLEGAL,        0,              0,
  37 "cvi",          FUNCTION,       CVISYM,         0,
  38 "cvs",          FUNCTION,       CVSSYM,         0,
  39 "cvd",          FUNCTION,       CVDSYM,         0,
  40 "data",         DATASYM,        0,              0,
  41 "defint",       DEFINTSYM,      0,              0,
  42 "defsng",       DEFSNGSYM,      0,              0,
  43 "defdbl",       DEFDBLSYM,      0,              0,
  44 "defstr",       DEFSTRSYM,      0,              0,
  45 "def",          DEFSYM,         0,              0,
  46 "delete",       ILLEGAL,        0,              0,
  47 "dim",          DIMSYM,         0,              0,
  48 "edit",         ILLEGAL,        0,              0,
  49 "else",         ELSESYM,        0,              0,
  50 "end",          ENDSYM,         0,              0,
  51 "eof",          FUNCTION,       EOFSYM,         0,
  52 "eqv",          EQVSYM,         EQVSYM,         0,
  53 "erase",        ILLEGAL,        0,              0,
  54 "error",        ERRORSYM,       0,              0,
  55 "err",          ERRSYM,         0,              0,
  56 "erl",          ERLSYM,         0,              0,
  57 "exp",          FUNCTION,       EXPSYM,         0,
  58 "field",        FIELDSYM,       0,              0,
  59 "fix",          FUNCTION,       FIXSYM,         0,
  60 "for",          FORSYM,         0,              0,
  61 "fre",          FUNCTION,       FRESYM,         0,
  62 "get",          GETSYM,         0,              0,
  63 "gosub",        GOSUBSYM,       0,              0,
  64 "goto",         GOTOSYM,        0,              0,
  65 "hex",          FUNCTION,       HEXSYM,         0,
  66 "if",           IFSYM,          0,              0,
  67 "imp",          IMPSYM,         IMPSYM,         0,
  68 "inkey",        INKEYSYM,       0,              0,
  69 "input",        INPUTSYM,       0,              0,
  70 "inp",          FUNCTION,       INPSYM,         0,
  71 "instr",        FUNCTION,       INSTRSYM,       0,
  72 "int",          FUNCTION,       INTSYM,         0,
  73 "kill",         ILLEGAL,        0,              0,
  74 "left",         FUNCTION,       LEFTSYM,        0,
  75 "len",          FUNCTION,       LENSYM,         0,
  76 "let",          LETSYM,         0,              0,
  77 "line",         LINESYM,        0,              0,
  78 "list",         LISTSYM,        0,              0,
  79 "llist",        ILLEGAL,        0,              0,
  80 "load",         LOADSYM,        0,              0,
  81 "loc",          FUNCTION,       LOCSYM,         0,
  82 "log",          FUNCTION,       LOGSYM,         0,
  83 "lpos",         FUNCTION,       LPOSSYM,        0,
  84 "lprint",       ILLEGAL,        0,              0,
  85 "lset",         LSETSYM,        0,              0,
  86 "merge",        MERGESYM,       0,              0,
  87 "mid",          MIDSYM,         0,              0,
  88 "mki",          FUNCTION,       MKISYM,         0,
  89 "mks",          FUNCTION,       MKSSYM,         0,
  90 "mkd",          FUNCTION,       MKDSYM,         0,
  91 "mod",          MODSYM,         0,              0,
  92 "name",         ILLEGAL,        0,              0,
  93 "new",          ILLEGAL,        0,              0,
  94 "next",         NEXTSYM,        0,              0,
  95 "not",          NOTSYM,         0,              0,
  96 "null",         ILLEGAL,        0,              0,
  97 "on",           ONSYM,          0,              0,
  98 "oct",          FUNCTION,       OCTSYM,         0,
  99 "open",         OPENSYM,        0,              0,
 100 "option",       OPTIONSYM,      0,              0,
 101 "or",           ORSYM,          ORSYM,          0,
 102 "out",          FUNCTION,       OUTSYM,         0,
 103 "peek",         PEEKSYM,        0,              0,
 104 "poke",         POKESYM,        0,              0,
 105 "print",        PRINTSYM,       0,              0,
 106 "pos",          FUNCTION,       POSSYM,         0,
 107 "put",          PUTSYM,         0,              0,
 108 "randomize",    RANDOMIZESYM,   0,              0,
 109 "read",         READSYM,        0,              0,
 110 "rem",          REMSYM,         0,              0,
 111 "renum",        ILLEGAL,        0,              0,
 112 "ren",          ILLEGAL,        0,              0,
 113 "restore",      RESTORESYM,     0,              0,
 114 "resume",       ILLEGAL,        0,              0,
 115 "return",       RETURNSYM,      0,              0,
 116 "right",        FUNCTION,       RIGHTSYM,       0,
 117 "rnd",          FUNCTION,       RNDSYM,         0,
 118 "run",          ILLEGAL,        0,              0,
 119 "save",         ILLEGAL,        0,              0,
 120 "step",         STEPSYM,        0,              0,
 121 "sgn",          FUNCTION,       SGNSYM,         0,
 122 "sin",          FUNCTION,       SINSYM,         0,
 123 "space",        FUNCTION,       SPACESYM,       0,
 124 "spc",          FUNCTION,       SPCSYM,         0,
 125 "sqr",          FUNCTION,       SQRSYM,         0,
 126 "stop",         STOPSYM,        0,              0,
 127 "string",       FUNCTION,       STRINGSYM,      0,
 128 "str",          FUNCTION,       STRSYM,         0,
 129 "swap",         SWAPSYM,        0,              0,
 130 "tab",          FUNCTION,       TABSYM,         0,
 131 "tan",          FUNCTION,       TANSYM,         0,
 132 "then",         THENSYM,        0,              0,
 133 "to",           TOSYM,          0,              0,
 134 "tron",         TRONOFFSYM,     TRONSYM,        0,
 135 "troff",        TRONOFFSYM,     TROFFSYM,       0,
 136 "using",        USINGSYM,       0,              0,
 137 "usr",          FUNCTION,       USRSYM,         0,
 138 "val",          FUNCTION,       VALSYM,         0,
 139 "varptr",       FUNCTION,       VARPTRSYM,      0,
 140 "wait",         ILLEGAL,        0,              0,
 141 "while",        WHILESYM,       0,              0,
 142 "wend",         WENDSYM,        0,              0,
 143 "width",        ILLEGAL,        0,              0,
 144 "write",        WRITESYM,       0,              0,
 145 "xor",          XORSYM,         XORSYM,         0,
 146 0,              0,              0,              0
 147 };
 148
 149 /* Keyword index table */
 150
 151 int     kex[27];
 152
 153 /* Initialize the keyword table */
 154 fillkex()
 155 {
 156         Key *k;
 157         int i;
 158         for(k=keywords;k->name;k++)
 159                 k->length= strlen(k->name);
 160         k=keywords;
 161         for(i=0;k->name && i<='z'-'a';i++)
 162         {
 163                 for(;k->name && *k->name<i+'a';k++);
 164                 if ( *k->name!=i+'a') continue;
 165                 kex[*k->name-'a']=k-keywords;
 166                 for(;k->name && *k->name==i+'a';k++);
 167                 kex[*(k-1)->name-'a'+1]=k-keywords;
 168         }
 169         if (debug)
 170         {
 171                 for(i=0;i<27;i++)
 172                 print("%c:%d\n",'a'+i,kex[i]);
 173         }
 174 }
 175
 176 #include <ctype.h>
 177
 178 /* Get each line separately into the buffer */
 179 /* Lines too long are terminated and flagged illegal */
 180
 181 #define MAXLINELENGTH   1024
 182
 183 char    inputline[MAXLINELENGTH];       /* current source line */
 184 char    *cptr;                          /* next character to decode */
 185 int     yylineno=0;                     /* source line counter */
 186
 187 #define GETSBUFSIZE 1024
 188
 189 char fgets_buf[GETSBUFSIZE];
 190
 191
 192
 193 char *our_fgets(buffer,n_char,stream)
 194 char *buffer;
 195 int n_char;
 196 File *stream;
 197 {
 198     /* Read one line or n_char */
 199     static int characters_left = 0;
 200     static char *internal_bufp = fgets_buf;
 201     char *external_bufp;
 202
 203     external_bufp = buffer;  /* Moves through the external buffer */
 204     while ( 1 ) {
 205         if ( characters_left ) { /* There is still something buffered */
 206             if ( n_char > 1 ) { /* More characters have to be copied  */
 207                 if ( *internal_bufp == '\n' ) {
 208                     *external_bufp++ = *internal_bufp++;
 209                     characters_left--;
 210                     *external_bufp = '\0';
 211                     return(buffer); /* One line is read */
 212                 } else {
 213                     *external_bufp++ = *internal_bufp++;
 214                     characters_left--;
 215                     n_char--;  /* One character is copied */
 216                 }
 217             } else { /* Enough characters read */
 218                 *external_bufp = '\0';
 219                 return(buffer);
 220             }
 221         } else { /* Read new block */
 222             sys_read(stream,fgets_buf,GETSBUFSIZE,&characters_left);
 223             internal_bufp = fgets_buf;
 224                 /* Move pointer  back to the beginning */
 225             if ( characters_left == 0 ) { /* Nothing read */
 226                 if ( external_bufp == buffer ) {
 227                     *external_bufp = '\0';
 228                     return(0);  /* EOF */
 229                 } else { /* Something was already copied */
 230                     *external_bufp = '\0';
 231                     return(buffer);
 232                 }
 233             }
 234         }
 235     }
 236 }
 237
 238 extern char *strindex();
 239
 240 getline()
 241 {
 242         /* get next input line */
 243
 244         if ( our_fgets(inputline,MAXLINELENGTH,yyin) == 0)
 245                 return(FALSE);
 246         yylineno ++;
 247         if ( strindex(inputline,'\n') == 0)
 248                 error("source line too long");
 249         inputline[MAXLINELENGTH-1]=0;
 250         if ( listing)
 251                 fprint(STDERR, inputline);
 252         cptr= inputline;
 253         return(TRUE);
 254 }
 255
 256
 257
 258
 259
 260 typechar()
 261 {
 262         switch(*cptr)
 263         {
 264         case '$':
 265                 cptr++; return( STRINGTYPE);
 266         case '%':
 267                 cptr++; return( INTTYPE);
 268         case '!':
 269                 cptr++; return( FLOATTYPE);
 270         case '#':
 271                 cptr++; return( DOUBLETYPE);
 272         }
 273         return(0);
 274 }
 275
 276
 277 /* symbols in Microsoft are significant for the first 40 characters */
 278 #define SIGNIFICANT 40
 279 char name[SIGNIFICANT+1];
 280
 281
 282 lookup()
 283 {
 284         Key *k;
 285         Symbol *Sym;
 286         char *c;
 287         int i, typech;
 288
 289         sval= name;
 290         for(c=cptr; *c && isalnum(*c);c++)
 291         if ( isupper(*c) )
 292                 *c= tolower(*c);
 293         for (k= keywords+kex[*cptr-'a']; k->name != 0 && *(k->name)== *cptr;k++)
 294                 if ( strncmp(cptr,k->name,k->length)==0)
 295                 {
 296                         /* if ( isalnum( *(cptr+k->length) )) *//* EHB */
 297                         if ( isalnum( *(cptr+k->length) ) &&    /* EHB */
 298                                 k->token == FUNCTION)           /* EHB */
 299                                 continue;
 300                                 /* keywords door delimiters gescheiden */
 301                         cptr += k->length;
 302                         yylval.integer= k->classvalue;
 303                         if (debug) print("lookup:%d %d\n",
 304                                          k->classvalue,k->token);
 305                         if ( k->token == FUNCTION)
 306                         {
 307                                 /* stripp type character */
 308                                 typech=typechar();
 309                         }
 310                                 /* illegals + rem */
 311                                 if ( k->token == REMSYM || k->token==ILLEGAL)
 312                                         while ( *cptr && *cptr!=':' &&
 313                                                 *cptr!='\n')
 314                                                 cptr++;
 315                                 return( k->token);
 316                 }
 317         /* Is it  a function  name ? */
 318         c=cptr;
 319         /* Identifier found, update the symbol table */
 320         i=0;
 321         while (( isalnum(*c) || *c == '.') && i < SIGNIFICANT)
 322                 name[i++]= *c++;
 323         while (isalnum(*c) || *c == '.') c++; /* skip rest */
 324         name[i]=0;
 325         cptr=c;
 326         Sym= srchsymbol(name);
 327         yylval.Sptr = Sym;
 328         typech= typechar();
 329         if (Sym->symtype!=DEFAULTTYPE)
 330         {
 331                 if (typech && typech!=Sym->symtype && wflag)
 332                         warning("type re-declared,ignored");
 333         }
 334         if ( typech)
 335                 Sym->symtype=typech;
 336         if (debug) print("lookup:%d Identifier\n",Sym);
 337         if ( (name[0]=='f' || name[0]=='F') &&
 338              (name[1]=='n' || name[1]=='N') )
 339                 return(FUNCTID);
 340         return(IDENTIFIER);
 341 }
 342
 343
 344
 345 /* Parsing unsigned numbers */
 346 readconstant()
 347 {
 348         /* read HEX and OCTAL numbers */
 349         char *c;
 350         cptr++;
 351         if ( *cptr == 'H' || *cptr=='h')
 352         {
 353                 /* HEX */
 354                 cptr++;
 355                 c=cptr;
 356                 while (  isdigit(*cptr) ||
 357                         (*cptr>='a' && *cptr<='f' ) ||
 358                         (*cptr>='A' && *cptr<='F' ) ) cptr++;
 359                 (void) sscanf(c,"%x",&ival);
 360         } else
 361         if ( *cptr == 'O' || *cptr == 'o')
 362         {
 363                 /* OCTAL */
 364                 cptr++;
 365                 c=cptr;
 366                 while ( isdigit(*cptr) ) cptr++;
 367                 (void) sscanf(c,"%o",&ival);
 368         } else error("H or O expected");
 369         return(INTVALUE);
 370 }
 371
 372
 373
 374 #ifdef ____
 375 /* Computes base to the power exponent. This was not done in the old
 376    compiler                                                          */
 377 double powr(base,exp)
 378 double base;
 379 int exp;
 380 {
 381         int i;
 382         double result;
 383         int abs_exp;
 384
 385         if ( exp < 0 )
 386                 abs_exp = -exp;
 387         else
 388                 abs_exp = exp;
 389
 390         result = 1.0;
 391         for ( i = 1; i <= abs_exp; i++ ) {
 392                 result = result * base;
 393         }
 394
 395         if ( exp < 0 )
 396                 return ( 1.0 / result );
 397         else
 398                 return ( result );
 399 }
 400 #endif
 401
 402
 403 number()
 404 {
 405         long    i1;
 406         int overflow = 0;
 407         register char *c;
 408         static char     numbuf[256];
 409         register char *d = numbuf;
 410
 411         dval = numbuf;
 412         i1=0;
 413         c=cptr;
 414         while (*c == '0') c++;
 415         while (isdigit(*c)){
 416                 i1= i1*10 + *c-'0';
 417                 if (i1 < 0) overflow = 1;
 418                 if (d < &numbuf[255]) *d++ = *c;
 419                 c++;
 420         }
 421         if (d == numbuf) *d++ = '0';
 422         cptr=c;
 423         if ( *c != '.'  && *c != 'e' && *c != 'E'
 424                         && *c != 'd' && *c != 'D' ){
 425                 if ( i1> MAXINT || i1<MININT || overflow) {
 426                         *d = 0;
 427                         return(FLTVALUE);
 428                 }
 429                 /*NOSTRICT*/ ival= i1;
 430 #ifdef YYDEBUG
 431                 if (yydebug) print("number:INTVALUE %d",i1);
 432 #endif
 433                 return(INTVALUE);
 434         }
 435         /* handle floats */
 436         if (*c == '.') {
 437                 if (d < &numbuf[255]) *d++ = *c;
 438                 c++;
 439                 while ( isdigit(*c)){
 440                         if (d < &numbuf[255]) *d++ = *c;
 441                         c++;
 442                 }
 443         }
 444         /* handle exponential part */
 445         if ( *c == 'e' || *c == 'E' || *c == 'd' || *c == 'D' ){
 446                 if (d < &numbuf[254]) *d++ = 'e';
 447                 c++;
 448                 if ( *c=='-' || *c=='+') {
 449                         if (d < &numbuf[255]) *d++ = *c;
 450                         c++;
 451                 }
 452                 while (isdigit(*c)){
 453                         if (d < &numbuf[255]) *d++ = *c;
 454                         c++;
 455                 }
 456                 if (*(d-1) == 'e') *d++ = '0';
 457         }
 458         *d = 0;
 459         cptr=c;
 460 #ifdef YYDEBUG
 461         if (yydebug) print("number:FLTVALUE %s",dval);
 462 #endif
 463         return(FLTVALUE);
 464 }
 465
 466
 467
 468 /* Maximale grootte van een chunk; >= 4 */
 469 #define CHUNKSIZE 123
 470
 471
 472
 473 scanstring()
 474 {
 475         int i,length=0;
 476         char firstchar = *cptr;
 477         char buffer[CHUNKSIZE],*bufp = buffer;
 478
 479         /* generate label here */
 480         if (! in_data) yylval.integer= genemlabel();
 481         if ( *cptr== '"') cptr++;
 482         sval= cptr;
 483         while ( *cptr !='"')
 484         {
 485                 switch(*cptr)
 486                 {
 487                 case 0:
 488                 case '\n':
 489 #ifdef YYDEBUG
 490                         if (yydebug) print("STRVALUE\n");
 491 #endif
 492                         if ( firstchar == '"')
 493                                 error("non-terminated string");
 494                         return(STRVALUE);
 495                 /*
 496                 case '\'':
 497                 case '\\':
 498                         *bufp++ = '\\';
 499                         *bufp++ = *cptr;
 500                         if ( bufp >= buffer + CHUNKSIZE - 4 ) {
 501                                 if (! in_data)
 502                                         C_con_scon(buffer,(arith)(bufp-buffer));
 503                                 bufp = buffer;
 504                         }
 505                         break;
 506                 */
 507                 default:
 508                         *bufp++ = *cptr;
 509                         if ( bufp >= buffer + CHUNKSIZE - 4 ) {
 510                                 if (! in_data)
 511                                         C_con_scon(buffer,(arith)(bufp-buffer));
 512                                 bufp = buffer;
 513                         }
 514                 }
 515                 cptr++;
 516                 length++;
 517         }
 518         *cptr = 0;
 519         *bufp++ = 0;
 520         cptr++;
 521         if (! in_data) {
 522                 C_con_scon(buffer,(arith)(bufp-buffer));
 523                 i=yylval.integer;
 524                 yylval.integer= genemlabel();
 525                 C_rom_dlb((label)i,(arith)0);
 526                 C_rom_icon("9999",(arith)BEMINTSIZE);
 527                 C_rom_icon(itoa(length),(arith)BEMINTSIZE);
 528         }
 529 #ifdef YYDEBUG
 530         if (yydebug) print("STRVALUE found\n");
 531 #endif
 532         return(STRVALUE);
 533 }
 534
 535
 536
 537 yylex()
 538 {
 539         char *c;
 540
 541         /* Here is the big switch */
 542         c= cptr;
 543         switch(*c){
 544                 case 'a': case 'b': case 'c': case 'd': case 'e':
 545                 case 'f': case 'g': case 'h': case 'i': case 'j':
 546                 case 'k': case 'l': case 'm': case 'n': case 'o':
 547                 case 'p': case 'q': case 'r': case 's': case 't':
 548                 case 'u': case 'v': case 'w': case 'x': case 'y':
 549                 case 'z': case 'A': case 'B': case 'C': case 'D':
 550                 case 'E': case 'F': case 'G': case 'H': case 'I':
 551                 case 'J': case 'K': case 'L': case 'M': case 'N':
 552                 case 'O': case 'P': case 'Q': case 'R': case 'S':
 553                 case 'T': case 'U': case 'V': case 'W': case 'X':
 554                 case 'Y': case 'Z': case '_':
 555                         return(lookup());
 556
 557                 case '0': case '1': case '2': case '3': case '4':
 558                 case '5': case '6': case '7': case '8': case '9':
 559                 case '.':
 560                         return(number());
 561
 562                 case '\'':
 563                         /* comment at end of line */
 564                         while ( *cptr != '\n' && *cptr) cptr++;
 565                 case '\n':
 566                         cptr++;
 567                         return(EOLN);
 568                 case 0:
 569 #ifdef YYDEBUG
 570                         if ( yydebug) print("end of buffer");
 571 #endif
 572                         return(0);
 573                 case '"':
 574                         return(scanstring());
 575                 /* handle double operators */
 576                 case ' ':
 577                 case '\t':
 578                         cptr++;
 579                         return(yylex());
 580                 case '&':
 581                         return(readconstant());
 582                 case '?':
 583                         cptr++;
 584                         return(PRINTSYM);
 585                 case '>':
 586                         if ( *(c+1)=='='){
 587                                 c++; c++;
 588                                 cptr=c;
 589                                 yylval.integer= GESYM;
 590                                 return(RELOP);
 591                         }
 592                         yylval.integer= '>';
 593                         cptr++;
 594                         return(RELOP);
 595                 case '<':
 596                         if ( *(c+1)=='='){
 597                                 c++; c++;
 598                                 cptr=c;
 599                                 yylval.integer=LESYM;
 600                                 return(RELOP);
 601                         } else
 602                                 if ( *(c+1)=='>'){
 603                                         c++; c++;
 604                                         cptr=c;
 605                                         yylval.integer=NESYM;
 606                                         return(RELOP);
 607                                 }
 608                         yylval.integer= '<';
 609                         cptr++;
 610                         return(RELOP);
 611         }
 612         return(*cptr++);
 613 }