*DECK     PS3CTL
          IDENT  PS3CTL 
 PS3CTL   TITLE  PASS 3 CONTROLLER
*CALL     SSTCALL 
          SPACE  4
 B=PS3CT  RPVDEF
 FTN25    SPACE  3,14 
*         IF (BREAK=25) WAS SELECTED, ENTRY TO OVERLAY(2,5) WILL BE TO
*         *FTN25-1* TO CALL THE COMPILE-TIME INTERACTIVE DEBUG PACKAGE. 
  
 FTN25    BREAK 
  
          ENTRY  FTN25
 FTN25    BSS    0           ** LOADER ENTRY POINT ** 
          SB1    1
          SA1    =XN.FERR 
          ZR     X1,PS32     IF NO FATAL ERRORS 
          SA2    =XCP.ERCT
          IX6    X1+X2
          SA6    A2          UPDATE ERROR COUNT GRAND TOTAL 
  
          RJ     IEM               ISSUE ERROR MESSAGE TO THE DAYFILE 
          SA1    =XDFLAG
          ZR     X1,PS31     IF NOT IN DEBUG MODE 
          SA2    =XP2NOGO 
          NZ     X2,PS31     IF NOGO OPTION SPECIFIED 
          MX7    0
          SA7    =XN.FERR    CLEAR FATAL ERROR COUNT
          EQ     PS32 
  
 PS31     WRITEC =XF.CMPS,ECODE,LECODE
  
*         OUTPUT END LINE -  *  END  XFERNAME * 
  
 PS32     SA1    =XXFRNAME   (X1) = NAME OF TRANSFER ADDR, 7L FORMAT
          ZR     X1,PS33     IF NO TRANSFER ADDRESS (NOT MAIN PROGRAM)
          SA2    ENDCODE+1   CONCATENATE *END * AND NAME
          MX6    4*6
          LX1    -4*6 
          BX7    X6*X1
          BX1    -X6*X1 
          BX6    X2+X1
          SA6    A2 
          SA7    A2+B1
 PS33     WRITEC =XF.CMPS,ENDCODE,0 
  
          CALL   RSSW        SET SWITCHS IN *LSTPRO* FOR ASSEMBLY 
  
          CALL   SYMDMP      ** DEBUG **
  
          CALL   REFMAP      LIST DIAGNOSTICS AND PRODUCE THE MAP 
  
          SA1    =XUFLAG
          SA2    =XCAFLAG 
          SA3    =XQFLAG
          BX4    X1+X2
          BX5    X4+X3
          NZ     X5,CLOS     IF NOT ASSEMBLING
  
          WRITER =XF.CMPS 
          REWIND =XF.CMPS,,NF 
 #RM      IFEQ   CP#RM,0
          READ   =XF.CMPS 
 #RM      ENDIF 
  
          CALL   FTNXAS            ASSEMBLE THE COMPS FILE
  
 CLOS     BSS    0
  
 PTIME    IFNE   TEST,0 
          CALL   TIMER
          SA5    =XTIME1
          IX1    X6-X5       LAST - FIRST 
          SA6    A5          NEW FIRST
          BX7    X1 
          SA7    PRG.MSG+2
          SB4    3*6         (B4) = -(SCALE FACTOR) * 6 
          CALL   REALDEC
          SA5    =XCOMPMSG+1
          LX6    6
          MX4    42 
          SA6    PRG.MSG+1
          SX3    3R - 
          BX5    X4*X5
          BX3    -X4*X3 
          BX6    X3+X5
          LX6    -6 
          SA6    A6-1 
          SA1    =XN.EXST 
          SA2    PRG.MSG+2   COMPUTE CARDS / MINUTE 
          SX3    60*1000D 
          SX1    X1+3 
          IX4    X1*X3
          IX1    X4/X2
          SB1    1
          CALL   CDD
          SA1    =5LSEC 
          MX0    30 
          BX6    -X0*X6 
          BX7    X1+X6
          SA7    PRG.MSG+2
          MESSAGE  PRG.MSG,,RECALL
  
          USE    PRGMSG 
 PRG.MSG  DATA   20L NAMEXXX - NNN.NNN
          DATA   18LSEC  NNNNN C/MIN
          USE    *
 PTIME    ENDIF 
  
          EQ     =XFTNEND 
 IEM      TITLE  IEM - ISSUE ERROR MESSAGE
**        IEM - ISSUE ERROR MESSAGE TO THE DAYFILE
* 
*         ENTRY  (X1) = ERROR COUNT 
  
 IEM      ENTRY.
          SB1    1
          CALL   CDD               RETURNS (X6) = NUMBR, DPC -A- FORMAT 
          SA2    =XPROGNAM         (X2) = PROGRAM NAME, 7H FORMAT 
          LX6    6
          BX7    X2 
          SA6    MSGC              STORE NUMBER OF ERRORS AND 
          SA7    MSGC+3            NAME IN DAYFILE MESSAGE
          MESSAGE MSGC,,RECALL     ISSUE MESSAGE TO DAYFILE 
          SB5    1
          EQ     IEM
  
 MSGC     DIS    4,      NNN  FORTRAN ERRORS IN   NAME
  
 ECODE    DATA   C/  ERR ERRORS IN FTN COMPILATION/ 
 LECODE   EQU    *-ECODE
 ENDCODE  DATA   2HZ.,4LEND ,0
  
          END 
