(* author : Nasser M. abbasi
   final project : compiler design cse565 Oakland University
   Compiler for Subset Of Pascal For 8088
   april 1988

   description:
    Input Files: this program Reads the parse table Generated by
    Yacc running on the prime (primix OS) and the table re build
    and scanned a number of times to build needed tables ( symbol
    table , hashed into linked list, and block description table,
    etc.
    Also the Lex genrated identifires tables are downloaded. these
    include the ident,integer,real, and string tables.

    Output files: the assemply code .

    language used : VAX pascal.
*)

program BackEnd(input,output);
 const
     tkasg=257;      tkne=258;      tkle=259;    tkge=260;    tkdtdt=261;
     tkabsolute=262; tkand=263;     tkarray=264; tkbegin=265;
     tkcase=266;     tkconst=267;   tkdiv=268;   tkdo=269;     tkdownto=270;
     tkelse=271;     tkend=272;     tkexternal=273;            tkfile=274;
     tkforward=275;  tkfor=276;     tkfunction=277;            tkgoto=278;
     tkinline=279;   tkif=280;      tkin=281;                  tklabel=282;
     tkmod=283;
     tknil=284;      tknot=285;     tkoverlay=286;             tkof=287;
     tkor=288; tkpacked=289;
     tkprocedure=290; tkprogram=291; tkrecord=292;
     tkrepeat=293;    tkset=294;     tkshl=295;   tkshr=296;   tkstring=297;
     tkthen=298;      tktype=299;    tkto=300;    tkuntil=301;
     tkvar=302;       tkwhile=303;   tkwith=304;  tkxor=305;   tktext=306;
     tkchar=307;      tkreadln=308;  tkwriteln=309;            tkreal=310;
     tkboolean=311;
     tkinteger=312;   tkread=313;    tkwrite=314;  tktrue=315; tkfalse=316;
     tkbyte=317;      tkputc=318;    tkgetc=319;
     lex_string=317;  lex_real=318;  lex_ident=319; lex_integer=320;

     subtree=1;
     literal=2;
     ident=3;
     token=4;
     integer_ident=5;
     real_ident=6;
     string_ident=7;
     empty=8;
     ident_size = 50;
     literal_max_size = 50;
     hash_size = 67;
     hlimit = 66;
     maxlen = 30; (* max length of indentifier *)
     stack_max = 20;
 type
     buildin = (chr,ord);  (* build in identifiers *)
     op_type = (sub_,add_,mul_,div_,assign_,le_);
     maxNest = 0..10;
     treeSize = 0..530;
     symtableSize = 0..100;
     status = 1..100;  (* return status codes *)
     string50 = varying [50] of char;

     (*  P A R S E    T R E E  *)
     treeNodeType = record
                    rhsn :integer;
                    rhstype : array[1..10] of integer;
                    rhsindex : array[1..10] of integer
                    end;
     ParseTreeType = array[treeSize] of treeNodeType;


     (*      B  S  T        T A B L E *)
     BstNodeType = record
                   OuterBlock   : integer;
                   LexicalLevel : integer;
                   local_size   : integer; (* size of local storage *)
                   parm_size    : integer; (* size of parameters *)
                   block_name   : string50;
                   block_num    : integer;
                   end;

     (* S Y M B O L  T A B L E *)
     sym_type_ = (variable,parm,entry,constant);
     vtype = (byte_,integer_,boolean_,char_,array_,notused);
     symbol = string50;
     symtabp = ^symtabtype;
     symtabtype = record
                  next :symtabp;
                  LEVEL : integer;
                  sym : symbol;
                  saddr  : integer;
                  parm_flag : boolean;
                  vtype_  : vtype; (* data type*)
                  sem_type : sym_type_;
                  blk_num : integer;
                  literal_val : varying [literal_max_size] of char;
                  size : integer;
                  END;

 (*  A S S E M P L Y     L I N E  *)
   assemply_line_type = varying[80] of char;

 (*  C O D E   G E N R A T I O N    S T A C K    *)
     stack_type = record
                  data : array[1..stack_max] of integer;
                  tos   : integer;
                  end;
var
     unique: integer;
     initial_label : symbol;
     debug : boolean;
     LHS : boolean; (* to tell if address or value generating *)
     assemply_line : assemply_line_type; (* emit string to assemply file *)
     assemply_line_number : integer; (* to emit number to assemply file *)
     symf,intf,realf,stringf,treef,assemply : text;
     tables : text;
     symtable : array [symtableSize] of symbol;
     inttable : array [symtableSize] of symbol;
     realtable : array [symtableSize] of symbol;
     stringtable : array [symtableSize] of string50;

     stack : stack_type;
     tree : parseTreeType;
     string_last : integer;
     symtable_last : integer;
     inttable_last : integer;
     realtable_last : integer;
     tree_last : integer;

     g_cb : integer; (* current block number *)
     g_lb : integer; (* last block number *)
     clevel :integer;

     symtab : ARRAY[0..hlimit] of symtabp;
     g_bsttable : array[maxNest] of BstNodeType;

  function travel_(level:integer):integer;   forward;
  function travel__(level: integer):integer; forward;
  function travel___(level,index : integer):integer; forward;
  function unique_label: integer; forward;
  procedure travel_code_gen(level : integer); forward;
 (**********************************************************)
procedure cleanup;
begin
    close(tables);
end;
  (***************************************************)
   procedure error;
    begin
       writeln ('Terminating due to pre-issued error ');
       cleanup;
        HALT
    end;
  (*****************************************)
  procedure readSymTable;
    var
    data : string50;

    begin
       
          while not eof(symf) do 
           begin
               readln(symf,data);
               symtable_last := symtable_last +1;
               symtable[symtable_last] := data;
            end;
            
      close(symf);
  end;
 (********************************************)
  procedure readStringTable;
  var
    data : string50;

    begin

    while not eof(stringf) do
     begin
        readln(stringf,data);
        string_last := string_last +1;
        stringtable[string_last] := data;
     end;
     
    close(stringf);
    end;
(**********************************************)
 procedure readintTable;
   var
    data : string50;
   begin
    
    while not eof(intf) do 
        begin
             readln(intf,data);
             inttable_last := inttable_last +1 ;             
             inttable[inttable_last] := data;
        end;
        
       close(intf);
    end;
 (********************************************)
  procedure readparsetree;

    var
     j: integer;
     blank :char;
     local_rhsn : integer;
     g1 : integer;
   begin

   while not eof(treef) do
     begin
         read(treef,local_rhsn);
         tree_last := tree_last+1;
         tree[tree_last].rhsn := local_rhsn;
         for j:= 1 to tree[tree_last].rhsn do
             read(treef
                  ,blank
                  ,tree[tree_last].rhstype[j]
                  );
         for j:=1 to tree[tree_last].rhsn do
             read(treef
                  ,blank
                  ,tree[tree_last].rhsindex[j]
                  );
         readln(treef); (* eat eoln mark *)
     end;

    close(treef);

   end;
(**********************************************)
procedure init_global_vars;
  begin
    g_lb :=0;
    g_cb :=0;
   end;
 (*************************************************)
 procedure init;
   var
   counter: integer;
   begin

      string_last :=-1;
      symtable_last :=-1;
      inttable_last :=-1;
      realtable_last :=-1;
      tree_last := -1;

      init_global_vars;

      unique:= 0;

      clevel :=  0;

      g_bsttable[0].outerblock := -1;
      g_bsttable[0].lexicallevel :=0;
      g_bsttable[0].local_size := 0;
      g_bsttable[0].block_name:= 'outer';

      for counter:=0 to hlimit do
          symtab[counter] := NIL;

      open (treef,file_name :='treef.dat',history:=old); reset(treef);
      open (stringf,file_name:='stringf.dat',history:=old); reset(stringf);
      open (intf,file_name :='intf.dat',history:=old); reset(intf);
      open (symf,file_name := 'symf.dat',history:=old); reset(symf);
      open (assemply,file_name:='assm.asm',history:=old); rewrite(assemply);
      open (tables,file_name:='tables.dat',history:=new); rewrite(tables);
   end;
   (****************************************************)
    function resolve_entry_name(level:integer; VAR which:integer):string50;
   var
     temp : integer;

   begin;
     temp := level;

     if (tree[level].rhstype[1] = subtree ) then (* its proc not pgm *)
       begin
          temp := tree[level].rhsindex[1];
          resolve_entry_name  := symtable[tree[temp].rhsindex[2] ];
          which :=2;
        end
    else
       if(tree[level].rhstype[1] = token) then
         begin
            resolve_entry_name :=
            symtable [ tree [ tree[level].rhsindex[2] ].rhsindex[1] ];
            which :=1
         end
       else
            begin
                writeln('illegal type in invalide state');
                writeln('error in resolve_entry_name');
                error
            end
   end;
(************************************************************)
 function hashit (fsym:symbol): integer;
  var n,i:integer;
  begin
     n := 0;
     for i:= 1 to length(fsym) do
          n:= n+ int(fsym[i]);
     n := (128 * n) mod hash_size;
     hashit := n;
 
(*     hashit:= (128 * n) mod hash_size; *)

  end;
(*************************************************************)
function findsym(fsym:symbol):symtabp;
(* return nil if not found, used to resolve refernces
  IMPORTRANT : object ordered in linked list as deepest lexical level to
               highest so search until lexical level same else return last
                visited befor that *)
  label 99;
  var sp:symtabp;
      candidate : symtabp;      
  begin
      candidate := nil;

      sp:= symtab[hashit(fsym)];

      while sp<> nil do
          begin  (* walk down the hash chain *)
               if sp^.sym=fsym then
                  begin 
                       candidate := sp;
                       if sp^.level = g_bsttable[g_cb].lexicallevel then
                          goto 99
                       else
                         sp:= sp^.next
                  end
               else
                 sp := sp^.next
           end; (* while*)
99:
      findsym := candidate;
end;
   (***********************************************)
function  makesym ( fsym: symbol
                    ; syt: vtype
                    ; lev:integer
                    ; id_offset : integer
                    ; id_size : integer (* size of variables in bytes *)
                    ; id_sym :sym_type_
                    ; const_literal : symbol (* for constants *)  
                 ): symtabp;
     label 99;
     var sp:symtabp;
         hx: integer;
     begin
         hx := HASHIT(fsym);
         sp:= symtab[hx];
         while sp<> NIL do
         with sp^ do
                   begin
                        if sym=fsym then
                          begin
                            if ( lev = g_bsttable[g_cb].lexicallevel)
                                AND (blk_num = g_cb)  then 
                                begin
                                    write('error duplicate declaration at');
                                    writeln('same lexical level and block');
                                    error
                                end
                            else
                            ;
                          end
                        else
                         ;
                   sp:=next
                   end;
         new(sp); (* add new entry here *)
         with sp^ do
              begin
                  sem_type := id_sym;
                  sym  := fsym;
                  vtype_ := syt;
                  next := symtab[hx];
                  symtab[hx] := sp;
                  level := lev;
                  if (sem_type = entry) OR (sem_type = constant) then 
                     begin
                        id_offset := 0;
                         size := 0;
                         literal_val := const_literal;
                     end
                  else
                     begin
                        size := id_size;
                        literal_val := '-notused-'
                    end;
                  saddr := id_offset;
                  blk_num := g_cb
               end;
         makesym := sp;
 99:
     end;
(*********************************************************)
procedure clearsym (clevel : integer);
  label 1;
  var hx:integer;
      sp,sptemp:symtabp;

  begin
        (* travel the hash table and get rid of identifirs that
          belong to scope we just left *)

       if clevel <0 then
          clevel:=0
       else
       ;


       for hx:=0 to hlimit do
           begin
               sp:= symtab[hx];
               while sp<> nil do
               with sp^ do
                    begin
                         if level<clevel then
                            goto 1
                         else
                         ;
                         sptemp:=sp;
                         sp:=next;
                         dispose(sptemp);
                   end;
              1:
              symtab[hx] := sp
         end
end;
(**********************************************************)
procedure emit;
  begin
       writeln(assemply,assemply_line);
   end;
(****************************************************)
procedure subemit;
  begin
      write(assemply,assemply_line);
  end;
(***************************************************)
procedure subemit_num;
  begin
      write(assemply,assemply_line_number:2);
  end;
(*****************************************************)
procedure emit_;
   begin writeln(assemply); end;
(*******************************************************)
procedure emit_main_entry(sym : symbol);
begin
   assemply_line := 'st_seq   segment  byte stack ;define stack segment'; emit;
   assemply_line := '         db   20 dup (?)'; emit;
   assemply_line := 'st_seq   ends';            emit;
   assemply_line := ';-------------------------------------------'; emit;
   assemply_line := 'code    segment  byte public ; define code seqment'; emit;
   emit_;
   assemply_line := sym + '    proc   far' ; emit;
   assemply_line := '        assume cs:code'; emit;
   assemply_line := 'Start: '; emit;
   assemply_line := '      push ds           ;save old value'; emit;
   assemply_line := '      sub ax,ax         ;put zero in ax '; emit;
   assemply_line := '      push ax            ;save it on stack'; emit;
   assemply_line := ' '; emit; emit_;
   
end;
(*********************************************************)
procedure emit_proc_entry(sym: symbol);
  begin
assemply_line := sym + '  proc   near'; emit;
assemply_line := ' push bp                 ;save bp'; emit;
assemply_line := ' mov  bp,sp              ;set up stak frame'; emit;
assemply_line := ' sub  sp,';subemit;
assemply_line_number := g_bsttable[g_cb].local_size ; subemit_num;
assemply_line := '         ;allocate frame'; emit; emit_;

   end;
(**********************************************)
procedure adjust_bst(sym : symbol);
begin

       g_lb := g_lb +1;
       g_bsttable[g_lb].outerblock := g_cb;
       g_cb := g_lb;
       g_bsttable[g_cb].lexicallevel :=
          1+ g_bsttable[g_bsttable[g_cb].outerblock].lexicallevel;
       g_bsttable[g_cb].block_name:= sym;
       g_bsttable[g_cb].block_num := g_cb;
end;

   (************************************************)
   procedure  prolog(level: integer);
    var proc_name: symbol;
        symt : vtype;
        literal : symbol;
        sp : symtabp;
        semantic :sym_type_;
        proc_pgm : integer; (* use set later *)
    begin
    proc_pgm :=0;
    literal :='';
    proc_name := resolve_entry_name(level,proc_pgm);

    symt := notused;
    semantic := entry;

    adjust_bst(proc_name);

    sp:= makesym(proc_name
                ,symt             (* symbol type *)
                ,g_bsttable[g_cb].lexicallevel
                ,0
                ,0
                ,semantic
                ,literal);


    end;
   (************************************************)
   procedure epilog( storage : integer);  (*this is bst epilog pass one *)
     begin

         g_bsttable[g_cb].local_size := storage;
         g_cb := g_bsttable[g_cb].outerblock;

  end;
(******************************************************************)
procedure _epilog(level:integer); (* this is the code epilog pass two*)
var proc_pgm :integer;
    proc_name: symbol;
begin
proc_pgm := 0;
proc_name := '-notfound-';

proc_name:= resolve_entry_name(level,proc_pgm);
if proc_pgm = 1 then
   begin
     assemply_line := '     ret     ;go back to OS';  emit; 
     assemply_line := proc_name +'      endp'; emit; 
     assemply_line := ' ;-------------------------------------'; emit; emit_;
   end
else
    begin      
      assemply_line := '  mov sp,bp    ;deallocate local variables'; emit;
      assemply_line := '  pop bp       ;restore old value of bp '; emit;
      assemply_line := '  RET '; subemit;
      assemply_line_number := g_bsttable[g_cb].parm_size; subemit_num;
      emit_;
      assemply_line := proc_name +'       endp'; emit;
      assemply_line := ' ;--------------------------------------------'; emit;
      emit_;
    end;
     
(* clearsym(g_bsttable[g_cb].lexicallevel); (*clean after exit *)
 g_cb := g_bsttable[g_cb].outerblock;

      end;
(********************************************************)
procedure closing_code;
begin
 assemply_line:=' ;------------------------------------'; emit;
 assemply_line := 'code ENDS'; emit;
 assemply_line := '     end start' ; emit;
end;   
(********************************************************)
procedure _prolog(level : integer);
 var proc_name:symbol;
     proc_pgm : integer;
 begin
   proc_pgm := 0;
   proc_name := resolve_entry_name(level,proc_pgm);
      
   if proc_pgm = 1 then
      emit_main_entry(proc_name)
   else
     emit_proc_entry(proc_name)
   ;

   g_lb := g_lb +1;
   g_cb := g_lb;

end;

   (*************************************************)
 procedure receive_parsor_output;
  begin

  readSymTable;
  readIntTable;
  readStringTable;
  readParseTree;

 end;
(******************************************************)
function number( str : string50) :integer;
  var i,j,result,wt :integer; 
  begin
     result:=0;
     wt :=0;
     i:= 0;
     for j:=1 to length(str) do 
         begin
            wt := wt * 10 ; 
            result:= result + (int(str[j])-48)*wt;
         end;
number:= result;

   end;
(********************************************************)
procedure gen_ident_ref(level:integer);
var sym : symbol;
    sp : symtabp;
    offset : integer;
    lexical_diff,counter : integer;
(*-----*)
procedure gen1;
    begin
      if LHS= true then
                     begin
                        assemply_line :=' ; resolve lhs reference '; emit;
                        assemply_line:='     mov ax,BP+'; subemit;
                        assemply_line_number := sp^.saddr; subemit_num;
                        emit_;
    (*                  assemply_line := '     push ax '; emit; *)
                     end
      else
         if lhs= false then
            begin
               assemply_line :='; resolve rhs refernce'; emit;
                assemply_line:='     mov ax,'; subemit;
                assemply_line_number := sp^.saddr; subemit_num;
                assemply_line :='[BP]'; emit;
                assemply_line := '     push ax '; emit;
            end
         else
         ;
 end;
 (*-----*)
 procedure gen2;
 begin
     if lhs = true then
       begin
           if sp^.vtype = array_ then
              begin
                   assemply_line:=' ; lhs refernce for array'; emit;
                   assemply_line:='   POP ax  ; get offset '; emit;
                   assemply_line:='   MOV bx,'; emit;
                   write(assemply,sp^.saddr:2); emit_;
                   assemply_line:='   ADD bx,ax  ; get element offset';
                   emit;
                   assemply_line :='  mov ax,BP'; emit;
                   assemply_line :='  SUB ax,bx'; emit;
              end
           else
              begin
                assemply_line := ' ; resolve lhs refernce '; emit;
                assemply_line := '   mov ax,BP-'; subemit;
                assemply_line_number := sp^.saddr ; subemit_num;
                emit_;
                (* assemply_line := '    push ax'; emit;  *)
             end;
      end
    else
       if lhs = false then
             if  sp^.vtype = array_ then
               begin
                   assemply_line:=' ; lhs refernce for array'; emit;
                   assemply_line:='   POP ax  ; get offset '; emit;
                   assemply_line:='   MOV bx,'; emit;
                   write(assemply,sp^.saddr:2); emit_;
                   assemply_line:='   ADD bx,ax  ; get element offset';
                   emit;
                   assemply_line :='  mov ax,-bx[BP]'; emit;
                   assemply_line :='  PUSH ax'; emit;
                end
              else
               begin
                 assemply_line:=' ; resolve rhs refernce '; emit;
                 assemply_line:='  mov ax,'; subemit;
                 assemply_line_number:= -(sp^.saddr); subemit_num;
                 assemply_line :='[BP]'; emit;
                 assemply_line := '    push ax'; emit;
              end
         end
       else
       ;
end;
(*------*)
procedure gen3;
 var sym : symbol;
    begin
      if LHS= true then
         begin
             writeln (' constant not allowed in LHS');
             error
          end
     else
         begin
           assemply_line :=' ; move number on stack'; emit;
            sym := inttable[(tree[level].rhsindex[1])-1];
            if sym[1] ='$' then
               begin   
                   sym[1] := ' ';
                   sym := sym + 'H' ;
               end
            else
            ;
            assemply_line:='     mov ax,'+ sym ; emit;
            assemply_line := '     push ax '; emit;
         end
end;
(*-------*)
procedure gen4; (* call follow up *)
begin
   assemply_line :=' ; generate call argumnet allready on stack ';emit;
   assemply_line :='    CALL ' + sym ; emit;
   emit_;
end; 
(*-----*)
procedure gen5; (* outer block ident refernce follow up *)
  begin
    lexical_diff := g_bsttable[g_cb].lexicallevel- sp^.level;
    assemply_line:=' ; refernce variable in outer block'; emit; 
    assemply_line := '   mov ax,[BP+4]'; emit;
    for counter := 1 to lexical_diff-1 do
        assemply_line := '  mov ax,[ax+4] ; hup over '; emit;
    if lhs=true then
       begin
           assemply_line:=' ; get the address of outer block variable'; emit;
           assemply_line :='     mov ax,ax-'; subemit;
           assemply_line_number := sp^.saddr; subemit_num;
           emit_;
       end
    else
       if lhs = false then
          begin
             assemply_line :=' ; get the value of outer block variable'; emit;
              assemply_line :='    mov dx,ax  ; save ax'; emit;
              assemply_line :='    mov ax,'; subemit;
              assemply_line_number := -(sp^.saddr); subemit_num;
              assemply_line:='[DX]'; emit;
              assemply_line := '    push ax'; emit;
          end
      else
      ;
 end;
 (*------*)
begin (* gen ident refr *)
    sym := symtable[tree[level].rhsindex[1]];
    sp := findsym(sym);
    if sp = nil then
         if (sym='chr') or (sym='ord') then
         else
 (*  if (not ((sym[1]='c') and (sym[2]='h') and (sym[3]='r'))) then *)
            begin
              writeln('undeclared ident encountered');
              error
            end
     else
       if sp^.level = g_bsttable[g_cb].lexicallevel then
          case sp^.sem_type of
              parm : gen1 ;
              variable : gen2 ;
              constant : gen3;
              entry : gen4;
              otherwise
                   begin
                   writeln(' unacceptable context for reference ');
                   writeln(' object must be variable or parameter');
                   error
                 end
         end
     else 
        if sp^.sem_type = entry then
            gen4
        else
            (* it is not in this block  run after it through lex level*)
            gen5 ;
 end;
(*********************************************************)
procedure gen_rhs_real(level : integer);
begin
end;
(*********************************************************)
procedure gen_rhs_int(level: integer);
var sym : symbol;
begin

    sym := inttable[tree[level].rhsindex[1]];
    if sym[1] = '$' then
       begin
         sym[1] := ' ';
         sym := sym + 'H'
       end
    else
    ;
    assemply_line :=' ; push the value of variable on stack'; emit;
    assemply_line :='   mov   ax,' + sym ; emit;
    assemply_line :='   push  ax'; emit;
    end;
(*********************************************************)
procedure gen_rhs_string(level: integer);
var sym : symbol;
begin
   assemply_line:=' ; push char on stack '; emit;
   assemply_line :='   mov ax,'; subemit;
   sym := stringtable[tree[level].rhsindex[1]];
   assemply_line_number:= int(sym[2]); subemit_num;
   emit_;
   assemply_line :='   PUSH ax'; emit;
   end;
(**********************************************************)
procedure normalize(op :op_type);
var lab1,lab2:integer;
begin
    case op of
     add_ : begin
            assemply_line :=' ; perform addition'; emit;
            assemply_line := '   POP ax'; emit;
            assemply_line := '   POP bx'; emit;
            assemply_line := '   ADD ax,bx'; emit;
            assemply_line := '   push ax'; emit;
            end;
     mul_ : begin
            assemply_line:=' ; perform multiplication'; emit;
            assemply_line := '   POP ax'; emit;
            assemply_line := '   POP bx'; emit;
            assemply_line := '   MUL bx'; emit;
            assemply_line := '   push ax'; emit;
            end;
    assign_: begin    (* note lhs allready in ax *)
            assemply_line :=' ; perform assignment '; emit;
            assemply_line :='    POP bx'; emit;
            assemply_line :='    MOV ax,bx'; emit;
            end;
     le_   : begin
           
             assemply_line:=' ;---- resolve le '; emit;
             assemply_line:='; leave ax=1 on true, ax=0 on false'; emit;
             assemply_line:='   POP  ax'; emit;
             assemply_line:='   POP  bx'; emit;
             assemply_line:='   CMP  ax,bx'; emit;
             lab1:=unique_label;
             assemply_line:='   JG lab'; subemit;
             write(assemply,lab1:1);
             assemply_line :='   ; jump on greater than '; emit; emit_;

             assemply_line:='   mov  ax,1  ; test passed'; emit;
             lab2 :=unique_label;

             assemply_line :='   JMP lab';subemit;
             write(assemply,lab2:1); emit_;

             assemply_line :='lab'; subemit;
             write(assemply,lab1:1);
             assemply_line :=':'; emit; 
             emit_;

             assemply_line:='    mov ax,0  ;test failed' ; emit;
             assemply_line :='lab'; subemit;
             write(assemply,lab2:1);
             assemply_line :=':'; emit; emit_;

             end;
     sub_: begin
             assemply_line :='  POP ax'; emit;
             assemply_line :='  POP dx'; emit;
             assemply_line :='  SUB ax,bx'; emit;
          end; 
  end;
end;
(*******************************************************)
function unique_label;  (* :integer *)
begin
   unique := unique +1;
   unique_label := unique;
 end;
(*********************************************************)
procedure gentest(level: integer);
var op :op_type;
 begin
     case tree[level].rhsn of
     3: if tree[level].rhsindex[1]= int('(')+128 then
           gentest(tree[level].rhsindex[2])
        else
           if tree[level].rhstype[3] = subtree then
              begin
                  travel_code_gen(tree[level].rhsindex[3]);
                  if tree[level].rhstype[1] = subtree then
                     begin
                       travel_code_gen(tree[level].rhsindex[1]);
                       case tree[tree[level].rhsindex[2]].rhsindex[1] of
                       tkle : begin
                              op:= le_;
                              normalize(op);
                              end;
                        end;
                      end
                  else
                  ;
              end
           else
           ;
     end;
 end;
 (*******************************************************)
 procedure gen_body(level:integer);
 begin
     travel_code_gen(level);
 end;
(*********************************************************)
procedure process_others(level:integer);
var
sym : symbol;
lab2,lab1 : integer;
begin

  case tree[level].rhsn of
    4: case tree[level].rhstype[1] of
       token: case tree[level].rhsindex[1] of
              tkwhile: begin
                       lab1 := unique_label;
                       lab2 := unique_label;
                       assemply_line :=' ; code for while stmt'; emit;
                       write(assemply,'lab'); write(assemply,lab1:1);
                       assemply_line :=':'; emit; emit_;

                       assemply_line:=' ;Test for While Loop'; emit;
                       gentest(tree[level].rhsindex[2]);

                       assemply_line:='   mov dx,1'; emit;
                       assemply_line:='   cmp ax,dx'; emit;
                       assemply_line:='   JL  lab';subemit;
                       write(assemply,lab2:1); emit_;

                       assemply_line:=' ; Body of While Loop'; emit;
                       gen_body(tree[level].rhsindex[4]);

                       assemply_line:='   JMP lab'; subemit;
                       write(assemply,lab1:1);
                       emit_;

                       assemply_line :='lab'; subemit;
                       write(assemply,lab2:1); 
                       assemply_line :=':'; emit;
                       emit_;

                       end;
               end;
       end;
  end;
end;
(*********************************************************)
procedure gen_IO;
begin
    assemply_line :='   POP ax  ; get char from the stack '; emit;
    assemply_line := '  INT doscall ;  output it '; emit;
end;
(*********************************************************)
procedure travel_code_gen; (* (level:integer); *)
 (* this is recursive *)
 var op :op_type;
 begin
       if tree[level].rhstype[1] <> empty then
          begin
            case tree[level].rhsn of
            1: case (tree[level].rhstype[1]) of
                ident: gen_ident_ref(level);
                integer_ident:
                      if lhs=true then
                          begin
                              writeln('cant have integer in lhs');
                              error
                          end
                      else
                         gen_rhs_int(level);
                 real_ident:
                       if lhs=true then
                          begin
                            writeln('cant have real in lhs');
                            error
                          end
                       else
                         gen_rhs_real(level);
                  string_ident:
                        if lhs=true then
                            begin
                             writeln('cant have string in lhs');
                             error
                            end
                        else
                          gen_rhs_string(level);
                  otherwise
                          begin
                           writeln('unexpected type in lhs');
                           error
                          end
                  end; (* case 1 *)
              2: if tree[level].rhstype[2] = subtree then
                    begin
                       travel_code_gen(tree[level].rhsindex[2]);
                       if (tree[level].rhstype[1] = subtree) then
                           travel_code_gen(tree[level].rhsindex[1])
                       else
                          if (tree[level].rhsindex[1] = TKWRITE ) then
                              gen_IO
                          else 
                          if (tree[level].rhsindex[1]= int('-')+128 then
                             begin
                               travel_code_gen(tree[level].rhsindex[2]);
                               assemply_line:=' ; make negative number'; emit;
                               assemply_line:='  POP ax'; emit;
                               assemply_line :=' mov bx,-1'; emit;
                               assemply_line :=' MUL bx'; emit;
                               assemply_line :=' PUSH ax'; emit; 
                             end
                          else
                          begin
                             writeln('unexpcetd type of node in context');
                             error
                          end
                   end
                 else
                    begin
                        writeln('unacceptable type of node in context');
                        error
                    end;
             3: case tree[level].rhsindex[2] of
                int(';')+128: begin
                                travel_code_gen(tree[level].rhsindex[1]);
                                travel_code_gen(tree[level].rhsindex[3])
                             end;
                tkasg :  begin
                            op := assign_;
                            travel_code_gen(tree[level].rhsindex[3]);
                            lhs := true;
                            travel_code_gen(tree[level].rhsindex[1]);
                            lhs := false;
                            normalize(op)
                         end;
                int('*')+128 : begin
                                op := mul_;
                                travel_code_gen(tree[level].rhsindex[3]);
                                travel_code_gen(tree[level].rhsindex[1]);
                                normalize(op)
                               end;
                int('+')+128 : begin
                                op:= add_;
                                travel_code_gen(tree[level].rhsindex[3]);
                                travel_code_gen(tree[level].rhsindex[1]);
                                normalize(op)
                              end
                otherwise 
                  begin
                      if tree[level].rhsindex[1] = tkbegin then
                           travel_code_gen(tree[level].rhsindex[2])
                      else (* check for argumnet *)
                          if tree[level].rhsindex[1] = int ('(')+128 then
                            travel_code_gen(tree[level].rhsindex[2])
                          else
                             if tree[level].rhsindex[1] = int('[')+128 then
                                travel_code_gen(tree[level].rhsindex[2])
                             else
                             ;
                   end     
                end; (*case 3 *)
            4: process_others(level);
        end; (* main case *)
        end
    else
    ;

  end;
(********************************************************)
function ret_array(level :integer) : integer;
 var temp : integer;
   begin
      if tree[level].rhstype[3] = SUBTREE then
          begin (* it in form [0..x] *)
                temp:=tree[tree[level].rhsindex[3]].rhsindex[3];
                ret_array := number(inttable[tree[temp].rhsindex[1]]);
          end
      else
        ret_array :=
             number(inttable[tree[level].rhsindex[3] ])
    end;
 (***********************************************************)
 procedure travel_dcl_ (level : integer
                       ;type_ : vtype
                       ;var local_size,size : integer
                       ;semantic :sym_type_
                       );
    var t1,t2 : integer;
             literal : symbol;
             sp : symtabp;
  begin

 literal :='';
 if tree[level].rhsindex[1] <> 0 then
  BEGIN
    if tree[level].rhsindex[2] = int(';')+128 then
      begin
          travel_dcl_(tree[level].rhsindex[1]
                     ,type_
                     ,local_size
                     ,size
                     ,semantic); (* jump left *)
          travel_dcl_(tree[level].rhsindex[3]
                     ,type_
                     ,local_size
                     ,size
                     ,semantic); (* jump right *)
      end
   else
      begin
          if tree[level].rhsindex[2] = int(':')+128 then
             begin
                 t1 := tree[level].rhsindex[3] ;
                 if tree[ t1 ].rhstype[1] <> token then
                    begin
                        writeln('error need token type here ');
                        writeln (' error in function collect_');
                        error
                     end
                 else
                     if tree[t1].rhstype[1] <> token then 
                       begin
                           writeln('type must be token in this context');
                           error 
                       end
                     else
                     ;
                     case tree[t1].rhsindex[1] of
                          TKARRAY : begin;
                                      t2 := t1-1;
                                      case tree[t2].rhstype[1] of
                                       TKBYTE: type_:=byte_;
                                       TKINTEGER: type_ :=integer_;
                                       TKBOOLEAN:  type_ :=boolean_;
                                       TKCHAR : type_ :=char_;
                                      end;
                                      size  := 2* ret_array(t1);
                                     end;
                          TKINTEGER : begin
                                        type_ := integer_;
                                        size := 2;
                                       end;
                          TKBYTE :  begin
                                        type_ := byte_;
                                        size := 2;
                                    end;
                          TKBOOLEAN : begin
                                        type_ := boolean_;
                                        size := 2;
                                       end;
                          TKCHAR : begin
                                       type_ := char_;
                                        size := 2;
                                        end
                     end;
             travel_dcl_(tree[level].rhsindex[1]
                        ,type_
                        ,local_size
                        ,size 
                        ,semantic
                        ); (* jump left*)
             end
          else
            begin
                 if tree[level].rhstype[1] = subtree then
                    travel_dcl_(tree[level].rhsindex[1]
                               ,type_
                               ,local_size
                               ,size
                                ,semantic)
                 else
                    if tree[level].rhstype[1] = ident then
                       begin
                          local_size := local_size + size;
                          sp := makesym(symtable[ tree[level].rhsindex[1]]
                                       ,type_
                                       ,g_bsttable[g_cb].lexicallevel
                                       ,local_size
                                       ,size
                                       ,semantic
                                       ,literal )
                      end
                    else
                       begin
                         writeln('error expect an identifire found  another ');
                         writeln('error in collect_');
                         error
                       end;
                 
                if tree[level].rhsindex[2] = int(',')+128 then
                   if tree[level].rhstype[3] = subtree then
                      travel_dcl_(tree[level].rhsindex[3]
                                 , type_
                                 , local_size
                                 , size
                                 ,semantic)
                   else
                      if tree[level].rhstype[3] = ident then
                         begin 
                             local_size := local_size + size;
                             makesym(symtable[tree[level].rhsindex[3]]
                                    ,type_
                                    ,g_bsttable[g_cb].lexicallevel
                                    ,local_size
                                    ,size
                                    ,semantic
                                    ,literal)
                         end
                      else
                          begin
                            writeln(' have to be ident or subtree only');
                            error
                           end
                else
                ;
       end;  
   end;
 END;
end;
 (**********************************************************)
 procedure travel_dcl(level : integer; var local_size: integer);
     var type_ : vtype ;
         size : integer;
         semantic : sym_type_; 
     begin
          type_ := notused;
          semantic := variable;
          size  := 0; 
          travel_dcl_ (tree[level].rhsindex[2]
                      ,type_
                      ,local_size
                      ,size
                      ,semantic );
          travel_dcl_ (tree[level].rhsindex[4]
                       ,type_
                       ,local_size
                       ,size
                       ,semantic);
     end;
 (**************************************)
  procedure travel( level : integer);
   (* this is recursive proc *)
   var local_size : integer;
   begin

       local_size :=0;
       
       if (tree[level].rhstype[1]) <> empty then
          if (tree[tree[level].rhsindex[1]].rhsn = 6 ) then
             begin
                local_size :=travel___(level,1); (* look for dcls *)
                travel  (* goto lower procedures dcls *)
                (tree[tree[tree[level].rhsindex[1]].rhsindex[5]].rhsindex[5]);
                epilog(local_size)
             end
          else
             if(tree[tree[level].rhsindex[1]].rhsn = 2) then
                begin
                   travel(tree[level].rhsindex[1]);
                   travel(tree[level].rhsindex[2])
                end
             else
            ;
                  
      if (tree[level].rhstype[2]) <> empty then 
          if (tree[tree[level].rhsindex[2]].rhsn = 6) then
             begin
                local_size :=travel___(level,2);
                travel
               (tree[tree[tree[level].rhsindex[2]].rhsindex[5]].rhsindex[5]);
               epilog(local_size);
             end
          else
              if(tree[tree[level].rhsindex[2]].rhsn = 2) then
                  begin
                      travel(tree[level].rhsindex[1]);
                      travel(tree[level].rhsindex[2])
                  end
             else
             ;

      
end;
(*************************************************************)
function travel___ ;(* (level,index: integer); *)
var local_size : integer;
begin
       local_size := travel_(tree[level].rhsindex[index]);
       travel___ := local_size;
end;                       
(***************************************************************)
function travel_args(level:integer):integer;
var semantic: sym_type_;
    type_ : vtype;
    size,arg_storage : integer;
 begin
  arg_storage :=0;
  size :=0;
  semantic := parm;
  type_ := notused;

  if tree[level].rhsn <> 1 then
     begin
         if tree[level].rhsindex[1] = int('(')+128 then
            travel_dcl_(tree[level].rhsindex[2]
                        ,type_
                        ,arg_storage
                        ,size
                        ,semantic)
         else
            begin
                 writeln('invalide token in this conext');
                 writeln(' in travel_agrs'); error
            end;
    end
else
;
    travel_args := arg_storage;

end;
  (****************************************************************)
  function travel_ ; (* (level:integer) *)
  begin
      if tree[level].rhstype[1] <> empty then
         if tree[tree[level].rhsindex[1]].rhstype[1] <> empty then
           begin
             prolog(level);
             g_bsttable[g_cb].parm_size := travel_args(tree[level].rhsindex[2]);
             travel_ :=  travel__(tree[level].rhsindex[5])
          end
        else
     else
    ;

end;
(**************************************************************)
procedure travel_const (level: integer);
  var type_ : vtype;
      literal : symbol;
      semantic : sym_type_;
  begin
      type_ := notused;
      semantic := constant;

      if tree[level].rhsindex[2] = int(';')+128 then
         begin
            travel_const(tree[level].rhsindex[1]);
            travel_const(tree[level].rhsindex[3])
         end
      else
         makesym(symtable[tree[level].rhsindex[1]]
               ,type_
               ,g_bsttable[g_cb].lexicallevel
               ,0
               ,number(inttable[tree[level].rhsindex[3]])
               ,semantic
               ,inttable[tree[level].rhsindex[3]]
             );
end;     
(***************************************************************)        
function travel__ ;  (*  (level:integer)  *)
 var
     local_size,lower_level : integer;
     proc_name : symbol;
     temp :integer;


   begin
  
     local_size :=0;
     (* see if there are constants will become EQU *)
     temp:= tree[level].rhsindex[2];
     if (tree[temp].rhsindex[1] = TKCONST) then
       travel_const(tree[temp].rhsindex[2])
     else
     ;

     (* see if there are varibles in this proc *)
     temp := tree[level].rhsindex[4] ; (* point to VAR node *)

     if ( tree[temp].rhsindex[1] = TKVAR) then
         travel_dcl(temp,local_size) 
     else
     ;
   
     travel__ := local_size;

  end;
(*************************************************)
procedure make_outer_level_node;
 begin
    (* build imaginitive outer block for main program so that
       recursion work right *)
    tree[tree_last+1].rhstype[1] := subtree;
    tree[tree_last+1].rhstype[2] := subtree;
    tree[tree_last+1].rhsn :=2;
    (* now point this to the main *)
    tree[tree_last+1].rhsindex[1] := tree_last;
    tree[tree_last+1].rhsindex[2] := tree_last+2;
    tree[tree_last+2].rhstype[1] := EMPTY;
    tree[tree_last+2].rhsindex[1] := 9999;
    tree[tree_last+2].rhsn :=1;

 end;
 (****************************************)
  procedure build_global_symbol_table;
   var proc_name : symbol;
       symt : vtype;
   begin
       
    make_outer_level_node;
      (* now start travering the tree *)
    travel(tree_last+1);

   end;
(*******************************************************)
procedure print_token(a : integer);
begin
    case a of
      tkchar:   write(tables,'CHAR  '); 
      TKASG: 	write(tables,':=  ')  ;
      TKNE: 	write(tables,'NE  ')  ;
      TKLE: 	write(tables,'LE  ')  ;
      TKGE: 	write(tables,'GE  ')  ;
      TKDTDT: 	write(tables,'..  ')  ;
      TKABSOLUTE: 	write(tables,'ABSOLUTE  ')  ;
      TKAND: 	write(tables,'AND  ')  ;
      TKARRAY: 	write(tables,'ARRAY  ')  ;
      TKBEGIN: 	write(tables,'BEGIN  ')  ;
      TKCASE : 	write(tables,'   ')  ;
        TKCONST: 	write(tables,'CONST  ')  ;
        TKDIV: 	write(tables,'DIV  ')  ;
        TKDO: 	write(tables,'DO  ')  ;
        TKDOWNTO: 	write(tables,'DOWNTO  ')  ;
        TKELSE: 	write(tables,'ELSE  ')  ;
        TKEND: 	write(tables,'END  ')  ;
        TKEXTERNAL: 	write(tables,'EXTERNAL  ')  ;
        TKFILE: 	write(tables,'FILE  ')  ;
        TKFORWARD: 	write(tables,'FORWARD  ')  ;
        TKFOR: 	write(tables,'FOR  ')  ;
        TKFUNCTION: 	write(tables,'FUNCTION  ')  ;
        TKGOTO: 	write(tables,'GOTO  ')  ;
        TKINLINE: 	write(tables,'INLINE  ')  ;
        TKIF: 	write(tables,'IF  ')  ;
        TKIN: 	write(tables,'IN  ')  ;
        TKLABEL: 	write(tables,'LABEL  ')  ;
        TKMOD: 	write(tables,'MOD  ')  ;
        TKNIL: 	write(tables,'NIL  ')  ;
        TKNOT: 	write(tables,'NOT  ')  ;
        TKOVERLAY: 	write(tables,'OVERLAY  ')  ;
        TKOF: 	write(tables,'OF  ')  ;
        TKOR: 	write(tables,'OR  ')  ;
        TKPACKED: 	write(tables,'PACKED  ')  ;
        TKPROCEDURE: write(tables,'PROCEDURE  ')  ;
        TKPROGRAM: 	write(tables,'PROGRAM  ')  ;
        TKRECORD: 	write(tables,'RECORD  ')  ;
        TKREPEAT: 	write(tables,'REPEAT  ')  ;
        TKSET: 	write(tables,'SET  ')  ;
        TKSHL: 	write(tables,'SHL  ')  ;
        TKSHR: 	write(tables,'SHR  ')  ;
        TKSTRING: 	write(tables,'STRING  ')  ;
        TKTHEN: 	write(tables,'THEN  ')  ;
        TKTYPE: 	write(tables,'TYPE  ')  ;
        TKTO: 	write ('TO  ')  ;
        TKUNTIL: 	write(tables,'UNTIL  ')  ;
        TKVAR: 	write(tables,'VAR  ')  ;
        TKWHILE: 	write(tables,'WHILE  ')  ;
        TKWITH: 	write(tables,'WITH  ')  ;
        TKXOR: 	write(tables,'XOR  ')  ;
        TKREAL: 	write(tables,'REAL  ')  ;
        TKBOOLEAN: 	write(tables,'BOOLEAN  ')  ;
        TKINTEGER: 	write(tables,'INTEGER  ')  ;
        TKREAD: 	write(tables,'READ  ')  ;
        TKWRITE: 	write(tables,'WRITE  ')  ;
        TKTRUE: 	write(tables,'TRUE  ')  ;
        TKFALSE: 	write ('FALSE  ')  ;
        TKWRITELN:  write(tables,'WRITELN ')  ;
        TKREADLN: write(tables,'READLN ')  ;
        TKBYTE:    write(tables,'BYTE ')  ;
        otherwise 
          begin
             write ('error in write token unknown token number') ;
            error;
         end
    end
end;
(*******************************************************)
procedure dump_indx(i,j : integer);
begin
               case tree[i].rhstype[j] of 
                   SUBTREE:
                        write (tables,'(',tree[i].rhsindex[j]:1,')');
                   LITERAL:
                       write (tables,(tree[i].rhsindex[j]-128):1);
                   IDENT:
                        write (tables,symtable[tree[i].rhsindex[j]]:1);
                   INTEGER_IDENT:
                        write (tables,inttable[tree[i].rhsindEx[j]]:1);
                   TOKEN:
                        print_token(tree[i].rhsindex[j]);
                   STRING_IDENT:
                        write (tables,stringtable[tree[i].rhsindex[j]]:1);
                   EMPTY:
                        write(tables,'*empty*');
                   otherwise 
                        begin
                        writeln(' error cannot recorgize type in tree');
                        error;
                        end;
                 end;
end;
 (***********************************************************)
procedure dump_parse_tree;
 var i,j : integer;

 begin
writeln(tables);     
writeln(tables,'       P   A    R   S   E           T   A   B  L  E ');

    for i:=0 to tree_last do
       begin
           WRITE(tables,i,'. ');
           for j:=1 to tree[i].rhsn do
               case tree[i].rhstype[j] of

               SUBTREE :      write(tables,' subtree ');
               LITERAL :      write(tables,' literal ');
               IDENT   :      write(tables,' ident ');
               INTEGER_IDENT: write(tables,' int_idnt ');
               REAL_IDENT:    write(tables,' real_idnt ');
               TOKEN :        write(tables,' token ');
               STRING_IDENT:  write(tables,' string ');
               EMPTY :        write(tables,' EMPTY ');
               otherwise 
                    begin
                        writeln;
                        writeln('dont understand this type in pase_tree');
                        writeln('error in dump tree');
                        error;
                    end;

               end; (*case*)
           writeln(tables);
          write(tables,'             ');
          for j:=1 to tree[i].rhsn do
              begin
                dump_indx(i,j);
                write(tables,'    ');
             end;
       writeln(tables);
      end;

writeln(tables,'** end of parse table **');
end;
(***********************************************************************)
procedure dump_bst_table;
  var i,j : integer;
  begin
          
 writeln(tables,'                B  S  T       T A B L E   '); 
 writeln(tables,' Index  Entry_name   lex_level  Outer  localsize  parmsize');
     for i:=1 to g_lb do
          begin
               write(tables
                    ,i:5
                    ,g_bsttable[i].block_name:10
                    ,g_bsttable[i].lexicallevel:12
                    ,g_bsttable[i].outerblock:8
                    ,g_bsttable[i].local_size:10
                    ,g_bsttable[i].parm_size:10
                    );
               writeln(tables)
          end;
  writeln(tables,'** end of bst tables **');
end;
(*********************************************************)
procedure dump_symbol_table;

 var sp: symtabp;
     i: integer;

(*-----*)
   procedure dump(sp : symtabp);
     begin
          with sp^ do
              begin
                  write(tables,sym:3,Level:5,saddr:9,size:10);
                  case vtype_ of
                     byte_ : write(tables,'   BYTE');
                     integer_: write(tables,'   INTEGER');
                     boolean_ :write(tables,'   BOOL');
                     char_ :write(tables,'   CHAR');
                     array_ :write(tables,'   ARRAY');
                     notused: write(tables,'     n/a');
                     otherwise 
                        begin
                          writeln('dont undertand ident type in dump symtable');
                          error
                        end;
                     end; (* case *)
                  case sem_type of
                     entry: write(tables,'    ENTRY');
                     parm     :write(tables,'     PARM');
                     constant :write(tables,'     CONST');
                     variable : write(tables,'    VAR');
                  end;
                  write(tables,literal_val:10);
                  write(tables,blk_num:8);
                  writeln(tables); writeln(tables);
              end;
 end;
(*----*)

 begin
 writeln(tables,'              S Y M B O L      T A B L E');
 writeln(tables,'symbol Level  Offset  size(equ)  data   Type  literal Blk_num');

 for i:=0 to hlimit do
     begin
          sp:=symtab[i];
          while sp<> NIL do
               Begin
                    dump(sp);
                    sp:=sp^.next
               end;
     end;
 end;
(************************************************************)
procedure generate_code___ (level,index:integer);
  var temp:integer;
 begin
      temp:= tree[level].rhsindex[index];
      if tree[temp].rhstype[1] <> empty then
         if tree[tree[temp].rhsindex[1]].rhstype[1] <> empty then
             begin 
               _prolog(temp);
               temp:=
               tree[tree[tree[level].rhsindex[index]].rhsindex[5]].rhsindex[7];
               LHS := false;
               travel_code_gen (temp);
            end

end;       
      
(**************************************************************)
procedure generate_code (level:integer);
 (* this is recursive *)
 var temp: integer;
 begin
   
   if (tree[level].rhstype[1]) <> empty then
      if tree[level].rhsindex[1] <> 0 then
         if (tree[tree[level].rhsindex[1]].rhsn = 6 ) then
             begin
                generate_code___ (level,1);
                _epilog(tree[level].rhsindex[1]);
                temp:= tree[level].rhsindex[1];
                temp:= tree[temp].rhsindex[5];
                temp:= tree[temp].rhsindex[5];
                generate_code(temp)
             end
        else
      else
           if(tree[tree[level].rhsindex[1]].rhsn = 2 ) then
             begin
               generate_code(tree[level].rhsindex[1]);
               generate_code(tree[level].rhsindex[2])
             end
           else
           ; 

   if (tree[level].rhstype[2]) <> empty then
      if tree[level].rhsindex[2] <> 0 then
         if (tree[tree[level].rhsindex[2]].rhsn =6) then
           begin
             generate_code___(level,2);
             _epilog(tree[level].rhsindex[2]);
             temp:= tree[level].rhsindex[2];
             temp := tree[temp].rhsindex[5];
             temp := tree[temp].rhsindex[5];
             generate_code(temp)
           end
         else
      else
         if (tree[tree[level].rhsindex[2]].rhsn = 2) then
            begin
                generate_code(tree[level].rhsindex[1]);
                generate_code(tree[level].rhsindex[2])
           end
         else
         ;
end;
   
(**************************************************************)
procedure global_generate_code; (* i come here after initial tree traversal
                                where symtable and bst have been constructed *)
 begin
     init_global_vars;
     make_outer_level_node;
     generate_code(tree_last+1);      
   end; 
(*************************************************************)
procedure generate_EQU;
 var sp : symtabp;
     sym1 : symbol;
     hx : integer;

 begin
    assemply_line :=' ; OUTPUT of pascal compiler by Naser Abbasi'; emit;
    assemply_line :=' ; CSE565 Oakland University  April 1988'; emit;
    for hx:=0 to hlimit do
     begin    
        sp:=symtab[hx];
          while sp<>nil do
           begin
                if sp^.sem_type=constant then
                   begin
                     sym1 := sp^.literal_val;
                     (* handel hex values *)
                     if sym1[1]='$' then
                        begin
                           sym1[1] :=' ';
                           sym1 := sym1 + 'H'
                        end
                     else
                      ; 
                     assemply_line:=' '+ sp^.sym+' EQU  '  + sym1;
                     emit;
                   end
                else
                ;
    
               sp:= sp^.next
          end;
     end;
 assemply_line :=' doscall  EQU   21h  ; dos interupt routine'; emit; 
 emit_;

end;
 (**********************************************************)
 (*  M A I N    L I N E    S T A R T S   H E R E           *) 
begin

  debug := true;

  init;

  receive_parsor_output;
  if tree_last=-1  then begin 
     writeln(' parse tree was empty ');
     error
     end
  else
  ;
 
  build_global_symbol_table;

  if debug then
     BEGIN
         dump_symbol_table;
         dump_bst_table;
         dump_parse_tree
     END
   else
   ;

   generate_EQU; 
   global_generate_code;
   closing_code;
   cleanup;

end.