⟦809220910⟧

TextFile

mode list.yes
clear login stdvar
stdvar=set 80 disc1
scope user stdvar
lookup stdlist
if ok.yes
mode 15.yes
stdvar=algol message.no
Anders Lindgård
1978 09 21
Creates standard variables for the algol system.
begin
boolean list,test,begcond,endcond,ok,thisok,
  temp,login,user,project;
integer i,j,k,totbyte,byteinit,total,no,oldkind,kind,
  maxentry,res,del,bi,bo,startext,exti,entrypoint,c,char;
real rt,time;
long field lval;
array r,w,entry,main(1:2);
boolean field init,bval;
integer field I1,I2,type,ival;
integer array a,tail(1:10);
integer array field ifi,byte;
array field name,cur;
real field rval;

integer procedure readdel;
begin
integer c,char;
readdel:=0;
repeatchar(in);
for c:=readchar(in,char) while char=10 or char=32do;
repeatchar(in);
if c=7 then
  begin
  <*delimiter*>
  if -,(char=44 <*,*> or char=61 <*=*> or char=59<*;*>) then
    write(out,"nl",1,<:delimiter1 :>,false add char,1);
  end
else
  if c<7 then write(out,"nl",1,<:-delimiter:>);
readdel:=char;
end readdel;


type:=2; name:=2; init:=12; bval:=ival:=rval:=lval:=16;
readbfp(<:test:>,test,false);
readbfp(<:list:>,list,true);
readbfp(<:temp:>,temp,false);
readbfp(<:login:>,login,false);
readbfp(<:user:>,user,false);
readbfp(<:project:>,project,false);
readifp(<:maxentry:>,maxentry,100);

begin
array rec(1:4*maxentry);

cleararray(rec);
if -,readlsfp(main) then alarm(<:***left side missing:>);
removeentry(main);
res:=lookupentry(main);
i:=1;
if res=0 then alarm(<:***connect left side :>,string main(increase(i)));
cleararray(tail);
tail(1):=1;
res:=createentry(main,tail);
i:=1;
if res<>0 then alarm(<:create :>,string main(increase(i)),<: , result :>,res);
res:=if project then scope_pro(main) else
     if user    then scope_user(main)    else
     if login   then scope_login(main)   else
     if temp    then scope_temp(main)    else 0;
i:=1;
if res<>0 then alarm(<:permanent :>,string main(increase(i)),<: , result:>,res);
kind:=0;
totbyte:=byteinit:=0;
ok:=true;
begcond:=endcond:=false;
cur:=0;
del:=59;
total:=no:=0;
for no:=no+1 while -,endcond do
begin
igen:
  thisok:=true;
  if del=59 then
  begin
    cleararray(r);
    res:=readstring(in,r,1);
    if res<0 then alarm(<:***exhausted:>);
    repeatchar(in);
    readchar(in,i);
    if test then 
    begin
      i:=1;
      write(out,"nl",1,<:$:>,string r(increase(i)));
      outendcur(i);
     end;
    j:=0;
    for j:=j+1 while j<7 and r(1)<>(case j of
                 (real<:boole:> add  97,
                  real<:integ:> add 101,
                  real<:real:>,real<:long:>,real<:begin:>,
                  real<:end:>,real<::>)) do;
    begcond:=begcond or j=5;
    if -,begcond or j=5 then goto igen;
    endcond:=j=6;
    if j<5 then kind:=j;
    if j>6 then
    begin
     thisok:=ok:=false;
     i:=1;
     write(out,"nl",1,<:declarator :>,string r(increase(i)));
     outendcur(0);
     repeatchar(in);
     for c:=readchar(in,char) while char<>25 and char<>59 do;
     repeatchar(in);
    end;
    if kind=0 and -,endcond then goto igen;
    repeatchar(in);
    for c:=readchar(in,char) while char=32 or char=10 do;
    repeatchar(in);
    if c<>6 and -,endcond then
    begin
     ok:=false;
     write(out,"nl",1,"*",2,<:delimiter2 :>,false add char,1);
     for c:=readchar(in,char) while char<>44 <*,*> and char<>25 do;
     repeatchar(in);
    end;
    end search for type;
    if -,endcond then
    begin
    res:=readstring(in,rec.cur.name,1);
    if res<0 or res>2 then
    begin
      i:=1;
      write(out,"nl",1,"*",2,<:identifierlength :>,string rec.cur.name(increase(i)),
      <: size (in reals):>,res);
      thisok:=ok:=false;
    end;
    i:=1;
    if test then
     write(out,"nl",1,"*",1,
       case kind of(<:b:>,<:i:>,<:r:>,<:l:>),
       "sp",2,
       string rec.cur.name(increase(i)));
    del:=readdel;
    if test then outendcur(del);
    if -,(del=44 or del=59 or del=61) then
    begin
      thisok:=ok:=false;
      write(out,"nl",1,"*",2,<:delimiter3 :>,false add del,1);
    end;
    rec.cur.type:=kind;
    rec.cur.init:=del=61 <*=*>;
    totbyte:=totbyte+(if kind<3 then 2 else 4);
    if rec.cur.init then
    begin
     byteinit:=byteinit+(if kind<3 then 2 else 4);
     case kind of
     begin
       rec.cur.bval:=readstring(in,w,1) >0 and w(1)=real <:true:>;
       read(in,rec.cur.ival);
       read(in,rec.cur.rval);
       read(in,rec.cur.lval);
     end case;
    if kind=1 and w(1)=real <:false:> then
    begin
     <*search for add <integer>*>
     repeatchar(in);
     for i:=readchar(in,j) while j=32 do;
     repeatchar(in);
     if i=6 then
     begin
      res:=readstring(in,w,1);
      if w(1)=real <:add:> then
      begin
         repeatchar(in);
         for i:=readchar(in,j) while j=32 do;
         repeatchar(in);
         if i=2 then
         begin
           read(in,i);
           if i>0 and i<=128 then rec.cur.ival:=i else
           begin
             thisok:=ok:=false;
             write(out,"nl",1,"*",2,<:boolean value :>,i);
           end;

         end integer else
         begin
           thisok:=ok:=false;
           write(out,"nl",1,"*",2,<:boolean value missing:>);
         end;
       end add else
       begin
         thisok:=ok:=false;
         i:=1;
         write(out,"nl",1,"*",2,<:delimiter :>,string w(increase(i)));
       end;
     end text after boolean;
    end false;
    del:=readdel;
    end initial value;
    if del=59 <*;*> then kind:=0 else
    if del<>44 <*,*> then
    begin
      thisok:=ok:=false;
      write(out,"nl",1,"*",2,<:delimiter4 :>,false add del,1);
    end else
    begin
      readchar(in,char); <* read , *>
      for c:=readchar(in,char) while char=32 or char=10 do;
      repeatchar(in);
      if c<>6 then
      begin
        ok:=thisok:=false;
        write(out,"nl",1,"*",2,<:delimiter5 :>,false add char,1);
        for c:=readchar(in,char) while c=7 do;
        repeatchar(in);
      end;
    end delimiter error;
    if no>maxentry then alarm(<:***maxentry exceeded:>);
    if thisok then
    begin
    cur:=cur+16;
    total:=total+1;
    end;

   end end_cond;
   end loop;

if true then write(out,
  "nl",1,<:syntax check :>,if ok then <:ok:> else <:not ok:>,
  "nl",1,<:total variables :>,total,
  "nl",1,<:total own bytes  :>,totbyte,
  "nl",1,<:bytes initialized:>,byteinit);

if list then
begin
  write(out,"nl",2,<:begin:>,"nl",1);
  oldkind:=cur:=0;
  for no:=1 step 1 until total do
  begin
    kind:=rec.cur.type;
    if kind<>oldkind then
    begin
    if oldkind>0 then write(out,<:;:>,"nl",1);
    write(out,case kind of
       (<:boolean :>,<:integer :>,
        <:real :>,<:long :>));
    end else if oldkind>0 then write(out,<:, :>);
    i:=1;
    write(out,string rec.cur.name(increase(i)));
    if rec.cur.init then
    begin
    write(out,<:=:>);
    case rec.cur.type of
    begin
      if rec.cur.ival=0 or rec.cur.ival=-1 then
      write(out,if rec.cur.bval then <:true:> else <:false:>)
      else write(out,<:add:>,rec.cur.ival);
      write(out,<<d>,rec.cur.ival);
      write(out,<<d.dddddd'-ddd>,rec.cur.rval);
      write(out,<<d>,rec.cur.lval);
    end case;
    end initialval;
    oldkind:=kind;
    cur:=cur+16;
    end loop;
  write(out,"nl",1,<:end:>,"nl",1);
  end list;

if ok or test then
begin
  cur:=0;
  tail(1):=1 shift 23+4;
  for i:=1,2 do tail.name(i):=main(i);
  tail(8):=0;
  tail(9):=4 shift 12;
  tail(10):=1 shift 12 + totbyte;
  bi:=-1;
  bo:=byteinit-1;
  for no:=1 step 1 until total do
  begin
    kind:=rec.cur.type;
    for i:=1,2 do entry(i):=rec.cur.name(i);
    res:=remove_entry(entry);
    tail(7):=(kind+7) shift 18;
    if rec.cur.init then tail(6):=bi:=bi+(if kind<3 then 2 else 4) else
      tail(6):=bo:=bo+(if kind<3 then 2 else 4);
    res:=createentry(entry,tail);
    k:=i:=1;
    if test then write(out,"nl",1,<:$$:>,string entry(increase(i)),"sp",2,
       <:=set :>,tail(1),"sp",2,
       string tail.name(increase(k)),res);
    if res<>0 then
    begin
     i:=1;
     write(out,"nl",1,"*",2,<:create entry :>,string entry(increase(i)),<: , result :>,res);
     ok:=false;
    end create check;
    if ok and (temp or login or user or project) then
    begin
    res:=if project then scope_pro(entry) else
         if user    then scope_user   (entry) else
         if login   then scope_login  (entry) else
         if temp    then scope_temp   (entry) else 0;
    if res<>0 then
    begin
      i:=1;
      write(out,"nl",1,"*",2,<:permanent :>,string entry(increase(i)),<: , result :>,res);
      ok:=false;
    end check perm;
   end perm;
    cur:=cur+16;
  end loop;
  begin
  zone z(128,1,stderror);
  open (z,4,string main(increase(i)),0);
  ifi:=0;
  outrec6(z,512);
  cleararray(z);
  startext:=2+8;
  exti:=startext//2+1;
  entrypoint:=486;
  z.ifi(1):=startext shift 12 + startext;
  z.ifi(2):=21 shift 12 <*general alarm*>;
  z.ifi(3):= 8 shift 12 <*end address expression*>;
  z.ifi(4):=13 shift 12 <*last used*>;
  z.ifi(5):= 3 shift 12 <*reserve*>;
  z.ifi(exti):= 0 <*no of externals*>;
  z.ifi(exti+1):=byteinit;
  cur:=0;
  byte:=startext+4-bval;
  for no:=1 step 1 until total do
  begin
    if rec.cur.init then
    begin
      byte:=byte+(if rec.cur.type<3 then 2 else 4);
      case rec.cur.type of
      begin
        z.byte.bval:=rec.cur.bval;
        z.byte.ival:=rec.cur.ival;
        z.byte.rval:=rec.cur.rval;
        z.byte.lval:=rec.cur.lval;
      end case;
     end initialvalues;
   cur:=cur+16;
   end loop;
  ifi:=byteinit+startext+4;
  systime(1,0,time);
  z.ifi(1):=systime(2,time,rt);
  z.ifi(2):=rt;
  ifi:=entrypoint;
  z.ifi(1):=2953212; <*al w1 -4*>
  z.ifi(2):=3657248; <*jl. w3 (-480) 8*>
  z.ifi(3):=2887674; <*al w0 -6*>
  z.ifi(4):=-2289662; <*ds w1 x1+2*>
  z.ifi(5):=3018756; <*al w2 x2+4*>
  z.ifi(6):=6213142;<*rs. w2 (-490) 6*>
  z.ifi(7):=3460626; <*jl.   (-494) 4*>
  z.ifi(8):=2887670; <*al w0 -10*>
  z.ifi(9):=3657228; <*jl. w3 (-500) 2*>
  z(127):=main(1);
  z(128):=main(2);
close(z,true);
cleararray(tail);
tail(1):=1;
tail(6):=1 shift 23+entrypoint;
tail(7):=1 shift 18;
tail(8):=0;
tail(9):=4 shift 12 + startext;
tail(10):=1 shift 12 + totbyte;
res:=changetail(main,tail);
if res<>0 then
begin
 i:=1;
 write(out,"nl",1,"*",2,<:changetail :>,string main(increase(i)),<: , result :>);
 ok:=false;
end changetail not ok;
end initialize segment;
      end set catalog entries;
end rec;
end;
(if warning.no
(head 1
xzw=stdvar
)
if warning.yes
skip 42.1
)
begin
integer poi=25,kqp=-99,aew;
boolean b,c,d=9.999;
real a;
end;
;*
mode list.no
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦809220910⟧ TextFile

Derivation

TextFile
