ASMB,L,R,C
      HED FLOAD 91700-16131 REV A * (C) HEWLETT-PACKARD CO. 1976
      NAM FLOAD,7 91700-16131 REV A 751219
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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 LOADS
* 
*SOURCE PART #:     91700-18131 REV A 
* 
*REL PART #         91700-16131 REV A 
* 
*WRITTEN BY:        LARRY POMATTO 
* 
*DATE WRITTEN:      8-23-74 
* 
*MODIFIED BY:       JEAN-PIERRE D. BAUDOUIN 
* 
*DATE MODIFIED:     DEC 1975
* 
*********************************************** 
      SPC 1 
      SUP 
* 
      EXT D65MS,.ENTR,.DFER,D65AB 
      SPC 1 
      ENT FLOAD 
      SPC 1 
A     EQU 0 
B     EQU 1 
      SPC 1 
* 
*     CALLING SEQUENCE
*     JSB FLOAD 
*     DEF *+4 OR *+5
*     DEF PROGRAM FILE NAME 
*     DEF DESTINATION LOGICAL UNIT
*     DEF ERROR CODE
*     DEF OPTIONAL 3 WORD MESSAGE BUFFER
      SPC 2 
FNAM  NOP 
FLU   NOP 
FERCD NOP 
FERMG NOP 
FLOAD NOP 
      JSB .ENTR 
      DEF FNAM
* 
      LDA FLU,I     GET THE COMM. LU
      AND B77       SET FOR REQ ONLY
      STA FLU 
* 
      LDA FERMG 
      STA ERMOV     SAVE FOR LATTER MOVE
      LDB FLOAD     GET CALLING ADDRESS 
      ADB M5        GET BACK TO ADD WHO CALLED
      SZA           OPTIONAL PRAM SUPPLIED? 
      ADB M1        YES...TAKE IT INTO ACCOUNT
      STB ERADD     SAVE FOR MSTR CALL
      LDA D8        GET STREAM TYPE 
      STA STRM      SAVE STREAM TYPE
      LDA BT150     SET BITS 0 AND 15 (FOR LO COMMAND)
      CLB 
      DST FLGWD     SET FLAG WORDS
      JSB .DFER     MOVE NAME INTO PARMB
      DEF FNAME 
      DEF FNAM,I
* 
      JSB D65MS     CALL MSTER TO SEND REQ
      DEF *+7 
      DEF B2        WRITE 
      DEF FLU       CONTROL FOR REQ ONLY
      DEF STRM      PARMB 
      DEF D35       LENGTH OF PARMB 
      DEF DUMMY 
      DEF DUMMY 
      JMP LNERR     LINE ERROR
      LDA FNAME     GET ERROR RETURN
      STA FERCD,I   AND SAVE FOR USER 
      LDA FERMG     SEE IF WE MOVE OPTIONAL NAME
      SZA,RSS 
      JMP FLOAD,I   NO
      JSB .DFER     MOVE NAME 
ERMOV NOP 
      DEF ERNM
      JMP FLOAD,I   RETURN
      SPC 3 
LNERR DST ERMS      SAVE ERROR MESSAGE FROM A & B REG.
      CPA ASDS      IS IT A "DSXX"ERROR ? 
      JMP DSER      YES 
      LDB MSER      NO, SYSTEM ERROR, ABORT THE 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
* 
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 CHARATERS VALUE 
      MPY D10       WEIGHT IT 
      ADA LCHAR     WE NOW HAVE THE ERROR # 
      CMA,INA       MAKE IT <0
      ADA DM46      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 FLOAD,I   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 
      JMP FLOAD,I   RETURN
      SPC 3 
D8    DEC 8 
D10   DEC 10
BT150 OCT 100001
B2    DEC 2 
D35   DEC 35
M5    DEC 5 
M1    DEC -1
DM46  DEC -46 
B77   OCT 77
B17   OCT 17
DUMMY NOP 
LCHAR NOP 
MSER  DEF ERMS
ERMS  NOP 
BLNK  ASC 1,
ASDS  ASC 1,DS
ERADD NOP 
      SPC 1 
STRM  NOP 
      NOP           CLASS # HERE
      BSS 3 
FLGWD NOP 
      NOP 
FNAME BSS 1 
ERNM  BSS 2 
      ASC 1,
      BSS 24        MAKE THE PARMB 35 WORDS LONG
      END 
                                                                        