|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 223488 (0x36900)
Types: TextFile
Names: »tctxtb «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦f546e193b⟧
└─⟦this⟧ »tctxtb «
<****************************************************************************>
<* SW8110 Terminal Access System *>
<* Catalog and Operator Program 'tascat' *>
<* *>
<* Henning Godske 870105 *>
<* A/S Regnecentralen *>
<* *>
<* Compiler call :tc=algol connect.no fp.yes spill.no *>
<****************************************************************************>
begin
<****************************************************************************>
<* Vedligeholdelse af katalogerne, operatør kommunikation *>
<* og initialisering af systemet. *>
<* *>
<* Program skitse: *>
<* a) Læsning af intialiserings parametre fra init fil. *>
<* b) Åbning af test output filen. *>
<* c) Evt. oprettelse af nye katalogfiler ud fra catalog tekst fil *>
<* d) Synkronisering med Tas processen herunder overførsel af init *>
<* data til Tas. *>
<* e) Opstart af korutiner: 1) Katalog vedligeholdelse og modtagelse af *>
<* message fra Tas og bruger processer. *>
<* 2) Timecheck rutinen til evt. automatisk *>
<* udlogning af brugerer. *>
<* 3) Kontrol af afsendelse af tekster til *>
<* terminaler via tasterm. *>
<* 4) Operatør korutinerne. En for hver operatør *>
<* der skal kunne 'køre' samtidig, dog altid *>
<* en til brug for hovedkonsollen. *>
<* f) Start af kerne. *>
<* Besvarelse af message fra tasterm-processen. *>
<* Besvarelse af message fra bruger-processer. *>
<* Opstart af operatør rutiner. *>
<****************************************************************************>
<****************************************************************************>
<* Revision history: *>
<* *>
<* 87.02.01 tascat release 1.0 *>
<****************************************************************************>
<*******************************>
<* Globale variable for tascat *>
<*******************************>
integer reld; <* Release datoer *>
integer relt;
integer initver;
integer tastermverd;
integer tastermvert;
integer array init_file_name(1:4); <* Navnet på init filen *>
integer number_of_opera; <* Antal operatør korutiner Max. 5 *>
integer array opera_terms(4:8,1:2); <* Beskrivelse af opr. rutiner *>
integer language; <* Sprog benyttet ved bruger udskrift*>
integer cps; <* Initialiserings parametre *>
integer cls;
integer max_sessions;
integer max_sysmenu;
integer max_terminals;
integer corebufs;
integer mclprogs;
integer termtypes;
integer max_users;
boolean system_stop; <* Systemet er ved at stoppe *>
integer login_stat; <* Aktuel login status for terminaler*>
integer fp_maxterms; <* Maxterms angivet ved kald *>
integer max_terms; <* Max. terminaler inlogget *>
integer terms; <* Aktuel antal terminaler inlogget *>
integer users; <* Aktuel antal brugerer inlogget *>
integer sessions; <* Aktuel antal sessioner *>
integer max_text_count; <* Max antal udestående 'send text' *>
integer max_user_block; <* Max. antal user block før alarm *>
integer max_term_block; <* Max. antal term block før alarm *>
integer array text_buf_reserved(1:3); <* Text buffer reserveret *>
boolean timecheck_stat; <* Status for timecheck *>
integer array log_txt(0:27); <* Logout tekst for timecheck *>
integer array stop_txt(0:27);
integer log_time; <* Logout vente tid *>
integer array host_id(0:27); <* host navn signon tekst *>
integer array signon_text(0:68); <* operator signon tekst *>
zone head_term_zone(14,1,konsol_error);<* Hovedkonsol output zone *>
integer array head_term_name(1:4); <* Hovedkonsollens navn *>
integer head_term_pda; <* Hovedkonsol pda *>
integer tasterm_pda; <* Tasterm processens pda *>
integer array tasterm_name(1:4); <* Tasterm processens navn *>
integer own_size; <* Egen proces størrelse *>
integer own_pda; <* Egen proces pda *>
integer array own_name(1:4); <* Eget proces navn *>
integer array prog_name(1:4); <* Programmets navn *>
integer struc_size; <* Antal blokke i login_struc *>
integer user_list; <* Peger til user kæden i login_struc*>
integer free_list; <* Peger til free kæden i login_struc*>
boolean new_catalog; <* True = nyt katalog angivet *>
integer array cattxt_name(1:4); <* Navnet på katalog tekst filen *>
integer array cat_doc(1:4); <* Katalogernes dokument navn *>
zone cat_file(128,1,stderror); <* Zone til læsning af katalog tekst *>
integer array sys_bases(1:2); <* Base par for system baser *>
integer array cmcl_bases(1:2); <* Base par for cmcl filer *>
zone usercat(128,1,std_error); <* Zone til user kataloget *>
zone termcat(128,1,std_error); <* Zone til terminal kataloget *>
zone typecat(128,1,std_error); <* Zone til terminaltype kataloget *>
integer usercat_size; <* Antal segmenter i user kataloget *>
integer termcat_size; <* Antal segmenter i terminal kat. *>
integer typecat_size; <* Antal segmenter i terminaltype kat*>
integer array field user_entry; <* Aktuelt entry i user kat. segment *>
integer array field term_entry; <* Aktuelt entry i term kat. segment *>
integer array field type_entry; <* Aktuelt entry i type kat. segment *>
integer user_seg; <* Aktuelt seg. i zone fra user kat. *>
integer term_seg; <* aktuelt seg. i zone fra term kat. *>
integer user_entry_length; <* Længden af et entry i user kat. *>
integer term_entry_length; <* Længden af et entry i term kat. *>
integer type_entry_length; <* Længden af et entry i type kat. *>
integer array usercat_name(1:4); <* Bruger katalogets fil navn *>
integer array termcat_name(1:4); <* Terminal katalogets fil navn *>
integer array typecat_name(1:4); <* Terminaltype katalogets fil navn *>
long array opr_keywords(0:20); <* Operatør keywords i tascat *>
integer opr_num_keys; <* Antal keywords defineret *>
long array cat_keywords(0:60); <* Katalog keywords i tascat *>
integer cat_num_keys; <* Antal keywords defineret *>
long array init_keywords(0:50); <* Init keywords i tascat *>
integer init_num_keys; <* Antal keywords defineret *>
integer array char_table(0:255); <* Tegn input tabel *>
zone copy_buf(128,1,stderror); <* Buffer til general copy *>
boolean killed; <* True = stoppet ved kill *>
boolean test_on; <* Status for test output *>
boolean sys_start; <* Korutine system startet *>
zone test_out(128,1,test_out_error);<* Zone til output af test records *>
integer array testout_name(1:4); <* Navnet på testout filen *>
integer trace_type; <* Typen af den trace der foretages *>
integer test_select; <* Typen af test fra aktiviteter *>
integer run_alarm_cause; <* Cause ved alarm (trap) *>
integer run_alarm_pos; <* procedure nr ved alarm *>
integer free_sem; <* Semafor -4 *>
integer delay_sem; <* Semafor -3 *>
integer wait_answer_pool; <* Semafor -2 *>
integer wait_message; <* Semafor -1 *>
integer wait_message_pool; <* Semafor 0 *>
integer message_buf_pool; <* Semafor 1 *>
integer time_sem; <* Semafor 2 *>
integer struc_sema; <* Semafor 3 *>
integer text_write_sem; <* Semafor 4 *>
real t_n_l,miss_par,u_n_l,ill_val, <* konstant tekster *>
ill_par,long_text,ill_time, <* *>
c_p ;
integer array answer(1:9); <* Answer til modtaget mess *>
integer array mess(1:1); <* Reference til message *>
integer field sender_pda; <* Sender pda i mess *>
integer field reciever_pda; <* Modtager pda i mess *>
integer field buf_addr; <* Buffer adresse på mess *>
integer array field mess_array; <* Message *>
long array field laf; <* work *>
integer array field iaf; <* work *>
boolean array field baf; <* work *>
integer i; <* work *>
<*********************************************************>
<* Procedure til afhjælpelse af fejl i externe procedure *>
<*********************************************************>
integer procedure put_ch(dest,pos,char,rep);
long array dest;
integer pos,char,rep;
begin
trap(local);
put_ch:=putchar(dest,pos,char,rep);
if false then
local: put_ch:=-1;
end;
integer procedure put_txt(dest,pos,text,length);
long array dest,text;
integer pos,length;
begin
trap(local);
put_txt:=puttext(dest,pos,text,length);
if false then
local: put_txt:=-1;
end;
<*******************************************>
<* Generelle hjælpe procedure til TASCAT *>
<*******************************************>
procedure claim(words);
<* 1 *>
<*------------------------------------------------------*>
<* Reserver et antal ord på stakken *>
<* *>
<* words (call) : Antal ord der reserveres på stakken *>
<*------------------------------------------------------*>
integer words;
begin
integer array x(1:words);
end;
integer procedure send_mess(z,mess);
<* 4 *>
<*--------------------------------------------------------------------*>
<* z (call and return) : Zone åbnet med navnet på den proces der skal *>
<* sendes til. Share 1 benyttes til message og *>
<* sharestate skal være 0 el. 1. Ved retur er *>
<* sharestate lig message buffer adresse. *>
<* mess (call) : Integer array(1:8) indeholdede message *>
<* Return : Message buffer adresse *>
<* Der udføres TRAP hvis message buffer claim *>
<* er overskredet *>
<*--------------------------------------------------------------------*>
zone z;
integer array mess;
begin
integer array share(1:12);
integer buf_addr,i;
trap(alarm);
getshare6(z,share,1);
for i:=1 step 1 until 8 do
share(i+3):=mess(i);
setshare6(z,share,1);
buf_addr:=monitor(16,z,1,share <* dummy ia *>);
if buf_addr=0 then
write_message(4,1,false,<:claims exceeded:>);
send_mess:=buf_addr;
if false then
alarm: disable traped(4);
end;
boolean procedure wait_ans(z,mess_addr,time,wait_sem,regret);
<* 5 *>
<*---------------------------------------------------------------------*>
<* z (call and return) : Zone der blev benyttet ved send_mess *>
<* Ved retur er sharestate lig 0 *>
<* mess_addr (call) : Adressen på message buffer fra send_mess. *>
<* time (call) : Tiden der skal ventes inden message fortrydes *>
<* sættes tiden 0 ventes uendeligt *>
<* wait_sem (call) : Semafor der benyttes til at vente på answer *>
<* regret (call) : True = regret message ved time-out *>
<* Return : True= answer modtaget; False=Time out *>
<* Ved time out fortrydes den sendte message *>
<*---------------------------------------------------------------------*>
zone z;
integer mess_addr,time,wait_sem;
boolean regret;
begin
integer array answer(1:1),ia(1:1);
trap(alarm);
initref(answer);
wait_select:=6;
wait(message_buf_pool,answer);
answer(2):=mess_addr;
answer(3):=wait_sem;
signal(wait_answer_pool,answer);
wait_ans:=true;
wait_time:=time;
if wait(wait_sem,answer)=0 then
begin <* time out *>
wait_ans:=false;
wait_select:=mess_addr;
wait(wait_answer_pool,answer);
if regret then
monitor(82<* regret message *>,z,1,ia<* dummy *>);
end;
answer(2):=6;
signal(message_buf_pool,answer);
if false then
alarm: disable traped(5);
end;
procedure write_message(from,result,cont,mess);
<* 6 *>
<*------------------------------------------------------------*>
<* Udskriver meddelelse på hovedkonsol og danner test-record *>
<* *>
<* from (call) : Angiver hvorfra meddelensen kommer *>
<* result (call) : Angiver årsagen eller resultat til mes. *>
<* cont (call) : True= returner efter udskrift *>
<* False= Afbryd kørslen med trap(from) *>
<* mess (call) : Selve meddelelsen *>
<*------------------------------------------------------------*>
integer from,result;
boolean cont;
string mess;
begin
real time;
trap(alarm);
if sys_start and test_on then
begin
prepare_test;
test_out.iaf(1):=1030; <* message *>
test_out.iaf(2):=abs from;
test_out.iaf(3):=result;
end;
if (false add (trace_type shift (-1))) or from>=0 then
begin
open(head_term_zone,8,head_term_name,1 shift 9);
write(head_term_zone,<:message Tas : :>);
outdate(head_term_zone,round systime(5,0,time));
write(head_term_zone,<: :>);
outdate(head_term_zone,round time);
write(head_term_zone,<: :>,true,30,mess,<<-dddddd>,
<: :>,result,
<:.:>,<<zddddd>,abs from,<:<10>:>);
close(head_term_zone,false);
end;
if -,cont then
trap(from);
if false then
alarm: disable traped(6);
end;
procedure traped(procedure_nr);
<* 7 *>
<*--------------------------------------------------------------------*>
<* procedure_nr (call) : Nummeret på den procedure hvori kaldet står *>
<* *>
<* Der dannes test records til beskrivelse af *>
<* årsagen til trap'et. Der efter fortsætte til *>
<* de næste ydre trap niveau. På yderste niveau *>
<* afbrydes programmet *>
<*--------------------------------------------------------------------*>
value procedure_nr;
integer procedure_nr;
begin
integer i,cause;
integer array ia(1:8);
trap(alarm);
cause:=alarmcause extract 24;
if run_alarm_pos=0 and cause<>-13 then
begin
run_alarm_cause:=cause;
run_alarm_pos:=procedure_nr;
end;
if cause=-9 and (alarmcause shift (-24))=8 then
killed:=true;
if sys_start and test_on then
begin
prepare_test;
test_out.iaf(2):=procedure_nr;
test_out.iaf(3):=alarmcause shift (-24) extract 24;
test_out.iaf(4):=cause;
if cause=-13 then
test_out.iaf(1):=1028 <* Cont *>
else
if cause=-11 then
begin <* Give up *>
test_out.iaf(1):=1026; <* give up 1 *>
test_out.iaf(5):=getalarm(ia);
prepare_test;
test_out.iaf(1):=1027; <* give up 2 *>
for i:=2 step 1 until 5 do
test_out.iaf(i):=ia(i+3);
end
else
test_out.iaf(1):=1025;<* Trap *>
end;
if false then
alarm: procedure_nr:=(alarmcause extract 24)-100;
trap(0);
trap(procedure_nr);
end;
procedure trace(p1,p2,p3,p4);
<* 8 *>
<*----------------------------------------------------------------------*>
<* p1 til p4 (call) : Integer parametre der skrives i trace test record *>
<*----------------------------------------------------------------------*>
integer p1,p2,p3,p4;
begin
if sys_start and test_on then
begin
prepare_test;
test_out.iaf(1):=1029; <* trace *>
test_out.iaf(2):=p1;
test_out.iaf(3):=p2;
test_out.iaf(4):=p3;
test_out.iaf(5):=p4;
end;
end;
procedure close_test_out;
<* 9 *>
<*---------------------------------------*>
<* Luk test_out filen hvis det er muligt *>
<*---------------------------------------*>
begin
if sys_start and test_on then
begin
write_message(-9,select_test,true,<:Test output stopped:>);
<* Udskriv stop record *>
prepare_test;
close(test_out,true);
end;
select_test:=0;
test_on:=false;
end;
procedure open_test(name);
<* 10 *>
<*----------------------------------------------------------------------*>
<* Åben test filen hvis det er muligt og tilladt. *>
<* *>
<* name (call) : Navnet på det dokument der skal benyttes som test out *>
<* *>
<*----------------------------------------------------------------------*>
integer array name;
begin
integer array tail(1:10);
integer i,stop_result;
trap(alarm);
stop_result:=0;
if test_on then
begin
set_cat_bases(sys_bases);
test_on:=false;
open(test_out,4,name,1 shift 18 <* end document *>);
if monitor(42<* lookup entry *>,test_out,0,tail)<>0 then
stop_result:=1
else
if tail(1)<2 then
stop_result:=2
else
begin
tail(6):=systime(7,0,0.0);
i:=monitor(44,test_out,0,tail);
i:=monitor(52,test_out,0,tail)+i;
i:=monitor(08,test_out,0,tail)+i;
if i<>0 then
stop_result:=3;
end;
if stop_result=0 then
begin
<* initialiser test_out segmenterne *>
outrec6(test_out,512);
for i:=1 step 1 until 128 do
test_out(i):=real <::>;
for i:=2 step 1 until tail(1) do
outrec6(test_out,512);
setposition(test_out,0,0);
write_message(-10,tail(1),true,<:Test output started:>);
test_on:=true;
end
else
begin
test_on:=false;
write_message(10,stop_result,true,<:Error in test out file:>);
end;
end;
if -,test_on then
close_test_out;
if false then
alarm: disable traped(10);
end;
procedure test_out_error(z,s,b);
<* 11 *>
<*-----------------------------------*>
<* blok procedure for test_out zonen *>
<*-----------------------------------*>
zone z;
integer s,b;
begin
integer array ia(1:20);
trap(alarm);
if false add (s shift (-18)) then
begin <* EOF Skift tilbage til segment 1 *>
getzone6(test_out,ia);
ia(9):=2;
setzone6(test_out,ia);
getshare6(test_out,ia,1);
ia(7):=1;
setshare6(test_out,ia,1);
monitor(16,test_out,1,ia);
check(test_out);
b:=512;
end
else
close_test_out;
if false then
alarm: disable traped(11);
end;
boolean procedure set_cat_bases(bases);
<* 12 *>
<*--------------------------------------*>
<* Sæt cat baserne til angivet base-par *>
<* *>
<* bases(1) : Nedre base værdi. *>
<* bases(2) : Øvre base værdi. *>
<* Return : True= baser sat *>
<* False= baser IKKE sat *>
<*--------------------------------------*>
integer array bases;
begin
zone this_proc(1,1,stderror);
trap(alarm);
open(this_proc,0,<::>,0);
set_cat_bases:=
monitor(72<* set catalog base *>,this_proc,0,bases)=0;
if false then
alarm: disable traped(12);
end;
integer procedure get_pda(name);
<* 13 *>
<*-----------------------------------------------------------------*>
<* Hent pda for angivet proces *>
<* *>
<* name (call) : Navnet på processen som pda skal findes for *>
<* Return : pda for proces hvis den findes ellers 0 *>
<*-----------------------------------------------------------------*>
integer array name;
begin
integer array ia(1:20);
integer i;
zone proc(1,1,stderror);
trap(open_trap);
getzone6(proc,ia);
for i:=1,2,3,4 do
ia(i+1):=name(i);
setzone6(proc,ia);
get_pda:=monitor(4,proc,0,ia);
if false then
open_trap: get_pda:=0;
end;
boolean procedure get_proc_name(pda,name);
<* 14 *>
<*---------------------------------------------------------------------*>
<* Hent navnet på processen udpeget af proces beskriver adressen i pda *>
<* *>
<* pda (call) : Proces beskriver adressen *>
<* name (ret) : Navn på proces i integer array name(1:4) *>
<* Return : True = navn fundet *>
<* False = navn IKKE fundet *>
<*---------------------------------------------------------------------*>
integer pda;
integer array name;
begin
integer array ia(1:20),bases(1:2);
integer lt,i;
boolean ok;
zone proc(1,1,stderror);
trap(alarm);
lt:=trapmode;
trapmode:=-1;
ok:=system(5,pda+2,name)=1;
trap(open_trap);
getzone6(proc,ia);
for i:=1,2,3,4 do
ia(i+1):=name(i);
setzone6(proc,ia);
ok:=ok and monitor(4,proc,0,ia)=pda;
if false then
open_trap: ok:=false;
get_proc_name:=ok;
if not ok then
name.laf(1):=long <:No connect:>;
trapmode:=lt;
if false then
alarm: disable traped(14);
end;
integer procedure cur_time;
<* 15 *>
<*-------------------------------------------*>
<* Find den aktuelle tid *>
<* *>
<* Return : Aktuelle tid i hel time (0-23) *>
<*-------------------------------------------*>
begin
real time;
trap(alarm);
systime(5,0,time);
cur_time:=round(time)//10000;
if false then
alarm: disable traped(15);
end;
integer procedure date(text);
<* 16 *>
<*-----------------------------------------------------------------------*>
<* Dan dags dato som tekst med følgende format: *>
<* <dags navn> d.<dag>/<måned> 19<år> <time>.<minut> *>
<* *>
<* text (ret) : Long array indeholdende dags dato som tekst *>
<* Array'ets første 6 longs benyttes (36 tegn) *>
<* Return : Antal tegn sat i text *>
<*-----------------------------------------------------------------------*>
long array text;
begin
real time,year,hour;
integer day,pos;
trap(alarm);
systime(1,0,time);
day:=(round((time/86400)-0.5) mod 7)+1;
pos:=1;
text(5):=text(6):=0;
case language of
begin
put_text(text,pos,case day of (<:Mandag :>,<:Tirsdag:>,
<:Onsdag :>,<:Torsdag:>,
<:Fredag :>,<:Lørdag :>,
<:Søndag :>) ,7);
put_text(text,pos,case day of (<:Monday :>,<:Tuesday :>,
<:Wedensday:>,<:Thursday :>,
<:Friday :>,<:Saturday :>,
<:Sunday :>) ,9);
end;
put_text(text,pos,<: d.:>,3);
year:=systime(4,time,hour);
put_number(text,pos,<<zd>,round(year) mod 100);
put_text(text,pos,<:/:>,1);
put_number(text,pos,<<zd >,(round(year) mod 10000)//100);
put_text(text,pos,<:19:>,2);
put_number(text,pos,<<zd >,round(year)//10000);
put_number(text,pos,<<dd>,round(hour)//10000);
put_text(text,pos,<:.:>,1);
put_number(text,pos,<<zd>,(round(hour) mod 10000)//100);
date:=pos-1;
if false then
alarm: disable traped(16);
end;
integer procedure data_to_copy_buf(words,mess_addr,answer);
<* 17 *>
<*------------------------------------------------------------------------*>
<* Kopier data fra anden proces til copy_buf. *>
<* *>
<* words (call) : Antal ord der kopieres (max. 256) *>
<* mess_addr (call) : Adressen på message der udpeger område der skal *>
<* kopieres fra (2 og 3 ord i message: first,last) *>
<* answer (ret) : Resultatet af kopieringen: *>
<* answer(1) : Udefineret. *>
<* answer(2) : Antal HW overført *>
<* answer(3) : Antal tegn overført *>
<* answer(9) : Hvis returværdi lig 3 så 3 ellers 1 *>
<* Return : 0 = Data kopieret til copy_buf. *>
<* 2 = Anden proces stoppet. *>
<* 3 = Fejl i kopieringen m.m *>
<*------------------------------------------------------------------------*>
integer mess_addr,words;
integer array answer;
begin
trap(alarm);
answer(1):=2 shift 1 + 0;
answer(2):=2;
answer(3):=2*words;
answer(4):=0;
data_to_copy_buf:=monitor(84,copy_buf,mess_addr,answer);
answer(3):=3*(answer(2)//2);
if false then
begin
alarm: answer(9):=3;
data_to_copy_buf:=3;
end;
end;
integer procedure data_from_copy_buf(words,mess_addr,answer);
<* 18 *>
<*------------------------------------------------------------------------*>
<* Kopier data til anden proces fra copy_buf. *>
<* *>
<* words (call) : Antal ord der kopieres (max. 256) *>
<* mess_addr (call) : Adressen på message der udpeger område der skal *>
<* kopieres til (2 og 3 ord i message: first,last) *>
<* answer (ret) : Resultatet af kopieringen: *>
<* answer(1) : Udefineret. *>
<* answer(2) : Antal HW overført *>
<* answer(3) : Antal tegn overført *>
<* answer(9) : Hvis returværdi lig 3 så 3 ellers 1 *>
<* Return : 0 = Data kopieret til anden proces *>
<* 2 = Anden proces stoppet. *>
<* 3 = Fejl i kopieringen m.m *>
<*------------------------------------------------------------------------*>
integer mess_addr,words;
integer array answer;
begin
trap(alarm);
answer(1):=2 shift 1 + 1;
answer(2):=2;
answer(3):=2*words;
answer(4):=0;
data_from_copy_buf:=monitor(84,copy_buf,mess_addr,answer);
answer(3):=3*(answer(2)//2);
if false then
begin
alarm: answer(9):=3;
data_from_copy_buf:=3;
end;
end;
procedure init_sem;
<* 19 *>
<*----------------------------------------------------*>
<* initialiser semafor navnene med nummer *>
<* Semafor 5 og frem benyttes af operatør korutinerne *>
<*----------------------------------------------------*>
begin
free_sem:=-4; <* Semafor -4 *>
delay_sem:=-3; <* Semafor -3 *>
wait_answer_pool:=-2; <* Semafor -2 *>
wait_message:=-1; <* Semafor -1 *>
wait_message_pool:=0; <* Semafor 0 *>
message_buf_pool:=1; <* Semafor 1 *>
time_sem:=2; <* Semafor 2 *>
struc_sema:=3; <* Semafor 3 *>
text_write_sem:=4; <* Semafor 4 *>
end;
procedure konsol_error(z,s,b);
<* 20 *>
<*----------------------------------------------------*>
<* Block procedure for hoved_konsollen *>
<* Ignorer alle error og give up *>
<*----------------------------------------------------*>
zone z;
integer s,b;
begin
end;
procedure init_bases;
<* 22 *>
<*----------------------------------------------------*>
<* Check om mcl baser og sys baser kan benyttes *>
<* Sæt catalog baser til sys_bases *>
<*----------------------------------------------------*>
begin
integer array bases(1:6);
integer b;
trap(alarm);
own_pda:=system(6,0,own_name.laf);
if system(5,own_pda+68,bases)<>1 then
trap(2);
b:=0;
if -,set_cat_bases(cmcl_bases) then
b:=1;
if -,set_cat_bases(sys_bases) then
b:=2;
if b<>0 then
write_message(22,b,false,<:Illegal base parameter:>);
if false then
alarm: disable traped(22);
end;
procedure keywords_init;
<* 23 *>
<*-------------------------------------------*>
<* initialiser keywords *>
<*-------------------------------------------*>
begin
integer i;
opr_num_keys:=20;
for i:=1 step 1 until opr_num_keys do
begin
opr_keywords(i):=0;
opr_keywords(i):= long (case i of
<* 1 *> (<:finis:>,<:displ:>,<:messa:>,<:remov:>,<:set:>,
<* 6 *> <:start:>,<:stop:>,<:termi:>,<:user:>,<:on:>,
<* 11 *> <:off:>,<:all:>,<:signo:>,<:sessi:>,<:syste:>,
<* 16 *> <:login:>,<:timec:>,<:users:>,<:resou:>,<:check:>));
end;
cat_num_keys:=50;
for i:=1 step 1 until cat_num_keys do
begin
cat_keywords(i):=0;
cat_keywords(i):= long (case i of
<* 1 *> (<:end:>,<:size:>,<:user:>,<:passw:>,<:cpass:>,
<* 6 *> <:monda:>,<:tuesd:>,<:wedne:>,<:thurs:>,<:frida:>,
<* 11 *> <:satur:>,<:sunda:>,<:block:>,<:sessi:>,<:privi:>,
<* 16 *> <:mclna:>,<:base:>,<:group:>,<:mclte:>,<:freet:>,
<* 21 *> <:termi:>,<:termt:>,<:termg:>,<:bypas:>,<:type:>,
<* 26 *> <:scree:>,<:colum:>,<:lines:>,<:sbup:>,<:sbdow:>,
<* 31 *> <:sblef:>,<:sbrig:>,<:sbhom:>,<:sbdel:>,<:ceod:>,
<* 36 *> <:ceol:>,<:invon:>,<:invof:>,<:hlon:>,<:hloff:>,
<* 41 *> <:delet:>,<:inser:>,<:curso:>,<:up:>,<:down:>,
<* 46 *> <:left:>,<:right:>,<:home:>,<:xxxxx:>,<:init:>));
end;
init_num_keys:=46;
for i:=1 step 1 until init_num_keys do
begin
init_keywords(i):=0;
init_keywords(i):= long (case i of
<* 1 *> (<:true:>,<:false:>,<:on:>,<:off:>,<:start:>,
<* 6 *> <:stop:>,<:catal:>,<:termi:>,<:init:>,<:catdo:>,
<* 11 *> <:userc:>,<:termc:>,<:typec:>,<:ctnam:>,<:spool:>,
<* 16 *> <:ttnam:>,<:temna:>,<:login:>,<:userb:>,<:termb:>,
<* 21 *> <:timec:>,<:logti:>,<:mclba:>,<:sysba:>,<:cpool:>,
<* 26 *> <:clink:>,<:maxse:>,<:maxte:>,<:maxsy:>,<:coreb:>,
<* 31 *> <:mclpr:>,<:maxty:>,<:tbufs:>,<:spseg:>,<:maxus:>,
<* 36 *> <:maxop:>,<:timeo:>,<:hosti:>,<:signo:>,<:timet:>,
<* 41 *> <:stopt:>,<:catte:>,<:trap:>,<:termt:>,<:initv:>,
<* 46 *> <:reser:>));
end;
end;
integer procedure find_keyword_value(keyword,tabel);
<* 24 *>
<*----------------------------------------------------------------*>
<* Find 'token' værdien for det angivne keyword *>
<* *>
<* keyword (call) : Long indeholdende op til 5 tegn af keyword *>
<* tabel (call) : 1=opr 2=cat 3=init keword-tabel *>
<* Return : Værdien for det angivne keyword eller *>
<* 0 hvis keyword er ukendt *>
<*----------------------------------------------------------------*>
long keyword;
integer tabel;
begin
integer i;
trap(alarm);
i:=case tabel of (opr_num_keys,cat_num_keys,init_num_keys)+1;
keyword:=(keyword shift (-8)) shift 8;
case tabel of
begin
for i:=i-1 while (not (keyword=opr_keywords(i))
and (i<>0)) do; <* nothing *>
for i:=i-1 while (not (keyword=cat_keywords(i))
and (i<>0)) do; <* nothing *>
for i:=i-1 while (not (keyword=init_keywords(i))
and (i<>0)) do; <* nothing *>
end;
find_keyword_value:=i;
if false then
alarm: disable traped(24);
end;
procedure init_opera_terms;
<* 25 *>
<*----------------------------------------------------*>
<* init opera_terms array'et *>
<*----------------------------------------------------*>
begin
integer i;
trap(alarm);
for i:=4 step 1 until number_of_opera+3 do
begin
opera_terms(i,1):=0;
opera_terms(i,2):=i+2
end;
if false then
alarm: disable traped(25);
end;
procedure next_line(z,z_line_nr);
<* 26 *>
<*-------------------------------------------------------*>
<* Læs til starten af næste linie i fil *>
<* Linier der starter med ; eller er blanke overspringes *>
<* Linie tæller optælles med 1 for hver linie *>
<* *>
<* z (call) : Fil der læses fra. *>
<* z_line_nr (call and ret) : Linie tæller for fil, *>
<*-------------------------------------------------------*>
zone z;
integer z_line_nr;
begin
integer i;
trap(alarm);
repeatchar(z);
readchar(z,i);
while (i<>'nl') and (i<>'em') do
readchar(z,i);
z_line_nr:=z_line_nr+1;
readchar(z,i);
if i<>'em' then
begin
while i=' ' do
readchar(z,i);
if i='nl' or i='em' or i=';' then
begin
next_line(z,z_line_nr);
readchar(z,i);
end;
end;
repeatchar(z);
if false then
alarm: disable traped(26);
end;
integer procedure read_start_key(z,t,z_line_nr);
<* 27 *>
<*-------------------------------------------------------------------*>
<* Find værdien af nøgleordet i starten af tekst linien i fil *>
<* *>
<* z (call) : Filen der læses fra *>
<* t (call) : Keyword tabel. 1=opr 2=cat 3=init *>
<* Return : -1 = Sidste linie i fil er læst *>
<* 0 = Nøgleord er ikke fundet *>
<* >0 = Nøgleordets værdi *>
<*-------------------------------------------------------------------*>
zone z;
integer t,z_line_nr;
begin
long array key(1:5);
integer i;
trap(alarm);
readchar(z,i);
if i<>'em' then
begin
while i=' ' do
readchar(z,i);
if i='nl' or i='em' or i=';' then
begin
next_line(z,z_line_nr);
readchar(z,i);
end;
end;
repeatchar(z);
read_start_key:=if readstring(z,key,1)>0 then
find_keyword_value(key(1),t)
else
-1;
repeatchar(z);
if false then
alarm: disable traped(27);
end;
integer procedure read_text(z,text,max);
<* 28 *>
<*---------------------------------------------------------------------*>
<* Læs tekst fra z filen til text til slutning af linie eller til *>
<* maximalt antal tegn læst. Indledende blanktegn overspringes. *>
<* *>
<* z (call) : File der læses fra *>
<* text (ret) : Den læste tekst *>
<* max (call) : Det maximale antal tegn der læses *>
<* Return : Antal tegn læst til text *>
<* *>
<* NB. Der læses altid et tegn mere fra z *>
<*---------------------------------------------------------------------*>
zone z;
integer max;
long array text;
begin
integer ch,pos;
boolean first;
trap(alarm);
pos:=1;
first:=true;
repeatchar(z);
readchar(z,ch);
if (ch<>'nl') and (ch<>'em') then
begin
readchar(z,ch);
while ch<>'nl' and ch<>'em' and pos<=max do
begin
if first and (ch<>' ') then
first:=false;
if not first then
put_ch(text,pos,ch,1);
readchar(z,ch);
end;
end;
read_text:=pos-1;
if pos<=max then
put_ch(text,pos,0,1);
repeatchar(z);
if false then
alarm: disable traped(28);
end;
boolean procedure read_nr(z,nr);
<* 29 *>
<*-----------------------------------------------------------------*>
<* Læs et heltal fra fil z. Er der ikke flere tal på linien *>
<* returneres -1 ellers det læste tal. Er der angivet ulovligt *>
<* tal (eller andet end tal) sættes read_nr til false *>
<* *>
<* z (call) : Zonen der læses fra *>
<* nr (ret) : Læst tal eller -1 hvis ikke flere tal *>
<* Return : True = ok False = illegalt tal *>
<*-----------------------------------------------------------------*>
zone z;
integer nr;
begin
integer ch,class;
trap(alarm);
read_nr:=true;
repeat
class:=readchar(z,ch);
until class<>7 or ch=';' ;
if ch=';' or class=8 then
nr:=-1
else
if class<2 or class>3 then
begin
nr:=-1;
read_nr:=false;
end
else
begin
repeatchar(z);
read(z,nr);
end;
repeatchar(z);
if false then
alarm: disable traped(29);
end;
boolean procedure read_name(z,name,ok);
<* 30 *>
<*---------------------------------------------------------------------*>
<* Læs et navn fra filen z til name. Resterende tegn nulstilles *>
<* Indledende blanktegn overspringes. Der stoppes ved kommentar *>
<* *>
<* z (call) : File der læses fra *>
<* name (ret) : Det læste navn i integer array name(0:3) *>
<* ok (ret) : True hvis første tegn er et bogstav *>
<* NB. Der læses altid et tegn mere fra z *>
<*---------------------------------------------------------------------*>
zone z;
integer array name;
boolean ok;
begin
integer ch,pos;
long array field laf;
trap(alarm);
for pos:=0,1,2,3 do
name(pos):=0;
pos:=1;
laf:=-2;
repeatchar(z);
readchar(z,ch);
while ch=' ' do
readchar(z,ch);
ok:=(ch>='a' and ch<='å');
while ((ch>='0' and ch<='9') or (ch>='a' and ch<='å')) and pos<=11 do
begin
put_ch(name.laf,pos,ch,1);
readchar(z,ch);
end;
repeatchar(z);
read_name:=not name(0)=0;
if false then
alarm: disable traped(30);
end;
procedure open_catalogs(usercat_name,termcat_name,typecat_name);
<* 31 *>
<*-----------------------------------------------------------------*>
<* Åben kataloger og undersøg om disse er ok og kan bruges til i/o *>
<* sæt size og length for hvert katalog *>
<* Er newcat=true dannes nye kataloger ud fra teksten i cat_file. *>
<* cat_doc angiver navnet på dokument hvorpå katalogerne lægges. *>
<* *>
<* usercat_name, *>
<* termcat_name, *>
<* typecat_name (call) : Navnene på katalogerne *>
<*-----------------------------------------------------------------*>
integer array usercat_name,termcat_name,typecat_name;
begin
integer array user_tail,term_tail,type_tail(1:10);
integer reason,cat_line_nr;
long array start_key(1:47);
integer procedure init_catalogs;
<* 32 *>
<*----------------------------------------------------------------------*>
<* Initialiser de 3 kataloger til tomme ud fra størrelserne læst fra *>
<* cat_file *>
<* *>
<* Return : Reason fra initialiseringen. reason=0 er OK *>
<*----------------------------------------------------------------------*>
begin
integer reason,i;
trap(alarm);
reason:=0;
open(cat_file,4,cattxt_name,0);
i:=read_start_key(cat_file,2,cat_line_nr);
while i=0 do
begin
next_line(cat_file,cat_line_nr);
i:=read_start_key(cat_file,2,cat_line_nr);
end;
if i=2 then
begin
read_nr(cat_file,usercat_size);
read_nr(cat_file,termcat_size);
read_nr(cat_file,typecat_size);
if usercat_size<1 or termcat_size<1 or typecat_size<1 then
reason:=16
else
begin
next_line(cat_file,cat_line_nr);
user_entry_length:=126; <************************>
term_entry_length:=36; <* Antal hw i entry !!! *>
type_entry_length:=128; <************************>
usercat_size:=(usercat_size-1)//(512//user_entry_length)+2;
termcat_size:=(termcat_size-1)//(512//term_entry_length)+2;
typecat_size:=(typecat_size-1)//(512//type_entry_length)+2;
user_tail(1):=usercat_size;
user_tail(2):=cat_doc(1);
user_tail(3):=cat_doc(2);
user_tail(4):=cat_doc(3);
user_tail(5):=cat_doc(4);
user_tail(6):=systime(7,0,0.0);
user_tail(7):=0;
user_tail(8):=0;
user_tail(9):=11 shift 12;
user_tail(10):=0;
end;
if reason=0 then
begin
if monitor(40<* create entry *>,usercat,0,user_tail)<>0 then
reason:=21
else
if monitor(50<* permanent *>,usercat,3,user_tail)<>0 then
reason:=22
else
if monitor(52<* create area proc *>,usercat,0,user_tail)<>0 then
reason:=23
else
if monitor(8<* reserve proc *>,usercat,0,user_tail)<>0 then
reason:=24;
end;
if reason=0 then
begin
term_tail(1):=termcat_size;
term_tail(2):=cat_doc(1);
term_tail(3):=cat_doc(2);
term_tail(4):=cat_doc(3);
term_tail(5):=cat_doc(4);
term_tail(6):=systime(7,0,0.0);
term_tail(7):=0;
term_tail(8):=0;
term_tail(9):=11 shift 12;
term_tail(10):=0;
if monitor(40<* create entry *>,termcat,0,term_tail)<>0 then
reason:=31
else
if monitor(50<* permanent *>,termcat,3,term_tail)<>0 then
reason:=32
else
if monitor(52<* create area proc *>,termcat,0,term_tail)<>0 then
reason:=33
else
if monitor(8<* reserve proc *>,termcat,0,term_tail)<>0 then
reason:=34;
end;
if reason=0 then
begin
type_tail(1):=typecat_size;
type_tail(2):=cat_doc(1);
type_tail(3):=cat_doc(2);
type_tail(4):=cat_doc(3);
type_tail(5):=cat_doc(4);
type_tail(6):=systime(7,0,0.0);
type_tail(7):=0;
type_tail(8):=0;
type_tail(9):=11 shift 12;
type_tail(10):=0;
if monitor(40<* create entry *>,typecat,0,type_tail)<>0 then
reason:=41
else
if monitor(50<* permanent *>,typecat,3,type_tail)<>0 then
reason:=42
else
if monitor(52<* create area proc *>,typecat,0,type_tail)<>0 then
reason:=43
else
if monitor(8<* reserve proc *>,typecat,0,type_tail)<>0 then
reason:=44;
end;
if reason=0 then
begin <* initialiser katalog indholdet *>
setposition(usercat,0,1);
outrec6(usercat,512);
for i:=1 step 1 until 128 do
usercat(i):=real <::>;
for i:=3 step 1 until usercat_size do
outrec6(usercat,512);
setposition(usercat,0,0);
outrec6(usercat,512);
usercat.iaf(1):=1; <* Bruger katalog = 1 *>
usercat.iaf(2):=usercat_size;
usercat.iaf(3):=user_entry_length;
usercat.iaf(4):=systime(7,0,0.0);
setposition(usercat,0,0);
user_seg:=-1;
setposition(termcat,0,1);
outrec6(termcat,512);
for i:=1 step 1 until 128 do
termcat(i):=real <::>;
for i:=3 step 1 until termcat_size do
outrec6(termcat,512);
setposition(termcat,0,0);
term_seg:=-1;
outrec6(termcat,512);
termcat.iaf(1):=2; <* Terminal katalog = 2 *>
termcat.iaf(2):=termcat_size;
termcat.iaf(3):=term_entry_length;
termcat.iaf(4):=systime(7,0,0.0);
setposition(termcat,0,0);
setposition(typecat,0,1);
outrec6(typecat,512);
for i:=1 step 1 until 128 do
typecat(i):=real <::>;
for i:=3 step 1 until typecat_size do
outrec6(typecat,512);
setposition(typecat,0,0);
outrec6(typecat,512);
typecat.iaf(1):=3; <* Type katalog = 3 *>
typecat.iaf(2):=typecat_size;
typecat.iaf(3):=type_entry_length;
typecat.iaf(4):=systime(7,0,0.0);
setposition(typecat,0,0);
end;
end
else
reason:=17;
init_catalogs:=reason;
if false then
alarm: disable traped(32);
end;
integer procedure fill_catalogs;
<* 33 *>
<*-----------------------------------------------------*>
<* Hent data fra cat_file og indsæt i relevant katalog *>
<*-----------------------------------------------------*>
begin
integer reason,key,i,first,last,type,term_type,priv;
integer array group,pgn,term_id,user_id(0:4);
long array password(1:8);
boolean ok;
procedure clear_high(i);
<* 32 *>
integer i;
begin
i:=(i shift 12) shift (-12);
end;
procedure clear_low(i);
<* 33 *>
integer i;
begin
i:=(i shift (-12)) shift 12;
end;
trap(alarm);
reason:=0;
key:=read_start_key(cat_file,2,cat_line_nr);
while (key<>1 <* end *>) and (key<>-1) and (reason=0) do
begin
if key=3 then
begin <* user entry *>
if not read_name(cat_file,user_id,ok) then
goto ill_nr;
if not ok then
goto ill_nr;
for i:=3,2,1,0 do
user_id(i+1):=user_id(i);
if not find_user(user_id) then
begin
if find_empty_user_entry(calc_hash(user_id,usercat_size)) then
begin
<* init entry *>
for i:=2 step 1 until 5 do
usercat.user_entry(i):=user_id(i-1);
usercat.user_entry(12):=1 shift 12; <* max user index *>
usercat.user_entry(23):=2 shift 12; <* mcl def. text *>
usercat.user_entry(19):=1 shift 23; <* term. group 0 *>
next_line(cat_file,cat_line_nr);
key:=read_start_key(cat_file,2,cat_line_nr);
while (key>=4) and (key<=20) do
begin
<* indsæt i entry *>
if (key>=6) and (key<=12) then
begin <* læs first og last for login tid *>
if not (read_nr(cat_file,first) and
read_nr(cat_file,last)) then
goto ill_nr;
if first<0 or first>24 or last<0 or last>24 then
goto ill_nr;
type:=if first<1 and last>23 then
3
else
if first=last then
0
else
if first<last then
1
else
2;
end;
begin
case key-3 of
begin
begin <* password *>
for i:=1 step 1 until 8 do
password(i):=0;
usercat.user_entry(6):=0;
usercat.user_entry(7):=0;
if read_text(cat_file,password,48)>0 then
begin <* kod password *>
for last:=1 step 1 until 31 do
begin
key:=password.baf(last) extract 12;
for i:=last+1 step 1 until 32 do
password.baf(i):=false add
((password.baf(i) extract 12) + key);
end;
for i:=1 step 1 until 16 do
begin
usercat.user_entry(6):=usercat.user_entry(6)+
password.iaf(i);
usercat.user_entry(7):=usercat.user_entry(7)+
usercat.user_entry(6);
end;
end;
end;
begin <* kodet password *>
read(cat_file,password(1));
usercat.user_entry(6):=password(1) shift (-24);
usercat.user_entry(7):=password(1) extract 24;
end;
begin <* monday *>
clear_high(usercat.user_entry(8));
usercat.user_entry(8):=usercat.user_entry(8)+
((first shift 7)+(last shift 2) + type) shift 12;
end;
begin <* tuesday *>
clear_low(usercat.user_entry(8));
usercat.user_entry(8):=usercat.user_entry(8)+
((first shift 7)+(last shift 2) + type);
end;
begin <* wednesday *>
clear_high(usercat.user_entry(9));
usercat.user_entry(9):=usercat.user_entry(9)+
((first shift 7)+(last shift 2) + type) shift 12;
end;
begin <* thursday *>
clear_low(usercat.user_entry(9));
usercat.user_entry(9):=usercat.user_entry(9)+
((first shift 7)+(last shift 2) + type);
end;
begin <* friday *>
clear_high(usercat.user_entry(10));
usercat.user_entry(10):=usercat.user_entry(10)+
((first shift 7)+(last shift 2) + type) shift 12;
end;
begin <* saturday *>
clear_low(usercat.user_entry(10));
usercat.user_entry(10):=usercat.user_entry(10)+
((first shift 7)+(last shift 2) + type);
end;
begin <* sunday *>
clear_high(usercat.user_entry(11));
usercat.user_entry(11):=usercat.user_entry(11)+
((first shift 7)+(last shift 2) + type) shift 12;
end;
begin <* block *>
clear_low(usercat.user_entry(11));
if not read_nr(cat_file,i) or i<0 then
goto ill_nr;
usercat.user_entry(11):=usercat.user_entry(12)+i;
end;
begin <* index *>
clear_high(usercat.user_entry(12));
if not read_nr(cat_file,i) then
goto ill_nr;
if i>9 or i<1 then
goto ill_nr;
usercat.user_entry(12):=usercat.user_entry(12)+
(i shift 12);
end;
begin <* privilegier *>
priv:=0;
clear_low(usercat.user_entry(12));
if not read_nr(cat_file,i) then
goto ill_nr;
while i>=0 do
begin
if i>11 then
goto ill_nr;
priv:=priv+(1 shift (11-i));
if not read_nr(cat_file,i) then
goto ill_nr;
end;
usercat.user_entry(12):=usercat.user_entry(12)+priv;
end;
begin <* mcl name *>
if not read_name(cat_file,pgn,ok) then
goto ill_nr;
if not ok then
goto ill_nr;
for i:=0 step 1 until 3 do
usercat.user_entry(i+13):=pgn(i);
end;
begin <* cmcl bases *>
if not (read_nr(cat_file,first) and
read_nr(cat_file,last)) then
goto ill_nr;
if first>last then
goto ill_nr;
usercat.user_entry(17):=first;
usercat.user_entry(18):=last;
end;
begin <* groups *>
for i:=1 step 1 until 4 do
group(i):=0;
if not read_nr(cat_file,i) then
goto ill_nr;
while (i>=0) and (i<=95) do
begin
first:=(i//24)+1;
last:=23-(i mod 24);
if not (false add (group(first) shift (-last))) then
group(first):=group(first)+(1 shift last);
if not read_nr(cat_file,i) then
goto ill_nr;
end;
for i:=1 step 1 until 4 do
usercat.user_entry(18+i):=group(i);
end;
begin <* mcl text *>
laf:=46;
i:=read_text(cat_file,usercat.user_entry.laf,80);
usercat.user_entry(23):=
((((i+2)//3*2)+2) shift 12) + i;
laf:=0;
end;
begin <* free text *>
laf:=100;
read_text(cat_file,usercat.user_entry.laf,30);
laf:=0;
end;
end;
end;
next_line(cat_file,cat_line_nr);
key:=read_start_key(cat_file,2,cat_line_nr);
end;
write_user_seg;
end
else
reason:=101; <* Ikke flere entries *>
end
else
reason:=102; <* Entry eksisterer *>
end
else
if key=21 then
begin <* terminal entry *>
if not read_name(cat_file,term_id,ok) then
goto ill_nr;
for i:=3 step (-1) until 0 do
term_id(i+1):=term_id(i);
if not find_term(term_id) then
begin
if find_empty_term_entry(calc_hash(term_id,termcat_size)) then
begin
<* init entry *>
for i:=2 step 1 until 5 do
termcat.term_entry(i):=term_id(i-1);
termcat.term_entry(6):=1 shift 12; <* terminal type *>
next_line(cat_file,cat_line_nr);
key:=read_start_key(cat_file,2,cat_line_nr);
while (key=13) or (key=20) or (key>=22 and key<=24) do
begin
<* indsæt i entry *>
if key=22 then
begin <* Terminal type *>
if not read_nr(cat_file,i) or i<0 or i>2047 then
goto ill_nr;
clear_high(termcat.term_entry(6));
termcat.term_entry(6):=termcat.term_entry(6)+
i shift 12;
end;
if key=13 then
begin <* Block *>
if not read_nr(cat_file,i) or i<0 then
goto ill_nr;
clear_low(termcat.term_entry(6));
termcat.term_entry(6):=termcat.term_entry(6)+i;
end;
if key=23 then
begin <* terminal group *>
if not read_nr(cat_file,i) or i<0 or i>95 then
goto ill_nr;
clear_low(termcat.term_entry(7));
termcat.term_entry(7):=termcat.term_entry(7)+i;
end;
if key=24 then
begin <* bypass *>
clear_high(termcat.term_entry(7));
termcat.term_entry(7):=termcat.term_entry(7)+(1 shift 12);
end;
if key=20 then
begin <* free text *>
laf:=14;
read_text(cat_file,termcat.term_entry.laf,30);
laf:=0;
end;
next_line(cat_file,cat_line_nr);
key:=read_start_key(cat_file,2,cat_line_nr);
end;
write_term_seg;
end
else
reason:=105; <* Ikke flere entries *>
end
else
reason:=106; <* Entry eksisterer *>
end
else
if key=25 then
begin <* type entry *>
if not read_nr(cat_file,term_type) or term_type<1 then
goto ill_nr;
if find_type_entry(term_type) then
begin
if typecat.type_entry(1) = 0 then
begin
<* init entry *>
typecat.type_entry(1):=term_type; <* terminal type *>
typecat.type_entry(3):=(80 shift 12)+24;
next_line(cat_file,cat_line_nr);
key:=read_start_key(cat_file,2,cat_line_nr);
while (key>=26) or (key=20) do
begin
<* indsæt i entry *>
if key=26 then
begin <* screen type *>
priv:=0;
if not read_nr(cat_file,i) or i>23 then
goto ill_nr;
while i>=0 do
begin
if i>23 then
goto ill_nr;
priv:=priv+(1 shift (23-i));
if not read_nr(cat_file,i) then
goto ill_nr;
end;
typecat.type_entry(2):=priv;
end;
if (key>=27) and (key<=34) then
begin <* 'send by' værdier *>
boolean array field baf;
baf:=0;
if not read_nr(cat_file,i) or i>255 or i<0 then
goto ill_nr;
typecat.type_entry.baf(key-22):=if i>0 then
false add i
else
false;
end;
if (key>=44) and (key<=49) then
begin <* et tegns værdier *>
boolean array field baf;
baf:=0;
if not read_nr(cat_file,i) or i>255 or i<0 then
goto ill_nr;
typecat.type_entry.baf(key+7):=if i>0 then
false add i
else
false;
end;
if (key>=35) and (key<=42) then
begin <* 6 tegns sekevnser *>
if not read_nr(cat_file,i) or i>255 or i<0 then
goto ill_nr;
first:=1;
laf:=case (key-34) of
(12,16,20,24,28,32,36,40);
typecat.type_entry.laf(1):=0;
while (i<>-1) and (first<=6) do
begin
put_ch(typecat.type_entry.laf,first,i,1);
if first<=6 then
begin
if not read_nr(cat_file,i) or i>255 or i<(-1) then
goto ill_nr;
end;
end;
laf:=0;
end;
if key=43 then
begin <* cursor sekvens *>
if not read_nr(cat_file,i) or i>255 or i<0 then
goto ill_nr;
first:=1;
laf:=44;
while (i<>-1) and (first<=9) do
begin
put_ch(typecat.type_entry.laf,first,i,1);
if first<=9 then
begin
if not read_nr(cat_file,i) or i>255 or i<(-1) then
goto ill_nr;
end;
end;
laf:=0;
end;
if key=50 then
begin <* initialiserings sekvens *>
laf:=56;
if not read_nr(cat_file,i) or i>255 or i<0 then
goto ill_nr;
first:=1;
while (i<>-1) and (first<=75) do
begin
put_ch(typecat.type_entry.laf,first,i,1);
if first<=75 then
begin
if not read_nr(cat_file,i) or i>255 or i<(-1) then
goto ill_nr;
end;
end;
laf:=0;
end;
if key=20 then
begin <* free text *>
laf:=106;
read_text(cat_file,typecat.type_entry.laf,30);
laf:=0;
end;
next_line(cat_file,cat_line_nr);
key:=read_start_key(cat_file,2,cat_line_nr);
end;
write_type_seg;
end
else
reason:=108; <* Entry eksisterer *>
end
else
reason:=109; <* Illegal type *>
end
else
if key<>65 then
reason:=100; <* illegal entry key *>
end;
if false then
ill_nr: reason:=110;
fill_catalogs:=reason;
if false then
alarm: disable traped(33);
end;
<*****************************>
<* Hoveddel af open_catalogs *>
<*****************************>
trap(alarm);
cat_line_nr:=1;
set_cat_bases(sys_bases);
open(usercat,4,usercat_name,1 shift 9 <* passivate *> );
open(termcat,4,termcat_name,1 shift 9 <* passivate *> );
open(typecat,4,typecat_name,0 <* NO passivate *> );
reason:=0;
if monitor(42<* lookup *>,usercat,0,user_tail)<>0 then
reason:=1
else
if new_catalog then
monitor(48 <*remove entry*>,usercat,0,user_tail);
if monitor(42<* lookup *>,termcat,0,term_tail)<>0 then
reason:=2
else
if new_catalog then
monitor(48 <*remove entry*>,termcat,0,term_tail);
if monitor(42<* lookup *>,typecat,0,type_tail)<>0 then
reason:=3
else
if new_catalog then
monitor(48 <*remove entry*>,typecat,0,type_tail);
if (not new_catalog) and (reason=0) then
begin <* alle kataloger findes, test ydeligerer *>
usercat_size:=user_tail(1);
termcat_size:=term_tail(1);
typecat_size:=type_tail(1);
if monitor(92<* create area proc *>,usercat,0,user_tail)<>0 then
reason:=4
else
if monitor(8<* reserve proc *>,usercat,0,user_tail)<>0 then
reason:=5
else
begin
user_seg:=-1;
find_user_seg(0);
user_entry:=0;
if usercat.user_entry(1)<>1 then
reason:=6
else
if usercat.user_entry(2)<>usercat_size then
reason:=7
else
user_entry_length:=usercat.user_entry(3);
end;
if reason=0 then
begin
if monitor(92<* create area proc *>,termcat,0,term_tail)<>0 then
reason:=8
else
if monitor(8<* reserve proc *>,termcat,0,term_tail)<>0 then
reason:=9
else
begin
term_seg:=-1;
find_term_seg(0);
term_entry:=0;
if termcat.term_entry(1)<>2 then
reason:=10
else
if termcat.term_entry(2)<>termcat_size then
reason:=11
else
term_entry_length:=termcat.term_entry(3);
end;
end;
if reason=0 then
begin
if monitor(92<* create area proc *>,typecat,0,type_tail)<>0 then
reason:=12
else
if monitor(8<* reserve proc *>,typecat,0,type_tail)<>0 then
reason:=13
else
begin
setposition(typecat,0,0);
inrec6(typecat,512);
type_entry:=0;
if typecat.type_entry(1)<>3 then
reason:=14
else
if typecat.type_entry(2)<>typecat_size then
reason:=15
else
type_entry_length:=typecat.user_entry(3);
end;
end;
end
else
if new_catalog then
begin <* ingen kataloger findes, opret nye *>
write_message(31,0,true,<:Generating new catalog:>);
reason:=init_catalogs;
if reason=0 then
reason:=fill_catalogs;
close(cat_file,true);
end;
if reason<>0 then
write_message(cat_line_nr,reason,false,<:Catalog error:>);
if false then
alarm: disable traped(31);
end;
integer procedure calc_hash(id,cat_size);
<* 34 *>
<*-----------------------------------------------------------*>
<* Beregn hash key ud fra navnet i id og kataloget størrelse *>
<* *>
<* id (call) : Navnet som hash nøglen beregnes for *>
<* navnet står i integer array id(1:4) *>
<* cat_size (call) : Størrelsen af kataloget hvortil hash *>
<* skal benyttes *>
<* Return : Den beregnede hash nøgle. *>
<*-----------------------------------------------------------*>
integer array id;
integer cat_size;
begin
calc_hash:=1+((abs(id(1)+id(2)+id(3)+id(4))) mod (cat_size-1));
end;
procedure find_user_seg(seg_nr);
<* 35 *>
<*----------------------------------------------------------*>
<* Find segment i usercat og indlæs dette. Udskriv aktuelt *>
<* segment, hvis wflag er sat. *>
<* *>
<* seg_nr (call) : Nummeret på det segment der ønskes *>
<*----------------------------------------------------------*>
integer seg_nr;
begin
integer array ia(1:20);
trap(alarm);
if seg_nr>(usercat_size-1) or seg_nr<0 then
write_message(35,seg_nr,false,<:Illegal seg_nr in cat.:>)
else
if seg_nr<>user_seg then
begin
setposition(usercat,0,seg_nr);
inrec6(usercat,512);
getzone6(usercat,ia);
ia(9):=seg_nr;
setzone6(usercat,ia);
user_seg:=seg_nr;
end;
if false then
alarm: disable traped(35);
end;
procedure write_user_seg;
<* 36 *>
<*----------------------------------------------------------*>
<* Opdater aktuelt user segment på disken. Segmentet for- *>
<* bliver i zone-bufferen med state: opend and positioned. *>
<*----------------------------------------------------------*>
begin
integer array ia(1:20);
trap(alarm);
setstate(usercat,6);
if (user_seg>usercat_size-1) or (user_seg<0) then
write_message(36,user_seg,false,<:Illegal seg_nr in cat.:>);
setposition(usercat,0,user_seg);
inrec6(usercat,512);
getzone6(usercat,ia);
ia(9):=user_seg;
setzone6(usercat,ia);
if false then
alarm: disable traped(36);
end;
procedure next_user_entry;
<* 37 *>
<*----------------------------------------------------------*>
<* Find næste user_entry i katalog. Er aktuelt entry sidste *>
<* i katalog sættes næste entry til det første i kataloget *>
<*----------------------------------------------------------*>
begin
integer seg_nr;
trap(alarm);
user_entry:=user_entry+user_entry_length;
if (511-user_entry)<user_entry_length then
begin
seg_nr:=if user_seg=usercat_size-1 then
1 <* Segment 0 benyttes til katalog information *>
else
user_seg+1;
find_user_seg(seg_nr);
user_entry:=2;
end;
if false then
alarm: disable traped(37);
end;
boolean procedure find_user(user_id);
<* 38 *>
<*----------------------------------------------------------*>
<* Find user_entry i katalog med key som angivet user_id *>
<* *>
<* user_id (call) : Bruger navn i integer array (1:4) *>
<* Return : True=fundet, False=ikke fundet *>
<*----------------------------------------------------------*>
integer array user_id;
begin
integer field hash_count;
integer i,hash;
boolean found;
trap(alarm);
hash:=calc_hash(user_id,usercat_size);
find_user_seg(hash);
hash_count:=2;
hash_count:=usercat.hash_count;
user_entry:=2;
if hash_count>0 then
begin
repeat
if usercat.user_entry(1)=hash then
begin
found:=true;
hash_count:=hash_count-1;
for i:=2, i+1 while (i<=5 and found) do
if usercat.user_entry(i)<>user_id(i-1) then
found:=false;
end
else
found:=false;
if not found then
next_user_entry;
until found or hash_count=0 or
(user_seg=hash and user_entry=2);
if not found and hash_count>0 then
write_message(38,1,true,<:Cyclic in catalog:>);
end
else
found:=false;
find_user:=found;
if false then
alarm: disable traped(38);
end;
boolean procedure find_empty_user_entry(hash_key);
<* 39 *>
<*----------------------------------------------------------*>
<* Find første tomme user_entry hørende til hash_key *>
<* Optæl hash key tæller i hash segmentet. Sæt user_entry *>
<* til fundet entry. Hash_key indsættes i fundet segment. *>
<* Entry SKAL udskrives på disken efter indsættelse af data *>
<* *>
<* hash_key (call) : Hash nøglen hørende til det segment *>
<* hvorfra der søges efter tomt entry *>
<* Return : True=Entry fundet. Sat i user_entry *>
<* False=Ikke mere plads i katalog *>
<*----------------------------------------------------------*>
integer hash_key;
begin
boolean room;
trap(alarm);
find_user_seg(hash_key);
user_entry:=0;
usercat.user_entry(1):=usercat.user_entry(1)+1;
setstate(usercat,6);
user_entry:=2;
room:=true;
while usercat.user_entry(1)<>0 and room do
begin
next_user_entry;
if (hash_key=user_seg) and (user_entry=2) then
room:=false;
end;
if not room then
begin
find_empty_user_entry:=false;
find_user_seg(hash_key);
user_entry:=0;
usercat.user_entry(1):=usercat.user_entry(1)-1;
write_user_seg;
end
else
begin
find_empty_user_entry:=true;
usercat.user_entry(1):=hash_key;
end;
if false then
alarm: disable traped(39);
end;
procedure find_term_seg(seg_nr);
<* 40 *>
<*----------------------------------------------------------*>
<* Find segment i termcat og indlæs dette. Udskriv aktuelt *>
<* segment, hvis wflag er sat. *>
<* *>
<* seg_nr (call) : Nummeret på det segment der ønskes *>
<*----------------------------------------------------------*>
integer seg_nr;
begin
integer array ia(1:20);
trap(alarm);
if seg_nr>(termcat_size-1) or seg_nr<0 then
write_message(40,seg_nr,false,<:Illegal seg_nr in cat.:>)
else
if seg_nr<>term_seg then
begin
setposition(termcat,0,seg_nr);
inrec6(termcat,512);
getzone6(termcat,ia);
ia(9):=seg_nr;
setzone6(termcat,ia);
term_seg:=seg_nr;
end;
if false then
alarm: disable traped(40);
end;
procedure write_term_seg;
<* 41 *>
<*----------------------------------------------------------*>
<* Opdater aktuelt term segment på disken. Segmentet for- *>
<* bliver i zone-bufferen med state: opend and positioned. *>
<*----------------------------------------------------------*>
begin
integer array ia(1:20);
trap(alarm);
setstate(termcat,6);
if (term_seg>termcat_size-1) or (term_seg<0) then
write_message(41,term_seg,false,<:Illegal seg_nr in cat.:>);
setposition(termcat,0,term_seg);
inrec6(termcat,512);
getzone6(termcat,ia);
ia(9):=term_seg;
setzone6(termcat,ia);
if false then
alarm: disable traped(41);
end;
procedure next_term_entry;
<* 42 *>
<*----------------------------------------------------------*>
<* Find næste term_entry i katalog. Er aktuelt entry sidste *>
<* i katalog sættes næste entry til det første i kataloget *>
<*----------------------------------------------------------*>
begin
integer seg_nr;
trap(alarm);
term_entry:=term_entry+term_entry_length;
if (511-term_entry)<term_entry_length then
begin
seg_nr:=if term_seg=termcat_size-1 then
1 <* Segment 0 benyttes til katalog information *>
else
term_seg+1;
find_term_seg(seg_nr);
term_entry:=2;
end;
if false then
alarm: disable traped(42);
end;
boolean procedure find_term(term_id);
<* 43 *>
<*----------------------------------------------------------*>
<* Find term_entry i katalog med key som angivet term_id *>
<* *>
<* term_id (call) : Terminal navn (integer array (1:4)) *>
<* Return : True=fundet, False=ikke fundet *>
<*----------------------------------------------------------*>
integer array term_id;
begin
integer field hash_count;
integer i,hash;
boolean found;
trap(alarm);
hash:=calc_hash(term_id,termcat_size);
find_term_seg(hash);
hash_count:=2;
hash_count:=termcat.hash_count;
term_entry:=2;
if hash_count>0 then
begin
repeat
if termcat.term_entry(1)=hash then
begin
found:=true;
hash_count:=hash_count-1;
for i:=2, i+1 while (i<=5 and found) do
if termcat.term_entry(i)<>term_id(i-1) then
found:=false;
end
else
found:=false;
if not found then
next_term_entry;
until found or hash_count=0 or
(term_seg=hash and term_entry=2);
if not found and hash_count>0 then
write_message(43,2,true,<:Cyclic in catalog:>);
end
else
found:=false;
find_term:=found;
if false then
alarm: disable traped(43);
end;
boolean procedure find_empty_term_entry(hash_key);
<* 44 *>
<*----------------------------------------------------------*>
<* Find første tomme term_entry hørende til hash_key *>
<* Optæl hash key tæller i hash segmentet. Sæt term_entry *>
<* til fundet entry. Hash_key indsættes i fundet segment. *>
<* Entry SKAL udskrives på disken efter indsættelse af data *>
<* *>
<* hash_key (call) : Hash nøglen hørende til det segment *>
<* hvorfra der søges efter tomt entry *>
<* Return : True=Entry fundet. Sat i term_entry *>
<* False=Ikke mere plads i katalog *>
<*----------------------------------------------------------*>
integer hash_key;
begin
boolean room;
trap(alarm);
find_term_seg(hash_key);
term_entry:=0;
termcat.term_entry(1):=termcat.term_entry(1)+1;
setstate(termcat,6);
term_entry:=2;
room:=true;
while termcat.term_entry(1)<>0 and room do
begin
next_term_entry;
if (hash_key=term_seg) and (term_entry=2) then
room:=false;
end;
if not room then
begin
find_empty_term_entry:=false;
find_term_seg(hash_key);
term_entry:=0;
termcat.term_entry(1):=termcat.term_entry(1)-1;
write_term_seg;
end
else
begin
find_empty_term_entry:=true;
termcat.term_entry(1):=hash_key;
end;
if false then
alarm: disable traped(44);
end;
boolean procedure find_type_entry(type_nr);
<* 45 *>
<*----------------------------------------------------------*>
<* Find entry hørende til angivet type. Sæt type_entry *>
<* BEMÆRK: Benyttes parallelt i catalog, operatør og *>
<* timecheck korutinerne *>
<* *>
<* type_nr (call) : typen af terminalen >0 *>
<* Return : True=Entry fundet, False= IKKE fundet *>
<* field type_entry sat til entry *>
<*----------------------------------------------------------*>
integer type_nr;
begin
integer seg;
integer array ia(1:20);
trap(alarm);
seg:=(type_nr-1)//(512//type_entry_length)+1;
if seg > typecat_size-1 or seg<1 or type_nr<1 then
find_type_entry:=false
else
begin
type_entry:=type_entry_length*((type_nr-1) mod (512//type_entry_length));
setposition(typecat,0,seg);
inrec6(typecat,512); <* NO passivate *>
getzone6(typecat,ia);
ia(9):=seg;
setzone6(typecat,ia);
find_type_entry:=true;
end;
if false then
alarm: disable traped(45);
end;
procedure write_type_seg;
<* 46 *>
<*----------------------------------------------------------*>
<* Opdater aktuelt type segment på disken. Segmentet for- *>
<* bliver i zone-bufferen med state: opend and positioned. *>
<*----------------------------------------------------------*>
begin
integer seg;
integer array ia(1:20);
trap(alarm);
getposition(typecat,0,seg);
setstate(typecat,6);
setposition(typecat,0,seg);
inrec6(typecat,512);
getzone6(typecat,ia);
ia(9):=seg;
setzone6(typecat,ia);
if false then
alarm: disable traped(46);
end;
procedure read_param_line;
<* 47 *>
<*---------------------------------------------------------------*>
<* Læs parametre fra fp kaldet *>
<* Sæt : new_catalog / cattxt_name *>
<* init_file_name *>
<* fp_maxterms *>
<* *>
<* init_file_name sættes default til: 'tasinit' men ændres *>
<* hvis der angives init.<name> i kald *>
<* maxterms sættes fra kald hvis der angives terminals.<antal> *>
<* ellers sættes maxterms fra init_file. *>
<* Angives catalog.<name> sættes <name> i cattxt_name og *>
<* new_catalog sættes true *>
<*---------------------------------------------------------------*>
begin
integer j,seperator,i,key;
real array item(1:2);
trap(alarm);
new_catalog:=false;
fp_maxterms:=0;
init_file_name.laf(1):=init_file_name.laf(2):=0;
put_text(init_file_name.laf,1,<:tasinit:>); <* Default init name *>
i:=1;
repeat
seperator:=system(4,i,item);
i:=i+1;
if seperator=(4 shift 12) + 10 then
begin
key:=find_keyword_value(item.laf(1),3);
seperator:=system(4,i,item);
i:=i+1;
if key=7 then
begin
if seperator=(8 shift 12) + 10 then
begin
new_catalog:=true;
for j:=1,2 do
cattxt_name.laf(j):=item.laf(j);
end
else
write_message(47,i,false,<:Illegal call parameter:>);
end
else
if key=9 then
begin
if seperator=(8 shift 12) + 10 then
begin
for j:=1,2 do
init_file_name.laf(j):=item.laf(j);
end
else
write_message(47,i,false,<:Illegal call parameter:>);
end
else
if key=8 then
begin
if seperator=(8 shift 12) + 4 then
fp_maxterms:=item(1)
else
write_message(47,i,false,<:Illegal call parameter:>);
end
else
write_message(47,i,false,<:Unknown call parameter:>);
end;
until seperator=0;
if false then
alarm: disable traped(47);
end;
procedure init_tascat;
<* 48 *>
<*-------------------------------------------------------*>
<* Initialiser tascat variable. *>
<* Data hentes enten fra init fil eller der benyttes *>
<* standard værdi. Beskrivelsen af data typer og *>
<* standard værdier sættes i procedure init_param_arrays *>
<*-------------------------------------------------------*>
begin
zone init_file(128,1,std_error);
integer array val(0:45);
integer array init_type,init_count(1:init_num_keys-9);
integer array init_lim(1:init_num_keys-9,1:2);
long array init_default(1:init_num_keys-9);
integer array spoolname,ttname,temname(1:4);
integer spseg,textbufsize,timeout,tbufsize,ttmask,reserve,i;
procedure init_param_arrays;
<* 49 *>
<*-------------------------------------------------*>
<* Initialiser arrays der beskriver data typer m.m *>
<*-------------------------------------------------*>
begin
long f,t;
integer i;
integer max,min;
<*********************************************************************>
<* Følgende arrays initialiseres: *>
<* integer array init_type(1:???) ; Beskriver typen af data : *>
<* 0 = IKKE brugt *>
<* 1 = cmcl-tekst *>
<* 2 = navn *>
<* 3 = heltal (integer) *>
<* 4 = logisk (boolean) *>
<* 5 = 2 heltal (integer) *>
<* *>
<* long array init_default(1:???) ; Standard værdi : *>
<* For type 1 : 0 til 130 iso tegn *>
<* 2 : 0 til 11 iso tegn *>
<* 3 : Heltals værdi *>
<* 4 : false add værdi (0=false , 1=true) *>
<* 5 : Heltals værdi for begge værdier *>
<* *>
<* integer array init_lim(1:???,1:2) ; Grænser for angivet værdi *>
<* For type 1 : (1) = Max. antal tegn *>
<* (2) = ubrugt *>
<* 2 : (1) = ubrugt *>
<* (2) = ubrugt *>
<* 3 : (1) = mindste værdi *>
<* (2) = største værdi *>
<* 4 : (1) = ubrugt *>
<* (2) = ubrugt *>
<* 5 : (1) = mindste værdi *>
<* (2) = største værdi *>
<* *>
<* integer array init_count(1:???); Beskrivelse af gemning af værdi *>
<* Angiver antallet af ord -1, der indgår i værdien. *>
<* *>
<* Navne på parametrerne i init_file sættes i : *>
<* procedure keywords_init i array init_keywords. *>
<* fra keyword 10 og frem. Keyword værdi benyttes som index til *>
<* init array's. Lokale værdier sættes i set_local_data *>
<*********************************************************************>
trap(alarm);
t:=1; f:=0;
max:=8388605; min:=-8388607;
for i:=1 step 1 until init_num_keys-9 do
begin
init_type(i):=case i of
(2,2,2,2,2,2,2,2,4,3,
3,4,3,5,5,3,3,3,3,3,
3,3,3,3,3,3,3,3,1,1,
1,1,3,3,3,3,4);
init_default(i):=case i of
(long <:disc:>,long <:tasusercat:>,long <:tastermcat:>,
long <:tastypecat:>,long <:tascattest:>,long <:tasspool:>,
long <:tastermtest:>, long <:tem:>,t,3,
3,t,5,max,max,0,0,20,10,5,
25,5,2,170,3,10,2,30,long <::>,long <::>,
long <:Afmeld !:>,long <:Afmeld !:>,412,-1,1365,0,t);
init_count(i):=case i of
(3,3,3,3,3,3,3,3,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,27,45,
27,27,0,0,0,0,0);
init_lim(i,1):=case i of
(0,0,0,0,0,0,0,0,0,0,
0,0,1,min,min,0,0,1,1,1,
3,1,1,70,1,1,1,1,80,80,
80,80,0,-1,0,0,0);
init_lim(i,2):=case i of
(0,0,0,0,0,0,0,0,0,4095,
4095,0,30,max,max,max,max,max,max,max,
max,max,max,500,2047,max,5,max,0,0,
0,0,1024,0,4095,999999,0);
end;
if false then
alarm: disable traped(49);
end;
procedure set_default;
<* 50 *>
<*------------------------------------------------------*>
<* Sæt standard værdierne i lokale og globale variable *>
<*------------------------------------------------------*>
begin
integer i,j;
<*************************************************************************>
<* integer array val benyttes til midlertidig opbevaring af læst værdi *>
<* For type 1 : (0) = hw's shift 12 + char's *>
<* (1:45) = Teksten *>
<* 2 : (0:3) = Navnet (udfyldt med 0) *>
<* 3 : (0) = Værdien *>
<* 4 : (0) = (0=false , 1=true); *>
<* 5 : (0),(1)= 2 værdier *>
<*************************************************************************>
trap(alarm);
host_id(0):=signon_text(0):=logtxt(0):=stoptxt(0):=0;
for i:=1 step 1 until init_num_keys-9 do
begin
if init_type(i)>0 then
begin
case init_type(i) of
begin
begin <* 1 *>
val(0):=puttext(val.laf,1,string init_default(i),-init_lim(i,1));
val(0):=val(0)+1;
put_ch(val.laf,val(0)+0,10,1);
put_ch(val.laf,val(0)+1,0,6);
val(0):=(((val(0)+2)//3+1)*2) shift 12 + val(0);
end;
begin <* 2 *>
val.laf(1):=val.laf(2):=0;
puttext(val.laf,1,string init_default(i),-11);
for j:=1 step 1 until 4 do
val(j-1):=val(j);
end;
begin <* 3 *>
val(0):=init_default(i);
end;
begin <* 4 *>
val(0):=init_default(i);
end;
begin <* 5 *>
val(0):=init_default(i);
val(1):=init_default(i);
end;
end;
set_local_data(i);
end;
end;
if false then
alarm: disable traped(50);
end;
procedure read_init_param;
<* 51 *>
<*---------------------------------------------------*>
<* Modifiser værdier med læste værdier fra init_file *>
<*---------------------------------------------------*>
begin
integer i,j,init_line_nr;
boolean ok;
trap(alarm);
init_line_nr:=1;
i:=read_start_key(init_file,3,init_line_nr);
while i=0 do
begin
next_line(init_file,init_line_nr);
i:=read_start_key(init_file,3,init_line_nr);
end;
i:=i-9;
while i>=1 do
begin
if init_type(i)>0 then
begin
case init_type(i) of
begin
begin <* 1 *>
val(0):=read_text(init_file,val.laf,init_lim(i,1));
val(0):=val(0)+1;
put_ch(val.laf,val(0)+0,10,1);
put_ch(val.laf,val(0)+1,0,6);
val(0):=(((val(0)+2)//3+1)*2) shift 12 + val(0);
end;
begin <* 2 *>
read_name(init_file,val,ok);
if not ok then
write_message(51,init_line_nr,false,<:Illegal init value:>);
end;
begin <* 3 *>
if not read_nr(init_file,val(0)) or
(val(0)<init_lim(i,1)) or (val(0)>init_lim(i,2)) then
write_message(51,init_line_nr,false,<:Illegal init value:>);
end;
begin <* 4 *>
j:=read_start_key(init_file,3,init_line_nr);
if j=1 <* true *> or j=3 <* on *> or j=5 <* start *> then
val(0):=1
else
if j=2 <* false *> or j=4 <* off *> or j=6 <* stop *> then
val(0):=0
else
write_message(51,init_line_nr,false,<:Illegal init value:>);
end;
begin <* 5 *>
if not read_nr(init_file,val(0)) or
(val(0)<init_lim(i,1)) or (val(0)>init_lim(i,2)) then
write_message(51,init_line_nr,false,<:Illegal init value:>);
if not read_nr(init_file,val(1)) or
(val(1)<init_lim(i,1)) or (val(1)>init_lim(i,2)) then
write_message(51,init_line_nr,false,<:Illegal init value:>);
end;
end;
set_local_data(i);
end;
next_line(init_file,init_line_nr);
i:=read_start_key(init_file,3,init_line_nr)-9;
end;
if i=-9 then
write_message(51,init_line_nr,false,<:Unknown init param.:>);
if false then
alarm: disable traped(51);
end;
procedure set_local_data(key);
<* 52 *>
<*------------------------------------*>
<* Sæt data fra val i lokale variable *>
<* *>
<* key (call) : Angiver den variable *>
<* der skal initialiseres*>
<*------------------------------------*>
integer key;
begin
integer i;
integer array st(0:68);
for i:=0 step 1 until init_count(key) do
begin
case key of
begin
cat_doc(i+1):=val(i);
usercat_name(i+1):=val(i);
termcat_name(i+1):=val(i);
typecat_name(i+1):=val(i);
testout_name(i+1):=val(i);
spoolname(i+1):=val(i);
ttname(i+1):=val(i);
temname(i+1):=val(i);
login_stat:=if val(0)=0 then 0 else 96;
max_user_block:=val(0);
max_term_block:=val(0);
timecheck_stat:=false add val(0);
logtime:=val(0);
begin
cmclbases(1):=val(0);
cmclbases(2):=val(1);
end;
begin
sysbases(1):=val(0);
sysbases(2):=val(1);
end;
cps:=val(0);
cls:=val(0);
max_sessions:=val(0);
max_terminals:=val(0);
max_sysmenu:=val(0);
corebufs:=val(0);
mclprogs:=val(0);
term_types:=val(0);
tbufsize:=val(0);
spseg:=val(0);
max_users:=val(0);
number_of_opera:=val(0);
timeout:=val(0);
host_id(i):=val(i);
st(i):=val(i);
logtxt(i):=val(i);
stoptxt(i):=val(i);
begin
testselect:=val(0) extract 8;
tracetype:=val(0) shift (-8);
end;
trapmode:=val(0);
ttmask:=val(0);
initver:=val(0);
reserve:=val(0);
end;
end;
if key=30 then
begin
i:=signon_text(0) extract 12 + 1;
put_txt(signon_text.laf,i,st.laf,st(0) extract 12);
put_ch(signon_text.laf,i+0,0,6);
signon_text(0):=(((i+1)//3)*2) shift 12 + (i-1);
end;
end;
trap(alarm);
open(init_file,4,init_file_name,0);
if monitor(42,init_file,0,val)<>0 then
write_message(48,1,false,<:No init file:>);
init_param_arrays;
set_default;
<* Set host id fra navn i monitor *>
hostid(0):=22 shift 12 + 29;
hostid.laf(1):=long <: V:> add 'e';
hostid.laf(2):=long <:lkomm:> add 'e';
hostid.laf(3):=long <:n til:> add ' ';
system(5,1192,val);
for i:=0,1,2,3 do
hostid(7+i):=val(i);
read_init_param;
text_buf_size:=148;
max_text_count:=max_terminals//4;
test_on:=true;
language:=1;
close(init_file,true);
<* Sæt data i copy_buf *>
copy_buf.iaf(1):=cps+cls+2*max_sessions+max_sysmenu; <* Antal cdescr *>
copy_buf.iaf(2):=term_types; <* Antal terminal type beskrivelser *>
copy_buf.iaf(3):=max_terminals; <* Antal terminal beskrivelser *>
copy_buf.iaf(4):=mclprogs; <* Antal indgange i mcltable *>
copy_buf.iaf(5):=spoolname(1); <* Navn på spool area *>
copy_buf.iaf(6):=spoolname(2);
copy_buf.iaf(7):=spoolname(3);
copy_buf.iaf(8):=spoolname(4);
copy_buf.iaf(9):=corebufs; <* Antal core buffere *>
copy_buf.iaf(10):=max_sysmenu//2;<* Antal att event descr *>
copy_buf.iaf(11):=reserve; <* reserver terminal ved create link *>
copy_buf.iaf(12):=cmclbases(1); <* MCL database std baser *>
copy_buf.iaf(13):=cmclbases(2);
copy_buf.iaf(14):=cls+max_sessions+max_sysmenu; <* Antal termina buf *>
copy_buf.iaf(15):=tbufsize; <* max tbuf size *>
copy_buf.iaf(16):=spseg; <* std seg i link spool area *>
copy_buf.iaf(17):=2*152; <* hw i signon buffer *>
copy_buf.iaf(18):=sysbases(1); <* test/spool baser *>
copy_buf.iaf(19):=sysbases(2);
copy_buf.iaf(20):=temname(1); <* Navn på tem pseudo proces *>
copy_buf.iaf(21):=temname(2);
copy_buf.iaf(22):=temname(3);
copy_buf.iaf(23):=temname(4);
copy_buf.iaf(24):=ttname(1); <* Testområde navn *>
copy_buf.iaf(25):=ttname(2);
copy_buf.iaf(26):=ttname(3);
copy_buf.iaf(27):=ttname(4);
copy_buf.iaf(28):=timeout; <* Antal timeout på term i mcl *>
copy_buf.iaf(29):=textbufsize; <* Antal hw til txt i systxt buf *>
copy_buf.iaf(30):=max_text_count;<* Antal udestående systxt mess. *>
copy_buf.iaf(31):=ttmask; <* testmaske *>
copy_buf.iaf(32):=cps; <* max pools efter create pool mess. *>
copy_buf.iaf(33):=max_sessions; <* Max sessioner *>
if false then
alarm: disable traped(48);
end;
procedure wait_tasterm(error);
<* 53 *>
<*----------------------------------------------*>
<* Vent på init message fra tasterm *>
<* Når denne kommer sendes init data til tasterm*>
<*----------------------------------------------*>
boolean error;
begin
zone z(1,1,stderror);
integer buf;
trap(alarm);
write_message(-53,0,true,if error then <:Stop tas:> else <:Synchronizing:>);
repeat
<* sæt tasterm_pda ud fra denne message *>
tasterm_pda:=monitor(20,z,buf,answer);
<* sæt tasterm_name ud fra pda *>
if not get_proc_name(tasterm_pda,tasterm_name) then
write_message(53,1,false,<:Sync. error:>);
if answer(1)<>(9 shift 12 + 1) then
begin
write_message(53,answer(1),true,<:System not running yet:>);
answer(9):=3;
monitor(22,z,buf,answer);
end;
until answer(1)=(9 shift 12 + 1);
tastermverd:=answer(4);
tastermvert:=answer(5);
write_message(answer(5),answer(4),true,<:Tasterm release:>);
write_message(relt,reld,true,<:Tascat release:>);
write_message(0,initver,true,<:Init version:>);
<* retur init data til tasterm *>
if data_from_copy_buf(256,buf,answer)<>0 then
write_message(53,2,false,<:Sync. error:>);
answer(9):=1;
answer(1):=if error then 1 else 0;
monitor(22,z,buf,answer);
if false then
alarm: disable traped(53);
end;
procedure tascat;
<* 00 *>
<*------------------------------------------*>
<*------------------------------------------*>
<* Hoved procedure for TASCAT *>
<*------------------------------------------*>
<*------------------------------------------*>
begin
integer array login_struc(1:4*struc_size);
<*---------------------------------------------------------------------*>
<* login_struc indeholder beskrivelse af alle tilmeldte brugere *>
<* *>
<* ! *>
<* bruger ----> terminal ---- session *>
<* ! ! ! *>
<* ! ! V *>
<* ! ! session *>
<* ! ! . *>
<* ! V . *>
<* ! terminal ... *>
<* V . *>
<* bruger ... . *>
<* . *>
<* . *>
<* *>
<* login_struc er opdelt i blokke af 4 integer. *>
<* brugerbeskrivelse = 2 blokke *>
<* terminalbeskrivelse = 1 blok *>
<* sessionsbeskrivelse = 1 blok *>
<* *>
<* brugerbeskrivelse: *>
<* *>
<* (0) - (3) : user id *>
<* (4) : userindex map < 12 + last login time *>
<* (5) : user privilege < 12 + user status *>
<* (6) : terminal pointer *>
<* (7) : next user pointer *>
<* *>
<* terminalbeskrivelse: *>
<* *>
<* (0) : terminal pda *>
<* (1) : mess < 21 + session map < 12 + terminal type *>
<* (2) : session pointer *>
<* (3) : next terminal pointer *>
<* *>
<* sessionbeskriver *>
<* *>
<* (0) : terminal handler cda (tasterm) *>
<* (1) : session nr < 12 + user index *>
<* (2) : session status *>
<* (3) : next session *>
<* *>
<* free block beskriver *>
<* *>
<* (0) : 0 *>
<* (1) : 0 *>
<* (2) : prev. free block pointer *>
<* (3) : next free block pointer *>
<* *>
<* pointer er index på første integer i blok. pointer lig 0 er tom. *>
<* *>
<* mess : 0 = ingen message *>
<* bit sat angiver text buffer nr: *>
<* lsb = 1, msb = 3 *>
<* user index map : bit sat for hver user index benyttet *>
<* index 0 lig lsb. *>
<* session map : bit sat for hver session i brug *>
<* session 1 lig 1 shift 1. *>
<* last login time : sidste tilmeldingstid (0 til 24) *>
<* 25 = ingen begrænsning (NON) *>
<* 26 = under afmelding (NOW) *>
<* 27 = remove mess. sendt *>
<* >100 lig næste dag. *>
<* user privilege : privilegiebit fra katalog *>
<* user status : bit 11 sat lig tilmelding stoppet for bruger *>
<* session status : bit 23 sat lig removing session *>
<* *>
<*---------------------------------------------------------------------*>
procedure init_login_struc;
<* 54 *>
<*----------------------------------------------------*>
<* Initialiser login_struc *>
<*----------------------------------------------------*>
begin
integer size,pos;
trap(alarm);
system(3,size,login_struc);
free_list:=1;
userlist:=0;
login_struc(1):=login_struc(2):=login_struc(3):=0;
login_struc(4):=5;
for pos:=5 step 4 until size-4 do
begin
login_struc(pos):=login_struc(pos+1):=0;
login_struc(pos+2):=pos-4;
login_struc(pos+3):=pos+4;
end;
login_struc(pos):=login_struc(pos+1):=login_struc(pos+3):=0;
login_struc(pos+2):=pos-4;
if false then
alarm: disable traped(54);
end;
integer procedure get_free_login(numbers);
<* 55 *>
<*--------------------------------------------------------------*>
<* Reserver et antal sammenhængende blokke i login strukturen. *>
<* *>
<* numbers (call) : Det antal blokke der ønskes reserveret *>
<* Return : Peger til første blok der er reserveret *>
<* eller nul (0) hvis det ikke var muligt *>
<*--------------------------------------------------------------*>
integer numbers;
begin
boolean found;
integer free,cur,next,prev;
trap(alarm);
get_free_login:=0;
found:=false;
cur:=free_list;
while not found and cur>0 do
begin
found:=true;
free:=cur;
while free <= cur+(numbers-2)*4 and found do
if login_struc(free+3)=free+4 then
free:=free+4
else
found:=false;
if not found then
cur:=login_struc(free+3);
end;
if found then
begin
get_free_login:=cur;
next:=login_struc(free+3);
prev:=login_struc(cur+2);
if prev=0 then
free_list:=next
else
login_struc(prev+3):=next;
if next>0 then
login_struc(next+2):=prev;
end;
if false then
alarm: disable traped(55);
end;
procedure release_block(addr);
<* 56 *>
<*---------------------------------------------------------------*>
<* Indsæt blokken angivet ved addr i free listen direkte efter *>
<* den forrige frie blok. *>
<* *>
<* addr (call) : Adressen på den blok der skal indsættes i free *>
<* listen (listen udpeget af free_list) *>
<*---------------------------------------------------------------*>
integer addr;
begin
integer prev,next;
trap(alarm);
prev:=0;
next:=free_list;
while not (next > addr) and next>0 do
begin
prev:=next;
next:=login_struc(prev+3);
end;
login_struc(addr):=0;
login_struc(addr+1):=0;
login_struc(addr+2):=prev;
login_struc(addr+3):=next;
if prev=0 then
free_list:=addr
else
login_struc(prev+3):=addr;
if next>0 then
login_struc(next+2):=addr;
if false then
alarm: disable traped(56);
end;
integer procedure find_login_user(id,start);
<* 57 *>
<*-------------------------------------------------------------*>
<* Find bruger beskrivelse i login struktur ud fra id *>
<* Start søgningen med beskrivelsen udpeget af start *>
<* *>
<* id (call) : Navnet på brugeren der skal søges efter *>
<* start (call) : Peger til første beskrivelse der søges i *>
<* Return : Peger til fundet beskrivelse eller nul hvis *>
<* beskrivelsen ikke blev fundet *>
<*-------------------------------------------------------------*>
value start;
integer start;
integer array id;
begin
integer i;
boolean found;
trap(alarm);
find_login_user:=0;
while start>0 do
begin
found:=true;
for i:=1, i+1 while (i<=4 and found) do
if login_struc(start+i-1)<>id(i) then
found:=false;
if found then
begin
find_login_user:=start;
start:=0;
end
else
start:=login_struc(start+7);
end;
if false then
alarm: disable traped(57);
end;
integer procedure find_login_terminal(name,user_index);
<* 58 *>
<*-----------------------------------------------------------*>
<* Find terminal beskrivelse i login_struc ud fra navn *>
<* *>
<* name (call) : Navnet på terminalen *>
<* user_index (ret) : Index i login_struc på terminal bruger *>
<* Return : Index i login_struc hvis fundet ellers 0 *>
<*-----------------------------------------------------------*>
integer array name;
integer user_index;
begin
integer pda,term_index;
boolean found;
trap(alarm);
pda:=get_pda(name);
found:=false;
term_index:=0;
user_index:=user_list;
while user_index>0 and not found do
begin
term_index:=find_user_terminal(pda,login_struc(user_index+6));
if term_index>0 then
found:=true
else
user_index:=login_struc(user_index+7);
end;
find_login_terminal:=term_index;
if false then
alarm: disable traped(58);
end;
integer procedure find_user_terminal(pda,start);
<* 59 *>
<*-------------------------------------------------------------*>
<* Find terminal beskrivelse i login struktur ud fra pda *>
<* Start søgningen med beskrivelsen udpeget af start *>
<* *>
<* pda (call) : PDA for den terminal der ledes efter *>
<* start (call) : Peger til første beskrivelse der søges i *>
<* Return : Peger til fundet beskrivelse eller nul hvis *>
<* beskrivelsen ikke blev fundet *>
<*-------------------------------------------------------------*>
value start;
integer pda,start;
begin
trap(alarm);
find_user_terminal:=0;
while start>0 do
begin
if login_struc(start)=pda then
begin
find_user_terminal:=start;
start:=0;
end
else
start:=login_struc(start+3);
end;
if false then
alarm: disable traped(59);
end;
boolean procedure check_term(term_id);
<* 60 *>
<*--------------------------------------------------------------------*>
<* Undersøg om terminal er indlogget *>
<* *>
<* term_id (call) : Navnet på terminalen (integer array (1:4) *>
<* Return : True = terminal indlogget *>
<* False = terminal ikke indlogget *>
<*--------------------------------------------------------------------*>
integer array term_id;
begin
integer pda,next;
integer array dummy(1:1);
boolean found;
trap(alarm);
found:=false;
pda:=get_pda(term_id);
if pda<>0 then
begin
next:=user_list;
while (next<>0) and not found do
begin
found:=find_user_terminal(pda,login_struc(next+6))>0;
next:=login_struc(next+7);
end;
end;
check_term:=found;
if false then
alarm: disable traped(60);
end;
boolean procedure check_type(type_nr);
<* 61 *>
<*--------------------------------------------------------------------*>
<* Undersøg om terminal med givet type nummer er indlogget *>
<* *>
<* type_nr (call) : nummeret på den type der checkes *>
<* Return : True = type benyttet *>
<* False = type ikke benyttet *>
<*--------------------------------------------------------------------*>
integer type_nr;
begin
integer next_user,next_term;
boolean found;
trap(alarm);
found:=false;
next_user:=user_list;
while (next_user<>0) and not found do
begin
next_term:=login_struc(next_user+6);
while (next_term<>0) and not found do
begin
found:=(login_struc(next_term+1) extract 12)=type_nr;
next_term:=login_struc(next_term+3);
end;
next_user:=login_struc(next_user+7);
end;
check_type:=found;
if false then
alarm: disable traped(61);
end;
boolean procedure remove_sess(sess_index);
<* 62 *>
<*-----------------------------------------------------------------*>
<* Send remove message til tasterm for angivet session *>
<* Sæt remove-status i session hvis message er sendt ok *>
<* *>
<* sess_index (call) : Index i login_struc til session *>
<* Return : True = Message sendt og/eller status sat *>
<* False = Message ikke sendt eller ikke ok *>
<* Status ikke sat af denne procedure *>
<*-----------------------------------------------------------------*>
integer sess_index;
begin
integer array ia(1:8);
integer i;
zone tasterm(1,1,std_error);
trap(alarm);
remove_sess:=true;
if not (false add login_struc(sess_index+2)) then
begin
login_struc(sess_index+2):=login_struc(sess_index+2)+1;
ia(1):=10 shift 12 + 0;
ia(2):=login_struc(sess_index);
open(tasterm,0,tasterm_name,1 shift 9); <* Imp. passivate *>
send_mess(tasterm,ia);
i:=monitor(18,tasterm,1,ia);
if i<>1 or ia(1)<>0 then
begin
remove_sess:=false;
login_struc(sess_index+2):=login_struc(sess_index+2)-1
end;
end;
if false then
alarm: disable traped(62);
end;
integer procedure check_user(login_user,last_time,
user_id,term_id,password1,password2);
<* 63 *>
<*--------------------------------------------------------------------------*>
<* Check om bruger kan tilmeldes login strukturen *>
<* *>
<* last_time (ret) : Sidste indlognings tid for bruger (hvis bruger ok) *>
<* login_user (ret) : Index til fundet bruger i login_struc eller *>
<* hvis bruger er ny er login_user lig 0 *>
<* user_id (call) : Navn på bruger der skal checkes (fra inlogning) *>
<* term_id (call) : Navn på terminal hvorfra inlogning foretages. *>
<* password1 (call) : Første ord i kodet password (fra inlogning) *>
<* password2 (call) : Andet ord i kodet password *>
<* Return : 0 hvis check af bruger er OK ellers fejlårsag *>
<* *>
<* Fejlårsag: *>
<* *>
<* 0 = User ok *>
<* 1 = inlogning stopped *>
<* 2 = max terminals inloged *>
<* 3 = unknown user id *>
<* 4 = wrong password *>
<* 5 = terminal limit (illegal terminal group) *>
<* 6 = user blocked *>
<* 7 = terminal blocked *>
<* 8 = max sessions exceeded *>
<* 9 = login time exceeded *>
<* 10 = no resources *>
<* 11 = unknown terminal *>
<* 12 = main consol *>
<* *>
<*--------------------------------------------------------------------------*>
integer login_user,last_time;
integer array user_id,term_id;
integer password1,password2;
begin
integer check,group,i,count;
real time;
integer array id(1:8);
trap(alarm);
check:=0; <* Bruger OK *>
if not find_term(term_id) then
begin <* Find default terminal *>
integer array default(1:4);
default(1):=<:def:> shift (-24) extract 24;
default(2):=<:aul:> shift (-24) extract 24;
default(3):=<:t:> shift (-24) extract 24;
default(4):=0;
if not find_term(default) then
check:=11;
end;
if sessions>=max_sessions then
check:=8;
if check=0 then
begin
group:=termcat.term_entry(7) extract 12;
if group>=login_stat then
check:=1
else
if max_terms<=terms then
check:=2
else
if not find_user(user_id) then
begin
if max_term_block>0 then
termcat.term_entry(6):=termcat.term_entry(6)+1;
check:=3;
end
else
if not ((usercat.user_entry(6)=password1) and
(usercat.user_entry(7)=password2)) then
begin
check:=4;
if ((password1<>0) or (password2<>0)) and (max_user_block>0) then
usercat.user_entry(11):=usercat.user_entry(11)+1;
end
else
if (usercat.user_entry(11) extract 12)<max_user_block or
max_user_block=0 then
usercat.user_entry(11):=
(usercat.user_entry(11) shift (-12)) shift 12;
end;
if check=0 then
begin
i:=group//24;
group:=23-(group mod 24);
if not (false add (usercat.user_entry(19+i) shift (-group))) then
begin
check:=5;
if max_term_block>0 then
termcat.term_entry(6):=termcat.term_entry(6)+1;
end
else
if (termcat.term_entry(6) extract 12)<max_term_block or
max_term_block=0 then
termcat.term_entry(6):=
(termcat.term_entry(6) shift (-12)) shift 12;
end;
if check=0 then
begin
login_user:=find_login_user(user_id,user_list);
if login_user>0 then
begin
if false add (login_struc(login_user+5) extract 1) then
check:=1
else
begin
group:=login_struc(login_user+4);
count:=0;
for i:=-12 step (-1) until (-21) do
if false add (group shift i) then
count:=count+1;
if count>=(usercat.user_entry(12) shift (-12)) then
check:=8;
end;
end;
end;
if check=0 then
begin <* test inlognings tid *>
if login_user>0 then
begin <* test i login_struc *>
last_time:=login_struc(login_user+4) extract 12;
if timecheck_stat and (last_time=26 or last_time=27 or last_time=0) then
check:=9;
end
else <* test i katalog *>
if not check_time(last_time) then
check:=9
end;
for i:=1 step 1 until 4 do
id(i):=logor((32 shift 16 + 32 shift 8 + 32),user_id(i));
for i:=5 step 1 until 8 do
id(i):=term_id(i-4);
i:=1;
if ((usercat.user_entry(11) extract 12)>=max_user_block) and
(max_user_block>0) then
begin
check:=6;
if ((usercat.user_entry(11) extract 12) mod 5=max_user_block) then
begin
write_message(63,1,true,<:Max. user block reached:>);
write_message(63,usercat.user_entry(11) extract 12,true,
string id.laf(increase(i)));
end;
end
else
if ((termcat.term_entry(6) extract 12)>=max_term_block) and
(max_term_block>0) then
begin
check:=7;
if ((termcat.term_entry(6) extract 12) mod 5=max_term_block) then
begin
write_message(63,2,true,<:Max. terminal block reached:>);
write_message(63,termcat.term_entry(6) extract 12,true,
string id.laf(increase(i)));
end;
end;
write_user_seg;
write_term_seg;
check_user:=check;
if false then
alarm: disable traped(63);
end;
boolean procedure check_time(time_last);
<* 64 *>
<*----------------------------------------------------------------------*>
<* Check inlognings tidspunktet for bruger angivet i aktuelt user_entry *>
<* *>
<* time_last (ret) : sidste indlognings tid for bruger eller 25 hvis *>
<* der ikke er sat grænse *>
<* Return : True hvis ok, False hvis ikke ok *>
<*----------------------------------------------------------------------*>
integer time_last;
begin
boolean field day;
integer time_type,time_first,time_cur,new_time_last;
real time;
trap(alarm);
systime(1,0,time);
day:=(round((time/86400)-0.5) mod 7)+15;
time_type:=usercat.user_entry.day extract 2;
time_first:=(usercat.user_entry.day shift (-7)) extract 5;
time_last:=(usercat.user_entry.day shift (-2)) extract 5;
check_time:=false;
time_cur:=cur_time;
if time_type<>0 then
begin
if time_cur<time_first then
begin
day:=day-1;
if day<15 then
day:=21;
new_time_last:=(usercat.user_entry.day shift (-2)) extract 5;
if (usercat.user_entry.day extract 2 = 2) and
(time_cur<new_time_last) then
begin
if new_time_last<time_first then
time_last:=new_time_last;
check_time:=true;
end;
end
else
if (time_type=3) or
(time_last>24) or
(time_first=0 and time_last=24) then
begin
time_last:=25;
check_time:=true;
end
else
if (time_type=2) then
begin
time_last:=time_last+100;
check_time:=true;
end
else
if (time_type=1) and
(time_cur>=time_first) and
(time_cur<time_last) then
check_time:=true;
end
else
time_last:=0;
if not timecheck_stat then
check_time:=true;
if false then
alarm: disable traped(64);
end;
procedure mess_to_term(term_index,text_buf);
<* 65 *>
<*--------------------------------------------------------------------------*>
<* Sæt markering i login structure at tekst skal udskrives *>
<* Ved kald skal struc_sema være 'sat' *>
<* *>
<* term_index (call): Index i login_struc på terminal *>
<* text_buf (call) : Nummeret på tekst buffer der skal skrives fra *>
<*--------------------------------------------------------------------------*>
integer term_index;
integer text_buf;
begin
trap(alarm);
login_struc(term_index+1):=logor(loginstruc(term_index+1),
1 shift (text_buf+20) );
if false then
alarm: disable traped(65);
end;
integer procedure set_text_buf(text);
<* 65.1 *>
<*--------------------------------------------------------------------------*>
<* Sæt text i buffer i tasterm. *>
<* *>
<* text (call) : Teksten der skal sættes *>
<* Return : Nummeret på den buffer teksten er sat i eller 0 hvis *>
<* der ingen ledig buffer er *>
<*--------------------------------------------------------------------------*>
integer array text;
begin
zone tasterm(40,1,stderror);
integer array ia(1:20),term_id(1:4);
integer i,hw,term_type,nr;
trap(alarm);
hw:=text(0) shift (-12)+4;
nr:=0;
for i:=1,2,3 do
if text_buf_reserved(i)=0 then
nr:=i;
if hw<=148 and nr>0 then
begin
tasterm.iaf(1):=(7 shift 16) + (7 shift 8) +7;
tasterm.iaf(2):=10;
for i:=3 step 1 until (hw//2) do
tasterm.iaf(i):=text(i-2);
text_buf_reserved(nr):=-1;
open(tasterm,0,tasterm_name,1 shift 9); <* Imp. passivate *>
getzone6(tasterm,ia);
ia(1):=11 shift 12 +0;
ia(2):=ia(19)+1;
ia(3):=ia(2)+hw-2;
ia(4):=nr;
send_mess(tasterm,ia);
i:=monitor(18,tasterm,1,ia);
if i<>1 then
begin
text_buf_reserved(nr):=0;
nr:=0;
end;
end;
set_text_buf:=nr;
if false then
alarm: disable traped(651);
end;
procedure send_message_text(nr);
<* 65.2 *>
<*------------------------------------------*>
<* Signalerer til write_term_text korutinen *>
<* at der er tekst til udskrift *>
<*------------------------------------------*>
integer nr;
begin
integer array ref(1:1);
trap(alarm);
initref(ref);
wait_select:=8;
wait(message_buf_pool,ref);
ref(3):=nr;
signal(text_write_sem,ref);
if false then
alarm: disable traped(652);
end;
boolean procedure check_user_priv(priv,result);
<* 66 *>
<*-------------------------------------------------------------------*>
<* Test om bruger givet i copy_buf er kendt, har korrekt password og *>
<* har det angivne privilegie *>
<* *>
<* priv (call) : Privilegie der testes for (0 til 4) *>
<* result (ret) : 0 = Ok *>
<* 1 = Ukendt bruger *>
<* 2 = Forkert password *>
<* 3 = Privilegie ikke opfyldt *>
<* Return : True hvis result=0 ellers false *>
<* Er result=0 er user_entry sat til fundet bruger *>
<*-------------------------------------------------------------------*>
integer priv,result;
begin
trap(alarm);
result:=1;
if find_user(copy_buf.iaf) then
begin <* Bruger fundet *>
result:=2;
if (copy_buf.iaf(5)=usercat.user_entry(6)) and
(copy_buf.iaf(6)=usercat.user_entry(7)) then
begin <* password ok *>
result:=if false add (usercat.user_entry(12) shift (priv-11)) then
0 <* privilegie ok *>
else
3; <* Privilegie ikke sat *>
end;
end;
check_user_priv:=result=0;
if false then
alarm: disable traped(66);
end;
procedure catco;
<* 67 *>
<*---------------------------------------*>
<* Hoved procedure for catalog korutinen *>
<*---------------------------------------*>
begin
zone dummy_zone(1,1,stderror);
integer operation,
mode,
i;
<***********************************>
<* Procedure til katalog korutinen *>
<***********************************>
procedure attention;
<* 68 *>
<*---------------------------------------------------------------------*>
<* Start en ny operatør korutine hvis der er attention fra ny terminal *>
<*---------------------------------------------------------------------*>
begin
integer i,head_consol;
integer array ref(1:1);
boolean found;
integer array sender_name(1:4);
trap(alarm);
i:=4;
answer(9):=1;
found:=false;
while (not found) and (i<(number_of_opera+4)) do
begin
found:=opera_terms(i,1)=mess.sender_pda;
i:=i+1;
end;
system(5,mess.sender_pda,sender_name);
if sender_name(1)=0 then
begin
answer(9):=2;
found:=true;
end;
if not found then
begin <* Ny terminal *>
get_proc_name(mess.sender_pda,sender_name);
i:=if (sender_name.laf(1)=head_term_name.laf(1)) and
(sender_name.laf(2)=head_term_name.laf(2)) then
4 else 5;
head_consol:=i-4;
while (not found) and (i<(number_of_opera+4)) do
begin
found:=opera_terms(i,1)=0;
i:=i+1;
end;
if found then
begin <* Ventende operatør korutine er fundet *>
opera_terms(i-1,1):=mess.sender_pda;
initref(ref);
wait_select:=6;
wait(message_buf_pool,ref);
ref(3):=head_consol;
signal(opera_terms(i-1,2),ref);
answer(9):=1; <* Operatør er startet *>
end
else
begin
answer(9):=2; <* Ikke flere operatør rutiner *>
end;
end;
if false then
alarm: disable traped(68);
end;
procedure get_segments;
<* 69 *>
<*--------------------------------------------------*>
<* Hent segmenter fra katalogerne til bruger proces *>
<*--------------------------------------------------*>
begin
integer seg,cat,i,size;
trap(alarm);
seg:=mess.mess_array(4);
cat:=mess.mess_array(5);
if (cat<1) or (cat>3) then
answer(1):=1 shift 22 <* error; illegal katalog type *>
else
begin
if data_to_copy_buf(6,mess.buf_addr,answer)=0 then
begin <* data kopieret *>
if check_user_priv(1,answer(1)) then
begin <* operatør ok *>
case cat of
begin
begin <* bruger katalog *>
if usercat_size>seg then
begin
size:=usercat_size;
find_user_seg(seg);
for i:=1 step 1 until 128 do
copy_buf(i):=usercat(i);
end
else
answer(1):=1 shift 18; <* end of catalog *>
end;
begin <* terminal katalog *>
if termcat_size>seg then
begin
size:=termcat_size;
find_term_seg(seg);
for i:=1 step 1 until 128 do
copy_buf(i):=termcat(i);
end
else
answer(1):=1 shift 18; <* end of catalog *>
end;
begin <* type katalog *>
if typecat_size>seg then
begin
size:=typecat_size;
setposition(typecat,0,seg);
write_type_seg;
for i:=1 step 1 until 128 do
copy_buf(i):=typecat(i);
end
else
answer(1):=1 shift 18; <* end of catalog *>
end;
end; <* case *>
if answer(1)=0 then
begin
answer(1):=if data_from_copy_buf(256,mess.buf_addr,answer)<>0 then
1 shift 23 <* fejl i kopiering *>
else
0; <* alt ok *>
answer(4):=size;
end;
end
else
if answer(1)=3 then
answer(1):=1 shift 11 <* ingen privilegie *>
else
answer(1):=1 shift 10; <* illegal bruger (operatør) *>
end
else
answer(1):=1 shift 23; <* bruger proces stoppet *>
end;
answer(9):=1;
if false then
alarm: disable traped(69);
end;
procedure tasterm_mess;
<* 70 *>
<*-------------------------------*>
<* Behandling af message fra TAS *>
<*-------------------------------*>
begin
<******************************>
<* Procedure til tasterm_mess *>
<******************************>
procedure sign_on;
<* 71 *>
<*------------------------------------------------*>
<* Undersøg inlognings muligheden og hvis ok *>
<* dan signon tekst til brug for TAS *>
<*------------------------------------------------*>
begin
integer term_type,width,pos,date_width;
integer array term_id(1:4);
long array date_text(1:6);
boolean term_found,def;
trap(alarm);
def:=false;
get_proc_name(mess.mess_array(4),term_id);
if (term_id.laf(1)=head_term_name.laf(1)) and
(term_id.laf(2)=head_term_name.laf(2)) then
<* Hovedkonsollen *>
answer(1):=12
else
if terms<max_terms then
begin <* Ikke maximalt antal terminaler tilmeldt *>
answer(1):=11;
if get_proc_name(mess.mess_array(4),term_id) then
begin <* terminal id fundet *>
term_found:=find_term(term_id);
if not term_found then
begin <* Find default terminal *>
integer array default(1:4);
default(1):=<:def:> shift (-24) extract 24;
default(2):=<:aul:> shift (-24) extract 24;
default(3):=<:t:> shift (-24) extract 24;
default(4):=0;
def:=true;
term_found:=find_term(default);
end;
if term_found then
begin <* Terminal kendt i katalog *>
if (termcat.term_entry(7) extract 12)>=login_stat then
answer(1):=1;
term_type:=termcat.term_entry(6) shift (-12);
if answer(1)<>1 and find_type_entry(term_type) then
begin
if typecat.type_entry(1)>0 then
begin <* Term type fundet i katalog *>
width:=typecat.type_entry(3) shift (-12);
date_width:=date(date_text);
copy_buf.iaf(1):=((termcat.term_entry(7) shift (-12))
shift 12)+term_type;
<* sæt signon text i copy_buf *>
pos:=7; <* Første tegn i copy_buf i position 7 *>
laf:=56;
<* Sæt init data i tekst *>
put_text(copy_buf,pos,char_table,typecat.type_entry.laf,-75);
laf:=0;
<* Sæt signon tekst *>
put_char(copy_buf,pos,10,2);
put_char(copy_buf,pos,32,(width-(host_id(0) extract 12))//2);
put_text(copy_buf,pos,host_id.laf,host_id(0) extract 12);
put_char(copy_buf,pos,10,2);
put_char(copy_buf,pos,32,(width-date_width)//2);
put_text(copy_buf,pos,date_text,date_width);
put_char(copy_buf,pos,10,2);
put_text(copy_buf,pos,signon_text.laf,
signon_text(0) extract 12);
put_char(copy_buf,pos,10,2);
if def then
begin
puttext(copy_buf,pos,<:<10>Terminal :>,10);
puttext(copy_buf,pos,term_id.laf,-12);
puttext(copy_buf,pos,<: er ikke i katalog<10>:>,19);
end;
copy_buf.iaf(2):=(2*((pos-5)//3+1) shift 12) + (pos-7);
put_char(copy_buf,pos,0,3);
<* Kopier data til TAS *>
if data_from_copy_buf(152,mess.buf_addr,answer)<>0 then
write_message(71,1,true,string c_p );
answer(1):=0;
end;
end;
end;
end;
end
else
answer(1):=2;
if false then
alarm: disable traped(71);
end;
procedure include_user;
<* 72 *>
<*---------------------------------*>
<* Inkluder ny bruger og terminal *>
<*---------------------------------*>
begin
integer user_index,term_index,sess_index,last_time,i,ui;
integer array user_id,term_id(1:4);
integer array struc_ref(1:1);
boolean term_found;
procedure init_term;
<* 73 *>
<* initialiser term i login_struc *>
begin
login_struc(term_index):=copy_buf.iaf(1);
<* bemærk: term_entry sat af find_term *>
login_struc(term_index+1):=
(1 shift 13)+(termcat.term_entry(6) shift (-12));
login_struc(term_index+2):=sess_index;
login_struc(term_index+3):=login_struc(user_index+6);
login_struc(user_index+6):=term_index;
terms:=terms+1;
end;
procedure init_sess;
<* 74 *>
<* initialiser sess i login_struc *>
begin
login_struc(sess_index):=copy_buf.iaf(2);
ui:=0;
while false add (login_struc(user_index+4) shift (-ui-12)) do
ui:=ui+1;
<* Sæt ny userindex bit *>
login_struc(user_index+4):=login_struc(user_index+4)+(1 shift (12+ui));
login_struc(sess_index+1):=(1 shift 12)+ui; <* session 1, user-index ui *>
login_struc(sess_index+2):=0;
login_struc(sess_index+3):=0;
sessions:=sessions+1;
end;
trap(alarm);
initref(struc_ref);
wait(struc_sema,struc_ref);
answer(1):=0;
user_index:=term_index:=sess_index:=0;
if data_to_copy_buf(8,mess.buf_addr,answer)=0 then
begin <* Data kopieret *>
if answer(2)=16 then
begin <* alt kopieret *>
answer(1):=0;
for i:=1 step 1 until 4 do
user_id(i):=copy_buf.iaf(i+2);
if get_proc_name(copy_buf.iaf(1),term_id) then
begin <* Terminal navn fundet *>
term_found:=find_term(term_id);
if not term_found then
begin <* Find default terminal *>
integer array default(1:4);
default(1):=<:def:> shift (-24) extract 24;
default(2):=<:aul:> shift (-24) extract 24;
default(3):=<:t:> shift (-24) extract 24;
default(4):=0;
term_found:=find_term(default);
end;
if term_found then
begin <* Terminal fundet i katalog *>
answer(1):=check_user(user_index,last_time,
user_id,term_id,copy_buf.iaf(7),copy_buf.iaf(8));
if answer(1)=0 then
begin <* user ok *>
if user_index=0 then
begin <* Ny bruger *>
term_index:=sess_index:=0;
user_index:=get_free_login(4);
if user_index>0 then
begin
term_index:=user_index+8;
sess_index:=user_index+12;
end
else
begin
user_index:=get_free_login(2);
if user_index>0 then
begin
term_index:=get_free_login(2);
if term_index>0 then
sess_index:=term_index+4
else
begin
term_index:=get_free_login(1);
if term_index>0 then
sess_index:=get_free_login(1);
end;
end;
end;
if term_index=0 then
begin
release_block(user_index);
release_block(user_index+4);
user_index:=0;
end
else
if sess_index=0 then
begin
release_block(user_index);
release_block(user_index+4);
release_block(term_index);
user_index:=term_index:=0;
end;
if user_index>0 then
begin <* Initialiser ny user, term og sess *>
for i:=1 step 1 until 4 do
login_struc(user_index+i-1):=user_id(i);
login_struc(user_index+4):=last_time;
<* bemærk: user_entry sat af check_user *>
login_struc(user_index+5):=usercat.user_entry(12) shift 12;
login_struc(user_index+6):=0;
<* indsæt ny user først i user liste *>
login_struc(user_index+7):=user_list;
user_list:=user_index;
init_term;
init_sess;
users:=users+1;
end;
end <* Ny bruger indsat, hvis user_index>0 *>
else
begin <* Bruger kendt, ny terminal og session *>
term_index:=get_free_login(2);
if term_index>0 then
sess_index:=term_index+4
else
begin
term_index:=get_free_login(1);
if term_index>0 then
sess_index:=get_free_login(1);
end;
if sess_index=0 then
begin
release_block(term_index);
term_index:=0;
end;
if term_index>0 then
begin <* Initialiser term og sess *>
init_term;
init_sess;
end;
end; <* Ny terminal og session indsat, hvis term_index>0 *>
end; <* user ok *>
end <* terminal navn fundet *>
else <* pda ukendt *>
answer(1):=11;
end
else <* terminal ukendt *>
answer(1):=11;
if answer(1)=0 then
begin
if (user_index>0) and (term_index>0) then
begin
copy_buf.iaf(1):=user_index;
for i:=2 step 1 until 7 do
copy_buf.iaf(i):=usercat.user_entry(i+11);
copy_buf.iaf(8):=1;
copy_buf.iaf(9):=(4 shift 12)+1;
copy_buf.iaf(10):=(ui+48) shift 16;
copy_buf.iaf(11):=(4 shift 12)+1;
copy_buf.iaf(12):=49 shift 16;
for i:=13 step 1 until 40 do
copy_buf.iaf(i):=usercat.user_entry(i+10);
if data_from_copy_buf(40,mess.buf_addr,answer)<>0 then
write_message(74,1,true,string c_p );
answer(1):=0;
end
else
answer(1):=10;
end;
end <* alt kopiret *>
else
answer(9):=3;
end <* data kopieret *>
else
write_message(74,2,true,string c_p );
signal(struc_sema,struc_ref);
if false then
alarm: disable traped(74);
end;
procedure start_sess;
<* 75 *>
<*--------------------------------------------------*>
<* Start en ny session hos kendt bruger og terminal *>
<*--------------------------------------------------*>
begin
integer user_index,term_index,sess_index,i,ui,sess_nr,map,count;
integer array user_id(1:4);
integer array struc_ref(1:1);
trap(alarm);
initref(struc_ref);
wait(struc_sema,struc_ref);
user_index:=term_index:=sess_index:=0;
if data_to_copy_buf(3,mess.buf_addr,answer)=0 then
begin <* data kopieret *>
if answer(2)=6 then
begin
answer(1):=0;
user_index:=copy_buf.iaf(3);
if (user_index>0) and (user_index<=(4*struc_size-7)) then
begin
for i:=1 step 1 until 4 do
user_id(i):=login_struc(user_index+i-1);
if find_user(user_id) then
begin <* bruger kendt *>
if (login_stat>0) and not (false add login_struc(user_index+5)) then
begin <* bruger login ok *>
map:=login_struc(user_index+4) shift (-12);
count:=0;
for i:=0 step (-1) until (-9) do
if false add (map shift i) then
count:=count+1;
if (count<(usercat.user_entry(12) shift (-12))) and
(sessions<max_sessions) then
begin <* ledige sessioner *>
if cur_time<(login_struc(user_index+4) extract 12) then
begin <* tid ok *>
term_index:=find_user_terminal(copy_buf.iaf(1),
login_struc(user_index+6));
if term_index>0 then
begin <* terminal kendt *>
sess_index:=get_free_login(1);
if sess_index>0 then
begin <* resourcer ok *>
login_struc(sess_index+3):=login_struc(term_index+2);
login_struc(term_index+2):=sess_index;
login_struc(sess_index):=copy_buf.iaf(2);
login_struc(sess_index+2):=0;
ui:=0;
while false add
(login_struc(user_index+4) shift (-ui-12)) do
ui:=ui+1;
<* Sæt ny userindex bit *>
login_struc(user_index+4):=
login_struc(user_index+4)+(1 shift (12+ui));
sess_nr:=1;
sessions:=sessions+1;
while false add (login_struc(term_index+1) shift
(-sess_nr-12)) do
sess_nr:=sess_nr+1;
<* Sæt ny sessions nummer bit *>
login_struc(term_index+1):=
login_struc(term_index+1)+(1 shift (12+sess_nr));
login_struc(sess_index+1):=
(sess_nr shift 12)+ui; <* session nr, user-index *>
end <* initialiser *>
else
answer(1):=10;
end
else
answer(1):=11;
end
else
answer(1):=9;
end
else
answer(1):=8;
end
else
answer(1):=1;
end
else
answer(1):=3;
end
else
answer(1):=3;
if answer(1)=0 then
begin
<* sæt returdata i copy_buf *>
copy_buf.iaf(1):=user_index;
for i:=2 step 1 until 7 do
copy_buf.iaf(i):=usercat.user_entry(i+11);
copy_buf.iaf(8):=sess_nr;
copy_buf.iaf(9):=(4 shift 12)+1;
copy_buf.iaf(10):=(ui+48) shift 16;
copy_buf.iaf(11):=(4 shift 12)+1;
copy_buf.iaf(12):=(sess_nr+48) shift 16;
for i:=13 step 1 until 40 do
copy_buf.iaf(i):=usercat.user_entry(i+10);
if data_from_copy_buf(40,mess.buf_addr,answer)<>0 then
write_message(75,1,true,string c_p );
answer(1):=0;
end;
end
else
answer(9):=3;
end
else
write_message(75,2,true,string c_p );
signal(struc_sema,struc_ref);
if false then
alarm: disable traped(75);
end;
procedure end_sess;
<* 76 *>
<*-------------------------------------------------------------------------*>
<* Nedlæg en sessions beskrivelse *>
<* Er det sidste session på terminalen, nedlægges terminal beskrivelsen *>
<* Er det sidste terminal på bruger, nedlægges bruger beskrivelsen *>
<*-------------------------------------------------------------------------*>
begin
integer user_index,term_index,sess_index;
integer prev_user_index,prev_term_index,prev_sess_index;
integer next_user_index;
integer array struc_ref(1:1);
boolean found;
trap(alarm);
initref(struc_ref);
wait(struc_sema,struc_ref);
user_index:=mess.mess_array(4);
if (user_index>0) and (user_index<=(4*struc_size-7)) then
begin
found:=false;
prev_term_index:=0;
term_index:=login_struc(user_index+6);
while term_index>0 and not found do
begin <* find terminal beskrivelse *>
if login_struc(term_index)=mess.mess_array(2) then
found:=true
else
begin
prev_term_index:=term_index;
term_index:=login_struc(term_index+3);
end;
end;
if found then
begin <* terminal fundet *>
found:=false;
prev_sess_index:=0;
sess_index:=login_struc(term_index+2);
while sess_index>0 and not found do
begin <* find sessions beskrivelse *>
if login_struc(sess_index)=mess.mess_array(3) then
found:=true
else
begin
prev_sess_index:=sess_index;
sess_index:=login_struc(sess_index+3);
end;
end;
if found then
begin <* session fundet *>
if (prev_sess_index=0) and (login_struc(sess_index+3)=0) then
begin <* sidste session på denne terminal *>
if (prev_term_index=0) and (login_struc(term_index+3)=0) then
begin <* sidste terminal for denne bruger *>
<* nedlæg bruger *>
prev_user_index:=0;
next_user_index:=user_list;
while user_index<>next_user_index do
begin
prev_user_index:=next_user_index;
next_user_index:=login_struc(next_user_index+7);
end;
if prev_user_index=0 then
user_list:=login_struc(user_index+7)
else
login_struc(prev_user_index+7):=login_struc(user_index+7);
release_block(user_index);
release_block(user_index+4);
release_block(term_index);
release_block(sess_index);
terms:=terms-1;
users:=users-1;
sessions:=sessions-1;
answer(1):=2;
end
else
begin
<* nedlæg terminal *>
<* nulstil userindex bit for session i map *>
login_struc(user_index+4):=login_struc(user_index+4) -
(1 shift ((login_struc(sess_index+1) extract 12)+12));
if prev_term_index=0 then
login_struc(user_index+6):=login_struc(term_index+3)
else
login_struc(prev_term_index+3):=login_struc(term_index+3);
release_block(term_index);
release_block(sess_index);
terms:=terms-1;
sessions:=sessions-1;
answer(1):=1;
end;
end
else
begin
<* nedlæg session *>
<* nulstil userindex bit for session i map *>
login_struc(user_index+4):=login_struc(user_index+4) -
(1 shift ((login_struc(sess_index+1) extract 12)+12));
<* nulstil sessions nr bit for session i map *>
login_struc(term_index+1):=login_struc(term_index+1) -
(1 shift ((login_struc(sess_index+1) shift (-12))+12));
if prev_sess_index=0 then
login_struc(term_index+2):=login_struc(sess_index+3)
else
login_struc(prev_sess_index+3):=login_struc(sess_index+3);
release_block(sess_index);
sessions:=sessions-1;
answer(1):=0;
end;
end
else
answer(1):=3; <* session ikke fundet *>
end
else
answer(1):=3; <* terminal ikke fundet *>
end
else
answer(1):=3; <* Ukendt bruger *>
signal(struc_sema,struc_ref);
if false then
alarm: disable traped(76);
end;
procedure modify_pass;
<* 77 *>
<*--------------------------------------*>
<* Sæt nyt password for inlogget bruger *>
<*--------------------------------------*>
begin
integer user_index;
integer array field user_id;
integer array struc_ref(1:1);
trap(alarm);
initref(struc_ref);
wait(struc_sema,struc_ref);
if data_to_copy_buf(5,mess.buf_addr,answer)=0 then
begin <* data læst *>
if answer(2)=10 then
begin <* al data læst *>
answer(1):=1;
user_index:=copy_buf.iaf(1);
if (user_index>0) and (user_index<=(4*struc_size-7)) then
begin <* User ident ok *>
user_id:=(user_index-1)*2;
if find_user(login_struc.user_id) then
begin <* bruger fundet i katalog *>
if (usercat.user_entry(6)=copy_buf.iaf(2)) and
(usercat.user_entry(7)=copy_buf.iaf(3)) then
begin <* old password ok *>
usercat.user_entry(6):=copy_buf.iaf(4);
usercat.user_entry(7):=copy_buf.iaf(5);
usercat.user_entry(61):=usercat.user_entry(61)+1;
write_user_seg;
answer(1):=0;
end;
end;
end;
end
else
answer(9):=3;
end
else
write_message(77,3,true,string c_p );
signal(struc_sema,struc_ref);
if false then
alarm: disable traped(77);
end;
procedure get_term_data;
<* 78 *>
<*---------------------------------*>
<* Hent terminal type data til TAS *>
<*---------------------------------*>
begin
integer i;
trap(alarm);
answer(1):=1;
if find_type_entry(mess.mess_array(4)) then
begin
if typecat.type_entry(1)>0 then
begin <* type entry fundet *>
for i:=1 step 1 until 53 do <* Kopier data *>
copy_buf.iaf(i):=typecat.type_entry(i);
if data_from_copy_buf(53,mess.buf_addr,answer)<>0 then
write_message(78,1,true,string c_p );
answer(1):=0;
end;
end;
if false then
alarm: disable traped (78);
end;
<**************************************>
<* Hoveddel af procedure tasterm_mess *>
<**************************************>
trap(alarm);
if (mode<2) or (mode>7) or (mess.sender_pda<>tasterm_pda) then
<* Ukendt mode i message eller illegal sender *>
answer(9):=3
else
begin
answer(9):=1;
case mode-1 of
begin
sign_on;
include_user;
start_sess;
end_sess;
modify_pass;
get_term_data;
end;
end;
if false then
alarm: disable traped(70);
end;
procedure modify_entry;
<* 79 *>
<*-----------------------------------------------*>
<* Behandling af modify_entry message fra bruger *>
<*-----------------------------------------------*>
begin
procedure modify_user_entry;
<* 80 *>
<*------------------------------------------------*>
<* Hent, sæt eller modifiser data i brugerkatalog *>
<*------------------------------------------------*>
begin
integer array field user_id,liaf;
boolean user_exist;
integer func,i;
trap(alarm);
user_id:=12;
func:=mess.mess_array(4)+1;
if (func<1) or (func>4) then
answer(9):=3
else
begin
if data_to_copy_buf((case func of (10,66,66,10)),
mess.buf_addr,answer)=0 then
begin <* data kopieret *>
if check_user_priv(1,answer(1)) then
begin <* operatør ok *>
user_exist:=find_user(copy_buf.user_id);
liaf:=10;
case func of
begin
<* Get data *>
if user_exist then
begin
for i:=2 step 1 until 61 do
copy_buf.liaf(i):=usercat.user_entry(i);
answer(1):=if data_from_copy_buf(66,mess.buf_addr,answer)=0 then
0 <* ok *>
else
8; <* process stopped *>
end
else
answer(1):=2; <* entry not found *>
<* Modify data *>
if user_exist then
begin
if find_login_user(copy_buf.user_id,user_list)=0 then
begin <* bruger er ikke logget ind *>
if copy_buf.liaf(61)=usercat.user_entry(61) then
begin <* time stamp's ens *>
for i:=2 step 1 until 60 do
usercat.user_entry(i):=copy_buf.liaf(i);
<* sæt ny time stamp *>
usercat.user_entry(61):=usercat.user_entry(61)+1;
write_user_seg;
answer(1):=0;
end
else
answer(1):=7; <* Data changed since last get-data *>
end
else
answer(1):=1; <* entry in use *>
end
else
answer(1):=2; <* entry not found *>
<* Set new data *>
if not user_exist then
begin
if find_empty_user_entry(
calc_hash(copy_buf.user_id,usercat_size)) then
begin <* tomt entry fundet *>
for i:=2 step 1 until 60 do
usercat.user_entry(i):=copy_buf.liaf(i);
<* sæt ny time stamp *>
usercat.user_entry(61):=0;
write_user_seg;
answer(1):=0;
end
else
answer(1):=6; <* catalog full *>
end
else
answer(1):=3; <* entry exist *>
<* Delete data *>
if user_exist then
begin
if find_login_user(copy_buf.user_id,user_list)=0 then
begin <* bruger ikke logget ind *>
usercat.user_entry(1):=0;
setstate(usercat,6);
find_user_seg(calc_hash(copy_buf.user_id,usercat_size));
user_entry:=0;
<* nedtæl hash-nøgle tæller *>
usercat.user_entry(1):=usercat.user_entry(1)-1;
write_user_seg;
answer(1):=0;
end
else
answer(1):=1; <* entry in use *>
end
else
answer(1):=2; <* entry not found *>
end;
end
else
answer(1):=if answer(1)=3 then
4 <* ingen privilegie *>
else
13; <* illegal bruger (operatør) *>
end
else
answer(1):=8; <* bruger proces stoppet *>
end;
if false then
alarm: disable traped(80);
end;
procedure modify_term_entry;
<* 81 *>
<*--------------------------------------------------*>
<* Hent, sæt eller modificer data i terminalkatalog *>
<*--------------------------------------------------*>
begin
integer array field term_id,liaf;
boolean term_exist;
integer func,i;
trap(alarm);
term_id:=12;
func:=mess.mess_array(4)+1;
if (func<1) or (func>4) then
answer(9):=3
else
begin
if data_to_copy_buf((case func of (10,23,23,10)),
mess.buf_addr,answer)=0 then
begin <* data kopieret *>
if check_user_priv(1,answer(1)) then
begin <* operatør ok *>
term_exist:=find_term(copy_buf.term_id);
liaf:=10;
case func of
begin
<* Get data *>
if term_exist then
begin
for i:=2 step 1 until 18 do
copy_buf.liaf(i):=termcat.term_entry(i);
answer(1):=if data_from_copy_buf(23,mess.buf_addr,answer)=0 then
0 <* ok *>
else
8; <* process stopped *>
end
else
answer(1):=2; <* entry not found *>
<* Modify data *>
if term_exist then
begin
if not check_term(copy_buf.term_id) then
begin <* terminal ikke logget ind *>
if copy_buf.liaf(18)=termcat.term_entry(18) then
begin <* time stamp's ens *>
for i:=2 step 1 until 17 do
termcat.term_entry(i):=copy_buf.liaf(i);
<* sæt ny time stamp *>
termcat.term_entry(18):=termcat.term_entry(18)+1;
write_term_seg;
answer(1):=0;
end
else
answer(1):=7; <* Data changed since last get-data *>
end
else
answer(1):=1; <* entry in use *>
end
else
answer(1):=2; <* entry not found *>
<* Set new data *>
if not term_exist then
begin
if find_empty_term_entry(
calc_hash(copy_buf.term_id,termcat_size)) then
begin <* tomt entry fundet *>
for i:=2 step 1 until 17 do
termcat.term_entry(i):=copy_buf.liaf(i);
<* sæt ny time stamp *>
termcat.term_entry(18):=0;
write_term_seg;
answer(1):=0;
end
else
answer(1):=6; <* catalog full *>
end
else
answer(1):=3; <* entry exist *>
<* Delete data *>
if term_exist then
begin
if not check_term(copy_buf.term_id) then
begin <* terminal ikke logget ind *>
termcat.term_entry(1):=0;
setstate(termcat,6);
find_term_seg(calc_hash(copy_buf.term_id,termcat_size));
term_entry:=0;
<* nedtæl hash-nøgle tæller *>
termcat.term_entry(1):=termcat.term_entry(1)-1;
write_term_seg;
answer(1):=0;
end
else
answer(1):=1; <* entry in use *>
end
else
answer(1):=2; <* entry not found *>
end;
end
else
answer(1):=if answer(1)=3 then
4 <* ingen privilegie *>
else
13; <* illegal bruger (operatør) *>
end
else
answer(1):=8; <* bruger proces stoppet *>
end;
if false then
alarm: disable traped(81);
end;
procedure modify_type_entry;
<* 82 *>
<*----------------------------------------------*>
<* Hent, sæt eller modificer data i typekatalog *>
<*----------------------------------------------*>
begin
integer array field liaf;
boolean type_exist;
integer func,i;
integer field type_nr;
trap(alarm);
type_nr:=14;
func:=mess.mess_array(4)+1;
if (func<1) or (func>4) then
answer(9):=3
else
begin
if data_to_copy_buf((case func of (7,70,70,7)),
mess.buf_addr,answer)=0 then
begin <* data kopieret *>
if check_user_priv(1,answer(1)) then
begin <* operatør ok *>
type_exist:=false;
if find_type_entry(copy_buf.type_nr) then
type_exist:=typecat.type_entry(1)<>0;
liaf:=12;
case func of
begin
<* Get data *>
if type_exist then
begin
for i:=1 step 1 until 64 do
copy_buf.liaf(i):=typecat.type_entry(i);
answer(1):=if data_from_copy_buf(70,mess.buf_addr,answer)=0 then
0 <* ok *>
else
8; <* process stopped *>
end
else
answer(1):=2; <* entry not found *>
<* Modify data *>
if type_exist then
begin
if not check_type(copy_buf.type_nr) then
begin <* type er ikke i login terminaler *>
if copy_buf.liaf(64)=typecat.type_entry(64) then
begin <* time stamp's ens *>
for i:=1 step 1 until 63 do
typecat.type_entry(i):=copy_buf.liaf(i);
<* sæt ny time stamp *>
typecat.type_entry(64):=typecat.type_entry(64)+1;
write_type_seg;
answer(1):=0;
end
else
answer(1):=7; <* Data changed since last get-data *>
end
else
answer(1):=1; <* entry in use *>
end
else
answer(1):=2; <* entry not found *>
<* Set new data *>
if not type_exist then
begin
if find_type_entry(copy_buf.type_nr) then
begin <* tomt entry fundet *>
for i:=1 step 1 until 63 do
typecat.type_entry(i):=copy_buf.liaf(i);
<* sæt ny time stamp *>
typecat.type_entry(64):=0;
write_type_seg;
answer(1):=0;
end
else
answer(1):=6; <* illegal type *>
end
else
answer(1):=3; <* entry exist *>
<* Delete data *>
if type_exist then
begin
if not check_type(copy_buf.type_nr) then
begin <* type benyttes ikke i indlogget terminal *>
typecat.type_entry(1):=0;
write_type_seg;
answer(1):=0;
end
else
answer(1):=1; <* entry in use *>
end
else
answer(1):=2; <* entry not found *>
end;
answer(4):=(typecat_size-1)*(512//type_entry_length);
end
else
answer(1):=if answer(1)=3 then
4 <* ingen privilegie *>
else
13; <* illegal bruger (operatør) *>
end
else
answer(1):=8; <* bruger proces stoppet *>
end;
if false then
alarm: disable traped(82);
end;
<*****************************>
<* Hoved del af modify_entry *>
<*****************************>
trap(alarm);
if (mode<1) or (mode>3) then
answer(9):=3
else
begin
answer(9):=1;
case mode of
begin
modify_user_entry;
modify_term_entry;
modify_type_entry;
end;
end;
if false then
alarm: disable traped(79);
end;
procedure send_text;
<* 83 *>
<*--------------------------------------------------------------------*>
<* Behandling af message fra bruger, med tekst til udskrift på anden *>
<* terminal tilknyttet TAS *>
<*--------------------------------------------------------------------*>
begin
integer array id(1:4);
integer i,user_index,term_index,t,nr;
integer array field liaf;
integer array struc_ref(1:1);
trap(alarm);
initref(struc_ref);
answer(9):=1;
if data_to_copy_buf(256,mess.buf_addr,answer)=0 then
begin <* data kopieret *>
if check_user_priv(3,answer(1)) then
begin <* operatør ok *>
liaf:=14;
t:=0;
answer(1):=0;
for i:=1 step 1 until 4 do
id(i):=mess.mess_array(i+3);
if id(1)<>0 then
begin
user_index:=find_login_user(id,user_list);
if user_index>0 then
begin
nr:=set_text_buf(copy_buf.liaf);
if nr>0 then
begin
term_index:=login_struc(user_index+6);
wait(struc_sema,struc_ref);
while term_index>0 do
begin
mess_to_term(term_index,nr);
t:=t+1;
term_index:=login_struc(term_index+3);
end;
signal(struc_sema,struc_ref);
send_message_text(nr);
end
else
answer(1):=4;
end
else
answer(1):=1;
end
else
begin
nr:=set_text_buf(copy_buf.liaf);
if nr>0 then
begin
wait(struc_sema,struc_ref);
user_index:=user_list;
while user_index>0 do
begin
term_index:=login_struc(user_index+6);
while term_index>0 do
begin
mess_to_term(term_index,nr);
t:=t+1;
term_index:=login_struc(term_index+3);
end;
user_index:=login_struc(user_index+7);
end;
signal(struc_sema,struc_ref);
send_message_text(nr);
end
else
answer(1):=4;
end;
answer(4):=t;
end
else
answer(1):=if answer(1)=3 then
2
else
13;
end
else
answer(1):=3;
if false then
alarm: disable traped(83);
end;
procedure move_mcl;
<* 84 *>
<*-------------------------------------------------------*>
<* Behandling af message til flytning af cmcl programmer *>
<*-------------------------------------------------------*>
begin
integer array ia(1:17),name(1:4),user_bases(1:2);
zone z(1,1,stderror);
integer i,result;
trap(alarm);
if (mode<0) or (mode>2) then
answer(9):=3 <* error; illegal mode *>
else
begin
answer(9):=1;
if data_to_copy_buf(12,mess.buf_addr,answer)=0 then
begin <* data kopieret *>
if check_user_priv(2,result) then
begin <* operatør ok *>
result:=0;
for i:=1 step 1 until 4 do
name(i):=copy_buf.iaf(i+6);
open(z,0,name,0);
user_bases(1):=copy_buf.iaf(11);
user_bases(2):=copy_buf.iaf(12);
if mode=0 then
begin <* Lookup file *>
set_cat_bases(cmcl_bases);
if monitor(42,z,0,ia)<>0 or
ia(9)<>(29 shift 12) then
result:=1
else
begin
for i:=2,3,4,5 do
copy_buf.iaf(i+5):=ia(i);
copy_buf.iaf(11):=ia(6);
copy_buf.iaf(12):=ia(10);
result:=if data_from_copy_buf(12,mess.buf_addr,answer)=0 then
result
else
8;
end;
end
else
if mode=1 then
begin <* move to tascat *>
set_cat_bases(user_bases);
i:=monitor(76,z,0,ia);
if monitor(76,z,0,ia)=0 then
begin
if (ia(8)>0) and
(ia(16) shift (-12) = 29) and
(ia(1) extract 3 = 3) then
begin
result:=monitor(74,z,0,cmcl_bases);
if result=7 then
result:=2;
end
else
result:=9;
end
else
result:=1;
end
else
if mode=2 then
begin <* move to user *>
set_cat_bases(cmcl_bases);
if monitor(42,z,0,ia)=0 then
begin
result:=monitor(74,z,0,user_bases);
if result=7 then
result:=2;
end
else
result:=1;
end;
answer(1):=result;
answer(4):=cmcl_bases(1);
answer(5):=cmcl_bases(2);
set_cat_bases(sys_bases);
end
else
answer(1):=if result=3 then
7 <* ingen privilegie *>
else
13; <* illegal bruger (operatør) *>
end
else
answer(1):=8; <* bruger proces stoppet *>
end;
if false then
alarm: disable traped(84);
end;
<**********************************>
<* Hoved del af catalog korutinen *>
<**********************************>
trap(alarm);
claim(600); <* Reserver plads på stakken *>
<* Hent buffer til message *>
initref(mess);
wait_select:=22;
wait(message_buf_pool,mess);
<* sæt den i wait message pool *>
signal(wait_message_pool,mess);
while true do
begin
<* vent på næste message til TASCAT *>
<* Der behandles kun 1 mess af gangen *>
wait_time:=0;
wait_select:=0;
wait(wait_message,mess);
for i:=1 step 1 until 8 do
answer(i):=0;
answer(9):=3;
operation:=mess.mess_array(1) shift (-12);
mode:=mess.mess_array(1) extract 12;
if false add trace_type then
trace(61,1,operation,mode);
if operation=0 then
attention
else
if operation=3 then
get_segments
else
if operation=9 then
tasterm_mess
else
if operation=11 then
modify_entry
else
if operation=13 then
send_text
else
if operation=15 then
move_mcl;
<* send answer sat af procedure der behandlede message *>
<* answer(9) er sat til answer-result, mens answer(1) *>
<* til answer(8) indeholder svaret (hvis answer(9)=1) *>
monitor(22,dummy_zone,mess.buf_addr,answer);
<* sæt besked buffer i pool så der kan ventes på næste message *>
signal(wait_message_pool,mess);
end;
if false then
alarm: disable traped(67);
end;
<***********************************************>
<***********************************************>
<* Hoved procedurerne for operatør korutinerne *>
<***********************************************>
<***********************************************>
procedure operator(cor_nr);
<* 85 *>
<*------------------------------------------*>
<* Hoved procedure for operator korutinerne *>
<* *>
<* cor_nr (call) : Denne korutines nummer *>
<*------------------------------------------*>
value cor_nr;
integer cor_nr;
begin
zone term_in(13,1,in_error),
term_out(13,1,out_error);
integer i,
head_consol,
buf,
command_value,
command_keyword,
user_ident;
boolean priv,
break,
finis,
out_stop;
integer array term_name(1:4),
command_name(1:4),
ref(1:1),
ia(1:20),
user_id(1:4);
long password;
<**************************************>
<**************************************>
<* Operatør korutine hjælpe procedure *>
<**************************************>
<**************************************>
boolean procedure read_param(term_in,text_param,num_param);
<* 86 *>
<*--------------------------------------------------------------------------*>
<* Læs en parameter fra input fra terminal *>
<* *>
<* text_param (ret) : Den læste parameter (max 11 tegn) konverteret til *>
<* små bogstaver og efterstillet med nul *>
<* num_par (ret) : Den læste parameter omregnet til integer *>
<* Return : True = parameter læst til text_param og num_param *>
<* False = ikke flere parametre (retur param. nulstillet)*>
<*--------------------------------------------------------------------------*>
zone term_in;
integer num_param;
integer array text_param;
begin
integer text_pos,char_class,ch;
long array field laf;
boolean neg;
trap(alarm);
neg:=false;
char_class:=7;
while char_class=7 do
char_class:=readchar(term_in,ch);
laf:=0;
text_pos:=1;
num_param:=0;
text_param.laf(1):=text_param.laf(2):=0;
if (ch=0) or (char_class>=8) then
read_param:=false
else
begin
read_param:=true;
if ch='-' then
neg:=true;
while char_class<7 do
begin
num_param:=if char_class=2 then
(num_param*10)+(ch-48)
else
0;
if (text_pos<12) and (char_class>1) then
put_char(text_param.laf,text_pos,ch);
char_class:=readchar(term_in,ch);
end;
end;
if neg then
num_param:= -num_param;
repeatchar(term_in);
if false then
alarm: disable traped(86);
end;
procedure out_error(z,s,b);
<* 87 *>
<*--------------------------------------------------------------*>
<* Blok procedure for zonen term_out *>
<* Sæt out_stop true hvis der sættes attention status på output *>
<* Sæt break ved fejl *>
<*--------------------------------------------------------------*>
zone z;
integer s,b;
begin
out_stop:=true;
if not (false add (s shift (-16))) then
begin
<* Ikke attention status men give_up eller error *>
break:=true;
b:=0;
end;
end;
procedure in_error(z,s,b);
<* 88 *>
<*-------------------------------------*>
<* Blok procedure for zonen term_in *>
<* Sæt break ved fejl og returner da *>
<* 'em' i input *>
<*-------------------------------------*>
zone z;
integer s,b;
begin
<* Give_up eller error *>
break:=true;
b:=2;
z(1):= real <:<'em'><'em'><'em'>:>;
end;
procedure show_sess(sess_index);
<* 89 *>
<*---------------------------------------------------------------------*>
<* Udskriv en linie på skærmen indeholde data for den angivne sesseion *>
<* *>
<* sess_index (call) : Index i login_struc for sessionen *>
<*---------------------------------------------------------------------*>
integer sess_index;
begin
begin
zone tasterm(1,1,stderror);
integer array ia(1:8),name(1:4);
integer buf;
boolean ok;
trap(alarm);
ok:=false;
open(tasterm,0,tasterm_name,1 shift 9);
ia(1):=12 shift 12 + 0;
ia(2):=login_struc(sess_index);
buf:=send_mess(tasterm,ia);
if wait_ans(tasterm,buf,100,opera_terms(cor_nr,2),true) then
begin
if monitor(18,tasterm,1,ia)=1 then
begin
if ia(1)=0 then
begin
name(1):=ia(5);
name(2):=ia(6);
name(3):=name(4):=0;
write(term_out,<:Id =:>,true,6,name.laf,
<: Index=:>,<<d>,
login_struc(sess_index+1) extract 12);
if ia(2)>0 then
begin
get_proc_name(ia(2),name);
write(term_out,<: Sess.Term=:>,true,11,name.laf);
end
else
write(term_out," ",23);
if ia(3)>0 then
begin
get_proc_name(ia(3),name);
write(term_out,<: User=:>,true,11,name.laf);
end
else
write(term_out," ",18);
if false add login_struc(sess_index+2) then
write(term_out,<: Removing:>)
else
begin
write(term_out,if false add (ia(4) shift (-1)) then
<: :> else <: Active:>);
write(term_out,if false add ia(4) then
<: Direct:> else <::>);
end;
ok:=true;
end;
end;
end;
if not ok then
write(term_out,string c_p ,<:<10>:>);
if false then
alarm: disable traped(89);
end;
end;
procedure show_term(user_index,term_index);
<* 90 *>
<*---------------------------------------------------------------*>
<* Udskriv oplysninger om en inlogget terminal og dens sessioner *>
<* *>
<* user_index (call) : Index i login_struc til den user *>
<* der benytter terminalen *>
<* term_index (call) : Index i login_struc til ønsket terminal *>
<*---------------------------------------------------------------*>
integer user_index,term_index;
begin
begin
integer array user_id,term_id(1:4);
integer i,sess_index;
trap(alarm);
for i:=1 step 1 until 4 do
user_id(i):=login_struc(user_index-1+i);
get_proc_name(login_struc(term_index),term_id);
i:=login_struc(user_index+4) extract 12;
write(term_out,<:<10>User=:>,true,11,user_id.laf,
<: Terminal =:>,true,11,term_id.laf,
<: Logout :>);
if i>=100 then
i:=i-100;
if i=25 then
write(term_out,<:disabled for user:>)
else
if timecheck_stat then
begin
write(term_out,if i>25 or i=0 then
<:now:> else <:time :>);
if i<25 and i>0 then
write(term_out,<<dd>,i);
end
else
begin
write(term_out,<:disabled (:>);
if i>25 or i=0 then
write(term_out,<:now):>)
else
write(term_out,<<dd>,i,<:):>);
end;
write(term_out,<:<10>:>);
sess_index:=login_struc(term_index+2);
while sess_index>0 do
begin
show_sess(sess_index);
write(term_out,<:<10>:>);
sess_index:=login_struc(sess_index+3);
end;
if false then
alarm: disable traped(90);
end;
end;
boolean procedure check_priv(priv_nr);
<* 91 *>
<*--------------------------------------------------------*>
<* Check privilegie for bruger, udskriv fejl hvis ikke ok *>
<* *>
<* priv_nr (call) : Privilegie nummeret der checkes *>
<*--------------------------------------------------------*>
integer priv_nr;
begin
trap(alarm);
if false add ((priv extract 12) shift (priv_nr-11)) then
check_priv:=true
else
begin
check_priv:=false;
write(term_out,<:*** no privilege<10>:>);
end;
if false then
alarm: disable traped(91);
end;
procedure opr_finis;
<* 92 *>
<*-------------------------------------------*>
<* Stop udførelsen af operatør kommandoer og *>
<* send continue message til terminal hvis *>
<* denne ikke er hovedterminalen *>
<*-------------------------------------------*>
begin
trap(alarm);
write(term_out,<:Operator finis<10>:>);
finis:=true;
setposition(term_out,0,0);
if cor_nr<>4 then
begin
<* Send continue message til terminal *>
ia(1):=128 shift 12 + 0;
ia(2):=0;
ia(3):=8 shift 12 + 8;
ia(4):=<:ope:> shift (-24) extract 24;
ia(5):=<:rat:> shift (-24) extract 24;
ia(6):=<:or:> shift (-24) extract 24;
buf:=send_mess(term_in,ia);
wait_ans(term_in,buf,100,opera_terms(cor_nr,2),true);
end;
if false then
alarm: disable traped(92);
end;
procedure opr_disp;
<* 93 *>
<*---------------------------------------------------*>
<* Udskriv oplysninger om bruger / terminal / system *>
<*---------------------------------------------------*>
begin
zone tasterm(1,1,stderror);
long array text(1:6);
integer user_index,term_index;
integer array ia(1:8);
integer array struc_ref(1:1);
boolean ok;
trap(alarm);
initref(struc_ref);
if read_param(term_in,command_name,0) then
begin
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword=8 then
begin <* terminal *>
if check_priv(4) then
begin
wait(struc_sema,struc_ref);
if read_param(term_in,command_name,0) then
begin
term_index:=find_login_terminal(command_name,user_index);
if term_index>0 then
show_term(user_index,term_index)
else
write(term_out,string t_n_l);
end
else
opr_terminal;
signal(struc_sema,struc_ref);
end;
end
else
if command_keyword=9 or command_keyword=18 then
begin <* user *>
if check_priv(4) then
begin
wait(struc_sema,struc_ref);
if read_param(term_in,command_name,0) then
begin
user_index:=find_login_user(command_name,user_list);
if user_index>0 then
begin
term_index:=login_struc(user_index+6);
while term_index>0 and not out_stop do
begin
show_term(user_index,term_index);
term_index:=login_struc(term_index+3);
end;
end
else
write(term_out,string u_n_l);
end
else
opr_user;
signal(struc_sema,struc_ref);
end;
end
else
if command_keyword=15 then
begin <* system *>
if system_stop then
write(term_out,<:<10>System is stopping:>);
write(term_out,<:<10>--- Sign on ---:>);
write(term_out,<:<10>:>,host_id.laf);
date(text);
write(term_out,<:<10>:>,text);
write(term_out,<:<10>:>,signon_text.laf);
write(term_out,<:<10>--- Status ---:>);
write(term_out,<< dddd >,<:<10>Users : :>,users,
<:Free::>,maxterminals-terms);
write(term_out,<< dddd >,<:<10>Terminals : :>,terms,
<:Max ::>,max_terms);
write(term_out,<< dddd >,<:<10>Sessions : :>,sessions);
write(term_out,<:<10>Timecheck : :>,if timecheck_stat then
<:activ:>
else
<:passiv:>,
<:<10>Login : :>);
if login_stat=96 then
write(term_out,<:enabled:>)
else
if login_stat=0 then
write(term_out,<:disabled:>)
else
write(term_out,<:disabled from terminal group :>,login_stat);
write(term_out,<:<10><10>--- Release dates ---:>);
write(term_out,<:<10>Tasterm : :>,<<dddddd >,
tastermverd,tastermvert);
write(term_out,<:<10>Tascat : :>,<<dddddd >,reld,relt);
write(term_out,<:<10>Init : :>,<<dddddd >,initver);
end
else
if command_keyword=19 then
begin <* Resources *>
ok:=false;
open(tasterm,0,tasterm_name,1 shift 9);
ia(1):=18 shift 12;
if wait_ans(tasterm,send_mess(tasterm,ia),
100,operaterms(cor_nr,2),true) then
begin
if monitor(18,tasterm,1,ia)=1 then
begin
ok:=true;
write(term_out,<:<10>Resource Maximum:>,
<: Used % Used<10>:>,
<:<10>Create pools :>,
<<dddd >,cps,cps-ia(1),
<<ddd>,if cps=0 then 0 else (cps-ia(1))/cps*100,
<:<10>Create links :>,
<<dddd >,cls,ia(2),
<<ddd>,if cls=0 then 0 else ia(2)/cls*100,
<:<10>Sessions :>,
<<dddd >,maxsessions,sessions,
<<ddd>,sessions/maxsessions*100,
<:<10>Terminals :>,
<<dddd >,maxterminals,terms,
<<ddd>,terms/maxterminals*100,
<:<10>Users :>,
<<dddd >,maxusers,users,
<<ddd>,users/maxusers*100,
<:<10>System menues :>,
<<dddd >,maxsysmenu,ia(3),
<<ddd>,ia(3)/maxsysmenu*100,
<:<10>Terminal types :>,
<<dddd >,termtypes,termtypes-ia(6),
<<ddd>,(termtypes-ia(6))/termtypes*100,
<:<10>Mcl programs :>,
<<dddd >,mclprogs,mclprogs-ia(5),
<<ddd>,(mclprogs-ia(5))/mclprogs*100,
<:<10>Core buffers :>,
<<dddd >,corebufs,corebufs-ia(4),
<<ddd>,(corebufs-ia(4))/corebufs*100,
<:<10>Spool segments :>,
<<dddd >,ia(7),ia(7)-ia(8),
<<ddd>,(ia(7)-ia(8))/ia(7)*100);
end;
end;
if not ok then
write(term_out,string c_p,<:<10>:>);
end
else
write(term_out,string ill_par,command_name.laf);
end
else
write(term_out,string miss_par);
write(term_out,<:<10>:>);
if false then
alarm: disable traped(93);
end;
procedure opr_message;
<* 94 *>
<*---------------------------------------------------*>
<* Send meddelelser til bruger og terminal *>
<*---------------------------------------------------*>
begin
long array text(0:34);
integer i,t,user_index,term_index,nr;
integer array struc_ref(1:1);
boolean procedure read_term_text(text);
<* 95 *>
<*--------------------------------------------------------------*>
<* Læs tekst fra terminal til text i mcl-format *>
<* prompt for hver linie. Afslut ved '.' først på linie *>
<* *>
<* text (ret) : Den læste tekst i mcl-format *>
<* Return : True = Tekst læst, False = Fejl ved læsning *>
<*--------------------------------------------------------------*>
long array text;
begin
long array line(1:14);
integer i,pos;
trap(alarm);
pos:=1;
repeat
i:=read_line(line);
if i>0 then
i:=put_txt(text,pos,line,i);
until i<1;
if i=0 then
begin
put_ch(text,pos,0,3);
put_ch(text,200,0,3);
pos:=pos-4;
text(0):=((((pos+2)//3)*2+1) shift 12) + pos;
read_term_text:=true;
end
else
read_term_text:=false;
if false then
alarm: disable traped(95);
end;
integer procedure read_line(line);
<* 96 *>
<*--------------------------------------------------------------------*>
<* Læs en linie fra terminal *>
<* *>
<* line (ret) : Den læste linie *>
<* Return : Antal tegn læst ink. 'nl' (0 = '.' først på linie) *>
<*--------------------------------------------------------------------*>
long array line;
begin
integer ch,i,pos;
trap(alarm);
write(term_out,<:>:>);
setposition(term_out,0,0);
setposition(term_in,0,0);
pos:=1;
repeat
readchar(term_in,ch);
i:=put_ch(line,pos,ch,1);
until (ch='nl') or (i<1) or (((ch='.') or (ch='/')) and (pos=2));
if ch='nl' then
read_line:=pos-1
else
if ch='/' then
read_line:=-1
else
read_line:=pos-2;
if false then
alarm: disable traped(96);
end;
trap(alarm);
initref(struc_ref);
if read_param(term_in,command_name,0) then
begin
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword=16 then
begin <* login *>
if check_priv(0) then
begin
t:=0;
if read_term_text(text) then
begin
nr:=set_text_buf(text.iaf);
if nr>0 then
begin
wait(struc_sema,struc_ref);
user_index:=user_list;
while user_index>0 do
begin
term_index:=login_struc(user_index+6);
while term_index>0 do
begin
mess_to_term(term_index,nr);
t:=t+1;
term_index:=login_struc(term_index+3);
end;
user_index:=login_struc(user_index+7);
end;
signal(struc_sema,struc_ref);
send_message_text(nr);
end
else
write(term_out,<:No free text buffer<10>:>);
end
else
write(term_out,string long_text);
write(term_out,<<d>,<:Message sent to :>,t,<: terminal:>,
if t<>1 then <:s:> else <::>);
end;
end
else
if command_keyword=13 then
begin <* sign on *>
if check_priv(0) then
begin
if read_term_text(text) then
begin
signon_text(0):=text(0) extract 24;
for i:=1 step 1 until 34 do
signon_text.laf(i):=text(i);
end
else
write(term_out,string long_text);
end;
end
else
if command_keyword=12 then
begin <* all *>
if check_priv(0) then
begin
t:=0;
if read_term_text(text) then
begin
signon_text(0):=text(0) extract 24;
for i:=1 step 1 until 34 do
signon_text.laf(i):=text(i);
nr:=set_text_buf(text.iaf);
if nr>0 then
begin
wait(struc_sema,struc_ref);
user_index:=user_list;
while user_index>0 do
begin
term_index:=login_struc(user_index+6);
while term_index>0 do
begin
mess_to_term(term_index,nr);
t:=t+1;
term_index:=login_struc(term_index+3);
end;
user_index:=login_struc(user_index+7);
end;
signal(struc_sema,struc_ref);
send_message_text(nr);
end
else
write(term_out,<:No free text buffer<10>:>);
end
else
write(term_out,string long_text);
write(term_out,<<d>,<:Message sent to :>,t,<: terminal:>,
if t<>1 then <:s:> else <::>);
end;
end
else
if command_keyword=9 then
begin <* user *>
if read_param(term_in,command_name,0) then
begin
if check_priv(3) then
begin
t:=0;
user_index:=find_login_user(command_name,user_list);
if user_index>0 then
begin
if read_term_text(text) then
begin
nr:=set_text_buf(text.iaf);
if nr>0 then
begin
wait(struc_sema,struc_ref);
user_index:=find_login_user(command_name,user_list);
if user_index>0 then
term_index:=login_struc(user_index+6)
else
term_index:=0;
while term_index>0 do
begin
mess_to_term(term_index,nr);
t:=t+1;
term_index:=login_struc(term_index+3);
end;
signal(struc_sema,struc_ref);
send_message_text(nr);
end
else
write(term_out,<:No free text buffer<10>:>);
write(term_out,<<d>,<:Message sent to :>,t,<: terminal:>,
if t<>1 then <:s:> else <::>);
end
else
write(term_out,string long_text);
end
else
write(term_out,string u_n_l);
end;
end
else
write(term_out, string miss_par);
end
else
if command_keyword=8 then
begin <* terminal *>
if read_param(term_in,command_name,0) then
begin
if check_priv(3) then
begin
term_index:=find_login_terminal(command_name,0);
if term_index>0 then
begin
if read_term_text(text) then
begin
nr:=set_text_buf(text.iaf);
if nr>0 then
begin
wait(struc_sema,struc_ref);
term_index:=find_login_terminal(command_name,0);
if term_index>0 then
mess_to_term(term_index,nr);
signal(struc_sema,struc_ref);
send_message_text(nr);
end
else
write(term_out,<:No free text buffer<10>:>);
end
else
write(term_out,string long_text);
end
else
write(term_out,string t_n_l);
end;
end
else
write(term_out, string miss_par);
end
else
write(term_out,string ill_par,command_name.laf);
end
else
write(term_out,string miss_par);
write(term_out,<:<10>:>);
if false then
alarm: disable traped(94);
end;
procedure opr_remove;
<* 97 *>
<*---------------------------------------------------*>
<* Nedlæg session, terminal eller bruger *>
<*---------------------------------------------------*>
begin
integer array user_id,term_id(1:4);
integer index,user_index,term_index,sess_index,t;
integer array struc_ref(1:1);
boolean found;
trap(alarm);
initref(struc_ref);
if read_param(term_in,command_name,0) then
begin
if check_priv(0) then
begin
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword=14 then
begin <* session *>
if read_param(term_in,user_id,0) and
read_param(term_in,command_name,index) then
begin
wait(struc_sema,struc_ref);
user_index:=find_login_user(user_id,user_list);
if user_index>0 then
begin
if false add (login_struc(user_index+4) shift (-12-index)) then
begin
found:=false;
term_index:=login_struc(user_index+6);
while not found and term_index>0 do
begin
sess_index:=login_struc(term_index+2);
while not found and sess_index>0 do
begin
if (login_struc(sess_index+1) extract 12)=index then
found:=true
else
sess_index:=login_struc(sess_index+3);
end;
term_index:=login_struc(term_index+3);
end;
if not remove_sess(sess_index) then
write(term_out,<:*** session not removed:>);
end
else
write(term_out,<:*** unknow user index:>);
end
else
write(term_out,string u_n_l);
signal(struc_sema,struc_ref);
end
else
write(term_out,string miss_par);
end
else
if command_keyword=9 then
begin <* user *>
if read_param(term_in,user_id,0) then
begin
t:=0;
wait(struc_sema,struc_ref);
user_index:=find_login_user(user_id,user_list);
if user_index>0 then
begin
term_index:=login_struc(user_index+6);
while term_index>0 do
begin
sess_index:=login_struc(term_index+2);
while sess_index>0 do
begin
if remove_sess(sess_index) then
t:=t+1;
sess_index:=login_struc(sess_index+3);
end;
term_index:=login_struc(term_index+3);
end;
end
else
write(term_out,string u_n_l);
signal(struc_sema,struc_ref);
write(term_out,<<dd >,t,<:session:>,if t<>1 then <:s:> else <::>,
<: removed:>);
end
else
write(term_out,string miss_par);
end
else
if command_keyword=8 then
begin <* terminal *>
if read_param(term_in,term_id,0) then
begin
t:=0;
wait(struc_sema,struc_ref);
term_index:=find_login_terminal(term_id,0);
if term_index>0 then
begin
sess_index:=login_struc(term_index+2);
while sess_index>0 do
begin
if remove_sess(sess_index) then
t:=t+1;
sess_index:=login_struc(sess_index+3);
end;
term_index:=login_struc(term_index+3);
end
else
write(term_out,string t_n_l);
signal(struc_sema,struc_ref);
write(term_out,<<dd >,t,<:session:>,if t<>1 then <:s:> else <::>,
<: removed:>);
end
else
write(term_out,string miss_par);
end
else
write(term_out,string ill_par,command_name.laf);
end;
end
else
write(term_out,string miss_par);
write(term_out,<:<10>:>);
if false then
alarm: disable traped(97);
end;
procedure opr_set;
<* 98 *>
<*---------------------------------------------------*>
<* Sæt værdi for timecheck eller antal terminaler *>
<*---------------------------------------------------*>
begin
integer user_index;
integer array user_id(1:4),ref(1:1),struc_ref(1:1);
trap(alarm);
initref(struc_ref);
if read_param(term_in,command_name,0) then
begin
if check_priv(0) then
begin
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword=8 then
begin <* terminal *>
if read_param(term_in,command_name,command_value) then
begin
if command_value<=maxterminals then
max_terms:=command_value
else
write(term_out,<:*** not enough resources<10>:>);
end
else
write(term_out,string miss_par);
end
else
if command_keyword=17 then
begin <* timecheck *>
if read_param(term_in,command_name,0) then
begin
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword=10 or command_keyword=11 then
begin <* on/off *>
timecheck_stat:=if command_keyword=10 then
true
else
false;
end
else
if command_keyword=9 then
begin <* user *>
if read_param(term_in,user_id,0) then
begin
if read_param(term_in,command_name,command_value) then
begin
if find_keyword_value(command_name.laf(1),1)=11 then
command_value:=25;
if command_value<=25 and command_value>=0 then
begin
wait(struc_sema,struc_ref);
user_index:=find_login_user(user_id,user_list);
if user_index>0 then
login_struc(user_index+4):=
((login_struc(user_index+4) shift (-12)) shift 12)+
command_value
else
write(term_out,string u_n_l);
signal(struc_sema,struc_ref);
end
else
write(term_out,string ill_time);
end
else
write(term_out, string miss_par);
end
else
write(term_out,string miss_par);
end
else
write(term_out,string ill_par,command_name.laf,<:<10>:>);
end;
<* start time check *>
initref(ref);
wait_select:=6;
wait(message_buf_pool,ref);
signal(time_sem,ref);
end
else
write(term_out,string ill_par,command_name.laf,<:<10>:>);
end;
end
else
write(term_out,string miss_par);
if false then
alarm: disable traped(98);
end;
procedure opr_start;
<* 99 *>
<*---------------------------------------------------*>
<* Start inlogning til systemet *>
<*---------------------------------------------------*>
begin
integer array ref(1:1);
trap(alarm);
if read_param(term_in,command_name,0) then
begin
if check_priv(0) then
begin
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword=16 then
begin <* login *>
login_stat:=96;
end
else
if command_keyword=15 then
begin <* system *>
if system_stop then
begin
initref(ref);
wait_select:=6;
wait(message_buf_pool,ref);
signal(free_sem,ref);
write(term_out,<:System restarted<10>:>);
end
else
write(term_out,<:*** System not stoped<10>:>);
end
else
write(term_out,string ill_par,command_name.laf,<:<10>:>);
end;
end
else
write(term_out,string miss_par);
if false then
alarm: disable traped(99);
end;
procedure opr_stop;
<* 100 *>
<*---------------------------------------------------*>
<* Stop inlogning eller hele systemet *>
<*---------------------------------------------------*>
begin
zone z(4,1,stderror);
integer array ia(1:8);
integer array dummy(1:1);
integer user_index,i,stop_time;
trap(alarm);
initref(dummy);
if read_param(term_in,command_name,0) then
begin
if check_priv(4) then
begin
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword=15 then
begin <* system *>
if read_param(term_in,command_name,stop_time) then
begin
if stop_time=0 then
begin
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword=20 then
begin <* check *>
stop_time:=8388606;
write(term_out,<:System stopping after check<10>:>);
end
else
if command_name.laf(1)<> long <:0:> then
begin
write(term_out,string ill_par,command_name.laf,<:<10>:>);
goto start;
end;
end
else
write(term_out,<:System stopping<10>:>);
setposition(term_out,0,0);
opera_terms(cor_nr,1):=1;
login_stat:=0;
system_stop:=true;
timecheck_stat:=false;
write_message(-100,if stop_time<>8388606 then stop_time
else -1,true,<:Operator system stop:>);
for i:=1 step 1 until stop_time do
begin
if (stop_time=8388606) and (sessions=0) then
goto stop_sys;
notis_users(stop_txt);
if i<stop_time then
begin
wait(struc_sema,dummy);
user_index:=user_list;
while user_index>0 do
begin
if login_struc(user_index+4) extract 12 = 26 then
login_struc(user_index+4):=
(login_struc(user_index+4) shift (-12)) shift 12 ;
user_index:=login_struc(user_index+7);
end;
signal(struc_sema,dummy);
end;
wait_time:=600;
if wait(free_sem,dummy)>0 then
begin
signal(message_buf_pool,dummy);
system_stop:=false;
finis:=true;
if head_consol=1 then
write(term_out,<:System restarted<10>:>);
head_consol:=1;
wait(struc_sema,dummy);
user_index:=user_list;
while user_index>0 do
begin
login_struc(user_index+4):=
((login_struc(user_index+4) shift (-12)) shift 12) + 25;
user_index:=login_struc(user_index+7);
end;
signal(struc_sema,dummy);
goto start;
end;
end;
stop_sys:
<* Send stop message til tasterm *>
ia(1):=14 shift 12 + 0;
ia(2):=0;
open(z,0,tasterm_name,0);
send_mess(z,ia);
monitor(18,z,1,ia);
goto stop;
end
else
write(term_out,string miss_par);
end
else
if command_keyword=16 then
begin <* login *>
read_param(term_in,command_name,i);
if i<0 or i>95 then
write(term_out,string ill_val)
else
login_stat:=i;
end
else
write(term_out,string ill_par,command_name.laf,<:<10>:>);
end;
end
else
write(term_out,string miss_par);
start:
if false then
alarm: disable traped(100);
end;
procedure opr_terminal;
<* 101 *>
<*---------------------------------------------------*>
<* Udskriv alle terminaler der er inlogget *>
<*---------------------------------------------------*>
begin
integer user_index,term_index,t,i;
integer array term_id,user_id(1:4);
trap(alarm);
t:=0;
user_index:=user_list;
while user_index>0 and not out_stop do
begin
for i:=0 step 1 until 3 do
user_id(i+1):=login_struc(user_index+i);
term_index:=login_struc(user_index+6);
while term_index>0 and not out_stop do
begin
get_proc_name(login_struc(term_index),term_id);
write(term_out,<:<10>:>,true,20,term_id.laf,true,11,user_id.laf);
term_index:=login_struc(term_index+3);
t:=t+1;
end;
user_index:=login_struc(user_index+7);
end;
write(term_out,<:<10><10>Terminals = :>,t);
if false then
alarm: disable traped(101);
end;
procedure opr_user;
<* 102 *>
<*---------------------------------------------------*>
<* Udskriv alle brugerer der er tilmeldt *>
<*---------------------------------------------------*>
begin
integer user_index,t,i;
integer array user_id(1:4);
trap(alarm);
t:=0;
user_index:=user_list;
while user_index>0 and not out_stop do
begin
for i:=0 step 1 until 3 do
user_id(i+1):=login_struc(user_index+i);
write(term_out,<:<10>:>,true,11,user_id.laf);
t:=t+1;
user_index:=login_struc(user_index+7);
end;
write(term_out,<:<10><10>Users = :>,t);
if false then
alarm: disable traped(102);
end;
<****************************************>
<* Hoved rutinen for operatør korutinen *>
<****************************************>
trap(alarm);
claim(600); <* Reserver plads på stakken *>
initref(ref);
wait_time:=0;
wait_select:=0;
while true do
begin
break:=false;
finis:=false;
wait(opera_terms(cor_nr,2),ref);
head_consol:=ref(3);
<* sæt uændret besked buffer tilbage i pool *>
signal(message_buf_pool,ref);
if get_proc_name(opera_terms(cor_nr,1),term_name) then
begin
open(term_out,8,term_name,1 shift 16 + 1 shift 9);
open(term_in,8,term_name,1 shift 9);
if head_consol=1 then
begin <* Ikke hoved terminalen *>
<* Hent user id fra terminal *>
getzone6(term_in,ia);
ia(1):=131 shift 12 + 0; <* get user id *>
ia(2):=ia(19)+1; <* first address *>
ia(3):=ia(19)+11; <* last address *>
buf:=send_mess(term_in,ia);
if buf=0 then
break:=true
else
begin
if not wait_ans(term_in,buf,100,opera_terms(cor_nr,2),false) then
break:=true <* Der blev ikke svaret inden 10 sek. *>
else
begin
if monitor(18,term_in,1,ia)<>1 then
break:=true
else
if ia(1)<>0 then
break:=true
else
begin
close(term_in,false);
for i:=1,2 do
user_id.laf(i):=term_in.laf(i);
password:=term_in.laf(3);
open(term_in,8,term_name,1 shift 9);
<* Find privilegier i login_struc *>
user_ident:=find_login_user(user_id,user_list);
if user_ident=0 then
break:=true <* Bruger ikke login *>
else
priv:=false add (login_struc(user_ident+5) shift (-12));
end;
end;
end;
end
else
priv:=true; <* alle privilegier *>
if not break then
write(term_out,<:<10>Operator ready<10>:>)
else
begin
write(term_out,
<:Tas operatør-adgang ikke tilladt fra denne terminal<10>:>);
setposition(term_out,0,0);
monitor(64,term_out,0,command_name <*dummy*>);
end;
while not (finis or break) do
begin <* Udfør operatør kommunikation *>
setposition(term_out,0,0);
write(term_out,<:$ :>);<* Prompt *>
setposition(term_out,0,0);
setposition(term_in,0,0); <* Slet input buffer *>
if read_param(term_in,command_name,0) then
begin
if not break then <* break evt. sat af write el. read_param *>
begin
<* fortolk kommando i commandline *>
command_keyword:=find_keyword_value(command_name.laf(1),1);
if command_keyword>7 or command_keyword=0 then
begin
write(term_out,<:*** unknown command: :>,
command_name.laf,<:<10>:>);
setposition(term_out,0,0);
end
else
begin
out_stop:=false;
case command_keyword of
begin
<* Udfør kommando *>
<* Test for out_stop ved hver setposition på output *>
<* er denne true stoppes evt ydeligerer udskrift *>
<* Test for break efter hver i/o, er denne true *>
<* stoppes udførelsen af kommandoen *>
opr_finis;
opr_disp;
opr_message;
opr_remove;
opr_set;
opr_start;
opr_stop;
end;
end;
end;
end;
if head_consol=0 then
begin
write(term_out,<:ok<10>:>);
finis:=true; <* Hoved terminal *>
end;
end; <* session *>
end;
close(term_in,true);
close(term_out,true);
opera_terms(cor_nr,1):=0;
end; <* while true *>
stop:
if false then
alarm: disable traped(85);
end; <* Operatør korutine *>
<**************************************>
<**************************************>
<* Procedure til time ckeck korutinen *>
<**************************************>
<**************************************>
integer procedure next_hour;
<* 103 *>
<*------------------------------------------------------------*>
<* Beregn ventetiden til næste hele klokkeslet i *>
<* 0.1 sek enheder *>
<* *>
<* Return : Tiden til næste hele klokkeslet i 0.1 sek enheder *>
<*------------------------------------------------------------*>
begin
real r;
long t;
systime(1,0,r);
t:=r;
next_hour:=round(3600-t+t//3600*3600)*10;
end;
procedure notis_users(txt);
<* 104 *>
<*--------------------------------------------------------------------*>
<* Find bruger der har overskredet tiden eller alle hvis stop *>
<* Send log_txt og mærk tiden med 26 *>
<* Gentag for alle brugere *>
<*--------------------------------------------------------------------*>
integer array txt;
begin
integer user_index,term_index,map,ut,nr;
boolean found;
integer array ref(1:1),struc_ref(1:1);
trap(alarm);
initref(ref);
initref(struc_ref);
found:=true;
repeat
nr:=set_text_buf(txt);
if nr=0 then
begin
wait_time:=100;
wait(delay_sem,ref);
end;
until nr>0;
while found do
begin
wait(struc_sema,struc_ref);
found:=false;
user_index:=user_list;
while user_index>0 and not found do
begin
ut:=login_struc(user_index+4) extract 12;
found:=(ut<=cur_time) or (system_stop and (ut<>26));
if not found then
user_index:=login_struc(user_index+7);
end;
if found then
begin
map:=login_struc(user_index+4) shift (-12);
login_struc(user_index+4):=(map shift 12)+26;
term_index:=login_struc(user_index+6);
while term_index>0 do
begin
mess_to_term(term_index,nr);
term_index:=login_struc(term_index+3);
end;
end;
signal(struc_sema,struc_ref);
send_message_text(nr);
end;
if false then
alarm: disable traped(104);
end;
procedure remove_users;
<* 105 *>
<*--------------------------------------------------------------------*>
<* Find første bruger der har 26 sat i tid *>
<* Send remove session message til TAS og sæt tid 27 *>
<* Gentag for alle *>
<*--------------------------------------------------------------------*>
begin
integer user_index,term_index,sess_index,map;
boolean found;
integer array struc_ref(1:1);
trap(alarm);
initref(struc_ref);
found:=true;
while found do
begin
wait(struc_sema,struc_ref);
found:=false;
user_index:=user_list;
while user_index>0 and not found do
begin
found:=(login_struc(user_index+4) extract 12)=26;
if not found then
user_index:=login_struc(user_index+7);
end;
if found then
begin
map:=login_struc(user_index+4) shift (-12);
login_struc(user_index+4):=(map shift 12)+27;
term_index:=login_struc(user_index+6);
while term_index>0 do
begin
sess_index:=login_struc(term_index+2);
while sess_index>0 do
begin
remove_sess(sess_index);
sess_index:=login_struc(sess_index+3);
end;
term_index:=login_struc(term_index+3);
end;
end;
signal(struc_sema,struc_ref);
end;
if false then
alarm: disable traped(105);
end;
procedure timeco;
<* 106 *>
<*--------------------------------------------*>
<* Hoved procedure for check time korutinen *>
<*--------------------------------------------*>
begin
integer array dummy(1:1);
integer user_index,i,last_time;
integer array id(1:4);
trap(alarm);
claim(500);
initref(dummy);
while true do
begin
wait_time:=next_hour;
if wait(time_sem,dummy)>0 then
signal(message_buf_pool,dummy);
if cur_time=0 then
begin
wait(struc_sema,dummy);
user_index:=user_list;
while user_index>0 do
begin
for i:=0,1,2,3 do
id(i+1):=login_struc(user_index+i);
find_user(id);
last_time:=if check_time(last_time) then
last_time
else
0;
login_struc(user_index+4):=
((login_struc(user_index+4) shift (-12)) shift 12) + last_time;
user_index:=login_struc(user_index+7);
end;
signal(struc_sema,dummy);
end;
for i:=1 step 1 until log_time do
begin
if timecheck_stat then
begin
notis_users(log_txt);
if i<log_time then
begin
wait(struc_sema,dummy);
user_index:=user_list;
while user_index>0 do
begin
if login_struc(user_index+4) extract 12 = 26 then
login_struc(user_index+4):=
(login_struc(user_index+4) shift (-12)) shift 12 ;
user_index:=login_struc(user_index+7);
end;
signal(struc_sema,dummy);
end;
wait_time:=600;
if wait(time_sem,dummy)>0 then
signal(message_buf_pool,dummy);
end;
end;
if timecheck_stat then
remove_users;
end;
if false then
alarm: disable traped(106);
end;
procedure write_term_text; <* Korutine *>
<* 107 *>
<*---------------------------------------------------------------*>
<* Gemmenløb alle terminaler for at udskrive en evt tekst der er *>
<* markeret i login_struc. Start gennemløb ved signalering fra *>
<* send_text proceduren. Efter udskrift frigives text-buffer *>
<* *>
<* Formater af sem-message: *>
<* *>
<* Ved send_text: (1) buf nr. *>
<* (2) message_buf_addr *>
<* (3) text_write_sem *>
<* (4) zone array index *>
<* *>
<* Ved signal : (1) 0 *>
<* (2) 8 *>
<* (3) text buf. nr. *>
<* (4) 0 *>
<* *>
<*---------------------------------------------------------------*>
begin
integer array ref(1:1),answer(1:8);
integer out_count,i,buf_nr;
boolean finis;
zone array z(max_text_count,1,1,stderror);
boolean procedure write_next_term;
<* 108 *>
<*-----------------------------------------------------*>
<* Udskriv text på en terminal (den første der findes) *>
<*-----------------------------------------------------*>
begin
integer array ref(1:1),share(1:12);
integer user_index,term_index,bufs,nr,i,buf_addr;
integer array struc_ref(1:1);
boolean found;
trap(alarm);
initref(ref);
initref(struc_ref);
wait(struc_sema,struc_ref);
found:=false;
user_index:=user_list;
while (user_index>0) and (not found) do
begin
term_index:=login_struc(user_index+6);
while term_index>0 and not found do
begin
bufs:=login_struc(term_index+1) shift (-21);
if bufs<>0 then
begin
found:=true;
nr:=0;
while not (false add (bufs shift (-nr))) do
nr:=nr+1;
nr:=nr+1;
login_struc(term_index+1):=login_struc(term_index+1)-
(1 shift (20+nr));
i:=1;
repeat
getshare6(z(i),share,1);
i:=i+1;
until share(1)<2;
i:=i-1;
share(4):=16 shift 12;
share(5):=nr;
share(6):=login_struc(term_index);
setshare6(z(i),share,1);
buf_addr:=monitor(16,z(i),1,share);
if buf_addr=0 then
write_message(998,1,false,<:Claims exceeded:>);
text_buf_reserved(nr):=if text_buf_reserved(nr)=-1 then
1
else
text_buf_reserved(nr)+1;
wait_select:=8;
wait(message_buf_pool,ref);
ref(1):=nr;
ref(2):=buf_addr;
ref(3):=text_write_sem;
ref(4):=i;
signal(wait_answer_pool,ref);
end
else
term_index:=login_struc(term_index+3);
end;
user_index:=login_struc(user_index+7);
end;
write_next_term:=not found;
signal(struc_sema,struc_ref);
if false then
alarm: disable traped(108);
end; <* write_next_text *>
trap(alarm); <* main write_term_text *>
claim(500);
initref(ref);
out_count:=0;
for i:=1,2,3 do
text_buf_reserved(i):=0;
for i:=1 step 1 until max_text_count do
open(z(i),0,tasterm_name,1 shift 9);
while true do
begin
wait(text_write_sem,ref);
if ref(1)<>0 then
begin
<* answer *>
monitor(18,z(ref(4)),1,answer);
text_buf_reserved(ref(1)):=text_buf_reserved(ref(1))-1;
ref(1):=0;
ref(2):=8;
signal(message_buf_pool,ref);
out_count:=out_count-1;
end
else
begin
<* Ny tekst *>
buf_nr:=ref(3);
signal(message_buf_pool,ref);
finis:=false;
while not finis do
begin
if out_count=max_text_count then
begin
wait_select:=-1;
wait(text_write_sem,ref);
monitor(18,z(ref(4)),1,answer);
text_buf_reserved(ref(1)):=text_buf_reserved(ref(1))-1;
ref(1):=0;
ref(2):=8;
signal(message_buf_pool,ref);
out_count:=out_count-1;
end;
finis:=write_next_term;
if not finis then
out_count:=out_count+1;
end;
if text_buf_reserved(buf_nr)=-1 then
text_buf_reserved(buf_nr):=0;
end;
end;
if false then
alarm: disable traped(107);
end;
<*************************************************>
<* Start af tascat og initialisering af korutiner*>
<*************************************************>
trap(alarm);
<* Initialiser login_struc *>
init_login_struc;
<* Opret korutinerne og semafor beskrivelserne *>
activity(3+number_of_opera);
coroutines(5+number_of_opera,test_out);
sys_start:=true;
<***********************************************************>
<* Alloker alle besked buffere på stakken og signaler dem *>
<* til semaforen message_buf_pool *>
<* En buffer kan hentes fra poolen på følgende måde: *>
<* wait_selct:= 'besked buffer størrelse'; *>
<* wait(message_buf_pool,ref); *>
<* *>
<* Når bufferen ikke skal benyttes mere sættes den tilbage *>
<* ref(1):=0; *>
<* ref(2):='besked buffer størrelse'; *>
<* signal(message_buf_pool,ref); *>
<***********************************************************>
for i:=1 step 1 until (2*number_of_opera) do
allocate(message_buf_pool,6,0);
for i:=1 step 1 until (3 + max_text_count) do
allocate(message_buf_pool,8,0);
allocate(message_buf_pool,22,0);
allocate(struc_sema,6,0);
select_test:=test_select;
<* Vent på synkronisering med tasterm *>
wait_tasterm(false);
<* Start korutinerne *>
new_activity(1,0,catco); <* Katalog hovedrutinen *>
new_activity(2,0,timeco); <* Time check rutinen *>
new_activity(3,0,write_term_text);
for i:=4 step 1 until number_of_opera+3 do
new_activity(i,0,operator,i); <* Operatør rutinerne *>
<* Start kerne, Udskriv version *>
write_message(struc_size,number_of_opera,true,<:Tas version 1.0 ready:>);
i:=kernel(traped);
answer(4):= <:ok :> shift (-24) extract 24;
answer(5):= <: :> shift (-24) extract 24;
if not system_stop then
begin
alarm:traped(0);
write_message(run_alarm_pos,run_alarm_cause,true,<:Run error:>);
answer(4):= <:err:> shift (-24) extract 24;
answer(5):= <:or :> shift (-24) extract 24;
end;
close(usercat,true);
close(termcat,true);
close(typecat,true);
close_test_out;
sys_start:=false;
end; <* TASCAT *>
<******************************************>
<* Program start og initialisering *>
<******************************************>
<* Sæt global trap lable *>
trap(init_alarm);
<* sæt fields *>
sender_pda:=2;
reciever_pda:=4;
buf_addr:=6;
mess_array:=6;
laf:=iaf:=baf:=0;
<* sæt status *>
trap_mode:=-1;
sys_start:=false;
system_stop:=false;
test_on:=false;
killed:=false;
users:=
sessions:=
terms:=0;
run_alarm_pos:=
run_alarm_cause:=0;
<* initialiser konstant tekster *>
ill_par:= real <:*** illegal parameter: :>;
miss_par:= real <:*** missing parameter<10>:>;
ill_val:= real <:*** illegal value<10>:>;
long_text:= real <:*** text too long or input terminated by /<10>:>;
t_n_l:= real <:*** terminal not login<10>:>;
u_n_l:= real <:*** user not login<10>:>;
ill_time:= real <:*** illegal login time<10>:>;
c_p := real <:*** communication problems<10>:>;
<* Fjern fp area proces og in zonen *>
open(test_out,4,<:fp:>,0);
close(test_out,true);
close(in,true);
<* Fjern c og v entry *>
open(copy_buf,0,<:c:>,0);
monitor(48,copy_buf,i,log_txt);
close(copy_buf,true);
open(copy_buf,0,<:v:>,0);
monitor(48,copy_buf,i,log_txt);
close(copy_buf,true);
isotable(char_table);
for i:=0 step 1 until 127 do
char_table(i+128):=char_table(i)+128;
char_table(46):=7 shift 12 + 46;
intable(char_table);
<* Initialiser hovedterminalen *>
head_term_pda:=system(7,i,head_term_name.laf);
<* initialiser keywords *>
keywords_init;
<* Læs fp parametre *>
read_param_line;
<* Sæt konstant værdier m.m fra init fil *>
init_tascat;
<* Åben test output filen *>
open_test(testout_name);
<* initialiser semafor navnene med nummer *>
init_sem;
<* Test og initialiser baserne for processen *>
init_bases;
<* init opera_terms array'et *>
init_opera_terms;
<* Beregn struc_size og test processens størrelse *>
struc_size:=2*max_users+max_terminals+max_sessions;
max_terms:=if fp_maxterms>0 then
fp_maxterms
else
max_terminals;
system(2,own_size,prog_name.laf);
<* Hent oversættelses dato og tid for tascat *>
begin
integer segm,rel;
integer array tail(1:10);
zone z(128,1,stderror);
open(z,4,prog_name,0);
monitor(42,z,0,tail);
segm:=tail(7) shift (-12);
rel:=tail(7) extract 12;
setposition(z,0,segm);
inrec6(z,rel-4);
inrec6(z,4);
reld:=z(1) shift (-24) extract 24;
relt:=z(1) extract 24;
close(z,true);
end;
if struc_size>(own_size-5000-number_of_opera*1500)//8 then
write_message(own_size,25000+number_of_opera*1500+struc_size*8,
false,<:Process too small:>)
else
begin
<* Åben katalogerne *>
open_catalogs(usercat_name,termcat_name,typecat_name);
<* test buffer claims *>
system(5,own_pda+26,testout_name <* work array *>);
if (testout_name(1) shift (-12))<(max_text_count+3+ number_of_opera) then
write_message(testout_name(1) shift (-12)+2,
max_text_count+5+number_of_opera,
false,<:Not enough buffers:>);
if false then
begin <* trap i initialiseringen *>
init_alarm: traped(0);
write_message(run_alarm_pos,run_alarm_cause,true,<:Initiation error:>);
wait_tasterm(true);
answer(4):= <:err:> shift (-24) extract 24;
answer(5):= <:or :> shift (-24) extract 24;
end
else
<* start hovedproceduren *>
tascat;
if killed then
write_message(0,3,true,<:System breaked:>)
else
write_message(0,4,true,<:System stopped:>);
system(11,i,log_txt);
sys_bases(1):=log_txt(1);
sys_bases(2):=log_txt(2);
set_cat_bases(sys_bases);
answer(1):=2 shift 12 + 1;
answer(2):= <: st:> shift (-24) extract 24;
answer(3):= <:op :> shift (-24) extract 24;
for i:=6,7,8 do
answer(i):=0;
system(10,0,answer);
end;
end;
▶EOF◀