|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 4608 (0x1200)
Types: TextFileVerbose
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»