10   .IOMAP (REV 00.11)         (C) HEWLETT-PACKARD  *1978*
   15 LPOFF 
   17 LET A:=H:=T:=FALSE
   20 PRINT 14;" IOMAP            Revision 00.11",1,1,10;"Enter 'GO' to ";
   30 PRINT "continue",16;"'GO ,1' to continue with Line Pr";
   40 PRINT "inter",1,16;"'GO 1' for ";
   50 PRINT "Optional Test Sections",16;"'GO 1,1 ' to run Optional ";
   60 PRINT "Test Sections with Line Printer",1
   70 PRINT 16;"('LC' to List Commands)",1
   80 PAUSE 
   90 DB AA,10
  110 DB HH,6,0
  120 ASSIGN HH(0),1,10,100,1000,10000
  130 DB CC,10,0                      .INTERNAL CMND INDEX
  140 DB II,128,0
  150 DB JJ,128,0
  160 DB KK,128,0
  170 DB DD,100,0                     .INTERNAL COMMAND BUFFER
  180 DB EE,10,0
  190 DB FF,10,0
  200 DB BB,50,0                       .UNPACK BUFFER
  203 DB YY,7,0                 .CPVA
  205 DB SS,7,-1                .STATUS  BUFFER
  208 DB XX,2,-1
  210 ASSIGN DD(0),!4C,!4F,!4F,!50,!42,!41,!43,!4B,!FFFF .'LOOPBACK'
  220 ASSIGN DD(9),!53,!45,!4C,!46,!54,!45,!53,!54,!FFFF .'SELFTEST'
  230 ASSIGN DD(18),!49,!4F,!4D,!41,!50,!FFFF            .'IOMAP'
  240 ASSIGN DD(32),!49,!44,!45,!4E,!54,!49,!46,!59,!FFFF.'IDENTIFY'
  250 ASSIGN DD(41),!44,!45,!4C,!41,!59,!FFFF            .'DELAY'
  260 ASSIGN CC(0),0,9,18,24,29,32,41,!FFFF
  270 ASSIGN EE(0),8,8,5,4,2,8,5,4
  275 CPVA YY(0)
  280 IFN GOPARAM2 EQ 1 THEN 300
  290 LET T:=TRUE
  300 IF NEWTEST THEN 410
  310 IF GOPARAM1 NE 0 THEN 340
  320 LET SECTIONS1:=!8000
  330 GOTO 500
  340 LET A:=GOPARAM1
  350 PRINT 1,1,11;"---   OPTIONAL TEST SECTIONS    ---",1,1
  360 PRINT 16;"Test Section 2 ---- IDENTIFY",16;"Test Section 3 ---";
  370 PRINT "- SELF TEST",16;"Test Section 4 ---- LOOPBACK",1,10;"Enter";
  380 PRINT " Desired Test Section(s)",16;"('LC' to list commands)",1
  390 PAUSE 
  400 IFN NEWTEST THEN 20
  410 ASSIGN AA(0),6,-1
  420 IF SECTIONS1 AND !F000 THEN 500   .Valid tests are 1/4
  430 PRINT 1,"INVALID TEST ENTERED !!!",1
  440 IF A EQ 1 THEN 350
  450 GOTO 20
  460 IFN T THEN 480
  470 LPON 
  480 IOMAP 
  490 LPOFF 
  500 IFN T THEN 520
  510 LPON 
  520 SECTION 1,540
  530 IOMAP 
  540 SECTION 2,630
  550 IF PASSCOUNT THEN 600
  555 LPOFF 
  560 PRINT 1,14;"Test Section 2---IDENTIFY",1,"Function: to describe ";
  570 PRINT "the device on a specific Channel","Enter a channel and devi";
  580 PRINT "ce number separated by a comma or,","-2 to Exit this";
  582 PRINT " test section."
  585 INPUTB AA(0)
  586 IF AA(0)=-2 THEN 630
  587 IFN 0 LT AA(0) LT 16 THEN 560        .VALID CHAN?
  588 IFN -1 LT AA(1) LT 8 THEN 560        .VALID DEV?
  593 IFN T THEN 600
  596 LPON 
  600 LET Z:=AA(0),Y:=AA(1)
  610 DOIDEN Z,Y
  620 PRINT "------------------------------------------------------------"
  622 LOOPTO 630
  626 IFN PASSCOUNT THEN 560
  630 SECTION 3,720
  640 IF PASSCOUNT THEN 690
  645 LPOFF 
  650 PRINT 1,14;"Test Section 3---SELFTEST",1,"Function: to Invoke ";
  660 PRINT "SELFTEST"
  670 PRINT "Enter a channel and device number separated by a comma or,"
  672 PRINT "-2 to Exit this test section."
  675 INPUTB AA(2)
  677 IF AA(2)=-2 THEN 720
  679 IFN 0 LT AA(2) LT 16 THEN 670
  681 IFN -1 LT AA(3) LT 8 THEN 670
  683 IFN T THEN 690
  686 LPON 
  690 LET W:=AA(2),X:=AA(3)
  700 SELFTEST W,X
  710 PRINT "------------------------------------------------------------"
  712 LOOPTO 720
  716 IFN PASSCOUNT THEN 650          .LOOPING?
  720 SECTION 4,820
  730 IF PASSCOUNT THEN 780
  735 LPOFF 
  740 PRINT 1,14;"Test Section 4---LOOPBACK",1,"Function: to Perform ";
  750 PRINT "the LOOPBACK test","Enter a channel and device number ";
  760 PRINT "separated by a comma or,","-2 to Exit this test section."
  770 INPUTB AA(4)
  771 IF AA(4)=-2 THEN 820
  772 IFN 0 LT AA(4) LT 16 THEN 740       .VALID CHAN?
  773 IFN -1 LT AA(5) LT 8 THEN 740       .VALID DEV?
  775 IFN T THEN 780
  776 LPON 
  780 LET U:=AA(4),V:=AA(5)
  790 DLOOPBAK U,V
  800 PRINT "LOOPBACK test completed"
  810 PRINT "------------------------------------------------------------"
  812 LOOPTO 820
  816 IFN PASSCOUNT THEN 740          .LOOPING?
  820 BUMP
  840 PRINT 1,
  850 LOOPTO 500
  860 LPOFF 
  870 END 
  880 .-------------------------------------------------
  890 .This function runs the loopback test on selected
  900 .channel/device.
  910 .IF REPEATFACTOR NE 0 THEN LOOP(REPEATFACTOR) ELSE
  920 .LOOP UNTIL (c)Y OR ATTN.
  930 .---------------------------------------------------
  940 FUNCTION DLOOPBAK VALUE1,VALUE2
  950 LET FF(1):=VALUE1,FF(2):=VALUE2
  960 RANGEOK 
  970 IF E THEN 1080
  980 MSGOUT 5
  990 LPOFF 
 1000 PRINT "Enter an existing channel and device number separated"
 1010 PRINT "by a comma or, Enter '100' to run IOMAP again."
 1020 INPUTB FF(1)
 1030 IF FF(1)=100 THEN 470
 1040 LET AA(4):=FF(1),AA(5):=FF(2)
 1050 IFN T THEN 1070
 1060 LPON 
 1070 GOTO 780
 1080 LET FF(7):=FF(1) CSL 3 OR FF(2).FORM C/D WORD
 1090 IF FF(7) NE CONCHAN THEN 1120
 1100 MSGOUT 4
 1110 GOTO 1640
 1120 CKCHAN FF(1)      .SEE IF CHAN EXISTS
 1130 IF E THEN 1240
 1140 MSGOUT 1
 1150 LPOFF 
 1160 PRINT "Enter an existing channel and device number separated"
 1170 PRINT "by a comma or, Enter '100' to run IOMAP again."
 1180 INPUTB FF(1)
 1190 IF FF(1)=100 THEN 460
 1200 LET AA(4):=FF(1),AA(5):=FF(2)
 1210 IFN T THEN 1230
 1220 LPON 
 1230 GOTO 780
 1240 CKDEV        .SEE IF DEVICE EXISTS
 1250 IF E THEN 1360
 1260 MSGOUT 2
 1270 LPOFF 
 1280 PRINT "Enter an existing channel and device number separated"
 1290 PRINT "by a comma or, Enter '100' to run IOMAP again."
 1300 INPUTB FF(1)
 1310 IF FF(1)=100 THEN 460
 1320 LET AA(4):=FF(1),AA(5):=FF(2)
 1330 IFN T THEN 1350
 1340 LPON 
 1350 GOTO 780
 1360 CKLBKCAP        .CHECK LOOPBACK CAPABILITY
 1362 GOTO 1368
 1364 LET OFFSET:=0
 1366 ENDF 
 1368 BLDSDATA 
 1370 BLDADATA 
 1380 INIT 
 1384 IF XX(0)<>!176 THEN 1390         .7976 MAG TAPE?
 1386 GOSUB 7670
 1390 GOSUB 1500         .DO LOOPBACK CHANNEL PGM XFER II
 1400 LET FF(5):=ZZ(24)-ZZ(9)
 1410 CKSDATA FF(5)
 1420 IFN E THEN 1440    .IF NOT ERR
 1430 GOTO 1640
 1440 INIT 
 1450 GOSUB 1560          .DO LOOPBACK CHAN PGM XFER KK
 1460 LET FF(5):=ZZ(24)-ZZ(9)
 1470 CKADATA VALUE1
 1480 GOTO 1640
 1490 .................. LOOPBACK CHANNEL PROGRAM
 1500 BSIO ZZ
 1510 WR !1E,II(0),256
 1515 IF XX(0)=!183 THEN 1642
 1520 WAIT 
 1530 RR !1E,JJ(0),256
 1535 IN H,1,1
 1540 RSIO ZZ,,1620
 1545 GOSUB 7840        .CHECK CPVA
 1550 RETURN 
 1560 BSIO ZZ
 1570 WR !1E,KK(0),256
 1580 GOTO 1515
 1620 PRINT "Channel program error in loopback test."
 1630 PRINT "Test aborted"
 1640 ENDF 
 1642 IN H,1,1
 1643 RSIO ZZ,,1620
 1644 BSIO ZZ
 1646 RR !1E,JJ(0),129
 1647 DSJ 1648
 1648 IN H,2,2
 1649 RSIO ZZ,,1620
 1650 GOSUB 7840                  .CHECK CPVA
 1652 LET FF(5):=64,OFFSET:=1
 1653 RETURN 
 1657 .----------------------------------------------
 1660 .This function executes the IOMAP command
 1670 .A list of all existing Channels and devices
 1680 .is displayed.
 1690 .----------------------------------------------
 1700 FUNCTION IOMAP 
 1710 .
 1714 IF T THEN 1730    .DON'T LINEFEED FOR PRINTER
 1720 LINEFEED 24
 1730 PRINT " IOMAP            SYSTEM I/O CONFIGURATION"
 1740 PRINT "-----------------------------------------------------------------"
 1750 RSW FF(7)
 1760 LET FF(8):=FF(7) CSR 3 AND !F
 1770 LET FF(7):=FF(7) AND 7
 1780 PRINT ">Control panel switch settings: Channel=";FF(8);" Device=";FF(7)
 1790 LET FF(7):=CONCHAN CSR 3 AND !F
 1800 LET FF(8):=CONCHAN AND !7
 1810 PRINT ">System console is device ";FF(8);" on channel ";FF(7)
 1820 FOR FF(1):=1 UNTIL 15
 1830 LET CHANNEL:=FF(1)
 1840 CKCHAN FF(1)
 1850 IFN E THEN 1970  .IF NOCHAN THEN TRYNEXTCHAN
 1860 PRINT "-----------------------------------------------------------------"
 1880 PRINT "Channel ";A;
 1890 CHNTYPE 
 1900 IF E THEN 1970
 1910 FOR FF(2):=0 UNTIL 7.DEVICE LOOP
 1920 CKDEV 
 1930 IFN E THEN 1960  .JMP IF NO DEV
 1940 DISPTYPE 
 1960 NEXT 1910   .NEXT DEV
 1970 NEXT 1820   .NEXT CHAN
 1980 PRINT "-----------------------------------------------------------------"
 1990 PRINT "Explanation of '(CODE=   )'"
 2000 PRINT 5;"1 implies:  NO LOOPBACK Capability."
 2010 PRINT 5;"2 implies:  NO SELFTEST Capability. ","---------";
 2020 PRINT "---------------------------------------------------------"
 2040 ENDF 
 2050 .--------------------------------------------------
 2060 .Processes IDENTIFY command
 2070 .----------------------------------------------
 2080 FUNCTION DOIDEN VALUE1,VALUE2
 2090 LET FF(1):=VALUE1,FF(2):=VALUE2
 2100 RANGEOK 
 2110 IF E THEN 2230
 2120 LPON 
 2130 MSGOUT 5
 2140 LPOFF 
 2150 PRINT "Enter an existing channel and device number separated"
 2160 PRINT "by a comma or, Enter '100' to run IOMAP again."
 2170 INPUTB FF(1)
 2180 IF FF(1)=100 THEN 460
 2190 LET AA(0):=FF(1),AA(1):=FF(2)
 2200 IFN T THEN 2220
 2210 LPON 
 2220 GOTO 600
 2230 CKCHAN FF(1)
 2240 IF E THEN 2350
 2250 MSGOUT 1
 2260 LPOFF 
 2270 PRINT "Enter an existing channel and device number separated"
 2280 PRINT "by a comma or, Enter '100' to run IOMAP again."
 2290 INPUTB FF(1)
 2300 IF FF(1)=100 THEN 460
 2310 LET AA(0):=FF(1),AA(1):=FF(2)
 2320 IFN T THEN 2340
 2330 LPON 
 2340 GOTO 600
 2350 CKDEV 
 2360 IF E THEN 2470
 2370 MSGOUT 2
 2380 LPOFF 
 2390 PRINT "Enter an existing channel and device number separated"
 2400 PRINT "by a comma or, Enter '100' to run IOMAP again."
 2410 INPUTB FF(1)
 2420 IF FF(1)=100 THEN 460
 2430 LET AA(0):=FF(1),AA(1):=FF(2)
 2440 IFN T THEN 2460
 2450 LPON 
 2460 GOTO 600
 2470 PRINT 1,"IDENTIFY Results:","Channel ";FF(1);
 2480 CHNTYPE 
 2490 IF E THEN 2540
 2500 DISPTYPE 
 2510 ADELAY 
 2520 GOTO 2540
 2530 ADELAY 
 2540 IF FF(3) EQ 0 THEN 2580
 2550 IF FF(3) EQ 1 THEN 2580
 2560 LET FF(3):=FF(3)-1
 2570 GOTO 2470
 2580 ENDF 
 2590 .====================================================
 2600 .This function unpacks the command from the
 2610 .input buffer, determines the command and sets
 2620 .FF(0) to a number that is used later to execute the command.
 2630 .====================================================
 2640 FUNCTION GETCMND      .UNPACKS AND DECODES COMMAND
 2650 .
 2660 LET A:=0,B:=0,E:=FALSE
 2670 IF &AA(A) LT !41 THEN 2710
 2680 IF &AA(A) GT !5A THEN 2710
 2690 LET BB(B):=&AA(A),A:=A+1,B:=B+1
 2700 GOTO 2670
 2710 LET A:=0,C:=CC(A),D:=EE(A)
 2720 IF C=!FFFF THEN 2790
 2730 CB BB(0),DD(C),D
 2740 IF INDEX=-1 THEN 2770
 2750 LET A:=A+1,C:=CC(A),D:=EE(A)
 2760 GOTO 2720
 2770 LET FF(0):=A
 2780 GOTO 2800
 2790 LET E:=TRUE
 2800 ENDF 
 2810 .======================================================
 2820 .This function unpacks the parameters in the input
 2830 .buffer and stuffs the hex codes for param1 into
 2840 .BB(0), param2 into BB(10), param3 into BB(20).
 2850 .=======================================================
 2860 FUNCTION GETPARAM 
 2870 .
 2880 DB BB,50,0      .CLEAR BUF BB
 2890 LET C:=0,E:=FALSE
 2900 IF &AA(B) NE !20 THEN 3030
 2910 FOR D:=1 UNTIL 3
 2920 LET F:=C
 2930 LET B:=B+1           .NEXT CHAR
 2940 IF &AA(B)="," THEN 3000  .JMP IF COMMA
 2950 IF &AA(B)=!20 THEN 3000        .JMP IF SPACE
 2960 IF &AA(B) LT !30 THEN 3000
 2970 IF &AA(B) GT !39 THEN 3000    .JUMP IF NOT NUMERIC
 2980 LET BB(F):=&AA(B),F:=F+1
 2990 GOTO 2930
 3000 LET C:=C+10
 3010 NEXT 2910                .LOOPFOR 3 PARAMS
 3020 GOTO 3040
 3030 LET E:=TRUE
 3040 ENDF 
 3050 .---------------------------------------------------------
 3060 .This function converts the hex parameter string whose
 3070 .address is BB(VALUE1) ,to a decimal number and
 3080 .stuffs the result in FF(VALUE2).
 3090 .---------------------------------------------------------
 3100 FUNCTION HEXTODEC VALUE1,VALUE2
 3110 .
 3120 LET F:=VALUE2,G:=VALUE1
 3130 DB GG,6,0               .CLR A BUFFR
 3140 LET A:=0
 3150 IF BB(G)=0 THEN 3210
 3160 LET GG(A):=BB(G) AND !F    .ASCII TO BIN
 3170 LET A:=A+1,G:=G+1           .NEXT CHAR
 3180 IF A=5 THEN 3210       .OUT IF MORE THAN 5 CHAR IN PARAM
 3190 GOTO 3150
 3200 ......... NEXT LOOP PERFORMS ACTUAL BIN TO DEC CONVERSION
 3210 LET D:=0,E:=0
 3220 FOR B:=A-1 STEP -1 UNTIL 0
 3230 IF B<0 THEN 3260
 3240 LET C:=GG(B)*HH(D),E:=E+C,D:=D+1
 3250 NEXT 3220
 3260 LET FF(F):=E         .STORE DECIMAL VALUE
 3270 ENDF 
 3280 LET Z:=0
 3290 .-----------------------------------------------------
 3300 .This function determines if the specified channel
 3310 .exists. IF (CHAN'EXISTS) THEN E:=TRUE ELSE FALSE.
 3320 .Caller Should test E upon return from FUNCTION
 3330 .Enter with channel to be tested in VALUE1.
 3340 .-------------------------------------------------
 3350 FUNCTION CKCHAN VALUE1
 3360 .
 3370 LET CHANNEL:=FF(1)
 3380 LET A:=VALUE1,E:=TRUE
 3390 ROCL B
 3400 LET B:=B CSL A
 3410 IF B AND !8000 NE 0 THEN 3430
 3420 LET E:=FALSE
 3430 ENDF 
 3440 .------------------------------------------------
 3450 .This function builds a sequential data
 3460 .pattern for loopback test. data in buffer II.
 3470 .-----------------------------------------------
 3480 FUNCTION BLDSDATA 
 3490 .
 3500 LET A:=0
 3510 FOR B:=0 UNTIL 127
 3520 LET II(B):=A CSL 8
 3530 LET A:=A+1
 3540 LET II(B):=II(B) OR A
 3550 LET A:=A+1
 3560 NEXT 3510
 3565 DB JJ,128,0         .CLEAR BUF
 3570 ENDF 
 3580 .------------------------------------------------
 3590 .This function builds a data buffer of alternate
 3600 .!FF's and zeroes. For loopback test
 3610 .------------------------------------------------
 3620 FUNCTION BLDADATA 
 3630 .
 3640 FOR B:=0 UNTIL 127
 3650 LET KK(B):=!FF CSL 8
 3660 LET KK(B):=KK(B) OR 0
 3670 NEXT 3640
 3680 GOTO 3565
 3690 .-----------------------------------------------
 3700 .This function checks if the specified
 3710 .device exists.
 3720 .IF DEVICEEXISTS THEN E:=TRUE ELSE E:=FALSE
 3730 .---------------------------------------------
 3740 FUNCTION CKDEV 
 3750 .
 3760 LET E:=FALSE
 3770 LET CHANNEL:=FF(1),DEVICE:=FF(2)
 3780 RIOC 14,FF(5)
 3790 IF FF(5) AND !F EQ 1 THEN 3870
 3800 LET NORESPONS:=1
 3810 INIT 
 3820 HIOP 
 3825 PROC 
 3830 BSIO ZZ
 3840 IDENT FF(5)
 3845 IN H,1,1
 3850 RSIO ZZ,,3851
 3851 RDRT 3,E           .DONE?
 3852 IFN E THEN 3870    .BRANCH IF DONE
 3853 HIOP               .DON'T WAIT FOR GIC TIMEOUT
 3854 INIT 
 3855 LET E:=FALSE
 3856 GOTO 3875
 3870 LET E:=TRUE
 3875 PROC N
 3877 LET XX(0):=FF(5)        .SAVE ID
 3880 ENDF 
 3890 .-----------------------------------------
 3900 .This function checks sequental data
 3910 .returned by loopback test. Returned data in JJ.
 3920 .-----------------------------------------
 3930 FUNCTION CKSDATA VALUE1
 3940 .
 3950 LET E:=FALSE
 3960 CB JJ(0),II(0),VALUE1 .pre-test data skip byte cheks if ok
 3970 IF INDEX=-1 THEN 4110     .ELSE FIND THE BAD BYTE
 3980 PRINT 
 3990 LET A:=0
 4000 FOR B:=0 UNTIL VALUE1-1
 4010 IF D:=JJ(B) CSL 8 AND !FF EQ C:=II(B) CSL 8 AND !FF THEN 4050
 4020 LET E:=TRUE
 4030 MSGOUT 3
 4040 ADELAY 
 4050 LET A:=A+1        .BUMP BYTE COUNTR
 4060 IF D:=JJ(B) AND !FF EQ C:=II(B) AND !FF THEN 4100
 4070 LET E:=TRUE
 4080 MSGOUT 3
 4090 ADELAY 
 4100 LET A:=A+1
 4104 NEXT 4000
 4110 ENDF 
 4120 .-------------------------------------------
 4130 .returned by loopback test. Data in JJ.
 4140 .-------------------------------------------
 4150 FUNCTION CKADATA VALUE1
 4160 .
 4170 LET E:=FALSE
 4180 CB JJ(0),KK(0),VALUE1 .pre-test data slip byte cheks if ok
 4190 IF INDEX=-1 THEN 4330    .ELSE FIND BAD BYTE
 4200 PRINT 
 4210 LET A:=0
 4220 FOR B:=0 UNTIL VALUE1-1
 4230 IF D:=JJ(B) CSL 8 AND !FF EQ C:=KK(B) CSL 8 AND !FF THEN 4270
 4240 LET E:=TRUE
 4250 MSGOUT 3
 4260 ADELAY 
 4270 LET A:=A+1
 4280 IF D:=JJ(B) AND !FF EQ C:=KK(B) AND !FF THEN 4320
 4290 LET E:=TRUE
 4300 MSGOUT 3
 4310 ADELAY 
 4320 LET A:=A+1
 4324 NEXT 4220
 4330 ENDF 
 4340 .-----------------------------------------
 4350 .Message processor for misc. messages.
 4360 .-----------------------------------------
 4370 FUNCTION MSGOUT VALUE1
 4380 LET M:=VALUE1
 4390 IF M NE 1 THEN 4430
 4400 LPOFF 
 4410 PRINT "Channel ";FF(1);"  does not exist on this system !"
 4420 GOTO 4570
 4430 IF M NE 2 THEN 4470
 4440 LPOFF 
 4450 PRINT 1,"Device ";FF(2);" does not exist on channel ";FF(1)
 4460 GOTO 4570
 4470 IF M NE 3 THEN 4510
 4480 PRINT "Loopback Error: pass ";PASSCOUNT;
 4490 PRINT " Byte ";A;"  Received  ";!D;"  Sent  ";!C
 4500 GOTO 4570
 4510 IF M NE 4 THEN 4530
 4520 PRINT " Can't run LOOPBACK on device acting as system console."
 4530 IF M NE 5 THEN 4570
 4540 LPOFF 
 4550 PRINT "Chan or Dev number out of range"
 4560 GOTO 4570
 4570 ENDF 
 4580 .----------------------------------------
 4590 .This function is called if the channel is
 4600 .an ADCC.
 4610 .If entered from IOMAP, dev will be 0.
 4620 .If entered from DOIDEN, dev will be in param ff(2)
 4630 .-----------------------------------------
 4640 FUNCTION TRYADCC 
 4650 .
 4660 PRINT "Channel ";FF(1);" (ADCC )"
 4670 IF DEVICE>3 THEN 4720
 4680 PRINT "  Devices 0-3  ID=!4080  Async. Data Comm. Channel (MAIN)"
 4690 IF FF(5) AND !10 EQ 0 THEN 4750
 4700 PRINT "  Devices 4-7  ID=!4080  Async. Data Comm. Channel (EXTEND)"
 4710 GOTO 4750
 4720 IF FF(5) AND !10 EQ 0 THEN 4740
 4730 GOTO 4700
 4740 PRINT "   No devices 4-7 on this channel. ( ADCC EXTEND absent)"
 4750 ENDF 
 4760 .-----------------------------------------------
 4770 .Outputs line feeds to terminal. # in VALUE1
 4780 .-----------------------------------------------
 4790 FUNCTION LINEFEED VALUE1
 4800 LET A:=VALUE1
 4810 FOR B:=1 UNTIL A
 4820 PRINT 
 4830 NEXT 4810
 4840 ENDF 
 4850 .-----------------------------------------------
 4860 .Performs wait between error printing.
 4870 .-----------------------------------------------
 4880 FUNCTION ADELAY 
 4890 .
 4900 IF FF(6)=0 THEN 4940
 4910 FOR Z:=1 UNTIL FF(6)
 4920 DELAY 6000
 4930 NEXT 4910
 4940 ENDF 
 4950 .Checks halt command for 'on' or 'off'.
 4960 .IF ON THEN H:=TRUE ELSE IF OFF THEN H:=FALSE ELSE ERR
 4970 .-----------------------------------------
 4980 FUNCTION SETHALT 
 4990 .
 5000 LET B:=B+1,C:=B+1,E:=FALSE.SET POINTERS
 5010 IF &AA(B)="O" AND &AA(C)="N" THEN 5050
 5020 IF &AA(B)="O" AND &AA(C)="F" THEN 5070
 5030 LET E:=TRUE
 5040 GOTO 5080
 5050 LET H:=TRUE
 5060 GOTO 5080
 5070 LET H:=FALSE
 5080 ENDF 
 5090 .-------------------------------------
 5100 .Checks channel,device number for legal range.
 5110 .-------------------------------------
 5120 FUNCTION RANGEOK 
 5130 .
 5140 LET E:=TRUE
 5150 IF FF(1)<1 THEN 5190
 5160 IF FF(1)>15 THEN 5190
 5170 IF FF(2)>7 THEN 5190
 5180 GOTO 5200
 5190 LET E:=FALSE
 5200 ENDF 
 5210 ........................................
 5220 .Displays device type from ID code in FF(5)
 5230 .........................................
 5240 FUNCTION DISPTYPE 
 5250 ADELAY 
 5260 PRINT 2;"Device ";FF(2);" ID=";!FF(5);3;
 5270 IF FF(5)>!FFF THEN 5330
 5280 PRINT " ";
 5290 IF FF(5)>!FF THEN 5330
 5300 PRINT " ";
 5310 IF FF(5)>!F THEN 5330
 5320 PRINT " ";
 5330 IF FF(5) NE !80 THEN 5360
 5340 PRINT "Flexible Disc Unit  (Single sided)"
 5350 GOTO 6030
 5360 IF FF(5) NE !81 THEN 5390
 5370 PRINT "Flexible Disc Unit  (Double-sided)"
 5380 GOTO 6030
 5390 IF FF(5) NE !1 THEN 5420
 5400 PRINT "7910 Fixed Disc "
 5410 GOTO 6030
 5420 IF FF(5) NE !2 THEN 5480
 5430 PRINT "7906/7920/7925 Disc Controller";6;"(CODE=2)"
 5435 CKDISCS                      .CHECK ALL UNITS ON CNTLR
 5440 GOTO 6030
 5480 IF FF(5) NE !100 THEN 5510
 5490 PRINT "31207 Writable Control Store"
 5500 GOTO 6030
 5510 IF FF(5) NE !101 THEN 5540
 5520 PRINT "2893 Card Reader"
 5530 GOTO 6030
 5540 IF FF(5) NE !102 THEN 5555
 5550 PRINT "9875 Cartridge Tape Controller  (CODE=1,2)."
 5553 GOTO 6030
 5555 IF FF(5) NE !176 THEN 5562
 5557 PRINT "7976 Mag Tape Unit"
 5558 GOTO 6030
 5562 IF FF(5) NE !183 THEN 5570
 5564 PRINT "7970E Mag Tape Controller           (CODE=2)"
 5565 CKMAGTAP                          .CHECK MAG TAPE UNITS
 5566 GOTO 6030
 5570 IF FF(5) NE !2000 THEN 5600
 5580 PRINT "9871 Character Printer";9;"(CODE= 1,2)."
 5590 GOTO 6030
 5600 IF FF(5) NE !2001 THEN 5630
 5610 PRINT "2608 Dot Matrix Printer"
 5620 GOTO 6030
 5630 IF FF(5) NE !2002 THEN 5660
 5640 PRINT "2631A Serial Printer"
 5650 GOTO 6030
 5660 IF FF(5) NE !2003 THEN 5690
 5670 PRINT "2617 Line Printer";14;"(CODE= 1,2)."
 5680 GOTO 6030
 5690 IF FF(5) NE !2004 THEN 5720
 5700 PRINT "2680 Page Printer"
 5710 GOTO 6030
 5720 IF FF(5) NE !2005 THEN 5750
 5730 PRINT "9872 Plotter"
 5740 GOTO 6030
 5750 IF FF(5) NE !2006 THEN 5773
 5760 PRINT "7245 Plotter/Printer"
 5770 GOTO 6030
 5773 IF FF(5) NE !2009 THEN 5780
 5775 PRINT "2631B Serial Printer"
 5777 GOTO 6030
 5780 IF FF(5) NE !2080 THEN 5804
 5790 PRINT "Integrated Display System      (CODE= 1)."
 5800 GOTO 6030
 5804 IF FF(5) NE !200A THEN 5810
 5806 PRINT "2613/2617/2619A LINE PRINTER"
 5808 GOTO 6030
 5810 IF FF(5) NE !4000 THEN 5840
 5820 PRINT "31281  SDLC-EIA Interface   (CODE=  1,2)."
 5830 GOTO 6030
 5840 IF FF(5) NE !4001 THEN 5864
 5850 PRINT "BISYNC Interface"
 5860 GOTO 6030
 5864 IF FF(5) NE !4002 THEN 5867
 5865 PRINT "30020A Intelligent Network Processor (INP)  (CODE= 1,2)"
 5866 GOTO 6030
 5867 IF FF(5) NE !4003 THEN 5870
 5868 PRINT "30020B Intelligent Network Processor (INP)  (CODE= 1,2)"
 5869 GOTO 6030
 5870 IF FF(5) NE !6000 THEN 5900
 5880 PRINT "31262  GIC acting as a device   (CODE=1,2)."
 5890 GOTO 6030
 5900 IF FF(5) AND !FFF6 NE !6080 THEN 5960
 5910 PRINT "9845 Calculator"
 5920 GOTO 6030
 5960 IF FF(5) NE !8000 THEN 5990
 5970 PRINT "31321 Processor Maint. Panel";4;"CODE= 1,2)."
 5980 GOTO 6030
 5990 IF FF(5) NE !A000 THEN 6020
 6000 PRINT "9874 Digitizer"
 6010 GOTO 6030
 6020 PRINT "* Device responds but ID code undefined *"
 6030 ENDF 
 6040 .....................................................
 6050 .Performs sefltest on selected chan/dev.
 6060 .....................................................
 6070 FUNCTION SELFTEST VALUE1,VALUE2
 6080 LET FF(1):=VALUE1,FF(2):=VALUE2
 6090 CKCHAN FF(1)
 6100 IF E THEN 6210
 6110 MSGOUT 1
 6120 LPOFF 
 6130 PRINT "Enter an existing channel and device number separated"
 6140 PRINT "by a comma or, Enter '100' to run IOMAP again."
 6150 INPUTB FF(1)
 6160 IF FF(1)=100 THEN 460
 6170 LET AA(2):=FF(1),AA(3):=FF(2)
 6180 IFN T THEN 6200
 6190 LPON 
 6200 GOTO 690
 6210 CKDEV 
 6220 IF E THEN 6340
 6230 MSGOUT 2
 6240 LPOFF 
 6250 PRINT "Enter an existing channel and device number separated"
 6260 PRINT "by a comma or, Enter '100' to run IOMAP again."
 6270 INPUTB FF(1)
 6280 IF FF(1)=100 THEN 460
 6290 LET AA(2):=FF(1),AA(3):=FF(2)
 6300 IFN T THEN 6320
 6310 LPON 
 6320 GOTO 690
 6330 LET TIMEOUT:=100
 6340 CKSTCAP           .CHECK SELFTEST CAPABILITY
 6342 INIT 
 6344 GOTO 6350
 6346 LET OFFSET:=0
 6348 ENDF 
 6350 LET II(0):=0,II(1):=!FF00
 6352 IF XX(0)<>!176 THEN 6360
 6353 GOSUB 7670
 6360 BSIO ZZ
 6365 IF XX(0)=!176 THEN 6380     .BYPASS DSJ FOR 7976 MAG TAPE
 6370 DSJ 6380
 6380 WR !1F,II(0),1
 6390 WAIT 
 6395 IN H,1,1
 6400 ESIO 
 6410 BSIO XX
 6420 DSJ 6430;V
 6430 RR !1F,II(1),2
 6440 WAIT 
 6445 IN H,1,1
 6450 ESIO 
 6460 HIOP  .FOR IDS
 6470 RSIO ZZ  .INVOKE SELFTEST
 6475 GOSUB 7840                .CHECK CPVA
 6480 RSIO XX
 6485 GOSUB 7840                .CHECK CPVA
 6490 IF V EQ 255 THEN 6480    .FOR IDS
 6500 INIT 
 6510 IF XX(25)-XX(12) NE 0 THEN 6530
 6520 LET II(1):=II(1) CSL 8
 6530 IF PASSCOUNT THEN 6580
 6540 PRINT "Initial SELFTEST Results = ";!II(1);
 6542 IF II(1)<>0 THEN 6548
 6544 PRINT ". Unit passed test."
 6546 GOTO 6550
 6548 PRINT ". Unit failed test."
 6550 DELAY 20000
 6560 LET H:=II(1).save initial results
 6570 GOTO 6630
 6580 IF II(1) EQ H THEN 6620
 6590 PRINT " SELFTEST results changed on pass ";PASSCOUNT;" expected ";
 6600 PRINT !H;" received ";!II(1)
 6610 GOTO 6630
 6620 PRINT "New SELFTEST result equivalent to initial result of ";!H
 6630 ENDF 
 6640 ..........
 6650 .print channel type
 6660 ..........
 6670 FUNCTION CHNTYPE 
 6680 RIOC 14,FF(8)
 6690 LET E:=FALSE.clear adcc flag
 6700 LET FF(7):=FF(8) AND !F
 6710 IF FF(7) NE 0 THEN 6740
 6720 PRINT "  ID=";!FF(7);"      General I/O Channel  (GIC)"
 6730 GOTO 6860
 6740 IF FF(7) NE 1 THEN 6850
 6750 LET E:=TRUE.set adcc flag
 6760 PRINT "   ID=";!FF(7);"          Async. Data Comm. Channel (ADCC)"
 6770 ADELAY 
 6780 PRINT "  Devices 0-3  ID=!4080    Devices on  ADCC MAIN     (CODE";
 6790 PRINT "= 1,2)."
 6800 IF FF(8) AND !10 NE !10 THEN 6860
 6810 ADELAY 
 6820 PRINT "  Devices 4-7  ID=!4080    Devices on  ADCC EXTEND   (CODE";
 6830 PRINT "= 1,2)."
 6840 GOTO 6860
 6850 PRINT "  ID=";!FF(7);"  **Undefined Channel ID Code**"
 6860 ENDF 
 6865 .****************************************************************
 6870 FUNCTION CKDISCS 
 6880 FOR SS(3):=0 UNTIL 7
 6890 LET SS(2):=!300+SS(3)           .FORM STATUS CMD
 6900 BSIO LL
 6905 CLEAR 
 6910 WR 8,SS(2),2
 6920 RR 8,SS(0),4                    .READ UNIT STATUS
 6930 IN H,1,1
 6940 RSIO LL
 6943 GOSUB 7840                .CHECK CPVA
 6945 IF SS(1)=-1 THEN 7110
 6950 IF SS(1) AND 3 EQ 2 THEN 7110     .UNIT NOT THERE
 6955 PRINT 4;"Unit ";SS(3);12;
 6960 LET SS(4):=SS(1) AND !1E00      .GET DISC TYPE
 6970 IF SS(4)<>0 THEN 7000
 6980 PRINT "7906 Disc Drive"
 6990 GOTO 7110
 7000 IF SS(4)<>!200 THEN 7030
 7010 PRINT "7920 Disc Drive"
 7020 GOTO 7110
 7030 IF SS(4)<>!400 THEN 7060
 7040 PRINT "7905 Disc Drive"
 7050 GOTO 7110
 7060 IF SS(4)<>!600 THEN 7090
 7070 PRINT "7925 Disc Drive"
 7080 GOTO 7110
 7090 PRINT "Undefined unit detected"
 7110 NEXT 6880
 7120 ENDF 
 7125 .***************************************************************
 7130 FUNCTION CKMAGTAP 
 7135 LET L:=0
 7140 FOR SS(3):=1 UNTIL 4
 7150 BSIO LL
 7152 CHP !94                             .CLEAR
 7154 WAIT 
 7156 DSJ 7160
 7160 WR 1,SS(3),1,,R       .SELECT UNIT
 7170 WAIT 
 7180 DSJ 7190;SS(2)
 7190 RR 1,SS(4),3          .READ STATUS
 7195 JUMP 7200
 7200 IN H,1,1
 7210 RSIO 
 7214 GOSUB 7840                .CHECK CPVA
 7220 IFN SS(4) AND !100 THEN 7390            .UNIT NOT ON-LINE
 7230 LET SS(6):=SS(4) AND !60               .GET ON LINE UNIT #
 7240 IF SS(6)<>0 THEN 7270
 7250 PRINT 4;"Unit 0";
 7260 GOTO 7385
 7270 IF SS(6)<>!20 THEN 7300
 7280 PRINT 4;"Unit 1";
 7290 GOTO 7385
 7300 IF SS(6)<>!40 THEN 7330
 7310 PRINT 4;"Unit 2";
 7320 GOTO 7385
 7330 PRINT 4;"Unit 3";
 7385 PRINT 12;"7970E Mag Tape Drive"
 7388 LET L:=L+1
 7390 NEXT 7140
 7394 IF L<>0 THEN 7400
 7396 PRINT 4;"Unit ?";12;"7970E not on line or unit number not selected"
 7400 ENDF 
 7405 .******************************************************
 7410 FUNCTION CKSTCAP 
 7420 IF XX(0)=2 THEN 7500
 7430 IF XX(0)=!102 THEN 7500
 7440 IF XX(0)=!183 THEN 7500
 7450 IF XX(0)=!2000 THEN 7500
 7460 IF XX(0)=!2003 THEN 7500
 7470 IF XX(0)=!4000 THEN 7500
 7474 IF XX(0)=!4002 THEN 7500
 7477 IF XX(0)=!4003 THEN 7500
 7480 IF XX(0)=!6000 THEN 7500
 7490 IF XX(0)=!8000 THEN 7500
 7494 ENDF 
 7500 PRINT 8;"SELFTEST is not available on this device."
 7510 LET OFFSET:=2
 7520 ENDF 
 7530 .**********************************************************
 7540 FUNCTION CKLBKCAP 
 7550 IF XX(0)=!102 THEN 7620
 7560 IF XX(0)=!2000 THEN 7620
 7570 IF XX(0)=!2003 THEN 7620
 7580 IF XX(0)=!2080 THEN 7620
 7590 IF XX(0)=!4000 THEN 7620
 7594 IF XX(0)=!4002 THEN 7620
 7597 IF XX(0)=!4003 THEN 7620
 7600 IF XX(0)=!6000 THEN 7620
 7610 ENDF 
 7620 PRINT 8;"LOOPBACK is not available on this device."
 7630 LET OFFSET:=1
 7640 ENDF 
 7650 
 7660 .********************************************************************
 7670 LET X:=DEVICE OR !20,XX(1):=!800
 7690 IF DEVICE=7 THEN 7710
 7700 IF DEVICE=1 EQ DEVICE=2 EQ DEVICE=4 THEN 7720
 7710 LET X:=X OR !80            .ADD ODD PARITY BIT
 7720 BSIO MM
 7725 DSJ 7730;V
 7730 CHP !DF,!BF,X,4,!DF,!BF    .CLEAR CMD
 7740 IN H,1,1
 7750 RSIO MM
 7760 BSIO NN
 7770 WAIT 
 7775 GOSUB 7840                .CHECK CPVA
 7780 DSJ 7785;Y
 7785 RR 1,SS(0),5         .STATUS
 7790 WR 7,XX(1),1
 7800 IN H,1,1
 7810 RSIO NN
 7815 GOSUB 7840                .CHECK CPVA
 7820 RETURN 
 7830 .*************************************************************
 7840 IFN YY(0) THEN 7820             .CPVA FAILURE?
 7850 PRINTEX 0,"CHANNEL PROGRAM ABORT - CPVA(0) = ";!YY(0)
 7855 PRINTEX 0,"LAST FUNCTION CALLED BEFORE ERROR WAS ON LINE ";STATENUM
 7860 END