*DECK DB$PROF 
USETEXT CDGDFTX 
      PROC DB$PROF; 
      BEGIN 
 #
* *   DB$PROF - PRINT OUTPUT FILE                PAGE  1
* *   BOB MCALLESTER                             DATE  08/30/82 
* 
* DC  PURPOSE 
* 
*     COPY THE CURRENT CONTENTS OF THE OUTPUT FILE TO A FILE THAT IS
*     ROUTED TO A PRINTER.
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     THE ARRAY DB$OFET DEFINES THE FET FOR THE OUTPUT FILE.
* 
* DC  EXIT CONDITIONS 
* 
*     THE OUTPUT FILE IS REWOUND AND READY TO RECEIVE MORE OUTPUT.
* 
* DC  CALLING ROUTINES
* 
*     DB$ERR                 CDCS ERROR MESSAGE PROCESSOR 
*     DB$ODMP                OPERATOR DUMP ROUTINE
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC CMMSDA;      # RESPECIFY DYNAMIC AREA BASE ADDRESS     #
      XREF PROC DB$FLOP;     # RECORD FLOW POINT                       #
      XREF PROC DB$IORD;     # READ AND SKIP TO END-OF-RECORD          #
      XREF PROC DB$LINE;     # CONTROL LINE OUTPUT                     #
      XREF ITEM DB$LINH C(30);  # HEADER LINE FOR CDCS LIST            #
      XREF PROC DB$MSG;      # ISSUE A MESSAGE TO THE DAYFILE          #
      XREF PROC DB$RCLM;     # RELINQUISH THE CPU TEMPORARILY          #
      XREF PROC DB$RDM;      # READ MACRO                              #
      XREF FUNC DB$ROPM;     # ROUTE FILE TO A PRINTER                 #
      XREF FUNC DB$ROPQ;     # ASSIGN FILE TO A QUEUE DEVICE (NOS/BE)  #
      XREF PROC DB$RTN;      # RETURN A FILE                           #
      XREF PROC DB$RWND;     # REWIND MACRO                            #
      XREF PROC DB$WRTM;     # WRITE MACRO                             #
      XREF PROC DB$WRRM;     # WRITER MACRO                            #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
# 
      XREF ITEM DB$ERLC;     # ERROR MESSAGE LINE COUNT                #
  
      XREF ARRAY DB$OFET;    # FET FOR OUTPUT FILE                     #
*CALL FETDCLS 
  
      XREF ARRAY DB$QFET;    # FET FOR PRINT FILE ROUTING              #
        BEGIN 
        ITEM QFTLFNU  U(00,00,42);  # Q FET LOCAL FILE NAME            #
        ITEM QFTCOMP  B(00,59,01);  # Q FET COMPLETION BIT             #
        ITEM QFTFIRST I(01,42,18);  # Q FET FIRST                      #
        ITEM QFTIN    I(02,00,60);  # Q FET IN                         #
        ITEM QFTOUT   I(03,00,60);  # Q FET OUT                        #
        ITEM QFTLIMIT I(04,42,18);  # Q FET LIMIT                      #
        END 
# 
* DC  DESCRIPTION 
* 
*     THIS ROUTINE REWINDS THE OUTPUT FILE. 
*     COPIES THE OUTPUT FILE TO A SCRATCH FILE. 
*     ROUTES THE SCRATCH FILE TO A PRINTER. 
*     REWINDS THE OUTPUT FILE AGAIN SO THAT IT WILL BE REWRITTEN
*     WITH NEW DB$LINE OUTPUT.
* 
*     THIS PERMITS LARGE VOLUMES OF ERROR MESSAGES TO BE USED BEFORE
*     CDCS TERMINATES.
* 
*     NOTE -
*     TO INCREASE THE EFFICIENCY OF THE COPY, DB$PROF USES A LARGER 
*     BUFFER THAN IS USED DURING NORMAL WRITES TO OUTPUT. 
*     IT USES THE SPACE FROM THE END OF THE FET DB$QFET TO HHA. 
*     THEREFORE THE FET  M-U-S-T  BE AT THE HIGH END OF THE OVERLAY.
 #
  
# 
*     NON-LOCAL VARIABLES  (NOT MODIFIED) 
# 
      XREF ITEM DB$HHAE I;   # HIGHEST HIGH ADDRESS DURING EXECUTION   #
  
# 
*     LOCAL VARIABLES 
# 
      ITEM ERRCODE I;        # ERROR CODE ON SYSTEM CALLS              #
      ITEM MSG1 C(40) = "  OUTPUT FILE ROUTED TO A PRINTER:"; 
      ITEM MSG2 C(50) = "  ERROR 00 WHILE REQUESTING A QUEUE DEVICE:";
      ITEM MSG3 C(40) = "  ERROR 00 WHILE ROUTING A PRINT FILE:"; 
      ITEM OFIRST  I;        # SAVE FIRST FROM DB$OFET                 #
      ITEM OLIMIT  I;        # SAVE LIMIT FROM DB$OFET                 #
      ITEM XR      I;        # INDUCTION VARIABLE                      #
      ITEM XX      I;        # INDUCTION VARIABLE                      #
  
      BASED ARRAY INBUF;
        BEGIN 
        ITEM INWORDS C(00,00,30);  # INPUT BUFFER WORDS                #
        END 
  
# 
*     STATUS DEFINITIONS
# 
      DEF DFSTATUS #FETLFNWD[0] LAN O"31"#;  # FET FILE POSITION BITS  #
      DEF DFSTEOI  #O"31"#;  # END-OF-INFORMATION                      #
      DEF DFSTEOR  #O"21"#;  # END-OF-RECORD                           #
      DEF DFSTFULL #O"11"#;  # BUFFER FULL STATUS                      #
  
  
  
#     B E G I N   D B $ P R O F   E X E C U T A B L E   C O D E .      #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("PROF");
      CONTROL ENDIF;
  
      DB$ERLC = 0;           # RESET THE ERROR LINE COUNT              #
  
      ERRCODE = DB$ROPQ;     # REQUEST A QUEUE DEVICE (NOS/BE)         #
      IF ERRCODE NQ 0 
      THEN
        BEGIN 
        B<54,6>MSG2 = B<57,3>ERRCODE + O"33"; 
        B<48,6>MSG2 = B<54,3>ERRCODE + O"33"; 
        DB$MSG(MSG2);        # ISSUE ERROR MESSAGE                     #
        RETURN;              # ABANDON ROUTING ATTEMPT                 #
  
        END 
      DB$LINE(0,-1);         # WRITE AN END-OF-RECORD ON THE OUTPUT    #
      FOR XX = XX WHILE NOT FETCOMP[0]
      DO
        BEGIN 
        DB$RCLM;
        END 
      DB$RWND(LOC(DB$OFET)); # REWIND THE OUTPUT FILE                  #
      FOR XX = XX WHILE NOT FETCOMP[0]
      DO
        BEGIN 
        DB$RCLM;
        END 
      OFIRST = FETFIRST[0]; 
      OLIMIT = FETLIMIT[0];  # SAVE BUFFER BOUNDS OF NORMAL OUTPUT BUF #
  
      CMMSDA(DB$HHAE);       # INCREASE DABA TO ENLARGE THE BUFFER     #
  
      FETLIMIT[0] = DB$HHAE -1;  # INITIALIZE BOTH FETS                #
      QFTLIMIT[0] = DB$HHAE -1; 
      FETFIRST[0] = QFTFIRST[0];
      FETIN[0]    = QFTFIRST[0];
      FETOUT[0]   = QFTFIRST[0];
      QFTIN[0]    = QFTFIRST[0];
      QFTOUT[0]   = QFTFIRST[0];
  
  
# 
*     COPY THE OUTPUT FILE TO THE FILE TO BE ROUTED TO THE PRINTER
# 
      DB$RDM(LOC(DB$OFET));  # DO AN INITIAL READ                      #
  
      FOR XR = XR WHILE DFSTATUS NQ DFSTEOI  # LOOP UNTIL END-OF-INFO  #
      DO
        BEGIN 
        FETOUT[0] = QFTOUT[0];
        QFTIN[0] = FETIN[0];
  
        IF NOT (QFTCOMP[0] OR FETCOMP[0]) 
        THEN
          BEGIN 
          DB$RCLM;           # WHEN BOTH FET'S ARE BUSY, RECALL        #
          TEST XR;           # THEN LOOP AGAIN                         #
  
          END 
        IF DFSTATUS EQ DFSTEOR
        THEN                 # AN END-OF-RECORD HAS BEEN READ          #
          BEGIN 
          FOR XX = XX WHILE NOT QFTCOMP[0]
          DO
            BEGIN 
            DB$RCLM;
            END 
          QFTIN[0] = FETIN[0];
          DB$WRRM(LOC(DB$QFET));   # WRITE AN END-OF-RECORD            #
          FOR XX = XX WHILE NOT QFTCOMP[0]
          DO
            BEGIN 
            DB$RCLM;
            END 
          FETOUT[0] = QFTOUT[0];
          DB$RDM(LOC(DB$OFET));    # READ NEXT SYSTEM LOGICAL RECORD   #
          END 
        IF QFTIN[0] NQ QFTOUT[0]
          AND QFTCOMP[0]
        THEN
          BEGIN 
          DB$WRTM(LOC(DB$QFET));   # INITIATE A WRITE                  #
          END 
        IF DFSTATUS EQ DFSTFULL 
        THEN                       # FULL BUFFER                       #
          BEGIN 
          DB$RCLM;                 # WAIT FOR WRITE TO START WRITING   #
          FETOUT[0] = QFTOUT[0];
          DB$RDM(LOC(DB$OFET));    # INITIATE A NEW READ               #
          END 
  
        END  # COPY LOOP #
  
# 
*     THE ABOVE LOOP TERMINATES ON AN END-OF-INFORMATION
# 
      FOR XX = XX WHILE NOT QFTCOMP[0]
      DO
        BEGIN 
        DB$RCLM;
        END 
      QFTIN[0] = FETIN[0];
      DB$WRRM(LOC(DB$QFET));       # WRITE FINAL END-OF-RECORD         #
      FOR XX = XX WHILE NOT QFTCOMP[0]
      DO
        BEGIN 
        DB$RCLM;
        END 
  
# 
*     RESTORE OUTPUT FET TO ITS NORMAL BUFFER 
# 
      FETFIRST[0] = OFIRST; 
      FETIN[0]    = OFIRST; 
      FETOUT[0]   = OFIRST; 
      FETLIMIT[0] = OLIMIT; 
  
      ERRCODE = DB$ROPM;           # ROUTE FILE TO PRINTER             #
      IF ERRCODE NQ 0 
      THEN
        BEGIN 
        B<48,6>MSG3 = B<54,3>ERRCODE + O"33"; 
        B<54,6>MSG3 = B<57,3>ERRCODE + O"33"; 
        DB$MSG(MSG3);        # ISSUE ERROR MESSAGE                     #
        DB$RTN(QFTLFNU[0]);  # RETURN THE ROUTING FILE                 #
        RETURN;              # ABANDON THE ROUTING ATTEMPT             #
  
        END 
      DB$MSG(MSG1); 
      DB$RWND(LOC(DB$OFET));       # REWIND OUTPUT                     #
  
# 
*     READ THE FIRST RECORD.
*     IF THE FIRST RECORD IS THE CDCS LISTING REWIND AGAIN
*     TO WRITE OVER IT. 
*     IF THE FIRST RECORD IS NOT THE CDCS LISTING, LEAVE
*     THE FILE POSITINED AT THE SECOND RECORD SO THE FIRST
*     ONE IS PRESERVED. 
*     A BANNER PAGE IS PRESERVED IF THERE IS ONE. 
# 
      DB$IORD(LOC(DB$OFET),OFIRST,64);
      FOR XX = XX WHILE NOT FETCOMP[0]
      DO
        BEGIN 
        DB$RCLM;
        END 
      P<INBUF> = OFIRST;
      IF DB$LINH EQ INWORDS[0]
      THEN
        BEGIN 
        DB$RWND(LOC(DB$OFET));     # REWIND OUTPUT AGAIN               #
        FOR XX = XX WHILE NOT FETCOMP[0]
        DO
          BEGIN 
          DB$RCLM;
          END 
        END 
# 
*     RESTORE OUTPUT FET AGAIN
# 
      FETFIRST[0] = OFIRST; 
      FETIN[0]    = OFIRST; 
      FETOUT[0]   = OFIRST; 
      FETLIMIT[0] = OLIMIT; 
  
      END 
      TERM
