Retro1.org codex

*DECK HPNONAP 
USETEXT NIPDEF
USETEXT ACB 
USETEXT AHEADER 
USETEXT APPSTAT 
USETEXT AT
USETEXT AWLNTRY 
USETEXT DRHDR 
USETEXT DUMPFLG 
USETEXT FLIST 
USETEXT MSGIDX
USETEXT NWLHEAD 
USETEXT PARAMS
USETEXT PT
USETEXT SUPABH
USETEXT SUPMSG
 PRGM HPNONAP;               # PROCESS NETON OF (NON-SUP) APPLICATION  #
 
 STARTIMS;
 #
*1DC  HPNONAP 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPNONAP             E. GEE              77/07/27 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          PROCESS NETON OF (NON-SUP) APPLICATION.
* 
*     3. METHOD USED. 
*          CREATE NET/ON SUPERVISOR MESSAGE TO SEND TO NVF
*          CREATE FUNCTION LIST TO SWAPOUT APPLICATION
*          ISSUE SYSTEM CONTROL POINT FUNCTION
*          PROCESS SCP RETURN CODE
*          IF RETURN CODE EQ 0 OR RCSWAPPEDOUT, THEN QUEUE NET/ON SUP 
*            MSG TO NVF-S DATA RING,SCHEDULE NVF,CREATE AWL NETON ENTRY,
*            AND UPDATE ACB FIELDS
*          IF RETURN CODE EQUALS ANYTHING ELSE, THEN RELEASE NWL AND
*            SET DELETE ACB FLAG
* 
*     4. ENTRY PARAMETERS.
*          PARAMS1           MAXIMUM NUMBER OF CONNECTIONS
*          PARAMS2           APPLICATION NAME FROM FROM NETON NWL ENTRY 
*          PARAMS3           DATA AVAILABLE ADDRESS 
*          PARAMS4           APPLICATION NUMBER 
*          PARAMS5           PRIVILEGE USER BIT 
*          PARAMS7           PRIVILEGE PROGRAM BIT
*          NWLADDR           NWL ADDRESS
*          SIZENWL           SIZE OF NWL BUFFER 
*          JOBID             APPLICATION JOB ID WORD
*          AWLA              UCP AWL ADDRESS
*          CBA               UCP COMPLETION BIT ADDRESS 
* 
*     5. EXIT PARAMETERS. 
*          PARAMS5           DELETE-ACB FLAG
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB      AHEADER   APPSTAT   AT      AWLNTRY 
*        DRHDR     FLIST
*        NET      NIPDEF    NWLHEAD   OSSIZE
*        PARAMS    PT    SUPABH    SUPMSG 
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          BLINK             LINK DATA BLOCK TO DATA RING 
*          MRELS             RELEASE BUFFER SPACE 
*          OMSG              ISSUE DAYFILE MESSAGE
*          OSCCALL           ISSUE SCP CALL 
*          OSCHAPP           SCHEDULE APPLICATION 
*          RDUMP             DUMP NIP-S FIELD LENGTH
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
* 
*        THIS PROGRAM IS A SECONDARY OVERLAY LOADED BY SUBROUTINE 
*        OVLCALL.  WHEN EXECUTION IS 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 SECONDARY 
*CALL OSSIZE
* 
*        THIS OVERLAY IS CALLED BY HPNON. 
* 
 #
 STOPIMS; 
# 
                    ENTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC BLINK;
   PROC MRELS;
   PROC OMSG;                # DAYFILE MESSAGE                         #
   PROC OSCCALL;
   PROC OSCHAPP;
   PROC RDUMP;
   PROC XTRACE; 
   LABEL RJMAIN;
   END
# 
                    INTERNAL VARIABLES
# 
 ITEM BUFADDR;
 ITEM BUFSIZE;
 ITEM NVFADDR;
 ITEM AN; 
 
 
 #*********************************************************************#
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
       XTRACE("HONAP") ;
      CONTROL FI; 
 
      AN = PARAMS4; 
# 
      CREATE NET/ON SUPERVISOR MESSAGE TO SEND TO NVF 
# 
      P<DRHDRWD> = NWLADDR;  # ADDR OF BUF TO HOLD NET/ON SUP MSG      #
      BLKID[0] = DRIDVALUE;  # DATA RING BLOCK ID VALUE                #
      BLKBS[0] = LNETON + ABHSIZE + DBHSIZE; # SIZE OF SM DATA BLK     #
      BUFADDR = NWLADDR + BLKBS[0]; 
      BUFSIZE = SIZENWL - BLKBS[0]; 
 
#     CREATE APPLICATION BLOCK HEADER                                  #
      P<AHEADER> = NWLADDR + DBHSIZE; # ADDR TO HOLD ABH               #
      ABHWORD[0] = SMABHW[0]; # SUP MSG APP BLK HEADER                 #
      ABHTLC[0] = LNETON;    # LENGTH OF NET/ON SUP MSG (IN WORDS)     #
 
#     CREATE SUPERVISOR MESSAGE                                        #
      P<SUPMSG>   =   P<AHEADER> + ABHSIZE; # ADDR TO HOLD NET/ON SM   #
      P<SMNVF> = P<SUPMSG>;  # BASE NET/ON TEMPLATE                    #
      NETWD0[0] = 0;
      PFCSFC[0] = NETONR;    # PFC/SFC CODE FOR NET/ON/R SUP MSG       #
      NETANAM[0] = C<0,7> PARAMS2;  # APPLICATION NAME                 #
      NETMCN[0] = PARAMS1;         # MAXIMUN NUMBER OF CONNECTIONS     #
      NETNRCN[0] = PARAMS0 ;      # NUMBER OF RESERVED OUTGOING CONNS. #
      NETAN[0] = AN;               # APPLICATION NUMBER                #
      NETWD2[0] = 0;
      NETJSN[0] = C<0,4>JOBID ;          # JOB SEQUENCE NUMBER         #
      NETPU[0] = PARAMS5 ;               # PRIVILEGED USER BIT         #
      NETPP[0] = PARAMS8 ;               # PRIVILEGED PROGRAM BIT      #
      NETACCL[0] = PARAMS7;  # APPLICATION ACCESS LEVEL                #
 
      NVFADDR = ATACBA[NVFAN];  # NVF ACB ADDRESS                      #
# 
      CREATE FUNCTION LIST TO SWAPOUT APPLICATION 
# 
      P<FLHEAD> = BUFADDR;   # ADDR OF BUF TO HOLD FUNCTION LIST       #
      FLWD0[0] = 0; 
      FLID[0] = FLIDVALUE;   # FUNCTION LIST BLOCK ID VALUE            #
      FLBS[0] = FLSIZE;      # FUNCTION LIST SIZE                      #
      FLAN[0] = AN;          # APPLICATION NUMBER                      #
      FLFW[0] = 0;
      FLJOBID[0] = JOBID;    # APPLICATION JOB ID WORD                 #
# 
      ISSUE SYSTEM CONTROL POINT FUNCTION 
# 
      P<FLE> = LOC(FLFW[0]);
      FLFC[0] = SFSWPO;      # SCP SF.SWPO FUNCTION CODE               #
      OSCCALL(FLE); 
# 
      PROCESS SYS CON PT CALL RETURN CODE 
# 
      IF FLRC[0] EQ 0 OR FLRC[0] EQ RCSWAPPEDOUT
      THEN                   # APPLICATION IS NOW SWAPPED OUT          #
        BEGIN 
        BLINK(NWLADDR,NVFADDR); # LINK DATA BLK TO NVF ACB DATA RING   #
        OSCHAPP(NVFADDR);     # SCHEDULE NVF                           #
 
#       CREATE AWL NETON ENTRY                                         #
 
 
 
 
        P<ACB> = ATACBA[AN]; # ACB ADDRESS OD APPLICATION NETTING ON   #
        ACBAWLADDR[0] = AWLA; # UCP AWL ADDRESS                        #
        ACBAN[0] = AN;       # PROCESS NUMBER OF APP NETTING ON        #
        P<AWLENTRY> = LOC(ACBAWL0[0]);  # ADDRESS OF AWL NETON ENTRY   #
        AWLEAIPH[0] = 0;
        AWLOP[0] = WLOPNON;  # AIP OPCODE FOR NETON                    #
 
# 
            U P D A T E   A P P L I C A T I O N  A C B
# 
        ACBUCPADR[0] = CBA;  # UCP COMPLETION BIT ADDRESS              #
        ACBWLFWA[0] = BUFADDR;
        P<DRHDRWD> = ACBWLFWA[0];# ADDR OF NEXT NWL ENTRY              #
        BLKID[0] = NWLEIDVALUE; # NWL ENTRY ID VALUE                   #
        ATNVFR[AN] = TRUE;      # WAITING-FOR-NET/ON /R-FROM-NVF FLAG  #
        ACBWLLWA[0] = BUFADDR + BUFSIZE - 1; # STORE NWL LWA IN ACB    #
        BLKBS[0] = ACBWLLWA[0] - ACBWLFWA[0] + 1; 
        ATASBO[AN] = TRUE;       # SET APP-SWAPPED-OUT-BY-NETON FLAG   #
        ACBIASCPA[0] = LOC(ACBAAVAL[0]);
        ACBIAUCPA[0] = PARAMS3;  # DATA AVAILABLE WORD ADDR            #
        ACBIAFC[0] = SFWRITE;  # FUNCTION CODE                         #
        ACBIAFP[0] = 1;        # FUNCTION PARAMETER                    #
        PARAMS5 = FALSE;     # CLEAR DELETE-ACB FLAG                   #
        END 
      ELSE                   # GOT ABNORMAL SCP FUNCTION RETURN CODE   #
        BEGIN 
        IF FLRC[0] NQ RCUCPGONE 
        THEN                 # GOT BAD SCP FUNCTION RETURN CODE        #
          BEGIN 
          RDUMP;             # DUMP NIP-S FIELD LENGTH                 #
          D25M2[0] = "HPNONAP"; 
          OMSG(DFMSG25,0);  # NIP DUMP TAKEN                           #
          END 
#       RELEASE NWL                                                    #
        P<DRHDRWD> = NWLADDR; # NWL ADDRESS                            #
        BLKBS[0] = SIZENWL;  # SIZE OF NWL BUFFER                      #
        MRELS(P<DRHDRWD>);
        PARAMS5 = TRUE;      # SET DELETE-ACB FLAG                     #
        END 
      GOTO RJMAIN;           # RETURN TO CALLING PROGRAM               #
      END 
TERM