|
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: 8448 (0x2100)
Types: TextFile
Names: »qwerty«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »qwerty«
printlogtx d.810305.1608
1 begin
2 integer segm_pr_block,max_block;
3 segm_pr_block := læs_fp_tal(<:segm:>);
4 max_block := læs_fp_tal(<:maxblock:>);
5 begin
6 zone z_in(128 * segm_pr_block,1,tapeerror),
7 _ z_out(128,1,stderror),
8 _ block_descr(max_block,1,tape_error);
9
9 real array doc_name(1:2);
10 real array field mess;
11 long field time;
12 long from_time,to_time,sender,receiver;
13 integer array field data;
14 integer op_code,i,block_count,line_no,old_left,new_left,mess_lgh;
15 boolean tape_mode,block_change;
16
16 procedure header(z);
17 zone z;
18 begin
19 own integer page_no;
20 own long print_date;
21 own boolean called_before;
22
22 if -, called_before then
23 begin
24 print_date := convtime(getclock);
25 called_before := true;
26 end;
27
27 page_no := page_no + 1;
28
28 write(z,"ff",1,<:UDSKRIFT AF LOG:>,"sp",10,<:19:>,<<dd dd dd>,
29 print_date shift (-24),<:-:>,print_date extract 24,"sp",17,<:Side :>,
30 <<ddd>,page_no,"nl",1,"-",69,"nl",2,
31 <:DATO:>,"sp",7,<:KLOKKEN:>,"sp",3,<:MODTAGER:>,"sp",6,
32 <:AFSENDER:>,"sp",6,<:KODE:>,"sp",3,<:DATA:>,"nl",1);
33 end header;
34
34 procedure tape_error(z,s,b);
35 zone z;
36 integer s,b;
37 begin
38 if -, tape_mode then stderror(z,s,b);
39
39 if s shift (-22) extract 1 = 1 then error(1) else
40 if s shift (-7) extract 1 = 1 then error(2) else stderror(z,s,b);
41 close(z,true);
42 goto after_tape_error;
43 end tape_error;
44
44 procedure error(no);
45 integer no;
46 begin
47 write(out,"nl",1,case no of (
48 <:paritetsfejl på bånd:>,
49 <:"worddefect" på bånd:>),
50 "sp",4,<:print ikke udført:>,"nl",1);
51 end error;
52
52 readstring(in,doc_name,1);
53 read(in,from_time,to_time,sender,receiver,op_code);
54
54 if to_time = 0 then to_time := extend (-1) shift (-1);
55 line_no := 80;
56 mess := time := 8;
57 data := 0;
58 tape_mode := doc_name(1) <> real <:discl:> add 'o';
59 i := 1;
60 open(block_descr,if tape_mode then 18 else 4,
61 string doc_name(increase(i)),0);
62
62 setposition(block_descr,1,0);
63 inrec6(block_descr,max_block * 4);
64
64 open(z_out,4,<:logprintfil:>,0);
65 i := 1;
66
66 open(z_in,if tape_mode then 18 else 4,
67 string doc_name(increase(i)),0);
68
68 replacechar(1 <* space in number *>, '.');
69
69 for block_count := 1 step 1 until max_block do
70 begin
71 if block_descr(block_count) <> real (extend (-1)) then
72 begin
73 if to_time >= long block_descr(block_count) then
74 begin
75 setposition(z_in,1,block_count * (if tape_mode then
76 1 else segm_pr_block));
77
77 old_left := segm_pr_block * 4;
78
78 repeat
79 new_left := invar(z_in);
80 block_change := new_left > old_left;
81 if -, block_change then
82 begin
83 old_left := new_left;
84
84 if z_in.time >= from_time and z_in.time <= to_time then
85 begin
86 unpack_mess(z_in.mess);
87 mess_lgh := (z_in.mess.data(1) + 2) // 2;
88 if sender = 0 or sender = extend
89 z_in.mess.data(4) shift 24 add z_in.mess.data(5) then
90 begin
91 if receiver = 0 or receiver = extend
92 z_in.mess.data(2) shift 24 add
93 z_in.mess.data(3) then
94 begin
95 if op_code = 0 or op_code =
96 z_in.mess.data(6) shift (-8) then
97 begin
98 line_no := line_no + 1;
99 if line_no > 39 then
100 begin
101 header(z_out);
102 line_no := 0;
103 end;
104 write(z_out,"nl",1,<: 19:>,<<zd dd dd>,
105 convtime(z_in.time) shift (-24),"sp",1,
106 convtime(z_in.time) extract 24,"sp",2,<<z>,
107 z_in.mess.data(2) shift (-12),"-",1,<<zd>,
108 z_in.mess.data(2) shift (-6) extract 6,"-",1,
109 z_in.mess.data(2) extract 6,"-",1,<<zddd>,
110 z_in.mess.data(3),"sp",2,<<z>,
111 z_in.mess.data(4) shift (-12),"-",1,<<zd>,
112 z_in.mess.data(4) shift (-6) extract 6,"-",1,
113 z_in.mess.data(4) extract 6,"-",1,<<zddd>,
114 z_in.mess.data(5),"sp",2,<<zd>,
115 z_in.mess.data(6) shift (-12),".",1,
116 z_in.mess.data(6) shift (-8) extract 4,"sp",2);
117
117 i := 9;
118
118 for i := i + 1 while i <= mess_lgh do
119 begin
120 write(zout,<<ddddd>,z_in.mess.data(i),
121 "sp",2,<<dd>,z_in.mess.data(i) shift (-8)
122 extract 8,"sp",1,z_in.mess.data(i) extract 8);
123 if i < mess_lgh then
124 begin
125 line_no := line_no + 1;
126 if line_no > 39 then
127 begin
128 header(zout);
129 line_no := 0;
130 end;
131 write(z_out,"nl",1,"sp"57);
132 end;
133 end;
134 end;
135 end;
136 end;
137 end;
138 end
139 until block_change;
140 end;
141 end;
142 end;
143 setposition(z_in,-1,0);
144 after_tape_error:
145 close(z_in,true);
146 close(block_descr,true);
147 write(z_out,"ff",1,"em",3);
148 close(z_out,true);
149
149 <* convert(<:logprintfil:>); *>
150 end;
151 end
algol end 42
▶EOF◀