include include include include "lexer.h" include "parser.h" include "token.h" # FC_LEXER - Lexical analizer for the file calculator. The input line is # read directly from the lexer common since the parser generated by XYACC # does not pass a line, but insead a file descriptor (actually, this can # be done by passing the pointer to the line as if it were the file # descriptor, but this is not an elegant solution). int procedure fc_lexer (dummy, yylval) int dummy # input stream (not used) pointer yylval # YYLVAL token pointer char key[SZ_LINE] # keyword or function name char nextch # next character bool match # matching quote ? int tok # next token int nkey # keyword number in dictionary int ip, n include "lexer.com" bool strne() int ctoi(), ctor(), ctod() int stridx(), strdic() int lexnum() begin # Skip white spaces while (IS_WHITE (Memc[lex_line + lex_pos - 1])) lex_pos = lex_pos + 1 # Get next character. nextch = Memc[lex_line + lex_pos - 1] #call eprintf ("fc_lexer: nextch=%c, lex_pos=%d\n") #call pargc (nextch) #call pargi (lex_pos) # Return inmediately if an end of the line is found if (nextch == EOS) return (EOLINE) # Test first valid character against the possible tokens if (IS_ALPHA (nextch)) { # keyword or function name # Read identifier and convert it to lowercase for (ip=1; IS_ALNUM (Memc[lex_line + lex_pos - 1]); ip=ip+1) { lex_id[ip] = Memc[lex_line + lex_pos - 1] lex_pos = lex_pos + 1 } lex_id[ip] = EOS call strlwr (lex_id) # Check for a keyword name. Anything not matching # the keyword dictionary or anything abreviated # is considered to be an error. nkey = strdic (lex_id, key, SZ_LINE, KEYWORDS) if (nkey == 0) tok = ERR # no match else if (strne (lex_id, key)) tok = ERR # abreviation else { switch (nkey) { case KEY_FILE: # file reference tok = FILE case KEY_PI, KEY_HALFPI, KEY_TWOPI, KEY_FOURPI: # constants tok = DNUMBER case K_ACOS: # arc cosine tok = F_ACOS case K_ASIN: # arc sine tok = F_ASIN case K_ATAN: # arc tangent tok = F_ATAN case K_ATAN2: # arc tangent of y / x tok = F_ATAN2 case K_COS: # cosine tok = F_COS case K_SIN: # sine tok = F_SIN case K_TAN: # tangent tok = F_TAN case K_EXP: # exponential tok = F_EXP case K_LOG: # natural logarithm tok = F_LOG case K_LOG10: # decimal logarithm tok = F_LOG10 case K_SQRT: # square root tok = F_SQRT case K_ABS: # absolute value tok = F_ABS case K_INT: # integer part tok = F_INT case K_MIN: # minimum value tok = F_MIN case K_MAX: # maximum value tok = F_MAX case K_AVG: # average tok = F_AVG case K_MEDIAN: # median tok = F_MEDIAN case K_MODE: # mode tok = F_MODE case K_SIGMA: # sigma tok = F_SIGMA case K_STR: # convert to string tok = F_STR default: call error (0, "fc_lexer: Unknown keyword name") } } } else if (IS_DIGIT (nextch) || nextch == '.') { # number # Process number switch (lexnum (Memc[lex_line], lex_pos, n)) { case LEX_DECIMAL: tok = INUMBER case LEX_REAL: tok = RNUMBER default: tok = ERR } # Copy whatever was processed to the identifier, # and convert it to lowercase do ip = 1, n lex_id[ip] = Memc[lex_line + lex_pos + ip - 2] lex_id[n + 1] = EOS call strlwr (lex_id) # Check for a double precission number if (tok == RNUMBER && stridx ("d", lex_id) > 0) tok = DNUMBER # Advance to next token lex_pos = lex_pos + n } else if (nextch == '"') { # character string # Read string until either the matching quote or # the end of the lexer line is found. match = true lex_pos = lex_pos + 1 for (ip=1; Memc[lex_line + lex_pos - 1] != '"'; ip=ip+1) { if (Memc[lex_line + lex_pos - 1] != EOS) { lex_id[ip] = Memc[lex_line + lex_pos - 1] lex_pos = lex_pos + 1 } else { match = false break } } lex_id[ip] = EOS # Determine the token to return based on the existence # of the matching quote. Issue an error message if the # matching quote was not found. if (match) { tok = STRING lex_pos = lex_pos + 1 } else { call fc_error ("Unmatched string", PERR_SYNTAX) tok = ERR } } else if (nextch == '@') { # file reference call strcpy ("@", lex_id, SZ_LINE) tok = FILE lex_pos = lex_pos + 1 } else if (nextch == '$') { # column reference call strcpy ("$", lex_id, SZ_LINE) tok = COLUMN lex_pos = lex_pos + 1 } else if (nextch == '(') { # left parenthesis call strcpy ("(", lex_id, SZ_LINE) tok = LPAR lex_pos = lex_pos + 1 } else if (nextch == ')') { # right parenthesis call strcpy (")", lex_id, SZ_LINE) tok = RPAR lex_pos = lex_pos + 1 } else if (nextch == '+') { # plus call strcpy ("+", lex_id, SZ_LINE) tok = PLUS lex_pos = lex_pos + 1 } else if (nextch == '-') { # minus call strcpy ("-", lex_id, SZ_LINE) tok = MINUS lex_pos = lex_pos + 1 } else if (nextch == '*') { # mult. and exponentiation lex_pos = lex_pos + 1 if (Memc[lex_line + lex_pos - 1] == '*') { call strcpy ("**", lex_id, SZ_LINE) tok = EXPON lex_pos = lex_pos + 1 } else { call strcpy ("*", lex_id, SZ_LINE) tok = STAR } } else if (nextch == '/') { # div. and concatenation lex_pos = lex_pos + 1 if (Memc[lex_line + lex_pos - 1] == '/') { call strcpy ("//", lex_id, SZ_LINE) tok = CONCAT lex_pos = lex_pos + 1 } else { call strcpy ("/", lex_id, SZ_LINE) tok = SLASH } } else if (nextch == ',') { # argument delimiter call strcpy (",", lex_id, SZ_LINE) tok = COMMA lex_pos = lex_pos + 1 } else if (nextch == ';') { # expression delimiter call strcpy (";", lex_id, SZ_LINE) tok = SEMICOLON lex_pos = lex_pos + 1 } else { # none of the above # Anything not included in the previous categories # is treated as an error. lex_id[1] = nextch lex_id[2] = EOS tok = ERR # Advance to next character lex_pos = lex_pos + 1 } # Update yylval structure LEX_TOK (yylval) = tok call strcpy (lex_id, LEX_ID (yylval), SZ_LINE) LEX_IVAL (yylval) = INDEFI LEX_RVAL (yylval) = INDEFR LEX_DVAL (yylval) = INDEFD switch (tok) { case INUMBER: ip = 1 n = ctoi (lex_id, ip, LEX_IVAL (yylval)) case RNUMBER: ip = 1 n = ctor (lex_id, ip, LEX_RVAL (yylval)) case DNUMBER: switch (nkey) { case KEY_PI: LEX_DVAL (yylval) = PI case KEY_HALFPI: LEX_DVAL (yylval) = HALFPI case KEY_TWOPI: LEX_DVAL (yylval) = TWOPI case KEY_FOURPI: LEX_DVAL (yylval) = FOURPI default: ip = 1 n = ctod (lex_id, ip, LEX_DVAL (yylval)) } } # # Debug # call eprintf ( # "fc_lexer: (tok=%d) (lex_id=%s) (ival=%d) (rval=%g) (dval=%g)\n") # call pargi (LEX_TOK (yylval)) # call pargstr (LEX_ID (yylval)) # call pargi (LEX_IVAL (yylval)) # call pargr (LEX_RVAL (yylval)) # call pargd (LEX_DVAL (yylval)) # Return token value return (tok) end