PREQ $(2) . LIT BM* 'ATHENA EXTENDED FORTRAN ' '25I-96' ' (27 SEP 80) ' FPKT 'PSF$ ' RES 7 MCID +0 INCASG '@ASG,A INCLZ$,F . ' INCUSE '@USE INCLZ$,SYS$*AAABBBCCCDDD' IMSG ' UNABLE TO ASIGN FILE AAAAAA' '@BAD ENVIRON' . -2 FOR ILLEGAL INDEX VALUES RLIBTAB . TABLE OF FILE NAMES FOR DIFFERENT ENVIROMENTS 'RLIB$ ' . CURRENT VERSION 'RLIB$O ' . OLD VERSION 'RLIB$N ' . NEW VERSION 'RLIB$T ' . TEST VERSION 'RLIB$A ' . A TO F FOR EXPANSION 'RLIB$B ' . A TO F FOR EXPANSION 'RLIB$C ' . A TO F FOR EXPANSION 'RLIB$D ' . A TO F FOR EXPANSION 'RLIB$E ' . A TO F FOR EXPANSION 'RLIB$F ' . A TO F FOR EXPANSION RLIBTABL EQU $-RLIBTAB FASGPK '@ASG,T PSF$,F/1//800 ' FREEPK '@FREE PSF$. ' FMSG 'UNABLE TO ASSIGN SCRATCH FILE PSF$. ' P FORM 12,6,18 PRNTR P 1,1,BM+4 JACK* +0 . TIME RUN IN SECONDS CMMTH ' JAN' ' FEB' ' MAR' ' APR' ' MAY' ' JUN' ' JUL' ' AUG' ' SEP' ' OCT' ' NOV' ' DEC' . . VAL1* J $-$ . ROUTINE TO FETCH DATE & TIME. SZ A0 ER IALL$ . ELIMINATE CONTINGENCIES ANU A0,A0 . CLEAR D1 DI A0,A1 . PRODUCE DIVIDE FAULT JNDF VAL2 . AN 1106/1108 WILL JUMP SPD A0 . IT'S AN 1110, GET PSR BITS OR,M A0,0100 . SET D20 TO 1 LPD 0,A1 . RESTORE PSR L A0,CTRAP0 . RESTORE CONTINGENCY ER IALL$ VAL2 . S A5,PARTBZ TNE,M A4,4 S A4,CREMOT . SET TO INDICATE DEMAND S R2,JACK . TIME AND DATE SSL A5,4 JNB A5,$+5 V OPTION, REVERSE BATCH/DEMAND MODE L,M A5,4 TNE,M A4,4 DEMAND IS 4 SZ A5 S A5,CREMOT DO 1-JPL , PROC L A5,PARTBZ AND A5,(0200000,0) . TEST IF PROCESSOR BREAKPOINTED SSL A6,18 . ONLY SET H2 OF WORD S A6,BRKPTT . NON ZERO IF BREAKPOINTED AND A5,(0100000,0) S A6,N0SYSLV . SAVE SYSYEM LEVEL FLAG JZ A6,ENVLS L A0,R15 . GET SYSTEM ID AND A0,(0777777) TE A1,('JPL') J ENDJPL PCTENV EQU 07 . WORD IN PCT WITH ENVIRONMENT INDEX ENVL EQU N0RGSA . LOCATION TO READ JPL BUFFER ENVLS L A0,('X',ENVL) . GET JPL BUFFER ER PCT$ L,S3 A1,ENVL+PCTENV . GET ENVIROMENT INDEX LSSL A1,1 JZ A1,ENVLEND . USE STANDARDS TG,M A1,RLIBTABL L,XM A1,-2 . CAUSE ERROR IF BAD INDEX A,M A1,RLIBTAB . INDEX OF POSSIBLE NAMES DL A4,0,A1 . GET FILE NAME FOR RLIB$ DS A4,INCUSE+3 . SAVE NAME OF ALTERNATE LIBRARY S A4,IMSG+4 . SET UP DIAGNOSTIC L A0,(5,INCUSE) ER CSF$ L A0,(3,INCASG) ER CSF$ JN A0,$+4 . ASSIGN ERROR SSC A0,33 JB A0,ENV25A . PREVIOUS ASIGN J ENV027 SSC A0,33 TE,M A0,1 . PREV ASG J AXXY . ASSIGN ERROR ENV25A L,M A0,' ' . REMOVE R OPT FROM FREE S,S6 A0,CRJOPT . SAVE TILL END ENV027 L A0,INCUSE+1 . USE NAME L A1,(' ') DS A0,ALTLIBN ENVLEND DO JPL , PROC END L A0,(0112,ERRT) ER PCT$ L A0,ERRT+11 . SUPS UP TO NOW S A0,CRTIME DO 1-JPL , PROC TIMER$ EQU 0400300 . TIMING COMMON BANK TIMNG$ EQU 01000 . TO GET DATA FMTIM$ EQU 01001 . TO FORMAT THE DATA L,M A0,DQFB1 . FOR ACCOUNTING INFO LXI,M B11,TIMER$ LIJ B11,TIMNG$ L A0,(0112,ERRT) . READ PCT ER PCT$ . GET FILE COMPILER EXECUTED FROM L A1,ERRT+0110 . SEE IF COMPILER IN JZP ENV TNE A1,('LIB$F ') S,S6 A1,CRNCCB . SET FLAG FOR NON CONFIGURED TESTING ENDJPL DO JPL , PROC END TZ,H2 BRKPTT . IF BREAKPOINTED ASSUME NOT DEMAND SZ CREMOT L A0,('LIB$ ') TNE A0,ERRT+0110 J ND2 S,S3 A0,CRFLGS . COMPILER NOT LOADED FROM LIB$ ND2 . ER DATE$ S,S5 A0,CM+4 . MMDDYY SSL A0,6 . @MMDDY S,S4 A0,CM+4 SSL A0,6 . @@MMDD S,S4 A0,CM+3 SSL A0,6 S,S3 A0,CM+3 L,S1 A0,JACK . MONTH AS INTEGER L A0,CMMTH-1,A0 . @@@MMM S,S2 A0,CM+4 . MONTH IN FIELD DATA SSL A0,6 S,S1 A0,CM+4 SSL A0,6 S,S6 A0,CM+3 S,S5 A1,CM+6 . HHMMSS SSL A1,6 S,S4 A1,CM+6 SSL A1,6 . @@HHMM S,S2 A1,CM+6 SSL A1,6 S,S1 A1,CM+6 SSL A1,6 S,S5 A1,CM+5 SSL A1,6 S,S4 A1,CM+5 L A1,(1,BMX) L A0,(1,BM) L,M R1,7 BT A1,0,*A0 L,M A3,2 L,M A4,1 L A5,PARTBZ SSL A5,1 JNB A5,$+2 S,H1 A5,CRDBUG Y OPTION SSL A5,6 JNB A5,$+2 S A4,CRLIST S OPTION SSC A5,3 JNB A5,$+2 S,S1 A4,CRDGSY . P OPTION, OUTPUT SYMBOL TABLE SSC A5,4 JNB A5,$+2 S A3,CRLIST L OPTION TEP,M A5,2 S,S1 A4,CRJOPT . SET K OPTION TO REMOVE SOME OPTIMIZATI LSSC A5,3 JNB A5,ND10 O OPTION S,S2 A4,CRFLGS FORTRAN CALLED BY CTS L,M A0,3 TZ,H1 CRDBUG Y OPTION S A0,CRTRAC SET SHORT AND MATERALIZE OPTIONS ND10 SSL A5,1 N OPTION JNB A5,$+3 SZ CRLIST S A4,CRPD1A SSL A5,7 JNB A5,$+2 S,S6 A5,CR131K SSL A5,2 . SET START EDIT GENERATE JNB A5,$+2 . ON E OPTION S,H1 A5,CRSD1 SSL A5,1 JNB A5,$+2 S,H2 A4,CRDBUG D OPTION SSL A5,1 JNB A5,$+2 S A4,CRSD1 C OPTION SSL A5,1 JNB A5,$+2 S A4,CRSDG B-OPTION. SSL A5,1 JNB A5,$+3 . NO A OPTION S,S3 A4,U1110A . TURN ON REENT. MATH LIB. S,S2 A4,U1110A A OPTION, REENTRANT LIB CALLING SEQUENCES DO 1-LMSC , PROC L,H1 A5,PARTBZ . GET H OPTION JNB A5,$+2 . SZ,S3 U1110A . USE NON REENT. MATH LIB. DO LMSC , PRPC END L,S4 A5,PARTBZ TOP,M A5,2 . TEST M OPTION J ENDEXP L,M A1,15000 S,H1 A1,MCEXPD . NUMBER OF WORDS TO SAVE FOR MACROS L,H2 A0,SYMBRK+1 . CURRENT END OF SYMBOL TABLE A,M A0,2 . CREATE A POOL OF SPACE FOR MACROS S,H2 A0,MCEXPD A A0,A1 S,H2 A0,SYMBRK+1 . RESET END OF MEMMORY ER MCORE$ L A1,CRSFNX A,M A1,10000 . GIVE MORE SPACE FOR FIXED LENGTH ENTR S A1,CRSFNX L,H2 A1,MCEXPD A,M A1,10000 L,H1 A0,MCEXPD AN,M A0,10000 LMJ A3,SYMFRE . PUT SPACE IN REUSABLE POOL ENDEXP . L A0,PRNTR TZ,S2 CRFLGS NO IDENTIFICATION FOR CTS CALL J BATCH+1 TZ CREMOT J BATCH L A0,PRNTP DEMAND IDENTIFICATION ER PRINT$ L A0,PRNTPA BATCH ER PRINT$ . THIS AREA REQUESTS FASTRAND FILES FOR COMPILER SCRATCH FILES L,M A5,0 TRYAGN . L,M A0,FPKT ER FACIL$ L,S1 A1,FPKT+6 . EQUIPMENT TYPE, ZERO IS UNASSIGNED L A0,(4,FASGPK) TLE,M A1,040 TLE,M A1,030 ER CSF$ JP A0,*VAL1 CXXX TZ A5 J CXXY L,M A5,1 L A0,(4,FREEPK) ER CSF$ J TRYAGN CXXY L A0,(0106,FMSG) ER PRINT$ S,S1 A5,CRE . SET FOR LAST TEST BEFORE EXIT S,S2 A5,CRE . J SEXIT AXXY L A0,(0105,IMSG) J CXXY+1 END