📄 main.pas
字号:
writeln(DSP,' * * * * * * * * * * *');
writeln(DSP);
writeln(DSP,'order size form');
tp:=invptr;
repeat
with tp^do
begin
write(DSP,order:4,size:7,StFormSp[form]:9);
case form of
inv,ints,chars,bools
:{no output};
subranges:write(DSP,RangeType^.order:7,'(RangeTp)',
min:7,'(min)',max:7,'(max)');
arrays:write(DSP,IndexType^.order:7,'(IndexTp)',
ElementType^.order:7,'(ElemtTp)');
records:write(DSP,LastField:7,'(LastFld)')
end{of case}
end{of with};
writeln(DSP);
tp:=tp^.next
until tp=nil;
end;
if p in [pass3,pass4]
then begin
writeln(DSP);
writeln(DSP,' Identifier Table');
writeln(DSP,' * * * * * * * * * * *');
writeln(DSP);
writeln(DSP,'order name type prevous class');
if p=pass4 then write(DSP,'order name typ previous class');
writeln(DSP);
if p=pass3 then t0:=1 else t0:=18;
for tt:=t0 to ti do
with ITab[tt] do
if(p=pass3)or((p=pass4)and(class in[procss,funcss]))then
begin
write(DSP,tt:4,name:4,'(',NTab[name],')',typ^.order:4,'(',
StFormSp[typ^.form],')',previous:4,IdClassSp[class]:9);
case class of
constss:write(DSP,val:7);
typess:write(DSP);
varss:write(DSP,address.StaticLevel:7,address.RelativeAddress:7,
KindSp[kind]:7,IsControlvar:7);
fieldss:write(DSP,IsStandp:7);
procss:begin
write(DSP,IsStandp:7);
case IsStandf of
true:write(DSP,StandpSp[standp]:7);
false:write(DSP,plev:7,pEntry:7,pindex:7)
end
end;
funcss:begin
write(DSP,IsStandf:7);
case IsStandf of
true:write(DSP,StandpSp[standp]:7);
false:write(DSP,plev:7,pEntry:7,pindex:7)
end
end;
end{case};
writeln(DSP)
end{with};
writeln(DSP)
end;
if p=pass4
then begin
writeln(DSP);
writeln(DSP,' Code Table');
writeln(DSP,' * * * * * * * * * * *');
writeln(DSP);
reset(PTCode);
i:=0;
while not eof(PTCode)do
begin
read(PTCode,Cd);OpCd:=OperatCd[Cd];
write(DSP,i:5, OpCdSp[OpCd]:8); i:=succ(i);
for num:=1 to InsArgNum(OpCd) do
if not eof(PTCode)
then begin
read(PTCode,Cd); write(DSP,Cd:6); i:=succ(i)
end;
writeln(DSP);
end;
writeln(DSP);
writeln(DSP);
writeln(DSP,' Lable Table');
writeln(DSP,' * * * * * * * * * * *');
writeln(DSP);
for tt:=1 to tl do
begin
write(DSP,LTab[tt]:5); if tt mod 10=0 then writeln(DSP)
end;
writeln(DSP);
end{Write Code Table and Lable Table}
end;
end{WriteTabToDsp};
procedure PassHead(p:pass);
begin
writeln;writeln(DSP);
case p of
pass1:begin
writeln( '* * * * * pass 1:Lexical Analysis * * * * *');
writeln(DSP,'* * * * * pass 1:Lexical Analysis * * * * *')
end;
pass2:begin
writeln( '* * * * * pass 2:Syntax Analysis * * * * *');
writeln(DSP,'* * * * * pass 2:Syntax Analysis * * * * *')
end;
pass3:begin
writeln( '* * * * * pass 3:Semantic Analysis * * * * *');
writeln(DSP,'* * * * * pass 3:Semantic Analysis * * * * *')
end;
pass4:begin
writeln( '* * * * * pass 4:Code Generation * * * * *');
writeln( ' (Ideal Computer)');
writeln(DSP,'* * * * * pass 4:Code Generation * * * * *');
writeln(DSP,' (Ideal Computer)')
end;
pass5:begin
writeln( '* * * * * pass 5:Assembly Code Generation * * * * *');
writeln( ' (Intel 8088)');
writeln(DSP,'* * * * * pass 5:Assembly Code Generation * * * * *');
writeln(DSP,' (Intel 8088)')
end;
end{of case};
writeln;writeln(DSP)
end{PassHead};
procedure PassFinal;
var InOrBlank:packed array[1..2]of char;
begin
if(ErrCount=0)and(overflow=[])
then InOrBlank:=' '
else InOrBlank:='IN';
writeln( InOrBlank:16,'CORRECT');
writeln(DSP,InOrBlank:10,'CORRECT');
end{PassFinal};
{{{*******************************************************************}
{{{ SECOND GROUP }
{{{*******************************************************************}
procedure GetSymbol(var f:ILFileType;var sy:symbol;p:pass);
var c:cardinal;
begin
read(f, SyPos.CharNumber,c);sy:=sym[c];
if sy in [ident..strconst,boolconst]
then case sy of
ident :read(f,IdIndex);
intconst :read(f,IValue);
charconst :read(f,CValue);
boolconst :read(f,BValue);
strconst :read(f,SEntry,SLength)
end;{case}
if(p=pass4)and(sy in [notop..eqop,becomes,unaryminus])
then begin read(f,c); operandfm:=OpFm[c] end
end{GetSymbol};
procedure PutSymbol(var f:ILFileType;var DSP:text;sy:symbol;p:pass);
var ordd:cardinal;ordfm:cardinal;
begin
ordd:=ord(sy);
write(f,SyPos.CharNumber,ordd);
with SyPos do
write(DSP,LineNumber:4,CharNumber:3,ord(sy):4,'(',sp[sy],')');
if sy in[ident..strconst,boolconst]
then case sy of
ident : begin write(f,IdIndex); write(DSP,IdIndex:4) end;
intconst : begin write(f,IValue); write(DSP,IValue :4) end;
charconst : begin write(f,CValue); write(DSP,CValue :4) end;
boolconst : begin write(f,BValue); write(DSP,BValue :4) end;
strconst : begin write(f,SEntry,SLength);
write(DSP,SEntry:4,SLength:4) end;
end;{case}
if(p=pass3)and(sy in [notop..eqop,becomes,unaryminus])
then begin
ordfm:=Ord(operandfm);
write(f ,ordfm);
write(DSP ,Ord(operandfm):4,'(',OpFmSp[operandfm],')')
end;
writeln(DSP);
end;{PutSymbol}
procedure error(var DSP:text;SyPos:TextPos;n:cardinal;
var ErrCount:cardinal;p:pass);
begin
ErrCount:=succ(ErrCount);
with SyPos do
begin
if p<>pass1
then writeln( ' ERROR',n:3,'(',LineNumber:4,',',CharNumber:4,')');
writeln(DSP,' ERROR',n:3,'(',LineNumber:4,',',CharNumber:4,')');
end
end;
procedure TabOverflow(tab:table;pos:TextPos);
begin
if not(tab in overflow)
then begin
write('* * * * ');
case tab of
nametab :write('Name table NTab');
stringtab:write('String table STab');
identtab :write('Identifier table ITab');
blocktab :write('Block table BTab');
codetab :write('Code table');
labletab :write('Lable table')
end;
writeln('overflow in line',pos.LineNumber:1);
overflow:=overflow+[tab]
end
end{TabOverflow};
{{{******************************************************************}
{{***********************LexicalAnalysis*****************************}
{{{******************************************************************}
procedure LexicalAnalysis(var PAS:text;var IL1:ILFileType;var DSP:text);
const
IdLengPlus1=11;
rwnum=25;
type
charset=set of char;
var
ch :char;
ChPos :TextPos;
LastInLine :CharPos;
EndScan :Boolean;
OnString :Boolean;
digits :charset;
letters :charset;
CharTotal :cardinal;
SymTotal :cardinal;
line :array[CharPos]of char;
ResWords :array[1..rwnum]of
record
sp:alfa;
sy:symbol
end;
frw :array[1..IdLengPlus1]of cardinal;
procedure ScanError(n:cardinal);
begin
write('* * * *');
with SyPos do
if CharNumber>=1
then writeln('':CharNumber-8,'Error',n:1,'^')
else writeln('':CharNumber,'^','Error',n:1);
error(DSP,SyPos,n,ErrCount,Pass1);
end{scanError};
procedure InitResWords{and array frw};
begin
frw[1]:=1;
frw[2]:=1;
with ResWords[1] do begin sp:='IF '; sy:=ifsy end;
with ResWords[2] do begin sp:='OF '; sy:=ofsy end;
with ResWords[3] do begin sp:='DO '; sy:=dosy end;
with ResWords[4] do begin sp:='TO '; sy:=tosy end;
with ResWords[5] do begin sp:='OR '; sy:=orop end;
frw[3]:=6;
with ResWords[6] do begin sp:='VAR '; sy:=varsy end;
with ResWords[7] do begin sp:='FOR '; sy:=forsy end;
with ResWords[8] do begin sp:='END '; sy:=endsy end;
with ResWords[9] do begin sp:='NOT '; sy:=notop end;
with ResWords[10]do begin sp:='AND '; sy:=andop end;
with ResWords[11]do begin sp:='DIV '; sy:=divop end;
with ResWords[12]do begin sp:='MOD '; sy:=modop end;
frw[4]:=13;
with ResWords[13]do begin sp:='TYPE '; sy:=typesy end;
with ResWords[14]do begin sp:='THEN '; sy:=thensy end;
with ResWords[15]do begin sp:='ELSE '; sy:=elsesy end;
frw[5]:=16;
with ResWords[16]do begin sp:='CONST '; sy:=constsy end;
with ResWords[17]do begin sp:='BEGIN '; sy:=beginsy end;
with ResWords[18]do begin sp:='WHILE '; sy:=whilesy end;
with ResWords[19]do begin sp:='ARRAY '; sy:=arraysy end;
frw[6]:=20;
with ResWords[20]do begin sp:='DOWNTO '; sy:=downtosy end;
with ResWords[21]do begin sp:='RECORD '; sy:=recordsy end;
frw[7]:=22;
with ResWords[22]do begin sp:='PROGRAM '; sy:=programsy end;
frw[8]:=23;
with ResWords[23]do begin sp:='FUNCTION '; sy:=funcsy end;
frw[9]:=24;
with ResWords[24]do begin sp:='PROCEDURE '; sy:=procsy end;
frw[10]:=25;
frw[11]:=25
end{InitResWords};
procedure InitSets;
begin
letters:=['A'..'Z']; digits :=['0'..'9']
end{InitSets};
procedure InitNTab;
begin
NTab[1] :='FALSE ';NTab[2] :='TRUE ';NTab[3] :='MAXINT ';
NTab[4] :='INTEGER ';NTab[5] :='CHAR ';NTab[6] :='BOOLEAN ';
NTab[7] :='ABS ';NTab[8] :='SQR ';NTab[9] :='ORD ';
NTab[10]:='CHR ';NTab[11] :='SUCC ';NTab[12] :='PRED ';
NTab[13]:='ODD ';NTab[14] :='READ ';NTab[15] :='READLN ';
NTab[16]:='WRITE ';NTab[17] :='WRITELN ';
end{InitNTab};
procedure PutSy(sy:symbol);
begin
SymTotal:=succ(SymTotal);
if sy = ident then IdIndex :=NIndex;
PutSymbol(IL1,DSP,sy,pass1)
end{PutSy};
procedure GetCh;
procedure ReadNextLine;
var i:cardinal;
begin
i:=1;
while not eoln(PAS) and (i<illeng) do
begin read(PAS,line[i]); i:=succ(i)end;
readln(PAS);
line[i]:=' ';
LastInLine:=i
end{ReadNextLine};
procedure ListThisLine;
var i:cardinal;
begin{ListThisLine}
write( ChPos.LineNumber:4,'');
write(DSP,ChPos.LineNumber:4,'');
for i:=1 to LastInLine do
begin write(line[i]); write(DSP,line[i]) end;
writeln; writeln(DSP)
end{ListThisLine};
begin{GetCh}
with ChPos do
begin
if CharNumber =LastInLine
then begin
PutSy(eoline);
LineNumber:=succ(LineNumber);
ReadNextLine;
ListThisLine;
CharNumber:=1;
CharTotal :=CharTotal+LastInLine;
end
else CharNumber:=succ(CharNumber);
ch:=line[CharNumber];
if not OnString and (ch in['a'..'z'])
then ch:=chr(ord('A')+ord(ch)-ord('a'));
if eof(PAS) and (CharNumber=lastInLine) then EndScan :=true;
end{with}
end{GetCh};
procedure identifier{or reserued word};
var i,j,k :cardinal; spelling :alfa;
procedure EnterNTab(name : alfa);
function PosInNTab(name: alfa):cardinal;
var i:cardinal;
begin
NTab[0]:=name;
i:=tn;
while name<>NTab[i] do i:=pred(i);
PosInNTab:=i
end{PosInNTab};
begin{EnterNTab}
NIndex :=PosInNTab(name);
if NIndex =0
then if tn = tnmax
then TabOverflow(nametab,SyPos)
else begin
tn:=succ(tn); NTab[tn]:=name; NIndex:=tn
end
end{EnterNTab};
begin{identifier}
spelling:=' ';
k:=0;
repeat
if k<IdLength then begin k:=succ(k); spelling[k]:=ch end;
GetCh
until not (ch in (letters+digits));
i:=frw[k]; j:=frw[k+1]-1;
while(spelling<>ResWords[i].sp) and(i<=j) do i:=succ(i);
if i<=j
then sy:=ResWords[i].sy
else begin sy:=ident; EnterNTab(spelling) end;
PutSy(sy)
end{identifier};
procedure number;
var digit:integer;
begin{number}
IValue:=0;
repeat
digit:=ord(ch)-ord('0');
if IValue<=(MaxInt-digit) div 10
then begin
IValue:=IValue * 10 + digit; GetCh
end
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -