DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFileVerbose
    Names: »testoutgen«

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

TextFileVerbose

job jaba 1 600 time 2 0 pres no perm mini 900 1

mode list.yes
( lookup testgen
if ok.no
testgen = pascal
ttestoutpas = testgen tprintpass1 pass1codes
printpass1 = pascal ttestoutpas codesize.2000
finis)

program testoutgen(input, input1, output);

label 10, 999;

type
string35 = packed array [ 1 .. 35 ] of char;


var
ch : char;
step,
count : integer;
input1 : text;
input1id, inputid, outputid : alfa;


procedure error( errtext : string35);
begin
writeln(errtext);
goto 999; (* exit *)
end;


procedure copyprogram;
begin
while input1^ <> '$' do
begin
write(output,input1^);
get(input1);
end;
get(input1); (* skip '$' *)
end;  (* copy program *)

begin
if system(1,step,inputid) div 4096 <> 6 then
error(' ??? lefthandside must be specified');

if system(0,step, outputid) mod 4096 <> 10 then 
error(' ??? illegal outputfile ');
if system( 2, step, input1id) mod 4096 <> 10 then
error('??? illegal input file ');
if system( 3, step, inputid) mod 4096 <> 10 then
error(' ??? illegal codefile spec ');


open(output, outputid); rewrite(output);
open (input, inputid); reset(input);
open(input1, input1id); reset(input1);

count := 0;
copyprogram; (* get program head *)
writeln(' codes = ');
while input^ <> '#' do
get(input);
readln(input);

while input^ <> ';' do
begin

while (input^ <> ',') and (input ^ <> ';') do
begin
write(input^); get(input);
end;
if input^ <> ';' then
begin
count := count + 1;
get(input); write(',');
end
else writeln(';');

end;
copyprogram; (* get codeindex = 0 .. *)
writeln(output, count : 3, ';');
copyprogram; (* copy until value *)
reset(input);
read(ch);
while ch <> '(' do read(ch);
while ch <> ')' do
10: if not eoln(input) then
begin
read(ch);
while ch = ' ' do 
begin
write(ch); read(ch);
end;
if ch = '(' then (* start of comment *)
begin
while ch <> ')' do
read(ch);
if eoln(input) or (input^ = ' ') or (input^ = ',') then
begin
if input ^ = ',' then
begin
read(ch);
write(ch);
end;
ch := ' ';
goto 10
end
else
read(ch);
end;


if ch <> ')' then
begin
write("'"); 
read(ch); (* skip first letter in identifier *)
end;
while (ch <> ',') and (ch <> ' ') and (ch <> ')') and (ch <> '(') do
begin
write(ch); read(ch);
end;
if ch <> ')' then
if ch <> '(' then write("'", ch ) else write("'");
end (* if not eol *)
else
begin
readln;
writeln;
end;
writeln(');');
copyprogram; (* copy the rest of program *)
999:
close(output);
end.

«eof»