main.pas

编译原理实验 完整的

program PasCompiler(input,output);

  const
    IdLength=10;
    maxint=16383;
    illeng=81;
    symnum=53;
    levmax=7;
    addrmax=4095;
    tnmax=70;
    tsmax=200;
    timax=80;
    tbmax=10;
    tcmax=1023;
    tlmax=255;

    isize=1;
    csize=1;
    bsize=1;
  type
    symbol=({ 0}ident,intconst,charconst,strconst,programsy,
            { 5}constsy,typesy,varsy,procsy,funcsy,beginsy,ifsy,
            {12}whilesy,forsy,endsy,thensy,elsesy,ofsy,dosy,
            {19}tosy,downtosy,arraysy,recordsy,notop,times,divop,
            {26}modop,andop,plus,minus,orop,lsop,leop,gtop,
            {34}geop,neop,eqop,lparent,rparent,lbracket,rbracket,
            {41}comma,semicolon,period,colon,becomes,range,
            {47}eoline,eofile,other,call,empty,boolconst,
            {53}unaryminus);
    symset=set of symbol;
    cardinal=0..maxint;
    CharPos=0..illeng;
    TextPos=record
              LineNumber:0..9999;
              CharNumber:cardinal
            end;
    LevelRange=0..levmax;
    AddrRange=0..addrmax;
    RuntimeAddress
             =record
                StaticLevel:LevelRange;
                RelativeAddress:AddrRange
              end;
    StructForm=(inv,strs,ints,chars,bools,subranges,arrays,records);
    StPtr=^Structure;
    Structure=packed record
                  order:cardinal;
                  next:StPtr;
                  size:cardinal;
                  case form:StructForm of
        inv,strs,ints,chars,bools
                       :({no field});
        subranges:(RangeType:StPtr;
                   min:integer;
                   max:integer);
        arrays:(IndexType:StPtr;
                ElementType:StPtr);
        records:(LastField:cardinal)
                     end{record};
    IdClass=(constss,typess,varss,
             fieldss,procss,funcss);
    VarKind=(noparam,valparam,varparam);
    StandFuncs=(absf,sqrf,ordf,chrf,succf,predf,oddf);
    StandProcs=(readp,readlnp,writep,writelnp);
    identifier=packed record
                   name:cardinal;
                   previous:cardinal;
                   typ:StPtr;
                   case class:IdClass of
           constss:(val:integer);
           typess:(               );
           varss:(address:RuntimeAddress;
                     kind:VarKind;
                     IsControlVar:Boolean);
           fieldss:(offset:cardinal);
           procss:(case IsStandp:Boolean of
                      true:(standp:StandProcs);
                      false:(plev:LevelRange;
                            pEntry:cardinal;
                            pindex:cardinal));
           funcss:(case IsStandf:Boolean of
                      true:(standf:StandProcs);
                      false:(flev:LevelRange;
                            fEntry:cardinal;
                            findex:cardinal));
                      end{record};
    BTabTerm=record
                    LastPar:cardinal;
                    ParSize:cardinal;
                    LastId:cardinal;
                    VarSize:cardinal;
             end;
    OperandForm=(invalid,invinv,strstr,invint,intinv,intint,
                 invbool,boolinv,boolbool,invchar,charinv,charchar,
                 invarr,arrinv,arrarr,invrec,recinv,recrec);
    ILFileType=file of cardinal;
    PTCFileType=file of integer;
    table=(nametab,stringtab,identtab,blocktab,codetab,labletab);
    alfa=packed array[1..IdLength]of char;
    pass=(pass1,pass2,pass3,pass4,pass5);
    {**********PASCAL-T Machine(PTCode)***********}
    OperatingCode=({ 0}LADR,LVAL,LINT,OPAR,CAL,ETBK,EXBK,EXPG,
                   { 8}UDSP,LBK,CPBK,IDXV,FLDV,JMP,JMPZ,ASIG,
                   {16}EFLU,EFLD,AFBU,AFBD,EFL,NEGI,ADDI,SUBI,
                   {24}MULI,DIVI,MODI,EQCP,NECP,LTCP,LECP,GTCP,
                   {32}GECP,ORB,ANDB,NOTB,FABS,FSQR,FORD,FCHR,
                   {40}FSUC,FPRE,FODD,RVAR,RLIN,WSTR,WEXP,WLIN,
                   {48}NOP);
    OpCodeSet=set of OperatingCode;
    instruction=record
                  OpCode:OperatingCode;
                  arg1,arg2,arg3:integer
                end;
    CodeLable=AddrRange;
    {********MAIN PROGRAM and UTILITY ROUTINE********}
    alfa4=packed array [1..4] of char;
    alfa6=packed array [1..6] of char;
    alfa10=packed array [1..10] of char;
  var
    sy:symbol;
    SyPos:TextPos;
    ErrCount:cardinal;
    overflow:set of table;
    operandfm:OperandForm;
    ZeroArgument,OneArgument,TwoArgument,ThreeArgument
             :OpCodeSet;{pass5}
    NTab:array[0..tnmax]of alfa;
    STab:array[0..tsmax]of char;
    ITab:array[0..timax]of identifier;
    BTab:array[0..tbmax]of BTabTerm;
    CTab:array[0..tcmax]of integer;
    LTab:array[0..tlmax]of cardinal;
    tn:cardinal;
    ts:cardinal;
    ti:cardinal;
    tb:cardinal;
    tl:cardinal;
    NIndex:cardinal;
    IdIndex:cardinal;
    IValue:cardinal;
    BValue:cardinal;
    CValue:cardinal;
    SEntry:cardinal;
    SLength:cardinal;
    signs:symset;
    mulops:symset;
    addops:symset;
    relops:symset;
    defbegsys:symset;
    constbegsys:symset;
    typebegsys:symset;
    statbegsys:symset;
    facbegsys:symset;
    termbegsys:symset;
    simexprbegsys:symset;
    exprbegsys:symset;
    invptr:StPtr;
    strptr:StPtr;
    intptr:StPtr;
    charptr:StPtr;
    boolptr:StPtr;
    {*************MAIN PROGRAM and UTILITY ROUTINE*****************}
    PAS:text;
    IL1:ILFileType;
    IL2:ILFileType;
    IL3:ILFileType;
    PTCode:PTCFileType;
    ASN:text;
    SFile:file of char;
    DSP:text;
    sym:array[0..symnum]of symbol;
    OpFm:array[0..16]of OperandForm;
    OperatCd:array[0..48]of OperatingCode;
    sp:array[symbol]of alfa10;
    OpFmSp:array[OperandForm]of alfa6;
    OpCdSp:array[OperatingCode]of alfa4;
    IdClassSp:array[IdClass]of alfa6;
    StandpSp:array[StandProcs]of alfa6;
    StandfSp:array[StandFuncs]of alfa6;
    KindSp:array[VarKind]of alfa6;
    StFormSp:array[StructForm]of alfa6;

{{{*******************************************************************}
{{{                         FIRST GROUP                               }
{{{*******************************************************************}
procedure Initialization;
  procedure InitSmOdOm;
    var sy:symbol;oc:OperatingCode;od:OperandForm;
  begin
    for sy:=ident to unaryminus do sym[ord(sy)]:=sy;
    for oc:=LADR to NOP do OperatCd[ord(oc)]:=oc;
    for od:=invalid to recrec do OpFm[ord(od)]:=od
  end;
  procedure InitSp;
  begin
    sp[ident]:='ident     ';      sp[intconst]:='intconst  ';
    sp[charconst]:='charconst ';  sp[strconst]:='strconst  ';
    sp[programsy]:='programsy ';  sp[constsy]:='constsy   ';
    sp[typesy]:='typesy    ';     sp[varsy]:='varsy     ';
    sp[procsy]:='procsy    ';     sp[funcsy]:='funcsy    ';
    sp[beginsy]:='beginsy   ';    sp[ifsy]:='ifsy      ';
    sp[whilesy]:='whilesy   ';    sp[forsy]:='forsy     ';
    sp[endsy]:='endsy     ';      sp[thensy]:='thensy    ';
    sp[elsesy]:='elsesy    ';     sp[ofsy]:='ofsy      ';
    sp[dosy]:='dosy      ';       sp[tosy]:='tosy      ';
    sp[downtosy]:='downtosy  ';   sp[arraysy]:='arraysy   ';
    sp[recordsy]:='recordsy  ';   sp[notop]:='notsy     ';
    sp[times]:='times     ';      sp[divop]:='divop     ';
    sp[modop]:='modop     ';      sp[andop]:='andop     ';
    sp[plus]:='plus      ';       sp[minus]:='minus     ';
    sp[orop]:='orop      ';       sp[lsop]:='lsop      ';
    sp[leop]:='leop      ';       sp[gtop]:='gtop      ';
    sp[geop]:='geop      ';       sp[neop]:='neop      ';
    sp[eqop]:='eqop      ';       sp[lparent]:='lparent   ';
    sp[rparent]:='rparent   ';    sp[lbracket]:='lbracket  ';
    sp[rbracket]:='rbracket  ';   sp[comma]:='comma     ';
    sp[semicolon]:='semicolon ';  sp[period]:='period    ';
    sp[colon]:='colon     ';      sp[becomes]:='becomes   ';
    sp[range]:='range     ';      sp[eoline]:='eoline    ';
    sp[eofile]:='edfile    ';     sp[other]:='other     ';
    sp[call]:='call      ';       sp[empty]:='empty     ';
    sp[boolconst]:='boolconst ';  sp[unaryminus]:='unaryminus';
    {}
    IdClassSp[constss]:='consts';
    IdClassSp[typess]:='types ';
    IdClassSp[varss]:='vars  ';
    IdClassSp[fieldss]:='fields';
    IdClassSp[procss]:='procss';
    IdClassSp[funcss]:='funcs ';
    {}
    StandpSp[readp]:='read  ';  StandpSp[readlnp]:='readln';
    StandpSp[writep]:='write '; StandpSp[writelnp]:='writln';
    {}
    StandfSp[absf]:='abs   ';       StandfSp[sqrf]:='sqr   ';
    StandfSp[ordf]:='ord   ';       StandfSp[chrf]:='chr   ';
    StandfSp[succf]:='succ  ';      StandfSp[predf]:='pred  ';
    StandfSp[oddf]:='odd   ';
    {}
    KindSp[noparam]:='nopar ';    KindSp[valparam]:='valpar';
    KindSp[varparam]:='varpar';
    {}
    StFormSp[inv]:='inv   ';           StFormSp[strs]:='strs  ';
    StFormSp[ints]:='ints  ';          StFormSp[chars]:='chars ';
    StFormSp[bools]:='bools ';         StFormSp[subranges]:='subran';
    StFormSp[arrays]:='arrays';       StFormSp[records]:='record';
    {}
    OpFmSp[invalid]:='invald';       OpFmSp[invinv]:='invinv';
    OpFmSp[strstr]:='strstr';        OpFmSp[invint]:='invint';
    OpFmSp[intinv]:='intinv';       OpFmSp[intint]:='intint';
    OpFmSp[invbool]:='invbol';       OpFmSp[boolinv]:='bolinv';
    OpFmSp[boolbool]:='bolbol';      OpFmSp[invchar]:='invchr';
    OpFmSp[charinv]:='chrinv';      OpFmSp[charchar]:='chrchr';
    OpFmSp[invarr]:='invarr';        OpFmSp[arrinv]:='arrinv';
    OpFmSp[arrarr]:='arrarr';        OpFmSp[invrec]:='invrec';
    OpFmSp[recinv]:='recinv';        OpFmSp[recrec]:='recrec';
    {}
    OpCdSp[LADR]:='LADR';    OpCdSp[LVAL]:='LVAL';    OpCdSp[LINT]:='LINT';
    OpCdSp[OPAR]:='OPAR';    OpCdSp[CAL]:='CAL ';     OpCdSp[ETBK]:='ETBK';
    OpCdSp[EXBK]:='EXBK';    OpCdSp[EXPG]:='EXPG';    OpCdSp[UDSP]:='UDSP';
    OpCdSp[LBK]:='LBK ';     OpCdSp[CPBK]:='CPBK';    OpCdSp[IDXV]:='IDXV';
    OpCdSp[FLDV]:='FLDV';    OpCdSp[JMP]:='JMP ';     OpCdSp[JMPZ]:='JMPZ';
    OpCdSp[ASIG]:='ASIG';    OpCdSp[EFLU]:='EFLU';    OpCdSp[EFLD]:='EFLD';
    OpCdSp[AFBU]:='AFBU';    OpCdSp[AFBD]:='AFBD';    OpCdSp[EFL]:='EFL ';
    OpCdSp[NEGI]:='NEGI';    OpCdSp[ADDI]:='ADDI';    OpCdSp[SUBI]:='SUBI';
    OpCdSp[MULI]:='MULI';    OpCdSp[DIVI]:='DIVI';    OpCdSp[MODI]:='MODI';
    OpCdSp[EQCP]:='EQCP';    OpCdSp[NECP]:='NECP';    OpCdSp[LTCP]:='LTCP';
    OpCdSp[LECP]:='LECP';    OpCdSp[GTCP]:='GTCP';    OpCdSp[GECP]:='GECP';
    OpCdSp[ORB]:='ORB ';     OpCdSp[ANDB]:='ANDB';    OpCdSp[NOTB]:='NOTB';
    OpCdSp[FABS]:='FABS';    OpCdSp[FSQR]:='FSQR';    OpCdSp[FORD]:='FORD';
    OpCdSp[FCHR]:='FCHR';    OpCdSp[FSUC]:='FSUC';    OpCdSp[FPRE]:='FPRE';
    OpCdSp[FODD]:='FODD';    OpCdSp[RVAR]:='RVAR';    OpCdSp[RLIN]:='RLIN';
    OpCdSp[WSTR]:='WSTR';    OpCdSp[WEXP]:='WEXP';    OpCdSp[WLIN]:='WLIN';
    OpCdSp[NOP]:='NOP ';
  end{InitSp};
  procedure InitSets;
  begin
    defbegsys:=[constsy..funcsy];
    constbegsys:=[ident,intconst,charconst,plus,minus];
    typebegsys:=constbegsys+[arraysy,recordsy];
    statbegsys:=[ident,beginsy..forsy];
    facbegsys:=[ident,intconst,charconst,strconst,lparent,notop];
    termbegsys:=facbegsys;
    simexprbegsys:=[plus,minus]+termbegsys;
    exprbegsys:=simexprbegsys;
    signs:=[plus,minus];
    addops:=[plus..orop];
    mulops:=[times..andop];
    relops:=[lsop..eqop];
    {              main  pass5}
    ZeroArgument:=[LVAL,EXPG,ASIG,EFL,NEGI..NOTB,
                   FABS,FSQR,FORD,FCHR,FODD,RLIN,WLIN];
    OneArgument:=[LINT,OPAR,CAL,EXBK,LBK,CPBK,CPBK,FLDV,JMP,
                  JMPZ,FSUC,FPRE,RVAR,WEXP];
    TwoArgument:=[LADR,ETBK,UDSP,EFLU,EFLD,AFBU,AFBD,NOP,WSTR];
    ThreeArgument:=[IDXV]
  end;
begin
  overflow:=[];ErrCount:=0;
  InitSmOdOm;InitSp;InitSets
end;



procedure OpenFiles;
  type alfa8=packed array[1..8] of char;
       alfa3=packed array[1..3] of char;
       alfa12=packed array[1..12] of char;
  var SourceName:alfa8;
        FileFullName:alfa12;
  procedure ReadFileName(var FileName:alfa8);
    var i:integer; ch:char;
  begin
    write('Name of source file:');
    repeat read(ch) until ch<>'';
    FileName:='        ';i:=1;
    while((ch<>'.')and(i<=8)) do
    begin
      FileName[i]:=ch;
      if not eoln then begin i:=succ(i);read(ch) end else ch:='.'
    end;
    readln;
  end;
  procedure LinkExtName(var FileFullName:alfa12;
                          FileName:alfa8;ExtName:alfa3);
    var i,j:integer;
  begin
    FileFullName:='            ';i:=1;
    while(FileName[i]<>'')and(i<=8) do