home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol097 / cross.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  19.1 KB  |  567 lines

  1. PROGRAM CROSS;{$l-}{$E-}{$T-}{$C-}
  2.   (*******************************************************************
  3.    *
  4.    *
  5.    *   PROGRAM ZUR ERSTELLUNG EINER CROSS-REFERENCE LISTE
  6.    *   UND EINER NEU FORMATTIERTEN VERSION EINES PASCAL
  7.    *   PROGRAMS.
  8.    *
  9.    *   EINGABE: PASCAL QUELL-FILE
  10.    *   AUSGABE: NEU FORMATTIERTER QUELL-FILE UND
  11.    *            CROSS-REFERENCE LISTE
  12.    *
  13.    *   AUTHOR:  MANUEL MALL (1974)
  14.    *
  15.    *
  16.    *******************************************************************)
  17. {  PROGRAM CROSS( OLDSOURCE, NEWSOURCE, CROSSLIST,OUTPUT);}
  18. CONST
  19.   VERSION='Version  11-Jun-81';
  20.   Big_Line=MaxInt;
  21.   First_Char='$';Last_Char='_';
  22.   CASEFEED = 6;    (*ZEICHENVORSCHUB BEI CASE*)
  23.   ID_LENGTH=10;
  24.   Num_Reserved_Words=47;
  25.   {%E}
  26. TYPE
  27.   CHAR2=PACKED ARRAY[1..2]OF CHAR;
  28.   LINE_PTR_TY = ^LINE;
  29.   LIST_PTR_TY = ^LIST;
  30.   PROC_CALL_TYPE = ^PROCCALL;
  31.   PROC_STRUC_TYPE = ^PROCSTRUC;
  32.   LINENRTY = 0..32000;          (* ALLOW ALL THE LINE NUMBERS *)
  33.   PAGENRTY = 0..255;            (* ALLOW LARGE NUMBER OF PAGES *)
  34.   WORD    = PACKED ARRAY [1..10] OF CHAR;
  35.   SYMBOL = (LABELSY,CONSTSY,TYPESY,VARSY,
  36.             { 0        1       2      3 }
  37.             (*DECSYM*)
  38.             FUNCT_SY,PROC_SY,INITPROCSY,Sub_Program,  (*PROSYM*)
  39.             { 4        5       6            7 }
  40.          ENDSY,UNTILSY,ELSESY,THENSY,EXITSY,OFSY,DOSY,EOBSY, (*ENDSYMBOLS*)
  41.             { 8   9         10     11    12    13   14   15 }
  42.             BEGINSY,CASESY,LOOPSY,REPEATSY,IFSY,           (*BEGSYM*)
  43.             { 16     17    18      19       20 }
  44.     RECORDSY,FORWARDSY,OTHERSY,INTCONST,IDENT,STRGCONST,EXTERNSY,FORTRANSY,
  45.             RPARENT,SEMICOLON,POINT,LPARENT,COLON,LBRACK,OTHERSSY,
  46.             Other_Wise
  47.             (*DELIMITER*));
  48.   LINE = PACKED RECORD
  49.                   (*BESCHREIBUNG DER ZEILENNUMMERN*)
  50.                   LINENR : LINENRTY;            (*ZEILENNUMMER*)
  51.                   PAGENR : PAGENRTY;            (*SEITENNUMMER*)
  52.           CONTLINK : LINE_PTR_TY          (*NAECHSTER ZEILENNUMMERNRECORD*)
  53.                 END;
  54.   LIST = PACKED RECORD
  55.                   (*BESCHREIBUNG VON IDENTIFIERN*)
  56.                   NAME : WORD;                  (*NAME DES IDENTIFIERS*)
  57.                 LLINK ,                       (*LINKER NACHFOLGER IN BAUM*)
  58.              RLINK : LIST_PTR_TY;            (*RECHTER NACHFOLGER IM BAUM*)
  59.     FIRST ,                       (*ZEIGER AUF ERSTEN ZEILENNUMMERNRECORD*)
  60.  LAST  : LINE_PTR_TY;            (*ZEIGER AUF LETZTEN ZEILENNUMMERNRECORD*)
  61.  PROCVAR : 0..2;               (*0=KEINE PROZEDUR/ 1=PROZEDUR/ 2=FUNKTION*)
  62.                   CALLED,
  63.               (*ZEIGER AUF DIE ERSTE PROZEDUR DIE VON DIESER GERUFEN WIRD*)
  64.     CALLEDBY : PROC_CALL_TYPE         (*ZEIGER AUF ERSTE RUFENDE PROZEDUR*)
  65.                 END;
  66.   {%E}
  67.   PROCCALL = PACKED RECORD
  68.                       (*BESCHREIBUNG VON PROZEDURAUFRUFEN*)
  69.                       PROCNAME : LIST_PTR_TY;
  70.                       (*ZEIGER AUF DEN ZUGEHOERIGEN IDENTIFIERRECORD*)
  71.          NEXTPROC : PROC_CALL_TYPE;    (*ZEIGER AUF DIE NAECHSTE PROZEDUR*)
  72.                       FIRST,
  73.                       (*ZEILENNUMMERNRECORD FUER DEN ERSTEN AUFRUF*)
  74.                       LAST : LINE_PTR_TY
  75.                       (*ZEILENNUMMERNRECORD FUER DEN LETZTEN AUFRUF*)
  76.                     END;
  77.   DBL_DEC = PACKED RECORD
  78.                    (*PROZEDUREN DIE AUCH ALS NORMALE ID. DEFINIERT WURDEN*)
  79.                      PROCORT : LIST_PTR_TY;     (*ZEIGER AUF DIE PROZEDUR*)
  80.          NEXTPROC: ^DBL_DEC     (*NAECHSTE DOPPELT DEKLARIERTE PROZEDUR*)
  81.                      END;
  82. Dbl_Ptr=^Dbl_Dec;
  83.   PROCSTRUC = PACKED RECORD
  84.                        (*BESCHREIBUNG DER PROZEDURVERSCHACHTELUNG*)
  85.      PROCNAME : LIST_PTR_TY;    (*ZEIGER AUF DEN ZUGERHOERIGEN IDENTIFIER*)
  86.                        NEXTPROC : PROC_STRUC_TYPE;
  87.                        (*ZEIGER AUF DIE NAECHSTD DEKLARIERTE PROZEDUR*)
  88.            LINENR : LINENRTY;       (*ZEILENNUMMER DER PROZEDURDEFINITION*)
  89.            PAGENR ,                 (*SEITENNUMMER DER PROZEDURDEFINITION*)
  90.             PROCLEVEL: PAGENRTY      (*VERSCHACHTELUNGSTIEFE DER PROZEDUR*)
  91.                      END;
  92.   ALFA=PACKED ARRAY[1..ID_LENGTH]OF CHAR;
  93.   Char8=Packed Array[1..8]Of Char;
  94.   {%E}
  95. VAR
  96.   INPUT,OUTPUT:TEXT;
  97.   MaxCh:Integer;MaxLine:Integer;
  98.   RightMargin:Integer;{Do not put text past this margin}
  99.   Bump,Nasty:Boolean;{Bump=True if we bumped into the right margin}
  100.   {Nasty=True if we had to go past the margin}
  101.   FEED,BACKFEED:INTEGER;                         (* INDENT SIZES *)
  102.   I,                                    (*SCHLEIFENVARIABLE*)
  103.   BUFFLEN,
  104.   (*LAENGE DES BESCHRIEBENEN TEILS DES EINGABEPUFFERS*)
  105.   BUFFMARK,
  106.   (*LAENGE DES SCHON GEDRUCKTEN TEIL DES PUFFERS*)
  107.   BUFFERPTR,
  108.   (*ZEIGER AUF DAS NAECHSTE ZU LESENDE ZEICHEN IM PUFFER*)
  109.   BUFFINDEX,                            (*ZEIGER IM ARRAY VON BUFF*)
  110.   BMARKNR,
  111.   (*ZU DRUCKENDE NUMMER FUER MARKIERUNG VON 'BEGIN', 'LOOP' ETC.*)
  112.   EMARKNR,
  113.   (*ZU DRUCKENDE NUMMER FUER MARKIERUNG VON 'END', 'UNTIL' ETC.*)
  114.   SPACES,
  115.   (*ZEICHENVORSCHUB FUER DIE FORMATIERUNG*)
  116. LASTSPACES,                           (*LETZTER BENUTZTER ZEICHENVORSCHUB*)
  117.   SYLENG,
  118.   (*LAENGE DES LETZTEN GELESENEN BEZEICHNERS*)
  119.   CHCNT,
  120.   (*ANZAHL DER RELEVANTEN ZEICHEN IM LETZTEN BEZEICHNER*)
  121.   LEVEL,
  122.   (*VERSCHACHTELUNGSTIEFE DER AKTUELLEN PROZEDUR*)
  123.   BLOCKNR,
  124.   (*ZAEHLT DIE GEKENNZEICHNETEN STATEMENTS*)
  125.   PROCDEC,
  126.   (*GESETZT BEI PROZEDUR DEKLARATION 1=PROCEDURE 2=FUNCTION*)
  127.   PAGECNT,                              (*ZAEHLT DIE SOS-SEITEN*)
  128.   PAGECNT2,
  129.   (*ZAEHLT DIE DRUCKSEITEN PRO SOS-SEITE*)
  130.   INCREMENT,
  131.   (*PARAMETER FUER DIE ERHOEHUNG DER ZEILENNUMMERN*)
  132.   MAXINC,                               (*GROESSTE ERLAUBTE ZEILENNUMMER*)
  133.   REALLINCNT,                         (*ZAEHLT DIE ZEILEN PRO DRUCKSEITE*)
  134.   LINECNT : INTEGER;                    (*ZAEHLT DIE ZEILEN PRO SOS-SEITE*)
  135.   BUFFER  : ARRAY [1..147] OF CHAR;
  136.   (*EINGABEPUFFER (147 ZEICHEN = MAX. LAENGE SOS-ZEILE)*)
  137.   DATUM, DAYTIME: Char8;
  138.   {%E}
  139.   SY      : WORD;                       (*LETZTER GELESENER BEZEICHNER*)
  140.   SYTY    : SYMBOL;                (*TYP DES LETZTEN GELESENEN ZEICHENS*)
  141.   ERRFLAG,                              (*FEHLERMARKE*)
  142.   OLDSPACES,
  143.   (*GESETZT WENN LASTSPACES BENUTZT WERDEN SOLL*)
  144.   EOB     : BOOLEAN;                    (*EOF-MARKE*)
  145.   CH,                                   (*LETZTES GELESENES ZEICHEN*)
  146.   BMARKTEXT,
  147.   (*TEXT ZUR MARKIERUNG VON 'BEGIN' ETC.*)
  148.   EMARKTEXT: CHAR;                  (*TEXT ZUR MARKIERUNG VON 'END' ETC.*)
  149.   DELSY : ARRAY [' '..'_'] OF SYMBOL;(*TYPENARRAY FUER DELIMITERZEICHEN*)
  150.   RESNUM  : ARRAY [1..11] OF INTEGER;
  151.   (*STARTADRESSEN FUER DIE RESERVIERTEN WORTE BESTIMMTER LAENGE*)
  152.   RESLIST : ARRAY [1..Num_Reserved_Words] OF WORD;
  153.   RESSY   : ARRAY [1..Num_Reserved_Words] OF SYMBOL;
  154.   ALPHANUM,                             (*ZEICHEN VON 0..9 UND A..Z*)
  155.   DIGITS,                               (*ZEICHEN VON 0..9*)
  156.   LETTERS : SET OF CHAR;                (*ZEICHEN VON A..Z*)
  157.   RELEVANTSYM,
  158.   (*STARTSYMBOLE FUER STATEMENTS UND PROCEDURES*)
  159.   PROSYM,
  160.   (*ALLE SYMBOLE DIE DEN BEGINN EINER PROZEDUR KENNZEICHNEN*)
  161.   DECSYM,
  162.   (*ALLE SYMBOLE DIE DEN BEGINN VON DEKLARATIONEN KENNZEICHNEN*)
  163.   BEGSYM,
  164.   (*ALLE SYMBOLE DIE DEN BEGINN EINES STATEMENTS KENNZEICHNEN*)
  165.   ENDSYM  : SET OF SYMBOL;
  166.   (*ALLE SYMBOLE DIE STATEMENTS ODER PROZEDUREN TERMINIEREN*)
  167.   LISTPTR : LIST_PTR_TY;
  168.   (*ZEIGER IM BINAERBAUM DER DEKLARIETEN BEZEICHNER*)
  169.   FIRSTNAME : ARRAY [First_Char..Last_Char] OF LIST_PTR_TY;
  170.   (*ZEIGER AUF DIE WURZELN DES BAUMES*)
  171.   PROC_CF,
  172.   (*ZEIGER AUF DAS ERSTE ELEMENT DER PROZEDURENLISTE*)
  173.   PROC_CL : PROC_STRUC_TYPE;
  174.   (*ZEIGER AUF DAS LETZTE ELEMENT DER PROZEDURENLISTE*)
  175.   NEWSOURCE : TEXT;
  176.   (*AUSGABEFILE AUF DEM DAS NEUFORMATIERTE PROGRAMM STEHT*)
  177.   OLDSOURCE, CROSSLIST : TEXT;
  178.   MESSAGE : PACKED ARRAY [1..23] OF CHAR;
  179.   (*ARRAY ZUR AUSGABE DER SCHLUSSMELDUNG*)
  180.   No_Main:Boolean;{True if no main program }
  181.   {%E}
  182. Function GetSize:Integer;External;
  183. Procedure Init_P3;External;
  184. Procedure Init;External;
  185. Procedure Init_Proc;External;
  186.   {%E}
  187.   Function Hack_EolN(Var F:Text):Boolean;
  188.   Begin
  189.     If Eof(F)
  190.       Then Hack_Eol:=True
  191.       Else Hack_Eol:=Eoln(F);
  192.   End;
  193.   PROCEDURE WRITECH (FCH : CHAR);
  194.   BEGIN (*WRITECH*)
  195.     WRITE(NEWSOURCE,FCH);
  196.   END (*WRITECH*);
  197.   PROCEDURE WRITELIN;
  198.   BEGIN (*WRITELIN*)
  199.     WRITELN(NEWSOURCE);
  200.   END (*WRITELIN*);
  201.   PROCEDURE WRITEPAGE;
  202.   BEGIN (*WRITEPAGE*)
  203.     {TAKEN CARE OF IN THE OPTIONS ALREADY}
  204.   END (*WRITEPAGE*);
  205.   PROCEDURE WRITE_LINE_NUMBER;
  206.   VAR
  207.     I, LLINECNT : INTEGER;
  208.   BEGIN (*WRITE_LINE_NUMBER*)
  209.     LLINECNT := LINECNT * INCREMENT;
  210.   END (*WRITE_LINE_NUMBER*);
  211. Procedure Page(Var Where:Text);
  212. Begin
  213.   Write(Where,Chr(12));
  214. End;
  215.  
  216.   PROCEDURE HEADER;
  217.   BEGIN (*HEADER*)
  218.     PAGECNT2 := PAGECNT2 + 1;
  219.     REALLINCNT := 0;
  220.     PAGE (CROSSLIST);
  221.     WRITELN (CROSSLIST,'Page ':20,PAGECNT:3,'-',PAGECNT2:3
  222.              ,' ':15,' ':5,DATUM,' ':4,DAYTIME);
  223.     WRITELN (CROSSLIST);
  224.   END (*HEADER*) ;
  225.   PROCEDURE NEWPAGE;
  226.   BEGIN (*NEWPAGE*)
  227.     PAGECNT2 := 0;
  228.     PAGECNT := PAGECNT + 1;
  229.     WRITEPAGE;
  230.     HEADER;
  231.     IF (HACK_EOLN (OLDSOURCE))AND(NOT EOF(OLDSOURCE))
  232.       THEN READLN (OLDSOURCE);
  233.   END (*NEWPAGE*) ;
  234.   {%E}
  235.   PROCEDURE WR_LINE (POSITION
  236.                     (*LETZTES ZU DRUCKENDES ZEICHEN IM PUFFER*) : INTEGER);
  237.   VAR
  238.     I, COL, LSPACES : INTEGER;    (*MARKIERT ERSTES ZU DRUCKENDES ZEICHEN*)
  239.   BEGIN (*WR_LINE*)
  240.     POSITION := POSITION - 2;
  241.     IF POSITION > 0
  242.       THEN
  243.         BEGIN
  244.           I := BUFFMARK + 1;
  245.           WHILE (BUFFER [I] = ' ') AND (I <= POSITION) DO I := I + 1;
  246.           BUFFMARK := POSITION;
  247.           WHILE (BUFFER [POSITION] = ' ') AND
  248.           (I < POSITION) DO POSITION := POSITION - 1;
  249.           IF I <= POSITION
  250.             THEN
  251.               BEGIN
  252.                 IF REALLINCNT = MAXLINE
  253.                   THEN HEADER;
  254.                 LINECNT := LINECNT + 1;
  255.                 REALLINCNT := REALLINCNT + 1;
  256.                 IF BMARKTEXT <> ' '
  257.                   THEN
  258.                     BEGIN
  259.                       WRITE (CROSSLIST,BMARKTEXT, BMARKNR : 4, '       ');
  260.                       BMARKTEXT := ' ';
  261.                     END
  262.                   ELSE
  263.                     IF EMARKTEXT <> ' '
  264.                       THEN
  265.                         BEGIN
  266.                       WRITE (CROSSLIST,'      ',EMARKTEXT,EMARKNR : 4,' ');
  267.                           EMARKTEXT := ' ';
  268.                         END
  269.                       ELSE WRITE (CROSSLIST,'            ');
  270.                 WRITE (CROSSLIST,LINECNT * INCREMENT : 5,' ');
  271.                 COL:=18;{18 FOR STUFF AT THE BEGINNING OF THE LINE }
  272.                 WRITE_LINE_NUMBER;
  273.                 IF NOT OLDSPACES
  274.                   THEN LASTSPACES := SPACES;
  275.                 LSPACES := LASTSPACES;
  276.                 If(Position-I+Lspaces+1)>=RightMargin
  277.                   Then
  278.                     Begin
  279.                       Lspaces:=RightMargin-(Position-I+1);
  280.                       Bump:=True;
  281.                       If Lspaces<0
  282.                         Then Nasty:=True;
  283.                     End;
  284.                     {%E}
  285.                 FOR LSPACES := LSPACES DOWNTO 1 DO
  286.                 WriteCh(' ');
  287.                 For LSpaces:=1 To LastSpaces Do
  288.                 Begin
  289.                   Write(CrossList,' ');
  290.                   Col:=Col+1;
  291.                   If Col=MaxCh
  292.                     Then
  293.                       Begin
  294.                         Col:=18;
  295.                         Writeln(CrossList);
  296.                         Write(CrossList,' ':18);
  297.                         RealLinCnt:=RealLinCnt+1;
  298.                       End;
  299.                 End;
  300.                 FOR I := I TO POSITION DO
  301.                 BEGIN
  302.                   WRITE (CROSSLIST,BUFFER [I]);
  303.                   Col:=Col+1;
  304.                   If Col=MaxCh
  305.                     Then
  306.                       Begin
  307.                         Col:=18;
  308.                         Writeln(CrossList);
  309.                         Write(CrossList,' ':18);
  310.                         RealLinCnt:=RealLinCnt+1;
  311.                       End;
  312.  
  313.                   WRITECH (BUFFER[I]);
  314.                   BUFFER [I] := ' ';
  315.                 END;
  316.                 WRITELIN;
  317.                 WRITELN (CROSSLIST);
  318.                 IF  (MAXINC = LINECNT)
  319.                   THEN NEWPAGE;
  320.               END;
  321.         END;
  322.     LASTSPACES := SPACES;
  323.     OLDSPACES := FALSE;
  324.   END (*WR_LINE*) ;
  325.   {%E}
  326. PROCEDURE INSYMBOL(Var DBL_DECF,Dbl_DecL:Dbl_Ptr;
  327. VAR CURPROC:LIST_PTR_TY);
  328. EXTERNAL;
  329. Procedure Block;External;
  330.   {%E}
  331.   PROCEDURE PRINTLISTE;
  332.   VAR
  333.     FIRSTPROC,LASTPROC,
  334.     (*ZEIGER ZUM DURCHHANGELN DURCH DIE BAEUME UND LISTEN BEIM AUSDRUCKEN*)
  335.     PRED : LIST_PTR_TY;
  336.     INDEXCH : CHAR;
  337.     Col:Integer;
  338.     (*LAUFVARIABLE FUER DAS FELD 'FIRSTNAME' ZUM AUSDRUCKEN*)
  339.     LineCounter:Integer; {Count of the lines on the page}
  340.     Procedure List_Page;
  341.     Begin
  342.       LineCounter:=0;
  343.       Page(CrossList);
  344.     End;
  345.     Procedure List_Eol;
  346.     Begin
  347.       Writeln(CrossList);
  348.       LineCounter:=LineCounter+1;
  349.       If LineCounter=MaxLine
  350.         Then List_Page;
  351.       Col:=1;
  352.     End;
  353.     Procedure Write_N3(N:Integer);
  354.     Begin
  355.       If N>=100
  356.         Then Write(CrossList,N:3)
  357.         Else
  358.           If N>=10
  359.             Then
  360.               Write(CrossList,N:2,' ')
  361.             Else Write(CrossList,N:1,'  ');
  362.     End;
  363.     PROCEDURE WR_LINENR (SPACES : INTEGER);
  364.     VAR
  365.       LINK : LINE_PTR_TY;
  366.       (*ZEIGER ZUM DURCHHANGELN DURCH DIE VERKETTUNG DER ZEILENNUMMERN*)
  367.     BEGIN (*WR_LINENR*)
  368.       LINK := LISTPTR^.FIRST;
  369.       Col:=Spaces+1;
  370.       REPEAT
  371.         IF (Col+13)>MaxCh
  372.           THEN
  373.             BEGIN
  374.               List_Eol;
  375.               WRITE (CROSSLIST,' ' : SPACES);
  376.               Col:=Spaces+1;
  377.             END;
  378.         WRITE (CROSSLIST,LINK^.LINENR*INCREMENT:6,'/');
  379.         Write_N3(Link^.PageNr);Write(CrossList,' ':3);
  380.         COL:=COL+13;
  381.         LINK := LINK^.CONTLINK;
  382.       UNTIL LINK = NIL;
  383.     END (*WR_LINENR*) ;
  384.     {%E}
  385.   BEGIN (*PRINTLISTE*)
  386.     FIRSTPROC := NIL;
  387.     LASTPROC := NIL;
  388.     WITH FIRSTNAME ['M']^ DO
  389.     IF RLINK = NIL
  390.       THEN FIRSTNAME ['M'] := LLINK
  391.       ELSE
  392.         BEGIN
  393.           LISTPTR := RLINK;
  394.           WHILE LISTPTR^.LLINK <> NIL DO LISTPTR := LISTPTR^.LLINK;
  395.           LISTPTR^.LLINK := LLINK;
  396.           FIRSTNAME ['M'] := RLINK;
  397.         END;
  398.     INDEXCH := First_Char;
  399.     WHILE (INDEXCH < Last_Char) AND (FIRSTNAME [INDEXCH] = NIL)
  400.     DO INDEXCH := SUCC (INDEXCH);
  401.     IF FIRSTNAME [INDEXCH] <> NIL
  402.       THEN
  403.         BEGIN
  404.           List_page;
  405.           WRITE (CROSSLIST,'Cross listing of identifiers');
  406.           List_Eol;
  407.           WRITE (CROSSLIST,'****************************');
  408.           List_Eol;
  409.           FOR INDEXCH := INDEXCH TO Last_Char DO
  410.           WHILE FIRSTNAME [INDEXCH] <> NIL DO
  411.           BEGIN
  412.             LISTPTR := FIRSTNAME [INDEXCH];
  413.             WHILE LISTPTR^.LLINK <> NIL DO
  414.             BEGIN
  415.               PRED := LISTPTR;
  416.               LISTPTR := LISTPTR^.LLINK;
  417.             END;
  418.             IF LISTPTR = FIRSTNAME [INDEXCH]
  419.               THEN FIRSTNAME [INDEXCH] := LISTPTR^.RLINK
  420.               ELSE PRED^.LLINK := LISTPTR^.RLINK;
  421.             IF LISTPTR^.CALLED <> NIL
  422.               THEN
  423.                 BEGIN
  424.                   IF FIRSTPROC = NIL
  425.                     THEN
  426.                       BEGIN
  427.                         FIRSTPROC := LISTPTR;
  428.                         LASTPROC := FIRSTPROC;
  429.                         LASTPROC^.CALLED^.PROCNAME := NIL;
  430.                       END
  431.                     ELSE
  432.                       BEGIN
  433.                         LASTPROC^.CALLED^.PROCNAME := LISTPTR;
  434.                         LASTPROC := LISTPTR;
  435.                       END;
  436.                 END;
  437.                 {%E}
  438.             List_Eol;
  439.             WRITE (CROSSLIST,LISTPTR^.NAME : 11);
  440.             WR_LINENR (11);
  441.           END;
  442.           IF FIRSTPROC <> NIL
  443.             THEN
  444.               BEGIN
  445.                 List_Page;
  446.                 WRITE(CROSSLIST,'Cross listing of routines');
  447.                 List_Eol;
  448.                 WRITE(CROSSLIST,'*************************');
  449.                 List_Eol;
  450.                 LASTPROC^.CALLED^.PROCNAME := NIL;
  451.                 LASTPROC := FIRSTPROC;
  452.                 WHILE LASTPROC <> NIL DO
  453.                 BEGIN
  454.                   LISTPTR :=LASTPROC;
  455.                   List_Eol;List_Eol;
  456.                   WRITE (CROSSLIST,LASTPROC^.NAME:11, ' Is called from:');
  457.                   WITH LASTPROC^ DO
  458.                   REPEAT
  459.                     List_Eol;
  460.                     WRITE (CROSSLIST,' ' : 11,CALLEDBY^.PROCNAME^.NAME:11);
  461.                     LISTPTR^.FIRST := CALLEDBY^.FIRST;
  462.                     WR_LINENR (22);
  463.                     CALLEDBY := CALLEDBY^.NEXTPROC;
  464.                   UNTIL CALLEDBY = NIL;
  465.                   List_Eol;List_Eol;
  466.                   IF LASTPROC^.CALLED^.NEXTPROC <> NIL
  467.                     THEN
  468.                       BEGIN
  469.                         WRITE (CROSSLIST,' ' : 11, ' Calls:');
  470.                         WITH LASTPROC^.CALLED^ DO
  471.                         REPEAT
  472.                           List_Eol;
  473.                     WRITE (CROSSLIST,' ' : 11,NEXTPROC^.PROCNAME^.NAME:11);
  474.                           LISTPTR^.FIRST := NEXTPROC^.FIRST;
  475.                           WR_LINENR (22);
  476.                           NEXTPROC := NEXTPROC^.NEXTPROC;
  477.                         UNTIL NEXTPROC = NIL;
  478.                       END;
  479.                   LASTPROC := LASTPROC^.CALLED^.PROCNAME;
  480.                 END;
  481.                 List_Page;
  482.                 WRITE(CROSSLIST,'Procedure Nesting ');List_Eol;
  483.                 WRITE(CROSSLIST,'******************');List_Eol;
  484.                 PROC_CL := PROC_CF;
  485.                 REPEAT
  486.                   List_Eol;
  487.                   WITH PROC_CL^ DO
  488.                   WRITE (CROSSLIST,' ':PROCLEVEL*3,PROCNAME^.NAME : 11,
  489.                          LINENR * INCREMENT : 6,'/',PAGENR : 3);
  490.                   PROC_CL := PROC_CL^.NEXTPROC;
  491.                 UNTIL PROC_CL = NIL;
  492.               END;
  493.         END;
  494.   END (*PRINTLISTE*) ;
  495.   {%E}
  496. Function P$Date:Char8;
  497. Begin
  498.   P$Date:='        ';
  499. End;
  500.   Function P$Time:Char8;
  501. Begin
  502.   P$Time:='        ';
  503. End;
  504.   Procedure Option(Var R,I,P,S:Integer);
  505. Begin
  506.   R:=72;I:=2;P:=132;S:=55;
  507. End;
  508. Procedure Init_Files;
  509. Var Name:Array[1..30]Of Char;
  510. Procedure Read_Name;
  511. Var Cur_Char:1..30;
  512. Begin
  513.   Readln(Input,Name);
  514.   For Cur_Char:=1 To 30 Do
  515.     If Name[Cur_Char]>='a' Then
  516.       Name[Cur_Char]:=Chr(Ord(Name[Cur_Char])-Ord('a')+Ord('A'));
  517. End;
  518.  
  519. Begin
  520.   Reset('CON:',Input);Rewrite('CON:',Output);
  521.   Write(Output,'Input file:');
  522.   Read_Name;
  523.   Reset(Name,OLDSOURCE);
  524.   Write(Output,'Output file:');
  525.   Read_Name;
  526.   Rewrite(Name,NEWSOURCE);
  527.   Write(Output,'Cross file:');
  528.   Read_Name;
  529.   Rewrite(Name,CROSSLIST);
  530. End;
  531. {%E}
  532. BEGIN (*MAIN*)
  533.   Init_Files;
  534.   INIT_PROC;
  535.   INIT_P3;
  536.   INIT;
  537.   WRITELN (OUTPUT);
  538.   WRITELN (OUTPUT,VERSION);
  539.   WRITELN (OUTPUT);
  540.   MAXINC := Big_Line DIV INCREMENT ;
  541.   IF MAXINC > Big_Line
  542.     THEN MAXINC := Big_Line;
  543.   CH := ' ';
  544.   Datum:=P$Date;DayTime:=P$Time;
  545.   Option(RightMargin,Feed,MaxCh,MaxLine);
  546.   If MaxCh<60
  547.     Then MaxCh:=60;
  548.   BackFeed:=Feed;
  549.   BEGIN
  550.     HEADER;
  551.     BLOCK;
  552.     WR_LINE (BUFFLEN+2);
  553.     IF NOT ERRFLAG
  554.       THEN WRITE (OUTPUT,'No ');
  555.     WRITELN (OUTPUT,MESSAGE);
  556.     PRINTLISTE;
  557.     INIT;
  558.   END;
  559.   If Bump
  560.     Then Write(Output,'Some')
  561.     Else Write(Output,'No');
  562.   Writeln(Output,' lines bumped into the right margin');
  563.   If Nasty
  564.     Then Writeln(Output,'Some did not fit even when bumped');
  565. Writeln(Output,'Heap size remaining ',GetSize:1);
  566. END (*MAIN*) .
  567.