|
|
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: 3072 (0xc00)
Types: TextFile
Names: »printsegstx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »printsegstx «
mode list.yes
printsegs=algol rts.algftnrts7 survey.yes connect.no
begin
integer segtab_base, last_segtab, top_prog_segtab, no_of_segs,
no_of_prog , segtype , lower , upper, i,
no_of_hwds ;
integer field if2, if32, if34, if506, if508, if510, if512;
zone zdump (128, 1, stderror);
long array fpparam (1:2);
long array field laf504, tofield;
if2 := 2 ; if32 := 32; if34 := 34; laf504 := 504;
if506 := 506; if508 := 508; if510 := 510; if512 := 512;
if system (4, 1, fpparam) <> 4 shift 12 + 10 then
movestring (fpparam, 1, <:image:>);
open (zdump, 4, fpparam, 0);
setposition (zdump, 0, 1604 // 512);
inrec6 (zdump, 1604 mod 512);
inrec6 (zdump, 1638 - 1604);
segtab_base := zdump.if2 ;
last_segtab := zdump.if32;
top_prog_segtab := zdump.if34;
no_of_segs := (top_prog_segtab - segtab_base) // 2;
no_of_prog := (last_segtab + 2 - segtab_base) // 2;
no_of_hwds := no_of_segs * 2;
begin integer array segtab (1:no_of_segs);
setposition (zdump, 0, segtab_base // 512);
inrec6 (zdump, segtab_base mod 512);
sumhwds := 0;
for
hwds := inrec6 (zdump, 0)
while
hwds + sumhwds <= no_of_hwds + 512 do
begin
inrec6 (zdump, hwds);
tofield := sumhwds ;
sumhwds := sumhwds + hwds;
tofrom (segtab.tofield, zdump,
if sumhwds < no_of_hwds then
hwds
else
hwds - sumhwds + no_of_hwds);
end while;
upper := 1;
for i := 1 step 1 until no_of_segs do
begin
if segtab (i) > 0 then
begin <*active segment*>
setposition (zdump, 0, (segtab (i) + 504) // 512);
inrec6 (zdump, (segtab (i) + 504) mod 512);
inrec6 (zdump, 8);
*********************
seg_type := zdump.if512 extract 3;
write (out,
"nl", 1, <:segm no. :>, <<d>, i,
if i <= no_of_prog then
(case (seg_type + 1) of (
<:code proc:>, <:ext proc:>, <:program :>, <:rs proc:>))
else
<:data segm:>);
write (out, "sp", 2);
if i <= no_of_prog then
begin
if segtype = 1
or segtype = 2 then
begin <*prog or ext proc*>
lower := upper;
upper := zdump.if506 shift (-5) extract 18;
write (out,
<:line :>, <<dddddd>, lower, <:-:>, upper);
end else
if segtype = 0 then
write (out, zdump.laf504);
end; <*i <= no_of_prog*>
end; <*active segment*>
end; <*for i*>
end; <*block array decl*>
end;
end
▶EOF◀