ASMB,R,Q,C
      HED IB4A3, RTE4 HPIB UTILITIES ACCESSING SSGA ENT'S.
      NAM IB4A3,7 59310-1X014 REV 2026 800407 
* 
*     RELOC  59310-1X014  PHANTOM MODULE. 
*     SOURCE 59310-18014
* 
      ENT SRQSN 
      EXT .ENTR,EXEC,SRQ.T,IPUT,LUTRU 
* 
EQTA  EQU 1650B 
DRT   EQU 1652B 
LUMAX EQU 1653B 
* 
********************************************************************* 
*     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 
* 
      LDA CPAR2,I 
      STA TRP#      USE TRAP NUMBER AS PASSED VALUE.
      LDB T3
      JMP SRQ1
* 
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 LU        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 
****************************************************************
****************************************************************
* 
*     SUBROUTINES 
* 
****************************************************************
****************************************************************
* 
********************************************* 
* 
*     SUBROUNTINE TO EXIT UTILITY LIBRARY 
* 
********************************************* 
RTN   DST ANB 
RTN1  LDA .0A 
      STA CPAR2 
      STA CPAR3 
      DLD ANB 
      JMP XIT,I 
* 
**************************************************************
* 
*     SUBROUTNINE TO RETRIEVE PARAMETERS AND 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 
      IOR B2000     SET SRQ SETUP BIT IN CONTROL WORD.
      STA LU        CONTROL WORD. 
* 
      JSB LUTRU     SET TRUE (SYSTEM) LU. 
      DEF *+3       SYSTEM LU IS RETURNED IN A REGISTER AND 
      DEF CPAR1,I   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    BSS 1 
T2    BSS 1 
T3    BSS 1 
T4    BSS 1 
T5    BSS 1 
T6    BSS 1 
* 
CBUFA DEF *+1 
CBUFR BSS 4 
ANB   BSS 2 
SRQ.P DEF * 
      ASC 3,SRQ.P 
TRP#  BSS 1        TRAP NUMBER. MUST FOLLOW SRQ.P 
* 
MSGA  ASC 12,ILL RQ-HPIB PROG ABORTED 
* 
SIZE  EQU * 
      END 
            