ASMB,R,L,C      ** INPRS ** 
      HED INPRS - PREAMBLE
*     NAME:   INPRS 
*     SOURCE: 92067-18286 
*     RELOC:  PART OF 92067-16268 AND 92067-16035 
*     PGMR:   G.A.A.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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 INPRS,6 92067-1X286 REV.2013 770621 
      SUP PRESS EXTRANEOUS LISTING
      ENT INPRS 
      EXT .ENTP,$CVT3,.ZPRV 
      SPC 1 
A     EQU 0 
B     EQU 1 
      HED INPRS : DESCRIPTION 
* CALLING EXAMPLE : 
* FTN,L 
*       PROGRAM R$PN$(2,10) 
*       INTEGER BUFFER(22),PARBUF(33),PRAM(5),IREG(2),P1,P2,CLASS 
*       EQUIVALENCE (PRAM(1),CLASS),
*      &            (PRAM(2),IREG,REG,IA),
*      &            (PRAM(3),IB), 
*      &            (PRAM(4),IC), 
*      &            (PRAM(5),ID)
*       CALL RMPAR(PRAM)
*     1 REG = EXEC(21,BUFFER,22,IC,ID,CLASS)
*       CALL PARSE(BUFFER,IB,PARBUF)
*       <"ON" REQUEST - PARBUF(2)="ON" ?> 
*         <YES,3RD PRAM=0 - PARBUF(10)=0 ?> 
*           <YES,SUPPLY DEFAULT - PARBUF(10)=IC>
*           CALL INPRS(PARBUF,PARBUF(33)) 
*       IC = MESSS(BUFFER,IB) 
*       <ANY RETURN MESSAGES -IC=0 ?> 
*         <YES,DISPLAY> 
*       GO TO 1 
*       END 
      SPC 2 
* THE BUFFER 'PARBUF' LOOKS LIKE :
      SPC 2 
* PARBUF(1) * PRAM(1) TYPE
*       (2) *         VALUE(1)
*       (3) *              (2)
*       (4) *              (3)
*       (5) * PRAM(2) TYPE
*       (6) *         VALUE(1)
*       (7) *              (2)
*       (8) *              (3)
      SPC 1 
*    ET CETERA
      SPC 1 
* PARBUF(33)* NUMBER OF PARAMETERS PARSED 
      SPC 2 
* WHERE : TYPE = 0 => NULL PARAMETER
*                1 => NUMERIC PARAMETER IN VALUE(1) 
*                2 OR 3 => ASCII PARAMETERS IN VALUE(1) TO VALUE(3) 
      HED INPRS : MAIN
BUF   NOP 
#P    NOP 
INPRS NOP 
      JSB .ZPRV 
      DEF LIBX
      JSB .ENTP 
      DEF BUF 
      SPC 2 
      LDA #P,I      SET PRAM
      CMA,INA,SZA,RSS  COUNTER
      JMP EXIT      NO PRAMS EXIT 
      STA #P        INIT COUNTER
      LDB BLANK     USE LEADING BLANK 
      SPC 2 
LOOP  EQU * 
      LDA BUF       GET VALUE FOR 
      INA           THIS ENTRY
      LDA A,I       AND IF
      SSA           NEGATIVE
      ADB B21       CONVERT BLANK TO 1. 
      LDA BUF,I     GET PRAM SPEC 
      STB BUF,I     STORE ", " OR "  " BACK 
      ISZ BUF       STEP TO VALUE 
      CMA,INA,SZA,RSS IF ZERO 
      JMP NULL       THEN NULL PRAM 
      SPC 2 
      INA,SZA,RSS   IF ONE
      JMP NUMBR      THEN NUMERIC 
      SPC 2 
      ISZ BUF       MUST BE ASCII,SO
LOOP2 EQU *          IT'S OK
      ISZ BUF         AS
      ISZ BUF          IS.
      LDB COMMA     GET ", "
      ISZ #P        DONE ?
      JMP LOOP      NO-GET NEXT PRAM. 
      SPC 2 
EXIT  EQU * 
LIBX  JMP INPRS,I   YES-EXIT TO CALLER
      DEF INPRS 
      SPC 2 
NULL  EQU * 
      LDB BLANK     FOR NULL
      STB BUF,I      PRAM , REPLACE 
      LDA B           WITH
STO   EQU * 
      ISZ BUF           SIX 
      DST BUF,I          BLANKS 
      JMP LOOP2           & GET NEXT PRAM.
      SPC 2 
NUMBR EQU *         NUMERIC PRAM PROC.
      LDA BUF,I     GET NUMBER
      CCE,SSA       VALUE IF
      CLE            NEG,SET FOR OCTAL CONVERSION 
      JSB $CVT3     CONVERT TO ASCII
      ERB           SET E IF NEG. 
      LDB A,I       GET HIGH DIGIT
      SEZ,INA       STEP & IF OCTAL 
      ADB B104C      CONVERT '1' TO 'B' 
      STA T         SAVE ADDRESS
      LDA A,I       GET NEXT DIGIT
      RRL 8         ROTATE 1ST 2 DIGITS TO 'B'REG 
      STB BUF,I     STORE 1ST 2 DIGITS
      ISZ T         STEP TO LAST 2 DIGITS 
      ALF,ALF 
      LDB T,I       GET LAST 2 DIGITS 
      RRL 8         ROTATE TO RIGHT ORDER 
      JMP STO       GO STORE IT 
      HED INPRS : CONSTANTS 
B21   OCT 21
B104C OCT 10400 
COMMA ASC 1,, 
BLANK ASC 1,
T     NOP 
      HED INPRS - END 
      END 
                                                  