Added upstream from http://ftp.icm.edu.pl/pub/loglan/
[loglan.git] / loglan96 / loglan84.rs / antek6.txt
1 From:   MX%"antek@mimuw.edu.pl"  1-MAR-1993 17:47:52.39\r
2 To:     SALWICKI\r
3 CC:     \r
4 Subj:   \r
5 \r
6 Date: Mon, 1 Mar 93 14:59:27 GMT\r
7 From: antek@mimuw.edu.pl\r
8 To: salwicki@pauvx1.univ-pau.fr\r
9 \r
10 \1cw\r
11 \U1STANDARD\r
12 \U2POLISH\r
13 \U3ITALIC\r
14 \U4BOLD\r
15 \U"ORATOR\r
16 \U(PLORATOR\r
17 \+\r
18 \+\r
19 \ \ \ \ \\r
20 \-\r
21 \+\r
22 \+\r
23 \^\ \ \ \ \ \ \ \ \ \ \ \"PRZENASZALNY RUNNING SYSTEM NOWEGO LOGLANU\ \ \ \ \ \ \ \ \ \ \^\r
24 \-\r
25 \+\r
26 \+\r
27 \^\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ NAPISANY W J\(E\"ZYKU C\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \^\r
28 \-\r
29 \+\r
30 \r
31 \-\r
32 \+\r
33 \,\r
34 \-\r
35 \+\r
36 \+\r
37 \r
38 \-\r
39 \+\r
40 \r
41 \-\r
42 \+\r
43 \^\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \1Antoni  Kreczmar\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \^\r
44 \-\r
45 \+\r
46 \ \\r
47 \-\r
48 \+\r
49 \r
50 \-\r
51 \+\r
52 \r
53 \-\r
54 \+\r
55 1. Wst\2e\1p\r
56 \-\r
57 \+\r
58 \r
59 \-\r
60 \+\r
61 Poni\2x\1szy kr\2o\1tki opis Running Systemu dla \ nowego \ Loglanu \ opiera\r
62 \-\r
63 \+\r
64 si\2e \ \1w \ du\2x\1ym \ stopniu \ na \ poprzednich \ dokumentacjach. \ \ Przede\r
65 \-\r
66 \+\r
67 wszystkim na opisie Running \ Systemu \ Loglanu-82 \ oraz \ na \ dw\2o\1ch\r
68 \-\r
69 \+\r
70 pracach opublikowanych, \ tj. \ G.Cioni, \ "Programmed \ deallocation\r
71 \-\r
72 \+\r
73 without \ dangling \ reference" \ IPL \ 18(1984) \  pp.179-187, \ \ oraz\r
74 \-\r
75 \+\r
76 M.Krause, \ A.Kreczmar, \ H.Langmaack, \ A.Salwicki, \ M.Warpechowski\r
77 \-\r
78 \+\r
79 "Algebraic approach to ...." w Lecture Notes in Computer \ Science\r
80 \-\r
81 \+\r
82 Springer 208, pp.134-156. W pierwszej z tych prac \ opisano \ system\r
83 \-\r
84 \+\r
85 adresowania \ po\2s\1redniego \ dla \ Loglanu, \ \ a \ \ w \ \ drugiej \ \ dosy\2c\r
86 \-\r
87 \+\r
88 \1skomplikowane \ algorytmy \ poprawiania \ \  tablicy \ \ Display \ \ oraz\r
89 \-\r
90 \+\r
91 adresowania nielokalnego dla j\2e\1zyk\2o\1w z metodami dziedziczenia \ na\r
92 \-\r
93 \+\r
94 r\2ox\1nych poziomach. Bez znajomo\2s\1ci \ tych \ dw\2o\1ch \ prac \ zrozumienie\r
95 \-\r
96 \+\r
97 poni\2x\1szego kr\2o\1tkiego raportu jest niezwykle trudne. Radzimy \ wi\2e\1c\r
98 \-\r
99 \+\r
100 przed przyst\2a\1pienie do czytania niniejszego tekstu  zapozna\2c \ \1si\2e\r
101 \-\r
102 \+\r
103 \1z tymi dwiema pracami, \ jak \ r\2o\1wnie\2x \ \1z \ dokumentacj\2a \ \1w \   dw\2o\1ch\r
104 \-\r
105 \+\r
106 poprzednich jej postaciach (dla Loglanu-82 w \ pe\2l\1ni \ uruchominego\r
107 \-\r
108 \+\r
109 i dla Loglanu-84 w pr\2o\1bnej wersji loglanowej). \,\r
110 \-\r
111 \+\r
112 \,\r
113 \-\r
114 \+\r
115 Nowy RS  system dla nowego Loglanu \ zosta\2l \ \1napisany \ najpierw \ w\r
116 \-\r
117 \+\r
118 Loglanie-82, \ a \ nast\2e\1pnie \  w \ j\2e\1zyku \ C. \ Wyb\2o\1r \ j\2e\1zyka \ C \ by\2l\r
119 \-\r
120 \+\r
121 \1nieprzypadkowy. Ot\2ox \1w j\2e\1zyku tym mo\2x\1na wyrazi\2c \ \1wiele \ w\2l\1asno\2s\1ci\r
122 \-\r
123 \+\r
124 niskopoziomowych, a posiada \ on \ tak\2x\1e \ wszystkie \ zalety \ j\2e\1zyka\r
125 \-\r
126 \+\r
127 wysokopoziomowego.  Przet\2l\1umaczenie wersji loglanowej na  j\2e\1zyk C\r
128 \-\r
129 \+\r
130 nie \ przedstawia\2l\1o \ wi\2e\1kszych \ trudno\2s\1ci, \ umo\2x\1liwi\2l\1o \  natomiast\r
131 \-\r
132 \+\r
133 stworzenie bardzo efektywnego systemu \2l\1atwego do przenoszenia. \,\r
134 \-\/\f\r
135 \+\r
136 RS system  napisany \ w \ C \ daje \ mo\2x\1liwo\2sc \ \1wykonywania \ programu\r
137 \-\r
138 \+\r
139 loglanowego przet\2l\1umaczonego na j\2e\1zyk C. Taki \ spos\2o\1b \ realizacji\r
140 \-\r
141 \+\r
142 Loglanu \ wydaje \ mi \ si\2e \ \1najprostszy. \ Napisanie \ kompilatora \ z\r
143 \-\r
144 \+\r
145 Loglanu na C jest \ znacznie \ \2l\1atwiejsze \ ni\2x \ \1napisanie \  pe\2l\1nego\r
146 \-\r
147 \+\r
148 kompilatora \ na \ docelow\2a \  \1maszyn\2e\1. \ Problem \ przenoszenia \ jest\r
149 \-\r
150 \+\r
151 rozwi\2a\1zany w spos\2o\1b natychmiastowy. Ponadto  kompilator taki mo\2x\1e\r
152 \-\r
153 \+\r
154 korzysta\2c \1z bogactwa konstrukcji j\2e\1zyka C. Nie b\2e\1dzie problemu ze\r
155 \-\r
156 \+\r
157 sta\2l\1ymi, \ \ instrukcjami \ \ \ steruj\2a\1cymi \ \ \ w \ \ \ obr\2e\1bie \ \ \ modu\2l\1u,\r
158 \-\r
159 \+\r
160 wej\2s\1ciem-wyj\2s\1ciem, \2l\1a\2n\1cuchami itp. \ Niezwykle \ upro\2s\1ci \ si\2e \  \1sam\r
161 \-\r
162 \+\r
163 proces translacji. Wyra\2x\1enia mog\2a \1pozosta\2c \1w prawie niezmienionej\r
164 \-\r
165 \+\r
166 postaci - jedynie dost\2e\1p do  zmiennych loglanowych b\2e\1dzie wymaga\2l\r
167 \-\r
168 \+\r
169 \1wywo\2l\1ywania specjalnych makro  - ale proces \2l\1adowania \ rejestr\2o\1w,\r
170 \-\r
171 \+\r
172 optymalizacji lokalnej  itd. przerzucony  zostanie na system \  C.\r
173 \-\r
174 \+\r
175 A \ przecie\2x \ \1jest \ to \ system \ niezwykle \ \ efektywny. \ \ Wi\2e\1kszo\2sc\r
176 \-\r
177 \+\r
178 \1kompilator\2o\1w C daje kod \ dobrze \ zoptymalizowany. \ W \ ten \ prosty\r
179 \-\r
180 \+\r
181 spos\2o\1b  mo\2x\1emy wykorzysta\2c \1si\2le  \1tego j\2e\1zyka \ zostawiaj\2a\1c \ troski\r
182 \-\r
183 \+\r
184 techniczne \ \ \  (rejestry, \ \ \ arytmetyka \ \ \ maszyny, \ \ \ \ etykiety,\r
185 \-\r
186 \+\r
187 optymalizacja) systemowi C. \,\r
188 \-\r
189 \+\r
190 \,\r
191 \-\r
192 \+\r
193 Opisany poni\2x\1ej system sk\2l\1ada  si\2e \1z dwu \ plik\2o\1w \ : \  Rs.c \  oraz\r
194 \-\r
195 \+\r
196 Rsdata.h. Plik Rsdata.h jest \ tzw. \ plikiem \ nag\2lo\1wkowym \ (header\r
197 \-\r
198 \+\r
199 file).  W nim wyra\2x\1ono wszystkie wsp\2o\1lne struktury \  danych \ oraz\r
200 \-\r
201 \+\r
202 podstawowe zmienne. Na pliku Rs.c znajduje \ si\2e \ \1natomiast \ pe\2l\1na\r
203 \-\r
204 \+\r
205 biblioteka \ \ Running \ \ Systemu. \ \ Tekst \ \ programu \ \ \ loglanowego\r
206 \-\r
207 \+\r
208 przet\2l\1umaczony  na  C  musi w\2la\1cza\2c \1za pomoc\2a \1instrukcji \ include\r
209 \-\r
210 \+\r
211 plik Rsdata.h. W taki sam spos\2o\1b w\2la\1czany \ jest \ ten \ plik \ przez\r
212 \-\r
213 \+\r
214 Rs.c. \,\r
215 \-\r
216 \+\r
217 \,\r
218 \-\r
219 \+\r
220 \+\r
221                                                Edmonton, Maj 1988\r
222 \-\r
223 \+\r
224 \+\r
225                                           Warszawa, Sierpie\2n \11988\,\r
226 \-\r
227 \+\r
228 \,\r
229 \-\r
230 \+\r
231 \,\r
232 \-\f\r
233 \+\r
234 \,\r
235 \-\r
236 \+\r
237 2. Opis struktur danych na pliku Rsdata.h\r
238 \-\r
239 \+\r
240 \r
241 \-\r
242 \+\r
243 Na pliku \ tym \ znajduj\2a \ \1si\2e \ \1deklaracje \ struktury \ prototyp\2o\1w \ i\r
244 \-\r
245 \+\r
246 offset\2o\1w. Zajmiemy \ si\2e \ \1najpierw \ struktur\2a \ \ \1prototypu. \ \ Ma \ \ on\r
247 \-\r
248 \+\r
249 nast\2e\1puj\2a\1c\2a \1posta\2c\1: \,\r
250 \-\r
251 \+\r
252 \,\r
253 \-\r
254 \+\r
255 \4struct \3Prototype\r
256 \-\r
257 \+\r
258 \1{\r
259 \-\r
260 \+\r
261 \  \4int \3kind\1;\r
262 \-\r
263 \+\r
264 \  \4int \3num\1;\r
265 \-\r
266 \+\r
267 \  \4int \3lspan\1, \3rspan\1;\r
268 \-\r
269 \+\r
270 \  \4int \3references\1;\r
271 \-\r
272 \+\r
273 \  \4int \3decl\1, \3level\1;\r
274 \-\r
275 \+\r
276 \  \4int \3lastwill\1;\r
277 \-\r
278 \+\r
279 \  \4int \3permadd\1;\r
280 \-\r
281 \+\r
282 \  \4int \3Sloffset\1, \3Dloffset\1;\r
283 \-\r
284 \+\r
285 \  \4int \3Statoffset\1, \3Lscoffset\1;\r
286 \-\r
287 \+\r
288 \  \4int \3handlist\1;\r
289 \-\r
290 \+\r
291 \  \4int \3pref\1, \3pslength\1;\r
292 \-\r
293 \+\r
294 };\r
295 \-\r
296 \+\r
297 \r
298 \-\r
299 \+\r
300 Atrybut \3kind \1definiuje rodzaj \ prototypu. \ Mamy \ nast\2e\1puj\2a\1ce \ ich\r
301 \-\r
302 \+\r
303 rodzaje: CLASS, SUBROUTINE, PROCESS, COROUTINE, HANDLER, \ RECORD,\r
304 \-\r
305 \+\r
306 PRIMITARRAY, REFARRAY, SUBARRAY,  STRUCTARRAY, POINTARRAY. \  Pi\2ec\r
307 \-\r
308 \+\r
309 \1pierwszych nie wymaga wyja\2s\1nie\2n\1. RECORD jest klas\2a \1bez kodu i bez\r
310 \-\r
311 \+\r
312 innych modu\2lo\1w zadeklarowanych \ wewn\2a\1trz. \ Ten \ rodzaj \ prototypu\r
313 \-\r
314 \+\r
315 istnia\2l \1ju\2x \1w poprzedniej wersji  Running Systemu.  Ostanich pi\2ec\r
316 \-\r
317 \+\r
318 \1rodzaj\2o\1w dotyczy tablic. PRIMITARRAY jest tablic\2a \  \1o \ elementach\r
319 \-\r
320 \+\r
321 typu pierwotnego, \ REFARRAY \ jest \ tablic\2a \ \1typu \ referencyjnego,\r
322 \-\r
323 \+\r
324 SUBARRAY jest tablic\2a\1, kt\2o\1rej elementami s\2a \1domkni\2e\1cia \ procedur,\r
325 \-\r
326 \+\r
327 STRUCTARRAY jest tablic\2a \1o elementach typu z\2l\1o\2x\1onego \ i \ wreszcie\r
328 \-\r
329 \+\r
330 POINTARRAY \ jest \ tablic\2a \  \1typu \ \ referencyjnego, \ \ jednak\2x\1e \ \ o\r
331 \-\r
332 \+\r
333 elementach daj\2a\1cych  adresy  po\2s\1rednie  bez licznik\2o\1w. \ Taki \ typ\r
334 \-\r
335 \+\r
336 dodatkowy wprowadzili\2s\1my w nowej wersji \ RS \ w \ celu \ osi\2a\1gni\2e\1cia\r
337 \-\r
338 \+\r
339 wi\2e\1kszej efektywno\2s\1ci kodu. Zamiast \ pe\2l\1nego \ adresu \ wirtualnego\r
340 \-\r
341 \+\r
342 [adres po\2s\1redni, licznik] niekt\2o\1re referencje s\2a \ \1postaci \ [adres\r
343 \-\r
344 \+\r
345 po\2s\1redni]. \ Nie \ daj\2a \  \1one \ oczywi\2s\1cie \ gwarancji \ \  poprawno\2s\1ci\r
346 \-\r
347 \+\r
348 adresowania \ (mo\2x\1e \  wyst\2a\1pi\2c \  \1tzw. \ nieokre\2s\1lona \ \ referencja),\r
349 \-\/\f\r
350 \+\r
351 nimniej, \ je\2s\1li \ u\2x\1ytkownik \ jest \  pewny \ \  poprawno\2s\1ci \ \ swoich\r
352 \-\r
353 \+\r
354 adresowa\2n\1, mo\2x\1e cz\2esc \1lub \ wszystkie \ referencje \ zaznaczy\2c \ \1jako\r
355 \-\r
356 \+\r
357 proste. Poniewa\2x \1typy \ tablicowe \ s\2a \ \1rozr\2ox\1niane \ przez \ atrybut\r
358 \-\r
359 \+\r
360 \3kind, \1w\2s\1r\2o\1d rodzaj\2o\1w typ\2o\1w pojawi\2l \1si\2e \1tak\2x\1e typ POINTERARRAY. \,\r
361 \-\r
362 \+\r
363 \,\r
364 \-\r
365 \+\r
366 Drugim atrybutem prototypu jest \3num\1. Wskazuje on \ pozycj\2e \ \1danego\r
367 \-\r
368 \+\r
369 prototypu w tablicy PROT [] definiuj\2a\1cej wszystkie prototypy. \,\r
370 \-\r
371 \+\r
372 \r
373 \-\r
374 \+\r
375 Atrybuty \3lspan \1i \3rspan \1definiuj\2a \ \1rozmiar \ obiektu \ danego \ typu.\r
376 \-\r
377 \+\r
378 Wszystkie obiekty alokowane \ s\2a \ \1w \ tablicy \ M[ \ ]. \ Maj\2a\1c \ adres\r
379 \-\r
380 \+\r
381 obiektu \3am \1na lewo mamy rozmiar \ \3lspan\1, \ na \ prawo \ \3rspan\1, \ czyli\r
382 \-\r
383 \+\r
384 obiekt \ zajmuje \ elementy \ tablicy \ M[\3am-lspan\1..\3am\1+\3rspan\1]. \ Adres\r
385 \-\r
386 \+\r
387 prototypu usytuowany jest zawsze w s\2l\1owie M[\3am\1], tzn. maj\2a\1c adres\r
388 \-\r
389 \+\r
390 obiektu na zmiennej \3am\1, w\2l\1a\2s\1nie M[\3am\1] = \ \3num \ \1, \ gdzie \ \3num \ \1jest\r
391 \-\r
392 \+\r
393 adresem prototypu tego \ obiektu \ w \ tablicy \ PROT. \ Tablice \ maj\2a\r
394 \-\r
395 \+\r
396 \1rozmiar definiowany  dynamicznie. W s\2l\1owie \ M[\3am\1] \ jest \ zapisany\r
397 \-\r
398 \+\r
399 stosowny \ numer \  prototypu, \ natomiast \ \  dwa \ \ kolejne \ \  s\2l\1owa\r
400 \-\r
401 \+\r
402 definiuj\2a \1doln\2a \ \1i \ g\2o\1rn\2a \ \1granice \ wska\2z\1nika. \ Rozmiar \ elementu\r
403 \-\r
404 \+\r
405 tablicy w przypadku PRIMITARRAY podawany jest za pomoc\2a \ \1atrybutu\r
406 \-\r
407 \+\r
408 \3lspan\1. \,\r
409 \-\r
410 \+\r
411 \r
412 \-\r
413 \+\r
414 Pozosta\2l\1e atrybuty nie s\2a \1konieczne w przypadku tablic.\r
415 \-\r
416 \+\r
417 \r
418 \-\r
419 \+\r
420 Atrubut \3references \1definiuje struktur\2e \1referencji prototypu. \ Jest\r
421 \-\r
422 \+\r
423 to po prostu indeks  w tablicy  OFF[], kt\2o\1ra \ definiuje \ wszystkie\r
424 \-\r
425 \+\r
426 rodzaje struktur referencji (patrz definicja OFF poni\2x\1ej). \,\r
427 \-\r
428 \+\r
429 \,\r
430 \-\r
431 \+\r
432 Atrybuty \3decl \1i \ \3level \ \1odnosz\2a \ \1si\2e \ \1do \  struktury \ zagnie\2x\1d\2x\1e\2n\r
433 \-\r
434 \+\r
435 \1programu. Mianowicie \3decl \1jest indeksem w PROT \ ojca \ statycznego\r
436 \-\r
437 \+\r
438 danego modu\2l\1u, natomiast \3level \1jest g\2le\1boko\2s\1ci\2a \1zagnie\2x\1d\2x\1enia. \,\r
439 \-\r
440 \+\r
441 \r
442 \-\r
443 \+\r
444 Atrybut \3lastwill \1okre\2s\1la miejsce w module, od kt\2o\1rego rozpoczynaj\2a\r
445 \-\r
446 \+\r
447 \1si\2e \1instrukcje lastwill. \ W \ jaki \ spos\2o\1b \ modeluje \ si\2e \ \1kontrol\2e\r
448 \-\r
449 \+\r
450 \1sterowania podamy w punktach 4 i 10. \,\r
451 \-\r
452 \+\r
453 \,\r
454 \-\r
455 \+\r
456 Nast\2e\1pny atrybut \3permadd \1jest wsp\2o\1lnym adresem dla \ permutacji \ i\r
457 \-\r
458 \+\r
459 inwersji permutacji numer\2o\1w displaya.  Mianowicie plik \ loglanowy\r
460 \-\r
461 \+\r
462 definiuje dwie tablice \3perm\1[] i \3perminv\1[], kt\2o\1re \ musz\2a \ \1zawiera\2c\r
463 \-\r
464 \+\r
465 \1te permutacji. \ Przyk\2l\1adowo, \ dla \ \3perm\1[] \ = \ {0,1,2,0,2,1} \ oraz\r
466 \-\/\f\r
467 \+\r
468 \3perminv\1[] = {0,1,2,0,2,1}, indeks \3permadd\1=0 dla warto\2s\1ci \ \3level\1=2\r
469 \-\r
470 \+\r
471 okre\2s\1la permutacj\2e \1{0,1,2} \ (i \ te \ sam\2a \  \1odwrotn\2a\1), \  natomiast\r
472 \-\r
473 \+\r
474 \3permadd\1=2 dla  \3level \1te\2x \1r\2o\1wnym 2 daje perm={0,2,1} \ (i \ podobnie\r
475 \-\r
476 \+\r
477 te sam\2a \1odwrotn\2a\1}. \,\r
478 \-\r
479 \+\r
480 \,\r
481 \-\r
482 \+\r
483 Cztery \  kolejne \ atrybuty \ \ (\3Sloffset\1, \ \ \3Dloffset\1, \ \ \3Statoffset\1,\r
484 \-\r
485 \+\r
486 \3Lscoffset\1) definiuj\2a \1adresy wzgl\2e\1dne (offsety) czterech zmiennych\r
487 \-\r
488 \+\r
489 systemowych Sl, Dl, Statsl i  Lsc. Ka\2x\1dy \ modu\2l \ \1posiadaj\2a\1cy \ kod\r
490 \-\r
491 \+\r
492 musi \ mie\2c \ \1okre\2s\1lon\2a \ \1pozycj\2e \ \1Sl \ ojca, \ Dl \ \ ojca, \ \ lokalnego\r
493 \-\r
494 \+\r
495 sterowania Lsc i licznika Sl syn\2o\1w (Statsl). \ O \ tych \  zmiennych\r
496 \-\r
497 \+\r
498 systemowych b\2e\1dziemy m\2o\1wi\2c \1za chwil\2e\1. Tutaj natomiast \ chcieli\2s\1my\r
499 \-\r
500 \+\r
501 zwr\2o\1ci\2c \1uwag\2e \1na to, \2x\1e w poprzedniej \  wersji \ RS \ offsety \ tych\r
502 \-\r
503 \+\r
504 zmiennych by\2l\1y podawane w prototypie (ich pozycja \ by\2l\1a \ ustalona\r
505 \-\r
506 \+\r
507 na ko\2n\1cu obiektu). Wprowadzenie offset\2o\1w zmiennych systemowych do\r
508 \-\r
509 \+\r
510 prototyp\2o\1w skomplikuje kompilacj\2e\1,  ale przyspieszy i ujednorodni\r
511 \-\r
512 \+\r
513 RS. Dost\2e\1p do tych zmiennych \  b\2e\1dzie \ bowiem \ taki \ sam \ jak \ do\r
514 \-\r
515 \+\r
516 innych \ zmiennych \ wprowadzonych \ przez \ \ u\2x\1ytkownika \ \ czy \ \ te\2x\r
517 \-\r
518 \+\r
519 \1kompilator. \,\r
520 \-\r
521 \+\r
522 \r
523 \-\r
524 \+\r
525 Atrybut \3handlist \1definiuje list\2e \1handler\2o\1w zadeklarowanych w danym\r
526 \-\r
527 \+\r
528 module. Jest to  indeks w \ tablicy \ HL[], \ gdzie \ zdefiniowane \ s\2a\r
529 \-\r
530 \+\r
531 \1wszystkie takie listy. \ Tablica \ HL \ jest \ typu \ Hlstelem \ postaci\r
532 \-\r
533 \+\r
534 nast\2e\1puj\2a\1cej: \,\r
535 \-\r
536 \+\r
537 \r
538 \-\r
539 \+\r
540 \4struct \3Hlstelem\r
541 \-\r
542 \+\r
543 \1{\r
544 \-\r
545 \+\r
546 \  \4int \3hand\1;\r
547 \-\r
548 \+\r
549 \  \4int \3signlist\1;\r
550 \-\r
551 \+\r
552 \  \4int \3next\1;\r
553 \-\r
554 \+\r
555 };\r
556 \-\r
557 \+\r
558 \r
559 \-\r
560 \+\r
561 \r
562 \-\r
563 \+\r
564 Atrybut \3hand  \1jest indeksem w tablicy \ PROT \ w\2l\1a\2s\1ciwego \ handlera.\r
565 \-\r
566 \+\r
567 Natomiast atrybut \3signlist \ \1jest \ indeksem \ w \ tablicy \ SL[] \ typu\r
568 \-\r
569 \+\r
570 \3Sgelem\1, \ gdzie \ okre\2s\1lone \ s\2a \ \1numery \ sygna\2lo\1w \ zwi\2a\1zane \ z \ \ tym\r
571 \-\r
572 \+\r
573 handlerem. Typ \3Sgelem \1ma posta\2c \1nast\2e\1puj\2a\1c\2a\1: \,\r
574 \-\r
575 \+\r
576 \,\r
577 \-\f\r
578 \+\r
579 \4struct \3Sgelem\r
580 \-\r
581 \+\r
582 \1{\r
583 \-\r
584 \+\r
585 \  \4int \3signalnum\1;\r
586 \-\r
587 \+\r
588 \  \4int \3next\r
589 \-\r
590 \+\r
591 \1};\r
592 \-\r
593 \+\r
594 \r
595 \-\r
596 \+\r
597 \r
598 \-\r
599 \+\r
600 W ka\2x\1dym elemencie tablicy \ SL[] \ mamy \ numer \ sygna\2l\1u \ \3signalnum\1,\r
601 \-\r
602 \+\r
603 kt\2o\1ry jest warto\2s\1ci\2a \1absolutn\2a \1budowan\2a \1przez kompilator. \ Atrybut\r
604 \-\r
605 \+\r
606 \3next \1pokazuje na kolejny element takiej \ listy \ w \ SL[]. \ Podobnie\r
607 \-\r
608 \+\r
609 zreszt\2a \1atrybut \3next \1w HL[] wskazuje na nast\2e\1pny handler \ zwi\2a\1zany\r
610 \-\r
611 \+\r
612 z danym modu\2l\1em. Koniec ka\2x\1dej takiej listy \ (w \ obu \ przypadkach)\r
613 \-\r
614 \+\r
615 okre\2s\1la warto\2sc \3next\1=-1 (tak wybrano z uwagi na \ adresowanie \ w \ C\r
616 \-\r
617 \+\r
618 tablic od 0). \,\r
619 \-\r
620 \+\r
621 \r
622 \-\r
623 \+\r
624 Atrybut \3handlist \1wyst\2e\1puje tak\2x\1e w  prototypie handlera. \ Okre\2s\1la\r
625 \-\r
626 \+\r
627 on jedynie, \ czy \ handler \ ten \ odpowiada \ na \ wszystkie \ sygna\2l\1y\r
628 \-\r
629 \+\r
630 (others), \ czy \ \ te\2x \ \ \1jest \ \ deklarowany \ \ jako \ \ handler \ \  dla\r
631 \-\r
632 \+\r
633 wyspecyfikowanych \ numer\2o\1w \  sygna\2lo\1w. \ W \ \ pierwszym \ \ przypadku\r
634 \-\r
635 \+\r
636 warto\2sc \ \1tego \  atrybutu \ jest \  1 \ (hanlder \ dla \ \  others), \ \ w\r
637 \-\r
638 \+\r
639 pozosta\2l\1ych przypadkach warto\2sc \1tego atrybutu jest 0. \,\r
640 \-\r
641 \+\r
642 \r
643 \-\r
644 \+\r
645 \r
646 \-\r
647 \+\r
648 Dwa ostatnie atrybuty w prototypie ( \ \3pref\1, \ \3pslength\1) \ okre\2s\1laj\2a\r
649 \-\r
650 \+\r
651 \1struktur\2e \1prefiksowania. Nie musz\2a \1one \  wyst\2e\1powa\2c \ \1w \ przypadku\r
652 \-\r
653 \+\r
654 prototyp\2o\1w dla handler\2o\1w, gdy\2x \1handler nie mo\2x\1e by\2c \1prefiksowany.\r
655 \-\r
656 \+\r
657 Atrybut  \3pref \1jest indeksem w tablicy PROT modu\2l\1u \ prefiksuj\2a\1cego\r
658 \-\r
659 \+\r
660 (-1 gdy nie istnieje), \ atrybut \ \3pslength \ \1jest \ d\2l\1ugo\2s\1ci\2a \ \1ci\2a\1gu\r
661 \-\r
662 \+\r
663 prefiksuj\2a\1cego. \,\r
664 \-\r
665 \+\r
666 \r
667 \-\r
668 \+\r
669 Pozosta\2l\1a  do \ om\2o\1wienia \ struktura \ referencji. \ Ot\2ox \ \1z \ powodu\r
670 \-\r
671 \+\r
672 wprowadzenia bogactwa typ\2o\1w z\2l\1o\2x\1onych w nowym Loglanie, struktura\r
673 \-\r
674 \+\r
675 referencji \ w \ obiektach \ jest \ stosunkowo \ skomplikowana. \ Takie\r
676 \-\r
677 \+\r
678 struktury opisuje tablica OFF[] typu \3Offsets\1. \,\r
679 \-\r
680 \+\r
681 \r
682 \-\f\r
683 \+\r
684 \4struct \3Offsets\r
685 \-\r
686 \+\r
687 \1{\r
688 \-\r
689 \+\r
690 \  \4int \3kind\1;\r
691 \-\r
692 \+\r
693 \  \4int \3size\1, \3num\1;\r
694 \-\r
695 \+\r
696 \  \4int \3length\1, \3finish\1;\r
697 \-\r
698 \+\r
699 \  \4int \3head\1;\r
700 \-\r
701 \+\r
702 \  \4int \3references\1;\r
703 \-\r
704 \+\r
705 };\r
706 \-\r
707 \+\r
708 \,\r
709 \-\r
710 \+\r
711 \r
712 \-\r
713 \+\r
714 Atrybut \3kind \1jest nast\2e\1puj\2a\1cych \ rodzaj\2o\1w: \ SIMPLELIST, \ SEGMENT,\r
715 \-\r
716 \+\r
717 REPEATED \ oraz \ COMBINEDLIST. \ SIMPLELIST \ jest \ list\2a \ \ \1zwyk\2l\1ych\r
718 \-\r
719 \+\r
720 offset\2o\1w \  zmiennych \ referencyjnych \ w \ obiekcie. \ SEGMENT \ jest\r
721 \-\r
722 \+\r
723 szczeg\2o\1ln\2a  \1postaci\2a \ \1takiej \  listy, \ gdy \ te \  offsety \ zajmuj\2a\r
724 \-\r
725 \+\r
726 \1kolejne miejsca  w pami\2e\1ci (ten  typ wprowadzili\2s\1my \  ze \ wzgl\2e\1du\r
727 \-\r
728 \+\r
729 na tablice referencyjne,  jakkolwiek  jest \  on \ sprowadzalny \ do\r
730 \-\r
731 \+\r
732 przypadku poprzedniego). REPEATED jest \ n-krotn\2a \ \1iteracj\2a \ \1danej\r
733 \-\r
734 \+\r
735 struktury referencyjnej. COMBINEDLIST jest list\2a \1by\2c \1mo\2x\1e r\2ox\1nych\r
736 \-\r
737 \+\r
738 struktur referencji. \,\r
739 \-\r
740 \+\r
741 \,\r
742 \-\r
743 \+\r
744 Atrybut \3size \1okre\2s\1la ca\2l\1kowit\2a \1d\2l\1ugo\2sc \1opisywanej \ struktury  \ Dla\r
745 \-\r
746 \+\r
747 SIMPLELIST musi to \  by\2c \  \1d\2l\1ugo\2sc \ \1ca\2l\1ego \ obiektu, \ dla \ SEGMENT\r
748 \-\r
749 \+\r
750 r\2o\1wnie\2x \1d\2l\1ugo\2sc \1ca\2l\1ego obiektu, dla REPEATED  musi to by\2c \ \1d\2l\1ugo\2sc\r
751 \-\r
752 \+\r
753 \1powtarzanej struktury, i ostatecznie dla COMBINEDLIST  ma  to \ by\2c\r
754 \-\r
755 \+\r
756 \1d\2l\1ugo\2sc \ \1struktury \ wewn\2a\1trz \ kt\2o\1rej \ podawane \ s\2a \ \1wska\2z\1niki \ \ do\r
757 \-\r
758 \+\r
759 podstruktur. \,\r
760 \-\r
761 \+\r
762 \,\r
763 \-\r
764 \+\r
765 Kolejny \ atrybut \ \3num \ \1definiuje \ indeks \ w \ tablicy \ \ OFF \ \ danej\r
766 \-\r
767 \+\r
768 struktury.\,\r
769 \-\r
770 \+\r
771 \,\r
772 \-\r
773 \+\r
774 Znaczenie  atrybutu \3length \1jest \ wieloznaczne. \  Dla \  SIMPLELIST\r
775 \-\r
776 \+\r
777 \3length  \1jest d\2l\1ugo\2s\1ci\2a  \1listy offset\2o\1w. Dla SEGMENT \ \3length \ \1jest\r
778 \-\r
779 \+\r
780 pozycj\2a \1pierwszego,a \3finish \1ostatniego  elementu \  segmentu. \ Dla\r
781 \-\r
782 \+\r
783 REPEATED \3length \1jest \ krotno\2s\1ci\2a \ \1powt\2o\1rzenia \ podstruktury. \ Dla\r
784 \-\r
785 \+\r
786 COMBINEDLIST \3length \1jest d\2l\1ugo\2s\1ci\2a \1listy. \,\r
787 \-\r
788 \+\r
789 \,\r
790 \-\r
791 \+\r
792 Atrybut  \3head \1jest indeksem w tablicy EL[], gdzie \  zakodowane \ s\2a\r
793 \-\r
794 \+\r
795 \1listy struktur referencji. Typem tej tablicy jest  \3Elem\1: \,\r
796 \-\r
797 \+\r
798 \,\r
799 \-\/\f\r
800 \+\r
801 \4struct \3Elem\r
802 \-\r
803 \+\r
804 \1{\r
805 \-\r
806 \+\r
807 \  \4int \3offset\1;\r
808 \-\r
809 \+\r
810 \  \4int \3next\1;\r
811 \-\r
812 \+\r
813 \  \4int \3references\1;\r
814 \-\r
815 \+\r
816 };\r
817 \-\r
818 \+\r
819 \r
820 \-\r
821 \+\r
822 W tablicy tej atrybut  \3offset \1definiuje odpowiedni offset a \ \3next\r
823 \-\r
824 \+\r
825 \1jest jak zwykle wska\2z\1nikiem do \ nast\2e\1pnego \ elementu \ listy. \ Dla\r
826 \-\r
827 \+\r
828 typu SIMPLELIST ka\2x\1dy taki \ offset \ mo\2x\1e \ by\2c \ \1offsetem \ zmiennej\r
829 \-\r
830 \+\r
831 referencyjnej pe\2l\1nej lub tylko adresem po\2s\1rednim, ale tak\2x\1e \ mo\2x\1e\r
832 \-\r
833 \+\r
834 by\2c \1offsetem domkni\2e\1cia procedury (czyli pary <SL, adres kodu> ).\r
835 \-\r
836 \+\r
837 Gdy atrybut \3references \1jest 0, mamy referencje pe\2l\1n\2a\1, gdy jest \ 1\r
838 \-\r
839 \+\r
840 jest to adres po\2s\1redni, wreszcie gdy jest 2 \ jest \ to \ domkni\2e\1cie\r
841 \-\r
842 \+\r
843 procedury. \,\r
844 \-\r
845 \+\r
846 \,\r
847 \-\r
848 \+\r
849 Dla typu COMBINEDLIST atrybut \3references \1okre\2s\1la indeks w tablicy\r
850 \-\r
851 \+\r
852 OFF wskazywanej podstruktury referencji. \,\r
853 \-\r
854 \+\r
855 \,\r
856 \-\r
857 \+\r
858 \,\r
859 \-\r
860 \+\r
861 W  przypadku  typu SEGMENT atrybut \ \3head \ \1mo\2x\1e \ jeszcze \ okre\2s\1la\2c\r
862 \-\r
863 \+\r
864 \1rodzaj referencji. Gdy \3head \1= 0, mamy segment pe\2l\1nych referencji,\r
865 \-\r
866 \+\r
867 gdy jest 1 jest to segment adres\2o\1w po\2s\1rednich, gdy jest 2 jest to\r
868 \-\r
869 \+\r
870 segment domkni\2ec \1procedur.\,\r
871 \-\r
872 \+\r
873 \,\r
874 \-\r
875 \+\r
876 \,\r
877 \-\r
878 \+\r
879 Dla ostatniego atrybutu \3references \1w \ typie \ \3Offsets \ \1mamy \ jedno\r
880 \-\r
881 \+\r
882 zadanie. Powinien on okre\2s\1la\2c \1dla typu REPEATED indeks w \ tablicy\r
883 \-\r
884 \+\r
885 OFF powtarzanej struktury. \,\r
886 \-\r
887 \+\r
888 \r
889 \-\r
890 \+\r
891 Powy\2x\1szy system wprowadzania \  struktury \ prototyp\2o\1w \ jest \ dosy\2c\r
892 \-\r
893 \+\r
894 \1niezr\2e\1czny, je\2s\1li musi  by\2c \1wykonany r\2e\1cznie. Troch\2e \1w \ tym \ wina\r
895 \-\r
896 \+\r
897 j\2e\1zyka C.  Mo\2x\1na by\2l\1o \ wprowadzi\2c \ \1typ \ union, \ kt\2o\1ry \ przypomina\r
898 \-\r
899 \+\r
900 rekordy z \ wariantami, \ ale \ w\2o\1wczas \ nie \ mo\2x\1naby \ podawa\2c \ \1tych\r
901 \-\r
902 \+\r
903 struktur przez definicje w deklaracji (odp. DATA  \ w \ Fortranie).\r
904 \-\r
905 \+\r
906 Zatem przyj\2al\1em \ takie \ rozwi\2a\1zanie \ przez \ zwyk\2la \ \1struktur\2e\1. \ Z\r
907 \-\r
908 \+\r
909 drugiej strony translator z Loglanu na C mo\2x\1e bez k\2l\1opotu budowa\2c\r
910 \-\r
911 \+\r
912 \1tak\2a \1struktur\2e\1. \,\r
913 \-\r
914 \+\r
915 \,\r
916 \-\f\r
917 \+\r
918 \,\r
919 \-\r
920 \+\r
921 3. Struktury Dl i Sl\r
922 \-\r
923 \+\r
924 \r
925 \-\r
926 \+\r
927 Struktura Dl zachowana jest taka \ jak \ w \ Simuli \ i \ Loglanie-82.\r
928 \-\r
929 \+\r
930 Aktywny wsp\2ol\1program  jest \2l\1a\2n\1cuchem Dl, zawieszony  jest \ cyklem\r
931 \-\r
932 \+\r
933 Dl. \ Nowy \ Loglan \ usun\2al \ \ \1Detach, \ \ gdy\2x \ \ \1wprowadzi\2l \ \ \1zmienn\2a\r
934 \-\r
935 \+\r
936 \1LAST_ATTACH - \ wskazuj\2a\1c\2a \ \1na \ ostatni \ wsp\2ol\1program \  wykonuj\2a\1cy\r
937 \-\r
938 \+\r
939 Attach(X). Zako\2n\1czenie wsp\2ol\1programu \ jest \ sygnalizowane \ b\2le\1dem\r
940 \-\r
941 \+\r
942 (propozycja \ \ \ \ Marka \ \ \ \ Warpechowskiego). \ \ \ \ Wykonuje \ \ \ \ \ si\2e\r
943 \-\r
944 \+\r
945 \1Attach(LAST_ATTACH) with Cor_Term (coroutine terminated), \ o \ ile\r
946 \-\r
947 \+\r
948 LAST_ATTACH \ =/= \ \4none\1, \  w \ \ przeciwnym \ \ razie \ \ wykonuje \ \ si\2e\r
949 \-\r
950 \+\r
951 \1Attach(My_Process) \ \ with \ \ Cor_Term. \ \ To \ \ \ rozwi\2a\1zanie \ \ \ jest\r
952 \-\r
953 \+\r
954 metodologicznie  uzasadnione i najprostsze. \,\r
955 \-\r
956 \+\r
957 \,\r
958 \-\r
959 \+\r
960 Dla \  wsp\2ol\1programu \ aktywnego \ warto\2sc \ \1Dl \ jest \ \ \4none\1. \ \ Pr\2o\1ba\r
961 \-\r
962 \+\r
963 reaktywacji  wsp\2ol\1programu aktywnego \ powoduje \ wys\2l\1anie \ sygna\2l\1u\r
964 \-\r
965 \+\r
966 alarmowego. \ Wsp\2ol\1program \ \ zako\2n\1czony \ \ ma \ \ ustawion\2a \ \ \1warto\2sc\r
967 \-\r
968 \+\r
969 \1lokalnego sterowania Lsc na 0. \ Pr\2o\1ba \  reaktywacji \ zako\2n\1czonego\r
970 \-\r
971 \+\r
972 wsp\2ol\1programu powoduje wys\2l\1anie sygna\2l\1u. Zauwa\2x\1my na \ zako\2n\1czenie\r
973 \-\r
974 \+\r
975 omawiania struktury Dl, \ \2x\1e \ Dl-link \ mo\2x\1e \ by\2c \ \1w \ tym \ systemie\r
976 \-\r
977 \+\r
978 referencj\2a  \1niepe\2l\1n\2a  \1(tzn.  tylko adresem po\2s\1rednim). \ Zyskujemy\r
979 \-\r
980 \+\r
981 w ten spos\2o\1b na pami\2e\1ci i na czasie wykonania programu. \,\r
982 \-\r
983 \+\r
984 \,\r
985 \-\r
986 \+\r
987 Struktura Sl link\2o\1w \ tworzy \ drzewo. Problemem s\2a \ \1tylko \ usuwane\r
988 \-\r
989 \+\r
990 obiekty procedur, \ funkcji \ i \ blok\2o\1w, \  po \ ich \ terminacji. \  W\r
991 \-\r
992 \+\r
993 poprzedniej \ wersji \ przyj\2e\1li\2s\1my \ \ strategi\2e \ \  \1usuwania \ \ takich\r
994 \-\r
995 \+\r
996 obiekt\2o\1w bez wzgl\2e\1du na konsekwencje. Mog\2l\1o si\2e \ \1zdarzy\2c\1, \ \2x\1e \ po\r
997 \-\r
998 \+\r
999 pewnym \ czasie \ wznawiany \ dobrze \ \ okre\2s\1lony \ \ obiekt \ \ nie \ \ ma\r
1000 \-\r
1001 \+\r
1002 okre\2s\1lonego otoczenia statycznego (Sl link przeci\2e\1ty). \ Umieli\2s\1my\r
1003 \-\r
1004 \+\r
1005 wykry\2c \1takie przypadki, ale nie by\2l\1o to \ rozwi\2a\1zanie \ eleganckie.\r
1006 \-\r
1007 \+\r
1008 Marek Lao \ zauwa\2x\1y\2l\1, \ \2x\1e \ lepiej \ by\2l\1oby \ u\2x\1y\2c \ \1zwyk\2l\1ej \ techniki\r
1009 \-\r
1010 \+\r
1011 licznik\2o\1w referencji tylko \ dla \ tego \ przypadku. \ Mamy \ przecie\2x\r
1012 \-\r
1013 \+\r
1014 \1licznik Statsl (poprzednio inaczej okre\2s\1lony),  nale\2x\1y zastosowa\2c\r
1015 \-\r
1016 \+\r
1017 \1go w spos\2o\1b nast\2e\1puj\2a\1cy. \,\r
1018 \-\r
1019 \+\r
1020 \,\r
1021 \-\r
1022 \+\r
1023 Ka\2x\1de otwarcie nowego obiektu zwi\2e\1ksza o 1 \ licznik \ Statsl \ jego\r
1024 \-\r
1025 \+\r
1026 statycznego ojca. Ka\2x\1de zako\2n\1czenie obiektu \ procedury \ (funkcji,\r
1027 \-\r
1028 \+\r
1029 bloku) sprawdza, czy jego Statsl jest 0. Je\2s\1li tak, obiekt \ mo\2x\1na\r
1030 \-\r
1031 \+\r
1032 usun\2ac\1, zmniejszy\2c \1Statsl o \ 1 \ dla \ jego \ ojca \ i \ powt\2o\1rzy\2c \ \1te\r
1033 \-\/\f\r
1034 \+\r
1035 operacje dla takiego \ ojca \ (o \ ile \ jest \ to \ obiekt \ procedury,\r
1036 \-\r
1037 \+\r
1038 funkcji lub bloku). Dla usuwanego za pomoc\2a \1kill \ obiektu \ klasy,\r
1039 \-\r
1040 \+\r
1041 sprawdzamy \ najpierw \ jego \ Statsl, \ \ i \ \ post\2e\1pujemy \ \ podobnie.\r
1042 \-\r
1043 \+\r
1044 Pozostaje rozwi\2a\1za\2c \1poprawnie problem usuwania wsp\2ol\1program\2o\1w. \,\r
1045 \-\f\r
1046 \+\r
1047 \,\r
1048 \-\r
1049 \+\r
1050 Zabicie zawieszonego wsp\2ol\1programu polega na \ zabiciu \ stosownego\r
1051 \-\r
1052 \+\r
1053 cyklu Dl. Najpierw przegl\2a\1damy taki cykl i sprawdzamy, \ czy \ jego\r
1054 \-\r
1055 \+\r
1056 wszystkie obiekty maj\2a \1Statsl \ r\2o\1wny \ 0. \ Je\2s\1li \ nie, \ wywo\2l\1ujemy\r
1057 \-\r
1058 \+\r
1059 sygna\2l \1alarmowy. Je\2s\1li natomiast wszystkie \ s\2a \ \1usuwalne, \ mo\2x\1emy\r
1060 \-\r
1061 \+\r
1062 przyst\2a\1pi\2c \1do kolejnego ich usuwania. Aby \ to \ zrobi\2c \ \1poprawnie,\r
1063 \-\r
1064 \+\r
1065 nale\2x\1a\2l\1oby stosowa\2c \1operacj\2e \1przej\2s\1cia po Sl-\2l\1a\2n\1cuchu dla ka\2x\1dego\r
1066 \-\r
1067 \+\r
1068 obiektu usuni\2e\1tego (tak jak \ dla \ obiektu \ klasy). \ Ale \ przecie\2x\r
1069 \-\r
1070 \+\r
1071 \1mogliby\2s\1my usun\2ac \1jaki\2s \1obiekt jeszcze \ nieusuni\2e\1ty \ z \ usuwanego\r
1072 \-\r
1073 \+\r
1074 w\2l\1a\2s\1nie cyklu wsp\2ol\1programu. Aby unikn\2ac \1tej sytuacji, \ odwracamy\r
1075 \-\r
1076 \+\r
1077 najpierw \ cykl \ wsp\2ol\1programu. \ Zabijaj\2a\1c \ obiekty \ w \ kolejno\2s\1ci\r
1078 \-\r
1079 \+\r
1080 odwrotnej (od g\2l\1owy wsp\2ol\1programu, nast\2e\1pnie syn dynamiczny itd),\r
1081 \-\r
1082 \+\r
1083 mamy pewno\2sc\1, \ \2x\1e \  nie \  usuniemy \ przy \  czyszczeniu \ kolejnych\r
1084 \-\r
1085 \+\r
1086 \2l\1a\2n\1cuch\2o\1w  Sl \2x\1adnego pozosta\2l\1ego elementu \ cyklu. \ Wynika \ to \ z\r
1087 \-\r
1088 \+\r
1089 w\2l\1asno\2s\1ci Sl \ i \ Dl \ \2l\1a\2n\1cuch\2o\1w \ - \ nie \ mog\2a \ \1i\2sc \ \1w \ przeciwnych\r
1090 \-\r
1091 \+\r
1092 kierunkach, tzn. je\2s\1li jest Dl droga od A do B to nie ma Sl drogi\r
1093 \-\r
1094 \+\r
1095 od B do A. \ W \ drugiej \ fazie \ usuwania \ wsp\2ol\1programu \ zmieniamy\r
1096 \-\r
1097 \+\r
1098 orientacj\2e \1cyklu. W trzeciej, ju\2x \1bezpiecznie mo\2x\1emy usun\2ac \ \1ca\2l\1y\r
1099 \-\r
1100 \+\r
1101 cykl \ czyszcz\2a\1c \ po \ \ drodze \ \ \2l\1a\2n\1cuchy \ \  Sl. \ \ W \ \ ten \ \ spos\2o\1b\r
1102 \-\r
1103 \+\r
1104 rozwi\2a\1zali\2s\1my, \  chyba \ dostatecznie \ \ poprawnie \ \ i \ \ elegancko,\r
1105 \-\r
1106 \+\r
1107 problemy  czyszczenia pami\2e\1ci w Loglanie. Ponadto taka \ struktura\r
1108 \-\r
1109 \+\r
1110 Sl pozwala \ na \ zast\2a\1pi\2e\1nie \ pe\2l\1nych \ referencji \ dla \ Sl \ link\2o\1w\r
1111 \-\r
1112 \+\r
1113 adresami po\2s\1rednimi (tak jak to \ mia\2l\1o \ miejsce \ w \ przypadku \ Dl\r
1114 \-\r
1115 \+\r
1116 link\2o\1w). Zawsze bowiem warto\2sc \1Sl jest \ dobrze \ okre\2s\1lona \ i \ nie\r
1117 \-\r
1118 \+\r
1119 wymaga sprawdzenia, tak jak to mia\2l\1o miejsce w \ starym \ Loglanie,\r
1120 \-\r
1121 \+\r
1122 tzn. czy okre\2s\1la jeszcze istniej\2a\1cy obiekt. \,\r
1123 \-\r
1124 \+\r
1125 \,\r
1126 \-\r
1127 \+\r
1128 Zmiana warto\2s\1ci atrybutu Statsl dotyczy \ tak\2x\1e \ u\2x\1ycia \ zmiennych\r
1129 \-\r
1130 \+\r
1131 podprogramowych. Warto\2s\1ci\2a \1takiej \ zmiennej \ podprogramowej \ jest\r
1132 \-\r
1133 \+\r
1134 domkni\2e\1cie procedury (<SL,adres kodu>). Poniewa\2x \1j\2e\1zyk w \ obecnej\r
1135 \-\r
1136 \+\r
1137 postaci dopuszcza operowanie na zmiennych podprogramowych, system\r
1138 \-\r
1139 \+\r
1140 musi dba\2c \1o to, by nieopatrznie nie usuwa\2c \1otoczenia \ statycznego\r
1141 \-\r
1142 \+\r
1143 dla dost\2e\1pnego domkni\2e\1cia procedury, \ albowiem \ takie \ domkni\2e\1cie\r
1144 \-\r
1145 \+\r
1146 mo\2x\1e by\2c \1w ka\2x\1dej chwili u\2x\1yte.  Jak wi\2e\1c post\2e\1pujemy. Traktujemy\r
1147 \-\r
1148 \+\r
1149 domkni\2e\1cia \ \ procedur \ \ jako \ \ specjalne \ \ zmienne \ \ referencyjne\r
1150 \-\r
1151 \+\r
1152 (przypominam, \ \2x\1e \ odpowiednie \ SL \ linki \ \ mog\2a \ \ \1by\2c \ \ \1adresami\r
1153 \-\r
1154 \+\r
1155 kr\2o\1tkimi). Dla tych specjalnych \ referencji \ stosujemy \ strategi\2e\r
1156 \-\r
1157 \+\r
1158 \1reference counter, czyli ka\2x\1de \ podstawienie \ wymaga \ poprawienia\r
1159 \-\r
1160 \+\r
1161 odpowiednich \ Statsl. \ Przy \ usuwaniu \ \ obiektu \ \ nale\2x\1y \ \ jednak\r
1162 \-\/\f\r
1163 \+\r
1164 wszystkie takie zmienne przejrze\2c \1i \ tak\2x\1e \ poprawi\2c \ \1odpowiednie\r
1165 \-\r
1166 \+\r
1167 Statsl. Ca\2l\1o\2sc \1jest bardzo prosta, wymaga jednak wyr\2ox\1nienia tych\r
1168 \-\r
1169 \+\r
1170 referencji, co zosta\2l\1o zrobione w\2l\1a\2s\1nie w strukturze OFF.\,\r
1171 \-\r
1172 \+\r
1173 \,\r
1174 \-\r
1175 \+\r
1176 4. Struktura sterowania lokalnego\r
1177 \-\r
1178 \+\r
1179 \r
1180 \-\r
1181 \+\r
1182 Sterowanie lokalne w j\2e\1zyku C jest bardzo podobne \ do \ sterowania\r
1183 \-\r
1184 \+\r
1185 lokalnego w Loglanie. Wszystkie p\2e\1tle \ loglanowe \ mo\2x\1na \ zast\2a\1pi\2c\r
1186 \-\r
1187 \+\r
1188 \1przez ich \ odpowiedniki \ w \ j\2e\1zyku \ C. \ Podobnie \ z \ instrukcjami\r
1189 \-\r
1190 \+\r
1191 warunkowymi i instrukcjami wyboru. Problem techniczny  powstaje w\r
1192 \-\r
1193 \+\r
1194 momencie przekazywanie sterowania pomi\2e\1dzy modu\2l\1ami \ Loglanowymi,\r
1195 \-\r
1196 \+\r
1197 poniewa\2x \1ka\2x\1de takie przekazanie sterowania zawiesza \ wykonywanie\r
1198 \-\r
1199 \+\r
1200 instrukcji modu\2l\1u aktywnego. Jak z tym \ problemem \ upora\2c \ \1si\2e \ \1w\r
1201 \-\r
1202 \+\r
1203 j\2e\1zyku C. Modu\2l \1loglanowy przet\2l\1umaczony na odpowiedni modu\2l \1C ma\r
1204 \-\r
1205 \+\r
1206 jako pierwsz\2a \1instrukcj\2e \1wygenerowan\2a \1przez kompilator instrukcj\2e\r
1207 \-\r
1208 \+\r
1209 \1wyboru: \,\r
1210 \-\r
1211 \+\r
1212 \,\r
1213 \-\r
1214 \+\r
1215    \4switch \1(IC)\r
1216 \-\r
1217 \+\r
1218    {\r
1219 \-\r
1220 \+\r
1221      \4case \11: \4goto \1L1; \4break\1;\r
1222 \-\r
1223 \+\r
1224 \r
1225 \-\r
1226 \+\r
1227             ...\r
1228 \-\r
1229 \+\r
1230 \r
1231 \-\r
1232 \+\r
1233      \4case \1n: \4goto \1Ln; \4break\1;\r
1234 \-\r
1235 \+\r
1236    };\r
1237 \-\r
1238 \+\r
1239 \r
1240 \-\r
1241 \+\r
1242 gdzie IC jest wsp\2o\1ln\2a \ \1zmienn\2a \ \1globaln\2a \ \1zadeklarowan\2a \ \1w \ pliku\r
1243 \-\r
1244 \+\r
1245 Rsdata.h oraz etykiety L1,...,Ln definiuj\2a \1r\2ox\1ne \ punkty \ wej\2s\1cia\r
1246 \-\r
1247 \+\r
1248 do modu\2l\1u. Ka\2x\1de \ przekazanie \ sterowania \ do \ innego \ modu\2l\1u \ za\r
1249 \-\r
1250 \+\r
1251 pomoc\2a \1procedur systemowych RS \ (np. \ Go, \ Attach, \ itp.) \ wymaga\r
1252 \-\r
1253 \+\r
1254 prawid\2l\1owego okre\2s\1lenia warto\2s\1ci \ IC, \ kt\2o\1ra \ jest \ zapami\2e\1tywana\r
1255 \-\r
1256 \+\r
1257 przez RS w \ odpowiedniej \ lokacji \ obiektu \ (Lsc). \ Na \ przyk\2l\1ad,\r
1258 \-\r
1259 \+\r
1260 wywo\2l\1anie procedury loglanowej ma posta\2c\1: \,\r
1261 \-\r
1262 \+\r
1263 \r
1264 \-\r
1265 \+\r
1266     IC=m; Go(..);\r
1267 \-\r
1268 \+\r
1269 Lm: ...;\r
1270 \-\r
1271 \+\r
1272 \r
1273 \-\r
1274 \+\r
1275 Przy ponownym wywo\2l\1aniu tego modu\2l\1u, na \ przyk\2l\1ad \ po \ powrocie \ z\r
1276 \-\r
1277 \+\r
1278 wywo\2l\1anej \ procedury, \ odtworzona \ warto\2sc \ \1IC \ \ pozwala \ \ Running\r
1279 \-\/\f\r
1280 \+\r
1281 Systemowi trafi\2c \1w poprawne miejsce modu\2l\1u, a wi\2e\1c w instrukcje po\r
1282 \-\r
1283 \+\r
1284 wywo\2l\1aniu Go(...). \,\r
1285 \-\r
1286 \+\r
1287 \,\r
1288 \-\r
1289 \+\r
1290 \,\r
1291 \-\r
1292 \+\r
1293 Pierwsze wej\2s\1cie do modu\2l\1u okre\2s\1la warto\2sc \1IC=1, zatem etykieta L1\r
1294 \-\r
1295 \+\r
1296 musi \ wyst\2a\1pi\2c \ \1przed \ pierwsz\2a \ \1przet\2l\1umaczon\2a \ \1na \ C \ instrukcj\2a\r
1297 \-\r
1298 \+\r
1299 \1loglanow\2a\1. \,\r
1300 \-\f\r
1301 \+\r
1302 \,\r
1303 \-\r
1304 \+\r
1305 Jak ju\2x \1powiedzieli\2s\1my, ka\2x\1dy modu\2l \1loglanowy ma sw\2o\1j \ odpowiedni\r
1306 \-\r
1307 \+\r
1308 modu\2l \1w j\2e\1zyku C. Poniewa\2x \1chcemy przekazywa\2c \1sterowanie pomi\2e\1dzy\r
1309 \-\r
1310 \+\r
1311 takimi modu\2l\1ami w C, wraz z tekstami modu\2lo\1w przet\2l\1umaczony tekst\r
1312 \-\r
1313 \+\r
1314 musi mie\2c \1zdefiniowan\2a \1tablic\2e\1: \,\r
1315 \-\r
1316 \+\r
1317 \r
1318 \-\r
1319 \+\r
1320    \4int \1(* module []) () ;\r
1321 \-\r
1322 \+\r
1323 \,\r
1324 \-\r
1325 \+\r
1326 Ka\2x\1da pozycja \ w \ tej \ tablicy \ musi \ okre\2s\1la\2c \ \1modu\2l\1, \ zgodnie \ z\r
1327 \-\r
1328 \+\r
1329 porz\2a\1dkiem zadanym przez tablic\2e \1PROT. Ca\2l\1y program \ ko\2n\1czy \ modu\2l\r
1330 \-\r
1331 \+\r
1332 \1main(), gdzie warto\2s\1ci tej tablicy musz\2a \1by\2c \1tak w\2l\1a\2s\1nie okre\2s\1lone\r
1333 \-\r
1334 \+\r
1335 i \ gdzie \ przekazuje \ si\2e \ \1sterowanie \ do \ \ loglanowego \ \ programu\r
1336 \-\r
1337 \+\r
1338 g\2lo\1wnego: \,\r
1339 \-\r
1340 \+\r
1341 \r
1342 \-\r
1343 \+\r
1344 main ()\r
1345 \-\r
1346 \+\r
1347 {\r
1348 \-\r
1349 \+\r
1350   module[0]=A1;\r
1351 \-\r
1352 \+\r
1353     ...\r
1354 \-\r
1355 \+\r
1356   module[k]=Ak;\r
1357 \-\r
1358 \+\r
1359   Init();\r
1360 \-\r
1361 \+\r
1362   IC=1;\r
1363 \-\r
1364 \+\r
1365   ...\,\r
1366 \-\r
1367 \+\r
1368 }\r
1369 \-\r
1370 \+\r
1371 \r
1372 \-\r
1373 \+\r
1374 W \ powy\2x\1szym \ tek\2s\1cie \ A1,...,Ak \ s\2a \ \ \1nazwami \ \ modu\2lo\1w, \ \ kt\2o\1re\r
1375 \-\r
1376 \+\r
1377 wprowadzi\2l \1translator i okre\2s\1laj\2a \1one \ odpowiednie \ modu\2l\1y \ w \ C.\r
1378 \-\r
1379 \+\r
1380 Instrukcja Init() inicjalizuje struktury danych Running \ Systemu.\r
1381 \-\r
1382 \+\r
1383 Potem IC okre\2s\1lamy na 1 i \ przekazujemy \ sterowanie \ do \ programu\r
1384 \-\r
1385 \+\r
1386 loglanowego \ ( \ przekazywanie \ \ sterowania \ \  pomi\2e\1dzy \ \ modu\2l\1ami\r
1387 \-\r
1388 \+\r
1389 zostanie porzedstawione w rozdziale 7). \,\r
1390 \-\r
1391 \+\r
1392 \r
1393 \-\r
1394 \+\r
1395 W podobny spos\2o\1b definiuje si\2e \1etykiet\2e \3lastwill \1w module. Atrybut\r
1396 \-\r
1397 \+\r
1398 \3lastwill \1w prototypie musi \ okre\2s\1la\2c \ \1tak\2a \ \1warto\2sc \ \1zmiennej \ IC,\r
1399 \-\r
1400 \+\r
1401 kt\2o\1ra przeka\2x\1e sterowanie w odpowiednie miejsce modu\2l\1u. \,\r
1402 \-\r
1403 \+\r
1404 \,\r
1405 \-\f\r
1406 \+\r
1407 \,\r
1408 \-\r
1409 \+\r
1410 5. Adresowanie\r
1411 \-\r
1412 \+\r
1413 \r
1414 \-\r
1415 \+\r
1416 Plik \ Rsdata.h \ dostarcza \ \ odpowiednich \ \ macro \ \  s\2l\1u\2xa\1cych \ \ do\r
1417 \-\r
1418 \+\r
1419 adresowania zmiennych loglanowych. \ Macro \ Address(\3dnum\1,\3off\1) \ daje\r
1420 \-\r
1421 \+\r
1422 adres zmiennej o numerze displaya \3dnum \1i offsecie \ \3off\1. \ Wykonanie\r
1423 \-\r
1424 \+\r
1425 zatem instrukcji podstawienia: \,\r
1426 \-\r
1427 \+\r
1428 \,\r
1429 \-\r
1430 \+\r
1431     i:=j+k\r
1432 \-\r
1433 \+\r
1434 \,\r
1435 \-\r
1436 \+\r
1437 dla \ zmiennych \ integer \ \ o \ \ adresach \ \ (\3dnum\1,\3off\1) \ \ odpowiednio\r
1438 \-\r
1439 \+\r
1440 (1,2),(2,3) oraz (1,4) t\2l\1umaczymy nast\2e\1puj\2a\1co: \,\r
1441 \-\r
1442 \+\r
1443 \,\r
1444 \-\r
1445 \+\r
1446     *Address(1,2)= *Address(2,3) + *Address(1,4);\r
1447 \-\r
1448 \+\r
1449 \r
1450 \-\r
1451 \+\r
1452 Plik Rsdata.h daje \ tak\2x\1e \ dwa \ dodatkowe \ macra \ dla \ adresowania\r
1453 \-\r
1454 \+\r
1455 lokalnego i globalnego. Local(\3off\1) daje adres w obiekcie \ aktywnym\r
1456 \-\r
1457 \+\r
1458 o \ offsecie \ \3off\1, \ Global(\3off\1) \ daje \ adres \ w \ obiekcie \ programu\r
1459 \-\r
1460 \+\r
1461 g\2lo\1wnego o offsecie \3off\1. Instrukcj\2e\1:\,\r
1462 \-\r
1463 \+\r
1464 \,\r
1465 \-\r
1466 \+\r
1467     i:=i-j\r
1468 \-\r
1469 \+\r
1470 \,\r
1471 \-\r
1472 \+\r
1473 gdzie i jest zmienn\2a \1globaln\2a \1o offsecie \ 5, \ a \ j \ jest \ zmienn\2a\r
1474 \-\r
1475 \+\r
1476 \1lokaln\2a \1o offsecie 2 t\2l\1umaczymy nast\2e\1puj\2a\1co: \,\r
1477 \-\r
1478 \+\r
1479 \r
1480 \-\r
1481 \+\r
1482     *Global(5) -= *Local(2);\r
1483 \-\r
1484 \+\r
1485 \r
1486 \-\r
1487 \+\r
1488 Wykonywanie operacji arytmetycznych na innym \ typie \ ni\2x \ \1integer\r
1489 \-\r
1490 \+\r
1491 wymaga \ zastosowania \  zmiany \ typu \ (cast). \ Nie \ wiem \ \ jak \ \ w\r
1492 \-\r
1493 \+\r
1494 przysz\2l\1o\2s\1ci post\2a\1pi kompilator z typami pierwotnymi \  r\2ox\1nymi \ od\r
1495 \-\r
1496 \+\r
1497 typu integer, niemniej dla typu real mo\2x\1emy \ w \ spos\2o\1b \ naturalny\r
1498 \-\r
1499 \+\r
1500 dokona\2c \1zmiany kwalifikacji. Plik Rsdata.h  zawiera \  odpowiednie\r
1501 \-\r
1502 \+\r
1503 makra \  Fladdress, \ Fllocal \ i \ Flglobal, \ \ kt\2o\1re \ \ automatycznie\r
1504 \-\r
1505 \+\r
1506 dokonuj\2a \1konwersji typu integer na real. Zatem instrukcj\2e\1: \,\r
1507 \-\r
1508 \+\r
1509 \,\r
1510 \-\r
1511 \+\r
1512     x:=x+y\r
1513 \-\r
1514 \+\r
1515 \,\r
1516 \-\r
1517 \+\r
1518 dla zmiennych typu real o \ adresach \ odpowiednio \ (2,3) \ i \ (1,4),\r
1519 \-\r
1520 \+\r
1521 t\2l\1umaczymy nast\2e\1puj\2a\1co: \,\r
1522 \-\/\f\r
1523 \+\r
1524 \r
1525 \-\r
1526 \+\r
1527    *Fladdress(2,3) += *Fladdress(1,4);\r
1528 \-\r
1529 \+\r
1530 \r
1531 \-\r
1532 \+\r
1533 \,\r
1534 \-\f\r
1535 \+\r
1536 \,\r
1537 \-\r
1538 \+\r
1539 Poza \ optymalizacj\2a \ \1adresowania \ \  polegaj\2a\1c\2a \ \ \1na \ \ wywo\2l\1ywaniu\r
1540 \-\r
1541 \+\r
1542 uproszczonych macro (Global i \ Local), \ kompilator \ Loglanu \ mo\2x\1e\r
1543 \-\r
1544 \+\r
1545 stosowa\2c \1zmienne lokalne j\2e\1zyka C. \ Dotyczy \ to \ w \ szczeg\2o\1lno\2s\1ci\r
1546 \-\r
1547 \+\r
1548 zmiennych steruj\2a\1cych p\2e\1tlami, ale tak\2x\1e wielu \ innych \ sytuacji.\r
1549 \-\r
1550 \+\r
1551 (Poniewa\2x \ \1zaproponowana \ tutaj \ wersja \ kompilatora \ nie \ wymaga\r
1552 \-\r
1553 \+\r
1554 generowania \ \ zmiennych \ \ roboczych, \ \ nie \ \ \ widz\2e \ \ \ \1mo\2x\1liwo\2s\1ci\r
1555 \-\r
1556 \+\r
1557 wykorzystania takiej techniki w obliczaniu wyra\2x\1e\2n\1.) \ Przyk\2l\1adowo\r
1558 \-\r
1559 \+\r
1560 w Loglanie p\2e\1tle: \,\r
1561 \-\r
1562 \+\r
1563 \,\r
1564 \-\r
1565 \+\r
1566      k:=0;\r
1567 \-\r
1568 \+\r
1569      \4for \1i:=3 \4to \1n\r
1570 \-\r
1571 \+\r
1572      \4do\r
1573 \-\r
1574 \+\r
1575        if \1(p \4mod \1i)=0 \4then \1k:=1; \4exit fi\1;\r
1576 \-\r
1577 \+\r
1578      \4od\1;\r
1579 \-\r
1580 \+\r
1581 \r
1582 \-\r
1583 \+\r
1584 mo\2x\1emy przet\2l\1umaczy\2c  \1nast\2e\1puj\2a\1co  (wiedz\2a\1c, \2x\1e k \ jest \  zmienn\2a\r
1585 \-\r
1586 \+\r
1587 \1o adresie (3,4), n  jest  zmienn\2a \1o adresie  (0,1)  i wreszcie  p\r
1588 \-\r
1589 \+\r
1590 jest zmienn\2a \1o adresie (1,2)): \,\r
1591 \-\r
1592 \+\r
1593 \r
1594 \-\r
1595 \+\r
1596      *Address(3,4)=0;\r
1597 \-\r
1598 \+\r
1599      { \4int \1i;\r
1600 \-\r
1601 \+\r
1602        \4for \1(i=3; i<= *Global(1); i++)\r
1603 \-\r
1604 \+\r
1605        {\r
1606 \-\r
1607 \+\r
1608          \4if \1( *Address(1,2) % i ==0) { *Address(3,4)=1; \4break\1;};\r
1609 \-\r
1610 \+\r
1611        };\r
1612 \-\r
1613 \+\r
1614      };\r
1615 \-\r
1616 \+\r
1617 \,\r
1618 \-\r
1619 \+\r
1620 co oczywi\2s\1cie da znacznie lepszy kod ko\2n\1cowy, ni\2x \ \1wersja \ "czysto\r
1621 \-\r
1622 \+\r
1623 loglanowa": \,\r
1624 \-\r
1625 \+\r
1626 \r
1627 \-\r
1628 \+\r
1629      *Address(3,4)=0;\r
1630 \-\r
1631 \+\r
1632      *Local(2)=3;       /*  za\2lox\1my, \2x\1e i ma lokalny offset 2 */\r
1633 \-\r
1634 \+\r
1635      \4while\1(1)\r
1636 \-\r
1637 \+\r
1638      {\r
1639 \-\r
1640 \+\r
1641         \4if \1( *Local(2) > *Global(1) ) \4break\1;\r
1642 \-\r
1643 \+\r
1644         \4if \1( *Address(1,2) % *Local(2) ==0)\r
1645 \-\r
1646 \+\r
1647          { *Address(3,4)=1; \4break\1; };\r
1648 \-\r
1649 \+\r
1650         (*Local(2))++;\r
1651 \-\/\f\r
1652 \+\r
1653      };\r
1654 \-\r
1655 \+\r
1656 \r
1657 \-\r
1658 \+\r
1659 \r
1660 \-\f\r
1661 \+\r
1662 \,\r
1663 \-\r
1664 \+\r
1665 Dost\2e\1p \ do \ \ element\2o\1w \ \ tablic \ \ dynamicznych \ \ daje \ \ procedura\r
1666 \-\r
1667 \+\r
1668 Arrayelem(X,i). \ \ Pierwszy \ \ parametr \ \ musi \ \ okre\2s\1la\2c \ \ \1zmienn\2a\r
1669 \-\r
1670 \+\r
1671 \1referencyjn\2a \1wskazuj\2a\1c\2a \1obiekt tablicy natomiast \ drugi \ parametr\r
1672 \-\r
1673 \+\r
1674 musi okre\2s\1la\2c \ \1indeks \ tablicy. \ Przyk\2l\1adowo, \ wczytanie \ tablicy\r
1675 \-\r
1676 \+\r
1677 ca\2l\1kowitej wyznaczonej przez adres (1,2) o zakresie wska\2z\1nika \ od\r
1678 \-\r
1679 \+\r
1680 1 do n, gdzie n ma adres (0,8), mo\2x\1e wygl\2a\1da\2c \1nast\2e\1puj\2a\1co: \,\r
1681 \-\r
1682 \+\r
1683 \,\r
1684 \-\r
1685 \+\r
1686     {\4int \1i;\r
1687 \-\r
1688 \+\r
1689       \4for \1(i=1; i<= *Global(8); i++)\r
1690 \-\r
1691 \+\r
1692        scanf("%d", Arrayelem(*Address(1,2),i));\r
1693 \-\r
1694 \+\r
1695     };\r
1696 \-\r
1697 \+\r
1698 \r
1699 \-\r
1700 \+\r
1701 \r
1702 \-\r
1703 \+\r
1704 Natomiast wypisanie takiej tablicy b\2e\1dzie \ r\2o\1wnie \ proste, \ i \ ma\r
1705 \-\r
1706 \+\r
1707 posta\2c \1nast\2e\1puj\2a\1c\2a\1: \,\r
1708 \-\r
1709 \+\r
1710 \r
1711 \-\r
1712 \+\r
1713     {\4int \1i;\r
1714 \-\r
1715 \+\r
1716       \4for \1(i=1; i<= *Global(8); i++)\r
1717 \-\r
1718 \+\r
1719        printf("%d", *Arrayelem(*Address(1,2),i));\r
1720 \-\r
1721 \+\r
1722     };\r
1723 \-\r
1724 \+\r
1725 \r
1726 \-\r
1727 \+\r
1728 W celu wykonywania adresowania zdalnego nale\2x\1y wywo\2l\1a\2c \ \1procedur\2e\r
1729 \-\r
1730 \+\r
1731 \1RS o nazwie Physical(X). Parametrem tej procedury jest referencja\r
1732 \-\r
1733 \+\r
1734 do \ obiektu. \ Adres \ wzgl\2e\1dny \ w \ obiekcie \ wyznacza \ translator.\r
1735 \-\r
1736 \+\r
1737 Przyk\2l\1adowo rozwa\2x\1my instrukcj\2e \1i:=X.k, gdzie i ma adres (1,1), X\r
1738 \-\r
1739 \+\r
1740 ma adres (2,3) i wreszcie k ma offset 4. Odpowiednia instrukcja w\r
1741 \-\r
1742 \+\r
1743 j\2e\1zyku C powinna mie\2c \1posta\2c\1: \,\r
1744 \-\r
1745 \+\r
1746 \,\r
1747 \-\r
1748 \+\r
1749     *Address(1,1)= *(Physical(Address(2,3)+4);\r
1750 \-\r
1751 \+\r
1752 \r
1753 \-\r
1754 \+\r
1755 RS \ dostarcza \ tak\2x\1e \ wielu \ pomocnych \ \ operacji \ \ na \ \ adresach\r
1756 \-\r
1757 \+\r
1758 wirtualnych. Poza Physical(X) mamy Physimple(X), kt\2o\1ra \ realizuje\r
1759 \-\r
1760 \+\r
1761 wyznaczenie adresu bez sprawdzania zgodno\2s\1ci licznik\2o\1w (mo\2x\1e \ by\2c\r
1762 \-\r
1763 \+\r
1764 \1u\2x\1ywana \ w \ zoptymalizowanych \ wersjach). \ \ Mamy \ \ te\2x \ \ \1operacje\r
1765 \-\r
1766 \+\r
1767 podstawienia referencyjnego Refmove(X<Y) co odpowiada X:=Y. \ Dwie\r
1768 \-\r
1769 \+\r
1770 funkcje \ Member(X) \ i \ Notmember(X) \ daj\2a \ \1odpowiednie \ testy \ na\r
1771 \-\r
1772 \+\r
1773 istnienie \ obiektu. \ Wreszcie \ Equal(X,Y) \ i \ Notequal(X,Y) \ daj\2a\r
1774 \-\r
1775 \+\r
1776 \1por\2o\1wnania \ zmiennych \ referencyjnych, \ co \ odpowiada \ warto\2s\1ciom\r
1777 \-\/\f\r
1778 \+\r
1779 wyra\2x\1e\2n  \1X=Y i \ X=/=Y. \  Instrukcj\2e \ \1X:=\4none \ \1realizuje \ none(X).\r
1780 \-\r
1781 \+\r
1782 Ponadto wszystkie zmienne referencyjne (nie  dotyczy \ to \ adres\2o\1w\r
1783 \-\r
1784 \+\r
1785 po\2s\1rednich) s\2a \1inicjalizowane na \4none\1. Inne zmienne maj\2a \ \1warto\2sc\r
1786 \-\r
1787 \+\r
1788 \1pocz\2a\1tkowa nieokre\2s\1lona. \,\r
1789 \-\f\r
1790 \+\r
1791 \r
1792 \-\r
1793 \+\r
1794 6. Operacje  otwierania obiekt\2o\1w\r
1795 \-\r
1796 \+\r
1797 \r
1798 \-\r
1799 \+\r
1800 Mamy cztery operacje otwierania obiekt\2o\1w: Openrc, Slopen, Dopen \ i\r
1801 \-\r
1802 \+\r
1803 Open array. Ich nag\2lo\1wki s\2a \1nast\2e\1puj\2a\1ce: \,\r
1804 \-\r
1805 \+\r
1806 \r
1807 \-\r
1808 \+\r
1809    Openrc (\3a\1,X)\r
1810 \-\r
1811 \+\r
1812     \4int \3a\1;\r
1813 \-\r
1814 \+\r
1815    \4unsigned int \1*X;\r
1816 \-\r
1817 \+\r
1818 \r
1819 \-\r
1820 \+\r
1821 \r
1822 \-\r
1823 \+\r
1824    Slopen (\3a\1,X,Y)\r
1825 \-\r
1826 \+\r
1827    \4unsigned int \1*X,*Y;\r
1828 \-\r
1829 \+\r
1830     \4int \3a\1;\r
1831 \-\r
1832 \+\r
1833 \r
1834 \-\r
1835 \+\r
1836 \r
1837 \-\r
1838 \+\r
1839    Dopen(\3a\1,\3b\1,X)\r
1840 \-\r
1841 \+\r
1842     \4int \3a\1,\3b\1;\r
1843 \-\r
1844 \+\r
1845    \4unsigned int \1*X;\r
1846 \-\r
1847 \+\r
1848 \r
1849 \-\r
1850 \+\r
1851 \r
1852 \-\r
1853 \+\r
1854    Openarray (\3a\1,\3l\1,\3u\1,X)\r
1855 \-\r
1856 \+\r
1857    \4int \3l\1,\3u\1;\r
1858 \-\r
1859 \+\r
1860     \4int \3a\1;\r
1861 \-\r
1862 \+\r
1863    \4unsigned int \1*X;\r
1864 \-\r
1865 \+\r
1866 \r
1867 \-\r
1868 \+\r
1869 \r
1870 \-\r
1871 \+\r
1872 Procedura Openrc otwiera obiekt klasy, \ kt\2o\1ra \ nie \ ma \ kodu \ ani\r
1873 \-\r
1874 \+\r
1875 modu\2lo\1w wewn\2e\1trznych. Slopen otwiera \  obiekt \  ze \ znanym \ ojcem\r
1876 \-\r
1877 \+\r
1878 syntaktycznym \ (dost\2e\1p \ zdalny \ do \ procedury). \ Procedura \ Dopen\r
1879 \-\r
1880 \+\r
1881 otwiera obiekt modu\2l\1u widocznego i wreszcie \ procedura \ Openarray\r
1882 \-\r
1883 \+\r
1884 otwiera \ obiekt \ tablicy. \ Parametr \ X \ jest \ \ adresem \ \ zmiennej\r
1885 \-\r
1886 \+\r
1887 referencyjnej, kt\2o\1ra po wykonaniu odpowiedniej \ procedury \ b\2e\1dzie\r
1888 \-\r
1889 \+\r
1890 wskazywa\2c \1na otwarty \ obiekt. \ Parametr \ \3a \  \1wskazuje \ zawsze \ na\r
1891 \-\r
1892 \+\r
1893 indeks prototypu otwieranego obiektu w tablicy PROT. \,\r
1894 \-\r
1895 \+\r
1896 \,\r
1897 \-\r
1898 \+\r
1899 W procedurze Slopen parametr Y wskazuje na obiekt, kt\2o\1ry \ ma \ by\2c\r
1900 \-\r
1901 \+\r
1902 \1ojcem syntaktycznym otwieranego obiektu. \ W \ procedurze \ Dopen \ \3b\r
1903 \-\r
1904 \+\r
1905 \1jest \ numerem \ prototypu \ w \ kt\2o\1rym \ jest \  zadeklarowany \ \ modu\2l\r
1906 \-\/\f\r
1907 \+\r
1908 \1otwierany. W procedurze Openarray  parametry \3l\1, \3u \1okre\2s\1laj\2a \1dolny\r
1909 \-\r
1910 \+\r
1911 i g\2o\1rny wska\2z\1nik indeksu. \,\r
1912 \-\r
1913 \+\r
1914 \,\r
1915 \-\f\r
1916 \+\r
1917 \,\r
1918 \-\r
1919 \+\r
1920 7. Operacje przekazywania sterowania\r
1921 \-\r
1922 \+\r
1923 \,\r
1924 \-\r
1925 \+\r
1926 Wywo\2l\1anie modu\2l\1u loglanowego mo\2x\1e odbywa\2c \ \1si\2e \ \1tylko \ za \ pomoc\2a\r
1927 \-\r
1928 \+\r
1929 \1wywo\2l\1ania odpowiedniego modu\2l\1u w C. Takie wywo\2l\1ania odk\2l\1adane \ na\r
1930 \-\r
1931 \+\r
1932 stos \ powodowa\2l\1yby \ szybkie \ jego \ przepe\2l\1nienie. \ \ Aby \ \ unikn\2ac\r
1933 \-\r
1934 \+\r
1935 \1odk\2l\1adania kopii modu\2lo\1w j\2e\1zyka C na stos mo\2x\1na za \ ka\2x\1dym \ razem\r
1936 \-\r
1937 \+\r
1938 przekazywania sterowania pomi\2e\1dzy \ modu\2l\1ami \ wraca\2c \ \1do \ programu\r
1939 \-\r
1940 \+\r
1941 g\2lo\1wnego main(), czyszcz\2a\1c w ten spos\2o\1b stos. \ Ka\2x\1da \ z \ procedur\r
1942 \-\r
1943 \+\r
1944 przekazywania sterowania pomi\2e\1dzy modu\2l\1ami wyznacza \ tylko \ numer\r
1945 \-\r
1946 \+\r
1947 kolejnego \ modu\2l\1u, \ kt\2o\1ry \ nale\2x\1y \ wywo\2l\1a\2c\1. \ Taki \ numer \ \ modu\2l\1u\r
1948 \-\r
1949 \+\r
1950 b\2e\1dziemy trzyma\2c \1na zmiennej globalnej \3modulenumber\1. W \ programie\r
1951 \-\r
1952 \+\r
1953 main() nale\2x\1y tylko wywo\2l\1a\2c \1odpowiedni modu\2l \1za pomoc\2a \1instrukcji\r
1954 \-\r
1955 \+\r
1956 module[\3modulenumber\1]().\,\r
1957 \-\r
1958 \+\r
1959 \,\r
1960 \-\r
1961 \+\r
1962 \,\r
1963 \-\r
1964 \+\r
1965 \,\r
1966 \-\r
1967 \+\r
1968 Aby powr\2o\1t do programu main() czy\2s\1ci\2l \1stos, \ kt\2o\1ry \ mo\2x\1e \ zawiera\2c\r
1969 \-\r
1970 \+\r
1971 \1poza kolejnym wykonywanym modu\2l\1em wywo\2l\1ania \ r\2ox\1nych \ pomocniczych\r
1972 \-\r
1973 \+\r
1974 procedur, nale\2x\1y skorzysta\2c \1z procedur standardowych \ setjmp \ oraz\r
1975 \-\r
1976 \+\r
1977 longjmp dostarczanych przez system C. Ustawiaj\2a\1c setjmp(buffer) \ w\r
1978 \-\r
1979 \+\r
1980 programie \ g\2lo\1wnym, \ ka\2x\1de \ zako\2n\1czenie \ przekazywania \ sterowania\r
1981 \-\r
1982 \+\r
1983 pomi\2e\1dzy modu\2l\1ami ko\2n\1czy wykonanie longjmp(buffer,-1). \ Sterowanie\r
1984 \-\r
1985 \+\r
1986 wraca do setjmp(buffer) czyszcz\2a\1c \ stos. \ Zako\2n\1czenie \ wykonywania\r
1987 \-\r
1988 \+\r
1989 programu \ mo\2x\1na \ zrealizowa\2c \ \1wywo\2l\1aniem \ \ longjmp(buffer,-2). \ \ W\r
1990 \-\r
1991 \+\r
1992 zale\2x\1no\2s\1ci \ od \ warto\2s\1ci \ setjmp(buffer) \ otrzymanej \ w \ programie\r
1993 \-\r
1994 \+\r
1995 main() mo\2x\1emy albo przekaza\2c \1sterowanie do kolejnego modu\2l\1u, \ albo\r
1996 \-\r
1997 \+\r
1998 zako\2n\1czy\2c \1wykonywanie programu. Przy \ takich \ za\2l\1o\2x\1eniach \ program\r
1999 \-\r
2000 \+\r
2001 g\2lo\1wny ma nast\2e\1puj\2a\1c\2a \1posta\2c\1:\,\r
2002 \-\r
2003 \+\r
2004 \,\r
2005 \-\f\r
2006 \+\r
2007 \,\r
2008 \-\r
2009 \+\r
2010 \,\r
2011 \-\r
2012 \+\r
2013 main ()\r
2014 \-\r
2015 \+\r
2016 {\r
2017 \-\r
2018 \+\r
2019   module[0]=A1;\r
2020 \-\r
2021 \+\r
2022     ...\r
2023 \-\r
2024 \+\r
2025   module[k]=Ak;\r
2026 \-\r
2027 \+\r
2028   Init();\r
2029 \-\r
2030 \+\r
2031   IC=1;\r
2032 \-\r
2033 \+\r
2034   \3modulenumber\1=0;\,\r
2035 \-\r
2036 \+\r
2037   \4if \1(setjmp(buffer)!=-2) module[\3modulenumber\1]();\,\r
2038 \-\r
2039 \+\r
2040 }\r
2041 \-\r
2042 \+\r
2043 \,\r
2044 \-\r
2045 \+\r
2046 W RS mamy \ pi\2ec \ \1operacji \ zwi\2a\1zanych \ z \ prostym \ przekazywaniem\r
2047 \-\r
2048 \+\r
2049 sterowania: \ Go, \ Back, \ Endclass, \ Inn \ oraz \ Endrun. \ Oto \ \ ich\r
2050 \-\r
2051 \+\r
2052 nag\2lo\1wki: \,\r
2053 \-\r
2054 \+\r
2055 \,\r
2056 \-\r
2057 \+\r
2058    Go (X)\r
2059 \-\r
2060 \+\r
2061    \4unsigned int \1*X;\r
2062 \-\r
2063 \+\r
2064 \r
2065 \-\r
2066 \+\r
2067    Back ()\r
2068 \-\r
2069 \+\r
2070 \,\r
2071 \-\r
2072 \+\r
2073    Endclass()\,\r
2074 \-\r
2075 \+\r
2076 \r
2077 \-\r
2078 \+\r
2079    Inn(k)\r
2080 \-\r
2081 \+\r
2082    \4int \1k;\r
2083 \-\r
2084 \+\r
2085 \,\r
2086 \-\r
2087 \+\r
2088    Endrun ()\r
2089 \-\r
2090 \+\r
2091 \,\r
2092 \-\r
2093 \+\r
2094 Procedura \ Go(X) \ przekazuje \ sterowania \ do \ obiektu \ X. \ \ Typowa\r
2095 \-\r
2096 \+\r
2097 kolejno\2sc \ \ \1operacji \ \ przy \ \ przekazywaniu \ \ \  sterowania \ \ \ jest\r
2098 \-\r
2099 \+\r
2100 nast\2e\1puj\2a\1ca: \,\r
2101 \-\r
2102 \+\r
2103 \r
2104 \-\r
2105 \+\r
2106    Dopen(a,b,X);\r
2107 \-\r
2108 \+\r
2109    /* przekazanie parametr\2o\1w  do X */\r
2110 \-\r
2111 \+\r
2112    IC=m;  Go(X);\r
2113 \-\r
2114 \+\r
2115 Lm:/* po powrocie z X */\r
2116 \-\r
2117 \+\r
2118 \r
2119 \-\f\r
2120 \+\r
2121 \,\r
2122 \-\r
2123 \+\r
2124 Procedura Back() zwraca sterowanie po Dl. Nie \ ma \ parametr\2o\1w. \ W\r
2125 \-\r
2126 \+\r
2127 przypadku wsp\2ol\1program\2o\1w \ musi \ by\2c \ \1po \ niej \ wej\2s\1cie \ opatrzone\r
2128 \-\r
2129 \+\r
2130 etykiet\2a\1: \,\r
2131 \-\r
2132 \+\r
2133 \,\r
2134 \-\r
2135 \+\r
2136    IC=m; Back();\r
2137 \-\r
2138 \+\r
2139 Lm:/* ponowna reaktywacja modu\2l\1u */\r
2140 \-\r
2141 \+\r
2142 \,\r
2143 \-\r
2144 \+\r
2145 Procedura \ Endclass() \ realizuje \ operacj\2e \ \ \1zako\2n\1czenia \ \ klasy.\r
2146 \-\r
2147 \+\r
2148 Wywo\2l\1ujemy j\2a \1w miejscu wyst\2a\1pienia ko\2n\1ca klasy (\4return \1w \ klasie\r
2149 \-\r
2150 \+\r
2151 t\2l\1umaczone \ jest \ zawsze \ na \ Back \ ). \ Procedura \ \ ta \ \ sprawdza\r
2152 \-\r
2153 \+\r
2154 dynamicznie w jakiego typu obiekcie jest sterowanie. Je\2x\1eli \ jest\r
2155 \-\r
2156 \+\r
2157 to obiekt wsp\2ol\1programu, wywo\2l\1ywana \ jest \ operacja \ Endcor(). \ W\r
2158 \-\r
2159 \+\r
2160 przeciwnym przypadku \ wywo\2l\1ywana \ jest \ zwyk\2l\1a \ operacja \ Back().\r
2161 \-\r
2162 \+\r
2163 Zako\2n\1czenie \ nieprefiksowanego \ podprogramu \ \ lub \ \ bloku \ \ mo\2x\1na\r
2164 \-\r
2165 \+\r
2166 zrealizowa\2c \1za pomoc\2a \1procedury \ Back(), \ natomiast \ w \ przypadku\r
2167 \-\r
2168 \+\r
2169 klasy \ niemo\2x\1liwe \ jest \ statyczne \ sprawdzenie \ czy \ b\2e\1dzie \ \ to\r
2170 \-\r
2171 \+\r
2172 instrukcja ko\2n\1cz\2a\1ca wsp\2ol\1program, czy te\2x \1nie. \,\r
2173 \-\r
2174 \+\r
2175 \r
2176 \-\r
2177 \+\r
2178 Procedura Inn(k) przekazuje sterowanie \ przez \ \4inner\1. \ Warto\2sc \ \1k\r
2179 \-\r
2180 \+\r
2181 okre\2s\1la d\2l\1ugo\2sc l\1a\2n\1cucha prefiksowego danego \ modu\2l\1u. \ Instrukcja\r
2182 \-\r
2183 \+\r
2184 po Inn(k) musi by\2c \1tak\2x\1e w stosowny \ spos\2o\1b \ opatrzona \ etykiet\2a\1.\r
2185 \-\r
2186 \+\r
2187 Powr\2o\1t za \4inner \1wykonuje si\2e \1bezpo\2s\1rednio, bez \ uczestnictwa \ RS.\r
2188 \-\r
2189 \+\r
2190 Na przyk\2l\1ad, maj\2a\1c \ modu\2l\1y \ A \ i \ B \ (B \ prefiksowany \ przez \ A),\r
2191 \-\r
2192 \+\r
2193 operacja  \4inner \1w A oraz powr\2o\1t w B powinny wygl\2a\1da\2c \1nast\2e\1puj\2a\1co: \,\r
2194 \-\r
2195 \+\r
2196 \,\r
2197 \-\r
2198 \+\r
2199   A()\r
2200 \-\r
2201 \+\r
2202   {\r
2203 \-\r
2204 \+\r
2205     ...\r
2206 \-\r
2207 \+\r
2208     Inn(1);\,\r
2209 \-\r
2210 \+\r
2211 Lm:  ...\r
2212 \-\r
2213 \+\r
2214   };\r
2215 \-\r
2216 \+\r
2217 \,\r
2218 \-\r
2219 \+\r
2220   B()\r
2221 \-\r
2222 \+\r
2223   {\r
2224 \-\r
2225 \+\r
2226     ...\r
2227 \-\r
2228 \+\r
2229     IC=m; \,\r
2230 \-\r
2231 \+\r
2232     \3modulenumber\1=n; /* gdzie n jest numerem modu\2l\1u A */\,\r
2233 \-\r
2234 \+\r
2235     longjmp(buffer,-1); /* skok do programu g\2lo\1wnego */\,\r
2236 \-\/\f\r
2237 \+\r
2238 \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ /* gdzie wywo\2l\1any zostanie modu\2l \1A */\,\r
2239 \-\r
2240 \+\r
2241   };\r
2242 \-\r
2243 \+\r
2244 \r
2245 \-\r
2246 \+\r
2247 Procedura Endrun ko\2n\1czy wykonanie programu.\r
2248 \-\f\r
2249 \+\r
2250 \,\r
2251 \-\r
2252 \+\r
2253 8. Operacje usuwania obiekt\2o\1w\r
2254 \-\r
2255 \+\r
2256 \r
2257 \-\r
2258 \+\r
2259 Mamy \  dwie \  procedury \ do \ usuwania \ obiekt\2o\1w \ : \ Killafter() \ i\r
2260 \-\r
2261 \+\r
2262 Gkill(X). Pierwsza z nich wywo\2l\1ywana jest po powrocie z procedury,\r
2263 \-\r
2264 \+\r
2265 funkcji lub \ bloku \ loglanowego. \ Jej \ zadaniem \ jest \ czyszczenie\r
2266 \-\r
2267 \+\r
2268 \2l\1a\2n\1cucha Sl (patrz \ punkt \ 3). \ Zatem \ typowa \ kolejno\2sc \ \1operacji\r
2269 \-\r
2270 \+\r
2271 wywo\2l\1ania takiego modu\2l\1u loglanowego b\2e\1dzie nast\2e\1puj\2a\1ca :\,\r
2272 \-\r
2273 \+\r
2274 \,\r
2275 \-\r
2276 \+\r
2277         Dopen(a,b,X);\r
2278 \-\r
2279 \+\r
2280         /* przekazanie parametr\2o\1w wej\2s\1ciowych */\r
2281 \-\r
2282 \+\r
2283         IC=m;  Go(X);\r
2284 \-\r
2285 \+\r
2286 Lm:     /* przekazanie parametr\2o\1w wyj\2s\1ciowych */\r
2287 \-\r
2288 \+\r
2289         Killafter();\r
2290 \-\r
2291 \+\r
2292 \r
2293 \-\r
2294 \+\r
2295 Jakkolwiek nowy RS jest wyposa\2x\1ony w \ automatyczny \ od\2s\1miecacz \ i\r
2296 \-\r
2297 \+\r
2298 zb\2e\1dne obiekty funkcji, procedur i blok\2o\1w \ i \ tak \ b\2e\1da \ usuwane,\r
2299 \-\r
2300 \+\r
2301 jednak\2x\1e wywo\2l\1anie Killafter() w przypadku \ ka\2x\1dego \ modu\2l\1u \ typu\r
2302 \-\r
2303 \+\r
2304 procedura, funkcja lub blok usprawni dzia\2l\1anie pami\2e\1ci \ RS, \ gdy\2x\r
2305 \-\r
2306 \+\r
2307 \1najcz\2es\1ciej jest to ostatni obiekt w pami\2e\1ci, \ kt\2o\1rego \ usuni\2e\1cie\r
2308 \-\r
2309 \+\r
2310 odbywa si\2e \1jak na stosie. \,\r
2311 \-\r
2312 \+\r
2313 \,\r
2314 \-\r
2315 \+\r
2316 Operacja Gkill(X) jest star\2a \1operacj\2a \1z modyfikacjami opisanymi \ w\r
2317 \-\r
2318 \+\r
2319 punkcie 3. Parametrem tej operacji jest adres usuwanego obiektu. \,\r
2320 \-\r
2321 \+\r
2322 \r
2323 \-\r
2324 \+\r
2325 \r
2326 \-\f\r
2327 \+\r
2328 \,\r
2329 \-\r
2330 \+\r
2331 9. Operacje na wsp\2ol\1programach\r
2332 \-\r
2333 \+\r
2334 \r
2335 \-\r
2336 \+\r
2337 \r
2338 \-\r
2339 \+\r
2340 RS dostarcza trzech procedur operuj\2a\1cych na wsp\2ol\1programach. S\2a \1to\r
2341 \-\r
2342 \+\r
2343 operacje \ Endcor(), \ Attach(X) \ \ oraz \ \ Attachwith(X,\3signalnum\1,Y).\r
2344 \-\r
2345 \+\r
2346 Operacja Endcor jest wywo\2l\1ywana na zako\2n\1czenie wsp\2ol\1programu. \ Jej\r
2347 \-\r
2348 \+\r
2349 dzia\2l\1anie zosta\2l\1o om\2o\1wione przy okazji \ opisywania \ struktury \ Dl.\r
2350 \-\r
2351 \+\r
2352 Operacja \ Attach(X) \ \ przekazuje \ \ sterowanie \ \ do \ \ wsp\2ol\1programu\r
2353 \-\r
2354 \+\r
2355 wyznaczonego przez parametr X. \,\r
2356 \-\r
2357 \+\r
2358 \,\r
2359 \-\r
2360 \+\r
2361 Wi\2e\1kszego om\2o\1wienia \ wymaga \ natomiast \ operacja \ Attachwith. \ Jej\r
2362 \-\r
2363 \+\r
2364 pierwszym parametrem jest referencja do wsp\2ol\1programu gdzie ma by\2c\r
2365 \-\r
2366 \+\r
2367 \1wywo\2l\1any alarm. Drugi parametr to numer \ sygna\2l\1u. \ Wreszcie \ trzeci\r
2368 \-\r
2369 \+\r
2370 parametr jest referencj\2a \1do obiektu utworzonego \ handlera \ (o \ ile\r
2371 \-\r
2372 \+\r
2373 taki zostanie znaleziony). Po wywo\2l\1aniu mo\2x\1na b\2e\1dzie przekaza\2c \ \1do\r
2374 \-\r
2375 \+\r
2376 handlera parametry wej\2s\1ciowe i dopiero wtedy przekaza\2c \ \1sterowanie\r
2377 \-\r
2378 \+\r
2379 do wsp\2ol\1programu X za \ pomoc\2a \ \1zwyk\2l\1ego \ Attach. \ Ciag \ instrukcji\r
2380 \-\r
2381 \+\r
2382 realizuj\2a\1cych \ wywo\2l\1anie \ sygna\2l\1u \ w \ innym \ wsp\2ol\1programie \ \ mo\2x\1e\r
2383 \-\r
2384 \+\r
2385 wygl\2a\1da\2c \1na przyk\2l\1ad tak: \,\r
2386 \-\r
2387 \+\r
2388 \,\r
2389 \-\r
2390 \+\r
2391      Attachwith(X,s,Y);\r
2392 \-\r
2393 \+\r
2394      /* przekazujemy do Y parametry wej\2s\1ciowe */\r
2395 \-\r
2396 \+\r
2397      IC=m;  Attach(X);\r
2398 \-\r
2399 \+\r
2400 Lm:  /* dalsze instrukcje w module */\r
2401 \-\r
2402 \+\r
2403 \r
2404 \-\r
2405 \+\r
2406 \r
2407 \-\f\r
2408 \+\r
2409 \r
2410 \-\r
2411 \+\r
2412 10. Wyj\2a\1tki\r
2413 \-\r
2414 \+\r
2415 \r
2416 \-\r
2417 \+\r
2418 Z \ wyj\2a\1tkami \ \ zwi\2a\1zane \ \ s\2a \ \ \1operacje \ \ Raising(\3signalnum\1,X) \ \ i\r
2419 \-\r
2420 \+\r
2421 Termination() oraz etykiety \3lastwill\1. \,\r
2422 \-\r
2423 \+\r
2424 \r
2425 \-\r
2426 \+\r
2427 Operacja Raising(\3signalnum\1,X) powoduje \ poszukiwanie \ w \ aktywnym\r
2428 \-\r
2429 \+\r
2430 \2l\1a\2n\1cuchu Dl handlera dla sygna\2l\1u o numerze \3signalnum\1. Je\2x\1eli taki\r
2431 \-\r
2432 \+\r
2433 handler \ zostanie \ znaleziony, \ otwarty \ zostanie \ jego \ \ obiekt,\r
2434 \-\r
2435 \+\r
2436 kt\2o\1rego referencja przekazana zostanie \ na \ parametr \ X. \ Po \ tej\r
2437 \-\r
2438 \+\r
2439 instrukcji \ mo\2x\1na \ przekaza\2c \ \1do \ \ obiektu \ \ handlera \ \ parametry\r
2440 \-\r
2441 \+\r
2442 wej\2s\1ciowe i wreszcie przekaza\2c \ \1sterowanie \ do \ handlera \ zwyk\2l\1ym\r
2443 \-\r
2444 \+\r
2445 Go(X). Czyli odpowiedni ci\2a\1g instrukcji jest \ taki \ sam \ jak \ dla\r
2446 \-\r
2447 \+\r
2448 wywo\2l\1ania procedury. \ Zamiast \ operacji \ Dopen \ czy \ Slopen \ mamy\r
2449 \-\r
2450 \+\r
2451 operacj\2e \1Raising. Oczywi\2s\1cie po powrocie obiekt \ handlera \ chcemy\r
2452 \-\r
2453 \+\r
2454 usun\2ac\1, musi zatem wyst\2a\1pi\2c \1Killafter(). \,\r
2455 \-\r
2456 \+\r
2457 \,\r
2458 \-\r
2459 \+\r
2460 \,\r
2461 \-\r
2462 \+\r
2463 Je\2x\1eli w handlerze wyst\2e\1puje \ na \ zako\2n\1czenie \ instrukcja \ \4return\1,\r
2464 \-\r
2465 \+\r
2466 wykonuje \ si\2e \ \1zwyk\2l\1e \ Back() \ z \ jego \ konsekwencjami. \ Mamy \ \ do\r
2467 \-\r
2468 \+\r
2469 czynienia ze zwyk\2l\1a procedur\2a \1tylko wo\2l\1an\2a \1dynamicznie. Je\2x\1eli \ na\r
2470 \-\r
2471 \+\r
2472 zako\2n\1czenie \ handlera \ wyst\2e\1puje \ terminate, \ wywo\2l\1ujemy \ operacj\2e\r
2473 \-\r
2474 \+\r
2475 \1Termination(). Jak teraz powinny wygl\2a\1da\2c \ \1odpowiednie \ instrukcj\2e\r
2476 \-\r
2477 \+\r
2478 \1lastwill. Ot\2ox \1Termination ustawia w ka\2x\1dym obiekcie \ \2l\1a\2n\1cucha \ Dl\r
2479 \-\r
2480 \+\r
2481 (od  obiektu gdzie wywo\2l\1ano \ alarm \ do \ obiektu \ gdzie \ znaleziono\r
2482 \-\r
2483 \+\r
2484 handler) lokalne sterowanie \ na \ etykiet\2e \ \3lastwill\1. \ Nast\2e\1pnie \ w\r
2485 \-\r
2486 \+\r
2487 handlerze nale\2x\1y wykona\2c \1zwyk\2l\1e \ Back() \ - \ powr\2o\1t \ po \ Dl \ linku.\r
2488 \-\r
2489 \+\r
2490 Pierwsza \  instrukcja \ lastwill \ \ powinna \ \ by\2c \ \ \1zatem \ \ operacj\2a\r
2491 \-\r
2492 \+\r
2493 \1Killafter(). Czyli w handlerze terminate t\2l\1umaczymy na: \,\r
2494 \-\r
2495 \+\r
2496 \,\r
2497 \-\r
2498 \+\r
2499           Termination();\r
2500 \-\r
2501 \+\r
2502           Back();\r
2503 \-\r
2504 \+\r
2505 \r
2506 \-\r
2507 \+\r
2508 natomiast  ci\2a\1g instrukcji lastwill powinien wygl\2a\1da\2c \1nast\2e\1puj\2a\1co:\r
2509 \-\r
2510 \+\r
2511 \,\r
2512 \-\r
2513 \+\r
2514 Lk:  Killafter();         /* Lk etykieta dla IC=k dla lastwill */\r
2515 \-\r
2516 \+\r
2517      ....                 /* instrukcje lastwill */\r
2518 \-\r
2519 \+\r
2520      Back();              /* lub IC=...; \3modulenumber\1= ...;\,\r
2521 \-\r
2522 \+\r
2523                              longjmp(buffer,-1); \,\r
2524 \-\/\f\r
2525 \+\r
2526                              w przypadku modu\2l\1u prefiksowanego  */\r
2527 \-\r
2528 \+\r
2529 \r
2530 \-\r
2531 \+\r
2532 \r
2533 \-\f\r
2534 \+\r
2535 \,\r
2536 \-\r
2537 \+\r
2538 11. Za\2la\1czone przyk\2l\1ady\r
2539 \-\r
2540 \+\r
2541 \r
2542 \-\r
2543 \+\r
2544 System RS testowa\2l\1em na przyk\2l\1adach napisanych r\2e\1cznie. \ Stara\2l\1em\r
2545 \-\r
2546 \+\r
2547 si\2e \ \1przetestowa\2c \ \1wszystkie \ wa\2x\1ne \ konstrukcje \ \ RS, \ \ a \ \ wi\2e\1c\r
2548 \-\r
2549 \+\r
2550 otwieranie \ obiekt\2o\1w, \ przekazywanie \ sterowania, \ wsp\2ol\1programy,\r
2551 \-\r
2552 \+\r
2553 wyj\2a\1tki, \ tablice \ dynamiczne, \ no \ i \ oczywi\2s\1cie \ od\2s\1miecacz \ \ z\r
2554 \-\r
2555 \+\r
2556 kompaktyfikatorem. Nie \ mog\2l\1em \ przetestowa\2c \ \1tego \ systemu \ zbyt\r
2557 \-\r
2558 \+\r
2559 szczeg\2ol\1owo, gdy\2x \ \1zawiera \ on \ za \ wiele \ elemnt\2o\1w \ trudnych \ do\r
2560 \-\r
2561 \+\r
2562 wychwycenia w r\2e\1cznym tworzeniu kodu. \ Nie \ przetestowa\2l\1em \ wielu\r
2563 \-\r
2564 \+\r
2565 fragment\2o\1w \ zwi\2a\1zanych \ z \ definicj\2a \ \ \1struktur \ \ referencyjnych.\r
2566 \-\r
2567 \+\r
2568 Oczywi\2s\1cie, wydaje \ mi \ si\2e\1, \ \2x\1e \ przetestowanie \ ca\2l\1o\2s\1ci \ nale\2x\1y\r
2569 \-\r
2570 \+\r
2571 od\2l\1o\2x\1y\2c \1do czasu powstania kompilatora. \,\r
2572 \-\r
2573 \+\r
2574 \,\r
2575 \-\r
2576 \+\r
2577 \,\r
2578 \-\r
2579 \+\r
2580 Przyk\2l\1ad perm.c odpowiada znanej nam procedurze \ rekurencyjnej \ na\r
2581 \-\r
2582 \+\r
2583 generowanie wszystkich permutacji. Przyk\2l\1ad ten testuje \ dzia\2l\1anie\r
2584 \-\r
2585 \+\r
2586 otwierania \ obiektu \ widocznego, \ tablice, \ rekursj\2e\1, \ adresowanie\r
2587 \-\r
2588 \+\r
2589 nielokalne i u\2x\1ycie zmiennych sterowania p\2e\1tla. \,\r
2590 \-\r
2591 \+\r
2592 \r
2593 \-\r
2594 \+\r
2595 Przyk\2l\1ad  merge.c   jest stosunkowo du\2x\1ym programem do testowania\r
2596 \-\r
2597 \+\r
2598 operacji na wsp\2ol\1programach. Jest to znany \ program \ na \ scalanie\r
2599 \-\r
2600 \+\r
2601 drzew binarnych poszukiwa\2n\1. \ Program \ testuje \ tak\2x\1e \ wywo\2l\1ywanie\r
2602 \-\r
2603 \+\r
2604 zdalne procedur, przekazywanie parametr\2o\1w referencyjnych, tablice\r
2605 \-\r
2606 \+\r
2607 wsp\2ol\1program\2o\1w, operacje Attach, itp. Napisa\2l\1em przy okazji \ trzy\r
2608 \-\r
2609 \+\r
2610 warianty tego przyk\2l\1adu pozwalaj\2a\1ce \ testowa\2c \ \1inne \ operacje \ na\r
2611 \-\r
2612 \+\r
2613 wsp\2ol\1programach. Ot\2ox \1mergecor.c jest tym samym algorytmem, z tym\r
2614 \-\r
2615 \+\r
2616 \2x\1e \ zako\2n\1czenie \ sygnalizuje \  operacja \ Attachwith \ do \ drugiego\r
2617 \-\r
2618 \+\r
2619 wsp\2ol\1programu. Przyk\2l\1ad testcor.c testuje poprawno\2sc \ \1reakcji \ na\r
2620 \-\r
2621 \+\r
2622 pr\2o\1b\2e \1reaktywacji wsp\2ol\1programu zako\2n\1czonego. Wreszcie \  kmerge.c\r
2623 \-\r
2624 \+\r
2625 jest wariantem tego przyk\2l\1adu gdzie usuwane s\2a \ \1za \ pomoc\2a \ \1Gkill\r
2626 \-\r
2627 \+\r
2628 zb\2e\1dne obiekty. Przyk\2l\1ad ten \ s\2l\1u\2x\1y\2l \ \1przetestowaniu \ poprawno\2s\1ci\r
2629 \-\r
2630 \+\r
2631 dzia\2l\1ania \ \ w\2l\1a\2s\1nie \ \  operacji \ \ Gkill, \ \ tak\2x\1e \ \ w \ \ \ przypadku\r
2632 \-\r
2633 \+\r
2634 wsp\2ol\1program\2o\1w (a to jest przypadek trudniejszy). \,\r
2635 \-\r
2636 \+\r
2637 \,\r
2638 \-\f\r
2639 \+\r
2640 \,\r
2641 \-\r
2642 \+\r
2643 Program  memor.c by\2l \1dla mnie najtrudniejszy w uruchamianiu. Jest\r
2644 \-\r
2645 \+\r
2646 to kr\2o\1tki program  na  testowanie od\2s\1miecacza i kompaktyfikatora.\r
2647 \-\r
2648 \+\r
2649 Poniewa\2x \1kompaktyfikator musia\2l \ \1by\2c \ \1nieznacznie \ rozszerzony \ z\r
2650 \-\r
2651 \+\r
2652 uwagi na nowa koncepcje Statsl, wprowadzi\2l\1em \ dodatkowy \ przebieg\r
2653 \-\r
2654 \+\r
2655 poprawiaj\2a\1cy to pole dla obiekt\2o\1w, kt\2o\1re po od\2s\1mieceniu pozostan\2a\r
2656 \-\r
2657 \+\r
2658 x\1ywe. Testowa\2l\1em kompaktyfikator dla r\2ox\1nych \ parametr\2o\1w \  w \ tym\r
2659 \-\r
2660 \+\r
2661 przyk\2l\1adzie (n=liczba obiekt\2o\1w wygenerowanych, \ k= \ cz\2e\1stotliwo\2sc\r
2662 \-\r
2663 \+\r
2664 \1usuwania poprzednik\2o\1w). Poniewa\2x \1j\2e\1zyk C \ umo\2x\1liwia \ profilowanie\r
2665 \-\r
2666 \+\r
2667 programu, by\2l\1em \ w \ stanie \ oszacowa\2c \ \1koszt \ wzgl\2e\1dny \ dzia\2l\1ania\r
2668 \-\r
2669 \+\r
2670 kompaktyfikatora. Ot\2ox \1kompaktyfikator  zabiera\2l \1nie wi\2e\1cej ni\2x \16\r
2671 \-\r
2672 \+\r
2673 procent  czasu dzia\2l\1ania programu , kt\2o\1ry sam nic \ w\2l\1a\2s\1ciwie \ nie\r
2674 \-\r
2675 \+\r
2676 robi. \ Du\2x\1a \ cz\2esc \ \1czasu \ (ponad \ 4 \ procent) \ \ zajmuje \ \ jednak\r
2677 \-\r
2678 \+\r
2679 inicjalizowanie zmiennych referencyjnych. \ Wydaje \ si\2e\1, \ \2x\1e \ taka\r
2680 \-\r
2681 \+\r
2682 inicjalizacja mog\2l\1aby by\2c \ \1czasem \ pomijana \ (programista \ bardzo\r
2683 \-\r
2684 \+\r
2685 rzadko zapomina o podstawieniu \ na \ zmienn\2a \ \1referencyjn\2a\1). \ Przy\r
2686 \-\r
2687 \+\r
2688 okazji tego \ testu \ musz\2e \ \1zwr\2o\1ci\2c \ \1uwag\2e \ \1na \ to, \ \2x\1e \ w \ wersji\r
2689 \-\r
2690 \+\r
2691 loglanowej nowego RS inicjalizacja zmiennych by\2l\1a wykonywana wraz\r
2692 \-\r
2693 \+\r
2694 z zerowanie obiektu (\4none \1=[0,0]). Niestety w wersji napisanej \ w\r
2695 \-\r
2696 \+\r
2697 C chcia\2l\1em, aby zmienne loglanowe \ by\2l\1y \ adresowane \ nie \ poprzez\r
2698 \-\r
2699 \+\r
2700 indeks w tablicy M, ale przez adres w pami\2e\1ci. Takie \ rozwi\2a\1zanie\r
2701 \-\r
2702 \+\r
2703 jest oczywi\2s\1cie bardziej efektywne, ale wymaga innego \ okre\2s\1lenia\r
2704 \-\r
2705 \+\r
2706 \4none\1.  Mianowicie \4none\1=[M0,0], gdzie M0= &M[0], oraz M[1]=1. \ Ale\r
2707 \-\r
2708 \+\r
2709 w\2o\1wczas inicjalizacj\2e \1obiektu trzeba wykonywa\2c \1przegl\2a\1daj\2a\1c list\2e\r
2710 \-\r
2711 \+\r
2712 \1referencji \ - \ a \ to \ jak \ widzimy \ kosztuje \ bardzo. \ Co \ prawda\r
2713 \-\r
2714 \+\r
2715 przyk\2l\1adowy \ program \ nie \ zawiera\2l \ x\1adnych \ oblicze\2n\1, \ a \ \ wi\2e\1c\r
2716 \-\r
2717 \+\r
2718 inicjalizacja mog\2l\1a kosztowa\2c \1gros czasu dzia\2l\1ania. \,\r
2719 \-\r
2720 \+\r
2721 \,\r
2722 \-\f\r
2723 \+\r
2724 \,\r
2725 \-\r
2726 \+\r
2727 \,\r
2728 \-\r
2729 \+\r
2730 Napisa\2l\1em jeden przyk\2l\1ad testuj\2a\1cy \ arytmetyk\2e \ \1zmiennopozycyjn\2a\1.\r
2731 \-\r
2732 \+\r
2733 Jest to program square.c gdzie  rozwi\2a\1zujemy r\2o\1wnanie kwadratowe.\r
2734 \-\r
2735 \+\r
2736 Wykorzystuj\2a\1c macra dla arytmetyki \ zmiennopozycyjnej \ bez \ trudu\r
2737 \-\r
2738 \+\r
2739 uda\2l\1o si\2e \1wyrazi\2c \1opracje na typie real. Wida\2c\1, \2x\1e wyra\2x\1enia mog\2a\r
2740 \-\r
2741 \+\r
2742 \1pozosta\2c \1bez zmiany, ewentualne zmienne \ robocze \ wygeneruje \ sam\r
2743 \-\r
2744 \+\r
2745 kompilator j\2e\1zyka C. Ich \ typ \ b\2e\1dzie \ dobrany \ zgodnie \ z \ typem\r
2746 \-\r
2747 \+\r
2748 argument\2o\1w. \,\r
2749 \-\r
2750 \+\r
2751 \,\r
2752 \-\r
2753 \+\r
2754 \,\r
2755 \-\r
2756 \+\r
2757 Przyk\2l\1ad  sltest.c s\2l\1u\2x\1y\2l \1do sprawdzenia dzia\2l\1ania nowej struktury\r
2758 \-\r
2759 \+\r
2760 Sl. \ Prosty \  program \ o \  znanej \ strukturze, \ gdzie \ \ wywo\2l\1ywana\r
2761 \-\r
2762 \+\r
2763 procedura ma zniszczone otoczenie \ statyczne, \ pozwala\2l \ \1sprawdzi\2c\r
2764 \-\r
2765 \+\r
2766 \1poprawno\2sc \ \1dzia\2l\1ania \ tej \ techniki. \ Wydaje \ si\2e\1, \ \2x\1e \ \ ma \ \ ona\r
2767 \-\r
2768 \+\r
2769 metodologicznie znaczna przewag\2e \1nad starym rozwi\2a\1zaniem \ (nie \ ma\r
2770 \-\r
2771 \+\r
2772 efekt\2o\1w dziwnych i niezrozumia\2l\1ych \ dla \ programisty), \ a \ ponadto\r
2773 \-\r
2774 \+\r
2775 jest stosunkowo \2l\1atwo implementowalna. Troch\2e \1tracimy \ na \ czasie,\r
2776 \-\r
2777 \+\r
2778 poniewa\2x \1sprawdzenie i czyszczenie \2l\1a\2n\1cuch\2o\1w Sl jest \ dro\2x\1sze \ ni\2x\r
2779 \-\r
2780 \+\r
2781 \1usuwanie na \2s\1lepo obiekt\2o\1w funkcji \ i \ blok\2o\1w. \ Z \ drugiej \ strony\r
2782 \-\r
2783 \+\r
2784 zyskuje si\2e \1troch\2e \1na pami\2e\1ci gdy\2x \1Sl link mo\2x\1e by\2c \1referencj\2a \1bez\r
2785 \-\r
2786 \+\r
2787 licznika. \,\r
2788 \-\r
2789 \+\r
2790 \,\r
2791 \-\r
2792 \+\r
2793 Ostatni przyk\2l\1ad functest.c s\2l\1u\2x\1y sprawdzeniu poprawno\2s\1ci u\2x\1ywania\r
2794 \-\r
2795 \+\r
2796 zmiennych podprogramowych. W bloku g\2lo\1wnym zadeklarowany jest \ typ\r
2797 \-\r
2798 \+\r
2799 funkcyjny F oraz funkcja  f z parametrem integer oraz typem wyniku\r
2800 \-\r
2801 \+\r
2802 F. W funkcji tej zadeklarowano dwie inne funkcje \ h, \ g, \ kt\2o\1re \ w\r
2803 \-\r
2804 \+\r
2805 tre\2s\1ci funkcji f  podstawiane s\2a \1jako jej wynik (typ f jest zgodny\r
2806 \-\r
2807 \+\r
2808 z F). W programie g\2lo\1wnym na zmienne x,y podstawiana jest \ warto\2sc\r
2809 \-\r
2810 \+\r
2811 \1wyniku wywo\2l\1ania funkcji f, dla argumentu 0 tym wynikiem \ jest \ h,\r
2812 \-\r
2813 \+\r
2814 dla argumentu 1 tym wynikiem jest g. Wreszcie \ na \ ko\2n\1cu \ programu\r
2815 \-\r
2816 \+\r
2817 wywo\2l\1ujemy x(n), oraz y(n) jako odpowiednie funkcje zapami\2e\1tane na\r
2818 \-\r
2819 \+\r
2820 zmiennych x,y.\r
2821 \-\r
2822 \=\r
2823 \1a#include "rsdata.h"\r
2824 \r
2825 \r
2826 \r
2827 \r
2828     int IC;                             /* global control */\r
2829     int modulenumber;                   /* module number */\r
2830     unsigned int *DISPLAY,*DISPDIR;     /* displays' addresses */\r
2831     unsigned int *lastcor,*mycoroutine,*myprocess;\r
2832     unsigned int *current,*local,*global;\r
2833 \r
2834 \r
2835 \r
2836 /************************************************************************/\r
2837 /*                                                                      */\r
2838 /*                                                                      */\r
2839 /*                       Running System basic constants                 */\r
2840 /*                                                                      */\r
2841 /*                                                                      */\r
2842 /************************************************************************/\r
2843 \r
2844 \r
2845 \r
2846 #define maxint 65535\r
2847 #define maxapp maxint           /* to be defined for each system */\r
2848 #define maxcounter (-1)         /* maximal value of counter */\r
2849 #define reflength 2             /* reference variable length */\r
2850 #define memorylength 16000      /* to be defined for each system */\r
2851 #define upr (memorylength-1)    /* memory upper index */\r
2852 #define minsize 2               /* minimal object size */\r
2853 #define virt1 reflength         /* auxiliary virtual addresses */\r
2854 #define virt2 2*reflength\r
2855 #define virt3 3*reflength\r
2856 #define virt4 4*reflength\r
2857 #define virtn virt4\r
2858 #define lwr (virtn+reflength)   /* memory lower index */\r
2859 \r
2860 \r
2861 \r
2862 \r
2863 \r
2864 \r
2865 /************************************************************************/\r
2866 /*                                                                      */\r
2867 /*                                                                      */\r
2868 /*              Functions defining system offsets                       */\r
2869 /*                                                                      */\r
2870 /*                                                                      */\r
2871 /************************************************************************/\r
2872 \r
2873 \r
2874 \r
2875 #define Sl(a,am) (am+PROT[a].Sloffset)          /* Sl link  offset */\r
2876 #define Dl(a,am) (am+PROT[a].Dloffset)          /* Dl link  offset */\r
2877 #define Statsl(a,am) (am+PROT[a].Statoffset)    /* Statussl offset */\r
2878 #define Lsc(a,am) (am+PROT[a].Lscoffset)        /* Lsc      offset */\r
2879 \r
2880 /************************************************************************/\r
2881 /*                                                                      */\r
2882 /*      Sl - defines the static father of an object, where is declared  */\r
2883 /*      Dl - defines the dynamic father of an object, where to return   */\r
2884 /*      Statussl - defines the number of syntactic sons                 */\r
2885 /*      Lsc - defines the local sequence control                        */\r
2886 /************************************************************************/\r
2887 \r
2888 \r
2889 \r
2890 \r
2891 /************************************************************************/\r
2892 /*                                                                      */\r
2893 /*                                                                      */\r
2894 /*                       Running System basic offsets                   */\r
2895 /*                                                                      */\r
2896 /*                                                                      */\r
2897 /************************************************************************/\r
2898 \r
2899 \r
2900 \r
2901 /*----------------------------------------------------------------------*/\r
2902 /*                              for arrays                              */\r
2903 /*----------------------------------------------------------------------*/\r
2904 \r
2905 #define lboffset 1              /* array lower bound offset */\r
2906 #define uboffset 2              /* array upper bound offset */\r
2907 #define elmoffset 3             /* array first element offset */\r
2908 \r
2909 \r
2910 /*----------------------------------------------------------------------*/\r
2911 /*                              for killed objects                      */\r
2912 /*----------------------------------------------------------------------*/\r
2913 \r
2914 \r
2915 #define shortlink 1             /* offset of next shortlist element */\r
2916 #define longlink 2              /* offset of next longlist element */\r
2917 \r
2918 \r
2919 \r
2920 /************************************************************************/\r
2921 /*                                                                      */\r
2922 /*                                                                      */\r
2923 /*                      Entities imported from a program                */\r
2924 /*                                                                      */\r
2925 /*                                                                      */\r
2926 /************************************************************************/\r
2927 \r
2928 \r
2929 \r
2930 extern int displ,curr,lstcor,chead,displdir;    /* basic offsets in main */\r
2931 extern struct Prototype PROT[];                 /* Prototypes */\r
2932 extern struct Offsets OFF[];                    /* Reference structures */\r
2933 extern struct Elem EL[];                        /* Lists of references */\r
2934 extern struct Hlstelem HL[];                    /* Lists of handlers */\r
2935 extern struct Sgelem SL[];                      /* Lists of signals */\r
2936 extern int perm[],perminv[];                    /* Langmaack's permutations */\r
2937 extern int (*module []) ();                     /* Modules addresses */\r
2938 extern int protnum,offnum;                      /* Length of PROT and OFF */\r
2939 extern jmp_buf buffer;                          /* buffer for jumps */\r
2940 \r
2941 \r
2942 \r
2943 /************************************************************************/\r
2944 /*                                                                      */\r
2945 /*                      Loglan memory structure                         */\r
2946 /*                                                                      */\r
2947 /*      M[lwr],...,M[lastused],.....,M[lastitem],...,M[upr]             */\r
2948 /*                                              where:                  */\r
2949 /*              M[lwr],...,M[lastused] memory for objects               */\r
2950 /*              M[lastitem],...,M[upr] memory for indirect addresses    */\r
2951 /*                                                                      */\r
2952 /*----------------------------------------------------------------------*/\r
2953 /*                                                                      */\r
2954 /*      Every reference X =  [ah,counter]                               */\r
2955 /*                                              where:                  */\r
2956 /*              ah = address in indirect addresses table                */\r
2957 /*              counter = a consecutive positive integer                */\r
2958 /*                                                                      */\r
2959 /*      Every indirect addresses table item=  [am,guard_counter]        */\r
2960 /*                                              where:                  */\r
2961 /*              am = address of an object                               */\r
2962 /*              guard_counter = a consecutive positive integer          */\r
2963 /*----------------------------------------------------------------------*/\r
2964 /*                                                                      */\r
2965 /*      X=none iff  counter <> guard_counter i.e. iff                   */\r
2966 /*              M[X+1]<> M[M[X]+1]                                      */\r
2967 /************************************************************************/\r
2968 \r
2969 \r
2970 \r
2971 unsigned int M[memorylength];           /* Loglan memory  */\r
2972 unsigned int * M0;                      /* address of M[0],[M0,0]=none */\r
2973 \r
2974 unsigned int *lastitem,*freeitem;\r
2975 \r
2976         /* M[lastitem..upr] - indirect addresses table;\r
2977                 M[freeitem] - head of free indirect addresses  */\r
2978 \r
2979 unsigned int *lastused;\r
2980 \r
2981         /* M[lwr..lastused] - memory for objects */\r
2982 \r
2983 \r
2984 \r
2985 \r
2986 /************************************************************************/\r
2987 /*                                                                      */\r
2988 /*                                                                      */\r
2989 /*                      Basic runnning system structures:               */\r
2990 /*                                                                      */\r
2991 /*      class object:                                                   */\r
2992 /*                      M[lspan],...,M[am],...,M[rspan]                 */\r
2993 /*                              where M[am]=prototype number            */\r
2994 /*                                                                      */\r
2995 /*      array object:                                                   */\r
2996 /*                      M[am],M[am+1],M[am+2],...,M[am+l-1]             */\r
2997 /*                              where M[am]=prototype number            */\r
2998 /*                                    M[am+1]= lowr bound               */\r
2999 /*                                    M[am+2]= upper bound              */\r
3000 /*                                    l = total length                  */\r
3001 /*----------------------------------------------------------------------*/\r
3002 /*                                                                      */\r
3003 /*      killed object:                                                  */\r
3004 /*                      M[am],M[am+1],M[am+2],...,M[am+l-1]             */\r
3005 /*                              where M[am]=l, total length             */\r
3006 /*                                    M[am+1]= address of next killed   */\r
3007 /*                                      with equal length               */\r
3008 /*                                    M[am+2]= address of next killed   */\r
3009 /*                                      with next greater length        */\r
3010 /*                                                                      */\r
3011 /************************************************************************/\r
3012 \r
3013 \r
3014 \r
3015 \r
3016 \r
3017 \r
3018 unsigned int *headk,*headkmin;\r
3019 \r
3020 \r
3021 /************************************************************************/\r
3022 /*                                                                      */\r
3023 /* headk    - head of killed objects list                               */\r
3024 /*              the list ends with M[lwr]=maximal appetite              */\r
3025 /* headkmin - head of killed objects list of minimal length             */\r
3026 /*              each list element has only address of next killed with  */\r
3027 /*              equal length, so no need for M[am+2]                    */\r
3028 /*                                                                      */\r
3029 /************************************************************************/\r
3030 \r
3031 /************************************************************************/\r
3032 /*                                                                      */\r
3033 /*                                                                      */\r
3034 /*                      Global variables                                */\r
3035 /*                                                                      */\r
3036 /*                                                                      */\r
3037 /************************************************************************/\r
3038 \r
3039 \r
3040 \r
3041 \r
3042 \r
3043 unsigned int *vipt1,*vipt2,*vipt3,*vipt4,*viptn;\r
3044 \r
3045         /* vipti = address of M[virti] */\r
3046 \r
3047 unsigned int *Mlwr,*Mupr;               /* addresses of M[lwr] and M[upr] */\r
3048 \r
3049 int protnum1;                           /* =protnum+1, used in marking */\r
3050 \r
3051 \r
3052 \r
3053 /************************************************************************/\r
3054 /*                                                                      */\r
3055 /*                                                                      */\r
3056 /*                              Object size                             */\r
3057 /*                                                                      */\r
3058 /*                                                                      */\r
3059 /************************************************************************/\r
3060 \r
3061 static unsigned int Size (a,am)\r
3062 int a;\r
3063 unsigned int *am;\r
3064 {\r
3065         switch (PROT[a].kind)\r
3066         {\r
3067         case PRIMITARRAY:\r
3068                 return((*(am+uboffset)- *(am+lboffset)+1)*PROT[a].elsize+\r
3069                     elmoffset);\r
3070         case REFARRAY :\r
3071         case SUBARRAY:\r
3072                 return((*(am+uboffset)- *(am+lboffset)+1)*reflength+elmoffset);\r
3073         case STRUCTARRAY:\r
3074                 return((*(am+uboffset)- *(am+lboffset)+1)*\r
3075                     (OFF[PROT[a].references].size)+elmoffset);\r
3076         case POINTARRAY:\r
3077                 return(*(am+uboffset)- *(am+lboffset)+1+elmoffset);\r
3078         default:\r
3079                 return(PROT[a].rspan+PROT[a].lspan+1);\r
3080         }\r
3081 }\r
3082 \r
3083 \r
3084 /************************************************************************/\r
3085 /*                                                                      */\r
3086 /*                                                                      */\r
3087 /*                      Position of protnum in object                   */\r
3088 /*                                                                      */\r
3089 /*                                                                      */\r
3090 /************************************************************************/\r
3091 \r
3092 \r
3093 static unsigned int Ptposition(a)\r
3094 int a;\r
3095 {\r
3096         switch (PROT[a].kind)\r
3097         {\r
3098         case PRIMITARRAY:\r
3099         case REFARRAY:\r
3100         case SUBARRAY:\r
3101         case STRUCTARRAY:\r
3102         case POINTARRAY:\r
3103                 return(0);\r
3104         default:\r
3105                 return(PROT[a].lspan);\r
3106         }\r
3107 }\r
3108 \r
3109 \r
3110 \r
3111 \r
3112 /************************************************************************/\r
3113 /*                                                                      */\r
3114 /*                                                                      */\r
3115 /*       Auxiliary function for dumping the whole memory                */\r
3116 /*                                                                      */\r
3117 /*                                                                      */\r
3118 /************************************************************************/\r
3119 \r
3120 \r
3121 \r
3122 \r
3123 Memorydump ()\r
3124 {\r
3125         unsigned int *i,*l,*u;\r
3126         int j;\r
3127 \r
3128         printf("\n         SYSTEM VARIABLES\n");\r
3129         printf(\r
3130         "freeitem   lastused   lastitem   headk   headkmin   Mlwr  Mupr\n");\r
3131         printf("%3d         %3d       %3d    %3d    %3d     %3d  %3d\n",\r
3132         freeitem,lastused,lastitem,headk,headkmin,Mlwr,Mupr);\r
3133         printf("           VIRTUAL ADDRESSES\n");\r
3134         l= Mupr-1;\r
3135         do\r
3136             {\r
3137                 if (l-18>lastitem) u=l-18;\r
3138                 else u=lastitem;\r
3139                 printf(" ah    ");\r
3140                 for (i=l; i>=u; i=i-reflength) printf(" %5d",i);\r
3141                 printf("\n M[ah]  ");\r
3142                 for (i=l; i>=u; i=i-reflength) printf(" %5d", *i);\r
3143                 printf("\nM[ah+1]");\r
3144                 for (i=l; i>=u; i=i-reflength) printf(" %5d",*(i+1));\r
3145                 printf("\n");\r
3146                 l=u-reflength;\r
3147         }\r
3148         while (u!=lastitem);\r
3149 \r
3150         printf("        OBJECTS\n");\r
3151         j=0;\r
3152         for (i=M0; i<=lastused; ++i)\r
3153         {\r
3154                 printf(" %6d",*i);\r
3155                 ++j;\r
3156                 if (j==10){\r
3157                         printf("\n");\r
3158                         j=0;\r
3159                 };\r
3160         };\r
3161         printf(  "\n");\r
3162 }                  /* end Memorydump */\r
3163 \r
3164 \r
3165 \r
3166 /************************************************************************/\r
3167 /*                                                                      */\r
3168 /*                                                                      */\r
3169 /*       Auxiliary function for dumping  prototype structures           */\r
3170 /*                                                                      */\r
3171 /*                                                                      */\r
3172 /************************************************************************/\r
3173 \r
3174 \r
3175 \r
3176 Writedata()\r
3177 \r
3178 {\r
3179         int i,j;\r
3180 \r
3181         struct Prototype a;\r
3182         struct Offsets L;\r
3183         int p;\r
3184         int q;\r
3185         int working;\r
3186 \r
3187         printf("\n PROTOTYPE STRUCTURE\n");\r
3188         printf(\r
3189         "Nr Kind Lspan Rspan Ref  Decl Lev Lstw Sl Dl Lsc Stat Pref Psl \n");\r
3190         for (i=0; i<=protnum-1; ++i)\r
3191         {\r
3192                 printf("\n%2d ",i);\r
3193                 a=PROT[i];\r
3194                 switch (a.kind)\r
3195                 {\r
3196                 case PROCESS:\r
3197                         printf("proc ");\r
3198                         break;\r
3199                 case SUBROUTINE:\r
3200                         printf("sub  ");\r
3201                         break;\r
3202                 case COROUTINE:\r
3203                         printf("cor  ");\r
3204                         break;\r
3205                 case CLASS:\r
3206                         printf("class");\r
3207                         break;\r
3208                 case HANDLER:\r
3209                         printf("hand ");\r
3210                         break;\r
3211                 default:\r
3212                         printf("array");\r
3213                 };\r
3214 \r
3215                 printf("%2d   ",a.lspan);\r
3216                 switch(a.kind)\r
3217                 {\r
3218                 case CLASS:\r
3219                 case SUBROUTINE:\r
3220                 case PROCESS:\r
3221                 case HANDLER:\r
3222                 case COROUTINE:\r
3223                         break;\r
3224                 default:\r
3225                         continue;\r
3226                 };\r
3227                 printf("  %2d   ",a.rspan);\r
3228                 if (a.references!=-1)   printf("%2d   ",OFF[a.references].num);\r
3229                 else printf("     ");\r
3230                 if (a.decl!=-1)  printf("%2d  ",PROT[a.decl].num) ;\r
3231                 else printf("    ");\r
3232                 printf("%2d   ",a.level);\r
3233                 printf("%2d   ",a.lastwill);\r
3234                 printf("%2d %2d %2d  %2d ",\r
3235                 a.Sloffset,a.Dloffset,a.Statoffset,a.Lscoffset);\r
3236                 switch (a.kind)\r
3237                 {\r
3238                 case HANDLER:\r
3239                         continue;\r
3240                 };\r
3241                 if (a.pref!=-1)  printf("%2d    ",PROT[a.pref].num) ;\r
3242                 else printf("      ");\r
3243                 printf("%2d",a.pslength);\r
3244 \r
3245         };\r
3246         printf("\n HANDLERS\n\n handler signals\n");\r
3247         for (i=0; i<=protnum-1; ++i)\r
3248         {\r
3249                 a=PROT[i];\r
3250                 printf("\n%2d  ",i);\r
3251                 switch (a.kind)\r
3252                 {\r
3253                 case CLASS:\r
3254                 case SUBROUTINE:\r
3255                 case PROCESS:\r
3256                 case COROUTINE:\r
3257                         break;\r
3258                 default:\r
3259                         continue;\r
3260                 };\r
3261                 p=a.handlist;\r
3262                 while (p>=0)\r
3263                 {\r
3264                         printf("%2d  ",HL[p].hand);\r
3265                         q=HL[p].signlist;\r
3266                         while (q>=0)\r
3267                         {\r
3268                                 printf("%2d  ",SL[q].signalnum);\r
3269                                 q=SL[q].next;\r
3270                         };\r
3271                         p=HL[p].next;\r
3272                 };\r
3273                 printf("\n");\r
3274         };\r
3275         printf("\n\n OFFSETS\n");\r
3276         for (i=0; i<=offnum-1; ++i)\r
3277         {\r
3278                 L=OFF[i];\r
3279                 printf(" %2d   size %d ",i,L.size);\r
3280                 switch(L.kind)\r
3281                 {\r
3282                 case SIMPLELIST:\r
3283                         printf(" Listref ");\r
3284                         working=L.head;\r
3285                         for (j=1; j<=L.length; ++j)\r
3286                         {\r
3287                                 printf("%2d  ",EL[working].offset);\r
3288                                 if (EL[working].references==1) printf("s ");\r
3289                                 if (EL[working].references==2) printf("p ");\r
3290                                 working=EL[working].next;\r
3291                         };\r
3292                         break;\r
3293                 case SEGMENT:\r
3294                         printf("Segment  ");\r
3295                         printf("%2d    %2d    ",L.start,L.finish);\r
3296                         if (L.head==1) printf(" s ");\r
3297                         if (L.head==2) printf(" p ");\r
3298                         break;\r
3299                 case REPEATED:\r
3300                         printf("Repeated ");\r
3301                         printf("%2d    %2d    ",L.ntimes,OFF[L.references].num);\r
3302                         break;\r
3303                 case COMBINEDLIST:\r
3304                         printf(" List    ");\r
3305                         working=L.head;\r
3306                         for (j=1; j<=L.length; ++j)\r
3307                         {\r
3308                                 printf("%2d    %2d   ",EL[working].offset,\r
3309                                 OFF[EL[working].references].num);\r
3310                                 working=EL[working].next;\r
3311                         };\r
3312                         break;\r
3313                 };\r
3314                 printf("  \n");\r
3315         };\r
3316         printf(" \n PERMUTATIONS  ");\r
3317         printf("\n Prot \tPerm ");\r
3318         for (i=0;  i<=protnum-1;  ++i)\r
3319         {\r
3320                 a=PROT[i];\r
3321                 switch(a.kind)\r
3322                 {\r
3323                 case CLASS:\r
3324                 case SUBROUTINE:\r
3325                 case PROCESS:\r
3326                 case HANDLER:\r
3327                 case COROUTINE:\r
3328                         break;\r
3329                 default:\r
3330                         continue;\r
3331                 };\r
3332                 printf("\n%2d      ",i);\r
3333                 for (j=0; j<=PROT[i].level; ++j)\r
3334                         printf("%2d  ",perm[PROT[i].permadd+j]);\r
3335         };\r
3336         printf("\n Prot \tPerminv ");\r
3337         for (i=0;  i<=protnum-1;  ++i)\r
3338         {\r
3339                 a=PROT[i];\r
3340                 switch(a.kind)\r
3341                 {\r
3342                 case CLASS:\r
3343                 case SUBROUTINE:\r
3344                 case PROCESS:\r
3345                 case HANDLER:\r
3346                 case COROUTINE:\r
3347                         break;\r
3348                 default:\r
3349                         continue;\r
3350                 };\r
3351                 printf("\n%2d      ",i);\r
3352                 for (j=0; j<=PROT[i].level; ++j)\r
3353                         printf("%2d  ",perminv[PROT[i].permadd+j]);\r
3354         };\r
3355         printf(" \n");\r
3356 }                           /* end writedata */\r
3357 \r
3358 \r
3359 \r
3360 /************************************************************************/\r
3361 /*                                                                      */\r
3362 /*                                                                      */\r
3363 /*              The final address of object referenced by X             */\r
3364 /*                                                                      */\r
3365 /*                                                                      */\r
3366 /************************************************************************/\r
3367 \r
3368 \r
3369 \r
3370 \r
3371 unsigned int *Physical(X)\r
3372 unsigned int *X;\r
3373 {\r
3374         if( Notmember(X) )\r
3375                 Raising(reftonone,vipt2);\r
3376         else\r
3377             return(Physimple(X));\r
3378 }\r
3379 \r
3380 \r
3381 \r
3382 /************************************************************************/\r
3383 /*                                                                      */\r
3384 /*      Request for a new object:                                       */\r
3385 /*                                                                      */\r
3386 /*      (a) Search for a free indirect address item                     */\r
3387 /*                                                                      */\r
3388 /*      (i)  if freeitem <>0, then take from list of free addresses     */\r
3389 /*      (ii) if freeitem=0, then expand indirect addresses table        */\r
3390 /*      (iii)if no space, then compactify the whole memory              */\r
3391 /*      (iv) if still no space, then fatal error                        */\r
3392 /*                                                                      */\r
3393 /*      (b) Search for a  frame of size defined by length:              */\r
3394 /*                                                                      */\r
3395 /*      (i)  if lastused+length<lastitem, then like in stack            */\r
3396 /*      (ii) if no space, then search on the list of killed objects     */\r
3397 /*      (iii)if not found, then compactify the whole memory             */\r
3398 /*      (iv) if still no space, then fatal error                        */\r
3399 /*                                                                      */\r
3400 /*                                                                      */\r
3401 /************************************************************************/\r
3402 \r
3403 \r
3404 static Request(a,length,X)\r
3405 int a;\r
3406 unsigned int *X,length;\r
3407 \r
3408 {\r
3409         unsigned int *t1,*t2,*t3,*ah,*am,l;\r
3410         char wascomp,nfound;\r
3411 \r
3412         if (length >= maxapp)\r
3413                 Error(8);\r
3414 \r
3415         if (length <= minsize)\r
3416                 length=minsize;\r
3417 \r
3418         wascomp=0;\r
3419 \r
3420         /* search for a free indirect address */\r
3421 \r
3422         if (freeitem)\r
3423         {\r
3424                 ah=freeitem;\r
3425                 freeitem= (unsigned int *)*ah;\r
3426         }\r
3427         else            /* extend the indirect address table */\r
3428         {\r
3429                 ah=lastitem-reflength;\r
3430                 if (ah<=lastused)\r
3431                 {\r
3432                         Compactify();\r
3433                         wascomp=1;\r
3434                         ah=lastitem-reflength;\r
3435                         if (ah<=lastused)\r
3436                                 Error(8);\r
3437                 };\r
3438                 lastitem=ah;\r
3439                 *(ah+1)=0;\r
3440         };\r
3441 \r
3442         /* search for free frame */\r
3443 \r
3444         t1=lastused+length;\r
3445         if (t1<lastused || t1>= lastitem)\r
3446         {\r
3447                 if(length==minsize && headkmin)\r
3448                 {\r
3449                         am=headkmin;\r
3450                         headkmin=(unsigned int *) *(am+shortlink);\r
3451                 }\r
3452                 else\r
3453                 {\r
3454                         t1=headk;\r
3455                         nfound=1;\r
3456                         t2=0;\r
3457                         while (t1!= Mlwr)\r
3458                         {\r
3459                                 if (*(t1)==length ||\r
3460                                     *(t1)>(length+minsize) )\r
3461                                 {\r
3462                                         l= *(t1)-length;\r
3463                                         nfound=0;\r
3464                                         break;\r
3465                                 }\r
3466                                 else\r
3467                                 {\r
3468                                         t2=t1;\r
3469                                         t1= (unsigned int *)*(t1+longlink);\r
3470                                 };\r
3471                         };\r
3472                         if (nfound)\r
3473                         {\r
3474                                 if  (wascomp) Error(8);\r
3475                                 *ah=(unsigned int) freeitem;\r
3476                                 freeitem=ah;\r
3477                                 Compactify();\r
3478                                 ah=lastitem-reflength;\r
3479                                 lastitem=ah;\r
3480                                 *(ah+1)=0;\r
3481                                 t1=lastused+length;\r
3482                                 if (t1<lastused || t1>=lastitem) Error(8);\r
3483                                 am=lastused+1;\r
3484                                 lastused=t1;\r
3485                         }\r
3486                         else\r
3487                         {\r
3488                                 t3= (unsigned int *) *(t1+shortlink);\r
3489                                 am=t1;\r
3490                                 if (t3)\r
3491                                         *(t3+longlink)= *(t1+longlink);\r
3492                                 else\r
3493                                     t3= (unsigned int *)*(t1+longlink);\r
3494                                 if (t2)\r
3495                                         *(t2+longlink)= (unsigned int) t3;\r
3496                                 else\r
3497                                     headk=t3;\r
3498                                 if (l)\r
3499                                 {\r
3500                                         t3=t1+length;\r
3501                                         *t3=l;\r
3502                                         Insert(t3);\r
3503                                 }\r
3504                         };\r
3505                 };\r
3506         }\r
3507         else\r
3508         {\r
3509                 am=lastused+1;\r
3510                 lastused=t1;\r
3511         };\r
3512         *X= (unsigned int)ah;\r
3513         *(X+1)= *(ah+1);\r
3514         am+=Ptposition(a);\r
3515         *am=a;\r
3516         *ah= (unsigned int )am;\r
3517 \r
3518 }                               /* end Request */\r
3519 \r
3520 \r
3521 \r
3522 \r
3523 \r
3524 /************************************************************************/\r
3525 /*                                                                      */\r
3526 /*                                                                      */\r
3527 /*      Dispose the  object referenced by X=[ah,counter]                */\r
3528 /*                                                                      */\r
3529 /*      (a) dispose the indirect address:                               */\r
3530 /*      (i)  advance M[ah+1], i.e. guard_counter                        */\r
3531 /*      (ii) if guard_counter=-1, then leave it                         */\r
3532 /*              for compactification of the whole memory                */\r
3533 /*      (iii) otherwise put on the list of free addresses               */\r
3534 /*                                                                      */\r
3535 /*      (b) dispose the frame:                                          */\r
3536 /*      (i) if the frame is bordering free space, increase lastused     */\r
3537 /*      (ii) otherwise put it on the list of killed objects             */\r
3538 /*      (iii) correct Statussl for procedure closures                   */\r
3539 /*                                                                      */\r
3540 /*                                                                      */\r
3541 /************************************************************************/\r
3542 \r
3543 static Disp (X)\r
3544 \r
3545 unsigned int *X;\r
3546 {\r
3547         int a;\r
3548         unsigned int *am,*ah;\r
3549         unsigned int length;\r
3550 \r
3551         if (Notmember(X)) return;\r
3552 \r
3553         ah=  (unsigned int *) *X;\r
3554         am=  (unsigned int *) *ah;\r
3555         if (++(*(ah+1))!=maxcounter)\r
3556         {\r
3557                 *ah=(unsigned int)freeitem;\r
3558                 freeitem=ah;\r
3559         };\r
3560         traverse(am,5);\r
3561         a= *am;\r
3562         length=Size(a,am);\r
3563         if (am+length-Ptposition(a)-1==lastused)\r
3564                 lastused-=length;\r
3565         else\r
3566         {\r
3567                 am-=Ptposition(a);\r
3568                 *am=length;\r
3569                 Insert(am);\r
3570         };\r
3571 }                                  /* end Disp  */\r
3572 \r
3573 \r
3574 \r
3575 /************************************************************************/\r
3576 /*                                                                      */\r
3577 /*                                                                      */\r
3578 /*                      Move virtual address Y on X                     */\r
3579 /*                                                                      */\r
3580 /*                                                                      */\r
3581 /************************************************************************/\r
3582 \r
3583 \r
3584 Refmove(X,Y)\r
3585 unsigned int *X,*Y;\r
3586 \r
3587 {\r
3588         *X++ = *Y++;\r
3589         *X= *Y;\r
3590 }\r
3591 \r
3592 \r
3593 \r
3594 /************************************************************************/\r
3595 /*                                                                      */\r
3596 /*                                                                      */\r
3597 /*              Move procedure closure address Y on X                   */\r
3598 /*                                                                      */\r
3599 /*                                                                      */\r
3600 /************************************************************************/\r
3601 \r
3602 \r
3603 Procclosmove(X,Y)\r
3604 unsigned int *X,*Y;\r
3605 \r
3606 {       unsigned int *am;\r
3607         int a;\r
3608 \r
3609         if ( *X!=0)\r
3610         {\r
3611                 am=Physimple(X);\r
3612                 a= *am;\r
3613                 (*Statsl(a,am))--;\r
3614         };\r
3615         if ( *Y!=0)\r
3616         {\r
3617                 am=Physimple(Y);\r
3618                 a= *am;\r
3619                 (*Statsl(a,am))++;\r
3620         };\r
3621         *X++ = *Y++;\r
3622         *X= *Y;\r
3623 }\r
3624 \r
3625 \r
3626 /************************************************************************/\r
3627 /*                                                                      */\r
3628 /*                                                                      */\r
3629 /*              For Y shortaddress, reconstruct reference on X          */\r
3630 /*                                                                      */\r
3631 /*                                                                      */\r
3632 /************************************************************************/\r
3633 \r
3634 Refset(X,Y)\r
3635 unsigned int *X,*Y;\r
3636 {\r
3637         *X= *Y;\r
3638         *(X+1)= *((unsigned int *)*X+1);\r
3639 }\r
3640 \r
3641 \r
3642 \r
3643 /************************************************************************/\r
3644 /*                                                                      */\r
3645 /*                                                                      */\r
3646 /*                              X:=none                                 */\r
3647 /*                                                                      */\r
3648 /*                                                                      */\r
3649 /************************************************************************/\r
3650 \r
3651 \r
3652 Setnone(X)\r
3653 unsigned int *X;\r
3654 \r
3655 {\r
3656         *X++ = (unsigned int)M0;\r
3657         *X= 0;\r
3658 }\r
3659 \r
3660 \r
3661 /************************************************************************/\r
3662 /*                                                                      */\r
3663 /*                                                                      */\r
3664 /*                              X=/=Y                                   */\r
3665 /*                                                                      */\r
3666 /*                                                                      */\r
3667 /************************************************************************/\r
3668 \r
3669 int Notequal(X,Y)\r
3670 unsigned int *X,*Y;\r
3671 \r
3672 {\r
3673         if (Notmember(X))     return(Member(Y));\r
3674         else\r
3675                 if (Notmember(Y))\r
3676                         return(1);\r
3677                 else\r
3678                         return((int)(Physimple(X)-Physimple(Y)));\r
3679 }\r
3680 \r
3681 \r
3682 /************************************************************************/\r
3683 /*                                                                      */\r
3684 /*                                                                      */\r
3685 /*                                X=Y                                   */\r
3686 /*                                                                      */\r
3687 /*                                                                      */\r
3688 /************************************************************************/\r
3689 \r
3690 \r
3691 int Equal(X,Y)\r
3692 unsigned int *X,*Y;\r
3693 \r
3694 {\r
3695         return(! Notequal(X,Y));\r
3696 }\r
3697 \r
3698 \r
3699 /************************************************************************/\r
3700 /*                                                                      */\r
3701 /*                                                                      */\r
3702 /*      Insert the frame pointed by am on the list of killed objects    */\r
3703 /*                                                                      */\r
3704 /*                                                                      */\r
3705 /************************************************************************/\r
3706 \r
3707 \r
3708 static Insert(am)\r
3709 unsigned int *am;\r
3710 {\r
3711         unsigned int *t1,*t2;\r
3712         unsigned int l,k;\r
3713 \r
3714         l= *am;\r
3715         if (l==minsize)\r
3716         {\r
3717                 *(am+shortlink)=(unsigned int)headkmin;\r
3718                 headkmin=am;\r
3719         }\r
3720         else\r
3721         {\r
3722                 t1=headk;\r
3723                 t2=0;\r
3724                 while (1)\r
3725                 {\r
3726                         k= *t1;\r
3727                         if (l==k)\r
3728                         {\r
3729                                 *(am+shortlink)= *(t1+shortlink);\r
3730                                 *(t1+shortlink)= (unsigned int)am;\r
3731                                 break;\r
3732                         }\r
3733                         else\r
3734                                 if (l<k)\r
3735                                 {\r
3736                                         *(am+longlink)= (unsigned int)t1;\r
3737                                         *(am+shortlink)=0;\r
3738                                         if(t2) *(t2+longlink)=(unsigned int)am;\r
3739                                         else headk=am;\r
3740                                         break;\r
3741                                 }\r
3742                                 else\r
3743                                 {\r
3744                                         t2=t1;\r
3745                                         t1=(unsigned int *)  *(t1+longlink);\r
3746                                 };\r
3747                 };\r
3748         };\r
3749 }                            /* end Insert */\r
3750 \r
3751 \r
3752 \r
3753 \r
3754 /************************************************************************/\r
3755 /*                                                                      */\r
3756 /*                                                                      */\r
3757 /*      Purge the Sl-chain of an object referenced by vipt3             */\r
3758 /*                                                                      */\r
3759 /*      (i)  if  Statussl=0 and it is procedure instance, dispose it    */\r
3760 /*      (ii) otherwise goto end                                         */\r
3761 /*      (iv) put vipt3 = Sl father of vipt3, and goto (i)               */\r
3762 /*                                                                      */\r
3763 /*                                                                      */\r
3764 /************************************************************************/\r
3765 \r
3766 \r
3767 \r
3768 static Killer ()\r
3769 {\r
3770         unsigned int *am;\r
3771         int a;\r
3772 \r
3773         while (1)\r
3774         {\r
3775                 am=Physimple(vipt3);\r
3776                 a= *am;\r
3777                 if ( *Statsl(a,am)) return;\r
3778                 switch (PROT[a].kind)\r
3779                 {\r
3780                 case SUBROUTINE:\r
3781                         break;\r
3782                 default:\r
3783                         return;\r
3784                 };\r
3785                 if ( Physimple(vipt3)!=Physimple(Dl(a,am))) return;\r
3786                 Refset(vipt2,Sl(a,am));\r
3787                 Disp(vipt3);\r
3788                 Refmove(vipt3,vipt2);\r
3789         };\r
3790 }                      /* end of killer */\r
3791 \r
3792 \r
3793 \r
3794 /************************************************************************/\r
3795 /*                                                                      */\r
3796 /*                                                                      */\r
3797 /*      Purge memory after procedure instance termination               */\r
3798 /*                                                                      */\r
3799 /*      (i) if Statussl<>0,  nothing can be deallocated                 */\r
3800 /*      (ii) otherwise dispose the object, put on vipt3 its Sl father   */\r
3801 /*              and call Killer, which purges Sl-chain                  */\r
3802 /*                                                                      */\r
3803 /*                                                                      */\r
3804 /************************************************************************/\r
3805 \r
3806 \r
3807 Killafter()\r
3808 {\r
3809         unsigned int *am;\r
3810         int a;\r
3811 \r
3812         am=Physimple(vipt2);\r
3813         a= *am;\r
3814         if ( *Statsl(a,am)) return;\r
3815         Refset(vipt3,Sl(a,am));\r
3816         Disp(vipt2);\r
3817         Killer();\r
3818 }\r
3819 \r
3820 \r
3821 \r
3822 /************************************************************************/\r
3823 /*                                                                      */\r
3824 /*                                                                      */\r
3825 /*      Compactifier - the play in 9 acts (Oh My God!!!)                */\r
3826 /*                                                                      */\r
3827 /*      It's like an ancient tragedy with  prolog, epilogue,            */\r
3828 /*              chorus singing in  some entr'acts, deus ex machina etc. */\r
3829 /*                                                                      */\r
3830 /*                                                                      */\r
3831 /************************************************************************/\r
3832 \r
3833 /*----------------------------------------------------------------------*/\r
3834 /* Procedure traverse is a Deus ex machina                              */\r
3835 /*      (helps to solve dramatic problems in many moments):             */\r
3836 /*                                                                      */\r
3837 /*      short trip through the object pointed by am with action         */\r
3838 /*              performed for each reference                            */\r
3839 /*      (uses  procedures pointed and correct)                          */\r
3840 /*                                                                      */\r
3841 /*----------------------------------------------------------------------*/\r
3842 \r
3843 static traverse (am,action)\r
3844 unsigned int *am;\r
3845 char action;\r
3846 {\r
3847         int a, L;\r
3848         unsigned int *t;\r
3849 \r
3850         if ((int) *am >= 0) a= *am;\r
3851         else a= *am+protnum1;\r
3852         switch (PROT[a].kind)\r
3853         {\r
3854         case PRIMITARRAY :\r
3855                 return;\r
3856         case REFARRAY :\r
3857                 for (t= am+elmoffset;t<=am+Size(a,am)-1;t+=reflength)\r
3858                         correct(t,action,0);\r
3859                 return;\r
3860         case SUBARRAY :\r
3861                 for (t= am+elmoffset;t<=am+Size(a,am)-1;t+=reflength)\r
3862                         correct(t,action,2);\r
3863                 return;\r
3864         case STRUCTARRAY :\r
3865                 L=PROT[a].references;\r
3866                 for (t= am+elmoffset;t<=am+Size(a,am)-1;t+=OFF[L].size)\r
3867                         pointed(t,L,action);\r
3868                 return;\r
3869         case POINTARRAY :\r
3870                 for (t= am+elmoffset;t<=am+Size(a,am)-1; t++)\r
3871                         correct(t,action,1);\r
3872                 return;\r
3873         default  :\r
3874                 L=PROT[a].references;\r
3875                 pointed(am,L,action);\r
3876         };\r
3877 }   /* end traverse */\r
3878 \r
3879 \r
3880 \r
3881 \r
3882 /*----------------------------------------------------------------------*/\r
3883 /*                                                                      */\r
3884 /*      correct all references defined by the structure of offsets L    */\r
3885 /*      according to action, in the subframe starting with acron        */\r
3886 /*                                                                      */\r
3887 /*----------------------------------------------------------------------*/\r
3888 \r
3889 static pointed (acron,L,action)\r
3890 unsigned int *acron;\r
3891 char L;\r
3892 char action; /* 1 nonefy,2 relocate,3 mark,4 Setnone,5 decstatussl */\r
3893 {\r
3894         int i,k,working,ref;\r
3895 \r
3896         if (L==-1) return;\r
3897         switch (OFF[L].kind)\r
3898         {\r
3899         case SIMPLELIST:\r
3900                 working=OFF[L].head;\r
3901                 for (i=1; i<=OFF[L].length; ++i)\r
3902                 {\r
3903                         k=EL[working].offset;\r
3904                         correct(acron+k,action,EL[working].references);\r
3905                         working=EL[working].next;\r
3906                 };\r
3907                 return;\r
3908         case SEGMENT:\r
3909                 switch(OFF[L].head)\r
3910                 {case 0:\r
3911                         for (k=OFF[L].start;k<=OFF[L].finish;k+=reflength)\r
3912                                 correct(acron+k,action,0);\r
3913                         break;\r
3914                 case 1:\r
3915                         for (k=OFF[L].start;k<=OFF[L].finish;++k)\r
3916                                 correct(acron+k,action,1);\r
3917                         break;\r
3918                 case 2:\r
3919                         for (k=OFF[L].start;k<=OFF[L].finish;k+=reflength)\r
3920                                 correct(acron+k,action,2);\r
3921                         break;\r
3922                 };\r
3923 \r
3924                 return;\r
3925         case REPEATED:\r
3926                 for (i=1;i<=OFF[L].ntimes;++i)\r
3927                 {\r
3928                         pointed(acron,OFF[L].references,action);\r
3929                         acron+=OFF[L].size;\r
3930                 };\r
3931                 return;\r
3932         case COMBINEDLIST:\r
3933                 working=OFF[L].head;\r
3934                 for (i=1;i<=OFF[L].length;++i)\r
3935                 {\r
3936                         k=EL[working].offset;\r
3937                         ref=EL[working].references;\r
3938                         pointed(acron+k,ref,action);\r
3939                         working=EL[working].next;\r
3940                 };\r
3941                 return;\r
3942         };\r
3943 } /* end pointed */\r
3944 \r
3945 \r
3946 \r
3947 \r
3948 \r
3949 \r
3950 /*----------------------------------------------------------------------*/\r
3951 /*                                                                      */\r
3952 /*      correct one reference pointed by am according to action         */\r
3953 /*      (for long references it is different than for the short ones)   */\r
3954 /*                                                                      */\r
3955 /*----------------------------------------------------------------------*/\r
3956 \r
3957 static correct (am,action,reftype)\r
3958 unsigned int *am;\r
3959 char reftype;   /* 0-fulladdress, 1-shortaddress, 2-procedure closure */\r
3960 char action;\r
3961 {       int a;\r
3962 \r
3963         switch (action)\r
3964         {\r
3965         case 1:\r
3966                 if (reftype==0) nonefy(am); return;\r
3967         case 2:\r
3968                 if (reftype==0) relocate(am); else relocs(am);\r
3969                 return;\r
3970         case 3:\r
3971                 if (reftype==0) mark(am); else marks(am);\r
3972                 return;\r
3973         case 4:\r
3974                 if (reftype==0) Setnone(am); else *am=0;\r
3975                 return;\r
3976         case 5:\r
3977                 if (reftype==2)\r
3978                 {\r
3979                         if ( *am==0) return;\r
3980                         am=Physimple(am);\r
3981                         a= *am;\r
3982                         if (a < 0)   a+=protnum1;\r
3983                         (*Statsl(a,am))--;\r
3984                 };\r
3985                 return;\r
3986         };\r
3987 }\r
3988 \r
3989 \r
3990 \r
3991 \r
3992 /*----------------------------------------------------------------------*/\r
3993 /*                                                                      */\r
3994 /*      Two auxiliary procedures mark and marks are called by traverse  */\r
3995 /*      in prologue. They help to visit all accessible objects from an  */\r
3996 /*      active one. Each  accessible  object is marked by changing its  */\r
3997 /*      basic item M[am](=prototype number) on a negative value.  Mark  */\r
3998 /*      passes through full references [ah,counter],while marks passes  */\r
3999 /*                      through simplified references [ah].             */\r
4000 /*                                                                      */\r
4001 /*----------------------------------------------------------------------*/\r
4002 \r
4003 \r
4004 \r
4005 static mark (am)\r
4006 unsigned int *am;\r
4007 {\r
4008         if (Notmember(am)) return;\r
4009         am=Physimple(am);\r
4010         if ((int) *am >=0)\r
4011         {\r
4012                 *am -= protnum1  ;\r
4013                 traverse(am,3);\r
4014         };\r
4015 }\r
4016 \r
4017 \r
4018 \r
4019 static marks (am)\r
4020 unsigned int *am;\r
4021 {\r
4022 \r
4023         if (*am==0) return;\r
4024         am=Physimple(am);\r
4025         if ((int)*am >=0)\r
4026         {\r
4027                 *am -= protnum1;\r
4028                 traverse(am,3);\r
4029         };\r
4030 }\r
4031 \r
4032 \r
4033 \r
4034 \r
4035 /*----------------------------------------------------------------------*/\r
4036 /*                                                                      */\r
4037 /*      Prologue:                                                       */\r
4038 /*              marking of all accessible objects                       */\r
4039 /*                                                                      */\r
4040 /*----------------------------------------------------------------------*/\r
4041 \r
4042 \r
4043 static prologue ()\r
4044 {\r
4045         unsigned int *am;\r
4046 \r
4047         am=Physimple(current);\r
4048         *am -= protnum1;\r
4049         traverse(am,3);\r
4050 }\r
4051 \r
4052 \r
4053 \r
4054 \r
4055 /*----------------------------------------------------------------------*/\r
4056 /*                                                                      */\r
4057 /*      Chorus song No 1:                                               */\r
4058 /*              for each free address change its guard counter on max   */\r
4059 /*                                                                      */\r
4060 /*----------------------------------------------------------------------*/\r
4061 \r
4062 \r
4063 static chorus_song_1 ()\r
4064 {\r
4065         unsigned int *t;\r
4066 \r
4067         t=freeitem;\r
4068         while (t) {\r
4069                 *(t+1)=maxcounter;\r
4070                 t= (unsigned int *) *t;\r
4071         };\r
4072 }\r
4073 \r
4074 \r
4075 \r
4076 /*----------------------------------------------------------------------*/\r
4077 /*                                                                      */\r
4078 /*      Act No 1:                                                       */\r
4079 /*              for each not-killed object  recognize those which       */\r
4080 /*              will be deallocated  because are not  accessible;       */\r
4081 /*              knowing  that these  objects  will be deallocated       */\r
4082 /*              correct the corresponding Statussl items.               */\r
4083 /*                                                                      */\r
4084 /*----------------------------------------------------------------------*/\r
4085 \r
4086 \r
4087 static act1 ()\r
4088 {\r
4089         unsigned int *t1,*t2;\r
4090         int a;\r
4091 \r
4092         for (t2= lastitem;t2<= Mupr;t2+=reflength)\r
4093         {\r
4094                 if(*(t2+1)==maxcounter) continue;\r
4095                 t1= (unsigned int *) *t2;\r
4096                 if ((int) *t1 >=0) traverse(t1,5);\r
4097         };\r
4098 }\r
4099 \r
4100 \r
4101 \r
4102 \r
4103 /*----------------------------------------------------------------------*/\r
4104 /*                                                                      */\r
4105 /*      Act No 2:                                                       */\r
4106 /*              each  non-accesible object  put on the list of killed   */\r
4107 /*              objects; for  each accessible  object put on M[am] ah   */\r
4108 /*              in order to be able in  act4  to  compute   on  M[ah]   */\r
4109 /*              updated am (Attention! for Ptposition=0,special case)   */\r
4110 /*                                                                      */\r
4111 /*----------------------------------------------------------------------*/\r
4112 \r
4113 \r
4114 \r
4115 static act2 ()\r
4116 {\r
4117         unsigned int *t1,*t2,*t3,l;\r
4118         int a;\r
4119 \r
4120         for (t1=lastitem;t1<= Mupr;t1+=reflength)\r
4121         {\r
4122                 if (*(t1+1)==maxcounter) continue;\r
4123                 t2= (unsigned int *) *t1;\r
4124                 if ((int) *t2<0)  *t2 += protnum1;\r
4125                 else\r
4126                 {\r
4127                         *(t1+1)=maxcounter;\r
4128                         a= *t2;\r
4129                         l=Size(a,t2);\r
4130                         t2-=Ptposition(a);\r
4131                         *t2=l;\r
4132                         Insert(t2);\r
4133                         continue;\r
4134                 };\r
4135                 a= *t2;\r
4136                 if (Ptposition(a))\r
4137                 {\r
4138                         t3=t2-Ptposition(a);\r
4139                         *t1= *t3;\r
4140                         *t3= *t2;\r
4141                         *t2= (unsigned int)t1;\r
4142                 }\r
4143                 else\r
4144                 {\r
4145                         *t1= *(t2+1);\r
4146                         *(t2+1)= (unsigned int) t1;\r
4147                 };\r
4148         };\r
4149 }  /* end act2 */\r
4150 \r
4151 \r
4152 \r
4153 \r
4154 \r
4155 \r
4156 \r
4157 /*----------------------------------------------------------------------*/\r
4158 /*                                                                      */\r
4159 /*      Chorus song No 2:                                               */\r
4160 /*              marking of all killed objects                           */\r
4161 /*                                                                      */\r
4162 /*----------------------------------------------------------------------*/\r
4163 \r
4164 \r
4165 #define skilled (-1)            /* marking for killed object */\r
4166 \r
4167 static chorus_song_2 ()\r
4168 {\r
4169         unsigned int *t1,*t2,*t3;\r
4170 \r
4171         t1=headkmin;\r
4172         while (t1)\r
4173         {\r
4174                 t2=(unsigned int *) *(t1+shortlink);\r
4175                 *(t1+shortlink)=minsize;\r
4176                 *t1=skilled;\r
4177                 t1=t2;\r
4178         };\r
4179         t1=headk;\r
4180         while (t1!= Mlwr)\r
4181         {\r
4182                 t2=t1;\r
4183                 while (t2)\r
4184                 {\r
4185                         t3= (unsigned int *)*(t2+shortlink);\r
4186                         *(t2+shortlink)= *t2;\r
4187                         *t2=skilled;\r
4188                         t2=t3;\r
4189                 };\r
4190                 t1= (unsigned int *) *(t1+longlink);\r
4191         };\r
4192 }\r
4193 \r
4194 \r
4195 \r
4196 \r
4197 /*----------------------------------------------------------------------*/\r
4198 /*                                                                      */\r
4199 /*      Auxiliary procedure nonefy called by traverse. It sets to none  */\r
4200 /*              [M0,0] each reference which points no object.           */\r
4201 /*                                                                      */\r
4202 /*----------------------------------------------------------------------*/\r
4203 \r
4204 static nonefy (am)\r
4205 unsigned int *am;\r
4206 {\r
4207         if ( Notmember(am)) Setnone(am);\r
4208 }\r
4209 \r
4210 \r
4211 \r
4212 /*----------------------------------------------------------------------*/\r
4213 /*                                                                      */\r
4214 /*      Act No 3:                                                       */\r
4215 /*              traverse memory and for all alive objects set to [M0,0] */\r
4216 /*              each reference pointing no object                       */\r
4217 /*                                                                      */\r
4218 /*----------------------------------------------------------------------*/\r
4219 \r
4220 static act3 ()\r
4221 {\r
4222         unsigned int *t1,*t2,*t3,l;\r
4223         int a;\r
4224 \r
4225         t1= Mlwr+1;\r
4226         while (t1<=lastused)\r
4227         {\r
4228                 if ( *t1!=skilled)\r
4229                 {\r
4230                         a= *t1;\r
4231                         if (Ptposition(a))\r
4232                         {\r
4233                                 t2=t1+Ptposition(a);\r
4234                                 t3= (unsigned int *)*t2;\r
4235                                 *t1= *t3;\r
4236                                 *t2=  a;\r
4237                         }\r
4238                         else\r
4239                         {\r
4240                                 t3= (unsigned int *) *(t1+1);\r
4241                                 *(t1+1)= *t3;\r
4242                                 t2=t1;\r
4243                         };\r
4244                         l=Size(a,t2);\r
4245                         traverse(t2,1);\r
4246                         if (Ptposition(a))\r
4247                         {\r
4248                                 *t2= (unsigned int) t3;\r
4249                                 *t1= a;\r
4250                         }\r
4251                         else\r
4252                                 *(t1+1)= (unsigned int)t3;\r
4253                         t1+=l;\r
4254                 }\r
4255                 else\r
4256                         t1+= *(t1+shortlink);\r
4257         };\r
4258         for (t1=vipt1; t1<=viptn; t1+=reflength) nonefy(t1);\r
4259 }       /* end act3 */\r
4260 \r
4261 \r
4262 \r
4263 /*----------------------------------------------------------------------*/\r
4264 /*                                                                      */\r
4265 /*      Chorus song No 3:                                               */\r
4266 /*              compute new values of indirect addresses and put them   */\r
4267 /*              on guard counters; this enables to update  references   */\r
4268 /*              during memory squeezing; now M[ah+1]= future ah         */\r
4269 /*                                                                      */\r
4270 /*----------------------------------------------------------------------*/\r
4271 \r
4272 static chorus_song_3()\r
4273 {\r
4274         unsigned int *t1,*t2;\r
4275 \r
4276         t1= Mupr-1;\r
4277         for ( t2= Mupr; t2>= lastitem; t2-=reflength)\r
4278         {\r
4279                 if (*t2==maxcounter) *t2= (unsigned int)M0;\r
4280                 else\r
4281                 {\r
4282                         *t2= (unsigned int)t1;\r
4283                         t1-=reflength;\r
4284                 };\r
4285         };\r
4286 }\r
4287 \r
4288 \r
4289 \r
4290 /*----------------------------------------------------------------------*/\r
4291 /*                                                                      */\r
4292 /*      Two auxiliary procedures relocate and relocs are used in  act4. */\r
4293 /*      They update for each  reference  its  ah  taking a new one from */\r
4294 /*      M[ah+1] computed in chorus song No 3.  Procedure  relocates  is */\r
4295 /*      applied for full references,  procedure relocs for simplified.  */\r
4296 /*                                                                      */\r
4297 /*----------------------------------------------------------------------*/\r
4298 \r
4299 static relocate(am)\r
4300 unsigned int *am;\r
4301 {\r
4302         *am= *( (unsigned int *)*am+1);\r
4303         *(am+1)=0;\r
4304 }\r
4305 \r
4306 static relocs(am)\r
4307 unsigned int *am;\r
4308 {\r
4309         if (*am==0) return;\r
4310         *am= *( (unsigned int *)*am+1);\r
4311 }\r
4312 \r
4313 \r
4314 \r
4315 /*----------------------------------------------------------------------*/\r
4316 /*                                                                      */\r
4317 /*      Act No 4:                                                       */\r
4318 /*              squeeze memory;  for all alive objects  update  all     */\r
4319 /*              references using traverse with relocate and relocs;     */\r
4320 /*              simultaneously update M[ah] with a new value  of am     */\r
4321 /*              obtained after squeezing memory;  reconstruct  also     */\r
4322 /*              the value of M[am] changed in act2.                     */\r
4323 /*                                                                      */\r
4324 /*                                                                      */\r
4325 /*----------------------------------------------------------------------*/\r
4326 \r
4327 static act4()\r
4328 {\r
4329         unsigned int *t1,*t2,*t3,*t4,*t5,l,k;\r
4330         int a;\r
4331 \r
4332         t1= Mlwr+1;\r
4333         t2=t1;\r
4334         while (t1<=lastused)\r
4335         {\r
4336                 if (*t1==skilled)           t1+=  *(t1+shortlink);\r
4337                 else\r
4338                 {\r
4339                         t5=(unsigned int *) *t1;\r
4340                         a=(int)t5;\r
4341                         t3=t1+Ptposition(a);\r
4342                         if (Ptposition(a))\r
4343                         {\r
4344                                 t4= (unsigned int *)*t3;\r
4345                                 *t3=(unsigned int)t5;\r
4346                                 *t1= *t4;\r
4347                         }\r
4348                         else\r
4349                         {\r
4350                                 t4= (unsigned int *)*(t1+1);\r
4351                                 *(t1+1)= *t4;\r
4352                         };\r
4353                         l=Size(a,t3);\r
4354                         t3=t2;\r
4355                         for (k=1;k<=l;++k)\r
4356                                 *t3++= *t1++;\r
4357                         t5=t2+Ptposition(a);\r
4358                         *t4= (unsigned int)t5;\r
4359                         traverse(t5,2);\r
4360                         t2+=l;\r
4361                 };\r
4362         };\r
4363         for (t1=vipt1;t1<=viptn; t1+=reflength) relocate(t1);\r
4364         lastused=t2-1;\r
4365         headkmin=0;\r
4366         headk= Mlwr;\r
4367 }  /* end act4 */\r
4368 \r
4369 \r
4370 /*----------------------------------------------------------------------*/\r
4371 /*                                                                      */\r
4372 /*      Epilogue:                                                       */\r
4373 /*              squeeze the indirect address table;update also some     */\r
4374 /*              Running System variables.                               */\r
4375 /*                                                                      */\r
4376 /*----------------------------------------------------------------------*/\r
4377 \r
4378 \r
4379 static epilogue ()                      /* update virtual addresses */\r
4380 {\r
4381         unsigned int *t1,*t2,*t3;\r
4382 \r
4383         t1= Mupr+1;\r
4384         for ( t3= Mupr-1; t3>=lastitem; t3-=reflength)\r
4385         {\r
4386                 t2= (unsigned int *)*(t3+1);\r
4387                 if (t2!=M0)\r
4388                 {\r
4389                         *t2= *t3;\r
4390                         *(t2+1)=0;\r
4391                         t1=t2;\r
4392                 };\r
4393         };\r
4394         lastitem=t1;\r
4395         freeitem=0;\r
4396         Update(current);                /* update DISPDIR */\r
4397         local=Physimple(current);       /* update local register */\r
4398 }\r
4399 \r
4400 \r
4401 /*----------------------------------------------------------------------*/\r
4402 /*                                                                      */\r
4403 /*              Compactify (call prepared procedures)                   */\r
4404 /*                                                                      */\r
4405 /*----------------------------------------------------------------------*/\r
4406 \r
4407 \r
4408 Compactify ()\r
4409 {\r
4410         int nlength;\r
4411         nlength=lastitem-lastused;\r
4412         prologue();\r
4413         chorus_song_1();\r
4414         act1();\r
4415         act2();\r
4416         chorus_song_2();\r
4417         act3();\r
4418         chorus_song_3();\r
4419         act4();\r
4420         epilogue();\r
4421         printf("\n Compactifier used; released space=%d\n",\r
4422         lastitem-lastused-nlength);\r
4423 }\r
4424 \r
4425 \r
4426 \r
4427 /*----------------------------------------------------------------------*/\r
4428 /*                                                                      */\r
4429 /*      Errors at run-time are handled by Error(n), where n is          */\r
4430 /*                      the error number.                               */\r
4431 /*                                                                      */\r
4432 /*----------------------------------------------------------------------*/\r
4433 \r
4434 \r
4435 \r
4436 \r
4437 \r
4438 \r
4439 \r
4440 static Error(n)\r
4441 char n;\r
4442 \r
4443 {\r
4444         switch (n)\r
4445         {\r
4446 \r
4447         case 1:\r
4448                 printf("\nReference to none\n");\r
4449                 longjmp(buffer,-2);\r
4450         case 2:\r
4451                 printf("\nIllegal attach\n");\r
4452                 longjmp(buffer,-2);\r
4453         case 3:\r
4454                 printf("\nCoroutine terminated\n");\r
4455                 longjmp(buffer,-2);\r
4456         case 4:\r
4457                 printf("\nImproper coroutine end\n");\r
4458                 longjmp(buffer,-2);\r
4459         case 5:\r
4460                 printf("\nIncorrect kill\n");\r
4461                 longjmp(buffer,-2);\r
4462         case 6:\r
4463                 printf("\nArray index error\n");\r
4464                 longjmp(buffer,-2);\r
4465         case 7:\r
4466                 printf("\nIllegal array generation\n");\r
4467                 longjmp(buffer,-2);\r
4468         case 8:\r
4469                 printf("\nMemory overflow\n");\r
4470                 longjmp(buffer,-2);\r
4471         case 9:\r
4472                 printf("\nend of a program execution\n");\r
4473                 longjmp(buffer,-2);\r
4474         case 10:\r
4475                 printf("\nhandler not found\n");\r
4476                 longjmp(buffer,-2);\r
4477         };\r
4478 }\r
4479 \r
4480 \r
4481 \r
4482 /*----------------------------------------------------------------------*/\r
4483 /*                                                                      */\r
4484 /*      Openrc:                                                         */\r
4485 /*              opens a new object of a class without system attributes */\r
4486 /*              a - prototype number,                                   */\r
4487 /*              X - reference to the opened object                      */\r
4488 /*                                                                      */\r
4489 /*----------------------------------------------------------------------*/\r
4490 \r
4491 Openrc (a,X)\r
4492 int a;\r
4493 unsigned int *X;\r
4494 \r
4495 {\r
4496         unsigned int *am;\r
4497 \r
4498         Request(a,Size(a,0),X);\r
4499         am=Physimple(X);\r
4500         traverse(am,4);\r
4501 }\r
4502 \r
4503 \r
4504 \r
4505 \r
4506 /*----------------------------------------------------------------------*/\r
4507 /*                                                                      */\r
4508 /*      Slopen:                                                         */\r
4509 /*              opens a new object of with explicitly given Sl-father   */\r
4510 /*              a - prototype number,                                   */\r
4511 /*              X - reference to the opened object                      */\r
4512 /*              Y - reference to its Sl-father                          */\r
4513 /*                                                                      */\r
4514 /*----------------------------------------------------------------------*/\r
4515 \r
4516 \r
4517 \r
4518 Slopen (a,X,Y)\r
4519 \r
4520 unsigned int *X,*Y;\r
4521 int a;\r
4522 \r
4523 {\r
4524         unsigned int *am,*Slr,*Dlr;\r
4525 \r
4526         Request(a,Size(a,0),X);\r
4527         am=Physimple(X);\r
4528         traverse(am,4);\r
4529         *Statsl(a,am)=0;\r
4530         Slr=Sl(a,am);\r
4531         *Slr= *Y;\r
4532         Dlr=Dl(a,am);\r
4533         *Dlr= *current;\r
4534         am=Physimple(Y);\r
4535         a= *am;\r
4536         (*Statsl(a,am))++;\r
4537 }\r
4538 \r
4539 \r
4540 \r
4541 /*----------------------------------------------------------------------*/\r
4542 /*                                                                      */\r
4543 /*      Dopen:                                                          */\r
4544 /*              opens a new object of a visible module                  */\r
4545 /*              a - prototype number,                                   */\r
4546 /*              b - prototype number of a's static father               */\r
4547 /*              X - reference to the opened object                      */\r
4548 /*                                                                      */\r
4549 /*----------------------------------------------------------------------*/\r
4550 \r
4551 Dopen(a,b,X)\r
4552 \r
4553 int a,b;\r
4554 unsigned int *X;\r
4555 \r
4556 {\r
4557         int c;\r
4558 \r
4559         c=PROT[a].decl;\r
4560         Slopen(a,X,DISPLAY+reflength*perm[PROT[b].permadd+PROT[c].level]);\r
4561 }\r
4562 \r
4563 \r
4564 \r
4565 /*----------------------------------------------------------------------*/\r
4566 /*                                                                      */\r
4567 /*      Openarray:                                                      */\r
4568 /*              opens a new array                                       */\r
4569 /*              a - prototype number,                                   */\r
4570 /*              l - lower bound                                         */\r
4571 /*              u - upper bound                                         */\r
4572 /*              X - reference to the opened object                      */\r
4573 /*                                                                      */\r
4574 /*----------------------------------------------------------------------*/\r
4575 \r
4576 Openarray (a,l,u,X)\r
4577 \r
4578 int l,u;\r
4579 int a;\r
4580 unsigned int *X;\r
4581 \r
4582 {\r
4583         unsigned int length;\r
4584         unsigned int *am;\r
4585 \r
4586         if (u<l) Raising(illarray,vipt2);\r
4587         length=u-l+1;\r
4588         switch (PROT[a].kind)\r
4589         {\r
4590         case PRIMITARRAY :\r
4591                 length=length*PROT[a].elsize ;\r
4592                 break;\r
4593         case REFARRAY :\r
4594         case SUBARRAY :\r
4595                 length=length*reflength;\r
4596                 break;\r
4597         case STRUCTARRAY :\r
4598                 length=length*(OFF[PROT[a].references].size);\r
4599                 break;\r
4600         case POINTARRAY :\r
4601                 break;\r
4602         };\r
4603         length+=elmoffset;\r
4604         Request(a,length,X);\r
4605         am=Physimple(X);\r
4606         *(am+lboffset)=l;\r
4607         *(am+uboffset)=u;\r
4608         traverse(am,4);\r
4609 }\r
4610 \r
4611 \r
4612 \r
4613 /*----------------------------------------------------------------------*/\r
4614 /*                                                                      */\r
4615 /*      Go:                                                             */\r
4616 /*              calls an object X                                       */\r
4617 /*              X - reference to the object                             */\r
4618 /*                                                                      */\r
4619 /*----------------------------------------------------------------------*/\r
4620 \r
4621 Go (X)\r
4622 unsigned int *X;\r
4623 \r
4624 {\r
4625         int a,b;\r
4626 \r
4627         a= *local;\r
4628         *(Lsc(a,local))=IC*protnum1+modulenumber;\r
4629         Update(X);\r
4630         Refmove(current,X);\r
4631         local=Physimple(X);\r
4632         a= *local;\r
4633         b=a;\r
4634         switch (PROT[a].kind)\r
4635         {\r
4636         case HANDLER:\r
4637                 break;\r
4638         default:\r
4639                 while (a >=0)\r
4640                 {\r
4641                         switch (PROT[a].kind)\r
4642                         {\r
4643                         case RECORD:\r
4644                                 break;\r
4645                         default:\r
4646                                 b=a;\r
4647                         };\r
4648                         a=PROT[a].pref;\r
4649                 };\r
4650         };\r
4651         IC=1;\r
4652         modulenumber=b;\r
4653         longjmp(buffer,-1);\r
4654 }\r
4655 \r
4656 \r
4657 \r
4658 /*----------------------------------------------------------------------*/\r
4659 /*                                                                      */\r
4660 /*      Back:                                                           */\r
4661 /*              explicit return statement                               */\r
4662 /*              used also in end of unprefixed subprogram or block      */\r
4663 /*                                                                      */\r
4664 /*----------------------------------------------------------------------*/\r
4665 \r
4666 \r
4667 Back ()\r
4668 {\r
4669         unsigned int *Dlr;\r
4670         int a;\r
4671 \r
4672         a= *local;\r
4673         Dlr=Dl(a,local);\r
4674         if (*Dlr==0) Endcor();\r
4675         Refmove(vipt2,current);\r
4676         *Lsc(a,local)=IC*protnum1+modulenumber;\r
4677         Refset(current,Dlr);\r
4678         *Dlr= *vipt2;\r
4679         Update(current);\r
4680         local=Physimple(current);\r
4681         a= *local;\r
4682         IC= *Lsc(a,local);\r
4683         modulenumber=IC%protnum1;\r
4684         IC=IC/protnum1;\r
4685         longjmp(buffer,-1);\r
4686 }\r
4687 \r
4688 \r
4689 \r
4690 /*----------------------------------------------------------------------*/\r
4691 /*                                                                      */\r
4692 /*      Endclass:                                                       */\r
4693 /*              end of class statement                                  */\r
4694 /*                                                                      */\r
4695 /*----------------------------------------------------------------------*/\r
4696 \r
4697 Endclass ()\r
4698 {\r
4699         int a;\r
4700 \r
4701         a= *local;\r
4702         switch (PROT[a].kind)\r
4703         {\r
4704         case CLASS:\r
4705         case SUBROUTINE: Back(); break;\r
4706         case COROUTINE: Endcor(); break;\r
4707         };\r
4708 }\r
4709 \r
4710 \r
4711 \r
4712 \r
4713 \r
4714 \r
4715 \r
4716 \r
4717 \r
4718 \r
4719 \r
4720 /*----------------------------------------------------------------------*/\r
4721 /*                                                                      */\r
4722 /*      Inner:                                                          */\r
4723 /*              passes control to a subclass                            */\r
4724 /*              k - class level in the inheritance sequence             */\r
4725 /*                                                                      */\r
4726 /*----------------------------------------------------------------------*/\r
4727 \r
4728 Inn(k)\r
4729 int k;\r
4730 {\r
4731         int t,a;\r
4732 \r
4733         a= *local;\r
4734         if (PROT[a].pslength==k) return;\r
4735         for (t=2; t<=PROT[a].pslength-k; ++t) a=PROT[a].pref;\r
4736         IC=1;\r
4737         modulenumber=a;\r
4738         longjmp(buffer,-1);\r
4739 }\r
4740 \r
4741 \r
4742 \r
4743 \r
4744 /*----------------------------------------------------------------------*/\r
4745 /*                                                                      */\r
4746 /*      Endrun:                                                         */\r
4747 /*              end of computations                                     */\r
4748 /*                                                                      */\r
4749 /*----------------------------------------------------------------------*/\r
4750 \r
4751 \r
4752 Endrun ()\r
4753 {\r
4754         Error(9);\r
4755 }\r
4756 \r
4757 \r
4758 \r
4759 \r
4760 /*----------------------------------------------------------------------*/\r
4761 /*                                                                      */\r
4762 /*      Update:                                                         */\r
4763 /*              update display algorithm; no way to explain how it      */\r
4764 /*              works without a special theoretical background.         */\r
4765 /*              X - reference to an object which will be active         */\r
4766 /*                                                                      */\r
4767 /*----------------------------------------------------------------------*/\r
4768 \r
4769 \r
4770 static Update (X)\r
4771 unsigned int *X;\r
4772 \r
4773 {\r
4774         int a,c,d,j,k,permadd,l;\r
4775         unsigned int *am;\r
4776 \r
4777         am=Physimple(X);\r
4778         a= *am;\r
4779         k=PROT[a].level;\r
4780         d=a;\r
4781         permadd=PROT[a].permadd;\r
4782         while(1)\r
4783         {\r
4784                 l=perm[permadd+k];\r
4785                 Refset(DISPLAY+reflength*l,X);\r
4786                 *(DISPDIR+l)= (unsigned int )am;\r
4787                 if (k--==0)  return;\r
4788                 j=perminv[PROT[a].permadd+perm[PROT[d].permadd+k]];\r
4789                 d=PROT[d].decl;\r
4790                 do\r
4791                     {\r
4792                         c=PROT[a].decl;\r
4793                         X=Sl(a,am);\r
4794                         am=Physimple(X);\r
4795                         a= *am;\r
4796                         j=perminv[PROT[a].permadd+perm[PROT[c].permadd+j]];\r
4797                 }\r
4798                 while (PROT[a].level-j);\r
4799         };\r
4800 }                       /* end of update */\r
4801 \r
4802 \r
4803 \r
4804 \r
4805 /*----------------------------------------------------------------------*/\r
4806 /*                                                                      */\r
4807 /*      Gkill:                                                          */\r
4808 /*              deallocates a class, an array or a coroutine object     */\r
4809 /*              for coroutines deallocates the whole cycle              */\r
4810 /*              X - reference to the object                             */\r
4811 /*                                                                      */\r
4812 /*----------------------------------------------------------------------*/\r
4813 \r
4814 Gkill(X)\r
4815 unsigned int *X;\r
4816 {\r
4817         unsigned int *am,*Dlr;\r
4818         int a;\r
4819 \r
4820         if (Notmember(X) ) return;\r
4821         am=Physimple(X);\r
4822         a= *am;\r
4823         switch (PROT[a].kind)\r
4824         {\r
4825         case PRIMITARRAY:\r
4826         case REFARRAY:\r
4827         case SUBARRAY:\r
4828         case STRUCTARRAY:\r
4829         case POINTARRAY:\r
4830         case RECORD:\r
4831                 Disp(X);\r
4832                 return;\r
4833         case CLASS:\r
4834                 if ( *Statsl(a,am))  Raising(incorkill,vipt2);\r
4835                 Refset(vipt3,Sl(a,am));\r
4836                 Disp(X);\r
4837                 Killer();\r
4838                 return;\r
4839         case COROUTINE:\r
4840         case PROCESS:\r
4841                 Dlr=X;\r
4842                 while (1)\r
4843                 {\r
4844                         Refset(vipt4,Dlr);\r
4845                         if ( *Statsl(a,am))  Raising(incorkill,vipt2);\r
4846                         Dlr=Dl(a,am);\r
4847                         if (Physimple(X)==Physimple(Dlr)) break;\r
4848                         am=Physimple(Dlr);\r
4849                         a= *am;\r
4850                 };\r
4851 \r
4852                 Refmove(vipt2,X);\r
4853                 do\r
4854                     {\r
4855                         am=Physimple(vipt2);\r
4856                         a= *am;\r
4857                         Dlr=Dl(a,am);\r
4858                         Refset(vipt3,Dlr);\r
4859                         *Dlr= *vipt4;\r
4860                         Refmove(vipt4,vipt2);\r
4861                         Refmove(vipt2,vipt3);\r
4862                 }\r
4863                 while (Notequal(vipt2,X));\r
4864                 do\r
4865                     {\r
4866                         am=Physimple(X);\r
4867                         a= *am;\r
4868                         Refset(vipt3,Sl(a,am));\r
4869                         Refset(vipt4,Dl(a,am));\r
4870                         Disp(X);\r
4871                         Killer ();\r
4872                         Refmove(X,vipt4);\r
4873                 }\r
4874                 while (Member(X));\r
4875                 return;\r
4876         default:\r
4877                 Raising(incorkill,vipt2);\r
4878         };\r
4879 }                /* end Gkill  */\r
4880 \r
4881 \r
4882 \r
4883 \r
4884 /*----------------------------------------------------------------------*/\r
4885 /*                                                                      */\r
4886 /*      Endcor:                                                         */\r
4887 /*              end of coroutine; it is different than return;          */\r
4888 /*              treated as an error                                     */\r
4889 /*----------------------------------------------------------------------*/\r
4890 \r
4891 \r
4892 \r
4893 Endcor ()\r
4894 {\r
4895 \r
4896         if (Member(lastcor))\r
4897         {\r
4898                 Attachwith(lastcor,imprterm,vipt2);\r
4899                 IC=0;\r
4900                 Attach(lastcor);\r
4901         }\r
4902         else\r
4903         {\r
4904                 Attachwith(myprocess,imprterm,vipt2);\r
4905                 IC=0;\r
4906                 Attach(myprocess);\r
4907         };\r
4908 }\r
4909 \r
4910 \r
4911 \r
4912 /*----------------------------------------------------------------------*/\r
4913 /*                                                                      */\r
4914 /*      Atthelp:                                                        */\r
4915 /*              auxiliary for Attach and Attachwith                     */\r
4916 /*              X - reference to a    coroutine                         */\r
4917 /*                                                                      */\r
4918 /*----------------------------------------------------------------------*/\r
4919 \r
4920 \r
4921 static Atthelp(X)\r
4922 unsigned int *X;\r
4923 {\r
4924         unsigned int *amnew,*amold,*Dlr;\r
4925         int a,b;\r
4926 \r
4927         if ( Notmember(X)) Raising(ilattach,vipt2);\r
4928         amnew=Physimple(X);\r
4929         a= *amnew;\r
4930         switch(PROT[a].kind)\r
4931         {\r
4932         case COROUTINE:\r
4933         case PROCESS :\r
4934                 break;\r
4935         default:\r
4936                 Raising(ilattach,vipt2);\r
4937         };\r
4938         if ( *Lsc(a,amnew)<protnum1) Raising(corterm,vipt2);\r
4939         if (Equal(mycoroutine,X)) return;\r
4940         Refmove(vipt2,mycoroutine);\r
4941         amold=Physimple(mycoroutine);\r
4942         b= *amold;\r
4943         Dlr=Dl(b,amold);\r
4944         Refmove(mycoroutine,X);\r
4945         *Dlr= *current;\r
4946         Refmove(lastcor,vipt2);\r
4947         b=a;\r
4948         Dlr=Dl(b,amnew);\r
4949         a= *local;\r
4950         *Lsc(a,local)=IC*protnum1+modulenumber;\r
4951         Update(Dlr);\r
4952         Refset(current,Dlr);\r
4953         *Dlr=0;\r
4954         local=Physimple(current);\r
4955         a= *local;\r
4956         IC= *Lsc(a,local);\r
4957 }   /*end  Atthhelp */\r
4958 \r
4959 \r
4960 \r
4961 /*----------------------------------------------------------------------*/\r
4962 /*                                                                      */\r
4963 /*      Attach:                                                         */\r
4964 /*              attaches coroutine X                                    */\r
4965 /*              X - reference to  a coroutine                           */\r
4966 /*                                                                      */\r
4967 /*----------------------------------------------------------------------*/\r
4968 \r
4969 Attach(X)\r
4970 unsigned int *X;\r
4971 {\r
4972         Atthelp(X);\r
4973         modulenumber=IC%protnum1;\r
4974         IC=IC/protnum1;\r
4975         longjmp(buffer,-1);\r
4976 }\r
4977 \r
4978 \r
4979 \r
4980 \r
4981 \r
4982 /*----------------------------------------------------------------------*/\r
4983 /*                                                                      */\r
4984 /*      Raising:                                                        */\r
4985 /*              raises a signal                                         */\r
4986 /*              signalnum- signal number,                               */\r
4987 /*              X - reference to the opened object                      */\r
4988 /*                                                                      */\r
4989 /*----------------------------------------------------------------------*/\r
4990 \r
4991 \r
4992 Raising(signalnum,X)\r
4993 int signalnum;\r
4994 unsigned int *X;\r
4995 {\r
4996         unsigned int *am,*Y;\r
4997         int a,b,h,s;\r
4998 \r
4999         Y=current;\r
5000         while (*Y!=0)\r
5001         {\r
5002                 am=Physimple(Y);\r
5003                 a= *am;\r
5004                 switch (PROT[a].kind)\r
5005                 {\r
5006                 case HANDLER:\r
5007                         Y=Sl(a,am);\r
5008                         continue;\r
5009                 };\r
5010                 b=a;\r
5011                 while (b>=0)\r
5012                 {\r
5013                         h=PROT[b].handlist;\r
5014                         while (h>=0)\r
5015                         {\r
5016                                 if (PROT[HL[h].hand].others &&\r
5017                                     signalnum<=syssigl)\r
5018                                 {\r
5019                                         Slopen(HL[h].hand,X,Y);\r
5020                                         return;\r
5021                                 };\r
5022                                 s=HL[h].signlist;\r
5023                                 while (s>=0)\r
5024                                 {\r
5025                                         if (SL[s].signalnum==signalnum)\r
5026                                         {\r
5027                                                 Slopen(HL[h].hand,X,Y);\r
5028                                                 return;\r
5029                                         };\r
5030                                         s=SL[s].next;\r
5031                                 };\r
5032                                 h=HL[h].next;\r
5033                         };\r
5034                         b=PROT[b].pref;\r
5035                 };\r
5036                 Y=Dl(a,am);\r
5037         };\r
5038         if (signalnum<=syssigl)\r
5039                  Error(signalnum);\r
5040         else Error(10);                 /* handler not found */\r
5041 }   /* end Raising  */\r
5042 \r
5043 \r
5044 \r
5045 \r
5046 /*----------------------------------------------------------------------*/\r
5047 /*                                                                      */\r
5048 /*      Attachwith:                                                     */\r
5049 /*              raises a signal in another coroutine                    */\r
5050 /*              signalnum - signal number,                              */\r
5051 /*              X - reference to the  coroutine                         */\r
5052 /*              Y - reference to the opened object                      */\r
5053 /*                                                                      */\r
5054 /*----------------------------------------------------------------------*/\r
5055 \r
5056 \r
5057 Attachwith(X,signalnum,Y)\r
5058 unsigned int *X,*Y;\r
5059 int signalnum;\r
5060 \r
5061 {\r
5062 \r
5063         Refmove(vipt3,mycoroutine);\r
5064         Atthelp(X);\r
5065         Raising(signalnum,Y);\r
5066         IC=1;\r
5067         Refmove(current,Y);\r
5068         local=Physimple(current);\r
5069         Atthelp(vipt3);\r
5070 }\r
5071 \r
5072 \r
5073 \r
5074 /*----------------------------------------------------------------------*/\r
5075 /*                                                                      */\r
5076 /*      Termination:                                                    */\r
5077 /*              terminates an active dynamic chain                      */\r
5078 /*                                                                      */\r
5079 /*----------------------------------------------------------------------*/\r
5080 \r
5081 \r
5082 Termination ()\r
5083 {\r
5084         unsigned int *X,*Y,*am;\r
5085         int a,b;\r
5086 \r
5087         a= *local;\r
5088         X=Sl(a,local);\r
5089         Y=Dl(a,local);\r
5090         am=Physimple(X);\r
5091         while (1)\r
5092         {\r
5093                 Y=Physimple(Y);\r
5094                 b= *Y;\r
5095                 *Lsc(b,Y)=PROT[b].lastwill*protnum1+b;\r
5096                 if (Y==am) return;\r
5097                 Y=Dl(b,Y);\r
5098         };\r
5099 }\r
5100 \r
5101 \r
5102 \r
5103 \r
5104 /*----------------------------------------------------------------------*/\r
5105 /*                                                                      */\r
5106 /*      Init:                                                           */\r
5107 /*               initialize all RS data                                 */\r
5108 /*                                                                      */\r
5109 /*----------------------------------------------------------------------*/\r
5110 \r
5111 \r
5112 \r
5113 Init ()\r
5114 {\r
5115 \r
5116         protnum1=protnum+1;\r
5117         M0= &M[0];\r
5118         M[0]=0;\r
5119         M[1]= (unsigned int) M0;\r
5120         vipt1= &M[virt1];\r
5121         vipt2= &M[virt2];\r
5122         vipt3= &M[virt3];\r
5123         viptn=vipt4= &M[virt4];\r
5124         myprocess= vipt1;\r
5125         freeitem= 0;\r
5126         Mlwr= &M[lwr];\r
5127         Mupr= &M[upr];\r
5128         lastused=Mlwr;\r
5129         headk=Mlwr;\r
5130         headkmin=0;\r
5131         lastitem= Mupr+1;\r
5132         M[lwr]=maxapp;\r
5133         Request(0,Size(0,0),vipt1);\r
5134         global=local=Physimple(vipt1);\r
5135         *Statsl(0,local)=0;\r
5136         traverse(local,4);\r
5137         DISPLAY= local+displ;\r
5138         current= local+curr;\r
5139         Refmove(current,vipt1);\r
5140         Refmove(DISPLAY,current);\r
5141         DISPDIR= local +displdir;\r
5142         *DISPDIR = (unsigned int) local;\r
5143         lastcor= local+lstcor;\r
5144         mycoroutine= local+chead;\r
5145         Refmove(mycoroutine,current);\r
5146 }\r
5147 \r
5148 \r
5149 \r
5150 \r
5151 \r
5152 /*----------------------------------------------------------------------*/\r
5153 /*                                                                      */\r
5154 /*      Arrayelem:                                                      */\r
5155 /*              compute final address of an array element               */\r
5156 /*              X - reference to the  array object                      */\r
5157 /*              i - element index                                       */\r
5158 /*                                                                      */\r
5159 /*----------------------------------------------------------------------*/\r
5160 \r
5161 \r
5162 unsigned int *Arrayelem (X,i)\r
5163 unsigned int *X;\r
5164 int i;\r
5165 {\r
5166         int a;\r
5167         unsigned int *am,length;\r
5168 \r
5169         am=Physical(X);\r
5170         a= *am;\r
5171         if (i> (int) *(am+uboffset)) Raising(arrayind,vipt2);\r
5172         i-= (int) *(am+lboffset);\r
5173         if (i<0) Raising(arrayind,vipt2);\r
5174         switch (PROT[a].kind)\r
5175         {\r
5176         case PRIMITARRAY:\r
5177                 length=PROT[a].elsize;\r
5178                 break;\r
5179         case REFARRAY:\r
5180         case SUBARRAY:\r
5181                 length=reflength;\r
5182                 break;\r
5183         case STRUCTARRAY:\r
5184                 length=OFF[PROT[a].references].size;\r
5185                 break;\r
5186         case POINTARRAY:\r
5187                 length=1;\r
5188                 break;\r
5189         };\r
5190         am+=elmoffset+length*i;\r
5191         return(am);\r
5192 }\r
5193 \r
5194 \r
5195 \1a\r
5196 #include <setjmp.h>\r
5197                 /* on-line functions */\r
5198 \r
5199 \r
5200 #define Physimple(X)  (unsigned int *)(* ((unsigned int *) *X))\r
5201 #define Notmember(X)  ( *(X+1)!= *((unsigned int *)*X+1) )\r
5202 #define Member(X)     ( *(X+1)== *((unsigned int *)*X+1) )\r
5203 \r
5204 #define Address(dnum,off) ((unsigned int *)*(DISPDIR+dnum)+off)\r
5205 #define Local(off)  (local+off)\r
5206 #define Global(off) (global+off)\r
5207 #define Fladdress(dnum,off) (float *) ((unsigned int *)*(DISPDIR+dnum)+off)\r
5208 #define Fllocal(off) (float *)(local+off)\r
5209 #define Flglobal(off) (float *)(global+off)\r
5210 \r
5211 \r
5212                 /* repeated headings */\r
5213 \r
5214 unsigned int * Arrayelem();\r
5215 unsigned int * Physical();\r
5216 \r
5217 \r
5218                 /*  global common variables */\r
5219 \r
5220 \r
5221                 /* constants for standard signals */\r
5222 \r
5223 \r
5224 #define syssigl 100\r
5225 #define reftonone 1\r
5226 #define ilattach 2\r
5227 #define corterm 3\r
5228 #define imprterm 4\r
5229 #define incorkill 5\r
5230 #define arrayind 6\r
5231 #define illarray 7\r
5232 \r
5233 \r
5234                 /* common structures */\r
5235 \r
5236     enum { CLASS,SUBROUTINE,PROCESS,COROUTINE,HANDLER,RECORD,\r
5237            PRIMITARRAY,REFARRAY,SUBARRAY,STRUCTARRAY,POINTARRAY};\r
5238 \r
5239 struct Prototype\r
5240 \r
5241 {\r
5242         int kind;                       /* prototype kind  */\r
5243         int num;                        /* numer of prototype */\r
5244         int lspan,rspan;                /* lspan for arrays = elsize */\r
5245         int references;                 /* address of reference structure */\r
5246         int decl,level;                 /* sl-father and depth in sl-tree */\r
5247         int lastwill;                   /* label for lastwill statements */\r
5248         int permadd;                    /* address of permutations */\r
5249         int Sloffset,Dloffset;          /* offsets of */\r
5250         int Statoffset,Lscoffset;       /* system attributes */\r
5251         int handlist;                   /* handlerlist for handlers=others */\r
5252         int pref,pslength;              /* address of pref father, prefix */\r
5253                                         /* sequence length, both */\r
5254                                         /* for handlers not existant */\r
5255 \r
5256 };\r
5257 \r
5258 #define elsize lspan\r
5259 #define others handlist\r
5260 \r
5261 \r
5262 /* Structure for handlers  */\r
5263 \r
5264 struct Hlstelem\r
5265 {\r
5266         int hand;                       /* handler prototype */\r
5267         int signlist;                   /* address of signals */\r
5268         int next;\r
5269 };\r
5270 \r
5271 struct Sgelem\r
5272 {\r
5273         int signalnum;                  /* signal number */\r
5274         int next;\r
5275 };\r
5276 \r
5277 \r
5278 \r
5279 \r
5280 \r
5281 \r
5282 /* Structure for offsets of reference variables in objects */\r
5283 \r
5284 \r
5285 \r
5286 struct Elem\r
5287 {\r
5288         int offset;                     /* offset in a structure */\r
5289         int next;                       /* next list element */\r
5290         int references;                 /* for COMBINEDLIST points */\r
5291                                         /* the corresponding substructure */\r
5292                                         /* for SIMPLELIST  */\r
5293                                         /* 0 when it is fulladdress */\r
5294                                         /* 1 when it is shortaddress */\r
5295                                         /* 2 when it is procedure closure */\r
5296 };\r
5297 \r
5298 \r
5299 \r
5300     enum { SIMPLELIST,SEGMENT,REPEATED,COMBINEDLIST};   /* kind of structure */\r
5301 \r
5302 struct Offsets\r
5303 {\r
5304         int kind;               /* kind as above */\r
5305         int size;               /* size of characterized object */\r
5306         int num;                /* reference structure number */\r
5307         int length,finish;      /* for SIMPLELIST and COMBINEDLIST */\r
5308                                 /* length is a list length, finish not used */\r
5309                                 /* for SEGMENT length (start) and finish */\r
5310                                 /* define a segment span */\r
5311                                 /* for REPEATED length=ntimes */\r
5312                                 /* finish not used */\r
5313         int head;               /* for LISTS it is a list head */\r
5314                                 /* for SEGMENT  */\r
5315                                 /* 0 when they are fulladdresses */\r
5316                                 /* 1 when they are shortaddresses */\r
5317                                 /* 2 when they are procedure closures */\r
5318                                 /* for REPEATED not used */\r
5319         int references;         /* address of reference structure */\r
5320                                 /* used only for REPEATED */\r
5321 };\r
5322 \r
5323 #define start length\r
5324 #define ntimes length\r
5325 \r
5326 \1a\r