?? 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
begin FileFullName[i]:=FileName[i];i:=succ(i) end;
FileFullName[i]:='.';
for j:=1 to 3 do FileFullName[i+j]:=ExtName[j];
end;
begin
ReadFileName(SourceName);
LinkExtName(FileFullName,SourceName,'PAS');
assign(PAS,FileFullName);
LinkExtName(FileFullName,SourceName,'IL1');
assign(IL1,FileFullName);
LinkExtName(FileFullName,SourceName,'IL2');
assign(IL2,FileFullName);
LinkExtName(FileFullName,SourceName,'IL3');
assign(IL3,FileFullName);
LinkExtName(FileFullName,SourceName,'PTC');
assign(PTCode,FileFullName);
LinkExtName(FileFullName,SourceName,'ASN');
assign(ASN,FileFullName);
LinkExtName(FileFullName,SourceName,'STR');
assign(SFile,FileFullName);
LinkExtName(FileFullName,SourceName,'DSP');
assign(DSP,FileFullName);
end;
procedure WriteSTabToSFile;
var tt:cardinal;
begin
rewrite(SFile);
for tt:=1 to ts do write(SFile,STab[tt]);
close(SFile);
end;
procedure WriteTabToDsp(var DSP:text; p:pass);
var t0,tt:cardinal;tp:StPtr;
i,num:CodeLable;Cd:integer;OpCd:OperatingCode;
function InsArgNum(OpCode:OperatingCode):cardinal;
begin
if OpCode in ZeroArgument
then InsArgNum:=0
else if OpCode in OneArgument
then InsArgNum:=1
else if OpCode in TwoArgument
then InsArgNum:=2
else InsArgNum:=3
end;
begin
if p=pass1
then begin
if p=pass1
then begin
writeln(DSP);
writeln(DSP,'NTab','':5,'tn=',tn:1);
for tt:=1 to tn do
begin
if tt mod 5=1 then write(DSP,tt:7);
write(DSP,NTab[tt]:IdLength+2);
if tt mod 5=0 then writeln(DSP)
end;
writeln(DSP);writeln(DSP);
writeln(DSP,'STab','':5,'ts=',ts:1);
for tt:=1 to ts do
begin
write(DSP,STab[tt]);if tt mod 80=0 then writeln(DSP)
end;
writeln(DSP)
end;
if p=pass3
then begin
writeln(DSP);
writeln(DSP,' Block Table');
writeln(DSP,' * * * * * * * * * * *');
writeln(DSP);
writeln(DSP,'order LastPar LasrId pSize VSize');
for tt:=0 to tb do
with BTab[tt] do
writeln(DSP,tt:4,LastPar:8,LastId:8,ParSize:8,VarSize:8);
writeln(DSP);
writeln(DSP);
writeln(DSP,' Structural Table');
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -