Retro1.org codex

*DECK XSAPP 
USETEXT NIPDEF
USETEXT APPSTAT 
USETEXT DRHDR 
USETEXT DUMPFLG 
USETEXT FLIST 
USETEXT MSGIDX
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT SCPCOM
USETEXT SWAPIN
 PRGM XSAPP;                 # PROCESS SWAPIN OF (NO ACB) APPLICATION  #
 
 STARTIMS;
 #
*1DC  XSAPP 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        XSAPP               E. GEE              77/07/27 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          PROCESS SWAPIN OF (NO ACB) APPLICATION AND REISSUE PREVIOUS
*          SYSTEM CONTROL POINT FUNCTION. 
* 
*     3. METHOD USED. 
*          CHECK IF APPLICATION HAS BEEN SWAPPED IN 
*          PROCESS SCP SWAPIN FUNCTION RETURN CODE
*          CLEAR RETURN CODES AND COMPLETION BITS OF PREVIOUS SCP 
*            CALL IF NECESSARY
*          REISSUE PREVIOUS SYSTEM CONTROL POINT FUNCTION 
*          PROCESS SCP FUNCTION RETURN CODE FROM SECOND CALL
* 
*     4. ENTRY PARAMETERS.
*          SWAPINFP          ADDR OF FIRST ENTRY IN (NO ACB) SWAPIN 
*                            CHAIN
* 
*     5. EXIT PARAMETERS. 
*          NONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        APPSTAT     DUMPFLG     FLIST
*        MSGIDX    NIPDEF    OPSIZE    OVERLAY
*        PARAMS    SCPCOM    SWAPIN 
* 
*     7. ROUTINES AND OVERLAYS CALLED 
*          MRELS             RELEASE BUFFER SPACE 
*          OSCCALL           ISSUE SCP CALLS
*          OVLCALL           LOAD AND EXECUTE OVERLAYS
*          RDUMP             DUMP NIP-S FIELD LENGTH
*          XABTAPP    OVL    ABORT APPLICATION
*          XERRMSG    OVL    ISSUE DAYFILE MESSAGE
*          XSAPPRC           PROCESS (NO ACB) SCP FUNCTION RETURN CODE
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
*          * NIP/SCP ERROR RC = XXB,JOBID=XXXX* 
* 
*        THIS PROGRAM IS A PRIMARY OVERLAY LOADED BY SUBROUTINE 
*        OVLCALL.  WHEN EXECUTION HAS COMPLETED, A JUMP IS MADE TO
*        LOCATION RJMAIN TO RETURN TO THE CALLING PROGRAM.
* 
*        W A R N I N G - THIS PROGRAM AND PROCEDURE XSAPPRC 
*                        COMPRISE THIS OVERLAY AND THE TOTAL OF 
*                        THE TWO CANNOT EXCEED THE PRIMARY
*CALL OPSIZE
* 
*        THIS OVERLAY IS CALLED BY XSACB. 
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC ABORT ; 
   PROC MRELS;               # RELEASE BUFFER SPACE                    #
   PROC OSCCALL;             # ISSUE SYSTEM CONTROL POINT CALLS        #
   PROC OVLCALL;             # LOAD AND EXECUTE OVERLAYS               #
   PROC RDUMP;               # DUMP NIP-S FIELD LENGTH                 #
   PROC XSAPPRC;             # PROCESS (NO ACB) SCP FUNCTION RC        #
   PROC XTRACE;              # RECORD PROCEDURE CALLS                  #
   LABEL RJMAIN;             # RETURN ADDRESS IN OVLCALL               #
   END
# 
                    INTERNAL VARIABLES
# 
 ITEM FLW;                   # INDEX FOR CLEARING RETURN CODES         #
 ITEM NEXT;                  # ADDR OF NEXT ENTRY IN SWAPIN CHAIN      #
 ITEM RC;                    # SYS CONTROL POINT FUNCTION RETURN CODE  #
 ITEM SENTRY;                # ADDR OF (NO ACB) SWAPIN ENTRY           #
 ITEM SIZE;                  # SIZE OF SCP FUNCTION LIST               #
 
#**********************************************************************#
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("XSAPP") ; 
      CONTROL FI; 
 
      SENTRY = SWAPINFP;     # SWAPIN ENTRY TO PROCESS                 #
# 
      LOOP THROUGH (NO ACB) SWAPIN CHAIN UNTIL ALL ENTRIES ARE PROCESSED
# 
      FOR SENTRY=SENTRY WHILE SENTRY NQ LOC(SWAPINFP) DO
        BEGIN 
        P<SWPIE> = SENTRY;
        NEXT = SWPINFP[0];   # ADDR OF NEXT ENTRY IN SWAPIN CHAIN      #
        IF SWPICB[0] EQ 1 
        THEN                 # SWAPIN SCP CALL HAS COMPLETED           #
          BEGIN 
          P<SCPCALL> = SWPIFL[0]; # FUNCTION LIST FOR (NO ACB) APP     #
          SIZE = SCPBS[0];
# 
          CHECK SCP SWAPIN FUNCTION RETURN CODE 
# 
          IF SWPIRC[0] EQ 0 
          THEN               # APP SWAPPED IN WITH NO PROBLEMS         #
            BEGIN 
# 
              CLEAR RETURN CODES AND COMPLETION BITS IN ORIGINAL SCP
              FUNCTION LIST 
# 
              SCPRC[0] = 0;  # ZERO SCP FUNCTION LIST RETURN CODE      #
              SCPCB[0] = 0;  # CLEAR SCP FUNCTION LIST COMPLETION BIT  #
              IF SCPBS[0] GR SCPSIZE
              THEN           # THERE ARE SF.LIST ENTRIES TO CLEAN UP   #
                BEGIN 
                FOR FLW=SCPSIZE STEP FLESIZE UNTIL SCPBS[0]-1 DO
                  BEGIN 
                  P<FLE> = P<SCPCALL> + FLW; # ADDR OF SF.LIST ENTRY   #
                  FLERC[0] = 0; # ZERO SF.LIST ENTRY RETURN CODE       #
                  FLECB[0] = 0; # CLEAR SF.LIST ENTRY COMPLETION BIT   #
                  END 
                END 
 
#             REISSUE ORIGNIAL SCP FUNCTION CALL                       #
              P<FLE> = LOC(SCPFW[0]); 
              OSCCALL(FLE); 
# 
            PROCESS SCP FUNCTION RETURN CODE
# 
            RC = SCPRC[0];   # SCP FUNCTION RETURN CODE                #
            XSAPPRC(SENTRY,RC); 
            IF RC EQ RCUCPAOOR
            THEN             # UCP GAVE US BAD ADDR SO ABORT IT        #
              BEGIN 
              ABTAPPF = XFLERR; # SET ABORT-APPLICATION FLAG           #
              ABTADDR = P<SCPCALL>; # ADDR OF BUF FOR XABTAPP TO USE   #
              ABTSIZE = SIZE; # SIZE OF BUF FOR XABTAPP TO USE         #
              ABTJOBID = SWPIJOBID[0]; # APP JOB ID WORD               #
              OVLNAME = XABTAPPP; # NAME OF OVERLAY TO LOAD            #
              OVLCALL;       # LOAD AND EXECUTE OVELAY                 #
              END 
            ELSE
              BEGIN 
              IF RC NQ RCSWAPPEDOUT 
              THEN           # IT IS OKAY TO RELEASE BUFFER            #
                MRELS(P<SCPCALL>);
              END 
            END 
          ELSE               # GOT NONZERO RETURN CODE FROM SWAPIN CALL#
# 
            PROCESS SCP SWAPIN CALL RETURN CODE 
# 
            BEGIN 
            RC = SWPIRC[0];  # SCP FUNCTION RETURN CODE                #
            XSAPPRC(SENTRY,RC); 
            IF (RC NQ 0)       # SCP RC NOT EQUAL TO ZERO # 
              AND (RC NQ RCSWAPPEDOUT)  # UCP NOT SWAPPED OUT # 
              AND (RC NQ RCUCPGONE)  # UCP STILL IN SYSTEM #
              AND (RC NQ RCSTCBAD)
              AND (RC NQ RCSWAPDELAY)  # UCP CAN BE SWAPPED IN #
            THEN             # OP SYS GAVE NIP BAD RETURN CODE         #
              BEGIN 
              DMPFLG = DXSAPP1; # STORE REASON CODE FOR DUMPING FL     #
              RDUMP;         # DUMP NIP-S FIELD LENGTH                 #
              PARAMS1 = DFMSG07; # DAYFILE MESSAGE NUMBER              #
              PARAMS2 = RC;  # SCP FUNCTION RETURN CODE                #
              PARAMS3 = SWPIJOBID[0]; # APP JOB ID WORD                #
              OVLNAME = XERRMSGP; # NAME OF OVERLAY TO LOAD            #
              OVLCALL;       # LOAD AND EXECUTE OVERLAY                #
              ABORT ; 
              END 
 
            IF (RC NQ RCSWAPPEDOUT)            # UCP SWAPPED OUT AGAIN #
              AND (RC NQ RCSWAPDELAY)       # UCP CANNOT BE SWAPPED IN #
            THEN             # ALRIGHT TO RELEASE BUFFER               #
              MRELS(P<SCPCALL>);
            END 
          END 
        SENTRY = NEXT;       # SET PTR FOR NEXT ENTRY IN SWAPIN CHAIN  #
        END 
      GOTO RJMAIN;           # RETURN TO CALLING PROGRAM               #
      END 
TERM