ASMB,R,L,C
      HED HPIBM, HP-IB RTE-L MESSAGE SUBROUTINE LIBRARY 
      NAM HPIBM,7  92070-16242  REV 2026  800417
* 
* 
      ENT TRIGR,CLEAR,RMOTE,GTL,LLO,LOCL
      ENT STATS,PPOLL,PSTAT,CNFG,ABRT 
      ENT CMDR,CMDW,SECR,SECRR,SECW,SECWR 
      ENT SRQ,SRQSN,PPSCH,PPSN,IOCNT,IBERR
* 
      EXT .ENTR,EXEC,IMESS,$LUTA,PNAME,.MBT,IPUT,SRQ.T
      EXT HPIBB,CNFUE,$LIBR,$LIBX 
* 
******************************************************************* 
*  * (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 HEWLETT-PACKARD COMPANY.        * 
******************************************************************* 
* 
*     NAME:   HPIBM 
*     RELOC:  92070-16242 
*     SOURCE: 92070-18242 
*     PGMR:   T.A.L.
* 
* 
**************************************************
*                                                *
*     HP-IB MESSAGE SUBROUTINES                  *
*                                                *
*     TRIGR,CLEAR,RMOTE,GTL,LLO,LOCL,STATS,      *
*     PPOLL,PSTAT,CNFG,ABRT,CMDR,CMDW,SECR,      *
*     SECRR,SECW,SECWR,SRQ,SRQSN,PPSCH,PPSN,     *
*     IOCNT,IBERR                                *
*                                                *
**************************************************
* 
A     EQU 0 
B     EQU 1 
* 
      SKP 
* 
******************************************************************
*                 *                                              *
*     TRIGGER     *     CALL TRIGR(LU)                           *
*                 *                                              *
*                 *     WHERE: LU=AUTO ADDRESSING OR DIRECT      *
*                 *               I/O LU IN RANGE OF 1-63        *
*                 *                                              *
******************************************************************
TRIGR NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
* TRIGR(DLU) - CALL EXEC(3,27DLU) 
* TRIGR(BLU) - CALL EXEC(3,27BLU) 
* 
      LDA CTL27         LOAD CONTROL REQUEST CODE 
CTL   IOR LU            MERGE LU
      STA CTLWD         SAVE CONTROL WORD 
* 
CTLRQ LDA .3            SET REQUEST CODE
      STA REQ 
* 
      JSB CTLW          ADJUST CONTROL WORD 
      JSB CTLC          MAKE TRIGR CONTROL REQUEST
      JMP XIT,I         EXIT
      SKP 
******************************************************************
*                 *                                              *
*     CLEAR       *     CALL CLEAR(LU,I)                         *
*                 *                                              *
*                 *     WHERE: LU=AUTO ADDRESSING OR DIRECT      *
*                 *               I/O LU IN RANGE 1-63           *
*                 *                                              *
*                 *             I=FUNCTION CODE                  *
*                 *             I=1 FOR SELECTED DEVICE CLEAR    *
*                 *             I=2 FOR UNIVERSAL DEVICE CLEAR   *
*                 *                 (DIRECT I/O ONLY)            *
*                 *                                              *
******************************************************************
CLEAR NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      LDB CPAR2,I        LOAD I PARAMETER 
      CPB .1             I=1? 
      JMP CLR1           YES, SELECTED DEVICE CLEAR 
      CPB .2             NO,I=2?
      JMP CLR2           YES, UNIVERSAL DEVICE CLEAR
      JMP LOSE           INVALID I PARAMETER,EXIT WITH ERROR
* 
* CLEAR(DLU,1) - CALL EXEC(3,DLU) 
* CLEAR(BLU,1) - CALL EXEC(3,BLU,0) 
* 
CLR1  CLA                ZERO CONTROL REQUEST CODE
      JMP CTL            SELECTED DEVICE CLEAR REQUEST
* 
* CLEAR(BLU,2) - CALL EXEC(2,CTLWD,0,0,CBUFR,-1)
* 
CLR2  SZA                I=2, BUS LU? 
      JMP LOSE           NO,INVALID LU,EXIT WITH ERROR
* 
      JSB CNTL           FORM DIRECT I/O CTL WORD 
* 
      LDA DCL               I=2,LOAD UNIV DEV CLEAR CMND
      STA CBUFR          SAVE IN DIRECT I/O CMND BUFR 
* 
      LDA M1             LOAD DIRECT I/O CMND BUFR LENGTH 
      STA CLGTH          AND SAVE 
* 
      JSB CTLW           ADJUST CONTROL WORD
      JSB OUTPT          GO OUTPUT DIRECT I/O CLEAR CMND
      JMP XIT,I          EXIT 
* 
* 
      SKP 
******************************************************************
*                 *                                              *
*     REMOTE      *      CALL RMOTE(LU)                          *
*                 *                                              *
*                 *      WHERE: LU=AUTO ADDRESSING OR DIRECT     *
*                 *                I/O LU IN RANGE 1-63          *
*                 *                                              *
******************************************************************
RMOTE NOP 
      JSB SET             RETRIEVE VALID PARAMETERS 
* 
* RMOTE(DLU) - CALL EXEC(3,16DLU) 
* RMOTE(BLU) - CALL EXEC(3,16BLU) 
* 
      LDA CTL16           LOAD REN CONTROL REQUEST CODE 
* 
      JMP CTL             MAKE REMOTE CONTROL REQUEST 
* 
* 
      SKP 
******************************************************************
*                 *                                              *
*     GO TO LOCAL *       CALL GTL(LU)                           *
*                 *                                              *
*                 *       WHERE: LU=AUTO ADDRESSING OR DIRECT    *
*                 *                 I/O LU IN RANGE OF 1-63      *
*                 *                                              *
******************************************************************
GTL   NOP 
      JSB SET             RETRIEVE VALID PARAMETERS 
* 
      CLB 
      SZA,RSS             BUS LU? 
      INB                 YES, SET PARM3=1
      STB PARM3           NO, SET PARM3=0 
* 
* GTL(DLU) - CALL EXEC(3,17DLU) 
* GTL(BLU) - CALL EXEC(3,17BLU,1) 
* 
      LDA CTL17          LOAD CONTROL REQUEST CODE
* 
      JMP CTL            MAKE GTL CONTROL REQUEST 
* 
* 
      SKP 
******************************************************************
*                     *                                          *
*     LOCAL LOCK OUT  *   CALL LLO(BLU)                          *
*                     *                                          *
*                     *  WHERE: BLU=DIRECT I/O LU IN RANGE       *
*                     *             OF 1-63                      *
*                     *                                          *
******************************************************************
LLO   NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      SZA               BUS LU? 
      JMP LOSE          NO,INVALID LU,EXIT WITH ERROR 
* 
* LLO(BLU) - CALL EXEC(3,25BLU) 
* 
      LDA CTL25         LOAD CONTROL REQUEST CODE 
* 
      JMP CTL           MAKE LLO CONTROL REQUEST
* 
      SKP 
******************************************************************
*                 *                                              *
*     LOCAL       *     CALL LOCL(BLU)                           *
*                 *     WHERE: BLU=DIRECT I/O LU IN RANGE        *
*                 *                OF 1-63                       *
*                 *                                              *
******************************************************************
LOCL NOP
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      SZA               BUS LU? 
      JMP LOSE          NO,INVALID LU,EXIT WITH ERROR 
* 
* LOCL(BLU) - CALL EXEC(3,17BLU,0)
* 
      LDA CTL17         YES(DIRECT I/O),LOAD CONTROL REQUEST CODE 
* 
      JMP CTL           MAKE LOCAL ENABLE CONTROL REQUEST 
* 
      SKP 
******************************************************************
*                     *                                          *
*    DYNAMIC STATUS   * CALL STATS(DLU,I)                        *
*                     *                                          *
*                     * WHERE: LU=AUTO ADDRESSING LU IN RANGE    *
*                     *           OF 1-63                        *
*                     *         I=DEVICE/BUS STATUS RETURNED     *
*                     *           IN LOWER BYTE                  *
*                     *                                          *
******************************************************************
STATS NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      SZA,RSS           DEVICE LU?
      JMP LOSE          NO, INVALID LU, EXIT WITH ERROR 
* 
* STATS(DLU,I) - CALL EXEC(3,6DLU,I)
* 
STAT  LDA CTL6          LOAD CONTROL REQUEST CODE 
      IOR LU            MERGE LU
      STA CTLWD         AND SAVE IN CONTROL WORD
* 
      LDA .3            SET REQUEST CODE
      STA REQ 
      JSB CTLW          ADJUST CONTROL WORD 
* 
      JSB CTLC           MAKE STATUS CONROL REQUEST 
* 
      LDA DVTA           GET DVT ADDR 
      ADA .17            INDEX TO DVT18 
      LDA A,I            GET DVT18 (STATUS) 
      AND B377           MASK LOWER STATUS BYTE 
      STA CPAR2,I        STORE STATUS BYTE IN USER BUFFER 
      JMP XIT,I          EXIT 
* 
      SKP 
**********************************************************************
*                *                                                   *
*    PARALLEL    *       CALL PPOLL(LU,I,ASGN)                       *
*    POLL INT.   *                                                   *
*                *       WHERE: LU=AUTO ADDRESSING OR DIRECT         *
*                *                 I/O LU IN RANGE OF 1-63           *
*                *                                                   *
*                *               I=FUNCTION CODE                     *
*                *               I=1,PARALLEL POLL ENABLE(PPE)       *
*                *               I=2,PARALLEL POLL DISABLE(PPD)      *
*                *               I=3,PARALLEL POLL UNCONFIGURE(PPU)  *
*                *                   (DIRECT I/O ONLY)               *
*                *                                                   *
*                *            ASGN=POSITIVE OR NEGATIVE INTEGER      *
*                *                 IN THE RANGE OF 1-8 REPRESENTING  *
*                *                 HPIB DIO LINE ON WHICH TO RESPOND *
*                *                 TO A PARALLEL POLL. (I=1)         *
*                *                                                   *
*                *                 POSITIVE INTEGER INDICATES A      *
*                *                 ZERO RESPONSE AND A NEGATIVE      *
*                *                 INTEGER INDICATES A ONE RESPONSE  *
*                *                 TO A PARALLEL POLL.               *
*                *                                                   *
**********************************************************************
PPOLL NOP 
      JSB SET            RETRIEVE VALID PARAMETERS
* 
      LDB CPAR2,I        LOAD FUNCTION
      CPB .1             I=1? 
      JMP PPOL1          YES(PPE) 
      CPB .2             NO,I=2?
      JMP PPOL2          YES(PPD) 
      CPB .3             NO,I=3?
      JMP PPOL3          YES(PPU) 
      JMP LOSE           NO,INVALID FUNCTION,EXIT WITH ERROR
* 
* PPOLL(DLU,1,ASGN) - CALL EXEC(3,23DLU,0,ASGN) 
* PPOLL(BLU,1,ASGN) - CALL EXEC(3,23BLU,0,ASGN) 
* 
PPOL1 LDA CPAR3,I        I=1,LOAD ASSIGNMENT PARAMETER
      SZA,RSS            ASSIGNMENT=0?
      JMP LOSE           YES,INVALID ASSIGNMENT,EXIT WITH ERROR 
* 
      SSA                NO,IS ASSIGNMENT NEGATIVE? 
* 
      CMA,INA            YES,CONVERT TO POSITIVE NUMBER 
* 
      ADA M9             SUBTRACT NINE FROM ASSIGNMENT
      SSA,RSS            1<=ASGN<=8 ??
      JMP LOSE           NO,INVALID ASSIGNMENT,EXIT WITH ERROR
* 
      LDB CPAR3,I         LOAD ASSIGNMENT AGAIN 
      STB PARM4           SAVE IT 
PPOL  LDA CTL23           LOAD CONTROL REQUEST CODE 
      JMP CTL             PARALLEL POLL ENABLE REQUEST
* 
* PPOLL(DLU,2,0) - CALL EXEC(3,23DLU,1) 
* PPOLL(BLU,2,0) - CALL EXEC(3,23BLU,1) 
* 
PPOL2 CLA,INA 
      STA PARM3            SET PARM3 = 1
* 
      JMP PPOL             PPOLL DISABLE REQUEST
* 
* PPOLL(BLU,3,0) - CALL EXEC(3,23BLU,2) 
* 
PPOL3 SZA                  BUS LU?
      JMP LOSE             NO, INVALID LU, EXIT WITH ERROR
* 
      LDA .2               FORM DIRECT I/O CNTRL WORD 
      STA PARM3            SAVE IT
      JMP PPOL             MAKE PPOLL UNCONFG CONTROL REQ.
* 
      SKP 
**********************************************************************
*                           *                                        *
*     PARALLEL POLL STATUS  *  CALL PSTAT(BLU,I)                     *
*                           *                                        *
*                           *  WHERE: BLU=DIRECT I/O LU IN RANGE     *
*                           *             OF 1-63                    *
*                           *                                        *
*                           *           I=INTEGER VARIABLE IN WHICH  *
*                           *             STATUS OF BUS DATA LINES   *
*                           *             DIO1-DIO8 WILL BE RETURNED *
*                           *             IN THE LOWER BYTE.         *
*                           *             BIT0=DIO1,BIT1=DIO2,ETC.   *
*                           *                                        *
**********************************************************************
PSTAT NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      SZA               BUS LU? 
      JMP LOSE          NO,INVALID LU,EXIT WITH ERROR 
* 
* PSTAT(BLU,I) - CALL EXEC(3,6BLU,I)
* 
      JMP STAT          INITIATE PARALLEL POLL STATUS REQ.
* 
      SKP 
* 
******************************************************************* 
*     CONFIGURE    *    CALL CNFG(LU,I,IW)                        * 
*                  *                                              * 
*                  *    WHERE: LU=AUTO ADDRESSING OR DIRECT       * 
*                  *              I/O LU IN RANGE OF 1-63         * 
*                  *                                              * 
*                  *            I=FUNCTION CODE                   * 
*                  *            I=1, CONFIGURATION REQUEST        * 
*                  *                 IW=400B, ENABLE PROGRAM      * 
*                  *                          ERROR HANDLING      * 
*                  *                 IW=0,    DISABLE PROGRAM     * 
*                  *                          ERROR HANDLING      * 
*                  *            I=2, UNCONFIGURE REQUEST          * 
*                  *                 IW=N/A   DISABLE PROGRAM     * 
*                  *                          ERROR HANDLING AND  * 
*                  *                          INTERRUPT PROGRAMS  * 
*                  *                                              * 
******************************************************************* 
* 
CNFG  NOP 
      JSB SET         RETRIEVE VALID PARAMETERS 
      CLB 
      SZA             DEVICE LU?
      INB             YES, SET LUTYP FLAG = 1 
      STB LUTYP       NO, SET LUTYP FLAG = 0
      LDA DVTA        GET DVT ADDRESS 
      ADA .19         INDEX TO DVT20 ADDRESS
      STA TBLAD       SAVE DVT20 ADDRESS
      LDA CPAR2,I     LOAD FUNCTION 
      CPA .1          I=1?
      JMP CNFG1       YES, CONFIGURE REQUEST
      CPA .2          I=2?
      JMP CNFG2       YES, UNCONFIGURE REQUEST
      JMP LOSE        NO,INVALID FUNCTION,EXIT WITH ERROR 
* 
CNFG1 LDA CPAR3,I     GET IW
      AND BIT8        GET ERROR BIT 
      SZA,RSS         ERROR BIT SET?
      JMP CNFG2       NO, DISABLE ERROR HANDLING
      LDA IOR14       IOR BIT14 
      STA MASK        SET ERROR HANDLING BIT 14 IN DVT20
      JSB ERRHD       ENABLE ERROR HANDLING 
      LDA IOR15       IOR BIT15 
      STA ADJLU       SET BIT 15 TO CONFIGURE LU
      JSB ERRHT       CONFIGURE LU IN HPIB TABLE
      JMP XIT,I       EXIT
* 
CNFG2 LDA AND14       AND MSK14 
      STA MASK        ZERO ERROR HANDLING BIT 14 IN DVT20 
      JSB ERRHD       DISABLE ERROR HANDLING
      LDA AND15       AND BIT15 
      STA ADJLU       ZERO BIT 15 TO UNCONFIGURE LU 
      JSB ERRHT       UNCONFIGURE LU IN HPIB TABLE
      LDA CPAR2,I     GET FUNCTION
      AND .2
      SZA,RSS         UNCONFIGURE REQUEST?
      JMP XIT,I       NO, EXIT
      LDA .3          YES, SET REQUEST CODE 
      STA REQ 
      LDA LUTYP       GET LU TYPE 
      SZA,RSS         BUS LU? 
      JMP CNFU        YES, DO PARALLEL POLL UNSCHEDULE
      LDA CTL21       NO, DO SERIAL POLL UNSCHEDULE 
      IOR LU          MERGE LU
      STA CTLWD       SAVE CONTROL WORD 
      JSB CTLC        MAKE SERIAL POLL UNSCHEDULE REQUEST 
CNFU  LDA CTL41       PARALLEL POLL UNSCHEDULE
      IOR LU          MERGE LU
      STA CTLWD       SAVE CONTROL WORD 
      JSB CTLC        MAKE PARALLEL POLL UNSCHEDULE REQUEST 
      JMP XIT,I       EXIT
* 
BIT14 OCT 40000 
BIT15 OCT 100000      CONFIGURATION BIT 
MSK14 OCT 137777      ZERO BIT 14 
MSK15 OCT 77777       ZERO BIT 15 
BIT8  OCT 400         E BIT IN CONFIGURATION WORD 
BIT9  OCT 1000
LUTYP NOP             LU TYPE 0/1 BUS/DEVICE
TBLAD NOP             CONFIGURATION TABLE ADDRESS 
RRL   RRL 16
IOR14 IOR BIT14 
IOR15 IOR BIT15 
AND14 AND MSK14 
AND15 AND MSK15 
M17   DEC -17 
* 
CONFG NOP 
      LDA LU          GET LU
      AND B77         MASK IT 
      CLB             CLEAR TABLE ADDR. OFFSET
CONF2 ADA M17         FIND WORD CONTAINING LU (16 LU'S/WRD) 
      SSA             WORD FOUND? 
      JMP CONF4       YES, TABLE ADDR. OFFSET IN B. 
      INA             NO, ADJUST LU 
      INB             ADJUST OFFSET 
      JMP CONF2       TRY AGAIN 
CONF4 INA             COMPUTE NUMBER OF BITS TO ROTATE
      CMA,INA         TO SIGN BIT POSITION. 
      JMP CONFG,I     RETURN
* 
ERRHT NOP 
      JSB CONFG       FIND LU IN HPIB CNFG TABLE
      SZA             LESS THAN 16 ROTATES? 
      IOR RRL         YES, SAVE RRL N 
      STA CNF2        NO, SAVE NOP
      SZA             LESS THAN 16 ROTATES? 
      IOR BIT9        YES, SAVE RRR N 
      STA CNF4        NO, SAVE NOP
      LDA HPIBB       GET TABLE STARTING ADDR.
      ADB A           ADD OFFSET
      JSB $LIBR 
       NOP
      LDA B,I         GET WORD CONTAINING LU
CNF2  NOP             ROTATE LU POSITION TO SIGN BIT
ADJLU NOP             SET OR ZERO IT
CNF4  NOP             ROTATE LU BIT BACK INTO POSITION
      STA B,I         PUT BACK INTO HPIB TABLE
      JSB $LIBX 
       DEF ERRHT
* 
ERRHD NOP 
      JSB $LIBR 
       NOP
      LDA TBLAD,I     SET OR ZERO BIT 14 IN DVT20 
MASK  NOP             TO ENABLE OR DISABLE ERROR HANDLING 
      STA TBLAD,I     PUT BACK INTO DVT20 
      JSB $LIBX 
       DEF ERRHD
* 
      SKP 
* 
********************************************************************
*                *                                                 *
*     ABORT      *      CALL ABRT(BLU,I)                           *
*                *                                                 *
*                *      WHERE: BLU=DIRECT I/O LU IN RANGE OF 1-63  *
*                *                                                 *
*                *               I=FUNCTION CODE                   *
*                *               I=1,ISSUE IFC COMMAND ONLY        *
*                *               I=2,ISSUE IFC AND DCL COMMANDS    *
*                *               I=3,ISSUE UNT,UNL COMMANDS        *
*                *                                                 *
********************************************************************
ABRT  NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      SZA               BUS LU? 
      JMP LOSE          NO,INVALID LU,EXIT WITH ERROR 
* 
      LDB CPAR2,I       LOAD FUNCTION 
      CPB .1            I=1?
      JMP ABRT1         YES, IFC
      CPB .2            NO,I=2? 
      JMP ABRT2         YES, IFC & DCL
      CPB .3            NO,I=3? 
      JMP ABRT3         YES, UNT,UNL
      JMP LOSE          NO,INVALID FUNCTION,EXIT WITH ERROR 
* 
* ABRT(BLU,1) - CALL EXEC(3,51BLU)
* 
ABRT1 IOR CTL51         MERGE CONFIGURE REQUEST CODE
      CLB,RSS           LOAD CTL REQ PARAMETER
* 
* ABRT(BLU,2) - CALL EXEC(3,BLU,1)
* 
ABRT2 CLB,INB           LOAD CTL REQ PARAMETER
      STB PARM3         AND SAVE IN CTL WORD PARM BUFR
* 
      JMP CTL           MAKE ABORT CONTROL REQUEST
* 
* ABRT(BLU,3) - CALL EXEC(2,CTLWD,0,0,CBUFR,-2) 
* 
ABRT3 JSB CNTL          FORM DIRECT I/O CTL WORD BUFR 
      LDA UNTLK         LOAD UNT,UNL CMNDS
      STA CBUFR         AND SAVE IN CMND BUFR 
      LDA M2            LOAD CMND BUFR LNGTH
      STA CLGTH         AND SAVE
      JSB CTLW          ADJUST CONTROL WORD 
      JSB OUTPT         OUTPUT UNT,UNL CMNDS
      JMP XIT,I         EXIT
      SKP 
* 
************************************************************
*                    *                                     *
* COMMAND READ       *  CALL CMDR(BLU,ICMND,IDATA)         *
* COMMAND WRITE      *  CALL CMDW(BLU,ICMND,IDATA)         *
* SEC. READ INTEGER  *  CALL SECR (DLU,ISEC,IBUFR,ILNG)    *
* SEC. READ REAL     *  CALL SECRR(DLU,ISEC,IBUFR,ILNG)    *
* SEC. WRITE INTEGER *  CALL SECW (DLU,ISEC,IBUFR,ILNG)    *
* SEC. WRITE REAL    *  CALL SECWR(DLU,ISEC,IBUFR,ILNG)    *
*                    *                                     *
*                    *  WHERE: BLU=DIRECT I/O LU IN RANGE  *
*                    *         OF 1-63                     *
*                    *         DLU=AUTO ADDRESSING LU IN   *
*                    *         RANGE OF 1-63               *
*                    *                                     *
*                    *   ICMND=A STRING VARIABLE IN BASIC  *
*                    *         OR A DIMENSIONED ARRAY IN   *
*                    *         FORTRAN, CONTAINING UNTALK  *
*                    *         UNLISTEN ADDRESSES FOLLOWED *
*                    *         BY THE ASCII CHARACTER EQUIV*
*                    *         OF THE DESIRED LISTEN AND/OR*
*                    *         TALK ADDRESSES.             *
*                    *                                     *
*                    *   IDATA=INTEGER 0 FOR NO DATA, OR A *
*                    *         STRING VARIABLE IN BASIC, OR*
*                    *         A DIMENSIONED ARRAY IN FORT,*
*                    *         TO SEND OR RECEIVE DATA TO  *
*                    *         THE DEVICE ADDRESSED TO     *
*                    *         LISTEN OR TALK.             *
*                    *                                     *
*                    *    ISEC=SECONDARY ADDRESS IN RANGE  *
*                    *         OF 0-31 DECIMAL             *
*                    *                                     *
*                    *   IBUFR=DATA BUFFER                 *
*                    *                                     *
*                    *    ILNG=LENGTH OF BUFFER IN WORDS   *
*                    *         IF>0 OR BYTES IF<0.         *
*                    *                                     *
************************************************************
CMDR  NOP           HERE FOR READ REQ.
      JSB SET       GET PARMS, ETC. 
      CLB,INB       SET REQUEST FOR READ
      JMP CMDS
* 
CMDW  NOP           HERE FOR WRITE REQ. 
      JSB SET 
      LDB .2        SET REQUEST FOR WRITE 
* 
* CMDR(BLU,ICMND,IDATA) - CALL EXEC(1,CTLWD,DATAB,DATAL,CMNDB,CMNDL)
* CMDW(BLU,ICMND,IDATA) - CALL EXEC(2,CTLWD,DATAB,DATAL,CMNDB,CMNDL)
* 
CMDS  SZA           BUS LU? 
      JMP LOSE       NO, LOSE!
      STB REQ       FORM I/O REQ. CODE
      LDA LU        GET BUS LU
      IOR BIT12     ADD Z-BIT FOR 
      STA CTLWD      2 BUFR REQUEST 
      LDA CPAR2,I   GET CMND BUFR LNG (+CHAR'S) 
      AND B377      ALLOW 255 BYTES 
      CMA,INA       MAKE -CHAR'S
      STA PARM6     SAVE CMND BUFR LENGTH 
      ISZ CPAR2     ADJUST BUFR ADDR
      LDA CPAR3,I   GET DATA BUFR LNG (+CHAR'S) 
      AND B377      ALLOW 255 BYTES 
      CMA,INA       MAKE IT -CHARS
      STA PARM4     SAVE DATA BUFR LENGTH 
      ISZ CPAR3     ADJUST BUFR ADDR
      JSB CTLW      ADJUST CONTROL WORD 
      JSB EXEC      MAKE COMMAND REQUEST
       DEF *+7
       DEF REQ      REQUEST CODE
       DEF CTLWD    CONTROL WORD
       DEF CPAR3,I  DATA BUFFER 
       DEF PARM4    DATA LENGTH 
       DEF CPAR2,I  COMMAND BUFFER
       DEF PARM6    COMMAND LENGTH
      JMP XIT,I     EXIT
* 
SECR  EQU * 
SECRR NOP 
      JSB SET       GET PARMS, ETC. 
      CLB,INB       SET REQUEST FOR READ
      JMP SEC 
* 
SECW  EQU * 
SECWR NOP 
      JSB SET       RETRIEVE VALID PARAMETERS 
      LDB .2        SET REQUEST FOR WRITE 
* 
* SECR (DLU,ISEC,IBUFR,ILNG) - CALL EXEC(1,CTLWD,DATAB,DATAL,SEC,0) 
* SECRR(DLU,ISEC,IBUFR,ILNG) - CALL EXEC(1,CTLWD,DATAB,DATAL,SEC,0) 
* SECW (DLU,ISEC,IBUFR,ILNG) - CALL EXEC(2,CTLWD,DATAB,DATAL,SEC,0) 
* SECWR(DLU,ISEC,IBUFR,ILNG) - CALL EXEC(2,CTLWD,DATAB,DATAL,SEC,0) 
* 
SEC   SZA,RSS       DEVICE LU?
      JMP LOSE      NO, LOSE! 
      STB REQ       FORM REQUEST CODE 
      LDA LU        GET DEVICE LU 
      IOR BIT6      ADD BINARY BIT
      STA CTLWD     SAVE IT 
      LDA CPAR2,I   GET SECONDARY 
      SSA           <0 DECIMAL
      JMP LOSE      YES, LOSE 
      ADA M32 
      SSA,RSS       >31 DECIMAL 
      JMP LOSE      YES, LOSE 
      LDA CPAR2,I   GET SECONDARY (DECIMAL) 
      ADA B140      CONVERT TO 140-177 OCTAL
      STA PARM5     SAVE IT 
      LDA CPAR4,I   GET BUFR LNG (+WORDS, -CHAR'S)
      SSA           CHARACTERS? 
      JMP *+3       YES, SAVE THEM
      CMA,INA       NO, CONVERT 
      ALS           TO -CHAR'S
      STA PARM4     SAVE -CHAR LENGTH 
      JSB CTLW      ADJUST CONTROL WORD 
      JSB EXEC      MAKE SECONDARY REQUEST
       DEF *+7
       DEF REQ      REQUEST CODE
       DEF CTLWD    CONTROL WORD
       DEF CPAR3,I  DATA BUFFER 
       DEF PARM4    DATA LENGTH 
       DEF PARM5    SECONDARY 
       DEF .0 
      JMP XIT,I     EXIT
* 
M32   DEC -32 
B140  OCT 140 
BIT6  OCT 100 
      SKP 
* 
********************************************************************* 
*                 *                                                 * 
*     SRQ SERVICE *  CALL SRQ(DLU,V,"PROG")                         * 
*                 *                                                 * 
*                 *  WHERE: DLU=AUTO ADDRESSING LU IN               * 
*                 *             RANGE OF 1-63                       * 
*                 *                                                 * 
*                 *           V=OPTIONAL VALUE PASSED TO PROGRAM    * 
*                 *                                                 * 
*                 *        PROG >0,SCHEDULE PROGRAM NAME            * 
*                 *             =0,UNSCHEDULE PROGRAM               * 
*                 *                                                 * 
********************************************************************* 
* 
* SRQ(DLU,V,"PROG") - CALL EXEC(3,20DLU,"PROG",V) 
* 
SRQ   NOP 
      JSB SET       RECOVER PARMS 
* 
      SZA,RSS       DEVICE LU?
      JMP LOSE      NO, LOSE! 
* 
      LDA CPAR3,I   GET STRING LENGTH 
      AND B377
      SZA,RSS       CHARACTER COUNT = 0?
      JMP SRQUN     YES, UNSCHEDULE PROGRAM 
* 
      STA COUNT     SAVE +CHAR'S
      LDA CTL20     LOAD CONTROL REQUEST CODE 
SRQ1  IOR LU        MERGE LU
      STA CTLWD     AND SAVE CONTROL WORD 
      ISZ CPAR3     INDEX PAST LENGTH 
      LDA SPACE     INITIALIZE
      STA PARM3      BUFFER 
      STA PARM4 
      STA PARM5 
      LDA CPAR3 
      RAL           CREATE BYTE ADDRESS 
      LDB BUF       TEMPORARY BUFFER ADDRESS
      JSB .MBT      MOVE NAME INTO BUFR 
       DEF COUNT    NUMBER OF CHARACTERS IN NAME
       NOP
      LDA CPAR2,I   GET OPTIONAL VALUE
      STA PARM6     SAVE IT 
      JMP CTLRQ 
* 
* SRQ(DLU,0,0) - CALL EXEC(3,21DLU) 
* 
SRQUN LDA CTL21     LOAD CONTROL REQUEST CODE 
      JMP CTL       UNSCHEDULE REQUEST
* 
COUNT NOP           +CHAR COUNT 
BUF   DBL PARM3 
SPACE OCT 20040 
      SKP 
***************************************************************** 
*                     *                                         * 
* ACTIVATES A SERVICE *  CALL SRQSN(DLU,N)                      * 
* REQUEST TRAP ENTRY  *                                         * 
*                     *  WHERE: DLU=AUTO ADDRESSING LU IN       * 
*                     *             RANGE OF 1-63               * 
*                     *                                         * 
*                     *           N=TRAP NUMBER                 * 
*                     *                                         * 
***************************************************************** 
* 
* SRQSN(DLU,N) - CALL EXEC(3,20DLU,"SRV.L") 
* 
SRQSN NOP 
      JSB SET       RECOVER PARAMETERS
* 
      SZA,RSS       BUS LU? 
      JMP LOSE      YES, LOSE 
* 
      LDA CTL20     LOAD CONTROL REQUEST CODE 
SRQ3  IOR LU        MERGE LU
      STA CTLWD     AND SAVE CONTROL WORD 
      LDA CPAR2,I   GET TRAP NUMBER (N) 
      CMA,SSA,INA   TRAP #'S 1-16 
      SZA,RSS       ARE LEGAL 
      JMP LOSE
      ADA .16 
      SSA 
      JMP LOSE      OTHERS LOSE 
      LDB SRQ.T     GET ARV.L TABLE ADDRESS 
      SZB,RSS       ADDRESS ZERO? 
      JMP LOSE      YES, BASIC TRAP NOT FOUND 
      LDA CPAR2,I   GET TRAP NUMBER (N) 
      ADA M1        COMPUTE LU ADDRESS
      STA TRAP       IN ARV.L TABLE 
      RAL            AT TRAP ENTRY (N)
      ADA TRAP
      ADB A 
      STB TRAP      SAVE LU ADDRESS 
* 
      LDA M16       TRAP TABLE COUNTER
      STA COUNT     SAVE IT 
      LDB SRQ.T     GET ARV.L TABLE ADDRESS 
NEXT  LDA B,I       GET LU FROM TABLE 
      CPA LU        LU ALREADY THERE? 
      JMP ZERO      YES, ZERO IT
      ADB .3        NO, INDEX TO NEXT LU
      ISZ COUNT     TABLE EXHAUSTED?
      JMP NEXT      NO, GET NEXT LU 
      JMP GO        YES, PUT LU INTO TABLE
ZERO  STB TBLAD     SAVE ADDRESS
      JSB IPUT      ZERO LU IN ARV.L TABLE
       DEF *+3
       DEF TBLAD
       DEF .0 
      ISZ TBLAD     INDEX TO VALUE ADDRESS
      JSB IPUT      ZERO VALUE IN ARV.L TABLE 
       DEF *+3
       DEF TBLAD
       DEF .0 
      ISZ TBLAD     INDEX TO STATUS ADDRESS 
      JSB IPUT      ZERO STATUS IN ARV.L TABLE
       DEF *+3
       DEF TBLAD
       DEF .0 
* 
GO    JSB IPUT      PUT LU INTO ARV.L TABLE 
       DEF *+3       AT CORRESPONDING TRAP ENTRY
       DEF TRAP 
       DEF LU 
      LDA SRV.N     SERVICE PROGRAM NAME "SRV.L"
      STA PARM3 
      LDA SRV.N+1 
      STA PARM4 
      LDA SRV.N+2 
      STA PARM5 
      JMP CTLRQ     SCHEDULE "SRV.L" PROGRAM
* 
SRV.N ASC 3,SRV.L 
TRAP  NOP 
M16   DEC -16 
      SKP 
* 
********************************************************************* 
*                                                                   * 
* PARALLEL POLL   *  CALL PPSCH(DLU,V,"PROG")                       * 
* SCHEDULE        *                                                 * 
*                 *  WHERE: DLU=AUTO ADDRESSING LU IN               * 
*                 *             RANGE OF 1-63                       * 
*                 *                                                 * 
*                 *           V=OPTIONAL VALUE PASSED TO PROGRAM    * 
*                 *                                                 * 
*                 *       PROG >0,SCHEDULE PROGRAM NAME             * 
*                 *            =0,UNSCHEDULE PROGRAM                * 
*                 *                                                 * 
********************************************************************* 
* 
* PPSCH(DLU,V,"PROG") - CALL EXEC(3,40DLU,"PROG",V) 
* PPSCH(BLU,V,"PROG") - CALL EXEC(3,40BLU,"PROG",V) 
* 
PPSCH NOP 
      JSB SET       RETRIEVE PARAMETERS 
      LDA CPAR3,I   GET STRING LENGTH 
      AND B377
      SZA,RSS       CHARACTER COUNT = 0?
      JMP PPUSC     YES, UNSCHEDULE PROGRAM 
      STA COUNT     SAVE +CHAR COUNT
      LDA CTL40     LOAD CONTROL REQUEST CODE 
      JMP SRQ1      PARALLEL POLL SCHEDULE REQUEST
* 
* PPSCH(DLU,0,0) - CALL EXEC(3,41DLU) 
* PPSCH(BLU,0,0) - CALL EXEC(3,41BLU) 
* 
PPUSC LDA CTL41     LOAD CONTROL REQUEST CODE 
      JMP CTL       PARALLEL POLL UNSCHEDULE REQUEST
* 
      SKP 
* 
********************************************************************* 
*                 *                                                 * 
* PARALLEL POLL   *  CALL PPSN(LU,N)                                * 
* TRAP ENTRY      *                                                 * 
*                 *  WHERE: LU=AUTO ADDRESSING OR DIRECT            * 
*                 *            I/O LU IN RANGE OF 1-63              * 
*                 *                                                 * 
*                 *          N=TRAP NUMBER                          * 
*                 *                                                 * 
********************************************************************* 
* 
* PPSN(DLU,N) - CALL EXEC(3,40DLU,"SRV.L")
* PPSN(BLU,N) - CALL EXEC(3,40BLU,"SRV.L")
* 
PPSN  NOP 
      JSB SET       RETRIEVE PARAMETERS 
      LDA CTL40     LOAD CONTROL REQUEST CODE 
      JMP SRQ3
      SKP 
* 
* RETURNED LENGTH FUNCTION
* 
* I=IOCNT(DLU)
* 
IOCNT NOP 
      JSB SET       RETRIEVE PARAMETERS 
      LDA DVTA      GET DVT ADDRESS 
      ADA .16       INDEX TO XLOG ADDR
      LDA A,I       GET XLOG
      JMP XIT,I     EXIT
      SKP 
* 
* 
*     ERROR STATUS FUNCTION 
* 
*     I=IBERR(LU) 
* 
IBERR NOP 
      JSB SET       GET PARMS & VALIDATE
      LDA DVTA      GET DVT ADDRESS 
      ADA .5        INDEX TO DVT 6
      LDB A,I       GET ERROR BIT 0 
      SLB           ERRORS? 
      JMP IBER1     YES 
      CLA           NO, ZERO A
      JMP XIT,I     EXIT
* 
IBER1 ADA .10       GET ERROR CODE ADDRESS
      LDA A,I       GET ERROR CODE
      AND B377
      STA B         SAVE IN B 
      CPB .1        ILLEGAL REQUEST?
      LDA .4        YES, ERROR CODE = 4 
      CPB .3        TIMEOUT?
      CLA,INA       YES, ERROR CODE = 1 
      JMP XIT,I     EXIT
* 
      SKP 
**************************
* ********************** *
* *                    * *
* *     SUBROUTINES    * *
* *                    * *
* ********************** *
**************************
* 
* 
**********************************************************
*                                                        *
*     SUBROUTINE TO RETREIVE PARAMETERS AND VALIDATE     *
*                                                        *
**********************************************************
SET   NOP 
      LDA SET       LOAD RETURN ADDRESS 
      ADA M2        SUBTRACT TWO
      LDA 0,I       LOAD PARAMETER LIST ADDRESS 
      STA XIT       AND SAVE
      CLA           ZERO
      STA PARM3 
      STA PARM4 
      STA PARM5 
      STA PARM6 
      STA CPAR2     SECOND
      STA CPAR3     THIRD AND 
      STA CPAR4     FOURTH PARAMETERS 
      JMP SET1
* 
* 
CPAR1 BSS 1         FIRST PARAMETER 
CPAR2 BSS 1         SECOND
CPAR3 BSS 1         THIRD AND 
CPAR4 BSS 1         FOURTH PARAMETERS 
* 
* 
XIT   NOP 
SET1  JSB .ENTR     RETRIEVE PARAMETERS 
       DEF CPAR1
      LDA CPAR1,I   LOAD FIRST PARAMETER
      AND B77      MASK LU
      STA LU       AND SAVE 
      CMA,INA,SZA,RSS CONVERT TO NEG. LU, ZERO? 
      JMP XIT,I       YES, EXIT 
      ADA $LUTA    ADD TO LAST CONFIGURED LU
      SSA          VALID LU?
      JMP LOSE      NO,EXIT WITH ERROR MESSAGE
      LDA $LUTA     YES,LOAD DVT TABLE ENTRY ADDRESS
      ADA LU       INDEX TO APPROPRIATE 
      ADA M1       DVT ADDRESS
      LDA A,I      LOAD DVT ADDRESS 
      SZA,RSS      ADDRESS=0? 
      JMP XIT,I     YES,EXIT(IGNORE BIT BUCKET) 
      STA DVTA      NO,SAVE DVT ADDRESS 
      LDB A        LOAD DVT ADDRESS INTO B-REG
      ADA .4       INDEX TO DVT WORD 5
      LDA A,I      LOAD DVT WORD 5
      ELA,CLE,ERA  CLEAR SIGN BIT 
      ADA .5       INDEX TO IFT WORD 6
      LDA A,I      GET INTERFACE TYPE 
      ALF,ALF      SHIFT AND
      AND B77      MASK INTERFACE TYPE
      CPA B37      INTERFACE TYPE=37? 
      JMP *+2      YES, CHECK FOR BUS LU
      JMP LOSE     NO, ERROR
      ADB .22      INDEX TO DVT PARAMETER ($DVTP) 
      LDA B,I      GET FIRST DRIVER PARAMETER 
      CPA B36      BUS LU?
      CLA          YES, RETURN A=0
      JMP SET,I     RETURN A=0 (BUS LU), A#0 (DEVICE LU)
* 
******************************************************
*                                                    *
*     ERROR SUBROUTINE - INDICATES BAD PARAMETER     *
*                                                    *
******************************************************
LOSE  JSB PNAME 
       DEF *+2
       DEF MSGA+6   GET PROGRAM NAME
      JSB IMESS 
       DEF *+4
       DEF .2       WRITE "ILL RQ-HPIB" MESSAGE 
       DEF MSGA 
       DEF .13
* 
      JSB EXEC
       DEF *+2      AND QUIT
       DEF .6 
* 
************************************************
*                                              *
*     SUBROUTINE FOR FORMING CONTROL WORD      *
*        FOR DOUBLE BUFFER I/O REQUEST         *
*                                              *
************************************************
CNTL  NOP 
      LDA LU        LOAD LU 
      IOR BIT12     MERGE DIRECT I/O BIT 12 
      STA CTLWD     AND SAVE
      JMP CNTL,I
* 
* 
******************************************************* 
*                                                     * 
*     SUBROUTINE FOR EXEC WRITE REQUEST               * 
*                                                     * 
******************************************************* 
OUTPT NOP 
      JSB EXEC
       DEF *+7
       DEF .2 
       DEF CTLWD
       DEF .0 
       DEF .0 
       DEF CBUFR
       DEF CLGTH
      JMP OUTPT,I 
* 
*************************************************************** 
*                                                             * 
*     SUBROUTINE FOR NON-BUFFERED/USER ERROR BITS             * 
*                                                             * 
*************************************************************** 
CTLW  NOP 
      LDA LU             GET LU 
      JSB CNFUE          CHECK LU CONFIGURATION 
      SZA,RSS            HANDLE ERRORS? 
      JMP CTLW,I         NO, RETURN 
      LDA CTLWD          YES, SET 
      IOR NBUE           'NB UE' BITS 
      STA CTLWD          IN CONTROL WORD
      JMP CTLW,I         RETURN 
* 
NBUE  OCT 60000 
* 
******************************************************************
*                                                                *
*     SUBROUTINE FOR CONTROL REQUEST WITH OPTIONAL PARAMETERS    *
*                                                                *
******************************************************************
CTLC  NOP 
      JSB EXEC
       DEF *+7
       DEF REQ
       DEF CTLWD
       DEF PARM3
       DEF PARM4
       DEF PARM5
       DEF PARM6
      JMP CTLC,I
* 
      SKP 
* 
********************************
* **************************** *
* *                          * *
* *   CONSTANT STORAGE,ETC.  * *
* *                          * *
* **************************** *
********************************
      SUP 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.10   DEC 10
.13   DEC 13
.16   DEC 16
.17   DEC 17
.19   DEC 19
.22   DEC 22
M1    DEC -1
M2    DEC -2
M9    DEC -9
B36   OCT 36
B37   OCT 37
B77   OCT 77
B377  OCT 377 
BIT12 OCT 10000 
CTL6  OCT 600 
CTL16 OCT 1600
CTL17 OCT 1700
CTL20 OCT 2000
CTL21 OCT 2100
CTL23 OCT 2300
CTL25 OCT 2500
CTL27 OCT 2700
CTL40 OCT 4000
CTL41 OCT 4100
CTL51 OCT 5100
DCL   OCT 12000 
UNTLK OCT 57477 
LU    BSS 1 
CBUFR BSS 2 
CLGTH BSS 1 
CTLWD BSS 1 
* 
* DO NOT CHANGE ORDER OR PARM3-PARM6
* 
PARM3 BSS 1 
PARM4 BSS 1 
PARM5 BSS 1 
PARM6 BSS 1 
* 
REQ   NOP 
DVTA  NOP 
* 
MSGA  ASC 13,ILL RQ-HPIB XXXXXXABORTED
* 
SIZE  EQU * 
      END 
                                                                                                                          