Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50417/cross.pas
There are no other files named cross.pas in the archive.
00010 (*$T-*)
00020
00030 (*********************************************************************************
00040 *
00050 *
00060 * PROGRAM ZUR ERSTELLUNG EINER CROSS-REFERENCE LISTE
00070 * UND EINER NEU FORMATTIERTEN VERSION EINES PASCAL
00080 * PROGRAMS.
00090 *
00100 * EINGABE: PASCAL QUELL-FILE
00110 * AUSGABE: NEU FORMATTIERTER QUELL-FILE UND
00120 * CROSS-REFERENCE LISTE
00130 *
00140 * AUTHOR: MANUEL MALL (1974)
00150 *
00160 *
00170 *********************************************************************************)
00180
00190
00200 PROGRAM CROSS( OLDSOURCE*, NEWSOURCE, CROSSLIST );
00210
00220
00230 CONST
00240 VERSION = 'CROSS(VERSION FROM 24-AUG-76)';
00250 FEED = 2; (*ZEICHENVORSCHUB BEI PROZEDUREN UND BLOECKEN*)
00260 MAXCH = 114; (*MAXIMALE ZAHL VON ZEICHEN PRO DRUCKZEILE*)
00270 BACKFEED = 1; (*ZEICHENVORRUECKUNG BEI 'PROCEDURE','BEGIN' ETC.*)
00280 MAXLINE = 57; (*MAXIMALE ZAHL VON ZEILEN PRO DRUCKSEITE*)
00290 HT = 11B; (*ASCII HORIZONTAL TAB*)
00300 LF = 12B; (*ASCII LINE FEED*)
00310 FF = 14B; (*ASCII FORM FEED*)
00320 CR = 15B; (*ASCII CARIAGE RETURN*)
00330 CASEFEED = 6; (*ZEICHENVORSCHUB BEI CASE*)
00340
00350 TYPE
00360 LINEPTRTY = ^LINE;
00370 LISTPTRTY = ^LIST;
00380 PROCCALLTY = ^PROCCALL;
00390 PROCSTRUCTY = ^PROCSTRUC;
00400 LINENRTY = 0..7777B;
00410 PAGENRTY = 0..77B;
00420 WORD = PACKED ARRAY [1..10] OF CHAR;
00430 SYMBOL = (LABELSY,CONSTSY,TYPESY,VARSY, (*DECSYM*)
00440 FUNCTIONSY,PROCEDURESY,INITPROCSY, (*PROSYM*)
00450 ENDSY,UNTILSY,ELSESY,THENSY,EXITSY,OFSY,DOSY,EOBSY, (*ENDSYMBOLS*)
00460 BEGINSY,CASESY,LOOPSY,REPEATSY,IFSY, (*BEGSYM*)
00470 RECORDSY,FORWARDSY,OTHERSY,INTCONST,IDENT,STRGCONST,EXTERNSY,FORTRANSY,
00480 RPARENT,SEMICOLON,POINT,LPARENT,COLON,LBRACK,OTHERSSY (*DELIMITER*));
00490
00500 BUFFTY = RECORD
00510 CASE BOOLEAN OF
00520 TRUE : (INT : INTEGER);
00530 FALSE: (CHARS : PACKED ARRAY [1..5] OF CHAR)
00540 END;
00550
00560 LINE = PACKED RECORD (*BESCHREIBUNG DER ZEILENNUMMERN*)
00570 LINENR : LINENRTY; (*ZEILENNUMMER*)
00580 PAGENR : PAGENRTY; (*SEITENNUMMER*)
00590 CONTLINK : LINEPTRTY (*NAECHSTER ZEILENNUMMERNRECORD*)
00600 END;
00610
00620 LIST = PACKED RECORD (*BESCHREIBUNG VON IDENTIFIERN*)
00630 NAME : WORD; (*NAME DES IDENTIFIERS*)
00640 LLINK , (*LINKER NACHFOLGER IN BAUM*)
00650 RLINK : LISTPTRTY; (*RECHTER NACHFOLGER IM BAUM*)
00660 FIRST , (*ZEIGER AUF ERSTEN ZEILENNUMMERNRECORD*)
00670 LAST : LINEPTRTY; (*ZEIGER AUF LETZTEN ZEILENNUMMERNRECORD*)
00680 PROCVAR : 0..2; (*0=KEINE PROZEDUR/ 1=PROZEDUR/ 2=FUNKTION*)
00690 CALLED, (*ZEIGER AUF DIE ERSTE PROZEDUR DIE VON DIESER GERUFEN WIRD*)
00700 CALLEDBY : PROCCALLTY (*ZEIGER AUF ERSTE RUFENDE PROZEDUR*)
00710 END;
00720
00730 PROCCALL = PACKED RECORD (*BESCHREIBUNG VON PROZEDURAUFRUFEN*)
00740 PROCNAME : LISTPTRTY; (*ZEIGER AUF DEN ZUGEHOERIGEN IDENTIFIERRECORD*)
00750 NEXTPROC : PROCCALLTY; (*ZEIGER AUF DIE NAECHSTE PROZEDUR*)
00760 FIRST, (*ZEILENNUMMERNRECORD FUER DEN ERSTEN AUFRUF*)
00770 LAST : LINEPTRTY (*ZEILENNUMMERNRECORD FUER DEN LETZTEN AUFRUF*)
00780 END;
00790
00800 DOUBLEDEC = PACKED RECORD (*PROZEDUREN DIE AUCH ALS NORMALE ID. DEFINIERT WURDEN*)
00810 PROCORT : LISTPTRTY; (*ZEIGER AUF DIE PROZEDUR*)
00820 NEXTPROC: ^DOUBLEDEC (*NAECHSTE DOPPELT DEKLARIERTE PROZEDUR*)
00830 END;
00840
00850 PROCSTRUC = PACKED RECORD (*BESCHREIBUNG DER PROZEDURVERSCHACHTELUNG*)
00860 PROCNAME : LISTPTRTY; (*ZEIGER AUF DEN ZUGERHOERIGEN IDENTIFIER*)
00870 NEXTPROC : PROCSTRUCTY; (*ZEIGER AUF DIE NAECHSTD DEKLARIERTE PROZEDUR*)
00880 LINENR : LINENRTY; (*ZEILENNUMMER DER PROZEDURDEFINITION*)
00890 PAGENR , (*SEITENNUMMER DER PROZEDURDEFINITION*)
00900 PROCLEVEL: PAGENRTY (*VERSCHACHTELUNGSTIEFE DER PROZEDUR*)
00910 END;
00920
00930 VAR
00940 I, (*SCHLEIFENVARIABLE*)
00950 BUFFLEN, (*LAENGE DES BESCHRIEBENEN TEILS DES EINGABEPUFFERS*)
00960 BUFFMARK, (*LAENGE DES SCHON GEDRUCKTEN TEIL DES PUFFERS*)
00970 BUFFERPTR, (*ZEIGER AUF DAS NAECHSTE ZU LESENDE ZEICHEN IM PUFFER*)
00980 BUFFINDEX, (*ZEIGER IM ARRAY VON BUFF*)
00990 BMARKNR, (*ZU DRUCKENDE NUMMER FUER MARKIERUNG VON 'BEGIN', 'LOOP' ETC.*)
01000 EMARKNR, (*ZU DRUCKENDE NUMMER FUER MARKIERUNG VON 'END', 'UNTIL' ETC.*)
01010 SPACES, (*ZEICHENVORSCHUB FUER DIE FORMATIERUNG*)
01020 LASTSPACES, (*LETZTER BENUTZTER ZEICHENVORSCHUB*)
01030 SYLENG, (*LAENGE DES LETZTEN GELESENEN BEZEICHNERS*)
01040 CHCNT, (*ANZAHL DER RELEVANTEN ZEICHEN IM LETZTEN BEZEICHNER*)
01050 LEVEL, (*VERSCHACHTELUNGSTIEFE DER AKTUELLEN PROZEDUR*)
01060 BLOCKNR, (*ZAEHLT DIE GEKENNZEICHNETEN STATEMENTS*)
01070 PROCDEC, (*GESETZT BEI PROZEDUR DEKLARATION 1=PROCEDURE 2=FUNCTION*)
01080 PAGECNT, (*ZAEHLT DIE SOS-SEITEN*)
01090 PAGECNT2, (*ZAEHLT DIE DRUCKSEITEN PRO SOS-SEITE*)
01100 INCREMENT, (*PARAMETER FUER DIE ERHOEHUNG DER ZEILENNUMMERN*)
01110 MAXINC, (*GROESSTE ERLAUBTE ZEILENNUMMER*)
01120 REALLINCNT, (*ZAEHLT DIE ZEILEN PRO DRUCKSEITE*)
01130 LINECNT : INTEGER; (*ZAEHLT DIE ZEILEN PRO SOS-SEITE*)
01140 NEWFILENAME, FILENAME : PACKED ARRAY [1..9] OF CHAR;
01150 DEVICE : PACKED ARRAY [1..6] OF CHAR;
01160 PPN : INTEGER;
01170 PROT : 0..777B;
01180 BUFF : BUFFTY;
01190 BUFFER : ARRAY [1..147] OF CHAR; (*EINGABEPUFFER (147 ZEICHEN = MAX. LAENGE SOS-ZEILE)*)
01200 LINENB : PACKED ARRAY [1..5] OF CHAR; (*SOS-ZEILENNUMMER*)
01210 DATUM, DAYTIME: ALFA;
01220 SY : WORD; (*LETZTER GELESENER BEZEICHNER*)
01230 SYTY : SYMBOL; (*TYP DES LETZTEN GELESENEN ZEICHENS*)
01240 ERRFLAG, (*FEHLERMARKE*)
01250 OLDSPACES, (*GESETZT WENN LASTSPACES BENUTZT WERDEN SOLL*)
01260 EOB : BOOLEAN; (*EOF-MARKE*)
01270 CH, (*LETZTES GELESENES ZEICHEN*)
01280 BMARKTEXT, (*TEXT ZUR MARKIERUNG VON 'BEGIN' ETC.*)
01290 EMARKTEXT: CHAR; (*TEXT ZUR MARKIERUNG VON 'END' ETC.*)
01300 DELSY : ARRAY [' '..'_'] OF SYMBOL; (*TYPENARRAY FUER DELIMITERZEICHEN*)
01310 RESNUM : ARRAY [1..11] OF INTEGER; (*STARTADRESSEN FUER DIE RESERVIERTEN WORTE BESTIMMTER LAENGE*)
01320 RESLIST : ARRAY [1..44] OF WORD; (*LISTE DER RESERVIERTEN WORTE*)
01330 RESSY : ARRAY [1..44] OF SYMBOL; (*TYPENLISTE DER RESERVIERTEN WORTE*)
01340 ALPHANUM, (*ZEICHEN VON 0..9 UND A..Z*)
01350 DIGITS, (*ZEICHEN VON 0..9*)
01360 LETTERS : SET OF CHAR; (*ZEICHEN VON A..Z*)
01370 RELEVANTSYM, (*STARTSYMBOLE FUER STATEMENTS UND PROCEDURES*)
01380 PROSYM, (*ALLE SYMBOLE DIE DEN BEGINN EINER PROZEDUR KENNZEICHNEN*)
01390 DECSYM, (*ALLE SYMBOLE DIE DEN BEGINN VON DEKLARATIONEN KENNZEICHNEN*)
01400 BEGSYM, (*ALLE SYMBOLE DIE DEN BEGINN EINES STATEMENTS KENNZEICHNEN*)
01410 ENDSYM : SET OF SYMBOL; (*ALLE SYMBOLE DIE STATEMENTS ODER PROZEDUREN TERMINIEREN*)
01420 LISTPTR : LISTPTRTY; (*ZEIGER IM BINAERBAUM DER DEKLARIETEN BEZEICHNER*)
01430 FIRSTNAME : ARRAY ['A'..'Z'] OF LISTPTRTY; (*ZEIGER AUF DIE WURZELN DES BAUMES*)
01440 PROCSTRUCF, (*ZEIGER AUF DAS ERSTE ELEMENT DER PROZEDURENLISTE*)
01450 PROCSTRUCL : PROCSTRUCTY; (*ZEIGER AUF DAS LETZTE ELEMENT DER PROZEDURENLISTE*)
01460 NEWSOURCE : FILE OF INTEGER; (*AUSGABEFILE AUF DEM DAS NEUFORMATIERTE PROGRAMM STEHT*)
01470 OLDSOURCE, CROSSLIST : TEXT;
01480 MESSAGE : PACKED ARRAY [1..23] OF CHAR; (*ARRAY ZUR AUSGABE DER SCHLUSSMELDUNG*)
01490
01500 INITPROCEDURE;
01510
01520 BEGIN
01530 RESNUM[1] := 1;
01540 RESNUM[2] := 1;
01550 RESNUM[3] := 7;
01560 RESNUM[4] :=15;
01570 RESNUM[5] :=26;
01580 RESNUM[6] :=32;
01590 RESNUM[7] :=38;
01600 RESNUM[8] :=42;
01610 RESNUM[9] :=43;
01620 RESNUM[10]:=44;
01630 RESNUM[11]:=45;
01640 RESLIST[ 1] :='IF '; RESSY [ 1] := IFSY; RESLIST[ 2] :='TO '; RESSY [ 2] := OTHERSY;
01650 RESLIST[ 3] :='OF '; RESSY [ 3] := OFSY; RESLIST[ 4] :='IN '; RESSY [ 4] := OTHERSY;
01660 RESLIST[ 5] :='DO '; RESSY [ 5] := DOSY; RESLIST[ 6] :='OR '; RESSY [ 6] := OTHERSY;
01670 RESLIST[ 7] :='END '; RESSY [ 7] := ENDSY; RESLIST[ 8] :='FOR '; RESSY [ 8] := OTHERSY;
01680 RESLIST[ 9] :='SET '; RESSY [ 9] := OTHERSY; RESLIST[10] :='AND '; RESSY [10] := OTHERSY;
01690 RESLIST[11] :='NOT '; RESSY [11] := OTHERSY; RESLIST[12] :='VAR '; RESSY [12] := VARSY;
01700 RESLIST[13] :='NIL '; RESSY [13] := OTHERSY; RESLIST[14] :='DIV '; RESSY [14] := OTHERSY;
01710 RESLIST[15] :='LOOP '; RESSY [15] := LOOPSY; RESLIST[16] :='CHAR '; RESSY [16] := OTHERSY;
01720 RESLIST[17] :='GOTO '; RESSY [17] := OTHERSY; RESLIST[18] :='THEN '; RESSY [18] := THENSY;
01730 RESLIST[19] :='ELSE '; RESSY [19] := ELSESY; RESLIST[20] :='WITH '; RESSY [20] := OTHERSY;
01740 RESLIST[21] :='CASE '; RESSY [21] := CASESY; RESLIST[22] :='REAL '; RESSY [22] := OTHERSY;
01750 RESLIST[23] :='FILE '; RESSY [23] := OTHERSY; RESLIST[24] :='TYPE '; RESSY [24] := TYPESY;
01760 RESLIST[25] :='EXIT '; RESSY [25] := EXITSY; RESLIST[26] :='BEGIN '; RESSY [26] := BEGINSY;
01770 RESLIST[27] :='ARRAY '; RESSY [27] := OTHERSY; RESLIST[28] :='WHILE '; RESSY [28] := OTHERSY;
01780 RESLIST[29] :='CONST '; RESSY [29] := CONSTSY; RESLIST[30] :='LABEL '; RESSY [30] := LABELSY;
01790 RESLIST[31] :='UNTIL '; RESSY [31] := UNTILSY; RESLIST[32] :='RECORD '; RESSY [32] := RECORDSY;
01800 RESLIST[33] :='REPEAT '; RESSY [33] := REPEATSY; RESLIST[34] :='DOWNTO '; RESSY [34] := OTHERSY;
01810 RESLIST[35] :='PACKED '; RESSY [35] := OTHERSY; RESLIST[36] :='OTHERS '; RESSY [36] := OTHERSSY;
01820 RESLIST[37] :='EXTERN '; RESSY [37] := EXTERNSY; RESLIST[38] :='INTEGER '; RESSY [38] := OTHERSY;
01830 RESLIST[39] :='BOOLEAN '; RESSY [39] := OTHERSY; RESLIST[40] :='FORWARD '; RESSY [40] := FORWARDSY;
01840 RESLIST[41] :='FORTRAN '; RESSY [41] := FORTRANSY;
01850 RESLIST[42] :='FUNCTION '; RESSY [42] := FUNCTIONSY;RESLIST[43] :='PROCEDURE '; RESSY [43] := PROCEDURESY;
01860 RESLIST[44] :='INITPROCED'; RESSY [44] := INITPROCSY;
01870 END;
01880
01890 INITPROCEDURE;
01900
01910 BEGIN
01920 I := 0;
01930 BUFFLEN := 0;
01940 BUFFMARK := 0;
01950 BUFFERPTR := 2;
01960 BUFFINDEX := 0;
01970 REALLINCNT:= 0;
01980 LINECNT :=0;
01990 BLOCKNR := 0;
02000 LEVEL := 0;
02010 PAGECNT := 1;
02020 PAGECNT2 := 0;
02030 INCREMENT := 10;
02040 BUFF.INT := 0;
02050 EOB := FALSE;
02060 ERRFLAG := FALSE;
02070 OLDSPACES := FALSE;
02080 CH := ' ';
02090 BMARKTEXT := ' ';
02100 EMARKTEXT := ' ';
02110 SY := ' ';
02120 MESSAGE := 'ERROR IN BLOCKSTRUCTURE';
02130 DIGITS := ['0'..'9'];
02140 LETTERS := ['A'..'Z'];
02150 ALPHANUM := ['0'..'9','A'..'Z'] (*LETTERS OR DIGITS*);
02160 DECSYM := [LABELSY..VARSY];
02170 PROSYM := [FUNCTIONSY..INITPROCSY];
02180 ENDSYM := [FUNCTIONSY..EOBSY]; (*PROSYM OR ENDSYMBOLS*)
02190 BEGSYM := [BEGINSY..IFSY];
02200 RELEVANTSYM := [LABELSY..INITPROCSY (*DECSYM OR PROSYM*) ,BEGINSY,FORWARDSY,FORTRANSY,EXTERNSY,EOBSY];
02210 END;
02220
02230 PROCEDURE INIT;
02240
02250 BEGIN (*INIT*)
02260 FOR CH := 'A' TO 'Z' DO FIRSTNAME [CH] := NIL;
02270 FOR CH := ' ' TO '_' DO DELSY [CH] := OTHERSY;
02280 DELSY ['('] := LPARENT;
02290 DELSY [')'] := RPARENT;
02300 DELSY ['['] := LPARENT;
02310 DELSY [']'] := RPARENT;
02320 DELSY [';'] := SEMICOLON;
02330 DELSY ['.'] := POINT;
02340 DELSY [':'] := COLON;
02350 FOR I := 1 TO 147 DO BUFFER [I] := ' ';
02360 I := 0;
02370 NEW (FIRSTNAME['M']);
02380 LISTPTR := FIRSTNAME ['M'];
02390 WITH FIRSTNAME ['M']^ DO
02400 BEGIN
02410 NAME := 'MAIN. ';
02420 LLINK := NIL;
02430 RLINK := NIL;
02440 NEW (FIRST);
02450 LAST := FIRST;
02460 PROCVAR := 1;
02470 WITH LAST^ DO
02480 BEGIN
02490 LINENR := LINECNT;
02500 CONTLINK := NIL;
02510 END;
02520 NEW (CALLED);
02530 WITH CALLED^ DO
02540 BEGIN
02550 PROCNAME := FIRSTNAME ['M'];
02560 NEXTPROC := NIL;
02570 NEW (FIRST);
02580 FIRST^.LINENR := 0;
02590 FIRST^.CONTLINK := NIL;
02600 LAST := FIRST;
02610 END;
02620 NEW (CALLEDBY);
02630 WITH CALLEDBY^ DO
02640 BEGIN
02650 PROCNAME := FIRSTNAME ['M'];
02660 NEXTPROC := NIL;
02670 NEW (FIRST);
02680 FIRST^.LINENR := 0;
02690 FIRST^.CONTLINK := NIL;
02700 LAST := FIRST;
02710 END;
02720 END;
02730 NEW (PROCSTRUCF);
02740 WITH PROCSTRUCF^ DO
02750 BEGIN
02760 PROCNAME := FIRSTNAME ['M'];
02770 NEXTPROC := NIL;
02780 LINENR := 0;
02790 PROCLEVEL:= 0;
02800 END;
02810 PROCSTRUCL := PROCSTRUCF;
02820 END (*INIT*) ;
02830
02840 PROCEDURE WRITEBUFF;
02850
02860 BEGIN (*WRITEBUFF*)
02870 NEWSOURCE^ := BUFF.INT;
02880 PUT (NEWSOURCE);
02890 BUFF.INT := 0;
02900 BUFFINDEX := 0
02910 END (*WRITEBUFF*);
02920
02930 PROCEDURE WRITECH (FCH : CHAR);
02940
02950 BEGIN (*WRITECH*)
02960 IF BUFFINDEX = 5
02970 THEN WRITEBUFF;
02980 BUFFINDEX := BUFFINDEX + 1;
02990 BUFF.CHARS [BUFFINDEX] := FCH
03000 END (*WRITECH*);
03010
03020 PROCEDURE WRITELIN;
03030
03040 BEGIN (*WRITELIN*)
03050 WRITECH (CHR(CR));
03060 WRITECH (CHR(LF));
03070 WRITEBUFF
03080 END (*WRITELIN*);
03090
03100 PROCEDURE WRITEPAGE;
03110
03120 BEGIN (*WRITEPAGE*)
03130 BUFF.INT := 201004020101B;
03140 WRITEBUFF;
03150 WRITECH (CHR(CR));
03160 WRITECH (CHR(FF));
03170 WRITEBUFF
03180 END (*WRITEPAGE*);
03190
03200 PROCEDURE WRITELINNR;
03210
03220 VAR
03230 I, LLINECNT : INTEGER;
03240
03250 BEGIN (*WRITELINNR*)
03260 LLINECNT := LINECNT * INCREMENT;
03270 I := 10000;
03280 FOR BUFFINDEX := 1 TO 5 DO
03290 BEGIN
03300 BUFF.CHARS [BUFFINDEX] := CHR (LLINECNT DIV I + 60B);
03310 LLINECNT := LLINECNT MOD I;
03320 I := I DIV 10
03330 END;
03340 BUFF.INT := BUFF.INT + 1;
03350 WRITEBUFF;
03360 WRITECH (CHR(HT))
03370 END (*WRITELINNR*);
03380
03390
03400 PROCEDURE HEADER;
03410
03420 BEGIN (*HEADER*)
03430 PAGECNT2 := PAGECNT2 + 1;
03440 REALLINCNT := 0;
03450 PAGE (CROSSLIST);
03460 WRITELN (CROSSLIST,'PAGE ':20,PAGECNT:3,'-',PAGECNT2:3,' ':15,NEWFILENAME:6,'.CRL',' ':5,DATUM,' ':4,DAYTIME);
03470 WRITELN (CROSSLIST);
03480 END (*HEADER*) ;
03490
03500
03510 PROCEDURE NEWPAGE;
03520
03530 BEGIN (*NEWPAGE*)
03540 PAGECNT2 := 0;
03550 PAGECNT := PAGECNT + 1;
03560 WRITEPAGE;
03570 HEADER;
03580 IF EOLN (OLDSOURCE)
03590 THEN READLN (OLDSOURCE);
03600 LINECNT := 0;
03610 REALLINCNT := 0;
03620 END (*NEWPAGE*) ;
03630
03640 PROCEDURE WRITELINE (POSITION (*LETZTES ZU DRUCKENDES ZEICHEN IM PUFFER*) : INTEGER);
03650
03660 VAR
03670 I, TABCNT, LSPACES : INTEGER; (*MARKIERT ERSTES ZU DRUCKENDES ZEICHEN*)
03680
03690 BEGIN (*WRITELINE*)
03700 POSITION := POSITION - 2;
03710 IF POSITION > 0
03720 THEN
03730 BEGIN
03740 I := BUFFMARK + 1;
03750 WHILE (BUFFER [I] = ' ') AND (I <= POSITION) DO I := I + 1;
03760 BUFFMARK := POSITION;
03770 WHILE (BUFFER [POSITION] = ' ') AND (I < POSITION) DO POSITION := POSITION - 1;
03780 IF I <= POSITION
03790 THEN
03800 BEGIN
03810 IF REALLINCNT = MAXLINE
03820 THEN HEADER;
03830 LINECNT := LINECNT + 1;
03840 REALLINCNT := REALLINCNT + 1;
03850 IF BMARKTEXT <> ' '
03860 THEN
03870 BEGIN
03880 WRITE (CROSSLIST,BMARKTEXT, BMARKNR : 4, ' ');
03890 BMARKTEXT := ' ';
03900 END
03910 ELSE
03920 IF EMARKTEXT <> ' '
03930 THEN
03940 BEGIN
03950 WRITE (CROSSLIST,' ',EMARKTEXT,EMARKNR : 4,' ');
03960 EMARKTEXT := ' ';
03970 END
03980 ELSE WRITE (CROSSLIST,' ');
03990 WRITE (CROSSLIST,LINECNT * INCREMENT : 5,' ');
04000 WRITELINNR;
04010 IF NOT OLDSPACES
04020 THEN LASTSPACES := SPACES;
04030 WRITE (CROSSLIST,' ' : LASTSPACES);
04040 TABCNT := LASTSPACES DIV 8;
04050 LSPACES := LASTSPACES MOD 8;
04060 FOR TABCNT := TABCNT DOWNTO 1 DO WRITECH (CHR(HT));
04070 FOR LSPACES := LSPACES DOWNTO 1 DO WRITECH (' ');
04080 IF (POSITION - I + LASTSPACES + 1) > MAXCH
04090 THEN
04100 BEGIN
04110 IF REALLINCNT = MAXLINE
04120 THEN
04130 BEGIN
04140 FOR I := I TO MAXCH + I - LASTSPACES - 1 DO
04150 BEGIN
04160 WRITE (CROSSLIST,BUFFER[I]);
04170 WRITECH (BUFFER[I]);
04180 BUFFER [I] := ' ';
04190 END;
04200 WRITELN (CROSSLIST);
04210 HEADER;
04220 END;
04230 REALLINCNT := REALLINCNT + 1;
04240 END;
04250 FOR I := I TO POSITION DO
04260 BEGIN
04270 WRITE (CROSSLIST,BUFFER [I]);
04280 WRITECH (BUFFER[I]);
04290 BUFFER [I] := ' ';
04300 END;
04310 WRITELIN;
04320 WRITELN (CROSSLIST);
04330 IF ((LINENB = ' ') AND (POSITION = BUFFLEN)) OR (MAXINC = LINECNT)
04340 THEN NEWPAGE;
04350 END;
04360 END;
04370 LASTSPACES := SPACES;
04380 OLDSPACES := FALSE;
04390 END (*WRITELINE*) ;
04400
04410 PROCEDURE BLOCK;
04420
04430 VAR
04440 DOUBLEDECF, (*ZEIGER AUF ERSTE UND LETZTE VARIABLE DIE ALS PROCEDURE*)
04450 DOUBLEDECL : ^DOUBLEDEC; (*IN DIESEM BLOCK DOPPELT DEKLARIERT WURDEN*)
04460 CURPROC : LISTPTRTY; (*ZEIGER AUF DIE PROZEDUR IN DEREN ANWEISUNGSTEIL DAS PROGRAMM SICH BEFINDET*)
04470
04480 PROCEDURE INSYMBOL ;
04490 LABEL
04500 1;
04510
04520 VAR
04530 OLDSPACESMARK, (*ALTER ZEICHENVORSCHUB BEI FORMATIERUNG VON KOMMENTAREN*)
04540 I : INTEGER;
04550 OLDSYTY: SYMBOL;
04560
04570 PROCEDURE READBUFFER;
04580
04590
04600 PROCEDURE READLINE;
04610
04620 VAR
04630 CH : CHAR;
04640
04650 BEGIN (*READLINE*)
04660 REPEAT
04670 WHILE EOLN (OLDSOURCE) AND NOT (EOF (OLDSOURCE)) DO
04680 BEGIN
04690 GETLINENR (LINENB);
04700 READLN (OLDSOURCE);
04710 IF LINENB = ' '
04720 THEN NEWPAGE
04730 ELSE
04740 BEGIN
04750 IF REALLINCNT = MAXLINE
04760 THEN HEADER;
04770 LINECNT := LINECNT + 1;
04780 REALLINCNT := REALLINCNT + 1;
04790 WRITELN (CROSSLIST,' ' : 12,LINECNT * INCREMENT : 5);
04800 WRITELINNR;
04810 WRITELIN;
04820 IF MAXINC = LINECNT
04830 THEN NEWPAGE;
04840 END;
04850 END;
04860 READ (OLDSOURCE,CH);
04870 UNTIL (CH <> ' ') OR (EOF (OLDSOURCE));
04880 BUFFLEN := 0;
04890 LOOP
04900 BUFFLEN := BUFFLEN + 1;
04910 BUFFER [BUFFLEN] := CH;
04920 EXIT IF (EOLN (OLDSOURCE) OR (BUFFLEN = 147));
04930 READ (OLDSOURCE,CH);
04940 END;
04950 IF NOT (EOLN (OLDSOURCE))
04960 THEN
04970 BEGIN
04980 WRITELN (TTY);
04990 WRITELN (TTY,'LINE ',(LINECNT+1)*INCREMENT : 5,'TOO LONG');
05000 WRITELN (CROSSLIST,' ' : 17,' **** NEXT LINE TOO LONG ****');
05010 END
05020 ELSE
05030 IF NOT (EOF (OLDSOURCE))
05040 THEN
05050 BEGIN
05060 GETLINENR (LINENB);
05070 READLN (OLDSOURCE);
05080 END;
05090 BUFFERPTR := 1;
05100 BUFFMARK := 0;
05110 END (*READLINE*) ;
05120 BEGIN (*READBUFFER*)
05130 IF BUFFERPTR = BUFFLEN + 2
05140 THEN
05150 BEGIN
05160 WRITELINE (BUFFERPTR);
05170 CH := ' ';
05180 IF EOF (OLDSOURCE)
05190 THEN EOB := TRUE
05200 ELSE READLINE;
05210 END
05220 ELSE
05230 BEGIN
05240 CH := BUFFER [BUFFERPTR];
05250 BUFFERPTR := BUFFERPTR + 1;
05260 END;
05270 END (*READBUFFER*) ;
05280
05290
05300 PROCEDURE PARENTHESE;
05310
05320 VAR
05330 OLDSPACESMARK : INTEGER; (*ALTER ZEICHENVORSCHUB BEI FORMATIERUNG VON KLAMMERN*)
05340
05350 BEGIN (*PARENTHESE*)
05360 OLDSPACESMARK := SPACES;
05370 IF OLDSPACES
05380 THEN SPACES := LASTSPACES + BUFFERPTR - 2
05390 ELSE
05400 BEGIN
05410 LASTSPACES := SPACES;
05420 SPACES := SPACES + BUFFERPTR - 2;
05430 OLDSPACES := TRUE;
05440 END;
05450 REPEAT
05460 INSYMBOL
05470 UNTIL SYTY IN [RPARENT,EOBSY];
05480 SPACES := OLDSPACESMARK;
05490 OLDSPACES := TRUE;
05500 INSYMBOL;
05510 END (*PARENTHESE*) ;
05520
05530
05540 FUNCTION RESWORD: BOOLEAN ;
05550 LABEL
05560 1;
05570
05580 VAR
05590 I : INTEGER;
05600
05610 BEGIN (*RESWORD*)
05620 RESWORD:= FALSE;
05630 FOR I:=RESNUM[CHCNT] TO RESNUM [CHCNT + 1] -1 DO
05640 IF RESLIST[ I ] = SY
05650 THEN
05660 BEGIN
05670 RESWORD := TRUE;
05680 SYTY := RESSY [I];
05690 GOTO 1;
05700 END;
05710 1:
05720 END (*RESWORD*) ;
05730 PROCEDURE FINDNAME;
05740 LABEL
05750 1;
05760
05770 VAR
05780 PROCPTR : PROCCALLTY; (*ZEIGER AUF RUFENDE BZW. GERUFENE PROZEDUR BEI DEREN VERKETTUNG*)
05790 LPTR: LISTPTRTY; (*ZEIGER AUF DEN VORGAENGER IM BAUM*)
05800 ZPTR : LINEPTRTY; (*ZEIGER AUF DIE VORLETZTE ZEILENNUMMER IN EINER KETTE*)
05810 RIGHT: BOOLEAN; (*MERKVARIABLE FUER DIE VERZWEIGUNG IM BAUM*)
05820 INDEXCH : CHAR; (*INDEXVARIABLE FUER DAS FELD DER STARTZEIGER (FIRSTNAME)*)
05830
05840
05850 PROCEDURE FINDPROC (COMP : LISTPTRTY);
05860
05870 VAR
05880 PROCCALLPTR : PROCCALLTY; (*MERK SICH LETZTE PROZEDUR FALLS EINE NEUE ERZEUGT WERDEN MUSS*)
05890
05900 BEGIN (*FINDPROC*)
05910 WHILE (PROCPTR^.PROCNAME <> COMP) AND (PROCPTR^.NEXTPROC <> NIL) DO
05920 PROCPTR := PROCPTR^.NEXTPROC;
05930 IF PROCPTR^.PROCNAME = COMP
05940 THEN
05950 BEGIN
05960 ZPTR := PROCPTR^.LAST;
05970 NEW (PROCPTR^.LAST);
05980 WITH PROCPTR^.LAST^ DO
05990 BEGIN
06000 LINENR := LINECNT + 1;
06010 PAGENR := PAGECNT;
06020 CONTLINK := NIL;
06030 END;
06040 ZPTR^.CONTLINK := PROCPTR^.LAST;
06050 END
06060 ELSE
06070 BEGIN
06080 PROCCALLPTR := PROCPTR;
06090 NEW (PROCPTR);
06100 WITH PROCPTR^ DO
06110 BEGIN
06120 PROCNAME := COMP;
06130 NEXTPROC := NIL;
06140 ZPTR := FIRST;
06150 NEW (FIRST);
06160 WITH FIRST^ DO
06170 BEGIN
06180 LINENR := LINECNT + 1;
06190 PAGENR := PAGECNT;
06200 CONTLINK := NIL;
06210 END;
06220 ZPTR^.CONTLINK := FIRST;
06230 LAST := FIRST;
06240 END;
06250 PROCCALLPTR^.NEXTPROC := PROCPTR;
06260 END;
06270 END (*FINDPROC*) ;
06280 PROCEDURE NEWPROCEDURE;
06290
06300 BEGIN (*NEWPROCEDURE*)
06310 WITH LISTPTR^ DO
06320 BEGIN
06330 PROCVAR := PROCDEC;
06340 NEW (CALLEDBY);
06350 WITH CALLEDBY^ DO
06360 BEGIN
06370 PROCNAME := CURPROC;
06380 NEXTPROC := NIL;
06390 ZPTR := FIRST;
06400 NEW (FIRST);
06410 WITH FIRST^ DO
06420 BEGIN
06430 LINENR := LINECNT + 1;
06440 PAGENR := PAGECNT;
06450 CONTLINK := NIL;
06460 END;
06470 ZPTR^.CONTLINK := FIRST;
06480 LAST := FIRST;
06490 END;
06500 NEW (CALLED);
06510 WITH CALLED^ DO
06520 BEGIN
06530 PROCNAME := FIRSTNAME ['M'];
06540 NEXTPROC := NIL;
06550 ZPTR := FIRST;
06560 NEW (FIRST);
06570 WITH FIRST^ DO
06580 BEGIN
06590 LINENR := LINECNT + 1;
06600 PAGENR := PAGECNT;
06610 CONTLINK := NIL;
06620 END;
06630 ZPTR^.CONTLINK := FIRST;
06640 LAST := FIRST;
06650 END;
06660 END;
06670 NEW (PROCSTRUCL^.NEXTPROC);
06680 PROCSTRUCL := PROCSTRUCL^.NEXTPROC;
06690 WITH PROCSTRUCL^ DO
06700 BEGIN
06710 PROCNAME := LISTPTR;
06720 NEXTPROC := NIL;
06730 LINENR := LINECNT + 1;
06740 PAGENR := PAGECNT;
06750 PROCLEVEL := LEVEL;
06760 END;
06770 END (*NEWPROCEDURE*) ;
06780 BEGIN (*FINDNAME*)
06790 INDEXCH := SY [1];
06800 LISTPTR := FIRSTNAME [INDEXCH];
06810 WHILE LISTPTR <> NIL DO
06820 BEGIN
06830 LPTR:= LISTPTR;
06840 IF SY = LISTPTR^.NAME
06850 THEN
06860 BEGIN
06870 ZPTR := LISTPTR^.LAST;
06880 NEW (LISTPTR^.LAST);
06890 WITH LISTPTR^.LAST^ DO
06900 BEGIN
06910 LINENR := LINECNT + 1;
06920 PAGENR := PAGECNT;
06930 CONTLINK := NIL;
06940 END;
06950 ZPTR^.CONTLINK := LISTPTR^.LAST;
06960 IF LISTPTR^.PROCVAR <> 0
06970 THEN
06980 BEGIN
06990 IF LISTPTR^.PROCVAR = 2
07000 THEN WHILE CH = ' ' DO
07010 BEGIN
07020 SYLENG := SYLENG + 1;
07030 READBUFFER;
07040 END;
07050 IF (CH <> ':') OR (LISTPTR^.PROCVAR = 1)
07060 THEN
07070 BEGIN
07080 PROCPTR := LISTPTR^.CALLEDBY;
07090 FINDPROC (CURPROC);
07100 PROCPTR := CURPROC^.CALLED;
07110 FINDPROC (LISTPTR);
07120 END
07130 END
07140 ELSE
07150 IF PROCDEC <> 0
07160 THEN
07170 BEGIN
07180 IF DOUBLEDECF = NIL
07190 THEN
07200 BEGIN
07210 NEW (DOUBLEDECF);
07220 DOUBLEDECL := DOUBLEDECF;
07230 END
07240 ELSE
07250 BEGIN
07260 NEW (DOUBLEDECL^.NEXTPROC);
07270 DOUBLEDECL := DOUBLEDECL^.NEXTPROC;
07280 END;
07290 DOUBLEDECL^.NEXTPROC := NIL;
07300 DOUBLEDECL^.PROCORT := LISTPTR;
07310 NEWPROCEDURE;
07320 END;
07330 GOTO 1;
07340 END
07350 ELSE
07360 IF SY > LISTPTR^.NAME
07370 THEN
07380 BEGIN
07390 LISTPTR:= LISTPTR^.RLINK;
07400 RIGHT:= TRUE;
07410 END
07420 ELSE
07430 BEGIN
07440 LISTPTR:= LISTPTR^.LLINK;
07450 RIGHT:= FALSE;
07460 END;
07470 END;
07480 NEW (LISTPTR);
07490 WITH LISTPTR^ DO
07500 BEGIN
07510 NAME := SY;
07520 LLINK := NIL;
07530 RLINK := NIL;
07540 END;
07550 IF FIRSTNAME [INDEXCH] = NIL
07560 THEN FIRSTNAME [INDEXCH] := LISTPTR
07570 ELSE
07580 IF RIGHT
07590 THEN LPTR^.RLINK := LISTPTR
07600 ELSE LPTR^.LLINK := LISTPTR;
07610 WITH LISTPTR^ DO
07620 BEGIN
07630 NEW (FIRST);
07640 WITH FIRST^ DO
07650 BEGIN
07660 LINENR := LINECNT + 1;
07670 PAGENR := PAGECNT;
07680 CONTLINK := NIL;
07690 END;
07700 LAST := FIRST ;
07710 IF PROCDEC = 0
07720 THEN
07730 BEGIN
07740 PROCVAR := 0;
07750 CALLED := NIL;
07760 CALLEDBY := NIL;
07770 END
07780 ELSE NEWPROCEDURE;
07790 END;
07800 1:
07810 PROCDEC := 0;
07820 END (*FINDNAME*) ;
07830
07840
07850 PROCEDURE FINDCOMMENT;
07860 LABEL
07870 1;
07880 VAR
07890 C: CHAR;
07900 I: INTEGER;
07910 FOUND: BOOLEAN;
07920 BEGIN
07930 I:= BUFFERPTR - 1;
07940 C:= ' ';
07950 FOUND := FALSE;
07960 WHILE (C=' ') AND (I<BUFFLEN) DO
07970 BEGIN
07980 C:= BUFFER[I];
07990 IF (C='%') OR (C='(') AND (BUFFER[I+1]='*')
08000 THEN
08010 BEGIN
08020 FOUND := TRUE;
08030 GOTO 1;
08040 END;
08050 I:= I + 1;
08060 END;
08070
08080 1:
08090 IF FOUND
08100 THEN
08110 BEGIN
08120 WHILE (CH<>'%') AND (CH<>'(') DO READBUFFER;
08130 IF CH = '%'
08140 THEN
08150 REPEAT
08160 READBUFFER
08170 UNTIL (CH='\') OR EOB
08180 ELSE
08190 REPEAT
08200 READBUFFER
08210 UNTIL (CH=')') AND (BUFFER[BUFFERPTR-2]='*') OR EOB;
08220 READBUFFER;
08230 END;
08240 END;
08250
08260 BEGIN (*INSYMBOL*)
08270 SYLENG := 0;
08280 WHILE (CH IN ['_','(',' ','%','$','?','\','!','@']) AND NOT EOB DO
08290 BEGIN
08300 IF (CH = '%') OR (CH = '(') AND (BUFFER[BUFFERPTR] = '*')
08310 THEN
08320 BEGIN
08330 OLDSPACESMARK := SPACES;
08340 IF OLDSPACES
08350 THEN SPACES := LASTSPACES
08360 ELSE LASTSPACES := SPACES;
08370 SPACES := SPACES + BUFFERPTR - 1;
08380 OLDSPACES := TRUE;
08390 IF CH = '%'
08400 THEN
08410 REPEAT
08420 READBUFFER;
08430 UNTIL (CH = '\') OR EOB
08440 ELSE
08450 REPEAT
08460 READBUFFER
08470 UNTIL (CH = ')') AND (BUFFER[BUFFERPTR-2] = '*') OR EOB;
08480 SPACES := OLDSPACESMARK;
08490 OLDSPACES := TRUE;
08500 END
08510 ELSE
08520 IF CH = '('
08530 THEN GOTO 1;
08540 READBUFFER;
08550 END;
08560 IF CH = ''''
08570 THEN
08580 BEGIN
08590 SYTY := STRGCONST;
08600 REPEAT
08610 READBUFFER;
08620 UNTIL (CH = '''') OR EOB;
08630 READBUFFER;
08640 END
08650 ELSE
08660 IF CH IN LETTERS
08670 THEN
08680 BEGIN
08690 SYLENG := 0;
08700 REPEAT
08710 SYLENG := SYLENG + 1;
08720 IF SYLENG <= 10
08730 THEN SY [SYLENG] := CH;
08740 READBUFFER;
08750 UNTIL NOT (CH IN (ALPHANUM + ['_']));
08760 FOR I := SYLENG + 1 TO 10 DO SY [I] := ' ';
08770 IF SYLENG > 10
08780 THEN CHCNT := 10
08790 ELSE CHCNT := SYLENG;
08800 IF NOT RESWORD
08810 THEN
08820 BEGIN
08830 SYTY := IDENT ;
08840 FINDNAME;
08850 END
08860 END
08870 ELSE
08880 IF CH IN DIGITS
08890 THEN
08900 BEGIN
08910 REPEAT
08920 READBUFFER;
08930 UNTIL NOT (CH IN DIGITS);
08940 SYTY := INTCONST;
08950 IF CH = 'B'
08960 THEN READBUFFER
08970 ELSE
08980 BEGIN
08990 IF CH = '.'
09000 THEN
09010 BEGIN
09020 REPEAT
09030 READBUFFER
09040 UNTIL NOT (CH IN DIGITS);
09050 SYTY := OTHERSY;
09060 END;
09070 IF CH = 'E'
09080 THEN
09090 BEGIN
09100 READBUFFER;
09110 IF CH IN ['+','-']
09120 THEN READBUFFER;
09130 WHILE CH IN DIGITS DO READBUFFER;
09140 SYTY := OTHERSY;
09150 END;
09160 END;
09170 END
09180 ELSE
09190 IF CH = '"'
09200 THEN
09210 BEGIN
09220 REPEAT
09230 READBUFFER
09240 UNTIL NOT (CH IN (DIGITS + ['A'..'F']));
09250 SYTY := INTCONST;
09260 END
09270 ELSE
09280 IF CH <> ' '
09290 THEN
09300 BEGIN
09310 1
09320 :
09330 OLDSYTY := SYTY;
09340 SYTY := DELSY [CH];
09350 READBUFFER;
09360 IF (OLDSYTY=ENDSY) AND (SYTY=SEMICOLON)
09370 THEN FINDCOMMENT;
09380 IF SYTY = LPARENT
09390 THEN PARENTHESE
09400 ELSE
09410 IF (SYTY = COLON) AND (CH = '=')
09420 THEN
09430 BEGIN
09440 SYTY := OTHERSY;
09450 READBUFFER;
09460 END;
09470 END
09480 ELSE SYTY := EOBSY;
09490 END (*INSYMBOL*) ;
09500
09510 PROCEDURE RECDEF;
09520
09530 VAR
09540 OLDSPACESMARK : INTEGER; (*ALTER ZEICHENVORSCHUB BEI FORMATIERUNG VON RECORDS*)
09550
09560
09570 PROCEDURE CASEDEF;
09580
09590 VAR
09600 OLDSPACESMARK : INTEGER; (*ALTER ZEICHENVORSCHUB BEI FORMATIERUNG VON VARIANT PARTS*)
09610
09620
09630 PROCEDURE PARENTHESE;
09640
09650 VAR
09660 OLDSPACESMARK : INTEGER; (*ALTER ZEICHENVORSCHUB BEI FORMATIERUNG VON KLAMMERN INNERHALB VON VARIANT PARTS*)
09670
09680 BEGIN (*PARENTHESE*)
09690 OLDSPACESMARK := SPACES;
09700 IF OLDSPACES
09710 THEN SPACES := LASTSPACES
09720 ELSE LASTSPACES := SPACES;
09730 SPACES := SPACES + BUFFERPTR - 2;
09740 OLDSPACES := TRUE;
09750 REPEAT
09760 INSYMBOL;
09770 CASE SYTY OF
09780 LBRACK :
09790 PARENTHESE;
09800 CASESY :
09810 CASEDEF;
09820 RECORDSY :
09830 RECDEF
09840 END;
09850 UNTIL SYTY IN [RPARENT,EOBSY];
09860 SPACES := OLDSPACESMARK;
09870 OLDSPACES := TRUE;
09880 INSYMBOL;
09890 END (*PARENTHESE*) ;
09900
09910
09920 BEGIN (*CASEDEF*)
09930 DELSY ['('] := LBRACK;
09940 OLDSPACESMARK := SPACES;
09950 IF OLDSPACES
09960 THEN SPACES := LASTSPACES
09970 ELSE LASTSPACES := SPACES;
09980 SPACES := BUFFERPTR - BUFFMARK + SPACES - SYLENG + 3;
09990 OLDSPACES := TRUE;
10000 REPEAT
10010 INSYMBOL ;
10020 CASE SYTY OF
10030 LBRACK :
10040 PARENTHESE;
10050 CASESY :
10060 CASEDEF;
10070 RECORDSY:
10080 RECDEF
10090 END;
10100 UNTIL SYTY IN [ENDSY,RPARENT,EOBSY];
10110 SPACES := OLDSPACESMARK;
10120 DELSY ['('] := LPARENT;
10130 END (*CASEDEF*) ;
10140
10150 BEGIN (*RECDEF*)
10160 OLDSPACESMARK := SPACES;
10170 SPACES := BUFFERPTR - BUFFMARK + SPACES - SYLENG - 2 + FEED;
10180 OLDSPACES := TRUE;
10190 INSYMBOL;
10200 WRITELINE ( BUFFERPTR-SYLENG);
10210 REPEAT
10220 CASE SYTY OF
10230 CASESY :
10240 CASEDEF;
10250 RECORDSY :
10260 RECDEF;
10270 OTHERS :
10280 INSYMBOL
10290 END;
10300 UNTIL SYTY IN [ENDSY,EOBSY];
10310 WRITELINE (BUFFERPTR-SYLENG);
10320 OLDSPACES := TRUE;
10330 LASTSPACES := SPACES - FEED;
10340 SPACES := OLDSPACESMARK;
10350 INSYMBOL;
10360 END (*RECDEF*) ;
10370
10380 PROCEDURE ERROR (ERRNR : INTEGER);
10390
10400 BEGIN (*ERROR*)
10410 ERRFLAG := TRUE;
10420 WRITELINE (BUFFERPTR);
10430 WRITE (CROSSLIST,' ':17,' **** ');
10440 CASE ERRNR OF
10450 1 :
10460 WRITELN (CROSSLIST,SY,' ? ? ? ',MESSAGE);
10470 2 :
10480 WRITELN (CROSSLIST,'MISSING ''END'' OR ''UNTIL'' NUMBER ',EMARKNR : 4);
10490 3 :
10500 WRITELN (CROSSLIST,'MISSING ''THEN'' NUMBER ',EMARKNR : 4);
10510 4 :
10520 WRITELN (CROSSLIST,'MISSING ''OF'' TO ''CASE'' NUMBER ',BMARKNR : 4);
10530 5 :
10540 WRITELN (CROSSLIST,' ONLY ONE ''EXIT'' ALLOWED');
10550 6 :
10560 WRITELN (CROSSLIST,'MISSING ''EXIT'' IN ''LOOP'' ',EMARKNR : 4)
10570 END;
10580 END (*ERROR*) ;
10590
10600 PROCEDURE STATEMENT (IFFLAG : BOOLEAN);
10610
10620 VAR
10630 CURBLOCKNR : INTEGER; (*AKTUELLE BLOCKNUMMER*)
10640
10650
10660
10670 PROCEDURE COMPSTAT;
10680
10690 BEGIN (*COMPSTAT*)
10700 BMARKTEXT := 'B';
10710 OLDSPACES := TRUE;
10720 LASTSPACES := SPACES - BACKFEED;
10730 INSYMBOL;
10740 WRITELINE (BUFFERPTR-SYLENG);
10750 LOOP
10760 REPEAT
10770 STATEMENT (FALSE);
10780 UNTIL SYTY IN ENDSYM;
10790 EXIT IF SYTY IN [ENDSY,EOBSY,PROCEDURESY,FUNCTIONSY];
10800 ERROR (1);
10810 INSYMBOL ;
10820 END;
10830 WRITELINE (BUFFERPTR-SYLENG);
10840 EMARKTEXT := 'E';
10850 EMARKNR := CURBLOCKNR;
10860 LASTSPACES := SPACES-BACKFEED;
10870 OLDSPACES := TRUE;
10880 IF SYTY = ENDSY
10890 THEN
10900 BEGIN
10910 INSYMBOL ;
10920 WRITELINE (BUFFERPTR-SYLENG);
10930 END
10940 ELSE ERROR (2);
10950 END (*COMPSTAT*) ;
10960
10970 PROCEDURE CASESTAT;
10980
10990 VAR
11000 OLDSPACESMARK : INTEGER; (*ALTER ZEICHENVORSCHUB BEI FORMATIERUNG VON CASE-STATEMENTS*)
11010
11020 BEGIN (*CASESTAT*)
11030 BMARKTEXT := 'C';
11040 OLDSPACES := TRUE;
11050 LASTSPACES := SPACES-BACKFEED;
11060 INSYMBOL;
11070 STATEMENT (FALSE);
11080 IF SYTY = OFSY
11090 THEN WRITELINE (BUFFERPTR)
11100 ELSE ERROR (3);
11110 LOOP
11120 REPEAT
11130 REPEAT
11140 INSYMBOL ;
11150 UNTIL SYTY IN (ENDSYM + [COLON]);
11160 IF SYTY = COLON
11170 THEN
11180 BEGIN
11190 OLDSPACESMARK := SPACES;
11200 LASTSPACES := SPACES;
11210 SPACES := OLDSPACESMARK + CASEFEED;
11220 OLDSPACES := TRUE;
11230 INSYMBOL;
11240 IF NOT ( SYTY IN BEGSYM )
11250 THEN
11260 BEGIN
11270 WRITELINE ( BUFFERPTR - SYLENG );
11280 SPACES := SPACES +1;
11290 END;
11300 STATEMENT (FALSE);
11310 SPACES := OLDSPACESMARK;
11320 END;
11330 UNTIL SYTY IN ENDSYM;
11340 EXIT IF SYTY IN [ENDSY,EOBSY,PROCEDURESY,FUNCTIONSY];
11350 ERROR (1);
11360 END;
11370 WRITELINE (BUFFERPTR-SYLENG);
11380 EMARKTEXT := 'E';
11390 EMARKNR := CURBLOCKNR;
11400 LASTSPACES := SPACES-BACKFEED;
11410 OLDSPACES := TRUE;
11420 IF SYTY = ENDSY
11430 THEN
11440 BEGIN
11450 INSYMBOL ;
11460 WRITELINE (BUFFERPTR-SYLENG);
11470 END
11480 ELSE ERROR (2);
11490 END (*CASESTAT*) ;
11500
11510 PROCEDURE LOOPSTAT;
11520
11530 VAR
11540 LOOPFLAG : BOOLEAN; (*GESETZT BEIM AUFTRETEN VON EXIT-STATEMENTS*)
11550
11560 BEGIN (*LOOPSTAT*)
11570 BMARKTEXT := 'L';
11580 OLDSPACES := TRUE;
11590 LASTSPACES := SPACES - BACKFEED;
11600 INSYMBOL;
11610 WRITELINE (BUFFERPTR-SYLENG);
11620 LOOPFLAG := FALSE;
11630 LOOP
11640 REPEAT
11650 STATEMENT (FALSE);
11660 IF SYTY = EXITSY
11670 THEN
11680 BEGIN
11690 WRITELINE (BUFFERPTR-SYLENG);
11700 IF LOOPFLAG
11710 THEN ERROR (5);
11720 OLDSPACES := TRUE;
11730 LASTSPACES := SPACES-BACKFEED;
11740 LOOPFLAG := TRUE;
11750 EMARKTEXT := 'X';
11760 EMARKNR := CURBLOCKNR;
11770 INSYMBOL; INSYMBOL;
11780 END;
11790 UNTIL SYTY IN ENDSYM;
11800 EXIT IF SYTY IN [ENDSY,EOBSY,PROCEDURESY,FUNCTIONSY];
11810 ERROR (1);
11820 INSYMBOL ;
11830 END;
11840 WRITELINE (BUFFERPTR-SYLENG);
11850 EMARKTEXT := 'E';
11860 EMARKNR := CURBLOCKNR;
11870 LASTSPACES := SPACES-BACKFEED;
11880 OLDSPACES := TRUE;
11890 IF SYTY = ENDSY
11900 THEN
11910 BEGIN
11920 INSYMBOL ;
11930 WRITELINE (BUFFERPTR-SYLENG);
11940 END
11950 ELSE ERROR (2);
11960 IF NOT LOOPFLAG
11970 THEN ERROR (6);
11980 END (*LOOPSTAT*) ;
11990
12000 PROCEDURE IFSTAT (IFVAR : BOOLEAN);
12010
12020 BEGIN (*IFSTAT*)
12030 BMARKTEXT := 'I';
12040 IF NOT IFVAR
12050 THEN
12060 BEGIN
12070 SPACES := SPACES - FEED; LASTSPACES := SPACES
12080 END
12090 ELSE LASTSPACES := SPACES - BACKFEED;
12100 OLDSPACES := TRUE;
12110 INSYMBOL;
12120 STATEMENT (FALSE);
12130 IF SYTY = THENSY
12140 THEN
12150 BEGIN
12160 WRITELINE (BUFFERPTR-SYLENG);
12170 IF IFVAR
12180 THEN LASTSPACES := SPACES - BACKFEED
12190 ELSE LASTSPACES := SPACES;
12200 OLDSPACES := TRUE;
12210 EMARKTEXT := 'T';
12220 EMARKNR := CURBLOCKNR;
12230 INSYMBOL;
12240 STATEMENT (TRUE);
12250 END
12260 ELSE ERROR (4);
12270 IF SYTY = ELSESY
12280 THEN
12290 BEGIN
12300 WRITELINE (BUFFERPTR-SYLENG);
12310 EMARKTEXT := 'S';
12320 EMARKNR := CURBLOCKNR;
12330 IF IFVAR
12340 THEN LASTSPACES := SPACES - BACKFEED
12350 ELSE LASTSPACES := SPACES;
12360 OLDSPACES := TRUE;
12370 INSYMBOL;
12380 STATEMENT (TRUE);
12390 END;
12400 IF NOT IFVAR
12410 THEN SPACES := SPACES + FEED
12420 END (*IFSTAT*) ;
12430
12440
12450 PROCEDURE LABELSTAT;
12460
12470 BEGIN (*LABELSTAT*)
12480 LASTSPACES := 0;
12490 OLDSPACES := TRUE;
12500 INSYMBOL;
12510 WRITELINE (BUFFERPTR-SYLENG);
12520 END (*LABELSTAT*) ;
12530
12540 PROCEDURE REPEATSTAT;
12550
12560 BEGIN (*REPEATSTAT*)
12570 BMARKTEXT := 'R';
12580 OLDSPACES := TRUE;
12590 LASTSPACES := SPACES - BACKFEED;
12600 INSYMBOL ;
12610 WRITELINE (BUFFERPTR-SYLENG);
12620 LOOP
12630 REPEAT
12640 STATEMENT (FALSE);
12650 UNTIL SYTY IN ENDSYM;
12660 EXIT IF SYTY IN [UNTILSY,EOBSY,PROCEDURESY,FUNCTIONSY];
12670 ERROR (1);
12680 INSYMBOL ;
12690 END;
12700 WRITELINE (BUFFERPTR-SYLENG);
12710 EMARKTEXT := 'U';
12720 EMARKNR := CURBLOCKNR;
12730 OLDSPACES := TRUE;
12740 LASTSPACES := SPACES-BACKFEED;
12750 IF SYTY = UNTILSY
12760 THEN
12770 BEGIN
12780 INSYMBOL;
12790 STATEMENT (FALSE);
12800 END
12810 ELSE ERROR (2);
12820 END (*REPEATSTAT*) ;
12830
12840
12850 BEGIN (*STATEMENT*)
12860 IF SYTY = INTCONST
12870 THEN
12880 BEGIN
12890 INSYMBOL;
12900 IF SYTY = COLON
12910 THEN LABELSTAT;
12920 END;
12930 IF SYTY IN BEGSYM
12940 THEN
12950 BEGIN
12960 BLOCKNR := BLOCKNR + 1;
12970 CURBLOCKNR := BLOCKNR;
12980 BMARKNR := CURBLOCKNR;
12990 WRITELINE (BUFFERPTR-SYLENG);
13000 SPACES := SPACES + FEED;
13010 CASE SYTY OF
13020 BEGINSY :
13030 COMPSTAT;
13040 LOOPSY :
13050 LOOPSTAT;
13060 CASESY :
13070 CASESTAT;
13080 IFSY :
13090 IFSTAT (IFFLAG);
13100 REPEATSY :
13110 REPEATSTAT
13120 END;
13130 SPACES := SPACES - FEED;
13140 END
13150 ELSE WHILE NOT (SYTY IN ([SEMICOLON] + ENDSYM)) DO INSYMBOL;
13160 IF SYTY = SEMICOLON
13170 THEN INSYMBOL
13180 ELSE
13190 IF SYTY = DOSY
13200 THEN
13210 BEGIN
13220 INSYMBOL;
13230 STATEMENT (FALSE);
13240 END;
13250 END (*STATEMENT*) ;
13260
13270 BEGIN (*BLOCK*)
13280 DOUBLEDECF := NIL;
13290 LEVEL := LEVEL + 1;
13300 CURPROC := LISTPTR;
13310 SPACES := LEVEL * FEED;
13320 REPEAT
13330 INSYMBOL
13340 UNTIL (SYTY IN RELEVANTSYM);
13350 WHILE SYTY IN DECSYM DO
13360 BEGIN
13370 WRITELINE (BUFFERPTR-SYLENG);
13380 SPACES := SPACES - FEED;
13390 WRITELINE (BUFFERPTR);
13400 SPACES := SPACES + FEED;
13410 REPEAT
13420 INSYMBOL ;
13430 IF SYTY = RECORDSY
13440 THEN RECDEF;
13450 UNTIL SYTY IN RELEVANTSYM;
13460 END;
13470 WHILE SYTY IN PROSYM DO
13480 BEGIN
13490 WRITELINE (BUFFERPTR-SYLENG);
13500 OLDSPACES := TRUE;
13510 IF SYTY <> INITPROCSY
13520 THEN
13530 BEGIN
13540 IF SYTY = PROCEDURESY
13550 THEN PROCDEC := 1
13560 ELSE PROCDEC := 2;
13570 INSYMBOL;
13580 END;
13590 BLOCK;
13600 IF SYTY = SEMICOLON
13610 THEN INSYMBOL;
13620 END;
13630 LEVEL := LEVEL - 1;
13640 SPACES := LEVEL * FEED;
13650 IF NOT (SYTY IN [BEGINSY,FORWARDSY,EXTERNSY,FORTRANSY])
13660 THEN
13670 BEGIN
13680 ERROR (1);
13690 WHILE NOT (SYTY IN [BEGINSY,FORWARDSY,EXTERNSY,FORTRANSY,EOBSY]) DO INSYMBOL
13700 END;
13710 IF SYTY = BEGINSY
13720 THEN STATEMENT (FALSE)
13730 ELSE
13740 BEGIN
13750 INSYMBOL ;
13760 IF SYTY = FORTRANSY
13770 THEN INSYMBOL ;
13780 END ;
13790 IF DOUBLEDECF <> NIL
13800 THEN
13810 REPEAT
13820 DOUBLEDECF^.PROCORT^.PROCVAR := 0;
13830 DOUBLEDECF := DOUBLEDECF^.NEXTPROC;
13840 UNTIL DOUBLEDECF = NIL;
13850 IF LEVEL = 0
13860 THEN
13870 BEGIN
13880 IF SYTY <> POINT
13890 THEN
13900 BEGIN
13910 WRITELN (TTY,'MISSING POINT AT PROGRAM END');
13920 WRITELN (TTY);
13930 WRITELN (CROSSLIST,' ' : 17, ' **** MISSING POINT AT PROGRAM END ****');
13940 INSYMBOL;
13950 END;
13960 IF SYTY <> EOBSY
13970 THEN
13980 REPEAT
13990 INSYMBOL
14000 UNTIL SYTY = EOBSY;
14010 END;
14020 END (*BLOCK*) ;
14030
14040 PROCEDURE PRINTLISTE;
14050
14060 VAR
14070 FIRSTPROC,LASTPROC, (*ZEIGER ZUM DURCHHANGELN DURCH DIE BAEUME UND LISTEN BEIM AUSDRUCKEN*)
14080 PRED : LISTPTRTY;
14090 INDEXCH : CHAR; (*LAUFVARIABLE FUER DAS FELD 'FIRSTNAME' ZUM AUSDRUCKEN*)
14100
14110
14120
14130 PROCEDURE WRITELINENR (SPACES : INTEGER);
14140
14150 VAR
14160 LINK : LINEPTRTY; (*ZEIGER ZUM DURCHHANGELN DURCH DIE VERKETTUNG DER ZEILENNUMMERN*)
14170 COUNT : INTEGER; (*ZAEHLT DIE GEDRUCKTEN ZEILENNUMMERN PRO ZEILE*)
14180
14190 BEGIN (*WRITELINENR*)
14200 COUNT := 0;
14210 LINK := LISTPTR^.FIRST;
14220 REPEAT
14230 IF COUNT = 8
14240 THEN
14250 BEGIN
14260 WRITELN (CROSSLIST);
14270 WRITE (CROSSLIST,' ' : SPACES);
14280 COUNT := 0;
14290 END;
14300 COUNT := COUNT + 1;
14310 WRITE (CROSSLIST,LINK^.LINENR * INCREMENT : 6,'/',LINK^.PAGENR : 3,' ' : 3);
14320 LINK := LINK^.CONTLINK;
14330 UNTIL LINK = NIL;
14340 END (*WRITELINENR*) ;
14350
14360 BEGIN (*PRINTLISTE*)
14370 FIRSTPROC := NIL;
14380 LASTPROC := NIL;
14390 WITH FIRSTNAME ['M']^ DO
14400 IF RLINK = NIL
14410 THEN FIRSTNAME ['M'] := LLINK
14420 ELSE
14430 BEGIN
14440 LISTPTR := RLINK;
14450 WHILE LISTPTR^.LLINK <> NIL DO LISTPTR := LISTPTR^.LLINK;
14460 LISTPTR^.LLINK := LLINK;
14470 FIRSTNAME ['M'] := RLINK;
14480 END;
14490 INDEXCH := 'A';
14500 WHILE (INDEXCH < 'Z') AND (FIRSTNAME [INDEXCH] = NIL) DO INDEXCH := SUCC (INDEXCH);
14510 IF FIRSTNAME [INDEXCH] <> NIL
14520 THEN
14530 BEGIN
14540 PAGE (CROSSLIST);
14550 WRITELN (CROSSLIST,'CROSSREFERENZLISTE DER BEZEICHNER');
14560 WRITELN (CROSSLIST,'*********************************');
14570 FOR INDEXCH := INDEXCH TO 'Z' DO
14580 WHILE FIRSTNAME [INDEXCH] <> NIL DO
14590 BEGIN
14600 LISTPTR := FIRSTNAME [INDEXCH];
14610 WHILE LISTPTR^.LLINK <> NIL DO
14620 BEGIN
14630 PRED := LISTPTR;
14640 LISTPTR := LISTPTR^.LLINK;
14650 END;
14660 IF LISTPTR = FIRSTNAME [INDEXCH]
14670 THEN FIRSTNAME [INDEXCH] := LISTPTR^.RLINK
14680 ELSE PRED^.LLINK := LISTPTR^.RLINK;
14690 IF LISTPTR^.CALLED <> NIL
14700 THEN
14710 BEGIN
14720 IF FIRSTPROC = NIL
14730 THEN
14740 BEGIN
14750 FIRSTPROC := LISTPTR;
14760 LASTPROC := FIRSTPROC;
14770 LASTPROC^.CALLED^.PROCNAME := NIL;
14780 END
14790 ELSE
14800 BEGIN
14810 LASTPROC^.CALLED^.PROCNAME := LISTPTR;
14820 LASTPROC := LISTPTR;
14830 END;
14840 END;
14850 WRITELN (CROSSLIST);
14860 WRITE (CROSSLIST,LISTPTR^.NAME : 11);
14870 WRITELINENR (11);
14880 END;
14890 IF FIRSTPROC <> NIL
14900 THEN
14910 BEGIN
14920 PAGE (CROSSLIST);
14930 WRITELN (CROSSLIST,'LISTE DER GEGENSEITIGEN PROZEDURAUFRUFE');
14940 WRITELN (CROSSLIST,'***************************************');
14950 LASTPROC^.CALLED^.PROCNAME := NIL;
14960 LASTPROC := FIRSTPROC;
14970 WHILE LASTPROC <> NIL DO
14980 BEGIN
14990 LISTPTR :=LASTPROC;
15000 WRITELN (CROSSLIST);WRITELN (CROSSLIST);
15010 WRITE (CROSSLIST,LASTPROC^.NAME:11, ' WIRD AUFGERUFEN VON :');
15020 WITH LASTPROC^ DO
15030 REPEAT
15040 WRITELN (CROSSLIST);
15050 WRITE (CROSSLIST,' ' : 11,CALLEDBY^.PROCNAME^.NAME:11);
15060 LISTPTR^.FIRST := CALLEDBY^.FIRST;
15070 WRITELINENR (22);
15080 CALLEDBY := CALLEDBY^.NEXTPROC;
15090 UNTIL CALLEDBY = NIL;
15100 WRITELN (CROSSLIST); WRITELN (CROSSLIST);
15110 IF LASTPROC^.CALLED^.NEXTPROC <> NIL
15120 THEN
15130 BEGIN
15140 WRITE (CROSSLIST,' ' : 11, ' UND RUFT AUF :');
15150 WITH LASTPROC^.CALLED^ DO
15160 REPEAT
15170 WRITELN (CROSSLIST);
15180 WRITE (CROSSLIST,' ' : 11,NEXTPROC^.PROCNAME^.NAME:11);
15190 LISTPTR^.FIRST := NEXTPROC^.FIRST;
15200 WRITELINENR (22);
15210 NEXTPROC := NEXTPROC^.NEXTPROC;
15220 UNTIL NEXTPROC = NIL;
15230 END;
15240 LASTPROC := LASTPROC^.CALLED^.PROCNAME;
15250 END;
15260 PAGE (CROSSLIST);
15270 WRITELN (CROSSLIST,'LISTE DER PROZEDURVERSCHACHTELUNGEN');
15280 WRITELN (CROSSLIST,'***********************************');
15290 PROCSTRUCL := PROCSTRUCF;
15300 REPEAT
15310 WRITELN (CROSSLIST);
15320 WITH PROCSTRUCL^ DO
15330 WRITE (CROSSLIST,' ':PROCLEVEL*3,PROCNAME^.NAME : 11,LINENR * INCREMENT : 6,'/',PAGENR : 3);
15340 PROCSTRUCL := PROCSTRUCL^.NEXTPROC;
15350 UNTIL PROCSTRUCL = NIL;
15360 END;
15370 END;
15380 END (*PRINTLISTE*) ;
15390
15400
15410 BEGIN (*MAIN*)
15420 INIT;
15430 GETSTATUS(OLDSOURCE,FILENAME,PROT,PPN,DEVICE);
15440 GETSTATUS(NEWSOURCE,NEWFILENAME,PROT,PPN,DEVICE);
15450 WRITELN (TTY);
15460 WRITELN (TTY,VERSION:5,': ',FILENAME:6);
15470 WRITELN (TTY);
15480 BREAK(TTY);
15490 MAXINC := 99999 DIV INCREMENT ;
15500 IF MAXINC > 4000
15510 THEN MAXINC := 4000;
15520 CH := ' ';
15530 DATE(DATUM); TIME(DAYTIME);
15540 HEADER;
15550 BLOCK;
15560 WRITELINE (BUFFLEN+2);
15570 IF NOT ERRFLAG
15580 THEN WRITE (TTY,'NO ');
15590 WRITELN (TTY,MESSAGE);
15600 BREAK(TTY);
15610 PRINTLISTE;
15630 IF OPTION('LINK ')
15640 THEN
15645 BEGIN
15647 WRITELN(TTY); BREAK(TTY);
15648 CALL('LINK ','SYS ')
15649 END
15650 END (*MAIN*) .