Un compilador sencillo paso a paso (2)

Este segundo acercamiento va a reconocer dos órdenes más: WRITECHAR, que escribirá una única letra en pantalla, y LOCATE, que moverá el cursor a otras coordenadas de pantalla. Además, en vez de aceptar una única orden por teclado, leerá varias desde disco.

Así, aceptará programas como éste:

cls
locate(10,5)
writeChar('a')
locate(1,10)
writeChar('b')

El hecho de que el usuario indique el nombre del fichero no es mucha complicación: vemos con "paramcount" si realmente lo ha detallado, avisamos si no lo ha hecho, y leemos el nombre con "paramstr(1)" en caso contrario:

if paramcount >= 1 then
  nombreOrigen := paramstr(1)
else
  begin
  writeln('No se ha indicado el nombre del fichero');
  halt;
  end;
assign( ficheroOrigen, nombreOrigen );
reset( ficheroOrigen );

En cuanto a la traducción de writeChar('a'), se convertiría en dos órdenes de ensamblador: LD A, &61; CALL &BB5A. El primer problema es que tenemos que crear un código que no será siempre el mismo, sino que dependerá del parámetro que indiquemos entre comillas. Nuestra aproximación por ahora será "poco práctica":tomar la letra que aparece en la posición 12, y usar su código ASCII en hexadecimal:

letra := orden[12];
writeln( ficheroDestino, lineaActual,' DATA 3E,',
  hexStr(ord(letra),2), ': '' LD A, "',letra, '"' );
writeln( ficheroDestino, lineaActual,
  ' DATA CD,5A,BB: '' CALL &BB5A - WRITECHAR' );

Además, para cada nueva línea que generemos, aumentaremos el número de línea del cargador en Basic y la cantidad de bytes de datos que hemos exportado:

lineaActual := lineaActual + 10;
longitudTotal := longitudTotal + 5;

Claramente, esta forma de saber la letra no es buena. ¿Qué ocurre si hay un espacio antes de las comillas? La letra que debemos escribir ya no estaría en la posición 12. Lo mismo ocurrirá si hay algún espacio antes de WRITECHAR o del paréntesis. Por eso, en la próxima aproximación crearemos un primer analizador léxico, que sea capaz de extraer correctamente una palabra, aunque tenga espacios delante.

Por lo que respecta a la traducción de LOCATE, tenemos otro problema: la posición puede ser un número de una cifra o de dos. Hasta que creemos un analizador léxico que nos ayude, de momento volveremos a hacerlo de forma artesanal: leeremos una primera cifra, miraremos si la siguiente es la coma o una cifra numérica, en caso de que sea numérica deberemos multiplicar por 10 la cifra anterior y sumársela... muy trabajoso, pero es lo que haremos por ahora; pronto lo mejoraremos.

En un CPC hay dos formas de situar el cursor: LD A, columna; CALL &BB6F y luego LD A, fila; CALL &BB72, o bien indicar a la vez la fila y la columna el registro HL (H=columna, L=fila) y hacer CALL &BB75. De momento usaremos la primera, que será algo más legible, aunque ocupe un poco más de espacio.

Con estas consideraciones, la parte que genera el código para la primera parte de LOCATE, la columna, todavía de forma muy rudimentaria y trabajosa, será:

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;
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;

Así, el código generado para el programita anterior sería:

10 DATA CD,6C,BB: ' CALL &BB6C - CLS
20 DATA 3E,0A: ' LD A, 10
30 DATA CD,6F,BB: ' CALL &BB6F - CURSOR COLUMN
40 DATA 3E,05: ' LD A, 5
50 DATA CD,72,BB: ' CALL &BB72 - CURSOR ROW
60 DATA 3E,61: ' LD A, "a"
70 DATA CD,5A,BB: ' CALL &BB5A - WRITECHAR
80 DATA 3E,01: ' LD A, 1
90 DATA CD,6F,BB: ' CALL &BB6F - CURSOR COLUMN
100 DATA 3E,0A: ' LD A, 10
110 DATA CD,72,BB: ' CALL &BB72 - CURSOR ROW
120 DATA 3E,62: ' LD A, "b"
130 DATA CD,5A,BB: ' CALL &BB5A - WRITECHAR
140 DATA C9: ' RET
150 longitud = 33
160 MEMORY 39999
170 FOR n=40000 TO 40000+longitud
180 READ a$:POKE n,VAL("&"+a$)
190 NEXT
200 CALL 40000

Y el conjunto de todo el fuente del compilador quedaría así:

program cpcPaChi;

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

   Versiones hasta la fecha:

   Num.   Fecha       Cambios
   ---------------------------------------------------
   0.02  22-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

*)


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

var
  ficheroOrigen, 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;
  assign( ficheroOrigen, nombreOrigen );
  reset( ficheroOrigen );
  nombreDestino := 'salida.bas';
  assign( ficheroDestino, nombreDestino );
  rewrite( ficheroDestino );
end;

(* Obtiene una orden del programa fuente. La toma del fichero de origen *)
procedure obtenerOrden;
begin
  readln(ficheroOrigen,orden);
end;


(* Analiza la orden que el usuario ha dado, y sale con un mensaje
de error si es incorrecta *)
procedure analizarUnaOrden;
begin
  if (upcase(orden) <> 'CLS')
      and (pos('LOCATE',upcase(orden))<>1)
      and (pos('WRITECHAR',upcase(orden))<>1)
      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;
  posicion: byte;
  letra: char;
begin
  if upcase(orden) = 'CLS' then
    begin
    writeln( ficheroDestino, lineaActual,' DATA CD,6C,BB: '' CALL &BB6C - CLS' );
    lineaActual := lineaActual + 10;
    longitudTotal := longitudTotal + 3;
    end;
  if pos('WRITECHAR',upcase(orden))=1 then
    begin
    letra := orden[12];
    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 pos('LOCATE',upcase(orden))=1 then
    begin
    (* 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;
    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;
    (* 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;
    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
  close(ficheroOrigen);

  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;

(* Cuerpo del programa *)
begin
  analizarOpciones;
  while not eof(ficheroOrigen) do
    begin
    obtenerOrden;
    analizarUnaOrden;
    generarCodigoUnaOrden;
    end;
  generarCodigoFinal;
end.