*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