2 (*********************************************************************)
12 (*====================================================================*)
16 (* D E B U G G E R F O R L O G L A N *)
18 (* WERSJA 2 ( 1985 ) *)
20 (* TERESA PRZYTYCKA *)
22 (*====================================================================*)
24 (*====================================================================*)
26 (* Adapted to the Loglan interpreter. *)
27 (* Uses special standard procedures DB01OX, SCCD01OX, SCND01OX, *)
28 (* DB01OF for communication with the interpreter. *)
29 (* Uses auxilliary files name.deb (name - file name of the source *)
30 (* loglan program) and temp.deb. *)
31 (* The copy of output is printed to the file debug.ech *)
33 (* June 1986, D.Szczepanska *)
34 (*====================================================================*)
36 (*============================================*)
37 (* WYDRUKI KOTROLNE : STRUMIEN LO *)
38 (* +i - PRZED INSTRUKCJA *)
39 (* ++i - PO INSTRUKCJI *)
40 (* i - szczegolowosc wydrukow kontrolnych *)
41 (*============================================*)
44 VAR LINENR:INTEGER, (* NR LINII MIEJSCA WYSTAPIENA PZETWANIA *)
45 LINENR1:INTEGER, (* NR LINII Z OSTATNIM PRZERWANIEM *)
46 linenr2:integer, (* nr linii do ktorej ciagnie sie "do" *)
47 DISPNR :INTEGER, (* DISPNR OBIEKTU,KTOREGO WYKONYWANIE ZOSTALO *)
48 UNITCASE : INTEGER,(* TYP JEDNOSTKI SYNTAKTYCZNEJ PUNKTU *)
50 (* PRZERWANE A POZNIEJ ZMIENNA ROBOCZA DO *)
51 (* PRZECHOWYWANIA WYNIKU Z PROCEDURY FIND *)
52 BREAKT (* TABLICA Z NUMERAMI LINII PUNKTUW LAMIACYCH *)
55 BREAKTL:ARRAYOF BR, (* TABLICA INFORMACJI O PUNKTACH LAMIACYCH *)
56 (* ODPOWIADAJACA TABLICY BREAKT *)
57 MOV :MOVEL, (* POCZATEK LISTY ZMIAN PONKTOW OBSERWACJI *)
58 CADR, (* ADRES OBIEKTU, KTOREG OBLICZENIA *)
59 (* ZOSTALY PRZERWANE *)
60 OBSADR, (* ADRES OBIEKTU BEDACEGO PUNKTEM *)
63 CCOR : ARRAYOF INTEGER, (* AKTYWNA COROUTINA *)
64 ctxt : arrayof integer, (* bufor na biezaca lnie wejsciowa *)
65 protf :FILE , (* PLIK O DOSTEPIE sekwencyjnym,binarny *)
66 (* zawierajacy breakt i prototypy debuggera *)
67 CO :FILE , (* PLIK NA KTORY WYSYLA WYNKI DEBUGGER *)
68 LO :FILE , (* KOPIA WYNIKOW PRZY WLACZONYM ECHU *)
69 PROTNR :INTEGER , (* NR PROTOTYPU OBIEKTU BEDACEGO *)
70 (* PUNKTEM OBSERWACJI *)
71 SINGLESTEP:boolean, (* CZY PRZERWANIE JEST GENEROWANE PO KAZDEJ *)
72 (* INSTRUKCJI LOGLANOWEJ *)
73 GGO :integer, (* GO = TRUE POWODUJE WYKONYWANIE PROGRAMU *)
74 (* BEZ PRZERWAN, JEDYNIE Z SYGNALIZACJA *)
75 (* PUNKTOW LAMIACYCH W POSTACI SLADU *)
76 ECHO : BOOLEAN, (* CZY JEST PISANA KOPIA WYNKOW NA LO *)
77 CBR :BR , (* PUNKT LAMIACY OBSLUGIWANY W BIEZACYM *)
79 CIND : INTEGER, (* INDEKS W TABLICY BIEZACEGO PRZERWANIA *)
80 (* STRUKTURU DANYCH DO KOMUNIKACJI Z BAZA *)
81 (* DANYCH PROTOTYPOW *)
82 IDICT , (* slownik prototypow debuggera *)
83 prot (* tablica zawierajaca prototypy debuggera *)
86 GOTXT : ARRAYOF INTEGER, (* TEKST INSTRUKCJI GO *)
88 first:boolean, (* true for the first interrupt *)
89 lastbr:integer, (* last used in breakt *)
90 DECL : DEC ; (* LISTA BANKOW INSTRUKCJI *)
93 CONST MAXBR=500, (* MAKSYMALNA LICZBA PUNKTOW LAMIACYCH *)
94 MAXIDICT = 499; (* ROZMIAR TABLICY IDICT *)
95 VAR I:INTEGER ; (* GLOBaLNA POMOCNICZA *)
96 var glovirt:arrayof integer, gloreal:real; (*globalne pomocnicze *)
97 var maxprot:integer; (* rozmiar tablicy PROT *)
99 (*=====================================================================*)
100 (* S T R U K T U R Y D A N Y C H *)
101 (*=====================================================================*)
103 UNIT INSTR : CLASS ; (* ELEMENT LISY INSTRUKCJI *)
105 TXT :ARRAYOF INTEGER,
109 UNIT KILLI :PROCEDURE(INOUT I:INSTR);
113 WHILE J=/= NONE DO J:=J.NEXT;KILL(I.TXT);KILL(I);I:=J OD;
116 (*---------------------------------------------------------------------*)
118 UNIT BR : CLASS ; (* OPIS PUNKTU PRZERYWAJACEGO *)
120 CONDTXT : ARRAYOF INTEGER,
124 UNIT KILLB :PROCEDURE(INOUT B:BR);
126 KILL(B.CONDTXT);CALL KILLI(B.INS) ; KILL(B)
129 (*-------------------------------------------------------------------*)
131 UNIT DEC :CLASS; (* ELEMENT LIST BANKOW INSTRUKCJI *)
137 (*----------------------------------------------------------------*)
139 UNIT MOVEL : CLASS(MARK,PROT :INTEGER,ADR,COR : ARRAYOF INTEGER);
141 (* ELEMENT LISTY ZMIAN PUNKTOW OBSERWACJI *)
142 (* ZNACZENIE ATRYBUTOW : MARK - ETYKIETA INSTRUKCJI MOVE *)
143 (* PROT - NR PROTOTUPU PUNKTU OBSERWACJI *)
144 (* ADR - ADRES PUNKTU OPSERWACJI *)
145 (* COR - OBSERWOWANA COROUTINA *)
148 (*------------------------------------------------------------------*)
150 (*===================================================================*)
151 (* CONTROL - PREFIX DLA COROUTIN UZYTKOWNIKA, KTORE MOGA BYC *)
152 (* OBSERWOWANE PO EWENTUALNYN BLEDZIE WYKONANIA *)
153 (*===================================================================*)
155 (*===================================================================*)
159 (*===================================================================*)
170 T9 = " BREAK POINT : ",
171 T10 = " INSTANCE OF ",
174 T13 = " DECLARED IN LINE",
175 T14 = " --- END OF LIST ---",
176 T15 = " NOT IMPLEMENTED",
179 T18 = " FORMAL TYPE",
180 T19 = " NONE VALUE OF FORMAL TYPE",
188 T27 = " !!! ERROR NR",
190 t29 = " OBSERVATION POINT:";
193 (*============================================================*)
194 (* CONTROL - prefix for user's coroutines *)
195 (*============================================================*)
200 WHEN ACCERROR : writeln(co,t1); call runerror;
201 WHEN CONERROR : writeln(co,t2); call runerror;
202 WHEN LOGERROR : writeln(co,t3); call runerror;
203 WHEN TYPERROR : writeln(co,t4); call runerror;
204 WHEN SYSERROR : writeln(co,t5); call runerror;
205 WHEN NUMERROR : writeln(co,t6); call runerror;
206 WHEN MEMERROR : writeln(co,t7); call runerror;
207 OTHERS : WRITELN(CO,t8);CALL RUNERROR;
211 (*=====================================================================*)
213 (*******************************************************************)
217 (*-----------------------------------------------------------------*)
218 (* PROCEDURA WYWOLYWANA PRZEZ PROCEDURE RUNING SYSTEMU :TRACE *)
219 (* SPRAWDZA CZY W DANEJ LINI WYKONYWANEGO PROGRAMU JEST *)
220 (* ZADEKLAROWANY BREAK POINT.JESLI TAK WYWOLUJE PROCEDURE INTERPR *)
221 (*******************************************************************)
223 UNIT BREAKL:PROCEDURE;
229 (* linenr := line of the break point, dispnr := number of interrupted
230 object, cadr := address of interrupted object *)
231 call db01ox(28,glovirt, linenr, cadr, gloreal, dispnr);
232 if ggo=4 then call endrun fi;
234 cind := 0; cbr := none;
235 (*+ WRITELN(LO," LINENR",LINENR," LINENR1",LINENR1); ++*)
236 if linenr1=0 then first:=true; fi;
237 IF SINGLESTEP OR LINENR1=0 THEN BREAKP:=TRUE
239 IF LINENR =/= LINENR1 THEN
241 FOR I:=1 TO lastbr DO
242 IF BREAKT(I)=LINENR THEN K:=LINENR ; CIND:=I;EXIT FI;
244 IF K =/= 0 THEN CBR:=BREAKTL(CIND);
250 IF BREAKP THEN (* jest przerwanie w lnii linenr *)
251 if ggo=1 andif linenr > linenr2 then ggo := 0 fi;
253 (* ccor - address of an active coroutine head *)
254 call db01ox (0,ccor,i,glovirt,gloreal,i);
257 writeln(co,t9,linenr);
258 if echo then writeln(lo,t9,linenr) fi;
265 (************************************************************)
269 (*----------------------------------------------------------*)
270 (* PROCEDURA INICJALIZUJACA DZIALANIE DEBUGGERA. *)
271 (* WYKONUJE KOLEJNO NASTEPUJACE KROKI : *)
272 (* 1.ZNAJDUJE ADRES PROTOTYPU INSTRUKCJI BREAKL *)
273 (* I EXPORTUJE GO DLA PROCEDURY RAN. SYS. TRACE *)
274 (* 2.KOPIUJE ZE STRUMIENIA SC TABLICE HASHU, *)
275 (* OTWIERA STRUMIEN SC DLA PROCEDUR LOGLANOWYCH, *)
276 (* OTWIERA STRUMIEN CI ,INICJALIZUJE ZMIENNE SCANERA *)
277 (* 3.INICJALIZUJE TABLICE BREAKT I DISPT, *)
278 (* OTWIERA STRUMIENI SC ORAZ CO *)
279 (************************************************************)
281 UNIT INICBR:PROCEDURE;
282 var i, brnr : integer;
285 open(protf,integer, unpack("debug.tmp"));
287 (* copy of the debugger output *)
288 open(lo,text,unpack( "debug.ech"));
290 open (co,text,unpack("SYS$OUTPUT")); (* output of the debugger *)
293 array breakt dim (1:maxbr);
295 array breaktl dim (1:maxbr);
297 get (protf, breakt(i));
299 for i := brnr+1 to maxbr do
302 (* initialization of lastbr *)
304 while lastbr <= maxbr do
305 if breakt(lastbr) = 0 then exit fi;
310 array idict dim (0:maxidict);
311 for i:=0 to maxidict do
317 array prot dim (1:maxprot);
318 for i:=1 to maxprot do
321 (* protf must be removed from directory *)
322 (* killing of protf and transferring the variable lo to the interpreter *)
323 call db01of(protf,lo);
326 (*********** PROCEDURY TESTUJACE ***************************)
328 UNIT TEST1:PROCEDURE (INPUT T:ARRAYOF INTEGER );
330 (* PROCEDURA DRUKUJE ZAWARTOSC TABLICY T *)
336 FOR I:=LOWER(T) TO UPPER(T) DO
337 IF J=10 THEN WRITELN(LO); J:=0 FI;
344 UNIT OUTREF:PROCEDURE(ADRES:ARRAYOF INTEGER);
347 (* (i,j) := virtual address refval *)
348 call db01ox(30,adres,i,glovirt,gloreal,j);
349 (*+ writeln(lo,"refval",i,j); ++*)
352 (************************************************************)
356 (*----------------------------------------------------------*)
357 (* PROCEDURA CZYTA I INTERPROTUJE INSTRUKCJE WYSYLANE PRZEZ *)
358 (* UZYTKOWNIKA DO DEBUGGERA . *)
359 (* WYJSCIE DLA INSTRUKCJI - STRUMIEN CI *)
360 (* WYNIKI - STRUMIEN CO *)
361 (* EWENTUALNA KOPIA - STRUMIEN LO *)
362 (************************************************************)
364 UNIT INTERPR :PROCEDURE ;
366 SIGNAL DEBERROR(NR :INTEGER);
368 VAR S,K,ADRES : INTEGER , (* ZMIENNE NA WYNIKI PROCEDURY SCAN *)
369 STP : BOOLEAN, (* CZY NAPOTKANO INSTRUKCJE GO *)
370 (* BUFORY DLA WARTASCI ZMIENNYCH *)
371 (* 1 -DLA WYNIKOW CZESCIWYCH PRZY ASSIGN *)
372 INTVAL,INTVAL1 : INTEGER,
373 RELVAL,RELVAL1 : REAL ,
374 CHAVAL,CHAVAL1 : CHAR ,
375 REFVAL,REFVAL1 : ARRAYOF INTEGER,
376 R,R1 : INTEGER, (* BUFORY NA LICZBE ARRAYOF *)
377 REFFVAL : ARRAYOF INTEGER,
378 PROTDEB,PROTDEB1,OFFSET1,OFFSET,MODE,MODE1:INTEGER,
381 MA:INTEGER; (* MARKER INTERPRETOWANEJ INSTRUKCJI *)
383 (*------ TYPY PREDEFINIOWANE -----------------*)
396 (* TYPY JEDNOSTEK SYNTAKTYCZNYCH *)
398 CONST VART = 5 , (* ZMIENNA *)
399 CORT = 11 , (* COROUTINA *)
400 RECT = 12 , (* REKORD *)
401 BLCT= 1 , (* BLOCK *)
402 HANT = 14 ; (* HANDLER *)
410 (* S T A L E S C A N E R A *)
412 (* IDENTYFIKATORY : S=1,ADRES = *)
413 CONST ADELETE = 2393,
424 (* SLOWA KLUCZOWE S = *)
441 SBOL = 1001, (* ADRES = 1 DLA FALSE 2 TRUE *)
455 SAST = 50, (* *-ADRES= ,- -ADRES=4*)
463 (*==================================================================*)
464 (* KOMUNIKACJA Z UZYTKOWNIKIEM *)
465 (* ---------------------------- *)
466 (* ODBYWA SIE LINIAMI ZA POSREDNICTWEM BUFORA SCANNERA *)
467 (*==================================================================*)
469 UNIT INTEX : PROCEDURE (OUTPUT TX:ARRAYOF INTEGER);
470 (* PROCEDURA CZYTA LINE Z BUFORA SCANNERA DO TABLICY TX *)
473 (*+ WRITELN(LO); ++*)
474 (*+ WRITELN(LO," INTEX"); ++*);
475 (* max := max from scanner *)
476 call sccd01ox(0,max,i,tx);
477 ARRAY TX DIM(1:MAX+1);
478 (* TX := bufor from scanner *)
479 call sccd01ox(1,max,max,tx);
480 (*+ for i:=1 to max do ++*)
481 (*+ IF(I MOD 10) =1 THEN WRITELN(LO);WRITE(LO," "); FI;++*)
482 (*+ WRITE(LO,TX(I));++*)
486 if i >= max then exit fi;
487 if tx(i) = eln then exit fi;
488 ch := tx(i); i := I+1
491 tx(i) := sr; i := i+1;
495 WHILE I<MAX DO tx(i) := bl;I:=I+1 OD;
498 UNIT OUTEX : PROCEDURE (TX:ARRAYOF INTEGER);
499 (* PROCEDURA WPISUJE ZAWARTOSC TABLICY TX DO BUFORA SCANERA *)
502 (*+ WRITELN(LO) ++*);
503 (*+ WRITELN(LO," OUTEX"); ++*);
504 (* bufor from scanner:=tx, max form scanner:=upper(tx),lp from scanner:=1 *)
505 i := 1; pom := upper(tx);
506 call sccd01ox(2,pom,i,tx);
507 (*+FOR I:=1 TO UPPER(TX) DO ++*)
508 (*+ IF (I MOD 10)=1 THEN WRITELN(LO);WRITE(LO," ") FI; ++*)
509 (*+ WRITE(LO,TX(I)) ++*);
513 (*---------------------------------------------------------*)
515 (* WYWOLUJE PROCEDURE ASSEMBLERA SCAN . WYNIK NA ZMIENNYCH *)
516 (* GLOBALNYCH S,K,ADRES *)
517 (* W PRZYPADKU BLEDU S OTRZYMYJE WARTOSC -1 A K -NUMER *)
518 (* BLEDU SYGNALIZOWANY PRZEZ SCANER *)
519 (*---------------------------------------------------------*)
521 UNIT SCAN :PROCEDURE;
523 call scnd01ox(s,k,adres);
524 (*+ WRITELN(LO," S= ",S," K= ",K," ADRES=",ADRES);++*)
525 IF S < 0 THEN RAISE DEBERROR(0) FI;
526 END (**** SCAN ******);
528 UNIT NEWLIN :PROCEDURE;
529 (* PRZEJSCIE DO NOWEJ LINII *)
531 (* scanner variables: sy1:=45; k1:=6; okey:=false;lp:=max+1 *)
532 call sccd01ox(4,i,i,refval);
535 (*-----------------------------------------------------------*)
536 (* WRID ,WRCH ,WRLIN *)
537 (*-----------------------------------------------------------*)
538 UNIT WRID:PROCEDURE (I:INTEGER; num : integer);
540 (* WYPISANIE IDENTYFIKATORA *)
541 (* I- ADRES IDENTYFIKATORA W TABLICY HASH *)
542 (* num - na tylu miejsach ma byc wypisany identyfikator *)
548 (* k, l := hash(i), hash(i+1) *)
549 call sccd01ox(3,i,k,refval );
551 call sccd01ox(3,i,l,refval);
553 IF L<0 THEN I:=-L;J:=J+2;REPEAT FI;
556 FOR I:=J+2 TO num DO WRITE(CO," ");
557 IF ECHO THEN WRITE(LO," ") FI;
561 UNIT WRCH:PROCEDURE(I:INTEGER);
562 (* I- SLOWO ZAWIERAJACE DWA ZNAKI DO WYPISANIA *)
569 WHEN 0:IF BOO THEN WRITE(CO,"0");
570 IF ECHO THEN WRITE(LO,"0") FI FI;
571 WHEN 60:IF NOT BOO THEN WRITE(CO,"0");
572 IF ECHO THEN WRITE(LO,"0") FI FI;
573 WHEN 46:WRITE(CO," "); IF ECHO THEN WRITE(LO," ") FI;
574 WHEN 1,2,3,4,5,6,7,8,9:WRITE(CO,CHR(48+K));
575 IF ECHO THEN WRITE(LO,CHR(48+K)) FI;
576 OTHERWISE WRITE(CO,CHR(55+K));IF ECHO THEN WRITE(LO,CHR(55+K)) FI;
584 UNIT WRLIN:PROCEDURE (TXT:ARRAYOF INTEGER);
587 IF ECHO THEN WRITE(LO," ") FI;
589 WHILE TXT(I)=/=eln DO
590 WRITE(CO,CHR(TXT(I)));
591 IF ECHO THEN WRITE(LO,CHR(TXT(I))) FI;
594 WRITELN(CO) ;IF ECHO THEN WRITELN(LO) FI;
597 (*-----------------------------------------------------------*)
600 (* GRUPA PROCEDUR UMAZLIWIAJACA ODCZYRANIE WARTOSCI OKRESLO- *)
601 (* TYPU PRZY OKRESLONYM SPOSOBIE ADRESOWANIA. *)
602 (* WYNIKI NA ZMINNYCH INTVAL,RELVAL,CHVAL,REFVAL ODPOWIEDNIO *)
603 (* DO TYPU ( BOOL NA INTVAL 0 LUB -1 ) *)
604 (*-----------------------------------------------------------*)
607 UNIT TAKEREF :PROCEDURE(OFFSET,TYP : INTEGER );
609 (* ODCZYTUJE WARTSC O DANYM OFFSECIE W OBIEKCIE WSKAZYWANYM PREZ REF *)
610 (* relval/chaval/intval/refval - value from memory *)
611 (* refval,offset - address in the memory *)
613 IF REFVAL=NONE THEN RAISE DEBERROR(15) FI;
617 (* relval := value of the address (refval,offset) *)
618 call db01ox(1,refval,offset,glovirt,relval,intval);
619 (*+ WRITELN(LO," TAKEREF RELVAL ",RELVAL)++*);
622 (* intval := value of the address (refval,offset) *)
623 call db01ox(2,refval,offset,glovirt,relval,intval );
626 (* chaval := value of the address (refval,offset ) *)
627 call db01ox(3,refval,offset,glovirt, relval, i);
629 (*+ WRITELN(LO," TAKEREF CHAVAL ",CHAVAL)++*);
631 WHEN STRT : WRITELN(CO,t15);
634 (* refval := value of the address (refval,offset) *)
635 call db01ox(4,refval,offset,glovirt,relval, intval);
636 (*+ WRITELN(LO," TAKEREF REFVAL ")++*)
640 (*-------------------------------------------------------------*)
641 UNIT TAKEARR :PROCEDURE(IND,TYP : INTEGER );
642 (* TO CO TAKEREF ALE DLA TABLIC *)
643 (* refval/intval/relval/chaval := value of an array element *)
644 (* ind - real offset in an array object, refval - address of the array *)
647 IF REFVAL=NONE THEN RAISE DEBERROR(15) FI;
649 WHEN RELT : IND:=IND*2;I:=2;
650 WHEN INTT,BOOLT,CHT,STRT :I:=1;
651 OTHERWISE IND:=IND*2;I:=2;
653 (* ind - offset, i - appetite of an array element *)
654 (* ap := appetite of the array object, intval := lower*element appetite -3 *)
655 call db01ox(5,refval,intval,glovirt,relval, ap);
656 INTVAL:=INTVAL+3; (* LOWER*APPETITE *)
657 IF IND < INTVAL OR IND >AP-3+I-INTVAL THEN RAISE DEBERROR(33) FI;
661 (* relval := array element *)
662 call db01ox(6,refval,ind,glovirt,relval,intval);
663 (*+ WRITELN(LO," TAKEARR IND RELVAL",IND,RELVAL)++*);
666 (* intval := array element *)
667 call db01ox(7,refval,ind,glovirt,relval,intval);
668 (*+ WRITELN(LO,"TAKEARR IND, INTVAL ",IND,INTVAL )++*);
671 (* chaval := array element *)
672 call db01ox(8,refval,ind,glovirt,relval,i);
674 (*+ WRITELN(LO," TAKEARR IND ,CHAVAL",IND,CHAVAL )++*);
676 WHEN STRT :WRITELN(CO,t15);
679 (* refval := array element *)
680 call db01ox(9,refval,ind,glovirt,relval,intval);
681 (*+ WRITELN(LO," TAKEARR REFVAL ")++*);
686 (*-----------------------------------------------------------*)
687 (* E N D P R O C E D U R T A K E ... *)
688 (*-----------------------------------------------------------*)
690 (*================ I N F ==================================*)
694 WRITE(CO,t10);IF ECHO THEN WRITE(LO,t10) FI;
697 IF UNITCASE=BLCT (* BLOCK *) THEN WRITE(CO,t11);
698 IF ECHO THEN WRITE(LO,t11) FI;
700 IF UNITCASE=HANT THEN WRITE(CO, t12);
701 IF ECHO THEN WRITE(LO,t12) FI
703 CALL WRID(prot(I-1), 10);
706 WRITE(CO,t13);IF ECHO THEN WRITE(LO,t13) FI;
708 WRITELN(CO,prot(I));IF ECHO THEN WRITELN(LO,prot(I)) FI;
711 (*===========================================================*)
713 (* ----------------------------------------------------------*)
716 (* reads line number, label or dot *)
717 (* returns index (in breakt) of the line identified by the *)
719 (*-----------------------------------------------------------*)
721 unit findlin:function:integer;
724 if s=sdot then result:=cind
727 for i:=1 to lastbr do
728 if breakt(i)=/=0 andif breaktl(i)=/=none andif
729 breaktl(i).mark = adres then result := i;
734 if s=/=sconst or k=/=kint then raise deberror(1) fi;
735 (* searching for the index in breakt *)
736 for i:=1 to lastbr do
737 if breakt(i) = adres then exit fi;
739 if i<=lastbr andif breakt(i) = adres then result := i fi;
742 if result=0 then raise deberror(18) fi;
743 (*+ writeln(lo," findlin :", result); ++*)
746 (*-----------------------------------------------------------*)
748 (* D E L (DELETE ) *)
750 (* PROCEDURA USUWA PUNKT PRZERYWAJACY OKRESLAONY PRZEZ *)
751 (* ETYKIETE LUB NUMER LINII *)
752 (*-----------------------------------------------------------*)
754 UNIT DEL : PROCEDURE;
759 if i=cind then raise deberror(39) fi;
760 if breaktl(i) =/= none then call killb(breaktl(i)) fi;
761 breakt(i) := breakt(lastbr);
762 if cind = lastbr then cind := i fi;
763 breaktl(i) := breaktl(lastbr);
767 (*-------------------------------------------------------------*)
771 (* DEKLARACJA PUNKTU PRZERYWAJECEGO. PUNKT TEM MOZE BYC *)
772 (* OZNACZONY ETYKIETA. MOZE BYC TO WARUNKOWY PUNKT PRZERYWAJACY*)
773 (*-------------------------------------------------------------*)
775 UNIT BRE : PROCEDURE;
778 CALL SCAN; (* CZYTAMY NR LINII *)
779 IF S =/= SCONST or K<>kint THEN RAISE DEBERROR(1) FI;
780 FOR I:=1 TO lastbr DO IF BREAKT(I)=ADRES THEN RAISE DEBERROR(17) FI OD;
781 IF lastbr = maxbr THEN RAISE DEBERROR(16) fi;
782 (* NO SPACE IN BREAK POINTS TABLE *)
784 BREAKT(lastbr):=ADRES;
785 BREAKTL(lastbr):=NEW BR;
786 if adres = linenr then cind := lastbr fi;
787 CALL SCAN; (* CZY JEST TO WARUNKOWY PUNKT ? *)
788 IF S=SWHEN THEN CALL INTEX(BREAKTL(lastbr).CONDTXT); (* TAK-ZAPAMIETUJEMY *)
789 (* TEKST Z WARUNKIEM *)
790 (* PRZESKAKUJEMY TEKST WARUNKU *)
791 WHILE S=/=SEMICOL AND NOT(S=sident AND ADRES=AWITH) DO CALL SCAN OD
793 IF S=sident AND ADRES = AWITH THEN CALL SCAN; (* BEDZIE ETYKIETA *)
794 IF S=/=sident THEN RAISE DEBERROR(1) (*IDENTIFIER EXPECTED *) FI;
795 BREAKTL(lastbr).MARK:=ADRES;
800 (*--------------------------------------------------------------------*)
804 (*--------------------------------------------------------------------*)
807 (* marks the given break point *)
812 if s=/= sident then raise deberror(1) fi;
813 if breaktl(i)=none then breaktl(i):=new br fi;
814 breaktl(i).mark:=adres;
817 (*--------------------------------------------------------------------*)
821 (* return to user program execution *)
822 (* - without parameters - standard execution *)
823 (* - * - execution with trace, without breaks *)
824 (* - line number - execution with traceand without breaks *)
825 (* up to the given line, then standard execution *)
826 (* - + - execution without trace and without breaks *)
828 (*--------------------------------------------------------------------*)
833 stp := true; (* stop ! *)
835 if s=sconst and k=3 then
836 ggo:=1; linenr2:=adres
840 when adast: ggo:=2 (* * *);
841 when adadd: ggo:=3 (* + *);
842 when admin: ggo:=4 (* - *);
843 otherwise raise deberror(34)
846 if s=/= semicol then raise deberror(10) fi
852 kill(mov); mov:=pom; pom:=pom.next
857 (*--------------------------------------------------------------------*)
861 (*--------------------------------------------------------------------*)
862 UNIT REPORT : PROCEDURE;
868 IF S=SBREAK THEN (* REPORT BREAK *)
870 IF S=SAST THEN (* REPORT BREAK * *)
872 WRITELN(CO," LIST OF BREAK POINTS");
873 WRITELN(CO," LINE NR / MARKER / INSTR. LIST ");
874 FOR I:=1 TO lastbr DO
875 IF BREAKT(I)=/=0 THEN
876 WRITELN(CO," ");WRITE(CO,BREAKT(I):8); write(co, " ");
877 IF BREAKTL(I)=/=NONE THEN
878 IF BREAKTL(I).MARK=/=0 THEN
880 CALL WRID(BREAKTL(I).MARK, 17)
881 ELSE WRITE(CO," ") FI;
882 IF BREAKTL(I).INS=/=NONE THEN WRITE(CO," YES")
883 ELSE WRITE(CO," NO") FI
884 ELSE WRITE(CO," NO") FI
889 ELSE (* REPORT BREAK - IDENTYFIKATOR , NR LINII lub kropka *)
891 if i=0 then raise deberror(18) fi; (* break point doesn't exist *)
892 if breaktl(i)=/=none then m:=breaktl(i).mark fi;
894 write(co," BREAK POINT - LINE :", breakt(i));
895 if m=/=0 then write(co," MARKER :"); call wrid(m, 10) fi;
897 if breaktl(i) =/= none then
898 pom := breaktl(i).ins;
907 ELSE (* OCZEKUJEMY REPORT DECLARE *)
908 IF ADRES=ADECLARE THEN
909 CALL SCAN;P2 := DECL;
911 IF S = SAST THEN (* LISTA WSZYSTKICH BANKOW INSTRUKCJI *)
912 WRITELN(CO," LIST OF DELCARED BANKS :");
914 WRITE(CO," ");CALL WRID(P2.ID, 10);WRITELN(CO);
918 ELSE RAISE DEBERROR(1)
920 ELSE (* LISTA INSTRUKCJI BANKU O PODANUM IDENTYFIKATORZE *)
922 IF P2.ID = ADRES THEN EXIT FI;P2:=P2.NEXT;
924 IF P2=NONE THEN RAISE DEBERROR(13)
927 WHILE POM =/= NONE DO
936 if s=semicol then (* report; *)
937 writeln(co,t9,linenr);write(co,t29);
938 if echo then writeln(lo,t9,linenr); write(lo,t29) fi;
940 ELSE RAISE DEBERROR(14) FI
945 (*----------------------------------------------------------*)
949 (* ZWIAZANIE listy INSTRUKCJI Z podanym PUNKTEM *)
951 (*----------------------------------------------------------*)
953 UNIT STORE :PROCEDURE;
960 if s =/= semicol then raise deberror(10) fi;
961 if breaktl(lin)=none then breaktl(lin) := new br fi;
962 pom,pom1 := breaktl(lin).ins;
963 while pom=/=none do pom1:=pom; pom:=pom.next od;
967 if s = send then exit fi;
970 if s=sident then pom.mark:=adres fi;
971 if pom1=none then breaktl(lin).ins:=pom
972 else pom1.next:=pom fi;
977 (*----------------------------------------------------------*)
981 (* USUNIECIE INSTRUKCJI ZWIAZANEJ Z AKTUALNYM PUNKTEM *)
982 (* PRZERYWAJECYM. (PODAJE SIE ETYKIETE USUWANEJ INSTRUKCJI) *)
983 (*----------------------------------------------------------*)
985 UNIT REMOVE :PROCEDURE;
992 if i=0 then raise deberror(18) fi;
993 (* ODCZYTALISMY ETYKIETE ,SZUKAMY INSTRUKCJI DO USUNECIA *)
994 IF BREAKTL(i)=NONE THEN POM:=NONE
995 ELSE POM:=BREAKTL(i).INS
998 WHILE POM =/= NONE DO
999 (*+ writeln(lo," marker :", pom.mark); ++*)
1000 IF POM.MARK = ADRES THEN (* ZNALEZLISMY, KOPIUJEMY *)
1002 if pom.next=/= none then
1004 (* element jest na poczatku listy *)
1005 breaktl(i).ins:=pom.next
1012 ELSE POM1:=POM;POM:=POM.NEXT
1015 if not ok then raise deberror(38) fi;
1018 (*---------------------------------------------------*)
1022 (* DEKLARACJA BANKU INSTRUKCJI *)
1023 (*---------------------------------------------------*)
1025 UNIT DECLARE :PROCEDURE;
1030 IF S =/= sident THEN RAISE DEBERROR(1) FI;
1031 (* PRZECZYTALISMY IDENTYFIKATOR PRZYSZLEGO BANKU *)
1035 (* DOLACZYLISMY INFORMACJE O NOWYM BANKU DO LISTY BANKOW *)
1036 DECL := POM; CALL NEWLIN;CALL SCAN;
1038 (* KOPIUJEMY INSTRUKCJE *)
1042 IF P2 = NONE THEN POM.INS := P1
1043 ELSE P2.NEXT := P1 FI;
1049 (*----------------------------------------------*)
1053 (* WYKONANIE INSTRUKCJI Z BANKU INSTRUKCJI *)
1054 (*----------------------------------------------*)
1056 UNIT CAL : PROCEDURE;
1063 (* PRZECHOWANIE BUFORA SCANERA *)
1064 CALL SCAN ;IF S =/= sident THEN RAISE DEBERROR(1) FI;
1066 WHILE POM =/= NONE DO
1067 IF POM.ID = ADRES THEN EXIT FI;
1070 IF POM = NONE THEN RAISE DEBERROR(13)
1073 WHILE P2 =/= NONE DO
1085 (*---------------------------------------------------------*)
1089 (* INTERPRERACJA INSTRUKCJI PODSTAWIENIA *)
1090 (*---------------------------------------------------------*)
1092 UNIT ASSIG :PROCEDURE;
1096 (* ODCZYTANE WARTOSCI prawej STRONY PODSTAWIENIA *)
1097 MODE1:=MODE; PROTDEB1:=PROTDEB; INTVAL1:= INTVAL;
1098 (* ZAPAMIETANIE WAROTSCI WYNIKOW PROCEDURY FIND *)
1099 REFVAL1:=REFVAL; RELVAL1:= RELVAL; CHAVAL1:= CHAVAL;
1100 (*+ WRITELN(LO," ",MODE,PROTDEB,INTVAL,RELVAL); ++*)
1101 IF S=/= STO THEN RAISE DEBERROR(11) FI;
1104 (* ODCZYTANIE PRAWEJ STRONY WYRAZENIA *)
1105 (*+ WRITELN(LO," ",MODE,PROTDEB,INTVAL,RELVAL,OFFSET); ++*)
1106 IF PROTDEB1=INTT AND PROTDEB=RELT THEN RELVAL1:=INTVAL1 FI;
1107 IF PROTDEB1=RELT AND PROTDEB=INTT THEN INTVAL1:=RELVAL1 FI;
1108 IF PROTDEB1*PROTDEB<0 THEN RAISE DEBERROR(19) FI;
1109 IF PROTDEB=NONT THEN RAISE DEBERROR(15) FI;
1110 IF PROTDEB1=NONT THEN PROTDEB1:=1 FI;
1111 (*+WRITELN(LO," ",MODE,RELVAL1,INTVAL1);++*)
1112 IF MODE1>3 THEN IF MODE<3 THEN RAISE DEBERROR(19) FI FI;
1113 CALL OUTREF(REFFVAL);
1114 CALL OUTREF(REFVAL);
1115 CALL OUTREF(REFVAL1);
1118 (* PODSTAWIENIE WARTOSCI PRZEBIEGA ROZNIE W ZALEZNOSCI *)
1119 (* OD SPOSOBU ADRESACJI I TYPU ZMIENNEJ *)
1120 WHEN 1,2,5,6 : (* assign an object attribute *)
1121 IF REFFVAL=NONE THEN RAISE DEBERROR(15) FI;
1122 IF MODE1>3 OR PROTDEB>0 THEN
1123 (* refval1 --> address (refval,offset) *)
1124 call db01ox(10,refval,offset,refval1,relval,intval);
1129 (* intval1 --> address(refval,offset) *)
1130 call db01ox(11,refval,offset,glovirt,relval,intval1);
1132 (* chaval1 --> address (refval,offset) *)
1134 call db01ox(12,refval,offset,glovirt,relval,i);
1136 (* relval1 --> address (refval,offset) *)
1137 call db01ox(13,refval,offset,glovirt,relval1,intval);
1141 WHEN 3,4: (* assign an array element *)
1142 IF REFFVAL = NONE THEN RAISE DEBERROR(15) FI;
1143 IF MODE1>3 OR PROTDEB>0 THEN
1145 (* refval1 ---> array element of an address (refval,offset) *)
1146 call db01ox(14,refval,offset,refval1,relval,intval);
1150 (* intval1 --> array element *)
1151 call db01ox(15,refval,offset,glovirt,relval,intval1);
1153 (* chaval1 --> array element *)
1155 call db01ox(16,refval,offset,glovirt,relval,i);
1157 (* relval1 --> array element *)
1159 call db01ox(17,refval,offset,glovirt,relval1,intval);
1165 (*========================================================*)
1167 (* O U T P ( OUTPUT ) *)
1169 (* WYPISANIE WARTOSCI WYRAZENIA LUB JEGO TYPU *)
1170 (*========================================================*)
1172 UNIT OUTP : PROCEDURE;
1177 IF S=SAST AND ADRES=adast then
1178 (* WYPISANIE TYPU WYRAZENIA *)
1180 WRITE(CO,t16,R,t17);
1181 IF ECHO THEN WRITE(LO,t16,R,t17) FI;
1182 IF PROTDEB=FORT THEN WRITELN(CO,t18);
1183 IF ECHO THEN WRITELN(LO,t18) FI;RETURN
1186 IF PROTDEB=FORT or protdeb =cortt or protdeb = proctt THEN
1187 IF REFVAL=NONE THEN WRITELN(CO,t19);
1188 IF ECHO THEN WRITELN(LO,t19) FI; RETURN FI;
1189 (* protdeb := dispnr of the object refval *)
1190 call db01ox(18,refval,i,glovirt,gloreal,protdeb);
1194 WHEN 2:WRITE(CO,t20); IF ECHO THEN WRITE(LO,t20) FI;
1195 WHEN 8:WRITE(CO,t21);IF ECHO THEN WRITE(LO,t21) FI;
1196 WHEN 11:WRITE(CO,t22);IF ECHO THEN WRITE(LO,t22) FI;
1197 WHEN 5:WRITE(CO,t23);IF ECHO THEN WRITE(LO,t23) FI;
1198 WHEN 35:WRITE(CO,t24);IF ECHO THEN WRITE(LO,t24) FI;
1202 i := idict(protdeb);
1203 WRITE(CO," "); IF ECHO THEN WRITE(LO," ") FI;
1204 CALL WRID(prot(I-1), 10)
1206 WRITELN(CO); IF ECHO THEN WRITELN(LO) FI;
1209 (* WYPISANIE WARTOSCI WYRAZENIA *)
1210 IF S=/=SEMICOL THEN RAISE DEBERROR(10) FI;
1211 IF MODE >= 4 THEN RAISE DEBERROR(20) FI;
1212 IF PROTDEB=INTT THEN WRITELN(CO," ",INTVAL);
1213 IF ECHO THEN WRITELN(LO," ",INTVAL) FI;
1215 IF PROTDEB=RELT THEN WRITELN (CO," ",RELVAL);
1216 IF ECHO THEN WRITELN(LO," ",RELVAL) FI
1218 IF PROTDEB=CHT THEN WRITELN(CO," ",CHAVAL);
1219 IF ECHO THEN WRITE(LO," ",CHAVAL) FI
1221 IF PROTDEB=BOOLT THEN IF INTVAL = -1 THEN WRITELN(CO,t25);
1222 IF ECHO THEN WRITELN(LO,t25) FI;
1223 ELSE WRITELN(CO,t26);
1224 IF ECHO THEN WRITELN(LO,t26) FI
1227 call db01ox(30,refval,i,glovirt,gloreal,j);
1228 writeln(co, " virtual address ",i,j);
1229 if echo then writeln(lo," virtual address ",i,j) fi;
1234 (*-----------------------------------------------*)
1238 (* ZMIANA PUNKTU OBSERWACJI *)
1239 (*-----------------------------------------------*)
1241 UNIT MOVE :PROCEDURE;
1242 VAR M:MOVEL, C:ARRAYOF INTEGER;
1245 CALL SCAN;C:=MOV.COR;
1247 (*+ CALL OUTREF(MOV.ADR); CALL OUTREF(C); ++*)
1248 IF S=SAST AND ADRES=adast THEN
1249 (* IDZIEMY PO PREFIKSIE *)
1250 IF PROTNR<0 THEN RAISE DEBERROR(31) FI;
1251 CALL SCAN;IF S=/=SART OR ADRES=/=adgt THEN RAISE DEBERROR (28) FI;
1252 I:=I+4; (* ADRES numeru PROTOTYPU PREFIKSU *)
1254 (* protdeb - adres prototypu prefiksu *)
1255 (* ODCZYTANIE PROTOTYPU DEBUGGERA PREFIKSU *)
1256 IF PROTDEB=0 (* NIE MA PREFIKSU *) THEN RAISE DEBERROR(31) FI;
1257 M:=NEW MOVEL(MA,PROTDEB,MOV.ADR,MOV.COR);
1258 M.NEXT:=MOV ; MOV:=M; PROTNR:=PROTDEB; CALL INF;
1259 call scan; (* przeczytanie ';' *)
1262 if s=/= 1 then (* poruSZAMY SIE PO SL LUB DL LUB CL *)
1263 IF UNITCASE=RECT THEN RAISE DEBERROR(35) FI;
1264 IF S=SART AND ADRES=adeq THEN (* = *) (* SL *)
1265 IF PROTNR=0 THEN RAISE DEBERROR(30) FI; (* main block *)
1267 IF S=/=SART OR ADRES=/=7 THEN RAISE DEBERROR(28) FI;
1268 I:=I+1; PROTDEB:=prot(I);(* SL *)
1269 (* ODCZYTANIE ADRESU OBIEKTU WSKAZYWANEGO PRZEZ SL *)
1270 (* refval := address of the SL of mov.adr *)
1271 call db01ox(19,mov.adr,offset,refval,relval,intval);
1273 call scan; (* wczytanie ';' *)
1275 IF S=SAST AND ADRES= admin THEN (* - *) (* DL *)
1276 IF PROTNR=0 THEN RAISE DEBERROR(30) FI; (* main block *)
1277 IF UNITCASE=CORT (* COROUTINE *) THEN RAISE DEBERROR(32) FI;
1279 IF S=/=SART OR ADRES=/=adgt THEN RAISE DEBERROR(28) FI;
1280 (* ODCZYTENIE OBIEKTU WSKAZYWNEGO PRZEZ DL *)
1281 (* refval := address of the DL of the object mov.adr *)
1282 call db01ox(20,mov.adr,offset,refval,relval,intval);
1283 IF MOV.ADR=REFVAL THEN RAISE DEBERROR(36) FI;
1284 call scan; (* wczytanie srednika *)
1285 (* MOVE DL W IBIEKCIE STERMINOWANYM *)
1287 IF S=/=SART OR ADRES =/= adgt THEN RAISE DEBERROR(28) FI;
1289 IF S =/= SART OR ADRES =/= adgt THEN RAISE DEBERROR(28) FI;
1290 (* ODCZYTUJEMY CL *)
1291 IF MOV.COR=NONE THEN RAISE DEBERROR(37) FI;
1292 (* JESTESMY W OBIEKCIE NALEZACYM DO LANCUCHA COROUTINY *)
1293 (* refval := address of the CL of the object mov.cor *)
1294 call db01ox(21,mov.cor,offset,refval,relval,intval);
1296 IF REFVAL=NONE THEN RAISE DEBERROR(15) FI;
1297 IF CCOR=REFVAL THEN (* WRACAMY DO AKTYWNEJ COROUTINY *)
1299 ELSE (* ODCZYTUJEMY ADRES OBJEKTU WSKAZYWANEGO PRZEZ DL GLOWY *)
1300 (* refval := address of DL of the object C *)
1301 call db01ox(22,c,offset,refval,relval,intval);
1303 call scan; (* wczytanie srednika *)
1305 (*+ CALL OUTREF(REFVAL); ++*)
1306 IF REFVAL=NONE THEN RAISE DEBERROR(15) FI;
1307 (* ODCZYTUJEMY DISPNR NOWEGO PUNKTU OBSERWACJI *)
1308 (* protdeb := dispnr of the object refval *)
1309 call db01ox(23,refval,offset,glovirt,relval,protdeb);
1310 (*+ WRITELN(LO," PR=",PROTDEB)++*);
1313 (* MOVE DO OBIEKTU OKRESLONEGO PRZEZ WYRAZENIE *)
1314 (*+ WRITELN(LO," MOVE DO OBIEKTU"); ++*)
1316 if refval=none then raise deberror(15) fi;
1317 IF PROTDEB<0 THEN RAISE DEBERROR(21) FI;
1318 i := idict(protdeb); UNITCASE:=prot(I);
1319 IF UNITCASE=/=RECT THEN C:=FINDCR(REFVAL) ELSE C:=NONE FI;
1322 (* UAKTUALNIENIE LISTY BREAKL *)
1323 M:=NEW MOVEL(MA,PROTDEB,REFVAL,C); M.NEXT:=MOV; MOV:=M;
1324 (*+ WRITELN(LO," NOWY PUNKT OBSERWACJI"); ++*)
1325 (*+ CALL OUTREF(REFVAL); ++*)
1326 OBSADR:=REFVAL; (* adres obiektu bedacego punktem obserwacji *)
1331 (*--------------------------------------------------*)
1333 (* R E T (RETURN) *)
1335 (* POWROT DO POPRZEDNIEGO PUNKTU OBSERWACJI *)
1336 (*--------------------------------------------------*)
1338 UNIT RET :PROCEDURE;
1342 (*+ CALL OUTREF(MOV.ADR); ++*)
1344 IF S=SAST and adres = adast THEN (* KASUJ WSZYSTKIE ZMIANY *)
1345 WHILE POM.NEXT=/=NONE DO MOV:=MOV.NEXT; KILL(POM); POM:=MOV OD;
1347 ELSE IF S=SEMICOL THEN (* COFAMY SIE JEDEN KROK *)
1348 IF MOV.NEXT=NONE THEN RAISE DEBERROR(22) FI;
1349 MOV:=MOV.NEXT; KILL (POM)
1350 ELSE (* COFAMY SIE DO PUNKTU OBSERWACJI, KTORY OBOWIAZYWAL *)
1351 (* PRZED INSTRUKCJA MOVE O ETYKIECI = ADRES *)
1352 IF S=/=sident THEN RAISE DEBERROR(1) FI;
1354 IF POM.MARK=ADRES THEN EXIT FI;
1357 IF POM=NONE THEN RAISE DEBERROR(22) FI;
1359 WHILE MOV=/=POM DO MOV:=MOV.NEXT; KILL(P1); P1:=MOV OD;
1360 MOV:=MOV.NEXT; KILL (P1);
1364 (* AKTUALIZUJEMY PUNKT OBSERWACJI *)
1367 i := idict(protnr); unitcase := prot(i);
1371 (*--------------------------------------------------------------------*)
1375 (*--------------------------------------------------------------------*)
1376 (* PROCEDURA ODCZYTUJE WARTOSC ZMIENNEJ A DLA LEXPR ROWNIEZ JEJ ADRES *)
1377 (* WYNIKI ZWRACA NA ZMIENNYCH GLOBALNYCH protdeb,DISPNR,OFFSET,R *)
1378 (* (LICZBA ARRAY OF ) I MODE - SPOSOB ADRESOWANIA *)
1379 (* WARTOSCI LICZBOWE NA INTVAL ,REFVAL ,CHAVAL,RELVAL W ZALEZNOSCI *)
1380 (* OD TYPU WARTOSCI *)
1381 (*--------------------------------------------------------------------*)
1383 UNIT FIND : PROCEDURE (LEXPR :BOOLEAN);
1385 (* mode = 0 - nie zmienna (stala) *)
1386 (* 1 - zmienna czytana jako offset w obiekcie *)
1388 (* 3 - zmienna czytana jako element tablicy *)
1389 (* 4 - tablica czytana jako element tablicy *)
1390 (* 5 - tablica czytana jako element w obiekcie *)
1391 (* 6 - tablica czytana jako offset w obiekcie *)
1394 UNIT SZUKATR:PROCEDURE(ADRES:INTEGER;INOUT ADRPROT:INTEGER;
1395 OUTPUT OFFSET,R:INTEGER;OUTPUT TAK:BOOLEAN);
1397 (* SZUKA W PROTOTYPIE O ADRESIE ADRPROT ZMIENNEJ O ADRESIE *)
1398 (* W TABLICY HASH ROWNYM ADRes *)
1399 (* WYNIK: OFFSET-OFFSET ZMIENNEJ,R-LICZBA ARRAYOF TYPU ZMIENNEJ,TAK-WSKAZUJE*)
1400 (* CZY ZNALEZIONO ZMIENNA,ADRPROT- JEST TYPEM ZMIENNEJ*)
1402 VAR L,ADR,PROTDEB:INTEGER;
1405 (*+WRITELN(LO," SZUATR ADRES=",ADRES,"ADRPROT = ",ADRPROT)++*);
1406 OFFSET:=(ADRES-1)/2;(*+WRITELN(LO," L1",OFFSET)++*);
1407 OFFSET:=OFFSET MOD 8;
1408 (*+ WRITELN(LO," L2",OFFSET)++*);
1411 (*+ WRITELN(LO," L3",L)++*);
1413 (*+ WRITELN(LO," ADR",ADR)++*);
1414 (* ADR-POCZATEK LISTY HASHU*)
1417 (* r - kolejny element listy *)
1418 IF R = -100 THEN EXIT FI;
1419 IF ADRES = R THEN (*TO JEST NASZA ZMIENNA*)
1421 adrprot := -prot(adr);
1422 if adrprot <= 15 then (* to nie jest zmienna *)
1423 raise deberror(29) fi;
1424 (* zmienna lub stala *)
1429 IF R =/= -100 THEN (* ZNALEZLISMY PROTOTYP ZMIENNEJ*)
1431 IF prot(ADRPROT)=VART THEN (*JEST TO ZMIENNA LUB PARAMETR*)
1433 R:= prot(ADR); (* R:= LICZBA ARRAY OF *)
1438 ELSE (*CASE=/=5*) RAISE DEBERROR(29) FI;
1439 ELSE (* NIE ZNALEZLISMY ZMIENNEJ*)
1444 UNIT SEP :FUNCTION:BOOLEAN;
1445 (* SPREWDZA CZY PRZECZYTANY PRZEZ SCANER SYMBOL JEST SEPERATOREM *)
1447 BEGIN RESULT:= S=SEMICOL OR S=STO OR S=SRPAR OR S=SLPAR OR S=SCOM
1448 OR S=SART OR S=SAST AND ADRES=adast OR S=SOR OR S=SAND OR S=SNOT
1449 OR S=SWHEN OR (S=1 AND ADRES=AWITH)
1450 OR PROTDEB<0 AND PROTDEB =/=FORT and protdeb <> cortt and protdeb <> proctt
1453 VAR ADRPROT,A,LINDEKSOW : INTEGER,
1454 BOL,SL,POKROPCE:BOOLEAN,
1455 CURADR : ARRAYOF INTEGER,
1460 (* ZAKLADAMY ,ZE JEST PRZECZYTANY SYMBOL *)
1461 (*PROTNR-NR PROTOTYPU DEBUGGERA AKTUALNEGO OBIEKTU*)
1462 IF S=/=sident THEN MODE:=0;
1463 IF LEXPR THEN RAISE DEBERROR(1) FI;
1464 IF S=SNONE THEN PROTDEB:=NONT;CALL SCAN;REFVAL:=NONE ;RETURN FI;
1465 IF S=SBOL THEN PROTDEB:=BOOLT;
1466 IF ADRES=1 THEN INTVAL:=0 ELSE INTVAL:=-1 FI;
1467 CALL SCAN; RETURN FI;
1468 IF S=SAST AND ADRES=admin THEN(* MINUS*) MIN:=-1;CALL SCAN FI;
1469 IF S=/=SCONST THEN RAISE DEBERROR(1) FI;
1471 WHEN kint : PROTDEB:=INTT;INTVAL:=ADRES*MIN;
1472 WHEN 4,5 :RAISE DEBERROR(23);
1473 WHEN kch : PROTDEB:=CHT;
1474 chaval := chr(adres);
1482 (*+WRITELN(LO," OUTP IN DO ")++*);
1483 adrprot := idict(protdeb);
1484 IF SL THEN A:=PROTDEB FI; (*A JEST PROTOTYPEM ZMIENIAJACYM SIE TYLKO DLA
1487 I:=ADRPROT+3; DISPNR:=prot(I);
1488 (*+WRITELN(LO," DISPNR = ",DISPNR," ADRPROT = ",ADRPROT)++*);
1489 (* ODCZYTANIE NR DISPLAYA Z PROTOTYPU AKT OBIEKTU*)
1490 CALL SZUKATR(ADRES, ADRPROT, OFFSET, R, BOL);
1491 (*PO WYWOLANIU ADRPROT JEST NR TYPU PIERWOTNEGO LUB NR PROTOTYPU *)
1492 (*O ILE ZNALEZIONO ZMIENNA *)
1493 (* W P.P. ADRPROT SIE NIE ZMIENIA*)
1494 IF BOL THEN (*ZNALEZLISMY ZMIENNA*)
1496 DO (*PETLA DO WYPISANIA ZMIENNEJ a wlasciwie do rozpoznania wyr. do konca*)
1499 IF R=0 AND NOT POKROPCE THEN (*JEST TO ZMIENNA NIEABLICOWA BEZ KROPKI*)
1500 (*+WRITELN(LO," ***LICZYMY WARTOSC PIERWSZEGO IDENT")++*);
1501 REFFVAL,REFVAL:=CURADR;
1502 CALL TAKEREF(OFFSET,ADRPROT);
1506 IF R=0 AND POKROPCE THEN (*REFVAL JEST ADRESEM OBIEKTU PRZED KROPKA*)
1507 (*+WRITELN(LO," ***LICZYMY WARTOSC IDENT PO KROPCE")++*);
1509 CALL TAKEREF(OFFSET,ADRPROT);PROTDEB:=ADRPROT;
1513 IF R=/=0 AND NOT POKROPCE AND LINDEKSOW=0 THEN (* PIERWSZY INDEKS *)
1514 (*+WRITELN(LO," ***LICZYMY WARTOSC ZMIENNEJ INDEKSOWANEJ")++*);
1515 REFFVAL,REFVAL:=CURADR;
1516 CALL TAKEREF(OFFSET,1);
1519 IF S=/=SLPAR THEN EXIT EXIT
1521 CALL SCAN; (*CZYTA INDEKS,TO MUSI BYC STALA*)
1523 IF S=SAST AND ADRES=admin THEN MIN:=-1;CALL SCAN FI;
1524 (*+ WRITELN(LO," ***CZYTA INDEKS")++*);
1525 IF S=SCONST AND K=3 THEN LINDEKSOW:=1;
1526 (*+WRITELN(LO," ***LICZY WARTOSC TABLICY")++*);
1528 IF R=1 THEN CALL TAKEARR(ADRES*MIN,ADRPROT)
1529 ELSE CALL TAKEARR(ADRES*MIN,1) FI;
1530 OFFSET:=ADRES;MODE:=4;
1531 (*+ WRITELN(LO," ***WARTOSC ZMIENNEJ INDEKSOWANEJ") ++*);
1532 ELSE RAISE DEBERROR(1) (*INDEKS NIE JEST STALA*)
1534 CALL SCAN; (* OGRANICZNIKI LUB ")"*)
1535 IF S=/=SRPAR THEN (*S=/=")"*)
1536 IF S =/=SCOM THEN RAISE DEBERROR(5) FI;
1538 (*+WRITELN(LO," ***PRZECZYTALISMY PRAWY NAWIAS")++*);
1539 IF R=1 THEN MODE:=3 FI;
1541 IF SEP THEN R:=R-LINDEKSOW FI;
1543 FI; (*S=/=52 0R ADRES=/=3 *)
1546 IF R>1 OR R=1 AND POKROPCE THEN
1547 DO (*PETLA OBSLUGUJE ZMIENNE TABLICOWE PO KROPCE LUB O WIECEJ NIZ
1549 (*S- WARTOSC INDEKSU*)
1552 IF S=SAST AND ADRES=admin (*MINUS*) THEN MIN:=-1; CALL SCAN FI;
1553 IF S=SCONST AND K=kint THEN LINDEKSOW := LINDEKSOW+1;
1555 REFFVAL:=REFVAL;CALL TAKEARR(ADRES,ADRPROT);
1556 MODE:=4;OFFSET:=ADRES;
1559 CALL TAKEARR(ADRES, 1); (*ADRES=WARTOSC(S)*)
1561 (* TYP DANY JAKO 1 OZNACZA TYP REFERENC.*)
1563 ELSE RAISE DEBERROR(1) (*INDEKS NIE JEST STALA*)
1565 CALL SCAN; (*OGRANICZNIKI*)
1566 IF S=SRPAR THEN IF R=LINDEKSOW THEN MODE:=3 FI;
1567 CALL SCAN ; IF SEP THEN R:=R-LINDEKSOW;EXIT FI;
1569 IF LINDEKSOW < R THEN
1570 IF S =/= SCOM THEN RAISE DEBERROR(5) FI
1571 ELSE RAISE DEBERROR(6); (*ZA DLUGIE WYRAZENIE INDEKSOWE *)
1574 if lindeksow=r then exit fi;
1577 if protdeb > 0 or protdeb = fort or protdeb = proctt or protdeb = cortt then
1578 (* TRZEBA ZNALESC PROTOTYP TYPU AKTUALNEGO *)
1579 IF REFVAL=NONE THEN RAISE DEBERROR(15) FI;
1580 (* protdeb := protnumber of the actual type *)
1581 call db01ox(24,refval,offset,glovirt,relval,protdeb);
1582 (*+ WRITELN(LO," PROTDEB =",PROTDEB);++*)
1584 IF SEP THEN EXIT EXIT FI;
1586 IF R=/=0 AND LINDEKSOW=/=R OR PROTDEB <0 THEN RAISE DEBERROR(24) FI;
1587 (*+ WRITELN(LO," ***CZYTAMY KROPKE") ++*);
1589 CALL SCAN; (*CZYTA ZMIENNA PO KROPCE*)
1590 (*+ WRITELN (LO," ***CZYTAMY IDENT PO KROPCE")++*);
1591 adrprot := idict(protdeb);
1592 CALL SZUKATR(ADRES,ADRPROT,OFFSET,R,BOL);
1593 (*ZNAJDUJE ZMIENNA ZAPISANA W ADRES I BEDACA
1594 ATRYBUTEM PROTOTYPU ADRPROT*)
1595 IF NOT BOL THEN RAISE DEBERROR(7) FI;
1596 IF R=/=0 THEN (* ATRYBUTEM JEST TABLICA *)
1599 IF S=/=SEMICOL and S=/=STO THEN RAISE DEBERROR(10) FI;
1603 CALL TAKEREF(OFFSET,1);
1608 ELSE (*NIE ZNALEZLISMY ZMIENNEJ, TRZEBA ISC DO PREFIKSU*)
1609 adrprot := idict(protdeb);
1610 I:=ADRPROT+4; (* ADRPROT+4 =ADRES PROTOTYPU PREFIKSU *)
1612 (*+WRITELN(LO," **** PROTDEB",PROTDEB)++*);
1613 IF PROTDEB<=0 (*NIE MA PREFIKSU WIEC IDZIEMY PO SL*) THEN
1614 IF A=0 THEN (* MODUL GLOWNY *) RAISE DEBERROR(9) FI;
1616 (*+WRITELN(LO," A =",A)++*);
1617 adrprot := idict(a);
1618 I:=ADRPROT+1; (* BUFFP(I) = NUMER PROTUTYPU SL *)
1619 IF UNITCASE=RECT THEN RAISE DEBERROR(9) FI;
1620 (* SZUKAMY DALEJ TYLKO WTEDY, GDY NIE JEST TO REKORD *)
1622 (* curadr := address of SL of the object curadr *)
1624 call db01ox(25,glovirt,offset,curadr,relval,intval);
1625 (*+WRITELN(LO," +++ PROTDEB",PROTDEB)++*);
1631 (* ------------------------------------------------------------------- *)
1633 UNIT FINDCR:FUNCTION( INPUT C1:ARRAYOF INTEGER):ARRAYOF INTEGER;
1634 (* SZUKA GLOWY COROUTINY DLA INSTANCJI O ADRESIE C1 *)
1637 (*+WRITELN(LO," FINDCR");++*)
1639 IF C1=NONE THEN EXIT FI;;
1640 (*+ CALL OUTREF(C1); ++*)
1642 (* i := dispnr of the object c1 *)
1643 call db01ox(26,c1,offset,refval,relval,i);
1644 (*+ WRITELN(LO," I=",I); ++*)
1645 IF I=0 THEN EXIT FI;
1647 DO (* SZUKAMY W CIAGU PREFIKSOWYM COROUTINY *)
1649 (*+ WRITELN(LO," J=",J); ++*)
1650 IF prot(J)=11 THEN EXIT EXIT FI;
1652 (*+ WRITELN(LO," J=",J); ++*)
1653 IF J<=0 THEN EXIT FI;
1655 (* PORUSZAMY SIE PO DL *)
1656 (* c1 := DL of the object c1 *)
1658 call db01ox(27,glovirt,offset,c1,relval,intval);
1659 IF RESULT=C1 THEN RESULT:=NONE ; EXIT FI;
1660 (* ZAPETLENIE DL WSKAZUJE NA OBIEKT STERMINOWANY *)
1664 (*-------------------------------------------------------*)
1668 (* SPRAWDZENIE WARUNKU BOOLOWSKIEGO PRZY WARUNKOWYM *)
1669 (* PUNKCIE PRZERYWAJACYM *)
1670 (*-------------------------------------------------------*)
1671 UNIT COND :FUNCTION:BOOLEAN;
1674 CALL SCAN;WHILE S=/=SWHEN DO CALL SCAN OD;
1675 (* ROZPOCZYNAMY INTERPRETACJE WARUNKU *)
1677 DO (* PETLA PO "AND" *)
1679 IF S = SNOT THEN CALL SCAN;RESULT:=NOT COND1 AND RESULT
1680 ELSE IF S=/=SLPAR THEN RESULT:=COND1 AND RESULT
1683 DO BL:=FALSE;CALL SCAN;
1684 IF S= SNOT THEN CALL SCAN;BL:=BL OR NOT COND1
1685 ELSE BL:=BL OR COND1 FI;
1686 IF S=SRPAR THEN CALL SCAN; EXIT FI;
1687 IF S =/= SOR THEN RAISE DEBERROR(25) FI;
1689 RESULT:=RESULT AND BL;
1692 IF ADRES=AWITH OR S=SEMICOL THEN EXIT FI;
1693 IF S =/= SAND THEN RAISE DEBERROR(26) FI;
1694 IF NOT RESULT THEN EXIT FI;
1698 UNIT COND1 : FUNCTION:BOOLEAN;
1699 (* WARUNEK - WYRAZENIE *)
1703 (* ZAKLADAMY ,ZE JEST PRZECZYTANY SYMBOL *)
1704 (*+WRITELN(LO," ",PROTDEB,INTVAL,RELVAL,CHAVAL,MODE) ++*);
1706 IF PROTDEB=BOOLT THEN RESULT:=INTVAL=/=0
1707 ELSE RAISE DEBERROR(8) FI
1708 ELSE OPER:=ADRES;PROTDEB1:=PROTDEB;MODE1:=MODE;REFVAL1:=REFVAL;
1709 INTVAL1:=INTVAL;CHAVAL1:=CHAVAL;RELVAL1:=RELVAL;
1712 (*+WRITELN(LO," ",PROTDEB,INTVAL,RELVAL,CHAVAL,MODE) ++*);
1713 IF (PROTDEB=INTT OR PROTDEB=RELT) AND MODE<4 AND
1714 (PROTDEB1=INTT OR PROTDEB1=RELT) AND MODE1<4 THEN
1715 IF PROTDEB=INTT THEN RELVAL:=INTVAL FI;
1716 IF PROTDEB1=INTT THEN RELVAL1:=INTVAL1 FI;
1718 WHEN adeq :RESULT:=RELVAL1=RELVAL;
1719 WHEN adne :RESULT:=RELVAL1=/=RELVAL;
1720 WHEN adgt :RESULT:=RELVAL1>RELVAL ;
1721 WHEN adge :RESULT:=RELVAL1>=RELVAL ;
1722 WHEN adlt :RESULT:=RELVAL1<RELVAL;
1723 WHEN adle :RESULT:=RELVAL1<=RELVAL;
1726 IF (PROTDEB=NONT OR PROTDEB>0 OR MODE>4) AND
1727 (PROTDEB1=NONT OR PROTDEB1>0 OR MODE1>4)
1728 OR PROTDEB1=PROTDEB AND MODE1<4 AND MODE<4 THEN
1729 IF PROTDEB=BOOLT THEN
1731 WHEN adeq: RESULT:=INTVAL1=INTVAL;
1732 WHEN adne: RESULT:=INTVAL1=/=INTVAL;
1733 OTHERWISE RAISE DEBERROR(8)
1738 WHEN adeq:RESULT:=CHAVAL1=CHAVAL;
1739 WHEN adne:RESULT:=CHAVAL1=/=CHAVAL;
1740 OTHERWISE RAISE DEBERROR(8)
1744 WHEN adeq:RESULT:=REFVAL1=REFVAL;
1745 WHEN adne:RESULT:=REFVAL1=/=REFVAL;
1746 OTHERWISE RAISE DEBERROR(8)
1750 ELSE RAISE DEBERROR(8) FI
1756 (*===========================================*)
1757 UNIT INTLIN :PROCEDURE;
1759 (* INTERPRETACJA LINII *)
1766 IF S= SEMICOL THEN CALL SCAN FI;
1767 IF S=sident THEN (* IDENTYFIKATOR *)
1768 IF ADRES=AGO THEN call goo; exit else
1769 IF ADRES=AREPORT THEN CALL REPORT ;EXIT ELSE
1770 IF ADRES=AREMOVE THEN CALL REMOVE ;call scan;EXIT ELSE
1771 IF ADRES=ASTORE THEN CALL STORE ;call scan;EXIT ELSE
1772 IF ADRES=AMOVE THEN CALL MOVE;EXIT ELSE
1773 IF ADRES=ASSIGN THEN CALL ASSIG;EXIT ELSE
1774 IF ADRES=ADELETE THEN CALL DEL ;call scan;EXIT ELSE
1775 IF ADRES=ADECLARE THEN CALL DECLARE;call scan;EXIT ELSE
1776 IF ADRES=AMARK THEN call mark;call scan; exit else
1777 MA :=ADRES; CALL SCAN;
1778 IF S=/= SCOLON THEN RAISE DEBERROR(4)
1780 FI FI FI FI FI FI FI FI FI
1781 ELSE (* SLOWO KLUCZOWE *)
1783 WHEN SOUTPUT : CALL OUTP ; EXIT ;
1784 WHEN SWRITE : ECHO:=NOT ECHO ;call scan;EXIT;
1785 WHEN SBREAK : CALL BRE ;EXIT;
1786 WHEN SRETURN: CALL RET; EXIT ;
1787 WHEN SCALL : CALL CAL ;EXIT;
1788 WHEN SSTEP : call scan;
1789 SINGLESTEP:=NOT SINGLESTEP;EXIT ;
1790 OTHERWISE RAISE DEBERROR(3); EXIT
1799 WRITE(CO," !!! ERROR NR ",NR, " - ");
1801 when 1: writeln(co,"IDENTIFIER EXPECTED");
1802 when 2: writeln(co,"INTEGER CONSTANT EXPECTED");
1803 when 3: writeln(co,"INCORRECT INSTRUCTION NAME");
1804 when 4: writeln(co,"':' EXPECTED");
1805 when 5: writeln(co,"',' EXPECTED");
1806 when 6: writeln(co,"TOO MANY INDICES");
1807 when 7: writeln(co,"IDENTIFIER AFTER '.' MUST BE AN ATTRIBUTE");
1808 when 8: writeln(co,"INCORRECT CONDITION");
1809 when 9: writeln(co,"UNDECLARED IDENTIFIER");
1810 when 10: writeln(co,"';' EXPECTED");
1811 when 11: writeln(co,"'TO' EXPECTED");
1812 when 12: writeln(co,"UNRECOGNIZED INSTRUCTION");
1813 when 13: writeln(co,"UNRECOGNIZED BANK");
1814 when 14: writeln(co,"ERROR IN REPORT PARAMETER");
1815 when 15: writeln(co,"REFERENCE TO NONE");
1816 when 16: writeln(co,"TOO MANY BREAK POINTS");
1817 when 17: writeln(co,"BREAK POINT DECLARED TWICE");
1818 when 18: writeln(co,"UNRECOGNIZED BREAK POINT");
1819 when 19: writeln(co,"INCOMPATIBLE TYPES IN ASSIGN STATEMENT");
1820 when 20: writeln(co,"TRY TO OUTPUT A REFERENCE TYPE VARIABLE");
1821 when 21: writeln(co,"MOVE ARGUMENT IS NOT OF A REFERENCE TYPE");
1822 when 22: writeln(co,"UNRECOGNIZED MOVE INSTRUCTION");
1823 when 23: writeln(co,"REAL AND STRING CONSTANTS ARE FORBIDDEN");
1824 when 24: writeln(co,"'.' AFTER AN ARRAY");
1825 when 25: writeln(co,"'OR' EXPECTED");
1826 when 26: writeln(co,"'AND' EXPECTED");
1827 WHEN 27: WRITELN(co,"';' OR '*' OR IDENTIFIER EXPECTED");
1828 when 28: writeln(co,"'->' OR '=>' OR '>>' OR '*>' EXPECTED");
1829 when 29: writeln(co,"VARIABLE EXPECTED");
1830 when 30: writeln(co,"TRY TO GO OUTSIDE THE MAIN BLOCK");
1831 when 31: writeln(co,"EMPTY PREFIX");
1832 when 32: writeln(co,"MOVE -> IN COROUTINE HEAD");
1833 when 33: writeln(co,"INDEX OUT OF RANGE");
1834 when 34: writeln(co,"WRONG PARAMETER OF GO");
1835 when 35: writeln(co,"MOVE IN RECORD OBJECT");
1836 when 36: writeln(co,"MOVE '->' IN TERMINATED OBJECT");
1837 when 37: writeln(co,"THIS IS NOT A COROUTINE");
1838 when 38: writeln(co,"WRONG MARK");
1839 when 39: writeln(co,"TRY TO DELETE CURRENT BREAK POINT");
1848 (*=============================================*)
1849 BEGIN (***** INTERPR ******)
1851 (*+CALL OUTREF(CADR);++*)
1853 IF CBR=NONE THEN HELP:=NONE
1855 if cbr.condtxt =/= none then call outex(cbr.condtxt);
1856 if not cond then return fi;
1859 IF CBR.MARK =/=0 THEN WRITE(CO," ");
1860 IF ECHO THEN WRITE(LO," ") FI;
1861 CALL WRID(CBR.MARK, 10)
1864 if first then (* first interrupt *)
1866 writeln(co," LOGLAN DEBUGGER ");
1868 if echo then writeln(lo,' ');
1869 writeln(lo," LOGLAN DEBUGGER ");
1870 writeln(lo,' '); fi;
1872 writeln(co,"INITIAL BREAK AT LINE ",linenr)
1874 writeln(co,t9,linenr);
1875 if echo then writeln(lo,t9,linenr) fi;
1878 mov := new movel(0,protnr,cadr,findcr(cadr));
1879 (*+WRITELN(LO," DISPNR :",DISPNR)++*);
1882 (* SCANER CZYTA TEREAZ TEREAZ OD NOWEJ LINII *)
1884 IF HELP =/= NONE THEN (* WYKONANIE INSTRUKCJI ZWIAZANYCH *)
1885 CALL OUTEX(HELP.TXT);
1886 CALL WRLIN(HELP.TXT);
1889 (* NASTEPNA INSTRUKCJA Z LISTY *)
1892 call sccd01ox(5,i,i,ctxt); (* prompt *)
1893 CALL SCAN;WHILE S=SEMICOL DO
1894 call sccd01ox(5,i,i,ctxt);
1898 IF ECHO THEN CALL WRLIN(ctxt) FI; CALL INTLIN;
1902 END (***** INTERPR ******);
1904 UNIT RUNERROR :PROCEDURE;
1906 (* ODTWARZMY SRODOWISKO MODULU W KTORYM WYSTAPIL BLAD *)
1907 (* OBIEKT TEN JEST WSKAZYWANY PRZEZ DL HANDLERA *)
1908 (* dispnr := number of interrupted object,
1909 obsadr := address of interrupted object *)
1910 call db01ox(29,glovirt,linenr,obsadr,gloreal,dispnr);
1912 (* ccor - address of an active coroutine head *)
1913 call db01ox(0,ccor,dispnr,glovirt,gloreal,dispnr);
1914 (* linenr = line of the last break = (sometimes) line of the error occurrence *)
1915 write(co,t28,linenr);
1916 if echo then write(lo,t28,linenr) fi;
1923 WHEN ACCERROR : writeln(co,t1); call runerror;
1924 WHEN CONERROR : writeln(co,t2); call runerror;
1925 WHEN LOGERROR : writeln(co,t3); call runerror;
1926 WHEN TYPERROR : writeln(co,t4); call runerror;
1927 WHEN SYSERROR : writeln(co,t5); call runerror;
1928 WHEN NUMERROR : writeln(co,t6); call runerror;
1929 WHEN MEMERROR : writeln(co,t7); call runerror;
1930 OTHERS : WRITELN(CO,t8);CALL RUNERROR;
1933 BEGIN (**** MAIN DEBUGGER *****)
1935 (*+WRITELN(LO," RETURN AFTER INICBR ")++*);
1937 call db01oe; (* end of block prefixed by LOGDEB *)
1939 (*******************************************************************)