⟦ed2f4111b⟧

TextFile

tramos trim 82.04.15
Anders Lindgård
:1: trim variables
algol list.on;
integer no_of_terminals,max_children,cur_children,
        child_base_address,childrencreated,termdisconnect,
        oscommunication,osparentmess,
        length_user_cat_entry,
        length_user_cat_entry0,size_user_cat,
        user_cat_users,
        con_desc_size,
        no_of_drums,no_of_discs,no_of_bs,
        core_block_size,no_of_core_blocks,
        first_user_core,
        reader,punch,console1,console2,firstmt,lastmt,firstterminal,
        lastterminal,lastdevice,
        sysconpda,
        ownbuf,ownarea,owninternal,
        freebuf,freearea,freeinternal,
        user_cat_lower,user_cat_upper,
        cat_sem,z_sem;
integer field base_ref;
integer array field cat_base_ref,std_base_ref,max_base_ref,
                    core_address_ref,own_ref,
        first_bs_ref,size_bs_ref;
long field run_time_ref,start_time_ref;
integer field buf_area_ref,int_func_ref,parent_ref;
boolean field state_ref;
integer bit_0,bit_batch,bit_abs_size,bit_std_base,
        bit_evening,bit_maxclaim,bit_auto,bit_waiting,
        bit_c1,bit_priv,tw_mask; 
boolean bit_mess,bit_answer,bit_wait,
        bit_run ,bit_stop  ,bit_start,
        bit_proc,bit_not_run,mon_list,mon_change;
integer std_buf,std_area,std_int,std_func,std_size,
        std_temp_entries,
        std_entries,std_segm_disc,std_segm_disc1,
        std_entry_disc,std_entry_disc1;
integer std_max_buf,std_max_area,std_max_int,std_max_size,
        std_max_entries,std_max_segm_disc,std_max_segm_disc1,
        std_max_entry_disc,std_max_entry_disc1,
        own_entries,own_entry_disc,own_segm_disc,
        own_entry_disc1,own_segm_disc1;
long array drum_name,std_disc_name,std_disc1_name,
     user_cat_name,own_drum,own_disc,own_disc1,
     std_program,
     own_name,name1,name(1:3);
long array field laf;
integer array field iaf;
real array field raf;
integer i,j,k;
integer field con_access,con_prio_and_commands,
     con_first_address,con_top_address,con_buf_and_area,
     con_job_id,
     con_int_and_func,con_mode,
     con_lower_max,con_upper_max,con_lower_std,con_upper_std,
     con_size,con_lower_user,con_upper_user,con_projno,
     con_usercat_no,con_job_state,
     con_term_pda,
     con_cur_child,con_cur_child_pda,
     con_term_no,con_ref,con_proc_in,con_proc_out,
     con_job;
integer array field cur_con_desc,con_first_bs,fi;
long array field con_proc_name,con_program,
  con_des_term,
  con_in_name,con_out_name,con_term_name,con_job_name;
integer maxpmess,maxmess;
boolean array testop(1:12);
long array sysconsole,logconsole,monitorconsole(1:3);
integer array tail(1:10);
long array field doc;
array field f;
boolean lock;
algol list.off;
algol copy.tmonpr;
:2: trimming
algol list.on;
lock:=true;
bit_0       :=(1 shift 0);
bit_batch   :=(1 shift 1);
bit_abs_size:=(1 shift 2);
bit_std_base:=(1 shift 3);
bit_evening :=(1 shift 4);
bit_maxclaim:=(1 shift 5);
bit_auto    :=(1 shift 6);
bit_waiting :=(1 shift 7);
bit_c1      :=(1 shift 8);
bit_priv    :=(1 shift 9);
twmask:=-1; <*mask for typewriters in call of open*>
<*bits for process state*>
bit_mess   :=false add (1 shift 0);
bit_answer :=false add (1 shift 1);
bit_wait   :=false add (1 shift 2);
bit_run    :=false add (1 shift 3);
bit_stop   :=false add (1 shift 4);
bit_start  :=false add (1 shift 5);
bit_proc   :=false add (1 shift 6);
bit_not_run:=false add (1 shift 7);
state_ref   :=12; <*process state*>
buf_area_ref:=28;
int_func_ref:=30;
parent_ref:=52;
std_base_ref:=76;
max_base_ref:=72;
cat_base_ref:=68;
core_address_ref:=22;
start_time_ref:=60+2;
run_time_ref:=56+2;
base_ref:=100; <*base register*>
firstbs_ref:=86;
size_bs_ref:=18;
i:=0;
i:=con_access:=i+2;
i:=con_prio_and_commands:=i+2;
i:=con_proc_name:=i;
i:=con_first_address:=i+2+8;
i:=con_top_address:=i+2;
i:=con_buf_and_area:=i+2;
i:=con_int_and_func:=i+2;
i:=con_mode:=i+2;
i:=con_lower_max:=i+2;
i:=con_upper_max:=i+2;
i:=con_lower_std:=i+2;
i:=con_upper_std:=i+2;
i:=con_size:=i+2;
i:=con_program:=i;
i:=con_lower_user:=i+2+8;
i:=con_upper_user:=i+2;
i:=con_projno:=i+2;
i:=con_user_cat_no:=i+2;
i:=con_in_name:=i;
i:=con_out_name:=i+8;
i:=con_term_name:=i+8;
i:=con_jobstate:=i+10;
i:=con_job_id:=i+2;
con_first_bs:=con_desc_size:=i+10;
doc:=2;
fi:=f:=0; readsfp(<:c:>,logconsole.f,<:c:>);
for i:=1 step 1 until 12 do testop(i):=false;
<*+2*>
readbfp(<:testinit:>,testop(1),false);
readbfp(<:testcreate:>,testop(2),false);
readbfp(<:verify:>,testop(3),false);
readbfp(<:testusc:>,testop(4),false);
readbfp(<:testcom:>,testop(5),false);
readbfp(<:testerror:>,testop(6),false);
readbfp(<:testb:>,testop(7),false);
readbfp(<:testsub:>,testop(8),false);
readbfp(<:testjob:>,testop(9),false);
readbfp(<:testprim:>,testop(10),false);
readbfp(<:testq:>,testop(11),false);
if readbfp(<:testall:>,true,true) then
begin
  for i:=1 step 1 until 5,7 step 1 until 11 do testop(i):=true;
end;
<*-2*>
connectlso;
for i:=1 step 1 until 11 do
begin
  if testop(i) then write(out,"nl",1,<:*test :>,case i of (
   <:init:>,<:create:>,<:verify:>,<:usercat:>,
   <:communication:>,<:error:>,<:batch:>,<:submit:>,
   <:job:>,<:primary in:>,<:queue selection:>));
end;
outendcur(10);
readsfp(<:cat:>,usercatname.f,<:osusercat:>);
std_program(1):=long <:fp:>;
std_program(2):=
sysconsole(2):=logconsole(2):=monitorconsole(2):=
drumname(2):=stddiscname(2):=stddisc1name(2):=0;
curchildren:=0;
maxmess:=5;
maxpmess:=5;
console1:=2;
ownbuf:=2;
ownarea:=2;
owninternal:=1;
child_base_address:=128*1024;
algol list.on copy.tramoption;
ownbuf:=ownbuf+noofterminals;
readifp(<:children:>,maxchildren,maxchildren);
readifp(<:blocks:>,noofcoreblocks,noofcoreblocks);
if maxchildren<noofcoreblocks then maxchildren:=noofcoreblocks;
readifp(<:size:>,coreblocksize,coreblocksize);
readifp(<:terminals:>,no_of_terminals,no_of_terminals);
i:=lookupentry(logconsole,tail);
if i<>0 then alarm("nl",1,logconsole,<: does not exist:>,i);
for i:=1,2 do logconsole(i):=tail.doc(i);
write(out,<:log console is :>,logconsole);
if readsfp(<:monitor:>,name.f,<::>) then
   readsfp(<:monitor:>,monitorconsole.f,<::>);
write(out,"nl",1,<:monitor console :>,monitorconsole);
name(1):=0;
set_cat_base(name,usercatlower,usercatupper);
i:=connectcuri(usercatname);
if i<>0 then alarm("*",3,usercatname,<: connect error :>,i);
setposition(in,0,0);
inrec6(in,512);
length_user_cat_entry:=in.fi(2);
length_user_cat_entry0:=in.fi(3);
size_user_cat:=in.fi(4);
user_cat_users:=in.fi(5);
<*+2*>
if testop(1) then
begin
  write(out,"nl",1,<:length user cat entry   :>,in.fi(2),
            "nl",1,<:length user cat entry 0 :>,in.fi(3),
            "nl",1,<:size   user cat         :>,in.fi(4),
            "nl",1,<:user cat users          :>,in.fi(5));
  outendcur(10);
end;
<*-2*>
unstackcuri;
no_of_bs:=no_of_drums+no_of_discs;
if no_of_bs*12+14<>lengthusercatentry0 then alarm("nl",1,
    <:***number of bs devices inconsistent:>,no_of_bs);
i:=condescsize:=condescsize+size_bs_ref*(no_of_drums+no_of_discs);
<*+2*>
if testop(1) or testop(2) then write(out,"nl",1,<:user cat desc:>,i);
<*-2*>
i:=con_proc_in:=i+4;
i:=con_proc_out:=i+2;
i:=con_term_pda:=i+2;
i:=con_des_term:=i;
i:=con_job_name:=i+8;
i:=con_cur_child:=i+2+8;
i:=con_cur_child_pda:=i+2;
i:=con_term_no:=i+2;
i:=con_ref:=i+2;
i:=con_job:=i+2;
condescsize:=i;
<*+2*>
if testop(1) or testop(2) then write(out,"nl",1,condescsize,sizebsref);
<*-2*>
algol list.off;
:3: tramos trim: claiming basic
maxsem:=maxsem+3+maxchildren;
:4: tramos trim global variables and procedures
algol list.on;
integer logsem;
boolean free,stopsystem;
zone log(128,1,noerror),cat(768,2,stderror),z(128,1,stderror);
long array basestack(1:25);
long array field basep,maxbasep;
integer array con_pda_table(1:no_of_terminals),
   con_desc(1:no_of_terminals*con_desc_size//2),
   chartable(0:255),user_core(1:256*coreblocksize*noofcoreblocks),
   usercatbs(1:6*no_of_bs),ownbs,freebs(1:8*no_of_bs),
   perm_bs_claimed(1:usercatusers+10,1:noofbs,1:4),
   <*+10 to allow some updating of the usercatalog
     while running*>
   includelist(0:lastdevice),
   coretable(1:no_of_core_blocks+1,1:2),
   childtable(1:(maxchildren+1)*20);
boolean array bs_exist(1:no_of_bs+1);

<*use of childtable
1:  childpda
2:  destermpda
3:  state (1 created, 2 running, 3 stopped, 4 breaked, 5 swopped
4:  ref to descriptor
5:  jobname
6:   -
7:   -
8:   -
9:  batch or online (0=online, 1=batch)
10: first address
11: last  address
12: job number
13: segment number swop
14: segment number batch queue
15: buffer ref finis or break
16: childno
17: usercatno
18: process description in
20: access semaphore
19: process description out
*>
integer field ct_child_pda, ct_term_pda, ct_state,
              ct_ref, ct_batch, ct_first, ct_last,
              ct_jobno, ct_segm_swop, ct_segm_queue,
              ct_bufref,ct_childno,ct_usercatno,
              ct_procin,ct_procout,ct_sem;
integer state_created,state_running,state_stopped,
        state_breaked,state_swopped,state_removed,
        ct_size;
long array field ct_job_name;

procedure set_base(lower,upper);
value lower,upper; integer lower,upper;
begin
integer res;
long array name(1:2);
integer array field lu;
name(1):=0;
lu:=0;
if basep>=maxbasep then  alarm("nl",1,<:base pointer:>) else
begin
  res:=set_cat_base(name,lower,upper);
  if res>0 then alarm("nl",1,<:base interval:>,res,lower,upper,basep) else
  begin
    basestack.basep.lu(1):=lower;
    basestack.basep.lu(2):=upper;
    basep:=basep+4;
  end set cat base;
end no stack over flow;
end set base;

procedure resetbase;
begin
integer res;
long array name(1:2);
integer array field lu;
name(1):=0;
lu:=0;
if basep=0 then set_base_std else
begin
  basep:=basep-4;
  res:=set_cat_base(name,basestack.basep.lu(1),basestack.basep.lu(2));
  if res<>0 then alarm("nl",1,<:reset base :>,res,basep);
end basep>0;
end reset_base;

procedure set_base_std;
begin
setbase(core.ownref.stdbaseref(1),core.ownref.stdbaseref(2));
end;

procedure set_base_user_cat;
begin
setbase(usercatlower,usercatupper);
end;

procedure set_own_bs(doc,claim,owndoc,ownsegm,ownentry);
value ownsegm,ownentry; integer ownsegm,ownentry;
long array doc,owndoc;
integer array claim;
if doc(1)<>owndoc(1) or doc(2)<>owndoc(2) then
begin
integer i; for i:=1 step 1 until 8 do claim(i):=0;
end else
begin
integer i;
for i:=2 step 2 until 8 do
begin
  claim(i-1):=ownentry;
  claim(i  ):=ownsegm;
end
end setownbs;

integer procedure find_term(pda);
value pda; integer pda;
if pda=0 then findterm:=-1 else
begin
integer i,j;
  findterm:=i:=0;
  j:=no_of_terminals+1;
  for i:=i+1 while i<=no_of_terminals and j=no_of_terminals+1 do
     if con_pda_table(i)=pda then j:=findterm:=i;
  cur_con_desc:=(j-1)*con_desc_size;
end findterm;

integer procedure next_free_term(pda);
value pda; integer pda;
if pda=0 then next_free_term:=-1 else
begin
integer i,j,k;
long array field name;
i:=next_free_term:=0;
j:=no_of_terminals+1;
for i:=i+1 while i<=no_of_terminals and j=no_of_terminals+1 do
  if con_pda_table(i)=0 or con_pda_table(i)=pda then
    begin
      j:=nextfreeterm:=i;
      con_pda_table(j):=pda;
      cur_con_desc:=(j-1)*con_desc_size;
      condesc.curcondesc.contermpda:=pda;
      name:=pda+2;
      for k:=1,2 do condesc.curcondesc.condesterm(k):=core.name(k);
      condesc.curcondesc.contermno:=i;
  end found;
end next free term;

procedure noerror(z,s,b);
zone z; integer s,b;
begin
comment no action;
end;

procedure writelog(t1,i,t2);
string t1,t2; integer i;
begin
  wait(logsem);
  write(log,t1,i,"sp",1,t2,"nl",1);
  setposition(log,0,0);
  signal(logsem);
end;
algol list.off;
:5: tramtrim program
<*+2*>
if testop(7) then 
begin
  write(out,"nl",1,maxcoru,maxsem,corusize,
   maxsemch,maxop,maxnettoop,maxmessext);
end;
<*-2*>
algol list.on;
i:=ct_child_pda:=2;
i:=ct_term_pda:=i+2;
i:=ct_state:=i+2;
i:=ct_ref:=i+2;
i:=ct_job_name:=i;
i:=ct_batch:=i+10;
i:=ct_first:=i+2;
i:=ct_last:=i+2;
i:=ct_jobno:=i+2;
i:=ct_segm_swop:=i+2;
i:=ct_segm_queue:=i+2;
i:=ct_bufref:=i+2;
i:=ct_childno:=i+2;
i:=ct_usercatno:=i+2;
i:=ct_procin:=i+2;
i:=ct_procout:=i+2;
i:=ct_sem:=i+2;
ct_size:=i;
state_created:=1;
state_running:=2;
state_stopped:=3;
state_breaked:=4;
state_swopped:=5;
ownref:=owndescr;
laf:=2;
for i:=1,2 do ownname(i):=core.ownref.laf(i);
basep:=0;
maxbasep:=100;
setbasestd;
free:=false add (1 shift 1);
sysconpda:=console;
laf:=sysconpda+2;
for i:=1,2 do sysconsole(i):=core.laf(i);
stopsystem:= false add (1 shift 2);
verify:=testop(3);
catsem:=nextsem;
signal(catsem);
zsem:=nextsem;
signal(zsem);
logsem:=nextsem;
signal(logsem);
termdisconnect:=oscommunication:=osparentmess:=childrencreated:=0;
initalf(chartable);
for i:=1 step 1 until usercatusers do
for j:=1 step 1 until noofbs do
for k:=1,2 do perm_bs_claimed(i,j,k):=0;
j:=0;
for i:=reader,punch,console1,firstmt step 1 until lastmt,
   firstterminal step 1 until lastterminal do
begin
  if j<=lastdevice then includelist(j):=i;
  j:=j+1;
end include;
lastdevice:=j-1;
for i:=(maxchildren+1)*ct_size//2 step -1 until 1 do
    childtable(i):=0;
for i:=1 step 1 until maxchildren do
begin
  iaf:=(i-1)*ctsize;
  childtable.iaf.ct_childno:=i;
  childtable.iaf.ct_sem:=nextsem;
  signal(childtable.iaf.ct_sem);
end;
firstusercore:=firstaddr(usercore)-1;
for i:=1 step 1 until no_of_core_blocks+1 do
begin
  coretable(i,1):=firstusercore+(i-1)*coreblocksize*512;
  coretable(i,2):=0; <*free*>
<*+2*>
  if testop(2) then write(out,"nl",1,<:coreblock:>,i,
   if i<=noofcoreblocks then <: start :> else <: last  :>,
       coretable(i,1));
<*-2*>
end;
coretable(no_of_core_blocks+1,2):=100000;
<*+2*>
if testop(2) then outendcur(0);
<*-2*>
cleararray(condesc);
for i:=1 step 1 until no_of_terminals do con_pda_table(i):=0;
open(log,0,logconsole,tw_mask);
name(1):=0;
readusercat(name,usercatbs,testop(4),log);
i:=core.ownref.bufarearef;
freebuf:=(i shift (-12) extract 12)-ownbuf;
freearea:=(i extract 12)-ownarea;
i:=core.ownref.intfuncref;
freeinternal:=(i shift (-12) extract 12)-owninternal;
for i:=1 step 1 until noofbs do
begin
  iaf:=(i-1)*16;
  laf:=(i-1)*12;
  setownbs(usercatbs.laf,ownbs.iaf,owndrum,0,ownentries);
  setownbs(usercatbs.laf,ownbs.iaf,owndisc,ownsegmdisc,ownentrydisc);
  setownbs(usercatbs.laf,ownbs.iaf,owndisc1,ownsegmdisc1,ownentrydisc1);
end;
for i:=1 step 1 until noofbs do
begin
  iaf:=i*16-16;
  laf:=i*12-12;
  j:=lookup_bs_claims(ownname,usercatbs.laf,freebs.iaf);
  bs_exist(i):=j=0;
  ownbs.iaf(1):=ownbs.iaf(3):=0;
 if j>0 then write(out,"nl",1,true,12,usercatbs.laf,<: does not exist:>,j) else
  for j:=1 step 1 until 8 do freebs.iaf(j):=freebs.iaf(j)-ownbs.iaf(j);
end;
write(out,"nl",2,"#",12,<: TRAMOS started: name=:>,ownname,
   "sp",3,"#",12);
writecurtime(out);
write(out,"nl",1,
   <<      -ddd>,
   "nl",1,<:resource            free    total:>,
   "nl",1,<:internals     :>,freeinternal,freeinternal+owninternal,
   "nl",1,<:buffers       :>,freebuf,freebuf+ownbuf,
   "nl",1,<:areas         :>,freearea,freearea+ownarea,
   "nl",1,<:coreblocks    :>,noofcoreblocks,
   "nl",1,<:coreblocksize :>,coreblocksize);
<*+2*>
  if testop(1) then list_bs(ownname,out);
<*-2*>
  write(out,"nl",2,<:bs resources:>,
  "nl",1,true,11,<:doc:>);
  write(out,"sp",12,<:temp:>,"sp",12,"sp",12,<:perm:>);
  write(out,"nl",1,"sp",11);
  for i:=1,2 do write(out,<:______entry___:>,<:_____segm____:>);
  write(out,"nl",1,"sp",11);
  for i:=1 step 1 until 4 do write(out,<:___free__total:>);
  for i:=1 step 1 until noofbs do
  begin
    iaf:=(i-1)*16;
    laf:=(i-1)*12;
    write(out,"nl",1,true,11,usercatbs.laf);
    if -,bs_exist(i) then write(out,<:  ** does not exist:>) else
    for j:=1,2,7,8 do write(out,<< dddddd>,
       freebs.iaf(j),freebs.iaf(j)+ownbs.iaf(j));
  end for bs;
outendcur(10);
algol list.off;
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦ed2f4111b⟧ TextFile

Derivation

TextFile
