ASMB,R,L,C HED HPIBM, HP-IB RTE-L MESSAGE SUBROUTINE LIBRARY NAM HPIBM,7 92071-16242 REV 2041 800905 * * 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,IXGET,IXPUT * ******************************************************************* * * (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: 92071-16242 * SOURCE: 92071-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 * CTLAD 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 STA TBLAD SAVE DVT18 ADDRESS JSB IXGET GET DVT18 (STATUS) DEF *+2 DEF TBLAD 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 LUFLG NOP LU + CONFIGURATION BIT 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 JSB IXGET GET ERROR HANDLING WORD DEF *+2 DEF TBLAD MASK NOP SET OR ZERO BIT 14 IN DVT20 STA LUFLG TO ENABLE OR DISABLE ERROR HANDLING JSB IXPUT PUT WORD BACK INTO DVT20 DEF *+3 DEF TBLAD DEF LUFLG 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) STA PARM4 SAVE 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 SRQRQ LDA .3 SET REQUEST CODE IOR BIT15 ADD NO-ABORT BIT STA REQ SAVE IT JMP CTLAD DO IT * * SRQ(DLU,0,0) - CALL EXEC(3,21DLU) * SRQUN LDA CTL21 LOAD CONTROL REQUEST CODE UNSCH IOR LU MERGE LU STA CTLWD SAVE CONTROL WORD JMP SRQRQ 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 SRQRQ SCHEDULE "SRV.L" PROGRAM * SRV.N ASC 3,SRV.L TRAP NOP M16 DEC -6 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 UNSCH 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 STA TBLAD SAVE TABLE ADDRESS JSB IXGET GET XLOG DEF *+2 DEF TBLAD 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 STA TBLAD SAVE ADDRESS JSB IXGET GET ERROR BIT 0 DEF *+2 DEF TBLAD SLA ERRORS? JMP IBER1 YES CLA NO, ZERO A JMP XIT,I EXIT * IBER1 LDA DVTA GET DVT ADDRESS ADA .15 INDEX TO ERROR CODE ADDRESS STA TBLAD SAVE IT JSB IXGET GET ERROR CODE DEF *+2 DEF TBLAD 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 JSB IXGET GET DVT TABLE ADDRESS DEF *+2 DEF LUTA STA B 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 B ADD TO LAST CONFIGURED LU SSA VALID LU? JMP LOSE NO,EXIT WITH ERROR MESSAGE ADB LU INDEX TO APPROPRIATE ADB M1 DVT ADDRESS POINTER STB TBLAD SAVE IT JSB IXGET GET DVT ADDRESS DEF *+2 DEF TBLAD SZA,RSS ADDRESS=0? JMP XIT,I YES,EXIT(IGNORE BIT BUCKET) STA DVTA NO,SAVE DVT ADDRESS ADA .4 INDEX TO DVT WORD 5 STA TBLAD SAVE ADDRESS JSB IXGET GET DVT WORD 5 DEF *+2 DEF TBLAD ELA,CLE,ERA CLEAR SIGN BIT ADA .5 INDEX TO IFT WORD 6 STA TBLAD SAVE ADDRESS JSB IXGET GET INTERFACE TYPE DEF *+2 DEF TBLAD 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 LDB DVTA GET DVT ADDRESS ADB .22 INDEX TO DVT PARAMETER ($DVTP) STB TBLAD SAVE ADDRESS JSB IXGET GET FIRST DRIVER PARAMETER DEF *+2 DEF TBLAD CPA B36 BUS LU? CLA YES, RETURN A=0 JMP SET,I RETURN A=0 (BUS LU), A#0 (DEVICE LU) * LUTA DEF $LUTA * ****************************************************** * * * 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 NOP 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 .13 DEC 13 .15 DEC 15 .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