|
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: 11520 (0x2d00)
Types: TextFile
Names: »testpr4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »testpr4tx «
(
mode list.yes
lookup ttestprint
testprint=algol list.yes xref.yes bossline.yes
lib on.libsmmtpr testprint ttestprint
end
)
external
procedure test_print(doc,rec_no,coroutine,type,cur_clock,print,print_record);
string doc ;
integer rec_no,coroutine,type,cur_clock ;
boolean print ;
procedure print_record ;
begin
<************************************************************************
* *
* parameters: *
* ---------- *
* *
* doc call: document name of the backing storage file *
* holding the test records *
* *
* rec_no *) record number *
* call: = 0 start at first record *
* > 0 start after 'rec_no' records *
* < 0 start -'rec_no' records from logical end- *
* of-document *
* return: last read record number *
* *
* coroutine *) coroutine number *
* return: coroutine number in last read record *
* *
* type *) record type *
* return: record type in last read record *
* *
* cur_clock *) current clock, hhmmss *
* call: = 0 start at 'rec_no' record *
* > 0 start at the first record after 'rec_no' *
* record, where clock is greater than or *
* equal to 'cur_clock' *
* return: clock in last read record *
* *
* print print condition *
* = true if current record should be printed *
* = false if current record is skipped *
* *
* the condition is evaluated for each possible *
* record (jensens device), see below *
* *
* print_record procedure with formal parameters as follows *
* (they may not be changed by the procedure): *
* record integer array (1:8) *
* the record to be printed *
* rec_no integer *
* current record number *
* cur_date integer *
* current date, yymmdd *
* cur_clock integer *
* current clock, hhmmss *
* *
* *) the parameters are changed whenever a record is read; i.e. the *
* actual parameters can be used as operands in the print condition *
* in order to decide whether such a record may be printed or not *
* (jensens device). *
* *
* *
* function: *
* -------- *
* *
* after positioning according to 'rec_no' the records are scanned *
* until 'cur_clock' condition is satisfied. *
* subsequently the reading of records starts. the print condition is *
* evaluated for each record and - if it is true - the print_record *
* procedure is called. *
* the reading stops at logical end-of-document. *
* *
* logical end-of-document is met when at least one of the following *
* conditions is fulfilled *
* - physical end-of-document *
* - 'cur_date' < 80 01 01 or 'cur_date' > to day's date *
* - time in current record less than in previous record (or less *
* than zero) *
* *
* all exceptions besides 'end of document' are treated by std_error; *
* i e. the program.stops with a run time alarm. *
* *
* *
* examples: *
* -------- *
* *
* test_print(<:test:>,0,0,0,0,true,print_rec); *
* all records until logical end-of-document in the test record file *
* document 'test' is printed by means of the procedure print_rec. *
* *
* rec:= 200; *
* test_print(<:test:>,rec,0,0,0,rec <= 300,print_rec); *
* if rec < 301 then write(out,<:<10>file exhausted at record:>,rec); *
* the records from number 201 through 300 are printed; but if there is *
* not at least 300 records in the (logical) file a warning is written *
* on current output. *
* *
* rec:= -1000; *
* test_print(<:testfile:>,rec,cor,type,0, *
* cor = 1 or (cor mod 3 = 2 and *
* (type = 4 or type = 5 or type = 8)),print); *
* among the latest 1000 records in 'testfile' all records concerning *
* coroutine 1 are printed but if the records are produced by the co- *
* routines 2, 5, 8, ... only signal and wait records are printed; no *
* other records are printed. *
* *
* test_print(<:test:>,2000,cor,type,13 00 00,cor <> 0 or cor <> 7 or *
* type >= 1024,print_rec); *
* the 'test' file is started at the first record generated at 1 p.m. *
* (or later) after record number 2000 (exclusive). all user records *
* from all coroutines or system generated records not produced by *
* centrallogic or coroutine 7, are printed. *
* *
************************************************************************>
\f
integer
cur_date, <* yymmdd, corresponding to last_time *>
p_cur_clock, <* value of parameter cur_clock *>
rel_rec_no, <* number of records from logical end-of-document *>
res, <* value of last call of next_record *>
to_day; <* to day's date, yymmdd *>
integer field
cor, <* field in test record *>
operation; <* field in test record *>
long
last_time; <* last read time value from test record *>
long field
time; <* field in test record *>
integer array field
iaf; <* test record as integer array *>
zone
in(128,1,read_error);<* zone for test record document *>
\f
procedure read_error(in,status,halfwords);
zone in ;
integer status,halfwords ;
begin
integer array
zone_descr(1:20); <* zone description area *>
if logand(status,1 shift 18 <* end of document *>) <> 0 then
begin
get_zone6(in,zone_descr);
zone_descr(14):= zone_descr(19); <* record_base:= base_buffer_area *>
zone_descr(16):= 16; <* record_length:= 16 hw *>
set_zone6(in,zone_descr);
in.iaf.operation:= 3;
in.iaf.cor:= -1;
in.iaf.time:= -1;
status:= 0;
halfwords:= 128*4;
end
else
std_error(in,status,halfwords);
end;
integer
procedure next_record;
begin
real r;
next_record:= 0;
inrec6(in,16);
rec_no:= rec_no + 1;
type:= in.iaf.operation;
if type > 2 then
begin
coroutine:= abs in.iaf.cor;
if in.iaf.time < last_time then
next_record:= 1;
last_time:= in.iaf.time;
cur_date:= systime(4,last_time/10000,r);
cur_clock:= r;
if cur_date < 80 01 01 or
cur_date > to_day then
next_record:= 2;
end;
end;
\f
begin
real r,time;
systime(1,0,time);
to_day:= systime(4,time,r);
end;
iaf:= 0;
operation:= 2;
cor:= 12;
time:= 16;
\f
open(in,4,doc,1 shift 18);
p_cur_clock:= cur_clock;
last_time:= 0;
if rec_no < 0 then
begin
rel_rec_no:= -rec_no;
rec_no:= 0;
repeat until next_record > 0;
if rec_no > rel_rec_no then
rec_no:= rec_no - 1 - rel_rec_no
else
begin
write(out,<:<10>relative record number greater than max record number, i.e.:>,
rel_rec_no,<: >=:>,rec_no,<:<10>:>);
rec_no:= 0;
end;
end;
setposition(in,0,rec_no//32 <* i.e. records per segment *>);
inrec6(in,(rec_no mod 32)*16);
coroutine:=
cur_date:=
cur_clock:= 0;
last_time:= 0;
repeat
res:= next_record;
until cur_clock >= p_cur_clock or res > 0;
if res = 0 then
begin
repeat
if print then
print_record(in.iaf,rec_no,cur_date,cur_clock);
until next_record > 0;
end
else
write(out,<:<10>file exhausted; record number:>,rec_no,<:<10>:>);
write(out,false,768);
close(in,true);
end; <*test print*>
end
▶EOF◀