/* $Id: clex.c,v 1.15 1997/02/14 16:33:00 cim Exp $ */
/* Copyright (C) 1994, 1998 Sverre Hvammen Johansen,
* Department of Informatics, University of Oslo.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; version 2.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
/* Scanner for Simula */
#include <stdio.h>
#include <ctype.h>
#include "gen.h"
#include "parser.h"
#include "name.h"
#include "filelist.h"
#include "error.h"
#include "extspec.h"
#include "mapline.h"
#ifdef STDC_HEADERS
#include <stdlib.h>
#else
double strtod ();
#endif
#include <obstack.h>
char *xmalloc();
void free();
#define obstack_chunk_alloc xmalloc
#define obstack_chunk_free free
static struct obstack osLex, osIfdef;
#define unput(c) {ungetc (c, includeFile ());}
static int notintext = TRUE;
#define newlexchar (lexchar=input())
static int newsymbole;
long lineno;
static int antnewline;
static int lexradix;
static int i;
static int lexchar;
static unsigned char firstchar;
static unsigned char secondchar;
static unsigned char thirdchar;
static char *yytext;
static int pardeep = 0;
static int antsimchar = 0;
static int antchar = 0;
static char leerror = FALSE;
static char end_of_file;
char external = FALSE; /* Har man sett "EXTERNAL PROC/CLASS =" angir
* external at man venter et filnavn
* som ikke skal behandles som
* en text-konstant. */
struct ifdefstack
{
char ifdef;
struct ifdefstack *prev;
} *ifdefp;
char *flag, mellflag, bl_in_dir_line;
/* Brytere som kan slåes AV/P} ved hjelp av kompilator-direktiver */
char nameasvar = OFF;
char sensitive = OFF;
static char flaggpass2;
char staticblock = OFF;
/******************************************************************************
INPUT */
/* Egen definisjon på input for å gjøre små bokstaver om til store
* Samt fjerne ^@ fra input
* Dette skal dog ikke gjøres innenfor text eller karakter -konstanter */
static int
input ()
{
int yytchar;
if (end_of_file)
{
end_of_file--;
yytchar = EOF;
}
else
do
{
yytchar = getc (includeFile ());
}
while (yytchar == 0L);
if (iscntrl (yytchar) && !isspace (yytchar) && yytchar != '\b'
&& yytchar != EOF
#if ISO_LATIN
&& yytchar<160
#endif
)
lerror (7);
if (yytchar == '#' && notintext) return('%');
return (islower (yytchar) && notintext && sensitive == OFF
? toupper (yytchar) : yytchar);
}
/* Behandler kompilator direktiver.
* F|lgende kompilator-direktiv er implementert:
* %comment Kommentar frem til matchende %endcomment.
* Dette direktivet kan v{re nestet.
* %endcomment Se ovenfor.
* %include Inkludere en annen fil.
* %indextest on/off initielt satt lik on.
* %line Si hvilken line/fil source kommer fra.
* %nameasvar on/off Name-parameter overf|rt som var.
* %nonetest on/off Skal nonetest utf|res ved referanse
* til objekter.
* %stripsideeffects Ikke ta hensyn til sideeffekter i
* uttrykk.
* %casesensitive
* on/off Case-sensitive p} samtlige symboler.
* Hvis on er satt s} m} n|kkelord skrives
* med store bokstaver.
* Beskyttede attributter i simset og simu-
* lation er implementert ved hjelp av dette
* direktivet.
* %nocomment Resten av linje blir behandlet p} vanlig
* m}te. Dette direktivet er nyttig p} den
* m}ten at andre kompilatorer vanligvis vil
* ignorere denne linjen, mens cim ikke
* gj|r det. F.eks. Lund gir bare en warning
* for slike linjer.
* %define Definerer et symbol.
* %undef Fjern en definisjon av et symbol.
* %ifdef Sjekker om symbolet er definert.
* %ifnotdef Sjekker om symbolet ikke er definert.
* %else Se nedenfor.
* %endif %ifdef og %ifnotdef er etterfulgt av
* et antall linjer muligens etterfulgt
* av %else og deretter etterfulgt av %endif.
* Hvis betingelsen er sann da vil alle
* linjer mellom %else og %endif bli ignorert.
* Ellers blir alle linjer mellom testen
* og %else eller %endif
* (hvis %else er utelatt) ignorert.
* %elsedef Forkortelse for %else - %ifdef - %endif.
* %elsenotdef Forkortelse for %else - %ifnotdef - %endif.
* %timestamp Setter opp et tidsmerke for en
* ekstern modul
* %eof End of file. Brukes for include-filer
* som er lagt i ar-biblioteker. */
/******************************************************************************
PRINT_LEXSYMBOL */
static print_lexsymbol (lextok, yylvalp)
int lextok;
YYSTYPE *yylvalp;
{
int yyleng;
switch (lextok)
{
case HACTIVATE:
printf ("ACTIVATE ");
break;
case HAFTER:
printf ("AFTER ");
break;
case HARRAY:
printf ("ARRAY ");
break;
case HAT:
printf ("AT ");
break;
case HBEFORE:
printf ("BEFORE ");
break;
case HBEGIN:
printf ("BEGIN ");
break;
case HBOOLEAN:
printf ("BOOLEAN ");
break;
case HCHARACTER:
printf ("CHARACTER ");
break;
case HCLASS:
printf ("CLASS ");
break;
case HDELAY:
printf ("DELAY ");
break;
case HDO:
printf ("DO ");
break;
case HELSE:
printf ("ELSE ");
break;
case HEND:
printf ("END ");
break;
case HEXTERNAL:
printf ("EXTERNAL ");
break;
case HFOR:
printf ("FOR ");
break;
case HGO:
printf ("GO ");
break;
case HGOTO:
printf ("GOTO ");
break;
case HHIDDEN:
printf ("HIDDEN ");
break;
case HIF:
printf ("IF ");
break;
case HINNER:
printf ("INNER ");
break;
case HINSPECT:
printf ("INSPECT ");
break;
case HINTEGER:
printf ("INTEGER ");
break;
case HLABEL:
printf ("LABEL ");
break;
case HLONG:
printf ("LONG ");
break;
case HNAME:
printf ("NAME ");
break;
case HNEW:
printf ("NEW ");
break;
case HNONE:
printf ("NONE ");
break;
case HNOTEXT:
printf ("NOTEXT ");
break;
case HOTHERWISE:
printf ("OTHERWISE ");
break;
case HPRIOR:
printf ("PRIOR ");
break;
case HPROCEDURE:
printf ("PROCEDURE ");
break;
case HPROTECTED:
printf ("PROTECTED ");
break;
case HQUA:
printf ("QUA ");
break;
case HREACTIVATE:
printf ("REACTIVATE ");
break;
case HREAL:
printf ("REAL ");
break;
case HREF:
printf ("REF ");
break;
case HSHORT:
printf ("SHORT ");
break;
case HSTEP:
printf ("STEP ");
break;
case HSWITCH:
printf ("SWITCH ");
break;
case HTEXT:
printf ("TEXT ");
break;
case HTHEN:
printf ("THEN ");
break;
case HTHIS:
printf ("THIS ");
break;
case HTO:
printf ("TO ");
break;
case HUNTIL:
printf ("UNTIL ");
break;
case HVALUE:
printf ("VALUE ");
break;
case HVAR:
printf ("VAR ");
break;
case HVIRTUAL:
printf ("VIRTUAL ");
break;
case HWHEN:
printf ("WHEN ");
break;
case HWHILE:
printf ("WHILE ");
break;
case HPAREXPSEPARATOR:
printf (", ");
break;
case HLABELSEPARATOR:
printf (": ");
break;
case HSTATEMENTSEPARATOR:
printf ("; ");
break;
case HBEGPAR:
printf ("( ");
break;
case HENDPAR:
printf (") ");
break;
case HEQV:
printf ("EQV ");
break;
case HIMP:
printf ("IMP ");
break;
case HOR:
printf ("OR ");
break;
case HAND:
printf ("AND ");
break;
case HNOT:
printf ("NOT ");
break;
case HPRIMARYOPERATOR:
printf ("** ");
break;
case HDOT:
printf (". ");
break;
case HDOTDOTDOT:
printf ("... ");
break;
case HCONC:
printf ("& ");
break;
case HINTEGERKONST:
printf ("%d ", yylvalp->ival);
break;
case HREALKONST:
sprintf ((char *) yytext, "%.16e", yylvalp->rval);
for (yyleng = 0; yytext[yyleng]; yyleng++)
if (yytext[yyleng] == 'e')
putchar ('&');
else
putchar (yytext[yyleng]);
putchar (' ');
break;
case HCHARACTERKONST:
if (iscntrl (yylvalp->ival)
|| yylvalp->ival == '\'')
printf ("'!%d!'", yylvalp->ival);
else
printf ("'%c' ", yylvalp->ival);
break;
case HTEXTKONST:
sprintf ((char *) yytext, "\"%s\"", yylvalp->ival);
for (yyleng = 0; yytext[yyleng]; yyleng++)
if (yytext[yyleng] == '\\')
{
char i = 0;
i = i * 8 + yytext[++yyleng] - '0';
i = i * 8 + yytext[++yyleng] - '0';
i = i * 8 + yytext[++yyleng] - '0';
if (i == ' ')
putchar (' ');
else
printf ("!%d!", i);
}
else
putchar (yytext[yyleng]);
putchar (' ');
break;
case HBOOLEANKONST:
printf (yylvalp->ival ? "TRUE " : "FALSE ");
break;
case HIDENTIFIER:
printf ("%s ", yylvalp->ident);
break;
case HASSIGN:
case HVALRELOPERATOR:
case HREFRELOPERATOR:
case HOBJRELOPERATOR:
case HTERMOPERATOR:
case HFACTOROPERATOR:
switch (yylvalp->token)
{
case HASSIGNVALUE:
printf (":= ");
break;
case HASSIGNREF:
printf (":- ");
break;
case HEQ:
printf ("= ");
break;
case HGE:
printf (">= ");
break;
case HGT:
printf ("> ");
break;
case HLE:
printf ("<= ");
break;
case HLT:
printf ("< ");
break;
case HNE:
printf ("<> ");
break;
case HEQR:
printf ("== ");
break;
case HNER:
printf ("=/= ");
break;
case HIN:
printf ("IN ");
break;
case HIS:
printf ("IS ");
break;
case HADD:
printf ("+ ");
break;
case HSUB:
printf ("- ");
break;
case HMUL:
printf ("* ");
break;
case HDIV:
printf ("/ ");
break;
case HINTDIV:
printf ("// ");
break;
default:
printf ("# ");
}
break;
default:
printf ("# ");
}
}
/******************************************************************************
RADIX */
/* Rutine for } lage et heltall gitt et tall som er kodet tekstlig. */
static long
radix (r, t)
int r;
char *t;
{
long maxint_div_r = MAX_INT / r;
long dig = 0,
siffer;
while (*t)
{
siffer = *t - '0';
if (siffer >= r)
{
lerror (12);
return (0);
}
if (dig < maxint_div_r)
dig = dig * r + siffer;
else if (dig == maxint_div_r)
{
if (siffer <= MAX_INT % r)
dig = dig * r + siffer;
else
{
lerror (9);
return (0);
}
}
else
{
lerror (9);
return (0);
}
t++;
}
return (dig);
}
/******************************************************************************
SCANNAME & SCANNOWS */
static scanNows ()
{
obstack_free (&osLex, yytext);
while (lexchar != '\n' && lexchar != EOF
&& lexchar != ' ' && lexchar != '\t')
{
obstack_1grow (&osLex, lexchar);
newlexchar;
}
obstack_1grow (&osLex, 0);
yytext= obstack_finish (&osLex);
}
static scanName ()
{
obstack_free (&osLex, yytext);
while ((isalnum (lexchar) || lexchar == '_'))
{
obstack_1grow (&osLex, lexchar);
newlexchar;
}
obstack_1grow (&osLex, 0);
yytext= obstack_finish (&osLex);
}
/******************************************************************************
SCANIFDEF */
static scanIfdef ()
{
char scan;
char elsedef;
char notdef;
while (lexchar != EOF)
{
if (!strcmp (yytext, "ENDIF"))
{
if (ifdefp == includeIfdefp ()) lerror (23);
else
{
struct ifdefstack *prev= ifdefp->prev;
obstack_free (&osIfdef, ifdefp);
ifdefp= prev;
}
}
else
{
if (!strcmp (yytext, "ELSE"))
{
if (!(ifdefp->ifdef & IFGREN))
lerror (22);
notdef = FALSE;
ifdefp->ifdef &= TRUE;
}
else
{
if (!strcmp (yytext, "ELSEDEF"))
{
elsedef = TRUE;
notdef = FALSE;
}
else if (!strcmp (yytext, "ELSENOTDEF"))
{
elsedef = TRUE;
notdef = TRUE;
}
else if (!strcmp (yytext, "IFDEF"))
{
elsedef = FALSE;
notdef = FALSE;
}
else if (!strcmp (yytext, "IFNOTDEF"))
{
elsedef = FALSE;
notdef = TRUE;
}
else goto proceed;
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (isalpha (lexchar) || lexchar == '_')
{
scanName ();
if (elsedef == TRUE)
{
if (!(ifdefp->ifdef & IFGREN))
lerror (21);
if (ifdefp->ifdef & (TRUE | SCAN))
scan = SCAN;
else
scan = FALSE;
}
else
{
struct ifdefstack *prev= ifdefp;
ifdefp= (struct ifdefstack *)
obstack_alloc (&osIfdef, sizeof (struct ifdefstack));
ifdefp->prev= prev;
ifdefp->ifdef= 0;
scan = FALSE;
}
ifdefp->ifdef = ifdefName (tag (yytext)) | IFGREN | scan;
}
else
{
if (!bl_in_dir_line) lerror (8);
goto proceed;
}
}
if (notdef)
{
if ((ifdefp->ifdef & TRUE) == TRUE)
ifdefp->ifdef--;
else
ifdefp->ifdef++;
}
}
if ((ifdefp->prev != includeIfdefp ()) && (ifdefp != includeIfdefp ()))
{
if (!((ifdefp->prev->ifdef == (IFGREN | TRUE)) ||
(ifdefp->prev->ifdef == (ELSEGREN | FALSE))))
ifdefp->ifdef |= SCAN;
}
if ((ifdefp->ifdef == (IFGREN | TRUE)) ||
(ifdefp->ifdef == (ELSEGREN | FALSE)))
break;
proceed:
while (lexchar != EOF)
{
while (lexchar != '\n' && lexchar != EOF) newlexchar;
lineno++;
if (!option_write_tokens)
mout (MNEWLINE);
if (newlexchar == '%' &&
((newlexchar == ' ' && option_bl_in_dir_line) ?
(newlexchar, bl_in_dir_line = TRUE) :
((bl_in_dir_line = FALSE), TRUE)) && isalpha (lexchar))
{
scanName ();
break;
}
}
}
}
/******************************************************************************
SCANDIRFLAGS */
static scanDirflags ()
{
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (isalpha (lexchar))
{
scanName ();
if (lexchar == '\n' | lexchar == EOF
| lexchar == ' ' | lexchar == '\t')
{
if (!strcmp (yytext, "ON"))
{
if (flag != &flaggpass2)
*flag = ON;
else
{
if (!option_write_tokens)
{
mout (MFLAG);
mout (mellflag + 1);
}
}
}
else if (!strcmp (yytext, "OFF"))
{
if (flag != &flaggpass2)
*flag = OFF;
else
{
if (!option_write_tokens)
{
mout (MFLAG);
mout (mellflag);
}
}
}
else if (!bl_in_dir_line) lerror (8);
}
else if (!bl_in_dir_line) lerror (8);
}
else if (!bl_in_dir_line) lerror (8);
}
/******************************************************************************
DIRLINE */
static scanDirline ()
{
FILE *file;
lineno += antnewline;
for (; antnewline; antnewline--)
if (!option_write_tokens)
mout(MNEWLINE);
if (newlexchar == ' ' && option_bl_in_dir_line)
{
bl_in_dir_line = TRUE;
newlexchar;
}
else
bl_in_dir_line = FALSE;
if (isalpha (lexchar))
{
scanName ();
if (lexchar == '\n' | lexchar == EOF
| lexchar == ' ' | lexchar == '\t')
{
switch (yytext[0])
{
case 'C':
if (!strcmp (yytext, "CASESENSITIVE"))
{
flag = &sensitive;
scanDirflags ();
}
else if (!strcmp (yytext, "COMMENT"))
{
int comlev = 1;
while (comlev && lexchar !=EOF)
{
while (lexchar != '\n' && lexchar != EOF)
newlexchar;
if (lexchar == EOF) lerror (19);
lineno++;
if (!option_write_tokens) mout (MNEWLINE);
if (newlexchar == '%' &&
((newlexchar == ' ' &&
option_bl_in_dir_line) ? newlexchar : 0, TRUE)
&& isalpha (lexchar))
{
scanName ();
if (!strcmp (yytext, "COMMENT"))
comlev++;
if (!strcmp (yytext, "ENDCOMMENT"))
comlev--;
}
}
}
else if (!bl_in_dir_line) lerror (8);
break;
case 'D':
if (!strcmp (yytext, "DEFINE"))
{
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (isalpha (lexchar) | lexchar == '_')
{
scanName ();
defineName (tag (yytext), TRUE);
}
else if (!bl_in_dir_line) lerror (8);
}
else if (!bl_in_dir_line) lerror (8);
break;
case 'E':
if (!strcmp (yytext, "EOF"))
{
//fclose (includeFile ());
end_of_file = 2;
return;
}
else if (!strcmp (yytext, "ELSE")) scanIfdef ();
else if (!strcmp (yytext, "ELSEDEF")) scanIfdef ();
else if (!strcmp (yytext, "ELSENOTDEF")) scanIfdef ();
else if (!strcmp (yytext, "ENDIF")) scanIfdef ();
else if (!strcmp (yytext, "ENDCOMMENT")) lerror (15);
else if (!bl_in_dir_line) lerror (8);
break;
case 'I':
if (!strcmp (yytext, "IFDEF")) scanIfdef ();
else if (!strcmp (yytext, "IFNOTDEF")) scanIfdef ();
else if (!strcmp (yytext, "INCLUDE") ||
!strcmp (yytext, "INSERT"))
{
notintext = FALSE;
defineName (tag ("INCLUDED"), TRUE);
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (lexchar != '\n' | lexchar != EOF)
{
scanNows ();
notintext = TRUE;
pushfilmap (tag (yytext), ifdefp);
}
else if (!bl_in_dir_line) lerror (8);
}
else if (!strcmp (yytext, "INDEXTEST"))
{
flag = &flaggpass2;
mellflag = MINDEXTEST;
scanDirflags ();
}
else if (!bl_in_dir_line) lerror (8);
break;
case 'L':
if (!strcmp (yytext, "LIST")) ;
else if (!strcmp (yytext, "LINE"))
{
long nylinje;
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (isdigit (lexchar))
{
obstack_free (&osLex, yytext);
while (isalnum (lexchar) || lexchar == '_')
{
if (lexchar != '_') obstack_1grow (&osLex, lexchar);
newlexchar;
}
obstack_1grow (&osLex, 0);
yytext= obstack_finish (&osLex);
nylinje = radix (10, yytext);
notintext = FALSE;
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (lexchar != '\n' & lexchar != EOF)
{
scanNows ();
setfilmap (tag (yytext), nylinje);
}
else
setfilmap ((char *) NULL, nylinje);
notintext = TRUE;
}
else if (!bl_in_dir_line) lerror (8);
}
else if (!bl_in_dir_line) lerror (8);
break;
case 'M':
if (!strcmp (yytext, "MAIN"))
{
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (isalpha (lexchar) | lexchar == '_')
{
scanName ();
mainroutine= yytext;
yytext= obstack_finish (&osLex);
}
else if (!bl_in_dir_line) lerror (8);
}
else if (!bl_in_dir_line) lerror (8);
break;
case 'N':
if (!strcmp (yytext, "NOCOMMENT"))
return;
else if (!strcmp (yytext, "NAMEASVAR"))
{
flag = &nameasvar;
scanDirflags ();
}
else if (!strcmp (yytext, "NONETEST"))
{
flag = &flaggpass2;
mellflag = MNONETEST;
scanDirflags ();
}
else if (!bl_in_dir_line) lerror (8);
break;
case 'P':
if (!strcmp (yytext, "PAGE")) ;
else if (!bl_in_dir_line) lerror (8);
break;
case 'S':
if (!strcmp (yytext, "STRIPSIDEEFFECTS"))
{
flag = &flaggpass2;
mellflag = MSTRIPSIDEEFFECTS;
scanDirflags ();
}
else if (!strcmp (yytext, "STATICBLOCK"))
{
flag = &staticblock;
scanDirflags ();
}
else if (!bl_in_dir_line) lerror (8);
break;
case 'T':
if (!strcmp (yytext, "TIMESTAMP"))
{
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (isalpha (lexchar) | lexchar == '_')
{
scanName ();
directive_timestamp= yytext;
yytext= obstack_finish (&osLex);
}
else if (!bl_in_dir_line) lerror (8);
}
else if (!strcmp (yytext, "TITLE")) ;
else if (!bl_in_dir_line) lerror (8);
break;
case 'U':
if (!strcmp (yytext, "UNDEF"))
{
while (lexchar == ' ' | lexchar == '\t')
newlexchar;
if (isalpha (lexchar) | lexchar == '_')
{
scanName ();
defineName (tag (yytext), FALSE);
}
else if (!bl_in_dir_line) lerror (8);
}
else if (!bl_in_dir_line) lerror (8);
break;
}
}
else if (!bl_in_dir_line) lerror (8);
}
else
/* Hvis det er en blank eller tom linje er hele linja en kommentar */
if (lexchar != ' ' & lexchar != '\t' & lexchar != '\n'
& lexchar != '\r' & lexchar != '!' & lexchar != EOF)
if (!bl_in_dir_line) lerror (8);
while (lexchar != '\n' && lexchar != EOF) newlexchar;
lineno++;
if (!option_write_tokens)
mout (MNEWLINE);
}
/******************************************************************************
INITLEX */
int initLex (sourcename) char *sourcename;
{
obstack_init (&osLex);
yytext= obstack_finish (&osLex);
obstack_init (&osIfdef);
ifdefp= obstack_alloc (&osIfdef, sizeof (struct ifdefstack));
ifdefp->prev= NULL;
ifdefp->ifdef= 0;
if (maplineInit (sourcename, ifdefp)) return (TRUE);
lineno = 1L;
while (newlexchar == '%')
scanDirline ();
unput (lexchar);
return FALSE;
}
/******************************************************************************
PUTCHARACTER */
/* Hjelpe-prosedyre for } bygge opp et konstant-tektsobjekt. */
static char *
putcharacter (character)
unsigned char character;
{
static char s[10];
if (external == TRUE)
sprintf (s, "%c", character);
else if (isgraph (character) && character != '\\' && character != '"')
sprintf (s, "%c", character);
else
sprintf (s, "\\%03o", character);
return (s);
}
/******************************************************************************
PUTCHARTEXT */
/* Prosedyre som fungerer som grensesnitt mot scanner,
* for } bygge opp et konstant-tekstobjekt.
* Denne rutinen kalles for hvert tegn som skal inn i tekst-objektet. */
static putchartext (character)
unsigned char character;
{
char *s;
s = putcharacter (character);
obstack_grow (&osLex, s, strlen (s));
}
/******************************************************************************
GETTEXT */
/* Denne rutinen bygger opp et internt konstant-tekstobjekt og returnerer
* en peker til det. Teksten er bygget opp p} en slik m}te at den
* kun inneholder skrivbare tegn eksklusiv '\' ' ' og '"'.
* Ikke skrivbare tegn og de tre som er nevnt ovenfor er kodet oktalt
* i teksten (\nnn). Denne teksten kan uten videre skrives ut i C og trenger
* ingen omkoding. For } sammenligne en tekst mot en annen tekst ved
* kompilering, m} det brukes spesial-versjoner av strcmp og strlen.
* Disser er sstrcmp() og sstrlen() (sjekker.c).
*/
static char *
gettext ()
{
char *s;
if (obstack_object_size (&osLex) >= MAX_TEXT_CHAR)
lerror (44);
obstack_1grow (&osLex, 0);
s= obstack_finish (&osLex);
yytext= obstack_finish (&osLex);
leerror = FALSE;
return (s);
}
/******************************************************************************
YYLEX */
/* Returnerer et token til parser. */
int
yylex ()
{
char firstLexchar;
int reported;
while (TRUE)
{
lineno += antnewline;
for (; antnewline; antnewline--)
if (!option_write_tokens)
mout (MNEWLINE);
if (newsymbole)
{
int symbol;
symbol = newsymbole;
newsymbole = NOSYMBOL;
if (symbol == HEND)
goto end;
return (symbol);
}
if (isalpha (newlexchar))
{
scanName ();
unput (lexchar);
switch (yytext[0])
{
case 'A':
if (!strcmp (yytext, "ACTIVATE"))
return (HACTIVATE);
if (!strcmp (yytext, "AFTER"))
return (HAFTER);
if (!strcmp (yytext, "AND"))
return (HAND);
if (!strcmp (yytext, "ARRAY"))
return (HARRAY);
if (!strcmp (yytext, "AT"))
return (HAT);
break;
case 'B':
if (!strcmp (yytext, "BEFORE"))
return (HBEFORE);
if (!strcmp (yytext, "BEGIN"))
return (HBEGIN);
if (!strcmp (yytext, "BOOLEAN"))
return (HBOOLEAN);
break;
case 'C':
if (!strcmp (yytext, "CHARACTER"))
return (HCHARACTER);
if (!strcmp (yytext, "CLASS"))
return (HCLASS);
if (!strcmp (yytext, "COMMENT"))
goto comment;
break;
case 'D':
if (!strcmp (yytext, "DELAY"))
return (HDELAY);
if (!strcmp (yytext, "DO"))
return (HDO);
break;
case 'E':
if (!strcmp (yytext, "ELSE"))
return (HELSE);
if (!strcmp (yytext, "END"))
{
end:
reported=0;
newlexchar;
while (TRUE)
{
while (!isalpha (lexchar))
if (lexchar == '\n')
{
antnewline++;
while (newlexchar == '%')
scanDirline ();
notintext = TRUE;
}
else if (lexchar == EOF)
{
//unput (lexchar);
return (HEND);
}
else if (lexchar == ';')
{
unput (lexchar);
return (HEND);
}
else
newlexchar;
if (lexchar == 'E')
{
if (newlexchar == 'N')
{
if (newlexchar == 'D' && !isalnum (newlexchar)
&& lexchar != '_')
{ /* END is found and comment is terminated */
unput (lexchar);
newsymbole = HEND;
return (HEND);
} else
if (antnewline && !reported)
{lerror (32); reported = 1;}
}
else if (lexchar == 'L' && newlexchar == 'S'
&& newlexchar == 'E'
&& !isalnum (newlexchar) && lexchar != '_')
{ /* ELSE is found and comment is terminated */
unput (lexchar);
newsymbole = HELSE;
return (HEND);
} else if (antnewline && !reported)
{lerror (32); reported = 1;}
}
else if (lexchar == 'W')
{
if (newlexchar == 'H' && newlexchar == 'E'
&& newlexchar == 'N'
&& !isalnum (newlexchar) && lexchar != '_')
{ /* WHEN is found and comment is terminated */
unput (lexchar);
newsymbole = HWHEN;
return (HEND);
} else if (antnewline && !reported)
{lerror (32); reported = 1;}
}
else if (lexchar == 'O' && newlexchar == 'T'
&& newlexchar == 'H' && newlexchar == 'E'
&& newlexchar == 'R' && newlexchar == 'W'
&& newlexchar == 'I' && newlexchar == 'S'
&& newlexchar == 'E'
&& !isalnum (newlexchar) && lexchar != '_')
{ /* OTHERWISE is found and comment is terminated */
unput (lexchar);
newsymbole = HOTHERWISE;
return (HEND);
} else if (antnewline && !reported)
{lerror (32); reported = 1;}
while (isalpha (lexchar) || lexchar == '_')
newlexchar;
}
}
if (!strcmp (yytext, "EQ"))
{
yylval.token = HEQ;
return (HVALRELOPERATOR);
}
if (!strcmp (yytext, "EQV"))
return (HEQV);
if (!strcmp (yytext, "EXTERNAL"))
return (HEXTERNAL);
break;
case 'F':
if (!strcmp (yytext, "FALSE"))
{
yylval.ival = FALSE;
return (HBOOLEANKONST);
}
if (!strcmp (yytext, "FOR"))
return (HFOR);
break;
case 'G':
if (!strcmp (yytext, "GE"))
{
yylval.token = HGE;
return (HVALRELOPERATOR);
}
if (!strcmp (yytext, "GO"))
return (HGO);
if (!strcmp (yytext, "GOTO"))
return (HGOTO);
if (!strcmp (yytext, "GT"))
{
yylval.token = HGT;
return (HVALRELOPERATOR);
}
break;
case 'H':
if (!strcmp (yytext, "HIDDEN"))
return (HHIDDEN);
break;
case 'I':
if (!strcmp (yytext, "IF"))
return (HIF);
if (!strcmp (yytext, "IMP"))
return (HIMP);
if (!strcmp (yytext, "IN"))
{
yylval.token = HIN;
return (HOBJRELOPERATOR);
}
if (!strcmp (yytext, "INNER"))
return (HINNER);
if (!strcmp (yytext, "INSPECT"))
return (HINSPECT);
if (!strcmp (yytext, "INTEGER"))
return (HINTEGER);
if (!strcmp (yytext, "IS"))
{
yylval.token = HIS;
return (HOBJRELOPERATOR);
}
break;
case 'L':
if (!strcmp (yytext, "LABEL"))
return (HLABEL);
if (!strcmp (yytext, "LE"))
{
yylval.token = HLE;
return (HVALRELOPERATOR);
}
if (!strcmp (yytext, "LONG"))
return (HLONG);
if (!strcmp (yytext, "LT"))
{
yylval.token = HLT;
return (HVALRELOPERATOR);
}
break;
case 'N':
if (!strcmp (yytext, "NAME"))
return (HNAME);
if (!strcmp (yytext, "NE"))
{
yylval.token = HNE;
return (HVALRELOPERATOR);
}
if (!strcmp (yytext, "NEW"))
return (HNEW);
if (!strcmp (yytext, "NONE"))
return (HNONE);
if (!strcmp (yytext, "NOT"))
return (HNOT);
if (!strcmp (yytext, "NOTEXT"))
{
yylval.tval = NOTEXT;
return (HTEXTKONST);
}
break;
case 'O':
if (!strcmp (yytext, "OR"))
return (HOR);
if (!strcmp (yytext, "OTHERWISE"))
return (HOTHERWISE);
break;
case 'P':
if (!strcmp (yytext, "PRIOR"))
return (HPRIOR);
if (!strcmp (yytext, "PROCEDURE"))
return (HPROCEDURE);
if (!strcmp (yytext, "PROTECTED"))
return (HPROTECTED);
break;
case 'Q':
if (!strcmp (yytext, "QUA"))
return (HQUA);
break;
case 'R':
if (!strcmp (yytext, "REACTIVATE"))
return (HREACTIVATE);
if (!strcmp (yytext, "REAL"))
{
return (HREAL);
}
if (!strcmp (yytext, "REF"))
return (HREF);
break;
case 'S':
if (!strcmp (yytext, "SHORT"))
return (HSHORT);
if (!strcmp (yytext, "STEP"))
return (HSTEP);
if (!strcmp (yytext, "SWITCH"))
return (HSWITCH);
break;
case 'T':
if (!strcmp (yytext, "TEXT"))
return (HTEXT);
if (!strcmp (yytext, "THEN"))
return (HTHEN);
if (!strcmp (yytext, "THIS"))
return (HTHIS);
if (!strcmp (yytext, "TO"))
return (HTO);
if (!strcmp (yytext, "TRUE"))
{
yylval.ival = TRUE;
return (HBOOLEANKONST);
}
break;
case 'U':
if (!strcmp (yytext, "UNTIL"))
return (HUNTIL);
break;
case 'V':
if (!strcmp (yytext, "VALUE"))
return (HVALUE);
if (!strcmp (yytext, "VAR"))
return (HVAR);
if (!strcmp (yytext, "VIRTUAL"))
return (HVIRTUAL);
break;
case 'W':
if (!strcmp (yytext, "WHEN"))
return (HWHEN);
if (!strcmp (yytext, "WHILE"))
return (HWHILE);
break;
}
/* IDENTIFIKATORER BLIR */
/* LAGT INN I NAVNELAGERET */
yylval.ident = tag (yytext);
return (HIDENTIFIER);
}
switch (lexchar)
{
case '=':
if (newlexchar == '=')
{
yylval.token = HEQR;
return (HREFRELOPERATOR);
}
if (lexchar == '/')
if (newlexchar == '=')
{
yylval.token = HNER;
return (HREFRELOPERATOR);
}
else
lerror (7);
unput (lexchar);
yylval.token = HEQ;
return (HVALRELOPERATOR);
case '>':
if (newlexchar == '=')
{
yylval.token = HGE;
return (HVALRELOPERATOR);
}
unput (lexchar);
yylval.token = HGT;
return (HVALRELOPERATOR);
case '<':
if (newlexchar == '=')
{
yylval.token = HLE;
return (HVALRELOPERATOR);
}
if (lexchar == '>')
{
yylval.token = HNE;
return (HVALRELOPERATOR);
}
unput (lexchar);
yylval.token = HLT;
return (HVALRELOPERATOR);
case '+':
yylval.token = HADD;
return (HTERMOPERATOR);
case '-':
yylval.token = HSUB;
return (HTERMOPERATOR);
case '*':
if (newlexchar == '*')
{
yylval.token = HEXP;
return (HPRIMARYOPERATOR);
}
unput (lexchar);
yylval.token = HMUL;
return (HFACTOROPERATOR);
case '/':
if (newlexchar == '/')
{
yylval.token = HINTDIV;
return (HFACTOROPERATOR);
}
unput (lexchar);
yylval.token = HDIV;
return (HFACTOROPERATOR);
case '.':
if (isdigit (newlexchar))
{
dotdigit:
/* Behandling av tall som starter med tegnet '.' */
obstack_free (&osLex, yytext);
lexradix = 10;
digitsdot:
obstack_1grow (&osLex, '.');
if (lexchar >= '0' & lexchar <= '9')
obstack_1grow (&osLex, lexchar);
while (newlexchar >= '0' && lexchar <= '9' || lexchar == '_')
if (lexchar != '_')
obstack_1grow (&osLex, lexchar);
if (lexchar == '&')
{
newlexchar;
digitsexp:
if (lexchar == '&')
newlexchar;
obstack_1grow (&osLex, 'e');
if (lexchar == '-')
{
obstack_1grow (&osLex, '-');
newlexchar;
}
else if (lexchar == '+')
newlexchar;
if (lexchar >= '0' & lexchar <= '9')
obstack_1grow (&osLex, lexchar);
while (newlexchar >= '0' && lexchar <= '9' || lexchar == '_')
obstack_1grow (&osLex, lexchar);
}
obstack_1grow (&osLex, 0);
yytext= obstack_finish (&osLex);
unput (lexchar);
yylval.rval = strtod (yytext, NULL);
if (lexradix != 10)
lerror (16);
return (HREALKONST);
}
if (lexchar == '.')
if (newlexchar == '.')
return (HDOTDOTDOT);
else
lerror (7);
unput (lexchar);
return (HDOT);
case ',':
return (HPAREXPSEPARATOR);
case ':':
if (newlexchar == '=')
{
yylval.token = HASSIGNVALUE;
return (HASSIGN);
}
if (lexchar == '-' && pardeep == 0)
{
yylval.token = HASSIGNREF;
return (HASSIGN);
}
unput (lexchar);
return (HLABELSEPARATOR);
case ';':
pardeep = 0;
return (HSTATEMENTSEPARATOR);
case '(':
pardeep++;
return (HBEGPAR);
case ')':
pardeep--;
return (HENDPAR);
case '&':
if (newlexchar == '&' || lexchar == '-' || lexchar == '+'
|| isdigit (lexchar))
{
lexradix = 10;
obstack_free (&osLex, yytext);
obstack_1grow (&osLex, '1');
goto digitsexp;
}
unput (lexchar);
return (HCONC);
case '!':
comment:
while ((newlexchar != ';') && lexchar != EOF)
if (lexchar == '\n')
{
antnewline++;
while (newlexchar == '%')
scanDirline ();
unput (lexchar);
}
if (lexchar != ';')
{
lerror (1);
unput (lexchar);
}
break;
case '\'':
notintext = FALSE;
if ((isprint (newlexchar)
#if ISO_LATIN
|| lexchar >= 160
#endif
) && lexchar != '!')
{
yylval.ival = lexchar;
newlexchar;
}
else if (lexchar == '!')
{
if (isdigit (newlexchar))
{
firstchar = lexchar;
if (isdigit (newlexchar))
{
secondchar = lexchar;
if (isdigit (newlexchar))
{
thirdchar = lexchar;
if (newlexchar == '!')
{
if (firstchar < '2'
|| (firstchar == '2' &&
(secondchar < '5'
|| (secondchar == '5'
&& thirdchar < '6'))))
{
yylval.ival = ((firstchar - '0') * 10
+ secondchar - '0') * 10
+ thirdchar - '0';
newlexchar;
}
else
{
lerror (2);
newlexchar;
}
}
else
{
lerror (2);
}
}
else if (lexchar == '!')
{
yylval.ival = (firstchar - '0') * 10
+ secondchar - '0';
newlexchar;
}
else
{
lerror (2);
}
}
else if (lexchar == '!')
{
yylval.ival = firstchar - '0';
newlexchar;
}
else
{
lerror (2);
}
}
else
{
yylval.ival = '!';
}
}
else
lerror (2);
if (lexchar != '\'')
{
unput (lexchar);
lerror (3);
}
notintext = TRUE;
return (HCHARACTERKONST);
case '\"':
obstack_free (&osLex, yytext);
notintext = FALSE;
newlexchar;
while (TRUE)
{
while ((isgraph (lexchar)
#if ISO_LATIN
|| lexchar >= 160
#endif
) && lexchar != '!' && lexchar != '"')
{
putchartext ((unsigned char) lexchar);
newlexchar;
}
if (lexchar == ' ')
{
putchartext ((unsigned char) lexchar);
newlexchar;
}
else if (lexchar == '!')
{
if (isdigit (newlexchar))
{
firstchar = lexchar;
if (isdigit (newlexchar))
{
secondchar = lexchar;
if (isdigit (newlexchar))
{
thirdchar = lexchar;
if (newlexchar == '!')
{
if (firstchar < '2'
|| (firstchar == '2'
&& (secondchar < '5'
|| (secondchar == '5'
&& thirdchar < '6'))))
{
putchartext
((unsigned char)
(((firstchar - '0') * 10
+ secondchar - '0') * 10
+ thirdchar - '0'));
newlexchar;
}
else
{
putchartext ('!');
putchartext (firstchar);
putchartext (secondchar);
putchartext (thirdchar);
}
}
else
{
putchartext ('!');
putchartext (firstchar);
putchartext (secondchar);
putchartext (thirdchar);
}
}
else if (lexchar == '!')
{
putchartext ((unsigned char)
((firstchar - '0') * 10
+ secondchar - '0'));
newlexchar;
}
else
{
putchartext ('!');
putchartext (firstchar);
putchartext (secondchar);
}
}
else if (lexchar == '!')
{
putchartext (firstchar - '0');
newlexchar;
}
else
{
putchartext ('!');
putchartext (firstchar);
}
}
else
{
putchartext ('!');
}
}
else if (lexchar == '\"')
{
if (newlexchar == '\"')
{
putchartext ((unsigned char) lexchar);
newlexchar;
}
else
{
while (isspace (lexchar) || lexchar == '\b')
{
if (lexchar == '\n')
antnewline++;
newlexchar;
}
if (lexchar == '\"')
newlexchar;
else
{
unput (lexchar);
yylval.tval = gettext ();
notintext = TRUE;
return (HTEXTKONST);
}
}
}
else if (lexchar == '\n')
{
antnewline++;
lerror (4);
yylval.tval = gettext ();
notintext = TRUE;
return (HTEXTKONST);
}
else
{
unput (lexchar);
lerror (5);
yylval.tval = gettext ();
notintext = TRUE;
return (HTEXTKONST);
}
}
break;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
lexradix = 10;
firstLexchar= lexchar;
obstack_free (&osLex, yytext);
obstack_1grow (&osLex, lexchar);
if (newlexchar == 'R' && (firstLexchar == '2' | firstLexchar == '4'
| firstLexchar == '8'))
{
lexradix = firstLexchar - '0';
yytext= obstack_finish (&osLex);
obstack_free (&osLex, yytext);
}
else if (firstLexchar == '1' && lexchar == '6')
{
obstack_1grow (&osLex, lexchar);
if (newlexchar == 'R')
{
lexradix = 16;
yytext= obstack_finish (&osLex);
obstack_free (&osLex, yytext);
}
else
unput (lexchar);
}
else
unput (lexchar);
while ((lexradix == 16 ? isxdigit (newlexchar) : isdigit (newlexchar))
|| lexchar == '_')
if (lexchar == '_');
else if (isdigit (lexchar))
obstack_1grow (&osLex, lexchar);
else
obstack_1grow (&osLex, lexchar + ('9' + 1 - 'A'));
if (lexchar == '.' && lexradix == 10)
{
newlexchar;
goto digitsdot;
}
if (lexchar == '&' && lexradix == 10)
{
newlexchar;
goto digitsexp;
}
obstack_1grow (&osLex, 0);
yytext= obstack_finish (&osLex);
unput (lexchar);
yylval.ival = radix (lexradix, yytext);
return (HINTEGERKONST);
case EOF:
if (ifdefp != includeIfdefp ())
{
lerror (24);
ifdefp = (struct ifdefstack *) includeIfdefp ();
}
fclose (includeFile ());
popfilmap ();
if (noFilemap ())
return (NOSYMBOL);
defineName (tag ("INCLUDED"), FALSE);
/* Ingen break her */
case '\n': /* NL (LF) */
lineno++;
if (!option_write_tokens)
mout (MNEWLINE);
while (newlexchar == '%')
scanDirline ();
unput (lexchar);
break;
case ' ':
case '\b': /* BS */
case '\t': /* HT */
case '\v': /* VT */
case '\f': /* FF */
case '\r': /* CR */
break;
default:
lerror (7);
break;
}
}
}
/******************************************************************************
SCAN_AND_WRITE_TOKENS */
scan_and_write_tokens ()
{
int token;
long line = 1L;
/* printf("% Cim_pp\n%line 1 %s\n",sourcename); */
while (token = yylex ())
{
while (line < lineno)
{
putchar ('\n');
line++;
}
print_lexsymbol (token, &yylval);
}
}
syntax highlighted by Code2HTML, v. 0.9.1