|
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: »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◀