FTN4,L SUBROUTINE SCNSU(ICHAN,IF),09580-16359 REV.2001 790927 C C HP 3495 SCANNER DEVICE SUBROUTINE C C 09580-16359 RELOCATABLE C 09580-18359 SOURCE C C !=================================================! C ! ! C ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979 ! C ! ALL RIGHTS RESERVED ! C ! ! C ! NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, ! C ! REPRODUCED OR TRANSLATED INTO ANOTHER PROGRAM ! C ! LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF ! C ! THE HEWLETT-PACKARD COMPANY. ! C ! ! C !-------------------------------------------------! C ! ! C ! TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETY ! C ! MATERIAL OF THE HEWLETT-PACKARD COMPANY. ! C ! ! C ! THIS SOURCE DATA SHALL BE USED SOLELY IN ! C ! CONJUCTION WITH ELECTRONIC COMPUTER SYSTEMS ! C ! SUPPLIED TO THE USER BY HEWLETT-PACKARD. ! C ! ! C ! THIS PROPRIETARY DATA SHALL NOT BE COPIED OR ! C ! OTHERWISE REPRODUCED WITHOUT THE PRIOR WRITTEN ! C ! CONSENT OF HEWLETT-PACKARD, EXCEPT THAT ONE ! C ! COPY MAY BE MADE AND RETAINED BY THE USER FOR ! C ! ARCHIVE PURPOSES. ! C ! ! C ! THE USER SHALL NOT DISCLOSE THIS DATA TO ANY ! C ! THIRD PARTIES WITHOUT THE PRIOR WRITTEN CONSENT ! C ! OF HEWLETT-PACKARD. IN ADDITION, THE USER SHALL ! C ! USE AT LEAST THE SAME CARE AND SAFEGUARDS TO ! C ! PROTECT THIS DATA FROM UNAUTHORIZED USE OR ! C ! DISCLOSURE AS THE USER USES TO PROTECT ITS OWN ! C ! PROPRIETARY DATA. ! C ! ! C !=================================================! C C GENERAL: C -------- C C THE FOLLOWING DEVICE SUBROUTINES ARE USED C TO PROGRAM THE HP3495A SCANNER. C C HARDWARE REQUIRED: C ------------------ C A. HP3495A SCANNER. C B. HP59310 BUS INTERFACE KIT. C C JUMPER POSITION: C SW1-1 - 1 C SW1-2 TO SW1-8 - 0 C SW2-1 - 0 C SW2-2 - 0 C SW2-3 - 0 C SW2-4 - 0 C SW2-5 - 1 C SW2-6 - REN C SW2-7 - ICF C SW2-8 - CNX C C C. HP 21XX SERIES COMPUTER C C CONFIGURATION TABLE ENTRIES: C ---------------------------- C C R54,10,3 C U1 C 0 LOWEST CHANNEL ASSIGNED TO THIS BOX C 79 HIGHEST CHANNEL ASSIGNED TO THIS BOX C -1 TEMPORARY STORAGE FOR INITIALIZATION FLAG C C U2 C 80 C 139 C -1 C C U3 C 200 C 279 C -1 C C U4 C . C . C . C C UP TO 10 BOXES CAN BE PUT IN THE TABLE C FOR MORE INFORMATION SEE CALL STATEMENT EXPLANATION. C C TABLE ENTRIES: C -------------- C C SCNSU(I,I), OV=XX ENT=SCNSU, FIL=%SCNSU C C C C C CALLING SEQUENCE: C C CALL SCNSU(ICHAN,IF) C ---------------------- C C ICHAN IS THE CHANNEL NUMBER TO BE CLOSED. C IF IS THE FUNCTION: C IF=0 OPEN ALL CHANNELS (ICHAN IS IGNORED). C IF=1 CLOSE CHANNEL ICHAN. C C THE CHANNEL NUMBER ASSIGNMENTS MUST BE GIVEN IN THE C CONFIGURATION FILE. THE ENTRY MUST CONTAIN THREE C WORDS FOR EACH UNIT. A UNIT IS DEFINED AS ONE OR MORE C 3495A BOX ASSIGNED TO AN HPIB ADDRESS. ALL CHANNELS C WITHIN A UNIT MUST BE CONTIGUOUS. MULTIPLE MODULES C WITHIN A UNIT MAY HAVE THE SAME ADDRESS IF TWO OR MORE C SETS OF RELAYS ARE TO BE CLOSED SIMULTANEOUSLY. EACH UNIT C IS INTERNALLY ADDRESSED BETWEEN 0 AND 79 (DECIMAL). THE C ADDRESSING WITHIN THE SYSTEM SHOULD BE ASSIGNED SO THAT C THERE ARE NO DUPLICATE CHANNEL NUMBERS. (EXAMPLE: UNIT C 1 CONTAINS MODULES 0-9 AND 10-29. UNIT 2 CONTAINS MODULES C 0-19, 20-29, 30-39, AND 40-59. UNIT 1 COULD BE ADDRESSED AS C CHANNELS 0-29, AND UNIT 2 COULD BE ADDRESSED AS CHANNELS 30-89. C ADDRESSING CHANNEL 21 ACTIVATES SWITCH 21 IN UNIT 1. ADDRESSING C CHANNEL 48 ACTIVATES SWITCH 9 IN UNIT 2. C A -1 IN BOTH CHANNEL NUMBERS INDICATES THAT THERE ARE NO SWITCHES C ASSIGNED TO A PARTICULAR UNIT. UP TO TEN UNITS MAY BE DEFINED. C THE TABLE VALUES ARE AS FOLLOWS: C WORD 1: LOW CHANNEL NUMBER OR -1. C WORD 2: HIGH CHANNEL NUMBER OR -1. C WORD 3: -1. C ----------------------------------------------------- DIMENSION IERMS(5) DATA IERMS/10,5,2HSC,2HNS,2HU / DATA IDTN/54/ C C SET UP DEFAULT ERROR CONDITION C IERMS=10 C C GET STATION NUMBER C ISTN=ISN(IDUMY) C C CHECK FOR A UNIT 1 OF THIS DEVICE TYPE C LU=LUDV(ISTN,IDTN,1) IF(LU)800,800,10 C C IF WE HAVE A REAL LOGICAL UNIT, CALL THE DEVICE SUBROUTINE C 10 CALL XCNSU(ICHAN,IF,IERMS,ISTN) IF(IERMS.EQ.0)RETURN 800 CALL ERROR(IERMS,IERMS(2)) END SUBROUTINE XCNSU(ICHAN,IF,IERMS,ISTN),09580-16359 REV.2001 +790927 C C THIS IS THE ROUTINE WHICH ACTUALLY DOES THE WORK. C C THE PARAMETERS ARE: C ICHAN = THE SYSTEM CHANNEL NUMBER TO BE OPERATED UPON C (ASSIGNED DURING CONFIGURATION). C IF = THE FUNCTION CODE: C 0= OPEN ALL CHANNELS (ICHAN IS IGNORED). C 1= CLOSE CHANNEL ICHAN. C IERMS = THE ERROR MESSAGE BUFFER. ONLY THE FIRST C WORD IS CHANGED. C 0 = NO ERROR. C 1 = PARAMETER ERROR C 3 = UNDEFINED OR NON-EXISTENT CHANNEL NUMBER. C 4 = TIM ERROR. C 10 = ZERO LOGICAL UNIT NUMBER FOR UNIT 1 OR THE C LU FOR THE SELECTED CHANNEL DOES NOT EXIST. C ISTN = THE STATION NUMBER OF THE CURRENT PROGRAM. C DIMENSION IBUF(3) DATA IDTN/54/,ICLR/2HC / C C CHECK PARAMETERS C IF(IF.LT.0.OR.IF.GT.1)GO TO 300 C C SET UNIT NUMBER FLAG C IUNIT=-1 C C SEARCH THROUGH UP TO 10 UNITS C DO 10 JUNIT=1,10 CALL TIM(IDTN,JUNIT,1,IBUF,3,IERFG) C C IF TIM ERROR IS -3, IGNORE IT ELSE RETURN ERROR MESSAGE. C IF(IERFG.EQ.-3)GO TO 10 IF(IERFG.NE.0)GO TO 400 C C SEE IF ANY CHANNELS DEFINED FOR THIS BOX C IF(IBUF(1).LT.0.OR.IBUF(2).LT.0)GO TO 10 IF(ICHAN.GE.IBUF(1).AND.ICHAN.LE.IBUF(2))17,20 C C WE FOUND A UNIT - COMPUTE THE OFFSET (SWITCH NUMBER C WITHIN THE UNIT). C 17 IUNIT=JUNIT IOFST=ICHAN-IBUF(1) C C CHECK FOR LEGAL CHANNEL NUMBER C IF(IOFST.GT.79)GO TO 990 C C IF "IF" IS 0, OPEN ALL BOXES, ELSE OPEN ONLY THE C LAST ONE CLOSED. THIS IS STORED IN THE THIRD WORD C OF THE "TIM" TABLE: C -1 = NEVER INITIALIZED C 0 = OPEN C 1 = LAST BOX CLOSED. C C FAKE "NEVER INITIALIZED" IF OPEN ALL BOXES. C 20 IF(IF.EQ.0)IBUF(3)=-1 C C IF ALREADY OPEN, IGNORE IT C IF(IBUF(3).EQ.0)GO TO 10 C C GET LOGICAL UNIT NUMBER C LUN=LUDV(ISTN,IDTN,JUNIT) C C CHECK FOR NON-EXISTENT LOGICAL UNIT NUMBER C IF(LUN.LE.0)GO TO 10 C C OPEN THE BOX C CALL REIO(2,LUN,ICLR,-1) C C INDICATE THE BOX HAS BEEN OPENED. C IBUF(3)=0 CALL TIM(IDTN,JUNIT,2,IBUF,3,IERFG) IF(IERFG.LT.0)GO TO 400 10 CONTINUE C C IF FUNCTION IS "OPEN ALL BOXES", DON'T CLOSE ANY. C IF(IF.EQ.0)GO TO 2000 C C IF CHANNEL CLOSE REQUIRED, CHECK TO SEE IF A VALID C CHANNEL WAS FOUND (IUNIT NOT -1). C IF(IUNIT.EQ.-1)GO TO 990 CALL TIM(IDTN,IUNIT,1,IBUF,3,IERFG) IF(IERFG.NE.0)GO TO 400 C C CHECK FOR LU C LUN=LUDV(ISTN,IDTN,IUNIT) IF(LUN.LE.0)GO TO 1000 C C MUST BE OK - CONVERT ADDRESS TO ASCII C ITENS=IOFST/10 IONES=IOFST-ITENS*10+60B IADDR=256*(ITENS+60B)+IONES CALL REIO(2,LUN,IADDR,-2) C C SET SWITCH CLOSED FLAG C IBUF(3)=1 CALL TIM(IDTN,IUNIT,2,IBUF,3,IERFG) IF(IERFG.EQ.0)GO TO 2000 C C PARAMETER ERROR C 300 IERMS=1 GO TO 1000 C C TIM ERROR C 400 IERMS=4 GO TO 1000 C C NON-EXISTENT OR UNDEFINED CHANNEL OR LOGICAL UNIT C 990 IERMS=3 C C DEFAULT BAD RETURN - LEAVE ERROR CODE AT 10 C 1000 RETURN C C GOOD COMPLETION RETURN - ERROR CODE = 0 C 2000 IERMS=0 END END$