Retro1.org codex

*DECK HPNOFF
USETEXT NIPDEF
USETEXT ACB 
USETEXT ACNT
USETEXT ACNB
USETEXT AHEADER 
USETEXT APPSTAT 
USETEXT AT
USETEXT DRHDR 
USETEXT DUMPFLG 
USETEXT FLIST 
USETEXT KDIS
USETEXT MSGIDX
USETEXT NWLHEAD 
USETEXT OVERLAY 
USETEXT PARAMP
USETEXT PARAMS
USETEXT PT
USETEXT SCPCOM
USETEXT SUPABH
USETEXT SUPMSG
USETEXT DISTAIL 
      PRGM HPNOFF;           # PROCESS A *NET OFF* WORK LIST ENTRY     #
 
 STARTIMS;
 #
*1DC  HPNOFF
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPNOFF              E. GEE              77/07/27 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR NETTING-OFF THE APPLICATION. 
* 
*     3. METHOD USED. 
*          CHECK IF ACB EXISTS FOR APPLICATION NETTING OFF
*          IF ACB EXISTS AND THIS WAS A NEW WORKLIST, THROW AWAY ANY OLD
*            WORKLIST AND BUFFERS.
*          IF ACB EXISTS, 
*            ABORT IF APPLICATION NETTING OFF IS NVF. 
*            SET UP SCP FUNCTION LIST TO SEND SCP CONNECTIONS.
*            FORMAT AND SEND NET/OFF SUPERVISORY MESSAGE TO 
*            NVF IF NONE OF THE NVF INTERFACE FLAGS ARE SET.
*            PROCESS RETURN CODE FROM SCP CALL. 
*          IF NO ACB EXISTS, ISSUE SCP CALL TO END SHORT-TERM CONNECTION
*            BETWEEN NAM AND APP. 
*            PROCESS RETURN CODE FROM SCP CALL. 
* 
*     4. ENTRY PARAMETERS.
*          PARAMP1           NWL ADDRESS OR NWL ENTRY ADDRESS 
*          ACBADDR           ACB ADDRESS IF PARAMP1 IS NWL ENTRY ADDRESS
*          WLADDR            NWL ENTRY ADDRESS IF PARAMP1 IS NWL ENTRY
*                            ADDRESS
* 
*     5. EXIT PARAMETERS. 
*          FAILADR           SET TO ACB ADDRESS IF NIP GETS SCP RETURN
*                            CODE = RCUCPGONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        AHEADER   APPSTAT   DRHDR     DUMPFLG
*        AT   FLIST     MSGIDX    NIPDEF
*        NWLHEAD   OPSIZE     PT
*        OVERLAY     PARAMS     ACB 
*        SCPCOM     ACNT     ACNB 
*        KDIS     SUPABH     SUPMSG 
* 
*     7. ROUTINES CALLED. 
*          ABORT             ABORT PROGRAM AND DAYFILE MESSAGE
*          KPCLNUP    OVL    CLEANUP K-DISPLAY TABLES 
*          HCSTTP            HOST CONNECTION STATE TABLE PROCESSOR
*          OMSG              OUTPUT DAYFILE MESSAGE 
*          MRELS             RELEASE BUFFER SPACE 
*          OSCCALL           SYSTEM-CONTROL-POINT CALL
*          OSCHAPP           SCHEDULE APPLICATION 
*          OSCPSI     OVL    SWAPIN (NO ACB) APPLICATION
*          OVLCALL           LOAD AND EXECUTE OVERLAY 
*          RDUMP             DUMP NIP-S FIELD LENGTH
*          XTRACE            TRACES CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*          NVF FAILURE. 
*          NIP DUMP TAKEN - HPNOFF
* 
*        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 HHIR.
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF BEGIN 
   PROC ABORT;               # ABORT PROGRAM AND DAYFILE MESSAGE       #
   PROC HCSTTP ;
   PROC BLINK  ;
   PROC MRELS;
   PROC XTRACE;              # TRACE CALLS                             #
   PROC OMSG;                # DAYFILE MESSAGE                         #
   PROC OSCCALL;             # CLEAR LONG TERM CONNECTION             # 
   PROC OSCHAPP;             # SCHEDULE APPLICATION                    #
   PROC OVLCALL;
   PROC RDUMP;
   PROC XRECALL;             # ISSUE EVENT RECALL                      #
   LABEL RJMAIN;             # RETURN ADDRESS IN OVLCALL               #
   END
# 
                    INTERNAL VARIABLES
# 
 ITEM I ; 
 ITEM ACBFOUND B ;
 ITEM AN ;
 ITEM FLNTRY ;
 ITEM LIMIT ; 
 ITEM IDX;
 ITEM REASON;                # RETURN CODE FROM SYS CONTROL PT CALLS   #
 ITEM SECACN;                # APP CON NUM FOR SECONDARY APPLICATION   #
 ITEM WLLWA ; 
 ITEM INDX1;
 BASED ARRAY KALANPTR [1:1] S(1);  # TEMPLATE FOR ALT BUFFER AN        #
   BEGIN
   ITEM KALNO U(00,00,09);
   END
 BASED ARRAY KALNAMPTR[1:1] S(1); 
   BEGIN                     # ALERT NAME POINTER                      #
   ITEM KALNAM C(00,00,07); 
   END
#**********************************************************************#
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
       XTRACE("HPNOF") ;
      CONTROL FI; 
 
      CONTROL OVERLAP NWLHEADER, SCPCALL; 
 
# 
      STEP 1  CHECK IF ACB EXIST
# 
 
      WLADDR = NWLADDR; 
      WLLWA = WLADDR + SIZENWL - 1 ;
      P<NWLHEADER> = WLADDR ; 
      ACBFOUND = FALSE ;               # CLEAR THE FLAG                #
      P<DRHDRWD> = WLADDR;
      CBA = NWLHADDR[0] ; 
      JOBID = NWLJOBID[0] ;            # JOB ID WORD IN HEADER         #
      FOR IDX = 1 STEP 1 WHILE IDX LQ ATHAN[0]
                         AND NOT ACBFOUND 
      DO
        BEGIN                          # FIND ACB                      #
        P<ACB> = ATACBA[IDX] ;         # THIS ACB                      #
        IF P<ACB> NQ 0
        THEN
          BEGIN                        # NON-ZERO ACB                  #
          IF ACBJNWD[0] EQ JOBID
          THEN
            BEGIN                      # MATCH ACB                     #
            ACBADDR = P<ACB> ;
            ACBFOUND = TRUE ;          # FOUND THIS ACB                #
            IF ATNVFN[IDX] # NET/OFF/R SENT TO NVF                     #
              OR ATNVFF[IDX] # FAIL/APP/R SENT TO NVF                  #
            THEN # NO FURTHER NETOFFS ALLOWED                          #
              GOTO NOFEXIT; # RELEASE NWL BUFFER                       #
            IF ATASBI[IDX] # SWAPIN IS IN PROGREE                      #
              AND ACBSCPCB[0] EQ 0 # REQUEST NOT YET COMPLETED         #
            THEN # WAIT FOR SWAPIN REQUEST COMPLETION                  #
              BEGIN 
              XRECALL(LOC(ACBSWAPWR[0])); # ISSUE EVENT RECALL         #
              ACBID[0] = ACBIDVALUE; # ALLOW ACB TO MOVE AGAIN         #
              END 
            ATASBV[IDX] = 0; # CLEAR APPLICATION STATUS FLAGS          #
            END                        # MATCH ACB                     #
 
          END                          # NON-ZERO ACB                  #
        END                            # FIND ACB                      #
 
      IF ACBFOUND 
      THEN
        BEGIN                          # ACB EXISTS                    #
 
# 
       NETTING OFF APPLICATION IS NVF, ABORT
# 
        AN = ACBAN[0] ; 
        ACBUCPADR[0] = CBA ;             # SAVE COMPLETION ADDRESS FOR #
                                         # NET/OFF/N PROCESSING        #
        IF AN EQ NVFAN
        THEN
          IF NOT SHUTDOWN 
          THEN
            ABORT(DFMSG10,0) ;
          ELSE
            BEGIN 
            ATENTRYW[NVFAN] = 0 ;      # ZERO OUT THE AT ENTRY OF      #
                                       # NVF FOR SHUTDOWN CASE         #
# 
            TERMINATE NVF'S SCP CONNECTIONS 
# 
            P<FLHEAD> = WLADDR;        # NWL USED FOR SCP FUNCTION BUF #
            FLWD0[0] = 0; 
            FLID[0] = NONMOVEABLE;     # FUNCTION LIST BUF NONMOVABLE  #
            FLBS[0] = FLSIZE + 3*FLESIZE;  # SIZE OF FUNCTION LIST     #
            FLFW[0] = 0;
            FLFP[0] = 3;               # NUMBER OF FUNCTION LIST ENTRYS#
            FLFC[0] = SFLIST;          # SCP FUNCTION CODE             #
            FLJOBID[0] = JOBID;        # NVF JOB ID                    #
            P<FLE> = WLADDR + FLSIZE; 
            FLSCPA[0] = P<FLE>; 
            FLEWD0[0] = 0;
            FLEFC[0] = SFENDT;         # TERMINATE SHORT TERM CON FC   #
            FLEUCPA[0] = CBA;          # COMPLETION ADDRESS            #
            FLEWD0[1] = 0;
            FLEFC[1] = SFENDT;         # TERMINATE SHORT TERM CON FC   #
            FLEUCPA[1] = CBA;          # COMPLETION ADDRESS            #
            FLEWD0[2] = 0;
            FLEFC[2] = SFCLTC;         # TERMINATE LONG TERM CON FC    #
            P<FLE> = LOC(FLFW[0]);
            OSCCALL(FLE);              # ISSUE SCP CALL                #
# 
            PROCESS SCP RETURN CODE 
# 
            REASON = FLRC[0];          # REASON CODE FROM SCP CALL     #
            IF REASON EQ RCSWAPPEDOUT 
            THEN                       # NVF WAS SWAPPED OUT           #
              BEGIN 
              PARAMS1 = WLADDR;        # ADDRESS OF FUNCTION LIST      #
              PARAMS2 = WLADDR + FLBS[0];  # ADDRESS TO SET UP SWAPIN  #
              PARAMS3 = 0;
              OVLNAME = OSCPSIP;       # NAME OF OVERLAY TO SET UP SWP #
              OVLCALL;
              P<DRHDRWD> = WLADDR + FLBS[0] + SWPISIZE; 
              END 
            ELSE                       # OTHER REASON CODE FROM SCP CAL#
              BEGIN 
              IF (REASON NQ RCUCPGONE) AND
                 (REASON NQ 0)
              THEN                     # BAD RETURN CODE FROM NOS      #
                BEGIN 
                D25M2[0] = "HPNOFFN"; 
                OMSG(DFMSG25,0);       # ISSUE DAYFILE MESSAGE         #
                RDUMP;
                END 
              END 
            END 
        ELSE
          BEGIN                        # OTHER APPLICATION NETTED OFF  #
 
 
#       CALL STATE TABLE FOR EACH EXISTING CONNECTION                  #
#       WITH NETOFF TRIGGER                                            #
 
          P<ACNT> = ACBACNT[0] ;         # ACNT OF THIS ACB            #
          LIMIT = ACNTHCN[0] - ACNTMINACN[0] + ACNTHSIZE ;
          FOR I = ACNTHSIZE STEP 1 UNTIL LIMIT
          DO
            BEGIN                        # CALL HC STATE TABLE         #
            IF ACNTACNB[I] NQ 0 
            THEN
              BEGIN                      # ACNB HERE                   #
              P<ACNB> = ACNTACNB[I] ; 
              ACNBRC[0] = RCRC"ANO" ;    # RC = 1, APPL NETTING OFF    #
              HCSTTP(P<ACB>,ACNBACN[0],OFFAP,0) ; 
              END 
            ELSE
              BEGIN 
              IF ACNTSECID[I] NQ 0
              THEN
                BEGIN                    # CONN. IS ON LOAN            #
                SECACN = ACNTSECACN[I];  # ACN FOR SECONDARY APP       #
                P<ACB> = ATACBA[ACNTSECAN[I]];  # ACB OF SECONDARY APP #
                P<ACNT> = ACBACNT[0];  # ACNT OF SECONDARY APP         #
                P<ACNB> = ACNTACNB[SECACN-ACNTMINACN[0]+ACNTHSIZE]; 
                P<ACB> = ACBADDR;      # ACB ADDR OF NETTED OFF APP    #
                P<ACNT> = ACBACNT[0];  # RESTORE ACNT ADR FOR NETOFF AP#
                IF P<ACNB> NQ 0 
                THEN                   # CON STILL EXISTS IN SEC APP   #
                  BEGIN 
                  ACNBPRAF[0] = TRUE;  # SET PRI APP FAILED FLAG       #
                  END 
                ELSE                   # BAD ENTRY IN PRI APP ACNT TABL#
                  BEGIN 
                  ABORT("HPNOFF, NIP INTERNAL ERROR",0);
                  END 
                END                      # CONN. IS ON LOAN            #
              END 
 
            END                        # CALL HC STATE TABLE           #
          IF ACBFNTW0[0] NQ 0 
          THEN
            BEGIN                      # FILE LOANNING EXISTED         #
            IF ACBFNTMAS[0] 
            THEN
              PARAMS1 = TMAB ;         # MASTER NETTING OFF            #
            ELSE
              PARAMS1 = TSOF ;         # ELSE IS SLAVE                 #
            PARAMS2 = ACBAN[0] ;       # AN  OF NETTING OFF APPLICATION#
            PARAMS3 = 0 ; 
            OVLNAME = HFNTSMP ; 
            OVLCALL ; 
            END 
 
        # FORM NET/OFF AND SEND TO NVF                                 #
 
          P<DRHDRWD> = WLADDR ;          # USE SAME BUFFER FOR NETOFF  #
          DRBS[0] = LNETOFF + BLKHSIZE + ABHSIZE ;
 
        # APPLICATION BLOCK HEADER                                     #
 
          P<AHEADER> = WLADDR + BLKHSIZE ;
          ABHWORD[0] = SMABHW[0] ;
          ABHTLC[0] = LNETOFF ; 
 
        # SUPERVISOR MESSAGE                                           #
 
          P<SUPMSG> = WLADDR + BLKHSIZE + ABHSIZE ; 
          P<SMNVF> = P<SUPMSG> ;
          NETWD0[0] = 0 ;                # CLEAR THE CONTENT BEFORE    #
          PFCSFC[0] = NETOFFR ; 
          NETAN[0] = AN ;                # APPLICATION NUMBER          #
 
        # CALL TO LINK TO NVF          #
 
          BLINK(WLADDR,ATACBA[NVFAN]) ; 
 
          OSCHAPP(ATACBA[NVFAN]) ;
          ATNVFN[ACBAN[0]] = TRUE ;  # SET WAITING FLAG ON             #
          WLADDR = WLADDR + DRBS[0] ;    # UPDATE THE WL ADDRESS       #
          P<DRHDRWD> = WLADDR ;          # READY TO RELEASE THE REST   #
          IF KDAM[0] # NAM K DISPLAY IN APPLICATION MODE               #
            AND KDAN[0] EQ ACBAN[0] # ASSIGNED TO K DISPLAY            #
          THEN # CLEAN UP NAM K DISPLAY TABLES                         #
            BEGIN 
            P<KALANPTR> = LOC(KDALAN1[0]);
            P<KALNAMPTR> = LOC(KAPALT1[0]); 
            FOR INDX1 = 1 STEP 1 UNTIL KMAXALT
            DO
              BEGIN 
              IF KDAN[0] EQ KALNO[INDX1]
              THEN                 # CLEAN UP ALERT BUFFER             #
                BEGIN 
                KALNO[INDX1] = 0; 
                KALNAM[INDX1] = " ";
                END 
              END 
            OVLNAME = KPCLNUPP; 
            OVLCALL;
            END 
          END                          # OTHER APPLICATION NETTED OFF  #
 
 
        END                            # ACB EXISTS                    #
 
      ELSE
        BEGIN                          # ACB DOES NOT EXIST            #
        P<SCPCALL> = WLADDR ;          # OVERWRITE SCP BUFFER          #
        SCPWD0[0] = 0;
        SCPID[0] = NAFLIDVALUE ;       # FUNCTION BLOCK ID             #
        SCPBS[0] = SCPSIZE; 
        SCPFW[0] = 0 ;
        SCPUCPA[0] = CBA ;             # COMPLETION BIT ADDR           #
        SCPFC[0] = SFENDT ; 
        P<FLE> = LOC(SCPFW[0]) ;
        OSCCALL(FLE) ;
        P<FLHEAD> = WLADDR ;
        REASON = FLRC[0] ;
        P<DRHDRWD> = P<FLHEAD> ;
 
        IF REASON NQ 0
        THEN
          BEGIN                          # NOT  O.K.                   #
          IF REASON EQ RCSWAPPEDOUT 
          THEN
            BEGIN                        # SWAPPED OUT                 #
 
            PARAMS1 = WLADDR  ; 
            PARAMS2 = WLADDR + FLBS[0] ;
            PARAMS3 = 0 ; 
            OVLNAME = OSCPSIP ; 
            OVLCALL ; 
            P<DRHDRWD> = WLADDR + FLBS[0] + SWPISIZE ;
            END                          # SWAPPED OUT                 #
          ELSE
            BEGIN 
            D25M2[0] = "HPNOFF "; 
            OMSG(DFMSG25,0);    # "NIP DUMP TAKEN"                     #
            RDUMP ; 
          END 
 
        END                            #NOT O.K.                       #
 
 
 
        END                            # ACB DOES NOT EXIST            #
 
NOFEXIT: # RELEASE UNUSED BUFFER SPACE                                 #
      BLKBS[0] = WLLWA - P<DRHDRWD> + 1 ; 
      MRELS(P<DRHDRWD>) ; 
      GOTO RJMAIN;
      END 
TERM