Retro1.org codex

*DECK HPAWL 
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT AT
USETEXT STATTAB 
 PROC HPAWL;
 
 STARTIMS;
 #
*1DC  HPAWL 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPAWL               E. GEE              78/01/25 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          WRITE AWL BACK TO APPLICATION
* 
*     3. METHOD USED. 
*          CREATE FUNCTION LIST TO WRITE AWL (IF ONE) AND CLEAR SHORT 
*            TERM CONNECTION
*          ISSUE SYSTEM CONTROL POINT FUNCTION
*          PROCESS SCP FUNCTION RETURN CODE 
* 
*     4. ENTRY PARAMETERS.
*          ACBADDR           ACB ADDRESS
* 
*     5. EXIT PARAMETERS. 
*          ABTAPPF           ABORT FLG SET IF NIP GOT SCP RC = RCUCPAOOR
*          FAILADR           FAIL FLG SET IF NIP GOT SCP RC = RCUCPGONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB     APPSTAT     AT 
*        NIPDEF 
*        STATTAB             STATISTICS TABLE 
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          HRELWWL           RELEASE THE WHOLE WORKLIST 
*          OSCCALL           ISSUE SYSTEM CONTROL POINT FUNCTION
*          OSCHAPP           SCHEDULE APPLICATION 
*          OTIME             GET SYSTEM RTIME 
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
*        THIS PROCEDURE IS CALLED BY HWLP.
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC HRELWWL;                       # RELEASE THE WHOLE NWL         #
   PROC OSCCALL;                       # ISSUE SCP CALL                #
   PROC OSCHAPP;
   PROC OTIME;                         # GET SYSTEM RTIME              #
   PROC XTRACE;                        # TRACE CALLS                   #
   END
# 
                    INTERNAL VARIABLES
# 
 
 CONTROL IFEQ STAT,1; 
   ARRAY STIME P(1);                   # RTIME BUFFER FOR STARTING TIME#
     BEGIN
     ITEM SMILS U(0,24,36);            # STARTING TIME IN MILLESECONDS #
     END
   ARRAY ETIME P(1);                   # RTIME BUFFER FOR ENDING TIME  #
     BEGIN
     ITEM EMILS U(0,24,36);            # ENDING TIME IN MILLESECONDS   #
     END
 
   ITEM STTEMP;                        # TEMPORARY STATISTICS VARIABLE #
 CONTROL FI;
 
 
 ARRAY FL$BUF [0:2];                   # ARRAY OF SCP FUNCTION REQUESTS#
   BEGIN
   ITEM FL$RC     U(00,00,06) = [3(0)];   # RETURN CODE FROM SCP CALL  #
   ITEM FL$FP     U(00,06,12) = [2,6,0];  # FUNCTION PARAMETER         #
   ITEM FL$UCPA   U(00,18,18) = [3(0)];   # UCP ADDRESS                #
   ITEM FL$SCPA   U(00,36,18) = [3(0)];   # SCP ADDRESS                #
   ITEM FL$FC     U(00,54,06) = [SFLIST,SFWRITE,SFENDT];  # SCP FUNC CD#
   ITEM FL$CB     U(00,59,01);         # SCP FUNCTION COMPLETION BIT   #
   ITEM FL$WD0    U(00,00,60);         # WORD 0 OF SCP FUNCTION BUFFER #
   END
 
 ARRAY FLE$BUF S(4);                   # ARRAY FOR ISSUING SCP REQUEST #
   BEGIN
   ITEM FLE$HRC    U(00,00,06);        # SCP RETURN CODE               #
   ITEM FLE$HUCPA  U(00,18,18);        # UCP ADDRESS                   #
   ITEM FLE$HSCPA  U(00,36,18);        # SCP ADDRESS                   #
   ITEM FLE$HWD    U(00,00,60);        # SCP FUNCTION CODE WORD        #
   ITEM FLE$JSNWD  U(01,00,60);        # UCP JSN / EJT ORDINAL WORD    #
   ITEM FLE$1UCPA  U(02,18,18);        # UCP ADR FOR SF.WRITE SCP FUNC #
   ITEM FLE$1SCPA  U(02,36,18);        # SCP ADR FOR SF.WRITE SCP FUNC #
   ITEM FLE$1WD    U(02,00,60);        # SCP FUNCTION CODE WORD        #
   ITEM FLE$2UCPA  U(03,18,18);        # UCP ADR FOR SF.ENDT SCP FUNC  #
   ITEM FLE$2SCPA  U(03,36,18);        # SCP ADR FOR SF.ENDT SCP FUNC  #
   ITEM FLE$2WD    U(03,00,60);        # SCP FUNCTION CODE WORD        #
   END
 
 ITEM AN;                              # APPLICATION NUMBER            #
 
#**********************************************************************#
     BEGIN
 
      CONTROL IFEQ DEBUG,1; 
       XTRACE("HPAWL") ;
      CONTROL FI; 
 
      CONTROL IFEQ STAT,1;
        OTIME(STIME);        # GET SYSTEM TIME AT BEGINNING OF PROC    #
      CONTROL FI; 
 
 
      P<ACB> = ACBADDR;      # ACB ADDRESS                             #
# 
      CREATE FUNCTION LIST TO WRITE AWL (IF SOMETHING TO WRITE BACK)
      AND END SHORT TERM CONNECTION BETWEEN APP AND NIP 
# 
      AN = ACBAN[0];         # APPLICATION NUMBER                      #
      FLE$JSNWD[0] = ACBJNWD[0];  # ACB JOB WORD                       #
      IF (ACBAWL0[0] NQ 0) OR   # NO GET/GETL OR NETON OR NETXFR RESP  #
         (ACBAWL2[0] NQ 0) OR   # NO GETMM RESPONSE                    #
         (ACBAWL4[0] NQ 0)      # NO GETSM RESPONSE                    #
      THEN                   # WRITE AWL RESPONSE TO APP               #
        BEGIN 
# 
        UPDATE DATA AVAILABLE FLAGS IN AWL RESPONSE 
# 
        FLE$HWD[0] = FL$WD0[0];  # SF.LIST FUNCTION CODE WORD          #
        FLE$HSCPA[0] = LOC(FLE$1WD);  # ADDR OF SF.LIST ENTRIES        #
        FLE$1WD[0] = FL$WD0[1];  # SF.WRITE FUNCTION CODE WORD         #
        FLE$1UCPA[0] = ACBAWLADDR[0];  # UCP ADDR TO WRITE AWL         #
        FLE$1SCPA[0] = LOC(ACBAWL0[0]); 
        FLE$2WD[0] = FL$WD0[2];  # SF.ENDT FUNCTION CODE WORD          #
        FLE$2UCPA[0] = ACBUCPADR[0];  # UCP COMPLETION BIT ADDR        #
        END 
      ELSE                   # ONLY NEED TO CLEAR SHORT TERM           #
        BEGIN 
        FLE$HWD[0] = FL$WD0[2];  # SF.ENDT SCP FUNCTION WORD           #
        FLE$HUCPA[0]= ACBUCPADR[0];  # UCP COMPLETION BIT ADDR         #
        END 
# 
      ISSUE SCP REQUEST 
# 
      OSCCALL(FLE$BUF); 
# 
      PROCESS SCP FUNCTION RETURN CODE
# 
      IF FLE$HRC[0] NQ RCSWAPPEDOUT 
      THEN                   # ALRIGHT TO RELEASE AWL BUFFER           #
        BEGIN 
        IF FLE$HRC[0] EQ 0
        THEN                 # SCP FUNCTION COMPLETED OK               #
          BEGIN 
          ACBAWLADDR[0] = 0;
          ACBAWL0[0] = 0;    # CLEAR  AWL WORD IN ACB                  #
          ACBAWL2[0] = 0;    # CLEAR AWL WORD IN ACB BLOCK             #
          ACBAWL4[0] = 0 ;
          HRELWWL;           # RELEASE THE WHOLE NWL                   #
          END 
        ELSE                 # SCP FUNCTION NOT COMPLETED OK           #
          BEGIN 
          IF FLE$HRC[0] EQ RCUCPGONE
             OR FLE$HRC[0] EQ RCSTCBAD
          THEN               # UCP IS NO LONGER IN SYSTEM SO           #
            FAILADR = ACBADDR; # SET APPLICATION-FAILED FLAG           #
          ELSE               # UCP GAVE BAD AWL ADDR SO ABORT IT       #
            ABTAPPF = XFLERR;   # SET ABORT-APPLICATION FLAG           #
          END 
        END 
      ELSE                   # APP IS SWAPPED OUT                      #
        BEGIN              # AFTER SWAPIN,HPAWL WILL BE CALLED AGAIN   #
        ATASBS[AN] = TRUE;   # SET APP-SWAPPED-OUT FLAG IN ACB         #
        OSCHAPP(ACBADDR);    # SCHEDULE APPLICATION                    #
        END 
 
      CONTROL IFEQ STAT,1;
        OTIME(ETIME);        # GET SYSTEM TIME AT END OF PROCEDURE     #
        ST$NAW = ST$NAW + 1; # INCREMENT NUMBER OF TIMES HPAWL CALLED  #
        STTEMP = EMILS[0] - SMILS[0];  # TIME SPENT IN THIS ROUTINE    #
        ST$TAW = ST$TAW + STTEMP;  # TOTAL TIME SPENT IN THIS ROUTINE  #
        IF ST$LAW LS STTEMP 
        THEN                 # FOUND LARGER TIME INTERVAL IN ROUTINE   #
          BEGIN 
          ST$LAW = STTEMP;   # NEW LARGEST TIME INTERVAL               #
          END 
      CONTROL FI; 
 
      RETURN; 
      END 
TERM