SPL,L,O 
!     NAME:   CNT.
!     SOURCE: 92067-18162 
!     RELOC:  92067-16125 
!     PGMR:   A.M.G.
! 
!  ***************************************************************
!  * (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 HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
       NAME CNT.(8) "92067-16125 REV.1940 790802" 
! 
! 
!     THE FOLLOWING IMPLEMENTS THE CONTROL COMMAND. 
! 
!     :CN [[[,NAMR][,FUNCTION][,SUB-FUNCTION]]] 
! 
       LET OPEN.,                           \OPEN FILE OR LU
           FCONT,                           \SEND CONTROL FUNCTION
           EXEC                             \SYSTEM I/O 
              BE SUBROUTINE,EXTERNAL
! 
       LET O.BUF,                           \DCB BUFFER 
           .E.R.,                           \GLOBAL ERROR RETURN
           N.OPL                            \SUB-PARAMETER STORAGE
              BE INTEGER,EXTERNAL 
! 
       LET PTR,EQWD5,NAMR,FUNC,FUNCT BE INTEGER 
       LET SUBF,SUBFN,FTAB,FTAB1 BE INTEGER 
       LET FTAB2 BE INTEGER (3) 
       LET FTAB3 BE INTEGER 
       LET FTAB4 BE INTEGER (9) 
       LET FTAB5,FTAB6 BE INTEGER 
! 
       INITIALIZE FTAB,FTAB1,FTAB2,FTAB3,FTAB4,FTAB5,\
          FTAB6 TO "RW",400K,"EO",100K,"TO",1100K,   \
          "FF",1300K,"BF",1400K,"FR",300K,"BR",200K, \
          "LE",1000K,0
! 
! 
CNT.:  SUBROUTINE(NUM,PLIST,ERR) GLOBAL 
       LET NUM,PLIST,ERR BE INTEGER 
       SUBFN _ [SUBF _ [FUNCT _ [FUNC _     \SET UP POINTERS
          [NAMR _ @PLIST + 1] + 3] + 1]     \AND, IF NECESSARY, 
          + 3] + 1
       IFNOT PLIST THEN $NAMR _ 8           !THE DEFAULT FOR NAMR.
       CALL OPEN.(O.BUF,$NAMR,N.OPL,10K)    !OPEN THE FILE OR LU. 
       IF .E.R. THEN GO TO ERR20            !NON TYPE-ZERO CHECK
       IFNOT $FUNC THEN GOTO DEFLT          !WAS FUNCTION SUPPLIED? 
       IF $FUNC = 3 THEN GOTO DCODE         !FUNCTION SUPPLIED.  IF 
       FUNC _ $FUNCT <- 6                   !NUMERIC, SHIFT TO
       GOTO SUBFU                           !PROPER POSITION. 
DCODE: NAMR _ @SUBF                         !IF ASCII, DECODE IT. 
TLOOP: IFNOT $[NAMR _ NAMR + 2] THEN [      \END OF TABLE?
PRMER:    ERR _ 56;  RETURN]                !PARAMETER ERROR. 
       IF  $FUNCT # $NAMR  THEN GOTO TLOOP  !MATCH? 
       FUNC _ $(NAMR+1)                     !YES - GET FUNCTION CODE. 
SUBFU: IFNOT $SUBF THEN $SUBFN _ -2         !DEFAULT SUBFN IF NEC.
       CALL FCONT(O.BUF,ERR,FUNC,$SUBFN)    !SEND THE CONT. FUNC. 
       IF ERR = -12 THEN ERR _ 0
       RETURN 
DEFLT: PTR _ @O.BUF + 3                     !FUNCTION NOT SUPPLIED. 
       CALL EXEC(100015K,$PTR,EQ5,NAMR,FUNC)!GET DEVICE TYPE. 
       GO TO ERR20                          !BAIL OUT IF ERROR ( NEVER HAPPEN)
       IF [EQ5 _ EQ5 AND 37400K] > 7000K THEN [ \IF TYPE > 16 
RWCD:      FUNC_FTAB1; GOTO SUBFU ]         !USE REWIND 
       IF EQ5 = 2400K THEN[                 \IF DVR05 CHECK 
          IF [FUNC _ FUNC AND 7] = 1 THEN GO TO RWCD; \IF CASSET USE REWIND 
          IF  FUNC               = 2 THEN GO TO RWCD] !IF CASSET USE REWIND 
       FUNC_$(PTR+1)                        !ELSE USE DEFAULT EOF 
       GO TO SUBFU
! 
ERR20: ERR _ 20;  RETURN                    !ILLEGAL LU ERROR.
       END
       END
       END$ 
                                          