DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦584c52bed⟧ TextFile

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »printsegstx «

Derivation

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »printsegstx « 

TextFile

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◀