cc4.pas

C,C++ To Delphi转换器的源码

Unit CC4;
(*
** Small-C Compiler -- Part 4 -- Back End.
** Copyright 1982, 1983, 1985, 1988 J. E. Hendrix
** All rights reserved.
*)
Interface

uses CLIB,STDIO,CC,CC1,CC2;

(* #define DISOPT *)       (* display optimizations values *)

(***************** optimizer command definitions ******************)
const
             (*     --      p-codes must not overlap these *)
 any     =$00FF;   (* matches any p-code *)
 _pop    =$00FE;   (* matches if corresponding POP2 exists *)
 pfree   =$00FD;   (* matches if pri register free *)
 sfree   =$00FC;   (* matches if sec register free *)
 comm    =$00FB;   (* matches if registers are commutative *)

             (*     --      these digits are reserved for n *)
 go      =$0100;   (* go n entries *)
 gc      =$0200;   (* get code from n entries away *)
 gv      =$0300;   (* get value from n entries away *)
 sum     =$0400;   (* add value from nth entry away *)
 neg     =$0500;   (* negate the value *)
 ife     =$0600;   (* if value == n do commands to next 0 *)
 ifl     =$0700;   (* if value <  n do commands to next 0 *)
 swv     =$0800;   (* swap value with value n entries away *)
 topop   =$0900;   (* moves |code and current value to POP2 *)

 p1      =$0001;   (* plus 1 *)
 p2      =$0002;   (* plus 2 *)
 p3      =$0003;   (* plus 3 *)
 p4      =$0004;   (* plus 4 *)
 m1      =$00FF;   (* minus 1 *)
 m2      =$00FE;   (* minus 2 *)
 m3      =$00FD;   (* minus 3 *)
 m4      =$00FC;   (* minus 4 *)

 PRI     =  24;{0030}    (* primary register bits *)
 SEC     =   3;{0003}    (* secondary register bits *)
 _USES   =   9;{0011}    (* use register contents *)
 ZAPS    =  18;{0022}    (* zap register contents *)
 PUSHES  =  64;{0100}    (* pushes onto the stack *)
 COMMUTES= 128;{0200}    (* commutative p-code *)

(******************** optimizer command lists *********************)

 seq00:array[0..6] of integer =
  (0,ADD12,MOVE21,0,                       (* ADD21 *)
   go or p1,ADD21,0);

 seq01:array[0..12] of integer =
  (0,ADD1n,0,                              (* rINC1 or rDEC1 ? *)
   ifl or m2,0,ifl or 0,rDEC1,neg,0,ifl or p3,rINC1,0,0);

 seq02:array[0..12] of integer =
  (0,ADD2n,0,                              (* rINC2 or rDEC2 ? *)
   ifl or m2,0,ifl or 0,rDEC2,neg,0,ifl or p3,rINC2,0,0);

 seq03:array[0..10] of integer =
  (0,rDEC1,PUTbp1,rINC1,0,                 (* SUBbpn or DECbp *)
   go or p2,ife or p1,DECbp,0,SUBbpn,0);

 seq04:array[0..10] of integer =
  (0,rDEC1,PUTwp1,rINC1,0,                 (* SUBwpn or DECwp *)
   go or p2,ife or p1,DECwp,0,SUBwpn,0);

 seq05:array[0..10] of integer =
  (0,rDEC1,PUTbm1,rINC1,0,                 (* SUB_m_ COMMAn *)
   go or p1,SUB_m_,go or p1,COMMAn,go or m1,0);

 seq06:array[0..10] of integer =
  (0,rDEC1,PUTwm1,rINC1,0,                 (* SUB_m_ COMMAn *)
   go or p1,SUB_m_,go or p1,COMMAn,go or m1,0);

 seq07:array[0..12] of integer =
  (0,GETw1m,GETw2n,ADD12,MOVE21,GETb1p,0,  (* GETw2m GETb1p *)
   go or p4,gv or m3,go or m1,GETw2m,gv or m3,0);

 seq08:array[0..12] of integer =
  (0,GETw1m,GETw2n,ADD12,MOVE21,GETb1pu,0, (* GETw2m GETb1pu *)
   go or p4,gv or m3,go or m1,GETw2m,gv or m3,0);

 seq09:array[0..12] of integer =
  (0,GETw1m,GETw2n,ADD12,MOVE21,GETw1p,0,  (* GETw2m GETw1p *)
   go or p4,gv or m3,go or m1,GETw2m,gv or m3,0);

 seq10:array[0..10] of integer =
  (0,GETw1m,GETw2m,SWAP12,0,               (* GETw2m GETw1m *)
   go or p2,GETw1m,gv or m1,go or m1,gv or m1,0);

 seq11:array[0..7] of integer =
  (0,GETw1m,MOVE21,0,                      (* GETw2m *)
   go or p1,GETw2m,gv or m1,0);

 seq12:array[0..8] of integer =
  (0,GETw1m,PUSH1,pfree,0,                 (* PUSHm *)
   go or p1,PUSHm,gv or m1,0);

 seq13:array[0..10] of integer =
  (0,GETw1n,PUTbm1,pfree,0,                (* PUT_m_ COMMAn *)
   PUT_m_,go or p1,COMMAn,go or m1,swv or p1,0);

 seq14:array[0..10] of integer =
  (0,GETw1n,PUTwm1,pfree,0,                (* PUT_m_ COMMAn *)
   PUT_m_,go or p1,COMMAn,go or m1,swv or p1,0);

 seq15:array[0..8] of integer =
  (0,GETw1p,PUSH1,pfree,0,                 (* PUSHp *)
   go or p1,PUSHp,gv or m1,0);

 seq16:array[0..12] of integer =
  (0,GETw1s,GETw2n,ADD12,MOVE21,0,         (* GETw2s ADD2n *)
   go or p3,ADD2n,gv or m2,go or m1,GETw2s,gv or m2,0);

 seq17:array[0..11] of integer =
  (0,GETw1s,GETw2s,SWAP12,0,               (* GETw2s GETw1s *)
   go or p2,GETw1s,gv or m1,go or m1,GETw2s,gv or m1,0);

 seq18:array[0..7] of integer =
  (0,GETw1s,MOVE21,0,                      (* GETw2s *)
   go or p1,GETw2s,gv or m1,0);

 seq19:array[0..12] of integer =
  (0,GETw2m,GETw1n,SWAP12,SUB12,0,         (* GETw1m SUB1n *)
   go or p3,SUB1n,gv or m2,go or m1,GETw1m,gv or m2,0);

 seq20:array[0..7] of integer =
  (0,GETw2n,ADD12,0,                       (* ADD1n *)
   go or p1,ADD1n,gv or m1,0);

 seq21:array[0..12] of integer =
  (0,GETw2s,GETw1n,SWAP12,SUB12,0,         (* GETw1s SUB1n *)
   go or p3,SUB1n,gv or m2,go or m1,GETw1s,gv or m2,0);

 seq22:array[0..10] of integer =
  (0,rINC1,PUTbm1,rDEC1,0,                 (* ADDm_ COMMAn *)
   go or p1,ADDm_,go or p1,COMMAn,go or m1,0);

 seq23:array[0..10] of integer =
  (0,rINC1,PUTwm1,rDEC1,0,                 (* ADDm_ COMMAn *)
   go or p1,ADDm_,go or p1,COMMAn,go or m1,0);

 seq24:array[0..10] of integer =
  (0,rINC1,PUTbp1,rDEC1,0,                 (* ADDbpn or INCbp *)
   go or p2,ife or p1,INCbp,0,ADDbpn,0);

 seq25:array[0..10] of integer =
  (0,rINC1,PUTwp1,rDEC1,0,                 (* ADDwpn or INCwp *)
   go or p2,ife or p1,INCwp,0,ADDwpn,0);

 seq26:array[0..9] of integer =
  (0,MOVE21,GETw1n,SWAP12,SUB12,0,         (* SUB1n *)
  go or p3,SUB1n,gv or m2,0);

 seq27:array[0..7] of integer =
  (0,MOVE21,GETw1n,comm,0,                 (* GETw2n comm *)
   go or p1,GETw2n,0);

 seq28:array[0..12] of integer =
  (0,POINT1m,GETw2n,ADD12,MOVE21,0,        (* POINT2m_ PLUSn *)
   go or p3,PLUSn,gv or m2,go or m1,POINT2m_,gv or m2,0);

 seq29:array[0..8] of integer =
  (0,POINT1m,MOVE21,pfree,0,               (* POINT2m *)
  go or p1,POINT2m,gv or m1,0);

 seq30:array[0..8] of integer =
  (0,POINT1m,PUSH1,pfree,_pop,0,           (* ... POINT2m *)
   topop or POINT2m,go or p2,0);

 seq31:array[0..10] of integer =
  (0,POINT1s,GETw2n,ADD12,MOVE21,0,        (* POINT2s *)
   sum or p1,go or p3,POINT2s,gv or m3,0);

 seq32:array[0..11] of integer =
  (0,POINT1s,PUSH1,MOVE21,0,               (* POINT2s PUSH2 *)
   go or p1,POINT2s,gv or m1,go or p1,PUSH2,go or m1,0);

 seq33:array[0..8] of integer =
  (0,POINT1s,PUSH1,pfree,_pop,0,           (* ... POINT2s *)
   topop or POINT2s,go or p2,0);

 seq34:array[0..7] of integer =
  (0,POINT1s,MOVE21,0,                     (* POINT2s *)
   go or p1,POINT2s,gv or m1,0);

 seq35:array[0..8] of integer =
  (0,POINT2m,GETb1p,sfree,0,               (* GETb1m *)
   go or p1,GETb1m,gv or m1,0);

 seq36:array[0..8] of integer =
  (0,POINT2m,GETb1pu,sfree,0,              (* GETb1mu *)
   go or p1,GETb1mu,gv or m1,0);

 seq37:array[0..8] of integer =
  (0,POINT2m,GETw1p,sfree,0,               (* GETw1m *)
   go or p1,GETw1m,gv or m1,0);

 seq38:array[0..12] of integer =
  (0,POINT2m_,PLUSn,GETw1p,sfree,0,        (* GETw1m_ PLUSn *)
   go or p2,gc or m1,gv or m1,go or m1,GETw1m_,gv or m1,0);

 seq39:array[0..9] of integer =
  (0,POINT2s,GETb1p,sfree,0,               (* GETb1s *)
   sum or p1,go or p1,GETb1s,gv or m1,0);

 seq40:array[0..9] of integer =
  (0,POINT2s,GETb1pu,sfree,0,              (* GETb1su *)
   sum or p1,go or p1,GETb1su,gv or m1,0);

 seq41:array[0..10] of integer =
  (0,POINT2s,GETw1p,PUSH1,pfree,0,         (* PUSHs *)
   sum or p1,go or p2,PUSHs,gv or m2,0);

 seq42:array[0..9] of integer =
  (0,POINT2s,GETw1p,sfree,0,               (* GETw1s *)
   sum or p1,go or p1,GETw1s,gv or m1,0);

 seq43:array[0..10] of integer =
  (0,PUSH1,any,POP2,0,                     (* MOVE21 any *)
   go or p2,gc or m1,gv or m1,go or m1,MOVE21,0);

 seq44:array[0..6] of integer =
  (0,PUSHm,_pop,0,                         (* ... GETw2m *)
   topop or GETw2m,go or p1,0);

 seq45:array[0..11] of integer =
  (0,PUSHp,any,POP2,0,                     (* GETw2p ... *)
   go or p2,gc or m1,gv or m1,go or m1,GETw2p,gv or m1,0);

 seq46:array[0..6] of integer =
  (0,PUSHs,_pop,0,                         (* ... GETw2s *)
   topop or GETw2s,go or p1,0);

 seq47:array[0..12] of integer =
  (0,SUB1n,0,                              (* rDEC1 or rINC1 ? *)
   ifl or m2,0,ifl or 0,rINC1,neg,0,ifl or p3,rDEC1,0,0);

 HIGH_SEQ  =47;

type
 TIntegers=array[0..16383] of integer;
 PIntegers=^TIntegers;
var
 seq:array[0..HIGH_SEQ] of PIntegers;

procedure setseq;

(***************** assembly-code strings ******************)

var
 code:array[0..PCODES-1] of pchar;

(*
** First byte contains flag bits indicating:
**    the value in ax is needed (010) or zapped (020)
**    the value in bx is needed (001) or zapped (002)
*)
procedure setcodes;

(***************** code generation functions *****************)

(*
** print all assembler info before any code is generated
** and ensure that the segments appear in the correct order.
*)
procedure header;

(*
** print any assembler stuff needed at the end
*)
procedure trailer;

(*
** remember where we are in the queue in case we have to back up.
*)
procedure setstage(var before, start:integer);

(*
** generate code in staging buffer.
*)
procedure gen(pcode, value:integer);

(*
** dump the contents of the queue.
** If start = 0, throw away contents.
** If before != 0, don't dump queue yet.
*)
procedure clearstage(var before, start:integer);

(*
** dump the staging buffer
*)
procedure dumpstage;

(*
** change to a new segment
** may be called with NULL, CODESEG, or DATASEG
*)
procedure toseg(newseg:integer);

(*
** declare entry point
*)
procedure _public(ident:integer);

(*
** declare external reference
*)
procedure _external(name:pchar; size, ident:integer);

(*
** output the size of the object pointed to.
*)
procedure outsize(size, ident:integer);

(*
** point to following object(s)
*)
procedure point;

(*
** dump the literal pool
*)
procedure dumplits(size:integer);

(*
** dump zeroes for default initial values
*)
procedure dumpzero(size, count:integer);

(******************** optimizer functions ***********************)

(*
** Try to optimize sequence at snext in the staging buffer.
*)
function peep(seq:pintegers):integer;

(*
** Is the primary or secondary register free?
** Is it zapped or unused by the p-code at pp
** or a successor?  If the primary register is
** unused by it still may not be free if the
** context uses the value of the expression.
*)
function isfree(reg:integer; var pp:integer):boolean;

(*
** Get place where the currently pushed value is popped?
** NOTE: Function arguments are not popped, they are
** wasted with an ADDSP.
*)
function getpop(var next:integer):integer;

(******************* output functions *********************)

procedure colon;
procedure newline;

(*
** output assembly code.
*)
procedure outcode(pcode, value:integer);
procedure outdec(number:integer);
procedure outline(ptr:pchar);
procedure outname(ptr:pchar);
procedure outstr(ptr:pchar);

Implementation

procedure setseq;
 begin
  seq[ 0]:=@seq00;  seq[ 1]:=@seq01;  seq[ 2]:=@seq02;  seq[ 3]:=@seq03;
  seq[ 4]:=@seq04;  seq[ 5]:=@seq05;  seq[ 6]:=@seq06;  seq[ 7]:=@seq07;
  seq[ 8]:=@seq08;  seq[ 9]:=@seq09;  seq[10]:=@seq10;  seq[11]:=@seq11;
  seq[12]:=@seq12;  seq[13]:=@seq13;  seq[14]:=@seq14;  seq[15]:=@seq15;
  seq[16]:=@seq16;  seq[17]:=@seq17;  seq[18]:=@seq18;  seq[19]:=@seq19;
  seq[20]:=@seq20;  seq[21]:=@seq21;  seq[22]:=@seq22;  seq[23]:=@seq23;
  seq[24]:=@seq24;  seq[25]:=@seq25;  seq[26]:=@seq26;  seq[27]:=@seq27;