ASMB,Q,C,N
      HED <#PKUP> PICK UP SCHEDULE PARAMS * (C) HEWLETT-PACKARD CO. 
      IFN          *****
      NAM #PKUP,7 91750-1X023 REV.2013 790516 ALL EXCEPT RTE-M
      XIF          *****
      IFZ          *****
      NAM #PKUP,7 91750-1X024 REV.2013 790516 RTE-M 
      XIF          *****
      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 THE HEWLETT-PACKARD COMPANY.   *
******************************************************************
      SPC 2 
      UNL           NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING 
*  NAME: #PKUP
*SOURCE: 91750-18023
* RELOC: 91750-1X023
*  PGMR: DMT
      LST 
**************************   #PKUP   *************************
*                                                            *
* SOURCE: 91750-18023                                        *
*                                                            *
* BINARY: 91750-1X023 (N-OPTION FOR NON-RTE-M NODES)         *
*                     (Z-OPTION FOR RTE-M NODES)             *
*                                                            *
* PROGRAMMER: DAVE TRIBBY                                    *
*                                                            *
* FEBRUARY 13, 1979                                          *
*                                                            *
**************************************************************
      SPC 1 
* 
*  SUBROUTINE TO RETRIEVE UP TO 5 SCHEDULING PARAMETERS.
* 
*   CALLING SEQUENCE:  JSB #PKUP
*                      DEF *+4
*                      DEF MASK     NUMBER & TYPE OF PARAMETERS 
*                      DEF ARRAY    RETURNED INFORMATION ARRAY
*                      DEF DEFLU    INTERACTIVE LU NO. FOR USER 
* 
* NOTE: B-REGISTER MUST NOT BE MODIFIED BEFORE CALLING #PKUP
*       BECAUSE IT PICKS UP THE SCHEDULING PARAMETER FROM RTE.
* 
* MASK HAS THE FOLLOWING FORMAT:
*   BITS 8-10 (LEFT BYTE): NUMBER OF PARAMETERS TO RETRIEVE 
*   BIT 0: 1 IF 1ST PARAMETER IS TO BE RETURNED IN NAMR FORMAT (10 WORDS) 
*          0 IF 1ST PARAMETER IS TO BE RETURNED IN A SINGLE WORD
*   BITS 1-4: SAME INFORMATION FOR PARAMETERS 2-5 
* EXAMPLE: 5 PARAMETERS, FIRST IS NAMR, REST ARE SINGLE WORDS:
*        MASK  BYT 5,1
* 
* DEFAULT LU IS THE FIRST PARAMETER, IF INTERACTIVE, ELSE LOGLU VALUE.
* 
      SPC 1 
      EXT IFTTY,.ENTR,.MVW,RMPAR
      UNL 
      IFN          *****
      LST 
      EXT NAMR,LOGLU,EXEC 
      UNL 
      XIF          *****
      LST 
      ENT #PKUP 
* 
A     EQU 0         A-REGISTER
B     EQU 1         B-REGISTER
      SUP 
      SPC 5 
#PKUP NOP           ENTRY POINT.
      STB SAVEB     SAVE B-REGISTER.
      CLA           CLEAR PARAMETER ADDRESSES.
      STA MASK
      STA ARRAY 
      STA DEFLU 
      LDA #PKUP     SET UP FOR
      STA RETRN      .ENTR CALL.
      JMP RETRN+1 
      SPC 1 
MASK  NOP           PARAMETERS. 
ARRAY NOP 
DEFLU NOP 
RETRN NOP 
      JSB .ENTR 
      DEF MASK
* 
      LDA ARRAY     IF SECOND PARAM WAS 
      SZA,RSS        NOT SPECIFIED, 
      JMP RETRN,I     RETURN. 
* 
      LDA MASK,I    GET MASK WORD.
      STA LMASK     SAVE LOCALLY. 
      ALF,ALF 
      AND B7
      CMA,INA 
      STA PCNT      SAVE NEG # PARAMS.
      SZA,RSS       IF ZERO,
      JMP ALDON       RETURN. 
* 
      LDB SAVEB     RESTORE B-REGISTER. 
      JSB RMPAR     PICK UP 
      DEF *+2        SCHEDULING PARAMS. 
@RPRM DEF RPRM
      LDA RPRM
      SZA,RSS       IF FIRST PARAM IS 0,
      JMP SETLU      SET TO LOGLU.
      STA LDFLU     STORE DEFAULT LU. 
      AND HB377     IF LEFT BYTE IS NOT 
      SZA            ZERO, MUST BE ALPHABETIC.
      JMP SETLU 
      JSB IFTTY     IF NON-INTERACTIVE
      DEF *+2        LU NUMBER, 
      DEF LDFLU        USE LOGLU. 
      SSA 
      JMP GTSTR 
*  FIRST PARAMETER IS NON-INTERACTIVE. SET DEFAULT LU VIA LOGLU.
SETLU EQU * 
      UNL 
      IFN          *****
      LST 
      JSB LOGLU     PICK UP LOG LU. 
      DEF *+2 
      DEF #PKUP 
      UNL 
      XIF          *****
      LST 
      UNL 
      IFZ          *****
      LST 
      CLA,INA       USE 1 FOR LOGLU.
      UNL 
      XIF          *****
      LST 
      STA LDFLU     STORE AS DEFAULT. 
* 
GTSTR EQU * 
      UNL 
      IFN          *****
      LST 
      JSB EXEC      PICK
      DEF *+5        UP 
      DEF D14         COMMAND 
      DEF D1           STRING.
      DEF STRNG 
      DEF DN80
      STB STRLN     SAVE LENGTH.
* 
      SZB           IF NO STRING WAS PASSED,
      JMP STPNT 
      UNL 
      XIF           ***** 
      LST 
      LDA @RPRM      SET UP POINTER 
      STA PNTR1       TO RMPAR PARAMS.
      UNL 
      IFN           ***** 
      LST 
      JMP GTPR1      GO TO RMPAR PARAM LOOP.
* 
STPNT CLA,INA       POINT TO
      STA PNTR       FIRST COLUMN.
* 
      JSB PNAMR     SKIP OVER 
      JSB PNAMR      "RU,<PROGRAM>,"
* 
      JSB PNAMR     PARSE PARAMETER.
      CPA "NO"      IF "NO", SKIP OVER IT.
      SPC 2 
*  LOOP TO PICK UP SPECIFIED NUMBER OF PARAMETERS.
GTPRM JSB PNAMR 
      LST 
      LDB LMASK     POSITION PARAMETER MASK 
      ERB            BIT INTO E-REG AND SAVE
      STB LMASK       SHIFTED MASK. 
      SEZ           IF NAMR FORMAT IS DESIRED,
      JMP MVNAM       GO MOVE IT. 
* 
      STA ARRAY,I   STORE SINGLE WORD.
      ISZ ARRAY     BUMP POINTER. 
      JMP LPEND     GO TO END OF LOOP.
* 
*  MOVE 10-WORD NAMR ARRAY. 
MVNAM LDA @NAMR     SOURCE ADDR.
      LDB ARRAY     DESTINATION.
      JSB .MVW
      DEF D10       MOVE 10 WORDS.
      NOP 
      STB ARRAY     UPDATE DEST. POINTER. 
* 
LPEND ISZ PCNT      BUMP PARAM. COUNTER.
      JMP GTPRM     IF MORE, GET NEXT PARAMETER.
      JMP ALDON     OTHERWISE, ALL DONE.
      SPC 2 
* 
*  THIS SECTION MOVES RMPAR PARAMS WHEN NO STRING WAS SENT. 
* 
      UNL 
      XIF           ***** 
      LST 
GTPR1 LDA PNTR1,I 
      ISZ PNTR1     BUMP POINTER. 
      JSB STRWD     STORE VALUE.
      LDB LMASK     POSITION PARAMETER MASK 
      ERB            BIT INTO E-REG AND SAVE
      STB LMASK       SHIFTED MASK. 
      SEZ,RSS       IF NOT NAMR FORMAT, 
      JMP LPEN2      GO TO END OF LOOP. 
* 
      UNL 
      IFZ           ***** 
      LST 
      LDB PNTR1     IF THIS ISN'T 
      CPB @RPM1      THE 1ST PARAM, 
      SSA             OR IF NEGATIVE, 
      JMP NUMER        FORCE TO NUMERIC.
      AND HB377     CHECK FOR 
      SZA            ASCII. 
      JMP ASCII 
* 
      UNL 
      XIF           ***** 
      LST 
NUMER LDA DN2       CLEAR 
      STA COUNT      TWO
      JSB CLR         WORDS.
      CLA,INA       STORE 'NAMR'
      JSB STRWD      STATUS WORD. 
      LDA DN6       CLEAR 
      STA COUNT      LAST 6 
      JSB CLR         WORDS.
* 
LPEN2 ISZ PCNT      BUMP PARAM. COUNTER.
      JMP GTPR1     IF MORE, GET NEXT PARAMETER.
      SPC 2 
*  ALL DONE SETTING UP ARRAY. 
ALDON LDA LDFLU     STORE 
      STA DEFLU,I    DEFAULT LU.
      JMP RETRN,I   RETURN TO CALLER. 
      SKP 
      UNL 
      IFN          *****
      LST 
*  SUBROUTINE TO CALL NAMR PARSE ROUTINE
*   CALLING SEQUENCE: <SET PNTR TO PROPER COLUMN OF STRNG>
*                      JSB PNAMR
*                     <A-REG CONTAINS PARAMETER>
* 
PNAMR NOP           ENTRY POINT 
      JSB NAMR      CALL
      DEF *+5        NAMR 
@NAMR DEF NAME        ROUTINE.
      DEF STRNG 
      DEF STRLN 
      DEF PNTR
      LDA NAME      LOAD PARAM. 
      JMP PNAMR,I   RETURN. 
      SPC 2 
NAME  BSS 10        NAMR PARAMETERS.
PNTR  NOP           COLUMN POINTER. 
STRNG BSS 40        SCHEDULING STRING.
STRLN NOP           STRING LENGTH (BYTES).
      UNL 
      XIF          *****
      LST 
      UNL 
      IFZ          *****
      LST 
*  FIRST PARAMETER IS ASCII. SET UP 'NAMR' FORMAT.
* 
ASCII LDA RPRM+1    GET SECOND PARAM. 
      SZA,RSS       IF ZERO,
      LDA BLANK      USE BLANK. 
      JSB STRWD     STORE.
      LDA RPRM+2    GET THIRD PARAM.
      SZA,RSS       IF ZERO,
      LDA BLANK      USE BLANK. 
      JSB STRWD     STORE.
      LDA B27       STORE 'NAMR'
      JSB STRWD      STATUS WORD
      LDA RPRM+3      AND LAST
      JSB STRWD        TWO PARAMS.
      LDA RPRM+4
      JSB STRWD 
      LDA DN4       CLEAR LAST
      STA COUNT      4 NAMR WORDS.
      JSB CLR 
*  CLEAR REST OF REQUESTED PARAMETERS.
      ISZ PCNT      IF NONE,
      RSS 
      JMP ALDON       ALL DONE. 
* 
      CLA           A-REG COUNTS # OF WORDS.
      LDB LMASK     GET BIT MASK. 
NXTBT ERB           SHIFT BIT INTO E-REG. 
      SEZ           IF 'NAMR' FORMAT
      ADA DN9        ADD 9 TO COUNT.
      ADA DN1         (OTHERWISE, JUST 1.)
      ISZ PCNT      DONE? 
      JMP NXTBT      NO--STAY IN LOOP.
      STA COUNT      YES--STORE WORD COUNT. 
      JSB CLR       CLEAR THOSE WORDS.
      JMP ALDON     RETURN TO CALLER. 
      UNL 
      XIF           ***** 
      LST 
      SPC 2 
*  SUBROUTINE TO CLEAR "COUNT" WORDS IN "ARRAY" 
* 
CLR   NOP           ENTRY.
      CLA           CLEAR.
CLOOP JSB STRWD     STORE.
      ISZ COUNT     DONE? 
      JMP CLOOP      NO!
      JMP CLR,I     RETURN. 
      SPC 2 
*  SUBROUTINE TO STORE A-REG IN ARRAY 
STRWD NOP           ENTRY 
      STA ARRAY,I   STORE.
      ISZ ARRAY     BUMP POINTER. 
      JMP STRWD,I   RETURN. 
      SPC 2 
COUNT NOP           NUMBER OF WORDS TO CLEAR. 
BLANK ASC 1,
      SPC 5 
*** CONSTANTS *** 
* 
DN2   DEC -2
DN6   DEC -6
D10   DEC 10
HB377 BYT 377,0 
B7    OCT 7 
      UNL 
      IFZ          *****
      LST 
DN1   DEC -1
DN4   DEC -4
DN9   DEC -9
B27   OCT 27
@RPM1 DEF RPRM+1
      UNL 
      XIF          *****
      LST 
      UNL 
      IFN          *****
      LST 
D1    DEC 1 
D14   DEC 14
DN80  DEC -80 
"NO"  ASC 1,NO
      UNL 
      XIF          *****
      LST 
      SPC 1 
*** MISCL. STORAGE ***
* 
LMASK NOP           LOCAL PARAM. MASK.
LDFLU NOP           LOCAL DEFAULT LU. 
PCNT  NOP           PARAMETER COUNT.
PNTR1 NOP           POINTER TO PARAMETER. 
SAVEB NOP           B-REG HOLDER. 
RPRM  BSS 5         'RMPAR' PARAMETERS. 
      SPC 1 
      BSS 0         *** SIZE OF SUBROUTINE ***
      SPC 1 
      END 
                                                                                                                              