ASMB,L,R,C
      HED FLOAD 91750-16118 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 
      NAM FLOAD,7 91750-16118 REV.2013 800430 ALL 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
******************************************************************
      SPC 2 
      SPC 1 
**********************************************
* 
*FLOAD              SUBROUTINE TO DO FORCED DOWN LOAD OF
*                   ABSOLUTE PROGRAM TO RTE-M OR L SYSTEM.  
* 
*     NAME:    FLOAD
*     SOURCE:  91750-18118
*     RELOC:   91750-16118
*     PGMR:    JERRY BELDEN 
* 
*WRITTEN BY:        LARRY POMATTO                             AUGUST 74 
* 
*MODIFIED BY:       JEAN-PIERRE D. BAUDOUIN                   JULY 76 
*                   DAN GIBBONS                               FEB  77 
*                   JDH FOR DS REQUEST EQUATED OFFSETS        790220
*                   GAB FOR 91750 ON 790607 
* 
*********************************************** 
      SPC 1 
      SUP 
* 
      EXT #MAST,.ENTR,#TILT,#RQB
      EXT .MVW
      SPC 1 
      ENT FLOAD 
      SPC 1 
B     EQU 1 
RQB   EQU #RQB
      SPC 1 
* 
*     CALLING SEQUENCE
*     JSB FLOAD 
*     DEF *+6 TO *+10 
*     DEF PROGRAM FILE NAME 
*     DEF CRN 
*     DEF FILE NODE #    (=>0)
*     DEF DESTINATION NODE
*     DEF ERROR CODE
*     DEF FILE SECURITY CODE (OPTIONAL) 
*     DEF PARTITION # (OPTIONAL)
*     DEF PARTITION SIZE IN PAGES (OPTIONAL)
*     DEF 3 WORD ERROR MESSAGE BUFR (OPTIONAL)
      SKP 
* GLBLK-START 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV XXXX 790531      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  LSTEN, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*                                                                *
******************************************************************
* 
***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!***
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
* 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
* GLBLK-END 
      SKP 
* DXBLK-START 
* 
******************************************************************
*                                                                *
*      D E X E C   B L O C K                REV XXXX 790531      *
*                                                                *
*      OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY:      *
*                                                                *
*       DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT          *
*                                                                *
******************************************************************
* 
* OFFSETS INTO DEXEC REQUEST BUFFERS. 
* 
#ICD  EQU #REQ      ICODE FOR DEXEC(ALL)
#CNW  EQU #ICD+1    CONWD FOR DEXEC(1,2,3,13) 
#BFL  EQU #CNW+1    IBUFL FOR DEXEC(1,2)
#PM1  EQU #BFL+1    IPRM1 FOR DEXEC(1,2)
#PM2  EQU #PM1+1    IPRM2 FOR DEXEC(1,2)
#PRM  EQU #CNW+1    IPRAM FOR DEXEC(3)
#PGN  EQU #ICD+1    PRGNM FOR DEXEC(6,9,10,12,23,24,99) 
#INU  EQU #PGN+3    INUMB FOR DEXEC(6)
#DPM  EQU #INU+1    PARMS FOR DEXEC(6)          (5-WORD AREA) 
#PMS  EQU #PGN+3    PARMS FOR DEXEC(9,10,23,24) (5-WORD AREA) 
#IBF  EQU #PMS+5    IBUFR FOR DEXEC(9,10,23,24) 
#IBL  EQU #IBF+1    IBUFL FOR DEXEC(9,10,23,24) 
#FNO  EQU #IBL+1    FNOD  FOR DEXEC(9)          (APLDR) 
#RSL  EQU #PGN+3    IRESL FOR DEXEC(12) 
#MPL  EQU #RSL+1    MTPLE FOR DEXEC(12) 
#HRS  EQU #MPL+1    IHRS  FOR DEXEC(12) 
#MIN  EQU #HRS+1    IMIN  FOR DEXEC(12) 
#SEC  EQU #MIN+1    ISECS FOR DEXEC(12) 
#MSC  EQU #SEC+1    MSECS FOR DEXEC(12) 
#PAR  EQU #ICD+1    PARTI FOR DEXEC(25)         (PARTITION #) 
#IST  EQU #PGN+3    ISTAT FOR DEXEC(99) 
* 
* OFFSETS INTO DEXEC REPLY BUFFERS. 
* 
#EQ5  EQU #EC1      EQT 5 FOR DEXEC(1,2,3)
#XML  EQU #EC2      TRANSMISSION LOG (DEXEC 1,2)
#RPM  EQU #REP      PRAMS FOR DEXEC(9,23)       (5-WORD AREA) 
#TMS  EQU #REP      MSEC  FOR DEXEC(11) 
#TSC  EQU #TMS+1    SEC   FOR DEXEC(11) 
#TMN  EQU #TSC+1    MIN   FOR DEXEC(11) 
#THR  EQU #TMN+1    HRS   FOR DEXEC(11) 
#TDA  EQU #THR+1    DAY   FOR DEXEC(11) 
#TYR  EQU #TDA+1    YEAR  FOR DEXEC(11) 
#ST1  EQU #REP      ISTA1 FOR DEXEC(13) 
#ST2  EQU #ST1+1    ISTA2 FOR DEXEC(13) 
#ST3  EQU #ST2+1    ISTA3 FOR DEXEC(13) 
#PAG  EQU #REP      IPAGE FOR DEXEC(25) 
#IPN  EQU #PAG+1    IPNUM FOR DEXEC(25) 
#PST  EQU #IPN+1    ISTAT FOR DEXEC(25) 
#KST  EQU #REP      ISTAT FOR DEXEC(99) 
* 
* MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. 
* 
#DLW  EQU #MHD+12      M A X I M U M   S I Z E   ! ! !
* 
* DXBLK-END 
      SKP 
FNAM  NOP 
CRN   NOP 
FNOD  NOP 
FLU   NOP 
FERCD NOP 
ISECU NOP 
PNUM  NOP 
PSIZE NOP 
FERMG NOP 
      SPC 2         ENTRY POINT 
FLOAD NOP 
      JSB .ENTR 
PRMSA DEF FNAM
* 
      LDA FERCD     ERROR RETURN SPECIFIED? 
      SZA,RSS 
      JMP EXIT      NO, GET OUT QUICK 
* 
      LDA FLU,I     GET DESTINATION 
      STA RQB+#DST
* 
* 
      LDA D3        SET STREAM TYPE 
      STA RQB+#STR
      LDA D9        SET ICODE FOR 
      STA RQB+#ICD    SCHED-WITH-WAIT.
* 
      LDA APNAM     MOVE "APLDR" NAME 
      LDB PNAMA 
      JSB .MVW
      DEF D3
      NOP 
* 
      LDA FNAM      MOVE THE FILE NAME
      LDB NAMA
      JSB .MVW
      DEF D3
      NOP 
* 
      LDA CRN,I 
      STA RQB+#PMS+6
* 
      LDA FNOD,I
      STA RQB+#PMS+7
* 
      CLA           (IN CASE ISECU MISSING) 
      LDB ISECU,I   SET ISECU OR 0
      STB RQB+#PMS+5  INTO REQST BUFR.
* 
* FORMAT 1ST APLDR SCHED PARAM
* 
      LDB PNUM,I    SET FUNCTION CODE TO 1 IF BOTH
      CLE,SZB,RSS     PNUM & PSIZE ARE MISSING OR 0,
      LDB PSIZE,I       ELSE 2. INCLUDE REMOTE BIT &
      LDA REM1              SET INTO REQST BUFR.
      SZB 
      CCE,INA 
      STA RQB+#PMS
* 
* FORMAT 2ND APLDR SCHED PARAM
* 
      CLA,SEZ,RSS   WERE PNUM & PSIZE MISSING?
      JMP SETP2     YES, SET SCHED PARAM TO ZERO
      LDA PSIZE,I   NO, SET PNUM INTO BITS 0-5, 
      ALF,ALF         PSIZE INTO BITS 10-14.
      ALS,ALS 
      IOR PNUM,I
SETP2 STA RQB+#PMS+1
* 
      JSB #MAST     CALL MSTER TO SEND REQ
      DEF *+7 
      DEF CNWD
      DEF C.FN1     LENGTH OF RQBUF 
      DEF *         DUMMY DATA BUFR ADR 
      DEF D0        NO DATA ASSOCIATED WITH REQST 
      DEF D0          OR REPLY. 
      DEF C.FN1     MAX REQST-REPLY LENGTH
      JMP LNERR     LINE ERROR
      SPC 2 
      LDA RQB+#RPM  GET APLDR ERROR CODE
      STA FERCD,I   PASS IT TO USER 
      STA RQB+#EC2  SET UP ERROR
      LDA ASDS        FOR A 
      STA RQB+#EC1      POSSIBLE
      LDA RQB+#DST        DSERR 
      STA RQB+#ENO          CALL
      LDA FERMG     SEE IF WE MOVE OPTIONAL NAME
      SZA,RSS 
      JMP EXIT      NO
      LDA ERRA
      LDB FERMG     PASS THE ERROR MESSAGE BACK TO THE USER 
      JSB .MVW
      DEF D3
      NOP 
      JMP EXIT      RETURN
      SPC 3 
LNERR DST ERMS      SAVE ERROR MESSAGE FROM A & B REG.
      CPA ASDS      IS IT A "DSXX"ERROR ? 
      JMP DSER      YES 
      JSB CLR       NO, SYSTEM ERROR. CLEAR PARAM AREA
      LDB MSER        FOR NEXT TIME & ABORT USER. 
      LDA ERADD     GET MESSAGE @ AND ERROR @ 
      JSB #TILT     WE DO NOT RETURN FROM THIS JSB
* 
*     WE WILL DECODE THE XX PART OF THE ERROR MESSAGE 
*     AND MAP IT AS A NEGATIVE ERROR CODE FOR THE USER
*     & PASS THE ASCII ERROR MESSAGE TO USER IF WANTED. 
* 
DSER  LDA ERMS+1    GET THE XX PART 
      AND B17       GET VALUE OF THE LS DIGIT 
      STA LCHAR     SAVE
      LDA ERMS+1    GET VALUE AGAIN 
      ALF,ALF       SWAP CHARACTERS 
      AND B17       GET UPPER CHARACTER'S VALUE 
      MPY D10       WEIGHT IT 
      ADA LCHAR     WE NOW HAVE THE ERROR # 
      CMA,INA       MAKE IT <0
      ADA DM50      MAP IT
      STA FERCD,I   PASS IT TO THE USER 
* 
      LDA FERMG     IF THE USER WANTS IT WE WILL PASS HIM 
      SZA,RSS         THE ERROR MESSAGE 
      JMP EXIT      HE DOES NOT WANT IT, RETURN 
      DLD ERMS      GET THE MESSAGE 
      DST FERMG,I   PASS IT 
      ISZ FERMG 
      ISZ FERMG     STEP TO LAST WORD 
      LDA BLNK      GET AN ASCII DOUBLE BLANK 
      STA FERMG,I   PASS IT 
* 
EXIT  JSB CLR       CLEAR PARAM AREA FOR NEXT TIME
      JMP FLOAD,I   RETURN TO USER
CLR   NOP           SUBR TO CLEAR PARAM AREA
      LDA DM9       CLEAR THE PARAMETER 
      STA CNTR        AREA BEFORE RETURNING.
      CLA 
      LDB PRMSA 
CLR1  STA B,I 
      INB 
      ISZ CNTR
      JMP CLR1
      JMP CLR,I     RETURN
      SPC 3 
D9    DEC 9 
D10   DEC 10
C.FN1 ABS #FNO+1
D0    DEC 0 
D3    DEC 3 
DM9   DEC -9
DM50  DEC -50 
B17   OCT 17
REM1  OCT 100001    REMOTE BIT / FUNC = 1 
LCHAR NOP 
MSER  DEF ERMS
ERMS  BSS 2 
PNAMA DEF RQB+#PGN
NAMA  DEF RQB+#PMS+2
ERRA  DEF RQB+#RPM+1
APNAM DEF *+1 
      ASC 3,APLDR 
BLNK  ASC 1,
ASDS  ASC 1,DS
ERADD NOP 
CNWD  OCT 140000    D65MS CONWD (NO ABORT, LONG TIMEOUT)
CNTR  EQU ERMS      USE AS COUNTER BEFORE EXIT
      END 
                                                                                            