📄 source.htm.bak
字号:
BEGIN
while curProVarL<>nil do
begin
index:=hashindex(curProVarL^.name);
pointer:=curProVarL;
hashtable[index]:=curProVarL^.next_hash_id;
curProVarL:=curProVarL^.next_varList_id;
dispose(pointer)
end
END;
{------<a
name="init模块">init</a> and error operations---------------------------------------}
PROCEDURE <a
name="init0">init0</a>;
VAR
pointer:idpointer;
BEGIN
pointer:=insert('BOOLEAN');
with pointer^ do
begin
size:=1;
idclass:=4;
typename:=bool
end;
boolpoint:=pointer;
pointer:=insert('INTEGER');
with pointer^ do
begin
size:=1;
idclass:=4;
typename:=int
end;
intpoint:=pointer;
pointer:=insert('TRUE');
with pointer^ do
begin
size:=1;
idclass:=1;
value:=1;
consttype:=bool
end;
pointer:=insert('FALSE');
with pointer^ do
begin
size:=1;
idclass:=1;
value:=0;
consttype:=bool
end;
pointer:=insert('READ');
with pointer^ do
begin
size:=-1;
idclass:=6;
isStandard:=true
end;
pointer:=insert('WRITE');
with pointer^ do
begin
size:=-1;
idclass:=6;
isStandard:=true
end
END;
PROCEDURE <a
name="initParams">initParams</a>;
VAR
pcount,i:integer;
x:string;
BEGIN
{*** the input of this program can be "complier mypro.pas mypro.obj" ***}
{*** it can be "complier" or "complier mypro.pas" either. ***}
{*** deal with the paramter ***}
writeln;
pcount:=paramcount;
if pcount = 0 then
begin
write('[SOURCE.PAS]:');
readln( tf );
pcount:=1;
end
else tf:=paramstr(1);
for i:=1 to length( tf ) do
tf[i]:=upcase(tf[i]);
i:=pos('.',tf);
if i=0 then
begin
x:='';
i:=length(tf)+1
end
else
x:=copy(tf,i,4);
if i<2 then
begin
writeln('A name is needed.');
halt
end;
if not ((x='.PAS') or (x='')) then
begin
writeln('A filename as *.PAS is allowed to be a source file');
halt
end;
tf:=copy(tf,1,i-1)+'.PAS';
if pcount=1 then
begin
write('['+copy(tf,1,pos('.',tf)-1)+'.MOJ]:');
readln(obj);
pcount:=2
end
else obj:=paramstr(2);
for i:=1 to length(obj) do
obj[i]:=upcase(obj[i]);
i:=pos('.',obj);
if i=0 then
begin
x:='';
i:=length(obj)+1
end
else
x:=copy(obj,i,4);
if not ( (x='.OBJ') or (x='') ) then
begin
writeln('A filename as *.MOJ is allowed to be the object file');
halt
end;
if i<2 then
begin
obj:=tf;
i:=pos('.',tf)
end;
obj:=copy(obj,1,i-1)+'.MOJ';
if fsearch(tf,getenv('PATH'))='' then
begin
writeln(tf,' not found.');
halt
end
END;
PROCEDURE <a
name="initGlobals">initGlobals</a>;
VAR
i,readcount:integer;
BEGIN
assign(fsource,tf);
reset(fsource,1);
assign(fdestinate,obj);
rewrite(fdestinate);
filepointer:=0;
endtext:=false;
lineno:=1;
for i:=0 to PRIME-1 do
hashtable[i]:=nil;
head:=nil;
curProVarL:=nil;
curLevel:=0;
blockread(fsource,buffer[0],READBUFFER_SIZE-1,readcount);
if readcount<READBUFFER_SIZE-1 then
begin
endtext:=true;
buffer[readcount]:=#26;
end;
buffer[READBUFFER_SIZE-1]:=#26;
buffer[READBUFFER_SIZE*2-1]:=#26;
linebuffer:='';
forward:=0;
load:=false;
token:='';
retract_w:=false;
namelist:=nil;
errorhappen:=false;
compile_success:=false;
errorcount:=0;
END;
PROCEDURE <a
name="initerr">initerr</a>;
BEGIN
errorstring[1]:='Too many errors';
errorstring[2]:='Identifier already exists';
errorstring[3]:='Too many params';
errorstring[4]:='"program" expected';
errorstring[5]:='";" expected';
errorstring[6]:='"=" expected';
errorstring[7]:='":" expected';
errorstring[8]:='"[" expected';
errorstring[9]:='".." expected';
errorstring[10]:='array indextype not match';
errorstring[11]:='Invalid array index definition';
errorstring[12]:='"]" expected';
errorstring[13]:='"of" expected';
errorstring[14]:='Invalid type';
errorstring[15]:='Constant expected';
errorstring[16]:='identifier expected';
errorstring[17]:='Unexpected end of program';
errorstring[18]:='"," expected';
errorstring[19]:='"." expected';
errorstring[20]:='Invalid character';
errorstring[21]:='Integer out of constant';
errorstring[22]:='"begin" expected';
errorstring[23]:='Identifier not defined';
errorstring[24]:='Invalid identifier type';
errorstring[25]:='Error in sentence';
errorstring[26]:='":=" expected';
errorstring[27]:='Type mismatch';
errorstring[28]:='Invalid qualifier';
errorstring[29]:='"then" expected';
errorstring[30]:='"do" expected';
errorstring[31]:='no such field';
errorstring[32]:='param type not match';
errorstring[33]:='param number not match';
errorstring[34]:='"(" expected';
errorstring[35]:='")" expected';
errorstring[36]:='lower bound greater than upper bound';
errorstring[37]:='too many fields';
errorstring[38]:='"end" expected';
errorstring[39]:='Operand typs do not match operator'
END;
PROCEDURE <a
name="initReserved">initReserved</a>;
BEGIN
reservelist[1]:='PROGRAM';
reservelist[2]:='CONST';
reservelist[3]:='VAR';
reservelist[4]:='TYPE';
reservelist[5]:='ARRAY';
reservelist[6]:='OF';
reservelist[7]:='RECORD';
reservelist[8]:='END';
reservelist[9]:='IF';
reservelist[10]:='WHILE';
reservelist[11]:='THEN';
reservelist[12]:='ELES';
reservelist[13]:='BEGIN';
reservelist[14]:='DIV';
reservelist[15]:='MOD';
reservelist[16]:='OR';
reservelist[17]:='PROCEDURE';
reservelist[18]:='DO';
reservelist[19]:='AND';
reservelist[20]:='NOT'
END;
PROCEDURE <a
name="init">init</a>;
BEGIN
initerr;
initReserved;
initParams;
initGlobals;
init0
END;
{-------<a
name="final clean">final clean</a> ---------------------------------------------}
PROCEDURE finalcomp;
VAR
i:integer;
point:idpointer;
p:ProVarListStack;
BEGIN
for i:=0 to PRIME-1 do
while hashtable[i]<>nil do
begin
point:=hashtable[i]^.next_hash_id;
dispose(hashtable[i]);
hashtable[i]:=point;
end;
while head<>nil do
begin
p:=head^.next;
dispose(head);
head:=p;
end;
if namelist<>nil then deletelist;
close(fsource);
close(fdestinate);
END;
{-------<a
name="lexicure analysis">lexicure analysis</a>-----------------------------------------}
PROCEDURE <a
name="new_forward">new_forward</a>;
VAR
readcount:integer;
BEGIN
forward:=forward+1;
if buffer[forward]=#26 then
begin
if (forward=READBUFFER_SIZE-1) and (not endtext) then
begin
if not load then
begin
blockread(fsource,buffer[READBUFFER_SIZE],
READBUFFER_SIZE-1,readcount);
if readcount<READBUFFER_SIZE-1 then
buffer[READBUFFER_SIZE+readcount]:=#26;
end;
forward:=forward+1;
end
else if (forward=READBUFFER_SIZE*2-1) and (not endtext) then
begin
if not load then
begin
blockread(fsource,buffer[0],READBUFFER_SIZE-1,
readcount);
if readcount<READBUFFER_SIZE-1 then
buffer[readcount]:=#26;
end;
forward:=0;
end
else endtext:=true;
end;
END;
PROCEDURE <a
name="getchar">getchar</a>;
BEGIN
character:=buffer[forward];
linebuffer:=linebuffer+character;
character:=upcase(character);
new_forward;
END;
PROCEDURE <a
name="getbc">getbc</a>;
BEGIN
while (character=' ') or (character=#13) or (character=#10)
or (character=#9) do
begin
if character=#10 then
begin
if errorinline then printline;
linebuffer:='';
lineno:=lineno+1;
end;
getchar
end
END;
PROCEDURE <a
name="concatenation">concatenation</a>;
BEGIN
token:=token+character
END;
FUNCTION <a
name="letter">letter</a>:boolean;
BEGIN
if character in ALPHA
then letter:=true
else letter:=false
END;
FUNCTION <a
name="digit">digit</a>:boolean;
BEGIN
if character in NUMBER
then digit:=true
else digit:=false
END;
FUNCTION <a
name="is_reserve">is_reserve</a>:integer;
VAR
i:integer;
BEGIN
i:=1;
while (reservelist[i]<>token) and (i<21) do i:=i+1;
if i=21
then is_reserve:=0
else is_reserve:=i
END;
PROCEDURE <a
name="retract">retract</a>;
BEGIN
forward:=(forward-1+READBUFFER_SIZE*2) mod (READBUFFER_SIZE*2);
if buffer[forward]=#26 then
begin
if forward=READBUFFER_SIZE-1 then
begin
forward:=forward-1;
load:=true;
end
else if forward=READBUFFER_SIZE*2-1 then
begin
forward:=forward-1;
load:=true
end
end;
delete(linebuffer,length(linebuffer),1);
END;
PROCEDURE <a
name="lexicure">lexicure</a>;
VAR
c:integer;
BEGIN
if not retract_w then
begin
token:='';
getchar;
getbc;
column:=length(linebuffer);
case character of
'A'..'Z' :begin
while letter or digit do
begin
concatenation;
getchar;
end;
retract;
c:=is_reserve;
if c=0 then
begin
wtype:=id;
wval:=token;
end
else begin
wtype:=reserved;
wval:=token;
end;
end;
'0'..'9' :begin
while digit do
begin
concatenation;
getchar;
end;
retract;
wtype:=num;
wval:=token;
end;
'(',')',';',
'[',']',',' :begin
concatenation;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -