|
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: 241152 (0x3ae00)
Types: TextFile
Names: »tctxt «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦39138f30b⟧
└─⟦this⟧ »tctxt «
<****************************************************************************>
<* SW8110 Terminal Access System *>
<* Catalog and Operator Program 'tascat' *>
<* *>
<* Henning Godske 890818 *>
<* 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 menu processen herunder overførsel af init *>
<* data til menu. *>
<* e) Opstart af korutiner: 1) Katalog vedligeholdelse og modtagelse af *>
<* message fra Menu og bruger processer. *>
<* 2) Timecheck rutinen til evt. automatisk *>
<* udlogning af brugerer. *>
<* 3) Kontrol af afsendelse af tekster til *>
<* terminaler via menu processen. *>
<* 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 menu-processen. *>
<* Besvarelse af message fra bruger-processer. *>
<* Opstart af operatør rutiner. *>
<****************************************************************************>
<****************************************************************************>
<* Revision history: *>
<* *>
<* 87.05.06 tascat release 1.0 *>
<* 87.08.14 tascat release 1.1 ingen ændringer *>
<* 88.02.25 mode parameter in type catalog added *>
<* udvidet test på "Removed " (tidligere "No Connect") *>
<* System start tid i displ system *>
<* Nye MENU message: terminal_removed og terminal restart *>
<* Terminal PDA negativ = Midlertidigt fjernet *>
<* Release 1.2 OBS. Skal oversættes med algol rel. 3 *>
<* 88.08.30 Tascat Release 2.0 ingen ændringer *>
<* 89.02.22 NOLOGIN terminals added. Release 2.1 *>
<****************************************************************************>
<*******************************>
<* 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 'sent 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 *>
real start_time; <* Start time for Tas *>
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,<:Tas message : :>);
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 not 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 not 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
begin
if pda < 0 then
movestring(name.laf,1,<:No Connect:>)
else
movestring(name.laf,1,<:Removed :>);
end;
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 not set_cat_bases(cmcl_bases) then
b:=1;
if not 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:=51;
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:>,<:mode:>,<:init:>,
<* 51 *> <:nolog:>));
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);
<*--------------------------------------------------------------------------*>
<* ******************* Katalog indholds beskrivelse ********************** *>
<*
Bruger katalog (user catalog) :
Indeholder i hver indgang oplysninger om en bruger, der har ad-
gang til RC8000 via menu-systemet.
Hvert segment pånær det første i user catalog indeholder 4
indgange.
Indgangene sorteres i de enkelte segmenter efter deres hash nøgle
således at nøglens værdi svarer til segmentets nummer.
Segmentnummer = hash nøgle
Første ord i hvert segment indeholder hash nøgle tælleren. Denne
angiver den samlede antal indgange i hele kataloget, der har hash
nøgle svarende til segments nummer.
Format af første segment i bruger kataloget :
+0 : 1 ; User catalog
+2 : Catalog size (segments inc. segment 0)
+4 : Entry length i hw's for a user entry.
+8 : Generate date (short time)
+10 : Not used
+254: - -
Bruger indgang format :
+0 : Hash key (0 = empty entry)
+2 : User id (key)
+10 : Password
+14 : Login time limits: Monday
+15 : Tuesday
+16 : Wednesday
+17 : Thursday
+18 : Friday
+19 : Saturday
+20 : Sunday
+21 : User block count
+22 : Max. user index
+23 : Privilege
+24 : MCL program name
+32 : User MCL bases (lower, upper)
+36 : Terminal group limit (bit map)
+44 : MCL default variable text (mcl-text format)
+100: Free text (30 char)
+120: Time stamp
+122: Not used
+124: - -
Et segment indeholder (bortset fra segment 0):
+0 : Hash nøgle tæller
+2 : Entry 0
+128: Entry 1
+254: Entry 2
+380: Entry 3
+506: not used
+510: - -
Hash nøgel :
Hash nøglen beregnes ved:
Summen af de 4 integer der indgår i user id teksten beregnes til
S.
Hash key = 1+((ABS S) mod (n-1)) hvor n er antallet af segmenter
i kataloget (seg. 0 til seg. n-1).
User id:
Bruger navn. Fra 1 til 11 tegn afsluttet med nul-tegn. Kan kun
indgå i en indgang i brugerkataloget. (Nøgle)
Password:
Kryptograferet løsen (metode se ??). Værdien nul angiver at der
intet løsen er tilknyttet denne indgang.
Login time limits:
Angiver for hver dag i ugen det tidsrum, hvor indlogning for bru-
geren er tilladt.
Angives som første tidspunkt og sidste tidspunkt i hele timer (0-
24). Sidste tidspunkt er det klokkeslet, hvor brugeren bliver
logget ud.
Dagen og første tid er sammenhørende. Er aktuel tid (A) mindre
end første tid (F) prøves med dagen før, der da skal være af type
2. Hvis aktuel tid her er mindre end sidste tid (S) gives adgang.
Ellers skal gælde:
( F<S and A>=F and A<S ) or
( F>S and ( 24>A>=F or 0<=A<S ))
og typen skal være 1, 2 eller 3.
Hver dag beskrives i 1 HW ved:
F<7 + S<2 + type
Hvor type er: 0 = Ingen adgang denne dag.
1 = Første tid mindre end sidste tid.
2 = Første tid større end sidste tid.
3 = Adgang hele dagen (0 til 24).
User block count:
Angiver antal gange (i træk), der er førsøgt refereret til denne
indgang med forkert password.
Værdien nulstilles ved korrekt reference, hvis grænsen ikke er
nået.
Max. user index:
Angiver det maximale antal sessioner en bruger må have samtidig
(ved en eller flerer terminaler). Værdien skal ligge mellem 1 og
12 ink.
Privilege:
Brugerens privilegier er beskrevet i dette felt.
Bit: 0 = Menu-system control
1 = Catalog update/list
2 = MCL control
3 = Message control
4 = List control
MCL program name:
Navnet på det oversatte MCL-program, der skal udføres ved start
af en session.
User MCL bases:
Det base-interval, hvorpå der ledes efter et MCL-program, hvis
det ikke er kendt af menu-systemet.
Første værdi er nedre base, anden værdi er øvre base.
Terminal group limit:
Angiver hvilke terminalgrupper, der må benyttes af brugeren.
En bruger kan benytte terminaler i en eller flerer af grupperne 0
til 95. Angivet som bitmap, hvor bit 0 sat angiver at bruger må
benytte terminaler fra terminalgruppe 0, bit 1 fra terminalgruppe
1 o.s.v.
MCL default variable text:
Tekst der overføres til variabel (T) i MCL ved start af session.
Format som ved CMCL-text.
Free text:
Fri tekst til f.eks at beskrive brugeren (Navn m.m). Der kan
angives op til 30 tegn efterfulgt af nul-tegn.
Time stamp:
Tidsangivelse (access tæller ), der sættes når nyt indhold sættes
i entry. Benyttes til at kontrolerer gyldigheden af læst data ved
senere rettelse.
Terminal katalog (terminal catalog)
Indeholder i hver indgang en beskrivelse af en terminal, der er
tilsluttet via menu-systemet.
Hvert segment i terminal catalog pånær segment 0 indeholder 14
indgange.
Indgangene sorteres i de enkelte segmenter efter deres hash
nøglesåledes at nøglens værdi svarer til segmentets nummer.
Segmentnummer = hash nøgle
Første ord i hvert segment indeholder hash nøgle tælleren. Denne
angiver den samlede antal indgange i hele kataloget der har hash
key svarende til segments nummer.
Format af første segment i terminal kataloget
+0 : 2 ; Terminal catalog
+2 : Catalog size (segments inc. segment 0)
+4 : Entry length i hw's for a terminal entry.
+8 : Generate date (short time)
+10 : Not used
+254: - -
Terminal katalog format
+0 : Hash key (0 = empty entry)
+2 : Terminal name
+10 : Terminal type
+11 : Terminal block count
+12 : Nologin < 1 + Bypass
+13 : Terminal group
+14 : Free text (30 char.)
+34 : Time stamp
Segment indhold:
+0 : Hashnøgle tæller
+2 : Entry 0
+38 : Entry 1
+74 : Entry 2
.
.
+470: Entry 13
+506: not used
+510: - -
Hash nøgle:
Hash nøglen beregnes ved:
Summen af de 4 integer der indgår i user id teksten beregnes til
S.
Hash key = 1+((ABS S) mod (n-1)) hvor n er antallet af segmenter
i kataloget (seg. 0 til seg. n-1).
Terminal name:
Navnet på den externe proces, der er tilknyttet terminalen i
samme format som proces beskriverens navnefelt.
Terminal type:
Tal der refererer til beskrivelsen af terminalens type i ter-
minaltype kataloget. Typen skal ligge mellem 1 og antal af
segmenter i terminaltype kataloget gange 4.
Terminal block count:
Angiver antal gange (i træk), der er forsøgt indlogning fra denne
terminal uden at korrekt 'userid' er opgivet.
Værdien nulstilles ved korrekt indlogning, hvis den ikke har nået
grænsen.
Bypass:
Angiver om terminalen skal gå uden om menu systemet ved oprettelse af link.
0 = No bypass, 1 = Bypass.
Nologin:
Angiver om TAS skal oprette et link for terminalen ved opstart.
0 = No link, 1-99 = LAN number to use (lanmainxx)
Terminal group:
Angiver hvilken gruppe (en ud af grupperne 0 til 95) terminalen
indgår i.
Free text:
Fri tekst til f.eks at beskrive terminalens fysiske placering.
Der kan angives op til 30 tegn.
Time stamp:
Tidsangivelse der sættes når nyt indhold sættes i entry. Benyttes
til at kontrolerer gyldigheden af læst data ved senere rettelse.
Terminal type katalog
Indeholder i hver indgang beskrivelse af en bestem type terminals
funktioner.
Kataloget indeholder 4 indgange per segment.
En indgang findes ved at benytte typen som index.
segment = ((type-1) div 4)+1.
indgang i segment = 128*((type-1) mod 4)
Format af første segment i terminaltype kataloget
+0 : 3 ; Terminal type catalog
+2 : Catalog size (segments inc. segment 0)
+4 : Entry length i hw's for a type entry.
+8 : Generate date (short time)
+10 : Not used
+254: - -
Terminaltype indgang format
+0 : Terminal type (0= empty entry)
+2 : Screen type (set of values 0 to 11)
+3 : Mode (set term. spec. mode)
+4 : Number of colums on line
+5 : Number of lines on display
+6 : Send by CURSOR UP key
+7 : Send by CURSOR DOWN key
+8 : Send by CURSOR LEFT key
+9 : Send by CURSOR RIGHT key
+10 : Send by HOME key
+11 : Send by DELETE key
+12 : Clear to end of display seq.
+16 : Clear to end of line seq.
+20 : Invers on seq.
+24 : Invers off seq.
+28 : High light on seq.
+32 : High light off seq.
+36 : Delete line seq. (move succeeding lines up)
+40 : Insert line seq. (move lines down)
+44 : Cursor addressing seq.
+50 : Cursor up char.
+51 : Cursor down char.
+52 : Cursor left char.
+53 : Cursor right char.
+54 : Cursor home char.
+55 :
+56 : Init. terminal (75 char.)
+106: Free text (30 char.)
+126: Time stamp
Format af data.
Send by (sb) værdierne angiver værdien af det tegn, der sendes af
den pågældende tast.
Sekvenserne (seq.) kan bestå af op til 6 tegn. Ikke benyttede
tegn sættes til 0. Er første tegn et 0 er den pågældende funktion
ikke tilgænglig på terminalen.
Initialiserings sekvensen kan sendes til terminalen ved f.eks
opstart. Sekevensen kan f.eks være initialisering af funktions
tasterne. Der kan angives op til 30 tegn. Ikke benyttede tegn
sættes til 0.
Screen type
Angiver hvilke karekteristika den enkelte skærmtype har.
Bit: 0 = Terminal is a hardcopy (paper) terminal.
1 = Scroll when 'nl' on the last line
2 = Scroll when write in then last character on the
screen
3 =
.
.
11 =
Cursor addressing seq.:
Sekvensen består af op til 7 skrivbare tegn samt to positions-
tegn. Positions-tegnene står på de steder i sekvensen, hvor
cursor-positions værdierne skal sendes.
Positions tegnene er opbygget som:
(pos. er positionsværdi ved adresseringen)
bit: værdi: (bit 0 er MSB)
0 1 = Positionstegn markering sammen med bit 1 ellers
kontroltegn med MSB sat.
0 = Andet tegn
1 1 = Positionstegn markering sammen med bit 0 ellers
skrivbart tegn.
0 = Andet tegn.
2 1 = Brug pos. som colonne
0 = Brug pos. som linie
3 1 = Adder 1 til pos.
0 = intet
4 1 = Adder 32 til pos.
0 = intet
5 1 = Exclusive or pos med 140(octal)
0 = intet
6 1 = Udskriv pos. som et tegn (tegnværdi lig pos.)
0 = Udskriv pos. som 2 cifret decimal (2 tegn)
7 intet
Free text
Benyttes f.eks til at angive hvilken type terminal der er
beskrevet i denne indgang i kataloget. Der kan angives op til 30
tegn.
Time stamp:
Tidsangivelse der sættes når nyt indhold sættes i entry. Benyttes
til at kontrolerer gyldigheden af læst data ved senere rettelse.
*>
<*--------------------------------------------------------------------------*>
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=51 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;
clear_high(termcat.term_entry(7));
if key=24 then
begin <* bypass *>
if (not read_nr(cat_file,i)) or i<>0 then
termcat.term_entry(7):=termcat.term_entry(7)+(1 shift 12);
end;
if key=51 then
begin <* nologin *>
if not read_nr(cat_file,i) or i<0 or i>99 then
goto ill_nr;
termcat.term_entry(7):=termcat.term_entry(7)+(i shift 13);
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
boolean array field baf;
baf:=0;
<* 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>11 or i<0 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;
typecat.type_entry.baf(3):=false add (priv extract 12)
end;
if key=49 then
begin <* mode *>
if not read_nr(cat_file,i) or i>9 or i<0 then
goto ill_nr;
typecat.type_entry.baf(4):=false add (i extract 12)
end;
if (key>=27) and (key<=34) then
begin <* 'send by' værdier *>
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<=48) then
begin <* et tegns værdier *>
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;
movestring(hostid.laf,1,<: Velkommen til :>);
system(5,1192,val);
for i:=1,2,3,4 do
hostid(6+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 *>
copy_buf.iaf(34):=cls; <* Max create links *>
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), tasterm(1,1,std_error);
integer array ia(1:8);
long array la(1:10);
integer buf, lan;
trap(alarm);
write_message(-53,0,true,if error then <:Stop menu:> 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);
<* Find alle 'nologin' terminaler og beskriv dem for menu *>
open(tasterm,0,tasterm_name,1 shift 9);
term_entry := 2;
term_seg := 0;
find_term_seg(1);
repeat
if termcat.term_entry(1) <> 0 then
begin <* Check entry for nologin *>
lan := termcat.term_entry(7) shift (-13);
if lan <> 0 then
begin <* Nologin terminal *>
ia(1) := 20 shift 12 + 0;
ia(2) := termcat.term_entry(2);
ia(3) := termcat.term_entry(3);
ia(4) := termcat.term_entry(4);
ia(5) := termcat.term_entry(5);
ia(6) := <:lan:> shift (-24) extract 24;
ia(7) := <:mai:> shift (-24) extract 24;
ia(8) := <:n:> shift (-24) extract 24;
laf := 0;
put_number(ia.laf,23,<<d>,lan);
send_mess(tasterm,ia);
if monitor(18,tasterm,1,ia) <> 1 then
write_message(53,3,false,<:Sync. Error:>);
i := 1;
if ia(1) <> 0 then
put_text(la,i,<:Make link error : :>,18)
else
put_text(la,i,<:Link : :>,7);
laf := 2;
put_text(la,i,termcat.term_entry.laf,12);
i := 1;
write_message(lan,ia(1),true,string la(increase(i)));
end;
end;
next_term_entry;
until (term_seg = 1) and (term_entry = 2); <* Tilbage ved start ! *>
laf := 0;
ia(1) := 20 shift 12 + 0;
ia(2) := 0;
send_mess(tasterm,ia);
if monitor(18,tasterm,1,ia) <> 1 then
write_message(53,3,false,<:Sync. Error:>);
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 (Negative = terminal removed) *>
<* (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;
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 abs 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;
procedure terminal_removed;
<* 781 *>
<*-------------------------------------------------------------------------*>
<* Marker terminal som midlertidig fjernet. *>
<*-------------------------------------------------------------------------*>
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 abs 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 *>
login_struc(term_index) := -login_struc(term_index);
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(781);
end;
procedure terminal_restart;
<* 782 *>
<*-------------------------------------------------------------------------*>
<* Marker terminal som genstartet *>
<*-------------------------------------------------------------------------*>
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 abs 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. Sæt ny PDA *>
login_struc(term_index) := mess.mess_array(3);
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(782);
end;
<**************************************>
<* Hoveddel af procedure tasterm_mess *>
<**************************************>
trap(alarm);
if (mode<2) or (mode>9) 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;
terminal_removed;
terminal_restart;
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(31,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);
if get_proc_name(login_struc(term_index),term_id) then
begin
if find_login_terminal(term_id,login_struc(user_index+7))>0 then
movestring(term_id.laf,1,<:Removed :>); <* Optaget af anden terminal *>
end;
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 finish<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);
real r;
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
user_index:=user_list;
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 *>
write(term_out,<:<10>System start at: :>);
write(term_out,<<zddddd >,systime(4,start_time,r),r);
if system_stop then
write(term_out,<:<10>System is stopping:>);
write(term_out,<:<10><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 : :>,<<zddddd >,
tastermverd,tastermvert);
write(term_out,<:<10>Tascat : :>,<<zddddd >,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,user_list);
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,user_list);
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,user_list);
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 stopped<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 last logout<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,
<:Operatøradgang 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;
integer nh;
systime(1,0,r);
t:=r;
nh:=round(3600-t+t//3600*3600)*10;
if false add trace_type then
trace(103,nh,0,0);
next_hour:=nh;
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;
systime(1,0,start_time);
<* 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 *>
<* Udskriv version, Start kerne og system *>
write_message(struc_size,number_of_opera,true,<:Tas release 2.1 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
else
trapmode := -1;
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:=0;
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 <:*** menu 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 (algol rel. 3) *>
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+16);
inrec6(z,4);
segm:=z(1) shift (-12) extract 12;
rel:=z(1) 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,<:Tas 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);
if trapmode = (-1) then
answer(1):=2 shift 12 + 1
else
answer(1):=16 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◀