ASMB,R,L,C
      NAM DCOPL,7  09580-16134 REV.2001 791023
* 
*---------------------------------------------------------------
* 
*     RELOC.     09580-16134
*     SOURCE     09580-18134
* 
*     M.KAESSNER    REV.A   770301
*     BOB RICHARDS  791023  (NAME CHANGE FROM DCVPL)
* 
*     HP 92425B TEST SYSTEM SOFTWARE IS THE PROPRIETARY 
*     MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND 
*     DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT. 
* 
*     (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 
*     ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM 
*     MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED
*     TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR 
*     WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. 
* 
*---------------------------------------------------------------
* 
      ENT DCOPL,XCOPL 
      EXT .ENTR,EXEC,ISN,LUDV,ERROR 
* 
* 
A     EQU 0 
B     EQU 1 
      SPC 2 
*    CALL DCOPL(U)
*    CALL XCOPL(LU,IERMS,U) 
*        WHERE: 
*               LU = LOGICAL UNIT OF THE 61XX 
*               IERMS = 5 WORD ERROR MESSAGE BLOCK
*                       IERMS(1) = 0 NO ERROR 
*                                = 3 POWER SUPPLY READ ERROR
*                       IERMS(2-5) ARE ONLY SET ON ERROR
*                       IERMS(2) = 5, THE CHARACTER COUNT 
*                       IERMS(3-5)= ASCII "DCOPL "
*               U = EIGHT ELEMENT INTEGER ARRAY. THE UNIT NUMBERS 
*                   WHICH HAVE CURRENT/VOLTAGE LIMITED FOLLOWED BY A "0"
*                   ARE PLACED IN THIS ARRAY.  IF ALL EIGHT UNITS 
*                   CURRENT/VOLTAGE LIMITED, THERE IS NO TRAILING "0".
* 
* 
* 
*     THIS DEVICE SUBROUTINE IS USED TO POLL THE 61XX BUSS TO 
* DETERMINE WHICH UNIT(S) HAVE CURRENT/VOLTAGE LIMITED.  IT IS INTENDED 
* TO BE USED IN CONJUNCTON WITH THE TRAP SET ROUTINE, "DVINT". WHEN 
* A TRAP OCCURS ON THE LU OF THE 61XX BUSS, THIS WOULD BE THE FIRST CALL
* IN THE TRAP RESPONSE SUBROUTINE.  AFTER THE UNIT WHICH HAS CURRENT/ 
* VOLTAGE LIMITED HAS BEEN DETERMINED, THE POWER SUPPLY CAN BE TURNED 
* OFF.   EXAMPLE: 
* 
*      5 DIM V(8) 
*     10 DIM U(8) 
*     20 TRAP 7 GOSUB 9000
*         : 
*         : 
*    100 LET V(1) = 6140
*    110 LET V(2) = 6130
* 
*         : 
* 
*         : 
* 
*     9000 CALL DCOPL(U(1)) 
*     9001 FOR I=1 TO 8 
*     9002 IF U(I)=0 THEN 9015
*     9003 IF V(I)=6140 GOTO 9010 
*     9004 CALL DCV(U(I),0.0,0.0) 
*     9005 PRINT"POWER SUPPLY #";U(I);" CURRENT LIMITED"
*     9006 GOTO 9015
*     9007 REM  LINES 9003,9006,9010,9011 NOT NEEDED IF NO DCS IS 
*     9008 REM  CONFIGURED INTO THE SYSTEM. 
*     9010 CALL DCI(U(I),0.0,0.0) 
*     9011 PRINT"POWER SUPPLY #";U(I);" VOLTAGE LIMITED"
*     9015 NEXT I 
*     9020 RETURN 
* 
* 
* 
      SKP 
* 
*     FRIENDLY VERSION
* 
UNITS NOP 
DCOPL NOP 
      JSB .ENTR 
      DEF UNITS 
      SPC 1 
      LDA .10       SET ERROR CODE
      STA ERBF       IN THE ERROR BUFFER
      JSB ISN       GET STATION 
      DEF *+1        NUMBER 
      STA STATN 
      SPC 1 
      JSB LUDV      GET LU OF 61XX
      DEF *+1+2 
      DEF STATN     STATION NUMBER
      DEF .22       DEVICE TYPE "22"
      SZA,RSS       IF LU=0 
      JMP ERR         ERROR!
      STA LU
      SPC 1 
      JSB XCOPL     CALL UN-FRIENDLY VERSION
      DEF *+1+3 
      DEF LU
      DEF ERBF
      DEF UNITS,I 
      LDA ERBF      CHECK FOR ERRORS
      SZA,RSS         ANY?
      JMP DCOPL,I     NO,EXIT 
      SPC 2 
ERR   JSB ERROR     CALL ERROR
      DEF *+1+2 
      DEF ERBF
      DEF ERCNT 
      JMP DCOPL,I   EXIT
      SKP 
*     UN-FRIENDLY VERSION 
* 
LUN   NOP 
ERAD  NOP 
UNITZ NOP 
XCOPL NOP 
      JSB .ENTR 
      DEF LUN 
* 
*     READ STATUS 
* 
      LDA LUN,I     CONFIGURE CONWD 
      ADA B300
      STA LU        STORE FOR EXEC CALL 
      JSB EXEC      READ ONE WORD 
      DEF *+1+4       FROM DRIVER 
      DEF ICODE 
      DEF LU
      DEF STATS 
      DEF .1
      JMP ER        ERROR RETURN
* 
*     CHECK UNITS 
* 
      CLA 
      STA ERAD,I    NO MORE ERRORS NOW
      LDA .1
      STA PTR       INITIALIZE POWER SUPPLY COUNT 
      LDA M8
      STA CNT       INITIALIZE LOOP COUNT 
      LDB STATS     GET STATUS WORD 
SLOOP CLA           OUTPUT A ZERO INTO BUFFER 
      STA UNITZ,I    JUST IN CASE THIS IS THE LAST
      SLB           CURRENT LIMITED?
      JMP WRTE       YES,WRITE POWER # TO ARRAY 
NOCL  RBR           NO,POSITION NEXT BIT
      ISZ PTR       INCREMENT POWER SUPPLY NUMBER 
      ISZ CNT       INCREMENT LOOP COUNT, DONR? 
      JMP SLOOP      NO, DO IT AGAIN! 
      JMP XCOPL,I    EXIT 
      SPC 1 
WRTE  LDA PTR       GET POWER SUPPLY'S NUMBER 
      STA UNITZ,I   STORE IN USER'S ARRAY 
      ISZ UNITZ     INCREMENT NEXT ADDRESS
      JMP NOCL      GO BACK TO THE LOOP 
      SPC 2 
ER    LDA .3        INITIALIZE ERROR NUMBER 
      STA ERAD,I
      LDA ERAD      GET ERROR BUFFER ADDRESS
      INA            POINT TO COUNT 
      LDB M4
      STB CNT       INITIALIZE COUNT
      LDB ERPTR     INITIALIZE ADDRESS POINTER
      STB PTR 
ELOOP LDB PTR,I     CONFIGURE ERMSG 
      STB A,I 
      INA           BUMP DESTINATION ADDRESS
      ISZ PTR       BUMP SOURCE ADDRESS 
      ISZ CNT       BUMP COUNTER, DONE? 
      JMP ELOOP      NO, LOOP.
      JMP XCOPL,I    YES,EXIT!
      SKP 
* 
*     CONSTANTS AND VARIBLES
* 
LU    NOP 
STATN NOP 
ERBF  NOP           BEGINNING OF ERROR BUFFER 
ERCNT DEC 5         NUMBER OF CHARACTERS
      ASC 3,DCVOL   ERROR MESSAGE 
ERPTR DEF ERCNT     POINTER TO ERMSG
CNT   NOP 
PTR   NOP 
STATS NOP 
      SPC 2 
.1    DEC 1 
.10   DEC 10
.22   DEC 22
.3    DEC 3 
B300  OCT 300 
M4    DEC -4
M8    DEC -8
ICODE OCT 100001
      END 
      END$
                        