ASMB,R,Q,C
      HED HPIB, RTE BUS UTILITY 
      NAM HPIB,7 59310-16004 REV 1926 790516
* 
      ENT HPIB,SRQ,CMDR,CMDW
      ENT SRQSN,IBERR,IBSTS 
      EXT .ENTR,EXEC,SRQ.T,IPUT,LUTRU 
* 
*************************************************** 
*     (C) COPYRIGHT HEWLETT-PACKARD CO., 1975     * 
*               ALL RIGHTS RESERVED               * 
*************************************************** 
* 
*     HPIB - RTE BUS UTILITY
* 
*     RELOC:  59310-16004 
*     SOURCE: 59310-18006 
* 
*************************************************** 
*     1926 PCO
* 
*     PROBLEM: LU IS USED TO INDEX IN DRT. IN SESSION THE LU
*              PASSED TO ONE OF THESE SUBROUTINES IS NOT
*              NECESSARILY THE TRUE LU AND HENCE IS INVALID TO
*              USE FOR INDEXING THROUGH THE DRT. ALSO LU'S GREATER
*              THAN 77B ARE NOT HANDLED CORRECTLY.
*     SOLUTION: USE LIBRARY ROUTINE LUTRU TO GET TRUE LU
*              FOR PURPOSES OF INDEXING THROUGH THE DRT.
*              CHANGE THE LU MASK FROM B77 TO B377. 
******************************************************************* 
*     R.FAJARDO, 751017 
* 
EQTA  EQU 1650B 
DRT   EQU 1652B 
LUMAX EQU 1653B 
* 
*     HPIB CONTROL REQUESTS 
* 
*     CALL HPIB(LU,IFUN,IPARM)
* 
HPIB  NOP 
      JSB SET       RECOVER VALID PARMS 
      LDA CPAR2,I 
HPIB1 ASL 6 
      IOR LU        FORM CNTRL WORD 
      STA T1
      JSB EXEC      DO CONTROL REQ. 
       DEF *+4
       DEF .3        REQ.CODE 
       DEF T1        CNTRL WORD 
       DEF CPAR3,I   OPTIONAL PARM
      JMP RTN 
* 
      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 
* 
*     BASIC'S SRQ/TRAP SERVICE
* 
*     CALL SRQSN(LU,TRAP#)  -SET TRAP @LU 
* 
SRQSN NOP 
      JSB SET       GET PARMS & VALIDATE
      ADB .3         INDEX TO EQT WORD4 
      STB T3
      LDA 1,I           & 
      AND B77       EXTRACT CHANNEL 
      STA 1 
* 
      LDA T2        =DRT ENTRY
      ALF,RAL 
      AND B37       EXTRACT SUB-CHANNEL 
      SZA,RSS       SUB-CHAN=0? 
      JMP LOSE       YES, NOT AVAIL TO DIRECT I/O 
      ALF,ALF       POSITION TO HI BITS 
      IOR 1          & MERGE WITH CHANNEL 
      STA T1
* 
      LDA CPAR2,I   VALIDATE PARM2: 
      CMA,SSA,INA   TRAP #'S 1-16 
      SZA,RSS        ARE LEGAL
      JMP LOSE
      ADA .16 
      SSA 
      JMP LOSE       OTHERS LOSE
* 
      CCB 
      ADB SRQ.T     INDEX TO
      ADB CPAR2,I    INDICATED
      STB T2          TRAP #
      JSB IPUT      POST SUB-CHAN/CHAN
       DEF *+3
       DEF T2 
       DEF T1 
      LDA SRQ.P 
      STA CPAR3     =SRQ PROG NAME ADDR 
      LDB T3
      JMP SRQ1
* 
      SKP 
* 
*     SRQ SERVICE-SCHEDULE PROG 
* 
*     CALL SRQ(LU,16,"PROG")
* 
SRQ   NOP 
      JSB SET       RECOVER PARMS 
      LDA CPAR2,I 
      CPA B20 
      RSS 
      JMP HPIB1 
      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
      LDA B2000     BUILD CNTRL WORD
      IOR LU         =2000B+LU
      STA T1
      ISZ CPAR3      &MOVE BUFR BEYOND
      JSB EXEC      CALL DRIVER NOW 
       DEF *+4
       DEF RQ3       REQ.CODE-NO ABORT
       DEF T1        CNTRL WORD 
       DEF CPAR3     PROG NAME ADDR 
      CCB           IN CASE OF ERR
      ISZ T2         EQT MODIFIED?
      JMP RTN          NO, LEAVE
      STA T1           YES, SAVE REGS 
      STB T2            FOR USER
      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 
* 
*     ERROR STATUS FUNCTION 
* 
*     I=IBERR(LU) 
* 
IBERR NOP 
      JSB SET       GET PARMS & VALIDATE
      ADB .12 
      LDA 1,I       FIND EQTX AREA
      ELA,CLE,ERA 
      ADA .3        RETRIEVE XLOG WORD
      LDB 0,I 
      SSB           ERRS INDICATED? 
      JMP IBER1 
      CLA            NO,(A)=0 
      JMP RTN 
* 
IBER1 LDA T1        RECOVER ERR CODE
      AND B377
      SZA,RSS       DMA TROUBLES? 
      INA            YES, I/O ERR 
      JMP RTN       (A)=ERR CODE
* 
*     STATUS RECOVERY: I=IBSTS(LU)
* 
IBSTS NOP 
      JSB SET       GET LU & VALIDATE 
      LDA T1
      AND B377      (A)=STATUS BYTE 
* 
RTN   STA T1
RTN1  LDA .0A       CLEAR OPT. PARMS
      STA CPAR2 
      STA CPAR3 
      LDA T1
      JMP XIT,I     & LEAVE 
* 
      SKP 
*     GET PARMS & VALIDATE
* 
SET   NOP 
      LDA SET       RECOVER RETURN ADDR 
      ADA M2               &
      LDA 0,I       GET PARM LIST ADDR
      STA XIT 
      JMP SET1
* 
CPAR1 DEF * 
CPAR2 DEF * 
CPAR3 DEF .0        (OPTIONAL)
* 
XIT   NOP 
SET1  JSB .ENTR     GET PARMS 
       DEF CPAR1
      LDA CPAR1,I 
      AND B377      EXTRACT SESSION LU
      STA LU        SAVE SESSION LU 
* 
      JSB LUTRU     SET TRUE (SYSTEM) LU. 
      DEF *+3       SYSTEM LU IS RETURNED IN A REGISTER AND 
      DEF LU        ALSO STORED.
      DEF LUT 
* 
      CPA M1        DOES SESSION LU MAP TO SYSTEM LU? 
      JMP LOSE      NO. ERROR.
* 
      CMA,INA       YES. INSURE VALID SYSTEM LU.
      ADA LUMAX 
      SSA 
      JMP LOSE      WRONG!
      LDA DRT 
      ADA LUT       INDEX TO
      ADA M1         APPROPRIATE
      LDA 0,I        DRT ENTRY USING SYSTEM LU. 
      SZA,RSS 
      JMP RTN       (IGNORE BIT BUCKET) 
      STA T2           &
      AND B77       EXTRACT EQT # 
      ADA M1
      MPY .15       FIND EQT ADDR 
      ADA EQTA
      LDB 0 
      ADA .4        GET EQT WORD 5
      LDA 0,I          &
      STA T1        CHECK DEVICE TYPE 
      ALF,ALF 
      AND B77 
      CPA B37       HPIB? 
      JMP SET,I      OK, LEAVE, (B)=EQT ADDR
* 
LOSE  LDA .0A 
      STA CPAR2     CLEAR OPT.PARMS 
      STA CPAR3 
      JSB EXEC
       DEF *+5
       DEF .2 
       DEF .1       "ILL RQ-HPIB" 
       DEF MSGA 
       DEF .12
      JSB EXEC      & QUIT! 
       DEF *+2
       DEF .6 
* 
* 
*     STORAGE, ETC... 
* 
      SUP 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.6    DEC 6 
.12   DEC 12
.15   DEC 15
.16   DEC 16
M1    DEC -1
M2    DEC -2
M16   DEC -16 
B20   OCT 20
B37   OCT 37
B77   OCT 77
B377  OCT 377 
B2000 OCT 2000
BIT12 OCT 10000 
BIT14 OCT 40000 
RQ3   OCT 100003
* 
.0A   DEF .0
* 
LU    BSS 1 
LUT   BSS 1 
T1    EQU HPIB
T2    EQU CMDR
T3    EQU CMDW
T4    EQU IBERR 
T5    EQU IBSTS 
T6    EQU SET 
* 
SRQ.P DEF * 
      ASC 3,SRQ.P 
* 
MSGA  ASC 12,ILL RQ-HPIB PROG ABORTED 
* 
SIZE  EQU * 
      END 
                                                                                                                                                                                                                    