ASMB,L,R,C
      HED FLOAD 91740-16135 REV 1740 * (C) HEWLETT-PACKARD CO. 1977 
      NAM FLOAD,7 91740-16035 REV 1740 770602 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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 SYSTEM. 
* 
*SOURCE PART #:     91740-18035 REV 1740
* 
*REL PART #         91740-16035 REV 1740
* 
*WRITTEN BY:        LARRY POMATTO 
* 
*DATE WRITTEN:      8-23-74 
* 
*MODIFIED BY:       JEAN-PIERRE D. BAUDOUIN 
*                   DAN GIBBONS 
* 
*DATE MODIFIED:     JULY 1976 
*                   FEBRUARY 1977 
* 
*********************************************** 
      SPC 1 
      SUP 
* 
      EXT D65MS,.ENTR,D65AB 
      SPC 1 
      ENT FLOAD 
      SPC 1 
A     EQU 0 
B     EQU 1 
      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 
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 RQBUF+3 
* 
* 
      LDA D3        SET STREAM TYPE 
      STA RQBUF 
      LDA D9        SET ICODE FOR 
      STA RQBUF+4     SCHED-WITH-WAIT.
* 
      LDA APNAM     MOVE "APLDR" NAME 
      LDB PNAMA 
      MVW D3
* 
      LDA FNAM      MOVE THE FILE NAME
      LDB NAMA
      MVW D3
* 
      LDA CRN,I 
      STA RQBUF+14
* 
      LDA FNOD,I
      STA RQBUF+15
* 
      CLA           (IN CASE ISECU MISSING) 
      LDB ISECU,I   SET ISECU OR 0
      STB RQBUF+13    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 RQBUF+8 
* 
* 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 RQBUF+9 
* 
      JSB D65MS     CALL MSTER TO SEND REQ
      DEF *+8 
      DEF CNWD
      DEF RQBUF 
      DEF D16       LENGTH OF RQBUF 
      DEF *         DUMMY DATA BUFR ADR 
      DEF D0        NO DATA ASSOCIATED WITH REQST 
      DEF D0          OR REPLY. 
      DEF D16       MAX REQST-REPLY LENGTH
      JMP LNERR     LINE ERROR
      SPC 2 
      LDA RQBUF+7   GET APLDR ERROR CODE
      STA FERCD,I   PASS IT TO USER 
      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 
      MVW D3
      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 D65AB     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 
D11   DEC 11
D10   DEC 10
D16   DEC 16
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 RQBUF+5 
NAMA  DEF RQBUF+10
ERRA  DEF RQBUF+8 
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
      SPC 1 
RQBUF BSS 16        REQUEST-REPLY BUFR
      END 
                                                                                                                                                                                                                              