|
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: »xep1rcpas«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦6b41451d2⟧
└─⟦this⟧ »xep1rcpas«
; edit file : xep1rcpas
; speed up lexical
npass1txt = edit newpass1txt
l./program pass1/, i/
(*$t- *)
/,
l./procedure parser;/,
l./digitch:set of char/,
r/set of char; /array [char] of boolean;/,
l1, i/
convch : array [ char ] of char ;
/,
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 <= 'z') 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/, l1, i/
ch := convch [ ch ];
/,
l./pushch;/, d,
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 := convch [ line [ lineinx ] ] ;
/,
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 := convch [ 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 := convch [ line [ lineinx ] ] ;
/,
l./not(chinnamech)/, r/ch in namech/namech [ ch ]/,
l./oldch in namech/, r/oldch in namech/namech [ oldch ]/,
f
if ok.no
finis
clear temp newpass1txt
rename npass1txt.newpass1txt
«eof»