Retro1.org codex

*DECK HWRTDA
USETEXT NIPDEF
USETEXT ACNB
USETEXT ACB 
USETEXT APPSTAT 
USETEXT AT
USETEXT FLIST 
 PROC HWRTDA(FLW,FLSIZ,BUFADDR);       # WRITE MSGS BACK TO APP FL     #
 STARTIMS ; 
 #
*1DC  HWRTDA
*     1. PROC NAME           AUTHOR              DATE 
*        HWRTDA              E. GEE              85/04/02 
* 
*     2. FUNCTIONAL DESCRIPTION 
*          WRITE MULTIPLE MESSAGE BUFFERS TO APPLICATION-S FIELD
*            LENGTH.
* 
*     3. METHOD 
*        IF NO CONNECTION DATA RING EXISTS, 
*          UPDATE ACB TO POINT TO THIS ACNB.
*        ELSE (CONNECTION DATA RING ALREADY EXISTS),
*          ADD THIS ACNB TO CONNECTION DATA RING.  IT IS LINKED IN
*            FRONT OF THE ACNB POINTED TO BY THE ACB. 
* 
*     4. ENTRY PARAMETERS 
*          ACBADDR           ADDRESS OF CORRESPONDING ACB 
*          BUFADDR           ADDRESS OF DATA TO WRITE TO APP FL 
*          FLSIZ             SIZE OF SCP FUNCTION LIST
*          FLW               ADDRESS OF SCP FUNCTION LIST 
* 
*     5. EXIT PARAMETERS
*          ABTAPPF           FLAG SET IF APP SUPPLIED BAD ADDR
*          FAILADR           FLAG SET IF APP FAILED 
* 
*     6. COMDECKS CALLED
*          ACB               APPLICATION CONTROL BLOCK TEMPLATE 
*          ACNB              APPLICATION CONNECTION BLOCK TEMPLATE
*          APPSTAT           NETWORK WORKLIST PROCESSING TABLE
*          AT                APPLICATION TABLE
*          FLIST             SCP FUNCTION LIST TEMPLATE 
*          NIPDEF            CONSTANT DEFINITIONS 
* 
*     7. ROUTINES CALLED
*          MGETS             GET BUFFER 
*          MRELS             RETURN BUFFER
*          OSCCALL           ISSUE SCP REQUEST
*          OSCHAPP           ISSUE SCP SWAPIN REQUEST FOR APPLICATION 
*          XTRACE            TRACE PROCEDURE CALL 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
* 
 #
STOPIMS;
 
# 
 INPUT VARIABLES
# 
 ARRAY FLW P(3);                       # 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 READ       #
   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);         # WORD 0 OF SCP FUNCTION BUFFER #
   ITEM FLWJSNWD  U(01,00,60);         # UCP JSN / EJT ORDINAL WORD    #
   ITEM FLWXUCPA  U(02,12,24);         # UCP ADR FOR SF.XWRITE SCP FUNC#
   ITEM FLWXSCPA  U(02,36,24);         # SCP ADR FOR SF.XWRITE SCP FUNC#
   ITEM FLWWD2    U(02,00,60);         # WORD 2 OF SCP FUNCTION BUFFER #
   END
 
ITEM FLSIZ;                            # SIZE OF SCP FUNCTION LIST     #
ITEM BUFADDR;                          # ADDR OF BUFFER CONTAINING DATA#
 
# 
      EXTERNAL REFERENCES 
# 
      XREF
        BEGIN 
        PROC MGETS;                    # GET BUFFER                    #
        PROC MRELS;                    # RETURN BUFFER                 #
        PROC OSCCALL;                  # ISSUE SCP REQUEST             #
        PROC OSCHAPP;                  # ISSUE SCP SWAPIN REQ FOR APP  #
        PROC XTRACE;                   # TRACE PROCEDURE CALL          #
        END 
 
#**********************************************************************#
      CONTROL EJECT;
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("HWRDA");
      CONTROL FI; 
 
      P<ACB> = ACBADDR;                # ADDRESS OF ACB                #
 
WRBLK:  
      OSCCALL(FLW);                    # ISSUE SCP FUNCTION            #
# 
      PROCESS SCP FUNCTION RETURN CODE
# 
      IF FLWRC[0] EQ RCSWAPPEDOUT 
      THEN                             # APPLICATION WAS SWAPPED OUT   #
        BEGIN 
        MGETS(FLSIZ,P<FLHEAD>,TRUE);   # GET BUF FOR SAVING SCP REQ    #
        FLID[0] = FLIDVALUE;           # FUNCTION LIST BLOCK ID VALUE  #
        FLAN[0] = ACBAN[0];            # APPLICATION NUMBER            #
        FLFW[0] = FLWWD0[0];           # COPY WORD 0 OF SCP FUNC REQ   #
        FLJOBID[0] = FLWJSNWD[0];      # COPY WORD 1 OF SCP FUNC REQ   #
        IF FLSIZ EQ FLXSIZE 
        THEN                           # NEED TO COPY 1 MORE WORD      #
          BEGIN 
          FLXRW[0] = FLWWD2[0];        # COPY WORD 2 OF SCP FUNC REQ   #
          END 
        ACBFLIST[0] = P<FLHEAD>;       # FUNC LIST ADDRESS             #
        ATASBS[ACBAN[0]] = TRUE;       # SET-APP-SWAP-OUT FLAG IN ACB  #
        ACBWRADDR[0] = BUFADDR;        # ADDR OF BUF TO WRITE TO UCP FL#
        OSCHAPP(ACBADDR);              # SCHEDULE APPLICATION          #
        ACBNWLE[0] = ACBNWLE[0]-1;     # UPDATE NO OF ENTRIES LEFT     #
        ACBWLADR[0] = NEXTWLA;
        END 
      ELSE
        BEGIN 
        IF FLWRC[0] EQ 0
        THEN                           # NO ERROR RETURN CODE          #
          BEGIN 
          IF (FLWFP[0] NQ 0   ) AND    # NOT FINISHED WRITING TEXT     #
             (FLSIZ EQ FLXSIZE)        # EXTENDED WRITE FUNCTION       #
          THEN                         # NEED TO REISSUE REQUEST       #
            BEGIN 
            FLWCB[0] = 0;              # CLEAR COMPLETION BIT          #
            GOTO WRBLK;                # GO BACK AND REISSUE SCP REQ   #
 
            END 
          ELSE                         # COMPLETED WRITING TEXT        #
            BEGIN 
            DONE = TRUE;               # FINISHED PROCESSING WORKLIST  #
            MRELS(BUFADDR); 
            END 
          END 
        ELSE                           # ERROR RETURN CODE             #
          BEGIN 
          MRELS(BUFADDR); 
          IF FLWRC[0] EQ RCUCPGONE
             OR FLWRC[0] EQ RCSTCBAD
          THEN                         # APP IS NO LONGER IN SYSTEM    #
            BEGIN 
            FAILADR = ACBADDR;         # SET APPLICATION-FAILED FLAG   #
            END 
          ELSE                         # AIP MUST HAVE GIVEN BAD ADR   #
            BEGIN 
            ABTAPPF = XFLERR;          # SET ABORT-APPLICATION FLAG    #
            END 
          END 
        END 
      RETURN; 
      END 
TERM