ASMB,Q,C
      HED IB4A2, RTE4 HPIB LIBRARY
      NAM IB4A2,7 59310-1X013 REV 2026 800407 EQTX=18+7*D 
* 
* 
      ENT TRIGR,CLEAR,RMOTE,GTL,LLO,LOCL
      ENT STATS,PPOLL,PSTAT,CNFG,ABRT 
      ENT SECR,SECRR,SECW,SECWR 
      ENT CMDR,CMDW 
      ENT SRQ,IBERR,IOCNT 
* 
      EXT .ENTR,EXEC,IPUT,LUTRU 
* 
*************************************************** 
*     (C) COPYRIGHT HEWLETT-PACKARD CO., 1978     * 
*               ALL RIGHTS RESERVED               * 
*************************************************** 
*                                                 * 
*     MESS - RTE HP-IB MESSAGE UTILITY LIBRARY    * 
*                                                 * 
*     RELOC:  59310-1X013 PHANTOM MODULE          * 
*     SOURCE: 59310-18013                         * 
*                                                 * 
*************************************************** 
* 
EQTA  EQU 1650B 
DRT   EQU 1652B 
LUMAX EQU 1653B 
* 
**************************************************
*                                                *
*     HP-IB MESSAGE SUBROUTINES                  *
*                                                *
*     TRIGR,CLEAR,RMOTE,GTL,LLO,LOCL,STATS,      *
*     PPOLL,PSTAT,CNFG,ABRT                      *
*                                                *
**************************************************
      SKP 
* 
* 
* 
*     GENERAL HPIB I/O REQUESTS 
* 
*     CALL CMDW/CMDR(LU,ICMND,IDATA)
* 
CMDR  NOP           HERE FOR READ REQ.
      JSB SET       GET PARMS, ETC. 
      JMP CMDS
* 
CMDW  NOP           HERE FOR WRITE REQ. 
      JSB SET 
      CCB,CCE,RSS 
* 
CMDS  CLB,CLE 
      STB T5
      LDA T2
      ALF,RAL       INSURE WE HAVE UNIT=0 
      AND B37 
      SZA 
      JMP LOSE       NO, LOSE!
      SEZ,INA 
      INA           FORM I/O REQ.CODE 
      STA T1
      LDA LU
      IOR BIT12     ADD Z-BIT FOR 
      STA T2         2 BUFR REQUEST 
      LDA CPAR3,I   GET DATA BUFR LNG 
      AND B377
      CMA,INA       MAKE IT -CHARS
      STA T3              & 
      LDA CPAR3 
      STA T6
      ISZ CPAR3     ADJUST BUFR ADDR
      LDA CPAR2,I 
      AND B377      GET CMND BUFR LNG 
      CMA,INA       MAKE -CHARS 
      STA T4          & 
      ISZ CPAR2     ADJUST BUFR ADDR
      JSB EXEC
       DEF *+7      DO I/O
       DEF T1        I/O REQ.CODE 
       DEF T2        CNTRL WORD 
       DEF CPAR3,I   DATA BUFR
       DEF T3        DATA LNG 
       DEF CPAR2,I   CMND BUFR
       DEF T4        CMND LNG 
      ISZ T5        INPUT REQUEST?
      STB T6,I       YES, POST CNT
      JMP RTN 
* 
      SKP 
* 
* 
*     SRQ SERVICE-SCHEDULE PROG 
* 
*     CALL SRQ(LU,IV,"PROG")  SRQ CAUSES "PROG" TO BE SCHEDULED AND 
*                              PASSED VALUE IV. 
*     CALL SRQ(LU,IV,0)       DISABLES SRQ PROGRAM SCHEDULING.
* 
SRQ   NOP 
      JSB SET       RECOVER PARMS 
      CLA 
      CPA CPAR3,I   IS "PROG" CHARACTER COUNT IS 0? 
      LDA B100       YES. DISABLE ALARM PROGRAM.
      ADA B2000       COMPLETE FORMING REQUEST CODE.
      ADA LU          INCLUDE THE LU. 
      STA T1
* 
      CLA 
      STA T2         IF DISABLE, THEN SKIP CHANGING TO
      CPA CPAR3,I     UNBUFFERED I/O REQUEST FOR THIS 
      JMP SRQ3        EXEC CALL.
* 
      ADB .3
SRQ1  LDA 1,I       CHECK EQT4 FOR
      AND BIT14      BUFFERING BIT=1
      SZA,RSS       ??
      JMP SRQ2
* 
      XOR 1,I       YES, FORCE NON-BUFFERED 
      STB T3         REQUEST FOR THIS CALL
      STA T4
      JSB IPUT      POST @ EQT4 
       DEF *+3
       DEF T3 
       DEF T4 
      CCA           FLAG IT FOR RESET LATER 
* 
SRQ2  STA T2        SAVE FLAG FOR RESETTING BUFFERED I/O. 
* 
      ISZ CPAR3    MOVE "PROG" AND IV TO BUFFER.
      LDA CPAR3,I 
      STA CBUFR    MOVE 1 & 2 
* 
      ISZ CPAR3 
      LDA CPAR3,I 
      STA CBUFR+1  MOVE 3 & 4 
* 
      ISZ CPAR3 
      LDA CPAR3,I 
      STA CBUFR+2  MOVE 5 
* 
      LDA CPAR2,I 
      STA CBUFR+3  MOVE IV
* 
SRQ3  JSB EXEC      CALL DRIVER NOW 
       DEF *+4
       DEF RQ3       REQ.CODE-NO ABORT
       DEF T1        CNTRL WORD 
       DEF CBUFA     PROG NAME BUFFER ADDRESS.
      CCB           IN CASE OF ERR
      ISZ T2         EQT MODIFIED?
      JMP RTN          NO, LEAVE
      DST ANB          YES, SAVE REGS 
      LDA T3,I
      IOR BIT14     RESTORE BUFFERING 
      STA T4         INDICATOR
      JSB IPUT
       DEF *+3
       DEF T3 
       DEF T4 
      LDB T2
      SSB,RSS       ERRS? 
      JMP RTN1       NO, EXIT 
      JMP LOSE       YES, ABORT 
* 
      SKP 
* 
* 
********************************************************************
* 
* I = IOCNT (LU)
* 
********************************************************************
IOCNT NOP 
      JSB SET 
      JSB GBQT
      SSA            ERROR? 
      CLA            YES. RETURN ZERO FOR COUNT.
      JMP RTN 
* 
******************************************************************* 
* 
*     ERROR STATUS FUNCTION 
*     I = IBERR (LU)
* 
******************************************************************* 
IBERR NOP 
      JSB SET       GET PARMS & VALIDATE
      JSB GBQT
      SSA,RSS       ERROR?
      CLA           NO. RETURN ZERO FOR NO ERRORS.
      AND B377      YES. EXTRACT ERROR BITS.
      JMP RTN 
* 
      SKP 
* 
* 
******************************************************************
*                 *                                              *
*     TRIGGER     *     CALL TRIGR(LU)                           *
*                 *                                              *
*                 *     WHERE: LU = SESSION LU AUTO ADRESSING OR *
*                 *                 DIRECT I/O SESSION LU IN     *
*                 *                 RANGE OF 1-63.               *
*                 *                                              *
*                 *     TRIGR (BUSLU) GET                        *
*                 *     TRIGR (DEVLU) UNT,UNL,DEVLSN,GET         *
******************************************************************
TRIGR NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      JSB IOSTA         GET I/O STATUS
* 
      JSB SUBCH         GET SUBCHANNEL
* 
      SZA,RSS           SUBCHANNEL=0? 
      JMP TRIG1         YES(DIRECT I/O MODE)
* 
* 
*     TRIGR - AUTO ADDRESSING MODE
* 
* 
      JSB CNTL          NO, FORM AUTO ADDR CTL WORD 
* 
      LDA UNTLK         LOAD UNT,UNL COMMANDS 
      STA CBUFR         SAVE IN FIRST WORD OF CMND BUFR 
* 
      LDA T3            LOAD SUBCHANNEL 
      ALF,ALF           POSITION TO UPPER BYTE. 
      IOR LSGET         COMBINE WITH LSN,GET
      STA CBUFR+1       SAVE IN SECOND WORD OF CMND BUFR
* 
      LDA M4            LOAD AUTO ADDR CMND BUFR LENGTH 
      STA CLGTH         AND SAVE
* 
      JSB OUTPT         GO OUTPUT AUTO ADDR TRIGR CMNDS 
      JMP RTN1          EXIT
* 
* 
*     TRIGR - DIRECT I/O MODE 
* 
* 
TRIG1 JSB CNTL          FORM DIRECT I/O CTL WORD
* 
      LDA GET           LOAD GET COMMAND
      STA CBUFR         SAVE IN COMMAND BUFR
* 
      LDA M1            LOAD DIRECT I/O CMND BUFR LENGTH
      STA CLGTH         AND SAVE
* 
      JSB OUTPT         GO OUTPUT DIRECT I/O TRIGR CMNDS
      JMP RTN1          EXIT
* 
      SKP 
******************************************************************
*                 *                                              *
*     CLEAR       *     CALL CLEAR(LU,I)                         *
*                 *                                              *
*                 *     WHERE: LU = SESSION LU AUTO ADDRESSING   *
*                 *               OR DIRECT I/O SESSION 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 (DEVLU,1) UNT,UNL,DEVLSN,SDC      *
*                 *      CLEAR (BUSLU,1) SDC                     *
*                 *      CLEAR (BUSLU,2) DCL                     *
******************************************************************
CLEAR NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      JSB IOSTA         GET I/O STATUS
* 
      JSB SUBCH          GET SUBCHANNEL 
* 
      LDB CPAR2,I        LOAD I PARAMETER 
      CPB .1             I=1? 
      JMP CLR1           YES
      CPB .2             NO,I=2?
      JMP CLR2           YES
      JMP LOSE           INVALID I PARAMETER,EXIT WITH ERROR
* 
CLR1  SZA,RSS            I=1,SUBCHANNEL=0?
      JMP CLR3           YES(DIRECT I/O MODE) 
      JMP CLR4           NO(AUTO ADDR MODE) 
* 
CLR2  SZA                I=2,SUBCHANNEL=0?
      JMP LOSE           NO,INVALID SESSION LU,EXIT WITH ERROR
* 
* 
*     CLEAR - DIRECT I/O MODE 
* 
* 
CLR3  JSB CNTL           FORM DIRECT I/O CTL WORD 
* 
      CPB .1             I=1? 
      JMP *+3            YES
      LDA DCL            NO,I=2,LOAD UNIV DEV CLEAR CMND
      JMP *+2 
      LDA SDC            LOAD SELECTED DEVICE 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 OUTPT          GO OUTPUT DIRECT I/O CLEAR CMND
      JMP RTN1
* 
* 
*     CLEAR - AUTO ADDRESSING MODE
* 
* 
CLR4  JSB CNTL           FORM ATO ADDR CTL WORD 
* 
      LDA UNTLK          LOAD UNT,UNL 
      STA CBUFR          SAVE IN FIRST WORD OF AUTO ADDR CMND BUFR
* 
      LDA T3             FETCH SUBCHANNEL 
      ALF,ALF            POSITION SUBCHANNEL TO UPPER BYTE. 
      IOR LSSDC          COMBINE SUBCHANNEL WITH LSN,SDC
      STA CBUFR+1        SAVE IN SECOND WORD OF AUTO ADDR CMND BUFR 
* 
      LDA M4             LOAD AUTO ADDR CMND BUFR LENGTH
      STA CLGTH          AND SAVE 
* 
      JSB OUTPT          GO OUTPUT AUTO ADDR CLEAR CMNDS
      JMP RTN1           EXIT 
* 
      SKP 
******************************************************************
*                 *                                              *
*     REMOTE      *      CALL RMOTE(LU)                          *
*                 *                                              *
*                 *      WHERE: LU =SESSION LU AUTO ADDRESSING   *
*                 *                OR DIRECT I/O SESSION LU IN   *
*                 *                RANGE 1-63.                   *
*                 *                                              *
*                 *      RMOTE (BUSLU) REN                       *
*                 *      RMOTE (DEVLU) REN;UNT,UNL,DEVLSN        *
******************************************************************
RMOTE NOP 
      JSB SET             RETRIEVE VALID PARAMETERS 
* 
      JSB IOSTA           GET I/O STATUS
* 
      LDA CTL16           LOAD REN CONTROL REQUEST CODE 
      IOR LU              MERGE SESSION LU
      STA CTLWD           AND SAVE IN CONTROL WORD. 
* 
      JSB CTLR1           MAKE REN ENABLE CONTROL REQUEST 
* 
      JSB SUBCH           GET SUBCHANNEL
* 
      SZA,RSS             SUBCHANNEL=0? 
      JMP RTN1            YES,EXIT(DIRECT I/O MODE) 
* 
* 
*     RMOTE - AUTO ADDRESSING MODE
* 
* 
      JSB CNTL            NO,FORM AUTO ADDR CTL WORD
* 
      LDA UNTLK           LOAD UNT,UNL COMMANDS 
      STA CBUFR           SAVE IN AUTO ADDR COMMAND BUFR
* 
      LDA T3              FETCH  SUBCHANNEL 
      IOR NULSN           FORM DEVLSN COMMAND.
      ALF,ALF             POSITION TO UPPER BYTE. 
      STA CBUFR+1         SAVE AS LAST BYTE IN COMMAND BUFFER.
* 
      LDA M3              LOAD AUTO ADDR CMND BUFR LENGTH 
      STA CLGTH           AND SAVE
* 
      JSB OUTPT           GO OUTPUT AUTO ADDR REMOT CMNDS 
      JMP RTN1            EXIT
* 
      SKP 
******************************************************************
*                 *                                              *
*     GO TO LOCAL *       CALL GTL(LU)                           *
*                 *                                              *
*                 *       WHERE: LU = SESSION LU AUTO ADDRESSING *
*                 *                 OR DIRECT I/O SESSION LU IN  *
*                 *                 RANGE 1-63.                  *
*                 *                                              *
*                 *      GTL (DEVLU) UNT,UNL,DEVLSN,GTL          *
*                 *      GTL (BUSLU) GTL                         *
******************************************************************
GTL   NOP 
      JSB SET             RETRIEVE VALID PARAMETERS 
* 
      JSB IOSTA           GET I/O STATUS
* 
      JSB SUBCH           GET SUBCHANNEL
* 
      SZA,RSS             SUBCHANNEL=0? 
      JMP GTL1            YES(DIRECT I/O MODE)
* 
* 
*     GTL - AUTO ADDRESSING MODE
* 
* 
      JSB CNTL            NO,FORM AUTO ADDR CTL WORD
* 
      LDA UNTLK           LOAD UNT,UNL COMMANDS 
      STA CBUFR           SAVE IN FIRST OF AUTO ADDR CMND BUFR
* 
      LDA T3              FETCH SUBCHANNEL
      ALF,ALF             POSITION TO UPPER BYTE. 
      IOR LSGTL           COMBINE WITH LSN,GTL
      STA CBUFR+1         STORE IN SECOND WORD OF AUTO ADDR CMND BUFR 
* 
      LDA M4              LOAD AUTO ADDR CMND BUFR LENGTH 
      STA CLGTH           AND SAVE
* 
      JSB OUTPT           GO OUTPUT AUTO ADDR GTL CMNDS 
      JMP RTN1            EXIT
* 
* 
*     GTL - DIRECT I/O MODE 
* 
* 
GTL1  JSB CNTL            FORM DIRECT I/O CTL WORD
* 
      LDA GOLOC           LOAD GTL COMMAND
      STA CBUFR           AND SAVE IN DIRECT I/O CMND BUFR
* 
      LDA M1              LOAD DIRECT I/O CMND BUFR LENGTH
      STA CLGTH           AND SAVE
* 
      JSB OUTPT           GO OUTPUT DIRECT I/O GTL COMMANDS 
      JMP RTN1            EXIT
* 
      SKP 
******************************************************************
*                     *                                          *
*     LOCAL LOCK OUT  *   CALL LLO(BLU)                          *
*                     *                                          *
*                     *  WHERE: BLU=DIRECT I/O SESSION LU        *
*                     *         IN RANGE 1-63.                   *
******************************************************************
LLO   NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      JSB IOSTA         GET I/O STATUS
* 
      JSB SUBCH         GET SUBCHANNEL
* 
      SZA               SUBCHANNEL=0? 
      JMP LOSE          NO,INVALID SESSION LU,EXIT WITH ERROR 
* 
      JSB CNTL          YES,FORM DIRECT I/O CTL WORD
* 
      LDA LLOCK         LOAD LLO COMMAND AND
      STA CBUFR         AND SAVE IN DIRECT I/O CMND BUFR
* 
      LDA M1            LOAD COMMAND BUFR LENGTH
      STA CLGTH         AND SAVE
* 
      JSB OUTPT         GO OUTPUT DIRECT I/O LLO CMNDS
      JMP RTN1          EXIT
* 
      SKP 
******************************************************************
*                 *                                              *
*     LOCAL       *     CALL LOCL(BLU)                           *
*                 *     WHERE: BLU=DIRECT I/O SESSION LU IN RANGE*
*                 *                OF 1-63.                      *
*                 *                                              *
******************************************************************
LOCL NOP
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      JSB IOSTA         GET I/O STATUS
* 
      JSB SUBCH         GET SBCHANNEL 
* 
      SZA               SUBCHANNEL=0? 
      JMP LOSE          NO,INVALID SESSION LU,EXIT WITH ERROR 
* 
      LDA CTL17         YES(DIRECT I/O),LOAD CONTROL REQUEST CODE 
      IOR LU            MERGE SESSION LU
      STA CTLWD         AND SAVE IN DIRECT I/O CONTROL WORD 
* 
      JSB CTLR1         MAKE LOCAL ENABLE CONTROL REQUEST 
      JMP RTN1          EXIT
* 
      SKP 
******************************************************************
*                     *                                          *
*    DYNAMIC STATUS   * CALL STATS(LU,I)                         *
*                     *                                          *
*                     * WHERE: LU = SESSION LU AUTO ADDRESSING   *
*                     *           OR DIRECT I/O SESSION LU IN    *
*                     *           RANGE 1-63. 
*                     *         I=DEVICE/BUS STATUS RETURNED     *
*                     *           IN LOWER BYTE                  *
*                     *                                          *
******************************************************************
STATS NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      LDA CTL6          LOAD CONTROL REQUEST CODE 
      IOR LU            MERGE SESSION LU
      STA CTLWD         AND SAVE IN CONTROL WORD
* 
STAT  ADB .3            INCREMENT EQT ADDRESS TO WORD 4 
      LDA 1,I           LOAD EQT WORD 4 
      AND BIT14         ISOLATE BUFFERING BIT 14
      SZA,RSS           BIT 14=0? 
      JMP STAT1         YES(UNBUFFERED),GO MAKE STATUS REQUEST
* 
      XOR 1,I           NO(BUFFERED),FORCE UNBUFFERED,SET BIT14=0 
      STB T3            SAVE EQT WORD 4 ADDRESS 
      STA T4            SAVE NEW UNBUFFERED EQT WORD 4
* 
      JSB BUFCG         STORE UNBUFFERED EQT WORD 4 
* 
      CCA               SET FLAG TO RESET BIT 14 LATER
      STA T2            AND SAVE
* 
STAT1 JSB CTLR1          MAKE STATUS CONROL REQUEST 
* 
*     (A)=STATUS WORD 
* 
      AND B377           MASK LOWER STATUS BYTE 
      STA CPAR2,I        STORE STATUS BYTE IN USER BUFFER 
* 
      ISZ T2             EQT MODIFIED?
      JMP RTN1           NO,EXIT
      LDA T3,I           YES,LOAD EQT WORD 4
      IOR BIT14          RESET BUFFER BIT 14
      STA T4             AND SAVE 
* 
      JSB BUFCG          RESTORE BUFFERING IN EQT WORD 4
      JMP RTN1           EXIT 
* 
      SKP 
**********************************************************************
*                *                                                   *
*     PPOLL      *       CALL PPOLL(LU,I,ASGN)                       *
*                *                                                   *
*                *       WHERE: LU = SESSION LU AUTO ADDRESSING      *
*                *                 OR DIRECT I/O SESSION 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.               *
*                *                                                   *
*                *                 POSITIVE INTEGER INDICATES A      *
*                *                 ZERO RESPONSE AND A NEGATIVE      *
*                *                 INTEGER INDICATES A ONE RESPONSE  *
*                *                 TO A PARALLEL POLL.               *
*                *                                                   *
*                * PPOLL(DEVLU,1,A) UNT,UNL,LSN,PPC,PPE              *
*                * PPOLL(BUSLU,1,A) PPC,PPE                          *
*                * PPOLL(DEVLU,2,A) UNT,UNL,LSN,PPC,PPD              *
*                * PPOLL(BUSLU,2,A) PPC,PPD                          *
**********************************************************************
PPOLL NOP 
      JSB SET            RETRIEVE VALID PARAMETERS
* 
      LDA CPAR2,I        LOAD FUNCTION
      CPA .1             I=1? 
      JMP PPOL1          YES(PPE) 
      CPA .2             NO,I=2?
      JMP PPOL2          YES(PPD) 
      CPA .3             NO,I=3?
      JMP PPOL4          YES(PPU) 
      JMP LOSE           NO,INVALID FUNCTION,EXIT WITH ERROR
* 
PPOL1 LDA CPAR3,I        I=1,LOAD ASSIGNMENT PARAMETER
      SZA,RSS            ASSIGNMENT=0?
      JMP LOSE           YES,INVALID ASSIGNMENT,EXIT WITH ERROR 
* 
      SSA,RSS            NO,IS ASSIGNMENT NEGATIVE? 
      JMP *+2            NO,ASSIGNMENT IS POSITIVE
* 
      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
* 
      ADA .8              ADD EIGHT TO ASSIGNMENT 
      IOR PPCE            MERGE DATA LINE AND PPC,PPE CMNDS 
* 
      LDB CPAR3,I         LOAD ASSIGNMENT AGAIN 
      SSB                 IS ASSIGNMENT POSITIVE? 
      IOR .8              NO,SET BIT 3 IN COMMAND WORD
      STA CBUFR           YES,SAVE FIRST COMMAND WORD 
      JMP *+3 
* 
PPOL2 LDA PPCD            LOAD PPC,PPD COMMANDS 
      STA CBUFR           AND SAVE IN COMMAND WORD
* 
      JSB IOSTA           GET I/O STATUS REQUEST
* 
      JSB SUBCH           GET SUBCHANNEL
* 
      SZA,RSS             SUBCHANNEL=0? 
      JMP PPOL3           YES(DIRECT I/O MODE)
* 
* 
*     PPOLL - AUTO ADDRESSING MODE (PPE,PPD)
* 
* 
      JSB CNTL            NO,FORM AUTO ADDR CTL WORD
* 
      LDA CBUFR           LOAD SECOND COMMAND WORD
      AND B377            MASK TO GET PPE OR PPD
      ALF,ALF             POSITION TO UPPER BYTE. 
      STA CBUFR+2         SAVE AS LAST BYTE.
* 
      LDA CBUFR 
      AND H8              MASK TO GET CONFIGURED PPE. 
      IOR T3              COMBINE WITH SUBCHANNEL.
      IOR NULSN           COMBINE WITH NUL,LSN
      ALF,ALF             POSITION BYTES (LSN FIRST)
      STA CBUFR+1         AND STORE IN SECOND WORD OF CMND BUFR 
* 
      LDA UNTLK           LOAD UNT,UNL COMMANDS 
      STA CBUFR           AND SAVE IN FIRST WORD OF CMND BUFR 
* 
      LDA M5               LOAD COMMAND BUFR LENGTH 
      STA CLGTH            AND SAVE 
* 
      JSB OUTPT            GO OUTPUT AUTO ADDR PPOLL CMNDS
      JMP RTN1             EXIT 
* 
* 
*     PPOLL - DIRECT I/O MODE (PPE,PPD) 
* 
* 
PPOL3 JSB CNTL             FORM DIRECT I/O CTL WORD 
* 
      LDA M2               LOAD DIRECT I/O CMND BUFR LENGTH 
      STA CLGTH            AND SAVE 
* 
      JSB OUTPT            GO OUTPUT DIRECT I/O PPOLL CMNDS 
      JMP RTN1
* 
* 
*     PPOLL - UNCONFIGURE (DIRECT I/O ONLY) 
* 
* 
PPOL4 JSB IOSTA            GET I/O STATUS 
* 
      JSB SUBCH            GET SUBCHANNEL 
* 
      SZA                  SUBCHANNEL=0?
      JMP LOSE             NO,INVALID SESSION LU,EXIT WITH ERROR
* 
      JSB CNTL             YES,FORM DIRECT I/O CTL WORD 
* 
      LDA PPU              LOAD PPU COMMAND 
      STA CBUFR            AND SAVE IN DIRECT I/O CMND BUFR 
* 
      LDA M1               LOAD DIRECT I/O CMND BUFR LENGTH 
      STA CLGTH            AND SAVE 
* 
      JSB OUTPT            OUTPUT DIRECT I/O PPOLL COMMANDS 
      JMP RTN1             EXIT 
* 
      SKP 
**********************************************************************
*                           *                                        *
*     PARALLEL POLL STATUS  *  CALL PSTAT(BLU,I)                     *
*                           *                                        *
*                           *  WHERE: BLU=DIRECT I/O SESSION 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 
* 
      JSB IOSTA         GET I/O STATUS
* 
      JSB SUBCH         GET SUBCHANNEL
* 
      SZA               SUBCHANNEL=0? 
      JMP LOSE          NO,INVALID SESSION LU,EXIT WITH ERROR 
* 
      LDA B3000         YES,LOAD PARALLEL POLL REQUEST CODE 
      IOR LU            MERGE SESSION LU
      STA CTLWD         AND SAVE IN DIRECT I/O CONTROL WORD 
* 
      JMP STAT          INITIATE PARALLEL POLL STATUS REQUEST 
* 
      SKP 
******************************************************************* 
*                  *                                              * 
*     CONFIGURE    *    CALL CNFG(LU,I,IW)                        * 
*                  *                                              * 
*                  *    WHERE: LU = SESSION LU AUTO ADDRESSING    * 
*                  *              OR DIRECT I/O SESSION LU IN     * 
*                  *              RANGE OF 1-63.
*                  *                                              * 
*                  *            I=FUNCTION CODE                   * 
*                  *            I=1,CONFIGURATION REQUEST         * 
*                  *            I=2,UNCONFIGURE REQUEST           * 
*                  *                                              * 
*                  *           IW=DEVICE/BUS CONFIGURATION WORD   * 
*                  *                                              * 
******************************************************************* 
CNFG  NOP 
      JSB SET           RETRIEVE VALID PARAMETERS 
* 
      LDA CPAR2,I       LOAD FUNCTION 
      CPA .1            I=1?
      JMP CNFG1         YES(CONFIGURE REQUEST)
      CPA .2            NO,I=2? 
      JMP CNFG2         YES(UNCONFIGURE REQUEST)
      JMP LOSE          NO,INVALID FUNCTION,EXIT WITH ERROR 
* 
CNFG1 LDA CTL25         LOAD CONFIGURE REQUEST CODE 
      IOR LU            MERGE SESSION LU
      STA CTLWD         AND SAVE IN CONTROL WORD
* 
      LDA CPAR3,I       PUT CONFIGURATION WORD IN CONTROL 
      STA CBUFR          BUFFER.
* 
      JSB CTLR2         MAKE CONFIGURE CONTROL REQUEST
      JMP RTN1          EXIT
* 
CNFG2 LDA CTL27         LOAD UNCONFIGURE REQUEST CODE 
      IOR LU            MERGE SESSION LU
      STA CTLWD         AND SAVE IN CONTROL WORD
* 
      JSB CTLR1         MAKE UNCONFIGURE CONTROL REQUEST
      JMP RTN1          EXIT
* 
      SKP 
********************************************************************
*                *                                                 *
*     ABORT      *      CALL ABRT(BLU,I)                           *
*                *                                                 *
*                *      WHERE: BLU=DIRECT I/O SESSION 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 
* 
      JSB IOSTA         GET I/O STATUS
* 
      JSB SUBCH         GET SUBCHANNEL
* 
      SZA               SUBCHANNEL=0? 
      JMP LOSE          NO,INVALID SESSION LU,EXIT WITH ERROR 
* 
      LDA LU            YES(DIRECT I/O),LOAD SESSION LU 
      STA CTLWD         AND SAVE IN DIRECT I/O CONTROL WORD 
* 
      LDA CPAR2,I       LOAD FUNCTION 
      CPA .1            I=1?
      JMP ABRT1         YES 
      CPA .2            NO,I=2? 
      JMP ABRT2         YES 
      CPA .3            NO,I=3? 
      JMP ABRT3         YES 
      JMP LOSE          NO,INVALID FUNCTION,EXIT WITH ERROR 
* 
ABRT1 LDA .1            LOAD CTL REQ PARAMETER
      JMP *+2 
* 
ABRT2 CLA 
      STA CBUFR         AND SAVE IN CONTROL BUFFER. 
* 
      JSB CTLR2         MAKE ABORT CONTROL REQUEST
* 
      JMP RTN1          EXIT
* 
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 OUTPT         OUTPUT UNT,UNL CMNDS
      JMP RTN1          EXIT
* 
      SKP 
********************************************************************
*                      *                                           *
* READ AND WRITE WITH  * CALL SECR (LU,ISEC,IBUF,ILNG)             *
*  SECONDARY ADRRESSING* CALL SECW (LU,ISEC,IBUF,ILNG)             *
*                      * WHERE:                                    *
*                      *  LU = BLU OR DLU                          *
*                      *  ISEC = SECONDARY ADDRESS 0-31            *
*                      *  IBUF = DATA BUFFER                       *
*                      *  ILNG = LENGTH OF BUFFER IN               *
*                      *         WORDS IF >0 OR BYTES IF <0.       *
********************************************************************
* 
SECWR EQU *          ENTRY POINT FOR BASIC REAL READ. 
SECW  NOP             ENTRY POINT FOR BASIC INTEGER WRITE.
      JSB SET         ALSO ENTRY POINT FOR FORTRAN. 
      LDB .2        SET FOR WRITE.
      JMP SCS 
* 
* 
SECRR EQU *           ENTRY POINT FOR BASIC REAL READ.
SECR  NOP             ENTRY POINT FOR BASIC INTEGER READ. 
      JSB SET         ALSO ENTRY POINT FOR FORTRAN. 
      LDB .1       SET FOR READ.
* 
SCS   STB ICODE     SET CODE FOR READ OR WRITE. 
* 
      LDA CPAR3     FETCH DATA BUFFER ADDRESS.
      STA DBUFR     SET ADDRESS FOR I/O CALL. 
* 
      LDA CPAR4,I   FETCH DATA BUFFER LENGTH. 
      STA DLGTH     SET VALUE FOR I/O CALL. 
* 
* 
* 
      LDA CPAR2,I    FETCH SECONDARY ADDRESS. 
      AND B37        LIMIT TO 0 TO 31 
      CPA CPAR2,I 
      JMP *+2 
      JMP LOSE       ERROR EXIT WHEN OUTSIDE OF LIMITS. 
* 
      IOR SEC        SET UPPER BITS FOR SEC. ADDRS. 
* 
      STA CBUFR      STORE SEC AS 1ST OPT PARA. 
SCIO  JSB CNDIO      DO SECONDARY I/O REQUEST.
* 
      JMP RTN1       EXIT 
      SKP 
      SKP 
**************************
************************ *
* *                    * *
* *     SUBROUTINES    * *
* *                    * *
************************ *
**************************
* 
**********************************************
*                                            *
*     SUBROUTINE TO EXIT UTILITY LIBRARY     *
*                                            *
**********************************************
RTN   DST ANB          SAVE REGS
RTN1  LDA .0A 
      STA CPAR2 
      STA CPAR3 
      STA CPAR4 
      DLD ANB          RESTORE REG.S
      JMP XIT,I 
* 
**********************************************************
*                                                        *
*     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
      JMP SET1
* 
* 
CPAR1 DEF *         FIRST PARAMETER 
CPAR2 DEF *         SECOND PARAMETER
CPAR3 DEF .0        THIRD PARAMETER 
CPAR4 DEF .0        FOURTH PARAMETER
* 
* 
XIT   NOP 
SET1  JSB .ENTR     RETRIEVE PARAMETERS 
       DEF CPAR1
      LDA CPAR1,I   LOAD FIRST PARAMETER
      AND B77      MASK SESSION LU
      STA LU       AND SAVE 
* 
      JSB LUTRU    GET SESSION LU.
      DEF *+3      SYSTEM LU IS RETURNED IN A REGISTER AND
      DEF LU       ALSO STORED FOR USE LATER. 
      DEF LUT 
* 
      CPA M1       DOES SESSION LU MAP TO SYSTEM LU?
      JMP LOSE     NO. EXIT WITH ERROR MESSAGE. 
* 
      CMA,INA      YES. CONVERT TO NEGATIVE SYSTEM LU.
      ADA LUMAX    ADD TO LAST CONFIGURED SYSTEM LU 
      SSA          VALID SYSTEM LU? 
      JMP LOSE      NO,EXIT WITH ERROR MESSAGE
      LDA DRT       YES,LOAD DRT TABLE ENTRY ADDRESS
      ADA LUT      INDEX TO APPROPRIATE 
      ADA M1       DRT ENTRY
      LDA 0,I      LOAD DRT ENTRY 
      SZA,RSS      ENTRY=0? 
      JMP RTN1      YES,EXIT(IGNORE BIT BUCKET) 
      STA T2        NO,SAVE DRT ENTRY 
      AND B77      MASK EQT#
      ADA M1       INDEX TO 
      MPY .15      APPROPRIATE
      ADA EQTA     EQT TABLE 
      LDB 0        LOAD EQT ADDRESS INTO B-REG
      ADA .4       INDEX TO EQT WORD 5
      LDA 0,I      LOAD EQT WORD 5
      STA T1       AND SAVE 
      ALF,ALF      SHIFT AND
      AND B77      MASK DEVICE TYPE 
      CPA B37      DEVICE TYPE=37?
      JMP SET,I     YES,RETURN(B-REG=EQT ADDRESS) 
* 
******************************************************
*                                                    *
*     ERROR SUBROUTINE - INDICATES BAD PARAMETER     *
*                                                    *
******************************************************
LOSE  LDA .0A       LOAD ZERO 
      STA CPAR2     SET PARAMETERS
      STA CPAR3     TO ZERO 
* 
      JSB EXEC
       DEF *+5
       DEF .2       WRITE "ILL RQ-HPIB" MESSAGE 
       DEF .1 
       DEF MSGA 
       DEF .12
* 
      JSB EXEC
       DEF *+2      AND QUIT
       DEF .6 
* 
************************************************
*                                              *
*     SUBROUTINE FOR RETRIEVING SUBCHANNEL     *
*                                              *
************************************************
SUBCH NOP 
      LDA T3        LOAD STATUS WORD THREE
      AND B37       MASK SUBCHANNEL 
      STA T3        AND SAVE
      JMP SUBCH,I 
* 
************************************************
*                                              *
*     SUBROUTINE FOR FORMING CONTROL WORD      *
*        FOR DOUBLE BUFFER I/O REQUEST         *
*                                              *
************************************************
CNTL  NOP 
      LDA LU        LOAD SESSION LU 
      IOR BIT12     MERGE DIRECT I/O BIT 12 
      STA CTLWD     AND SAVE
      JMP CNTL,I
* 
************************************************
*                                              *
*     SUBROUTINE FOR I/O STATUS EXEC CALL      *
*                                              *
************************************************
IOSTA NOP 
      JSB EXEC
       DEF *+6
       DEF .13
       DEF LU 
       DEF T1 
       DEF T2 
       DEF T3 
      JMP IOSTA,I 
* 
******************************************************* 
*                                                     * 
*     SUBROUTINE FOR EXEC WRITE REQUEST TO DVR37      * 
*     WITH COMMAND BUFFER ONLY.                       * 
*                                                     * 
******************************************************* 
OUTPT NOP 
      JSB EXEC
       DEF *+7
       DEF .2 
       DEF CTLWD
       DEF .0 
       DEF .0 
       DEF CBUFR
       DEF CLGTH
       DST ANB
      JMP OUTPT,I 
* 
********************************************************************
*                                                                  *
*     SUBROUTINE FOR EXEC READ OR WRITE                            *
*     WITH DATA BUFFER ONLY.                                       *
*                                                                  *
********************************************************************
CNDIO NOP 
      LDA LU         SET  LU IN CONTROL WORD. 
      IOR B100        SET BIT FOR BINARY WITH EOR.
      STA CTLWD 
      JSB EXEC       SEND COMMAND AND DATA. 
      DEF *+7 
      DEF ICODE      1=READ, 2=WRITE. 
      DEF CTLWD      CONTROL WORD. BIT 12 AND LU. 
      DEF DBUFR,I    DATA BUFFER. 
      DEF DLGTH      LENGTH OF DATA BUFFER. 
      DEF CBUFR      FIRST OPTIONAL PARAMETER.
      DEF CLGTH      SECOND OPTIONAL PARAMETER. 
* 
      DST ANB        SAVE THE A AND B REGISTERS.
* 
      JMP CNDIO,I 
**************************************************************
*                                                            *
*     SUBROUTINE FOR CNTL REQ WITHOUT OPTIONAL PARAMETER     *
*                                                            *
**************************************************************
CTLR1 NOP 
      JSB EXEC
      DEF *+3 
      DEF .3
      DEF CTLWD 
      DST ANB 
      JMP CTLR1,I 
* 
*********************************************************** 
*                                                         * 
*     SUBROUTINE FOR CNTL REQ WITH OPTIONAL PARAMETER     * 
*                                                         * 
*********************************************************** 
CTLR2 NOP 
      JSB EXEC
       DEF *+4
       DEF .3 
       DEF CTLWD
       DEF CBUFR        CONTROL BUFFER WITH OPTIONAL PARAMETER. 
      DST ANB 
      JMP CTLR2,I 
* 
************************************************************* 
*                                                           * 
*     SUBROUTINE TO CLEAR OR RESET BUFFERING BIT 14 IN      * 
*     EQT WORD FOUR                                         * 
*                                                           * 
************************************************************* 
BUFCG NOP 
      JSB IPUT
       DEF *+3
       DEF T3 
       DEF T4 
      JMP BUFCG,I 
* 
******************************************************************* 
* 
*     UTILITY SUBROUTINE TO GET XLOG FROM BEQT
* 
*     JSB GBQT     WITH B REGISTER = ADDRESS OF FIRST EQT WORD. 
* 
*     BEQT7 IS RETURNED IN A REGISTER.
* 
******************************************************************* 
* 
GBQT  NOP           GET THE XLOG
      ADB .12 
      LDA 1,I       FIND EQTX AREA
      ELA,CLE,ERA 
      ADA LFEQX     FORM ADDR OF 1ST WORD PAST FXD EQTX.
      STA T4        SAVE ADDRESS. 
* 
      ADB M1
      LDA 1,I 
      ALF,ALF 
      AND B37       GET NUMBER OF ACTIVE DEVICES. 
* 
      SZA,RSS       TEST FOR NO CONFIGURED DEVICES. 
      JMP GBQTE     ERROR EXIT IF NO CONF. DEVICES. 
* 
      CMA,INA       FORM NEGATIVE FOR DOWN COUNTER. 
      STA T5        SAVE THE COUNT. 
* 
      LDA T2        RETRIEVE THE DRT ENTRY. 
      ALF,RAL 
      AND B37       EXTRACT THE SUBCHANNEL NUMBER.
      STA T3        SAVE THE SUBCHANNEL NUMBER. 
* 
      SZA           SUBCHANNEL = 0? 
      JMP GBQTA     NO. 
* 
      LDB T4        YES. GET 1ST ADDR PAST FXD EQTX.
      ADB M1        BACK INTO ADDR OF BUS XLOG. 
* 
      LDA 1,I       GET THE BUSS XLOG.
* 
      JMP GBQT,I    RETURN TO CALLONG ROUTINE.
* 
GBQTA LDB T4
* 
GBQTB ISZ T5        END OF CONFIGURED DEVICES?
      JMP GBQTC     NO. 
* 
      JMP GBQTE     YES. ERROR EXIT.
* 
GBQTC LDA 1,I       GET BEQT1 
      AND B37       EXTRACT SUBCNANNEL. 
      CPA T3        DESIRED SUBCHANNEL? 
      JMP GBQTD     YES. GO GET STATUS AND EXIT.
* 
      ADB .7        NO.  GOTO NEXT DEVICE.
      JMP GBQTB 
* 
GBQTD ADB .6
      LDA 1,I       FETCH BEQT7 
* 
      JMP GBQT,I    RETURN TO CALLING ROUTINE.
* 
GBQTE LDA B1X6      FETCH CONFIGURATION ERROR CODE. 
      JMP GBQT,I
* 
* 
* 
      SKP 
* 
********************************
* **************************** *
* *                          * *
* *   CONSTANT STORAGE,ETC.  * *
* *                          * *
* **************************** *
********************************
      SUP 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.6    DEC 6 
.7    DEC 7 
.8    DEC 8 
.12   DEC 12
.13   DEC 13
.15   DEC 15
LFEQX DEC 18
M1    DEC -1
M2    DEC -2
M3    DEC -3
M4    DEC -4
M5    DEC -5
M6    DEC -6
M9    DEC -9
B37   OCT 37
B77   OCT 77
B100  OCT 100 
B2000 OCT 2000
B377  OCT 377 
B3000 OCT 3000
BIT12 OCT 10000 
BIT14 OCT 40000 
B1X6  OCT 100006    CONFIGURATION ERROR CODE. 
H8    OCT 177400    MASK FOR HIGH 8 BITS. 
RQ3   OCT 100003
CTL6  OCT 600 
CTL16 OCT 1600
CTL17 OCT 1700
CTL25 OCT 2500
CTL27 OCT 2700
NULSN OCT 40
DCL   OCT 12000 
GET   OCT 4000
GOLOC OCT 400 
LLOCK OCT 10400 
PPCD  OCT 2560
PPCE  OCT 2540
PPU   OCT 12400 
SDC   OCT 2000
LSGTL OCT 20001       LSN,GTL 
LSSDC OCT 20004       LSN,SDC 
LSGET OCT 20010       LSN,GET 
UNLSN OCT 37440       UNL,LSN 
TKLSN OCT 40040       TLK,LSN 
UNTLK OCT 57477       UNT,UNL 
SEUNL OCT 60077       SEC,UNL 
SEUNT OCT 60137       SEC,UNT 
SEC   OCT 140         SEC 
* 
.0A   DEF .0
* 
LUT   BSS 1         SYSTEM LU 
LU    BSS 1         SESSION LU
ANB   BSS 2         SAVE OF A AND B REGISTER. 
ICODE BSS 1         REQUEST CODE. 1=READ, 2=WRITE, 3=CNTRL
CTLWD BSS 1         CONTROL WORD. CONTROL BITS & LU.
DBUFR BSS 1         DATA BUFFER ADDRESS.
DLGTH BSS 1         DATA BUFFER LENGTH. 
CBUFA DEF *+1       ADDRESS OF CONTROL BUFFER.
CBUFR BSS 4         CONTROL BUFFER. 
CLGTH BSS 1         CONTROL BUFFER LENGTH.
* 
T1    NOP 
T2    NOP 
T3    BSS 1 
T4    BSS 1 
T5    BSS 1 
T6    BSS 1 
* 
MSGA  ASC 12,ILL RQ-HPIB PROG ABORTED 
* 
SIZE  EQU * 
      END