*DECK QU4000
          IDENT  QU4000 
          COMMENT  INITIALIZATION OF OVERLAY 40-0 
QU4000    TITLE    QU4000 - INITIALIZATION OF OVERLAY 40-0
          LIST   -L                *CALL ENVIRON FOLLOWS
*CALL ENVIRON 
          LIST   L
          LIST   -L                *CALL BASIC FOLLOWS
*CALL BASIC 
          LIST   L
          LIST   -L                *CALL MACRO FOLLOWS
*CALL MACRO 
          LIST   L
          LIST   -L                * CALL TO NUMOPT FOLLOWS * 
*CALL NUMOPT
          LIST   L
          SST 
          LIST   F
          SPACE  4,10 
**        CAPSULE LIST FOR (40,0).
  
  
 CAPLIST  CAPSULE CAPLOG     DATA BASE LOGGING
          CAPSULE CREINIT    *CREATE* INITIALIZATION
          CAPSULE USINGEX    *USINGEX* OPTION PROCESSING
          CON    0           END OF LIST
          SPACE  4,10 
**        CAPSULE ENTRY POINTS. 
* 
*                THESE ENTRY POINTS MUST BE IN ALPHABETIC ORDER FOR FDL.
  
  
 CAPLOG   INCAP  CAPLOG,QU4000  DATA BASE LOGGING 
 CREINIT  INCAP  CREINIT,QU4000  *CREATE* INITIALIZATION
 FROMERR  INCAP  USINGEX,QU4000  ERROR PROCESSING FOR *FROM* FILE 
 USINGEX  INCAP  USINGEX,QU4000  *USING* OPTION PROCESSING
          SPACE  4,10 
**        ENTRY POINT PASSLOC LIST FOR (40,0).
  
  
 ENTLIST  PASSLOC            BUILD ENTRY POINT PASSLOC LIST HERE
          SPACE  4,10 
**        EXTERNAL PASSLOC LIST FOR (40,0). 
* 
*                THESE EXTERNALS MUST BE IN ALPHABETIC ORDER FOR FDL. 
  
  
          PASS   AKCHPOS,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   AKITORD,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   AKLNGTH,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   AKTYPE,X    REQUIRED BY CAPSULE *USINGEX*
          PASS   AKWOPOS,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   ALKEYLO,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   BIMAGE,X    REQUIRED BY CAPSULE *CAPLOG* 
          PASS   CALLOWN,X   REQUIRED BY CAPSULE *CREINIT*
          PASS   CLOSEM,X    REQUIRED BY CAPSULE *CAPLOG* AND *CREINIT* 
          PASS   CMM$FGR,X   REQUIRED BY CAPSULE *CREINIT*
          PASS   FIGSUB2,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   FIGSUB3,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   GET,X       REQUIRED BY CAPSULE *USINGEX*
          PASS   IMFDBM,X    REQUIRED BY CAPSULE *USINGEX*
          PASS   LGBIMAG,X   REQUIRED BY CAPSULE *CAPLOG* 
          PASS   MKL,X       REQUIRED BY CAPSULE *USINGEX*
          PASS   MKT,X       REQUIRED BY CAPSULE *USINGEX*
          PASS   NEWDATA,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   NEXTON,X    REQUIRED BY CAPSULE *USINGEX*
          PASS   ONALTER,X   REQUIRED BY CAPSULE *USINGEX*
          PASS   OPENM,X     REQUIRED BY CAPSULE *CAPLOG* AND *CREINIT* 
          PASS   P,X         REQUIRED BY CAPSULE *USINGEX*
          PASS   TIMES,X     REQUIRED BY CAPSULE *USINGEX*
 EXTLIST  PASSLOC            BUILD PASSLOC TABLE HERE 
          SPACE  4,10 
**        GLOBAL DECLARATIONS.
  
  
 P1       CON    CAPLIST     ALTERNATE CAPSULE LIST 
          CON    ENTLIST     ALTERNATE ENTRY POINT PASSLOC LIST 
          CON    EXTLIST     ALTERNATE EXTERNAL PASSLOC LIST
 QU4000   SPACE  4,10 
***       QU4000 - MAIN ENTRY POINT FOR (40,0) OVERLAY. 
  
  
          ENTRY  EXITCTL     EXIT (40,0) BY LOADING (1,0) 
 QU4000   SUBR   =           ENTRY
          SX6    =XAUTOPSY   SET UP *AUTOPSY* FOR ABORT PROCESSING
          SA6    =XAUTLOC                                               000300
          SA1    P1 
          RJ     =XQU.LNK    LINK UP ALTERNATE CAPSULE LISTS
          RJ     =XQUCLOCK   UPDATE CURRENT-TIME (MAYBE DATE, TOO ) 
          RJ     =XDBP$LNK         LINK UP CRM ROUTINES FOR DBP-S 
  
          SA1    INDEX       TO TEST IF CTL40 OR USEOPEN IS CALLED
          NZ     X1,QU41
 EXITCTL  RJ     =XCTL40     EXECUTE BASIC DIRECTIVES 
QU42      SX6    1           THEN RELOAD OVERLAY 1-0
          SA6    =XPRIMARY
          RJ     =XLOADX0 
*         --     ------    UNCONDITIONAL EXIT BY OVERLAY LOAD 
  
QU4ERR    ABORT              ABORT IF RETURN HERE OR INDEX VALUE WRONG
* 
QU41      SX1    X1-1 
          NZ     X1,QU4ERR   IF ILLEGAL CALL TO (40,0) OVERLAY
          RJ     =XCREINIT   COMPLETE THE CREATE DIRECTIVE PROCESSING 
          EQ     QU42        THEN RELOAD 1-0
          SPACE  3                                                      000390
 SAVCODE  CON    0
 PARAMLT  CON    0
 PARAMCT  CON    0
 RTNADDR  CON    0
          SPACE  5
          LIST   -L     *CALL COSPACE FOLLOWS. SEE LISTING IN QU10
          LIST   L
          ENTRY  RETURNM
 RETURNM  DATA   0
          SX2    174B              RETURN/UNLOAD CIO CODE 
          RJ     CALLCIO           GO PROCESS THE REQUEST(S)
+         EQ     RETURNM           EXIT 
* 
* 
          ENTRY REWINDM 
REWINDM   DATA   0                 ENTRY TO REWIND A LIST OF FILES
          SX2    50B               REWIND CIO CODE
          RJ     CALLCIO
+         EQ     REWINDM           EXIT 
* 
* 
CALLCIO   DATA   0
          BX6    X2 
          SA6    SAVCODE           SAVE THE CIO CODE FOR ALL REQUESTS 
          SX6    A1                GO GET PARAMETER LIST
          SA6    PARAMLT           LIMIT
          SX6    1                 AND
          SA6    PARAMCT           COUNT
CHKLOOP ZR X1,CALLCIO 
          SA1    X1 
          MX0    42                MASK FOR LFN 
          BX6    X0*X1             NASK JUST 7 CHAR 
          SA2    SAVCODE           GET THE CIO CODE TO BE DONE ON THIS L
          BX6    X6+X2             MERGE IN CIO CODE
          SA6    DUMYFET
          SX6    DUMYFET
          SA5    CIOP 
          BX6    X6+X5
          EXT    CIOWD
          SA6    CIOWD
          RJ     =XCIOREQ       GO DO AN RA+1 REQUEST 
          SA2    PARAMCT           GET LIST POINTERS
          SA3    PARAMLT
          IX1    X2+X3             UPDATE 
          SA1    X1 
          SX6    X2+1 
          SA6    A2                AND
          EQ     CHKLOOP           LOOP FOR MORE LFN-S
CIOP      VFD    18/3LCIO,3/2,39/0
 DUMYFET  BSS     1                                                     006300
          DATA    100B    FIRST                                         006310
          DATA    100B    IN                                            006320
          DATA    101B    OUT                                           006330
          DATA    200B    LIMIT                                         006340
*CALL ATTACH
          ENTRY   EXTEND                                                005310
 EXTEND   DATA    0                                                     005320
          IFEQ   OS$NAME,KRONOS 
*       A NO-OP UNTIL I FIGURE OUT WHAT TO DO WITH EXTEND CALLS 
          ENDIF 
          IFEQ   OS$NAME,SCOPE
          SA2     EXT                                                   005330
          SX3     30B                                                   005340
          RJ      PFIO                                                  005350
          ENDIF 
          EQ      EXTEND                                                005360
          IFEQ   OS$NAME,SCOPE
 PFIO     DATA    0                                                     005370
          SX1    X1+4        LOCATE LFN ADDRESS IN FDB
          BX7     X2+X1                                                 005380
          SA4     A1+1                                                  005390
          BX6     X4                                                    005400
          SA6     RTNADDR                                               005410
          SA1     X1                                                    005420
          SA5     TERMINAL                                              005430
          ZR      X5,BATCHMO                                            005440
          SX3     X3+200B                                               005450
 BATCHMO  BSS     0                                                     005460
          MX0     42                                                    005470
          BX0     X0*X1                                                 005480
          BX6     X0+X3                                                 005490
          SA6     A1                                                    005500
          SB1     1                                                     005510
+         SA5     B1                                                    005520
          NZ      X5,*                                                  005530
          SA7     B1                                                    005540
          SA5    66B
          PL     X5,NOXJ
          XJ
* 
NOXJ      BSS    0
+         SA5     B1                                                    005550
          NZ      X5,*                                                  005560
          SA2     A1                                                    005570
          BX7     X2                                                    005580
          AX2     9                                                     005590
          MX0     51                                                    005600
          BX6     -X0*X2                                                005610
          SA2     RTNADDR                                               005620
          SA6     X2                                                    005630
          EQ      PFIO                                                  005640
 EXT      VFD     18/3LPFE,2/1,40/0                                     005660
          ENDIF 
          SPACE  3
          ENTRY  KEYFLFI
 KEYFLFI  FILE   FO=SQ,BT=C,RT=S,BFS=257,MRL=0,MBL=630,EFC=3
*CALL CKININF 
  
          END    QU4000 
