Un compilador sencillo paso a paso (3)

Este tercer acercamiento va a incluir un primer analizador léxico, que se encargue de extraer la información que le pidamos del fichero de entrada.

La intención es tener funciones como "obtenerIdentificador" o como "obtenerEntero", que simplifiquen el análisis del programa fuente.

Por ejemplo, el análisis de "LOCATE", que debe estar seguido por un paréntesis abierto, un número entero, una coma, otro número entero y un paréntesis cerrado, antes era totalmente artesanal:

(* Leo X: 1 o 2 letras *)
posicion := 8;
x := ord(orden[posicion])-ord('0');
posicion := posicion + 1;
if orden[posicion]  ',' then
  begin
  x := x*10 + ord(orden[posicion])-ord('0');
  posicion := posicion + 1;
  end;
(* Tras la coma esta Y: 1 o 2 letras *)
posicion := posicion + 1;
y := ord(orden[posicion])-ord('0');
posicion := posicion + 1;
if orden[posicion]  ')' then
  begin
  y := y*10 + ord(orden[posicion])-ord('0');
  posicion := posicion + 1;
  end;

y ahora será algo mucho más legible:

leerSimbolo('(');
val(obtenerEntero,x,codError);
leerSimbolo(',');
val(obtenerEntero,y,codError);
leerSimbolo(')');

Las posibilidades de nuestro analizador léxico son pocas por ahora, pero suficientes para lo que necesitamos en este momento:

• Una función "obtenerLetra", que devuelve una letra (un "char") del fichero de entrada. Internamente se lee de linea en linea: cada letra se toma de la línea actual, o se pide una nueva línea si no quedan más letras en la actual.


• Una función "obtenerIdentificador", que devuelve una cadena ("string") formada por un conjunto de letras de la A a la Z (en "el mundo real" se suelen permitir también cifras numéricas dentro de un identificador, pero a nosotros nos basta así por ahora).


• Una función "obtenerEntero", que devuelve un número entero, como cadena ("string") formada por un conjunto de cifras del 0 al 9.


• Una función "leerSimbolo", que intenta leer un cierto símbolo desde la entrada, y sale con un mensaje de error si no lo encuentra. Es nuestra primera ayuda para el análisis sintáctico, del que hablaremos pronto: ciertos símbolos deben aparecer en un cierto orden (por ejemplo, después de LOCATE debe hacer un paréntesis abierto, un número entero, una coma...) y esta función nos servirá para comprobar que es así.

El código fuente de este primer analizador léxico será

unit upachil;

(* cpcPaChi - Un compilador de Pascal chiquitito para CPC
   Por Nacho Cabanes

   uPachiL - unidad "Lexer" (analizador lexico)

   Versiones hasta la fecha:

   Num.   Fecha       Cambios
   ---------------------------------------------------
   0.03  25-Mar-2008  Primera version del analizador lexico:
                      es capaz de devolver un identificador,
                      un entero y de comprobar si el siguiente
                      simbolo es uno prefijado;
                      lee linea a linea del fichero de entrada
*)


interface

  function abrirFicheroEntrada(nombre: string): boolean;
  function obtenerLetra: char;
  function obtenerIdentificador: string;
  function obtenerEntero: string;
  procedure cerrarFicheroEntrada;
  procedure leerSimbolo(simbolo:char);

  var
    lineaDeEntrada: string;
    finFicheroEntrada: boolean;

implementation

var
  ficheroEntrada: text;
  posicionLineaActual: integer;


(* Abre el fichero de entrada. Devuelve FALSE si no se
ha podido *)
function abrirFicheroEntrada(nombre: string): boolean;
begin
   assign( ficheroEntrada, nombre );
   {$I-}
   reset( ficheroEntrada );
   {$I+}
   posicionLineaActual := 0;

   if ioResult = 0 then
     begin
     finFicheroEntrada := false;
     abrirFicheroEntrada := true;
     end
   else
     begin
     finFicheroEntrada := true;
     abrirFicheroEntrada := false;
     end;
end;


(* Cerrar fichero de entrada (al final del analisis) *)
procedure cerrarFicheroEntrada;
begin
  close(ficheroEntrada);
end;

(* Lee una linea del fichero de entrada. Solo para uso interno del lexer *)
procedure leerLinea;
begin
  readln( ficheroEntrada, lineaDeEntrada );
  if eof(ficheroEntrada) then
    finFicheroEntrada := true;
end;

(* Obtiene una letra del fichero. Se apoya en leerLinea: toma la
siguiente letra de "LineaDeEntrada", o lee otra linea del fichero
si la actual ha terminado *)
function obtenerLetra: char;
begin
  if posicionLineaActual >= length(lineaDeEntrada) then
    begin
    leerLinea;
    posicionLineaActual := 0;
    obtenerLetra := ' ';
    end
  else
    begin
    inc(posicionLineaActual);
    obtenerLetra := lineaDeEntrada[posicionLineaActual];
    end;
end;

(* Obtiene un identificador: devuelve una secuencia de letras *)
function obtenerIdentificador: string;
var
  lexema: string;
  letra: char;
begin
  lexema := '';
  letra := obtenerLetra;
  while upcase(letra) in ['A'..'Z'] do
    begin
    lexema := lexema + letra;
    letra := obtenerLetra;
    end;
  (* He leido uno de mas, asi que retrocedo *)
  if posicionLineaActual > 0 then
    dec(posicionLineaActual);
  obtenerIdentificador := lexema;
end;


(* Obtiene un entero: devuelve una secuencia de cifras *)
function obtenerEntero: string;
var
  lexema: string;
  letra: char;
begin
  lexema := '';
  letra := obtenerLetra;
  while upcase(letra) in ['0'..'9'] do
    begin
    lexema := lexema + letra;
    letra := obtenerLetra;
    end;
  (* He leido uno de mas, asi que retrocedo *)
  if posicionLineaActual > 0 then
    dec(posicionLineaActual);
  obtenerEntero := lexema;
end;


(* Obtiene un identificador: devuelve una secuencia de letras *)
procedure leerSimbolo(simbolo:char);
var
  letra: char;
begin
  letra := obtenerLetra;
  if letra <> simbolo then
    begin
    writeln('Se esperaba ',simbolo,' y se ha encontrado ',letra);
    halt;
    end;
end;


begin
end.

Y el código fuente del programa principal será:

program cpcPaChi;


(* Chi - Un compilador de Pascal chiquitito para CPC
   Por Nacho Cabanes - Version 0.03

   Versiones hasta la fecha:

   Num.   Fecha       Cambios
   ---------------------------------------------------
   0.03  25-Mar-2008  Creado un analizador lexico independiente
                      (en la unit "uPaChiL")

   0.02  23-Mar-2008  Admite CLS, LOCATE, WRITECHAR,
                      que lee desde fichero. Solo permite
                      una orden en cada linea, con formato fijo

   0.01  21-Mar-2008  Preliminar: solo acepta CLS por teclado
                      y genera el codigo correspondiente

*)

uses upachil;  (* Analizador lexico *)

const
  lineaActual: integer = 10;
  longitudTotal: integer = 0;

var
  ficheroDestino: text;
  nombreOrigen, nombreDestino: string;
  orden: string;

(* Analiza las opciones que teclee el usuario. Por ahora,
solo el nombre del fichero a compilar *)
procedure analizarOpciones;
begin
  if paramcount >= 1 then
    nombreOrigen := paramstr(1)
  else
    begin
    writeln('No se ha indicado el nombre del fichero');
    halt;
    end;
  abrirFicheroEntrada( nombreOrigen );
  nombreDestino := 'salida.bas';
  assign( ficheroDestino, nombreDestino );
  rewrite( ficheroDestino );
end;


(* Analiza la orden que el usuario ha dado, y sale con un mensaje
de error si es incorrecta *)
procedure analizarUnaOrden;
begin
  orden := upcase(obtenerIdentificador);
  if (orden <> 'CLS')
      and (orden <> 'LOCATE')
      and (orden <> 'WRITECHAR')
      and (orden <> '') then
    begin
    writeln('Error: orden no reconocida. Se esperaba: CLS, LOCATE o WRITECHAR');
    (*halt;*)
    end;
end;


(* Genera el codigo de destino: codigo maquina de Amstrad CPC
dentro de un cargador en Basic *)
procedure generarCodigoUnaOrden;
var
  x, y: byte;
  letra: char;
  codError: integer;
begin
  if orden = 'CLS' then
    begin
    writeln( ficheroDestino, lineaActual,' DATA CD,6C,BB: '' CALL &BB6C - CLS' );
    lineaActual := lineaActual + 10;
    longitudTotal := longitudTotal + 3;
    end;
  if orden = 'WRITECHAR' then
    begin
    leerSimbolo('(');
    leerSimbolo('''');
    letra := obtenerLetra;
    leerSimbolo('''');
    leerSimbolo(')');
    writeln( ficheroDestino, lineaActual,' DATA 3E,',
      hexStr(ord(letra),2), ': '' LD A, "',letra, '"' );
    lineaActual := lineaActual + 10;
    writeln( ficheroDestino, lineaActual,' DATA CD,5A,BB: '' CALL &BB5A - WRITECHAR' );
    lineaActual := lineaActual + 10;
    longitudTotal := longitudTotal + 5;
    end;
  if orden = 'LOCATE' then
    begin
    leerSimbolo('(');
    val(obtenerEntero,x,codError);
    leerSimbolo(',');
    val(obtenerEntero,y,codError);
    leerSimbolo(')');
    writeln( ficheroDestino, lineaActual,' DATA 3E,',
      hexStr(x,2), ': '' LD A, ',x );
    lineaActual := lineaActual + 10;
    writeln( ficheroDestino, lineaActual,' DATA CD,6F,BB: '' CALL &BB6F - CURSOR COLUMN' );
    lineaActual := lineaActual + 10;
    writeln( ficheroDestino, lineaActual,' DATA 3E,',
      hexStr(y,2), ': '' LD A, ',y );
    lineaActual := lineaActual + 10;
    writeln( ficheroDestino, lineaActual,' DATA CD,72,BB: '' CALL &BB72 - CURSOR ROW' );
    (* 10 bytes *)
    lineaActual := lineaActual + 10;
    longitudTotal := longitudTotal + 10;
    end;
end;

(* Genera el codigo de destino final: cargador Basic *)
procedure generarCodigoFinal;
begin
  cerrarFicheroEntrada;

  append( ficheroDestino );
  writeln( ficheroDestino, lineaActual,' DATA C9: '' RET' );
  writeln( ficheroDestino, lineaActual+10,' longitud = ',longitudTotal );
  writeln( ficheroDestino, lineaActual+20,' MEMORY 39999' );
  writeln( ficheroDestino, lineaActual+30,' FOR n=40000 TO 40000+longitud' );
  writeln( ficheroDestino, lineaActual+40,' READ a$:POKE n,VAL("&"+a$)' );
  writeln( ficheroDestino, lineaActual+50,' NEXT' );
  writeln( ficheroDestino, lineaActual+60,' CALL 40000' );
  close(ficheroDestino);
end;