FTN4,L
      PROGRAM TXWL0(3,89),91711-16019  REV 1926  790428 
C 
C 
C THIS TEST IS FOR CHECKOUT OF LINE PRINTERS USING DRIVER DVA12 OR DVB12
C 
C VARIABLE NAMES USED IN THIS PROGRAM ARE AS FOLLOWS: 
C     IBUF1-6...BUFFERS CONTAINING DATA TO BE PRINTED 
C     IQUE......INPUT FROM CRT TO ABORT OR CONTINUE PROGRAM 
C     IPRAM(1)..LOG DEVICE LU 
C     IPRAM(2)..TEST DEVICE LU
C     ILUL......PROGRAM NAME FOR LOG LU 
C     ILUT......PROGRAM NAME FOR TEST LU
C     MLU.......MASK OF ISTAT2 FOR CHECK IF LU IS ASSIGNED
C     MTYP......MASK OF ISTAT1 FOR DEVICE TYPE CHECK
C     MAV.......MASK OF ISTAT1 FOR DEVICE AVAILABILITY CHECK
C               AND STATUS
C     ISTAT1....EQT WORD 5
C     ISTAT2....EQT WORD 4
C     ISTAT3....WORD WHICH GIVES LU STATUS & SUBSHANNEL 
C     ISTR......BUFFER LOCATION FOR PROGRAMMABLE STATUS READ
C     IDOT......BUFFER LOCATION FOR DOT MATRIX & PING-PONG READ 
C     ITYPE.....INPUT FROM CRT FOR TYPE OF PRINTER
C     IT........A CONSTANT = 1 IF PRINTER IS A 2608A
C 
      DIMENSION IBUF1(40),IBUF2(40),IBUF3(41),IBUF4(40),IBUF5(40) 
     1,IBUF6(22),IQUE(1),IPRAM(5),ISTR(258),IDOT(1154),ITYPE(3) 
      DATA IBUF1/2HAB,2HCD,2HEF,2HGH,2HIJ,2HKL,2HMN,2HOP,2HQR,2HST, 
     12HUV,2HWX,2HYZ,2H01,2H23,2H45,2H67,2H89,2H!",2H #/
      DATA IBUF2/2H$%,2H'(,2H)-,2H=@,2H+*,2H<>,2H?;,2H:,,2H65,2H43,2H21,
     12H0A,2HBC,2HDE,2HFG,2HHI,2HJK,2HLM,2HNO,2HPQ/ 
      DATA IBUF3/2H0$,2H%&,2H'(,2H)-,2H=@,2H+*,2H<>,2H?;,2H:,,2H65,2H43,
     12H21,2H0A,2HBC,2HDE,2HFG,2HHI,2HJK,2HLM,2HNO,1HP/ 
      DATA IBUF4/2H*A,2H C,2H E,2H G,2H I,2H K,2H M,2H O,2H Q,2H S, 
     12H U,2H W,2H Y,2H 0,2H 2,2H 4,2H 6,2H 8,2H !,2H "/
      DATA IBUF5/2H B,2H D,2H F,2H H,2H J,2H L,2H N,2H P,2H R,2H T, 
     12H V,2H X,2H Z,2H 1,2H 3,2H 5,2H 7,2H 9,2H #,2H $/
      DATA IBUF6/2H1 ,2H  ,2H  ,2H  ,2H  ,2HTO,2HP ,2HOF,2H F,2HOR,2HM!/
      CALL RMPAR(IPRAM) 
      IT=0
C 
C ASSIGN LOG DEVICE LU
C 
      ILUL=IPRAM(1) 
      IF(IPRAM(1).LE.0) ILUL=LOGLU(IPRAM(1))
C 
C ASSIGN TEST DEVICE LU 
C 
      IF(IPRAM(2).LE.0) GOTO 8020 
   40 ILUT=IPRAM(2) 
C 
C*********************************************************************
C*                  SECTION 100 - GET LU AND VERIFY 
C*********************************************************************
C 
      CALL EXEC(13,ILUT,ISTAT1,ISTAT2,ISTAT3) 
C 
C CHECK TO SEE IF LU WAS ASSIGNED 
C 
      MLU=IAND(ISTAT2,77B)
      IF(MLU) 8000,8000,100 
C 
C CHECK FOR PROPER DEVICE TYPE
C 
  100 MTYP=IAND(ISTAT1,37400B)
      IF(MTYP-5000B) 8100,110,8100
C 
C CHECK FOR TEST DEVICE AVAILABILITY
C 
  110 MAV=IAND(ISTAT1,140000B)
      IF(MAV) 8200,120,8200 
C 
C CHECK TO SEE IF LU IS UP
C 
  120 MAV=IAND(ISTAT3,100000B)
      IF(MAV) 8200,500,8200 
C 
C*********************************************************************
C*         SECTION 500 - GRAPHICS AND DOT MATRIX TESTS
C*********************************************************************
C 
  500 WRITE(ILUL,505) ILUT
  505 FORMAT(/"  TXWL0 - LU#",I3,": IS PRINTER A 2608A (Y OR N)? _")
      CALL EXEC(1,ILUL+400B,ITYPE,1)
      IF(ITYPE.EQ.2HN ) GOTO 1017 
      IT=1
      WRITE(ILUL,506) ILUT
  506 FORMAT(/"  TXWL0 - LU#",I3,": DOT MATRIX TEST RUNNING") 
C 
C  HEADER 
C 
      WRITE(ILUT,510) 
  510 FORMAT(30X,"2608A PRINTER TESTS!"///,30X,"DOT MATRIX TEST"//) 
C 
C DOT MATRIX READ/WRITE TEST
C 
      CALL EXEC(1,ILUT,IDOT,-1153,0)
      CALL EXEC(3,ILUT+3000B,2) 
      DO 600 I=1,1153 
      WRITE(ILUT,512) IDOT(I) 
  512 FORMAT(50(" "),A2)
  600 CONTINUE
      CALL EXEC(3,ILUT+3000B,0) 
C 
C PING-PONG READ/WRITE TEST 
C 
      WRITE(ILUT,610) 
  610 FORMAT(/////30X,"PING-PONG READ/WRITE TEST TO FOLLOW")
      WRITE(ILUL,612) ILUT
  612 FORMAT(/"  TXWL0 - LU#",I3,": PING-PONG TEST RUNNING")
      CALL EXEC(3,ILUT) 
      CALL EXEC(1,ILUT+100B,IDOT,257) 
      DO 620 I=1,257
      WRITE(ILUT,615) I,IDOT(I),IDOT(I) 
  615 FORMAT(20X," BUFFER LOC.(",I3,") = ",@6," = ",A2) 
  620 CONTINUE
C 
C*********************************************************************
C*                  SECTION 1000 - PRINT & LINE SPACE TESTS 
C*********************************************************************
C 
C 
      WRITE(ILUT,1000)
 1000 FORMAT(//////30X,"PRINT VERSION OF SELF-TEST TO FOLLOW")
C SELF TEST--PRINT VERSION
C 
      WRITE(ILUL,1005) ILUT 
 1005 FORMAT(/"  TXWL0 - LU#",I3,": SELF TEST--PRINT VERSION" 
     1" RUNNING.")
      CALL EXEC(3,ILUT+2000B,0) 
C 
C DOUBLE SIZE PRINT TEST
C 
      WRITE(ILUT,1010)
 1010 FORMAT(30X,"DOUBLE SIZE PRINT TEST")
      WRITE(ILUL,1015) ILUT 
 1015 FORMAT(/"  TXWL0 - LU#",I3,": DOUBLE SIZE PRINT TEST RUNNING.") 
      CALL EXEC(3,ILUT+3000B,1) 
      WRITE(ILUT,1016)
 1016 FORMAT(/"     DOUBLE SIZE PRINT"/)
      CALL EXEC(3,ILUT+3000B,0) 
 1017 WRITE(ILUT,1018)
 1018 FORMAT(//////30X,"STANDARD PRINTER TESTS TO FOLLOW")
      WRITE(ILUL,1019) ILUT 
 1019 FORMAT(/"  TXWL0 - LU#",I3,": CHARACTER & LINE SPACE TEST"
     1" RUNNING") 
C 
C OUTPUT DATA FROM BUFFERS TO PRINTER 
C 
C OUTPUT TEN LINE SPACINGS
C 
      CALL EXEC(3,ILUT+1100B,10)
C 
C OUTPUT BUFFER, PRINT COLUMN 1 
C 
      CALL EXEC(2,ILUT+200B,IBUF1,-40)
C 
C OUTPUT BUFFER, PRINT COLUMN 1 
C 
      CALL EXEC(2,ILUT+200B,IBUF2,-40)
C 
C FIRST CHARACTER INTERPRETED AS CONTROL CHARACTER. 
C DO A DOUBLE SPACE, THEN OUTPUT BUFFER.
C 
      CALL EXEC(2,ILUT,IBUF3,-41) 
C 
C FIRST CHARACTER INTERPRETED AS CONTROL CHARACTER. 
C SUPPRESS SPACE (OVERPRINT), THEN OUTPUT BUFFER PRINTING COLUMN 1. 
C 
      CALL EXEC(2,ILUT,IBUF4,-40) 
C 
C OUTPUT BUFFER, PRINT COLUMN 1.
C 
      CALL EXEC(2,ILUT+200B,IBUF5,-40)
C 
C SPACE ONE LINE
C 
      CALL EXEC(3,ILUT+1100B,1) 
C 
C OUTPUT BUFFER TO CHECK CHARACTERS 
C 
      WRITE(ILUT,1020)
 1020 FORMAT(" ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!'#$%&()-=@+<>?:876" 
     1"543210ZYXWVUTSRQPONMLKJ")
C 
C FIRST CHARACTER INTERPRETED AS A CONTROL CHARACTER
C TOP OF FORM, THEN OUTPUT BUFFER.
C 
      CALL EXEC(2,ILUT,IBUF6,-22) 
C 
C REQUEST TO CONTINUE OR ABORT
C 
      WRITE(ILUL,1030) ILUT 
 1030 FORMAT(/"  TXWL0 - LU#",I3,": CHARACTER & LINE SPACE TEST"
     1" FINISHED")
 1040 WRITE(ILUL,1050) ILUT 
 1050 FORMAT(/"  TXWL0 - LU#",I3,": TYPE  /C  TO CONTINUE NEXT TEST"
     1" OR"/"          TYPE  /A  TO ABORT THIS TEST: _")
      CALL EXEC(1,ILUL+400B,IQUE,1) 
      IF(IQUE.EQ.2H/C) GOTO 2000
      IF(IQUE.EQ.2H/A) GOTO 9000
      GOTO 1040 
C 
C*********************************************************************
C*                  SECTION 2000 - CONTROL FUNCTION TESTS 
C*********************************************************************
C 
 2000 IF(IT) 2005,2016,2005 
C 
C CONTROL REQUEST FOR STATUS READ & OUTPUT OF STATUS
C 
 2005 WRITE(ILUL,2010) ILUT 
 2010 FORMAT(/"  TXWL0 - LU#",I3,":  CONTROL REQUEST FOR STATUS READ."
     1" UNIQUE TO 2608A PRINTER.")
      WRITE(ILUT,2011)
 2011 FORMAT(///20X,"CONTROL REQUEST STATUS READ - UNIQUE TO 2608A" 
     1" PRINTER"///)
      CALL EXEC(1,ILUT+200B,ISTR,16)
      DO 2015 I=1,16
      WRITE(ILUT,2012) ILUT,I,ISTR(I) 
 2012 FORMAT(10X," TXWL0 - LU#",I3,": STATUS BUFFER WORD #",I3," - ",@6)
 2015 CONTINUE
 2016 WRITE(ILUL,2018) ILUT 
 2018 FORMAT(/"  TXWL0 - LU#",I3,": CONTROL FUNCTION TEST RUNNING") 
C 
C DO A PAGE EJECT AND WRITE TOP OF FORM MESSAGE 
C 
      CALL EXEC(3,ILUT+1100B,-1)
      WRITE(ILUT,2020)
 2020 FORMAT("          TOP OF FORM!")
C 
C SKIP TO NEXT 1/6 PAGE BOUNDARY AND PRINT MESSAGE
C 
      CALL EXEC(3,ILUT+1100B,61)
      WRITE(ILUT,2030)
 2030 FORMAT("          1/6 PAGE BOUNDRY!") 
C 
C SKIP TO NEXT 1/4 PAGE BOUNDARY AND PRINT MESSAGE
C 
      CALL EXEC(3,ILUT+1100B,60)
      WRITE(ILUT,2040)
 2040 FORMAT("          1/4 PAGE BOUNDRY!") 
C 
C SKIP TO NEXT 1/2 PAGE BOUNDARY AND PRINT MESSAGE
C 
      CALL EXEC(3,ILUT+1100B,59)
      WRITE(ILUT,2050)
 2050 FORMAT("          1/2 PAGE BOUNDRY!") 
C 
C SKIP TO BOTTOM OF THE PAGE AND PRINT MESSAGE
C 
      CALL EXEC(3,ILUT+1100B,62)
      WRITE(ILUT,2060)
 2060 FORMAT("          BOTTOM OF PAGE!") 
C 
C SKIP TO APPROXIMATELY 3/4 PAGE BOUNDARY AND PRINT MESSAGE 
C 
      CALL EXEC(3,ILUT+1100B,45)
      WRITE(ILUT,2070)
 2070 FORMAT("          APPROXIMATELY 3/4 DOWN PAGE!")
C 
C SKIP TO TOP OF NEXT PAGE
C 
      CALL EXEC(3,ILUT+1100B,63)
      WRITE(ILUL,2080) ILUT 
 2080 FORMAT(/"  TXWL0 - LU#",I3,": LINE PRINTER TESTS FINISHED"/)
      GOTO 9900 
C 
C*********************************************************************
C*                  SECTION 8000 - ERROR MESSAGES 
C*********************************************************************
C 
 8000 WRITE(ILUL,8010) ILUT 
 8010 FORMAT(/"  TXWL0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/)
      GOTO 9900 
 8020 WRITE(ILUL,8025)
 8025 FORMAT(/"  TXWL0 - LU# SPECIFIED FOR LINE PRINTER"
     1" IS ILLEGAL."/"          RERUN TEST SPECIFYING AN INTEGER >0"
     2" AND <64 FOR LU#.")
      GOTO 9000 
 8100 WRITE(ILUL,8110) ILUT 
 8110 FORMAT(/"  TXWL0 - LU#",I3," IS NOT ASSIGNED TO A LINE PRINTER."/ 
     1"          RERUN TEST SPECIFYING CORRECT LU#.") 
      GOTO 9000 
 8200 WRITE(ILUL,8210) ILUT 
 8210 FORMAT(/"  TXWL0 - LU#",I3,": EQT OR LU FOR TEST PRINTER" 
     1" IS DOWN."/"          UP EQT AND RERUN TEST.") 
C 
C*********************************************************************
C*                  SECTION 9000 - ABORT MESSAGE AND TERMINATE
C*********************************************************************
C 
 9000 WRITE(ILUL,9010) ILUT 
 9010 FORMAT(/"  TXWL0 - LU#",I3,":  LINE PRINTER TEST ABORTED!"/)
 9900 END 
      END$
                                                                                                                                                                                                                                          