DataMuseum.dk

top - metrics - download

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

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

TextFile

clear pinitrun
pinitrun=set 27
(pinitrun=algol
 message program in pinitrun)
begin
zone z(128,1,stderror);
integer i, j, line, ba, sh;
real array NAME(1:1), T(1:12);
integer array A(0:127);
procedure error(str);
string str;
begin
write(out,<:<10>:>,str);
setposition(out,0,0);
goto REP;
end error;

open(z,4,<:pinitarea:>,0);

for i:=0 step 1 until 127 do A(i):=i;
for i:= 32, 48 step 1 until 57, 65 step 1 until 93,
        97 step 1 until 125 do A(i):=6 shift 12 add i;
A(10):=8 shift 12 add 10;

swoprec(z,128);

REP:

readstring(in,NAME,1);

if NAME(1)=real (<:init:>) then
  begin
  for i:=1 step 1 until 128 do z(i):=0.0 shift 48;
  end
else
if NAME(1)=real(<:list:>) then
  begin
  for i:=1 step 1 until 10 do
    begin
    j:=(i-1)*12+1;
    if z(j)<>0.0 shift 48 then write(out,<:<10>:>,<<ddd>,i,
                    false add 32,3,string(z(increase(j))));
    end;
  write(out,false add 10,1);
  setposition(out,0,0);
  end
else
if NAME(1)=real(<:clear:>) then
  begin
  read(in,line);
  if line<0 or line>10 then error(<:lineno too great:>);
  for j:=(line-1)*12+1 step 1 until line*12 do z(j):=0.0 shift 48;
  end
else
if NAME(1)=real(<:set:>) then
  begin
  read(in,line);
  if line<0 or line>10 then error(<:lineno too great:>);
  intable(A);
  i:=readstring(in,T,1);
  intable(0);
  if i<0 then error(<:too long line:>);
  for sh:=-40 step 8 until 0 do
  if T(i) shift sh extract 8 = 0 then
    begin
    T(i):=T(i) shift (sh-8) shift 8 add 10 shift (-sh);
    if i=12 and sh=0 then error(<:too long line:>);
    for i:=i+1 while i<=12 do T(i):=0.0 shift 48;
    goto OUTR;
    end;

  OUTR:
  i:=1;
  write(out,string(T(increase(i))));
  setposition(out,0,0);
  i:=(line-1)*12;
  for j:=1 step 1 until 12 do z(i+j):=T(j);
  end
else
if NAME(1)=real<:stop:> then
  goto ENDP;

goto REP;

ENDP:

close(z,true);

end



pinitrun c
clear pinitrun
end
▶EOF◀