From:	MX%"antek@mimuw.edu.pl"  1-MAR-1993 17:47:52.39
To:	SALWICKI
CC:	
Subj:	

Date: Mon, 1 Mar 93 14:59:27 GMT
From: antek@mimuw.edu.pl
To: salwicki@pauvx1.univ-pau.fr

\1cw
\U1STANDARD
\U2POLISH
\U3ITALIC
\U4BOLD
\U"ORATOR
\U(PLORATOR
\+
\+
\ \ \ \ \
\-
\+
\+
\^\ \ \ \ \ \ \ \ \ \ \ \"PRZENASZALNY RUNNING SYSTEM NOWEGO LOGLANU\ \ \ \ \ \ \ \ \ \ \^
\-
\+
\+
\^\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ NAPISANY W J\(E\"ZYKU C\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \^
\-
\+

\-
\+
\,
\-
\+
\+

\-
\+

\-
\+
\^\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \1Antoni  Kreczmar\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \^
\-
\+
\ \
\-
\+

\-
\+

\-
\+
1. Wst\2e\1p
\-
\+

\-
\+
Poni\2x\1szy kr\2o\1tki opis Running Systemu dla \ nowego \ Loglanu \ opiera
\-
\+
si\2e \ \1w \ du\2x\1ym \ stopniu \ na \ poprzednich \ dokumentacjach. \ \ Przede
\-
\+
wszystkim na opisie Running \ Systemu \ Loglanu-82 \ oraz \ na \ dw\2o\1ch
\-
\+
pracach opublikowanych, \ tj. \ G.Cioni, \ "Programmed \ deallocation
\-
\+
without \ dangling \ reference" \ IPL \ 18(1984) \  pp.179-187, \ \ oraz
\-
\+
M.Krause, \ A.Kreczmar, \ H.Langmaack, \ A.Salwicki, \ M.Warpechowski
\-
\+
"Algebraic approach to ...." w Lecture Notes in Computer \ Science
\-
\+
Springer 208, pp.134-156. W pierwszej z tych prac \ opisano \ system
\-
\+
adresowania \ po\2s\1redniego \ dla \ Loglanu, \ \ a \ \ w \ \ drugiej \ \ dosy\2c
\-
\+
\1skomplikowane \ algorytmy \ poprawiania \ \  tablicy \ \ Display \ \ oraz
\-
\+
adresowania nielokalnego dla j\2e\1zyk\2o\1w z metodami dziedziczenia \ na
\-
\+
r\2ox\1nych poziomach. Bez znajomo\2s\1ci \ tych \ dw\2o\1ch \ prac \ zrozumienie
\-
\+
poni\2x\1szego kr\2o\1tkiego raportu jest niezwykle trudne. Radzimy \ wi\2e\1c
\-
\+
przed przyst\2a\1pienie do czytania niniejszego tekstu  zapozna\2c \ \1si\2e
\-
\+
\1z tymi dwiema pracami, \ jak \ r\2o\1wnie\2x \ \1z \ dokumentacj\2a \ \1w \   dw\2o\1ch
\-
\+
poprzednich jej postaciach (dla Loglanu-82 w \ pe\2l\1ni \ uruchominego
\-
\+
i dla Loglanu-84 w pr\2o\1bnej wersji loglanowej). \,
\-
\+
\,
\-
\+
Nowy RS  system dla nowego Loglanu \ zosta\2l \ \1napisany \ najpierw \ w
\-
\+
Loglanie-82, \ a \ nast\2e\1pnie \  w \ j\2e\1zyku \ C. \ Wyb\2o\1r \ j\2e\1zyka \ C \ by\2l
\-
\+
\1nieprzypadkowy. Ot\2ox \1w j\2e\1zyku tym mo\2x\1na wyrazi\2c \ \1wiele \ w\2l\1asno\2s\1ci
\-
\+
niskopoziomowych, a posiada \ on \ tak\2x\1e \ wszystkie \ zalety \ j\2e\1zyka
\-
\+
wysokopoziomowego.  Przet\2l\1umaczenie wersji loglanowej na  j\2e\1zyk C
\-
\+
nie \ przedstawia\2l\1o \ wi\2e\1kszych \ trudno\2s\1ci, \ umo\2x\1liwi\2l\1o \  natomiast
\-
\+
stworzenie bardzo efektywnego systemu \2l\1atwego do przenoszenia. \,
\-\/
\+
RS system  napisany \ w \ C \ daje \ mo\2x\1liwo\2sc \ \1wykonywania \ programu
\-
\+
loglanowego przet\2l\1umaczonego na j\2e\1zyk C. Taki \ spos\2o\1b \ realizacji
\-
\+
Loglanu \ wydaje \ mi \ si\2e \ \1najprostszy. \ Napisanie \ kompilatora \ z
\-
\+
Loglanu na C jest \ znacznie \ \2l\1atwiejsze \ ni\2x \ \1napisanie \  pe\2l\1nego
\-
\+
kompilatora \ na \ docelow\2a \  \1maszyn\2e\1. \ Problem \ przenoszenia \ jest
\-
\+
rozwi\2a\1zany w spos\2o\1b natychmiastowy. Ponadto  kompilator taki mo\2x\1e
\-
\+
korzysta\2c \1z bogactwa konstrukcji j\2e\1zyka C. Nie b\2e\1dzie problemu ze
\-
\+
sta\2l\1ymi, \ \ instrukcjami \ \ \ steruj\2a\1cymi \ \ \ w \ \ \ obr\2e\1bie \ \ \ modu\2l\1u,
\-
\+
wej\2s\1ciem-wyj\2s\1ciem, \2l\1a\2n\1cuchami itp. \ Niezwykle \ upro\2s\1ci \ si\2e \  \1sam
\-
\+
proces translacji. Wyra\2x\1enia mog\2a \1pozosta\2c \1w prawie niezmienionej
\-
\+
postaci - jedynie dost\2e\1p do  zmiennych loglanowych b\2e\1dzie wymaga\2l
\-
\+
\1wywo\2l\1ywania specjalnych makro  - ale proces \2l\1adowania \ rejestr\2o\1w,
\-
\+
optymalizacji lokalnej  itd. przerzucony  zostanie na system \  C.
\-
\+
A \ przecie\2x \ \1jest \ to \ system \ niezwykle \ \ efektywny. \ \ Wi\2e\1kszo\2sc
\-
\+
\1kompilator\2o\1w C daje kod \ dobrze \ zoptymalizowany. \ W \ ten \ prosty
\-
\+
spos\2o\1b  mo\2x\1emy wykorzysta\2c \1si\2le  \1tego j\2e\1zyka \ zostawiaj\2a\1c \ troski
\-
\+
techniczne \ \ \  (rejestry, \ \ \ arytmetyka \ \ \ maszyny, \ \ \ \ etykiety,
\-
\+
optymalizacja) systemowi C. \,
\-
\+
\,
\-
\+
Opisany poni\2x\1ej system sk\2l\1ada  si\2e \1z dwu \ plik\2o\1w \ : \  Rs.c \  oraz
\-
\+
Rsdata.h. Plik Rsdata.h jest \ tzw. \ plikiem \ nag\2lo\1wkowym \ (header
\-
\+
file).  W nim wyra\2x\1ono wszystkie wsp\2o\1lne struktury \  danych \ oraz
\-
\+
podstawowe zmienne. Na pliku Rs.c znajduje \ si\2e \ \1natomiast \ pe\2l\1na
\-
\+
biblioteka \ \ Running \ \ Systemu. \ \ Tekst \ \ programu \ \ \ loglanowego
\-
\+
przet\2l\1umaczony  na  C  musi w\2la\1cza\2c \1za pomoc\2a \1instrukcji \ include
\-
\+
plik Rsdata.h. W taki sam spos\2o\1b w\2la\1czany \ jest \ ten \ plik \ przez
\-
\+
Rs.c. \,
\-
\+
\,
\-
\+
\+
                                               Edmonton, Maj 1988
\-
\+
\+
                                          Warszawa, Sierpie\2n \11988\,
\-
\+
\,
\-
\+
\,
\-
\+
\,
\-
\+
2. Opis struktur danych na pliku Rsdata.h
\-
\+

\-
\+
Na pliku \ tym \ znajduj\2a \ \1si\2e \ \1deklaracje \ struktury \ prototyp\2o\1w \ i
\-
\+
offset\2o\1w. Zajmiemy \ si\2e \ \1najpierw \ struktur\2a \ \ \1prototypu. \ \ Ma \ \ on
\-
\+
nast\2e\1puj\2a\1c\2a \1posta\2c\1: \,
\-
\+
\,
\-
\+
\4struct \3Prototype
\-
\+
\1{
\-
\+
\  \4int \3kind\1;
\-
\+
\  \4int \3num\1;
\-
\+
\  \4int \3lspan\1, \3rspan\1;
\-
\+
\  \4int \3references\1;
\-
\+
\  \4int \3decl\1, \3level\1;
\-
\+
\  \4int \3lastwill\1;
\-
\+
\  \4int \3permadd\1;
\-
\+
\  \4int \3Sloffset\1, \3Dloffset\1;
\-
\+
\  \4int \3Statoffset\1, \3Lscoffset\1;
\-
\+
\  \4int \3handlist\1;
\-
\+
\  \4int \3pref\1, \3pslength\1;
\-
\+
};
\-
\+

\-
\+
Atrybut \3kind \1definiuje rodzaj \ prototypu. \ Mamy \ nast\2e\1puj\2a\1ce \ ich
\-
\+
rodzaje: CLASS, SUBROUTINE, PROCESS, COROUTINE, HANDLER, \ RECORD,
\-
\+
PRIMITARRAY, REFARRAY, SUBARRAY,  STRUCTARRAY, POINTARRAY. \  Pi\2ec
\-
\+
\1pierwszych nie wymaga wyja\2s\1nie\2n\1. RECORD jest klas\2a \1bez kodu i bez
\-
\+
innych modu\2lo\1w zadeklarowanych \ wewn\2a\1trz. \ Ten \ rodzaj \ prototypu
\-
\+
istnia\2l \1ju\2x \1w poprzedniej wersji  Running Systemu.  Ostanich pi\2ec
\-
\+
\1rodzaj\2o\1w dotyczy tablic. PRIMITARRAY jest tablic\2a \  \1o \ elementach
\-
\+
typu pierwotnego, \ REFARRAY \ jest \ tablic\2a \ \1typu \ referencyjnego,
\-
\+
SUBARRAY jest tablic\2a\1, kt\2o\1rej elementami s\2a \1domkni\2e\1cia \ procedur,
\-
\+
STRUCTARRAY jest tablic\2a \1o elementach typu z\2l\1o\2x\1onego \ i \ wreszcie
\-
\+
POINTARRAY \ jest \ tablic\2a \  \1typu \ \ referencyjnego, \ \ jednak\2x\1e \ \ o
\-
\+
elementach daj\2a\1cych  adresy  po\2s\1rednie  bez licznik\2o\1w. \ Taki \ typ
\-
\+
dodatkowy wprowadzili\2s\1my w nowej wersji \ RS \ w \ celu \ osi\2a\1gni\2e\1cia
\-
\+
wi\2e\1kszej efektywno\2s\1ci kodu. Zamiast \ pe\2l\1nego \ adresu \ wirtualnego
\-
\+
[adres po\2s\1redni, licznik] niekt\2o\1re referencje s\2a \ \1postaci \ [adres
\-
\+
po\2s\1redni]. \ Nie \ daj\2a \  \1one \ oczywi\2s\1cie \ gwarancji \ \  poprawno\2s\1ci
\-
\+
adresowania \ (mo\2x\1e \  wyst\2a\1pi\2c \  \1tzw. \ nieokre\2s\1lona \ \ referencja),
\-\/
\+
nimniej, \ je\2s\1li \ u\2x\1ytkownik \ jest \  pewny \ \  poprawno\2s\1ci \ \ swoich
\-
\+
adresowa\2n\1, mo\2x\1e cz\2esc \1lub \ wszystkie \ referencje \ zaznaczy\2c \ \1jako
\-
\+
proste. Poniewa\2x \1typy \ tablicowe \ s\2a \ \1rozr\2ox\1niane \ przez \ atrybut
\-
\+
\3kind, \1w\2s\1r\2o\1d rodzaj\2o\1w typ\2o\1w pojawi\2l \1si\2e \1tak\2x\1e typ POINTERARRAY. \,
\-
\+
\,
\-
\+
Drugim atrybutem prototypu jest \3num\1. Wskazuje on \ pozycj\2e \ \1danego
\-
\+
prototypu w tablicy PROT [] definiuj\2a\1cej wszystkie prototypy. \,
\-
\+

\-
\+
Atrybuty \3lspan \1i \3rspan \1definiuj\2a \ \1rozmiar \ obiektu \ danego \ typu.
\-
\+
Wszystkie obiekty alokowane \ s\2a \ \1w \ tablicy \ M[ \ ]. \ Maj\2a\1c \ adres
\-
\+
obiektu \3am \1na lewo mamy rozmiar \ \3lspan\1, \ na \ prawo \ \3rspan\1, \ czyli
\-
\+
obiekt \ zajmuje \ elementy \ tablicy \ M[\3am-lspan\1..\3am\1+\3rspan\1]. \ Adres
\-
\+
prototypu usytuowany jest zawsze w s\2l\1owie M[\3am\1], tzn. maj\2a\1c adres
\-
\+
obiektu na zmiennej \3am\1, w\2l\1a\2s\1nie M[\3am\1] = \ \3num \ \1, \ gdzie \ \3num \ \1jest
\-
\+
adresem prototypu tego \ obiektu \ w \ tablicy \ PROT. \ Tablice \ maj\2a
\-
\+
\1rozmiar definiowany  dynamicznie. W s\2l\1owie \ M[\3am\1] \ jest \ zapisany
\-
\+
stosowny \ numer \  prototypu, \ natomiast \ \  dwa \ \ kolejne \ \  s\2l\1owa
\-
\+
definiuj\2a \1doln\2a \ \1i \ g\2o\1rn\2a \ \1granice \ wska\2z\1nika. \ Rozmiar \ elementu
\-
\+
tablicy w przypadku PRIMITARRAY podawany jest za pomoc\2a \ \1atrybutu
\-
\+
\3lspan\1. \,
\-
\+

\-
\+
Pozosta\2l\1e atrybuty nie s\2a \1konieczne w przypadku tablic.
\-
\+

\-
\+
Atrubut \3references \1definiuje struktur\2e \1referencji prototypu. \ Jest
\-
\+
to po prostu indeks  w tablicy  OFF[], kt\2o\1ra \ definiuje \ wszystkie
\-
\+
rodzaje struktur referencji (patrz definicja OFF poni\2x\1ej). \,
\-
\+
\,
\-
\+
Atrybuty \3decl \1i \ \3level \ \1odnosz\2a \ \1si\2e \ \1do \  struktury \ zagnie\2x\1d\2x\1e\2n
\-
\+
\1programu. Mianowicie \3decl \1jest indeksem w PROT \ ojca \ statycznego
\-
\+
danego modu\2l\1u, natomiast \3level \1jest g\2le\1boko\2s\1ci\2a \1zagnie\2x\1d\2x\1enia. \,
\-
\+

\-
\+
Atrybut \3lastwill \1okre\2s\1la miejsce w module, od kt\2o\1rego rozpoczynaj\2a
\-
\+
\1si\2e \1instrukcje lastwill. \ W \ jaki \ spos\2o\1b \ modeluje \ si\2e \ \1kontrol\2e
\-
\+
\1sterowania podamy w punktach 4 i 10. \,
\-
\+
\,
\-
\+
Nast\2e\1pny atrybut \3permadd \1jest wsp\2o\1lnym adresem dla \ permutacji \ i
\-
\+
inwersji permutacji numer\2o\1w displaya.  Mianowicie plik \ loglanowy
\-
\+
definiuje dwie tablice \3perm\1[] i \3perminv\1[], kt\2o\1re \ musz\2a \ \1zawiera\2c
\-
\+
\1te permutacji. \ Przyk\2l\1adowo, \ dla \ \3perm\1[] \ = \ {0,1,2,0,2,1} \ oraz
\-\/
\+
\3perminv\1[] = {0,1,2,0,2,1}, indeks \3permadd\1=0 dla warto\2s\1ci \ \3level\1=2
\-
\+
okre\2s\1la permutacj\2e \1{0,1,2} \ (i \ te \ sam\2a \  \1odwrotn\2a\1), \  natomiast
\-
\+
\3permadd\1=2 dla  \3level \1te\2x \1r\2o\1wnym 2 daje perm={0,2,1} \ (i \ podobnie
\-
\+
te sam\2a \1odwrotn\2a\1}. \,
\-
\+
\,
\-
\+
Cztery \  kolejne \ atrybuty \ \ (\3Sloffset\1, \ \ \3Dloffset\1, \ \ \3Statoffset\1,
\-
\+
\3Lscoffset\1) definiuj\2a \1adresy wzgl\2e\1dne (offsety) czterech zmiennych
\-
\+
systemowych Sl, Dl, Statsl i  Lsc. Ka\2x\1dy \ modu\2l \ \1posiadaj\2a\1cy \ kod
\-
\+
musi \ mie\2c \ \1okre\2s\1lon\2a \ \1pozycj\2e \ \1Sl \ ojca, \ Dl \ \ ojca, \ \ lokalnego
\-
\+
sterowania Lsc i licznika Sl syn\2o\1w (Statsl). \ O \ tych \  zmiennych
\-
\+
systemowych b\2e\1dziemy m\2o\1wi\2c \1za chwil\2e\1. Tutaj natomiast \ chcieli\2s\1my
\-
\+
zwr\2o\1ci\2c \1uwag\2e \1na to, \2x\1e w poprzedniej \  wersji \ RS \ offsety \ tych
\-
\+
zmiennych by\2l\1y podawane w prototypie (ich pozycja \ by\2l\1a \ ustalona
\-
\+
na ko\2n\1cu obiektu). Wprowadzenie offset\2o\1w zmiennych systemowych do
\-
\+
prototyp\2o\1w skomplikuje kompilacj\2e\1,  ale przyspieszy i ujednorodni
\-
\+
RS. Dost\2e\1p do tych zmiennych \  b\2e\1dzie \ bowiem \ taki \ sam \ jak \ do
\-
\+
innych \ zmiennych \ wprowadzonych \ przez \ \ u\2x\1ytkownika \ \ czy \ \ te\2x
\-
\+
\1kompilator. \,
\-
\+

\-
\+
Atrybut \3handlist \1definiuje list\2e \1handler\2o\1w zadeklarowanych w danym
\-
\+
module. Jest to  indeks w \ tablicy \ HL[], \ gdzie \ zdefiniowane \ s\2a
\-
\+
\1wszystkie takie listy. \ Tablica \ HL \ jest \ typu \ Hlstelem \ postaci
\-
\+
nast\2e\1puj\2a\1cej: \,
\-
\+

\-
\+
\4struct \3Hlstelem
\-
\+
\1{
\-
\+
\  \4int \3hand\1;
\-
\+
\  \4int \3signlist\1;
\-
\+
\  \4int \3next\1;
\-
\+
};
\-
\+

\-
\+

\-
\+
Atrybut \3hand  \1jest indeksem w tablicy \ PROT \ w\2l\1a\2s\1ciwego \ handlera.
\-
\+
Natomiast atrybut \3signlist \ \1jest \ indeksem \ w \ tablicy \ SL[] \ typu
\-
\+
\3Sgelem\1, \ gdzie \ okre\2s\1lone \ s\2a \ \1numery \ sygna\2lo\1w \ zwi\2a\1zane \ z \ \ tym
\-
\+
handlerem. Typ \3Sgelem \1ma posta\2c \1nast\2e\1puj\2a\1c\2a\1: \,
\-
\+
\,
\-
\+
\4struct \3Sgelem
\-
\+
\1{
\-
\+
\  \4int \3signalnum\1;
\-
\+
\  \4int \3next
\-
\+
\1};
\-
\+

\-
\+

\-
\+
W ka\2x\1dym elemencie tablicy \ SL[] \ mamy \ numer \ sygna\2l\1u \ \3signalnum\1,
\-
\+
kt\2o\1ry jest warto\2s\1ci\2a \1absolutn\2a \1budowan\2a \1przez kompilator. \ Atrybut
\-
\+
\3next \1pokazuje na kolejny element takiej \ listy \ w \ SL[]. \ Podobnie
\-
\+
zreszt\2a \1atrybut \3next \1w HL[] wskazuje na nast\2e\1pny handler \ zwi\2a\1zany
\-
\+
z danym modu\2l\1em. Koniec ka\2x\1dej takiej listy \ (w \ obu \ przypadkach)
\-
\+
okre\2s\1la warto\2sc \3next\1=-1 (tak wybrano z uwagi na \ adresowanie \ w \ C
\-
\+
tablic od 0). \,
\-
\+

\-
\+
Atrybut \3handlist \1wyst\2e\1puje tak\2x\1e w  prototypie handlera. \ Okre\2s\1la
\-
\+
on jedynie, \ czy \ handler \ ten \ odpowiada \ na \ wszystkie \ sygna\2l\1y
\-
\+
(others), \ czy \ \ te\2x \ \ \1jest \ \ deklarowany \ \ jako \ \ handler \ \  dla
\-
\+
wyspecyfikowanych \ numer\2o\1w \  sygna\2lo\1w. \ W \ \ pierwszym \ \ przypadku
\-
\+
warto\2sc \ \1tego \  atrybutu \ jest \  1 \ (hanlder \ dla \ \  others), \ \ w
\-
\+
pozosta\2l\1ych przypadkach warto\2sc \1tego atrybutu jest 0. \,
\-
\+

\-
\+

\-
\+
Dwa ostatnie atrybuty w prototypie ( \ \3pref\1, \ \3pslength\1) \ okre\2s\1laj\2a
\-
\+
\1struktur\2e \1prefiksowania. Nie musz\2a \1one \  wyst\2e\1powa\2c \ \1w \ przypadku
\-
\+
prototyp\2o\1w dla handler\2o\1w, gdy\2x \1handler nie mo\2x\1e by\2c \1prefiksowany.
\-
\+
Atrybut  \3pref \1jest indeksem w tablicy PROT modu\2l\1u \ prefiksuj\2a\1cego
\-
\+
(-1 gdy nie istnieje), \ atrybut \ \3pslength \ \1jest \ d\2l\1ugo\2s\1ci\2a \ \1ci\2a\1gu
\-
\+
prefiksuj\2a\1cego. \,
\-
\+

\-
\+
Pozosta\2l\1a  do \ om\2o\1wienia \ struktura \ referencji. \ Ot\2ox \ \1z \ powodu
\-
\+
wprowadzenia bogactwa typ\2o\1w z\2l\1o\2x\1onych w nowym Loglanie, struktura
\-
\+
referencji \ w \ obiektach \ jest \ stosunkowo \ skomplikowana. \ Takie
\-
\+
struktury opisuje tablica OFF[] typu \3Offsets\1. \,
\-
\+

\-
\+
\4struct \3Offsets
\-
\+
\1{
\-
\+
\  \4int \3kind\1;
\-
\+
\  \4int \3size\1, \3num\1;
\-
\+
\  \4int \3length\1, \3finish\1;
\-
\+
\  \4int \3head\1;
\-
\+
\  \4int \3references\1;
\-
\+
};
\-
\+
\,
\-
\+

\-
\+
Atrybut \3kind \1jest nast\2e\1puj\2a\1cych \ rodzaj\2o\1w: \ SIMPLELIST, \ SEGMENT,
\-
\+
REPEATED \ oraz \ COMBINEDLIST. \ SIMPLELIST \ jest \ list\2a \ \ \1zwyk\2l\1ych
\-
\+
offset\2o\1w \  zmiennych \ referencyjnych \ w \ obiekcie. \ SEGMENT \ jest
\-
\+
szczeg\2o\1ln\2a  \1postaci\2a \ \1takiej \  listy, \ gdy \ te \  offsety \ zajmuj\2a
\-
\+
\1kolejne miejsca  w pami\2e\1ci (ten  typ wprowadzili\2s\1my \  ze \ wzgl\2e\1du
\-
\+
na tablice referencyjne,  jakkolwiek  jest \  on \ sprowadzalny \ do
\-
\+
przypadku poprzedniego). REPEATED jest \ n-krotn\2a \ \1iteracj\2a \ \1danej
\-
\+
struktury referencyjnej. COMBINEDLIST jest list\2a \1by\2c \1mo\2x\1e r\2ox\1nych
\-
\+
struktur referencji. \,
\-
\+
\,
\-
\+
Atrybut \3size \1okre\2s\1la ca\2l\1kowit\2a \1d\2l\1ugo\2sc \1opisywanej \ struktury  \ Dla
\-
\+
SIMPLELIST musi to \  by\2c \  \1d\2l\1ugo\2sc \ \1ca\2l\1ego \ obiektu, \ dla \ SEGMENT
\-
\+
r\2o\1wnie\2x \1d\2l\1ugo\2sc \1ca\2l\1ego obiektu, dla REPEATED  musi to by\2c \ \1d\2l\1ugo\2sc
\-
\+
\1powtarzanej struktury, i ostatecznie dla COMBINEDLIST  ma  to \ by\2c
\-
\+
\1d\2l\1ugo\2sc \ \1struktury \ wewn\2a\1trz \ kt\2o\1rej \ podawane \ s\2a \ \1wska\2z\1niki \ \ do
\-
\+
podstruktur. \,
\-
\+
\,
\-
\+
Kolejny \ atrybut \ \3num \ \1definiuje \ indeks \ w \ tablicy \ \ OFF \ \ danej
\-
\+
struktury.\,
\-
\+
\,
\-
\+
Znaczenie  atrybutu \3length \1jest \ wieloznaczne. \  Dla \  SIMPLELIST
\-
\+
\3length  \1jest d\2l\1ugo\2s\1ci\2a  \1listy offset\2o\1w. Dla SEGMENT \ \3length \ \1jest
\-
\+
pozycj\2a \1pierwszego,a \3finish \1ostatniego  elementu \  segmentu. \ Dla
\-
\+
REPEATED \3length \1jest \ krotno\2s\1ci\2a \ \1powt\2o\1rzenia \ podstruktury. \ Dla
\-
\+
COMBINEDLIST \3length \1jest d\2l\1ugo\2s\1ci\2a \1listy. \,
\-
\+
\,
\-
\+
Atrybut  \3head \1jest indeksem w tablicy EL[], gdzie \  zakodowane \ s\2a
\-
\+
\1listy struktur referencji. Typem tej tablicy jest  \3Elem\1: \,
\-
\+
\,
\-\/
\+
\4struct \3Elem
\-
\+
\1{
\-
\+
\  \4int \3offset\1;
\-
\+
\  \4int \3next\1;
\-
\+
\  \4int \3references\1;
\-
\+
};
\-
\+

\-
\+
W tablicy tej atrybut  \3offset \1definiuje odpowiedni offset a \ \3next
\-
\+
\1jest jak zwykle wska\2z\1nikiem do \ nast\2e\1pnego \ elementu \ listy. \ Dla
\-
\+
typu SIMPLELIST ka\2x\1dy taki \ offset \ mo\2x\1e \ by\2c \ \1offsetem \ zmiennej
\-
\+
referencyjnej pe\2l\1nej lub tylko adresem po\2s\1rednim, ale tak\2x\1e \ mo\2x\1e
\-
\+
by\2c \1offsetem domkni\2e\1cia procedury (czyli pary <SL, adres kodu> ).
\-
\+
Gdy atrybut \3references \1jest 0, mamy referencje pe\2l\1n\2a\1, gdy jest \ 1
\-
\+
jest to adres po\2s\1redni, wreszcie gdy jest 2 \ jest \ to \ domkni\2e\1cie
\-
\+
procedury. \,
\-
\+
\,
\-
\+
Dla typu COMBINEDLIST atrybut \3references \1okre\2s\1la indeks w tablicy
\-
\+
OFF wskazywanej podstruktury referencji. \,
\-
\+
\,
\-
\+
\,
\-
\+
W  przypadku  typu SEGMENT atrybut \ \3head \ \1mo\2x\1e \ jeszcze \ okre\2s\1la\2c
\-
\+
\1rodzaj referencji. Gdy \3head \1= 0, mamy segment pe\2l\1nych referencji,
\-
\+
gdy jest 1 jest to segment adres\2o\1w po\2s\1rednich, gdy jest 2 jest to
\-
\+
segment domkni\2ec \1procedur.\,
\-
\+
\,
\-
\+
\,
\-
\+
Dla ostatniego atrybutu \3references \1w \ typie \ \3Offsets \ \1mamy \ jedno
\-
\+
zadanie. Powinien on okre\2s\1la\2c \1dla typu REPEATED indeks w \ tablicy
\-
\+
OFF powtarzanej struktury. \,
\-
\+

\-
\+
Powy\2x\1szy system wprowadzania \  struktury \ prototyp\2o\1w \ jest \ dosy\2c
\-
\+
\1niezr\2e\1czny, je\2s\1li musi  by\2c \1wykonany r\2e\1cznie. Troch\2e \1w \ tym \ wina
\-
\+
j\2e\1zyka C.  Mo\2x\1na by\2l\1o \ wprowadzi\2c \ \1typ \ union, \ kt\2o\1ry \ przypomina
\-
\+
rekordy z \ wariantami, \ ale \ w\2o\1wczas \ nie \ mo\2x\1naby \ podawa\2c \ \1tych
\-
\+
struktur przez definicje w deklaracji (odp. DATA  \ w \ Fortranie).
\-
\+
Zatem przyj\2al\1em \ takie \ rozwi\2a\1zanie \ przez \ zwyk\2la \ \1struktur\2e\1. \ Z
\-
\+
drugiej strony translator z Loglanu na C mo\2x\1e bez k\2l\1opotu budowa\2c
\-
\+
\1tak\2a \1struktur\2e\1. \,
\-
\+
\,
\-
\+
\,
\-
\+
3. Struktury Dl i Sl
\-
\+

\-
\+
Struktura Dl zachowana jest taka \ jak \ w \ Simuli \ i \ Loglanie-82.
\-
\+
Aktywny wsp\2ol\1program  jest \2l\1a\2n\1cuchem Dl, zawieszony  jest \ cyklem
\-
\+
Dl. \ Nowy \ Loglan \ usun\2al \ \ \1Detach, \ \ gdy\2x \ \ \1wprowadzi\2l \ \ \1zmienn\2a
\-
\+
\1LAST_ATTACH - \ wskazuj\2a\1c\2a \ \1na \ ostatni \ wsp\2ol\1program \  wykonuj\2a\1cy
\-
\+
Attach(X). Zako\2n\1czenie wsp\2ol\1programu \ jest \ sygnalizowane \ b\2le\1dem
\-
\+
(propozycja \ \ \ \ Marka \ \ \ \ Warpechowskiego). \ \ \ \ Wykonuje \ \ \ \ \ si\2e
\-
\+
\1Attach(LAST_ATTACH) with Cor_Term (coroutine terminated), \ o \ ile
\-
\+
LAST_ATTACH \ =/= \ \4none\1, \  w \ \ przeciwnym \ \ razie \ \ wykonuje \ \ si\2e
\-
\+
\1Attach(My_Process) \ \ with \ \ Cor_Term. \ \ To \ \ \ rozwi\2a\1zanie \ \ \ jest
\-
\+
metodologicznie  uzasadnione i najprostsze. \,
\-
\+
\,
\-
\+
Dla \  wsp\2ol\1programu \ aktywnego \ warto\2sc \ \1Dl \ jest \ \ \4none\1. \ \ Pr\2o\1ba
\-
\+
reaktywacji  wsp\2ol\1programu aktywnego \ powoduje \ wys\2l\1anie \ sygna\2l\1u
\-
\+
alarmowego. \ Wsp\2ol\1program \ \ zako\2n\1czony \ \ ma \ \ ustawion\2a \ \ \1warto\2sc
\-
\+
\1lokalnego sterowania Lsc na 0. \ Pr\2o\1ba \  reaktywacji \ zako\2n\1czonego
\-
\+
wsp\2ol\1programu powoduje wys\2l\1anie sygna\2l\1u. Zauwa\2x\1my na \ zako\2n\1czenie
\-
\+
omawiania struktury Dl, \ \2x\1e \ Dl-link \ mo\2x\1e \ by\2c \ \1w \ tym \ systemie
\-
\+
referencj\2a  \1niepe\2l\1n\2a  \1(tzn.  tylko adresem po\2s\1rednim). \ Zyskujemy
\-
\+
w ten spos\2o\1b na pami\2e\1ci i na czasie wykonania programu. \,
\-
\+
\,
\-
\+
Struktura Sl link\2o\1w \ tworzy \ drzewo. Problemem s\2a \ \1tylko \ usuwane
\-
\+
obiekty procedur, \ funkcji \ i \ blok\2o\1w, \  po \ ich \ terminacji. \  W
\-
\+
poprzedniej \ wersji \ przyj\2e\1li\2s\1my \ \ strategi\2e \ \  \1usuwania \ \ takich
\-
\+
obiekt\2o\1w bez wzgl\2e\1du na konsekwencje. Mog\2l\1o si\2e \ \1zdarzy\2c\1, \ \2x\1e \ po
\-
\+
pewnym \ czasie \ wznawiany \ dobrze \ \ okre\2s\1lony \ \ obiekt \ \ nie \ \ ma
\-
\+
okre\2s\1lonego otoczenia statycznego (Sl link przeci\2e\1ty). \ Umieli\2s\1my
\-
\+
wykry\2c \1takie przypadki, ale nie by\2l\1o to \ rozwi\2a\1zanie \ eleganckie.
\-
\+
Marek Lao \ zauwa\2x\1y\2l\1, \ \2x\1e \ lepiej \ by\2l\1oby \ u\2x\1y\2c \ \1zwyk\2l\1ej \ techniki
\-
\+
licznik\2o\1w referencji tylko \ dla \ tego \ przypadku. \ Mamy \ przecie\2x
\-
\+
\1licznik Statsl (poprzednio inaczej okre\2s\1lony),  nale\2x\1y zastosowa\2c
\-
\+
\1go w spos\2o\1b nast\2e\1puj\2a\1cy. \,
\-
\+
\,
\-
\+
Ka\2x\1de otwarcie nowego obiektu zwi\2e\1ksza o 1 \ licznik \ Statsl \ jego
\-
\+
statycznego ojca. Ka\2x\1de zako\2n\1czenie obiektu \ procedury \ (funkcji,
\-
\+
bloku) sprawdza, czy jego Statsl jest 0. Je\2s\1li tak, obiekt \ mo\2x\1na
\-
\+
usun\2ac\1, zmniejszy\2c \1Statsl o \ 1 \ dla \ jego \ ojca \ i \ powt\2o\1rzy\2c \ \1te
\-\/
\+
operacje dla takiego \ ojca \ (o \ ile \ jest \ to \ obiekt \ procedury,
\-
\+
funkcji lub bloku). Dla usuwanego za pomoc\2a \1kill \ obiektu \ klasy,
\-
\+
sprawdzamy \ najpierw \ jego \ Statsl, \ \ i \ \ post\2e\1pujemy \ \ podobnie.
\-
\+
Pozostaje rozwi\2a\1za\2c \1poprawnie problem usuwania wsp\2ol\1program\2o\1w. \,
\-
\+
\,
\-
\+
Zabicie zawieszonego wsp\2ol\1programu polega na \ zabiciu \ stosownego
\-
\+
cyklu Dl. Najpierw przegl\2a\1damy taki cykl i sprawdzamy, \ czy \ jego
\-
\+
wszystkie obiekty maj\2a \1Statsl \ r\2o\1wny \ 0. \ Je\2s\1li \ nie, \ wywo\2l\1ujemy
\-
\+
sygna\2l \1alarmowy. Je\2s\1li natomiast wszystkie \ s\2a \ \1usuwalne, \ mo\2x\1emy
\-
\+
przyst\2a\1pi\2c \1do kolejnego ich usuwania. Aby \ to \ zrobi\2c \ \1poprawnie,
\-
\+
nale\2x\1a\2l\1oby stosowa\2c \1operacj\2e \1przej\2s\1cia po Sl-\2l\1a\2n\1cuchu dla ka\2x\1dego
\-
\+
obiektu usuni\2e\1tego (tak jak \ dla \ obiektu \ klasy). \ Ale \ przecie\2x
\-
\+
\1mogliby\2s\1my usun\2ac \1jaki\2s \1obiekt jeszcze \ nieusuni\2e\1ty \ z \ usuwanego
\-
\+
w\2l\1a\2s\1nie cyklu wsp\2ol\1programu. Aby unikn\2ac \1tej sytuacji, \ odwracamy
\-
\+
najpierw \ cykl \ wsp\2ol\1programu. \ Zabijaj\2a\1c \ obiekty \ w \ kolejno\2s\1ci
\-
\+
odwrotnej (od g\2l\1owy wsp\2ol\1programu, nast\2e\1pnie syn dynamiczny itd),
\-
\+
mamy pewno\2sc\1, \ \2x\1e \  nie \  usuniemy \ przy \  czyszczeniu \ kolejnych
\-
\+
\2l\1a\2n\1cuch\2o\1w  Sl \2x\1adnego pozosta\2l\1ego elementu \ cyklu. \ Wynika \ to \ z
\-
\+
w\2l\1asno\2s\1ci Sl \ i \ Dl \ \2l\1a\2n\1cuch\2o\1w \ - \ nie \ mog\2a \ \1i\2sc \ \1w \ przeciwnych
\-
\+
kierunkach, tzn. je\2s\1li jest Dl droga od A do B to nie ma Sl drogi
\-
\+
od B do A. \ W \ drugiej \ fazie \ usuwania \ wsp\2ol\1programu \ zmieniamy
\-
\+
orientacj\2e \1cyklu. W trzeciej, ju\2x \1bezpiecznie mo\2x\1emy usun\2ac \ \1ca\2l\1y
\-
\+
cykl \ czyszcz\2a\1c \ po \ \ drodze \ \ \2l\1a\2n\1cuchy \ \  Sl. \ \ W \ \ ten \ \ spos\2o\1b
\-
\+
rozwi\2a\1zali\2s\1my, \  chyba \ dostatecznie \ \ poprawnie \ \ i \ \ elegancko,
\-
\+
problemy  czyszczenia pami\2e\1ci w Loglanie. Ponadto taka \ struktura
\-
\+
Sl pozwala \ na \ zast\2a\1pi\2e\1nie \ pe\2l\1nych \ referencji \ dla \ Sl \ link\2o\1w
\-
\+
adresami po\2s\1rednimi (tak jak to \ mia\2l\1o \ miejsce \ w \ przypadku \ Dl
\-
\+
link\2o\1w). Zawsze bowiem warto\2sc \1Sl jest \ dobrze \ okre\2s\1lona \ i \ nie
\-
\+
wymaga sprawdzenia, tak jak to mia\2l\1o miejsce w \ starym \ Loglanie,
\-
\+
tzn. czy okre\2s\1la jeszcze istniej\2a\1cy obiekt. \,
\-
\+
\,
\-
\+
Zmiana warto\2s\1ci atrybutu Statsl dotyczy \ tak\2x\1e \ u\2x\1ycia \ zmiennych
\-
\+
podprogramowych. Warto\2s\1ci\2a \1takiej \ zmiennej \ podprogramowej \ jest
\-
\+
domkni\2e\1cie procedury (<SL,adres kodu>). Poniewa\2x \1j\2e\1zyk w \ obecnej
\-
\+
postaci dopuszcza operowanie na zmiennych podprogramowych, system
\-
\+
musi dba\2c \1o to, by nieopatrznie nie usuwa\2c \1otoczenia \ statycznego
\-
\+
dla dost\2e\1pnego domkni\2e\1cia procedury, \ albowiem \ takie \ domkni\2e\1cie
\-
\+
mo\2x\1e by\2c \1w ka\2x\1dej chwili u\2x\1yte.  Jak wi\2e\1c post\2e\1pujemy. Traktujemy
\-
\+
domkni\2e\1cia \ \ procedur \ \ jako \ \ specjalne \ \ zmienne \ \ referencyjne
\-
\+
(przypominam, \ \2x\1e \ odpowiednie \ SL \ linki \ \ mog\2a \ \ \1by\2c \ \ \1adresami
\-
\+
kr\2o\1tkimi). Dla tych specjalnych \ referencji \ stosujemy \ strategi\2e
\-
\+
\1reference counter, czyli ka\2x\1de \ podstawienie \ wymaga \ poprawienia
\-
\+
odpowiednich \ Statsl. \ Przy \ usuwaniu \ \ obiektu \ \ nale\2x\1y \ \ jednak
\-\/
\+
wszystkie takie zmienne przejrze\2c \1i \ tak\2x\1e \ poprawi\2c \ \1odpowiednie
\-
\+
Statsl. Ca\2l\1o\2sc \1jest bardzo prosta, wymaga jednak wyr\2ox\1nienia tych
\-
\+
referencji, co zosta\2l\1o zrobione w\2l\1a\2s\1nie w strukturze OFF.\,
\-
\+
\,
\-
\+
4. Struktura sterowania lokalnego
\-
\+

\-
\+
Sterowanie lokalne w j\2e\1zyku C jest bardzo podobne \ do \ sterowania
\-
\+
lokalnego w Loglanie. Wszystkie p\2e\1tle \ loglanowe \ mo\2x\1na \ zast\2a\1pi\2c
\-
\+
\1przez ich \ odpowiedniki \ w \ j\2e\1zyku \ C. \ Podobnie \ z \ instrukcjami
\-
\+
warunkowymi i instrukcjami wyboru. Problem techniczny  powstaje w
\-
\+
momencie przekazywanie sterowania pomi\2e\1dzy modu\2l\1ami \ Loglanowymi,
\-
\+
poniewa\2x \1ka\2x\1de takie przekazanie sterowania zawiesza \ wykonywanie
\-
\+
instrukcji modu\2l\1u aktywnego. Jak z tym \ problemem \ upora\2c \ \1si\2e \ \1w
\-
\+
j\2e\1zyku C. Modu\2l \1loglanowy przet\2l\1umaczony na odpowiedni modu\2l \1C ma
\-
\+
jako pierwsz\2a \1instrukcj\2e \1wygenerowan\2a \1przez kompilator instrukcj\2e
\-
\+
\1wyboru: \,
\-
\+
\,
\-
\+
   \4switch \1(IC)
\-
\+
   {
\-
\+
     \4case \11: \4goto \1L1; \4break\1;
\-
\+

\-
\+
            ...
\-
\+

\-
\+
     \4case \1n: \4goto \1Ln; \4break\1;
\-
\+
   };
\-
\+

\-
\+
gdzie IC jest wsp\2o\1ln\2a \ \1zmienn\2a \ \1globaln\2a \ \1zadeklarowan\2a \ \1w \ pliku
\-
\+
Rsdata.h oraz etykiety L1,...,Ln definiuj\2a \1r\2ox\1ne \ punkty \ wej\2s\1cia
\-
\+
do modu\2l\1u. Ka\2x\1de \ przekazanie \ sterowania \ do \ innego \ modu\2l\1u \ za
\-
\+
pomoc\2a \1procedur systemowych RS \ (np. \ Go, \ Attach, \ itp.) \ wymaga
\-
\+
prawid\2l\1owego okre\2s\1lenia warto\2s\1ci \ IC, \ kt\2o\1ra \ jest \ zapami\2e\1tywana
\-
\+
przez RS w \ odpowiedniej \ lokacji \ obiektu \ (Lsc). \ Na \ przyk\2l\1ad,
\-
\+
wywo\2l\1anie procedury loglanowej ma posta\2c\1: \,
\-
\+

\-
\+
    IC=m; Go(..);
\-
\+
Lm: ...;
\-
\+

\-
\+
Przy ponownym wywo\2l\1aniu tego modu\2l\1u, na \ przyk\2l\1ad \ po \ powrocie \ z
\-
\+
wywo\2l\1anej \ procedury, \ odtworzona \ warto\2sc \ \1IC \ \ pozwala \ \ Running
\-\/
\+
Systemowi trafi\2c \1w poprawne miejsce modu\2l\1u, a wi\2e\1c w instrukcje po
\-
\+
wywo\2l\1aniu Go(...). \,
\-
\+
\,
\-
\+
\,
\-
\+
Pierwsze wej\2s\1cie do modu\2l\1u okre\2s\1la warto\2sc \1IC=1, zatem etykieta L1
\-
\+
musi \ wyst\2a\1pi\2c \ \1przed \ pierwsz\2a \ \1przet\2l\1umaczon\2a \ \1na \ C \ instrukcj\2a
\-
\+
\1loglanow\2a\1. \,
\-
\+
\,
\-
\+
Jak ju\2x \1powiedzieli\2s\1my, ka\2x\1dy modu\2l \1loglanowy ma sw\2o\1j \ odpowiedni
\-
\+
modu\2l \1w j\2e\1zyku C. Poniewa\2x \1chcemy przekazywa\2c \1sterowanie pomi\2e\1dzy
\-
\+
takimi modu\2l\1ami w C, wraz z tekstami modu\2lo\1w przet\2l\1umaczony tekst
\-
\+
musi mie\2c \1zdefiniowan\2a \1tablic\2e\1: \,
\-
\+

\-
\+
   \4int \1(* module []) () ;
\-
\+
\,
\-
\+
Ka\2x\1da pozycja \ w \ tej \ tablicy \ musi \ okre\2s\1la\2c \ \1modu\2l\1, \ zgodnie \ z
\-
\+
porz\2a\1dkiem zadanym przez tablic\2e \1PROT. Ca\2l\1y program \ ko\2n\1czy \ modu\2l
\-
\+
\1main(), gdzie warto\2s\1ci tej tablicy musz\2a \1by\2c \1tak w\2l\1a\2s\1nie okre\2s\1lone
\-
\+
i \ gdzie \ przekazuje \ si\2e \ \1sterowanie \ do \ \ loglanowego \ \ programu
\-
\+
g\2lo\1wnego: \,
\-
\+

\-
\+
main ()
\-
\+
{
\-
\+
  module[0]=A1;
\-
\+
    ...
\-
\+
  module[k]=Ak;
\-
\+
  Init();
\-
\+
  IC=1;
\-
\+
  ...\,
\-
\+
}
\-
\+

\-
\+
W \ powy\2x\1szym \ tek\2s\1cie \ A1,...,Ak \ s\2a \ \ \1nazwami \ \ modu\2lo\1w, \ \ kt\2o\1re
\-
\+
wprowadzi\2l \1translator i okre\2s\1laj\2a \1one \ odpowiednie \ modu\2l\1y \ w \ C.
\-
\+
Instrukcja Init() inicjalizuje struktury danych Running \ Systemu.
\-
\+
Potem IC okre\2s\1lamy na 1 i \ przekazujemy \ sterowanie \ do \ programu
\-
\+
loglanowego \ ( \ przekazywanie \ \ sterowania \ \  pomi\2e\1dzy \ \ modu\2l\1ami
\-
\+
zostanie porzedstawione w rozdziale 7). \,
\-
\+

\-
\+
W podobny spos\2o\1b definiuje si\2e \1etykiet\2e \3lastwill \1w module. Atrybut
\-
\+
\3lastwill \1w prototypie musi \ okre\2s\1la\2c \ \1tak\2a \ \1warto\2sc \ \1zmiennej \ IC,
\-
\+
kt\2o\1ra przeka\2x\1e sterowanie w odpowiednie miejsce modu\2l\1u. \,
\-
\+
\,
\-
\+
\,
\-
\+
5. Adresowanie
\-
\+

\-
\+
Plik \ Rsdata.h \ dostarcza \ \ odpowiednich \ \ macro \ \  s\2l\1u\2xa\1cych \ \ do
\-
\+
adresowania zmiennych loglanowych. \ Macro \ Address(\3dnum\1,\3off\1) \ daje
\-
\+
adres zmiennej o numerze displaya \3dnum \1i offsecie \ \3off\1. \ Wykonanie
\-
\+
zatem instrukcji podstawienia: \,
\-
\+
\,
\-
\+
    i:=j+k
\-
\+
\,
\-
\+
dla \ zmiennych \ integer \ \ o \ \ adresach \ \ (\3dnum\1,\3off\1) \ \ odpowiednio
\-
\+
(1,2),(2,3) oraz (1,4) t\2l\1umaczymy nast\2e\1puj\2a\1co: \,
\-
\+
\,
\-
\+
    *Address(1,2)= *Address(2,3) + *Address(1,4);
\-
\+

\-
\+
Plik Rsdata.h daje \ tak\2x\1e \ dwa \ dodatkowe \ macra \ dla \ adresowania
\-
\+
lokalnego i globalnego. Local(\3off\1) daje adres w obiekcie \ aktywnym
\-
\+
o \ offsecie \ \3off\1, \ Global(\3off\1) \ daje \ adres \ w \ obiekcie \ programu
\-
\+
g\2lo\1wnego o offsecie \3off\1. Instrukcj\2e\1:\,
\-
\+
\,
\-
\+
    i:=i-j
\-
\+
\,
\-
\+
gdzie i jest zmienn\2a \1globaln\2a \1o offsecie \ 5, \ a \ j \ jest \ zmienn\2a
\-
\+
\1lokaln\2a \1o offsecie 2 t\2l\1umaczymy nast\2e\1puj\2a\1co: \,
\-
\+

\-
\+
    *Global(5) -= *Local(2);
\-
\+

\-
\+
Wykonywanie operacji arytmetycznych na innym \ typie \ ni\2x \ \1integer
\-
\+
wymaga \ zastosowania \  zmiany \ typu \ (cast). \ Nie \ wiem \ \ jak \ \ w
\-
\+
przysz\2l\1o\2s\1ci post\2a\1pi kompilator z typami pierwotnymi \  r\2ox\1nymi \ od
\-
\+
typu integer, niemniej dla typu real mo\2x\1emy \ w \ spos\2o\1b \ naturalny
\-
\+
dokona\2c \1zmiany kwalifikacji. Plik Rsdata.h  zawiera \  odpowiednie
\-
\+
makra \  Fladdress, \ Fllocal \ i \ Flglobal, \ \ kt\2o\1re \ \ automatycznie
\-
\+
dokonuj\2a \1konwersji typu integer na real. Zatem instrukcj\2e\1: \,
\-
\+
\,
\-
\+
    x:=x+y
\-
\+
\,
\-
\+
dla zmiennych typu real o \ adresach \ odpowiednio \ (2,3) \ i \ (1,4),
\-
\+
t\2l\1umaczymy nast\2e\1puj\2a\1co: \,
\-\/
\+

\-
\+
   *Fladdress(2,3) += *Fladdress(1,4);
\-
\+

\-
\+
\,
\-
\+
\,
\-
\+
Poza \ optymalizacj\2a \ \1adresowania \ \  polegaj\2a\1c\2a \ \ \1na \ \ wywo\2l\1ywaniu
\-
\+
uproszczonych macro (Global i \ Local), \ kompilator \ Loglanu \ mo\2x\1e
\-
\+
stosowa\2c \1zmienne lokalne j\2e\1zyka C. \ Dotyczy \ to \ w \ szczeg\2o\1lno\2s\1ci
\-
\+
zmiennych steruj\2a\1cych p\2e\1tlami, ale tak\2x\1e wielu \ innych \ sytuacji.
\-
\+
(Poniewa\2x \ \1zaproponowana \ tutaj \ wersja \ kompilatora \ nie \ wymaga
\-
\+
generowania \ \ zmiennych \ \ roboczych, \ \ nie \ \ \ widz\2e \ \ \ \1mo\2x\1liwo\2s\1ci
\-
\+
wykorzystania takiej techniki w obliczaniu wyra\2x\1e\2n\1.) \ Przyk\2l\1adowo
\-
\+
w Loglanie p\2e\1tle: \,
\-
\+
\,
\-
\+
     k:=0;
\-
\+
     \4for \1i:=3 \4to \1n
\-
\+
     \4do
\-
\+
       if \1(p \4mod \1i)=0 \4then \1k:=1; \4exit fi\1;
\-
\+
     \4od\1;
\-
\+

\-
\+
mo\2x\1emy przet\2l\1umaczy\2c  \1nast\2e\1puj\2a\1co  (wiedz\2a\1c, \2x\1e k \ jest \  zmienn\2a
\-
\+
\1o adresie (3,4), n  jest  zmienn\2a \1o adresie  (0,1)  i wreszcie  p
\-
\+
jest zmienn\2a \1o adresie (1,2)): \,
\-
\+

\-
\+
     *Address(3,4)=0;
\-
\+
     { \4int \1i;
\-
\+
       \4for \1(i=3; i<= *Global(1); i++)
\-
\+
       {
\-
\+
         \4if \1( *Address(1,2) % i ==0) { *Address(3,4)=1; \4break\1;};
\-
\+
       };
\-
\+
     };
\-
\+
\,
\-
\+
co oczywi\2s\1cie da znacznie lepszy kod ko\2n\1cowy, ni\2x \ \1wersja \ "czysto
\-
\+
loglanowa": \,
\-
\+

\-
\+
     *Address(3,4)=0;
\-
\+
     *Local(2)=3;       /*  za\2lox\1my, \2x\1e i ma lokalny offset 2 */
\-
\+
     \4while\1(1)
\-
\+
     {
\-
\+
        \4if \1( *Local(2) > *Global(1) ) \4break\1;
\-
\+
        \4if \1( *Address(1,2) % *Local(2) ==0)
\-
\+
         { *Address(3,4)=1; \4break\1; };
\-
\+
        (*Local(2))++;
\-\/
\+
     };
\-
\+

\-
\+

\-
\+
\,
\-
\+
Dost\2e\1p \ do \ \ element\2o\1w \ \ tablic \ \ dynamicznych \ \ daje \ \ procedura
\-
\+
Arrayelem(X,i). \ \ Pierwszy \ \ parametr \ \ musi \ \ okre\2s\1la\2c \ \ \1zmienn\2a
\-
\+
\1referencyjn\2a \1wskazuj\2a\1c\2a \1obiekt tablicy natomiast \ drugi \ parametr
\-
\+
musi okre\2s\1la\2c \ \1indeks \ tablicy. \ Przyk\2l\1adowo, \ wczytanie \ tablicy
\-
\+
ca\2l\1kowitej wyznaczonej przez adres (1,2) o zakresie wska\2z\1nika \ od
\-
\+
1 do n, gdzie n ma adres (0,8), mo\2x\1e wygl\2a\1da\2c \1nast\2e\1puj\2a\1co: \,
\-
\+
\,
\-
\+
    {\4int \1i;
\-
\+
      \4for \1(i=1; i<= *Global(8); i++)
\-
\+
       scanf("%d", Arrayelem(*Address(1,2),i));
\-
\+
    };
\-
\+

\-
\+

\-
\+
Natomiast wypisanie takiej tablicy b\2e\1dzie \ r\2o\1wnie \ proste, \ i \ ma
\-
\+
posta\2c \1nast\2e\1puj\2a\1c\2a\1: \,
\-
\+

\-
\+
    {\4int \1i;
\-
\+
      \4for \1(i=1; i<= *Global(8); i++)
\-
\+
       printf("%d", *Arrayelem(*Address(1,2),i));
\-
\+
    };
\-
\+

\-
\+
W celu wykonywania adresowania zdalnego nale\2x\1y wywo\2l\1a\2c \ \1procedur\2e
\-
\+
\1RS o nazwie Physical(X). Parametrem tej procedury jest referencja
\-
\+
do \ obiektu. \ Adres \ wzgl\2e\1dny \ w \ obiekcie \ wyznacza \ translator.
\-
\+
Przyk\2l\1adowo rozwa\2x\1my instrukcj\2e \1i:=X.k, gdzie i ma adres (1,1), X
\-
\+
ma adres (2,3) i wreszcie k ma offset 4. Odpowiednia instrukcja w
\-
\+
j\2e\1zyku C powinna mie\2c \1posta\2c\1: \,
\-
\+
\,
\-
\+
    *Address(1,1)= *(Physical(Address(2,3)+4);
\-
\+

\-
\+
RS \ dostarcza \ tak\2x\1e \ wielu \ pomocnych \ \ operacji \ \ na \ \ adresach
\-
\+
wirtualnych. Poza Physical(X) mamy Physimple(X), kt\2o\1ra \ realizuje
\-
\+
wyznaczenie adresu bez sprawdzania zgodno\2s\1ci licznik\2o\1w (mo\2x\1e \ by\2c
\-
\+
\1u\2x\1ywana \ w \ zoptymalizowanych \ wersjach). \ \ Mamy \ \ te\2x \ \ \1operacje
\-
\+
podstawienia referencyjnego Refmove(X<Y) co odpowiada X:=Y. \ Dwie
\-
\+
funkcje \ Member(X) \ i \ Notmember(X) \ daj\2a \ \1odpowiednie \ testy \ na
\-
\+
istnienie \ obiektu. \ Wreszcie \ Equal(X,Y) \ i \ Notequal(X,Y) \ daj\2a
\-
\+
\1por\2o\1wnania \ zmiennych \ referencyjnych, \ co \ odpowiada \ warto\2s\1ciom
\-\/
\+
wyra\2x\1e\2n  \1X=Y i \ X=/=Y. \  Instrukcj\2e \ \1X:=\4none \ \1realizuje \ none(X).
\-
\+
Ponadto wszystkie zmienne referencyjne (nie  dotyczy \ to \ adres\2o\1w
\-
\+
po\2s\1rednich) s\2a \1inicjalizowane na \4none\1. Inne zmienne maj\2a \ \1warto\2sc
\-
\+
\1pocz\2a\1tkowa nieokre\2s\1lona. \,
\-
\+

\-
\+
6. Operacje  otwierania obiekt\2o\1w
\-
\+

\-
\+
Mamy cztery operacje otwierania obiekt\2o\1w: Openrc, Slopen, Dopen \ i
\-
\+
Open array. Ich nag\2lo\1wki s\2a \1nast\2e\1puj\2a\1ce: \,
\-
\+

\-
\+
   Openrc (\3a\1,X)
\-
\+
    \4int \3a\1;
\-
\+
   \4unsigned int \1*X;
\-
\+

\-
\+

\-
\+
   Slopen (\3a\1,X,Y)
\-
\+
   \4unsigned int \1*X,*Y;
\-
\+
    \4int \3a\1;
\-
\+

\-
\+

\-
\+
   Dopen(\3a\1,\3b\1,X)
\-
\+
    \4int \3a\1,\3b\1;
\-
\+
   \4unsigned int \1*X;
\-
\+

\-
\+

\-
\+
   Openarray (\3a\1,\3l\1,\3u\1,X)
\-
\+
   \4int \3l\1,\3u\1;
\-
\+
    \4int \3a\1;
\-
\+
   \4unsigned int \1*X;
\-
\+

\-
\+

\-
\+
Procedura Openrc otwiera obiekt klasy, \ kt\2o\1ra \ nie \ ma \ kodu \ ani
\-
\+
modu\2lo\1w wewn\2e\1trznych. Slopen otwiera \  obiekt \  ze \ znanym \ ojcem
\-
\+
syntaktycznym \ (dost\2e\1p \ zdalny \ do \ procedury). \ Procedura \ Dopen
\-
\+
otwiera obiekt modu\2l\1u widocznego i wreszcie \ procedura \ Openarray
\-
\+
otwiera \ obiekt \ tablicy. \ Parametr \ X \ jest \ \ adresem \ \ zmiennej
\-
\+
referencyjnej, kt\2o\1ra po wykonaniu odpowiedniej \ procedury \ b\2e\1dzie
\-
\+
wskazywa\2c \1na otwarty \ obiekt. \ Parametr \ \3a \  \1wskazuje \ zawsze \ na
\-
\+
indeks prototypu otwieranego obiektu w tablicy PROT. \,
\-
\+
\,
\-
\+
W procedurze Slopen parametr Y wskazuje na obiekt, kt\2o\1ry \ ma \ by\2c
\-
\+
\1ojcem syntaktycznym otwieranego obiektu. \ W \ procedurze \ Dopen \ \3b
\-
\+
\1jest \ numerem \ prototypu \ w \ kt\2o\1rym \ jest \  zadeklarowany \ \ modu\2l
\-\/
\+
\1otwierany. W procedurze Openarray  parametry \3l\1, \3u \1okre\2s\1laj\2a \1dolny
\-
\+
i g\2o\1rny wska\2z\1nik indeksu. \,
\-
\+
\,
\-
\+
\,
\-
\+
7. Operacje przekazywania sterowania
\-
\+
\,
\-
\+
Wywo\2l\1anie modu\2l\1u loglanowego mo\2x\1e odbywa\2c \ \1si\2e \ \1tylko \ za \ pomoc\2a
\-
\+
\1wywo\2l\1ania odpowiedniego modu\2l\1u w C. Takie wywo\2l\1ania odk\2l\1adane \ na
\-
\+
stos \ powodowa\2l\1yby \ szybkie \ jego \ przepe\2l\1nienie. \ \ Aby \ \ unikn\2ac
\-
\+
\1odk\2l\1adania kopii modu\2lo\1w j\2e\1zyka C na stos mo\2x\1na za \ ka\2x\1dym \ razem
\-
\+
przekazywania sterowania pomi\2e\1dzy \ modu\2l\1ami \ wraca\2c \ \1do \ programu
\-
\+
g\2lo\1wnego main(), czyszcz\2a\1c w ten spos\2o\1b stos. \ Ka\2x\1da \ z \ procedur
\-
\+
przekazywania sterowania pomi\2e\1dzy modu\2l\1ami wyznacza \ tylko \ numer
\-
\+
kolejnego \ modu\2l\1u, \ kt\2o\1ry \ nale\2x\1y \ wywo\2l\1a\2c\1. \ Taki \ numer \ \ modu\2l\1u
\-
\+
b\2e\1dziemy trzyma\2c \1na zmiennej globalnej \3modulenumber\1. W \ programie
\-
\+
main() nale\2x\1y tylko wywo\2l\1a\2c \1odpowiedni modu\2l \1za pomoc\2a \1instrukcji
\-
\+
module[\3modulenumber\1]().\,
\-
\+
\,
\-
\+
\,
\-
\+
\,
\-
\+
Aby powr\2o\1t do programu main() czy\2s\1ci\2l \1stos, \ kt\2o\1ry \ mo\2x\1e \ zawiera\2c
\-
\+
\1poza kolejnym wykonywanym modu\2l\1em wywo\2l\1ania \ r\2ox\1nych \ pomocniczych
\-
\+
procedur, nale\2x\1y skorzysta\2c \1z procedur standardowych \ setjmp \ oraz
\-
\+
longjmp dostarczanych przez system C. Ustawiaj\2a\1c setjmp(buffer) \ w
\-
\+
programie \ g\2lo\1wnym, \ ka\2x\1de \ zako\2n\1czenie \ przekazywania \ sterowania
\-
\+
pomi\2e\1dzy modu\2l\1ami ko\2n\1czy wykonanie longjmp(buffer,-1). \ Sterowanie
\-
\+
wraca do setjmp(buffer) czyszcz\2a\1c \ stos. \ Zako\2n\1czenie \ wykonywania
\-
\+
programu \ mo\2x\1na \ zrealizowa\2c \ \1wywo\2l\1aniem \ \ longjmp(buffer,-2). \ \ W
\-
\+
zale\2x\1no\2s\1ci \ od \ warto\2s\1ci \ setjmp(buffer) \ otrzymanej \ w \ programie
\-
\+
main() mo\2x\1emy albo przekaza\2c \1sterowanie do kolejnego modu\2l\1u, \ albo
\-
\+
zako\2n\1czy\2c \1wykonywanie programu. Przy \ takich \ za\2l\1o\2x\1eniach \ program
\-
\+
g\2lo\1wny ma nast\2e\1puj\2a\1c\2a \1posta\2c\1:\,
\-
\+
\,
\-
\+
\,
\-
\+
\,
\-
\+
main ()
\-
\+
{
\-
\+
  module[0]=A1;
\-
\+
    ...
\-
\+
  module[k]=Ak;
\-
\+
  Init();
\-
\+
  IC=1;
\-
\+
  \3modulenumber\1=0;\,
\-
\+
  \4if \1(setjmp(buffer)!=-2) module[\3modulenumber\1]();\,
\-
\+
}
\-
\+
\,
\-
\+
W RS mamy \ pi\2ec \ \1operacji \ zwi\2a\1zanych \ z \ prostym \ przekazywaniem
\-
\+
sterowania: \ Go, \ Back, \ Endclass, \ Inn \ oraz \ Endrun. \ Oto \ \ ich
\-
\+
nag\2lo\1wki: \,
\-
\+
\,
\-
\+
   Go (X)
\-
\+
   \4unsigned int \1*X;
\-
\+

\-
\+
   Back ()
\-
\+
\,
\-
\+
   Endclass()\,
\-
\+

\-
\+
   Inn(k)
\-
\+
   \4int \1k;
\-
\+
\,
\-
\+
   Endrun ()
\-
\+
\,
\-
\+
Procedura \ Go(X) \ przekazuje \ sterowania \ do \ obiektu \ X. \ \ Typowa
\-
\+
kolejno\2sc \ \ \1operacji \ \ przy \ \ przekazywaniu \ \ \  sterowania \ \ \ jest
\-
\+
nast\2e\1puj\2a\1ca: \,
\-
\+

\-
\+
   Dopen(a,b,X);
\-
\+
   /* przekazanie parametr\2o\1w  do X */
\-
\+
   IC=m;  Go(X);
\-
\+
Lm:/* po powrocie z X */
\-
\+

\-
\+
\,
\-
\+
Procedura Back() zwraca sterowanie po Dl. Nie \ ma \ parametr\2o\1w. \ W
\-
\+
przypadku wsp\2ol\1program\2o\1w \ musi \ by\2c \ \1po \ niej \ wej\2s\1cie \ opatrzone
\-
\+
etykiet\2a\1: \,
\-
\+
\,
\-
\+
   IC=m; Back();
\-
\+
Lm:/* ponowna reaktywacja modu\2l\1u */
\-
\+
\,
\-
\+
Procedura \ Endclass() \ realizuje \ operacj\2e \ \ \1zako\2n\1czenia \ \ klasy.
\-
\+
Wywo\2l\1ujemy j\2a \1w miejscu wyst\2a\1pienia ko\2n\1ca klasy (\4return \1w \ klasie
\-
\+
t\2l\1umaczone \ jest \ zawsze \ na \ Back \ ). \ Procedura \ \ ta \ \ sprawdza
\-
\+
dynamicznie w jakiego typu obiekcie jest sterowanie. Je\2x\1eli \ jest
\-
\+
to obiekt wsp\2ol\1programu, wywo\2l\1ywana \ jest \ operacja \ Endcor(). \ W
\-
\+
przeciwnym przypadku \ wywo\2l\1ywana \ jest \ zwyk\2l\1a \ operacja \ Back().
\-
\+
Zako\2n\1czenie \ nieprefiksowanego \ podprogramu \ \ lub \ \ bloku \ \ mo\2x\1na
\-
\+
zrealizowa\2c \1za pomoc\2a \1procedury \ Back(), \ natomiast \ w \ przypadku
\-
\+
klasy \ niemo\2x\1liwe \ jest \ statyczne \ sprawdzenie \ czy \ b\2e\1dzie \ \ to
\-
\+
instrukcja ko\2n\1cz\2a\1ca wsp\2ol\1program, czy te\2x \1nie. \,
\-
\+

\-
\+
Procedura Inn(k) przekazuje sterowanie \ przez \ \4inner\1. \ Warto\2sc \ \1k
\-
\+
okre\2s\1la d\2l\1ugo\2sc l\1a\2n\1cucha prefiksowego danego \ modu\2l\1u. \ Instrukcja
\-
\+
po Inn(k) musi by\2c \1tak\2x\1e w stosowny \ spos\2o\1b \ opatrzona \ etykiet\2a\1.
\-
\+
Powr\2o\1t za \4inner \1wykonuje si\2e \1bezpo\2s\1rednio, bez \ uczestnictwa \ RS.
\-
\+
Na przyk\2l\1ad, maj\2a\1c \ modu\2l\1y \ A \ i \ B \ (B \ prefiksowany \ przez \ A),
\-
\+
operacja  \4inner \1w A oraz powr\2o\1t w B powinny wygl\2a\1da\2c \1nast\2e\1puj\2a\1co: \,
\-
\+
\,
\-
\+
  A()
\-
\+
  {
\-
\+
    ...
\-
\+
    Inn(1);\,
\-
\+
Lm:  ...
\-
\+
  };
\-
\+
\,
\-
\+
  B()
\-
\+
  {
\-
\+
    ...
\-
\+
    IC=m; \,
\-
\+
    \3modulenumber\1=n; /* gdzie n jest numerem modu\2l\1u A */\,
\-
\+
    longjmp(buffer,-1); /* skok do programu g\2lo\1wnego */\,
\-\/
\+
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ /* gdzie wywo\2l\1any zostanie modu\2l \1A */\,
\-
\+
  };
\-
\+

\-
\+
Procedura Endrun ko\2n\1czy wykonanie programu.
\-
\+
\,
\-
\+
8. Operacje usuwania obiekt\2o\1w
\-
\+

\-
\+
Mamy \  dwie \  procedury \ do \ usuwania \ obiekt\2o\1w \ : \ Killafter() \ i
\-
\+
Gkill(X). Pierwsza z nich wywo\2l\1ywana jest po powrocie z procedury,
\-
\+
funkcji lub \ bloku \ loglanowego. \ Jej \ zadaniem \ jest \ czyszczenie
\-
\+
\2l\1a\2n\1cucha Sl (patrz \ punkt \ 3). \ Zatem \ typowa \ kolejno\2sc \ \1operacji
\-
\+
wywo\2l\1ania takiego modu\2l\1u loglanowego b\2e\1dzie nast\2e\1puj\2a\1ca :\,
\-
\+
\,
\-
\+
        Dopen(a,b,X);
\-
\+
        /* przekazanie parametr\2o\1w wej\2s\1ciowych */
\-
\+
        IC=m;  Go(X);
\-
\+
Lm:     /* przekazanie parametr\2o\1w wyj\2s\1ciowych */
\-
\+
        Killafter();
\-
\+

\-
\+
Jakkolwiek nowy RS jest wyposa\2x\1ony w \ automatyczny \ od\2s\1miecacz \ i
\-
\+
zb\2e\1dne obiekty funkcji, procedur i blok\2o\1w \ i \ tak \ b\2e\1da \ usuwane,
\-
\+
jednak\2x\1e wywo\2l\1anie Killafter() w przypadku \ ka\2x\1dego \ modu\2l\1u \ typu
\-
\+
procedura, funkcja lub blok usprawni dzia\2l\1anie pami\2e\1ci \ RS, \ gdy\2x
\-
\+
\1najcz\2es\1ciej jest to ostatni obiekt w pami\2e\1ci, \ kt\2o\1rego \ usuni\2e\1cie
\-
\+
odbywa si\2e \1jak na stosie. \,
\-
\+
\,
\-
\+
Operacja Gkill(X) jest star\2a \1operacj\2a \1z modyfikacjami opisanymi \ w
\-
\+
punkcie 3. Parametrem tej operacji jest adres usuwanego obiektu. \,
\-
\+

\-
\+

\-
\+
\,
\-
\+
9. Operacje na wsp\2ol\1programach
\-
\+

\-
\+

\-
\+
RS dostarcza trzech procedur operuj\2a\1cych na wsp\2ol\1programach. S\2a \1to
\-
\+
operacje \ Endcor(), \ Attach(X) \ \ oraz \ \ Attachwith(X,\3signalnum\1,Y).
\-
\+
Operacja Endcor jest wywo\2l\1ywana na zako\2n\1czenie wsp\2ol\1programu. \ Jej
\-
\+
dzia\2l\1anie zosta\2l\1o om\2o\1wione przy okazji \ opisywania \ struktury \ Dl.
\-
\+
Operacja \ Attach(X) \ \ przekazuje \ \ sterowanie \ \ do \ \ wsp\2ol\1programu
\-
\+
wyznaczonego przez parametr X. \,
\-
\+
\,
\-
\+
Wi\2e\1kszego om\2o\1wienia \ wymaga \ natomiast \ operacja \ Attachwith. \ Jej
\-
\+
pierwszym parametrem jest referencja do wsp\2ol\1programu gdzie ma by\2c
\-
\+
\1wywo\2l\1any alarm. Drugi parametr to numer \ sygna\2l\1u. \ Wreszcie \ trzeci
\-
\+
parametr jest referencj\2a \1do obiektu utworzonego \ handlera \ (o \ ile
\-
\+
taki zostanie znaleziony). Po wywo\2l\1aniu mo\2x\1na b\2e\1dzie przekaza\2c \ \1do
\-
\+
handlera parametry wej\2s\1ciowe i dopiero wtedy przekaza\2c \ \1sterowanie
\-
\+
do wsp\2ol\1programu X za \ pomoc\2a \ \1zwyk\2l\1ego \ Attach. \ Ciag \ instrukcji
\-
\+
realizuj\2a\1cych \ wywo\2l\1anie \ sygna\2l\1u \ w \ innym \ wsp\2ol\1programie \ \ mo\2x\1e
\-
\+
wygl\2a\1da\2c \1na przyk\2l\1ad tak: \,
\-
\+
\,
\-
\+
     Attachwith(X,s,Y);
\-
\+
     /* przekazujemy do Y parametry wej\2s\1ciowe */
\-
\+
     IC=m;  Attach(X);
\-
\+
Lm:  /* dalsze instrukcje w module */
\-
\+

\-
\+

\-
\+

\-
\+
10. Wyj\2a\1tki
\-
\+

\-
\+
Z \ wyj\2a\1tkami \ \ zwi\2a\1zane \ \ s\2a \ \ \1operacje \ \ Raising(\3signalnum\1,X) \ \ i
\-
\+
Termination() oraz etykiety \3lastwill\1. \,
\-
\+

\-
\+
Operacja Raising(\3signalnum\1,X) powoduje \ poszukiwanie \ w \ aktywnym
\-
\+
\2l\1a\2n\1cuchu Dl handlera dla sygna\2l\1u o numerze \3signalnum\1. Je\2x\1eli taki
\-
\+
handler \ zostanie \ znaleziony, \ otwarty \ zostanie \ jego \ \ obiekt,
\-
\+
kt\2o\1rego referencja przekazana zostanie \ na \ parametr \ X. \ Po \ tej
\-
\+
instrukcji \ mo\2x\1na \ przekaza\2c \ \1do \ \ obiektu \ \ handlera \ \ parametry
\-
\+
wej\2s\1ciowe i wreszcie przekaza\2c \ \1sterowanie \ do \ handlera \ zwyk\2l\1ym
\-
\+
Go(X). Czyli odpowiedni ci\2a\1g instrukcji jest \ taki \ sam \ jak \ dla
\-
\+
wywo\2l\1ania procedury. \ Zamiast \ operacji \ Dopen \ czy \ Slopen \ mamy
\-
\+
operacj\2e \1Raising. Oczywi\2s\1cie po powrocie obiekt \ handlera \ chcemy
\-
\+
usun\2ac\1, musi zatem wyst\2a\1pi\2c \1Killafter(). \,
\-
\+
\,
\-
\+
\,
\-
\+
Je\2x\1eli w handlerze wyst\2e\1puje \ na \ zako\2n\1czenie \ instrukcja \ \4return\1,
\-
\+
wykonuje \ si\2e \ \1zwyk\2l\1e \ Back() \ z \ jego \ konsekwencjami. \ Mamy \ \ do
\-
\+
czynienia ze zwyk\2l\1a procedur\2a \1tylko wo\2l\1an\2a \1dynamicznie. Je\2x\1eli \ na
\-
\+
zako\2n\1czenie \ handlera \ wyst\2e\1puje \ terminate, \ wywo\2l\1ujemy \ operacj\2e
\-
\+
\1Termination(). Jak teraz powinny wygl\2a\1da\2c \ \1odpowiednie \ instrukcj\2e
\-
\+
\1lastwill. Ot\2ox \1Termination ustawia w ka\2x\1dym obiekcie \ \2l\1a\2n\1cucha \ Dl
\-
\+
(od  obiektu gdzie wywo\2l\1ano \ alarm \ do \ obiektu \ gdzie \ znaleziono
\-
\+
handler) lokalne sterowanie \ na \ etykiet\2e \ \3lastwill\1. \ Nast\2e\1pnie \ w
\-
\+
handlerze nale\2x\1y wykona\2c \1zwyk\2l\1e \ Back() \ - \ powr\2o\1t \ po \ Dl \ linku.
\-
\+
Pierwsza \  instrukcja \ lastwill \ \ powinna \ \ by\2c \ \ \1zatem \ \ operacj\2a
\-
\+
\1Killafter(). Czyli w handlerze terminate t\2l\1umaczymy na: \,
\-
\+
\,
\-
\+
          Termination();
\-
\+
          Back();
\-
\+

\-
\+
natomiast  ci\2a\1g instrukcji lastwill powinien wygl\2a\1da\2c \1nast\2e\1puj\2a\1co:
\-
\+
\,
\-
\+
Lk:  Killafter();         /* Lk etykieta dla IC=k dla lastwill */
\-
\+
     ....                 /* instrukcje lastwill */
\-
\+
     Back();              /* lub IC=...; \3modulenumber\1= ...;\,
\-
\+
                             longjmp(buffer,-1); \,
\-\/
\+
                             w przypadku modu\2l\1u prefiksowanego  */
\-
\+

\-
\+

\-
\+
\,
\-
\+
11. Za\2la\1czone przyk\2l\1ady
\-
\+

\-
\+
System RS testowa\2l\1em na przyk\2l\1adach napisanych r\2e\1cznie. \ Stara\2l\1em
\-
\+
si\2e \ \1przetestowa\2c \ \1wszystkie \ wa\2x\1ne \ konstrukcje \ \ RS, \ \ a \ \ wi\2e\1c
\-
\+
otwieranie \ obiekt\2o\1w, \ przekazywanie \ sterowania, \ wsp\2ol\1programy,
\-
\+
wyj\2a\1tki, \ tablice \ dynamiczne, \ no \ i \ oczywi\2s\1cie \ od\2s\1miecacz \ \ z
\-
\+
kompaktyfikatorem. Nie \ mog\2l\1em \ przetestowa\2c \ \1tego \ systemu \ zbyt
\-
\+
szczeg\2ol\1owo, gdy\2x \ \1zawiera \ on \ za \ wiele \ elemnt\2o\1w \ trudnych \ do
\-
\+
wychwycenia w r\2e\1cznym tworzeniu kodu. \ Nie \ przetestowa\2l\1em \ wielu
\-
\+
fragment\2o\1w \ zwi\2a\1zanych \ z \ definicj\2a \ \ \1struktur \ \ referencyjnych.
\-
\+
Oczywi\2s\1cie, wydaje \ mi \ si\2e\1, \ \2x\1e \ przetestowanie \ ca\2l\1o\2s\1ci \ nale\2x\1y
\-
\+
od\2l\1o\2x\1y\2c \1do czasu powstania kompilatora. \,
\-
\+
\,
\-
\+
\,
\-
\+
Przyk\2l\1ad perm.c odpowiada znanej nam procedurze \ rekurencyjnej \ na
\-
\+
generowanie wszystkich permutacji. Przyk\2l\1ad ten testuje \ dzia\2l\1anie
\-
\+
otwierania \ obiektu \ widocznego, \ tablice, \ rekursj\2e\1, \ adresowanie
\-
\+
nielokalne i u\2x\1ycie zmiennych sterowania p\2e\1tla. \,
\-
\+

\-
\+
Przyk\2l\1ad  merge.c   jest stosunkowo du\2x\1ym programem do testowania
\-
\+
operacji na wsp\2ol\1programach. Jest to znany \ program \ na \ scalanie
\-
\+
drzew binarnych poszukiwa\2n\1. \ Program \ testuje \ tak\2x\1e \ wywo\2l\1ywanie
\-
\+
zdalne procedur, przekazywanie parametr\2o\1w referencyjnych, tablice
\-
\+
wsp\2ol\1program\2o\1w, operacje Attach, itp. Napisa\2l\1em przy okazji \ trzy
\-
\+
warianty tego przyk\2l\1adu pozwalaj\2a\1ce \ testowa\2c \ \1inne \ operacje \ na
\-
\+
wsp\2ol\1programach. Ot\2ox \1mergecor.c jest tym samym algorytmem, z tym
\-
\+
\2x\1e \ zako\2n\1czenie \ sygnalizuje \  operacja \ Attachwith \ do \ drugiego
\-
\+
wsp\2ol\1programu. Przyk\2l\1ad testcor.c testuje poprawno\2sc \ \1reakcji \ na
\-
\+
pr\2o\1b\2e \1reaktywacji wsp\2ol\1programu zako\2n\1czonego. Wreszcie \  kmerge.c
\-
\+
jest wariantem tego przyk\2l\1adu gdzie usuwane s\2a \ \1za \ pomoc\2a \ \1Gkill
\-
\+
zb\2e\1dne obiekty. Przyk\2l\1ad ten \ s\2l\1u\2x\1y\2l \ \1przetestowaniu \ poprawno\2s\1ci
\-
\+
dzia\2l\1ania \ \ w\2l\1a\2s\1nie \ \  operacji \ \ Gkill, \ \ tak\2x\1e \ \ w \ \ \ przypadku
\-
\+
wsp\2ol\1program\2o\1w (a to jest przypadek trudniejszy). \,
\-
\+
\,
\-
\+
\,
\-
\+
Program  memor.c by\2l \1dla mnie najtrudniejszy w uruchamianiu. Jest
\-
\+
to kr\2o\1tki program  na  testowanie od\2s\1miecacza i kompaktyfikatora.
\-
\+
Poniewa\2x \1kompaktyfikator musia\2l \ \1by\2c \ \1nieznacznie \ rozszerzony \ z
\-
\+
uwagi na nowa koncepcje Statsl, wprowadzi\2l\1em \ dodatkowy \ przebieg
\-
\+
poprawiaj\2a\1cy to pole dla obiekt\2o\1w, kt\2o\1re po od\2s\1mieceniu pozostan\2a
\-
\+
x\1ywe. Testowa\2l\1em kompaktyfikator dla r\2ox\1nych \ parametr\2o\1w \  w \ tym
\-
\+
przyk\2l\1adzie (n=liczba obiekt\2o\1w wygenerowanych, \ k= \ cz\2e\1stotliwo\2sc
\-
\+
\1usuwania poprzednik\2o\1w). Poniewa\2x \1j\2e\1zyk C \ umo\2x\1liwia \ profilowanie
\-
\+
programu, by\2l\1em \ w \ stanie \ oszacowa\2c \ \1koszt \ wzgl\2e\1dny \ dzia\2l\1ania
\-
\+
kompaktyfikatora. Ot\2ox \1kompaktyfikator  zabiera\2l \1nie wi\2e\1cej ni\2x \16
\-
\+
procent  czasu dzia\2l\1ania programu , kt\2o\1ry sam nic \ w\2l\1a\2s\1ciwie \ nie
\-
\+
robi. \ Du\2x\1a \ cz\2esc \ \1czasu \ (ponad \ 4 \ procent) \ \ zajmuje \ \ jednak
\-
\+
inicjalizowanie zmiennych referencyjnych. \ Wydaje \ si\2e\1, \ \2x\1e \ taka
\-
\+
inicjalizacja mog\2l\1aby by\2c \ \1czasem \ pomijana \ (programista \ bardzo
\-
\+
rzadko zapomina o podstawieniu \ na \ zmienn\2a \ \1referencyjn\2a\1). \ Przy
\-
\+
okazji tego \ testu \ musz\2e \ \1zwr\2o\1ci\2c \ \1uwag\2e \ \1na \ to, \ \2x\1e \ w \ wersji
\-
\+
loglanowej nowego RS inicjalizacja zmiennych by\2l\1a wykonywana wraz
\-
\+
z zerowanie obiektu (\4none \1=[0,0]). Niestety w wersji napisanej \ w
\-
\+
C chcia\2l\1em, aby zmienne loglanowe \ by\2l\1y \ adresowane \ nie \ poprzez
\-
\+
indeks w tablicy M, ale przez adres w pami\2e\1ci. Takie \ rozwi\2a\1zanie
\-
\+
jest oczywi\2s\1cie bardziej efektywne, ale wymaga innego \ okre\2s\1lenia
\-
\+
\4none\1.  Mianowicie \4none\1=[M0,0], gdzie M0= &M[0], oraz M[1]=1. \ Ale
\-
\+
w\2o\1wczas inicjalizacj\2e \1obiektu trzeba wykonywa\2c \1przegl\2a\1daj\2a\1c list\2e
\-
\+
\1referencji \ - \ a \ to \ jak \ widzimy \ kosztuje \ bardzo. \ Co \ prawda
\-
\+
przyk\2l\1adowy \ program \ nie \ zawiera\2l \ x\1adnych \ oblicze\2n\1, \ a \ \ wi\2e\1c
\-
\+
inicjalizacja mog\2l\1a kosztowa\2c \1gros czasu dzia\2l\1ania. \,
\-
\+
\,
\-
\+
\,
\-
\+
\,
\-
\+
Napisa\2l\1em jeden przyk\2l\1ad testuj\2a\1cy \ arytmetyk\2e \ \1zmiennopozycyjn\2a\1.
\-
\+
Jest to program square.c gdzie  rozwi\2a\1zujemy r\2o\1wnanie kwadratowe.
\-
\+
Wykorzystuj\2a\1c macra dla arytmetyki \ zmiennopozycyjnej \ bez \ trudu
\-
\+
uda\2l\1o si\2e \1wyrazi\2c \1opracje na typie real. Wida\2c\1, \2x\1e wyra\2x\1enia mog\2a
\-
\+
\1pozosta\2c \1bez zmiany, ewentualne zmienne \ robocze \ wygeneruje \ sam
\-
\+
kompilator j\2e\1zyka C. Ich \ typ \ b\2e\1dzie \ dobrany \ zgodnie \ z \ typem
\-
\+
argument\2o\1w. \,
\-
\+
\,
\-
\+
\,
\-
\+
Przyk\2l\1ad  sltest.c s\2l\1u\2x\1y\2l \1do sprawdzenia dzia\2l\1ania nowej struktury
\-
\+
Sl. \ Prosty \  program \ o \  znanej \ strukturze, \ gdzie \ \ wywo\2l\1ywana
\-
\+
procedura ma zniszczone otoczenie \ statyczne, \ pozwala\2l \ \1sprawdzi\2c
\-
\+
\1poprawno\2sc \ \1dzia\2l\1ania \ tej \ techniki. \ Wydaje \ si\2e\1, \ \2x\1e \ \ ma \ \ ona
\-
\+
metodologicznie znaczna przewag\2e \1nad starym rozwi\2a\1zaniem \ (nie \ ma
\-
\+
efekt\2o\1w dziwnych i niezrozumia\2l\1ych \ dla \ programisty), \ a \ ponadto
\-
\+
jest stosunkowo \2l\1atwo implementowalna. Troch\2e \1tracimy \ na \ czasie,
\-
\+
poniewa\2x \1sprawdzenie i czyszczenie \2l\1a\2n\1cuch\2o\1w Sl jest \ dro\2x\1sze \ ni\2x
\-
\+
\1usuwanie na \2s\1lepo obiekt\2o\1w funkcji \ i \ blok\2o\1w. \ Z \ drugiej \ strony
\-
\+
zyskuje si\2e \1troch\2e \1na pami\2e\1ci gdy\2x \1Sl link mo\2x\1e by\2c \1referencj\2a \1bez
\-
\+
licznika. \,
\-
\+
\,
\-
\+
Ostatni przyk\2l\1ad functest.c s\2l\1u\2x\1y sprawdzeniu poprawno\2s\1ci u\2x\1ywania
\-
\+
zmiennych podprogramowych. W bloku g\2lo\1wnym zadeklarowany jest \ typ
\-
\+
funkcyjny F oraz funkcja  f z parametrem integer oraz typem wyniku
\-
\+
F. W funkcji tej zadeklarowano dwie inne funkcje \ h, \ g, \ kt\2o\1re \ w
\-
\+
tre\2s\1ci funkcji f  podstawiane s\2a \1jako jej wynik (typ f jest zgodny
\-
\+
z F). W programie g\2lo\1wnym na zmienne x,y podstawiana jest \ warto\2sc
\-
\+
\1wyniku wywo\2l\1ania funkcji f, dla argumentu 0 tym wynikiem \ jest \ h,
\-
\+
dla argumentu 1 tym wynikiem jest g. Wreszcie \ na \ ko\2n\1cu \ programu
\-
\+
wywo\2l\1ujemy x(n), oraz y(n) jako odpowiednie funkcje zapami\2e\1tane na
\-
\+
zmiennych x,y.
\-
\=
#include "rsdata.h"




    int IC;				/* global control */
    int modulenumber;			/* module number */
    unsigned int *DISPLAY,*DISPDIR;	/* displays' addresses */
    unsigned int *lastcor,*mycoroutine,*myprocess;
    unsigned int *current,*local,*global;



/************************************************************************/
/*									*/
/*									*/
/*			 Running System basic constants			*/
/*									*/
/*									*/
/************************************************************************/



#define maxint 65535
#define maxapp maxint		/* to be defined for each system */
#define maxcounter (-1)		/* maximal value of counter */
#define reflength 2		/* reference variable length */
#define memorylength 16000	/* to be defined for each system */
#define upr (memorylength-1)	/* memory upper index */
#define minsize 2		/* minimal object size */
#define virt1 reflength		/* auxiliary virtual addresses */
#define virt2 2*reflength
#define virt3 3*reflength
#define virt4 4*reflength
#define virtn virt4
#define lwr (virtn+reflength)	/* memory lower index */






/************************************************************************/
/*									*/
/*									*/
/*		Functions defining system offsets 			*/
/*									*/
/*									*/
/************************************************************************/



#define Sl(a,am) (am+PROT[a].Sloffset)		/* Sl link  offset */
#define Dl(a,am) (am+PROT[a].Dloffset)		/* Dl link  offset */
#define Statsl(a,am) (am+PROT[a].Statoffset)	/* Statussl offset */
#define Lsc(a,am) (am+PROT[a].Lscoffset)	/* Lsc      offset */

/************************************************************************/
/*									*/
/*	Sl - defines the static father of an object, where is declared	*/
/*	Dl - defines the dynamic father of an object, where to return	*/
/*	Statussl - defines the number of syntactic sons			*/
/*	Lsc - defines the local sequence control			*/
/************************************************************************/




/************************************************************************/
/*									*/
/*									*/
/*			 Running System basic offsets			*/
/*									*/
/*									*/
/************************************************************************/



/*----------------------------------------------------------------------*/
/* 				for arrays 				*/
/*----------------------------------------------------------------------*/

#define lboffset 1		/* array lower bound offset */
#define uboffset 2		/* array upper bound offset */
#define elmoffset 3		/* array first element offset */


/*----------------------------------------------------------------------*/
/* 				for killed objects			*/
/*----------------------------------------------------------------------*/


#define shortlink 1		/* offset of next shortlist element */
#define longlink 2		/* offset of next longlist element */



/************************************************************************/
/*									*/
/*									*/
/*			Entities imported from a program		*/
/*									*/
/*									*/
/************************************************************************/



extern int displ,curr,lstcor,chead,displdir;	/* basic offsets in main */
extern struct Prototype PROT[];			/* Prototypes */
extern struct Offsets OFF[];			/* Reference structures */
extern struct Elem EL[];			/* Lists of references */
extern struct Hlstelem HL[];			/* Lists of handlers */
extern struct Sgelem SL[]; 			/* Lists of signals */
extern int perm[],perminv[];			/* Langmaack's permutations */
extern int (*module []) ();			/* Modules addresses */
extern int protnum,offnum;			/* Length of PROT and OFF */
extern jmp_buf buffer;				/* buffer for jumps */



/************************************************************************/
/*									*/
/*			Loglan memory structure				*/
/*									*/
/*	M[lwr],...,M[lastused],.....,M[lastitem],...,M[upr]		*/
/*						where:			*/
/*		M[lwr],...,M[lastused] memory for objects		*/
/*		M[lastitem],...,M[upr] memory for indirect addresses	*/
/*									*/
/*----------------------------------------------------------------------*/
/*									*/
/*	Every reference X =  [ah,counter] 				*/
/*						where:			*/
/*		ah = address in indirect addresses table		*/
/*		counter = a consecutive positive integer		*/
/*									*/
/*	Every indirect addresses table item=  [am,guard_counter]	*/
/*						where:			*/
/*		am = address of an object				*/
/*		guard_counter = a consecutive positive integer		*/
/*----------------------------------------------------------------------*/
/*									*/
/*	X=none iff  counter <> guard_counter i.e. iff			*/
/*		M[X+1]<> M[M[X]+1]					*/
/************************************************************************/



unsigned int M[memorylength];		/* Loglan memory  */
unsigned int * M0;			/* address of M[0],[M0,0]=none */

unsigned int *lastitem,*freeitem;

	/* M[lastitem..upr] - indirect addresses table;
		M[freeitem] - head of free indirect addresses  */

unsigned int *lastused;

	/* M[lwr..lastused] - memory for objects */




/************************************************************************/
/*									*/
/*									*/
/*			Basic runnning system structures:		*/
/*									*/
/*	class object:							*/
/*			M[lspan],...,M[am],...,M[rspan]			*/
/*				where M[am]=prototype number		*/
/*									*/
/*	array object:							*/
/*			M[am],M[am+1],M[am+2],...,M[am+l-1]		*/
/*				where M[am]=prototype number		*/
/*				      M[am+1]= lowr bound		*/
/*				      M[am+2]= upper bound		*/
/*				      l = total length			*/
/*----------------------------------------------------------------------*/
/*									*/
/*	killed object:							*/
/*			M[am],M[am+1],M[am+2],...,M[am+l-1]		*/
/*				where M[am]=l, total length		*/
/*				      M[am+1]= address of next killed   */
/*					with equal length		*/
/*				      M[am+2]= address of next killed   */
/*					with next greater length	*/
/*									*/
/************************************************************************/






unsigned int *headk,*headkmin;


/************************************************************************/
/*									*/
/* headk    - head of killed objects list				*/
/*		the list ends with M[lwr]=maximal appetite		*/
/* headkmin - head of killed objects list of minimal length 		*/
/*		each list element has only address of next killed with 	*/
/*		equal length, so no need for M[am+2]			*/
/*									*/
/************************************************************************/

/************************************************************************/
/*									*/
/*									*/
/*			Global variables				*/
/*									*/
/*									*/
/************************************************************************/





unsigned int *vipt1,*vipt2,*vipt3,*vipt4,*viptn;

	/* vipti = address of M[virti] */

unsigned int *Mlwr,*Mupr;		/* addresses of M[lwr] and M[upr] */

int protnum1;				/* =protnum+1, used in marking */



/************************************************************************/
/*									*/
/*									*/
/*				Object size				*/
/*									*/
/*									*/
/************************************************************************/

static unsigned int Size (a,am)
int a;
unsigned int *am;
{
	switch (PROT[a].kind)
	{
	case PRIMITARRAY:
		return((*(am+uboffset)- *(am+lboffset)+1)*PROT[a].elsize+
		    elmoffset);
	case REFARRAY :
	case SUBARRAY:
		return((*(am+uboffset)- *(am+lboffset)+1)*reflength+elmoffset);
	case STRUCTARRAY:
		return((*(am+uboffset)- *(am+lboffset)+1)*
		    (OFF[PROT[a].references].size)+elmoffset);
	case POINTARRAY:
		return(*(am+uboffset)- *(am+lboffset)+1+elmoffset);
	default:
		return(PROT[a].rspan+PROT[a].lspan+1);
	}
}


/************************************************************************/
/*									*/
/*									*/
/*			Position of protnum in object			*/
/*									*/
/*									*/
/************************************************************************/


static unsigned int Ptposition(a)
int a;
{
	switch (PROT[a].kind)
	{
	case PRIMITARRAY:
	case REFARRAY:
	case SUBARRAY:
	case STRUCTARRAY:
	case POINTARRAY:
		return(0);
	default:
		return(PROT[a].lspan);
	}
}




/************************************************************************/
/*									*/
/*									*/
/*	 Auxiliary function for dumping the whole memory		*/
/*									*/
/*									*/
/************************************************************************/




Memorydump ()
{
	unsigned int *i,*l,*u;
	int j;

	printf("\n         SYSTEM VARIABLES\n");
	printf(
	"freeitem   lastused   lastitem   headk   headkmin   Mlwr  Mupr\n");
	printf("%3d         %3d       %3d    %3d    %3d     %3d  %3d\n",
	freeitem,lastused,lastitem,headk,headkmin,Mlwr,Mupr);
	printf("           VIRTUAL ADDRESSES\n");
	l= Mupr-1;
	do
	    {
		if (l-18>lastitem) u=l-18;
		else u=lastitem;
		printf(" ah    ");
		for (i=l; i>=u; i=i-reflength) printf(" %5d",i);
		printf("\n M[ah]  ");
		for (i=l; i>=u; i=i-reflength) printf(" %5d", *i);
		printf("\nM[ah+1]");
		for (i=l; i>=u; i=i-reflength) printf(" %5d",*(i+1));
		printf("\n");
		l=u-reflength;
	}
	while (u!=lastitem);

	printf("        OBJECTS\n");
	j=0;
	for (i=M0; i<=lastused; ++i)
	{
		printf(" %6d",*i);
		++j;
		if (j==10){
			printf("\n");
			j=0;
		};
	};
	printf(  "\n");
}                  /* end Memorydump */



/************************************************************************/
/*									*/
/*									*/
/*	 Auxiliary function for dumping	 prototype structures		*/
/*									*/
/*									*/
/************************************************************************/



Writedata()

{
	int i,j;

	struct Prototype a;
	struct Offsets L;
	int p;
	int q;
	int working;

	printf("\n PROTOTYPE STRUCTURE\n");
	printf(
	"Nr Kind Lspan Rspan Ref  Decl Lev Lstw Sl Dl Lsc Stat Pref Psl \n");
	for (i=0; i<=protnum-1; ++i)
	{
		printf("\n%2d ",i);
		a=PROT[i];
		switch (a.kind)
		{
		case PROCESS:
			printf("proc ");
			break;
		case SUBROUTINE:
			printf("sub  ");
			break;
		case COROUTINE:
			printf("cor  ");
			break;
		case CLASS:
			printf("class");
			break;
		case HANDLER:
			printf("hand ");
			break;
		default:
			printf("array");
		};

		printf("%2d   ",a.lspan);
		switch(a.kind)
		{
		case CLASS:
		case SUBROUTINE:
		case PROCESS:
		case HANDLER:
		case COROUTINE:
			break;
		default:
			continue;
		};
		printf("  %2d   ",a.rspan);
		if (a.references!=-1)   printf("%2d   ",OFF[a.references].num);
		else printf("     ");
		if (a.decl!=-1)  printf("%2d  ",PROT[a.decl].num) ;
		else printf("    ");
		printf("%2d   ",a.level);
		printf("%2d   ",a.lastwill);
		printf("%2d %2d %2d  %2d ",
		a.Sloffset,a.Dloffset,a.Statoffset,a.Lscoffset);
		switch (a.kind)
		{
		case HANDLER:
			continue;
		};
		if (a.pref!=-1)  printf("%2d    ",PROT[a.pref].num) ;
		else printf("      ");
		printf("%2d",a.pslength);

	};
	printf("\n HANDLERS\n\n handler signals\n");
	for (i=0; i<=protnum-1; ++i)
	{
		a=PROT[i];
		printf("\n%2d  ",i);
		switch (a.kind)
		{
		case CLASS:
		case SUBROUTINE:
		case PROCESS:
		case COROUTINE:
			break;
		default:
			continue;
		};
		p=a.handlist;
		while (p>=0)
		{
			printf("%2d  ",HL[p].hand);
			q=HL[p].signlist;
			while (q>=0)
			{
				printf("%2d  ",SL[q].signalnum);
				q=SL[q].next;
			};
			p=HL[p].next;
		};
		printf("\n");
	};
	printf("\n\n OFFSETS\n");
	for (i=0; i<=offnum-1; ++i)
	{
		L=OFF[i];
		printf(" %2d   size %d ",i,L.size);
		switch(L.kind)
		{
		case SIMPLELIST:
			printf(" Listref ");
			working=L.head;
			for (j=1; j<=L.length; ++j)
			{
				printf("%2d  ",EL[working].offset);
				if (EL[working].references==1) printf("s ");
				if (EL[working].references==2) printf("p ");
				working=EL[working].next;
			};
			break;
		case SEGMENT:
			printf("Segment  ");
			printf("%2d    %2d    ",L.start,L.finish);
			if (L.head==1) printf(" s ");
			if (L.head==2) printf(" p ");
			break;
		case REPEATED:
			printf("Repeated ");
			printf("%2d    %2d    ",L.ntimes,OFF[L.references].num);
			break;
		case COMBINEDLIST:
			printf(" List    ");
			working=L.head;
			for (j=1; j<=L.length; ++j)
			{
				printf("%2d    %2d   ",EL[working].offset,
				OFF[EL[working].references].num);
				working=EL[working].next;
			};
			break;
		};
		printf("  \n");
	};
	printf(" \n PERMUTATIONS  ");
	printf("\n Prot \tPerm ");
	for (i=0;  i<=protnum-1;  ++i)
	{
		a=PROT[i];
		switch(a.kind)
		{
		case CLASS:
		case SUBROUTINE:
		case PROCESS:
		case HANDLER:
		case COROUTINE:
			break;
		default:
			continue;
		};
		printf("\n%2d      ",i);
		for (j=0; j<=PROT[i].level; ++j)
			printf("%2d  ",perm[PROT[i].permadd+j]);
	};
	printf("\n Prot \tPerminv ");
	for (i=0;  i<=protnum-1;  ++i)
	{
		a=PROT[i];
		switch(a.kind)
		{
		case CLASS:
		case SUBROUTINE:
		case PROCESS:
		case HANDLER:
		case COROUTINE:
			break;
		default:
			continue;
		};
		printf("\n%2d      ",i);
		for (j=0; j<=PROT[i].level; ++j)
			printf("%2d  ",perminv[PROT[i].permadd+j]);
	};
	printf(" \n");
}                           /* end writedata */



/************************************************************************/
/*									*/
/*									*/
/*		The final address of object referenced by X		*/
/*									*/
/*									*/
/************************************************************************/




unsigned int *Physical(X)
unsigned int *X;
{
	if( Notmember(X) )
		Raising(reftonone,vipt2);
	else
	    return(Physimple(X));
}



/************************************************************************/
/*									*/
/*	Request for a new object:					*/
/*									*/
/*	(a) Search for a free indirect address item			*/
/*									*/
/*	(i)  if freeitem <>0, then take from list of free addresses	*/
/*	(ii) if freeitem=0, then expand indirect addresses table	*/
/*	(iii)if no space, then compactify the whole memory		*/
/*	(iv) if still no space, then fatal error			*/
/*									*/
/*	(b) Search for a  frame of size defined by length:		*/
/*									*/
/*	(i)  if lastused+length<lastitem, then like in stack		*/
/*	(ii) if no space, then search on the list of killed objects	*/
/*	(iii)if not found, then compactify the whole memory		*/
/*	(iv) if still no space, then fatal error			*/
/*									*/
/*									*/
/************************************************************************/


static Request(a,length,X)
int a;
unsigned int *X,length;

{
	unsigned int *t1,*t2,*t3,*ah,*am,l;
	char wascomp,nfound;

	if (length >= maxapp)
		Error(8);

	if (length <= minsize)
		length=minsize;

	wascomp=0;

	/* search for a free indirect address */

	if (freeitem)
	{
		ah=freeitem;
		freeitem= (unsigned int *)*ah;
	}
	else		/* extend the indirect address table */
	{
		ah=lastitem-reflength;
		if (ah<=lastused)
		{
			Compactify();
			wascomp=1;
			ah=lastitem-reflength;
			if (ah<=lastused)
				Error(8);
		};
		lastitem=ah;
		*(ah+1)=0;
	};

	/* search for free frame */

	t1=lastused+length;
	if (t1<lastused || t1>= lastitem)
	{
		if(length==minsize && headkmin)
		{
			am=headkmin;
			headkmin=(unsigned int *) *(am+shortlink);
		}
		else
		{
			t1=headk;
			nfound=1;
			t2=0;
			while (t1!= Mlwr)
			{
				if (*(t1)==length ||
				    *(t1)>(length+minsize) )
				{
					l= *(t1)-length;
					nfound=0;
					break;
				}
				else
				{
					t2=t1;
					t1= (unsigned int *)*(t1+longlink);
				};
			};
			if (nfound)
			{
				if  (wascomp) Error(8);
				*ah=(unsigned int) freeitem;
				freeitem=ah;
				Compactify();
				ah=lastitem-reflength;
				lastitem=ah;
				*(ah+1)=0;
				t1=lastused+length;
				if (t1<lastused || t1>=lastitem) Error(8);
				am=lastused+1;
				lastused=t1;
			}
			else
			{
				t3= (unsigned int *) *(t1+shortlink);
				am=t1;
				if (t3)
					*(t3+longlink)= *(t1+longlink);
				else
				    t3= (unsigned int *)*(t1+longlink);
				if (t2)
					*(t2+longlink)= (unsigned int) t3;
				else
				    headk=t3;
				if (l)
				{
					t3=t1+length;
					*t3=l;
					Insert(t3);
				}
			};
		};
	}
	else
	{
		am=lastused+1;
		lastused=t1;
	};
	*X= (unsigned int)ah;
	*(X+1)= *(ah+1);
	am+=Ptposition(a);
	*am=a;
	*ah= (unsigned int )am;

}				/* end Request */





/************************************************************************/
/*									*/
/*									*/
/*	Dispose the  object referenced by X=[ah,counter]		*/
/*									*/
/*	(a) dispose the indirect address:				*/
/*	(i)  advance M[ah+1], i.e. guard_counter			*/
/*	(ii) if guard_counter=-1, then leave it				*/
/*		for compactification of the whole memory		*/
/*	(iii) otherwise put on the list of free addresses		*/
/*									*/
/*	(b) dispose the frame:						*/
/*	(i) if the frame is bordering free space, increase lastused	*/
/*	(ii) otherwise put it on the list of killed objects		*/
/*	(iii) correct Statussl for procedure closures			*/
/*									*/
/*									*/
/************************************************************************/

static Disp (X)

unsigned int *X;
{
	int a;
	unsigned int *am,*ah;
	unsigned int length;

	if (Notmember(X)) return;

	ah=  (unsigned int *) *X;
 	am=  (unsigned int *) *ah;
	if (++(*(ah+1))!=maxcounter)
	{
		*ah=(unsigned int)freeitem;
		freeitem=ah;
	};
	traverse(am,5);
	a= *am;
	length=Size(a,am);
	if (am+length-Ptposition(a)-1==lastused)
		lastused-=length;
	else
	{
		am-=Ptposition(a);
		*am=length;
		Insert(am);
	};
}                                  /* end Disp  */



/************************************************************************/
/*									*/
/*									*/
/*			Move virtual address Y on X			*/
/*									*/
/*									*/
/************************************************************************/


Refmove(X,Y)
unsigned int *X,*Y;

{
	*X++ = *Y++;
	*X= *Y;
}



/************************************************************************/
/*									*/
/*									*/
/*		Move procedure closure address Y on X			*/
/*									*/
/*									*/
/************************************************************************/


Procclosmove(X,Y)
unsigned int *X,*Y;

{	unsigned int *am;
	int a;

	if ( *X!=0)
	{
		am=Physimple(X);
		a= *am;
		(*Statsl(a,am))--;
	};
	if ( *Y!=0)
	{
		am=Physimple(Y);
		a= *am;
		(*Statsl(a,am))++;
	};
	*X++ = *Y++;
	*X= *Y;
}


/************************************************************************/
/*									*/
/*									*/
/*		For Y shortaddress, reconstruct reference on X		*/
/*									*/
/*									*/
/************************************************************************/

Refset(X,Y)
unsigned int *X,*Y;
{
	*X= *Y;
	*(X+1)= *((unsigned int *)*X+1);
}



/************************************************************************/
/*									*/
/*									*/
/*				X:=none					*/
/*									*/
/*									*/
/************************************************************************/


Setnone(X)
unsigned int *X;

{
	*X++ = (unsigned int)M0;
	*X= 0;
}


/************************************************************************/
/*									*/
/*									*/
/*				X=/=Y					*/
/*									*/
/*									*/
/************************************************************************/

int Notequal(X,Y)
unsigned int *X,*Y;

{
	if (Notmember(X))     return(Member(Y));
	else
		if (Notmember(Y))
			return(1);
		else
			return((int)(Physimple(X)-Physimple(Y)));
}


/************************************************************************/
/*									*/
/*									*/
/*				  X=Y					*/
/*									*/
/*									*/
/************************************************************************/


int Equal(X,Y)
unsigned int *X,*Y;

{
	return(! Notequal(X,Y));
}


/************************************************************************/
/*									*/
/*									*/
/*	Insert the frame pointed by am on the list of killed objects	*/
/*									*/
/*									*/
/************************************************************************/


static Insert(am)
unsigned int *am;
{
	unsigned int *t1,*t2;
	unsigned int l,k;

	l= *am;
	if (l==minsize)
	{
		*(am+shortlink)=(unsigned int)headkmin;
		headkmin=am;
	}
	else
	{
		t1=headk;
		t2=0;
		while (1)
		{
			k= *t1;
			if (l==k)
			{
				*(am+shortlink)= *(t1+shortlink);
				*(t1+shortlink)= (unsigned int)am;
				break;
			}
			else
				if (l<k)
				{
					*(am+longlink)= (unsigned int)t1;
					*(am+shortlink)=0;
					if(t2) *(t2+longlink)=(unsigned int)am;
					else headk=am;
					break;
				}
				else
				{
					t2=t1;
					t1=(unsigned int *)  *(t1+longlink);
				};
		};
	};
}                            /* end Insert */




/************************************************************************/
/*									*/
/*									*/
/*	Purge the Sl-chain of an object referenced by vipt3		*/
/*									*/
/*	(i)  if  Statussl=0 and it is procedure instance, dispose it	*/
/*	(ii) otherwise goto end						*/
/*	(iv) put vipt3 = Sl father of vipt3, and goto (i)		*/
/*									*/
/*									*/
/************************************************************************/



static Killer ()
{
	unsigned int *am;
	int a;

	while (1)
	{
		am=Physimple(vipt3);
		a= *am;
		if ( *Statsl(a,am)) return;
		switch (PROT[a].kind)
		{
		case SUBROUTINE:
			break;
		default:
			return;
		};
		if ( Physimple(vipt3)!=Physimple(Dl(a,am))) return;
		Refset(vipt2,Sl(a,am));
		Disp(vipt3);
		Refmove(vipt3,vipt2);
	};
}                      /* end of killer */



/************************************************************************/
/*									*/
/*									*/
/*	Purge memory after procedure instance termination		*/
/*									*/
/*	(i) if Statussl<>0,  nothing can be deallocated			*/
/*	(ii) otherwise dispose the object, put on vipt3 its Sl father	*/
/*		and call Killer, which purges Sl-chain			*/
/*									*/
/*									*/
/************************************************************************/


Killafter()
{
	unsigned int *am;
	int a;

	am=Physimple(vipt2);
	a= *am;
	if ( *Statsl(a,am)) return;
	Refset(vipt3,Sl(a,am));
	Disp(vipt2);
	Killer();
}



/************************************************************************/
/*									*/
/*									*/
/*	Compactifier - the play in 9 acts (Oh My God!!!)		*/
/*									*/
/*	It's like an ancient tragedy with  prolog, epilogue,		*/
/*		chorus singing in  some entr'acts, deus ex machina etc. */
/*									*/
/*									*/
/************************************************************************/

/*----------------------------------------------------------------------*/
/* Procedure traverse is a Deus ex machina 				*/
/*	(helps to solve dramatic problems in many moments):		*/
/*									*/
/*	short trip through the object pointed by am with action		*/
/*		performed for each reference				*/
/*	(uses  procedures pointed and correct)				*/
/*									*/
/*----------------------------------------------------------------------*/

static traverse (am,action)
unsigned int *am;
char action;
{
	int a, L;
	unsigned int *t;

	if ((int) *am >= 0) a= *am;
	else a= *am+protnum1;
	switch (PROT[a].kind)
	{
	case PRIMITARRAY :
		return;
	case REFARRAY :
		for (t= am+elmoffset;t<=am+Size(a,am)-1;t+=reflength)
			correct(t,action,0);
		return;
	case SUBARRAY :
		for (t= am+elmoffset;t<=am+Size(a,am)-1;t+=reflength)
			correct(t,action,2);
		return;
	case STRUCTARRAY :
		L=PROT[a].references;
		for (t= am+elmoffset;t<=am+Size(a,am)-1;t+=OFF[L].size)
			pointed(t,L,action);
		return;
	case POINTARRAY :
		for (t= am+elmoffset;t<=am+Size(a,am)-1; t++)
			correct(t,action,1);
		return;
	default  :
		L=PROT[a].references;
		pointed(am,L,action);
	};
}   /* end traverse */




/*----------------------------------------------------------------------*/
/*									*/
/*	correct all references defined by the structure of offsets L	*/
/*	according to action, in the subframe starting with acron	*/
/*									*/
/*----------------------------------------------------------------------*/

static pointed (acron,L,action)
unsigned int *acron;
char L;
char action; /* 1 nonefy,2 relocate,3 mark,4 Setnone,5 decstatussl */
{
	int i,k,working,ref;

	if (L==-1) return;
	switch (OFF[L].kind)
	{
	case SIMPLELIST:
		working=OFF[L].head;
		for (i=1; i<=OFF[L].length; ++i)
		{
			k=EL[working].offset;
			correct(acron+k,action,EL[working].references);
			working=EL[working].next;
		};
		return;
	case SEGMENT:
		switch(OFF[L].head)
		{case 0:
			for (k=OFF[L].start;k<=OFF[L].finish;k+=reflength)
				correct(acron+k,action,0);
			break;
		case 1:
			for (k=OFF[L].start;k<=OFF[L].finish;++k)
				correct(acron+k,action,1);
			break;
		case 2:
			for (k=OFF[L].start;k<=OFF[L].finish;k+=reflength)
				correct(acron+k,action,2);
			break;
		};

		return;
	case REPEATED:
		for (i=1;i<=OFF[L].ntimes;++i)
		{
			pointed(acron,OFF[L].references,action);
			acron+=OFF[L].size;
		};
		return;
	case COMBINEDLIST:
		working=OFF[L].head;
		for (i=1;i<=OFF[L].length;++i)
		{
			k=EL[working].offset;
			ref=EL[working].references;
			pointed(acron+k,ref,action);
			working=EL[working].next;
		};
		return;
	};
} /* end pointed */






/*----------------------------------------------------------------------*/
/*									*/
/*	correct one reference pointed by am according to action		*/
/*	(for long references it is different than for the short ones)	*/
/*									*/
/*----------------------------------------------------------------------*/

static correct (am,action,reftype)
unsigned int *am;
char reftype;	/* 0-fulladdress, 1-shortaddress, 2-procedure closure */
char action;
{	int a;

	switch (action)
	{
	case 1:
		if (reftype==0) nonefy(am); return;
	case 2:
		if (reftype==0) relocate(am); else relocs(am);
		return;
	case 3:
		if (reftype==0) mark(am); else marks(am);
		return;
	case 4:
		if (reftype==0) Setnone(am); else *am=0;
		return;
	case 5:
		if (reftype==2)
		{
			if ( *am==0) return;
			am=Physimple(am);
			a= *am;
			if (a < 0)   a+=protnum1;
			(*Statsl(a,am))--;
		};
		return;
	};
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Two auxiliary procedures mark and marks are called by traverse	*/
/*	in prologue. They help to visit all accessible objects from an	*/
/*	active one. Each  accessible  object is marked by changing its	*/
/*	basic item M[am](=prototype number) on a negative value.  Mark 	*/
/*	passes through full references [ah,counter],while marks passes	*/
/*			through simplified references [ah].  		*/
/*									*/
/*----------------------------------------------------------------------*/



static mark (am)
unsigned int *am;
{
	if (Notmember(am)) return;
	am=Physimple(am);
	if ((int) *am >=0)
	{
		*am -= protnum1  ;
		traverse(am,3);
	};
}



static marks (am)
unsigned int *am;
{

	if (*am==0) return;
	am=Physimple(am);
	if ((int)*am >=0)
	{
		*am -= protnum1;
		traverse(am,3);
	};
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Prologue:							*/
/*		marking of all accessible objects			*/
/*									*/
/*----------------------------------------------------------------------*/


static prologue ()
{
	unsigned int *am;

	am=Physimple(current);
	*am -= protnum1;
	traverse(am,3);
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Chorus song No 1:						*/
/*		for each free address change its guard counter on max	*/
/*									*/
/*----------------------------------------------------------------------*/


static chorus_song_1 ()
{
	unsigned int *t;

	t=freeitem;
	while (t) {
		*(t+1)=maxcounter;
		t= (unsigned int *) *t;
	};
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Act No 1:							*/
/*		for each not-killed object  recognize those which	*/
/*		will be deallocated  because are not  accessible;	*/
/*		knowing  that these  objects  will be deallocated	*/
/*		correct the corresponding Statussl items.		*/
/*									*/
/*----------------------------------------------------------------------*/


static act1 ()
{
	unsigned int *t1,*t2;
	int a;

	for (t2= lastitem;t2<= Mupr;t2+=reflength)
	{
		if(*(t2+1)==maxcounter) continue;
		t1= (unsigned int *) *t2;
		if ((int) *t1 >=0) traverse(t1,5);
	};
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Act No 2:							*/
/*		each  non-accesible object  put on the list of killed	*/
/*		objects; for  each accessible  object put on M[am] ah	*/
/*		in order to be able in  act4  to  compute   on  M[ah]	*/
/*		updated am (Attention! for Ptposition=0,special case)	*/
/*									*/
/*----------------------------------------------------------------------*/



static act2 ()
{
	unsigned int *t1,*t2,*t3,l;
	int a;

	for (t1=lastitem;t1<= Mupr;t1+=reflength)
	{
		if (*(t1+1)==maxcounter) continue;
		t2= (unsigned int *) *t1;
		if ((int) *t2<0)  *t2 += protnum1;
		else
		{
			*(t1+1)=maxcounter;
			a= *t2;
			l=Size(a,t2);
			t2-=Ptposition(a);
			*t2=l;
			Insert(t2);
			continue;
		};
		a= *t2;
		if (Ptposition(a))
		{
			t3=t2-Ptposition(a);
			*t1= *t3;
			*t3= *t2;
			*t2= (unsigned int)t1;
		}
		else
		{
			*t1= *(t2+1);
			*(t2+1)= (unsigned int) t1;
		};
	};
}  /* end act2 */







/*----------------------------------------------------------------------*/
/*									*/
/*	Chorus song No 2:						*/
/*		marking of all killed objects				*/
/*									*/
/*----------------------------------------------------------------------*/


#define skilled (-1)		/* marking for killed object */

static chorus_song_2 ()
{
	unsigned int *t1,*t2,*t3;

	t1=headkmin;
	while (t1)
	{
		t2=(unsigned int *) *(t1+shortlink);
		*(t1+shortlink)=minsize;
		*t1=skilled;
		t1=t2;
	};
	t1=headk;
	while (t1!= Mlwr)
	{
		t2=t1;
		while (t2)
		{
			t3= (unsigned int *)*(t2+shortlink);
			*(t2+shortlink)= *t2;
			*t2=skilled;
			t2=t3;
		};
		t1= (unsigned int *) *(t1+longlink);
	};
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Auxiliary procedure nonefy called by traverse. It sets to none	*/
/*		[M0,0] each reference which points no object.		*/
/*									*/
/*----------------------------------------------------------------------*/

static nonefy (am)
unsigned int *am;
{
	if ( Notmember(am)) Setnone(am);
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Act No 3:							*/
/*		traverse memory and for all alive objects set to [M0,0]	*/
/*		each reference pointing no object			*/
/*									*/
/*----------------------------------------------------------------------*/

static act3 ()
{
	unsigned int *t1,*t2,*t3,l;
	int a;

	t1= Mlwr+1;
	while (t1<=lastused)
	{
		if ( *t1!=skilled)
		{
			a= *t1;
			if (Ptposition(a))
			{
				t2=t1+Ptposition(a);
				t3= (unsigned int *)*t2;
				*t1= *t3;
				*t2=  a;
			}
			else
			{
				t3= (unsigned int *) *(t1+1);
				*(t1+1)= *t3;
				t2=t1;
			};
			l=Size(a,t2);
			traverse(t2,1);
			if (Ptposition(a))
			{
				*t2= (unsigned int) t3;
				*t1= a;
			}
			else
				*(t1+1)= (unsigned int)t3;
			t1+=l;
		}
		else
			t1+= *(t1+shortlink);
	};
	for (t1=vipt1; t1<=viptn; t1+=reflength) nonefy(t1);
}       /* end act3 */



/*----------------------------------------------------------------------*/
/*									*/
/*	Chorus song No 3:						*/
/*		compute new values of indirect addresses and put them	*/
/*		on guard counters; this enables to update  references	*/
/*		during memory squeezing; now M[ah+1]= future ah		*/
/*									*/
/*----------------------------------------------------------------------*/

static chorus_song_3()
{
	unsigned int *t1,*t2;

	t1= Mupr-1;
	for ( t2= Mupr; t2>= lastitem; t2-=reflength)
	{
		if (*t2==maxcounter) *t2= (unsigned int)M0;
		else
		{
			*t2= (unsigned int)t1;
			t1-=reflength;
		};
	};
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Two auxiliary procedures relocate and relocs are used in  act4.	*/
/*	They update for each  reference  its  ah  taking a new one from	*/
/*	M[ah+1] computed in chorus song No 3.  Procedure  relocates  is	*/
/*	applied for full references,  procedure relocs for simplified.	*/
/*									*/
/*----------------------------------------------------------------------*/

static relocate(am)
unsigned int *am;
{
	*am= *( (unsigned int *)*am+1);
	*(am+1)=0;
}

static relocs(am)
unsigned int *am;
{
	if (*am==0) return;
	*am= *( (unsigned int *)*am+1);
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Act No 4:							*/
/*		squeeze memory;  for all alive objects  update  all	*/
/*		references using traverse with relocate and relocs;	*/
/*		simultaneously update M[ah] with a new value  of am	*/
/*		obtained after squeezing memory;  reconstruct  also	*/
/*		the value of M[am] changed in act2.			*/
/*									*/
/*									*/
/*----------------------------------------------------------------------*/

static act4()
{
	unsigned int *t1,*t2,*t3,*t4,*t5,l,k;
	int a;

	t1= Mlwr+1;
	t2=t1;
	while (t1<=lastused)
	{
		if (*t1==skilled)           t1+=  *(t1+shortlink);
		else
		{
			t5=(unsigned int *) *t1;
			a=(int)t5;
			t3=t1+Ptposition(a);
			if (Ptposition(a))
			{
				t4= (unsigned int *)*t3;
				*t3=(unsigned int)t5;
				*t1= *t4;
			}
			else
			{
				t4= (unsigned int *)*(t1+1);
				*(t1+1)= *t4;
			};
			l=Size(a,t3);
			t3=t2;
			for (k=1;k<=l;++k)
				*t3++= *t1++;
			t5=t2+Ptposition(a);
			*t4= (unsigned int)t5;
			traverse(t5,2);
			t2+=l;
		};
	};
	for (t1=vipt1;t1<=viptn; t1+=reflength) relocate(t1);
	lastused=t2-1;
	headkmin=0;
	headk= Mlwr;
}  /* end act4 */


/*----------------------------------------------------------------------*/
/*									*/
/*	Epilogue:							*/
/*		squeeze the indirect address table;update also some	*/
/*		Running System variables.				*/
/*									*/
/*----------------------------------------------------------------------*/


static epilogue ()			/* update virtual addresses */
{
	unsigned int *t1,*t2,*t3;

	t1= Mupr+1;
	for ( t3= Mupr-1; t3>=lastitem; t3-=reflength)
	{
		t2= (unsigned int *)*(t3+1);
		if (t2!=M0)
		{
			*t2= *t3;
			*(t2+1)=0;
			t1=t2;
		};
	};
	lastitem=t1;
	freeitem=0;
	Update(current);		/* update DISPDIR */
	local=Physimple(current);	/* update local register */
}


/*----------------------------------------------------------------------*/
/*									*/
/*		Compactify (call prepared procedures)			*/
/*									*/
/*----------------------------------------------------------------------*/


Compactify ()
{
	int nlength;
	nlength=lastitem-lastused;
	prologue();
	chorus_song_1();
	act1();
	act2();
	chorus_song_2();
	act3();
	chorus_song_3();
	act4();
	epilogue();
	printf("\n Compactifier used; released space=%d\n",
	lastitem-lastused-nlength);
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Errors at run-time are handled by Error(n), where n is 		*/
/*			the error number.				*/
/*									*/
/*----------------------------------------------------------------------*/







static Error(n)
char n;

{
	switch (n)
	{

	case 1:
		printf("\nReference to none\n");
		longjmp(buffer,-2);
	case 2:
		printf("\nIllegal attach\n");
		longjmp(buffer,-2);
	case 3:
		printf("\nCoroutine terminated\n");
		longjmp(buffer,-2);
	case 4:
		printf("\nImproper coroutine end\n");
		longjmp(buffer,-2);
	case 5:
		printf("\nIncorrect kill\n");
		longjmp(buffer,-2);
	case 6:
		printf("\nArray index error\n");
		longjmp(buffer,-2);
	case 7:
		printf("\nIllegal array generation\n");
		longjmp(buffer,-2);
	case 8:
		printf("\nMemory overflow\n");
		longjmp(buffer,-2);
	case 9:
		printf("\nend of a program execution\n");
		longjmp(buffer,-2);
	case 10:
		printf("\nhandler not found\n");
		longjmp(buffer,-2);
	};
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Openrc:								*/
/*		opens a new object of a class without system attributes	*/
/*		a - prototype number,					*/
/*		X - reference to the opened object			*/
/*									*/
/*----------------------------------------------------------------------*/

Openrc (a,X)
int a;
unsigned int *X;

{
	unsigned int *am;

	Request(a,Size(a,0),X);
	am=Physimple(X);
	traverse(am,4);
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Slopen:								*/
/*		opens a new object of with explicitly given Sl-father	*/
/*		a - prototype number,					*/
/*		X - reference to the opened object			*/
/*		Y - reference to its Sl-father				*/
/*									*/
/*----------------------------------------------------------------------*/



Slopen (a,X,Y)

unsigned int *X,*Y;
int a;

{
	unsigned int *am,*Slr,*Dlr;

	Request(a,Size(a,0),X);
	am=Physimple(X);
	traverse(am,4);
	*Statsl(a,am)=0;
	Slr=Sl(a,am);
	*Slr= *Y;
	Dlr=Dl(a,am);
	*Dlr= *current;
	am=Physimple(Y);
	a= *am;
	(*Statsl(a,am))++;
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Dopen: 								*/
/*		opens a new object of a visible module			*/
/*		a - prototype number,					*/
/*		b - prototype number of a's static father		*/
/*		X - reference to the opened object			*/
/*									*/
/*----------------------------------------------------------------------*/

Dopen(a,b,X)

int a,b;
unsigned int *X;

{
	int c;

	c=PROT[a].decl;
	Slopen(a,X,DISPLAY+reflength*perm[PROT[b].permadd+PROT[c].level]);
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Openarray:							*/
/*		opens a new array					*/
/*		a - prototype number,					*/
/*		l - lower bound						*/
/*		u - upper bound						*/
/*		X - reference to the opened object			*/
/*									*/
/*----------------------------------------------------------------------*/

Openarray (a,l,u,X)

int l,u;
int a;
unsigned int *X;

{
	unsigned int length;
	unsigned int *am;

	if (u<l) Raising(illarray,vipt2);
	length=u-l+1;
	switch (PROT[a].kind)
	{
	case PRIMITARRAY :
		length=length*PROT[a].elsize ;
		break;
	case REFARRAY :
	case SUBARRAY :
		length=length*reflength;
		break;
	case STRUCTARRAY :
		length=length*(OFF[PROT[a].references].size);
		break;
	case POINTARRAY :
		break;
	};
	length+=elmoffset;
	Request(a,length,X);
	am=Physimple(X);
	*(am+lboffset)=l;
	*(am+uboffset)=u;
	traverse(am,4);
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Go:								*/
/*		calls an object X					*/
/*		X - reference to the object				*/
/*									*/
/*----------------------------------------------------------------------*/

Go (X)
unsigned int *X;

{
	int a,b;

	a= *local;
	*(Lsc(a,local))=IC*protnum1+modulenumber;
	Update(X);
	Refmove(current,X);
	local=Physimple(X);
	a= *local;
	b=a;
	switch (PROT[a].kind)
	{
	case HANDLER:
		break;
	default:
		while (a >=0)
		{
			switch (PROT[a].kind)
			{
			case RECORD:
				break;
			default:
				b=a;
			};
			a=PROT[a].pref;
		};
	};
	IC=1;
	modulenumber=b;
	longjmp(buffer,-1);
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Back:								*/
/*		explicit return statement				*/
/*		used also in end of unprefixed subprogram or block	*/
/*									*/
/*----------------------------------------------------------------------*/


Back ()
{
	unsigned int *Dlr;
	int a;

	a= *local;
	Dlr=Dl(a,local);
	if (*Dlr==0) Endcor();
	Refmove(vipt2,current);
	*Lsc(a,local)=IC*protnum1+modulenumber;
	Refset(current,Dlr);
	*Dlr= *vipt2;
	Update(current);
	local=Physimple(current);
	a= *local;
	IC= *Lsc(a,local);
	modulenumber=IC%protnum1;
	IC=IC/protnum1;
	longjmp(buffer,-1);
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Endclass:							*/
/*		end of class statement					*/
/*									*/
/*----------------------------------------------------------------------*/

Endclass ()
{
	int a;

	a= *local;
	switch (PROT[a].kind)
	{
	case CLASS:
	case SUBROUTINE: Back(); break;
	case COROUTINE: Endcor(); break;
	};
}











/*----------------------------------------------------------------------*/
/*									*/
/*	Inner:								*/
/*		passes control to a subclass				*/
/*		k - class level in the inheritance sequence		*/
/*									*/
/*----------------------------------------------------------------------*/

Inn(k)
int k;
{
	int t,a;

	a= *local;
	if (PROT[a].pslength==k) return;
	for (t=2; t<=PROT[a].pslength-k; ++t) a=PROT[a].pref;
	IC=1;
	modulenumber=a;
	longjmp(buffer,-1);
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Endrun:								*/
/*		end of computations					*/
/*									*/
/*----------------------------------------------------------------------*/


Endrun ()
{
	Error(9);
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Update:								*/
/*		update display algorithm; no way to explain how it	*/
/*		works without a special theoretical background.		*/
/*		X - reference to an object which will be active		*/
/*									*/
/*----------------------------------------------------------------------*/


static Update (X)
unsigned int *X;

{
	int a,c,d,j,k,permadd,l;
	unsigned int *am;

	am=Physimple(X);
	a= *am;
	k=PROT[a].level;
	d=a;
	permadd=PROT[a].permadd;
	while(1)
	{
		l=perm[permadd+k];
		Refset(DISPLAY+reflength*l,X);
		*(DISPDIR+l)= (unsigned int )am;
		if (k--==0)  return;
		j=perminv[PROT[a].permadd+perm[PROT[d].permadd+k]];
		d=PROT[d].decl;
		do
		    {
			c=PROT[a].decl;
			X=Sl(a,am);
			am=Physimple(X);
			a= *am;
			j=perminv[PROT[a].permadd+perm[PROT[c].permadd+j]];
		}
		while (PROT[a].level-j);
	};
}                       /* end of update */




/*----------------------------------------------------------------------*/
/*									*/
/*	Gkill:								*/
/*		deallocates a class, an array or a coroutine object	*/
/*		for coroutines deallocates the whole cycle		*/
/*		X - reference to the object 				*/
/*									*/
/*----------------------------------------------------------------------*/

Gkill(X)
unsigned int *X;
{
	unsigned int *am,*Dlr;
	int a;

	if (Notmember(X) ) return;
	am=Physimple(X);
	a= *am;
	switch (PROT[a].kind)
	{
	case PRIMITARRAY:
	case REFARRAY:
	case SUBARRAY:
	case STRUCTARRAY:
	case POINTARRAY:
	case RECORD:
		Disp(X);
		return;
	case CLASS:
		if ( *Statsl(a,am))  Raising(incorkill,vipt2);
		Refset(vipt3,Sl(a,am));
		Disp(X);
		Killer();
		return;
	case COROUTINE:
	case PROCESS:
		Dlr=X;
		while (1)
		{
			Refset(vipt4,Dlr);
			if ( *Statsl(a,am))  Raising(incorkill,vipt2);
			Dlr=Dl(a,am);
			if (Physimple(X)==Physimple(Dlr)) break;
			am=Physimple(Dlr);
			a= *am;
		};

		Refmove(vipt2,X);
		do
		    {
			am=Physimple(vipt2);
			a= *am;
			Dlr=Dl(a,am);
			Refset(vipt3,Dlr);
			*Dlr= *vipt4;
			Refmove(vipt4,vipt2);
			Refmove(vipt2,vipt3);
		}
		while (Notequal(vipt2,X));
		do
		    {
			am=Physimple(X);
			a= *am;
			Refset(vipt3,Sl(a,am));
			Refset(vipt4,Dl(a,am));
			Disp(X);
			Killer ();
			Refmove(X,vipt4);
		}
		while (Member(X));
		return;
	default:
		Raising(incorkill,vipt2);
	};
}                /* end Gkill  */




/*----------------------------------------------------------------------*/
/*									*/
/*	Endcor:								*/
/*	 	end of coroutine; it is different than return;		*/
/*		treated as an error					*/
/*----------------------------------------------------------------------*/



Endcor ()
{

	if (Member(lastcor))
	{
		Attachwith(lastcor,imprterm,vipt2);
		IC=0;
		Attach(lastcor);
	}
	else
	{
		Attachwith(myprocess,imprterm,vipt2);
		IC=0;
		Attach(myprocess);
	};
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Atthelp:							*/
/*		auxiliary for Attach and Attachwith			*/
/*		X - reference to a    coroutine				*/
/*									*/
/*----------------------------------------------------------------------*/


static Atthelp(X)
unsigned int *X;
{
	unsigned int *amnew,*amold,*Dlr;
	int a,b;

	if ( Notmember(X)) Raising(ilattach,vipt2);
	amnew=Physimple(X);
	a= *amnew;
	switch(PROT[a].kind)
	{
	case COROUTINE:
	case PROCESS :
		break;
	default:
		Raising(ilattach,vipt2);
	};
	if ( *Lsc(a,amnew)<protnum1) Raising(corterm,vipt2);
	if (Equal(mycoroutine,X)) return;
	Refmove(vipt2,mycoroutine);
	amold=Physimple(mycoroutine);
	b= *amold;
	Dlr=Dl(b,amold);
	Refmove(mycoroutine,X);
	*Dlr= *current;
	Refmove(lastcor,vipt2);
	b=a;
	Dlr=Dl(b,amnew);
	a= *local;
	*Lsc(a,local)=IC*protnum1+modulenumber;
	Update(Dlr);
	Refset(current,Dlr);
	*Dlr=0;
	local=Physimple(current);
	a= *local;
	IC= *Lsc(a,local);
}   /*end  Atthhelp */



/*----------------------------------------------------------------------*/
/*									*/
/*	Attach:								*/
/*		attaches coroutine X					*/
/*		X - reference to  a coroutine				*/
/*									*/
/*----------------------------------------------------------------------*/

Attach(X)
unsigned int *X;
{
        Atthelp(X);
	modulenumber=IC%protnum1;
	IC=IC/protnum1;
	longjmp(buffer,-1);
}





/*----------------------------------------------------------------------*/
/*									*/
/*	Raising:							*/
/*		raises a signal						*/
/*		signalnum- signal number,				*/
/*		X - reference to the opened object			*/
/*									*/
/*----------------------------------------------------------------------*/


Raising(signalnum,X)
int signalnum;
unsigned int *X;
{
	unsigned int *am,*Y;
	int a,b,h,s;

	Y=current;
	while (*Y!=0)
	{
		am=Physimple(Y);
		a= *am;
		switch (PROT[a].kind)
		{
		case HANDLER:
			Y=Sl(a,am);
			continue;
		};
		b=a;
		while (b>=0)
		{
			h=PROT[b].handlist;
			while (h>=0)
			{
				if (PROT[HL[h].hand].others &&
				    signalnum<=syssigl)
				{
					Slopen(HL[h].hand,X,Y);
					return;
				};
				s=HL[h].signlist;
				while (s>=0)
				{
					if (SL[s].signalnum==signalnum)
					{
						Slopen(HL[h].hand,X,Y);
						return;
					};
					s=SL[s].next;
				};
				h=HL[h].next;
			};
			b=PROT[b].pref;
		};
		Y=Dl(a,am);
	};
	if (signalnum<=syssigl)
		 Error(signalnum);
	else Error(10);			/* handler not found */
}   /* end Raising  */




/*----------------------------------------------------------------------*/
/*									*/
/*	Attachwith:							*/
/*		raises a signal in another coroutine			*/
/*		signalnum - signal number,				*/
/*		X - reference to the  coroutine				*/
/*		Y - reference to the opened object			*/
/*									*/
/*----------------------------------------------------------------------*/


Attachwith(X,signalnum,Y)
unsigned int *X,*Y;
int signalnum;

{

	Refmove(vipt3,mycoroutine);
	Atthelp(X);
	Raising(signalnum,Y);
	IC=1;
	Refmove(current,Y);
	local=Physimple(current);
	Atthelp(vipt3);
}



/*----------------------------------------------------------------------*/
/*									*/
/*	Termination:							*/
/*		terminates an active dynamic chain			*/
/*									*/
/*----------------------------------------------------------------------*/


Termination ()
{
	unsigned int *X,*Y,*am;
	int a,b;

	a= *local;
	X=Sl(a,local);
	Y=Dl(a,local);
	am=Physimple(X);
	while (1)
	{
		Y=Physimple(Y);
		b= *Y;
		*Lsc(b,Y)=PROT[b].lastwill*protnum1+b;
		if (Y==am) return;
		Y=Dl(b,Y);
	};
}




/*----------------------------------------------------------------------*/
/*									*/
/*	Init:								*/
/*		 initialize all RS data					*/
/*									*/
/*----------------------------------------------------------------------*/



Init ()
{

	protnum1=protnum+1;
	M0= &M[0];
	M[0]=0;
	M[1]= (unsigned int) M0;
	vipt1= &M[virt1];
	vipt2= &M[virt2];
	vipt3= &M[virt3];
	viptn=vipt4= &M[virt4];
	myprocess= vipt1;
	freeitem= 0;
	Mlwr= &M[lwr];
	Mupr= &M[upr];
	lastused=Mlwr;
	headk=Mlwr;
	headkmin=0;
	lastitem= Mupr+1;
	M[lwr]=maxapp;
	Request(0,Size(0,0),vipt1);
	global=local=Physimple(vipt1);
	*Statsl(0,local)=0;
	traverse(local,4);
	DISPLAY= local+displ;
	current= local+curr;
	Refmove(current,vipt1);
	Refmove(DISPLAY,current);
	DISPDIR= local +displdir;
	*DISPDIR = (unsigned int) local;
	lastcor= local+lstcor;
	mycoroutine= local+chead;
	Refmove(mycoroutine,current);
}





/*----------------------------------------------------------------------*/
/*									*/
/*	Arrayelem:							*/
/*		compute final address of an array element		*/
/*		X - reference to the  array object			*/
/*		i - element index					*/
/*									*/
/*----------------------------------------------------------------------*/


unsigned int *Arrayelem (X,i)
unsigned int *X;
int i;
{
	int a;
	unsigned int *am,length;

	am=Physical(X);
	a= *am;
	if (i> (int) *(am+uboffset)) Raising(arrayind,vipt2);
	i-= (int) *(am+lboffset);
	if (i<0) Raising(arrayind,vipt2);
	switch (PROT[a].kind)
	{
	case PRIMITARRAY:
		length=PROT[a].elsize;
		break;
	case REFARRAY:
	case SUBARRAY:
		length=reflength;
		break;
	case STRUCTARRAY:
		length=OFF[PROT[a].references].size;
		break;
	case POINTARRAY:
		length=1;
		break;
	};
	am+=elmoffset+length*i;
	return(am);
}



#include <setjmp.h>
		/* on-line functions */


#define Physimple(X)  (unsigned int *)(* ((unsigned int *) *X))
#define Notmember(X)  ( *(X+1)!= *((unsigned int *)*X+1) )
#define Member(X)     ( *(X+1)== *((unsigned int *)*X+1) )

#define Address(dnum,off) ((unsigned int *)*(DISPDIR+dnum)+off)
#define Local(off)  (local+off)
#define Global(off) (global+off)
#define Fladdress(dnum,off) (float *) ((unsigned int *)*(DISPDIR+dnum)+off)
#define Fllocal(off) (float *)(local+off)
#define Flglobal(off) (float *)(global+off)


		/* repeated headings */

unsigned int * Arrayelem();
unsigned int * Physical();


		/*  global common variables */


		/* constants for standard signals */


#define syssigl 100
#define reftonone 1
#define ilattach 2
#define corterm 3
#define imprterm 4
#define incorkill 5
#define arrayind 6
#define illarray 7


		/* common structures */

    enum { CLASS,SUBROUTINE,PROCESS,COROUTINE,HANDLER,RECORD,
           PRIMITARRAY,REFARRAY,SUBARRAY,STRUCTARRAY,POINTARRAY};

struct Prototype

{
	int kind;			/* prototype kind  */
	int num;         		/* numer of prototype */
	int lspan,rspan;		/* lspan for arrays = elsize */
	int references;			/* address of reference structure */
	int decl,level;			/* sl-father and depth in sl-tree */
	int lastwill;			/* label for lastwill statements */
	int permadd;			/* address of permutations */
	int Sloffset,Dloffset;		/* offsets of */
	int Statoffset,Lscoffset;	/* system attributes */
	int handlist;			/* handlerlist for handlers=others */
	int pref,pslength;		/* address of pref father, prefix */
					/* sequence length, both */
					/* for handlers not existant */

};

#define elsize lspan
#define others handlist


/* Structure for handlers  */

struct Hlstelem
{
	int hand;			/* handler prototype */
	int signlist;			/* address of signals */
	int next;
};

struct Sgelem
{
	int signalnum;			/* signal number */
	int next;
};






/* Structure for offsets of reference variables in objects */



struct Elem
{
	int offset;			/* offset in a structure */
	int next;			/* next list element */
	int references;			/* for COMBINEDLIST points */
					/* the corresponding substructure */
					/* for SIMPLELIST  */
					/* 0 when it is fulladdress */
					/* 1 when it is shortaddress */
					/* 2 when it is procedure closure */
};



    enum { SIMPLELIST,SEGMENT,REPEATED,COMBINEDLIST};	/* kind of structure */

struct Offsets
{
	int kind;		/* kind as above */
	int size;		/* size of characterized object */
	int num;		/* reference structure number */
	int length,finish;  	/* for SIMPLELIST and COMBINEDLIST */
				/* length is a list length, finish not used */
				/* for SEGMENT length (start) and finish */
				/* define a segment span */
				/* for REPEATED length=ntimes */
				/* finish not used */
	int head;		/* for LISTS it is a list head */
				/* for SEGMENT  */
				/* 0 when they are fulladdresses */
				/* 1 when they are shortaddresses */
				/* 2 when they are procedure closures */
				/* for REPEATED not used */
	int references;		/* address of reference structure */
				/* used only for REPEATED */
};

#define start length
#define ntimes length