📄 source.htm.bak

📁 建立《编译原理网络课程》的目的不仅使学生掌握构造编译程序的原理和技术
💻 BAK
📖 第 1 页 / 共 5 页
字号:
12 3 4 5 下一页
<html>

<head>
<style>
.unnamed1 {  font-family: "宋体"; font-size: 9pt; text-decoration: none; color: #666666}
body {  font-family: "宋体", "仿宋_GB2312", "楷体_GB2312"; font-size: 9pt}
tr {  font-family: "宋体", "仿宋_GB2312", "楷体_GB2312"; font-size: 9pt}
body {
background-color:#FFFFFF;
SCROLLBAR-FACE-COLOR: #f0f0f0;
SCROLLBAR-HIGHLIGHT-COLOR: #ffffff;
SCROLLBAR-SHADOW-COLOR: #339966;
SCROLLBAR-3DLIGHT-COLOR: #339966;
SCROLLBAR-ARROW-COLOR: #000000;
SCROLLBAR-TRACK-COLOR: #f0f0f0;
SCROLLBAR-DARKSHADOW-COLOR: #ffffff
}
a { text-transform: none; text-decoration: none }
-->
</style>
<title>源程序</title>
</head>

<body>

<pre><font size="3">
PROGRAM compile;

USES dos,crt;

CONST
      MAXparam=15;
      MAXfield=30;
      PRIME=211;
      READBUFFER_SIZE=512;

      ALPHA=['a'..'z','A'..'Z'];
      NUMBER=['0'..'9'];

TYPE
    <a
name="str12">str12</a>=string[12];

    <a name="idtype">idtype</a>=(int,bool);
    <a
name="idpointer">idpointer</a>=^identifier;

    <a name="namelinkp">namelinkp</a>=^namelink;
    <a
name="namelink">namelink</a>=record
             name:str12;
             next:namelinkp;
             end;

    <a
name="field">field</a>=record
            name:str12;
            fieldtype:idpointer;
            offset:integer
          end;
    <a
name="param">param</a>=record
            paramtype:idpointer;
            isVar:boolean;
          end;

    identifier=record
                     name:str12;
                     size:integer;
                     level:integer;
                     next_hash_id:idpointer;
                     next_varList_id:idpointer;
                     case idclass:1..6 of
      {constant}     1:
                        ( value:integer;
                          consttype:idtype );
      {arraytype}    2:
                        ( minindex,maxindex:integer;
                          indextype:idtype;
                          elementtype:idpointer );
      {recordtype}   3:
                        ( items:array [1..MAXfield] of field;
                          itemnum:integer );
      {standard type , integer or boolean}
                     4:
                        ( typename:idtype );
      {variables}    5:
                        ( vartype:idpointer;
                          offset:integer;
                          isvarparam:boolean );
      {procedure}    6:
                        ( isStandard:boolean;
                          params:array[1..MAXparam] of param;
                          paramnum,paramlength:integer;
                          address:integer; )
               end;

    hashtabletype=array [0..PRIME-1] of idpointer;

    <a
name="ProVarListStack">ProVarListStack</a>=^StackType;
    <a name="StackType">StackType</a>=record
                List:idpointer;
                next:ProVarListStack
              end;

    <a
name="wordsort">wordsort</a>=(id,reserved,num,addop,multiop,relop,other,endfile);

VAR
    tf,obj      :string;
    <a
name="fsource">fsource</a>     :file;
    <a name="fdestinate">fdestinate</a>  :file of integer;
    <a
name="filepointer">filepointer</a> :integer;
    endtext     :boolean;
    lineno      :integer;

    hashtable   :hashtabletype;
    <a
name="head">head</a>        :ProVarListStack;
    <a name="curProVarL">curProVarL</a>  :idpointer;
    curLevel    :integer;

    <a
name="buffer">buffer</a>      :array [0..2*READBUFFER_SIZE-1] of char;
    <a
name="forward">forward</a>     :integer;
    <a name="linebuffer">linebuffer</a>  :string;
    <a
name="column">column</a>      :integer;
    <a name="errorstring">errorstring </a>:array [1..40] of string;
    <a
name="errorhappen">errorhappen</a> :boolean;
    <a name="errorinline">errorinline</a> :boolean;
    <a
name="errorcol">errorcol</a>    :integer;
   <a name="errornum"> errornum </a>   :integer;
    <a
name="errorcount">errorcount</a>  :integer;

    <a name="namelist">namelist</a>    :namelinkp;
    <a
name="namelisttail">namelisttail</a>:namelinkp;

    reservelist :array [1..20] of string;
    <a
name="wtype">wtype</a>       :wordsort;
    <a name="wval">wval</a>        :string;
    <a
name="character">character</a>   :char;
    <a name="token">token</a>       :string;
    <a
name="load">load</a>        :boolean;
    <a name="retract_w">retract_w</a>   :boolean;

    boolpoint   :idpointer;
    intpoint    :idpointer;

    compile_success:boolean;

PROCEDURE lexicure;forward;
PROCEDURE _body(var varlength,templength,displ:integer);forward;
FUNCTION _sentence(var templength:integer):boolean;forward;
PROCEDURE _compound(var templength:integer);forward;
FUNCTION _expr(var thistype:idpointer;var templength:integer):boolean;forward;
PROCEDURE finalcomp;forward;

{------some operation of procedure_varible_list stack----------------}

PROCEDURE <a
name="push">push</a>;
  VAR element:ProVarListStack;
  BEGIN
       new(element);
       with element^ do
       begin
            List:=curProVarL;
            next:=head
       end;
       head:=element;
       curProVarL:=nil;
  END;

PROCEDURE <a
name="pop">pop</a>;
  VAR element:ProVarListStack;
  BEGIN
       curProVarL:=head^.list;
       element:=head;
       head:=element^.next;
       dispose(element);
  END;

FUNCTION <a
name="isEmpty">isEmpty</a>:boolean;
  BEGIN
       if head^.next=nil
       then isEmpty:=true
       else isEmpty:=false
  END;

{------some operation of namelist----------------}

PROCEDURE <a
name="insertname">insertname</a>(s:string);
  VAR
     nameitem:namelinkp;
  BEGIN
       new(nameitem);
       with nameitem^ do
       begin
            name:=copy(s,1,12);
            next:=nil;
       end;
       if namelist=nil then
       begin
            namelist:=nameitem;
            namelisttail:=nameitem;
       end
       else
       begin
            namelisttail^.next:=nameitem;
            namelisttail:=nameitem;
       end;
  END;

PROCEDURE <a
name="deletelist">deletelist</a>;
  VAR
     nameitem:namelinkp;
  BEGIN
       while namelist&lt;&gt;nil do
       begin
            nameitem:=namelist;
            namelist:=namelist^.next;
            dispose(nameitem);
       end;
       namelisttail:=nil;
       namelist:=nil;
  END;

{------<a
name="op errors">operations of errors-</a>-------------------------------------}

PROCEDURE <a
name="skipline">skipline</a>;
  BEGIN
       while wval&lt;&gt;';' do lexicure;
       retract_w:=true;
  END;

PROCEDURE <a
name="skip_in_record">skip_in_record</a>;
  BEGIN
       while (wval&lt;&gt;';') and (wval&lt;&gt;'END') and (wval&lt;&gt;'VAR') and
             (wval&lt;&gt;'PROCEDURE') and (wval&lt;&gt;'BEGIN') and (wtype&lt;&gt;endfile) do
             lexicure;
       retract_w:=true;
  END;

PROCEDURE <a
name="skip_in_const">skip_in_const</a>;
  BEGIN
       while (wval&lt;&gt;'TYPE') and (wval&lt;&gt;'VAR') and (wval&lt;&gt;'PROCEDURE') and
             (wval&lt;&gt;'BEGIN') and (wval&lt;&gt;';') and (wtype&lt;&gt;endfile) do
             lexicure;
       if wval&lt;&gt;';' then retract_w:=true;
  END;

PROCEDURE <a
name="skip_in_type">skip_in_type</a>;
  BEGIN
       while (wval&lt;&gt;'VAR') and (wval&lt;&gt;'PROCEDURE') and (wval&lt;&gt;'BEGIN') and
             (wval&lt;&gt;';') and (wtype&lt;&gt;endfile) do
             lexicure;
       if wval&lt;&gt;';' then retract_w:=true;
  END;

PROCEDURE <a
name="skip_in_var">skip_in_var</a>;
  BEGIN
       while (wval&lt;&gt;'PROCEDURE') and (wval&lt;&gt;'BEGIN') and (wval&lt;&gt;';')
         and (wtype&lt;&gt;endfile) do
             lexicure;
       retract_w:=true;
  END;

PROCEDURE <a
name="skip_in_param">skip_in_param</a>;
  BEGIN
       while (wval&lt;&gt;';') and (wval&lt;&gt;')') and (wval&lt;&gt;'VAR') and
             (wval&lt;&gt;'BEGIN') and (wval&lt;&gt;'PROCEDURE') and (wval&lt;&gt;'TYPE')
         and (wval&lt;&gt;'CONST') and (wtype&lt;&gt;endfile) do
             lexicure;
       retract_w:=true;
  END;

PROCEDURE <a
name="skip_sentence">skip_sentence</a>;
  BEGIN
       repeat
             lexicure;
       until (wval='IF') or (wval='WHILE')
          or (wval='BEGIN') or (wval=';') or (wtype=endfile);
       retract_w:=true;
  END;

PROCEDURE <a
name="error">error</a>(num:integer);
  BEGIN
       errorhappen:=true;
       errorcol:=column;
       errornum:=num;
       errorinline:=true;
       errorcount:=errorcount+1;
       if errorcount&gt;6 then
       begin
            writeln(errorstring[1]);
            finalcomp;
            halt;
       end;
  END;

PROCEDURE <a
name="fatalerror">fatalerror;</a>
  BEGIN
       write('Fatal error happens.Comile halted');
       finalcomp;
       halt;
  END;

PROCEDURE <a
name="printline">printline</a>;
  VAR
       oldTextAttr:byte;
       i          :integer;
  BEGIN
       write('Error in line ');
       write(lineno);
       write(' : ');
       writeln(errorstring[errornum]);

       for i:=1 to length(linebuffer) do
         if (linebuffer[i]&lt;&gt;#13) and (linebuffer[i]&lt;&gt;#10) then
            if i=errorcol then
            begin
                 oldTextAttr:=TextAttr;
                 textcolor(red);
                 write(linebuffer[i]);
                 TextAttr:=oldTextAttr
            end
            else
                write(linebuffer[i]);
       writeln;

       if errornum in [4] then
       begin
            write('Fatal error happens. Compile halted');
            finalcomp;
            halt;
       end;
       errorinline:=false;
       writeln;
  END;

{------<a
name="op hashtable">operations of hashtable</a>-----------------------------------}

FUNCTION <a
name="hashindex">hashindex</a>(s:string):integer;
  VAR
      i    :integer;
      str  :str12;
      h    :word;
  BEGIN
       str:=copy(s,1,12);
       h:=0;
       for i:=1 to length(str) do
            h:=h shl 4+ord(str[i]);
       hashindex:=h mod PRIME
  END;

FUNCTION <a
name="lookup">lookup</a>(s:string):idpointer;
  VAR
      index  :integer;
      pointer:idpointer;
      str    :str12;
  BEGIN
       str:=copy(s,1,12);
       index:=hashindex(str);
       pointer:=hashtable[index];

       while (pointer&lt;&gt;nil) and (pointer^.name&lt;&gt;str) do
          pointer:=pointer^.next_hash_id;
       lookup:=pointer
  END;

FUNCTION <a
name="lookup_in_curLevel">lookup_in_curLevel</a>(s:string):idpointer;
  VAR
      index   :integer;
      pointer :idpointer;
      str     :str12;
  BEGIN
       str:=copy(s,1,12);
       index:=hashindex(str);
       pointer:=hashtable[index];

       while (pointer&lt;&gt;nil) and (pointer^.name&lt;&gt;str)
                            and (pointer^.level=curLevel) do
         pointer:=pointer^.next_hash_id;
       if (pointer=nil) or (pointer^.level&lt;curLevel)  then
          lookup_in_curLevel:=nil
       else
          lookup_in_curLevel:=pointer
  END;

FUNCTION <a
name="insert">insert</a>(s:string):idpointer;
  VAR
      pointer:idpointer;
      stackp :ProVarListStack;
      index  :integer;
      str    :str12;
  BEGIN
       if lookup_in_curLevel(s)=nil then
       begin
          str:=copy(s,1,12);
          index:=hashindex(str);

          new(pointer);
          pointer^.name:=str;
          pointer^.level:=curLevel;
          pointer^.next_hash_id:=hashtable[index];  {deal with hashtable list}
          hashtable[index]:=pointer;
          pointer^.next_varList_id:=curProVarL;     {deal with curProVarL list}
          curProVarL:=pointer;

          insert:=pointer
       end
       else
       begin
            error(2);
            insert:=nil;
       end;
  END;

PROCEDURE <a
name="deleteCurent">deleteCurent</a>;
  VAR
      index:integer;
      temppoint:idpointer;
  BEGIN
       index:=hashindex(curProVarL^.name);
       temppoint:=curProVarL;
       hashtable[index]:=curProVarL^.next_hash_id;
       curProVarL:=curProVarL^.next_varList_id;
       dispose(temppoint)
  END;

PROCEDURE <a
name="del_curProVarList">del_curProVarList</a>;
  VAR
      pointer :idpointer;
      index   :integer;
12 3 4 5 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -