*DECK QU1100
          IDENT  QU1100 
          COMMENT  INITIALIZATION OF OVERLAY 11-0 
QU1100    TITLE    QU1100 - INITIALIZATION OF OVERLAY 11-0
          ENTRY  QU1100 
          LIST   F
          LIST   -L                -*CALL MACRO- FOLLOWS
*CALL MACRO 
          LIST   L
          LIST   -L                -*CALL NUMOPT- FOLLOWS 
*CALL NUMOPT
          LIST   L
          LIST   -L                -*CALL ENVIRON- FOLLOWS
*CALL ENVIRON 
          LIST   L
          LIST   -L                -*CALL BASIC- FOLLOWS
*CALL BASIC 
          LIST   L
          IFEQ   OS$NAME,NOS
OPL       XTEXT  COMCMAC
OPL       XTEXT  COMCCMD     CENTRAL PROCESSOR MACROS FOR NOS 
          ENDIF 
 LEVEL    MICRO  1,,_871  PSRLEVEL
  
          IFC    NE,#"MODLEVEL"#"JDATE"#,1
 LEVEL    MICRO  1,,#"MODLEVEL"#  USE LEVEL GIVEN ON COMPASS CARD 
 VERSION  MICRO  1,,#3.4#    QU VERSION NUMBER
          SPACE  10 
QU1100    JP     *+400000B
          RJ     CLEAR             CLEAR COMMON CBASIC (COPYRIGHT INFO) 
          RJ     =XINITIAL
          IFEQ   OS$NAME,NOS
          SA1    TERMINAL 
          ZR     X1,LEAVE      IF TERMINAL
          PROMPT OFF          NOS PROMPT OFF AS DEFAULT 
          SA1    =XOPROCES
          ZR     X1,LEAVE      AND O=LFN USED,
          PROMPT ON           THEN TURN NOS PROMPT ON.
  
LEAVE     BSS    0
          ENDIF 
          EQ     QU1100 
          SPACE  4
 CLEAR    JP     *+1S17            CLEAR COMMON CBASIC
          SB1    1
          SB2    CBASIC            FWA OF COMMON CBASIC 
          SB3    CBASIC.           LWA+1 OF COMMON CBASIC 
          MX6    0
 CLEAR1   SA6    B2                CLEAR THIS WORD
          SB2    B2+B1             ADDRESS OF NEXT WORD TO CLEAR
          LT     B2,B3,CLEAR1      IF NEXT WORD IS IN CBASIC
          EQ     CLEAR
          SPACE  5
          EJECT 
          ENTRY  CALLCMM
  
  
*         C A L L C M M 
  
**             THIS SUBROUTINE PASSES THE ADDRESS OF THE QU ERROR 
*         EXIT ROUTINE TO CMM AND CAUSES CMM TO USE ALL THE AVAILABLE 
*         FREE SPACE (INSTEAD OF THE DEFAULT 95%) 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         CALLS  CMM.OWN
* 
*         USES   X1 
* 
  
 CALLCMM  SUBR               ENTRY/EXIT 
          SX1    =XQUERR     ADDRESS OF QU ERROR ROUTINE
          RJ     =XCMM.OWN
          EQ     CALLCMM
          SPACE  4
          ENTRY  CALLRPV
          EXT    ABTADDR
CALLRPV   JP     *+400000B
          SA1    RPV1              SET LENGTH IN PARAM BLOCK
          BX6    X1 
          SA6    ABTADDR
          REPRIEVE   ABTADDR,SETUP,277B 
          EQ     CALLRPV
          SPACE  5
 RPV1     VFD    36/0,12/31B,2/0,9/1,1/0
*CALL IDP=COM 
          EJECT 
          ENTRY  TTYSTAT
BATMODE   EQU    0                VALUE OF -TERMINAL- IF BATCH JOB
TTYMODE   EQU    1                  IF TTY JOB
          IFEQ  OS$NAME,SCOPE 
TTYSTAT   JP     *+400000B
          MX6    0
          SA6    =XRWESTAT   CLEAR RWE STATUS WORD BEFORE RWE CALL
          SYSTEM RWE,RECALL,A6
          EQ     TTYSTAT     RETURN 
          ENDIF 
          SPACE  5
          IFEQ   OS$NAME,NOS
TTYSTAT   JP     *+400000B
          USERNUM INTUSID          GET USED ID
          SA1    66B
          MX0    48 
          LX1    36 
          BX1    -X0*X1            PULL OUT JOB ORIGIN TYPE 
          SX1    X1-3              NOW TEST FOR TTY 
          ZR     X1,INT            IF TXOT, THEN INTERACTIVE MODE 
          SX7    BATMODE           SET BATCH MODE 
          SA7    TERMINAL 
          SX7    1
          SA7    BATCHMD
          EQ     TTYSTAT
INT       SX7    TTYMODE           SET INTERACTIVE MODE 
          SA7    TERMINAL 
          EQ     TTYSTAT
          ENDIF 
          IFEQ   OS$NAME,SCOPE
          SPACE  5
          ENTRY  CONZIN 
          ENTRY  CONZOU 
CONZIN    JP     *+400000B
          SA1    CONREQI           CONNECT THE -INPUT- FILE 
          BX6    X1 
          RJ     =XSYS= 
          EQ     CONZIN 
          SPACE  2
CONREQI   VFD    24/4LCONP,36/INCON 
INCON     VFD    42/7LZZZZZIN,18/0
          SPACE  5
CONZOU    JP     *+400000B
          SA1    CONREQO      CONNECT THE -OUTPUT- FILE 
          BX6    X1 
          RJ     =XSYS= 
          EQ     CONZOU 
          SPACE  2
CONREQO   VFD    24/4LCONP,36/OUTCON
OUTCON    VFD    42/7LZZZZZOU,18/0
          ENDIF 
          SPACE  4,8
***       GETJN  - GET JOB NAME 
* 
*         ENTRY  (X1) = ADDRESS OF WHERE TO STORE JOB NAME
* 
*         EXIT   NONE 
* 
*         CALLS  GETJN MACRO
* 
*         USES   ALL
          SPACE  4
 GETJN    IFEQ   OS$NAME,SCOPE
 GETJN    MACRO  ADDR              LEAVES JOB NAME IN ADDR
          LOCAL  STATUS,LEAVE 
          SX5    ADDR        SAVE ADDRESS FOR RETURN OF NAME
          SYSTEM ACT,RECALL,STATUS  READ A WORD OF CP AREA WITH ACT 
          SA1    STATUS+1          (X1) = CONTS OF CP WORD 25B
          MX6    42 
          BX6    X6*X1             (X6) = 42/JOBNAME,18/0 
          SA6    X5                STORE FOR THE CALLER 
          EQ     LEAVE             JUMP AROUND STATUS WORDS 
* 
 STATUS   VFD    6/0,18/25B+1S17,12/1,12/0,12/10B     FETCH CP+25B
          BSSZ   1                 WORD TO RECIEVE CP+25B 
 LEAVE    BSS    0                 JUMP HERE TO AVOID STATUS WORDS
          ENDM
 GETJN    ENDIF 
          SPACE  4
          ENTRY  GETJN
 GETJN    SUBR                     ENTRY/EXIT 
          GETJN  X1                ((X1)) = JOBNAME, L-JUST, ZERO-FILL
          EQ     GETJN
          SPACE  3                                                       FEAT157
          IFEQ   OS$NAME,NOS                                             FEAT157
          ENTRY  REQUEST                                                 FEAT157
 REQUEST  JP     *+1S17                                                  FEAT157
          SX2    X1                (X2) = FET ADDRESS                    FEAT157
          SA5    X2+1              WORD OF FET WITH EP BIT               FEAT157
          SX0    4                                                       FEAT157
          LX0    42                POSITION AS EP BIT                    FEAT157
          BX6    X0+X5             ADD IN EP BIT                         FEAT157
          SA6    A5                REPLACE WORD                          FEAT157
          SX7    15B               CODE FOR REQUEST                      FEAT157
          RJ     =XLFM=            ISSUE REQUEST                         FEAT157
          BX6    X5                FET+1 WORD BEFORE EP FORCED           FEAT157
          SA6    A5                REPLACE THE WORD                      FEAT157
          EQ     REQUEST                                                 FEAT157
          ENDIF                                                          FEAT157
          SPACE  5
          ENTRY  MESSAGE
MESSAGE   JP     *+400000B          SEND A MESSAGE TO USER/DAYFILE
          MESSAGE  X1,,RECALL 
          EQ     MESSAGE
          SPACE  6
          IFEQ   OS$NAME,SCOPE
          SST 
*  THIS CODE IS A TEMPORARY KLUGE. IF QU HAS SYSTEM PRIVELEGES (LOADED
*   FROM SYSTEM LIBRARY), IAP DOES NOT SCREEN OUT CERTAIN RISKY CONTROL 
*   CARDS (EG. LOGIN,LOGOUT,EDITOR, ETC.). BY SETTING THE SYSTEM PROTECT
*   BIT, WE MAKE SURE IAP SCREENS OUT THOSE CONTROL CARDS. THIS CODE CAN
*   BE PULLED AS SOON AS IAP GETS A BETTER METHOD OF ACCESS CHECKING, OR
*   WITH THE IMPLEMENTATION OF A COMMON CONTROL LANGUAGE. THIS CODE IS
*   IN SUPPORT OF THE USAGE OF IAP FOR THE -OS- DIRECTIVE (OSEXEC). 
*   NOS DOES NOT HAVE THIS PROBLEM SINCE WE WORK WITH MACROS FOR USERS. 
*   ASSEMBLY OF THIS CODE ON NOS/BE REQUIRES PPTEXT TO BE ADDED TO OUR
*   LIST OF OTHER TEXTS.
          SPACE  2
          ENTRY  SYSPROT           KNOWN FROM SYMPL AS -SYSPROTECT- 
*                                  TO SET THE SYSTEM PROTECT BIT
 SYSPROT  JP     *+1S17 
          SYSTEM LDL,RECALL,SYSPROTA   GET LDL TO SET SYSTEM PROTECT BIT
          EQ     SYSPROT
          SPACE  2
 SYSPROTA VFD    27/1,6/S.CPLP,3/C.CPLP,12/W.CPLDR1,12/0
          ENDIF 
          SPACE  5                                                       FEAT157
          ENTRY  DIE                                                     FEAT157
 DIE      JP     *+400000B         ABORT QU... USED IF CONTROL CARD      FEAT157
          ABORT                                ERRORS ARE *FATAL*        FEAT157
          SPACE  4,10 
          ENTRY  RETURNM
 RETURNM  DATA   0
          SX2    174B              RETURN/UNLOAD CIO CODE 
          RJ     CALLCIO           GO PROCESS THE REQUEST(S)
+         EQ     RETURNM           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    =XTPROCES
          ZR     X2,CHKLOOP1       IF NO TRACE FILE 
          SA2    =XTFILE           (X2) = WORD 0 OF TRACE FILE FET
          BX3    X0*X2             (X3) = LFN OF TRACE FILE 
          BX3    X6-X3
          NZ     X3,CHKLOOP1       IF NOT CALLED TO REW/RET TRACE FILE
          SA2    A2+2              (X2) = IN POINTER FOR TRACE FILE 
          SX7    X2 
          SA7    A2+1              STORE AS IN=OUT, OR, BUFFER EMPTY
 CHKLOOP1 SA2    SAVCODE           GET CIO CODE FOR THIS LFN
          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
  
  
PARAMLT   BSS    1
PARAMCT   BSS    1
 SAVCODE  BSS    1           TO HOLD CIO CODE 
  
  
          ENTRY  ZZZZZQ2     FIT FOR THE CATALOG OF REPORTS AND SESSIONS000240
          EXT    FORTCOL
 ZZZZZQ2  FILE   FO=IS,KT=S,KL=10,DCT=FORTCOL,ORG=NEW,EFC=3,EMK=YES 
 SETLOF   SPACE  4,10 
***       SETLOF - SET LIST-OF-FILES LOCATION 
* 
*         ENTRY  (A1) = POINTER TO PARAMETER LIST 
*                CALLING SEQUENCE - (LOF) 
*                WHERE *LOF* IS THE LIST-OF-FILES 
* 
*         CALLS  SETLOF MACRO 
  
  
          ENTRY  SETLOF 
 SETLOF   SUBR               ENTRY/EXIT 
          SA1    A1          (X1) = ADDRESS OF LIST OF FILES
          MX0    42 
          BX6    -X0*X1 
          LX6    30D         (X6) = 30/LOF,30/0 
          SA6    SETLOFA     STORE SETLOF MACRO PARAM WORD
          SETLOF SETLOFA,RCL  SET LIST OF FILES LOCATION
          EQ     SETLOF 
  
  
 SETLOFA  BSSZ   1           SETLOF PARAMETER WORD
          EJECT 
          ENTRY  WRTRDY 
************************************************************************
*         WRTRDY                   PERFORMS THE INITIAL WRITE FOR THIS *
*                                  QU RUN. IT REQUIRES THAT BUFFERS    *
*                                  HAVE BEEN SET UP FOR -OUTPUT- AND   *
*                                  POSSIBLY -TFILE-. ASSUMES THE FETS  *
*                                  ARE INITIALIZED WITH IN=OUT=FIRST.  *
*                                  THE -QURDY- MESSAGE IS INSERTED INTO*
*                                  THE BUFFER, THE -IN- POINTER IS THEN*
*                                  UPDATED , AND THE -WRITE MACRO DOES *
*                                  THE REST. THIS INITIALIZATION IS RE-*
*                                  QUIRED BY THE I/O MACROES USED IN   *
*                                  -QU2IO-.                            *
************************************************************************
          SPACE  2
 WRTRDY   JP     *+400000B   ENTRY/EXIT 
          SB1    1
          SA1    =XQU$RPT    GET REPORT FLAG
          ZR     X1,WRTRDY.0  IF NOT REPORT 
          WRITEC  =XOUTPUT,JPD  WRITE PRINT DENSITY 
          WRITEC  =XOUTPUT,RDY  WRITE REPORT READY
          WRITE  X2,RCL      FLUSH OUTPUT BUFFER
          EQ     WRTRDY      EXIT 
 WRTRDY.0 BSS    0
          SA1    DATE 
          SA2    TIME 
          BX6    X1 
          BX7    X2 
          SA6    QUDATE      MOVE DATE AND TIME INTO MESSAGE
          SA7    QUTIME 
          SA1    =XTPROCES
          ZR     X1,WRTRDY0        IF NO TRACE FILE 
          WRITEC  =XTFILE,JPD  WRITE PRINT DENSITY
          SA5    =XTFILE     (A5) = TRACE FILE FET
          RJ     WRTRDY1           WRITE THE MESSAGE TO THIS FET
 WRTRDY0  BSS    0
          SA1    TERMINAL 
          NZ     X1,WRTRDY.1  IF NOT BATCH
          WRITEC  =XOUTPUT,JPD  WRITE PRINT DENSITY 
 WRTRDY.1 BSS    0
          IFEQ   OS$NAME,NOS
          SA1    TERMINAL 
          ZR     X1,WRTRDY0A       IF BATCH MODE
          SA1    =XOPROCES
          NZ     X1,WRTRDY0A       IF NON-CONNECTED OUTPUT FILE 
          SA1    QURDY
          SX2    1R -1R1           CHANGE *1* TO * * IN QU MESSAGE
          LX2    -6 
          IX6    X1+X2
          SA6    A1 
          ENDIF 
 WRTRDY0A SA5    =XOUTPUT          (A5) = OUTPUT FILE FET 
          RJ     WRTRDY1           WRITE THE MESSAGE TO THIS FET
 PAGEWAIT IFEQ   OS$NAME,SCOPE
          SA1    TERMINAL 
          ZR     X1,WRTRDY0B IF BATCH MODE
          SA1    =XIPROCES
          NZ     X1,WRTRDY0B IF NON-CONNECTED INPUT FILE
          SA1    =XOPROCES
          NZ     X1,WRTRDY0B IF NON-CONNECTED OUTPUT FILE 
          WRITEC (=XOUTPUT),(=C*Q*) CLEAR INTERCOM AUTO PAGE-WAIT 
 WRTRDY0B BSS    0
 PAGEWAIT ENDIF 
          EQ     WRTRDY            RETURN 
          SPACE  3
 WRTRDY1  JP     *+400000B   ENTRY/EXIT..SUBR TO WRITE QURDY TO FET (A5)
          SA1    A5+2              (A5) = FET ADDR.  +2 IS -IN- PTR 
          SB2    QURDYLG           (B2) = NO. WORDS OF MESSAGE TO MOVE
          SA4    QURDY             FETCH FIRST WORD OF MESSAGE
          BX6    X4                (X4) HAS FIRST WORD OF MESSAGE 
          SA6    X1                (X1) = FWA OF BUFFER (-IN- PTR)
 WRTRDY2  SB2    B2-B1             DECREMENT NO. WORDS TO BE MOVED
          ZR     B2,WRTRDY3        IF NO MORE WORDS TO MOVE...WRITE 
          SA4    A4+B1             (A4) = ADDR OF PREV. WORD OF MSG 
          BX6    X4                (X4) = NEXT WORD OF MSG
          SA6    A6+B1             STORE IN NEXT WORD OF BUFFER 
          EQ     WRTRDY2           FINISHED WITH ANOTHER WORD 
          SPACE  1
 WRTRDY3  SX7    A6+B1             (X7) = ADDR OF NEXT UNFILLED BFR WORD
          SA7    A1                (A1) = ADDR OF -IN- POINTER
          WRITE  A5,RECALL         (A5) = ADDR OF FET 
          EQ     WRTRDY1           RETURN..THIS MESSAGE WRITTEN 
          SPACE  2
 JPD      DATA   8LS 6 LPI   JOB PRINT DENSITY PRESET TO 6 LINES/INCH 
 RDY      DATA   C/0REPORT UTILITY PROGRAM./
 QURDY    DATA   H*1QUERY UPDATE "VERSION" "LEVEL"-"JDATE" *
 QUDATE   DATA   0           DATE 
 QUTIME   DATA   0           TIME 
          DATA   0           END OF MESSAGE 
 QURDYLG  EQU    *-QURDY     THIS CARD MUST IMMEDIATELY FOLLOW -QURDY-
*                            IT IS USED FOR LENGTH CALCULATION
          SPACE  4,8
***       GETPAGE - GET PAGE SIZE 
* 
*         THIS SUBROUTINE OBTAINS THE CURRENT JOB PAGE SIZE AND SETS
*         THE GLOBAL VARIABLE *NBLINES* TO JOB PAGE LENGTH ,  THE 
*         VARIABLE *CHPLIN* TO JOB PAGE WIDTH. FURTHER THE FORMAT 
*         EFFECTOR *JPD* IS INITIALIZED TO 6 OR 8 LPI DEPENDING ON
*         THE JOB PRINT DENSITY.
* 
  
          ENTRY  GETPAGE
  
 GETPAGE  SUBR               ENTRY/EXIT  FOR GET PAGE SIZE
          GETPAGE  PGSIZE    GET PAGE SIZE PARAMETERS 
          SA3    PGSIZE      GET JOB PAGE SIZE PARAMETERS 
          MX0    -4 
          LX3    59-27       POSITION JPD 
          BX6    -X0*X3 
          SB7    X6-8 
          MX0    -8 
          LX3    8           POSITION JPS 
          BX6    -X0*X3 
          SA6    NBLINES     SET JPS
          LX3    8           POSITION JPW 
          BX6    -X0*X3 
          SA6    CHPLIN      SET JPW
          NZ     B7,GETPAGE  IF PRINT DENSITY IS NOT 8 LPI EXIT 
          SA3    FE8L        GET 8 LPI FORMAT EFFECTOR
          BX6    X3 
          SA6    JPD
          EQ     GETPAGE     EXIT 
  
 PGSIZE   BSSZ   2           PAGE SIZE PARAMETER BLOCK
 FE8L     DATA   8LT 8 LPI   8 LINES/INCH FORMAT EFFECTOR 
          EJECT 
          END    QU1100 
