DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »extpal«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »extpal« 
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »extpal« 

TextFile

external
boolean procedure outmedium(output);
zone output;

begin
integer i,j,p;
boolean b;
integer array t(1:10);
array a(1:2);
integer procedure alarm; alarm:= system(9,0,<:<10>***param:>);
i:= system(4,1,a);  b:= i = 6 shift 12 + 10;
if b then begin zone z(1,1,stderror);
   system(4,0,a); i:= 1; open(z,0,string a(increase(i)),0);
   j:= monitor(42,z,0,t);  i:= 1;  p:= t(1);
   if j<>0 then begin
      write(out,<:<10>***:>,string a(increase(i)),<: unknown.:>);
      alarm end;
   if p>0 then p:= 4 else begin
      p:= (p shift 1) shift (-1);
      for j:=1,2 do
         a(j):= 0.0 shift 24 add t(j+j) shift 24 add t(j+j+1)
   end;
   open(output,p,string a(increase(i)),0);
   setposition(output,t(7),t(8))
end else begin
   array field name; integer array zonedex(1:20);
   name:= 2; getzone(out,zonedex); i:= 1;
   open(output,zonedex(1),string zonedex.name(increase(i)),0)
end;
outmedium:= b
end;
end
\f



readhead

external
integer procedure readhead(z,a,i);
value i; integer i; zone z; array a;
begin comment
   Proceduren læser en overskrift startende med  <  og afsluttet
af  >  eller  NL.  Return value er antallet af tegn i den indlæste
tekststreng;
integer array alfabet(0:127);   integer j,k,l;
procedure inset(k);  value k; integer k;
begin alfabet(j):= k shift 12 + j end;

for j:=38 step 1 until 125 do inset(6);
for j:=0  step 1 until  37, 63,64,94,95,96,126,127 do inset(0);
for j:=10,32 do inset(6);
for j:=62    do inset(7);
for j:=25    do inset(8);

for j:=readchar(in,k) while k<>60 do;
readchar(in,k);
if k<>62 then begin
   repeatchar(in);  intable(alfabet);  tableindex:= 0;
   k:= readstring(z,a,i); l:= 6*k; k:= i+k-1;
   for j:=-40 step 8 until 0 do
   if a(k) shift j extract 8 = 0 then l:= l-1;
   intable(0)
end else begin
   l:= 0;  a(i):= 0 shift 24
end;
readhead:= l
end; end
▶EOF◀