DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »tmuscopy«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦87223b8a0⟧ »kkrcmonfil« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦87223b8a0⟧ »kkrcmonfil« 
            └─⟦this⟧ 

TextFile

muscopy = algol

begin
integer       field i, if2, file, chars, rem, size;
integer array field trel;
long    array field laf;
boolean             block, firstblock, noleft;
zone                tape(128*2, 2, tapeproc),
                    disc(128*2, 2, discproc);

procedure tapeproc(z, s, b); zone z; integer s, b;
   begin
   comment the main purpose is to check tapemark and 
           to compute number of chars in the block;
   if false add s then stderror(z, s, b);
   block := (s shift 7) >= 0;  <* i.e. not tapemark *>
   chars := b * 3 // 2;        <* i.e. first guess *>
   if (s shift 16) < 0 then
      begin <* word defect, i.e. not multiplum of 3 chars *>
      chars := if chars mod 6 = 0 then chars - 2
                                  else chars - 1;
      end;
   end;

procedure discproc(z, s, b); zone z; integer s, b;
   begin
   comment the main purpose is to produce an alarmtext,
           in case the area is extended;
   integer array ia(1:20); integer i, j;
   if false add s then stderror(z, s, b);
   if (s shift 5) < 0 then
      begin <* end of area, alarm and repeat transfers, after extension *>
      write(out, <:<10>*** area extended ***:>);
      getzone6(z, ia);
      i := ia(10); ia(10) := 0;
      setzone6(z, ia);  <* change user-bits *>
      monitor(16, z, ia(17), ia);
      check(z);         <* repeat the message, and take standard actions *>
      ia(10) := i;
      setzone6(z, ia);  <* reset user-bits *>
      getshare6(z, ia, ia(17));
      b := ia(12) - 1 - ia(14);  <* top transferred(used share) - 1 - record base *>

      comment wait all pending transfers and start them again;
      j := ia(17) - 1;           <* last used share *>
      for i := ia(17) + 1 step 1 until ia(18),
               1 step 1 until j do
         begin
         getshare6(z, ia, i);
         if ia(1) > 1 then
            begin <* wait message and send it again *>
            monitor(18, z, i, ia);
            monitor(16, z, i, ia);
            end;
         end;
      end alarm;
   end discproc;

begin comment block for initialization;
integer array tail(1:20);
real    array ra(1:2);
  
getzone6(in,tail);
if tail(1) extract 12 <> 18 then
   system(9,tail(1) extract 12,<:<10>mtkind:>);
laf:=2;
i:=1;

open(tape, tail(1), string tail.laf(increase(i)), 1 shift 19 + 1 shift 16 + 1 shift 7 + 1 shift 1);
    <* userbits = block length error + tapemark + word defect + normal answer *>

noleft := system(4, 1, ra) <> 6 shift 12 + 10;
if -, noleft then
   begin <* i.e. left hand side in call, maybe create entry *>
   system(4, 0, ra);
   i := 1;
   open(disc, 4, string ra(increase(i)), 1 shift 18);
       <* user-bits = end of area *>
   tail(1) := 1; tail(2) := 1;  <* prepare area on disc *>
   for i := 3 step 1 until 10 do tail(i) := 0;
   monitor(52) create area process :(disc, 0, tail);
   if monitor(8) reserve process :(disc, 0, tail) <> 0 then
      monitor(40) create entry :(disc, 0, tail);
   end;
end initialization block;

if2 := 2; laf := 0;

for file := 0, file + 1 while -, firstblock do
begin

setposition(tape, file, 0);
firstblock := true;

for rem := inrec6(tape, 0) while block do
   begin

   inrec6(tape, rem);

   if firstblock then
      begin
      firstblock := false;
      write(out, <:<10>file :>, <<ddd>, file, <: = :>, tape.laf);
      if noleft then goto endfile;
      if file = 0 then goto skipblock; <* skip ident-block in boot-file *>
      end;

   outrec6(disc, 2); disc.if2 := chars;

   for trel := 0, trel + size while rem > 0 do
      begin

      size := outrec6(disc, 0);
      if size > rem then size := rem;
      outrec6(disc, size);
      rem := rem - size;

      for i := 2 step 2 until size do
         disc.i := tape.trel.i;

      end move of single tape-block;

skipblock:
   end move of blocks;

if -, noleft then
   begin
   outrec6(disc, 2); disc.if2 := 0;
   end;

endfile:

end move of files;

begin
comment generate end of tape mark and initiate time of catalog entry;
integer array tail(1:20);

if -, noleft then
   begin
   outrec6(disc, 2); disc.if2 := -3;
   monitor(42, disc, 0, tail);
   tail(6):=systime(7, 0, 0.0);
   monitor(44, disc, 0, tail);
   close(disc, true);
   end;

close(tape, false);
monitor(10) release process :(tape, 0, tape.trel);

end

end
\f

▶EOF◀