*DECK HPGETSM 
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT DBGBUF
USETEXT FREETAB 
USETEXT GETSM 
USETEXT MEM 
 PROC HPGETSM;               # GET SUPERVISORY MESSAGES                #
 STARTIMS;
 #
*1DC  HPGETSM 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPGETSM             E. GEE              78/01/25 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          PROCESS AIP NETGSM WORKLIST ENTRY
* 
*     3. METHOD USED. 
*          IF NO ROOM, THEN AIP SENT BAD WORKLIST SO ABORT APP
*          COPY NETGSM WORKLIST ENTRY TO ACB
*          GET BUFFER TO HOLD SCP FUNCTION LIST AND SUP MSGS
*          CREATE SCP FUNCTION LIST TO WRITE SUP MSGS TO AIP SUP MSG BUF
*          DELINK SUP MSGS FROM ACB AND COPY TO NIP SUP MSG BUFFER
*          ISSUE SCP FUNCTION TO WRITE SMS TO AIP SM BUFFER 
*          PROCESS SCP FUNCTION RETURN CODE 
*          UPDATE FIELDS IN ACB NETGSM ENTRY
* 
*     4. ENTRY PARAMETERS.
*          ACBADDR           ACB ADDRESS
*          WLADDR            NWL NETGSM WORKLIST ENTRY ADDRESS
* 
*     5. EXIT PARAMETERS. 
*          ABTAPPF           ABORT FLG SET IF NO ROOM IN AWL FOR NETGSM 
*                            ENTRY OR NIP GOT SCP RC = RCUCPAOOR
*          DONE              SET FALSE IF SUP MSGS NOT SENT TO APP FOR
*                            REASON OTHER THAN NIP DID NOT HAVE ANY TO
*                            SEND 
*          FAILADR           FAIL FLG SET IF NIP GOT SCP RC = RCUCPGONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB       APPSTAT
*        DBGBUF    FREETAB
*        GETSM     MEM     NIPDEF 
* 
*     7. ROUTINES CALLED. 
*          BDELINK           DELINK DATA BLK FROM ACB/ACNB DATA RING
*          HBSMABH           COMPUTE LENGTH OF SUP MSG
*          HWRTDA            WRITE DATA TO APP FIELD LENGTH 
*          MGETS             ALLOCATE EMPTY BUFFER
*          MRELS             RELEASE BUFFER SPACE 
*          OMOVE             COPY INFORMATION 
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES.  NONE
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
      XREF PROC BDELINK;     # DELINK DATA BLK FROM DATA RING          #
      XREF PROC HBSMABH;     # BUILD NEW SUP MSG APPLICATION BLK HDR   #
      XREF PROC HWRTDA;      # WRITE DATA TO APP FIELD LENGTH          #
      XREF PROC MGETS;       # ALLOCATE BUFFER SPACE                   #
      XREF PROC MRELS;       # ERLEASE BUFFER SPACE                    #
      XREF PROC OMOVE;       # COPY INFORMATION                        #
      XREF PROC XTRACE; 
# 
                    INTERNAL VARIABLES
# 
 ARRAY FLW P(2);                       # ARRAY FOR ISSUING SCP CALL    #
   BEGIN
   ITEM FLWRC     U(00,00,06);         # RETURN CODE FROM SCP CALL     #
   ITEM FLWFP     U(00,06,12);         # NUMBER OF WORDS TO WRITE      #
   ITEM FLWUCPA   U(00,18,18);         # UCP ADR FOR SF.WRITE SCP FUNC #
   ITEM FLWSCPA   U(00,36,18);         # SCP ADR FOR SF.WRITE SCP FUNC #
   ITEM FLWFC     U(00,54,06);         # SCP FUNCTION CODE             #
   ITEM FLWCB     U(00,59,01);         # SCP FUNCTION COMPLETION BIT   #
   ITEM FLWWD0    U(00,00,60) = [0];   # WORD 0 OF SCP FUNCTION BUFFER #
   ITEM FLWJSNWD  U(01,00,60);         # UCP JSN / EJT ORDINAL WORD    #
   END
  
 ITEM BLKADDR;
 ITEM BUFADDR;               # ADDR OF BUFFER FOR SUP MSG              #
 ITEM BUFSIZE;               # NO OF EMPTY WORDS REMAINING IN SM BUF   #
 ITEM NDEL;                  # NO OF SUP MSGS WRITTEN TO AIP-S SM BUF  #
 ITEM NEXT;                  # ADDR OF NEXT EMPTY WORD IN SUP MSG BUF  #
 ITEM NEXTLEN;               # LENGTH OF NEXT SUP MSG TO BE DELIVERED  #
 ITEM NWDS;                  # NO OF WORDS WRITTEN TO AIP-S SUP MSG BUF#
#**********************************************************************#
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
       XTRACE("HPGSM") ;
      CONTROL FI; 
      DONE = FALSE;          # ASSUME FUNC NOT COMPLTE UNLESS OTHERWISE#
      P<GETSM> = WLADDR;     # WORKLIST ADDRESS                        #
      P<ACB> = ACBADDR;      # ACB ADDRESS                             #
# 
        COPY NEEDED INFORMATION FROM GETSM WORKLIST ENTRY 
# 
        BUFSIZE = GETSMLE[0]; # NO OF EMPTY WORD IN AIP-S SUP MSG BUF  #
        IF BUFSIZE GR 64
        THEN                 # SUP MSG BUFFER IS TOO BIG               #
          BUFSIZE = 64;      # SO REDUCE IT TO MAXIMUM SIZE            #
        NEXTLEN = 0;         # LENGTH OF NEXT SUP MSG TO BE DELIVERED  #
        NDEL = 0;            # NO OF SUP MSGS WRITTEN TO AIP-S SM BUF  #
        NWDS = 0;            # NO OF WORDS WRITTEN TO AIP-S SUP MSG BUF#
# 
        COPY NETGETSM WORKLIST ENTRY TO AWL 
# 
        ACBAWL4[0] = GETSMWD0[0]; # AIP OPCODE WORD                    #
        ACBAWL5[0] = GETSMWD1[0]; # SECOND WORD OF GETSM ENTRY         #
        P<GETSM> = LOC(ACBAWL4[0]); # BASED ARRAY NOW POINTS TO AWL ENT#
        IF ACBDRFP[0] NQ 0 AND BUFSIZE NQ 0 
        THEN                 # THERE ARE SUP MSGS TO SEND TO APP       #
          BEGIN 
# 
          GET BUFFER FOR HOLDING SUPERVISORY MESSAGES 
# 
          MGETS(BUFSIZE+BLKHSIZE,BUFADDR,FALSE);
# 
          CREATE SCP FUNCTION LIST TO WRITE SUP MSGS TO UCP FL
# 
          FLWWD0[0] = 0;             # INITIALIZE SCP FUNCTION CODE WD #
          FLWUCPA[0] = GETSMTA[0]; # AIP SUP MSG BUF ADDRESS           #
          FLWSCPA[0] = BUFADDR + BLKHSIZE; # ADDR OF FIRST SUP MSG     #
          FLWJSNWD[0] = ACBJNWD[0]; # JOB ID WORD                      #
# 
            SET UP NIP SUPERVISOR MESSAGE BUFFER
# 
            NEXT = BUFADDR + BLKHSIZE; # SUP MSG BUFFER FREE WD PTR    #
            HBSMABH(NEXTLEN); 
            BUFSIZE = BUFSIZE - 1; # REDUCE AVAIL SPACE FOR ZERO WORD  #
# 
            FILL SUPERVISOR MESSAGE BUFFER
# 
            FOR NEXT=NEXT WHILE NEXTLEN LQ BUFSIZE
                AND ACBDRFP[0] NQ 0 DO
              BEGIN 
              BDELINK(ACBADDR,BLKADDR,0); 
# 
                COPY SUPERVISOR MESSAGE TO SUPERVISOR MESSAGE BUFFER
# 
                MOLD = BLKADDR + BLKHSIZE;
                MNEW = NEXT;
                MSIZE = NEXTLEN;
                OMOVE;
                NEXT = NEXT + NEXTLEN;
                MRELS(BLKADDR); # RELEASE DATA BLOCK                   #
                BUFSIZE = BUFSIZE - NEXTLEN; # UPDATE SIZE REMAINING   #
                NWDS = NWDS + NEXTLEN; # UPDATE COUNT OF WDS TO DELIVER#
                NDEL = NDEL + 1; # UPDATE COUNT OF NO OF SUP MSGS      #
                IF ACBDRFP[0] EQ 0
                THEN         # NO MORE SUP MSGS AVAILABLE              #
                  BEGIN 
                  NEXTLEN = 0;
                  ACBERCNT[0] = 0;      # CLEAR LOGICAL ERROR COUNT    #
                  END 
                ELSE
                  HBSMABH(NEXTLEN); 
              END 
  
            CONTROL IFEQ DEBUG,1; 
              PNVALUE[0] = ACBAN[0];# APPLICATION PROCESS NUMBER       #
              BGETSMW[BGETSMP] = PNWORD[0]; # STORE PN IN DEBUG BUFFER #
              BGETSMP = BGETSMP + 1; # INCREMENT BUFFER OFFSET PTR     #
              IF BGETSMP GR 999 
              THEN           # END OF BUFFER HAS BEEN REACHED          #
                BGETSMP = 0; # INITIALIZE OFFSET PTR TO BEG OF BUFFER  #
  
#             COPY SUPERVISOR MESSAGES TO DEBUG BUFFER                 #
              P<TRAP> = BUFADDR; # ADDR OF SUP MSG BUFFER              #
              FOR TRAPINDEX = 1 STEP 1 UNTIL NWDS DO
                BEGIN 
                BGETSMW[BGETSMP] = WORD[TRAPINDEX]; 
                BGETSMP = BGETSMP + 1; # INCREMENT BUFFER OFFSET PTR   #
                IF BGETSMP GR 999 
                THEN         # END OF BUFFER HAS BEEN REACHED          #
                  BGETSMP = 0; # INITIALIZE OFFSET PTR TO BEG OF BUFFER#
                END 
            CONTROL FI; 
  
  
            MEMORY[NEXT] = 0;# ZERO WORD AT END OF THE BUFFER          #
            FLWFC[0] = SFWRITE;  # SCP WRITE FUNCTION CODE             #
            FLWFP[0] = NWDS + 1; # NO OF WORDS TO WRITE TO UCP FL      #
            HWRTDA(FLW,FLSIZE,BUFADDR); 
          END 
        ELSE                 # NO SUP MSGS TO SEND TO APP              #
          DONE = TRUE;       # SET FUNCTION-COMPLETED FLAG             #
  
# 
          FILL AWL NETGETSM ENTRY 
# 
          GETSMND[0] = NDEL; # NO OF SUP MSGS WRITTEN TO UCP FL        #
          GETSMCB[0] = 1;    # SET WORKLIST ENTRY COMPLETION BIT       #
          IF NEXTLEN EQ 0 
          THEN               # THERE ARE NO MORE SUP MSGS IN DATA RING #
            GETSMNL[0] = 0;  # LENGTH OF NEXT SUP MSG FIELD            #
          ELSE               # THERE ARE MORE SUP MSGS IN DATA RING    #
            GETSMNL[0] = NEXTLEN+1; # LENGTH+1 OF NEXT SUP MSG IN D R  #
          GETSMNW[0] = NWDS; # NO OF WDS WRITTEN TO AIP SUP MSG BUF    #
      END 
TERM
