|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 4608 (0x1200)
Types: TextFile
Names: »xcomplaton«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦6b41451d2⟧
└─⟦this⟧ »xcomplaton«
; edit file: xcomplaton
; speed up lexical
m e
l./line:arrayÆ/, i/
convch : array Æ char Å of char;
/,
l./procedure parser;/,
i/
(*$t- *)
/,
l./digitch:set of char/,
r/set of char; /array ÆcharÅ of boolean;/,
l./procedure inchar;/,
; do not convert to upper case
l./if(ch>='a/, d1,
l./procedure initialize(var/,
l./digitch:=/, i/
for ch1 := ' ' to 'ü' do
if (ch1 >= 'a') and (ch1 <= 'å') then
convch Æ ch1 Å := chr( ord(ch1) - ( ord('a') - ord('A') ) )
else
convch Æ ch1 Å := ch1;
/,
l./begin(*lexical/,
i/
procedure getline;
begin
if not printed and moreinput then printline;
if errorinx > 0 then writeln;
readline;
end;
/,
l./if ch in digitch/,
r/ch in digitch/digitch Æ ch Å/,
l./pushch;inchar;/, d,
i/
chbuf Æ chbufi Å := ch;
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./not(ch in digitch/, r/ch in digitch/digitch Æ ch Å/,
l./pushch;inchar;/, d,
i/
chbuf Æ chbufi Å := ch;
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./if ch indigitch/, r/ch in digitch/digitch Æ ch Å/,
l./pushch;inchar;/, d,
i/
chbuf Æ chbufi Å := ch;
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./not(ch in digitch/, r/ch in digitch/digitch Æ ch Å/,
l./if ch='e'/, r/ch='e'/(ch = 'E') or (ch = 'e')/,
l./pushch;inchar;/, d,
i/
chbuf Æ chbufi Å := 'E';
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./if ch in Æ'+',/, r/ch in Æ'+','-'Å/(ch = '+') or (ch = '-')/,
l./pushch;inchar;/, d,
i/
chbuf Æ chbufi Å := ch;
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./if ch in digitch/, r/ch indigitch/digitch Æ ch Å/,
l./pushch;inchar;/, d,
i/
chbuf Æ chbufi Å := ch;
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./not(ch in digitch)/, r/ch in digitch/digitch Æ ch Å/,
l./begin(*search in termtree/,
l./pushch;/, d,
l./lxnode:=entryÆch/, r/ch/convch Æ ch Å/,
l./inchar;/, d,
i/
chbuf Æ chbufi Å := ch;
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./lxÆnewiÅ.ch=/, r/=ch/= convch Æ ch Å/,
l./pushch;/ , r/ pushch;//, l./inchar/, d,
i/
chbuf Æ chbufi Å := ch;
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./if(oldchin namech)/, d, i/
if namech Æ oldch Å and namech Æ ch Å then
/,
l./pushch;/, r/ pushch;//,
l./inchar;/, d,
i/
chbuf Æ chbufi Å := ch;
if chbufi < chbufmax then
chbufi := chbufi + 1
else stop( 6 );
if testoutput then write(output, ch); (***SNAPSHOT***)
if lineinx = linelength then
getline;
lineinx := lineinx + 1;
ch := line Æ lineinx Å ;
/,
l./not(chinnamech)/, r/ch in namech/namech Æ ch Å/,
l./oldch in namech/, r/oldch in namech/namech Æ oldch Å/,
l./not_endbody:boolean/,
l./if ch = 'E' then/, d, i/
if (ch = 'E') or (ch = 'e') then
/,
l./found:=(endbodyÆstepÅ=' ') and not(lineÆlineinxÅin namech);/,
r/lineÆlineinxÅ in namech/namech Æ line Æ lineinx Å Å /,
f
clear temp platon1pasc
▶EOF◀