home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src / ace / c / lex.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-10-04  |  26.2 KB  |  1,117 lines
  1. /* << ACE >>
  2.  
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Lexical Analyser **
  6.    ** Copyright (C) 1998 David Benn
  7.    ** 
  8.    ** This program is free software; you can redistribute it and/or
  9.    ** modify it under the terms of the GNU General Public License
  10.    ** as published by the Free Software Foundation; either version 2
  11.    ** of the License, or (at your option) any later version.
  12.    **
  13.    ** This program is distributed in the hope that it will be useful,
  14.    ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.    ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.    ** GNU General Public License for more details.
  17.    **
  18.    ** You should have received a copy of the GNU General Public License
  19.    ** along with this program; if not, write to the Free Software
  20.    ** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22.    Author: David J Benn
  23.      Date: 18th October-30th November, 1st-13th December 1991,
  24.            14th,20th,26th January 1992, 
  25.            2nd-17th, 23rd-24th February 1992,
  26.        21st April 1992,
  27.        7th,11th,13th June 1992,
  28.        2nd,3rd,4th,5th,8th,14th,15th,16th,19th,26th,28th,29th July 1992,
  29.        2nd,8th August 1992,
  30.        6th,22nd,27th-30th December 1992,
  31.        4th,5th,7th,19th,31st January 1993,
  32.        2nd,6th,11th-15th,19th,28th February 1993,
  33.        1st,24th March 1993,
  34.        12th,17th April 1993,
  35.        6th,13th June 1993,
  36.        1st,2nd,10th July 1993,
  37.        5th,26th September 1993,
  38.        15th November 1993,
  39.        14th,16th,17th,25th,26th December 1993,
  40.        2nd,5th,7th-9th January 1994,
  41.        7th,15th February 1994,
  42.        20th,22nd,28th August 1994,
  43.        4th,10th,11th September 1994,
  44.        7th August 1995,
  45.        6th October 1995,
  46.        10th March 1996,
  47.        11th June 1996,
  48.        4th September 1996
  49. */
  50.  
  51. #include "lexvar.c"
  52.  
  53. /* globals */
  54. ULONG     MathBase = NULL;
  55. ULONG     MathTransBase = NULL;
  56. ULONG    IntuitionBase = NULL;
  57. BOOL     inside_string = FALSE;    /* see last line of nextch() */
  58.  
  59. /* functions */
  60. void open_shared_libs()
  61. {
  62.  if ((MathBase = OpenLibrary("mathffp.library",0)) == NULL) 
  63.  {
  64.   printf("Unable to open mathffp.library!\n");
  65.   exit(10);
  66.  }
  67.  
  68.  if ((MathTransBase = OpenLibrary("mathtrans.library",0)) == NULL)
  69.  {
  70.   printf("Unable to open mathtrans.library!\n");
  71.   exit(10);
  72.  }
  73.  
  74.  if ((IntuitionBase = OpenLibrary("intuition.library",0)) == NULL)
  75.  {
  76.   printf("Unable to open intuition.library!\n");
  77.   exit(10);
  78.  }
  79. }
  80.  
  81. void close_shared_libs()
  82. {
  83.  if (IntuitionBase != NULL) CloseLibrary(MathTransBase);
  84.  if (MathTransBase != NULL) CloseLibrary(MathTransBase);
  85.  if (MathBase != NULL) CloseLibrary(MathBase);
  86. }
  87.  
  88. void setup()
  89. {
  90. int i;
  91.  
  92.  /* initialize nextch() variables */
  93.  column=linelen=-1; 
  94.  line[0]='\0';
  95.  
  96.  /* 
  97.  ** All id's default to singletype (A..Z + "_" 
  98.  ** with 4 bytes wasted between Z and "_").
  99.  */ 
  100.  for (i=0;i<=30;i++) idtype[i]=singletype; 
  101.  
  102.  /* libraries used by ACE */
  103.  strcpy(acelib[0].name,"DOS");
  104.  strcpy(acelib[0].base,"_DOSBase");
  105.  strcpy(acelib[1].name,"INTUITION");
  106.  strcpy(acelib[1].base,"_IntuitionBase");
  107.  strcpy(acelib[2].name,"GRAPHICS");
  108.  strcpy(acelib[2].base,"_GfxBase");
  109.  strcpy(acelib[3].name,"MATHFFP");
  110.  strcpy(acelib[3].base,"_MathBase");
  111.  strcpy(acelib[4].name,"MATHTRANS");
  112.  strcpy(acelib[4].base,"_MathTransBase");
  113.  strcpy(acelib[5].name,"TRANSLATOR");
  114.  strcpy(acelib[5].base,"_TransBase");
  115.  /* sentinel ACE library entry */
  116.  strcpy(acelib[6].name,"SENTINEL");
  117.  
  118.  /* make "other library" entries null */ 
  119.  for (i=0;i<NUMLIBS-1;i++)
  120.  {
  121.     otherlib[i].name[0] = '\0';
  122.     otherlib[i].base[0] = '\0';
  123.  }
  124.  /* sentinel for "other libraries" */
  125.  strcpy(otherlib[NUMLIBS-1].name,"SENTINEL");
  126.  
  127.  /* open error log? */
  128.  if (error_log)
  129.  {
  130.   err_log = fopen("ace.err","w");
  131.   if (err_log == NULL) 
  132.      { puts("Unable to open error log: ace.err!"); exit(10); }
  133.  }
  134. }
  135.  
  136. void cleanup()
  137. {
  138.  /* close files */
  139.  if (!std_in && src != NULL) fclose(src);
  140.  if (dest != NULL) fclose(dest);
  141.  if (err_log != NULL) fclose(err_log);
  142.  
  143.  free_alloc();
  144.  
  145.  close_shared_libs();
  146.  
  147.  /* exit with return value */
  148.  if (early_exit) exitvalue=10;
  149.  exit(exitvalue);
  150. }
  151.  
  152. void _warn(n)
  153. int n;
  154. {
  155. char *msg;
  156.  
  157.  printf("Warning: ");
  158.  if (error_log) fprintf(err_log,"Warning: ");
  159.  
  160.  switch(n)
  161.  {
  162.   case 0 : /* dummy */ break;
  163.   case 1 : msg="Exponent out of range"; break;
  164.  }
  165.  printf("%s",msg);
  166.  if (error_log) fprintf(err_log,"%s",msg);
  167.  printf(" in line %d.\n",lineno);
  168.  if (error_log) fprintf(err_log," in line %d.\n",lineno);
  169. }
  170.  
  171. void _error(n)
  172. int n;
  173. {
  174. int  i,spot,badline,length;
  175. char *msg;
  176.  
  177.  /* display an error and the line in which it occurs */
  178.  
  179.  if (!report_errors) return;    /* eg. see assem() in misc.c */
  180.  
  181.  if (n > 1 && n != 8)
  182.  {
  183.   if (n!=12 && n!=15 && n!=17 && n!=25 && n!=34 && 
  184.       n!=51 && n!=52 && n!=64 && n!=73)
  185.   {
  186.    /* show the offending line */
  187.    if (column != 0)
  188.    {
  189.     length=strlen(line);
  190.     if (length > 0) 
  191.     {
  192.      printf("\n%s\n",line); 
  193.      if (error_log) fprintf(err_log,"\n%s\n",line);
  194.      spot=column;
  195.     }
  196.     badline=lineno;
  197.    }
  198.    else
  199.    {
  200.     length=strlen(lastline);
  201.     if (length > 0) 
  202.     {
  203.      printf("\n%s\n",lastline);
  204.      if (error_log) fprintf(err_log,"\n%s\n",lastline); 
  205.      spot=length;
  206.     }
  207.     badline=lineno-1;
  208.    }
  209.      
  210.    if (length > 0)
  211.    {
  212.     /* point to the error */
  213.     for (i=1;i<spot;i++) { putchar(' '); if (error_log) fputc(' ',err_log); }
  214.     printf("^\n");
  215.     if (error_log) fprintf(err_log,"^\n");    
  216.    }
  217.  
  218.    /* ignore rest of line */
  219.    column=linelen;
  220.    ch=' ';   /* force a call to nextch() when insymbol() next invoked */
  221.   }
  222.   else
  223.   {
  224.    putchar('\n');
  225.    if (error_log) fputc('\n',err_log);
  226.    badline=lineno;
  227.   }
  228.  
  229.   printf("** ");
  230.   if (error_log) fprintf(err_log,"** ");
  231.  
  232.   if (!early_exit) early_exit=TRUE;
  233.  }
  234.  
  235.  switch(n)
  236.  {
  237.   case 0  : /* dummy */ break;
  238.   case 1  : msg="Unexpected end of source\n"; break;
  239.   case 2  : msg="Unknown symbol"; break;
  240.   case 3  : msg="Decimal digit expected"; break;
  241.   case 4  : msg="Type mismatch"; break;
  242.   case 5  : msg="'=' expected"; break;
  243.   case 6  : msg="Duplicate label"; break;
  244.   case 7  : msg="Identifier expected"; break;
  245.   case 8  : msg="\nUndefined label: "; break;
  246.   case 9  : msg="')' expected"; break;
  247.   case 10 : msg="Expression expected"; break;
  248.   case 11 : msg="IF without THEN"; break;
  249.   case 12 : msg="WHILE without WEND"; break;
  250.   case 13 : msg="Illegal expression"; break;
  251.   case 14 : msg="'(' expected"; break;
  252.   case 15 : msg="IF without END IF"; break;
  253.   case 16 : msg="',' expected"; break;
  254.   case 17 : msg="FOR without NEXT"; break;
  255.   case 18 : msg="String constant expected"; break;
  256.   case 19 : msg="Variable expected"; break;
  257.   case 20 : msg="'b' or 'bf' expected"; break;
  258.   case 21 : msg="'-' expected"; break;
  259.   case 22 : msg="Array already dimensioned"; break;
  260.   case 23 : msg="Illegal array index"; break;
  261.   case 24 : msg="Illegal use of identifier"; break;
  262.   case 25 : msg="READ without DATA"; break;
  263.   case 26 : msg="Constant expected"; break;
  264.   case 27 : msg="Numeric constant expected"; break;
  265.   case 28 : msg="Short integer array expected"; break;
  266.   case 29 : msg="Radius expected"; break;
  267.   case 30 : msg="No start angle specified"; break;
  268.   case 31 : msg="Illegal letter-range"; break;
  269.   case 32 : msg="Subprogram name expected"; break;
  270.   case 33 : msg="Duplicate subprogram/function name"; break;
  271.   case 34 : msg="SUB without END SUB"; break;
  272.   case 35 : msg="SUB expected"; break;
  273.   case 36 : msg="EXIT SUB illegal outside subprogram"; break;
  274.   case 37 : msg="CALL to undeclared subprogram"; break;
  275.   case 38 : msg="Parameter already declared"; break;
  276.   case 39 : msg="Parameter count mismatch"; break;
  277.   case 40 : msg="Object cannot be shared"; break;
  278.   case 41 : msg="Zero or negative string size"; break;
  279.   case 42 : msg="Too many parameters in SUB"; break;
  280.   case 43 : msg="Invalid object"; break;
  281.   case 44 : msg="'#' expected"; break;
  282.   case 45 : msg="Library already open"; break;
  283.   case 46 : msg="Library not open"; break;
  284.   case 47 : msg="FUNCTION expected"; break;
  285.   case 48 : msg="LIBRARY expected"; break;
  286.   case 49 : msg="Unknown library function"; break;
  287.   case 50 : msg="Can't open bmap file"; break;
  288.   case 51 : msg="REPEAT without UNTIL"; break;
  289.   case 52 : msg="CASE without END CASE"; break;
  290.   case 53 : msg="Unable to reassign a constant"; break;
  291.   case 54 : msg="Variable exists"; break;
  292.   case 55 : msg="Event specifier expected"; break;
  293.   case 56 : msg="GOSUB, GOTO or CALL expected"; break;
  294.   case 57 : msg="Label, line number or SUB name expected"; break;
  295.   case 58 : msg="ON, OFF or STOP expected"; break;
  296.   case 59 : msg="No event trapping label or SUB defined for this event"; break;
  297.   case 60 : msg="Identifier or Type expected"; break;
  298.   case 61 : msg="Duplicate structure member"; break;
  299.   case 62 : msg="Structure type already defined"; break; 
  300.   case 63 : msg="Member type declaration expected"; break;
  301.   case 64 : msg="STRUCT without END STRUCT"; break;
  302.   case 65 : msg="Unknown structure type"; break;
  303.   case 66 : msg="Structure already declared"; break;
  304.   case 67 : msg="Not a structure member"; break;
  305.   case 68 : msg="Unrecognised or incorrectly used command/function"; break;
  306.   case 69 : msg="SHARED can only be used inside a subprogram"; break;
  307.   case 70 : msg="FOR loop index cannot be a shared variable"; break;
  308.   case 71 : msg="Undefined function or array not dimensioned"; break;
  309.   case 72 : msg="AS expected"; break;
  310.   case 73 : msg="ASSEM without END ASSEM"; break;
  311.   case 74 : msg="Compiler directive expected"; break;
  312.   case 75 : msg="OPEN, CLOSE, READ, WRITE or NAME expected"; break;
  313.   case 76 : msg="Unable to open another library"; break;
  314.   case 77 : msg="OPEN, CLOSE, READ, WRITE, WAIT or CLEAR expected"; break;
  315.   case 78 : msg="An event trapping SUB may not have a parameter list"; break;
  316.   case 79 : msg="Structure variable expected"; break;
  317.   case 80 : msg="BLOCK without END BLOCK"; break;
  318.  }
  319.  
  320.  /* show the error */
  321.  printf("%s",msg);
  322.  if (error_log) fprintf(err_log,"%s",msg);
  323.  if (n > 1 && n != 8)
  324.  {
  325.   printf(" in line %d.\n",badline);
  326.   if (error_log) fprintf(err_log," in line %d.\n",badline);
  327.  }
  328.  
  329.  if (n != 0) errors++;
  330. }
  331.  
  332. void _abort(n)
  333. int n;
  334. {
  335.  _error(n);
  336.  printf("*** compilation aborted with %d error(s).\n",errors);
  337.  early_exit=TRUE;
  338.  kill_all_lists();
  339.  cleanup();
  340. }
  341.  
  342. void open_files(source)
  343. char *source;
  344. {
  345. int  cc;
  346. char *xtn;
  347.  
  348.  /* 
  349.  ** Open source file: allocate memory for extension in case required.
  350.  */
  351.  srcfile = (char *)alloc(strlen(source)+3,MEMF_ANY); /* 3 = 2*Xtn + EOS */
  352.  if (srcfile == NULL)
  353.  {
  354.   puts("can't allocate memory for source file name.");
  355.   early_exit=TRUE;
  356.   cleanup();
  357.  }
  358.  
  359.  /* copy source file name */
  360.  strcpy(srcfile,source);
  361.  
  362.  /* 
  363.  ** Does source file name already have an extension (.b or .bas)? 
  364.  ** If not, add one. 
  365.  */
  366.  cc=0;
  367.  while (srcfile[cc] && srcfile[cc] != '.') cc++;
  368.  
  369.  xtn = &srcfile[cc];
  370.  
  371.  /*
  372.  ** Allow an extension of ".bas",".BAS",
  373.  ** ".b" or ".B". If none is present -> append ".b".
  374.  */
  375.  if (strcmp(xtn,".bas") != 0 && strcmp(xtn,".BAS") != 0 && 
  376.      strcmp(xtn,".b") != 0 && strcmp(xtn,".B") != 0) 
  377.  strcat(srcfile,".b");
  378.  
  379.  /* open source file */
  380.  if ((src = fopen(srcfile,"r")) == NULL) 
  381.  { 
  382.   printf("can't open %s.\n",srcfile);
  383.   early_exit=TRUE;
  384.   cleanup();
  385.  }
  386.  
  387.  /* 
  388.  ** Open object file. 
  389.  */
  390.  destfile = (char *)alloc(strlen(srcfile)+1,MEMF_ANY);
  391.  if (destfile == NULL)
  392.  {
  393.   puts("can't allocate memory for object file name.");
  394.   early_exit=TRUE;
  395.   cleanup();
  396.  }
  397.  
  398.  /* copy source file name and change extension to ".s" */
  399.  cc=0;
  400.  while (srcfile[cc] != '.') { destfile[cc] = srcfile[cc]; cc++; }
  401.  destfile[cc] = '\0';
  402.  strcat(destfile,".s");
  403.  
  404.  /* open target file */
  405.  if ((dest = fopen(destfile,"w")) == NULL)
  406.  {
  407.   printf("can't write to %s.\n",destfile);
  408.   early_exit=TRUE;
  409.   cleanup();
  410.  }
  411. }
  412.  
  413. void nextch()
  414. /* character handler */
  415. {
  416. char lineno_buf[15], *tmp;
  417. int  i,n;
  418. BOOL continue_line;
  419.  
  420.  /* if user hits ctrl-c clean up and abort. */
  421.  if (SetSignal(0L,SIGBREAKF_CTRL_C) & SIGBREAKF_CTRL_C)
  422.  {
  423.   puts("\n*** Break: ACE terminating.");
  424.   early_exit=TRUE;
  425.   kill_all_lists();
  426.   cleanup();
  427.  }
  428.  
  429.  if (column == linelen)
  430.  {
  431.   strcpy(lastline,line);
  432.  
  433.   /* refill line buffer */
  434.   column = linelen = -1;
  435.  
  436.   do
  437.   {
  438.       line[++linelen]=(ch=getc(src));
  439.   }
  440.   while ((ch != '\n') && (ch != EOF) && (linelen < MAXLINELEN));
  441.  
  442.   /* next line of source code */
  443.   line[linelen] = '\0';
  444.  
  445.   /* 
  446.   ** !!! eoln for previous line [PRINT statement etc] !!! 
  447.   **
  448.   ** Having just refilled the line buffer means we've
  449.   ** run out of characters, so reached the eoln. The last
  450.   ** character was '\0' which will be treated as whitespace
  451.   ** but which is required for string literal parsing.
  452.   **
  453.   ** If the previous line's last non-whitespace character is '~' the line 
  454.   ** should be continued (ie. the eoln should be ignored) and the '~' 
  455.   ** character should be seen as whitespace.
  456.   **
  457.   ** Geez this whole EOLN thing is _messy_!!
  458.   */
  459.   tmp = lastline;
  460.   while (*tmp) tmp++;                 /* find EOS */
  461.   while (tmp > lastline && *tmp <= ' ') tmp--;    /* find '~' */
  462.   if (*tmp != '~') sym=endofline;
  463.  
  464.   /* advance line counter */  
  465.   lineno++;
  466.  
  467.   /* 
  468.   ** Check for EOF -> Due to some editors, last line may not have 
  469.   **               a LF, but parse it! Next time nextch() is called
  470.   **              EOF will be detected immediately. 
  471.   */
  472.   if (ch == EOF && linelen == 0)
  473.   {
  474.    if ((lineno == 0) && (linelen == 0)) _abort(1);
  475.    else
  476.        end_of_source = TRUE; 
  477.   }
  478.  
  479.   /* line count display */
  480.   if (!list_source && ((lineno % 10 == 0) || end_of_source))
  481.   {
  482.       n=lineno;
  483.       if (end_of_source && linelen == 0) --n;
  484.             printf("\rCompiling line %s",itoa(n,lineno_buf,10));
  485.       for (i=1;i<=strlen(lineno_buf);i++) putchar('\b');
  486.       fflush(stdout);
  487.   }
  488.  
  489.   if (!end_of_source)
  490.   {
  491.    /* use source code line as a comment? */
  492.    if (asm_comments) gen("; *** ",line,"  ");
  493.  
  494.    /* show each source code line before compilation? */
  495.    if (list_source) printf("%ld: %s\n",lineno,line);
  496.   }
  497.  }
  498.  
  499.  /* next character */
  500.  column++;
  501.  ut_ch = ch = line[column];
  502.  if (ch == '~' && !inside_string) ut_ch = ch = ' ';  /* '~' == whitespace */
  503. }
  504.  
  505. BOOL letter()
  506. {
  507.  if ((ch >= 'A') && (ch <= 'Z')) return(TRUE);
  508.  if ((ch >= 'a') && (ch <= 'z')) { ch -= 32; return(TRUE); }
  509.  return(FALSE);
  510. }
  511.  
  512. BOOL digit()
  513. {
  514.  if ((ch >= '0') && (ch <= '9')) return(TRUE);
  515.  else
  516.      return(FALSE);
  517. }
  518.  
  519. BYTE hex_digit()
  520. {
  521.  if ((ch >= '0') && (ch <= '9')) return(ch-'0');
  522.  letter(); /* make sure it's uppercase */
  523.  if ((ch >= 'A') && (ch <= 'F')) return(10+ch-'A');
  524.  return(-1);
  525. }
  526.  
  527. BYTE octal_digit()
  528. {
  529.  if ((ch >= '0') && (ch <= '7')) return(ch-'0');
  530.  return(-1);
  531. }
  532.  
  533. void convert_special_ident()
  534. {
  535. /* 
  536. ** If the current identifier is one of a special 
  537. ** group, modify it by prefixing an underscore.
  538. **
  539. ** This is a kludge to get around problems with
  540. ** certain names (eg: 68000 register names)
  541. ** which cause A68K to generate errors when
  542. ** encountered as labels. 
  543. */
  544. char chr0,chr1;
  545.  
  546.   chr0 = id[0];
  547.   chr1 = id[1];
  548.  
  549.   /* 
  550.   ** Address or data register name? (A0..A7, D0..D7 or SP)
  551.   ** If so -> convert to _Dn, _An or _SP.
  552.   */
  553.   if (((chr0 == 'A' || chr0 == 'D') &&
  554.        (chr1 >= '0' && chr1 <= '7' && id[2] == '\0')) ||
  555.       (chr0 == 'S' && chr1 == 'P' && id[2] == '\0'))
  556.   {
  557.     /* convert id */
  558.     id[3] = '\0';
  559.     id[2] = chr1;
  560.     id[1] = chr0;
  561.     id[0] = '_';
  562.   }   
  563. }
  564.  
  565. BOOL qualifier()
  566. {
  567.  /* - Attach a qualifier character (%&$!#).
  568.     - The default object (variable) can be overriden by
  569.       the later declaration of an array, subprogram etc.
  570.  */
  571.  
  572.  switch(ch)
  573.  {
  574.   case '$' : obj = variable;  typ = stringtype; return(TRUE);
  575.   case '%' : obj = variable;  typ = shorttype;  return(TRUE);  
  576.   case '&' : obj = variable;  typ = longtype;   return(TRUE);
  577.   case '!' : obj = variable;  typ = singletype; return(TRUE);
  578.   case '#' : obj = variable;  typ = singletype; return(TRUE);
  579.   default  : obj = undefined; typ = undefined;  return(FALSE);
  580.  }
  581. }
  582.  
  583. BOOL ssymbol()
  584. {
  585. int  i=0;
  586. BOOL found=FALSE;
  587.  
  588.  /* if (ch == '"') return(TRUE); */
  589.  while ((spec_sym[i] != '\0')&&(!found)) if (ch == spec_sym[i++]) found=TRUE;
  590.  return(found);
  591. }
  592.  
  593. int rsvd_wd(id)
  594. char *id;
  595. {
  596. BOOL found=FALSE;
  597. int first,last,this;
  598.  
  599.    /* search the reserved word
  600.       list using a binary search 
  601.       for AmigaBASIC and then ACE 
  602.       keywords.
  603.    */
  604.  
  605.    /* AmigaBASIC keyword? */
  606.    first=abssym; last=xorsym;
  607.    do
  608.    {
  609.     this = (first+last) / 2;
  610.     if (strcmp(id,rword[this]) <= 0) last  = this-1;  /* id <= rword[this] ? */
  611.     if (strcmp(id,rword[this]) >= 0) first = this+1;  /* id >= rword[this] ? */
  612.    }   
  613.    while (first <= last);
  614.    if (first-1 > last) found=TRUE;
  615.  
  616.    /* ACE keyword? */
  617.    if (!found)
  618.    {
  619.     first=addresssym; last=ycorsym;
  620.     do
  621.     {
  622.      this = (first+last) / 2;
  623.      if (strcmp(id,rword[this]) <= 0) last  = this-1;  /* id <= rword[this] ? */
  624.      if (strcmp(id,rword[this]) >= 0) first = this+1;  /* id >= rword[this] ? */
  625.     }   
  626.     while (first <= last);
  627.     if (first-1 > last) found=TRUE;
  628.    }
  629.  
  630.    if (found) return(this); else return(undefined);
  631. }
  632.  
  633. int rsvd_sym(id)
  634. char *id;
  635. {
  636. BOOL found=FALSE;
  637. int cc=0;
  638.  
  639.    /* reserved symbol? */
  640.    do
  641.    {
  642.     if (strcmp(id,rsym[cc++]) == 0) found=TRUE;
  643.    }
  644.    while ((!found) && (strcmp(rsym[cc],"SENTINEL")!=0));
  645.    if (found) return(500+cc-1); else return(undefined); 
  646. }
  647.  
  648. void reclassify_number()
  649. {
  650.  /* reclassify a number as a short, long or floating point value
  651.     if a qualifying character (%&!#) follows the numeric literal.
  652.  */
  653.   if (ch == '%')
  654.   {
  655.    /* coerce to a SHORT constant */
  656.    nextch();
  657.    switch(typ)
  658.    {
  659.     case longtype   : shortval=(SHORT)longval; break;
  660.     case singletype : if (SPCmp(0.5,SPSub(SPFloor(singleval),singleval)) == 1) 
  661.                   shortval=(SHORT)SPFix(SPFloor(singleval));
  662.               else
  663.                   shortval=(SHORT)SPFix(SPCeil(singleval));
  664.               break; /*if fnum-fix(fnum)<0.5 round_down else round_up*/
  665.    }
  666.    sym=shortconst;
  667.    typ=shorttype;
  668.   }
  669.   else
  670.   if (ch == '&')  
  671.   {
  672.    /* coerce to a LONG constant */
  673.    nextch(); 
  674.    switch(typ)
  675.    {
  676.     case shorttype  : longval=(LONG)shortval; break;
  677.     case singletype : if (SPCmp(0.5,SPSub(SPFloor(singleval),singleval)) == 1) 
  678.                   longval=(LONG)SPFix(SPFloor(singleval));
  679.               else
  680.                   longval=(LONG)SPFix(SPCeil(singleval));
  681.               break; /*if fnum-fix(fnum)<0.5 round_down else round_up*/
  682.    }
  683.    sym=longconst;
  684.    typ=longtype; 
  685.   }
  686.   else
  687.   if (ch == '!' || ch == '#')
  688.   {
  689.    /* coerce to a SINGLE constant */
  690.    nextch();
  691.    switch(typ)
  692.    {
  693.     case shorttype : singleval=SPFlt((LONG)shortval); break;
  694.     case longtype  : singleval=SPFlt(longval); break;    
  695.    }
  696.    sym=singleconst;
  697.    typ=singletype;
  698.   }  
  699. }
  700.  
  701. void classify_integer(n)
  702. LONG n;
  703. {
  704.  /* classify as a long or short integer value */
  705.  if (n >= 0 && n <= MAXSHORT)
  706.  {
  707.    /* SHORT constant */
  708.    shortval=(SHORT)n;
  709.    sym=shortconst; 
  710.    typ=shorttype;
  711.  }
  712.  else
  713.  {
  714.    /* LONG constant */
  715.    longval=n;  
  716.    sym=longconst;
  717.    typ=longtype; 
  718.  }
  719. }
  720.  
  721. void insymbol()
  722. /* lexical analyser */
  723. {
  724. int  i,cc=0;
  725. BOOL found;
  726. char ssym[3];
  727. LONG n[2],n0,n1;
  728. int  index;
  729. int  periods;
  730. BOOL period;
  731. LONG places;
  732. int  placecount;
  733. char ffpbuf[20];
  734. int  ex;
  735. LONG val;
  736. BYTE num;
  737. int  sign;
  738. char lastch=' ';
  739. BOOL ans;
  740.  
  741.  lastsym=sym;   
  742.  sym = undefined;
  743.  obj = undefined;
  744.  typ = undefined;
  745.  found = FALSE;
  746.  
  747.  if (!end_of_source)
  748.  {
  749.   /* skip whitespace */
  750.   while (ch <= ' ') 
  751.   { 
  752.    nextch(); 
  753.    if (end_of_source) return; 
  754.    if (sym == endofline) return;  /* for PRINT */
  755.   }
  756.  
  757.   /* single-line comment? */
  758.   if (ch == '\'') 
  759.   {
  760.    do
  761.    {
  762.     nextch();
  763.    }
  764.    while ((sym != endofline) && (!end_of_source));
  765.    if (end_of_source) return;
  766.    if (sym == endofline) return;  /* for PRINT '... */
  767.   }
  768.  
  769.   /* block comment? */
  770.   if (ch == '{')
  771.   {
  772.    do
  773.    {
  774.     nextch();
  775.    }
  776.    while ((ch != '}') && (!end_of_source));
  777.  
  778.    if (!end_of_source) nextch();  /* character after "}" */
  779.    else
  780.        return;
  781.  
  782.    if (sym == endofline) return;  /* for PRINT {..} */
  783.  
  784.    /* skip whitespace */
  785.    while (ch <= ' ') 
  786.    { 
  787.     nextch(); 
  788.     if (end_of_source) return; 
  789.     if (sym == endofline) return;  /* for PRINT {..} eoln */
  790.    }
  791.   }
  792.  
  793.   /* identifier or reserved word? */
  794.   if (letter() || (ch == '_'))
  795.   {
  796.    do
  797.    {
  798.     ut_id[cc]=ut_ch; /* keep an "untouched" version (ie: upper/lower case) 
  799.             for DATA statements, library function searches 
  800.             and external functions */
  801.     id[cc++]=ch;
  802.     nextch();
  803.    }
  804.    while ((letter() || digit() || (ch == '.') || (ch == '_')) && 
  805.       (cc < MAXIDSIZE-2));  
  806.  
  807.    id[cc]='\0';
  808.    ut_id[cc]='\0';
  809.   
  810.    /* is there a qualifier? %&$!# */
  811.    if (qualifier()) 
  812.    {
  813.     if (ch == '&') ch='@';   
  814.     if (ch == '!') ch='[';   /* this is ONLY because a jsr SUB_name& or
  815.                 SUB_name! gives an error in A68K, whereas
  816.                   SUB_name@ and SUB_name[ don't!! */
  817.     id[cc++]=ch;
  818.     nextch();
  819.    }
  820.  
  821.    id[cc] = '\0';
  822.    ut_id[cc] = '\0';
  823.    
  824.    /* reserved word? */
  825.    if ((sym = rsvd_wd(id)) == undefined)
  826.    { 
  827.     /* no, it's an identifier */
  828.     convert_special_ident();
  829.  
  830.     sym=ident; 
  831.  
  832.     if (typ == undefined) 
  833.     { 
  834.         /* 
  835.     ** Data type = ASCII value of 1st char in id minus 'A'.
  836.     ** Note that the underscore character is also catered
  837.     ** for here since it is higher in the ASCII table than
  838.     ** "Z". See lexvar.c, misc.c and setup() (above) for 
  839.     ** more info.
  840.         */
  841.     typ=idtype[id[0]-'A']; 
  842.  
  843.         obj=variable;        
  844.     }
  845.    }
  846.    else
  847.     {
  848.      /* 
  849.      ** It's a reserved word, so typ & obj mean nothing, but may
  850.      ** have been set by qualifier() if qualifier character was a '$' 
  851.      */
  852.      typ=undefined;
  853.      obj=rsvd_word;
  854.     }
  855.   }
  856.   else
  857.   /* string constant? */
  858.   if (ch == '"')
  859.   {
  860.    inside_string = TRUE;
  861.    cc=0;
  862.    do
  863.    {
  864.     nextch();
  865.     stringval[cc++] = ch;
  866.    }
  867.    while ((ch != '"') && (ch != '\0') && (cc < MAXSTRLEN));
  868.    if (ch == '"') --cc;
  869.    if (ch == '"') nextch();
  870.    stringval[cc]='\0';
  871.    sym=stringconst; typ=stringtype; obj=constant;
  872.    inside_string = FALSE;
  873.   }
  874.   else
  875.   /* numeric literal? */
  876.   if (digit() || (ch == '.'))
  877.   {
  878.    n[0]=n[1]=0;
  879.    index=0;
  880.    period=FALSE;
  881.    periods=0;
  882.    placecount=0;
  883.    
  884.    /* is first char '.'? */
  885.    if (ch == '.')
  886.    {
  887.     period=TRUE;
  888.     placecount=0;
  889.     index=1;
  890.     periods++;
  891.    }
  892.    /* get the value */
  893.    if (!period) n[0]=10*n[0]+(ch-'0');
  894.    do
  895.    {
  896.     nextch();
  897.     if (digit()) n[index]=10*n[index]+(ch-'0');
  898.     if (digit() && period) placecount++;
  899.     if (ch == '.') periods++;
  900.     if ((ch == '.') && (!period))
  901.     {
  902.      period=TRUE;
  903.      placecount=0;
  904.      index=1;
  905.     }
  906.    }
  907.    while ((digit() || ch == '.') && (periods <= 1));
  908.  
  909.    /* integer or real? */
  910.    if (period && (periods == 1))
  911.    {
  912.     /* make FFP */
  913.     sym = singleconst; typ=singletype;
  914.     places=1;
  915.     for (i=1;i<=placecount;i++) places *= 10;
  916.     n0=n[0];
  917.     n1=n[1];
  918.     singleval=SPAdd(SPFlt(n0),SPDiv(SPFlt(places),SPFlt(n1)));
  919.     /*ex = fpa(singleval,ffpbuf);
  920.     ffpbuf[14]='\0'; 
  921.     printf("FFP: %s\t%lx\t",ffpbuf,singleval);
  922.     ffprint(ex,ffpbuf);*/
  923.    }  
  924.   else 
  925.       classify_integer(n[0]);
  926.  
  927.   reclassify_number();
  928.  
  929.   /* is it a real in scientific format? */
  930.   if ((ch == 'e') || (ch == 'E'))
  931.   {
  932.    ex=0;
  933.    sign=1;
  934.    nextch();
  935.    if (ch == '+') { sign=1; nextch(); }
  936.    else
  937.       if (ch == '-') { sign=-1; nextch(); }
  938.    if (!digit()) _error(3);  /* expect a digit */ 
  939.    /* get digits */
  940.    while (digit()) { ex = 10*ex + (ch-48); nextch(); }
  941.    ex *= sign;
  942.    /* convert to FFP */
  943.    if ((ex >= -20) && (ex <= 18))
  944.    {
  945.  
  946.     /* mantissa */
  947.     if (sym != singleconst) 
  948.     { 
  949.      singleval = SPFlt(n[0]); 
  950.      sym=singleconst; typ=singletype;
  951.     }
  952.  
  953.     /* if exponent is zero: 10^ex = 1 -> num*1 = num 
  954.        so just return singleval as it is. */
  955.     if (ex != 0) singleval = SPMul(SPPow(SPFlt(ex),10.0),singleval);
  956.  
  957.     reclassify_number();
  958.    }
  959.    else { singleval = 0.0; _warn(1); }
  960.   }    
  961.   obj=constant;
  962.  }
  963.  else
  964.   /* reserved symbol? */
  965.   if (ch == '\\') /* backslash */
  966.   { 
  967.    sym=idiv;  
  968.    nextch();
  969.   }
  970.   else
  971.   if (ssymbol() || (ch == '&') || (ch == '#'))
  972.   {
  973.    /* one character symbol? */
  974.    ssym[0]=ch;
  975.    ssym[1]='\0';
  976.    sym = rsvd_sym(ssym);  /* tentatively */
  977.  
  978.    lastch=ch;  /* might be '&' or '*' */
  979.    nextch();   
  980.  
  981.    /* multiple character symbol? (++,--,->,<>,<=,>=,:=,&H,&O,*%,*&,*!) */
  982.  
  983.    /* ++ */
  984.    if (sym==plus && ch=='+') 
  985.       { ssym[1]=ch; ssym[2]='\0'; sym=rsvd_sym(ssym); nextch(); }
  986.    else 
  987.    /* --,-> */
  988.    if (sym==minus && (ch=='-' || ch=='>')) 
  989.       { ssym[1]=ch; ssym[2]='\0'; sym=rsvd_sym(ssym); nextch(); }
  990.    else
  991.    /* <>,<= */
  992.    if (sym==lessthan && (ch=='>' || ch=='=')) 
  993.       { ssym[1]=ch; ssym[2]='\0'; sym=rsvd_sym(ssym); nextch(); }
  994.    else
  995.    /* >=,:= */
  996.    if ((sym==gtrthan || sym==colon) && ch=='=') 
  997.       { ssym[1]=ch; ssym[2]='\0'; sym=rsvd_sym(ssym); nextch(); }
  998.    else
  999.    /* &H,&O */
  1000.    if (lastch=='&' && (ch=='H' || ch=='O')) 
  1001.       { ssym[1]=ch; ssym[2]='\0'; sym=rsvd_sym(ssym); nextch(); }
  1002.    else
  1003.    /* *%,*&,*! */
  1004.    if (lastch=='*' && (ch=='%' || ch=='&' || ch=='!'))
  1005.       { ssym[1]=ch; ssym[2]='\0'; sym=rsvd_sym(ssym); nextch(); }
  1006.   
  1007.  
  1008.        /* hexadecimal constant? */
  1009.        if (sym == hexprefix)
  1010.        {
  1011.         val=0;
  1012.     if (hex_digit() == -1)
  1013.        _error(2);
  1014.     else
  1015.         while ((num = hex_digit()) != -1)
  1016.         {
  1017.          val = 16*val + num;
  1018.          nextch();
  1019.         }
  1020.         classify_integer(val); 
  1021.     reclassify_number();
  1022.        }
  1023.        else
  1024.       /* octal constant? */
  1025.       if ((sym == octalprefix) || ((ssym[0] == '&') && (strlen(ssym)==1)))
  1026.       {
  1027.        val=0;
  1028.        if (octal_digit() == -1) 
  1029.            _error(2); 
  1030.        else
  1031.        {
  1032.         while ((num = octal_digit()) != -1)
  1033.         {
  1034.          val = 8*val + num;
  1035.          nextch();
  1036.         }
  1037.         classify_integer(val);
  1038.     reclassify_number();
  1039.        }
  1040.       }
  1041.     }
  1042.     /*
  1043.     ** Unknown symbol.
  1044.     */
  1045.     if (sym == undefined) { _error(2); nextch(); }
  1046.     /*showsym(sym); lf();*/
  1047.  } 
  1048. }
  1049.  
  1050. /*
  1051. void showsym(sym)
  1052. int sym;
  1053. {
  1054.  if (sym == undefined) printf("undefined");
  1055.  else
  1056.  if (sym <= RWSENTINEL) printf("%s -> %d",rword[sym],sym);
  1057.  else
  1058.  if (sym <= RSSENTINEL) printf("%s",rsym[sym-500]);
  1059.  else
  1060.      printf("%s",symbol[sym-1000]);
  1061. }
  1062.  
  1063. void showobj(obj)
  1064. int obj;
  1065. {
  1066.  if (obj == undefined) printf(" undefined");
  1067.  else
  1068.      printf("%10s",object[obj-3000]);
  1069. }
  1070.  
  1071. void showtyp(typ)
  1072. int typ;
  1073. {
  1074.  if (typ == undefined) printf(" undefined");
  1075.  else
  1076.      printf("%10s",type[typ-2000]);
  1077. }
  1078.  
  1079. void tab()
  1080. {
  1081.  putchar('\t');
  1082. }
  1083.  
  1084. void lf()
  1085. {
  1086.  putchar('\n');
  1087. }
  1088. */
  1089.  
  1090. /*
  1091. void main(argc,argv)
  1092. int  argc;
  1093. char *argv[];
  1094. {
  1095.  if (argc == 1) { src = stdin; std_in=TRUE; }
  1096.  else
  1097.     open_files(argv[1]);
  1098.  setup();
  1099.  while (!end_of_source) 
  1100.  { 
  1101.   insymbol(); 
  1102.   puts("                             ");
  1103.   showsym(sym); tab(); 
  1104.   showobj(obj); tab(); 
  1105.   showtyp(typ); lf(); 
  1106.   switch(sym)
  1107.   {
  1108.    case stringconst : printf("-->>%s\n",stringval); break;
  1109.    case shortconst  : printf("-->>%d\n",shortval);  break;
  1110.    case longconst   : printf("-->>%ld\n",longval);  break;
  1111.    case singleconst : printf("-->>%x\n",singleval); break;
  1112.   }
  1113.  }
  1114.  cleanup();
  1115. }
  1116. */
  1117.