00001000 $SET $                                                                             
00100000 $SET LIST                                                                          
00101000 $SET FORMAT                                                                        
00102000 $VERSION 29.001.001                                                                
00103000 $SET CIS431                                                                        
00103100 $SET SEEPATCHID                                                                    
00104000 BEGIN                                                                              
00105000                                                                                    
00106000 COMMENT THIS PROGRAM PRODUCES A ROUGH CROSS-REFERENCE OF A PASCAL                  
00107000     SYMBOLIC PROGRAM.  TO RUN, EQUATE THIS PROGRAM'S CARD INPUT                    
00108000     FILE TO THE PASCAL SYMBOLIC FILE;                                              
00109000                                                                                    
00110000 INTEGER                                                                            
00111000     SEQ,                                                                           
00112000     MRS;                                                                           
00114000                                                                                    
00115000 FILE                                                                               
00116000     TERM(KIND=REMOTE, MAXRECSIZE=22),                                              
00117000     DBG(KIND=REMOTE),                                                              
00118000     CARD(KIND=DISK, FILETYPE=7, MYUSE=IN),                                         
00119000     LINE(KIND=PRINTER, UNITS=WORDS, MAXRECSIZE=22);                                
00120000                                                                                    
00121000 EBCDIC ARRAY                                                                       
00122000     ES[0:131],                                                                     
00123000     PREVSYMBOL[0:71];                                                              
00124000                                                                                    
00125000 ARRAY                                                                              
00126000     BUF[0:14],                                                                     
00127000     XREFLINE[0:21];                                                                
00128000                                                                                    
00129000 POINTER                                                                            
00130000     PB,                                                                            
00131000     PS,                                                                            
00132000     PSCR,                                                                          
00133000     NEXTP;                                                                         
00134000                                                                                    
00134010 BOOLEAN                                                                            
00134020     SUPPRESS;                                                                      
00134030                                                                                    
00135000 TRUTHSET                                                                           
00136000     IDSTARTER("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"),             
00137000     TRIGGER("{%('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz");           
00138000                                                                                    
00139000 DEFINE                                                                             
00140000     P = POINTER #,                                                                 
00141000     LASTXXXDEFINEXXX = #;                                                          
00142000                                                                                    
00143000 $SET LIST = SEEPATCHID                                                             
00144000 $BEGINSEGMENT                                                                      
00145000 PROCEDURE DATESTRING(PS, TIME0);                                                   
00146000 VALUE TIME0;                                                                       
00147000 POINTER PS;                                                                        
00148000 REAL TIME0;                                                                        
00149000     FORWARD;                                                                       
00150000                                                                                    
00151000                                                                                    
00152000 PROCEDURE  NAMEANDVERSION(P);                                                      
00153000 POINTER P;                                                                         
00154000     BEGIN                                                                          
00155000                                                                                    
00156000     COMMENT  RETURNS AS A CHARACTER STRING, THEN PROGRAM NAME AND                  
00157000     VERSION.                                                                       
00158000                                                                                    
00159000     IE:                                                                            
00160000                                                                                    
00161000                 TEST/PROGRAM[VERSION:  II.5.001]                                   
00162000                                                                                    
00163000     THE  STRING IS OF A VARIABLE LENGTH (DEPENDING UPON THE LENGTH                 
00164000     OF THE CODE-FILE NAME) AND P IS LEFT POINTING TO THE CHARACTER                 
00165000     IMMEDIATELY AFTER THE LAST SQUARE BRACKET.  IN OTHER WORDS,                    
00166000     A POINTER UPDATE IS DONE ON P.                                                 
00167000                                                                                    
00168000     NOTES:                                                                         
00169000                                                                                    
00170000         (1)  A $VERSION CARD SHOULD BE INCLUDED IN THE PROGRAM DECK.               
00171000              THIS CARD LOOKS LIKE:   $VERSION VV.CCC                               
00172000              WHERE VV REPRESENTS THE VERSION AND CCC REPRESENTS                    
00173000              THE LEVEL.  A TYPICAL CARD MIGHT LOOK LIKE:                           
00174000              $VERSION 25.012                                                       
00175000              AND WOULD COME OUT AS  [VERSION:   II.5.012]                          
00176000                                                                                    
00177000         (2)  IF A $VERSION CARD HAS NOT BEEN INCLUDED IN THE PROGRAM               
00178000              TEXT, THEN THE ENTIRE VERSION STUFF WILL BE LEFT OUT                  
00179000              IN THE RETURNED STRING AND P WILL POINT TO THE                        
00180000              CHARACTER POSITION IMMEIDATELY FOLLOWING THE CODEFILE                 
00181000              NAME.                                                                 
00182000                                                                                    
00183000     USAGE:                                                                         
00184000     ------                                                                         
00185000                                                                                    
00186000             P := POINTER(TOSOMEARRAY)                                              
00187000             NAMEANDVERSION(P)                                                      
00188000                                                                                    
00189000     ;                                                                              
00190000                                                                                    
00191000     POINTER P1, PR;                                                                
00192000     INTEGER VERSION, MARK, LEVEL, CYCLE;                                           
00193000                                                                                    
00194000     VALUE ARRAY ROMAN                                                              
00195000     ("    I.   II.  III.   IV.    V.   VI.  VII. VIII.   IX.    X.");              
00196000                                                                                    
00197000     VERSION := COMPILETIME(20);                                                    
00198000     MARK := VERSION DIV 10;                                                        
00199000     LEVEL := VERSION MOD 10;                                                       
00200000     CYCLE := COMPILETIME(21);                                                      
00201000                                                                                    
00202000     REPLACE P:P BY MYSELF.NAME;                                                    
00203000     P := P -1;                                                                     
00204000                                                                                    
00205000     IF VERSION > 0 THEN                                                            
00206000         BEGIN                                                                      
00207000                                                                                    
00208000         SCAN PR:POINTER(ROMAN[MARK-1]) WHILE = " ";                                
00209000         REPLACE P:P BY                                                             
00210000             "[",                                                                   
00211000             PR UNTIL = ".", ".",                                                   
00212000             LEVEL FOR 1 DIGITS,                                                    
00213000             ".",                                                                   
00214000             CYCLE FOR 3 DIGITS,                                                    
00215000             ".", COMPILETIME(22) FOR 3 DIGITS,                                     
00216000             "]";                                                                   
00217000                                                                                    
00218000         END;                                                                       
00219000     END NAMEANDVERSION;                                                            
00220000                                                                                    
00221000 PROCEDURE  MYSELFDOTNAME(LINE);                                                    
00222000 FILE LINE;                                                                         
00223000                                                                                    
00224000     BEGIN                                                                          
00225000                                                                                    
00226000     COMMENT  THE FUNCTION OF THIS PROCEDURE IS TO WRITE OUT A LINE                 
00227000     ON THE OUTPUT FILE THAT CONTAINS THE PROGRAM NAME, AND THE TIME                
00228000     AND DATE AT WHICH THE PROGRAM WAS COMPILED.                                    
00229000                                                                                    
00230000     THE PROGRAM TAKES ONE INPUT PARAMATER AND THAT IS THE NAME                     
00231000     OF THE PROGRAMMER'S PRINTER FILE.                                              
00232000                                                                                    
00233000     USAGE:                                                                         
00234000     ------                                                                         
00235000                                                                                    
00236000             MYSELFDOTNAME(PRINTERFILE)                                             
00237000                                                                                    
00238000     OTHER ROUTINES REQUIRED:  NONE                                                 
00239000     ------------------------                                                       
00240000                                                                                    
00241000     THE PROGRAM WILL PRODUCE A LINE OF OUTPUT SIMILAR TO:                          
00242000                                                                                    
00243000     USERCODE/001234/ABC -- PROGRAM COMPILED ON MAY 1, 1973 @ 4:32 PM.              
00244000                                                                                    
00245000     NOTE THAT THE PRINTER IS SPACED UP 2 LINES BEFORE AND AFTER THE                
00246000     LINE IS WRITTEN.;                                                              
00247000                                                                                    
00248000     ARRAY OUTLN[0:21], RESULT[0:1];                                                
00249000     POINTER PD, PO;                                                                
00250000     INTEGER  TME, HRS, MINS, CM;                                                   
00251000     REAL PERIOD;                                                                   
00252000                                                                                    
00253000     FILL OUTLN[*] WITH 22("      ");                                               
00254000     PD := POINTER(RESULT)+2;                                                       
00255000     TME := COMPILETIME(1);                                                         
00256000     RESULT[0] := COMPILETIME(15);                                                  
00257000     HRS := TME DIV 216000;                                                         
00258000                                                                                    
00259000     IF HRS = 12 THEN PERIOD := "  PM. "                                            
00260000     ELSE IF HRS = 0 THEN                                                           
00261000         BEGIN                                                                      
00262000         HRS := 12;                                                                 
00263000         PERIOD := "  AM. "                                                         
00264000         END                                                                        
00265000     ELSE IF HRS GTR 12  THEN                                                       
00266000         BEGIN                                                                      
00267000         HRS := HRS MOD 12;                                                         
00268000         PERIOD := "  PM. ";                                                        
00269000         END                                                                        
00270000     ELSE PERIOD := "  AM. ";                                                       
00271000                                                                                    
00272000     MINS := (TME DIV 3600) MOD 60;                                                 
00273000     CM := INTEGER(POINTER(RESULT), 2);                                             
00274000                                                                                    
00275000     COMMENT ALL THE DATA HAS BEEN ASSIGNED NOW.  AND NOW WE WILL                   
00276000     FORMAT OUT THE LINE;                                                           
00277000                                                                                    
00278000     PO := POINTER(OUTLN);                                                          
00279000     NAMEANDVERSION(PO);                                                            
00280000     REPLACE PO:PO BY                                                               
00281000         " -- PROGRAM COMPILED ON: ";                                               
00282000     DATESTRING(PO, COMPILETIME(0));                                                
00283000     REPLACE PO:PO BY                                                               
00284000         "  @  ", HRS FOR 2 DIGITS,                                                 
00285000         ":", MINS FOR 2 DIGITS,                                                    
00286000         PERIOD;                                                                    
00287000                                                                                    
00288000     WRITE(LINE [SPACE 2]);                                                         
00289000     WRITE(LINE [SPACE 2], LINE.MAXRECSIZE, OUTLN[*]);                              
00290000                                                                                    
00291000     END MYSELFDOTNAME;                                                             
00292000                                                                                    
00293000 PROCEDURE  HEADERINFO(P);                                                          
00294000 POINTER P;                                                                         
00295000                                                                                    
00296000     BEGIN                                                                          
00297000                                                                                    
00298000     COMMENT THE FUNCTION OF THIS PROCEDURE IS TO RETURN TO THE                     
00299000     PROGRAM AN ARRAY FILLED WITH CHARACTER INFORMATION CONCERNING THE              
00300000     DATE AND TIME THE PROGRAM IS BEING RUN.                                        
00301000                                                                                    
00302000     A SAMPLE RETURN WOULD BE AS FOLLOWS:                                           
00303000                                                                                    
00304000             AUGUST  09,  1973  @  12:04  PM.                                       
00305000                                                                                    
00306000     THE PROGRAMMER CALLS THE PROCEDURE AND PASSES IT A POINTER                     
00307000     THAT IS POINTING AT THE PLACE WHERE HE WANTS THIS INFORMATION                  
00308000     PLACED.  THE STRING IS EXACTLY 36 CHARACTERS LONG.                             
00309000                                                                                    
00310000     NOTE THAT THE SUPPLIED POINTER IS UPDATED BY THE PROCEDURE TO                  
00311000     POINT AT THE NEXT AVAILABLE CHARACTER POSITION AFTER THE INFORMATION           
00312000     HAS BEEN WRITTEN INTO THE STRING.;                                             
00313000                                                                                    
00314000     REAL PERIOD;                                                                   
00315000     INTEGER CM, HRS, MINS, TME;                                                    
00316000     POINTER PD, PR;                                                                
00317000                                                                                    
00318000     TME := TIME(1);                                                                
00319000     HRS := TME DIV 216000;                                                         
00320000     PERIOD := IF HRS LSS 12 THEN "  AM. " ELSE "  PM. ";                           
00321000     HRS := IF HRS EQL 0 THEN 12 ELSE IF HRS GTR 12 THEN HRS MOD 12                 
00322000         ELSE HRS;                                                                  
00323000     MINS := (TME DIV 3600) MOD 60;                                                 
00324000                                                                                    
00325000     DATESTRING(P, TIME(0));                                                        
00326000                                                                                    
00327000     REPLACE P:P BY                                                                 
00328000         "  @  ", HRS FOR 2 DIGITS,                                                 
00329000         ":", MINS FOR 2 DIGITS,                                                    
00330000         PERIOD, "   ";                                                             
00331000                                                                                    
00332000     END HEADERINFO;                                                                
00333000                                                                                    
00334000 PROCEDURE DATESTRING(PS, TIME0);                                                   
00335000 VALUE TIME0;                                                                       
00336000 POINTER PS;                                                                        
00337000 REAL TIME0;                                                                        
00338000     BEGIN                                                                          
00339000                                                                                    
00340000     COMMENT THIS PROCEDURE RETURNS A STRING IN THE FORM:                           
00341000                                                                                    
00342000          MONDAY, OCTOBER 12, 1975                                                  
00343000                                                                                    
00344000     AND A POINTER UPDATE IS DONE ON PS.                                            
00345000                                                                                    
00346000     THE SECOND PARAMETER IS INTENDED TO BE EITHER "TIME(0)"                        
00347000     OR AN INTEGER OF THE FORM:  YYDDD.    IN ORDER TO INDICATE                     
00348000     WHAT FORM THE DATE IS IN, SET BIT [47:1] OF THE SECOND PARM                    
00349000     TO 1 IF IT IS IN THE INTEGER FORM, OTHERWISE JUST CALL                         
00350000     AND PASS THE VALUE:   TIME(0).                                                 
00351000                                                                                    
00352000     ;                                                                              
00353000                                                                                    
00354000                                                                                    
00355000     INTEGER DA, YR, MO, MN, HR;                                                    
00356000     INTEGER DAY;                                                                   
00357000     LABEL OWT;                                                                     
00358000                                                                                    
00359000     VALUE ARRAY                                                                    
00360000         DAYNAMES                                                                   
00361000         ("MONDAY      TUESDAY     WEDNESDAY   THURSDAY    ",                       
00362000          "FRIDAY      SATURDAY    SUNDAY      "),                                  
00363000                                                                                    
00364000         MONTHNAMES(0,0,                                                            
00365000         "JANUARY     FEBRUARY    MARCH       APRIL       ",                        
00366000          "MAY         JUNE        JULY        AUGUST      ",                       
00367000          "SEPTEMBER   OCTOBER     NOVEMBER    DECEMBER    ");                      
00368000                                                                                    
00369000                                                                                    
00370000                                                                                    
00371000     IF BOOLEAN(TIME0.[47:1]) THEN                                                  
00372000         BEGIN                                                                      
00373000         DA := TIME0 MOD 1000;                                                      
00374000         YR := HR := TIME0 DIV 1000;                                                
00375000         END                                                                        
00376000     ELSE                                                                           
00377000     BEGIN                                                                          
00378000     DA := (((DAY:=TIME0).[17:6]*10) + DAY.[11:6])*10 + DAY.[5:6];                  
00379000     YR := HR := DAY.[29:6]*10 + DAY.[23:6];                                        
00380000     END;                                                                           
00381000                                                                                    
00382000     FOR DAY:= 31, REAL(YR MOD 4 =0)+28, 31, 30, 31, 30, 31, 31, 30, 31,            
00383000         30 DO                                                                      
00384000         IF DA LEQ DAY THEN GO OWT                                                  
00385000         ELSE                                                                       
00386000             BEGIN                                                                  
00387000             MO := MO + 1;                                                          
00388000             DA := DA - DAY;                                                        
00389000             END;                                                                   
00390000                                                                                    
00391000     OWT:                                                                           
00392000     IF MO < 2 THEN                                                                 
00393000         BEGIN                                                                      
00394000         MN := MO+11;                                                               
00395000         HR := YR-1;                                                                
00396000         END                                                                        
00397000     ELSE MN := MO -1;                                                              
00398000     MO := MO + 1;                                                                  
00399000                                                                                    
00400000     DAY := ((MN*26-2) DIV 10 + DA + HR + HR DIV 4) MOD 7;                          
00401000                                                                                    
00402000     REPLACE PS:PS BY                                                               
00403000         POINTER(DAYNAMES[DAY*2]) UNTIL = " ",                                      
00404000         ", ",                                                                      
00405000         POINTER(MONTHNAMES[MO*2]) UNTIL = " ",                                     
00406000         " ",                                                                       
00407000         DA FOR 2 DIGITS,                                                           
00408000         ",  19",                                                                   
00409000         YR FOR 2 DIGITS,                                                           
00410000         " ";                                                                       
00411000                                                                                    
00412000     END OF DATESTRING;                                                             
00413000                                                                                    
00414000 PROCEDURE COMPILEINFO(PS);                                                         
00415000 POINTER PS;                                                                        
00416000                                                                                    
00417000     BEGIN                                                                          
00418000                                                                                    
00419000     ARRAY OUTLN[0:21], RESULT[0:1];                                                
00420000     POINTER PD, PO;                                                                
00421000     INTEGER  TME, HRS, MINS, CM;                                                   
00422000     REAL PERIOD;                                                                   
00423000                                                                                    
00424000     PD := POINTER(RESULT)+2;                                                       
00425000     TME := COMPILETIME(1);                                                         
00426000     RESULT[0] := COMPILETIME(15);                                                  
00427000     HRS := TME DIV 216000;                                                         
00428000                                                                                    
00429000     IF HRS = 12 THEN PERIOD := "  PM. "                                            
00430000     ELSE IF HRS = 0 THEN                                                           
00431000         BEGIN                                                                      
00432000         HRS := 12;                                                                 
00433000         PERIOD := "  AM. "                                                         
00434000         END                                                                        
00435000     ELSE IF HRS GTR 12  THEN                                                       
00436000         BEGIN                                                                      
00437000         HRS := HRS MOD 12;                                                         
00438000         PERIOD := "  PM. ";                                                        
00439000         END                                                                        
00440000     ELSE PERIOD := "  AM. ";                                                       
00441000                                                                                    
00442000     MINS := (TME DIV 3600) MOD 60;                                                 
00443000     CM := INTEGER(POINTER(RESULT), 2);                                             
00444000                                                                                    
00445000     COMMENT ALL THE DATA HAS BEEN ASSIGNED NOW.  AND NOW WE WILL                   
00446000     FORMAT OUT THE LINE;                                                           
00447000                                                                                    
00448000     PO := POINTER(OUTLN);                                                          
00449000     DATESTRING(PO, COMPILETIME(0));                                                
00450000     REPLACE PO:PO BY                                                               
00451000         "  @  ", HRS FOR 2 DIGITS,                                                 
00452000         ":", MINS FOR 2 DIGITS,                                                    
00453000         PERIOD,                                                                    
00454000         0 FOR 1;                                                                   
00455000                                                                                    
00456000     REPLACE PS:PS BY POINTER(OUTLN) UNTIL = 0;                                     
00457000     END OF COMPILEINFO;                                                            
00458000 $ENDSEGMENT                                                                        
00459000 $POP LIST                                                                          
00460000 BOOLEAN PROCEDURE INCOMMON(P);                                                     
00461000 VALUE P;                                                                           
00462000 POINTER P;                                                                         
00463000     BEGIN                                                                          
00464000     VALUE ARRAY RESWORDS(                                                          
00465000         "123456789012",                                                            
00468000         "IF          ",                                                            
00469000         "DO          ",                                                            
00470000         "OF          ",                                                            
00471000         "TO          ",                                                            
00472000         "IN          ",                                                            
00473000         "OR          ",                                                            
00473100         "GO          ",                                                            
00474000         "END         ",                                                            
00475000         "FOR         ",                                                            
00476000         "VAR         ",                                                            
00477000         "DIV         ",                                                            
00478000         "MOD         ",                                                            
00479000         "SET         ",                                                            
00480000         "AND         ",                                                            
00481000         "NOT         ",                                                            
00481100         "NEQ         ",                                                            
00481200         "ELSE        ",                                                            
00482000         "THEN        ",                                                            
00484000         "WITH        ",                                                            
00485000         "GOTO        ",                                                            
00486000         "CASE        ",                                                            
00487000         "TYPE        ",                                                            
00488000         "FILE        ",                                                            
00489000         "BEGIN       ",                                                            
00490000         "UNTIL       ",                                                            
00491000         "WHILE       ",                                                            
00492000         "ARRAY       ",                                                            
00493000         "CONST       ",                                                            
00494000         "LABEL       ",                                                            
00494100         "FORMAT      ",                                                            
00495000         "REPEAT      ",                                                            
00496000         "RECORD      ",                                                            
00497000         "DOWNTO      ",                                                            
00498000         "PACKED      ",                                                            
00499000         "FORWARD     ",                                                            
00500000         "PROGRAM     ",                                                            
00501000         "FUNCTION    ",                                                            
00501100         "OTHERWISE   ",                                                            
00502000         "PROCEDURE   ");                                                           
00503000                                                                                    
00504000     LABEL AWAY;                                                                    
00505000     INTEGER I, SZ;                                                                 
00506000                                                                                    
00507000     SZ := (SIZE(RESWORDS) DIV 2)-1;                                                
00508000     FOR I:=0 STEP 1 UNTIL SZ DO                                                    
00509000         IF P = POINTER(RESWORDS[I*2]) FOR 12 THEN                                  
00510000             BEGIN INCOMMON:=TRUE; GO AWAY; END;                                    
00511000     AWAY:                                                                          
00512000     END OF INCOMMON;                                                               
00512010 BOOLEAN PROCEDURE PREDEFINEDNAME(SYMBOL);                                          
00512020                                                                                    
00512030 EBCDIC ARRAY SYMBOL[0];                                                            
00512040 BEGIN                                                                              
00512050 LABEL AWAY;                                                                        
00512060 INTEGER I,SZ;                                                                      
00512070 VALUE ARRAY PREDEFINEDS (                                                          
00512080         "INTEGER     ",                                                            
00512090         "REAL        ",                                                            
00512100         "CHAR        ",                                                            
00512110         "BOOLEAN     ",                                                            
00512120         "FALSE       ",                                                            
00512130         "TRUE        ",                                                            
00512140         "NIL         ",                                                            
00512150         "MAXINT      ",                                                            
00512160                                                                                    
00512170         "ABS         ",                                                            
00512180         "SQR         ",                                                            
00512190         "TRUNC       ",                                                            
00512200         "ROUND       ",                                                            
00512210         "ODD         ",                                                            
00512220         "ORD         ",                                                            
00512230         "CHR         ",                                                            
00512240         "PRED        ",                                                            
00512250         "SUCC        ",                                                            
00512260         "EOF         ",                                                            
00512270         "EOLN        ",                                                            
00512280         "SIN         ",                                                            
00512290         "COS         ",                                                            
00512300         "ARCTAN      ",                                                            
00512310         "EXP         ",                                                            
00512320         "LN          ",                                                            
00512330         "SQRT        ",                                                            
00512340         "TAN         ",                                                            
00512350         "COTAN       ",                                                            
00512360         "ARCSIN      ",                                                            
00512370         "ARCCOS      ",                                                            
00512380         "ARCTAN2     ",                                                            
00512390         "SINH        ",                                                            
00512400         "COSH        ",                                                            
00512410         "TANH        ",                                                            
00512420         "ATANH       ",                                                            
00512430         "LOG         ",                                                            
00512440         "ERF         ",                                                            
00512450         "ERFC        ",                                                            
00512460         "GAMMA       ",                                                            
00512470         "LNGAMMA     ",                                                            
00512480         "CARD        ",                                                            
00512490         "RANDOM      ",                                                            
00512500         "MIN         ",                                                            
00512510         "MAX         ",                                                            
00512520         "ELAPSEDTIME ",                                                            
00512530         "PROCESSTIME ",                                                            
00512540         "IOTIME      ",                                                            
00512550         "ENDOFFILE   ",                                                            
00512560                                                                                    
00512570         "GET         ",                                                            
00512580         "PUT         ",                                                            
00512590         "NEW         ",                                                            
00512600         "MARK        ",                                                            
00512610         "RELEASE     ",                                                            
00512620         "READ        ",                                                            
00512630         "WRITE       ",                                                            
00512640         "HALT        ",                                                            
00512650         "TIMESTAMP   ",                                                            
00512660         "CLOSE       ",                                                            
00512670         "SEEK        ",                                                            
00512680         "SPACE       ",                                                            
00512690         "PAGE        ",                                                            
00512700         "STARTJOB    ",                                                            
00512710         "READLN      ",                                                            
00512720         "WRITELN     ",                                                            
00512730         "RESET       ",                                                            
00512740         "REWRITE     ",                                                            
00512750         "PACK        ",                                                            
00512760         "UNPACK      ",                                                            
00512770         "DISPOSE     ",                                                            
00512780         "INPUT       ",                                                            
00512790         "OUTPUT      ",                                                            
00512800         "LOGICAL     ");                                                           
00512810                                                                                    
00512820 SZ := SIZE(PREDEFINEDS) DIV 2 -1;                                                  
00512830 FOR I := 0 STEP 1 UNTIL SZ DO                                                      
00512840   IF (SYMBOL[0] = POINTER(PREDEFINEDS[I*2]) FOR 12) THEN                           
00512850     BEGIN                                                                          
00512860       PREDEFINEDNAME := TRUE;                                                      
00512870       GO AWAY;                                                                     
00512880     END;                                                                           
00512890 AWAY:                                                                              
00512900 END;   %OF PREDEFINEDNAME                                                          
00512910                                                                                    
00513000 BOOLEAN PROCEDURE SORTIN(R);                                                       
00514000 ARRAY R[0];                                                                        
00515000     BEGIN                                                                          
00516000     OWN BOOLEAN GOTAREC;                                                           
00517000     LABEL SKAN, TILT;                                                              
00518000     OWN INTEGER L, K;                                                              
00519000     BOOLEAN EOS, EOC;                                                              
00520000     POINTER MARK FOR BUF;                                                          
00521000                                                                                    
00522000     PROCEDURE READACARD;                                                           
00523000         BEGIN                                                                      
00523100         LABEL AGAIN;                                                               
00523200     AGAIN:                                                                         
00524000         IF READ(CARD, MRS, BUF) THEN GO TILT;                                      
00524100         IF((POINTER(BUF[0])="$" FOR 1) OR(POINTER(BUF[0])=" $" FOR 2))             
00524200         THEN GO TO AGAIN;                                                          
00525000         PB := P(BUF);                                                              
00526000         L := 72;                                                                   
00527000         END OF READACARD;                                                          
00528000                                                                                    
00529000     SKAN:                                                                          
00530000     IF GOTAREC THEN                                                                
00531000         BEGIN                                                                      
00532000         SCAN PB:PB FOR L:L UNTIL IN TRIGGER;                                       
00533000         IF L=0 THEN                                                                
00534000             BEGIN                                                                  
00535000             READACARD;                                                             
00536000             GO SKAN;                                                               
00537000             END;                                                                   
00538000                                                                                    
00539000         IF PB="(*" THEN                                                            
00540000             BEGIN                                                                  
00541000             EOC := FALSE;                                                          
00541005             PB := *+2;                                                             
00541010             L := *-2;                                                              
00542000             DO                                                                     
00543000                 BEGIN                                                              
00544000                 SCAN PB:PB FOR L:L UNTIL = "*";                                    
00545000                 IF L=0 THEN READACARD                                              
00546000                 ELSE IF PB="*)" THEN                                               
00547000                     BEGIN                                                          
00548000                     EOC := TRUE;                                                   
00549000                     PB := *+2;                                                     
00550000                     L := *-2;                                                      
00551000                     END                                                            
00552000                 ELSE                                                               
00553000                     BEGIN                                                          
00554000                     PB:=*+1;                                                       
00555000                     L := *-1;                                                      
00556000                     END;                                                           
00557000                 END                                                                
00558000             UNTIL EOC;                                                             
00559000             GO SKAN;                                                               
00560000             END                                                                    
00560010     ELSE IF PB = "{" THEN    %LEFT BRACE                                           
00560020         BEGIN                                                                      
00560030         EOC := FALSE;                                                              
00560040         PB := *+1;                                                                 
00560050         L := *+1;                                                                  
00560060         DO                                                                         
00560070             BEGIN                                                                  
00560080             SCAN PB:PB FOR L:L UNTIL = "}";                                        
00560090             IF (L=0) THEN READACARD                                                
00560100             ELSE IF (PB = "}") THEN                                                
00560110                 BEGIN                                                              
00560120                 EOC := TRUE;                                                       
00560130                 PB := *+1;                                                         
00560140                 L := *-1;                                                          
00560150                 END                                                                
00560160             ELSE                                                                   
00560170                 BEGIN                                                              
00560180                 PB := *+1;                                                         
00560190                 L := *-1;                                                          
00560210                 END;                                                               
00560220         END UNTIL EOC;                                                             
00560230         GO SKAN;                                                                   
00560240         END                                                                        
00560250     ELSE IF (PB = "%") THEN                                                        
00560260         BEGIN                                                                      
00560270         READACARD;                                                                 
00560280         GO SKAN;                                                                   
00560290         END                                                                        
00561000         ELSE IF PB="'" THEN                                                        
00562000             BEGIN                                                                  
00563000             EOS := FALSE;                                                          
00563005             PB := *+1;                                                             
00563010             L := *-1;                                                              
00564000             DO                                                                     
00565000                 BEGIN                                                              
00566000                 SCAN PB:PB FOR L:L UNTIL = "'";                                    
00567000                 IF L=0 THEN READACARD                                              
00568000                 ELSE IF PB = "''" THEN                                             
00569000                     BEGIN                                                          
00570000                     PB := *+2;                                                     
00571000                     L := *-2;                                                      
00572000                     END                                                            
00573000                 ELSE                                                               
00574000                     BEGIN                                                          
00575000                     PB := *+1;                                                     
00576000                     L := *-1;                                                      
00577000                     EOS := TRUE;                                                   
00578000                     END;                                                           
00579000                 END                                                                
00580000             UNTIL EOS;                                                             
00581000             GO SKAN;                                                               
00582000             END                                                                    
00583000         ELSE IF NOT PB IN IDSTARTER THEN                                           
00584000             BEGIN                                                                  
00585000             PB := *+1;                                                             
00586000             L := *-1;                                                              
00586005             GO SKAN;                                                               
00587000             END;                                                                   
00588000                                                                                    
00589000                                                                                    
00590000         SCAN PB: MARK:=PB FOR L: K:=L WHILE IN ALPHA;                              
00591000         K := *-L;                                                                  
00592000         REPLACE P(R[1]) BY MARK FOR K, " " FOR 72-K;                               
00593000         SEQ := R[0] := INTEGER(P(BUF[12]), 8);                                     
00594000         IF SUPPRESS THEN                                                           
00594010             IF INCOMMON(P(R[1])) THEN GO SKAN;                                     
00595000         END                                                                        
00596000     ELSE                                                                           
00597000         BEGIN                                                                      
00598000         READACARD;                                                                 
00599000         GOTAREC := TRUE;                                                           
00600000         GO SKAN;                                                                   
00601000         END;                                                                       
00602000                                                                                    
00603000     IF FALSE THEN                                                                  
00604000         BEGIN                                                                      
00605000         TILT:                                                                      
00606000                                                                                    
00607000         CLOSE(CARD);                                                               
00608000         SORTIN := TRUE;                                                            
00609000         END;                                                                       
00611000     END OF SORTIN;                                                                 
00612000 PROCEDURE SORTOUT(EOF, R);                                                         
00613000 VALUE EOF;                                                                         
00614000 BOOLEAN EOF;                                                                       
00615000 ARRAY R[0];                                                                        
00616000     BEGIN                                                                          
00617000     OWN BOOLEAN UNDERLINE,INITTED;                                                 
00617100     POINTER PP;                                                                    
00617200     INTEGER NOCHARS;                                                               
00618000     OWN INTEGER CROSS;                                                             
00619000                                                                                    
00620000     PROCEDURE CENTRE(PT, SP);                                                      
00621000     VALUE PT, SP;                                                                  
00622000     POINTER PT;   INTEGER SP;                                                      
00623000         BEGIN                                                                      
00624000         EBCDIC ARRAY ES[0:131];                                                    
00625000         INTEGER K;                                                                 
00626000         SCAN PT FOR K:132 UNTIL = 0;                                               
00627000         REPLACE ES BY " " FOR 132;                                                 
00628000         REPLACE ES[K DIV 2] BY PT FOR 132-K;                                       
00629000         IF SP GTR 0 THEN WRITE(LINE[SPACE SP], 22, ES)                             
00630000         ELSE WRITE(LINE, 22, ES);                                                  
00631000         END OF CENTRE;                                                             
00634000     IF NOT READLOCK(TRUE, INITTED) THEN                                            
00635000         BEGIN                                                                      
00635100         UNDERLINE := FALSE;                                                        
00636000         REPLACE PS:PSCR BY "PASCAL SYMBOL XREFANALYZER ";                          
00637000         NAMEANDVERSION(PS);                                                        
00638000         REPLACE PS:PS BY "   ";                                                    
00639000         HEADERINFO(PS);                                                            
00640000         REPLACE PS BY " "; WHILE PS=" " DO PS:=*-1;                                
00641000         REPLACE PS+1 BY 0 FOR 1;                                                   
00642000         CENTRE(PSCR, 2);                                                           
00643000                                                                                    
00644000         REPLACE PS:PSCR BY                                                         
00645000             "CROSS REFERENCE OF: ", CARD.TITLE;                                    
00646000         REPLACE PS-1 BY 0 FOR 1;                                                   
00647000         CENTRE(PSCR, 2);                                                           
00647100         REPLACE PS:PSCR BY                                                         
00647110             "IDENTIFIER" FOR 10,                                                   
00647120             " " FOR 14,                                                            
00647130             "REFERENCES" FOR 10,                                                   
00647140             " " FOR 98;                                                            
00647150         WRITE(LINE,22,ES);                                                         
00648000                                                                                    
00649000         REPLACE PREVSYMBOL BY 48"00" FOR 30;                                       
00650000         END;                                                                       
00651000                                                                                    
00652000     IF EOF THEN                                                                    
00653000         BEGIN                                                                      
00654000         IF CROSS GTR 0 THEN                                                        
00655000             WRITE(LINE, 22, XREFLINE);                                             
00656000         END                                                                        
00657000     ELSE IF P(R[1]) = PREVSYMBOL FOR 72 THEN                                       
00658000         BEGIN                                                                      
00659000         REPLACE NEXTP:NEXTP BY R[0] FOR 8 DIGITS, "  ";                            
00660000         IF CROSS:=*+1 GEQ 10 THEN                                                  
00661000             BEGIN                                                                  
00662000             CROSS := 0;                                                            
00662100             IF UNDERLINE THEN BEGIN                                                
00662110                 SCAN PP:PREVSYMBOL[0] FOR NOCHARS:72 UNTIL = " ";                  
00662120                 NOCHARS := 72 - NOCHARS;                                           
00662130                 REPLACE P(XREFLINE[0]) BY "-" FOR NOCHARS;                         
00662140                 UNDERLINE := FALSE;                                                
00662150             END;                                                                   
00663000             WRITE(LINE, 22, XREFLINE);                                             
00664000             REPLACE XREFLINE BY " " FOR 22 WORDS;                                  
00665000             NEXTP := P(XREFLINE[4]);                                               
00666000             END;                                                                   
00667000         END                                                                        
00668000     ELSE                                                                           
00669000         BEGIN                                                                      
00670000         IF CROSS GTR 0 THEN BEGIN                                                  
00670100             IF UNDERLINE THEN BEGIN                                                
00670110                 SCAN PP:PREVSYMBOL[0] FOR NOCHARS:72 UNTIL = " ";                  
00670120                 NOCHARS := 72 - NOCHARS;                                           
00670130                 REPLACE P(XREFLINE[0]) BY "-" FOR NOCHARS;                         
00670140                 UNDERLINE := FALSE;                                                
00670150             END;                                                                   
00671000             WRITE(LINE, 22, XREFLINE);                                             
00671100         END;                                                                       
00672000                                                                                    
00673000         WRITE(LINE[SPACE 2]);                                                      
00674000         WRITE(LINE, 5, P(R[1]));                                                   
00675000         REPLACE XREFLINE BY " " FOR 22 WORDS;                                      
00676000         REPLACE NEXTP:P(XREFLINE[4]) BY R[0] FOR 8 DIGITS, "  ";                   
00677000         CROSS := 1;                                                                
00678000         REPLACE PREVSYMBOL BY P(R[1]) FOR 72;                                      
00678100         UNDERLINE := PREDEFINEDNAME(PREVSYMBOL);                                   
00679000         END;                                                                       
00680000     END OF SORTOUT;                                                                
00681000 BOOLEAN PROCEDURE COMPROC(R1, R2);                                                 
00682000 ARRAY R1, R2[0];                                                                   
00683000     BEGIN                                                                          
00684000     IF P(R1[1]) = P(R2[1]) FOR 30 THEN                                             
00685000         COMPROC := R1[0] LEQ R2[0]                                                 
00686000     ELSE COMPROC := P(R1[1]) LSS P(R2[1]) FOR 30;                                  
00687000                                                                                    
00688000     END OF COMPARE PROCEDURE;                                                      
00689000                                                                                    
00690000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%             
00691000 %                                                                    %             
00692000 %                MAIN  PASCAL  XREF  PROGRAM                         %             
00693000 %                                                                    %             
00694000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%             
00695000                                                                                    
00696000 PSCR := ES;                                                                        
00697000 CARD(OPEN);                                                                        
00698000 MRS := CARD.MAXRECSIZE;                                                            
00699000 SUPPRESS := MYSELF.TASKVALUE = 0;                                                  
00700000 SORT(SORTOUT, SORTIN, 0, COMPROC, 13, 12000, PACK 600000);                         
00701000 END.                                                                               