Retro1.org codex

*DECK HPNONSA 
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT AT
USETEXT AWLNTRY 
USETEXT DRHDR 
USETEXT FLIST 
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT PT
USETEXT SCPCOM
 PRGM HPNONSA;               # FINISH PROCESSING NETON OF APPLICATION  #
 
 STARTIMS;
 #
*1DC      HPNONSA 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPNONSA             E. GEE              77/06/02 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          FINISH PROCESSING NETON OF APPLICATION 
* 
*     3. METHOD USED. 
*          CHECK IF NORMAL RESPONSE 
*          IF NORMAL, CREATE SCP FUNCTION LIST TO WRITE NETON RESPONSE
*            SHORT-TERM CONN
*            ISSUE SCP FUNCTION 
*            PROCESS SCP FUNCTION RETURN CODE 
*            IF APPLICATION NETTING ON IS NS OR CS SEND 
*            REG/CP TO PIP. 
*          IF ABNORMAL, CHECK IF FATAL OR NON-FATAL RETURN CODE 
*            IF FATAL, SET ABORT FLAG 
*            IF NON-FATAL, CREATE FUNCTION LIST TO INFORM APP NETON 
*              WAS REJECTED 
*              ISSUE SCP FUNCTION 
*              PROCESS SCP FUNCTION RETURN CODE 
*            RELEASE ACB
* 
*     4. ENTRY PARAMETERS.
*          ACBADDR           ACB ADDRESS OF APP NETTING ON
* 
*     5. EXIT PARAMETERS. 
*          ABTAPPF           ABORT APP FLAG SET IF APP IS TO BE ABORTED 
*          ABTADDR           ADDR OF BUF TO BE USED BY XABTAPP
*          ABTJOBID          JOB ID WORD OF APP TO BE ABORTED 
*          ABTSIZE           SIZE OF BUF TO BE USED BY XABTAPP
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB     APPSTAT   AWLHEAD   AWLNTRY
*        DRHDR   FLIST     NIPDEF    OPSIZE 
*        OVERLAY PARAMS    PT        SCPCOM 
*        AT 
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          MRELS             RELEASE BUFFER SPACE 
*          NCREGCP    OVL    SEND SM REG/CP TO PIP
*          OSCCALL           ISSUE SCP FUNCTIONS
*          OSCHAPP           SCHEDULE APPLICATION 
*          OSCPSI     OVL    SWAPIN (NO ACB) APPLICATION
*          OVLCALL           LOAD AND EXECUTE OVERLAY 
*          RELACB        OVL RELEASE ACB
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
* 
*        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 CANNOT EXCEED THE PRIMARY 
*CALL OPSIZE
* 
*        THIS OVERLAY IS CALLED BY XSACB
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
XREF
   BEGIN
   PROC MRELS;               # RELEASE BUFFER SPACE                    #
   PROC OSCCALL;             # ISSUE SCP CALLS                         #
   PROC OSCHAPP;             # SCHEDULE APPLICATION                    #
   PROC OVLCALL;             # LOAD AND EXECUTE OVERLAYS               #
   PROC XTRACE;              # RECORD PROCEDURE CALLS                  #
   LABEL RJMAIN;             # RETURN ADDRESS IN OVLCALL               #
   END
# 
                    INTERNAL VARIABLES
# 
 ITEM BUFADDR;               # FWA OF NWL BUFFER                       #
 ITEM BUFSIZE;               # SIZE OF NWL BUFFER                      #
 ITEM NETONRC;               # NET/ON SUP MSG RETURN CODE              #
 ITEM RC;                    # SCP FUNCTION RETURN CODE                #
 
#**********************************************************************#
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("HPNSA");
      CONTROL FI; 
 
 
      P<ACB> = ACBADDR;      # ACB ADDRESS                             #
      BUFADDR = ACBWLFWA[0]; # FWA OF REST OF NWL BUFFER               #
      BUFSIZE = ACBWLLWA[0] - ACBWLFWA[0] + 1; # SIZE OF REST OF NWL B #
      JOBID = ACBJNWD[0];    # JOB ID WORD                             #
      CBA = ACBUCPADR[0];    # UCP COMPLETION BIT ADDRESS              #
      P<AWLENTRY> = LOC(ACBAWL0[0]);         # AWL NETON ENTRY ADDR    #
      NETONRC = AWLRC[0];    # NET/ON SUP MSG RETURN CODE              #
# 
      CHECK FOR NORMAL RESPONSE 
# 
      IF NETONRC EQ RNO"N"
      THEN                   # NVF OKAYED NETON                        #
        BEGIN 
# 
        CREATE FUNCTION LIST TO COMPLETE NETON PROCESSING - WRITE AWL 
        NETON ENTRY BACK TO APP, ESTABLISH LONG TERM CONNECTION 
        AND DO NOT CLEAR SHORT TERM CONNECTION SO THAT THE DATA 
        AVAILABILITY STATUS WORD IN APPLICATION FL MAY BE UPDATED 
        BY NIP AT ANY TIME
# 
        P<FLHEAD> = BUFADDR; # ADDR TO HOLD FUNCTION LIST              #
        FLWD0[0] = 0; 
        FLID[0] = NAFLIDVALUE ;    # NON-MOVEVABLE ID FUNCTION LIST ID #
        FLBS[0] = FLSIZE + 2*FLESIZE; # SIZE OF FUNCTION LIST          #
        FLFW[0] = 0;
        FLAN[0] = ACBAN[0];  # APP PROCESS NUMBER                      #
        FLFP[0] = 2;         # NUMBER OF SFLIST ENTRIES                #
        FLSCPA[0] = BUFADDR + FLSIZE; # ADDR OF SF.LIST ENTRIES        #
        FLJOBID[0] = JOBID;  # JOB ID WORD                             #
        P<FLE> = BUFADDR + FLSIZE;
        FLEWD0[0] = 0;
        FLEFP[0] = AWLNSIZE - BLKHSIZE; # AWL NETON ENTRY SIZE         #
        FLEUCPA[0] = ACBAWLADDR[0]; # UCP AWL ADDR                     #
        FLESCPA[0] = P<AWLENTRY>; # AWL NETON ENTRY ADDR               #
        FLEFC[0] = SFWRITE;  # SCP SF.WRITE FUNCTION                   #
        FLEWD0[1] = 0;
        FLEFC[1] = SFSLTC;   # SCP SF.WRITE FUNC. # 
# 
        ISSUE SCP FUNCTION
# 
        P<FLE> = LOC(FLFW[0]); # SCP FUNCTION WORD                     #
        FLFC = SFLIST;
        OSCCALL(FLE); 
# 
        PROCESS SCP FUNCTION RETURN CODE
# 
        RC = FLRC[0];        # SCP FUNCTION RETURN CODE                #
        IF RC EQ 0
        THEN                 # SCP FUNCTION COMPLETED                  #
          BEGIN 
          FLBS[0] = BUFSIZE;
          MRELS(BUFADDR);    # RELEASE REST OF NWL                     #
          ACBAWLADDR = 0; # CLEAR UCPAWL ADDR # 
          ACBWLFWA[0] = 0;
          ACBWLLWA[0] = 0;
          ACBAWL0[0] = 0;    # CLEAR 1ST WORD OF AWL ENTRY             #
                                   # IF APPLICATION IS NS OR CS 
                                     SEND REG/CP/C TO CCP              #
          IF ACBANAME[0] EQ "CS" OR ACBANAME[0] EQ "NS" 
          THEN
            BEGIN 
            IF ACBANAME[0] EQ "CS"
            THEN                   # INITIALIZE APPLICATION NO. FOR CS #
              BEGIN 
              PROCAN[CSORD] = ACBAN[0];  # SET AN IN COMMON            #
              END 
            ELSE                   # INITIALIZE APPLICATION NO. FOR NS #
              BEGIN 
              PROCAN[NSORD] = ACBAN[0];  # SET AN IN COMMON            #
              END 
            OVLNAME = NCREGCPP;  # SEND REG/CP SM TO PIP               #
            PARAMS1 = 0;         # ALL ACTIVE COUPLERS                 #
            PARAMS2 = 0 ; 
            OVLCALL;         # LOAD AND EXECUTE OVERLAY                #
            END 
          END 
        ELSE                 # SCP FUNCTION NOT COMPLETED              #
          BEGIN 
          IF RC EQ RCSWAPPEDOUT 
          THEN               # APP IS SWAPPED OUT                      #
            BEGIN            # SET UP ACB TO LATER REISSUE SCP FUNCTION#
            ATASBO[ACBAN[0]] = TRUE; # APP SWAPPED OUT AT NETON TIME   #
            OSCHAPP(ACBADDR); # SCHEDULE APPLICATION                   #
            END 
          ELSE
            BEGIN 
            IF RC EQ RCUCPAOOR
            THEN             # APP GAVE US BAD UCP AWL ADDR SO ABORT IT#
              BEGIN 
              ABTADDR = ACBADDR; # ACB ADDRESS                         #
              ABTAPPF = XFLERR;       # SET ABORT-APPLICATION FLAG     #
              END 
            ELSE             # APP MUST NO LONGER BE IN SYSTEM         #
              FAILADR = ACBADDR; # ACB ADDRESS                         #
            END 
          END 
        END 
      ELSE                   # NVF REJECTED NETON                      #
        BEGIN 
        ACBWLFWA[0] = 0;     # SO THAT SPCBDHS WILL NOT RELEASE NWL    #
# 
        CHECK IF FATAL OR NON-FATAL RETURN CODE 
# 
#       SET ABORT PARAMS IN CASE APP IS TO BE ABORTED                  #
        ABTSIZE = BUFSIZE;   # SIZE OF BUF FOR XABTAPP TO USE          #
        ABTADDR = BUFADDR;   # ADDR OF BUFFER FOR XABTAPP TO USE       #
        ABTJOBID = JOBID;    # JOB ID WORD OF APPLICATION TO ABORT     #
        IF  NETONRC EQ RNO"DIS" OR NETONRC EQ RNO"DUP"
        THEN                 # THIS IS A NON-FATAL NETON RETURN CODE   #
          BEGIN 
# 
          CREATE FUNCTION LIST TO INFORM APP NETON WAS REJECTED 
# 
          P<SCPCALL> = BUFADDR; # ADDR TO HOLD FUNCTION LIST           #
          SCPID[0] = NAFLIDVALUE; # (NO ACB) FUNCTION LIST ID VALUE    #
          SCPBS[0] = SCPSIZE + 2*FLESIZE; # SIZE OF FUNCTION LIST      #
          SCPFW[0] = 0; 
          SCPFP[0] = 2;      # NO OF SF.LIST ENTRIES                   #
          SCPSCPA[0] = BUFADDR + SCPSIZE; # ADDR OF SF.LIST ENTRIES    #
          SCPJOBID[0] = JOBID; # JOB ID WORD                           #
          P<FLE> = BUFADDR + SCPSIZE; 
          FLEWD0[0] = 0;
          AWLEWD1[0] = 0;    # ZERO AWL NETON ENTRY PN WORD            #
          FLEUCPA[0] = ACBAWLADDR[0]; # UCP AWL ADDR                   #
          FLESCPA[0] = P<AWLENTRY>; # ADDR OF AWL NETON ENTRY          #
          FLEFP[0] = AWLNSIZE - BLKHSIZE; # SIZE OF AWL ENTRY          #
          FLEFC[0] = SFWRITE; # SCP SF.WRITE FUNCTION                  #
          P<FLE> = P<FLE> + FLESIZE;
          FLEWD0[0] = 0;
          FLEUCPA[0] = CBA;  # UCP COMPLETION BIT ADDR                 #
          FLEFC[0] = SFENDT; # SCP SF.ENDT FUNCTION                    #
# 
          ISSUE SCP FUNCTION
# 
          P<FLE> = LOC(SCPFW[0]); # SCP FUNCTION WORD                  #
          SCPFC = SFLIST; 
          OSCCALL(FLE); 
# 
          PROCESS SCP FUNCTION RETURN CODE
# 
          RC = SCPRC[0];     # SCP FUNCTION RETURN CODE                #
          IF RC EQ RCSWAPPEDOUT 
          THEN               # APP WAS SWAPPED OUT                     #
            BEGIN 
            PARAMS1 = BUFADDR; # ADDR OF FUNCTION LIST                 #
            PARAMS3 = BUFADDR + SCPSIZE+2*FLESIZE; # AWL ENTRY WORD    #
            PARAMS2 = PARAMS3 + AWLNSIZE; # SWPI ENTRY BUF ADR         #
            P<DRHDRWD> = PARAMS3; # ADDR OF BUF TO HOLD AWL            #
            BLKID[0] = NONMOVEABLE; # (NONMOVABLE) WRITE BUF BLK ID    #
            BLKBS[0] = AWLNSIZE; # SIZE OF NETON AWL                   #
            P<AWLENTRY> = P<DRHDRWD> + BLKHSIZE; # ADR AWL NETON ENT   #
            AWLEAIPH[0] = ACBAWL0[0]; # TRF AWL-WD0 TO BUF AREA        #
            AWLEWD1[0] = ACBAWL1[0]; # TRF AWL-WD1 TO BUF AREA         #
            P<FLE> = BUFADDR + SCPSIZE; # ADR OF SF.LIST ENTRY         #
            FLESCPA[0] = P<AWLENTRY>; # ADR OF AWL NETON ENTRY         #
            OVLNAME = OSCPSIP; # NAME OF OVERLAY TO LOAD               #
            OVLCALL;         # LOAD AND EXECUTE OVERLAY                #
            BUFADDR = BUFADDR + SCPSIZE+2*FLESIZE + SWPISIZE + AWLNSIZE;
            BUFSIZE = BUFSIZE - SCPSIZE-2*FLESIZE - SWPISIZE - AWLNSIZE;
            END 
          IF RC EQ RCUCPAOOR
          THEN               # APP GAVE US BAD AWL ADDR SO ABORT IT    #
            ABTAPPF = XFLERR;   # SET ABORT-APPLICATION FLAG           #
          ELSE               # OKAY TO RELELEASE REST OF NWL           #
            BEGIN 
            P<DRHDRWD> = BUFADDR; # FWA OF BUFFER TO RELEASE           #
            BLKBS[0] = BUFSIZE; # SIZE OF REST OF NWL BUFFER           #
            MRELS(BUFADDR); 
            END 
          END 
        ELSE                 # THIS IS A FATAL NETON RETURN CODE       #
          BEGIN 
          IF NETONRC EQ RNO"IA" 
          THEN               # INVALID APPLICATION NAME                #
            ABTAPPF = XINVAPP; # SET ABORT-APPLICATION FLAG            #
          ELSE
            IF NETONRC EQ RNO"NPR"
            THEN             # RESERVED APPLICATION NAME               #
              ABTAPPF = XRESAPPNM; # SET ABORT-APPLICATION FLAG        #
          END 
# 
           N V F    R E J E C T E D    N E T O N
  
      R E L E A S E   A C B   AND   A C N T   B U F F E R S.
# 
        PARAMS1 = ACBAN[0];  # APPLICATION NUMBER OF ACB TO RELEASE    #
        OVLNAME = RELACBP;   # NAME OF OVERLAY TO LOAD                 #
        OVLCALL;             # LOAD AND EXECUTE OVERLAY                #
        END 
      GOTO RJMAIN;
      END 
TERM