|
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: 288768 (0x46800)
Types: TextFile
Names: »tclist «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦f546e193b⟧
└─⟦this⟧ »tclist «
tctxt d.881007.1343
1 <****************************************************************************>
1 <* SW8110 Terminal Access System *>
1 <* Catalog and Operator Program 'tascat' *>
1 <* *>
1 <* Henning Godske 880830 *>
1 <* A/S Regnecentralen *>
1 <* *>
1 <* Compiler call :tc=algol connect.no fp.yes spill.no *>
1 <****************************************************************************>
1
1 begin
2 <****************************************************************************>
3 <* Vedligeholdelse af katalogerne, operatør kommunikation *>
4 <* og initialisering af systemet. *>
5 <* *>
6 <* Program skitse: *>
7 <* a) Læsning af intialiserings parametre fra init fil. *>
8 <* b) Åbning af test output filen. *>
9 <* c) Evt. oprettelse af nye katalogfiler ud fra catalog tekst fil *>
10 <* d) Synkronisering med menu processen herunder overførsel af init *>
11 <* data til menu. *>
12 <* e) Opstart af korutiner: 1) Katalog vedligeholdelse og modtagelse af *>
13 <* message fra Menu og bruger processer. *>
14 <* 2) Timecheck rutinen til evt. automatisk *>
15 <* udlogning af brugerer. *>
16 <* 3) Kontrol af afsendelse af tekster til *>
17 <* terminaler via menu processen. *>
18 <* 4) Operatør korutinerne. En for hver operatør *>
19 <* der skal kunne 'køre' samtidig, dog altid *>
20 <* en til brug for hovedkonsollen. *>
21 <* f) Start af kerne. *>
22 <* Besvarelse af message fra menu-processen. *>
23 <* Besvarelse af message fra bruger-processer. *>
24 <* Opstart af operatør rutiner. *>
25 <****************************************************************************>
26
26 <****************************************************************************>
27 <* Revision history: *>
28 <* *>
29 <* 87.05.06 tascat release 1.0 *>
30 <* 87.08.14 tascat release 1.1 ingen ændringer *>
31 <* 88.02.25 mode parameter in type catalog added *>
32 <* udvidet test på "Removed " (tidligere "No Connect") *>
33 <* System start tid i displ system *>
34 <* Nye MENU message: terminal_removed og terminal restart *>
35 <* Terminal PDA negativ = Midlertidigt fjernet *>
36 <* Release 1.2 OBS. Skal oversættes med algol rel. 3 *>
37 <* 88.08.30 Tascat Release 1.3 ingen ændringer *>
38 <****************************************************************************>
39
39
39 <*******************************>
40 <* Globale variable for tascat *>
41 <*******************************>
42
42
42 integer reld; <* Release datoer *>
43 integer relt;
44 integer initver;
45 integer tastermverd;
46 integer tastermvert;
47
47 integer array init_file_name(1:4); <* Navnet på init filen *>
48
48 integer number_of_opera; <* Antal operatør korutiner Max. 5 *>
49 integer array opera_terms(4:8,1:2); <* Beskrivelse af opr. rutiner *>
50 integer language; <* Sprog benyttet ved bruger udskrift*>
51
51 integer cps; <* Initialiserings parametre *>
52 integer cls;
53 integer max_sessions;
54 integer max_sysmenu;
55 integer max_terminals;
56 integer corebufs;
57 integer mclprogs;
58 integer termtypes;
59 integer max_users;
60
60 boolean system_stop; <* Systemet er ved at stoppe *>
61 integer login_stat; <* Aktuel login status for terminaler*>
62 integer fp_maxterms; <* Maxterms angivet ved kald *>
63 integer max_terms; <* Max. terminaler inlogget *>
64 integer terms; <* Aktuel antal terminaler inlogget *>
65 integer users; <* Aktuel antal brugerer inlogget *>
66 integer sessions; <* Aktuel antal sessioner *>
67
67 integer max_text_count; <* Max antal udestående 'sent text' *>
68 integer max_user_block; <* Max. antal user block før alarm *>
69 integer max_term_block; <* Max. antal term block før alarm *>
70
70 integer array text_buf_reserved(1:3); <* Text buffer reserveret *>
71 boolean timecheck_stat; <* Status for timecheck *>
72 integer array log_txt(0:27); <* Logout tekst for timecheck *>
73 integer array stop_txt(0:27);
74 integer log_time; <* Logout vente tid *>
75
75 integer array host_id(0:27); <* host navn signon tekst *>
76 integer array signon_text(0:68); <* operator signon tekst *>
77
77 zone head_term_zone(14,1,konsol_error);<* Hovedkonsol output zone *>
78 integer array head_term_name(1:4); <* Hovedkonsollens navn *>
79 integer head_term_pda; <* Hovedkonsol pda *>
80
80 integer tasterm_pda; <* Tasterm processens pda *>
81 integer array tasterm_name(1:4); <* Tasterm processens navn *>
82
82 integer own_size; <* Egen proces størrelse *>
83 integer own_pda; <* Egen proces pda *>
84 integer array own_name(1:4); <* Eget proces navn *>
85 integer array prog_name(1:4); <* Programmets navn *>
86
86 integer struc_size; <* Antal blokke i login_struc *>
87 integer user_list; <* Peger til user kæden i login_struc*>
88 integer free_list; <* Peger til free kæden i login_struc*>
89
89 boolean new_catalog; <* True = nyt katalog angivet *>
90 integer array cattxt_name(1:4); <* Navnet på katalog tekst filen *>
91 integer array cat_doc(1:4); <* Katalogernes dokument navn *>
92 zone cat_file(128,1,stderror); <* Zone til læsning af katalog tekst *>
93
93 integer array sys_bases(1:2); <* Base par for system baser *>
94 integer array cmcl_bases(1:2); <* Base par for cmcl filer *>
95
95 zone usercat(128,1,std_error); <* Zone til user kataloget *>
96 zone termcat(128,1,std_error); <* Zone til terminal kataloget *>
97 zone typecat(128,1,std_error); <* Zone til terminaltype kataloget *>
98 integer usercat_size; <* Antal segmenter i user kataloget *>
99 integer termcat_size; <* Antal segmenter i terminal kat. *>
100 integer typecat_size; <* Antal segmenter i terminaltype kat*>
101 integer array field user_entry; <* Aktuelt entry i user kat. segment *>
102 integer array field term_entry; <* Aktuelt entry i term kat. segment *>
103 integer array field type_entry; <* Aktuelt entry i type kat. segment *>
104 integer user_seg; <* Aktuelt seg. i zone fra user kat. *>
105 integer term_seg; <* aktuelt seg. i zone fra term kat. *>
106 integer user_entry_length; <* Længden af et entry i user kat. *>
107 integer term_entry_length; <* Længden af et entry i term kat. *>
108 integer type_entry_length; <* Længden af et entry i type kat. *>
109 integer array usercat_name(1:4); <* Bruger katalogets fil navn *>
110 integer array termcat_name(1:4); <* Terminal katalogets fil navn *>
111 integer array typecat_name(1:4); <* Terminaltype katalogets fil navn *>
112
112 long array opr_keywords(0:20); <* Operatør keywords i tascat *>
113 integer opr_num_keys; <* Antal keywords defineret *>
114 long array cat_keywords(0:60); <* Katalog keywords i tascat *>
115 integer cat_num_keys; <* Antal keywords defineret *>
116 long array init_keywords(0:50); <* Init keywords i tascat *>
117 integer init_num_keys; <* Antal keywords defineret *>
118 integer array char_table(0:255); <* Tegn input tabel *>
119
119 zone copy_buf(128,1,stderror); <* Buffer til general copy *>
120
120 boolean killed; <* True = stoppet ved kill *>
121 boolean test_on; <* Status for test output *>
122 boolean sys_start; <* Korutine system startet *>
123 zone test_out(128,1,test_out_error);<* Zone til output af test records *>
124 integer array testout_name(1:4); <* Navnet på testout filen *>
125 integer trace_type; <* Typen af den trace der foretages *>
126 integer test_select; <* Typen af test fra aktiviteter *>
127
127 integer run_alarm_cause; <* Cause ved alarm (trap) *>
128 integer run_alarm_pos; <* procedure nr ved alarm *>
129
129 integer free_sem; <* Semafor -4 *>
130 integer delay_sem; <* Semafor -3 *>
131 integer wait_answer_pool; <* Semafor -2 *>
132 integer wait_message; <* Semafor -1 *>
133 integer wait_message_pool; <* Semafor 0 *>
134 integer message_buf_pool; <* Semafor 1 *>
135 integer time_sem; <* Semafor 2 *>
136 integer struc_sema; <* Semafor 3 *>
137 integer text_write_sem; <* Semafor 4 *>
138
138 real t_n_l,miss_par,u_n_l,ill_val, <* konstant tekster *>
139 ill_par,long_text,ill_time, <* *>
140 c_p ;
141
141 integer array answer(1:9); <* Answer til modtaget mess *>
142 integer array mess(1:1); <* Reference til message *>
143
143 integer field sender_pda; <* Sender pda i mess *>
144 integer field reciever_pda; <* Modtager pda i mess *>
145 integer field buf_addr; <* Buffer adresse på mess *>
146 integer array field mess_array; <* Message *>
147
147 real start_time; <* Start time for Tas *>
148
148 long array field laf; <* work *>
149 integer array field iaf; <* work *>
150 boolean array field baf; <* work *>
151 integer i; <* work *>
152
152 <*********************************************************>
153 <* Procedure til afhjælpelse af fejl i externe procedure *>
154 <*********************************************************>
155
155 integer procedure put_ch(dest,pos,char,rep);
156 long array dest;
157 integer pos,char,rep;
158 begin
159 trap(local);
160 put_ch:=putchar(dest,pos,char,rep);
161 if false then
162 local: put_ch:=-1;
163 end;
164
164 integer procedure put_txt(dest,pos,text,length);
165 long array dest,text;
166 integer pos,length;
167 begin
168 trap(local);
169 put_txt:=puttext(dest,pos,text,length);
170 if false then
171 local: put_txt:=-1;
172 end;
173
173 <*******************************************>
174 <* Generelle hjælpe procedure til TASCAT *>
175 <*******************************************>
176
176 procedure claim(words);
177 <* 1 *>
178 <*------------------------------------------------------*>
179 <* Reserver et antal ord på stakken *>
180 <* *>
181 <* words (call) : Antal ord der reserveres på stakken *>
182 <*------------------------------------------------------*>
183 integer words;
184 begin
185 integer array x(1:words);
186 end;
187
187 integer procedure send_mess(z,mess);
188 <* 4 *>
189 <*--------------------------------------------------------------------*>
190 <* z (call and return) : Zone åbnet med navnet på den proces der skal *>
191 <* sendes til. Share 1 benyttes til message og *>
192 <* sharestate skal være 0 el. 1. Ved retur er *>
193 <* sharestate lig message buffer adresse. *>
194 <* mess (call) : Integer array(1:8) indeholdede message *>
195 <* Return : Message buffer adresse *>
196 <* Der udføres TRAP hvis message buffer claim *>
197 <* er overskredet *>
198 <*--------------------------------------------------------------------*>
199 zone z;
200 integer array mess;
201 begin
202 integer array share(1:12);
203 integer buf_addr,i;
204
204 trap(alarm);
205 getshare6(z,share,1);
206 for i:=1 step 1 until 8 do
207 share(i+3):=mess(i);
208 setshare6(z,share,1);
209 buf_addr:=monitor(16,z,1,share <* dummy ia *>);
210 if buf_addr=0 then
211 write_message(4,1,false,<:claims exceeded:>);
212 send_mess:=buf_addr;
213 if false then
214 alarm: disable traped(4);
215 end;
216
216 boolean procedure wait_ans(z,mess_addr,time,wait_sem,regret);
217 <* 5 *>
218 <*---------------------------------------------------------------------*>
219 <* z (call and return) : Zone der blev benyttet ved send_mess *>
220 <* Ved retur er sharestate lig 0 *>
221 <* mess_addr (call) : Adressen på message buffer fra send_mess. *>
222 <* time (call) : Tiden der skal ventes inden message fortrydes *>
223 <* sættes tiden 0 ventes uendeligt *>
224 <* wait_sem (call) : Semafor der benyttes til at vente på answer *>
225 <* regret (call) : True = regret message ved time-out *>
226 <* Return : True= answer modtaget; False=Time out *>
227 <* Ved time out fortrydes den sendte message *>
228 <*---------------------------------------------------------------------*>
229 zone z;
230 integer mess_addr,time,wait_sem;
231 boolean regret;
232 begin
233 integer array answer(1:1),ia(1:1);
234
234 trap(alarm);
235 initref(answer);
236 wait_select:=6;
237 wait(message_buf_pool,answer);
238 answer(2):=mess_addr;
239 answer(3):=wait_sem;
240 signal(wait_answer_pool,answer);
241 wait_ans:=true;
242 wait_time:=time;
243 if wait(wait_sem,answer)=0 then
244 begin <* time out *>
245 wait_ans:=false;
246 wait_select:=mess_addr;
247 wait(wait_answer_pool,answer);
248 if regret then
249 monitor(82<* regret message *>,z,1,ia<* dummy *>);
250 end;
251 answer(2):=6;
252 signal(message_buf_pool,answer);
253 if false then
254 alarm: disable traped(5);
255 end;
256
256 procedure write_message(from,result,cont,mess);
257 <* 6 *>
258 <*------------------------------------------------------------*>
259 <* Udskriver meddelelse på hovedkonsol og danner test-record *>
260 <* *>
261 <* from (call) : Angiver hvorfra meddelensen kommer *>
262 <* result (call) : Angiver årsagen eller resultat til mes. *>
263 <* cont (call) : True= returner efter udskrift *>
264 <* False= Afbryd kørslen med trap(from) *>
265 <* mess (call) : Selve meddelelsen *>
266 <*------------------------------------------------------------*>
267 integer from,result;
268 boolean cont;
269 string mess;
270 begin
271 real time;
272
272 trap(alarm);
273 if sys_start and test_on then
274 begin
275 prepare_test;
276 test_out.iaf(1):=1030; <* message *>
277 test_out.iaf(2):=abs from;
278 test_out.iaf(3):=result;
279 end;
280 if (false add (trace_type shift (-1))) or from>=0 then
281 begin
282 open(head_term_zone,8,head_term_name,1 shift 9);
283 write(head_term_zone,<:Tas message : :>);
284 outdate(head_term_zone,round systime(5,0,time));
285 write(head_term_zone,<: :>);
286 outdate(head_term_zone,round time);
287 write(head_term_zone,<: :>,true,30,mess,<<-dddddd>,
288 <: :>,result,
289 <:.:>,<<zddddd>,abs from,<:<10>:>);
290 close(head_term_zone,false);
291 end;
292 if not cont then
293 trap(from);
294 if false then
295 alarm: disable traped(6);
296 end;
297
297 procedure traped(procedure_nr);
298 <* 7 *>
299 <*--------------------------------------------------------------------*>
300 <* procedure_nr (call) : Nummeret på den procedure hvori kaldet står *>
301 <* *>
302 <* Der dannes test records til beskrivelse af *>
303 <* årsagen til trap'et. Der efter fortsætte til *>
304 <* de næste ydre trap niveau. På yderste niveau *>
305 <* afbrydes programmet *>
306 <*--------------------------------------------------------------------*>
307 value procedure_nr;
308 integer procedure_nr;
309 begin
310 integer i,cause;
311 integer array ia(1:8);
312
312 trap(alarm);
313 cause:=alarmcause extract 24;
314 if run_alarm_pos=0 and cause<>-13 then
315 begin
316 run_alarm_cause:=cause;
317 run_alarm_pos:=procedure_nr;
318 end;
319 if cause=-9 and (alarmcause shift (-24))=8 then
320 killed:=true;
321 if sys_start and test_on then
322 begin
323 prepare_test;
324 test_out.iaf(2):=procedure_nr;
325 test_out.iaf(3):=alarmcause shift (-24) extract 24;
326 test_out.iaf(4):=cause;
327 if cause=-13 then
328 test_out.iaf(1):=1028 <* Cont *>
329 else
330 if cause=-11 then
331 begin <* Give up *>
332 test_out.iaf(1):=1026; <* give up 1 *>
333 test_out.iaf(5):=getalarm(ia);
334 prepare_test;
335 test_out.iaf(1):=1027; <* give up 2 *>
336 for i:=2 step 1 until 5 do
337 test_out.iaf(i):=ia(i+3);
338 end
339 else
340 test_out.iaf(1):=1025;<* Trap *>
341 end;
342 if false then
343 alarm: procedure_nr:=(alarmcause extract 24)-100;
344 trap(0);
345 trap(procedure_nr);
346 end;
347
347 procedure trace(p1,p2,p3,p4);
348 <* 8 *>
349 <*----------------------------------------------------------------------*>
350 <* p1 til p4 (call) : Integer parametre der skrives i trace test record *>
351 <*----------------------------------------------------------------------*>
352 integer p1,p2,p3,p4;
353 begin
354
354 if sys_start and test_on then
355 begin
356 prepare_test;
357 test_out.iaf(1):=1029; <* trace *>
358 test_out.iaf(2):=p1;
359 test_out.iaf(3):=p2;
360 test_out.iaf(4):=p3;
361 test_out.iaf(5):=p4;
362 end;
363 end;
364
364 procedure close_test_out;
365 <* 9 *>
366 <*---------------------------------------*>
367 <* Luk test_out filen hvis det er muligt *>
368 <*---------------------------------------*>
369 begin
370 if sys_start and test_on then
371 begin
372 write_message(-9,select_test,true,<:Test output stopped:>);
373 <* Udskriv stop record *>
374 prepare_test;
375 close(test_out,true);
376 end;
377 select_test:=0;
378 test_on:=false;
379 end;
380
380
380 procedure open_test(name);
381 <* 10 *>
382 <*----------------------------------------------------------------------*>
383 <* Åben test filen hvis det er muligt og tilladt. *>
384 <* *>
385 <* name (call) : Navnet på det dokument der skal benyttes som test out *>
386 <* *>
387 <*----------------------------------------------------------------------*>
388 integer array name;
389 begin
390 integer array tail(1:10);
391 integer i,stop_result;
392
392 trap(alarm);
393 stop_result:=0;
394 if test_on then
395 begin
396 set_cat_bases(sys_bases);
397 test_on:=false;
398 open(test_out,4,name,1 shift 18 <* end document *>);
399 if monitor(42<* lookup entry *>,test_out,0,tail)<>0 then
400 stop_result:=1
401 else
402 if tail(1)<2 then
403 stop_result:=2
404 else
405 begin
406 tail(6):=systime(7,0,0.0);
407 i:=monitor(44,test_out,0,tail);
408 i:=monitor(52,test_out,0,tail)+i;
409 i:=monitor(08,test_out,0,tail)+i;
410 if i<>0 then
411 stop_result:=3;
412 end;
413 if stop_result=0 then
414 begin
415 <* initialiser test_out segmenterne *>
416 outrec6(test_out,512);
417 for i:=1 step 1 until 128 do
418 test_out(i):=real <::>;
419 for i:=2 step 1 until tail(1) do
420 outrec6(test_out,512);
421 setposition(test_out,0,0);
422 write_message(-10,tail(1),true,<:Test output started:>);
423 test_on:=true;
424 end
425 else
426 begin
427 test_on:=false;
428 write_message(10,stop_result,true,<:Error in test out file:>);
429 end;
430 end;
431 if not test_on then
432 close_test_out;
433 if false then
434 alarm: disable traped(10);
435 end;
436
436
436 procedure test_out_error(z,s,b);
437 <* 11 *>
438 <*-----------------------------------*>
439 <* blok procedure for test_out zonen *>
440 <*-----------------------------------*>
441 zone z;
442 integer s,b;
443 begin
444 integer array ia(1:20);
445
445 trap(alarm);
446 if false add (s shift (-18)) then
447 begin <* EOF Skift tilbage til segment 1 *>
448 getzone6(test_out,ia);
449 ia(9):=2;
450 setzone6(test_out,ia);
451 getshare6(test_out,ia,1);
452 ia(7):=1;
453 setshare6(test_out,ia,1);
454 monitor(16,test_out,1,ia);
455 check(test_out);
456 b:=512;
457 end
458 else
459 close_test_out;
460 if false then
461 alarm: disable traped(11);
462 end;
463
463 boolean procedure set_cat_bases(bases);
464 <* 12 *>
465 <*--------------------------------------*>
466 <* Sæt cat baserne til angivet base-par *>
467 <* *>
468 <* bases(1) : Nedre base værdi. *>
469 <* bases(2) : Øvre base værdi. *>
470 <* Return : True= baser sat *>
471 <* False= baser IKKE sat *>
472 <*--------------------------------------*>
473 integer array bases;
474 begin
475 zone this_proc(1,1,stderror);
476
476 trap(alarm);
477 open(this_proc,0,<::>,0);
478 set_cat_bases:=
479 monitor(72<* set catalog base *>,this_proc,0,bases)=0;
480 if false then
481 alarm: disable traped(12);
482 end;
483
483 integer procedure get_pda(name);
484 <* 13 *>
485 <*-----------------------------------------------------------------*>
486 <* Hent pda for angivet proces *>
487 <* *>
488 <* name (call) : Navnet på processen som pda skal findes for *>
489 <* Return : pda for proces hvis den findes ellers 0 *>
490 <*-----------------------------------------------------------------*>
491 integer array name;
492 begin
493 integer array ia(1:20);
494 integer i;
495 zone proc(1,1,stderror);
496
496 trap(open_trap);
497 getzone6(proc,ia);
498 for i:=1,2,3,4 do
499 ia(i+1):=name(i);
500 setzone6(proc,ia);
501 get_pda:=monitor(4,proc,0,ia);
502 if false then
503 open_trap: get_pda:=0;
504 end;
505
505 boolean procedure get_proc_name(pda,name);
506 <* 14 *>
507 <*---------------------------------------------------------------------*>
508 <* Hent navnet på processen udpeget af proces beskriver adressen i pda *>
509 <* *>
510 <* pda (call) : Proces beskriver adressen *>
511 <* name (ret) : Navn på proces i integer array name(1:4) *>
512 <* Return : True = navn fundet *>
513 <* False = navn IKKE fundet *>
514 <*---------------------------------------------------------------------*>
515 integer pda;
516 integer array name;
517 begin
518 integer array ia(1:20),bases(1:2);
519 integer lt,i;
520 boolean ok;
521 zone proc(1,1,stderror);
522
522 trap(alarm);
523 lt:=trapmode;
524 trapmode:=-1;
525 ok:=system(5,pda+2,name)=1;
526 trap(open_trap);
527 getzone6(proc,ia);
528 for i:=1,2,3,4 do
529 ia(i+1):=name(i);
530 setzone6(proc,ia);
531 ok:=ok and monitor(4,proc,0,ia)=pda;
532 if false then
533 open_trap: ok:=false;
534 get_proc_name:=ok;
535 if not ok then
536 begin
537 if pda < 0 then
538 movestring(name.laf,1,<:No Connect:>)
539 else
540 movestring(name.laf,1,<:Removed :>);
541 end;
542 trapmode:=lt;
543 if false then
544 alarm: disable traped(14);
545 end;
546
546 integer procedure cur_time;
547 <* 15 *>
548 <*-------------------------------------------*>
549 <* Find den aktuelle tid *>
550 <* *>
551 <* Return : Aktuelle tid i hel time (0-23) *>
552 <*-------------------------------------------*>
553 begin
554 real time;
555
555 trap(alarm);
556 systime(5,0,time);
557 cur_time:=round(time)//10000;
558 if false then
559 alarm: disable traped(15);
560 end;
561
561
561 integer procedure date(text);
562 <* 16 *>
563 <*-----------------------------------------------------------------------*>
564 <* Dan dags dato som tekst med følgende format: *>
565 <* <dags navn> d.<dag>/<måned> 19<år> <time>.<minut> *>
566 <* *>
567 <* text (ret) : Long array indeholdende dags dato som tekst *>
568 <* Array'ets første 6 longs benyttes (36 tegn) *>
569 <* Return : Antal tegn sat i text *>
570 <*-----------------------------------------------------------------------*>
571 long array text;
572 begin
573 real time,year,hour;
574 integer day,pos;
575
575 trap(alarm);
576 systime(1,0,time);
577 day:=(round((time/86400)-0.5) mod 7)+1;
578 pos:=1;
579 text(5):=text(6):=0;
580 case language of
581 begin
582 put_text(text,pos,case day of (<:Mandag :>,<:Tirsdag:>,
583 <:Onsdag :>,<:Torsdag:>,
584 <:Fredag :>,<:Lørdag :>,
585 <:Søndag :>) ,7);
586 put_text(text,pos,case day of (<:Monday :>,<:Tuesday :>,
587 <:Wedensday:>,<:Thursday :>,
588 <:Friday :>,<:Saturday :>,
589 <:Sunday :>) ,9);
590 end;
591 put_text(text,pos,<: d.:>,3);
592 year:=systime(4,time,hour);
593 put_number(text,pos,<<zd>,round(year) mod 100);
594 put_text(text,pos,<:/:>,1);
595 put_number(text,pos,<<zd >,(round(year) mod 10000)//100);
596 put_text(text,pos,<:19:>,2);
597 put_number(text,pos,<<zd >,round(year)//10000);
598 put_number(text,pos,<<dd>,round(hour)//10000);
599 put_text(text,pos,<:.:>,1);
600 put_number(text,pos,<<zd>,(round(hour) mod 10000)//100);
601 date:=pos-1;
602 if false then
603 alarm: disable traped(16);
604 end;
605
605
605 integer procedure data_to_copy_buf(words,mess_addr,answer);
606 <* 17 *>
607 <*------------------------------------------------------------------------*>
608 <* Kopier data fra anden proces til copy_buf. *>
609 <* *>
610 <* words (call) : Antal ord der kopieres (max. 256) *>
611 <* mess_addr (call) : Adressen på message der udpeger område der skal *>
612 <* kopieres fra (2 og 3 ord i message: first,last) *>
613 <* answer (ret) : Resultatet af kopieringen: *>
614 <* answer(1) : Udefineret. *>
615 <* answer(2) : Antal HW overført *>
616 <* answer(3) : Antal tegn overført *>
617 <* answer(9) : Hvis returværdi lig 3 så 3 ellers 1 *>
618 <* Return : 0 = Data kopieret til copy_buf. *>
619 <* 2 = Anden proces stoppet. *>
620 <* 3 = Fejl i kopieringen m.m *>
621 <*------------------------------------------------------------------------*>
622 integer mess_addr,words;
623 integer array answer;
624 begin
625 trap(alarm);
626 answer(1):=2 shift 1 + 0;
627 answer(2):=2;
628 answer(3):=2*words;
629 answer(4):=0;
630 data_to_copy_buf:=monitor(84,copy_buf,mess_addr,answer);
631 answer(3):=3*(answer(2)//2);
632 if false then
633 begin
634 alarm: answer(9):=3;
635 data_to_copy_buf:=3;
636 end;
637 end;
638
638 integer procedure data_from_copy_buf(words,mess_addr,answer);
639 <* 18 *>
640 <*------------------------------------------------------------------------*>
641 <* Kopier data til anden proces fra copy_buf. *>
642 <* *>
643 <* words (call) : Antal ord der kopieres (max. 256) *>
644 <* mess_addr (call) : Adressen på message der udpeger område der skal *>
645 <* kopieres til (2 og 3 ord i message: first,last) *>
646 <* answer (ret) : Resultatet af kopieringen: *>
647 <* answer(1) : Udefineret. *>
648 <* answer(2) : Antal HW overført *>
649 <* answer(3) : Antal tegn overført *>
650 <* answer(9) : Hvis returværdi lig 3 så 3 ellers 1 *>
651 <* Return : 0 = Data kopieret til anden proces *>
652 <* 2 = Anden proces stoppet. *>
653 <* 3 = Fejl i kopieringen m.m *>
654 <*------------------------------------------------------------------------*>
655 integer mess_addr,words;
656 integer array answer;
657 begin
658 trap(alarm);
659 answer(1):=2 shift 1 + 1;
660 answer(2):=2;
661 answer(3):=2*words;
662 answer(4):=0;
663 data_from_copy_buf:=monitor(84,copy_buf,mess_addr,answer);
664 answer(3):=3*(answer(2)//2);
665 if false then
666 begin
667 alarm: answer(9):=3;
668 data_from_copy_buf:=3;
669 end;
670 end;
671
671
671 procedure init_sem;
672 <* 19 *>
673 <*----------------------------------------------------*>
674 <* initialiser semafor navnene med nummer *>
675 <* Semafor 5 og frem benyttes af operatør korutinerne *>
676 <*----------------------------------------------------*>
677 begin
678 free_sem:=-4; <* Semafor -4 *>
679 delay_sem:=-3; <* Semafor -3 *>
680 wait_answer_pool:=-2; <* Semafor -2 *>
681 wait_message:=-1; <* Semafor -1 *>
682 wait_message_pool:=0; <* Semafor 0 *>
683 message_buf_pool:=1; <* Semafor 1 *>
684 time_sem:=2; <* Semafor 2 *>
685 struc_sema:=3; <* Semafor 3 *>
686 text_write_sem:=4; <* Semafor 4 *>
687 end;
688
688 procedure konsol_error(z,s,b);
689 <* 20 *>
690 <*----------------------------------------------------*>
691 <* Block procedure for hoved_konsollen *>
692 <* Ignorer alle error og give up *>
693 <*----------------------------------------------------*>
694 zone z;
695 integer s,b;
696 begin
697 end;
698
698 procedure init_bases;
699 <* 22 *>
700 <*----------------------------------------------------*>
701 <* Check om mcl baser og sys baser kan benyttes *>
702 <* Sæt catalog baser til sys_bases *>
703 <*----------------------------------------------------*>
704 begin
705 integer array bases(1:6);
706 integer b;
707
707 trap(alarm);
708 own_pda:=system(6,0,own_name.laf);
709 if system(5,own_pda+68,bases)<>1 then
710 trap(2);
711 b:=0;
712 if not set_cat_bases(cmcl_bases) then
713 b:=1;
714 if not set_cat_bases(sys_bases) then
715 b:=2;
716 if b<>0 then
717 write_message(22,b,false,<:Illegal base parameter:>);
718 if false then
719 alarm: disable traped(22);
720 end;
721
721
721 procedure keywords_init;
722 <* 23 *>
723 <*-------------------------------------------*>
724 <* initialiser keywords *>
725 <*-------------------------------------------*>
726 begin
727 integer i;
728
728 opr_num_keys:=20;
729 for i:=1 step 1 until opr_num_keys do
730 begin
731 opr_keywords(i):=0;
732 opr_keywords(i):= long (case i of
733 <* 1 *> (<:finis:>,<:displ:>,<:messa:>,<:remov:>,<:set:>,
734 <* 6 *> <:start:>,<:stop:>,<:termi:>,<:user:>,<:on:>,
735 <* 11 *> <:off:>,<:all:>,<:signo:>,<:sessi:>,<:syste:>,
736 <* 16 *> <:login:>,<:timec:>,<:users:>,<:resou:>,<:check:>));
737 end;
738 cat_num_keys:=50;
739 for i:=1 step 1 until cat_num_keys do
740 begin
741 cat_keywords(i):=0;
742 cat_keywords(i):= long (case i of
743 <* 1 *> (<:end:>,<:size:>,<:user:>,<:passw:>,<:cpass:>,
744 <* 6 *> <:monda:>,<:tuesd:>,<:wedne:>,<:thurs:>,<:frida:>,
745 <* 11 *> <:satur:>,<:sunda:>,<:block:>,<:sessi:>,<:privi:>,
746 <* 16 *> <:mclna:>,<:base:>,<:group:>,<:mclte:>,<:freet:>,
747 <* 21 *> <:termi:>,<:termt:>,<:termg:>,<:bypas:>,<:type:>,
748 <* 26 *> <:scree:>,<:colum:>,<:lines:>,<:sbup:>,<:sbdow:>,
749 <* 31 *> <:sblef:>,<:sbrig:>,<:sbhom:>,<:sbdel:>,<:ceod:>,
750 <* 36 *> <:ceol:>,<:invon:>,<:invof:>,<:hlon:>,<:hloff:>,
751 <* 41 *> <:delet:>,<:inser:>,<:curso:>,<:up:>,<:down:>,
752 <* 46 *> <:left:>,<:right:>,<:home:>,<:mode:>,<:init:>));
753 end;
754 init_num_keys:=46;
755 for i:=1 step 1 until init_num_keys do
756 begin
757 init_keywords(i):=0;
758 init_keywords(i):= long (case i of
759 <* 1 *> (<:true:>,<:false:>,<:on:>,<:off:>,<:start:>,
760 <* 6 *> <:stop:>,<:catal:>,<:termi:>,<:init:>,<:catdo:>,
761 <* 11 *> <:userc:>,<:termc:>,<:typec:>,<:ctnam:>,<:spool:>,
762 <* 16 *> <:ttnam:>,<:temna:>,<:login:>,<:userb:>,<:termb:>,
763 <* 21 *> <:timec:>,<:logti:>,<:mclba:>,<:sysba:>,<:cpool:>,
764 <* 26 *> <:clink:>,<:maxse:>,<:maxte:>,<:maxsy:>,<:coreb:>,
765 <* 31 *> <:mclpr:>,<:maxty:>,<:tbufs:>,<:spseg:>,<:maxus:>,
766 <* 36 *> <:maxop:>,<:timeo:>,<:hosti:>,<:signo:>,<:timet:>,
767 <* 41 *> <:stopt:>,<:catte:>,<:trap:>,<:termt:>,<:initv:>,
768 <* 46 *> <:reser:>));
769 end;
770 end;
771
771 integer procedure find_keyword_value(keyword,tabel);
772 <* 24 *>
773 <*----------------------------------------------------------------*>
774 <* Find 'token' værdien for det angivne keyword *>
775 <* *>
776 <* keyword (call) : Long indeholdende op til 5 tegn af keyword *>
777 <* tabel (call) : 1=opr 2=cat 3=init keword-tabel *>
778 <* Return : Værdien for det angivne keyword eller *>
779 <* 0 hvis keyword er ukendt *>
780 <*----------------------------------------------------------------*>
781 long keyword;
782 integer tabel;
783 begin
784 integer i;
785
785 trap(alarm);
786 i:=case tabel of (opr_num_keys,cat_num_keys,init_num_keys)+1;
787 keyword:=(keyword shift (-8)) shift 8;
788 case tabel of
789 begin
790 for i:=i-1 while (not (keyword=opr_keywords(i))
791 and (i<>0)) do; <* nothing *>
792 for i:=i-1 while (not (keyword=cat_keywords(i))
793 and (i<>0)) do; <* nothing *>
794 for i:=i-1 while (not (keyword=init_keywords(i))
795 and (i<>0)) do; <* nothing *>
796 end;
797 find_keyword_value:=i;
798 if false then
799 alarm: disable traped(24);
800 end;
801
801
801 procedure init_opera_terms;
802 <* 25 *>
803 <*----------------------------------------------------*>
804 <* init opera_terms array'et *>
805 <*----------------------------------------------------*>
806 begin
807 integer i;
808
808 trap(alarm);
809 for i:=4 step 1 until number_of_opera+3 do
810 begin
811 opera_terms(i,1):=0;
812 opera_terms(i,2):=i+2
813 end;
814 if false then
815 alarm: disable traped(25);
816 end;
817
817 procedure next_line(z,z_line_nr);
818 <* 26 *>
819 <*-------------------------------------------------------*>
820 <* Læs til starten af næste linie i fil *>
821 <* Linier der starter med ; eller er blanke overspringes *>
822 <* Linie tæller optælles med 1 for hver linie *>
823 <* *>
824 <* z (call) : Fil der læses fra. *>
825 <* z_line_nr (call and ret) : Linie tæller for fil, *>
826 <*-------------------------------------------------------*>
827 zone z;
828 integer z_line_nr;
829 begin
830 integer i;
831
831 trap(alarm);
832 repeatchar(z);
833 readchar(z,i);
834 while (i<>'nl') and (i<>'em') do
835 readchar(z,i);
836 z_line_nr:=z_line_nr+1;
837 readchar(z,i);
838 if i<>'em' then
839 begin
840 while i=' ' do
841 readchar(z,i);
842 if i='nl' or i='em' or i=';' then
843 begin
844 next_line(z,z_line_nr);
845 readchar(z,i);
846 end;
847 end;
848 repeatchar(z);
849 if false then
850 alarm: disable traped(26);
851 end;
852
852 integer procedure read_start_key(z,t,z_line_nr);
853 <* 27 *>
854 <*-------------------------------------------------------------------*>
855 <* Find værdien af nøgleordet i starten af tekst linien i fil *>
856 <* *>
857 <* z (call) : Filen der læses fra *>
858 <* t (call) : Keyword tabel. 1=opr 2=cat 3=init *>
859 <* Return : -1 = Sidste linie i fil er læst *>
860 <* 0 = Nøgleord er ikke fundet *>
861 <* >0 = Nøgleordets værdi *>
862 <*-------------------------------------------------------------------*>
863 zone z;
864 integer t,z_line_nr;
865 begin
866 long array key(1:5);
867 integer i;
868
868 trap(alarm);
869 readchar(z,i);
870 if i<>'em' then
871 begin
872 while i=' ' do
873 readchar(z,i);
874 if i='nl' or i='em' or i=';' then
875 begin
876 next_line(z,z_line_nr);
877 readchar(z,i);
878 end;
879 end;
880 repeatchar(z);
881 read_start_key:=if readstring(z,key,1)>0 then
882 find_keyword_value(key(1),t)
883 else
884 -1;
885 repeatchar(z);
886 if false then
887 alarm: disable traped(27);
888 end;
889
889 integer procedure read_text(z,text,max);
890 <* 28 *>
891 <*---------------------------------------------------------------------*>
892 <* Læs tekst fra z filen til text til slutning af linie eller til *>
893 <* maximalt antal tegn læst. Indledende blanktegn overspringes. *>
894 <* *>
895 <* z (call) : File der læses fra *>
896 <* text (ret) : Den læste tekst *>
897 <* max (call) : Det maximale antal tegn der læses *>
898 <* Return : Antal tegn læst til text *>
899 <* *>
900 <* NB. Der læses altid et tegn mere fra z *>
901 <*---------------------------------------------------------------------*>
902 zone z;
903 integer max;
904 long array text;
905 begin
906 integer ch,pos;
907 boolean first;
908
908 trap(alarm);
909 pos:=1;
910 first:=true;
911 repeatchar(z);
912 readchar(z,ch);
913 if (ch<>'nl') and (ch<>'em') then
914 begin
915 readchar(z,ch);
916 while ch<>'nl' and ch<>'em' and pos<=max do
917 begin
918 if first and (ch<>' ') then
919 first:=false;
920 if not first then
921 put_ch(text,pos,ch,1);
922 readchar(z,ch);
923 end;
924 end;
925 read_text:=pos-1;
926 if pos<=max then
927 put_ch(text,pos,0,1);
928 repeatchar(z);
929 if false then
930 alarm: disable traped(28);
931 end;
932
932 boolean procedure read_nr(z,nr);
933 <* 29 *>
934 <*-----------------------------------------------------------------*>
935 <* Læs et heltal fra fil z. Er der ikke flere tal på linien *>
936 <* returneres -1 ellers det læste tal. Er der angivet ulovligt *>
937 <* tal (eller andet end tal) sættes read_nr til false *>
938 <* *>
939 <* z (call) : Zonen der læses fra *>
940 <* nr (ret) : Læst tal eller -1 hvis ikke flere tal *>
941 <* Return : True = ok False = illegalt tal *>
942 <*-----------------------------------------------------------------*>
943 zone z;
944 integer nr;
945 begin
946 integer ch,class;
947
947 trap(alarm);
948 read_nr:=true;
949 repeat
950 class:=readchar(z,ch);
951 until class<>7 or ch=';' ;
952 if ch=';' or class=8 then
953 nr:=-1
954 else
955 if class<2 or class>3 then
956 begin
957 nr:=-1;
958 read_nr:=false;
959 end
960 else
961 begin
962 repeatchar(z);
963 read(z,nr);
964 end;
965 repeatchar(z);
966 if false then
967 alarm: disable traped(29);
968 end;
969
969 boolean procedure read_name(z,name,ok);
970 <* 30 *>
971 <*---------------------------------------------------------------------*>
972 <* Læs et navn fra filen z til name. Resterende tegn nulstilles *>
973 <* Indledende blanktegn overspringes. Der stoppes ved kommentar *>
974 <* *>
975 <* z (call) : File der læses fra *>
976 <* name (ret) : Det læste navn i integer array name(0:3) *>
977 <* ok (ret) : True hvis første tegn er et bogstav *>
978 <* NB. Der læses altid et tegn mere fra z *>
979 <*---------------------------------------------------------------------*>
980 zone z;
981 integer array name;
982 boolean ok;
983 begin
984 integer ch,pos;
985 long array field laf;
986
986 trap(alarm);
987 for pos:=0,1,2,3 do
988 name(pos):=0;
989 pos:=1;
990 laf:=-2;
991 repeatchar(z);
992 readchar(z,ch);
993 while ch=' ' do
994 readchar(z,ch);
995 ok:=(ch>='a' and ch<='å');
996 while ((ch>='0' and ch<='9') or (ch>='a' and ch<='å')) and pos<=11 do
997 begin
998 put_ch(name.laf,pos,ch,1);
999 readchar(z,ch);
1000 end;
1001 repeatchar(z);
1002 read_name:=not name(0)=0;
1003 if false then
1004 alarm: disable traped(30);
1005 end;
1006
1006
1006 procedure open_catalogs(usercat_name,termcat_name,typecat_name);
1007 <* 31 *>
1008 <*-----------------------------------------------------------------*>
1009 <* Åben kataloger og undersøg om disse er ok og kan bruges til i/o *>
1010 <* sæt size og length for hvert katalog *>
1011 <* Er newcat=true dannes nye kataloger ud fra teksten i cat_file. *>
1012 <* cat_doc angiver navnet på dokument hvorpå katalogerne lægges. *>
1013 <* *>
1014 <* usercat_name, *>
1015 <* termcat_name, *>
1016 <* typecat_name (call) : Navnene på katalogerne *>
1017 <*-----------------------------------------------------------------*>
1018 integer array usercat_name,termcat_name,typecat_name;
1019 begin
1020 integer array user_tail,term_tail,type_tail(1:10);
1021 integer reason,cat_line_nr;
1022 long array start_key(1:47);
1023
1023
1023 <*--------------------------------------------------------------------------*>
1024 <* ******************* Katalog indholds beskrivelse ********************** *>
1025 <*
1026
1026 Bruger katalog (user catalog) :
1027
1027 Indeholder i hver indgang oplysninger om en bruger, der har ad-
1028 gang til RC8000 via menu-systemet.
1029
1029 Hvert segment pånær det første i user catalog indeholder 4
1030 indgange.
1031
1031 Indgangene sorteres i de enkelte segmenter efter deres hash nøgle
1032 således at nøglens værdi svarer til segmentets nummer.
1033
1033 Segmentnummer = hash nøgle
1034
1034 Første ord i hvert segment indeholder hash nøgle tælleren. Denne
1035 angiver den samlede antal indgange i hele kataloget, der har hash
1036 nøgle svarende til segments nummer.
1037
1037 Format af første segment i bruger kataloget :
1038
1038 +0 : 1 ; User catalog
1039 +2 : Catalog size (segments inc. segment 0)
1040 +4 : Entry length i hw's for a user entry.
1041 +8 : Generate date (short time)
1042 +10 : Not used
1043 +254: - -
1044
1044 Bruger indgang format :
1045
1045 +0 : Hash key (0 = empty entry)
1046 +2 : User id (key)
1047 +10 : Password
1048 +14 : Login time limits: Monday
1049 +15 : Tuesday
1050 +16 : Wednesday
1051 +17 : Thursday
1052 +18 : Friday
1053 +19 : Saturday
1054 +20 : Sunday
1055 +21 : User block count
1056 +22 : Max. user index
1057 +23 : Privilege
1058 +24 : MCL program name
1059 +32 : User MCL bases (lower, upper)
1060 +36 : Terminal group limit (bit map)
1061 +44 : MCL default variable text (mcl-text format)
1062 +100: Free text (30 char)
1063 +120: Time stamp
1064 +122: Not used
1065 +124: - -
1066
1066 Et segment indeholder (bortset fra segment 0):
1067
1067 +0 : Hash nøgle tæller
1068 +2 : Entry 0
1069 +128: Entry 1
1070 +254: Entry 2
1071 +380: Entry 3
1072 +506: not used
1073 +510: - -
1074
1074 Hash nøgel :
1075 Hash nøglen beregnes ved:
1076
1076 Summen af de 4 integer der indgår i user id teksten beregnes til
1077 S.
1078
1078 Hash key = 1+((ABS S) mod (n-1)) hvor n er antallet af segmenter
1079 i kataloget (seg. 0 til seg. n-1).
1080
1080
1080 User id:
1081 Bruger navn. Fra 1 til 11 tegn afsluttet med nul-tegn. Kan kun
1082 indgå i en indgang i brugerkataloget. (Nøgle)
1083
1083 Password:
1084 Kryptograferet løsen (metode se ??). Værdien nul angiver at der
1085 intet løsen er tilknyttet denne indgang.
1086
1086 Login time limits:
1087 Angiver for hver dag i ugen det tidsrum, hvor indlogning for bru-
1088 geren er tilladt.
1089
1089 Angives som første tidspunkt og sidste tidspunkt i hele timer (0-
1090 24). Sidste tidspunkt er det klokkeslet, hvor brugeren bliver
1091 logget ud.
1092
1092 Dagen og første tid er sammenhørende. Er aktuel tid (A) mindre
1093 end første tid (F) prøves med dagen før, der da skal være af type
1094 2. Hvis aktuel tid her er mindre end sidste tid (S) gives adgang.
1095
1095 Ellers skal gælde:
1096
1096 ( F<S and A>=F and A<S ) or
1097 ( F>S and ( 24>A>=F or 0<=A<S ))
1098
1098 og typen skal være 1, 2 eller 3.
1099
1099 Hver dag beskrives i 1 HW ved:
1100
1100 F<7 + S<2 + type
1101
1101 Hvor type er: 0 = Ingen adgang denne dag.
1102 1 = Første tid mindre end sidste tid.
1103 2 = Første tid større end sidste tid.
1104 3 = Adgang hele dagen (0 til 24).
1105
1105 User block count:
1106
1106 Angiver antal gange (i træk), der er førsøgt refereret til denne
1107 indgang med forkert password.
1108
1108 Værdien nulstilles ved korrekt reference, hvis grænsen ikke er
1109 nået.
1110
1110 Max. user index:
1111
1111 Angiver det maximale antal sessioner en bruger må have samtidig
1112 (ved en eller flerer terminaler). Værdien skal ligge mellem 1 og
1113 12 ink.
1114
1114 Privilege:
1115 Brugerens privilegier er beskrevet i dette felt.
1116
1116 Bit: 0 = Menu-system control
1117 1 = Catalog update/list
1118 2 = MCL control
1119 3 = Message control
1120 4 = List control
1121
1121 MCL program name:
1122 Navnet på det oversatte MCL-program, der skal udføres ved start
1123 af en session.
1124
1124 User MCL bases:
1125 Det base-interval, hvorpå der ledes efter et MCL-program, hvis
1126 det ikke er kendt af menu-systemet.
1127
1127 Første værdi er nedre base, anden værdi er øvre base.
1128
1128 Terminal group limit:
1129 Angiver hvilke terminalgrupper, der må benyttes af brugeren.
1130
1130 En bruger kan benytte terminaler i en eller flerer af grupperne 0
1131 til 95. Angivet som bitmap, hvor bit 0 sat angiver at bruger må
1132 benytte terminaler fra terminalgruppe 0, bit 1 fra terminalgruppe
1133 1 o.s.v.
1134
1134 MCL default variable text:
1135 Tekst der overføres til variabel (T) i MCL ved start af session.
1136 Format som ved CMCL-text.
1137
1137 Free text:
1138 Fri tekst til f.eks at beskrive brugeren (Navn m.m). Der kan
1139 angives op til 30 tegn efterfulgt af nul-tegn.
1140
1140 Time stamp:
1141 Tidsangivelse (access tæller ), der sættes når nyt indhold sættes
1142 i entry. Benyttes til at kontrolerer gyldigheden af læst data ved
1143 senere rettelse.
1144
1144 Terminal katalog (terminal catalog)
1145 Indeholder i hver indgang en beskrivelse af en terminal, der er
1146 tilsluttet via menu-systemet.
1147
1147 Hvert segment i terminal catalog pånær segment 0 indeholder 14
1148 indgange.
1149
1149 Indgangene sorteres i de enkelte segmenter efter deres hash
1150 nøglesåledes at nøglens værdi svarer til segmentets nummer.
1151
1151 Segmentnummer = hash nøgle
1152
1152 Første ord i hvert segment indeholder hash nøgle tælleren. Denne
1153 angiver den samlede antal indgange i hele kataloget der har hash
1154 key svarende til segments nummer.
1155
1155 Format af første segment i terminal kataloget
1156
1156 +0 : 2 ; Terminal catalog
1157 +2 : Catalog size (segments inc. segment 0)
1158 +4 : Entry length i hw's for a terminal entry.
1159 +8 : Generate date (short time)
1160 +10 : Not used
1161 +254: - -
1162
1162 Terminal katalog format
1163
1163 +0 : Hash key (0 = empty entry)
1164 +2 : Terminal name
1165 +10 : Terminal type
1166 +11 : Terminal block count
1167 +12 : Bypass (1=on; 0=off)
1168 +13 : Terminal group
1169 +14 : Free text (30 char.)
1170 +34 : Time stamp
1171
1171 Segment indhold:
1172
1172 +0 : Hashnøgle tæller
1173 +2 : Entry 0
1174 +38 : Entry 1
1175 +74 : Entry 2
1176 .
1177 .
1178 +470: Entry 13
1179 +506: not used
1180 +510: - -
1181
1181 Hash nøgle:
1182 Hash nøglen beregnes ved:
1183
1183 Summen af de 4 integer der indgår i user id teksten beregnes til
1184 S.
1185
1185 Hash key = 1+((ABS S) mod (n-1)) hvor n er antallet af segmenter
1186 i kataloget (seg. 0 til seg. n-1).
1187
1187 Terminal name:
1188 Navnet på den externe proces, der er tilknyttet terminalen i
1189 samme format som proces beskriverens navnefelt.
1190
1190 Terminal type:
1191 Tal der refererer til beskrivelsen af terminalens type i ter-
1192 minaltype kataloget. Typen skal ligge mellem 1 og antal af
1193 segmenter i terminaltype kataloget gange 4.
1194
1194 Terminal block count:
1195 Angiver antal gange (i træk), der er forsøgt indlogning fra denne
1196 terminal uden at korrekt 'userid' er opgivet.
1197
1197 Værdien nulstilles ved korrekt indlogning, hvis den ikke har nået
1198 grænsen.
1199
1199 Terminal group:
1200 Angiver hvilken gruppe (en ud af grupperne 0 til 95) terminalen
1201 indgår i.
1202
1202 Free text:
1203 Fri tekst til f.eks at beskrive terminalens fysiske placering.
1204 Der kan angives op til 30 tegn.
1205
1205 Time stamp:
1206 Tidsangivelse der sættes når nyt indhold sættes i entry. Benyttes
1207 til at kontrolerer gyldigheden af læst data ved senere rettelse.
1208
1208 Terminal type katalog
1209
1209 Indeholder i hver indgang beskrivelse af en bestem type terminals
1210 funktioner.
1211
1211 Kataloget indeholder 4 indgange per segment.
1212
1212 En indgang findes ved at benytte typen som index.
1213
1213 segment = ((type-1) div 4)+1.
1214 indgang i segment = 128*((type-1) mod 4)
1215
1215
1215 Format af første segment i terminaltype kataloget
1216
1216 +0 : 3 ; Terminal type catalog
1217 +2 : Catalog size (segments inc. segment 0)
1218 +4 : Entry length i hw's for a type entry.
1219 +8 : Generate date (short time)
1220 +10 : Not used
1221 +254: - -
1222
1222 Terminaltype indgang format
1223
1223 +0 : Terminal type (0= empty entry)
1224 +2 : Screen type (set of values 0 to 11)
1225 +3 : Mode (set term. spec. mode)
1226 +4 : Number of colums on line
1227 +5 : Number of lines on display
1228 +6 : Send by CURSOR UP key
1229 +7 : Send by CURSOR DOWN key
1230 +8 : Send by CURSOR LEFT key
1231 +9 : Send by CURSOR RIGHT key
1232 +10 : Send by HOME key
1233 +11 : Send by DELETE key
1234 +12 : Clear to end of display seq.
1235 +16 : Clear to end of line seq.
1236 +20 : Invers on seq.
1237 +24 : Invers off seq.
1238 +28 : High light on seq.
1239 +32 : High light off seq.
1240 +36 : Delete line seq. (move succeeding lines up)
1241 +40 : Insert line seq. (move lines down)
1242 +44 : Cursor addressing seq.
1243 +50 : Cursor up char.
1244 +51 : Cursor down char.
1245 +52 : Cursor left char.
1246 +53 : Cursor right char.
1247 +54 : Cursor home char.
1248 +55 :
1249 +56 : Init. terminal (75 char.)
1250 +106: Free text (30 char.)
1251 +126: Time stamp
1252
1252 Format af data.
1253 Send by (sb) værdierne angiver værdien af det tegn, der sendes af
1254 den pågældende tast.
1255
1255 Sekvenserne (seq.) kan bestå af op til 6 tegn. Ikke benyttede
1256 tegn sættes til 0. Er første tegn et 0 er den pågældende funktion
1257 ikke tilgænglig på terminalen.
1258
1258 Initialiserings sekvensen kan sendes til terminalen ved f.eks
1259 opstart. Sekevensen kan f.eks være initialisering af funktions
1260 tasterne. Der kan angives op til 30 tegn. Ikke benyttede tegn
1261 sættes til 0.
1262
1262 Screen type
1263 Angiver hvilke karekteristika den enkelte skærmtype har.
1264
1264 Bit: 0 = Terminal is a hardcopy (paper) terminal.
1265 1 = Scroll when 'nl' on the last line
1266 2 = Scroll when write in then last character on the
1267 screen
1268 3 =
1269 .
1270 .
1271 11 =
1272
1272 Cursor addressing seq.:
1273 Sekvensen består af op til 7 skrivbare tegn samt to positions-
1274 tegn. Positions-tegnene står på de steder i sekvensen, hvor
1275 cursor-positions værdierne skal sendes.
1276
1276 Positions tegnene er opbygget som:
1277 (pos. er positionsværdi ved adresseringen)
1278
1278 bit: værdi: (bit 0 er MSB)
1279
1279 0 1 = Positionstegn markering sammen med bit 1 ellers
1280 kontroltegn med MSB sat.
1281 0 = Andet tegn
1282
1282 1 1 = Positionstegn markering sammen med bit 0 ellers
1283 skrivbart tegn.
1284 0 = Andet tegn.
1285
1285 2 1 = Brug pos. som colonne
1286 0 = Brug pos. som linie
1287
1287 3 1 = Adder 1 til pos.
1288 0 = intet
1289
1289 4 1 = Adder 32 til pos.
1290 0 = intet
1291
1291 5 1 = Exclusive or pos med 140(octal)
1292 0 = intet
1293
1293 6 1 = Udskriv pos. som et tegn (tegnværdi lig pos.)
1294 0 = Udskriv pos. som 2 cifret decimal (2 tegn)
1295
1295 7 intet
1296
1296 Free text
1297 Benyttes f.eks til at angive hvilken type terminal der er
1298 beskrevet i denne indgang i kataloget. Der kan angives op til 30
1299 tegn.
1300
1300 Time stamp:
1301 Tidsangivelse der sættes når nyt indhold sættes i entry. Benyttes
1302 til at kontrolerer gyldigheden af læst data ved senere rettelse.
1303
1303 *>
1304 <*--------------------------------------------------------------------------*>
1305
1305 integer procedure init_catalogs;
1306 <* 32 *>
1307 <*----------------------------------------------------------------------*>
1308 <* Initialiser de 3 kataloger til tomme ud fra størrelserne læst fra *>
1309 <* cat_file *>
1310 <* *>
1311 <* Return : Reason fra initialiseringen. reason=0 er OK *>
1312 <*----------------------------------------------------------------------*>
1313 begin
1314 integer reason,i;
1315
1315 trap(alarm);
1316 reason:=0;
1317 open(cat_file,4,cattxt_name,0);
1318 i:=read_start_key(cat_file,2,cat_line_nr);
1319 while i=0 do
1320 begin
1321 next_line(cat_file,cat_line_nr);
1322 i:=read_start_key(cat_file,2,cat_line_nr);
1323 end;
1324 if i=2 then
1325 begin
1326 read_nr(cat_file,usercat_size);
1327 read_nr(cat_file,termcat_size);
1328 read_nr(cat_file,typecat_size);
1329 if usercat_size<1 or termcat_size<1 or typecat_size<1 then
1330 reason:=16
1331 else
1332 begin
1333 next_line(cat_file,cat_line_nr);
1334 user_entry_length:=126; <************************>
1335 term_entry_length:=36; <* Antal hw i entry !!! *>
1336 type_entry_length:=128; <************************>
1337 usercat_size:=(usercat_size-1)//(512//user_entry_length)+2;
1338 termcat_size:=(termcat_size-1)//(512//term_entry_length)+2;
1339 typecat_size:=(typecat_size-1)//(512//type_entry_length)+2;
1340 user_tail(1):=usercat_size;
1341 user_tail(2):=cat_doc(1);
1342 user_tail(3):=cat_doc(2);
1343 user_tail(4):=cat_doc(3);
1344 user_tail(5):=cat_doc(4);
1345 user_tail(6):=systime(7,0,0.0);
1346 user_tail(7):=0;
1347 user_tail(8):=0;
1348 user_tail(9):=11 shift 12;
1349 user_tail(10):=0;
1350 end;
1351 if reason=0 then
1352 begin
1353 if monitor(40<* create entry *>,usercat,0,user_tail)<>0 then
1354 reason:=21
1355 else
1356 if monitor(50<* permanent *>,usercat,3,user_tail)<>0 then
1357 reason:=22
1358 else
1359 if monitor(52<* create area proc *>,usercat,0,user_tail)<>0 then
1360 reason:=23
1361 else
1362 if monitor(8<* reserve proc *>,usercat,0,user_tail)<>0 then
1363 reason:=24;
1364 end;
1365 if reason=0 then
1366 begin
1367 term_tail(1):=termcat_size;
1368 term_tail(2):=cat_doc(1);
1369 term_tail(3):=cat_doc(2);
1370 term_tail(4):=cat_doc(3);
1371 term_tail(5):=cat_doc(4);
1372 term_tail(6):=systime(7,0,0.0);
1373 term_tail(7):=0;
1374 term_tail(8):=0;
1375 term_tail(9):=11 shift 12;
1376 term_tail(10):=0;
1377 if monitor(40<* create entry *>,termcat,0,term_tail)<>0 then
1378 reason:=31
1379 else
1380 if monitor(50<* permanent *>,termcat,3,term_tail)<>0 then
1381 reason:=32
1382 else
1383 if monitor(52<* create area proc *>,termcat,0,term_tail)<>0 then
1384 reason:=33
1385 else
1386 if monitor(8<* reserve proc *>,termcat,0,term_tail)<>0 then
1387 reason:=34;
1388 end;
1389 if reason=0 then
1390 begin
1391 type_tail(1):=typecat_size;
1392 type_tail(2):=cat_doc(1);
1393 type_tail(3):=cat_doc(2);
1394 type_tail(4):=cat_doc(3);
1395 type_tail(5):=cat_doc(4);
1396 type_tail(6):=systime(7,0,0.0);
1397 type_tail(7):=0;
1398 type_tail(8):=0;
1399 type_tail(9):=11 shift 12;
1400 type_tail(10):=0;
1401 if monitor(40<* create entry *>,typecat,0,type_tail)<>0 then
1402 reason:=41
1403 else
1404 if monitor(50<* permanent *>,typecat,3,type_tail)<>0 then
1405 reason:=42
1406 else
1407 if monitor(52<* create area proc *>,typecat,0,type_tail)<>0 then
1408 reason:=43
1409 else
1410 if monitor(8<* reserve proc *>,typecat,0,type_tail)<>0 then
1411 reason:=44;
1412 end;
1413 if reason=0 then
1414 begin <* initialiser katalog indholdet *>
1415 setposition(usercat,0,1);
1416 outrec6(usercat,512);
1417 for i:=1 step 1 until 128 do
1418 usercat(i):=real <::>;
1419 for i:=3 step 1 until usercat_size do
1420 outrec6(usercat,512);
1421 setposition(usercat,0,0);
1422 outrec6(usercat,512);
1423 usercat.iaf(1):=1; <* Bruger katalog = 1 *>
1424 usercat.iaf(2):=usercat_size;
1425 usercat.iaf(3):=user_entry_length;
1426 usercat.iaf(4):=systime(7,0,0.0);
1427 setposition(usercat,0,0);
1428 user_seg:=-1;
1429 setposition(termcat,0,1);
1430 outrec6(termcat,512);
1431 for i:=1 step 1 until 128 do
1432 termcat(i):=real <::>;
1433 for i:=3 step 1 until termcat_size do
1434 outrec6(termcat,512);
1435 setposition(termcat,0,0);
1436 term_seg:=-1;
1437 outrec6(termcat,512);
1438 termcat.iaf(1):=2; <* Terminal katalog = 2 *>
1439 termcat.iaf(2):=termcat_size;
1440 termcat.iaf(3):=term_entry_length;
1441 termcat.iaf(4):=systime(7,0,0.0);
1442 setposition(termcat,0,0);
1443 setposition(typecat,0,1);
1444 outrec6(typecat,512);
1445 for i:=1 step 1 until 128 do
1446 typecat(i):=real <::>;
1447 for i:=3 step 1 until typecat_size do
1448 outrec6(typecat,512);
1449 setposition(typecat,0,0);
1450 outrec6(typecat,512);
1451 typecat.iaf(1):=3; <* Type katalog = 3 *>
1452 typecat.iaf(2):=typecat_size;
1453 typecat.iaf(3):=type_entry_length;
1454 typecat.iaf(4):=systime(7,0,0.0);
1455 setposition(typecat,0,0);
1456 end;
1457 end
1458 else
1459 reason:=17;
1460 init_catalogs:=reason;
1461 if false then
1462 alarm: disable traped(32);
1463 end;
1464
1464 integer procedure fill_catalogs;
1465 <* 33 *>
1466 <*-----------------------------------------------------*>
1467 <* Hent data fra cat_file og indsæt i relevant katalog *>
1468 <*-----------------------------------------------------*>
1469 begin
1470 integer reason,key,i,first,last,type,term_type,priv;
1471 integer array group,pgn,term_id,user_id(0:4);
1472 long array password(1:8);
1473 boolean ok;
1474
1474 procedure clear_high(i);
1475 <* 32 *>
1476 integer i;
1477 begin
1478 i:=(i shift 12) shift (-12);
1479 end;
1480
1480 procedure clear_low(i);
1481 <* 33 *>
1482 integer i;
1483 begin
1484 i:=(i shift (-12)) shift 12;
1485 end;
1486
1486 trap(alarm);
1487 reason:=0;
1488 key:=read_start_key(cat_file,2,cat_line_nr);
1489 while (key<>1 <* end *>) and (key<>-1) and (reason=0) do
1490 begin
1491 if key=3 then
1492 begin <* user entry *>
1493 if not read_name(cat_file,user_id,ok) then
1494 goto ill_nr;
1495 if not ok then
1496 goto ill_nr;
1497 for i:=3,2,1,0 do
1498 user_id(i+1):=user_id(i);
1499 if not find_user(user_id) then
1500 begin
1501 if find_empty_user_entry(calc_hash(user_id,usercat_size)) then
1502 begin
1503 <* init entry *>
1504 for i:=2 step 1 until 5 do
1505 usercat.user_entry(i):=user_id(i-1);
1506 usercat.user_entry(12):=1 shift 12; <* max user index *>
1507 usercat.user_entry(23):=2 shift 12; <* mcl def. text *>
1508 usercat.user_entry(19):=1 shift 23; <* term. group 0 *>
1509 next_line(cat_file,cat_line_nr);
1510 key:=read_start_key(cat_file,2,cat_line_nr);
1511 while (key>=4) and (key<=20) do
1512 begin
1513 <* indsæt i entry *>
1514 if (key>=6) and (key<=12) then
1515 begin <* læs first og last for login tid *>
1516 if not (read_nr(cat_file,first) and
1517 read_nr(cat_file,last)) then
1518 goto ill_nr;
1519 if first<0 or first>24 or last<0 or last>24 then
1520 goto ill_nr;
1521 type:=if first<1 and last>23 then
1522 3
1523 else
1524 if first=last then
1525 0
1526 else
1527 if first<last then
1528 1
1529 else
1530 2;
1531 end;
1532 begin
1533 case key-3 of
1534 begin
1535 begin <* password *>
1536 for i:=1 step 1 until 8 do
1537 password(i):=0;
1538 usercat.user_entry(6):=0;
1539 usercat.user_entry(7):=0;
1540 if read_text(cat_file,password,48)>0 then
1541 begin <* kod password *>
1542 for last:=1 step 1 until 31 do
1543 begin
1544 key:=password.baf(last) extract 12;
1545 for i:=last+1 step 1 until 32 do
1546 password.baf(i):=false add
1547 ((password.baf(i) extract 12) + key);
1548 end;
1549 for i:=1 step 1 until 16 do
1550 begin
1551 usercat.user_entry(6):=usercat.user_entry(6)+
1552 password.iaf(i);
1553 usercat.user_entry(7):=usercat.user_entry(7)+
1554 usercat.user_entry(6);
1555 end;
1556 end;
1557 end;
1558 begin <* kodet password *>
1559 read(cat_file,password(1));
1560 usercat.user_entry(6):=password(1) shift (-24);
1561 usercat.user_entry(7):=password(1) extract 24;
1562 end;
1563 begin <* monday *>
1564 clear_high(usercat.user_entry(8));
1565 usercat.user_entry(8):=usercat.user_entry(8)+
1566 ((first shift 7)+(last shift 2) + type) shift 12;
1567 end;
1568 begin <* tuesday *>
1569 clear_low(usercat.user_entry(8));
1570 usercat.user_entry(8):=usercat.user_entry(8)+
1571 ((first shift 7)+(last shift 2) + type);
1572 end;
1573 begin <* wednesday *>
1574 clear_high(usercat.user_entry(9));
1575 usercat.user_entry(9):=usercat.user_entry(9)+
1576 ((first shift 7)+(last shift 2) + type) shift 12;
1577 end;
1578 begin <* thursday *>
1579 clear_low(usercat.user_entry(9));
1580 usercat.user_entry(9):=usercat.user_entry(9)+
1581 ((first shift 7)+(last shift 2) + type);
1582 end;
1583 begin <* friday *>
1584 clear_high(usercat.user_entry(10));
1585 usercat.user_entry(10):=usercat.user_entry(10)+
1586 ((first shift 7)+(last shift 2) + type) shift 12;
1587 end;
1588 begin <* saturday *>
1589 clear_low(usercat.user_entry(10));
1590 usercat.user_entry(10):=usercat.user_entry(10)+
1591 ((first shift 7)+(last shift 2) + type);
1592 end;
1593 begin <* sunday *>
1594 clear_high(usercat.user_entry(11));
1595 usercat.user_entry(11):=usercat.user_entry(11)+
1596 ((first shift 7)+(last shift 2) + type) shift 12;
1597 end;
1598 begin <* block *>
1599 clear_low(usercat.user_entry(11));
1600 if not read_nr(cat_file,i) or i<0 then
1601 goto ill_nr;
1602 usercat.user_entry(11):=usercat.user_entry(12)+i;
1603 end;
1604 begin <* index *>
1605 clear_high(usercat.user_entry(12));
1606 if not read_nr(cat_file,i) then
1607 goto ill_nr;
1608 if i>9 or i<1 then
1609 goto ill_nr;
1610 usercat.user_entry(12):=usercat.user_entry(12)+
1611 (i shift 12);
1612 end;
1613 begin <* privilegier *>
1614 priv:=0;
1615 clear_low(usercat.user_entry(12));
1616 if not read_nr(cat_file,i) then
1617 goto ill_nr;
1618 while i>=0 do
1619 begin
1620 if i>11 then
1621 goto ill_nr;
1622 priv:=priv+(1 shift (11-i));
1623 if not read_nr(cat_file,i) then
1624 goto ill_nr;
1625 end;
1626 usercat.user_entry(12):=usercat.user_entry(12)+priv;
1627 end;
1628 begin <* mcl name *>
1629 if not read_name(cat_file,pgn,ok) then
1630 goto ill_nr;
1631 if not ok then
1632 goto ill_nr;
1633 for i:=0 step 1 until 3 do
1634 usercat.user_entry(i+13):=pgn(i);
1635 end;
1636 begin <* cmcl bases *>
1637 if not (read_nr(cat_file,first) and
1638 read_nr(cat_file,last)) then
1639 goto ill_nr;
1640 if first>last then
1641 goto ill_nr;
1642 usercat.user_entry(17):=first;
1643 usercat.user_entry(18):=last;
1644 end;
1645 begin <* groups *>
1646 for i:=1 step 1 until 4 do
1647 group(i):=0;
1648 if not read_nr(cat_file,i) then
1649 goto ill_nr;
1650 while (i>=0) and (i<=95) do
1651 begin
1652 first:=(i//24)+1;
1653 last:=23-(i mod 24);
1654 if not (false add (group(first) shift (-last))) then
1655 group(first):=group(first)+(1 shift last);
1656 if not read_nr(cat_file,i) then
1657 goto ill_nr;
1658 end;
1659 for i:=1 step 1 until 4 do
1660 usercat.user_entry(18+i):=group(i);
1661 end;
1662 begin <* mcl text *>
1663 laf:=46;
1664 i:=read_text(cat_file,usercat.user_entry.laf,80);
1665 usercat.user_entry(23):=
1666 ((((i+2)//3*2)+2) shift 12) + i;
1667 laf:=0;
1668 end;
1669 begin <* free text *>
1670 laf:=100;
1671 read_text(cat_file,usercat.user_entry.laf,30);
1672 laf:=0;
1673 end;
1674 end;
1675 end;
1676 next_line(cat_file,cat_line_nr);
1677 key:=read_start_key(cat_file,2,cat_line_nr);
1678 end;
1679 write_user_seg;
1680 end
1681 else
1682 reason:=101; <* Ikke flere entries *>
1683 end
1684 else
1685 reason:=102; <* Entry eksisterer *>
1686 end
1687 else
1688 if key=21 then
1689 begin <* terminal entry *>
1690 if not read_name(cat_file,term_id,ok) then
1691 goto ill_nr;
1692 for i:=3 step (-1) until 0 do
1693 term_id(i+1):=term_id(i);
1694 if not find_term(term_id) then
1695 begin
1696 if find_empty_term_entry(calc_hash(term_id,termcat_size)) then
1697 begin
1698 <* init entry *>
1699 for i:=2 step 1 until 5 do
1700 termcat.term_entry(i):=term_id(i-1);
1701 termcat.term_entry(6):=1 shift 12; <* terminal type *>
1702 next_line(cat_file,cat_line_nr);
1703 key:=read_start_key(cat_file,2,cat_line_nr);
1704 while (key=13) or (key=20) or (key>=22 and key<=24) do
1705 begin
1706 <* indsæt i entry *>
1707 if key=22 then
1708 begin <* Terminal type *>
1709 if not read_nr(cat_file,i) or i<0 or i>2047 then
1710 goto ill_nr;
1711 clear_high(termcat.term_entry(6));
1712 termcat.term_entry(6):=termcat.term_entry(6)+
1713 i shift 12;
1714 end;
1715 if key=13 then
1716 begin <* Block *>
1717 if not read_nr(cat_file,i) or i<0 then
1718 goto ill_nr;
1719 clear_low(termcat.term_entry(6));
1720 termcat.term_entry(6):=termcat.term_entry(6)+i;
1721 end;
1722 if key=23 then
1723 begin <* terminal group *>
1724 if not read_nr(cat_file,i) or i<0 or i>95 then
1725 goto ill_nr;
1726 clear_low(termcat.term_entry(7));
1727 termcat.term_entry(7):=termcat.term_entry(7)+i;
1728 end;
1729 if key=24 then
1730 begin <* bypass *>
1731 clear_high(termcat.term_entry(7));
1732 termcat.term_entry(7):=termcat.term_entry(7)+(1 shift 12);
1733 end;
1734 if key=20 then
1735 begin <* free text *>
1736 laf:=14;
1737 read_text(cat_file,termcat.term_entry.laf,30);
1738 laf:=0;
1739 end;
1740 next_line(cat_file,cat_line_nr);
1741 key:=read_start_key(cat_file,2,cat_line_nr);
1742 end;
1743 write_term_seg;
1744 end
1745 else
1746 reason:=105; <* Ikke flere entries *>
1747 end
1748 else
1749 reason:=106; <* Entry eksisterer *>
1750 end
1751 else
1752 if key=25 then
1753 begin <* type entry *>
1754 if not read_nr(cat_file,term_type) or term_type<1 then
1755 goto ill_nr;
1756 if find_type_entry(term_type) then
1757 begin
1758 if typecat.type_entry(1) = 0 then
1759 begin
1760 boolean array field baf;
1761 baf:=0;
1762 <* init entry *>
1763 typecat.type_entry(1):=term_type; <* terminal type *>
1764 typecat.type_entry(3):=(80 shift 12)+24;
1765 next_line(cat_file,cat_line_nr);
1766 key:=read_start_key(cat_file,2,cat_line_nr);
1767 while (key>=26) or (key=20) do
1768 begin
1769 <* indsæt i entry *>
1770 if key=26 then
1771 begin <* screen type *>
1772 priv:=0;
1773 if not read_nr(cat_file,i) or i>11 or i<0 then
1774 goto ill_nr;
1775 while i>=0 do
1776 begin
1777 if i>11 then
1778 goto ill_nr;
1779 priv:=priv+(1 shift (11-i));
1780 if not read_nr(cat_file,i) then
1781 goto ill_nr;
1782 end;
1783 typecat.type_entry.baf(3):=false add (priv extract 12)
1784 end;
1785 if key=49 then
1786 begin <* mode *>
1787 if not read_nr(cat_file,i) or i>9 or i<0 then
1788 goto ill_nr;
1789 typecat.type_entry.baf(4):=false add (i extract 12)
1790 end;
1791 if (key>=27) and (key<=34) then
1792 begin <* 'send by' værdier *>
1793 if not read_nr(cat_file,i) or i>255 or i<0 then
1794 goto ill_nr;
1795 typecat.type_entry.baf(key-22):=if i>0 then
1796 false add i
1797 else
1798 false;
1799 end;
1800 if (key>=44) and (key<=48) then
1801 begin <* et tegns værdier *>
1802 if not read_nr(cat_file,i) or i>255 or i<0 then
1803 goto ill_nr;
1804 typecat.type_entry.baf(key+7):=if i>0 then
1805 false add i
1806 else
1807 false;
1808 end;
1809 if (key>=35) and (key<=42) then
1810 begin <* 6 tegns sekevnser *>
1811 if not read_nr(cat_file,i) or i>255 or i<0 then
1812 goto ill_nr;
1813 first:=1;
1814 laf:=case (key-34) of
1815 (12,16,20,24,28,32,36,40);
1816 typecat.type_entry.laf(1):=0;
1817 while (i<>-1) and (first<=6) do
1818 begin
1819 put_ch(typecat.type_entry.laf,first,i,1);
1820 if first<=6 then
1821 begin
1822 if not read_nr(cat_file,i) or i>255 or i<(-1) then
1823 goto ill_nr;
1824 end;
1825 end;
1826 laf:=0;
1827 end;
1828 if key=43 then
1829 begin <* cursor sekvens *>
1830 if not read_nr(cat_file,i) or i>255 or i<0 then
1831 goto ill_nr;
1832 first:=1;
1833 laf:=44;
1834 while (i<>-1) and (first<=9) do
1835 begin
1836 put_ch(typecat.type_entry.laf,first,i,1);
1837 if first<=9 then
1838 begin
1839 if not read_nr(cat_file,i) or i>255 or i<(-1) then
1840 goto ill_nr;
1841 end;
1842 end;
1843 laf:=0;
1844 end;
1845 if key=50 then
1846 begin <* initialiserings sekvens *>
1847 laf:=56;
1848 if not read_nr(cat_file,i) or i>255 or i<0 then
1849 goto ill_nr;
1850 first:=1;
1851 while (i<>-1) and (first<=75) do
1852 begin
1853 put_ch(typecat.type_entry.laf,first,i,1);
1854 if first<=75 then
1855 begin
1856 if not read_nr(cat_file,i) or i>255 or i<(-1) then
1857 goto ill_nr;
1858 end;
1859 end;
1860 laf:=0;
1861 end;
1862 if key=20 then
1863 begin <* free text *>
1864 laf:=106;
1865 read_text(cat_file,typecat.type_entry.laf,30);
1866 laf:=0;
1867 end;
1868 next_line(cat_file,cat_line_nr);
1869 key:=read_start_key(cat_file,2,cat_line_nr);
1870 end;
1871 write_type_seg;
1872 end
1873 else
1874 reason:=108; <* Entry eksisterer *>
1875 end
1876 else
1877 reason:=109; <* Illegal type *>
1878 end
1879 else
1880 if key<>65 then
1881 reason:=100; <* illegal entry key *>
1882 end;
1883 if false then
1884 ill_nr: reason:=110;
1885 fill_catalogs:=reason;
1886 if false then
1887 alarm: disable traped(33);
1888 end;
1889
1889
1889 <*****************************>
1890 <* Hoveddel af open_catalogs *>
1891 <*****************************>
1892 trap(alarm);
1893 cat_line_nr:=1;
1894 set_cat_bases(sys_bases);
1895 open(usercat,4,usercat_name,1 shift 9 <* passivate *> );
1896 open(termcat,4,termcat_name,1 shift 9 <* passivate *> );
1897 open(typecat,4,typecat_name,0 <* NO passivate *> );
1898 reason:=0;
1899 if monitor(42<* lookup *>,usercat,0,user_tail)<>0 then
1900 reason:=1
1901 else
1902 if new_catalog then
1903 monitor(48 <*remove entry*>,usercat,0,user_tail);
1904 if monitor(42<* lookup *>,termcat,0,term_tail)<>0 then
1905 reason:=2
1906 else
1907 if new_catalog then
1908 monitor(48 <*remove entry*>,termcat,0,term_tail);
1909 if monitor(42<* lookup *>,typecat,0,type_tail)<>0 then
1910 reason:=3
1911 else
1912 if new_catalog then
1913 monitor(48 <*remove entry*>,typecat,0,type_tail);
1914 if (not new_catalog) and (reason=0) then
1915 begin <* alle kataloger findes, test ydeligerer *>
1916 usercat_size:=user_tail(1);
1917 termcat_size:=term_tail(1);
1918 typecat_size:=type_tail(1);
1919 if monitor(92<* create area proc *>,usercat,0,user_tail)<>0 then
1920 reason:=4
1921 else
1922 if monitor(8<* reserve proc *>,usercat,0,user_tail)<>0 then
1923 reason:=5
1924 else
1925 begin
1926 user_seg:=-1;
1927 find_user_seg(0);
1928 user_entry:=0;
1929 if usercat.user_entry(1)<>1 then
1930 reason:=6
1931 else
1932 if usercat.user_entry(2)<>usercat_size then
1933 reason:=7
1934 else
1935 user_entry_length:=usercat.user_entry(3);
1936 end;
1937 if reason=0 then
1938 begin
1939 if monitor(92<* create area proc *>,termcat,0,term_tail)<>0 then
1940 reason:=8
1941 else
1942 if monitor(8<* reserve proc *>,termcat,0,term_tail)<>0 then
1943 reason:=9
1944 else
1945 begin
1946 term_seg:=-1;
1947 find_term_seg(0);
1948 term_entry:=0;
1949 if termcat.term_entry(1)<>2 then
1950 reason:=10
1951 else
1952 if termcat.term_entry(2)<>termcat_size then
1953 reason:=11
1954 else
1955 term_entry_length:=termcat.term_entry(3);
1956 end;
1957 end;
1958 if reason=0 then
1959 begin
1960 if monitor(92<* create area proc *>,typecat,0,type_tail)<>0 then
1961 reason:=12
1962 else
1963 if monitor(8<* reserve proc *>,typecat,0,type_tail)<>0 then
1964 reason:=13
1965 else
1966 begin
1967 setposition(typecat,0,0);
1968 inrec6(typecat,512);
1969 type_entry:=0;
1970 if typecat.type_entry(1)<>3 then
1971 reason:=14
1972 else
1973 if typecat.type_entry(2)<>typecat_size then
1974 reason:=15
1975 else
1976 type_entry_length:=typecat.user_entry(3);
1977 end;
1978 end;
1979 end
1980 else
1981 if new_catalog then
1982 begin <* ingen kataloger findes, opret nye *>
1983 write_message(31,0,true,<:Generating new catalog:>);
1984 reason:=init_catalogs;
1985 if reason=0 then
1986 reason:=fill_catalogs;
1987 close(cat_file,true);
1988 end;
1989 if reason<>0 then
1990 write_message(cat_line_nr,reason,false,<:Catalog error:>);
1991 if false then
1992 alarm: disable traped(31);
1993 end;
1994
1994 integer procedure calc_hash(id,cat_size);
1995 <* 34 *>
1996 <*-----------------------------------------------------------*>
1997 <* Beregn hash key ud fra navnet i id og kataloget størrelse *>
1998 <* *>
1999 <* id (call) : Navnet som hash nøglen beregnes for *>
2000 <* navnet står i integer array id(1:4) *>
2001 <* cat_size (call) : Størrelsen af kataloget hvortil hash *>
2002 <* skal benyttes *>
2003 <* Return : Den beregnede hash nøgle. *>
2004 <*-----------------------------------------------------------*>
2005 integer array id;
2006 integer cat_size;
2007 begin
2008 calc_hash:=1+((abs(id(1)+id(2)+id(3)+id(4))) mod (cat_size-1));
2009 end;
2010
2010
2010 procedure find_user_seg(seg_nr);
2011 <* 35 *>
2012 <*----------------------------------------------------------*>
2013 <* Find segment i usercat og indlæs dette. Udskriv aktuelt *>
2014 <* segment, hvis wflag er sat. *>
2015 <* *>
2016 <* seg_nr (call) : Nummeret på det segment der ønskes *>
2017 <*----------------------------------------------------------*>
2018 integer seg_nr;
2019 begin
2020 integer array ia(1:20);
2021
2021 trap(alarm);
2022 if seg_nr>(usercat_size-1) or seg_nr<0 then
2023 write_message(35,seg_nr,false,<:Illegal seg_nr in cat.:>)
2024 else
2025 if seg_nr<>user_seg then
2026 begin
2027 setposition(usercat,0,seg_nr);
2028 inrec6(usercat,512);
2029 getzone6(usercat,ia);
2030 ia(9):=seg_nr;
2031 setzone6(usercat,ia);
2032 user_seg:=seg_nr;
2033 end;
2034 if false then
2035 alarm: disable traped(35);
2036 end;
2037
2037 procedure write_user_seg;
2038 <* 36 *>
2039 <*----------------------------------------------------------*>
2040 <* Opdater aktuelt user segment på disken. Segmentet for- *>
2041 <* bliver i zone-bufferen med state: opend and positioned. *>
2042 <*----------------------------------------------------------*>
2043 begin
2044 integer array ia(1:20);
2045
2045 trap(alarm);
2046 setstate(usercat,6);
2047 if (user_seg>usercat_size-1) or (user_seg<0) then
2048 write_message(36,user_seg,false,<:Illegal seg_nr in cat.:>);
2049 setposition(usercat,0,user_seg);
2050 inrec6(usercat,512);
2051 getzone6(usercat,ia);
2052 ia(9):=user_seg;
2053 setzone6(usercat,ia);
2054 if false then
2055 alarm: disable traped(36);
2056 end;
2057
2057 procedure next_user_entry;
2058 <* 37 *>
2059 <*----------------------------------------------------------*>
2060 <* Find næste user_entry i katalog. Er aktuelt entry sidste *>
2061 <* i katalog sættes næste entry til det første i kataloget *>
2062 <*----------------------------------------------------------*>
2063 begin
2064 integer seg_nr;
2065
2065 trap(alarm);
2066 user_entry:=user_entry+user_entry_length;
2067 if (511-user_entry)<user_entry_length then
2068 begin
2069 seg_nr:=if user_seg=usercat_size-1 then
2070 1 <* Segment 0 benyttes til katalog information *>
2071 else
2072 user_seg+1;
2073 find_user_seg(seg_nr);
2074 user_entry:=2;
2075 end;
2076 if false then
2077 alarm: disable traped(37);
2078 end;
2079
2079 boolean procedure find_user(user_id);
2080 <* 38 *>
2081 <*----------------------------------------------------------*>
2082 <* Find user_entry i katalog med key som angivet user_id *>
2083 <* *>
2084 <* user_id (call) : Bruger navn i integer array (1:4) *>
2085 <* Return : True=fundet, False=ikke fundet *>
2086 <*----------------------------------------------------------*>
2087 integer array user_id;
2088 begin
2089 integer field hash_count;
2090 integer i,hash;
2091 boolean found;
2092
2092 trap(alarm);
2093 hash:=calc_hash(user_id,usercat_size);
2094 find_user_seg(hash);
2095 hash_count:=2;
2096 hash_count:=usercat.hash_count;
2097 user_entry:=2;
2098 if hash_count>0 then
2099 begin
2100 repeat
2101 if usercat.user_entry(1)=hash then
2102 begin
2103 found:=true;
2104 hash_count:=hash_count-1;
2105 for i:=2, i+1 while (i<=5 and found) do
2106 if usercat.user_entry(i)<>user_id(i-1) then
2107 found:=false;
2108 end
2109 else
2110 found:=false;
2111 if not found then
2112 next_user_entry;
2113 until found or hash_count=0 or
2114 (user_seg=hash and user_entry=2);
2115 if not found and hash_count>0 then
2116 write_message(38,1,true,<:Cyclic in catalog:>);
2117 end
2118 else
2119 found:=false;
2120 find_user:=found;
2121 if false then
2122 alarm: disable traped(38);
2123 end;
2124
2124 boolean procedure find_empty_user_entry(hash_key);
2125 <* 39 *>
2126 <*----------------------------------------------------------*>
2127 <* Find første tomme user_entry hørende til hash_key *>
2128 <* Optæl hash key tæller i hash segmentet. Sæt user_entry *>
2129 <* til fundet entry. Hash_key indsættes i fundet segment. *>
2130 <* Entry SKAL udskrives på disken efter indsættelse af data *>
2131 <* *>
2132 <* hash_key (call) : Hash nøglen hørende til det segment *>
2133 <* hvorfra der søges efter tomt entry *>
2134 <* Return : True=Entry fundet. Sat i user_entry *>
2135 <* False=Ikke mere plads i katalog *>
2136 <*----------------------------------------------------------*>
2137 integer hash_key;
2138 begin
2139 boolean room;
2140
2140 trap(alarm);
2141 find_user_seg(hash_key);
2142 user_entry:=0;
2143 usercat.user_entry(1):=usercat.user_entry(1)+1;
2144 setstate(usercat,6);
2145 user_entry:=2;
2146 room:=true;
2147 while usercat.user_entry(1)<>0 and room do
2148 begin
2149 next_user_entry;
2150 if (hash_key=user_seg) and (user_entry=2) then
2151 room:=false;
2152 end;
2153 if not room then
2154 begin
2155 find_empty_user_entry:=false;
2156 find_user_seg(hash_key);
2157 user_entry:=0;
2158 usercat.user_entry(1):=usercat.user_entry(1)-1;
2159 write_user_seg;
2160 end
2161 else
2162 begin
2163 find_empty_user_entry:=true;
2164 usercat.user_entry(1):=hash_key;
2165 end;
2166 if false then
2167 alarm: disable traped(39);
2168 end;
2169
2169
2169 procedure find_term_seg(seg_nr);
2170 <* 40 *>
2171 <*----------------------------------------------------------*>
2172 <* Find segment i termcat og indlæs dette. Udskriv aktuelt *>
2173 <* segment, hvis wflag er sat. *>
2174 <* *>
2175 <* seg_nr (call) : Nummeret på det segment der ønskes *>
2176 <*----------------------------------------------------------*>
2177 integer seg_nr;
2178 begin
2179 integer array ia(1:20);
2180
2180 trap(alarm);
2181 if seg_nr>(termcat_size-1) or seg_nr<0 then
2182 write_message(40,seg_nr,false,<:Illegal seg_nr in cat.:>)
2183 else
2184 if seg_nr<>term_seg then
2185 begin
2186 setposition(termcat,0,seg_nr);
2187 inrec6(termcat,512);
2188 getzone6(termcat,ia);
2189 ia(9):=seg_nr;
2190 setzone6(termcat,ia);
2191 term_seg:=seg_nr;
2192 end;
2193 if false then
2194 alarm: disable traped(40);
2195 end;
2196
2196 procedure write_term_seg;
2197 <* 41 *>
2198 <*----------------------------------------------------------*>
2199 <* Opdater aktuelt term segment på disken. Segmentet for- *>
2200 <* bliver i zone-bufferen med state: opend and positioned. *>
2201 <*----------------------------------------------------------*>
2202 begin
2203 integer array ia(1:20);
2204
2204 trap(alarm);
2205 setstate(termcat,6);
2206 if (term_seg>termcat_size-1) or (term_seg<0) then
2207 write_message(41,term_seg,false,<:Illegal seg_nr in cat.:>);
2208 setposition(termcat,0,term_seg);
2209 inrec6(termcat,512);
2210 getzone6(termcat,ia);
2211 ia(9):=term_seg;
2212 setzone6(termcat,ia);
2213 if false then
2214 alarm: disable traped(41);
2215 end;
2216
2216 procedure next_term_entry;
2217 <* 42 *>
2218 <*----------------------------------------------------------*>
2219 <* Find næste term_entry i katalog. Er aktuelt entry sidste *>
2220 <* i katalog sættes næste entry til det første i kataloget *>
2221 <*----------------------------------------------------------*>
2222 begin
2223 integer seg_nr;
2224
2224 trap(alarm);
2225 term_entry:=term_entry+term_entry_length;
2226 if (511-term_entry)<term_entry_length then
2227 begin
2228 seg_nr:=if term_seg=termcat_size-1 then
2229 1 <* Segment 0 benyttes til katalog information *>
2230 else
2231 term_seg+1;
2232 find_term_seg(seg_nr);
2233 term_entry:=2;
2234 end;
2235 if false then
2236 alarm: disable traped(42);
2237 end;
2238
2238 boolean procedure find_term(term_id);
2239 <* 43 *>
2240 <*----------------------------------------------------------*>
2241 <* Find term_entry i katalog med key som angivet term_id *>
2242 <* *>
2243 <* term_id (call) : Terminal navn (integer array (1:4)) *>
2244 <* Return : True=fundet, False=ikke fundet *>
2245 <*----------------------------------------------------------*>
2246 integer array term_id;
2247 begin
2248 integer field hash_count;
2249 integer i,hash;
2250 boolean found;
2251
2251 trap(alarm);
2252 hash:=calc_hash(term_id,termcat_size);
2253 find_term_seg(hash);
2254 hash_count:=2;
2255 hash_count:=termcat.hash_count;
2256 term_entry:=2;
2257 if hash_count>0 then
2258 begin
2259 repeat
2260 if termcat.term_entry(1)=hash then
2261 begin
2262 found:=true;
2263 hash_count:=hash_count-1;
2264 for i:=2, i+1 while (i<=5 and found) do
2265 if termcat.term_entry(i)<>term_id(i-1) then
2266 found:=false;
2267 end
2268 else
2269 found:=false;
2270 if not found then
2271 next_term_entry;
2272 until found or hash_count=0 or
2273 (term_seg=hash and term_entry=2);
2274 if not found and hash_count>0 then
2275 write_message(43,2,true,<:Cyclic in catalog:>);
2276 end
2277 else
2278 found:=false;
2279 find_term:=found;
2280 if false then
2281 alarm: disable traped(43);
2282 end;
2283
2283 boolean procedure find_empty_term_entry(hash_key);
2284 <* 44 *>
2285 <*----------------------------------------------------------*>
2286 <* Find første tomme term_entry hørende til hash_key *>
2287 <* Optæl hash key tæller i hash segmentet. Sæt term_entry *>
2288 <* til fundet entry. Hash_key indsættes i fundet segment. *>
2289 <* Entry SKAL udskrives på disken efter indsættelse af data *>
2290 <* *>
2291 <* hash_key (call) : Hash nøglen hørende til det segment *>
2292 <* hvorfra der søges efter tomt entry *>
2293 <* Return : True=Entry fundet. Sat i term_entry *>
2294 <* False=Ikke mere plads i katalog *>
2295 <*----------------------------------------------------------*>
2296 integer hash_key;
2297 begin
2298 boolean room;
2299
2299 trap(alarm);
2300 find_term_seg(hash_key);
2301 term_entry:=0;
2302 termcat.term_entry(1):=termcat.term_entry(1)+1;
2303 setstate(termcat,6);
2304 term_entry:=2;
2305 room:=true;
2306 while termcat.term_entry(1)<>0 and room do
2307 begin
2308 next_term_entry;
2309 if (hash_key=term_seg) and (term_entry=2) then
2310 room:=false;
2311 end;
2312 if not room then
2313 begin
2314 find_empty_term_entry:=false;
2315 find_term_seg(hash_key);
2316 term_entry:=0;
2317 termcat.term_entry(1):=termcat.term_entry(1)-1;
2318 write_term_seg;
2319 end
2320 else
2321 begin
2322 find_empty_term_entry:=true;
2323 termcat.term_entry(1):=hash_key;
2324 end;
2325 if false then
2326 alarm: disable traped(44);
2327 end;
2328
2328 boolean procedure find_type_entry(type_nr);
2329 <* 45 *>
2330 <*----------------------------------------------------------*>
2331 <* Find entry hørende til angivet type. Sæt type_entry *>
2332 <* BEMÆRK: Benyttes parallelt i catalog, operatør og *>
2333 <* timecheck korutinerne *>
2334 <* *>
2335 <* type_nr (call) : typen af terminalen >0 *>
2336 <* Return : True=Entry fundet, False= IKKE fundet *>
2337 <* field type_entry sat til entry *>
2338 <*----------------------------------------------------------*>
2339 integer type_nr;
2340 begin
2341 integer seg;
2342 integer array ia(1:20);
2343
2343 trap(alarm);
2344 seg:=(type_nr-1)//(512//type_entry_length)+1;
2345 if seg > typecat_size-1 or seg<1 or type_nr<1 then
2346 find_type_entry:=false
2347 else
2348 begin
2349 type_entry:=type_entry_length*((type_nr-1) mod (512//type_entry_length));
2350 setposition(typecat,0,seg);
2351 inrec6(typecat,512); <* NO passivate *>
2352 getzone6(typecat,ia);
2353 ia(9):=seg;
2354 setzone6(typecat,ia);
2355 find_type_entry:=true;
2356 end;
2357 if false then
2358 alarm: disable traped(45);
2359 end;
2360
2360 procedure write_type_seg;
2361 <* 46 *>
2362 <*----------------------------------------------------------*>
2363 <* Opdater aktuelt type segment på disken. Segmentet for- *>
2364 <* bliver i zone-bufferen med state: opend and positioned. *>
2365 <*----------------------------------------------------------*>
2366 begin
2367 integer seg;
2368 integer array ia(1:20);
2369
2369 trap(alarm);
2370 getposition(typecat,0,seg);
2371 setstate(typecat,6);
2372 setposition(typecat,0,seg);
2373 inrec6(typecat,512);
2374 getzone6(typecat,ia);
2375 ia(9):=seg;
2376 setzone6(typecat,ia);
2377 if false then
2378 alarm: disable traped(46);
2379 end;
2380
2380 procedure read_param_line;
2381 <* 47 *>
2382 <*---------------------------------------------------------------*>
2383 <* Læs parametre fra fp kaldet *>
2384 <* Sæt : new_catalog / cattxt_name *>
2385 <* init_file_name *>
2386 <* fp_maxterms *>
2387 <* *>
2388 <* init_file_name sættes default til: 'tasinit' men ændres *>
2389 <* hvis der angives init.<name> i kald *>
2390 <* maxterms sættes fra kald hvis der angives terminals.<antal> *>
2391 <* ellers sættes maxterms fra init_file. *>
2392 <* Angives catalog.<name> sættes <name> i cattxt_name og *>
2393 <* new_catalog sættes true *>
2394 <*---------------------------------------------------------------*>
2395 begin
2396 integer j,seperator,i,key;
2397 real array item(1:2);
2398
2398 trap(alarm);
2399 new_catalog:=false;
2400 fp_maxterms:=0;
2401 init_file_name.laf(1):=init_file_name.laf(2):=0;
2402 put_text(init_file_name.laf,1,<:tasinit:>); <* Default init name *>
2403 i:=1;
2404 repeat
2405 seperator:=system(4,i,item);
2406 i:=i+1;
2407 if seperator=(4 shift 12) + 10 then
2408 begin
2409 key:=find_keyword_value(item.laf(1),3);
2410 seperator:=system(4,i,item);
2411 i:=i+1;
2412 if key=7 then
2413 begin
2414 if seperator=(8 shift 12) + 10 then
2415 begin
2416 new_catalog:=true;
2417 for j:=1,2 do
2418 cattxt_name.laf(j):=item.laf(j);
2419 end
2420 else
2421 write_message(47,i,false,<:Illegal call parameter:>);
2422 end
2423 else
2424 if key=9 then
2425 begin
2426 if seperator=(8 shift 12) + 10 then
2427 begin
2428 for j:=1,2 do
2429 init_file_name.laf(j):=item.laf(j);
2430 end
2431 else
2432 write_message(47,i,false,<:Illegal call parameter:>);
2433 end
2434 else
2435 if key=8 then
2436 begin
2437 if seperator=(8 shift 12) + 4 then
2438 fp_maxterms:=item(1)
2439 else
2440 write_message(47,i,false,<:Illegal call parameter:>);
2441 end
2442 else
2443 write_message(47,i,false,<:Unknown call parameter:>);
2444 end;
2445 until seperator=0;
2446 if false then
2447 alarm: disable traped(47);
2448 end;
2449
2449 procedure init_tascat;
2450 <* 48 *>
2451 <*-------------------------------------------------------*>
2452 <* Initialiser tascat variable. *>
2453 <* Data hentes enten fra init fil eller der benyttes *>
2454 <* standard værdi. Beskrivelsen af data typer og *>
2455 <* standard værdier sættes i procedure init_param_arrays *>
2456 <*-------------------------------------------------------*>
2457 begin
2458 zone init_file(128,1,std_error);
2459 integer array val(0:45);
2460 integer array init_type,init_count(1:init_num_keys-9);
2461 integer array init_lim(1:init_num_keys-9,1:2);
2462 long array init_default(1:init_num_keys-9);
2463 integer array spoolname,ttname,temname(1:4);
2464 integer spseg,textbufsize,timeout,tbufsize,ttmask,reserve,i;
2465
2465 procedure init_param_arrays;
2466 <* 49 *>
2467 <*-------------------------------------------------*>
2468 <* Initialiser arrays der beskriver data typer m.m *>
2469 <*-------------------------------------------------*>
2470 begin
2471 long f,t;
2472 integer i;
2473 integer max,min;
2474
2474 <*********************************************************************>
2475 <* Følgende arrays initialiseres: *>
2476 <* integer array init_type(1:???) ; Beskriver typen af data : *>
2477 <* 0 = IKKE brugt *>
2478 <* 1 = cmcl-tekst *>
2479 <* 2 = navn *>
2480 <* 3 = heltal (integer) *>
2481 <* 4 = logisk (boolean) *>
2482 <* 5 = 2 heltal (integer) *>
2483 <* *>
2484 <* long array init_default(1:???) ; Standard værdi : *>
2485 <* For type 1 : 0 til 130 iso tegn *>
2486 <* 2 : 0 til 11 iso tegn *>
2487 <* 3 : Heltals værdi *>
2488 <* 4 : false add værdi (0=false , 1=true) *>
2489 <* 5 : Heltals værdi for begge værdier *>
2490 <* *>
2491 <* integer array init_lim(1:???,1:2) ; Grænser for angivet værdi *>
2492 <* For type 1 : (1) = Max. antal tegn *>
2493 <* (2) = ubrugt *>
2494 <* 2 : (1) = ubrugt *>
2495 <* (2) = ubrugt *>
2496 <* 3 : (1) = mindste værdi *>
2497 <* (2) = største værdi *>
2498 <* 4 : (1) = ubrugt *>
2499 <* (2) = ubrugt *>
2500 <* 5 : (1) = mindste værdi *>
2501 <* (2) = største værdi *>
2502 <* *>
2503 <* integer array init_count(1:???); Beskrivelse af gemning af værdi *>
2504 <* Angiver antallet af ord -1, der indgår i værdien. *>
2505 <* *>
2506 <* Navne på parametrerne i init_file sættes i : *>
2507 <* procedure keywords_init i array init_keywords. *>
2508 <* fra keyword 10 og frem. Keyword værdi benyttes som index til *>
2509 <* init array's. Lokale værdier sættes i set_local_data *>
2510 <*********************************************************************>
2511 trap(alarm);
2512 t:=1; f:=0;
2513 max:=8388605; min:=-8388607;
2514 for i:=1 step 1 until init_num_keys-9 do
2515 begin
2516 init_type(i):=case i of
2517 (2,2,2,2,2,2,2,2,4,3,
2518 3,4,3,5,5,3,3,3,3,3,
2519 3,3,3,3,3,3,3,3,1,1,
2520 1,1,3,3,3,3,4);
2521
2521 init_default(i):=case i of
2522 (long <:disc:>,long <:tasusercat:>,long <:tastermcat:>,
2523 long <:tastypecat:>,long <:tascattest:>,long <:tasspool:>,
2524 long <:tastermtest:>, long <:tem:>,t,3,
2525 3,t,5,max,max,0,0,20,10,5,
2526 25,5,2,170,3,10,2,30,long <::>,long <::>,
2527 long <:Afmeld !:>,long <:Afmeld !:>,412,-1,1365,0,t);
2528
2528 init_count(i):=case i of
2529 (3,3,3,3,3,3,3,3,0,0,
2530 0,0,0,0,0,0,0,0,0,0,
2531 0,0,0,0,0,0,0,0,27,45,
2532 27,27,0,0,0,0,0);
2533
2533 init_lim(i,1):=case i of
2534 (0,0,0,0,0,0,0,0,0,0,
2535 0,0,1,min,min,0,0,1,1,1,
2536 3,1,1,70,1,1,1,1,80,80,
2537 80,80,0,-1,0,0,0);
2538
2538 init_lim(i,2):=case i of
2539 (0,0,0,0,0,0,0,0,0,4095,
2540 4095,0,30,max,max,max,max,max,max,max,
2541 max,max,max,500,2047,max,5,max,0,0,
2542 0,0,1024,0,4095,999999,0);
2543
2543 end;
2544 if false then
2545 alarm: disable traped(49);
2546 end;
2547
2547 procedure set_default;
2548 <* 50 *>
2549 <*------------------------------------------------------*>
2550 <* Sæt standard værdierne i lokale og globale variable *>
2551 <*------------------------------------------------------*>
2552 begin
2553 integer i,j;
2554
2554 <*************************************************************************>
2555 <* integer array val benyttes til midlertidig opbevaring af læst værdi *>
2556 <* For type 1 : (0) = hw's shift 12 + char's *>
2557 <* (1:45) = Teksten *>
2558 <* 2 : (0:3) = Navnet (udfyldt med 0) *>
2559 <* 3 : (0) = Værdien *>
2560 <* 4 : (0) = (0=false , 1=true); *>
2561 <* 5 : (0),(1)= 2 værdier *>
2562 <*************************************************************************>
2563 trap(alarm);
2564 host_id(0):=signon_text(0):=logtxt(0):=stoptxt(0):=0;
2565 for i:=1 step 1 until init_num_keys-9 do
2566 begin
2567 if init_type(i)>0 then
2568 begin
2569 case init_type(i) of
2570 begin
2571 begin <* 1 *>
2572 val(0):=puttext(val.laf,1,string init_default(i),-init_lim(i,1));
2573 val(0):=val(0)+1;
2574 put_ch(val.laf,val(0)+0,10,1);
2575 put_ch(val.laf,val(0)+1,0,6);
2576 val(0):=(((val(0)+2)//3+1)*2) shift 12 + val(0);
2577 end;
2578 begin <* 2 *>
2579 val.laf(1):=val.laf(2):=0;
2580 puttext(val.laf,1,string init_default(i),-11);
2581 for j:=1 step 1 until 4 do
2582 val(j-1):=val(j);
2583 end;
2584 begin <* 3 *>
2585 val(0):=init_default(i);
2586 end;
2587 begin <* 4 *>
2588 val(0):=init_default(i);
2589 end;
2590 begin <* 5 *>
2591 val(0):=init_default(i);
2592 val(1):=init_default(i);
2593 end;
2594 end;
2595 set_local_data(i);
2596 end;
2597 end;
2598 if false then
2599 alarm: disable traped(50);
2600 end;
2601
2601 procedure read_init_param;
2602 <* 51 *>
2603 <*---------------------------------------------------*>
2604 <* Modifiser værdier med læste værdier fra init_file *>
2605 <*---------------------------------------------------*>
2606 begin
2607 integer i,j,init_line_nr;
2608 boolean ok;
2609
2609 trap(alarm);
2610 init_line_nr:=1;
2611 i:=read_start_key(init_file,3,init_line_nr);
2612 while i=0 do
2613 begin
2614 next_line(init_file,init_line_nr);
2615 i:=read_start_key(init_file,3,init_line_nr);
2616 end;
2617 i:=i-9;
2618 while i>=1 do
2619 begin
2620 if init_type(i)>0 then
2621 begin
2622 case init_type(i) of
2623 begin
2624 begin <* 1 *>
2625 val(0):=read_text(init_file,val.laf,init_lim(i,1));
2626 val(0):=val(0)+1;
2627 put_ch(val.laf,val(0)+0,10,1);
2628 put_ch(val.laf,val(0)+1,0,6);
2629 val(0):=(((val(0)+2)//3+1)*2) shift 12 + val(0);
2630 end;
2631 begin <* 2 *>
2632 read_name(init_file,val,ok);
2633 if not ok then
2634 write_message(51,init_line_nr,false,<:Illegal init. value:>);
2635 end;
2636 begin <* 3 *>
2637 if not read_nr(init_file,val(0)) or
2638 (val(0)<init_lim(i,1)) or (val(0)>init_lim(i,2)) then
2639 write_message(51,init_line_nr,false,<:Illegal init. value:>);
2640 end;
2641 begin <* 4 *>
2642 j:=read_start_key(init_file,3,init_line_nr);
2643 if j=1 <* true *> or j=3 <* on *> or j=5 <* start *> then
2644 val(0):=1
2645 else
2646 if j=2 <* false *> or j=4 <* off *> or j=6 <* stop *> then
2647 val(0):=0
2648 else
2649 write_message(51,init_line_nr,false,<:Illegal init. value:>);
2650 end;
2651 begin <* 5 *>
2652 if not read_nr(init_file,val(0)) or
2653 (val(0)<init_lim(i,1)) or (val(0)>init_lim(i,2)) then
2654 write_message(51,init_line_nr,false,<:Illegal init. value:>);
2655 if not read_nr(init_file,val(1)) or
2656 (val(1)<init_lim(i,1)) or (val(1)>init_lim(i,2)) then
2657 write_message(51,init_line_nr,false,<:Illegal init. value:>);
2658 end;
2659 end;
2660 set_local_data(i);
2661 end;
2662 next_line(init_file,init_line_nr);
2663 i:=read_start_key(init_file,3,init_line_nr)-9;
2664 end;
2665 if i=-9 then
2666 write_message(51,init_line_nr,false,<:Unknown init. param.:>);
2667 if false then
2668 alarm: disable traped(51);
2669 end;
2670
2670 procedure set_local_data(key);
2671 <* 52 *>
2672 <*------------------------------------*>
2673 <* Sæt data fra val i lokale variable *>
2674 <* *>
2675 <* key (call) : Angiver den variable *>
2676 <* der skal initialiseres*>
2677 <*------------------------------------*>
2678 integer key;
2679 begin
2680 integer i;
2681 integer array st(0:68);
2682
2682 for i:=0 step 1 until init_count(key) do
2683 begin
2684 case key of
2685 begin
2686 cat_doc(i+1):=val(i);
2687 usercat_name(i+1):=val(i);
2688 termcat_name(i+1):=val(i);
2689 typecat_name(i+1):=val(i);
2690 testout_name(i+1):=val(i);
2691 spoolname(i+1):=val(i);
2692 ttname(i+1):=val(i);
2693 temname(i+1):=val(i);
2694 login_stat:=if val(0)=0 then 0 else 96;
2695 max_user_block:=val(0);
2696 max_term_block:=val(0);
2697 timecheck_stat:=false add val(0);
2698 logtime:=val(0);
2699 begin
2700 cmclbases(1):=val(0);
2701 cmclbases(2):=val(1);
2702 end;
2703 begin
2704 sysbases(1):=val(0);
2705 sysbases(2):=val(1);
2706 end;
2707 cps:=val(0);
2708 cls:=val(0);
2709 max_sessions:=val(0);
2710 max_terminals:=val(0);
2711 max_sysmenu:=val(0);
2712 corebufs:=val(0);
2713 mclprogs:=val(0);
2714 term_types:=val(0);
2715 tbufsize:=val(0);
2716 spseg:=val(0);
2717 max_users:=val(0);
2718 number_of_opera:=val(0);
2719 timeout:=val(0);
2720 host_id(i):=val(i);
2721 st(i):=val(i);
2722 logtxt(i):=val(i);
2723 stoptxt(i):=val(i);
2724 begin
2725 testselect:=val(0) extract 8;
2726 tracetype:=val(0) shift (-8);
2727 end;
2728 trapmode:=val(0);
2729 ttmask:=val(0);
2730 initver:=val(0);
2731 reserve:=val(0);
2732 end;
2733 end;
2734 if key=30 then
2735 begin
2736 i:=signon_text(0) extract 12 + 1;
2737 put_txt(signon_text.laf,i,st.laf,st(0) extract 12);
2738 put_ch(signon_text.laf,i+0,0,6);
2739 signon_text(0):=(((i+1)//3)*2) shift 12 + (i-1);
2740 end;
2741 end;
2742
2742 trap(alarm);
2743 open(init_file,4,init_file_name,0);
2744 if monitor(42,init_file,0,val)<>0 then
2745 write_message(48,1,false,<:No init. file:>);
2746 init_param_arrays;
2747 set_default;
2748 <* Set host id fra navn i monitor *>
2749 hostid(0):=22 shift 12 + 29;
2750 movestring(hostid.laf,1,<: Velkommen til :>);
2751 system(5,1192,val);
2752 for i:=1,2,3,4 do
2753 hostid(6+i):=val(i);
2754 read_init_param;
2755 text_buf_size:=148;
2756 max_text_count:=max_terminals//4;
2757 test_on:=true;
2758 language:=1;
2759 close(init_file,true);
2760 <* Sæt data i copy_buf *>
2761 copy_buf.iaf(1):=cps+cls+2*max_sessions+max_sysmenu; <* Antal cdescr *>
2762 copy_buf.iaf(2):=term_types; <* Antal terminal type beskrivelser *>
2763 copy_buf.iaf(3):=max_terminals; <* Antal terminal beskrivelser *>
2764 copy_buf.iaf(4):=mclprogs; <* Antal indgange i mcltable *>
2765 copy_buf.iaf(5):=spoolname(1); <* Navn på spool area *>
2766 copy_buf.iaf(6):=spoolname(2);
2767 copy_buf.iaf(7):=spoolname(3);
2768 copy_buf.iaf(8):=spoolname(4);
2769 copy_buf.iaf(9):=corebufs; <* Antal core buffere *>
2770 copy_buf.iaf(10):=max_sysmenu//2;<* Antal att event descr *>
2771 copy_buf.iaf(11):=reserve; <* reserver terminal ved create link *>
2772 copy_buf.iaf(12):=cmclbases(1); <* MCL database std baser *>
2773 copy_buf.iaf(13):=cmclbases(2);
2774 copy_buf.iaf(14):=cls+max_sessions+max_sysmenu; <* Antal termina buf *>
2775 copy_buf.iaf(15):=tbufsize; <* max tbuf size *>
2776 copy_buf.iaf(16):=spseg; <* std seg i link spool area *>
2777 copy_buf.iaf(17):=2*152; <* hw i signon buffer *>
2778 copy_buf.iaf(18):=sysbases(1); <* test/spool baser *>
2779 copy_buf.iaf(19):=sysbases(2);
2780 copy_buf.iaf(20):=temname(1); <* Navn på tem pseudo proces *>
2781 copy_buf.iaf(21):=temname(2);
2782 copy_buf.iaf(22):=temname(3);
2783 copy_buf.iaf(23):=temname(4);
2784 copy_buf.iaf(24):=ttname(1); <* Testområde navn *>
2785 copy_buf.iaf(25):=ttname(2);
2786 copy_buf.iaf(26):=ttname(3);
2787 copy_buf.iaf(27):=ttname(4);
2788 copy_buf.iaf(28):=timeout; <* Antal timeout på term i mcl *>
2789 copy_buf.iaf(29):=textbufsize; <* Antal hw til txt i systxt buf *>
2790 copy_buf.iaf(30):=max_text_count;<* Antal udestående systxt mess. *>
2791 copy_buf.iaf(31):=ttmask; <* testmaske *>
2792 copy_buf.iaf(32):=cps; <* max pools efter create pool mess. *>
2793 copy_buf.iaf(33):=max_sessions; <* Max sessioner *>
2794
2794 if false then
2795 alarm: disable traped(48);
2796 end;
2797
2797 procedure wait_tasterm(error);
2798 <* 53 *>
2799 <*----------------------------------------------*>
2800 <* Vent på init message fra tasterm *>
2801 <* Når denne kommer sendes init data til tasterm*>
2802 <*----------------------------------------------*>
2803 boolean error;
2804 begin
2805 zone z(1,1,stderror);
2806 integer buf;
2807
2807 trap(alarm);
2808 write_message(-53,0,true,if error then <:Stop menu:> else <:Synchronizing:>);
2809 repeat
2810 <* sæt tasterm_pda ud fra denne message *>
2811 tasterm_pda:=monitor(20,z,buf,answer);
2812 <* sæt tasterm_name ud fra pda *>
2813 if not get_proc_name(tasterm_pda,tasterm_name) then
2814 write_message(53,1,false,<:Sync. error:>);
2815 if answer(1)<>(9 shift 12 + 1) then
2816 begin
2817 write_message(53,answer(1),true,<:System not running yet:>);
2818 answer(9):=3;
2819 monitor(22,z,buf,answer);
2820 end;
2821 until answer(1)=(9 shift 12 + 1);
2822 tastermverd:=answer(4);
2823 tastermvert:=answer(5);
2824 write_message(answer(5),answer(4),true,<:Tasterm release:>);
2825 write_message(relt,reld,true,<:Tascat release:>);
2826 write_message(0,initver,true,<:Init. version:>);
2827 <* retur init data til tasterm *>
2828 if data_from_copy_buf(256,buf,answer)<>0 then
2829 write_message(53,2,false,<:Sync. error:>);
2830 answer(9):=1;
2831 answer(1):=if error then 1 else 0;
2832 monitor(22,z,buf,answer);
2833 if false then
2834 alarm: disable traped(53);
2835 end;
2836
2836 procedure tascat;
2837 <* 00 *>
2838 <*------------------------------------------*>
2839 <*------------------------------------------*>
2840 <* Hoved procedure for TASCAT *>
2841 <*------------------------------------------*>
2842 <*------------------------------------------*>
2843 begin
2844 integer array login_struc(1:4*struc_size);
2845
2845 <*---------------------------------------------------------------------*>
2846 <* login_struc indeholder beskrivelse af alle tilmeldte brugere *>
2847 <* *>
2848 <* ! *>
2849 <* bruger ----> terminal ---- session *>
2850 <* ! ! ! *>
2851 <* ! ! V *>
2852 <* ! ! session *>
2853 <* ! ! . *>
2854 <* ! V . *>
2855 <* ! terminal ... *>
2856 <* V . *>
2857 <* bruger ... . *>
2858 <* . *>
2859 <* . *>
2860 <* *>
2861 <* login_struc er opdelt i blokke af 4 integer. *>
2862 <* brugerbeskrivelse = 2 blokke *>
2863 <* terminalbeskrivelse = 1 blok *>
2864 <* sessionsbeskrivelse = 1 blok *>
2865 <* *>
2866 <* brugerbeskrivelse: *>
2867 <* *>
2868 <* (0) - (3) : user id *>
2869 <* (4) : userindex map < 12 + last login time *>
2870 <* (5) : user privilege < 12 + user status *>
2871 <* (6) : terminal pointer *>
2872 <* (7) : next user pointer *>
2873 <* *>
2874 <* terminalbeskrivelse: *>
2875 <* *>
2876 <* (0) : terminal pda (Negative = terminal removed) *>
2877 <* (1) : mess < 21 + session map < 12 + terminal type *>
2878 <* (2) : session pointer *>
2879 <* (3) : next terminal pointer *>
2880 <* *>
2881 <* sessionbeskriver *>
2882 <* *>
2883 <* (0) : terminal handler cda (tasterm) *>
2884 <* (1) : session nr < 12 + user index *>
2885 <* (2) : session status *>
2886 <* (3) : next session *>
2887 <* *>
2888 <* free block beskriver *>
2889 <* *>
2890 <* (0) : 0 *>
2891 <* (1) : 0 *>
2892 <* (2) : prev. free block pointer *>
2893 <* (3) : next free block pointer *>
2894 <* *>
2895 <* pointer er index på første integer i blok. pointer lig 0 er tom. *>
2896 <* *>
2897 <* mess : 0 = ingen message *>
2898 <* bit sat angiver text buffer nr: *>
2899 <* lsb = 1, msb = 3 *>
2900 <* user index map : bit sat for hver user index benyttet *>
2901 <* index 0 lig lsb. *>
2902 <* session map : bit sat for hver session i brug *>
2903 <* session 1 lig 1 shift 1. *>
2904 <* last login time : sidste tilmeldingstid (0 til 24) *>
2905 <* 25 = ingen begrænsning (NON) *>
2906 <* 26 = under afmelding (NOW) *>
2907 <* 27 = remove mess. sendt *>
2908 <* >100 lig næste dag. *>
2909 <* user privilege : privilegiebit fra katalog *>
2910 <* user status : bit 11 sat lig tilmelding stoppet for bruger *>
2911 <* session status : bit 23 sat lig removing session *>
2912 <* *>
2913 <*---------------------------------------------------------------------*>
2914
2914
2914 procedure init_login_struc;
2915 <* 54 *>
2916 <*----------------------------------------------------*>
2917 <* Initialiser login_struc *>
2918 <*----------------------------------------------------*>
2919 begin
2920 integer size,pos;
2921
2921 trap(alarm);
2922 system(3,size,login_struc);
2923 free_list:=1;
2924 userlist:=0;
2925 login_struc(1):=login_struc(2):=login_struc(3):=0;
2926 login_struc(4):=5;
2927 for pos:=5 step 4 until size-4 do
2928 begin
2929 login_struc(pos):=login_struc(pos+1):=0;
2930 login_struc(pos+2):=pos-4;
2931 login_struc(pos+3):=pos+4;
2932 end;
2933 login_struc(pos):=login_struc(pos+1):=login_struc(pos+3):=0;
2934 login_struc(pos+2):=pos-4;
2935 if false then
2936 alarm: disable traped(54);
2937 end;
2938
2938 integer procedure get_free_login(numbers);
2939 <* 55 *>
2940 <*--------------------------------------------------------------*>
2941 <* Reserver et antal sammenhængende blokke i login strukturen. *>
2942 <* *>
2943 <* numbers (call) : Det antal blokke der ønskes reserveret *>
2944 <* Return : Peger til første blok der er reserveret *>
2945 <* eller nul (0) hvis det ikke var muligt *>
2946 <*--------------------------------------------------------------*>
2947 integer numbers;
2948 begin
2949 boolean found;
2950 integer free,cur,next,prev;
2951
2951 trap(alarm);
2952 get_free_login:=0;
2953 found:=false;
2954 cur:=free_list;
2955 while not found and cur>0 do
2956 begin
2957 found:=true;
2958 free:=cur;
2959 while free <= cur+(numbers-2)*4 and found do
2960 if login_struc(free+3)=free+4 then
2961 free:=free+4
2962 else
2963 found:=false;
2964 if not found then
2965 cur:=login_struc(free+3);
2966 end;
2967 if found then
2968 begin
2969 get_free_login:=cur;
2970 next:=login_struc(free+3);
2971 prev:=login_struc(cur+2);
2972 if prev=0 then
2973 free_list:=next
2974 else
2975 login_struc(prev+3):=next;
2976 if next>0 then
2977 login_struc(next+2):=prev;
2978 end;
2979 if false then
2980 alarm: disable traped(55);
2981 end;
2982
2982 procedure release_block(addr);
2983 <* 56 *>
2984 <*---------------------------------------------------------------*>
2985 <* Indsæt blokken angivet ved addr i free listen direkte efter *>
2986 <* den forrige frie blok. *>
2987 <* *>
2988 <* addr (call) : Adressen på den blok der skal indsættes i free *>
2989 <* listen (listen udpeget af free_list) *>
2990 <*---------------------------------------------------------------*>
2991 integer addr;
2992 begin
2993 integer prev,next;
2994
2994 trap(alarm);
2995 prev:=0;
2996 next:=free_list;
2997 while not (next > addr) and next>0 do
2998 begin
2999 prev:=next;
3000 next:=login_struc(prev+3);
3001 end;
3002 login_struc(addr):=0;
3003 login_struc(addr+1):=0;
3004 login_struc(addr+2):=prev;
3005 login_struc(addr+3):=next;
3006 if prev=0 then
3007 free_list:=addr
3008 else
3009 login_struc(prev+3):=addr;
3010 if next>0 then
3011 login_struc(next+2):=addr;
3012 if false then
3013 alarm: disable traped(56);
3014 end;
3015
3015 integer procedure find_login_user(id,start);
3016 <* 57 *>
3017 <*-------------------------------------------------------------*>
3018 <* Find bruger beskrivelse i login struktur ud fra id *>
3019 <* Start søgningen med beskrivelsen udpeget af start *>
3020 <* *>
3021 <* id (call) : Navnet på brugeren der skal søges efter *>
3022 <* start (call) : Peger til første beskrivelse der søges i *>
3023 <* Return : Peger til fundet beskrivelse eller nul hvis *>
3024 <* beskrivelsen ikke blev fundet *>
3025 <*-------------------------------------------------------------*>
3026 value start;
3027 integer start;
3028 integer array id;
3029 begin
3030 integer i;
3031 boolean found;
3032
3032 trap(alarm);
3033 find_login_user:=0;
3034 while start>0 do
3035 begin
3036 found:=true;
3037 for i:=1, i+1 while (i<=4 and found) do
3038 if login_struc(start+i-1)<>id(i) then
3039 found:=false;
3040 if found then
3041 begin
3042 find_login_user:=start;
3043 start:=0;
3044 end
3045 else
3046 start:=login_struc(start+7);
3047 end;
3048 if false then
3049 alarm: disable traped(57);
3050 end;
3051
3051 integer procedure find_login_terminal(name,user_index);
3052 <* 58 *>
3053 <*-----------------------------------------------------------*>
3054 <* Find terminal beskrivelse i login_struc ud fra navn *>
3055 <* *>
3056 <* name (call) : Navnet på terminalen *>
3057 <* user_index (ret) : Index i login_struc på terminal bruger *>
3058 <* Return : Index i login_struc hvis fundet ellers 0 *>
3059 <*-----------------------------------------------------------*>
3060 integer array name;
3061 integer user_index;
3062 begin
3063 integer pda,term_index;
3064 boolean found;
3065
3065 trap(alarm);
3066 pda:=get_pda(name);
3067 found:=false;
3068 term_index:=0;
3069 while user_index>0 and not found do
3070 begin
3071 term_index:=find_user_terminal(pda,login_struc(user_index+6));
3072 if term_index>0 then
3073 found:=true
3074 else
3075 user_index:=login_struc(user_index+7);
3076 end;
3077 find_login_terminal:=term_index;
3078 if false then
3079 alarm: disable traped(58);
3080 end;
3081
3081 integer procedure find_user_terminal(pda,start);
3082 <* 59 *>
3083 <*-------------------------------------------------------------*>
3084 <* Find terminal beskrivelse i login struktur ud fra pda *>
3085 <* Start søgningen med beskrivelsen udpeget af start *>
3086 <* *>
3087 <* pda (call) : PDA for den terminal der ledes efter *>
3088 <* start (call) : Peger til første beskrivelse der søges i *>
3089 <* Return : Peger til fundet beskrivelse eller nul hvis *>
3090 <* beskrivelsen ikke blev fundet *>
3091 <*-------------------------------------------------------------*>
3092 value start;
3093 integer pda,start;
3094 begin
3095 trap(alarm);
3096 find_user_terminal:=0;
3097 while start>0 do
3098 begin
3099 if login_struc(start)=pda then
3100 begin
3101 find_user_terminal:=start;
3102 start:=0;
3103 end
3104 else
3105 start:=login_struc(start+3);
3106 end;
3107 if false then
3108 alarm: disable traped(59);
3109 end;
3110
3110
3110 boolean procedure check_term(term_id);
3111 <* 60 *>
3112 <*--------------------------------------------------------------------*>
3113 <* Undersøg om terminal er indlogget *>
3114 <* *>
3115 <* term_id (call) : Navnet på terminalen (integer array (1:4) *>
3116 <* Return : True = terminal indlogget *>
3117 <* False = terminal ikke indlogget *>
3118 <*--------------------------------------------------------------------*>
3119 integer array term_id;
3120 begin
3121 integer pda,next;
3122 integer array dummy(1:1);
3123 boolean found;
3124
3124 trap(alarm);
3125 found:=false;
3126 pda:=get_pda(term_id);
3127 if pda<>0 then
3128 begin
3129 next:=user_list;
3130 while (next<>0) and not found do
3131 begin
3132 found:=find_user_terminal(pda,login_struc(next+6))>0;
3133 next:=login_struc(next+7);
3134 end;
3135 end;
3136 check_term:=found;
3137 if false then
3138 alarm: disable traped(60);
3139 end;
3140
3140 boolean procedure check_type(type_nr);
3141 <* 61 *>
3142 <*--------------------------------------------------------------------*>
3143 <* Undersøg om terminal med givet type nummer er indlogget *>
3144 <* *>
3145 <* type_nr (call) : nummeret på den type der checkes *>
3146 <* Return : True = type benyttet *>
3147 <* False = type ikke benyttet *>
3148 <*--------------------------------------------------------------------*>
3149 integer type_nr;
3150 begin
3151 integer next_user,next_term;
3152 boolean found;
3153
3153 trap(alarm);
3154 found:=false;
3155 next_user:=user_list;
3156 while (next_user<>0) and not found do
3157 begin
3158 next_term:=login_struc(next_user+6);
3159 while (next_term<>0) and not found do
3160 begin
3161 found:=(login_struc(next_term+1) extract 12)=type_nr;
3162 next_term:=login_struc(next_term+3);
3163 end;
3164 next_user:=login_struc(next_user+7);
3165 end;
3166 check_type:=found;
3167 if false then
3168 alarm: disable traped(61);
3169 end;
3170
3170 boolean procedure remove_sess(sess_index);
3171 <* 62 *>
3172 <*-----------------------------------------------------------------*>
3173 <* Send remove message til tasterm for angivet session *>
3174 <* Sæt remove-status i session hvis message er sendt ok *>
3175 <* *>
3176 <* sess_index (call) : Index i login_struc til session *>
3177 <* Return : True = Message sendt og/eller status sat *>
3178 <* False = Message ikke sendt eller ikke ok *>
3179 <* Status ikke sat af denne procedure *>
3180 <*-----------------------------------------------------------------*>
3181 integer sess_index;
3182 begin
3183 integer array ia(1:8);
3184 integer i;
3185 zone tasterm(1,1,std_error);
3186
3186 trap(alarm);
3187 remove_sess:=true;
3188 if not (false add login_struc(sess_index+2)) then
3189 begin
3190 login_struc(sess_index+2):=login_struc(sess_index+2)+1;
3191 ia(1):=10 shift 12 + 0;
3192 ia(2):=login_struc(sess_index);
3193 open(tasterm,0,tasterm_name,1 shift 9); <* Imp. passivate *>
3194 send_mess(tasterm,ia);
3195 i:=monitor(18,tasterm,1,ia);
3196 if i<>1 or ia(1)<>0 then
3197 begin
3198 remove_sess:=false;
3199 login_struc(sess_index+2):=login_struc(sess_index+2)-1
3200 end;
3201 end;
3202 if false then
3203 alarm: disable traped(62);
3204 end;
3205
3205 integer procedure check_user(login_user,last_time,
3206 user_id,term_id,password1,password2);
3207 <* 63 *>
3208 <*--------------------------------------------------------------------------*>
3209 <* Check om bruger kan tilmeldes login strukturen *>
3210 <* *>
3211 <* last_time (ret) : Sidste indlognings tid for bruger (hvis bruger ok) *>
3212 <* login_user (ret) : Index til fundet bruger i login_struc eller *>
3213 <* hvis bruger er ny er login_user lig 0 *>
3214 <* user_id (call) : Navn på bruger der skal checkes (fra inlogning) *>
3215 <* term_id (call) : Navn på terminal hvorfra inlogning foretages. *>
3216 <* password1 (call) : Første ord i kodet password (fra inlogning) *>
3217 <* password2 (call) : Andet ord i kodet password *>
3218 <* Return : 0 hvis check af bruger er OK ellers fejlårsag *>
3219 <* *>
3220 <* Fejlårsag: *>
3221 <* *>
3222 <* 0 = User ok *>
3223 <* 1 = inlogning stopped *>
3224 <* 2 = max terminals inloged *>
3225 <* 3 = unknown user id *>
3226 <* 4 = wrong password *>
3227 <* 5 = terminal limit (illegal terminal group) *>
3228 <* 6 = user blocked *>
3229 <* 7 = terminal blocked *>
3230 <* 8 = max sessions exceeded *>
3231 <* 9 = login time exceeded *>
3232 <* 10 = no resources *>
3233 <* 11 = unknown terminal *>
3234 <* 12 = main consol *>
3235 <* *>
3236 <*--------------------------------------------------------------------------*>
3237 integer login_user,last_time;
3238 integer array user_id,term_id;
3239 integer password1,password2;
3240
3240 begin
3241 integer check,group,i,count;
3242 real time;
3243 integer array id(1:8);
3244
3244 trap(alarm);
3245 check:=0; <* Bruger OK *>
3246 if not find_term(term_id) then
3247 begin <* Find default terminal *>
3248 integer array default(1:4);
3249
3249 default(1):=<:def:> shift (-24) extract 24;
3250 default(2):=<:aul:> shift (-24) extract 24;
3251 default(3):=<:t:> shift (-24) extract 24;
3252 default(4):=0;
3253 if not find_term(default) then
3254 check:=11;
3255 end;
3256 if sessions>=max_sessions then
3257 check:=8;
3258 if check=0 then
3259 begin
3260 group:=termcat.term_entry(7) extract 12;
3261 if group>=login_stat then
3262 check:=1
3263 else
3264 if max_terms<=terms then
3265 check:=2
3266 else
3267 if not find_user(user_id) then
3268 begin
3269 if max_term_block>0 then
3270 termcat.term_entry(6):=termcat.term_entry(6)+1;
3271 check:=3;
3272 end
3273 else
3274 if not ((usercat.user_entry(6)=password1) and
3275 (usercat.user_entry(7)=password2)) then
3276 begin
3277 check:=4;
3278 if ((password1<>0) or (password2<>0)) and (max_user_block>0) then
3279 usercat.user_entry(11):=usercat.user_entry(11)+1;
3280 end
3281 else
3282 if (usercat.user_entry(11) extract 12)<max_user_block or
3283 max_user_block=0 then
3284 usercat.user_entry(11):=
3285 (usercat.user_entry(11) shift (-12)) shift 12;
3286 end;
3287 if check=0 then
3288 begin
3289 i:=group//24;
3290 group:=23-(group mod 24);
3291 if not (false add (usercat.user_entry(19+i) shift (-group))) then
3292 begin
3293 check:=5;
3294 if max_term_block>0 then
3295 termcat.term_entry(6):=termcat.term_entry(6)+1;
3296 end
3297 else
3298 if (termcat.term_entry(6) extract 12)<max_term_block or
3299 max_term_block=0 then
3300 termcat.term_entry(6):=
3301 (termcat.term_entry(6) shift (-12)) shift 12;
3302 end;
3303 if check=0 then
3304 begin
3305 login_user:=find_login_user(user_id,user_list);
3306 if login_user>0 then
3307 begin
3308 if false add (login_struc(login_user+5) extract 1) then
3309 check:=1
3310 else
3311 begin
3312 group:=login_struc(login_user+4);
3313 count:=0;
3314 for i:=-12 step (-1) until (-21) do
3315 if false add (group shift i) then
3316 count:=count+1;
3317 if count>=(usercat.user_entry(12) shift (-12)) then
3318 check:=8;
3319 end;
3320 end;
3321 end;
3322 if check=0 then
3323 begin <* test inlognings tid *>
3324 if login_user>0 then
3325 begin <* test i login_struc *>
3326 last_time:=login_struc(login_user+4) extract 12;
3327 if timecheck_stat and (last_time=26 or last_time=27 or last_time=0) then
3328 check:=9;
3329 end
3330 else <* test i katalog *>
3331 if not check_time(last_time) then
3332 check:=9
3333 end;
3334 for i:=1 step 1 until 4 do
3335 id(i):=logor((32 shift 16 + 32 shift 8 + 32),user_id(i));
3336 for i:=5 step 1 until 8 do
3337 id(i):=term_id(i-4);
3338 i:=1;
3339 if ((usercat.user_entry(11) extract 12)>=max_user_block) and
3340 (max_user_block>0) then
3341 begin
3342 check:=6;
3343 if ((usercat.user_entry(11) extract 12) mod 5=max_user_block) then
3344 begin
3345 write_message(63,1,true,<:Max. user block reached:>);
3346 write_message(63,usercat.user_entry(11) extract 12,true,
3347 string id.laf(increase(i)));
3348 end;
3349 end
3350 else
3351 if ((termcat.term_entry(6) extract 12)>=max_term_block) and
3352 (max_term_block>0) then
3353 begin
3354 check:=7;
3355 if ((termcat.term_entry(6) extract 12) mod 5=max_term_block) then
3356 begin
3357 write_message(63,2,true,<:Max. terminal block reached:>);
3358 write_message(63,termcat.term_entry(6) extract 12,true,
3359 string id.laf(increase(i)));
3360 end;
3361 end;
3362 write_user_seg;
3363 write_term_seg;
3364 check_user:=check;
3365 if false then
3366 alarm: disable traped(63);
3367 end;
3368
3368 boolean procedure check_time(time_last);
3369 <* 64 *>
3370 <*----------------------------------------------------------------------*>
3371 <* Check inlognings tidspunktet for bruger angivet i aktuelt user_entry *>
3372 <* *>
3373 <* time_last (ret) : sidste indlognings tid for bruger eller 25 hvis *>
3374 <* der ikke er sat grænse *>
3375 <* Return : True hvis ok, False hvis ikke ok *>
3376 <*----------------------------------------------------------------------*>
3377 integer time_last;
3378 begin
3379 boolean field day;
3380 integer time_type,time_first,time_cur,new_time_last;
3381 real time;
3382
3382 trap(alarm);
3383 systime(1,0,time);
3384 day:=(round((time/86400)-0.5) mod 7)+15;
3385 time_type:=usercat.user_entry.day extract 2;
3386 time_first:=(usercat.user_entry.day shift (-7)) extract 5;
3387 time_last:=(usercat.user_entry.day shift (-2)) extract 5;
3388 check_time:=false;
3389 time_cur:=cur_time;
3390 if time_type<>0 then
3391 begin
3392 if time_cur<time_first then
3393 begin
3394 day:=day-1;
3395 if day<15 then
3396 day:=21;
3397 new_time_last:=(usercat.user_entry.day shift (-2)) extract 5;
3398 if (usercat.user_entry.day extract 2 = 2) and
3399 (time_cur<new_time_last) then
3400 begin
3401 if new_time_last<time_first then
3402 time_last:=new_time_last;
3403 check_time:=true;
3404 end;
3405 end
3406 else
3407 if (time_type=3) or
3408 (time_last>24) or
3409 (time_first=0 and time_last=24) then
3410 begin
3411 time_last:=25;
3412 check_time:=true;
3413 end
3414 else
3415 if (time_type=2) then
3416 begin
3417 time_last:=time_last+100;
3418 check_time:=true;
3419 end
3420 else
3421 if (time_type=1) and
3422 (time_cur>=time_first) and
3423 (time_cur<time_last) then
3424 check_time:=true;
3425 end
3426 else
3427 time_last:=0;
3428 if not timecheck_stat then
3429 check_time:=true;
3430 if false then
3431 alarm: disable traped(64);
3432 end;
3433
3433 procedure mess_to_term(term_index,text_buf);
3434 <* 65 *>
3435 <*--------------------------------------------------------------------------*>
3436 <* Sæt markering i login structure at tekst skal udskrives *>
3437 <* Ved kald skal struc_sema være 'sat' *>
3438 <* *>
3439 <* term_index (call): Index i login_struc på terminal *>
3440 <* text_buf (call) : Nummeret på tekst buffer der skal skrives fra *>
3441 <*--------------------------------------------------------------------------*>
3442 integer term_index;
3443 integer text_buf;
3444 begin
3445 trap(alarm);
3446 login_struc(term_index+1):=logor(loginstruc(term_index+1),
3447 1 shift (text_buf+20) );
3448 if false then
3449 alarm: disable traped(65);
3450 end;
3451
3451 integer procedure set_text_buf(text);
3452 <* 65.1 *>
3453 <*--------------------------------------------------------------------------*>
3454 <* Sæt text i buffer i tasterm. *>
3455 <* *>
3456 <* text (call) : Teksten der skal sættes *>
3457 <* Return : Nummeret på den buffer teksten er sat i eller 0 hvis *>
3458 <* der ingen ledig buffer er *>
3459 <*--------------------------------------------------------------------------*>
3460 integer array text;
3461 begin
3462 zone tasterm(40,1,stderror);
3463 integer array ia(1:20),term_id(1:4);
3464 integer i,hw,term_type,nr;
3465
3465 trap(alarm);
3466 hw:=text(0) shift (-12)+4;
3467 nr:=0;
3468 for i:=1,2,3 do
3469 if text_buf_reserved(i)=0 then
3470 nr:=i;
3471 if hw<=148 and nr>0 then
3472 begin
3473 tasterm.iaf(1):=(7 shift 16) + (7 shift 8) +7;
3474 tasterm.iaf(2):=10;
3475 for i:=3 step 1 until (hw//2) do
3476 tasterm.iaf(i):=text(i-2);
3477 text_buf_reserved(nr):=-1;
3478 open(tasterm,0,tasterm_name,1 shift 9); <* Imp. passivate *>
3479 getzone6(tasterm,ia);
3480 ia(1):=11 shift 12 +0;
3481 ia(2):=ia(19)+1;
3482 ia(3):=ia(2)+hw-2;
3483 ia(4):=nr;
3484 send_mess(tasterm,ia);
3485 i:=monitor(18,tasterm,1,ia);
3486 if i<>1 then
3487 begin
3488 text_buf_reserved(nr):=0;
3489 nr:=0;
3490 end;
3491 end;
3492 set_text_buf:=nr;
3493 if false then
3494 alarm: disable traped(651);
3495 end;
3496
3496 procedure send_message_text(nr);
3497 <* 65.2 *>
3498 <*------------------------------------------*>
3499 <* Signalerer til write_term_text korutinen *>
3500 <* at der er tekst til udskrift *>
3501 <*------------------------------------------*>
3502 integer nr;
3503 begin
3504 integer array ref(1:1);
3505
3505 trap(alarm);
3506 initref(ref);
3507 wait_select:=8;
3508 wait(message_buf_pool,ref);
3509 ref(3):=nr;
3510 signal(text_write_sem,ref);
3511 if false then
3512 alarm: disable traped(652);
3513 end;
3514
3514 boolean procedure check_user_priv(priv,result);
3515 <* 66 *>
3516 <*-------------------------------------------------------------------*>
3517 <* Test om bruger givet i copy_buf er kendt, har korrekt password og *>
3518 <* har det angivne privilegie *>
3519 <* *>
3520 <* priv (call) : Privilegie der testes for (0 til 4) *>
3521 <* result (ret) : 0 = Ok *>
3522 <* 1 = Ukendt bruger *>
3523 <* 2 = Forkert password *>
3524 <* 3 = Privilegie ikke opfyldt *>
3525 <* Return : True hvis result=0 ellers false *>
3526 <* Er result=0 er user_entry sat til fundet bruger *>
3527 <*-------------------------------------------------------------------*>
3528 integer priv,result;
3529 begin
3530 trap(alarm);
3531 result:=1;
3532 if find_user(copy_buf.iaf) then
3533 begin <* Bruger fundet *>
3534 result:=2;
3535 if (copy_buf.iaf(5)=usercat.user_entry(6)) and
3536 (copy_buf.iaf(6)=usercat.user_entry(7)) then
3537 begin <* password ok *>
3538 result:=if false add (usercat.user_entry(12) shift (priv-11)) then
3539 0 <* privilegie ok *>
3540 else
3541 3; <* Privilegie ikke sat *>
3542 end;
3543 end;
3544 check_user_priv:=result=0;
3545 if false then
3546 alarm: disable traped(66);
3547 end;
3548
3548 procedure catco;
3549 <* 67 *>
3550 <*---------------------------------------*>
3551 <* Hoved procedure for catalog korutinen *>
3552 <*---------------------------------------*>
3553 begin
3554 zone dummy_zone(1,1,stderror);
3555 integer operation,
3556 mode,
3557 i;
3558
3558 <***********************************>
3559 <* Procedure til katalog korutinen *>
3560 <***********************************>
3561
3561 procedure attention;
3562 <* 68 *>
3563 <*---------------------------------------------------------------------*>
3564 <* Start en ny operatør korutine hvis der er attention fra ny terminal *>
3565 <*---------------------------------------------------------------------*>
3566 begin
3567 integer i,head_consol;
3568 integer array ref(1:1);
3569 boolean found;
3570 integer array sender_name(1:4);
3571
3571 trap(alarm);
3572 i:=4;
3573 answer(9):=1;
3574 found:=false;
3575 while (not found) and (i<(number_of_opera+4)) do
3576 begin
3577 found:=opera_terms(i,1)=mess.sender_pda;
3578 i:=i+1;
3579 end;
3580 system(5,mess.sender_pda,sender_name);
3581 if sender_name(1)=0 then
3582 begin
3583 answer(9):=2;
3584 found:=true;
3585 end;
3586 if not found then
3587 begin <* Ny terminal *>
3588 get_proc_name(mess.sender_pda,sender_name);
3589 i:=if (sender_name.laf(1)=head_term_name.laf(1)) and
3590 (sender_name.laf(2)=head_term_name.laf(2)) then
3591 4 else 5;
3592 head_consol:=i-4;
3593 while (not found) and (i<(number_of_opera+4)) do
3594 begin
3595 found:=opera_terms(i,1)=0;
3596 i:=i+1;
3597 end;
3598 if found then
3599 begin <* Ventende operatør korutine er fundet *>
3600 opera_terms(i-1,1):=mess.sender_pda;
3601 initref(ref);
3602 wait_select:=6;
3603 wait(message_buf_pool,ref);
3604 ref(3):=head_consol;
3605 signal(opera_terms(i-1,2),ref);
3606 answer(9):=1; <* Operatør er startet *>
3607 end
3608 else
3609 begin
3610 answer(9):=2; <* Ikke flere operatør rutiner *>
3611 end;
3612 end;
3613 if false then
3614 alarm: disable traped(68);
3615 end;
3616
3616 procedure get_segments;
3617 <* 69 *>
3618 <*--------------------------------------------------*>
3619 <* Hent segmenter fra katalogerne til bruger proces *>
3620 <*--------------------------------------------------*>
3621 begin
3622 integer seg,cat,i,size;
3623
3623 trap(alarm);
3624 seg:=mess.mess_array(4);
3625 cat:=mess.mess_array(5);
3626 if (cat<1) or (cat>3) then
3627 answer(1):=1 shift 22 <* error; illegal katalog type *>
3628 else
3629 begin
3630 if data_to_copy_buf(6,mess.buf_addr,answer)=0 then
3631 begin <* data kopieret *>
3632 if check_user_priv(1,answer(1)) then
3633 begin <* operatør ok *>
3634 case cat of
3635 begin
3636 begin <* bruger katalog *>
3637 if usercat_size>seg then
3638 begin
3639 size:=usercat_size;
3640 find_user_seg(seg);
3641 for i:=1 step 1 until 128 do
3642 copy_buf(i):=usercat(i);
3643 end
3644 else
3645 answer(1):=1 shift 18; <* end of catalog *>
3646 end;
3647 begin <* terminal katalog *>
3648 if termcat_size>seg then
3649 begin
3650 size:=termcat_size;
3651 find_term_seg(seg);
3652 for i:=1 step 1 until 128 do
3653 copy_buf(i):=termcat(i);
3654 end
3655 else
3656 answer(1):=1 shift 18; <* end of catalog *>
3657 end;
3658 begin <* type katalog *>
3659 if typecat_size>seg then
3660 begin
3661 size:=typecat_size;
3662 setposition(typecat,0,seg);
3663 write_type_seg;
3664 for i:=1 step 1 until 128 do
3665 copy_buf(i):=typecat(i);
3666 end
3667 else
3668 answer(1):=1 shift 18; <* end of catalog *>
3669 end;
3670 end; <* case *>
3671 if answer(1)=0 then
3672 begin
3673 answer(1):=if data_from_copy_buf(256,mess.buf_addr,answer)<>0 then
3674 1 shift 23 <* fejl i kopiering *>
3675 else
3676 0; <* alt ok *>
3677 answer(4):=size;
3678 end;
3679 end
3680 else
3681 if answer(1)=3 then
3682 answer(1):=1 shift 11 <* ingen privilegie *>
3683 else
3684 answer(1):=1 shift 10; <* illegal bruger (operatør) *>
3685 end
3686 else
3687 answer(1):=1 shift 23; <* bruger proces stoppet *>
3688 end;
3689 answer(9):=1;
3690 if false then
3691 alarm: disable traped(69);
3692 end;
3693
3693
3693 procedure tasterm_mess;
3694 <* 70 *>
3695 <*-------------------------------*>
3696 <* Behandling af message fra TAS *>
3697 <*-------------------------------*>
3698 begin
3699 <******************************>
3700 <* Procedure til tasterm_mess *>
3701 <******************************>
3702
3702 procedure sign_on;
3703 <* 71 *>
3704 <*------------------------------------------------*>
3705 <* Undersøg inlognings muligheden og hvis ok *>
3706 <* dan signon tekst til brug for TAS *>
3707 <*------------------------------------------------*>
3708 begin
3709 integer term_type,width,pos,date_width;
3710 integer array term_id(1:4);
3711 long array date_text(1:6);
3712 boolean term_found,def;
3713
3713 trap(alarm);
3714 def:=false;
3715 get_proc_name(mess.mess_array(4),term_id);
3716 if (term_id.laf(1)=head_term_name.laf(1)) and
3717 (term_id.laf(2)=head_term_name.laf(2)) then
3718 <* Hovedkonsollen *>
3719 answer(1):=12
3720 else
3721 if terms<max_terms then
3722 begin <* Ikke maximalt antal terminaler tilmeldt *>
3723 answer(1):=11;
3724 if get_proc_name(mess.mess_array(4),term_id) then
3725 begin <* terminal id fundet *>
3726 term_found:=find_term(term_id);
3727 if not term_found then
3728 begin <* Find default terminal *>
3729 integer array default(1:4);
3730
3730 default(1):=<:def:> shift (-24) extract 24;
3731 default(2):=<:aul:> shift (-24) extract 24;
3732 default(3):=<:t:> shift (-24) extract 24;
3733 default(4):=0;
3734 def:=true;
3735 term_found:=find_term(default);
3736 end;
3737 if term_found then
3738 begin <* Terminal kendt i katalog *>
3739 if (termcat.term_entry(7) extract 12)>=login_stat then
3740 answer(1):=1;
3741 term_type:=termcat.term_entry(6) shift (-12);
3742 if answer(1)<>1 and find_type_entry(term_type) then
3743 begin
3744 if typecat.type_entry(1)>0 then
3745 begin <* Term type fundet i katalog *>
3746 width:=typecat.type_entry(3) shift (-12);
3747 date_width:=date(date_text);
3748 copy_buf.iaf(1):=((termcat.term_entry(7) shift (-12))
3749 shift 12)+term_type;
3750 <* sæt signon text i copy_buf *>
3751 pos:=7; <* Første tegn i copy_buf i position 7 *>
3752 laf:=56;
3753 <* Sæt init data i tekst *>
3754 put_text(copy_buf,pos,char_table,typecat.type_entry.laf,-75);
3755 laf:=0;
3756 <* Sæt signon tekst *>
3757 put_char(copy_buf,pos,10,2);
3758 put_char(copy_buf,pos,32,(width-(host_id(0) extract 12))//2);
3759 put_text(copy_buf,pos,host_id.laf,host_id(0) extract 12);
3760 put_char(copy_buf,pos,10,2);
3761 put_char(copy_buf,pos,32,(width-date_width)//2);
3762 put_text(copy_buf,pos,date_text,date_width);
3763 put_char(copy_buf,pos,10,2);
3764 put_text(copy_buf,pos,signon_text.laf,
3765 signon_text(0) extract 12);
3766 put_char(copy_buf,pos,10,2);
3767 if def then
3768 begin
3769 puttext(copy_buf,pos,<:<10>Terminal :>,10);
3770 puttext(copy_buf,pos,term_id.laf,-12);
3771 puttext(copy_buf,pos,<: er ikke i katalog<10>:>,19);
3772 end;
3773 copy_buf.iaf(2):=(2*((pos-5)//3+1) shift 12) + (pos-7);
3774 put_char(copy_buf,pos,0,3);
3775 <* Kopier data til TAS *>
3776 if data_from_copy_buf(152,mess.buf_addr,answer)<>0 then
3777 write_message(71,1,true,string c_p );
3778 answer(1):=0;
3779 end;
3780 end;
3781 end;
3782 end;
3783 end
3784 else
3785 answer(1):=2;
3786 if false then
3787 alarm: disable traped(71);
3788 end;
3789
3789 procedure include_user;
3790 <* 72 *>
3791 <*---------------------------------*>
3792 <* Inkluder ny bruger og terminal *>
3793 <*---------------------------------*>
3794 begin
3795 integer user_index,term_index,sess_index,last_time,i,ui;
3796 integer array user_id,term_id(1:4);
3797 integer array struc_ref(1:1);
3798 boolean term_found;
3799
3799 procedure init_term;
3800 <* 73 *>
3801 <* initialiser term i login_struc *>
3802 begin
3803 login_struc(term_index):=copy_buf.iaf(1);
3804 <* bemærk: term_entry sat af find_term *>
3805 login_struc(term_index+1):=
3806 (1 shift 13)+(termcat.term_entry(6) shift (-12));
3807 login_struc(term_index+2):=sess_index;
3808 login_struc(term_index+3):=login_struc(user_index+6);
3809 login_struc(user_index+6):=term_index;
3810 terms:=terms+1;
3811 end;
3812
3812
3812 procedure init_sess;
3813 <* 74 *>
3814 <* initialiser sess i login_struc *>
3815 begin
3816 login_struc(sess_index):=copy_buf.iaf(2);
3817 ui:=0;
3818 while false add (login_struc(user_index+4) shift (-ui-12)) do
3819 ui:=ui+1;
3820 <* Sæt ny userindex bit *>
3821 login_struc(user_index+4):=login_struc(user_index+4)+(1 shift (12+ui));
3822 login_struc(sess_index+1):=(1 shift 12)+ui; <* session 1, user-index ui *>
3823 login_struc(sess_index+2):=0;
3824 login_struc(sess_index+3):=0;
3825 sessions:=sessions+1;
3826 end;
3827
3827
3827 trap(alarm);
3828 initref(struc_ref);
3829 wait(struc_sema,struc_ref);
3830 answer(1):=0;
3831 user_index:=term_index:=sess_index:=0;
3832 if data_to_copy_buf(8,mess.buf_addr,answer)=0 then
3833 begin <* Data kopieret *>
3834 if answer(2)=16 then
3835 begin <* alt kopieret *>
3836 answer(1):=0;
3837 for i:=1 step 1 until 4 do
3838 user_id(i):=copy_buf.iaf(i+2);
3839 if get_proc_name(copy_buf.iaf(1),term_id) then
3840 begin <* Terminal navn fundet *>
3841 term_found:=find_term(term_id);
3842 if not term_found then
3843 begin <* Find default terminal *>
3844 integer array default(1:4);
3845 default(1):=<:def:> shift (-24) extract 24;
3846 default(2):=<:aul:> shift (-24) extract 24;
3847 default(3):=<:t:> shift (-24) extract 24;
3848 default(4):=0;
3849 term_found:=find_term(default);
3850 end;
3851 if term_found then
3852 begin <* Terminal fundet i katalog *>
3853 answer(1):=check_user(user_index,last_time,
3854 user_id,term_id,copy_buf.iaf(7),copy_buf.iaf(8));
3855 if answer(1)=0 then
3856 begin <* user ok *>
3857 if user_index=0 then
3858 begin <* Ny bruger *>
3859 term_index:=sess_index:=0;
3860 user_index:=get_free_login(4);
3861 if user_index>0 then
3862 begin
3863 term_index:=user_index+8;
3864 sess_index:=user_index+12;
3865 end
3866 else
3867 begin
3868 user_index:=get_free_login(2);
3869 if user_index>0 then
3870 begin
3871 term_index:=get_free_login(2);
3872 if term_index>0 then
3873 sess_index:=term_index+4
3874 else
3875 begin
3876 term_index:=get_free_login(1);
3877 if term_index>0 then
3878 sess_index:=get_free_login(1);
3879 end;
3880 end;
3881 end;
3882 if term_index=0 then
3883 begin
3884 release_block(user_index);
3885 release_block(user_index+4);
3886 user_index:=0;
3887 end
3888 else
3889 if sess_index=0 then
3890 begin
3891 release_block(user_index);
3892 release_block(user_index+4);
3893 release_block(term_index);
3894 user_index:=term_index:=0;
3895 end;
3896 if user_index>0 then
3897 begin <* Initialiser ny user, term og sess *>
3898 for i:=1 step 1 until 4 do
3899 login_struc(user_index+i-1):=user_id(i);
3900 login_struc(user_index+4):=last_time;
3901 <* bemærk: user_entry sat af check_user *>
3902 login_struc(user_index+5):=usercat.user_entry(12) shift 12;
3903 login_struc(user_index+6):=0;
3904 <* indsæt ny user først i user liste *>
3905 login_struc(user_index+7):=user_list;
3906 user_list:=user_index;
3907 init_term;
3908 init_sess;
3909 users:=users+1;
3910 end;
3911 end <* Ny bruger indsat, hvis user_index>0 *>
3912 else
3913 begin <* Bruger kendt, ny terminal og session *>
3914 term_index:=get_free_login(2);
3915 if term_index>0 then
3916 sess_index:=term_index+4
3917 else
3918 begin
3919 term_index:=get_free_login(1);
3920 if term_index>0 then
3921 sess_index:=get_free_login(1);
3922 end;
3923 if sess_index=0 then
3924 begin
3925 release_block(term_index);
3926 term_index:=0;
3927 end;
3928 if term_index>0 then
3929 begin <* Initialiser term og sess *>
3930 init_term;
3931 init_sess;
3932 end;
3933 end; <* Ny terminal og session indsat, hvis term_index>0 *>
3934 end; <* user ok *>
3935 end <* terminal navn fundet *>
3936 else <* pda ukendt *>
3937 answer(1):=11;
3938 end
3939 else <* terminal ukendt *>
3940 answer(1):=11;
3941 if answer(1)=0 then
3942 begin
3943 if (user_index>0) and (term_index>0) then
3944 begin
3945 copy_buf.iaf(1):=user_index;
3946 for i:=2 step 1 until 7 do
3947 copy_buf.iaf(i):=usercat.user_entry(i+11);
3948 copy_buf.iaf(8):=1;
3949 copy_buf.iaf(9):=(4 shift 12)+1;
3950 copy_buf.iaf(10):=(ui+48) shift 16;
3951 copy_buf.iaf(11):=(4 shift 12)+1;
3952 copy_buf.iaf(12):=49 shift 16;
3953 for i:=13 step 1 until 40 do
3954 copy_buf.iaf(i):=usercat.user_entry(i+10);
3955 if data_from_copy_buf(40,mess.buf_addr,answer)<>0 then
3956 write_message(74,1,true,string c_p );
3957 answer(1):=0;
3958 end
3959 else
3960 answer(1):=10;
3961 end;
3962 end <* alt kopiret *>
3963 else
3964 answer(9):=3;
3965 end <* data kopieret *>
3966 else
3967 write_message(74,2,true,string c_p );
3968 signal(struc_sema,struc_ref);
3969 if false then
3970 alarm: disable traped(74);
3971 end;
3972
3972 procedure start_sess;
3973 <* 75 *>
3974 <*--------------------------------------------------*>
3975 <* Start en ny session hos kendt bruger og terminal *>
3976 <*--------------------------------------------------*>
3977 begin
3978 integer user_index,term_index,sess_index,i,ui,sess_nr,map,count;
3979 integer array user_id(1:4);
3980 integer array struc_ref(1:1);
3981
3981 trap(alarm);
3982 initref(struc_ref);
3983 wait(struc_sema,struc_ref);
3984 user_index:=term_index:=sess_index:=0;
3985 if data_to_copy_buf(3,mess.buf_addr,answer)=0 then
3986 begin <* data kopieret *>
3987 if answer(2)=6 then
3988 begin
3989 answer(1):=0;
3990 user_index:=copy_buf.iaf(3);
3991 if (user_index>0) and (user_index<=(4*struc_size-7)) then
3992 begin
3993 for i:=1 step 1 until 4 do
3994 user_id(i):=login_struc(user_index+i-1);
3995 if find_user(user_id) then
3996 begin <* bruger kendt *>
3997 if (login_stat>0) and not (false add login_struc(user_index+5)) then
3998 begin <* bruger login ok *>
3999 map:=login_struc(user_index+4) shift (-12);
4000 count:=0;
4001 for i:=0 step (-1) until (-9) do
4002 if false add (map shift i) then
4003 count:=count+1;
4004 if (count<(usercat.user_entry(12) shift (-12))) and
4005 (sessions<max_sessions) then
4006 begin <* ledige sessioner *>
4007 if cur_time<(login_struc(user_index+4) extract 12) then
4008 begin <* tid ok *>
4009 term_index:=find_user_terminal(copy_buf.iaf(1),
4010 login_struc(user_index+6));
4011 if term_index>0 then
4012 begin <* terminal kendt *>
4013 sess_index:=get_free_login(1);
4014 if sess_index>0 then
4015 begin <* resourcer ok *>
4016 login_struc(sess_index+3):=login_struc(term_index+2);
4017 login_struc(term_index+2):=sess_index;
4018 login_struc(sess_index):=copy_buf.iaf(2);
4019 login_struc(sess_index+2):=0;
4020 ui:=0;
4021 while false add
4022 (login_struc(user_index+4) shift (-ui-12)) do
4023 ui:=ui+1;
4024 <* Sæt ny userindex bit *>
4025 login_struc(user_index+4):=
4026 login_struc(user_index+4)+(1 shift (12+ui));
4027 sess_nr:=1;
4028 sessions:=sessions+1;
4029 while false add (login_struc(term_index+1) shift
4030 (-sess_nr-12)) do
4031 sess_nr:=sess_nr+1;
4032 <* Sæt ny sessions nummer bit *>
4033 login_struc(term_index+1):=
4034 login_struc(term_index+1)+(1 shift (12+sess_nr));
4035 login_struc(sess_index+1):=
4036 (sess_nr shift 12)+ui; <* session nr, user-index *>
4037 end <* initialiser *>
4038 else
4039 answer(1):=10;
4040 end
4041 else
4042 answer(1):=11;
4043 end
4044 else
4045 answer(1):=9;
4046 end
4047 else
4048 answer(1):=8;
4049 end
4050 else
4051 answer(1):=1;
4052 end
4053 else
4054 answer(1):=3;
4055 end
4056 else
4057 answer(1):=3;
4058 if answer(1)=0 then
4059 begin
4060 <* sæt returdata i copy_buf *>
4061 copy_buf.iaf(1):=user_index;
4062 for i:=2 step 1 until 7 do
4063 copy_buf.iaf(i):=usercat.user_entry(i+11);
4064 copy_buf.iaf(8):=sess_nr;
4065 copy_buf.iaf(9):=(4 shift 12)+1;
4066 copy_buf.iaf(10):=(ui+48) shift 16;
4067 copy_buf.iaf(11):=(4 shift 12)+1;
4068 copy_buf.iaf(12):=(sess_nr+48) shift 16;
4069 for i:=13 step 1 until 40 do
4070 copy_buf.iaf(i):=usercat.user_entry(i+10);
4071 if data_from_copy_buf(40,mess.buf_addr,answer)<>0 then
4072 write_message(75,1,true,string c_p );
4073 answer(1):=0;
4074 end;
4075 end
4076 else
4077 answer(9):=3;
4078 end
4079 else
4080 write_message(75,2,true,string c_p );
4081 signal(struc_sema,struc_ref);
4082 if false then
4083 alarm: disable traped(75);
4084 end;
4085
4085 procedure end_sess;
4086 <* 76 *>
4087 <*-------------------------------------------------------------------------*>
4088 <* Nedlæg en sessions beskrivelse *>
4089 <* Er det sidste session på terminalen, nedlægges terminal beskrivelsen *>
4090 <* Er det sidste terminal på bruger, nedlægges bruger beskrivelsen *>
4091 <*-------------------------------------------------------------------------*>
4092 begin
4093 integer user_index,term_index,sess_index;
4094 integer prev_user_index,prev_term_index,prev_sess_index;
4095 integer next_user_index;
4096 integer array struc_ref(1:1);
4097 boolean found;
4098
4098 trap(alarm);
4099 initref(struc_ref);
4100 wait(struc_sema,struc_ref);
4101 user_index:=mess.mess_array(4);
4102 if (user_index>0) and (user_index<=(4*struc_size-7)) then
4103 begin
4104 found:=false;
4105 prev_term_index:=0;
4106 term_index:=login_struc(user_index+6);
4107 while term_index>0 and not found do
4108 begin <* find terminal beskrivelse *>
4109 if abs login_struc(term_index)=mess.mess_array(2) then
4110 found:=true
4111 else
4112 begin
4113 prev_term_index:=term_index;
4114 term_index:=login_struc(term_index+3);
4115 end;
4116 end;
4117 if found then
4118 begin <* terminal fundet *>
4119 found:=false;
4120 prev_sess_index:=0;
4121 sess_index:=login_struc(term_index+2);
4122 while sess_index>0 and not found do
4123 begin <* find sessions beskrivelse *>
4124 if login_struc(sess_index)=mess.mess_array(3) then
4125 found:=true
4126 else
4127 begin
4128 prev_sess_index:=sess_index;
4129 sess_index:=login_struc(sess_index+3);
4130 end;
4131 end;
4132 if found then
4133 begin <* session fundet *>
4134 if (prev_sess_index=0) and (login_struc(sess_index+3)=0) then
4135 begin <* sidste session på denne terminal *>
4136 if (prev_term_index=0) and (login_struc(term_index+3)=0) then
4137 begin <* sidste terminal for denne bruger *>
4138 <* nedlæg bruger *>
4139 prev_user_index:=0;
4140 next_user_index:=user_list;
4141 while user_index<>next_user_index do
4142 begin
4143 prev_user_index:=next_user_index;
4144 next_user_index:=login_struc(next_user_index+7);
4145 end;
4146 if prev_user_index=0 then
4147 user_list:=login_struc(user_index+7)
4148 else
4149 login_struc(prev_user_index+7):=login_struc(user_index+7);
4150 release_block(user_index);
4151 release_block(user_index+4);
4152 release_block(term_index);
4153 release_block(sess_index);
4154 terms:=terms-1;
4155 users:=users-1;
4156 sessions:=sessions-1;
4157 answer(1):=2;
4158 end
4159 else
4160 begin
4161 <* nedlæg terminal *>
4162 <* nulstil userindex bit for session i map *>
4163 login_struc(user_index+4):=login_struc(user_index+4) -
4164 (1 shift ((login_struc(sess_index+1) extract 12)+12));
4165 if prev_term_index=0 then
4166 login_struc(user_index+6):=login_struc(term_index+3)
4167 else
4168 login_struc(prev_term_index+3):=login_struc(term_index+3);
4169 release_block(term_index);
4170 release_block(sess_index);
4171 terms:=terms-1;
4172 sessions:=sessions-1;
4173 answer(1):=1;
4174 end;
4175 end
4176 else
4177 begin
4178 <* nedlæg session *>
4179 <* nulstil userindex bit for session i map *>
4180 login_struc(user_index+4):=login_struc(user_index+4) -
4181 (1 shift ((login_struc(sess_index+1) extract 12)+12));
4182 <* nulstil sessions nr bit for session i map *>
4183 login_struc(term_index+1):=login_struc(term_index+1) -
4184 (1 shift ((login_struc(sess_index+1) shift (-12))+12));
4185 if prev_sess_index=0 then
4186 login_struc(term_index+2):=login_struc(sess_index+3)
4187 else
4188 login_struc(prev_sess_index+3):=login_struc(sess_index+3);
4189 release_block(sess_index);
4190 sessions:=sessions-1;
4191 answer(1):=0;
4192 end;
4193 end
4194 else
4195 answer(1):=3; <* session ikke fundet *>
4196 end
4197 else
4198 answer(1):=3; <* terminal ikke fundet *>
4199 end
4200 else
4201 answer(1):=3; <* Ukendt bruger *>
4202 signal(struc_sema,struc_ref);
4203 if false then
4204 alarm: disable traped(76);
4205 end;
4206
4206 procedure modify_pass;
4207 <* 77 *>
4208 <*--------------------------------------*>
4209 <* Sæt nyt password for inlogget bruger *>
4210 <*--------------------------------------*>
4211 begin
4212 integer user_index;
4213 integer array field user_id;
4214 integer array struc_ref(1:1);
4215
4215 trap(alarm);
4216 initref(struc_ref);
4217 wait(struc_sema,struc_ref);
4218 if data_to_copy_buf(5,mess.buf_addr,answer)=0 then
4219 begin <* data læst *>
4220 if answer(2)=10 then
4221 begin <* al data læst *>
4222 answer(1):=1;
4223 user_index:=copy_buf.iaf(1);
4224 if (user_index>0) and (user_index<=(4*struc_size-7)) then
4225 begin <* User ident ok *>
4226 user_id:=(user_index-1)*2;
4227 if find_user(login_struc.user_id) then
4228 begin <* bruger fundet i katalog *>
4229 if (usercat.user_entry(6)=copy_buf.iaf(2)) and
4230 (usercat.user_entry(7)=copy_buf.iaf(3)) then
4231 begin <* old password ok *>
4232 usercat.user_entry(6):=copy_buf.iaf(4);
4233 usercat.user_entry(7):=copy_buf.iaf(5);
4234 usercat.user_entry(61):=usercat.user_entry(61)+1;
4235 write_user_seg;
4236 answer(1):=0;
4237 end;
4238 end;
4239 end;
4240 end
4241 else
4242 answer(9):=3;
4243 end
4244 else
4245 write_message(77,3,true,string c_p );
4246 signal(struc_sema,struc_ref);
4247 if false then
4248 alarm: disable traped(77);
4249 end;
4250
4250 procedure get_term_data;
4251 <* 78 *>
4252 <*---------------------------------*>
4253 <* Hent terminal type data til TAS *>
4254 <*---------------------------------*>
4255 begin
4256 integer i;
4257
4257 trap(alarm);
4258 answer(1):=1;
4259 if find_type_entry(mess.mess_array(4)) then
4260 begin
4261 if typecat.type_entry(1)>0 then
4262 begin <* type entry fundet *>
4263 for i:=1 step 1 until 53 do <* Kopier data *>
4264 copy_buf.iaf(i):=typecat.type_entry(i);
4265 if data_from_copy_buf(53,mess.buf_addr,answer)<>0 then
4266 write_message(78,1,true,string c_p );
4267 answer(1):=0;
4268 end;
4269 end;
4270 if false then
4271 alarm: disable traped (78);
4272 end;
4273
4273 procedure terminal_removed;
4274 <* 781 *>
4275 <*-------------------------------------------------------------------------*>
4276 <* Marker terminal som midlertidig fjernet. *>
4277 <*-------------------------------------------------------------------------*>
4278 begin
4279 integer user_index,term_index,sess_index;
4280 integer prev_user_index,prev_term_index,prev_sess_index;
4281 integer next_user_index;
4282 integer array struc_ref(1:1);
4283 boolean found;
4284
4284 trap(alarm);
4285 initref(struc_ref);
4286 wait(struc_sema,struc_ref);
4287 user_index:=mess.mess_array(4);
4288 if (user_index>0) and (user_index<=(4*struc_size-7)) then
4289 begin
4290 found:=false;
4291 prev_term_index:=0;
4292 term_index:=login_struc(user_index+6);
4293 while term_index>0 and not found do
4294 begin <* find terminal beskrivelse *>
4295 if abs login_struc(term_index)=mess.mess_array(2) then
4296 found:=true
4297 else
4298 begin
4299 prev_term_index:=term_index;
4300 term_index:=login_struc(term_index+3);
4301 end;
4302 end;
4303 if found then
4304 begin <* terminal fundet *>
4305 login_struc(term_index) := -login_struc(term_index);
4306 end
4307 else
4308 answer(1):=3; <* terminal ikke fundet *>
4309 end
4310 else
4311 answer(1):=3; <* Ukendt bruger *>
4312 signal(struc_sema,struc_ref);
4313 if false then
4314 alarm: disable traped(781);
4315 end;
4316
4316 procedure terminal_restart;
4317 <* 782 *>
4318 <*-------------------------------------------------------------------------*>
4319 <* Marker terminal som genstartet *>
4320 <*-------------------------------------------------------------------------*>
4321 begin
4322 integer user_index,term_index,sess_index;
4323 integer prev_user_index,prev_term_index,prev_sess_index;
4324 integer next_user_index;
4325 integer array struc_ref(1:1);
4326 boolean found;
4327
4327 trap(alarm);
4328 initref(struc_ref);
4329 wait(struc_sema,struc_ref);
4330 user_index:=mess.mess_array(4);
4331 if (user_index>0) and (user_index<=(4*struc_size-7)) then
4332 begin
4333 found:=false;
4334 prev_term_index:=0;
4335 term_index:=login_struc(user_index+6);
4336 while term_index>0 and not found do
4337 begin <* find terminal beskrivelse *>
4338 if abs login_struc(term_index)=mess.mess_array(2) then
4339 found:=true
4340 else
4341 begin
4342 prev_term_index:=term_index;
4343 term_index:=login_struc(term_index+3);
4344 end;
4345 end;
4346 if found then
4347 begin <* terminal fundet. Sæt ny PDA *>
4348 login_struc(term_index) := mess.mess_array(3);
4349 end
4350 else
4351 answer(1):=3; <* terminal ikke fundet *>
4352 end
4353 else
4354 answer(1):=3; <* Ukendt bruger *>
4355 signal(struc_sema,struc_ref);
4356 if false then
4357 alarm: disable traped(782);
4358 end;
4359
4359
4359 <**************************************>
4360 <* Hoveddel af procedure tasterm_mess *>
4361 <**************************************>
4362 trap(alarm);
4363 if (mode<2) or (mode>9) or (mess.sender_pda<>tasterm_pda) then
4364 <* Ukendt mode i message eller illegal sender *>
4365 answer(9):=3
4366 else
4367 begin
4368 answer(9):=1;
4369 case mode-1 of
4370 begin
4371 sign_on;
4372 include_user;
4373 start_sess;
4374 end_sess;
4375 modify_pass;
4376 get_term_data;
4377 terminal_removed;
4378 terminal_restart;
4379 end;
4380 end;
4381 if false then
4382 alarm: disable traped(70);
4383 end;
4384
4384 procedure modify_entry;
4385 <* 79 *>
4386 <*-----------------------------------------------*>
4387 <* Behandling af modify_entry message fra bruger *>
4388 <*-----------------------------------------------*>
4389 begin
4390
4390 procedure modify_user_entry;
4391 <* 80 *>
4392 <*------------------------------------------------*>
4393 <* Hent, sæt eller modifiser data i brugerkatalog *>
4394 <*------------------------------------------------*>
4395 begin
4396 integer array field user_id,liaf;
4397 boolean user_exist;
4398 integer func,i;
4399
4399 trap(alarm);
4400 user_id:=12;
4401 func:=mess.mess_array(4)+1;
4402 if (func<1) or (func>4) then
4403 answer(9):=3
4404 else
4405 begin
4406 if data_to_copy_buf((case func of (10,66,66,10)),
4407 mess.buf_addr,answer)=0 then
4408 begin <* data kopieret *>
4409 if check_user_priv(1,answer(1)) then
4410 begin <* operatør ok *>
4411 user_exist:=find_user(copy_buf.user_id);
4412 liaf:=10;
4413 case func of
4414 begin
4415 <* Get data *>
4416 if user_exist then
4417 begin
4418 for i:=2 step 1 until 61 do
4419 copy_buf.liaf(i):=usercat.user_entry(i);
4420 answer(1):=if data_from_copy_buf(66,mess.buf_addr,answer)=0 then
4421 0 <* ok *>
4422 else
4423 8; <* process stopped *>
4424 end
4425 else
4426 answer(1):=2; <* entry not found *>
4427 <* Modify data *>
4428 if user_exist then
4429 begin
4430 if find_login_user(copy_buf.user_id,user_list)=0 then
4431 begin <* bruger er ikke logget ind *>
4432 if copy_buf.liaf(61)=usercat.user_entry(61) then
4433 begin <* time stamp's ens *>
4434 for i:=2 step 1 until 60 do
4435 usercat.user_entry(i):=copy_buf.liaf(i);
4436 <* sæt ny time stamp *>
4437 usercat.user_entry(61):=usercat.user_entry(61)+1;
4438 write_user_seg;
4439 answer(1):=0;
4440 end
4441 else
4442 answer(1):=7; <* Data changed since last get-data *>
4443 end
4444 else
4445 answer(1):=1; <* entry in use *>
4446 end
4447 else
4448 answer(1):=2; <* entry not found *>
4449 <* Set new data *>
4450 if not user_exist then
4451 begin
4452 if find_empty_user_entry(
4453 calc_hash(copy_buf.user_id,usercat_size)) then
4454 begin <* tomt entry fundet *>
4455 for i:=2 step 1 until 60 do
4456 usercat.user_entry(i):=copy_buf.liaf(i);
4457 <* sæt ny time stamp *>
4458 usercat.user_entry(61):=0;
4459 write_user_seg;
4460 answer(1):=0;
4461 end
4462 else
4463 answer(1):=6; <* catalog full *>
4464 end
4465 else
4466 answer(1):=3; <* entry exist *>
4467 <* Delete data *>
4468 if user_exist then
4469 begin
4470 if find_login_user(copy_buf.user_id,user_list)=0 then
4471 begin <* bruger ikke logget ind *>
4472 usercat.user_entry(1):=0;
4473 setstate(usercat,6);
4474 find_user_seg(calc_hash(copy_buf.user_id,usercat_size));
4475 user_entry:=0;
4476 <* nedtæl hash-nøgle tæller *>
4477 usercat.user_entry(1):=usercat.user_entry(1)-1;
4478 write_user_seg;
4479 answer(1):=0;
4480 end
4481 else
4482 answer(1):=1; <* entry in use *>
4483 end
4484 else
4485 answer(1):=2; <* entry not found *>
4486 end;
4487 end
4488 else
4489 answer(1):=if answer(1)=3 then
4490 4 <* ingen privilegie *>
4491 else
4492 13; <* illegal bruger (operatør) *>
4493 end
4494 else
4495 answer(1):=8; <* bruger proces stoppet *>
4496 end;
4497 if false then
4498 alarm: disable traped(80);
4499 end;
4500
4500 procedure modify_term_entry;
4501 <* 81 *>
4502 <*--------------------------------------------------*>
4503 <* Hent, sæt eller modificer data i terminalkatalog *>
4504 <*--------------------------------------------------*>
4505 begin
4506 integer array field term_id,liaf;
4507 boolean term_exist;
4508 integer func,i;
4509
4509 trap(alarm);
4510 term_id:=12;
4511 func:=mess.mess_array(4)+1;
4512 if (func<1) or (func>4) then
4513 answer(9):=3
4514 else
4515 begin
4516 if data_to_copy_buf((case func of (10,23,23,10)),
4517 mess.buf_addr,answer)=0 then
4518 begin <* data kopieret *>
4519 if check_user_priv(1,answer(1)) then
4520 begin <* operatør ok *>
4521 term_exist:=find_term(copy_buf.term_id);
4522 liaf:=10;
4523 case func of
4524 begin
4525 <* Get data *>
4526 if term_exist then
4527 begin
4528 for i:=2 step 1 until 18 do
4529 copy_buf.liaf(i):=termcat.term_entry(i);
4530 answer(1):=if data_from_copy_buf(23,mess.buf_addr,answer)=0 then
4531 0 <* ok *>
4532 else
4533 8; <* process stopped *>
4534 end
4535 else
4536 answer(1):=2; <* entry not found *>
4537 <* Modify data *>
4538 if term_exist then
4539 begin
4540 if not check_term(copy_buf.term_id) then
4541 begin <* terminal ikke logget ind *>
4542 if copy_buf.liaf(18)=termcat.term_entry(18) then
4543 begin <* time stamp's ens *>
4544 for i:=2 step 1 until 17 do
4545 termcat.term_entry(i):=copy_buf.liaf(i);
4546 <* sæt ny time stamp *>
4547 termcat.term_entry(18):=termcat.term_entry(18)+1;
4548 write_term_seg;
4549 answer(1):=0;
4550 end
4551 else
4552 answer(1):=7; <* Data changed since last get-data *>
4553 end
4554 else
4555 answer(1):=1; <* entry in use *>
4556 end
4557 else
4558 answer(1):=2; <* entry not found *>
4559 <* Set new data *>
4560 if not term_exist then
4561 begin
4562 if find_empty_term_entry(
4563 calc_hash(copy_buf.term_id,termcat_size)) then
4564 begin <* tomt entry fundet *>
4565 for i:=2 step 1 until 17 do
4566 termcat.term_entry(i):=copy_buf.liaf(i);
4567 <* sæt ny time stamp *>
4568 termcat.term_entry(18):=0;
4569 write_term_seg;
4570 answer(1):=0;
4571 end
4572 else
4573 answer(1):=6; <* catalog full *>
4574 end
4575 else
4576 answer(1):=3; <* entry exist *>
4577 <* Delete data *>
4578 if term_exist then
4579 begin
4580 if not check_term(copy_buf.term_id) then
4581 begin <* terminal ikke logget ind *>
4582 termcat.term_entry(1):=0;
4583 setstate(termcat,6);
4584 find_term_seg(calc_hash(copy_buf.term_id,termcat_size));
4585 term_entry:=0;
4586 <* nedtæl hash-nøgle tæller *>
4587 termcat.term_entry(1):=termcat.term_entry(1)-1;
4588 write_term_seg;
4589 answer(1):=0;
4590 end
4591 else
4592 answer(1):=1; <* entry in use *>
4593 end
4594 else
4595 answer(1):=2; <* entry not found *>
4596 end;
4597 end
4598 else
4599 answer(1):=if answer(1)=3 then
4600 4 <* ingen privilegie *>
4601 else
4602 13; <* illegal bruger (operatør) *>
4603 end
4604 else
4605 answer(1):=8; <* bruger proces stoppet *>
4606 end;
4607 if false then
4608 alarm: disable traped(81);
4609 end;
4610
4610 procedure modify_type_entry;
4611 <* 82 *>
4612 <*----------------------------------------------*>
4613 <* Hent, sæt eller modificer data i typekatalog *>
4614 <*----------------------------------------------*>
4615 begin
4616 integer array field liaf;
4617 boolean type_exist;
4618 integer func,i;
4619 integer field type_nr;
4620
4620 trap(alarm);
4621 type_nr:=14;
4622 func:=mess.mess_array(4)+1;
4623 if (func<1) or (func>4) then
4624 answer(9):=3
4625 else
4626 begin
4627 if data_to_copy_buf((case func of (7,70,70,7)),
4628 mess.buf_addr,answer)=0 then
4629 begin <* data kopieret *>
4630 if check_user_priv(1,answer(1)) then
4631 begin <* operatør ok *>
4632 type_exist:=false;
4633 if find_type_entry(copy_buf.type_nr) then
4634 type_exist:=typecat.type_entry(1)<>0;
4635 liaf:=12;
4636 case func of
4637 begin
4638 <* Get data *>
4639 if type_exist then
4640 begin
4641 for i:=1 step 1 until 64 do
4642 copy_buf.liaf(i):=typecat.type_entry(i);
4643 answer(1):=if data_from_copy_buf(70,mess.buf_addr,answer)=0 then
4644 0 <* ok *>
4645 else
4646 8; <* process stopped *>
4647 end
4648 else
4649 answer(1):=2; <* entry not found *>
4650 <* Modify data *>
4651 if type_exist then
4652 begin
4653 if not check_type(copy_buf.type_nr) then
4654 begin <* type er ikke i login terminaler *>
4655 if copy_buf.liaf(64)=typecat.type_entry(64) then
4656 begin <* time stamp's ens *>
4657 for i:=1 step 1 until 63 do
4658 typecat.type_entry(i):=copy_buf.liaf(i);
4659 <* sæt ny time stamp *>
4660 typecat.type_entry(64):=typecat.type_entry(64)+1;
4661 write_type_seg;
4662 answer(1):=0;
4663 end
4664 else
4665 answer(1):=7; <* Data changed since last get-data *>
4666 end
4667 else
4668 answer(1):=1; <* entry in use *>
4669 end
4670 else
4671 answer(1):=2; <* entry not found *>
4672 <* Set new data *>
4673 if not type_exist then
4674 begin
4675 if find_type_entry(copy_buf.type_nr) then
4676 begin <* tomt entry fundet *>
4677 for i:=1 step 1 until 63 do
4678 typecat.type_entry(i):=copy_buf.liaf(i);
4679 <* sæt ny time stamp *>
4680 typecat.type_entry(64):=0;
4681 write_type_seg;
4682 answer(1):=0;
4683 end
4684 else
4685 answer(1):=6; <* illegal type *>
4686 end
4687 else
4688 answer(1):=3; <* entry exist *>
4689 <* Delete data *>
4690 if type_exist then
4691 begin
4692 if not check_type(copy_buf.type_nr) then
4693 begin <* type benyttes ikke i indlogget terminal *>
4694 typecat.type_entry(1):=0;
4695 write_type_seg;
4696 answer(1):=0;
4697 end
4698 else
4699 answer(1):=1; <* entry in use *>
4700 end
4701 else
4702 answer(1):=2; <* entry not found *>
4703 end;
4704 answer(4):=(typecat_size-1)*(512//type_entry_length);
4705 end
4706 else
4707 answer(1):=if answer(1)=3 then
4708 4 <* ingen privilegie *>
4709 else
4710 13; <* illegal bruger (operatør) *>
4711 end
4712 else
4713 answer(1):=8; <* bruger proces stoppet *>
4714 end;
4715 if false then
4716 alarm: disable traped(82);
4717 end;
4718
4718 <*****************************>
4719 <* Hoved del af modify_entry *>
4720 <*****************************>
4721 trap(alarm);
4722 if (mode<1) or (mode>3) then
4723 answer(9):=3
4724 else
4725 begin
4726 answer(9):=1;
4727 case mode of
4728 begin
4729 modify_user_entry;
4730 modify_term_entry;
4731 modify_type_entry;
4732 end;
4733 end;
4734 if false then
4735 alarm: disable traped(79);
4736 end;
4737
4737 procedure send_text;
4738 <* 83 *>
4739 <*--------------------------------------------------------------------*>
4740 <* Behandling af message fra bruger, med tekst til udskrift på anden *>
4741 <* terminal tilknyttet TAS *>
4742 <*--------------------------------------------------------------------*>
4743 begin
4744 integer array id(1:4);
4745 integer i,user_index,term_index,t,nr;
4746 integer array field liaf;
4747 integer array struc_ref(1:1);
4748
4748 trap(alarm);
4749 initref(struc_ref);
4750 answer(9):=1;
4751 if data_to_copy_buf(256,mess.buf_addr,answer)=0 then
4752 begin <* data kopieret *>
4753 if check_user_priv(3,answer(1)) then
4754 begin <* operatør ok *>
4755 liaf:=14;
4756 t:=0;
4757 answer(1):=0;
4758 for i:=1 step 1 until 4 do
4759 id(i):=mess.mess_array(i+3);
4760 if id(1)<>0 then
4761 begin
4762 user_index:=find_login_user(id,user_list);
4763 if user_index>0 then
4764 begin
4765 nr:=set_text_buf(copy_buf.liaf);
4766 if nr>0 then
4767 begin
4768 term_index:=login_struc(user_index+6);
4769 wait(struc_sema,struc_ref);
4770 while term_index>0 do
4771 begin
4772 mess_to_term(term_index,nr);
4773 t:=t+1;
4774 term_index:=login_struc(term_index+3);
4775 end;
4776 signal(struc_sema,struc_ref);
4777 send_message_text(nr);
4778 end
4779 else
4780 answer(1):=4;
4781 end
4782 else
4783 answer(1):=1;
4784 end
4785 else
4786 begin
4787 nr:=set_text_buf(copy_buf.liaf);
4788 if nr>0 then
4789 begin
4790 wait(struc_sema,struc_ref);
4791 user_index:=user_list;
4792 while user_index>0 do
4793 begin
4794 term_index:=login_struc(user_index+6);
4795 while term_index>0 do
4796 begin
4797 mess_to_term(term_index,nr);
4798 t:=t+1;
4799 term_index:=login_struc(term_index+3);
4800 end;
4801 user_index:=login_struc(user_index+7);
4802 end;
4803 signal(struc_sema,struc_ref);
4804 send_message_text(nr);
4805 end
4806 else
4807 answer(1):=4;
4808 end;
4809 answer(4):=t;
4810 end
4811 else
4812 answer(1):=if answer(1)=3 then
4813 2
4814 else
4815 13;
4816 end
4817 else
4818 answer(1):=3;
4819 if false then
4820 alarm: disable traped(83);
4821 end;
4822
4822 procedure move_mcl;
4823 <* 84 *>
4824 <*-------------------------------------------------------*>
4825 <* Behandling af message til flytning af cmcl programmer *>
4826 <*-------------------------------------------------------*>
4827 begin
4828 integer array ia(1:17),name(1:4),user_bases(1:2);
4829 zone z(1,1,stderror);
4830 integer i,result;
4831
4831 trap(alarm);
4832 if (mode<0) or (mode>2) then
4833 answer(9):=3 <* error; illegal mode *>
4834 else
4835 begin
4836 answer(9):=1;
4837 if data_to_copy_buf(12,mess.buf_addr,answer)=0 then
4838 begin <* data kopieret *>
4839 if check_user_priv(2,result) then
4840 begin <* operatør ok *>
4841 result:=0;
4842 for i:=1 step 1 until 4 do
4843 name(i):=copy_buf.iaf(i+6);
4844 open(z,0,name,0);
4845 user_bases(1):=copy_buf.iaf(11);
4846 user_bases(2):=copy_buf.iaf(12);
4847 if mode=0 then
4848 begin <* Lookup file *>
4849 set_cat_bases(cmcl_bases);
4850 if monitor(42,z,0,ia)<>0 or
4851 ia(9)<>(29 shift 12) then
4852 result:=1
4853 else
4854 begin
4855 for i:=2,3,4,5 do
4856 copy_buf.iaf(i+5):=ia(i);
4857 copy_buf.iaf(11):=ia(6);
4858 copy_buf.iaf(12):=ia(10);
4859 result:=if data_from_copy_buf(12,mess.buf_addr,answer)=0 then
4860 result
4861 else
4862 8;
4863 end;
4864 end
4865 else
4866 if mode=1 then
4867 begin <* move to tascat *>
4868 set_cat_bases(user_bases);
4869 i:=monitor(76,z,0,ia);
4870 if monitor(76,z,0,ia)=0 then
4871 begin
4872 if (ia(8)>0) and
4873 (ia(16) shift (-12) = 29) and
4874 (ia(1) extract 3 = 3) then
4875 begin
4876 result:=monitor(74,z,0,cmcl_bases);
4877 if result=7 then
4878 result:=2;
4879 end
4880 else
4881 result:=9;
4882 end
4883 else
4884 result:=1;
4885 end
4886 else
4887 if mode=2 then
4888 begin <* move to user *>
4889 set_cat_bases(cmcl_bases);
4890 if monitor(42,z,0,ia)=0 then
4891 begin
4892 result:=monitor(74,z,0,user_bases);
4893 if result=7 then
4894 result:=2;
4895 end
4896 else
4897 result:=1;
4898 end;
4899 answer(1):=result;
4900 answer(4):=cmcl_bases(1);
4901 answer(5):=cmcl_bases(2);
4902 set_cat_bases(sys_bases);
4903 end
4904 else
4905 answer(1):=if result=3 then
4906 7 <* ingen privilegie *>
4907 else
4908 13; <* illegal bruger (operatør) *>
4909 end
4910 else
4911 answer(1):=8; <* bruger proces stoppet *>
4912 end;
4913 if false then
4914 alarm: disable traped(84);
4915 end;
4916
4916 <**********************************>
4917 <* Hoved del af catalog korutinen *>
4918 <**********************************>
4919 trap(alarm);
4920 claim(600); <* Reserver plads på stakken *>
4921 <* Hent buffer til message *>
4922 initref(mess);
4923 wait_select:=22;
4924 wait(message_buf_pool,mess);
4925 <* sæt den i wait message pool *>
4926 signal(wait_message_pool,mess);
4927 while true do
4928 begin
4929 <* vent på næste message til TASCAT *>
4930 <* Der behandles kun 1 mess af gangen *>
4931 wait_time:=0;
4932 wait_select:=0;
4933 wait(wait_message,mess);
4934 for i:=1 step 1 until 8 do
4935 answer(i):=0;
4936 answer(9):=3;
4937 operation:=mess.mess_array(1) shift (-12);
4938 mode:=mess.mess_array(1) extract 12;
4939 if false add trace_type then
4940 trace(31,1,operation,mode);
4941 if operation=0 then
4942 attention
4943 else
4944 if operation=3 then
4945 get_segments
4946 else
4947 if operation=9 then
4948 tasterm_mess
4949 else
4950 if operation=11 then
4951 modify_entry
4952 else
4953 if operation=13 then
4954 send_text
4955 else
4956 if operation=15 then
4957 move_mcl;
4958 <* send answer sat af procedure der behandlede message *>
4959 <* answer(9) er sat til answer-result, mens answer(1) *>
4960 <* til answer(8) indeholder svaret (hvis answer(9)=1) *>
4961 monitor(22,dummy_zone,mess.buf_addr,answer);
4962 <* sæt besked buffer i pool så der kan ventes på næste message *>
4963 signal(wait_message_pool,mess);
4964 end;
4965 if false then
4966 alarm: disable traped(67);
4967 end;
4968
4968 <***********************************************>
4969 <***********************************************>
4970 <* Hoved procedurerne for operatør korutinerne *>
4971 <***********************************************>
4972 <***********************************************>
4973
4973 procedure operator(cor_nr);
4974 <* 85 *>
4975 <*------------------------------------------*>
4976 <* Hoved procedure for operator korutinerne *>
4977 <* *>
4978 <* cor_nr (call) : Denne korutines nummer *>
4979 <*------------------------------------------*>
4980 value cor_nr;
4981 integer cor_nr;
4982 begin
4983 zone term_in(13,1,in_error),
4984 term_out(13,1,out_error);
4985 integer i,
4986 head_consol,
4987 buf,
4988 command_value,
4989 command_keyword,
4990 user_ident;
4991 boolean priv,
4992 break,
4993 finis,
4994 out_stop;
4995 integer array term_name(1:4),
4996 command_name(1:4),
4997 ref(1:1),
4998 ia(1:20),
4999 user_id(1:4);
5000 long password;
5001
5001 <**************************************>
5002 <**************************************>
5003 <* Operatør korutine hjælpe procedure *>
5004 <**************************************>
5005 <**************************************>
5006
5006
5006
5006 boolean procedure read_param(term_in,text_param,num_param);
5007 <* 86 *>
5008 <*--------------------------------------------------------------------------*>
5009 <* Læs en parameter fra input fra terminal *>
5010 <* *>
5011 <* text_param (ret) : Den læste parameter (max 11 tegn) konverteret til *>
5012 <* små bogstaver og efterstillet med nul *>
5013 <* num_par (ret) : Den læste parameter omregnet til integer *>
5014 <* Return : True = parameter læst til text_param og num_param *>
5015 <* False = ikke flere parametre (retur param. nulstillet)*>
5016 <*--------------------------------------------------------------------------*>
5017 zone term_in;
5018 integer num_param;
5019 integer array text_param;
5020 begin
5021 integer text_pos,char_class,ch;
5022 long array field laf;
5023 boolean neg;
5024
5024 trap(alarm);
5025 neg:=false;
5026 char_class:=7;
5027 while char_class=7 do
5028 char_class:=readchar(term_in,ch);
5029 laf:=0;
5030 text_pos:=1;
5031 num_param:=0;
5032 text_param.laf(1):=text_param.laf(2):=0;
5033 if (ch=0) or (char_class>=8) then
5034 read_param:=false
5035 else
5036 begin
5037 read_param:=true;
5038 if ch='-' then
5039 neg:=true;
5040 while char_class<7 do
5041 begin
5042 num_param:=if char_class=2 then
5043 (num_param*10)+(ch-48)
5044 else
5045 0;
5046 if (text_pos<12) and (char_class>1) then
5047 put_char(text_param.laf,text_pos,ch);
5048 char_class:=readchar(term_in,ch);
5049 end;
5050 end;
5051 if neg then
5052 num_param:= -num_param;
5053 repeatchar(term_in);
5054 if false then
5055 alarm: disable traped(86);
5056 end;
5057
5057 procedure out_error(z,s,b);
5058 <* 87 *>
5059 <*--------------------------------------------------------------*>
5060 <* Blok procedure for zonen term_out *>
5061 <* Sæt out_stop true hvis der sættes attention status på output *>
5062 <* Sæt break ved fejl *>
5063 <*--------------------------------------------------------------*>
5064 zone z;
5065 integer s,b;
5066 begin
5067 out_stop:=true;
5068 if not (false add (s shift (-16))) then
5069 begin
5070 <* Ikke attention status men give_up eller error *>
5071 break:=true;
5072 b:=0;
5073 end;
5074 end;
5075
5075 procedure in_error(z,s,b);
5076 <* 88 *>
5077 <*-------------------------------------*>
5078 <* Blok procedure for zonen term_in *>
5079 <* Sæt break ved fejl og returner da *>
5080 <* 'em' i input *>
5081 <*-------------------------------------*>
5082 zone z;
5083 integer s,b;
5084 begin
5085 <* Give_up eller error *>
5086 break:=true;
5087 b:=2;
5088 z(1):= real <:<'em'><'em'><'em'>:>;
5089 end;
5090
5090 procedure show_sess(sess_index);
5091 <* 89 *>
5092 <*---------------------------------------------------------------------*>
5093 <* Udskriv en linie på skærmen indeholde data for den angivne sesseion *>
5094 <* *>
5095 <* sess_index (call) : Index i login_struc for sessionen *>
5096 <*---------------------------------------------------------------------*>
5097 integer sess_index;
5098 begin
5099 begin
5100 zone tasterm(1,1,stderror);
5101 integer array ia(1:8),name(1:4);
5102 integer buf;
5103 boolean ok;
5104
5104 trap(alarm);
5105 ok:=false;
5106 open(tasterm,0,tasterm_name,1 shift 9);
5107 ia(1):=12 shift 12 + 0;
5108 ia(2):=login_struc(sess_index);
5109 buf:=send_mess(tasterm,ia);
5110 if wait_ans(tasterm,buf,100,opera_terms(cor_nr,2),true) then
5111 begin
5112 if monitor(18,tasterm,1,ia)=1 then
5113 begin
5114 if ia(1)=0 then
5115 begin
5116 name(1):=ia(5);
5117 name(2):=ia(6);
5118 name(3):=name(4):=0;
5119 write(term_out,<:Id =:>,true,6,name.laf,
5120 <: Index=:>,<<d>,
5121 login_struc(sess_index+1) extract 12);
5122 if ia(2)>0 then
5123 begin
5124 get_proc_name(ia(2),name);
5125 write(term_out,<: Sess.Term=:>,true,11,name.laf);
5126 end
5127 else
5128 write(term_out," ",23);
5129 if ia(3)>0 then
5130 begin
5131 get_proc_name(ia(3),name);
5132 write(term_out,<: User=:>,true,11,name.laf);
5133 end
5134 else
5135 write(term_out," ",18);
5136 if false add login_struc(sess_index+2) then
5137 write(term_out,<: Removing:>)
5138 else
5139 begin
5140 write(term_out,if false add (ia(4) shift (-1)) then
5141 <: :> else <: Active:>);
5142 write(term_out,if false add ia(4) then
5143 <: Direct:> else <::>);
5144 end;
5145 ok:=true;
5146 end;
5147 end;
5148 end;
5149 if not ok then
5150 write(term_out,string c_p ,<:<10>:>);
5151 if false then
5152 alarm: disable traped(89);
5153 end;
5154 end;
5155
5155 procedure show_term(user_index,term_index);
5156 <* 90 *>
5157 <*---------------------------------------------------------------*>
5158 <* Udskriv oplysninger om en inlogget terminal og dens sessioner *>
5159 <* *>
5160 <* user_index (call) : Index i login_struc til den user *>
5161 <* der benytter terminalen *>
5162 <* term_index (call) : Index i login_struc til ønsket terminal *>
5163 <*---------------------------------------------------------------*>
5164 integer user_index,term_index;
5165 begin
5166 begin
5167 integer array user_id,term_id(1:4);
5168 integer i,sess_index;
5169
5169 trap(alarm);
5170 for i:=1 step 1 until 4 do
5171 user_id(i):=login_struc(user_index-1+i);
5172 if get_proc_name(login_struc(term_index),term_id) then
5173 begin
5174 if find_login_terminal(term_id,login_struc(user_index+7))>0 then
5175 movestring(term_id.laf,1,<:Removed :>); <* Optaget af anden terminal *>
5176 end;
5177 i:=login_struc(user_index+4) extract 12;
5178 write(term_out,<:<10>User=:>,true,11,user_id.laf,
5179 <: Terminal =:>,true,11,term_id.laf,
5180 <: Logout :>);
5181 if i>=100 then
5182 i:=i-100;
5183 if i=25 then
5184 write(term_out,<:disabled for user:>)
5185 else
5186 if timecheck_stat then
5187 begin
5188 write(term_out,if i>25 or i=0 then
5189 <:now:> else <:time :>);
5190 if i<25 and i>0 then
5191 write(term_out,<<dd>,i);
5192 end
5193 else
5194 begin
5195 write(term_out,<:disabled (:>);
5196 if i>25 or i=0 then
5197 write(term_out,<:now):>)
5198 else
5199 write(term_out,<<dd>,i,<:):>);
5200 end;
5201 write(term_out,<:<10>:>);
5202 sess_index:=login_struc(term_index+2);
5203 while sess_index>0 do
5204 begin
5205 show_sess(sess_index);
5206 write(term_out,<:<10>:>);
5207 sess_index:=login_struc(sess_index+3);
5208 end;
5209 if false then
5210 alarm: disable traped(90);
5211 end;
5212 end;
5213
5213 boolean procedure check_priv(priv_nr);
5214 <* 91 *>
5215 <*--------------------------------------------------------*>
5216 <* Check privilegie for bruger, udskriv fejl hvis ikke ok *>
5217 <* *>
5218 <* priv_nr (call) : Privilegie nummeret der checkes *>
5219 <*--------------------------------------------------------*>
5220 integer priv_nr;
5221 begin
5222 trap(alarm);
5223 if false add ((priv extract 12) shift (priv_nr-11)) then
5224 check_priv:=true
5225 else
5226 begin
5227 check_priv:=false;
5228 write(term_out,<:*** no privilege<10>:>);
5229 end;
5230 if false then
5231 alarm: disable traped(91);
5232 end;
5233
5233
5233 procedure opr_finis;
5234 <* 92 *>
5235 <*-------------------------------------------*>
5236 <* Stop udførelsen af operatør kommandoer og *>
5237 <* send continue message til terminal hvis *>
5238 <* denne ikke er hovedterminalen *>
5239 <*-------------------------------------------*>
5240 begin
5241
5241 trap(alarm);
5242 write(term_out,<:Operator finis<10>:>);
5243 finis:=true;
5244 setposition(term_out,0,0);
5245 if cor_nr<>4 then
5246 begin
5247 <* Send continue message til terminal *>
5248 ia(1):=128 shift 12 + 0;
5249 ia(2):=0;
5250 ia(3):=8 shift 12 + 8;
5251 ia(4):=<:ope:> shift (-24) extract 24;
5252 ia(5):=<:rat:> shift (-24) extract 24;
5253 ia(6):=<:or:> shift (-24) extract 24;
5254 buf:=send_mess(term_in,ia);
5255 wait_ans(term_in,buf,100,opera_terms(cor_nr,2),true);
5256 end;
5257 if false then
5258 alarm: disable traped(92);
5259 end;
5260
5260 procedure opr_disp;
5261 <* 93 *>
5262 <*---------------------------------------------------*>
5263 <* Udskriv oplysninger om bruger / terminal / system *>
5264 <*---------------------------------------------------*>
5265 begin
5266 zone tasterm(1,1,stderror);
5267 long array text(1:6);
5268 integer user_index,term_index;
5269 integer array ia(1:8);
5270 integer array struc_ref(1:1);
5271 real r;
5272 boolean ok;
5273
5273 trap(alarm);
5274 initref(struc_ref);
5275 if read_param(term_in,command_name,0) then
5276 begin
5277 command_keyword:=find_keyword_value(command_name.laf(1),1);
5278 if command_keyword=8 then
5279 begin <* terminal *>
5280 if check_priv(4) then
5281 begin
5282 wait(struc_sema,struc_ref);
5283 if read_param(term_in,command_name,0) then
5284 begin
5285 user_index:=user_list;
5286 term_index:=find_login_terminal(command_name,user_index);
5287 if term_index>0 then
5288 show_term(user_index,term_index)
5289 else
5290 write(term_out,string t_n_l);
5291 end
5292 else
5293 opr_terminal;
5294 signal(struc_sema,struc_ref);
5295 end;
5296 end
5297 else
5298 if command_keyword=9 or command_keyword=18 then
5299 begin <* user *>
5300 if check_priv(4) then
5301 begin
5302 wait(struc_sema,struc_ref);
5303 if read_param(term_in,command_name,0) then
5304 begin
5305 user_index:=find_login_user(command_name,user_list);
5306 if user_index>0 then
5307 begin
5308 term_index:=login_struc(user_index+6);
5309 while term_index>0 and not out_stop do
5310 begin
5311 show_term(user_index,term_index);
5312 term_index:=login_struc(term_index+3);
5313 end;
5314 end
5315 else
5316 write(term_out,string u_n_l);
5317 end
5318 else
5319 opr_user;
5320 signal(struc_sema,struc_ref);
5321 end;
5322 end
5323 else
5324 if command_keyword=15 then
5325 begin <* system *>
5326 write(term_out,<:<10>System start at: :>);
5327 write(term_out,<<dddddd >,systime(4,start_time,r),r);
5328 if system_stop then
5329 write(term_out,<:<10>System is stopping:>);
5330 write(term_out,<:<10><10>--- Sign on ---:>);
5331 write(term_out,<:<10>:>,host_id.laf);
5332 date(text);
5333 write(term_out,<:<10>:>,text);
5334 write(term_out,<:<10>:>,signon_text.laf);
5335 write(term_out,<:<10>--- Status ---:>);
5336 write(term_out,<< dddd >,<:<10>Users : :>,users,
5337 <:Free::>,maxterminals-terms);
5338 write(term_out,<< dddd >,<:<10>Terminals : :>,terms,
5339 <:Max ::>,max_terms);
5340 write(term_out,<< dddd >,<:<10>Sessions : :>,sessions);
5341 write(term_out,<:<10>Timecheck : :>,if timecheck_stat then
5342 <:activ:>
5343 else
5344 <:passiv:>,
5345 <:<10>Login : :>);
5346 if login_stat=96 then
5347 write(term_out,<:enabled:>)
5348 else
5349 if login_stat=0 then
5350 write(term_out,<:disabled:>)
5351 else
5352 write(term_out,<:disabled from terminal group :>,login_stat);
5353 write(term_out,<:<10><10>--- Release dates ---:>);
5354 write(term_out,<:<10>Tasterm : :>,<<dddddd >,
5355 tastermverd,tastermvert);
5356 write(term_out,<:<10>Tascat : :>,<<dddddd >,reld,relt);
5357 write(term_out,<:<10>Init. : :>,<<dddddd >,initver);
5358 end
5359 else
5360 if command_keyword=19 then
5361 begin <* Resources *>
5362 ok:=false;
5363 open(tasterm,0,tasterm_name,1 shift 9);
5364 ia(1):=18 shift 12;
5365 if wait_ans(tasterm,send_mess(tasterm,ia),
5366 100,operaterms(cor_nr,2),true) then
5367 begin
5368 if monitor(18,tasterm,1,ia)=1 then
5369 begin
5370 ok:=true;
5371 write(term_out,<:<10>Resource Maximum:>,
5372 <: Used % Used<10>:>,
5373 <:<10>Create pools :>,
5374 <<dddd >,cps,cps-ia(1),
5375 <<ddd>,if cps=0 then 0 else (cps-ia(1))/cps*100,
5376 <:<10>Create links :>,
5377 <<dddd >,cls,ia(2),
5378 <<ddd>,if cls=0 then 0 else ia(2)/cls*100,
5379 <:<10>Sessions :>,
5380 <<dddd >,maxsessions,sessions,
5381 <<ddd>,sessions/maxsessions*100,
5382 <:<10>Terminals :>,
5383 <<dddd >,maxterminals,terms,
5384 <<ddd>,terms/maxterminals*100,
5385 <:<10>Users :>,
5386 <<dddd >,maxusers,users,
5387 <<ddd>,users/maxusers*100,
5388 <:<10>System menues :>,
5389 <<dddd >,maxsysmenu,ia(3),
5390 <<ddd>,ia(3)/maxsysmenu*100,
5391 <:<10>Terminal types :>,
5392 <<dddd >,termtypes,termtypes-ia(6),
5393 <<ddd>,(termtypes-ia(6))/termtypes*100,
5394 <:<10>MCL programs :>,
5395 <<dddd >,mclprogs,mclprogs-ia(5),
5396 <<ddd>,(mclprogs-ia(5))/mclprogs*100,
5397 <:<10>Core buffers :>,
5398 <<dddd >,corebufs,corebufs-ia(4),
5399 <<ddd>,(corebufs-ia(4))/corebufs*100,
5400 <:<10>Spool segments :>,
5401 <<dddd >,ia(7),ia(7)-ia(8),
5402 <<ddd>,(ia(7)-ia(8))/ia(7)*100);
5403 end;
5404 end;
5405 if not ok then
5406 write(term_out,string c_p,<:<10>:>);
5407 end
5408 else
5409 write(term_out,string ill_par,command_name.laf);
5410 end
5411 else
5412 write(term_out,string miss_par);
5413 write(term_out,<:<10>:>);
5414 if false then
5415 alarm: disable traped(93);
5416 end;
5417
5417 procedure opr_message;
5418 <* 94 *>
5419 <*---------------------------------------------------*>
5420 <* Send meddelelser til bruger og terminal *>
5421 <*---------------------------------------------------*>
5422 begin
5423 long array text(0:34);
5424 integer i,t,user_index,term_index,nr;
5425 integer array struc_ref(1:1);
5426
5426 boolean procedure read_term_text(text);
5427 <* 95 *>
5428 <*--------------------------------------------------------------*>
5429 <* Læs tekst fra terminal til text i mcl-format *>
5430 <* prompt for hver linie. Afslut ved '.' først på linie *>
5431 <* *>
5432 <* text (ret) : Den læste tekst i mcl-format *>
5433 <* Return : True = Tekst læst, False = Fejl ved læsning *>
5434 <*--------------------------------------------------------------*>
5435 long array text;
5436 begin
5437 long array line(1:14);
5438 integer i,pos;
5439
5439 trap(alarm);
5440 pos:=1;
5441 repeat
5442 i:=read_line(line);
5443 if i>0 then
5444 i:=put_txt(text,pos,line,i);
5445 until i<1;
5446 if i=0 then
5447 begin
5448 put_ch(text,pos,0,3);
5449 put_ch(text,200,0,3);
5450 pos:=pos-4;
5451 text(0):=((((pos+2)//3)*2+1) shift 12) + pos;
5452 read_term_text:=true;
5453 end
5454 else
5455 read_term_text:=false;
5456 if false then
5457 alarm: disable traped(95);
5458 end;
5459
5459 integer procedure read_line(line);
5460 <* 96 *>
5461 <*--------------------------------------------------------------------*>
5462 <* Læs en linie fra terminal *>
5463 <* *>
5464 <* line (ret) : Den læste linie *>
5465 <* Return : Antal tegn læst ink. 'nl' (0 = '.' først på linie) *>
5466 <*--------------------------------------------------------------------*>
5467 long array line;
5468 begin
5469 integer ch,i,pos;
5470
5470 trap(alarm);
5471 write(term_out,<:>:>);
5472 setposition(term_out,0,0);
5473 setposition(term_in,0,0);
5474 pos:=1;
5475 repeat
5476 readchar(term_in,ch);
5477 i:=put_ch(line,pos,ch,1);
5478 until (ch='nl') or (i<1) or (((ch='.') or (ch='/')) and (pos=2));
5479 if ch='nl' then
5480 read_line:=pos-1
5481 else
5482 if ch='/' then
5483 read_line:=-1
5484 else
5485 read_line:=pos-2;
5486 if false then
5487 alarm: disable traped(96);
5488 end;
5489
5489 trap(alarm);
5490 initref(struc_ref);
5491 if read_param(term_in,command_name,0) then
5492 begin
5493 command_keyword:=find_keyword_value(command_name.laf(1),1);
5494 if command_keyword=16 then
5495 begin <* login *>
5496 if check_priv(0) then
5497 begin
5498 t:=0;
5499 if read_term_text(text) then
5500 begin
5501 nr:=set_text_buf(text.iaf);
5502 if nr>0 then
5503 begin
5504 wait(struc_sema,struc_ref);
5505 user_index:=user_list;
5506 while user_index>0 do
5507 begin
5508 term_index:=login_struc(user_index+6);
5509 while term_index>0 do
5510 begin
5511 mess_to_term(term_index,nr);
5512 t:=t+1;
5513 term_index:=login_struc(term_index+3);
5514 end;
5515 user_index:=login_struc(user_index+7);
5516 end;
5517 signal(struc_sema,struc_ref);
5518 send_message_text(nr);
5519 end
5520 else
5521 write(term_out,<:No free text buffer<10>:>);
5522 end
5523 else
5524 write(term_out,string long_text);
5525 write(term_out,<<d>,<:Message sent to :>,t,<: terminal:>,
5526 if t<>1 then <:s:> else <::>);
5527 end;
5528 end
5529 else
5530 if command_keyword=13 then
5531 begin <* sign on *>
5532 if check_priv(0) then
5533 begin
5534 if read_term_text(text) then
5535 begin
5536 signon_text(0):=text(0) extract 24;
5537 for i:=1 step 1 until 34 do
5538 signon_text.laf(i):=text(i);
5539 end
5540 else
5541 write(term_out,string long_text);
5542 end;
5543 end
5544 else
5545 if command_keyword=12 then
5546 begin <* all *>
5547 if check_priv(0) then
5548 begin
5549 t:=0;
5550 if read_term_text(text) then
5551 begin
5552 signon_text(0):=text(0) extract 24;
5553 for i:=1 step 1 until 34 do
5554 signon_text.laf(i):=text(i);
5555 nr:=set_text_buf(text.iaf);
5556 if nr>0 then
5557 begin
5558 wait(struc_sema,struc_ref);
5559 user_index:=user_list;
5560 while user_index>0 do
5561 begin
5562 term_index:=login_struc(user_index+6);
5563 while term_index>0 do
5564 begin
5565 mess_to_term(term_index,nr);
5566 t:=t+1;
5567 term_index:=login_struc(term_index+3);
5568 end;
5569 user_index:=login_struc(user_index+7);
5570 end;
5571 signal(struc_sema,struc_ref);
5572 send_message_text(nr);
5573 end
5574 else
5575 write(term_out,<:No free text buffer<10>:>);
5576 end
5577 else
5578 write(term_out,string long_text);
5579 write(term_out,<<d>,<:Message sent to :>,t,<: terminal:>,
5580 if t<>1 then <:s:> else <::>);
5581 end;
5582 end
5583 else
5584 if command_keyword=9 then
5585 begin <* user *>
5586 if read_param(term_in,command_name,0) then
5587 begin
5588 if check_priv(3) then
5589 begin
5590 t:=0;
5591 user_index:=find_login_user(command_name,user_list);
5592 if user_index>0 then
5593 begin
5594 if read_term_text(text) then
5595 begin
5596 nr:=set_text_buf(text.iaf);
5597 if nr>0 then
5598 begin
5599 wait(struc_sema,struc_ref);
5600 user_index:=find_login_user(command_name,user_list);
5601 if user_index>0 then
5602 term_index:=login_struc(user_index+6)
5603 else
5604 term_index:=0;
5605 while term_index>0 do
5606 begin
5607 mess_to_term(term_index,nr);
5608 t:=t+1;
5609 term_index:=login_struc(term_index+3);
5610 end;
5611 signal(struc_sema,struc_ref);
5612 send_message_text(nr);
5613 end
5614 else
5615 write(term_out,<:No free text buffer<10>:>);
5616 write(term_out,<<d>,<:Message sent to :>,t,<: terminal:>,
5617 if t<>1 then <:s:> else <::>);
5618 end
5619 else
5620 write(term_out,string long_text);
5621 end
5622 else
5623 write(term_out,string u_n_l);
5624 end;
5625 end
5626 else
5627 write(term_out, string miss_par);
5628 end
5629 else
5630 if command_keyword=8 then
5631 begin <* terminal *>
5632 if read_param(term_in,command_name,0) then
5633 begin
5634 if check_priv(3) then
5635 begin
5636 term_index:=find_login_terminal(command_name,user_list);
5637 if term_index>0 then
5638 begin
5639 if read_term_text(text) then
5640 begin
5641 nr:=set_text_buf(text.iaf);
5642 if nr>0 then
5643 begin
5644 wait(struc_sema,struc_ref);
5645 term_index:=find_login_terminal(command_name,user_list);
5646 if term_index>0 then
5647 mess_to_term(term_index,nr);
5648 signal(struc_sema,struc_ref);
5649 send_message_text(nr);
5650 end
5651 else
5652 write(term_out,<:No free text buffer<10>:>);
5653 end
5654 else
5655 write(term_out,string long_text);
5656 end
5657 else
5658 write(term_out,string t_n_l);
5659 end;
5660 end
5661 else
5662 write(term_out, string miss_par);
5663 end
5664 else
5665 write(term_out,string ill_par,command_name.laf);
5666 end
5667 else
5668 write(term_out,string miss_par);
5669 write(term_out,<:<10>:>);
5670 if false then
5671 alarm: disable traped(94);
5672 end;
5673
5673 procedure opr_remove;
5674 <* 97 *>
5675 <*---------------------------------------------------*>
5676 <* Nedlæg session, terminal eller bruger *>
5677 <*---------------------------------------------------*>
5678 begin
5679 integer array user_id,term_id(1:4);
5680 integer index,user_index,term_index,sess_index,t;
5681 integer array struc_ref(1:1);
5682 boolean found;
5683
5683 trap(alarm);
5684 initref(struc_ref);
5685 if read_param(term_in,command_name,0) then
5686 begin
5687 if check_priv(0) then
5688 begin
5689 command_keyword:=find_keyword_value(command_name.laf(1),1);
5690 if command_keyword=14 then
5691 begin <* session *>
5692 if read_param(term_in,user_id,0) and
5693 read_param(term_in,command_name,index) then
5694 begin
5695 wait(struc_sema,struc_ref);
5696 user_index:=find_login_user(user_id,user_list);
5697 if user_index>0 then
5698 begin
5699 if false add (login_struc(user_index+4) shift (-12-index)) then
5700 begin
5701 found:=false;
5702 term_index:=login_struc(user_index+6);
5703 while not found and term_index>0 do
5704 begin
5705 sess_index:=login_struc(term_index+2);
5706 while not found and sess_index>0 do
5707 begin
5708 if (login_struc(sess_index+1) extract 12)=index then
5709 found:=true
5710 else
5711 sess_index:=login_struc(sess_index+3);
5712 end;
5713 term_index:=login_struc(term_index+3);
5714 end;
5715 if not remove_sess(sess_index) then
5716 write(term_out,<:*** session not removed:>);
5717 end
5718 else
5719 write(term_out,<:*** unknow user index:>);
5720 end
5721 else
5722 write(term_out,string u_n_l);
5723 signal(struc_sema,struc_ref);
5724 end
5725 else
5726 write(term_out,string miss_par);
5727 end
5728 else
5729 if command_keyword=9 then
5730 begin <* user *>
5731 if read_param(term_in,user_id,0) then
5732 begin
5733 t:=0;
5734 wait(struc_sema,struc_ref);
5735 user_index:=find_login_user(user_id,user_list);
5736 if user_index>0 then
5737 begin
5738 term_index:=login_struc(user_index+6);
5739 while term_index>0 do
5740 begin
5741 sess_index:=login_struc(term_index+2);
5742 while sess_index>0 do
5743 begin
5744 if remove_sess(sess_index) then
5745 t:=t+1;
5746 sess_index:=login_struc(sess_index+3);
5747 end;
5748 term_index:=login_struc(term_index+3);
5749 end;
5750 end
5751 else
5752 write(term_out,string u_n_l);
5753 signal(struc_sema,struc_ref);
5754 write(term_out,<<dd >,t,<:session:>,if t<>1 then <:s:> else <::>,
5755 <: removed:>);
5756 end
5757 else
5758 write(term_out,string miss_par);
5759 end
5760 else
5761 if command_keyword=8 then
5762 begin <* terminal *>
5763 if read_param(term_in,term_id,0) then
5764 begin
5765 t:=0;
5766 wait(struc_sema,struc_ref);
5767 term_index:=find_login_terminal(term_id,user_list);
5768 if term_index>0 then
5769 begin
5770 sess_index:=login_struc(term_index+2);
5771 while sess_index>0 do
5772 begin
5773 if remove_sess(sess_index) then
5774 t:=t+1;
5775 sess_index:=login_struc(sess_index+3);
5776 end;
5777 term_index:=login_struc(term_index+3);
5778 end
5779 else
5780 write(term_out,string t_n_l);
5781 signal(struc_sema,struc_ref);
5782 write(term_out,<<dd >,t,<:session:>,if t<>1 then <:s:> else <::>,
5783 <: removed:>);
5784 end
5785 else
5786 write(term_out,string miss_par);
5787 end
5788 else
5789 write(term_out,string ill_par,command_name.laf);
5790 end;
5791 end
5792 else
5793 write(term_out,string miss_par);
5794 write(term_out,<:<10>:>);
5795 if false then
5796 alarm: disable traped(97);
5797 end;
5798
5798 procedure opr_set;
5799 <* 98 *>
5800 <*---------------------------------------------------*>
5801 <* Sæt værdi for timecheck eller antal terminaler *>
5802 <*---------------------------------------------------*>
5803 begin
5804 integer user_index;
5805 integer array user_id(1:4),ref(1:1),struc_ref(1:1);
5806
5806 trap(alarm);
5807 initref(struc_ref);
5808 if read_param(term_in,command_name,0) then
5809 begin
5810 if check_priv(0) then
5811 begin
5812 command_keyword:=find_keyword_value(command_name.laf(1),1);
5813 if command_keyword=8 then
5814 begin <* terminal *>
5815 if read_param(term_in,command_name,command_value) then
5816 begin
5817 if command_value<=maxterminals then
5818 max_terms:=command_value
5819 else
5820 write(term_out,<:*** not enough resources<10>:>);
5821 end
5822 else
5823 write(term_out,string miss_par);
5824 end
5825 else
5826 if command_keyword=17 then
5827 begin <* timecheck *>
5828 if read_param(term_in,command_name,0) then
5829 begin
5830 command_keyword:=find_keyword_value(command_name.laf(1),1);
5831 if command_keyword=10 or command_keyword=11 then
5832 begin <* on/off *>
5833 timecheck_stat:=if command_keyword=10 then
5834 true
5835 else
5836 false;
5837 end
5838 else
5839 if command_keyword=9 then
5840 begin <* user *>
5841 if read_param(term_in,user_id,0) then
5842 begin
5843 if read_param(term_in,command_name,command_value) then
5844 begin
5845 if find_keyword_value(command_name.laf(1),1)=11 then
5846 command_value:=25;
5847 if command_value<=25 and command_value>=0 then
5848 begin
5849 wait(struc_sema,struc_ref);
5850 user_index:=find_login_user(user_id,user_list);
5851 if user_index>0 then
5852 login_struc(user_index+4):=
5853 ((login_struc(user_index+4) shift (-12)) shift 12)+
5854 command_value
5855 else
5856 write(term_out,string u_n_l);
5857 signal(struc_sema,struc_ref);
5858 end
5859 else
5860 write(term_out,string ill_time);
5861 end
5862 else
5863 write(term_out, string miss_par);
5864 end
5865 else
5866 write(term_out,string miss_par);
5867 end
5868 else
5869 write(term_out,string ill_par,command_name.laf,<:<10>:>);
5870 end;
5871 <* start time check *>
5872 initref(ref);
5873 wait_select:=6;
5874 wait(message_buf_pool,ref);
5875 signal(time_sem,ref);
5876 end
5877 else
5878 write(term_out,string ill_par,command_name.laf,<:<10>:>);
5879 end;
5880 end
5881 else
5882 write(term_out,string miss_par);
5883 if false then
5884 alarm: disable traped(98);
5885 end;
5886
5886 procedure opr_start;
5887 <* 99 *>
5888 <*---------------------------------------------------*>
5889 <* Start inlogning til systemet *>
5890 <*---------------------------------------------------*>
5891 begin
5892 integer array ref(1:1);
5893
5893 trap(alarm);
5894 if read_param(term_in,command_name,0) then
5895 begin
5896 if check_priv(0) then
5897 begin
5898 command_keyword:=find_keyword_value(command_name.laf(1),1);
5899 if command_keyword=16 then
5900 begin <* login *>
5901 login_stat:=96;
5902 end
5903 else
5904 if command_keyword=15 then
5905 begin <* system *>
5906 if system_stop then
5907 begin
5908 initref(ref);
5909 wait_select:=6;
5910 wait(message_buf_pool,ref);
5911 signal(free_sem,ref);
5912 write(term_out,<:System restarted<10>:>);
5913 end
5914 else
5915 write(term_out,<:*** System not stopped<10>:>);
5916 end
5917 else
5918 write(term_out,string ill_par,command_name.laf,<:<10>:>);
5919 end;
5920 end
5921 else
5922 write(term_out,string miss_par);
5923 if false then
5924 alarm: disable traped(99);
5925 end;
5926
5926 procedure opr_stop;
5927 <* 100 *>
5928 <*---------------------------------------------------*>
5929 <* Stop inlogning eller hele systemet *>
5930 <*---------------------------------------------------*>
5931 begin
5932 zone z(4,1,stderror);
5933 integer array ia(1:8);
5934 integer array dummy(1:1);
5935 integer user_index,i,stop_time;
5936
5936 trap(alarm);
5937 initref(dummy);
5938 if read_param(term_in,command_name,0) then
5939 begin
5940 if check_priv(4) then
5941 begin
5942 command_keyword:=find_keyword_value(command_name.laf(1),1);
5943 if command_keyword=15 then
5944 begin <* system *>
5945 if read_param(term_in,command_name,stop_time) then
5946 begin
5947 if stop_time=0 then
5948 begin
5949 command_keyword:=find_keyword_value(command_name.laf(1),1);
5950 if command_keyword=20 then
5951 begin <* check *>
5952 stop_time:=8388606;
5953 write(term_out,<:System stopping after last logout<10>:>);
5954 end
5955 else
5956 if command_name.laf(1)<> long <:0:> then
5957 begin
5958 write(term_out,string ill_par,command_name.laf,<:<10>:>);
5959 goto start;
5960 end;
5961 end
5962 else
5963 write(term_out,<:System stopping<10>:>);
5964 setposition(term_out,0,0);
5965 opera_terms(cor_nr,1):=1;
5966 login_stat:=0;
5967 system_stop:=true;
5968 timecheck_stat:=false;
5969 write_message(-100,if stop_time<>8388606 then stop_time
5970 else -1,true,<:Operator system stop:>);
5971 for i:=1 step 1 until stop_time do
5972 begin
5973 if (stop_time=8388606) and (sessions=0) then
5974 goto stop_sys;
5975 notis_users(stop_txt);
5976 if i<stop_time then
5977 begin
5978 wait(struc_sema,dummy);
5979 user_index:=user_list;
5980 while user_index>0 do
5981 begin
5982 if login_struc(user_index+4) extract 12 = 26 then
5983 login_struc(user_index+4):=
5984 (login_struc(user_index+4) shift (-12)) shift 12 ;
5985 user_index:=login_struc(user_index+7);
5986 end;
5987 signal(struc_sema,dummy);
5988 end;
5989 wait_time:=600;
5990 if wait(free_sem,dummy)>0 then
5991 begin
5992 signal(message_buf_pool,dummy);
5993 system_stop:=false;
5994 finis:=true;
5995 if head_consol=1 then
5996 write(term_out,<:System restarted<10>:>);
5997 head_consol:=1;
5998 wait(struc_sema,dummy);
5999 user_index:=user_list;
6000 while user_index>0 do
6001 begin
6002 login_struc(user_index+4):=
6003 ((login_struc(user_index+4) shift (-12)) shift 12) + 25;
6004 user_index:=login_struc(user_index+7);
6005 end;
6006 signal(struc_sema,dummy);
6007 goto start;
6008 end;
6009 end;
6010 stop_sys:
6011 <* Send stop message til tasterm *>
6012 ia(1):=14 shift 12 + 0;
6013 ia(2):=0;
6014 open(z,0,tasterm_name,0);
6015 send_mess(z,ia);
6016 monitor(18,z,1,ia);
6017 goto stop;
6018 end
6019 else
6020 write(term_out,string miss_par);
6021 end
6022 else
6023 if command_keyword=16 then
6024 begin <* login *>
6025 read_param(term_in,command_name,i);
6026 if i<0 or i>95 then
6027 write(term_out,string ill_val)
6028 else
6029 login_stat:=i;
6030 end
6031 else
6032 write(term_out,string ill_par,command_name.laf,<:<10>:>);
6033 end;
6034 end
6035 else
6036 write(term_out,string miss_par);
6037 start:
6038 if false then
6039 alarm: disable traped(100);
6040 end;
6041
6041 procedure opr_terminal;
6042 <* 101 *>
6043 <*---------------------------------------------------*>
6044 <* Udskriv alle terminaler der er inlogget *>
6045 <*---------------------------------------------------*>
6046 begin
6047 integer user_index,term_index,t,i;
6048 integer array term_id,user_id(1:4);
6049
6049 trap(alarm);
6050 t:=0;
6051 user_index:=user_list;
6052 while user_index>0 and not out_stop do
6053 begin
6054 for i:=0 step 1 until 3 do
6055 user_id(i+1):=login_struc(user_index+i);
6056 term_index:=login_struc(user_index+6);
6057 while term_index>0 and not out_stop do
6058 begin
6059 get_proc_name(login_struc(term_index),term_id);
6060 write(term_out,<:<10>:>,true,20,term_id.laf,true,11,user_id.laf);
6061 term_index:=login_struc(term_index+3);
6062 t:=t+1;
6063 end;
6064 user_index:=login_struc(user_index+7);
6065 end;
6066 write(term_out,<:<10><10>Terminals = :>,t);
6067 if false then
6068 alarm: disable traped(101);
6069 end;
6070
6070 procedure opr_user;
6071 <* 102 *>
6072 <*---------------------------------------------------*>
6073 <* Udskriv alle brugerer der er tilmeldt *>
6074 <*---------------------------------------------------*>
6075 begin
6076 integer user_index,t,i;
6077 integer array user_id(1:4);
6078
6078 trap(alarm);
6079 t:=0;
6080 user_index:=user_list;
6081 while user_index>0 and not out_stop do
6082 begin
6083 for i:=0 step 1 until 3 do
6084 user_id(i+1):=login_struc(user_index+i);
6085 write(term_out,<:<10>:>,true,11,user_id.laf);
6086 t:=t+1;
6087 user_index:=login_struc(user_index+7);
6088 end;
6089 write(term_out,<:<10><10>Users = :>,t);
6090 if false then
6091 alarm: disable traped(102);
6092 end;
6093
6093
6093 <****************************************>
6094 <* Hoved rutinen for operatør korutinen *>
6095 <****************************************>
6096 trap(alarm);
6097 claim(600); <* Reserver plads på stakken *>
6098 initref(ref);
6099 wait_time:=0;
6100 wait_select:=0;
6101 while true do
6102 begin
6103 break:=false;
6104 finis:=false;
6105 wait(opera_terms(cor_nr,2),ref);
6106 head_consol:=ref(3);
6107 <* sæt uændret besked buffer tilbage i pool *>
6108 signal(message_buf_pool,ref);
6109 if get_proc_name(opera_terms(cor_nr,1),term_name) then
6110 begin
6111 open(term_out,8,term_name,1 shift 16 + 1 shift 9);
6112 open(term_in,8,term_name,1 shift 9);
6113 if head_consol=1 then
6114 begin <* Ikke hoved terminalen *>
6115 <* Hent user id fra terminal *>
6116 getzone6(term_in,ia);
6117 ia(1):=131 shift 12 + 0; <* get user id *>
6118 ia(2):=ia(19)+1; <* first address *>
6119 ia(3):=ia(19)+11; <* last address *>
6120 buf:=send_mess(term_in,ia);
6121 if buf=0 then
6122 break:=true
6123 else
6124 begin
6125 if not wait_ans(term_in,buf,100,opera_terms(cor_nr,2),false) then
6126 break:=true <* Der blev ikke svaret inden 10 sek. *>
6127 else
6128 begin
6129 if monitor(18,term_in,1,ia)<>1 then
6130 break:=true
6131 else
6132 if ia(1)<>0 then
6133 break:=true
6134 else
6135 begin
6136 close(term_in,false);
6137 for i:=1,2 do
6138 user_id.laf(i):=term_in.laf(i);
6139 password:=term_in.laf(3);
6140 open(term_in,8,term_name,1 shift 9);
6141 <* Find privilegier i login_struc *>
6142 user_ident:=find_login_user(user_id,user_list);
6143 if user_ident=0 then
6144 break:=true <* Bruger ikke login *>
6145 else
6146 priv:=false add (login_struc(user_ident+5) shift (-12));
6147 end;
6148 end;
6149 end;
6150 end
6151 else
6152 priv:=true; <* alle privilegier *>
6153 if not break then
6154 write(term_out,<:<10>Operator ready<10>:>)
6155 else
6156 begin
6157 write(term_out,
6158 <:Operatøradgang ikke tilladt fra denne terminal<10>:>);
6159 setposition(term_out,0,0);
6160 monitor(64,term_out,0,command_name <*dummy*>);
6161 end;
6162 while not (finis or break) do
6163 begin <* Udfør operatør kommunikation *>
6164 setposition(term_out,0,0);
6165 write(term_out,<:$ :>);<* Prompt *>
6166 setposition(term_out,0,0);
6167 setposition(term_in,0,0); <* Slet input buffer *>
6168 if read_param(term_in,command_name,0) then
6169 begin
6170 if not break then <* break evt. sat af write el. read_param *>
6171 begin
6172 <* fortolk kommando i commandline *>
6173 command_keyword:=find_keyword_value(command_name.laf(1),1);
6174 if command_keyword>7 or command_keyword=0 then
6175 begin
6176 write(term_out,<:*** unknown command: :>,
6177 command_name.laf,<:<10>:>);
6178 setposition(term_out,0,0);
6179 end
6180 else
6181 begin
6182 out_stop:=false;
6183 case command_keyword of
6184 begin
6185 <* Udfør kommando *>
6186 <* Test for out_stop ved hver setposition på output *>
6187 <* er denne true stoppes evt ydeligerer udskrift *>
6188 <* Test for break efter hver i/o, er denne true *>
6189 <* stoppes udførelsen af kommandoen *>
6190 opr_finis;
6191 opr_disp;
6192 opr_message;
6193 opr_remove;
6194 opr_set;
6195 opr_start;
6196 opr_stop;
6197 end;
6198 end;
6199 end;
6200 end;
6201 if head_consol=0 then
6202 begin
6203 write(term_out,<:ok<10>:>);
6204 finis:=true; <* Hoved terminal *>
6205 end;
6206 end; <* session *>
6207 end;
6208 close(term_in,true);
6209 close(term_out,true);
6210 opera_terms(cor_nr,1):=0;
6211 end; <* while true *>
6212 stop:
6213 if false then
6214 alarm: disable traped(85);
6215 end; <* Operatør korutine *>
6216
6216 <**************************************>
6217 <**************************************>
6218 <* Procedure til time ckeck korutinen *>
6219 <**************************************>
6220 <**************************************>
6221
6221 integer procedure next_hour;
6222 <* 103 *>
6223 <*------------------------------------------------------------*>
6224 <* Beregn ventetiden til næste hele klokkeslet i *>
6225 <* 0.1 sek enheder *>
6226 <* *>
6227 <* Return : Tiden til næste hele klokkeslet i 0.1 sek enheder *>
6228 <*------------------------------------------------------------*>
6229 begin
6230 real r;
6231 long t;
6232 integer nh;
6233
6233 systime(1,0,r);
6234 t:=r;
6235 nh:=round(3600-t+t//3600*3600)*10;
6236 if false add trace_type then
6237 trace(103,nh,0,0);
6238 next_hour:=nh;
6239 end;
6240
6240 procedure notis_users(txt);
6241 <* 104 *>
6242 <*--------------------------------------------------------------------*>
6243 <* Find bruger der har overskredet tiden eller alle hvis stop *>
6244 <* Send log_txt og mærk tiden med 26 *>
6245 <* Gentag for alle brugere *>
6246 <*--------------------------------------------------------------------*>
6247 integer array txt;
6248 begin
6249 integer user_index,term_index,map,ut,nr;
6250 boolean found;
6251 integer array ref(1:1),struc_ref(1:1);
6252
6252 trap(alarm);
6253 initref(ref);
6254 initref(struc_ref);
6255 found:=true;
6256 repeat
6257 nr:=set_text_buf(txt);
6258 if nr=0 then
6259 begin
6260 wait_time:=100;
6261 wait(delay_sem,ref);
6262 end;
6263 until nr>0;
6264 while found do
6265 begin
6266 wait(struc_sema,struc_ref);
6267 found:=false;
6268 user_index:=user_list;
6269 while user_index>0 and not found do
6270 begin
6271 ut:=login_struc(user_index+4) extract 12;
6272 found:=(ut<=cur_time) or (system_stop and (ut<>26));
6273 if not found then
6274 user_index:=login_struc(user_index+7);
6275 end;
6276 if found then
6277 begin
6278 map:=login_struc(user_index+4) shift (-12);
6279 login_struc(user_index+4):=(map shift 12)+26;
6280 term_index:=login_struc(user_index+6);
6281 while term_index>0 do
6282 begin
6283 mess_to_term(term_index,nr);
6284 term_index:=login_struc(term_index+3);
6285 end;
6286 end;
6287 signal(struc_sema,struc_ref);
6288 send_message_text(nr);
6289 end;
6290 if false then
6291 alarm: disable traped(104);
6292 end;
6293
6293 procedure remove_users;
6294 <* 105 *>
6295 <*--------------------------------------------------------------------*>
6296 <* Find første bruger der har 26 sat i tid *>
6297 <* Send remove session message til TAS og sæt tid 27 *>
6298 <* Gentag for alle *>
6299 <*--------------------------------------------------------------------*>
6300 begin
6301 integer user_index,term_index,sess_index,map;
6302 boolean found;
6303 integer array struc_ref(1:1);
6304
6304 trap(alarm);
6305 initref(struc_ref);
6306 found:=true;
6307 while found do
6308 begin
6309 wait(struc_sema,struc_ref);
6310 found:=false;
6311 user_index:=user_list;
6312 while user_index>0 and not found do
6313 begin
6314 found:=(login_struc(user_index+4) extract 12)=26;
6315 if not found then
6316 user_index:=login_struc(user_index+7);
6317 end;
6318 if found then
6319 begin
6320 map:=login_struc(user_index+4) shift (-12);
6321 login_struc(user_index+4):=(map shift 12)+27;
6322 term_index:=login_struc(user_index+6);
6323 while term_index>0 do
6324 begin
6325 sess_index:=login_struc(term_index+2);
6326 while sess_index>0 do
6327 begin
6328 remove_sess(sess_index);
6329 sess_index:=login_struc(sess_index+3);
6330 end;
6331 term_index:=login_struc(term_index+3);
6332 end;
6333 end;
6334 signal(struc_sema,struc_ref);
6335 end;
6336 if false then
6337 alarm: disable traped(105);
6338 end;
6339
6339 procedure timeco;
6340 <* 106 *>
6341 <*--------------------------------------------*>
6342 <* Hoved procedure for check time korutinen *>
6343 <*--------------------------------------------*>
6344 begin
6345 integer array dummy(1:1);
6346 integer user_index,i,last_time;
6347 integer array id(1:4);
6348
6348 trap(alarm);
6349 claim(500);
6350 initref(dummy);
6351 while true do
6352 begin
6353 wait_time:=next_hour;
6354 if wait(time_sem,dummy)>0 then
6355 signal(message_buf_pool,dummy);
6356 if cur_time=0 then
6357 begin
6358 wait(struc_sema,dummy);
6359 user_index:=user_list;
6360 while user_index>0 do
6361 begin
6362 for i:=0,1,2,3 do
6363 id(i+1):=login_struc(user_index+i);
6364 find_user(id);
6365 last_time:=if check_time(last_time) then
6366 last_time
6367 else
6368 0;
6369 login_struc(user_index+4):=
6370 ((login_struc(user_index+4) shift (-12)) shift 12) + last_time;
6371 user_index:=login_struc(user_index+7);
6372 end;
6373 signal(struc_sema,dummy);
6374 end;
6375 for i:=1 step 1 until log_time do
6376 begin
6377 if timecheck_stat then
6378 begin
6379 notis_users(log_txt);
6380 if i<log_time then
6381 begin
6382 wait(struc_sema,dummy);
6383 user_index:=user_list;
6384 while user_index>0 do
6385 begin
6386 if login_struc(user_index+4) extract 12 = 26 then
6387 login_struc(user_index+4):=
6388 (login_struc(user_index+4) shift (-12)) shift 12 ;
6389 user_index:=login_struc(user_index+7);
6390 end;
6391 signal(struc_sema,dummy);
6392 end;
6393 wait_time:=600;
6394 if wait(time_sem,dummy)>0 then
6395 signal(message_buf_pool,dummy);
6396 end;
6397 end;
6398 if timecheck_stat then
6399 remove_users;
6400 end;
6401 if false then
6402 alarm: disable traped(106);
6403 end;
6404
6404 procedure write_term_text; <* Korutine *>
6405 <* 107 *>
6406 <*---------------------------------------------------------------*>
6407 <* Gemmenløb alle terminaler for at udskrive en evt tekst der er *>
6408 <* markeret i login_struc. Start gennemløb ved signalering fra *>
6409 <* send_text proceduren. Efter udskrift frigives text-buffer *>
6410 <* *>
6411 <* Formater af sem-message: *>
6412 <* *>
6413 <* Ved send_text: (1) buf nr. *>
6414 <* (2) message_buf_addr *>
6415 <* (3) text_write_sem *>
6416 <* (4) zone array index *>
6417 <* *>
6418 <* Ved signal : (1) 0 *>
6419 <* (2) 8 *>
6420 <* (3) text buf. nr. *>
6421 <* (4) 0 *>
6422 <* *>
6423 <*---------------------------------------------------------------*>
6424 begin
6425 integer array ref(1:1),answer(1:8);
6426 integer out_count,i,buf_nr;
6427 boolean finis;
6428 zone array z(max_text_count,1,1,stderror);
6429
6429 boolean procedure write_next_term;
6430 <* 108 *>
6431 <*-----------------------------------------------------*>
6432 <* Udskriv text på en terminal (den første der findes) *>
6433 <*-----------------------------------------------------*>
6434 begin
6435 integer array ref(1:1),share(1:12);
6436 integer user_index,term_index,bufs,nr,i,buf_addr;
6437 integer array struc_ref(1:1);
6438 boolean found;
6439
6439 trap(alarm);
6440 initref(ref);
6441 initref(struc_ref);
6442 wait(struc_sema,struc_ref);
6443 found:=false;
6444 user_index:=user_list;
6445 while (user_index>0) and (not found) do
6446 begin
6447 term_index:=login_struc(user_index+6);
6448 while term_index>0 and not found do
6449 begin
6450 bufs:=login_struc(term_index+1) shift (-21);
6451 if bufs<>0 then
6452 begin
6453 found:=true;
6454 nr:=0;
6455 while not (false add (bufs shift (-nr))) do
6456 nr:=nr+1;
6457 nr:=nr+1;
6458 login_struc(term_index+1):=login_struc(term_index+1)-
6459 (1 shift (20+nr));
6460 i:=1;
6461 repeat
6462 getshare6(z(i),share,1);
6463 i:=i+1;
6464 until share(1)<2;
6465 i:=i-1;
6466 share(4):=16 shift 12;
6467 share(5):=nr;
6468 share(6):=login_struc(term_index);
6469 setshare6(z(i),share,1);
6470 buf_addr:=monitor(16,z(i),1,share);
6471 if buf_addr=0 then
6472 write_message(998,1,false,<:claims exceeded:>);
6473 text_buf_reserved(nr):=if text_buf_reserved(nr)=-1 then
6474 1
6475 else
6476 text_buf_reserved(nr)+1;
6477 wait_select:=8;
6478 wait(message_buf_pool,ref);
6479 ref(1):=nr;
6480 ref(2):=buf_addr;
6481 ref(3):=text_write_sem;
6482 ref(4):=i;
6483 signal(wait_answer_pool,ref);
6484 end
6485 else
6486 term_index:=login_struc(term_index+3);
6487 end;
6488 user_index:=login_struc(user_index+7);
6489 end;
6490 write_next_term:=not found;
6491 signal(struc_sema,struc_ref);
6492 if false then
6493 alarm: disable traped(108);
6494 end; <* write_next_text *>
6495
6495
6495 trap(alarm); <* main write_term_text *>
6496 claim(500);
6497 initref(ref);
6498 out_count:=0;
6499 for i:=1,2,3 do
6500 text_buf_reserved(i):=0;
6501 for i:=1 step 1 until max_text_count do
6502 open(z(i),0,tasterm_name,1 shift 9);
6503 while true do
6504 begin
6505 wait(text_write_sem,ref);
6506 if ref(1)<>0 then
6507 begin
6508 <* answer *>
6509 monitor(18,z(ref(4)),1,answer);
6510 text_buf_reserved(ref(1)):=text_buf_reserved(ref(1))-1;
6511 ref(1):=0;
6512 ref(2):=8;
6513 signal(message_buf_pool,ref);
6514 out_count:=out_count-1;
6515 end
6516 else
6517 begin
6518 <* Ny tekst *>
6519 buf_nr:=ref(3);
6520 signal(message_buf_pool,ref);
6521 finis:=false;
6522 while not finis do
6523 begin
6524 if out_count=max_text_count then
6525 begin
6526 wait_select:=-1;
6527 wait(text_write_sem,ref);
6528 monitor(18,z(ref(4)),1,answer);
6529 text_buf_reserved(ref(1)):=text_buf_reserved(ref(1))-1;
6530 ref(1):=0;
6531 ref(2):=8;
6532 signal(message_buf_pool,ref);
6533 out_count:=out_count-1;
6534 end;
6535 finis:=write_next_term;
6536 if not finis then
6537 out_count:=out_count+1;
6538 end;
6539 if text_buf_reserved(buf_nr)=-1 then
6540 text_buf_reserved(buf_nr):=0;
6541 end;
6542 end;
6543 if false then
6544 alarm: disable traped(107);
6545 end;
6546
6546
6546 <*************************************************>
6547 <* Start af tascat og initialisering af korutiner*>
6548 <*************************************************>
6549
6549 trap(alarm);
6550 <* Initialiser login_struc *>
6551 init_login_struc;
6552 <* Opret korutinerne og semafor beskrivelserne *>
6553 activity(3+number_of_opera);
6554 coroutines(5+number_of_opera,test_out);
6555 sys_start:=true;
6556 <***********************************************************>
6557 <* Alloker alle besked buffere på stakken og signaler dem *>
6558 <* til semaforen message_buf_pool *>
6559 <* En buffer kan hentes fra poolen på følgende måde: *>
6560 <* wait_selct:= 'besked buffer størrelse'; *>
6561 <* wait(message_buf_pool,ref); *>
6562 <* *>
6563 <* Når bufferen ikke skal benyttes mere sættes den tilbage *>
6564 <* ref(1):=0; *>
6565 <* ref(2):='besked buffer størrelse'; *>
6566 <* signal(message_buf_pool,ref); *>
6567 <***********************************************************>
6568 for i:=1 step 1 until (2*number_of_opera) do
6569 allocate(message_buf_pool,6,0);
6570 for i:=1 step 1 until (3 + max_text_count) do
6571 allocate(message_buf_pool,8,0);
6572 allocate(message_buf_pool,22,0);
6573 allocate(struc_sema,6,0);
6574 select_test:=test_select;
6575 systime(1,0,start_time);
6576 <* Vent på synkronisering med tasterm *>
6577 wait_tasterm(false);
6578 <* Start korutinerne *>
6579 new_activity(1,0,catco); <* Katalog hovedrutinen *>
6580 new_activity(2,0,timeco); <* Time check rutinen *>
6581 new_activity(3,0,write_term_text);
6582 for i:=4 step 1 until number_of_opera+3 do
6583 new_activity(i,0,operator,i); <* Operatør rutinerne *>
6584
6584 <* Udskriv version, Start kerne og system *>
6585 write_message(struc_size,number_of_opera,true,<:Tas release 2.0 Ready:>);
6586 i:=kernel(traped);
6587
6587 answer(4):= <:ok :> shift (-24) extract 24;
6588 answer(5):= <: :> shift (-24) extract 24;
6589 if not system_stop then
6590 begin
6591 alarm:traped(0);
6592 write_message(run_alarm_pos,run_alarm_cause,true,<:Run error:>);
6593 answer(4):= <:err:> shift (-24) extract 24;
6594 answer(5):= <:or :> shift (-24) extract 24;
6595 end;
6596 close(usercat,true);
6597 close(termcat,true);
6598 close(typecat,true);
6599 close_test_out;
6600 sys_start:=false;
6601 end; <* TASCAT *>
6602
6602
6602 <******************************************>
6603 <* Program start og initialisering *>
6604 <******************************************>
6605
6605 <* Sæt global trap lable *>
6606 trap(init_alarm);
6607
6607 <* sæt fields *>
6608 sender_pda:=2;
6609 reciever_pda:=4;
6610 buf_addr:=6;
6611 mess_array:=6;
6612 laf:=iaf:=baf:=0;
6613
6613 <* sæt status *>
6614 trap_mode:=0;
6615 sys_start:=false;
6616 system_stop:=false;
6617 test_on:=false;
6618 killed:=false;
6619 users:= sessions:= terms:=0;
6620
6620 run_alarm_pos:= run_alarm_cause:=0;
6621
6621 <* initialiser konstant tekster *>
6622 ill_par:= real <:*** illegal parameter: :>;
6623 miss_par:= real <:*** missing parameter<10>:>;
6624 ill_val:= real <:*** illegal value<10>:>;
6625 long_text:= real <:*** text too long or input terminated by /<10>:>;
6626 t_n_l:= real <:*** terminal not login<10>:>;
6627 u_n_l:= real <:*** user not login<10>:>;
6628 ill_time:= real <:*** illegal login time<10>:>;
6629 c_p := real <:*** menu communication problems<10>:>;
6630
6630 <* Fjern fp area proces og in zonen *>
6631 open(test_out,4,<:fp:>,0);
6632 close(test_out,true);
6633 close(in,true);
6634 <* Fjern c og v entry *>
6635 open(copy_buf,0,<:c:>,0);
6636 monitor(48,copy_buf,i,log_txt);
6637 close(copy_buf,true);
6638 open(copy_buf,0,<:v:>,0);
6639 monitor(48,copy_buf,i,log_txt);
6640 close(copy_buf,true);
6641
6641 isotable(char_table);
6642 for i:=0 step 1 until 127 do
6643 char_table(i+128):=char_table(i)+128;
6644 char_table(46):=7 shift 12 + 46;
6645 intable(char_table);
6646
6646 <* Initialiser hovedterminalen *>
6647 head_term_pda:=system(7,i,head_term_name.laf);
6648
6648 <* initialiser keywords *>
6649 keywords_init;
6650
6650 <* Læs fp parametre *>
6651 read_param_line;
6652
6652 <* Sæt konstant værdier m.m fra init fil *>
6653 init_tascat;
6654
6654 <* Åben test output filen *>
6655 open_test(testout_name);
6656
6656 <* initialiser semafor navnene med nummer *>
6657 init_sem;
6658
6658 <* Test og initialiser baserne for processen *>
6659 init_bases;
6660
6660 <* init opera_terms array'et *>
6661 init_opera_terms;
6662
6662 <* Beregn struc_size og test processens størrelse *>
6663 struc_size:=2*max_users+max_terminals+max_sessions;
6664 max_terms:=if fp_maxterms>0 then
6665 fp_maxterms
6666 else
6667 max_terminals;
6668 system(2,own_size,prog_name.laf);
6669 <* Hent oversættelses dato og tid for tascat (algol rel. 3) *>
6670 begin
6671 integer segm,rel;
6672 integer array tail(1:10);
6673 zone z(128,1,stderror);
6674 open(z,4,prog_name,0);
6675 monitor(42,z,0,tail);
6676 segm:=tail(7) shift (-12);
6677 rel:=tail(7) extract 12;
6678 setposition(z,0,segm);
6679 inrec6(z,rel+16);
6680 inrec6(z,4);
6681 segm:=z(1) shift (-12) extract 12;
6682 rel:=z(1) extract 12;
6683 setposition(z,0,segm);
6684 inrec6(z,rel-4);
6685 inrec6(z,4);
6686 reld:=z(1) shift (-24) extract 24;
6687 relt:=z(1) extract 24;
6688 close(z,true);
6689 end;
6690
6690 if struc_size>(own_size-5000-number_of_opera*1500)//8 then
6691 write_message(own_size,25000+number_of_opera*1500+struc_size*8,
6692 false,<:Tas process too small:>)
6693 else
6694 begin
6695 <* Åben katalogerne *>
6696 open_catalogs(usercat_name,termcat_name,typecat_name);
6697
6697 <* test buffer claims *>
6698 system(5,own_pda+26,testout_name <* work array *>);
6699 if (testout_name(1) shift (-12))<(max_text_count+3+ number_of_opera) then
6700 write_message(testout_name(1) shift (-12)+2,
6701 max_text_count+5+number_of_opera,
6702 false,<:Not enough buffers:>);
6703
6703 if false then
6704 begin <* trap i initialiseringen *>
6705 init_alarm: traped(0);
6706 write_message(run_alarm_pos,run_alarm_cause,true,<:Initiation error:>);
6707 wait_tasterm(true);
6708 answer(4):= <:err:> shift (-24) extract 24;
6709 answer(5):= <:or :> shift (-24) extract 24;
6710 end
6711 else
6712
6712 <* start hovedproceduren *>
6713 tascat;
6714
6714 if killed then
6715 write_message(0,3,true,<:System breaked:>)
6716 else
6717 write_message(0,4,true,<:System stopped:>);
6718 system(11,i,log_txt);
6719 sys_bases(1):=log_txt(1);
6720 sys_bases(2):=log_txt(2);
6721 set_cat_bases(sys_bases);
6722 if trapmode = (-1) then
6723 answer(1):=2 shift 12 + 1
6724 else
6725 answer(1):=16 shift 12 + 1;
6726 answer(2):= <: st:> shift (-24) extract 24;
6727 answer(3):= <:op :> shift (-24) extract 24;
6728 for i:=6,7,8 do
6729 answer(i):=0;
6730 system(10,0,answer);
6731 end;
6732 end;\f
6. line 6586 . 2 undeclared
algol end 279
▶EOF◀