*DECK,QACRESP 
USETEXT COMCBEG 
USETEXT COMCCAE 
USETEXT COMQCAF 
USETEXT COMQCIO 
USETEXT COMQDEF 
USETEXT COMQDSP 
USETEXT COMQFIL 
USETEXT COMQKDS 
USETEXT COMQPID 
USETEXT COMQQAC 
USETEXT COMQSCH 
USETEXT COMQSEL 
    PROC QACRESP; 
      BEGIN    # QACRESP #
# 
**    QACRESP    PROCESS QAC/QAF RESPONSE.
* 
*     QACRESP PROCESSES A COMPLETED QAC/QAF ACQUIRE CALL TO GET 
*     A FILE FOR A VACANT ENTRY IN THE ACTIVE FILE TABLE. 
* 
*     PROC QACRESP
* 
*     ENTRY      FILETAB = AFT ENTRY. 
*                QAC/QAF CALL COMPLETE. 
*                FILESEL = SELECTION CLASS OF FILE. 
*                PLTHDR = PID ENTRY.
* 
*     EXIT       FILEQAR = QACRESP RESPONSE STATE.
*                FILETAB UPDATED. 
*                ROUTING TEXTS GENERATED, IF ACCEPTABLE FILE. 
*                PID.SELECTION-CLASS.IN-USE SET IF FILE FOUND.
*                PID.SELECTION-CLASS.COVERED SET FOR ALL COVERED
*                    CLASSES IF NO FILE FOUND.
* 
*     PROCESS    IF QAC/QAF ERROR:  
*                  IF ERROR CODE = NO FILE FOUND: 
*                    SET NO FILE FOUND RESPONSE.
*                  ELSE:  
*                    CALL CONERR TO TERMINATE CONNECTION
*                    SET NO FILE FOUND RESPONSE.
*                  RETURN.
*                SET UP AFT ENTRY.
*                IF DISPOSITION CODE RECOGNIZED:  
*                  BUILD ROUTING TEXTS. 
*                ELSE 
*                  CALL USRERR AND SENDCLF TO NOTIFY USER/EVICT FILE. 
* 
# 
  
# 
****  XREF
# 
      XREF
        BEGIN 
        PROC CALLSYS;              # MAKE RA+1 REQUEST #
        FUNC CHKCMM     U;         # ALLOCATE CMM BLOCK # 
        PROC CMMAGR;               # ASSIGN CMM GROUP # 
        PROC CONERR;               # PROCESS CONNECTION ERROR # 
        PROC CONLOG;               # LOG CONNECTION MESSAGE # 
        PROC DUDI;                 # DETERMINE INITIAL DD # 
        PROC GENERT;               # GENERATE EXPLICIT ROUTING TEXT # 
        PROC GENIRT;               # GENERATE IMPLICIT ROUTING TEXT # 
        PROC GENSRT;               # GENERATE SYSTEMS ROUTING TEXT #
        PROC MOVEI;                # MOVE WORDS # 
        PROC NAME;                 # DEBUG CODE # 
        FUNC PRUCNT     U;         # DETERMINE SIZE OF FILE # 
        PROC REQQDEV;              # ASSIGN FILE TO QUEUE DEVICE #
        PROC RTNFIL;               # RETURN FILE #
        PROC SENDCLF;              # SEND CON LOG FILE / EVICT FILE # 
        PROC USRDSC;               # DECREMENT USER SECURITY COUNT #
        PROC USRERR;               # PROCESS USER ERROR # 
        FUNC VALFN      C(10);     # VALIDATE FILE NAME # 
        FUNC YCDZ       C(10);     # CONVERT BIN TO DECIMAL DPC # 
        FUNC XCOD       C(10);     # CONVERT BIN TO OCTAL DPC # 
        END 
# 
****  XREF END
# 
  
  
  
      DEF LEMSGACQ   #32#;
      ARRAY EMSGACQ    S(4);
        BEGIN 
        ITEM $DACQ1     C(00,00,13) = ["ACQUIRED, DC="];
        ITEM EMSGACQDC  C(01,18,02);
        ITEM $DACQ2     C(01,30,05) = [", ST="];
        ITEM EMSGACQST  C(02,00,03);
        ITEM EMSGACQ3A  C(02,18,09);
        ITEM EMSGACQ3   C(02,18,05);
        ITEM EMSGACQDO  C(02,48,03);
        ITEM EMSGACQ4   C(03,06,01);
        END 
  
      DEF LEMSGAQE   #37#;
      ARRAY EMSGAQE    S(4);
        BEGIN 
        ITEM $DAQE      C(00,00,37) = 
                 ["UNEXPECTED ACQUIRE ERROR CODE =     B."];
        ITEM EMSGAQEEC  C(03,12,03);
        END 
  
      ARRAY S(1); 
        BEGIN 
        ITEM DUMWORD    C(00,00,10);
        ITEM DUMWDL7    C(00,00,07);
        ITEM DUMWDR3    C(00,42,03);
        ITEM DUMWDR2    C(00,48,02);
        END 
  
      DEF LEMSGIQF   #30#;
      ITEM EMSGIQF    C(LEMSGIQF) = "UNRECOGNIZED DISPOSITION CODE."; 
  
    CONTROL IFEQ OS$NOS;
  
      ARRAY ASCL [0:MXSC] S(1);    # SERVICE CLASS #
        BEGIN 
        ITEM SCL        C(00,00,02);  # DSP SERVICE CLASS # 
        ITEM SCLF       C(00,18,01);  # QAC SERVICE CLASS # 
        ITEM SCLW       C(00,00,04) = [ 
                  "SY-S"           # SYSTEM # 
                 ,"BC-B"           # BATCH #
                 ,"RB-R"           # REMOTE BATCH # 
                 ,"TS-T"           # INTERACTIVE #
                 ,"DI-D"           # DETACHED INTERACTIVE # 
                 ,"NS-N"           # NETWORK SERVICE #
                 ,"SS-X"           # SUBSYSTEM #
                 ,"MA-M"           # MAINTENCE #
                 ,"CT-C"           # COMMUNICATION TASK # 
                 ,"I0-0"           # INSTALLATION CLASS 0 # 
                 ,"I1-1"           # INSTALLATION CLASS 1 # 
                 ,"I2-2"           # INSTALLATION CLASS 2 # 
                 ,"I3-3"           # INSTALLATION CLASS 3 # 
                 ,"I4-4"           # INSTALLATION CLASS 4 # 
                 ,"I5-5"           # INSTALLATION CLASS 5 # 
                 ,"I6-6"           # INSTALLATION CLASS 6 # 
                 ,"I7-7"           # INSTALLATION CLASS 7 # 
                 ,"I8-8"           # INSTALLATION CLASS 8 # 
                 ,"DS-A"           # DEADSTART SEQUENCING # 
                 ,"BC-*"           # SENTINEL - DEFAULT # 
                 ]; 
        END 
  
    CONTROL ENDIF;
  
      ITEM I          I;
      ITEM K          I;
  
  
      $BEGIN
      NAME("QACRESP");
      $END
  
      I = QACBERR;                 # GET ERROR CODE # 
  
    CONTROL IFEQ OS$NOSBE;
      IF QACBF17                   # IF PREDAYFILE EXISTS # 
      THEN
        BEGIN 
        RTNFIL (QACBPDFC,TRUE);    # EVICT IT # 
        END 
  
    CONTROL ENDIF;
  
      IF I NE 0                    # IF ERROR # 
      THEN
        BEGIN 
        IF NOT ( (I EQ QACNFFERR)  # IF NOT (FILE NOT FOUND # 
          OR (I EQ QACNOFNTS)      #   OR NO FNT SPACE #
          OR (I EQ QACDUPLFN) )    #   OR DUPLICATE LFN) ERRORS # 
        THEN
          BEGIN 
          DUMWORD = XCOD(I);       # CONVERT ERROR CODE # 
          EMSGAQEEC = DUMWDR3;
          CONERR(LOC(EMSGAQE),LEMSGAQE);
          END 
  
        IF QACBLFNU NE 0           # IF LFN EXISTS #
        THEN
          BEGIN 
          RTNFIL(QACBLFN, FALSE);  # TRY TO REQUEUE # 
          QACBLFNU = 0; 
          END 
  
        PLTSCCOVER = PLTSCCOVER LOR SEL$COVERS[FILESEL];
        FILECER = FALSE;
        FILEQAR = QAR$FILNFF;      # NO FILE FOUND RESPONSE # 
        RETURN;                    # RETURN # 
        END 
  
      IF FILECMM EQ 0 
      THEN
        BEGIN 
        CMMAGR (0, I);
        FILECMM = I;         # ASSIGN GROUP NAME #
        END 
  
      IF FILECLF EQ 0              # IF NO CONNECTION LOG FILE #
      THEN
        BEGIN 
        FILECLF = CHKCMM(FILECLF,CLFCMMLNG);
        P<FET> = FILECLF + CLFFETLNG; 
        FOR I = 1 STEP 1 UNTIL CLFFETLNG
        DO
          BEGIN 
          P<FET> = P<FET> - 1;     # CLEAR FET WORD # 
          FETWD = 0;
          END 
  
        FETLFNC = YCDZ(FILECLF,7); # FORM UNIQUE LFN #
        C<00,01>FETLFNC = "L";
        FETCOMP = TRUE; 
        FETFETL = CLFFETLNG - 5;
        FETFIR  = FILECLF + CLFFETLNG;
        FETIN   = FETFIR; 
        FETOUT  = FETFIR; 
        FETLIM  = FETFIR + CLFBUFFER; 
        REQQDEV(FETLFNC, FALSE);   # REQUEST QUEUE DEVICE # 
        END 
  
      ELSE
        BEGIN 
        P<FET> = FILECLF; 
        FETCIOF = CIOREW;          # REWIND EXISTING CLF #
        CIORCL  = TRUE; 
        CIOADR  = FILECLF;
        CALLSYS (CIO);
        END 
  
      FILELFN = QACBLFNU;          # FILE NAME #
      FILELBK = FILECPD EQ HD;     # LOOP-BACK #
      IF FILELBK                   # IF LOOP-BACK # 
      THEN
        BEGIN 
        FILELID = HD;              # CHANGE LID = HOST PID #
        FILESLD = QACBDID;
        END 
  
      ELSE
        BEGIN 
        FILELID = QACBDID;         # LID = DID #
        FILESLD = QACBSID;         # SOURCE LID # 
        END 
  
      FILES0  = FALSE;             # RFT NOT SENT # 
      FILERTY = SCHRETRY;          # RETRY COUNT #
      FILEINT = QACBINT;           # FILE TYPE INPUT #
      FILEANW = FALSE;             # REQUEUE FILE IF ERROR #
      FILEICS = QACBIC;            # SET INTERNAL CHARAC #
  
    CONTROL IFEQ OS$NOS;
      FILEJBN  = VALFN(QACBUJNC); 
      FILEUJN  = FILEJBN; 
      FILEQFNC = VALFN(QACBJSNC);  # QUEUE FILE NAME #
      FILEDDC  = QACBDDC;          # DATA DECLARATION # 
      FILECFMC = QACBCFMC;         # CREATION FM #
      FILECUNC = QACBCUNC;         # CREATION UN #
      FILEDFMC = QACBDFMC;         # DESTINATION FM # 
      FILEDUNC = QACBDUNC;         # DESTINATION UN # 
      FILEOFMC = QACBOFMC;         # OWNER FM # 
      FILEOUNC = QACBOUNC;         # OWNER UN # 
      FILEDCC  = QACBDCC;          # DISPOSITION CODE # 
      FILEORG  = QACBORI;          # ORIGIN TYPE #
      FILEPW   = QACPW;            # ENCRYPTED PASSWORD # 
      FILESIZ  = QACBPRUS;         # FILE SIZE IN PRUS #
      I = 0;
      SCLF[MXSC] = QACBSCL;        # TRANSLATE SERVICE CLASS #
      ASLONGAS SCLF[I] NE SCLF[MXSC]
      DO
        BEGIN 
        I = I + 1;
        END 
  
      FILESCL = SCL[I];            # SERVICE CLASS #
      FILECHGU = QACBCHGU;         # CHARGE NUMBER #
      FILEPJ1U = QACBPJ1U;         # PROJECT NUMBER (1-10) #
      FILEPJ2U = QACBPJ2U;         # PROJECT NUMBER (11-20) # 
      P<FET> = FILECLF;            # MOVE CLF HEADER TO CLF BUFFER #
      FETOUT = FETFIR;
      FETIN  = FETFIR + CLFHDR$LEN; 
      MOVEI(CLFHDR$LEN, LOC(CLFHDR), FETFIR); 
      I = 0;
      DC$DSPDC[MAXDCV] = QACBDCC; 
      ASLONGAS DC$DSPDC[I] NE DC$DSPDC[MAXDCV]
      DO
        BEGIN 
        I = I + 1;
        END 
  
    CONTROL ENDIF;
  
    CONTROL IFEQ OS$NOSBE;
      FILEJBN = FILELFNC;          # JOB NAME # 
      FILEQFNC = VALFN(QACBLFN);   # QUEUE FILE NAME #
      FILESIZ = PRUCNT(FILELFNC);  # DETERMINE FILE SIZE #
      FILETIDC = QACBTIDC;
      IF QACRTR                    # IF EXTENDED PARAMETER BLOCK #
      THEN
        BEGIN 
        P<DSPXPB> = QACXPBP;       # POINTER TO EXTENDED BLOCK #
        FILEDDC = DSPXDDC;         # GET DD # 
        END 
  
      ELSE
        BEGIN 
        FILEDDC = "  ";            # USE DEFAULT DD # 
        END 
  
      DUMWORD = XCOD(QACBDC + O"100");
      FILEDCC = DUMWDR2;
      DC$DSPDC[MAXDCV] = DUMWDR2; 
      DC$NBEDC[MAXDCV] = DUMWDR2; 
      I = 0;
      ASLONGAS DC$NBEDC[I] NE DC$NBEDC[MAXDCV]
      DO
        BEGIN 
        I = I + 1;
        END 
  
      FILEDCC = DC$DSPDC[I];
    CONTROL ENDIF;
  
      IF NOT ( (FILEDDC EQ "  ")
            OR (FILEDDC EQ DD$C6) 
            OR (FILEDDC EQ DD$C8) 
            OR (FILEDDC EQ DD$US) 
            OR (FILEDDC EQ DD$UU) ) 
      THEN
        BEGIN 
        FILEDDC = "  "; 
        END 
  
      EMSGACQDC = FILEDCC;
      EMSGACQST = FILELIDC; 
      IF FILESLD EQ 0 
      THEN
        BEGIN 
        EMSGACQ3A = ".";
        FILESLD = HD;              # USE PID AS SOURCE LID #
        END 
  
      ELSE
        BEGIN 
        EMSGACQ3 = ", DO="; 
        EMSGACQDO = FILESLDC; 
        EMSGACQ4 = "."; 
        END 
  
      CONLOG (LOC(EMSGACQ),LEMSGACQ); 
      IF DC$DC[I] EQ "  "          # IF DISPOSITION CODE NOT FOUND #
      THEN
        BEGIN 
        USRERR(LOC(EMSGIQF),LEMSGIQF);
        SENDCLF;                   # SEND LOG FILE #
        FILEQAR = QAR$IQFASG;      # INVALID FILE RESPONSE #
        RETURN;                    # RETURN # 
        END 
  
      GENERT;                      # GENERATE EXPLICIT ROUTING TEXT # 
      GENIRT;                      # GENERATE IMPLICIT ROUTING TEXT # 
      GENSRT;                      # GENERATE SYSTEMS ROUTING TEXT #
      DUDI;                        # DETERMINE DD # 
      FILEIDDC = FILEDDC;          # SET INITIAL DD # 
      QACBLFNU = 0;                # FILE NOW IN AFT #
      PLTSCINUSE = PLTSCINUSE LOR (2**FILESEL); 
      SEL$INUCNT[FILESEL] = SEL$INUCNT[FILESEL] + 1;
      FILEINU = TRUE;              # SIGNAL INUSE COUNTS INCREMENTED #
      KS$UPDATE[KDIS"PID"] = TRUE;
      KS$UPDATE[KDIS"SC"] = TRUE; 
      FILEQAR = QAR$FILAVL;        # FILE AVAILABLE RESPONSE #
  
      END  # QACRESP #
    TERM
