Program Augusta;
{ A public domain subset of the US Deptartment of Defense }
{ computer language Ada. }

{$U+,R+}

const
  CrLf = #13#10; FF = #12;

  quote     = '"';
  alf       = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  lc        = 'abcdefghijklmnopqrstuvwxyz';
  dig       = '0123456789';
  hdig      = '0123456789ABCDEF';
  an        = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_';

  PLDCI = 1; PLDL = 2; PLLA = 3; PLDB = 4; PLDO = 5; PLAO = 6; PDUP = 7;
  PLOD = 8; PLDA = 9; PPOP = 10; PSTO = 11; PSINDO = 12; PLCA = 13;
  PSAS = 14; PAND = 16; POR = 17; PNOT = 18; PADI = 19; PNGI = 20;
  PSBI = 21; PMPI = 22; PDVI = 23; PIND = 24; PEQUI = 25; PNEQI = 26;
  PLEQI = 27; PSLDC = 61; PINCL = 80; PDECL = 81; PLESI = 28; PGEQI = 29;
  PGTRI = 30; PEQUSTR = 31; PNEQSTR = 32; PLEQSTR = 33; PLESSTR = 34;
  PGEQSTR = 35; PGTRSTR = 36; PUJP = 37; PFJP = 38; PXJP = 39; PCLP = 40;
  PCGP = 41; PCSP = 42; PRET = 43; PMODI = 45; PCIP = 46; PRNP = 47;
  PEOP = 15; PSLDCN1 = 63; PIXA = 48; PSLDO = 57; PSLAO = 58; PSLLA = 59;
  PSLDLO = 49; PSLDL = 60;

  squote = 0; eol = 1; c = 2; lp = 3; rp = 4;
  mul = 5; kdiv = 6; add = 7; subt = 8; les = 9; leq = 10; gt = 11;
  geq = 12; eq = 13; neq = 14; bar = 15; kid = 16;
  sc = 17; comma = 18; semicolon = 19; colon = 20; eqgt = 21;
  coloneq = 22; dot = 23; dotdot = 24; kch = 25; at = 26;
  kand = 27; karray = 28; kbegin = 29; kcase = 30; kconst = 31;
  kdeclare = 32; kelse = 33; kelseif = 34; kend = 35; kexit = 36;
  kfor = 37; kfunc = 38; kif = 39; kin = 40; kis = 41; kloop = 42;
  klast = 43; klen = 44; kmod = 45; knot = 46; knull = 47; kof = 48;
  kor = 49; kothers = 50; kout = 51; kpragma = 52; kproc = 53;
  kret = 54; kreverse = 55; kthen = 56; kwhen = 57; kwhile = 58;

  TSTR = 0; TINT = 1; TCHR = 2; TBOL = 4; FMSZ = 14; NKEY = 33; MB = 3;

  { Define sets of token numbers as character strings }
  addop     = #7#8;              { ADD,SUBT }
  mulop     = #5#6#45;           { MUL,KDIV,KMOD }
  logicalop = #27#49;            { KAND,KOR }
  unaryop   = #7#8#46;           { ADD,SUBT,KNOT }
  relop     = #9#10#11#12#13#14; { LES,LEQ,GT,GEQ,EQ,NEQ }
  declpartx = #16#53#38#52;      { ID,KPROC,KFUNC,KPRAGMA }
  stmtx     = #58#37#42#32#29#36#54#39#30#47#16#52;
   { KWHILE,KFOR,KLOOP,KDECLARE,KBEGIN,KEXIT,KRET,KIF,KCASE,KNULL,ID,KPRAGMA }

type
  anystring       = string[255];
  string2         = string[2];
  string8         = string[8];
  proc_entry_type = record
                      T1 : array[1..2] of char;
                      T2 : array[1..2] of char;
                      T3 : array[1..2] of char;
                      D  : array[1..2] of char;
                      S  : array[1..2] of char;
                    end;
  buffer_type     = array[1..128] of char;

var
  spaces,lexch    : anystring;  { constant strings too long to declare }
  null_rec        : buffer_type;
  Plst,Clst       : boolean;    { true if print or crt listing are on }
  LP_Str          : anystring;  { printer init string, read from datafile }
  C_Str           : anystring;

  MAP             : array[0..26] of integer;
  KEYWD           : array[0..33] of string8;
  S_str           : array[0..100] of anystring;
  TY              : array[0..20] of integer;
  buffer          : array[0..Mb] of buffer_type;
  B               : array[0..Mb] of integer;
  D               : buffer_type;
  S               : array[0..500] of integer;
  buf             : anystring; { holds the current line }
  B_ptr,Oldb      : integer;   { indexes into buf }
  Ch              : char;      { the most recent char out of buf }
  sym_str         : anystring;
  Id              : string8; { formatted symbol string }
  infile          : array[2..4] of text; { input file variables }
  isopen          : array[2..4] of boolean;
  One             : file of buffer_type; { code output file }
  Ln              : integer;   { line number being proceesed }
  Eoi             : boolean;   { true for end of input }
  LL,L1,P1,C1     : integer;
  Cproc,proc      : integer;   { proc # being compiled, proc count }
  M0              : integer;   { maximum code record }
  TSP,SSP         : integer;   { internal type and symbol stack counter }
  GC,CP,CB,SP     : integer;   { various code pointers }
  SI              : integer;   { input file number (changes with includes) }
  pType,Kind,
  Pinfo,pConst,
  Ofst,MxOf,Addr,
  ObjSz,Lex       : integer;   { procedure descriptors }
  I,J,X,W,Hash    : integer;
  R0,R1,R2        : integer;   { record numbers }
  T1,T2,T3,T4,
  T5,T6,T7,T8     : integer;
  T1_Str,T2_Str   : anystring;
  LOC1,LOC2       : integer;
  T,T0,TN         : integer;   { token numbers and values }
  TT              : char;      {  and character equivalents for search }
  XitJp,LFjp,LUjp : integer;   { heads of lists of jumps to be patched }
  lpflg           : integer; { non-zero when inside a LOOP-END structure }
  cases           : integer;

Procedure ShowErr(E : integer);
begin
  writeln(CrLf,'*** Error ',E,' in line ',LN,CrLf,BUF);
  writeln(copy(spaces,1,B_ptr-1),'*');
  if PLST then writeln(Lst,'*** Error ',E,' in line ',LN);
end;

Procedure Error(E : integer);
begin
  showerr(E);
  for SI:=2 to 4 do if isopen[SI] then close(infile[SI]);
  close(One);
  halt;
end;

Procedure Expected(E : integer);
begin
  writeln(CrLf,T0,' expected'); ShowErr(E);
end;

Function MKI(I : integer): string2;
begin
  mki := chr(lo(I)) + chr(hi(I));
end;

Procedure Push(X : integer);
{ 4280 '********** Push }
begin
  S[SP] := X; SP := SP + 1;
end;

Procedure Pop(var X : integer);
{ 4300 '********** Pop }
begin
  SP := SP - 1; X := S[SP];
end;

Procedure PushSyms;
{ 5400 '********** Push Syms }
begin
  X := LENgth(S_str[SSP]);
  IF X=255 THEN begin
    SSP := SSP + 1; s_str[SSP] := '';
    X := 0;
  end;
  Push(X); X := SSP; Push(X);
end;

Procedure PopSyms;
{ 5500 '********** Pop Syms }
begin
  Pop(X);
  FOR I:=X+1 TO SSP do S_str[I] := '';
  SSP := X; Pop(X); LOC2 := X;
end;

Procedure GetBuf;
{ 4140 '********** GetBuf }
var
  temp : integer;
begin
  R1 := (CP + CB) div 128 + 1; R2 := (CP + CB) and 127;
  IF R1<>R0 THEN begin
    J := 0;
    for temp:=1 to MB do
      if (B[temp]=R0) or (B[temp]=0) then J := temp;
    IF J<>0 THEN begin
      Buffer[J] := D; B[J] := R0; END
    else begin
      Buffer[0] := D;
      J := trunc(Random*MB) + 1;
      D := Buffer[J];
      while filesize(One)<(B[J]-1) do begin
        seek(One,filesize(One)); write(One,null_rec);
      end;
      Seek(One,B[J]-1); write(One,D);
      Buffer[J] := Buffer[0]; B[J] := R0;
    end;
    J := 0;
    for temp:=1 to MB do
      if B[temp]=R1 then J := temp;
    IF J<>0 THEN begin
      D := Buffer[J]; R0 := R1;
      IF R1>M0 THEN M0 := R1; end
    else begin
      if R1>filesize(One) then
        D := null_rec
      else begin
        seek(One,R1-1); Read(One,D);
      end;
      R0 := R1;
      IF R1>M0 THEN M0 := R1;
    end;
  end;
end;

Procedure ReadByte;
{ 4260 '********** ReadByte }
begin
  GetBuf;
  W := ord(D[R2+1]);
end;

Procedure ReadWrd;
{ 4010 '********** read wrd }
begin
  ReadByte; T1 := W;
  CP := CP + 1;
  ReadByte; W := (W shl 8) + T1;
  CP := CP - 1;
end;

Procedure GenByte;
{ 3990 '********** GenByte }
begin
  GetBuf;
  D[R2+1] := CHR(W);
  CP := CP + 1;
end;

Procedure GenWord;
{ 4030 '********** GenWord W }
var
  temp    : integer;
  tmp_str : string[2];
begin
  GetBuf;
  IF R2<127 THEN begin
    tmp_str := MKI(W);
    D[R2+1] := tmp_str[1]; D[R2+2] := tmp_str[2];
    CP := CP + 2; end
  else begin
    temp := W;
    W := W and 255;  GenByte;
    W := temp shr 8; GenByte;
  end;
end;

Procedure Open_source;
{1230 }
begin
  SI := SI + 1;
  if SI in[2..4] then begin
    assign(infile[SI],sym_str); reset(infile[SI]); isopen[SI] := true;
    end
  else begin
    writeln('Bad file number :',SI); halt;
  end;
end;

Procedure Getline;
{ 1280 }
begin
  repeat
    LN := LN + 1;
    IF EOF(infile[SI]) THEN begin
      CLOSE(infile[SI]);
      SI := SI - 1;
      IF (SI>1) AND PLST THEN writeln(lst,'* End of INCLUDE');
    end;
    IF SI=1 THEN
      EOI := true
    else begin
      readln(infile[SI],BUF);
      IF PLST THEN begin
        writeln(lst,ln:5,' ',cproc:4,' ',cp:6,' ',ofst:6,' ',copy(BUF,1,54));
        if (LN MOD 60)=0 THEN writeln(lst,ff,LP_Str);
      end;
      IF CLST THEN
        writeln(BUF)
      else IF (LN AND 63)=63 THEN
        writeln(LN,'...');
    end;
  until (buf>'') or EOI;
  if not EOI then begin
    BUF := BUF + CHR(3); B_ptr := 1;
    WHILE BUF[B_ptr]=' ' do B_ptr := B_ptr + 1;
    CH := BUF[B_ptr]; B_ptr := B_ptr + 1;
  end;
end;

Procedure Getch;
{ 1360 '********** GetCh }
begin
  CH := BUF[B_ptr]; B_ptr := B_ptr + 1;
end;

Procedure LookupKeyword;
begin
  HASH := MAP[pos(id[1],ALF)];
  while keywd[hash]<ID do HASH := HASH + 1;
  if keywd[hash]=id then
    T := hash + 26
  else
    T := kID;
end;

Procedure GetSStr;
{ 1930 '********** Get S$ }
begin
  Sym_str := copy(BUF,OLDB-1,B_ptr-OLDB); {1940}
end;

Procedure Getsym;
{ 1400 '********** GetSym }
var
  flag : boolean;
  I1   : integer;
begin
  repeat
    oldb := b_ptr; Ch := upcase(Ch);
    I := pos(ch,LEXCH);
    IF I=0 THEN Error(1);
    IF I<27 THEN begin
      sym_str := '';
      while pos(ch,an)<>0 do begin
        IF CH<>'_' THEN Sym_str := Sym_str + CH;
        GetCh; Ch := upcase(Ch);
      end;
      IF LENgth(Sym_str)>8 THEN Sym_str := copy(Sym_str,1,8);
      ID := Sym_str + copy(SPACEs,1,8-LENgth(Sym_str));
      LookupKeyword;
      end
    else begin
      case I of
      27..36: begin
                TN := 0; I1 := 10;
                repeat
                  flag := true;
                  WHILE pos(ch,HDIG)<>0 do begin
                    TN := TN * I1 + pos(ch,HDIG) - 1;
                    Getch;
                  end;
                  IF CH='#' THEN begin
                    flag := false; I1 := TN; TN := 0; Getch;
                  end;
                until flag;
                T := C;
              end;
          37: begin
                WHILE CH=' ' do begin
                  CH := BUF[B_ptr]; B_ptr := B_ptr + 1;
                end;
                OLDB := B_ptr;
              end;
          38: begin
                T := AT; Getch;
              end;
          39: begin
                T := MUL; Getch;
              end;
          40: begin
                T := ADD; Getch;
              end;
          41: begin
                Getch;
                IF CH='>' THEN begin
                  T := EQGT; Getch;
                  end
                ELSE T := EQ;
              end;
          42: begin
                T := SUBT; Getch;
                IF CH='-' THEN begin
                  Getline; OLDB := B_ptr;
                end;
              end;
          43: begin
                Getch;
                IF CH='=' THEN begin
                  T := LEQ; Getch;
                  end
                ELSE T := LES;
              end;
          44: begin
                Getch;
                IF CH='=' THEN begin
                  T := GEQ; Getch;
                  end
                ELSE T := GT;
              end;
          45: begin
                Getch;
                IF CH='=' THEN begin
                  T := NEQ; Getch;
                  end
                ELSE T := kDIV;
              end;
          46: begin
                Getch;
                IF CH='=' THEN begin
                  T := COLONEQ; Getch;
                  end
                ELSE T := COLON;
              end;
          47: begin
                T := SEMICOLON; Getch;
              end;
          48: begin
                Getch; Getch;
                IF CH<>#39 THEN error(11);
                Getch; GetSStr;
                TN := ord(Sym_str[2]); T := kCH;
              end;
          49: begin
                T := RP; Getch;
              end;
          50: begin
                T := LP; Getch;
              end;
          51: begin
                T := COMMA; Getch;
              end;
          52: begin
                I1 := pos('"',copy(buf,b_ptr,255));
                IF I1=0 THEN error(10);
                Sym_str := copy(BUF,B_ptr,I1-1);
                T := SC; B_ptr := B_ptr + I1; Getch;
              end;
          53: begin
                T := DOT; Getch;
                IF CH='.' THEN begin
                  T := DOTDOT; Getch;
                end;
              end;
          54: begin
                T := BAR; Getch;
              end;
          55: begin
                T := BAR; Getch;
              end;
          56: begin
                GetLine; OLDB := B_ptr;
              end;
          57: begin
                T := SQUOTE; Getch;
              end;
          58: begin
                Getch;
                OLDB := B_ptr;
              end;
        end;
    end;
    IF EOI THEN error(12);
  until oldb<>b_ptr;
  TT := CHR(T);
end;

Procedure AddID;
{ 3850 '********** Add ID }
begin
  IF (LENgth(S_str[SSP])+17)>255 THEN begin
    SSP := SSP + 1; s_str[ssp] := '';
  end;
  insert(ID+CHR(pTYPE)+CHR(KIND)+CHR(PINFO)+MKI(pCONST)+CHR(OBJSZ)
    +MKI(ADDR)+CHR(LL),s_str[SSP],1);
end;

Procedure LookupID;
{ 3890 '********** Lookup ID }
var
  work : anystring;
begin
  LOC1 := SSP; Loc2 := 0;
  while (loc1>0) and (Loc2=0) do begin
    LOC2 := pos(ID,S_str[LOC1]);
    IF LOC2=0 THEN LOC1 := LOC1 - 1;
  end;
  IF LOC1<1 THEN Error(2);
  work := s_str[loc1];
  pTYPE := ord(work[loc2+8]); KIND := ord(work[loc2+9]);
  PINFO := ord(work[loc2+10]);
  pCONST := ord(work[loc2+11]) + (ord(work[loc2+12]) shl 8);
  OBJSZ := ord(work[loc2+13]);
  ADDR := ord(work[loc2+14]) + (ord(work[loc2+15]) shl 8);
  LEX := ord(work[loc2+16]);
end;

Procedure TestToken;
var
  T_Str : anystring;
begin
  while T0<>T do begin {1950}
    expected(4);
    write('Reenter+ ');
    readln(T_str); BUF := copy(BUF,1,B_ptr-1) + T_str + CHR(3);
    Getch; Getsym;
  end;
end;

Procedure TstToken_GetNext;
begin
  IF T0<>T THEN TestToken;
  Getsym;
end;

Procedure Get_C;
{ 2290 '********** Get C }
var
  v1,v2,v3,v4,v5,v6 : integer; { temp variables to preserve the id }
begin
  IF T=kID THEN begin
    V1 := pTYPE;    V2 := KIND;    V3 := PINFO;
    V4 := pCONST;   V5 := OBJSZ;   V6 := LL;
    LookupID;
    IF (KIND=0) AND (pTYPE=1) THEN begin
      T := C; T2 := pCONST;
    end;
    pTYPE := V1; KIND := V2; PINFO := V3; pCONST := V4; OBJSZ := V5; LL := V6;
  end;
  T0 := C; TstToken_GetNext;
end;

Procedure Pragma;
{ 2770 '********** Pragma }
var
  t_str : string8;
begin
  while T=KPRAGMA do begin
    Getsym;
    if sym_str='CRT' then begin
      Getsym; T0 := LP; TstToken_GetNext; T_str := Sym_str;
      Getsym; T0 := RP; TstToken_GetNext;
      IF T_str='ON' THEN
        CLST := true
      ELSE
        CLST := false;
      end
    else if sym_str='INCLUDE' then begin
      Getsym; T0 := LP; TstToken_GetNext;
      IF T<>SC THEN Error(9) ELSE begin
        Open_Source; Getsym; T0 := RP; TstToken_GetNext;
      end; end
    else if sym_str='LIST' then begin
      Getsym; T0 := LP; TstToken_GetNext; T_str := Sym_str;
      Getsym; T0 := RP; TstToken_GetNext;
      IF T_str='ON' THEN begin
        PLST := true; write(lst,lp_str); end
      ELSE IF T_str='OFF' THEN
        PLST := false;
    end;
    Getline; Getsym;
  end;
end;

Procedure SubTIDUnit;
{ 2250 '********** SubtypeIdentificationUnit }
begin
  LookupID;
  IF KIND<>4 THEN error(8);
  IF PINFO=0 THEN KIND := 1 ELSE KIND := 5;
  IF pTYPE<>0 THEN
    Getsym
  else begin
    Getsym;
    IF T=LP THEN begin
      Getsym; Get_C; OBJSZ := TN + 1; T0 := RP; TstToken_GetNext;
    end;
    IF OBJSZ>255 THEN error(15);
  end;
end;

Procedure ProcDef;
{ 5200 '********** Proc DEF }
begin
  LL := LL + 1; Push(cproc); Push(OFST); Push(MXOF); T0 := kID; TestToken;
  PushSyms;
end;

Procedure ProcFormalPart;
{ 2100 '********** ProcFormalPart }
var
  flag : boolean;

  Procedure ProcParamDecl;
  { 2160 '********** ProcParamDecl }
  var
    flag : boolean;
  begin
    T1_str := '';
    repeat
      flag := true; T0 := kID; TestToken;
      T1_str := T1_str + ID; Getsym;
      IF T=COMMA THEN begin
        Getsym; flag := false;
      end;
    until flag;
    T0 := COLON; TstToken_GetNext; P1 := 1;
    IF T=KOUT THEN begin
      P1 := 2; Getsym; end
    else IF T=KIN THEN Getsym;
    SubTIDUnit; PINFO := P1;
    WHILE LENgth(T1_str)>0 do begin
      T2_str := T2_str + copy(T1_str,1,8) + CHR(pTYPE) + CHR(KIND) + CHR(PINFO)
            + MKI(pCONST) + CHR(OBJSZ) + MKI(0) + CHR(LL);
      delete(T1_str,1,9);
      OFST := OFST-2;
    end;
  end;

begin
  T2_str := ''; T0 := LP; TstToken_GetNext;
  repeat
    flag := true;
    ProcParamDecl;
    IF T=SEMICOLON THEN begin
      Getsym; flag := false;
    end;
  until flag;
  T0 := RP; TstToken_GetNext;
  I := OFST;
  repeat
    T1_str := copy(T2_str,1,17); delete(T2_str,1,17);
    IF (LENgth(S_str[SSP])+17)>255 THEN begin
      SSP := SSP + 1; s_str[SSP] := '';
    end;
    insert(copy(T1_str,1,14)+MKI(I)+T1_str[length(T1_str)],S_str[SSP],1);
    I := I + 2;
  until I>(-FMSZ-2);
end;

Procedure ProcEndDef;
{ 5300 '********** Proc END DEF }

  Procedure WriteProc;
  { 4910 '********** WriteProc }
  begin
    T2 := CP; T3 := CB; CB := 0; CP := (ADDR-1)*7 + 128;
    W := C1 - 1920; GenWord; W := L1; GenWord; W := P1; GenWord;
    W := LL; GenByte; CP := T2; CB := T3;
  end;

begin
  W := PEOP; GenByte; Pop(P1); Pop(ADDR); CPROC := ADDR; L1 := MXOF;
  C1 := GC; WriteProc; GC := GC + CP;
  LL := LL - 1;
  PopSyms; Delete(S_str[SSP],1,length(s_str[ssp])-LOC2-17);
  Pop(MXOF); Pop(OFST); Pop(X); CPROC := X;
end;

Procedure BodyPart; forward;
{ parseproc -> bodypart -> declpart -> parseproc or parsefunc. }
{ One has to be Forwarded }

Procedure ParseProc;
{ 2010 '********** Parse Proc }
begin
  ProcDef;
  KIND := 2; PROC := PROC + 1; CPROC := PROC; ADDR := PROC;
  X := ADDR; Push(X); AddID; Getsym;
  OFST := -FMSZ;
  IF T<>KIS THEN begin
    ProcFormalPart;
    T0 := KIS; TestToken;
  end;
  X := -(OFST+FMSZ); Push(X);
  Getsym;OFST := 0; MXOF := 0; BodyPart;
  W := PRET; GenByte;
  ProcEndDef;
end;

Procedure ParseFunc;
{ 2340 '********** ParseFunc }
begin
  ProcDef;
  KIND := 3; PROC := PROC + 1; CPROC := PROC; ADDR := PROC;
  X := ADDR; Push(X); AddID;
  Push(SSP); X := LENgth(S_str[SSP]); Push(X);
  Getsym; OFST := -FMSZ;
  IF T=LP THEN ProcFormalPart;
  T0 := KRET; TstToken_GetNext; SubTIDUnit; Pop(T2);
  Pop(X); T1 := X; T3 := LENgth(S_str[T1]);
  IF (KIND<>5) OR (OBJSZ<>2) THEN error(16);
  S_str[T1][T3-T2+9] := CHR(pTYPE);
  T0 := KIS; TstToken_GetNext;
  X := -(OFST+FMSZ); Push(X);
  OFST := 0; MXOF := 0; BodyPart; ProcEndDef;
end;

Procedure DeclPart;
{ 2480 '********** DeclPart }
var
  K1   : integer;

  Procedure ObjDecl;
  { 2560 '********** ObjDecl }
  var
    objsize : integer;
  begin
    Getsym;
    while T=COMMA do begin
      Getsym; T0 := kID; TestToken;
      T1_str := T1_str + ID;
      GetSym;
    end;
    T0 := COLON; TstToken_GetNext;
    IF T=KCONST THEN begin
      K1 := 0; OBJSIZE := 0; Getsym; T0 := COLONEQ; TstToken_GetNext;
      IF T=kID THEN
        LookupID
      ELSE begin
        IF T=SUBT THEN begin
          T1 := -1; Getsym; end
        ELSE T1 := 1;
        pCONST := TN*T1;
        IF T=C THEN pTYPE := 1 ELSE pTYPE := 2;
      end;
      Getsym;
      end
    else IF T=KARRAY THEN begin
      K1 := 1; Getsym; T0 := LP; TstToken_GetNext; T2 := TN; Get_C;
      T0:= RP; TstToken_GetNext; T0 := KOF; TstToken_GetNext;
      SubTIDUnit; pCONST := T2; OBJSIZE := (T2+1)*OBJSZ;
      IF (T2<0) OR (T2>16383) THEN error(15);
      end
    else begin
      SubTIDUnit; OBJSIZE := OBJSZ;
    end;
    PINFO := 0; KIND := K1;
    WHILE LENgth(T1_str)>0 do begin
      ID := copy(T1_str,1,8); delete(T1_str,1,8);
      ADDR := OFST; OFST := OFST + OBJSIZE;
      AddID;
    end;
  end;

begin
  case T of
        kID: begin
               T1_str := ID; K1 := 5; ObjDecl;
               IF T=SEMICOLON THEN Getsym ELSE expected(13);
             end;
      KPROC: begin
               Getsym; ParseProc;
               IF T=SEMICOLON THEN Getsym ELSE expected(13);
             end;
      KFUNC: begin
               Getsym; ParseFunc;
               IF T=SEMICOLON THEN Getsym ELSE expected(13);
             end;
    KPRAGMA: Pragma
        else error(3);
  end;
  IF pos(TT,DECLPARTx)<>0 THEN
    declpart
  ELSE IF OFST>MXOF THEN MXOF := OFST;
end;

Procedure B_B;
begin
  GenByte; W := ADDR; GenByte;
end;

Procedure B_W;
begin
  GenByte; W := ADDR; GenWord;
end;

Procedure LDCons;
{ 3635 '********** LD Cons }
begin
  case TN of
         -1 : begin
                W := PSLDCN1; Genbyte
              end;
      0..15 : begin
                W := 64 + TN; Genbyte;
              end;
    16..255 : begin
                W := PSLDC; GenByte; W := TN; GenByte;
              end;
        else  begin
                W := PLDCI; GenByte; W := TN; GenWord;
              end;
  end;
end;

Procedure LDVal;
{ 3820 '********** LD Val }
begin
  IF LEX=1 THEN
    IF ADDR<256 THEN begin
      W := PSLDO; B_B; end
    ELSE begin
      W := PLDO; B_W;
    end
  ELSE IF LEX=LL THEN
    IF (ADDR>=0) AND (ADDR<8) THEN begin
      W := PSLDLO + ADDR; GenByte; end
    else IF (ADDR>7) AND (ADDR<256) THEN begin
      W := PSLDL; B_B; end
    ELSE begin
      W := PLDL; B_W;
    end
  ELSE begin
    W := PLOD; GenByte; W := LL - LEX; B_W;
  end;
end;

Procedure LDAdr;
{ 4060 '********** LD Adr }
begin
  IF PINFO=2 THEN
    LDVal
  else IF LEX=1 THEN
    IF ADDR<256 THEN begin
      W := PSLAO; B_B; end
    ELSE begin
      W := PLAO; B_W;
    end
  ELSE IF LEX=LL THEN
    IF (ADDR>=0) AND (ADDR<256) THEN begin
      W := PSLLA; B_B; end
    ELSE begin
      W := PLLA; B_W;
    end
  ELSE begin
    W := PLDA; GenByte; W := LL - LEX; B_W;
  end;
end;

Procedure CheckBool;
{ 4930 '********** Check Bool }
begin
  IF TY[TSP]<>TBOL THEN Error(9);
  TSP := TSP - 1;
end;

Procedure CheckInt;
{ 4960 '********** Check Int }
begin
  IF TY[TSP]<>TINT THEN Error(9);
  TSP := TSP - 1;
end;

Procedure Expr; forward;
{ primary -> actualparam -> expr -> se -> primary. One has to be forwarded }

Procedure ActualParam;
{ 3570 '********** ActualParam }
begin
  IF T=AT THEN begin
    Getsym; T0 := kID; TestToken; LookupID;
    LDAdr; Getsym;
    IF KIND=1 THEN begin
      X := OBJSZ; Push(X);
      T0 := LP; TstToken_GetNext; Expr; CheckInt; Pop(X);
      IF X=2 THEN
        W := PIND
      ELSE begin
        W := PIXA; GenByte; W := X;
      end;
      GenByte; T0 := RP; TstToken_GetNext;
      end;
    end
  ELSE begin
    Expr; TSP := TSP - 1;
  end;
  IF T=COMMA THEN begin
    Getsym; ActualParam;
  end;
end;

Procedure CallProc;
{ 4100 '********** Call Proc }
begin
  Pop(LEX); Pop(X); ADDR := X;
  if Lex=0 then
    W := PCSP
  else if Lex=2 then
    W := PCGP
  else if LEX=(LL+1) then
    W := PCLP
  else W := PCIP;
  GenByte; W := ADDR; GenByte;
end;

Procedure Se;

  Procedure Term;
  { 3350 '********** Term }

    Procedure Primary;
    { 3610 '********** Primary }
    begin
      case T of
        LP  : begin
                Getsym; Expr; T0 := RP; TstToken_GetNext;
              end;
        C   : begin
                TSP := TSP + 1; TY[TSP] := TINT; LDCons; Getsym;
              end;
        kCH : begin
                TSP := TSP + 1; TY[TSP] := TCHR; LDCons; Getsym;
              end;
        SC  : begin
                TSP := TSP + 1; TY[TSP] := TSTR;
                W := PLCA; GenByte; W := LENgth(Sym_str); GenByte;
                FOR I:=1 TO LENgth(Sym_str) do begin
                  W := ord(Sym_str[I]); GenByte;
                end;
                Getsym;
              end;
         else begin
           T0 := kID; TestToken; LookupID;
           IF KIND=0 THEN begin
             TSP := TSP + 1; TY[TSP] := pTYPE; TN := pCONST; LDCons;
             Getsym; end
           else begin
             Getsym;
             IF T=SQUOTE THEN begin
               TSP := TSP + 1; TY[TSP] := TINT; Getsym;
               IF T=KLAST THEN begin
                 W := PLDCI; GenByte; W := pCONST; GenWord; Getsym; end
               else IF T=KLEN THEN begin
                 LDAdr; W := PLDB; GenByte; end
               ELSE Error(7); end
             else IF KIND=4 THEN begin
               X := pTYPE; Push(X); T0:=LP; TstToken_GetNext;
               Expr; T0:=RP; TstToken_GetNext;
               Pop(X); TY[TSP] := X; end
             else begin
               TSP := TSP + 1; TY[TSP] := pTYPE;
               IF pTYPE=0 THEN
                 IF KIND=1 THEN begin
                   LDAdr; X := OBJSZ; Push(X); T0 := LP; TstToken_GetNext;
                   Expr;
                   IF TY[TSP]<>TINT THEN Error(9);
                   TSP := TSP - 1; Pop(X); W := PIXA; GenByte;
                   W := X; GenByte; T0 := RP; TstToken_GetNext; end
                 else LDAdr
               else IF KIND=1 THEN begin
                 LDAdr; T0 := LP; TstToken_GetNext; Expr;
                 IF TY[TSP]<>TINT THEN Error(9);
                 TSP := TSP - 1; W := PIND; GenByte;
                 W := PSINDO; GenByte; T0 := RP; TstToken_GetNext; end
               else IF KIND=3 THEN begin
                 Push(ADDR); X := LEX; Push(X);
                 IF T=LP THEN begin
                   Getsym; ActualParam; T0 := RP; TstToken_GetNext;
                 end;
                 CallProc; end
               else begin
                 LDVal;
                 IF PINFO=2 THEN begin
                   W := PSINDO; GenByte;
                 end;
               end;
             end;
           end;
         end;
      end;
    end;

  begin
    Primary;
    while pos(TT,MULOP)<>0 do begin
      X := T; Push(X); Getsym; Primary;
      IF (TY[TSP]<>TY[TSP-1]) OR (TY[TSP]<>TINT) THEN Error(9);
      TSP := TSP - 1;
      Pop(X);
      IF X=MUL THEN
        W := PMPI
      ELSE IF X=kDIV THEN
        W := PDVI
      ELSE W := PMODI;
      GenByte;
    end;
  end;

begin
  IF pos(TT,UNARYOP)<>0 THEN begin
    Push(T); X := 1; Push(1); Getsym; end
  ELSE begin
    X := 0; Push(0);
  end;
  Term; Pop(X);
  IF X=1 THEN begin
    Pop(X);
    IF X=SUBT THEN begin
      W := PNGI; GenByte; end
    ELSE begin
      W := PNOT; GenByte;
    end;
  end;
  while pos(TT,ADDOP)<>0 do begin
    X := T; Push(X); Getsym; Term; Pop(X);
    IF X=ADD THEN W := PADI ELSE W := PSBI;
    IF TY[TSP]<>TINT THEN error(9);
    TSP := TSP - 1; GenByte;
  end;
end;

Procedure Expr;
{ 3100 '********** Expr }
var
  Prev : integer;

  Procedure Relation;
  { 3190 '********** Relation }
  begin
    Se;
    IF pos(TT,RELOP)<>0 THEN begin
      X := T; Push(X); Getsym; Se;
      IF (TY[TSP]=TINT) or (TY[TSP]=TCHR) or (TY[TSP]=TBOL) THEN begin
        IF TY[TSP]<>TY[TSP-1] THEN Error(9) ELSE begin
          TSP := TSP - 1; TY[TSP] := TBOL;
        end;
        Pop(X);
        case X of
          LES : w := PLESI;
          LEQ : W := PLEQI;
           GT : W := PGTRI;
          GEQ : W := PGEQI;
           EQ : W := PEQUI;
          NEQ : W := PNEQI;
        end; end
      else begin
        IF (TY[TSP]<>TSTR) OR (TY[TSP]<>TY[TSP-1]) THEN Error(9) else begin
          TSP := TSP - 1; TY[TSP] := TBOL;
        end;
        Pop(X);
        case X of
          LES : W := PLESSTR;
          LEQ : W := PLEQSTR;
           GT : W := PGTRSTR;
          GEQ : W := PGEQSTR;
           EQ : W := PEQUSTR;
          NEQ : W := PNEQSTR;
        end;
      end;
      GenByte;
    end;
  end;

begin
  Relation; LFJP := 0; PREV := 0;
  while pos(TT,Logicalop)<>0 do begin
    X := T; GetSym;
    IF (X=KAND) AND (T=KTHEN) THEN
      X := KAND + KTHEN
    ELSE IF (X=KOR) AND (T=KELSE) THEN
      X := KOR + KELSE;
    IF (PREV<>0) AND (PREV<>X) THEN Error(10);
    if (X=KAND) or (X=KOR) then begin
      Push(X); Relation;
      IF (TY[TSP]<>TBOL) OR (TY[TSP]<>TY[TSP-1]) THEN Error(9);
      TSP := TSP - 1; Pop(X); PREV := X;
      IF X=KAND THEN W := PAND ELSE W := POR;
      end
    else begin
      Push(X); T1 := X; W := PDUP; GenByte;
      IF T1=(KAND+KTHEN) THEN W := PFJP ELSE W := PNOT; GenByte;
      W := PFJP; GenByte;
      W := LFJP; LFJP := CP; GenWord;
      GetSym; X := LFJP; Push(X); Relation;
      IF (TY[TSP]<>TBOL) OR (TY[TSP]<>TY[TSP-1]) THEN Error(9);
      TSP := TSP - 1; Pop(LFJP); Pop(X); PREV := X;
      IF PREV=(KAND+KTHEN) THEN W := PAND ELSE W := POR;
    end;
    genbyte;
  end;
  if prev<>0 then begin
    T2 := CP;
    WHILE LFJP<>0 do begin
      CP := LFJP;
      ReadWrd; LFJP := W;
      W := T2 - CP - 2; GenWord;
    end;
    CP := T2;
  end;
end;

Procedure Stmt; forward;
{ stmt -> seqofstmts -> stmt. one has to be forwarded }

Procedure SeqOfStmts;
{ 2810 '********** SeqOfStmts }
var
  flag  : boolean;

  Procedure Loop1; {4590}
  begin
    T0 := KLOOP; TstToken_GetNext; Push(XITJP); XITJP := 0; X := LPFLG; Push(X);
    LPFLG := -1; SeqOfStmts; T0 := KEND; TstToken_GetNext;
    T0 := KLOOP; TstToken_GetNext; Pop(T5); Pop(X); T6 := X;
    IF T=SEMICOLON THEN Getsym ELSE expected(13);
  end;

  Procedure Loop2; {4620}
  begin
    T2 := CP;
    WHILE XITJP<>0 do begin
      CP := XITJP; ReadWrd; XITJP := W; W := T2 - CP - 2; GenWord;
    end;
    CP := T2; LPFLG := T5; XITJP := T6;
  end;

  Procedure FixFJP;
  begin
    T1 := CP; Pop(CP); W := T1-CP-2; GenWord; CP := T1;
  end;

  Procedure GenUJP;
  { 3060 '********** Gen UJP }
  begin
    W := PUJP; GenByte; W := LUJP; LUJP := CP; GenWord;
  end;

  Procedure Four780;
  begin
    T0 := EQGT; TstToken_GetNext; Push(CP); Push(T1); Push(LUJP);
    CASES := CASES + 1; X := CASES; Push(X); SeqOfStmts; W:= PUJP; GenByte;
    Pop(CASES); Pop(X); W := X; LUJP := CP; GenWord;
  end;

begin
  I := pos(TT,STMTx);
  while I<>0 do begin
    I := pos(TT,STMTx);
      case I of
        1..3: begin
                if T=KWHILE then begin
                  Getsym; X := CP; Push(X); Expr; CheckBool;
                  W := PFJP; GenByte; X := CP; Push(X); W := 0; GenWord;
                  Loop1; Pop(X); T1 := CP; CP := X; W := T1 - CP + 1; GenWord;
                  CP := T1; W := PUJP; GenByte; Pop(X);
                  W := X - CP - 2; GenWord; Loop2; end
                else if T=KFOR then begin
                  Getsym; T0 := kID; TestToken; X := OFST; Push(X); PushSyms;
                  ADDR := OFST; pTYPE := 1; KIND := 5; PINFO := 0; AddID;
                  Getsym; T0 := KIN; TstToken_GetNext;
                  IF T=KREVERSE THEN begin
                    X := -1; Getsym; end
                  ELSE X := 1;
                  Push(X); W := PLLA; GenByte; W := OFST; GenWord;
                  Se; CheckInt; W := PSTO; GenByte;
                  X := CP; Push(X); W := PLDL; GenByte; W := OFST; GenWord;
                  T0 := DOTDOT; TstToken_GetNext; Se; CheckInt;
                  Pop(T1); Pop(X); IF X<0 THEN W := PGEQI ELSE W := PLEQI;
                  GenByte; W := PFJP; GenByte; Push(X); Push(T1);
                  Push(CP); W := 0; GenWord; Push(OFST); OFST := OFST + 2;
                  IF OFST>MXOF THEN MXOF := OFST;
                  Loop1; Pop(T3); Pop(T1); Pop(T2); Pop(X);
                  IF X<0 THEN W := PDECL ELSE W := PINCL;
                  GenByte; W := T3; GenWord; W := PUJP; GenByte;
                  W := T2 - CP - 2; GenWord; T2 := CP; CP := T1;
                  W := T2 - T1 - 2; GenWord; CP := T2; PopSyms;
                  Delete(S_str[SSP],1,length(s_str[ssp])-LOC2);
                  Pop(X); OFST := X; Loop2; end
                else begin
                  X := CP; Push(X); Loop1; W := PUJP; GenByte;
                  Pop(X); W := X - CP - 2; GenWord; Loop2;
                end;
              end;
        4..5: begin
                Push(OFST); OFST := OFST + 2; PushSyms;
                IF T=KDECLARE THEN begin
                  Getsym; DeclPart;
                end;
                Stmt; PopSyms;
                Delete(S_str[SSP],1,length(s_str[ssp])-LOC2);
                Pop(X); OFST := X;
                IF T=SEMICOLON THEN Getsym ELSE expected(13);
              end;
           6: begin
                IF LPFLG=0 THEN error(14);
                Getsym;
                IF T=SEMICOLON THEN begin
                  W := PUJP; GenByte; end
                else begin
                  T0 := KWHEN; TstToken_GetNext; Expr; CheckBool;
                  W := PNOT; GenByte; W := PFJP; GenByte;
                end;
                W := XITJP; XITJP := CP; GenWord;
                IF T=SEMICOLON THEN Getsym ELSE expected(13);
              end;
           7: begin
                Getsym;
                IF T<>SEMICOLON THEN begin
                  Expr; TSP := TSP - 1; W := PRNP; end
                ELSE W := PRET;
                GenByte;
                IF T=SEMICOLON THEN Getsym ELSE expected(13);
              end;
           8: begin
                LUJP := 0; flag := true;
                repeat
                  Getsym; Expr; CheckBool; W := PFJP; GenByte;
                  Push(CP); GenWord; X := LUJP; Push(X);
                  T0 := KTHEN; TstToken_GetNext; SeqOfStmts;
                  Pop(X); LUJP := X;
                  IF T=KEND THEN
                    FixFJP
                  else IF T=KELSEIF THEN begin
                    GenUJP; FixFJP; flag := false; end
                  else begin
                    T0 := KELSE; TstToken_GetNext; GenUJP; FixFJP;
                    Push(LUJP); SeqOfStmts; Pop(LUJP);
                  end;
                until flag;
                T0 := KEND; TstToken_GetNext;
                T0 := KIF; TstToken_GetNext; T2 := CP;
                WHILE LUJP<>0 do begin
                  CP := LUJP; ReadWrd; LUJP := W; W := T2-CP-2; GenWord;
                end;
                CP := T2;
                IF T=SEMICOLON THEN Getsym ELSE expected(13);
              end;
           9: begin
                Getsym; Expr;
                IF (TY[TSP]<>TINT) AND (TY[TSP]<>TCHR) THEN Error(9);
                TSP := TSP - 1; W := PXJP; GenByte; X := CP; Push(X);
                GenWord; GenWord; GenWord;
                CASES := 0; LUJP := 0; T0 := KIS; TstToken_GetNext;
                repeat
                  T0 := KWHEN; TstToken_GetNext;
                  IF T=KOTHERS THEN begin
                    flag := true; Getsym; X := -1; Push(X);
                    T1 := 1; Four780; end
                  ELSE begin
                    T1 := 0;
                    repeat
                      flag := false;
                      if T=kID then begin
                        LookupID; TN := pCONST;
                        IF (pTYPE=1) OR (pTYPE=2) THEN T := C;
                      end;
                      IF (T<>kCH) AND (T<>C) THEN Error(5);
                      X := TN; Push(X); T1 := T1 + 1; Getsym;
                      IF T=BAR THEN begin
                        Getsym; flag := true;
                      end;
                    until not flag;
                    Four780;
                  end;
                until (T<>KWHEN) or flag;
                if not flag then begin
                  Push(0); Push(0); X := 1; Push(X); CASES := CASES + 1;
                end;
                T0 := KEND; TstToken_GetNext; T0 := KCASE; TstToken_GetNext;
                T1 := SP - 4; T3 := 32767; T4 := -32767;
                FOR I:=1 TO CASES-1 do begin
                  T2 := S[T1]; T1 := T1 - 2;
                  FOR J:=1 TO T2 do begin
                    IF S[T1]<T3 THEN T3 := S[T1];
                    IF S[T1]>T4 THEN T4 := S[T1];
                    T1 := T1 - 1;
                  end;
                end;
                W := PUJP; GenByte; T5 := CP; Pop(X); Pop(T1); Pop(X);
                IF X=-1 THEN begin
                  W := T1 - CP - 2; GenWord; end
                ELSE begin
                  W := LUJP; LUJP := CP; GenWord;
                end;
                FOR I:=T3 TO T4 do begin     { *** build table }
                  W := T5 - CP - 3; GenWord;
                end;
                T7 := CP;
                FOR I:=1 TO CASES-1 do begin
                  Pop(T2); Pop(T6);
                  FOR T8:=1 TO T2 do begin
                    Pop(X); CP := T5 + (X-T3)*2 + 2; W := T6 - CP - 2; GenWord;
                  end;
                end;
                CP := T7; Pop(X); T2 := CP; CP := X;
                W := T3; GenWord; W := T4; GenWord; W := T5 - CP - 2; GenWord;
                WHILE LUJP<>0 do begin
                  CP := LUJP; ReadWrd; LUJP := W; W := T2 - CP - 2; GenWord;
                end;
                CP := T2;
                IF T=SEMICOLON THEN Getsym ELSE expected(13);
              end;
          10: begin
                GetSym;
                IF T=SEMICOLON THEN Getsym ELSE expected(13);
              end;
          11: begin
                LookupID;
                IF KIND<>2 THEN begin
                  X := pTYPE; Push(X); LDAdr; Getsym;
                  if KIND=1 then begin
                    X := OBJSZ; Push(X); T0 := LP; TstToken_GetNext;
                    Expr; CheckInt; Pop(X);
                    if X=2 then W := PIND else begin
                      W := PIXA; GenByte; W := X;
                    end;
                    GenByte; T0 := RP; TstToken_GetNext;
                  end;
                  T0 := COLONEQ; TstToken_GetNext; Expr; Pop(X);
                  IF (X<>TY[TSP]) and ((X<>TINT) or (TY[TSP]<>TBOL)) and
                     ((X<>TBOL) or (TY[TSP]<>TINT)) THEN Error(9);
                  IF X=TSTR THEN W := PSAS ELSE W := PSTO;
                  TSP := TSP - 1; GenByte;
                  IF T=SEMICOLON THEN Getsym ELSE expected(13);
                  end
                ELSE begin
                  Push(ADDR); X := LEX; Push(X);
                  Getsym;
                  IF T<>SEMICOLON THEN begin
                    T0 :=LP; TstToken_GetNext; ActualParam;
                    T0 := RP; TstToken_GetNext;
                  end;
                  CallProc;
                  IF T=SEMICOLON THEN Getsym ELSE expected(13);
                end;
              end;
          12: Pragma;
      end;
  end;
end;

Procedure Stmt;
begin
  T0 := KBEGIN; TstToken_GetNext; SeqOfStmts; T0 := KEND; TstToken_GetNext;
end;

Procedure BodyPart;
{ 2440 '********** BodyPart }
begin
  IF pos(TT,DECLPARTx)<>0 THEN declpart;
  CB := GC; CP := 0; Stmt;
end;

Procedure Compilation;
{ 1970 '********** Compilation }
begin
  Pragma;
  IF T=KPROC THEN begin
    Getsym; ParseProc;
    T0 := SEMICOLON; TestToken;
  end;
end;

Procedure Read_data;
{ 1780 '********** Read Data }
var
  temp  : integer;
  t_str : anystring;
  data  : text;

  Function GetInt(var work : anystring): integer;
  var
    W,X,Y : integer;
  begin
    W := pos(',',work);
    if (W=1) or (work='') then
      X := 0
    else if W=0 then begin
      val(work,X,Y); W := length(work)
      end
    else begin
      val(copy(work,1,W-1),X,Y);
      if Y<>0 then X := 0;
    end;
    GetInt := X;
    delete(work,1,W);
  end;

begin
  Sym_str := ' '; CH := ' '; TT := ' '; ID := ' '; Buf := ' ';
  B_ptr := 0;    T := 0; T0 := 0;   SP := 0; TSP := 0; OFST := 0;
     CP := 0;   CB := 0;  W := 0;   R1 := 0;  R2 := 0;   T3 := 0;
   LOC1 := 0; LOC2 := 0; TN := 0; HASH := 0;  T1 := 0;   T2 := 0;
    SSP := 1; s_str[ssp] := '';

  for I:=1 to 128 do D[I] := ' ';
  FOR I:=0 TO MB do begin
    buffer[I] := D; B[I] := 0;
  end;

  assign(data,'keywords.txt'); reset(data);
  Lp_Str := '';
  readln(data); readln(data,t_str);
  WHILE T_str>'0' do begin
    while t_str>'' do begin
      if t_str[1]=',' then begin
        LP_str := LP_str + chr(temp); temp := 0; end
      else
        temp := temp * 10 + ord(t_str[1]) - 48;
      delete(t_str,1,1);
    end;
    lp_str := lp_str + chr(temp); temp := 0;
    readln(data,t_str);
  end;
  for I:=1 to 5 do readln(data);
  FOR I:=1 TO 26 do begin
    readln(data,t_str); val(t_str,MAP[I],temp);
  end;
  I := 1;
  repeat
    readln(data,t_str);
    temp := pos(',',t_str); ID := copy(t_str,1,temp-1); delete(t_str,1,temp);
    IF ID<>'*END*' THEN begin
      ID := ID + copy(SPACEs,1,8-LENgth(ID));
      pTYPE := GetInt(t_str);
      KIND := GetInt(t_str);
      PINFO := GetInt(t_str);
      pCONST := GetInt(t_str);
      OBJSZ := GetInt(t_str);
      ADDR := GetInt(t_str);
      LL := GetInt(t_str);
      AddID;
    END
  until ID='*END*';
  while not EOF(DATA) do BEGIN
    READln(DATA,t_str);
    IF LENGTH(T_str)>8 THEN T_str := copy(t_str,1,8);
    T_str := T_str + copy(spaces,1,8-LENgth(T_str));
    KEYWD[I] := T_str; I := I + 1;
  end;
  CLOSE(data);
  KEYWD[0] := ' '; KEYWD[NKEY] := ' ';
end;

BEGIN
  lexch  := Alf + Dig + ' @*+=-<>/:;' + #39 + ')(,".#!' + #3 + #96 + #9;
  spaces := ''; for I:=1 to 51 do spaces := spaces + '     ';{255 spaces}
  for I:=2 to 4 do isopen[I] := false;
  for I:=1 to 128 do null_rec[i] := #0;

  clst := true; plst := false; clrscr;
  writeln('Augusta(tm) Compiler v1.1A');
  writeln('(C) Copyright 1983 by Computer Linguistics');
  writeln('All rights reserved.');
  writeln(CrLf,'Initializing ...'); Read_Data;
  SI := 1; LN := 0; EOI := false;
  LL := 0; CPROC := 0; PROC := 0; GC := 1920; LPFLG := 0;
  write(CrLf,'Source file ? '); readln(Sym_str);
  Open_Source;
  write('Code file ? '); readln(C_str);
  assign(One,C_str); rewrite(One);
  R0 := 16; M0 := R0;
  write('Listing (Y,<N>)? '); readln(sym_str); sym_str := sym_str + ' ';
  IF upcase(sym_str[1])='Y' THEN begin
    PLST := true; write(Lst,LP_str);
  end;
  GetLine; Getsym; Compilation;
  seek(One,R0-1); write(One,D);

  sym_str := mki(GC) + mki(M0) + MKI(PROC) + mki(0) + MKI(1113);
  D := null_rec;
  for I:=1 to 10 do D[I] := sym_str[i];
  seek(One,0); write(One,D);
  FOR I:=1 TO MB do
    IF (B[I]<>0) AND (B[I]<>R0) THEN begin
      seek(one,B[I]-1); write(one,buffer[i]);
    end;
  CLOSE(one);
  writeln(CrLf,'Compiled OK');
  writeln(LN,' lines. ',GC-1920,' bytes.');
END.