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