Retro1.org codex

*DECK HPUTF 
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT AT
USETEXT AWLNTRY 
USETEXT DRHDR 
USETEXT FLIST 
USETEXT FREETAB 
USETEXT MEM 
USETEXT NP$TAA
USETEXT NWLHEAD 
USETEXT NWLNTRY 
USETEXT OVERLAY 
USETEXT PARAMP
USETEXT PARAMS
USETEXT PT
 PRGM HPUTF;                 # PROCESS NETPUTF REQUEST                 #
 STARTIMS;
 #
*1DC  HPUTF 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HPUTF               P.C.TAM             77/05/11 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          USE TEXT ARRAY PROVIDED BY APP TO READ TEXT INTO NWL FOR 
*          HPUTBLK
* 
*     3. METHOD USED. 
*          EDIT NA, SIZE FIELDS OF NWL. 
*          GET BUFFER BIG ENOUGH FOR FLHEAD, DATA BLOCK AND REST OF 
*          NWL. 
*          SET UP FLHEAD AND FLENTRIES FOR SF.LIST IN OLD NWL.
*          CALL SF.LIST 
*          IF EVERYTHING IS OK, COPY REST OF NWL OVER.
* 
*     4. ENTRY PARAMETERS.
*          ACBADDR           APPLICATION"S ACB
*          WLADDR            WORKLIST ENTRY 
* 
*     5. EXIT PARAMETERS. 
*          DONE              TRUE 
*          PARAMS1           REASON,IF LGL/ERR
*          ACBUCPFSNS         TRUE,IF NOT ENOUGH SPACE FOR MESSAGE. 
*          ACBUCPFSSO         TRUE,IF SFREAD RC IS RCSWAPPEDOUT 
*          PARAMP1           FLAG TO INDICATE IF VALID NETPUTF REQUEST
*                            = 0 IF INVALID REQUEST.
*                            = 1 IF VALID REQUEST 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB     APPSTAT     AT     DRHDR 
*        FLIST  FREETAB   MEM       NIPDEF    NP$TAA
*        PT  NWLHEAD   NWLNTRY   OVERLAY   PARAMS 
*        PARAMP1             BUFFER FOR PASSING PARAMETERS FROM PRI OVL 
* 
*     7. ROUTINES CALLED. 
*          HLGLERR    OVL    ISSUE ERR/LGL SUP MSG
*          HRELWWL           RELEASE WHOLE NWL
*          XCTLW             CALCULATE TEXT LENGTH FROM TLC, ACT. 
*          MGETS             ALLOCATE BUFFER SPACE
*          OMOVE             COPY INFORMATION 
*          OSCCALL           SCP CALL 
*          OSCHAPP           SCHEDULE APPLICATION 
*          MRELS             RELEASE FREE BUFFER SPACE
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES. NONE 
 #
 STOPIMS; 
 
      XREF BEGIN
        PROC XCTLW;          #CALCULATE TEXT LENGTH FROM TLC  # 
        PROC HRELWWL;        # RELEASE WHOLE NWL                       #
        PROC MGETS;          #ALLOCATE BUFFER SPACE           # 
        PROC OMOVE;          # COPY INFORMATION                        #
        PROC OSCCALL;        #SCP CALL                        # 
        PROC OSCHAPP;        #SCHEDULE APPLICATION            # 
        PROC MRELS;          #RELEASE FREE BUFFER SPACE       # 
        PROC OVLCALL;        #OVERLAY SUBROUTINE              # 
        PROC XTRACE;
        LABEL RJMAIN;        # RETURN ADDRESS IN OVLCALL TO RETURN TO  #
      END 
 
      ITEM  LENGTH         I, 
            TXTLN1         I, 
            TXTLN2         I, 
            SIZE           I, 
            BUFADDR        U, 
            LEFT           I, 
            TMP            I, 
            I              I, 
            START0         U, 
            START1         U; 
 
 
      BEGIN                  #NWL FOR NETPUTF                          #
      CONTROL IFEQ DEBUG,1; 
        XTRACE("HPUTF") ; 
      CONTROL FI; 
        CONTROL OVERLAP;
        DONE        =   FALSE;      # PRESET STATUS                   # 
        P<ACB>      =   ACBADDR;    # ESTABLISH ADDRESS.              # 
        P<NWLENTRY> =   WLADDR;     #                                 # 
        P<TAA>      =   WLADDR + FLSIZE;
        P<DRHDRWD> = 0; 
 
        TMP         =   0;
        LENGTH      =   0;
        XCTLW(NWLEABH,TXTLN1);
        TXTLN2      =   TXTLN1; 
 
        FOR I = 1 STEP FLESIZE UNTIL NWLELTAA      #GET ACTUAL SIZE   # 
        DO                   # GET ACTUAL SIZE OF TEXT FROM TAA DESC.  #
          BEGIN              # AND CHECK IF EACH FRAGMENT SIZE GR 63   #
          LENGTH    = LENGTH + TAASIZE[I];
          IF TAASIZE[I] GR 63 
          THEN
            TMP     = 1;
          END 
 
        IF (LENGTH GQ TXTLN1) AND # TEXT LENGTH ACTUAL LS BUFFER       #
           (TMP NQ 1)         AND # SIZE FRAGMENTS LS 63               #
           (NWLELTAA LQ MAXNA)    # NO OF TA ENTRIES LS 40             #
        THEN
        BEGIN 
          MGETS(ACBWLLWA[0]-WLADDR+TXTLN1,         # GET BUFFER SPACE  #
                BUFADDR, FALSE);                   # FOR DATA BLOCK    #
 
            MGETS(NWLEBS[0], START0, TRUE);        # GET BUF FOR FLIST.#
            SIZE       = BLKBS[BUFADDR];           #SAVE THE SIZE OF B# 
            MEMORY[BUFADDR] = MEMORY[WLADDR]; # AIP HEAD               #
            MEMORY[BUFADDR+AIPHSIZE] = MEMORY[WLADDR+AIPHSIZE]; 
 
            #  PREPARE FL HEADER FOR SF.LIST CALL  #
 
            P<FLHEAD> = START0; 
            FLID       = FLIDVALUE;                #SF.FUNCTION BLK ID# 
            FLAN       = ACBAN[0];
            FLJOBID    = ACBJNWD[0];               #FILL 3RD WORD     # 
            FLSCPA     = START0 + FLSIZE;          # CALCULATE SCP ADDR#
            FLFC       = SFLIST;                   #FUNCTION CODE     # 
            P<FLE>     = FLSCPA;
 
            P<TAA>     = WLADDR + FLSIZE; 
            FOR I = 0 STEP FLESIZE WHILE TXTLN2 GR 0
            DO                                     #LOOP TO FILL      # 
            BEGIN                                  #SF.READ ENTRIES   # 
              FLEFC[I]  = SFREAD; 
              FLEFP[I]  = TAASIZE[I+1]; 
              FLEUCPA[I]= TAADDR[I+1];
              FLESCPA[I]= BUFADDR + AIPHSIZE + ABHSIZE + TXTLN1 - 
                          TXTLN2; 
              TXTLN2    = TXTLN2 - TAASIZE[I+1];
            END 
 
            FLEFP[I-1] = FLEFP[I-1] + TXTLN2; 
            FLFP       = I; 
            P<FLE>     = START0 + FLHSIZE;
            OSCCALL(FLE); 
                                                   #CHECK FOR NORMAL  # 
            IF FLRC NQ 0                           #COMPLETION        # 
            THEN
            BEGIN 
 
              IF FLRC EQ RCSWAPPEDOUT              #USER JOB SWAPPED  # 
              THEN                                 #SET APP. SWP OUT  # 
              BEGIN                                #BIT, SCHEDULE     # 
                ATASBS[ACBAN[0]] = TRUE;           #APPLICATION       # 
                OSCHAPP(ACBADDR); 
              END 
 
              ELSE
              IF FLRC EQ RCUCPAOOR                 #UCPA OUT OF RANGE # 
              THEN ABTAPPF = XFLERR;
              ELSE FAILADR = ACBADDR;              #OTHER SCP ERROR   # 
              BLKBS[BUFADDR] = SIZE;   # RESTORE ORIGINAL BUFFER SIZE  #
              MRELS(BUFADDR); 
              MRELS(START0);
            END 
 
            ELSE                                   #SCP REQUEST COMP. # 
            BEGIN 
              MRELS(START0);
              DONE = TRUE;                         #COPY REST OF NWL  # 
              BLKBS[BUFADDR] = TXTLN1 + AIPHSIZE + ABHSIZE; 
              MSIZE = ACBWLLWA[0] - WLADDR - AIPHSIZE 
                      - ABHSIZE - NWLELTAA[0];
              MNEW = BUFADDR + BLKBS[BUFADDR];
              MOLD = WLADDR + AIPHSIZE + ABHSIZE + 1 + NWLELTAA[0]; 
              OMOVE;
              HRELWWL;       # RELEASE WHOLE NWL                       #
              ACBWLLWA[0] = BUFADDR + SIZE - 1;   # UPDATE ACB FIELDS # 
              ACBWLFWA[0] = BUFADDR;
              ACBWLADR[0] = BUFADDR;
              BLKID[BUFADDR] = NWLEIDVALUE; 
              NEXTWLA = BUFADDR + BLKBS[BUFADDR];  #                  # 
              WLADDR  = BUFADDR;
            END 
          PARAMP1 = 1;       # GOOD NETPUTF REQUEST WAS PROCESSED      #
        END 
        ELSE
                             #TOTAL SIZE IN TAA DESCRIPTION TOO SMALL # 
        BEGIN 
          CMWORD[WLADDR+AIPHSIZE+ABHSIZE] = TAAWORD[0]; # RESTORE NWL  #
          PARAMS1 = RLG"RES"; 
          OVLNAME = HLGLERRP; 
          OVLCALL;
          DONE    = TRUE; 
          PARAMP1 = 0;       # ERR/LGL WAS GENERATED FOR BAD NETPUTF RQ#
        END 
      GOTO RJMAIN;           # RETURN TO CALLING PROGRAM               #
      END #HPUTF# 
 TERM