ASMB,R,Q,C
*     NAME:   XQPRG 
*     SOURCE: 92070-18162 
*     RELOC:  92070-1X162 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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.        * 
*  **************************************************************** 
* 
* 
      NAM XQPRG,7  92070-1X162  REV.1941  790807  
      ENT XQPRG 
      EXT EXEC,.ENTR,OPEN,IDRPL,CLOSE 
      EXT RMPAR 
* 
*     CALLING SEQUENCE: 
*       CALL XQPRG(DCB,CODE,NAME,FIVE,STRNG,LNG,PRTN,ERR,SEC,CR)
* 
*     WHERE:
*       DCB   = 144 WORD BUFFER FOR USE BY XQPRG
*       CODE  = 9, 10, 23, 24, OR 28, SIMILAR TO EXEC REQUEST CODE
*       NAME  = 5-CHAR PROGRAM NAME OR 6-CHAR FILE NAME 
*       FIVE  = 5 WORD BUFFER TO PASS TO SCHEDULED PROGRAM
*       STRNG = STRING TO PASS TO SCHEDULED PROGRAM 
*       LNG   = LENGTH OF STRING (+WORDS OR -CHARS) 
*       PRTN  = 5 WORD BUFFER PASSED BACK FROM SCHEDULED PROGRAM
*       ERR   = ERROR CODE
*       SEC   = FILE SECURITY CODE
*       CR    = FILE CARTRIDGE REFERENCE
* 
* 
*     ERRORS: 
*       IERR =0     SUCCESS 
*            =1     DUPLICATE PROGRAM 
*                   (PRTN=23) 
*            =2     NO ID SEGMENTS AVAILABLE
*                   (PRTN=14) 
*            =3     PROGRAM NOT FOUND 
*                   (PRTN=-6 OR -32)  
*            =4     FILE OPEN ERROR (OTHER THAN NOT FOUND)
*                   (PRTN= FMP ERROR NUMBER)
*            =5     FILE CLOSE ERROR
*                   (PRTN= FMP ERROR NUMBER)
*            =6     RP ERROR OTHER THAN 'DUPLICATE PROGRAM' 
*                   OR 'NO ID SEGMENTS AVAILABLE':
*                     PRTN=19  --  PROGRAM NOT SET UP FOR CURRENT SYSTEM
*                     PRTN=39  --  PROGRAM TOO LARGE FOR PARTITION
*                     PRTN=40  --  ATTEMPT TO OVERLAY REAL-TIME PROGRAM 
*            =7     PROGRAM BUSY
*            =8     PROGRAM WAS SCHEDULED, BUT THEN ABORTED 
*                   (PRTN=100000B)
*            =9     NOT ENOUGH SYSTEM MEMORY EVER TO PASS STRING
*                   (PRTN='10' (ASCII)=30460B)    (OR SCHEDULING ERROR
*                   OTHER THAN 'SC05'  --  LAST 2 CHARS IN PRTN)
*            =10    BAD 'CODE' PARAMETER  (SHOULD BE 9,10,23,24, OR 28) 
* 
A     EQU 0 
B     EQU 1 
* 
* 
DCB   NOP 
CODE  NOP 
NAME  NOP 
P1    NOP 
STRNG NOP 
LNG   NOP 
RTN   NOP 
ERR   NOP 
SEC   NOP 
CR    NOP 
* 
XQPRG NOP 
      JSB .ENTR     PASS PARAMETER ADDRESSES
      DEF DCB   
      LDA CODE,I
      RAL,CLE,ERA   IGNORE NO-ABORT BIT 
      CPA =D9 
      JMP CODOK     SCHEDULE WITH WAIT
      CPA =D10
      JMP CODOK     SCHEDULE WITHOUT WAIT 
      CPA =D23
      JMP CODOK     QUEUE SCHEDULE WITH WAIT
      CPA =D24
      JMP CODOK     QUEUE SCHEDULE WITHOUT WAIT 
      CPA =D28
      JMP CODOK     REAL-TIME PROGRAM LOAD
* 
      LDB =D10
      JMP EROUT     ILLEGAL CODE
* 
* 
CODOK IOR =B100000  ADD 'NO-ABORT' BIT TO REQUEST 
      STA CODE
* 
      LDA P1    
      INA 
      STA P2
      INA 
      STA P3
      INA 
      STA P4
      INA 
      STA P5
* 
TRY   JSB EXEC      TRY TO SCHEDULE THE PROGRAM 
      DEF RTN1
      DEF CODE      EXEC CODE, NO ABORT 
      DEF NAME,I    PROGRAM NAME
      DEF P1,I    
P2    NOP 
P3    NOP 
P4    NOP 
P5    NOP 
      DEF STRNG,I 
      DEF LNG,I 
RTN1  JMP FAIL      SCHEDULE REQUEST FAILED 
      STA RTN,I 
* 
      CLB 
      LDA CODE
      CPA =B100034  EXEC 28, NO ABORT 
      JMP EROUT 
* 
      LDB =D7 
      LDA RTN,I 
      SZA 
      JMP EROUT     PROGRAM BUSY
* 
      JSB RMPAR     GET RETURNED PARAMETERS 
      DEF *+2 
      DEF RTN,I 
      CLB 
      LDA RTN,I 
      CPA =B100000
      LDB =D8       PROGRAM WAS ABORTED 
EROUT STB ERR,I     SAVE ERROR CODE 
      STB A 
      JMP XQPRG,I 
* 
* 
* 
* 
FAIL  CPB =A05
      JMP OPEN6     NO ID SEGMENT 
      STB RTN,I 
      LDB =D9       
      JMP EROUT     NOT ENOUGH SYSTEM MEMORY FOR STRING 
* 
OPEN6 JSB OPEN      OPEN THE TYPE 6 FILE
      DEF RTN2
      DEF DCB,I 
      DEF RTN,I     ERROR CODE
      DEF NAME,I    FILE NAME 
      DEF D1        NON-EXCLUSIVE OPEN
      DEF SEC,I 
      DEF CR,I
RTN2  LDB =D3 
      CPA =D-6
      JMP EROUT     FILE NOT FOUND
      CPA =D-32 
      JMP EROUT     CARTRIDGE NOT FOUND 
      INB 
      SSA 
      JMP EROUT     OPEN FAILED 
* 
      CLA 
      LDB CODE
      CPB =B100034  EXEC 28, NO ABORT 
      CLA,INA 
      STA TEMP  
      JSB IDRPL     'RP' THE PROGRAM
      DEF RTN3
      DEF DCB,I 
      DEF RPERR     ERROR CODE
      DEF NAME,I    PROGRAM NAME
      DEF TEMP      TEMPORARY / PERMANENT  FLAG 
RTN3  JSB CLOSE     CLOSE THE FILE
      DEF *+3 
      DEF DCB,I 
      DEF RTN,I 
      LDB =D5 
      SSA 
      JMP EROUT     CLOSE ERROR 
* 
      LDA RPERR     CHECK FOR IDRPL ERROR 
      STA RTN,I 
      LDB =D2 
      CPA =D14
      JMP EROUT     NO ID AVAILABLE 
      CLB,INB 
      CPA =D23
      JMP EROUT     DUPLICATE PROGRAM 
      LDB =D6 
      SZA 
      JMP EROUT     FILE NOT SET UP FOR CURRENT SYSTEM
      JMP TRY       SUCCESSFUL 'RP', TRY AGAIN
* 
* 
* 
* 
D1    DEC 1 
TEMP  NOP 
RPERR NOP 
      END 
                                                                                                