DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »tprintpass3«

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »tprintpass3« 

TextFile

job btj 7 600 perm disc 100 2 area 10 temp disc 500 20 time 5 0

(ttt = copy message.no 25.1
tt = testgen ttt pass3codes
printpass3 = pascal tt codesize.3000
printpass3 names
finis)
program printpass3(output, testin);                            
type                                                        
$
codeindex = 0..$

var                                                         
textcodes : array ÆcodeindexÅ of alfa;                      
convcodes : array ÆcodeindexÅ of codes;                     
testin : file of integer;                                   
actcode : codes;                                            
decl, spix, intcode, sort : integer;                        
from_line, to_line, line : integer;
prelude, names_out, ok : boolean;
printmode : boolean;
value                                                       
textcodes = ( $                                               

procedure param(n: integer);
var i,j: integer;
begin
if printmode then
write ("(");
for i := 1 to n do
begin
read (testin, j); if printmode then write(" ",j:1);
end;
if printmode then write (")");
if intcode = ord(xnewline) then line := j;
end;

procedure get_parameters;
const
equal = 6; space = 4; dot = 8;
name  = 10; int = 4;
power12 = 4096;

var
i, sep, paramno: integer;
id: alfa;

procedure paramerror;
begin
write(output, '*** printpass3, param error ');
repeat
if sep div power12 = space then
write (output, ' ')
else
write (output, '.');
if sep mod power12 = name then
write (output, id)
else
write (output, i:1);
paramno := paramno + 1;
sep := system (paramno, i, id);
if sep = 0 then sep := space * power12;
until sep div power12 = space;
ok := false;
writeln (output);
paramno := paramno - 1;
end;

function getint : integer;
var
p: integer;
begin
p := system (paramno + 1, i, id);
if p = dot * power12 + int then
begin
getint := i;
paramno := paramno + 1;
end
else
begin
paramerror;
getint := 0;
end;
end;

begin (* body of getparams *)
ok := true;
sep := system (1, i, id);
if sep div power12 = equal then
begin
sep := system (0, i, id);
open (output, id);
rewrite (output);
paramno := 2;
end
else
paramno := 1;
sep := system (paramno, i, id);

while sep > 0 do
begin
if sep <> space * power12 + name then
paramerror
else
begin
if id = 'prelude' then prelude := true
else
if id = 'names' then names_out := true
else
if id = 'from' then from_line := getint
else
if id = 'to' then to_line := getint
else
paramerror;
end;
paramno := paramno + 1;
sep := system (paramno, i, id);
end;
end;

begin
from_line := 0; to_line := 1000000; line := 1;
prelude := false; names_out := false;

get_parameters;
if ok then
begin

for actcode := xfirstcode to xlastcode do                      
begin
convcodesÆord(actcode)Å := actcode;                         
if names_out then
writeln (output, ord(actcode):3, ' = ', textcodes Æ ord (actcode) Å);
end;
if names_out then
page (output);

open (testin, "pass3code");
reset(testin);                                              

while not eof(testin) do                                    
begin
printmode := prelude and (line >= from_line) and (line <= to_line);
read(testin, intcode);                                
if printmode then write (textcodes ÆintcodeÅ: 10);

case convcodesÆintcodeÅ of                                  

xliteral: begin                                             
read(testin, intcode, sort);                                
if printmode then write ("(", intcode:1, ", ", sort:1, ', <:');
for spix := 1 to sort do                                    
begin read(testin,decl); if printmode then  write(chr(decl)); end;             
if printmode then write (":>)");
end;

xcodeline,
xname:
begin
read (testin, sort);
if printmode then write ("(", sort:1, ', <:');
for spix := 1 to sort do
begin
read (testin, decl); if printmode then  write(chr(decl));
end;
if printmode then write(":>)");
end;

xblock,
xexception,
xconstid,
xinteger,
xreal,
xniltype,
xerrortype,
xstringtype,
xboolean,
xshadow,
xreference,
xsemaphore,
xchar,
xsucc, xpred, xord, xchr,
xtype,
xscalarid,
xscalardef,
xpointerdef,
xfrozendef,
xredeftype,
xarraydef,
xpackedarraydef,
xfieldid, xrecdef,
xsetdef,
xendset,
xpooldef,
xvarid,
xundeclid,
xprocid,
xsecprocid,
xfuncid,
xsecfuncid,
xparamid,
xlabelid,
xlabel,
xproccall,
xactual,
xgoto,
xwithvar, xlockvar,
xrange,
xstrucconst,
xarrow,
xstruc,
xnewline,
xendproc,
xfcall,
xerrorno,
xerrortext:
param(1);

xsubdef,
xvarpointer, xfield, xvar, xindex, xerror:
param (2);

xoption,
xprocessid,
xfunccall:
param(3);

xendprelude:
prelude := true;

xeom,
xexternal,
xinitblock, xendblock,
xbegincode, xendcode,
xtypedef,
xgetexpr,
xpackedrecord, xrecord, xfielddef,
xinitconst, xvarlist,
xforward,
xvalueparam, xvarparam,
xprefix,
xprocessparam,
xtempointer, xarglistsize,
xendactual,
xassignstat, xbecomes, xassign,
xcasestat, xcase, xendcase,
xcaselabel, xcaserange, xotherwise,
xendcaselist, xendcasestat,
xforstat, xfor, xup, xdown, xdo, xendfor,
xifstat, xifexpr, xelse, xif,
xrepeat, xuntil, xendrepeat,
xwhile, xwhileexpr, xendwhile,
xwith, xendwith,
xlockstat, xlock, xendlock,
xchannel, xchanvar, xendchannel,
xexchangestat, xexchange,
xexpr,
xgetvalue,
xne, xeq, xle, xlt, xge, xgt, xin,
xneg, xadd, xsub, xor,
xdiv, xmul, xmod, xand,
xnot,
xset,
xinclude, xsetexpr, xincluderange,
xendstruc,
xtimes, xnull,
xindexexpr,
xendfunccall:
; (* no params *)



end (*case *)                                               
otherwise write("************",textcodesÆintcodeÅ);                      

if printmode then writeln;

end; (* while *)                                            

end; (* if get params *)

end.                                                        

$ $ $
▶EOF◀