|
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◀