|
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: 5376 (0x1500)
Types: TextFile
Names: »getdumptx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »getdumptx «
\f
<* fgs 1988.09.23 mainstat page ...17a...*>
integer
procedure seg (first_addr, dumparea, rel);
value first_addr ;
integer first_addr, rel ;
long array dumparea ;
begin
own
boolean seen_this_dump_before;
own
integer first_addr_low__part, top_addr_low__part,
no_of_segs_low__part,
first_addr_high_part, top_addr_high_part,
no_of_segs_high_part;
integer segment, relative, monrel,
addr_last_w_of_dumptable, first_addr_in_dump,
no_of_words_in_dump, segm_offset;
integer field ifld
zone zdump (128, 1, stderror);
\f
<* fgs 1988.09.23 mainstat page ...17b...*>
open (zdump, 4, dumparea, 0);
if testout then
write (out,
"nl", 1, <:seen this dump before = :>,
if seen_this_dump_before then <:true:> else <:false:>);
if not seen_this_dump_before then
begin <*this dumpfile just connected*>
seen_this_dump_before := true;
ifld := 2;
segment := 0;
relative := 64;
setposition (zdump, 0, segment);
inrec6 (zdump, relative );
inrec6 (zdump, 2 );
monrel := zdump.ifld;
if testout then
write (out,
"nl", 1, <:monrel = :>, monrel shift (-12), <:.:>, monrel extract 12);
if monrel < 80 shift 12 then
begin <*contigous dump area*>
first_addr_low_part := 0;
no_of_segs_low_part := no_of_segs_in_dump;
top___addr_low_part := no_of_segs_in_dump * 512;
end
\f
<* fgs 1988.09.23 mainstat page ...17c...*>
else
begin <*split dump*>
relative := 12;
setposition (zdump, 0, segment);
inrec6 (zdump, relative );
inrec6 (zdump, 2 );
addr_last_w_of_dumptable := zdump.ifld;
relative := addr_last_w_of_dumptable - 8;
if testout then
write (out,
"nl", 1, <:addr l w of dumptable = :>, relative);
setposition (zdump, 0, segment);
inrec6 (zdump, relative );
inrec6 (zdump, 2 );
first_addr_low_part := zdump.ifld;
inrec6 (zdump, 2 );
no_of_segs_low_part := zdump.ifld;
top_addr_low_part :=
first_addr_low_part + 512 * no_of_segs_low_part;
inrec6 (zdump, 2 );
first_addr_high_part := zdump.ifld;
inrec6 (zdump, 2 );
no_of_segs_high_part := zdump.ifld;
top_addr_high_part :=
first_addr_high_part + 512 * no_of_segs_high_part;
if testout then
write (out,
"nl", 1, <:f. addr low part = :>, first_addr_low_part,
"nl", 1, <:t. addr low part = :>, top___addr_low_part,
"nl", 1, <:n. segs low part = :>, no_of_segs_low_part,
"nl", 1, <:addr. l. w d.tabl = :>, addr_last_w_of_dumptable,
"nl", 1, <:f. addr high part = :>, first_addr_high_part,
"nl", 1, <:t. addr high part = :>, top___addr_high_part,
"nl", 1, <:n. segs high part = :>, no_of_segs_high_part);
end <*split dump*>;
end <*dump file just connected*>;
\f
<* fgs 1988.09.23 mainstat page ...17d...*>
if first_addr >= first_addr_low_part and
first_addr < top___addr_low_part then
begin <*low part*>
first_addr__in_dump := first_addr_low_part;
no_of_words_in_dump := (top_addr_low_part - first_addr) / 2;
segm_offset := 0;
if testout then
write (out,
"nl", 1, <:low part ::>,
"nl", 1, <:first addr in dump = :>, first_addr_in_dump,
"nl", 1, <:no of wrds in dump = :>, no_of_words_in_dump,
"nl", 1, <:segment offset = :>, segm_offset);
end else
if first_addr >= first_addr_high_part and
first_addr < top___addr_high_part then
begin <*high part*>
first_addr__in_dump := first_addr_high_part;
no_of_words_in_dump := (top_addr_high_part - first_addr) / 2;
segm_offset := no_of_segs_low_part;
if testout then
write (out,
"nl", 1, <:high part ::>,
"nl", 1, <:first addr in dump = :>, first_addr_in_dump,
"nl", 1, <:no of wrds in dump = :>, no_of_words_in_dump,
"nl", 1, <:segment offset = :>, segm_offset);
end else
error (10); <*outside dump*>
segment := segm_offset + (first_addr - first_addr_in_dump) shift (-9);
relative := (first_addr - first_addr_in_dump) extract 9 ;
if testout then
write (out,
"nl", 1, <:segment = :>, segment,
"nl", 1, <:relative = :>, relative);
close (zdump, true);
seg := segment;
rel := relative;
end procedure seg;
▶EOF◀