DataMuseum.dk

top - metrics - download

    Length: 9216 (0x2400)
    Types: TextFile
    Names: »slxref3tx   «

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

TextFile

begin
comment: this program is intended for near cooperation
     with the slang-assembler. it writes the records,
     produced by the xref-part of slang, on current
     output, after having sorted the records.
     the program is called like this:

     slangxref <name of xrefarea> <number of xref-records> ;

integer       records, recs_on_line, curr_ident, last_ident, line_no;
long field rec_ident;
real array    ra(1:2);
integer array ia(1:1);

procedure sldisksort(filnavn,læ,antalindiv,segmprblok,ngl1);
value segmprblok; string filnavn;
integer læ,antalindiv,segmprblok,ngl1;

begin integer fysisksubbloklængde, fysiskbloklængde, b;
      integer array ia(1:20); array ra(1:2);
      fysisksubbloklængde := 512 * segmprblok;
      b:= (system(2,b,ra)-8*512)//(2*fysisksubbloklængde);
      fysiskbloklængde := b * fysisksubbloklængde;
      segmprblok := b * segmprblok;

begin integer diff, fa, indivlæ2, logiskbloklængde,
      logisksubbloklængde, nedbasis, nedplads, nedslut, opbasis,
      opplads, opslut, slut2, start2, subblokstart, transporter;
      array field m, ned, op; integer array nuvblok(0:1);
      zone z(fysiskbloklængde//2,1,blproc);

      integer mid2;
      long r, mid1;
      long field i, nøgle1;
      integer j; integer field indivlæ;

procedure blproc(z,s,b); zone z; integer s, b;
if s extract 19 < 1 shift 18 or ia(4)<>5 shift 12 then
stderror(z,s,b);

procedure io(plads,operation); integer plads, operation;
begin b:=nuvblok(plads)*segmprblok;
      if b>=0 then
      begin ia(4):= operation shift 12;
            ia(7):= b;
            ia(5):= b:= fa + plads*fysiskbloklængde;
            ia(6):= b + fysiskbloklængde - 2;
            setshare(z,ia,1);
            monitor(16,z,1,ia); check(z);
      end
end io;
\f

                                                                         
procedure quicksort(start,slut,enblok); value start, slut, enblok;
integer start, slut; boolean enblok;
begin

for m:=(start+slut)//indivlæ2*indivlæ while start<slut-indivlæ2 do
begin op:= start-opbasis; ned:= slut-nedbasis;
      if enblok then m:=m-opbasis else
      begin transporter:=0;
            transport(m,0,opplads,nedplads);
            nedslut:=ned; opslut:=op;
      end;
      mid1:=z.m.nøgle1 shift (-2);
      mid2:=z.m.nøgle1 extract 2;

søgned:  ned:= ned-indivlæ; if ned < nedslut then
      begin transport(ned,nedbasis,nedplads,opplads);
            nedslut:= subblokstart;
      end;
      if z.ned.nøgle1 shift (-2) > mid1 then goto søgned;
      if z.ned.nøgle1 shift (-2) < mid1 then goto søgop;
      if z.ned.nøgle1 extract 2 > mid2 then goto søgned;

søgop:   op:= op+indivlæ; if op >= opslut then
      begin transport(op,opbasis,opplads,nedplads);
            opslut:= subblokstart + logisksubbloklængde;
            if transporter=3 then enblok:= nedslut=subblokstart;
      end;
      if z.op.nøgle1 shift (-2) < mid1 then goto søgop;
      if z.op.nøgle1 shift (-2) > mid1 then goto søgej;
      if z.op.nøgle1 extract 2 < mid2 then goto søgop;

søgej:
      if op+opbasis < ned+nedbasis then
      begin for i:=4 step 4 until indivlæ do
            begin r:=z.op.i; z.op.i:=z.ned.i; z.ned.i:=r end;
            goto søgned;
      end;

      slut2:= op+opbasis; start2:= start; start:= ned+nedbasis;
      if slut-start < slut2-start2 then
      begin i:=slut; slut:=slut2; slut2:=i;
            i:=start; start:=start2; start2:=i;
      end;
      if start2<slut2-indivlæ2 then quicksort(start2,slut2,enblok);
end for m;
end quicksort;
\f

                                                                     
procedure transport(fysisk,basis,plads,andenplads);
integer fysisk, basis, plads, andenplads;
begin integer logisk, blok, blokrel, subbloknr, blokbasis;

      logisk:= fysisk+basis;
      blok:= logisk//logiskbloklængde; blokrel:= logisk mod logiskbloklængde;

      if blok = nuvblok(0) then plads := 0 else
      if blok = nuvblok(1) then plads := 1 else
      begin plads := 1-andenplads; io(plads,5);
            nuvblok(plads):= blok; io(plads,3);
      end;

      subbloknr := blokrel//logisksubbloklængde;
      blokbasis := plads * fysiskbloklængde;
      fysisk := blokrel + subbloknr * diff + blokbasis;
      subblokstart := subbloknr * fysisksubbloklængde + blokbasis;
      basis := logisk - fysisk;
      transporter := transporter + 1;
end transport;


      open(z,4,filnavn,1 shift 18); close(z,false);
      getzone(z,ia); fa:=ia(19)+1; getshare(z,ia,1);

      nøgle1:=ngl1;  indivlæ:=læ; indivlæ2:=2*indivlæ;
      if nøgle1<4 or indivlæ<nøgle1 then system(9,nøgle1,<:<10>ngl1fiel:>);

      diff:= fysisksubbloklængde mod indivlæ;
      logisksubbloklængde := fysisksubbloklængde - diff;
      logiskbloklængde := b * logisksubbloklængde;

      nuvblok(0) := nuvblok(1) := -1;
      opbasis:= nedbasis:= nedplads:= 0;
      quicksort(-indivlæ, indivlæ*antalindiv, false);
      io(0,5); io(1,5);
end zone blok;
end disksort;

\f


comment: each record consists of two words
     the record consists of:

     <record> ::= <block no>     shift 38
                 +<record ident> shift 18
                 +<line no>

     the record ident is builded like this:

     <rec_ident> ::= <def or use> shift 19
                    +<id letter>  shift 13
                    +<id index>   shift 1
                    +<use>                 .
     (or in short: (<def or use>,<id letter>,<id index>,<use>)).

     this gives 6 kinds of records:
   1. <begin-records>:   <rec_ident> = (0,0,0,1)
   2. <decl-records>:    <rec_ident> = (0,<id letter>,<id index>,0)
   3. <end-records>:     <rec_ident> = (0,63,0,0)
   4. <k assignment>:    <rec_ident> = (1,0,0,0)
   5. <def-records>:     <rec_ident> = (1,<id letter>,<id index>,0)
   6. <use-records>:     <rec_ident> = (1,<id letter>,<id index>,1);
   if -,fpmode(18) then errorbits:= 1;
    trapmode:= 1 shift 10;

system(4,2,ra);  records := ra(1);
system(4,1,ra);  rec_ident := 1;
sldisksort(string ra(increase(rec_ident)),4,records,1,4);

write(out, <:<12><10>:>);
setposition(in,0,0);

next_block:
  if records = 0 then goto finis;
  inrec6(in,512);

  for rec_ident := 4 step 4 until 4+(512//4)*4-4 do
  begin
  if records = 0 then goto finis;
  records := records - 1;
  line_no := in.rec_ident extract 18;
  curr_ident := in.rec_ident shift (-18) extract 20;

comment: split into the different actions, depending
     on the record kind;

  if curr_ident <= 1 shift 19 then
    begin
    if curr_ident=0 then else
    if curr_ident = 1 then
      begin comment
<begin_record>;
      write (out, <:<10>:>, <<-dddddd>, line_no, <: b.:>);
      recs_on_line := 0;
      end else
    if curr_ident < 63 shift 13 then
      begin comment
<decl-record>;
      recs_on_line := recs_on_line + 1;
      if recs_on_line = 12 then
        begin comment line is full with declarations;
        recs_on_line := 1;
        write (out, <:<10>:>, false add 32, 10);
        end else
      if recs_on_line <> 1 then write (out, <:,:>);
      write (out, <: :>, false add (curr_ident shift (-13) extract 6) add 96, 1,
                  <<d>, curr_ident shift (-1) extract 12);
      end else
    if curr_ident = 63 shift 13 then
      begin comment
<end-record>;
      recs_on_line := last_ident := 0;
      write (out, <:<10>:>, <<-dddddd>, line_no, <: e.:>);
      end else

      begin comment
<k assignment>;
      if curr_ident <> last_ident then
      begin
        write (out, <:<10>  k:>, false add 32, 5, <:def :>);
      last_ident := curr_ident;
      recs_on_line := 0;
      end;
      goto common_write;
      end
    end else

    begin comment
<def-record> or <use-record>;
    if curr_ident <> last_ident then
      begin comment new ident name or use;
      if curr_ident shift (-1) <> last_ident shift (-1) then
        write (out, false add 32, 9 - write (out,
               <:<10>  :>, false add (curr_ident shift (-13) extract 6) add 96, 1,
               <<d>, curr_ident shift (-1) extract 12))
      else write (out, <:<10>:>, false add 32, 8);
      write (out, if curr_ident extract 1 = 0 then <:def :> else <:use :>);
      recs_on_line := 0;
      last_ident := curr_ident;
      end new ident name;

common_write:
    recs_on_line := recs_on_line + 1;
    if recs_on_line = 8 then
      begin comment line is full with def.s or use.s;
      recs_on_line := 1;
      write (out, <:<10>:>, false add 32, 12);
      end;
    write (out, <<-dddddd>, line_no);
    end def_record, use_record;
  end step_until_statement;

  goto next_block;

finis:

;comment remove the xref-area;
monitor(48,in,1,ia);
write(out, <:<10><10>:>);
write(out,if fpmode(18) then <:slang ok<10>:> else
          <:***slang sorry<10>:>);
message slangxref 1977.11.10;

end

\f

▶EOF◀