Listing of file='27B*HOOK' on disk='vmedia/tbo_81.wvd.zip'
# Sector 699, program filename = '27B*HOOK'
0010 REM 27B*HOOK 08/05/77 ---2228/27B HOOK IN TEST---PREPARED BY TYLER OLSEN
, WANG LABS R&D
0020 DIM I1$64,I1$(50)64,E$(7)8
: GOTO 520
: REM /SET-UP
0030 DIM C1$(16)16,C2$(16)16, I$(250)1, B$1,C$1, B$(5)4, S$(6)1
0040 REM % OUTPUT KEYED DATA TO 2227B
0050 $GIO SEND DATA #1(G9$,A$)C$
0060 REM %KEYBOARD/T.C. TEST LOOP
0070 $IF ON /001,310
0080 $GIO READ STATUS #1 (G1$,A$)S$()
0090 IF S$(3)>HEX(00)THEN 270
: REM /ERROR
0100 IF S$(1)>HEX(00)THEN 280
: REM /TEST BREAK
0110 IF S$(4)=HEX(00)THEN 70
: REM / TEST COUNT
0120 $GIO INPUT RCVD DATA #1 (G7$,A$) I$()<I>
0130 A= VAL(STR(A$,10))
0140 IF A+D>64THEN 180
0150 $GIO /005(A000,A$)I$()<I,A>
: REM ..ERR 98 DENOTES BUFFER OVERFLOW KEY S.F. '10 FOR ANALYSIS
0160 D=D+A
: GOTO 220
0170 REM DISPLAY OVERRUN
0180 B=65-D
0190 $GIO /005(A000 400D 400A,A$)I$()<I,B>
0200 D=A-B
0210 $GIO /005(A000,A$)I$()<I+B,D>
0220 I=I+A
: A=I-1
0230 C$=I$(A)
: AND (C$,7F)
: IF C$<>HEX(0D)THEN 70
0240 PRINT
0250 MAT COPY I$()<1,I>TO I1$()<I1,I>
: I1=I1+I
0260 INIT(00)I$()
: D,I=1
: GOTO 70
0270 PRINT E$(VAL(S$(3)));
: GOTO 80
: REM /RCV ERROR
0280 PRINT "...BREAK RECEIVED"
: GOTO 70
0290 REM %^******** KEY BOARD LOGIC FOLLOWS
0300 REM I$() INPUT BUFFER IS CLEARED ON KEYBOARD C.R.
0310 SELECT PRINT 005
: KEYIN C$,320,450
0320 ON O GOTO 360
: ON I GOTO 350
0330 $GIO/215(A000,A$)I$()<1,I-1>
: I=1
0340 SELECT PRINT 215
: PRINT "<<K.B. RESPONSE>>";
: SELECT PRINT 005
0350 $GIO/215(A000,A$)C$
0360 IF C$<HEX(20)THEN 400
0370 PRINT C$;
0380 D=D+1
: IF D<65THEN 50
: PRINT
: D=1
: GOTO 50
0385 IF I=1THEN 390
: MAT COPY I$()<1,I>TO I1$()<I1,I>
: I1=I1+I
0390 PRINT
: INIT(00)I$()
: D,I=1
: GOTO 50
0400 ON VAL(C$)-7GOTO 420,370,410,50,50,385
: GOTO 50
: REM /'08'THRU'0D'
0410 PRINT C$;
: GOTO 50
0420 D=D-1
: IF D>0THEN 430
: D=64
: PRINT HEX(0C);
0430 PRINT HEX(082008);
: GOTO 50
0440 REM % SPECIAL FUNCTION PAD
0450 ON VAL(C$)-6GOTO 410,420,370,410,50,50,50,460,480
: GOTO 50
: REM /'07'THRU'0F'
0460 O=-O
: PRINT "PRT ";
: ON OGOTO 470
: PRINT "ON"
: GOTO 70
0470 PRINT "OFF"
: GOTO 70
0480 PRINT "....SEND BREAK"
: $GIO #1(4407,A$)
0490 GOTO 70
0500 REM %^ INITIALIZATION
0510 REM DEFINE $GIO ARGUMENTS TO OPERATE CONTROLLER
0520 G0$=HEX(4402A000440C)
: REM /SET COM. CTRL VECTOR
0530 G1$=HEX(4403C620)
: REM /READ COM. STAT VECTOR
0540 G4$=HEX(4404A000440C)
: REM /LOAD TX CODE TABLE
0550 G3$=HEX(4405A000440C)
: REM /LOAD RX CODE TABLE
0560 G6$=HEX(4408)
: REM /START RECEIVE
0570 G7$=HEX(4409C620)
: REM /INPUT RECEIVED DATA
0580 G8$=HEX(440AA000440C)
: REM /SEND DATA
0590 G9$=HEX(440BA000440C)
: REM /SEND-THEN-RECEIVE DATA
0600 SELECT #1 01C
: REM / SELECT 2227B AS #1
0610 PRINT HEX(03),,"2227B KEYBOARD/TIME SHARE INTERACTION"
0620 PRINT " THIS PROGRAM IS WRITTEN TO AID IN HOOKIN TO AN UNKNOWN SYSTEM"
0630 PRINT "S.F. '1 = EMULATE TELETYPE 110 BAUD"
0640 PRINT "S.F. '2 = EMULATE TELETYPE 300 BAUD"
0650 PRINT "S.F. '3 = EMULATE TELETYPE 1200 BAUD"
0660 PRINT "S.F. '10 = AFTER CONNECTION TO DETERMINE DATA PATTERN"
0670 PRINT
: PRINT "RECEIVED ERRORS WILL DISPLAY AS FOLLOWS:"
0680 REM SET CRT REMARK ON RECEIVE ERRORS
0690 E$(1)="<PAR>"
: REM /PARITY ERROR
0700 E$(7),E$(6),E$(3),E$(2)=".OVERRUN."
: REM /OVERRUN
0710 E$(5),E$(4)="<FRM>"
: REM /FRAMING ERROR
0720 PRINT " PARITY=";
: PRINT E$(1)
0730 PRINT " OVERRUN=";
: PRINT E$(2)
0740 PRINT " FRAMING=";
: PRINT E$(4)
0750 STOP " KEY DESIRED START-UP"
0760 REM %^ DEFINE EMULATOR
0770 DEFFN'1
: REM /110 BAUD
0780 B$(1)=HEX(3321307F)
0790 B$(2)=HEX(00000000)
0800 B$(3)=HEX(1C0C0000)
: REM /BREAK SND=200 DET=120
0810 B$(4)=HEX(00000000)
0820 B$(5)=HEX(00000000)
0825 PRINT HEX(03),,"EMULATE TELETYPE"
0830 GOSUB 1070
: REM /SHOW PARAMETERS IN USE
0840 C$=HEX(00)
: O,D,I=1
: PRINT
0850 PRINT "S.F. KEYS MAY BE USED TO SEND CONTROL CODE EQUIVALENTS"
0860 PRINT " E.G. '27=HEX(1B)=ESCAPE"
0870 PRINT " '17=HEX(11)=X-ON"
0880 PRINT " S.F. '14 PUTS OUTPUT ON/OFF LINE PRINTER"
0890 PRINT " S.F. '15 IS PROGRAMMED TO SEND A BREAK SIGNAL."
0900 ON Z9GOTO 910
: $GIO RESET #1(4580,A$)
0910 $GIO SET CONTROLS #1 (G0$,A$)B$()
0920 I1=0
: INPUT "KEY 0 FOR NO 1 FOR EVEN 2 FOR ODD PARITY",I1
0930 ON I1GOTO 1260,1380
0940 I1=1
: INIT(20)I1$()
0950 $GIO START RCV #1 (G6$,A$)
0960 PRINT
: PRINT
: PRINT "KEYBOARD/T.C. NOW ACTIVE"
: GOTO 70
0970 DEFFN'2
: REM /300 BAUD
0980 B$(1)=HEX(1721307F)
0990 GOTO 790
1000 DEFFN'3
: REM /1200 BAUD
1010 B$(1)=HEX(1913307F)
1020 GOTO 790
1030 REM %^ PARAMETER DESCRIPTIONS
1040 DEFFN'15
: PRINT
: HEXPRINT B$()
1050 DIM P2$(16)4,P3$(4),P4$(4),P6$(4)
1060 REM %..BAUD RATE
1070 P2$(1)="50"
: P2$(2)="75"
: P2$(3)="100"
: P2$(4)="110"
1080 P2$(5)="134"
: P2$(6)="150"
: P2$(7)="200"
: P2$(8)="300"
1090 P2$(9)="600"
: P2$(10)="1200"
: P2$(11)="1800"
: P2$(12)="2400"
1100 P2$(13)="3600"
: P2$(14)="4800"
: P2$(15)="7200"
: P2$(16)="9600"
1110 REM %..MODE
1120 P3$(1)="HALF DUPLEX"
: P3$(2)="HALF W/DEL"
: P3$(3)="FULL DUPLEX"
: P3$(4)="FULL W/DEL"
1130 REM %..BREAK HANDLING
1140 P4$(1)="DISABLE"
: P4$(2)="ENABLE T/R"
: P4$(3)="BRK ON 2ND"
: P4$(4)="BRK INVERTED"
1150 REM %..PARITY
1160 P6$(1)="NO"
: P6$(2)="EVEN"
: P6$(3)="NO"
: P6$(4)="ODD"
1170 C$=STR(B$(1),1)
: ROTATE(C$,4)
: AND (C$,0F)
: PRINT ((VAL(C$)+1))/2;" STOP BITS--";
1180 C$=STR(B$(1),1)
: AND (C$,0F)
: PRINT P2$(VAL(C$)+1);" BAUD--";
1190 C$=STR(B$(1),2)
: ROTATE(C$,4)
: AND (C$,0F)
: PRINT P3$(VAL(C$)+1);" MODE--";
1200 C$=STR(B$(1),2)
: AND (C$,0F)
: PRINT P4$(VAL(C$)+1);" BREAK--"
1210 C$=STR(B$(1),3)
: ROTATE(C$,4)
: AND (C$,0F)
: PRINT VAL(C$)+5;" DATA BITS--";
1220 C$=STR(B$(1),3)
: AND (C$,0F)
: PRINT P6$(VAL(C$)+1);" PARITY";
1230 RETURN
1240 REM %^VALUES FOR SEND TRANSLATION
1250 REM TABLE WITH EVEN PARITY
1260 C1$(1),C1$(9) =HEX(008182038405068788090A8B0C8D8E0F)
1270 C1$(2),C1$(10)=HEX(901112931495961798999A1B9C1D1E9F)
1280 C1$(3),C1$(11)=HEX(A02122A324A5A62728A9AA2BAC2D2EAF)
1290 C1$(4),C1$(12)=HEX(30B1B233B43536B7B8393ABB3CBDBE3F)
1300 C1$(5),C1$(13)=HEX(C04142C344C5C64748C9CA4BCC4D4ECF)
1310 C1$(6),C1$(14)=HEX(50D1D253D45556D7D8595ADB5CDDDE5F)
1320 C1$(7),C1$(15)=HEX(60E1E263E46566E7E8696AEB6CEDEE6F)
1330 C1$(8),C1$(16)=HEX(F07172F374F5F67778F9FA7BFC7D7EFF)
1340 GOTO 1460
1350 REM ...............^.....^...^.^.....^.^...^.....^.
1360 REM .................^.^...^.....^.^.....^...^.^...
1370 REM TABLE WITH ODD PARITY
1380 C1$(1),C1$(9) =HEX(800102830485860708898A0B8C0D0E8F)
1390 C1$(2),C1$(10)=HEX(109192139415169798191A9B1C9D9E1F)
1400 C1$(3),C1$(11)=HEX(20A1A223A42526A7A8292AAB2CADAE2F)
1410 C1$(4),C1$(12)=HEX(B03132B334B5B63738B9BA3BBC3D3EBF)
1420 C1$(5),C1$(13)=HEX(40C1C243C44546C7C8494ACB4CCDCE4F)
1430 C1$(6),C1$(14)=HEX(D05152D354D5D65758D9DA5BDC5D5EDF)
1440 C1$(7),C1$(15)=HEX(E06162E364E5E66768E9EA6BEC6D6EEF)
1450 C1$(8),C1$(16)=HEX(70F1F273F47576F7F8797AFB7CFDFE7F)
1460 $GIO SET SEND TABLE #1(G4$,A$)C1$()
1470 GOTO 940
1480 REM %^ANALYZE RESULTS
1490 REM PROGRAM IS SET TO ALWAYS RECEIVE 8 DATA BITS+1 STOP
1500 REM USER SELECTS TRANSMISSION 7+EVEN 7+ODD 7+NO
1510 DEFFN'10
: SELECT PRINT 005
: PRINT HEX(03);"ANALYZE RECEIVED DATA"
1520 IF I1>0THEN 1530
: STOP "NO DATA TO ANALYZE"
1530 IF I1+I<250 THEN 1540
: I=1
: IF I1>250THEN 1540
: I=250-I1
1540 MAT COPY I$()<1,I>TO I1$()<I1,I>
: I=1
1550 D=0
: INPUT "KEY 1 FOR HARD COPY",D
: IF D=0THEN 1560
: SELECT PRINT 215
: INPUT "COMMENT",I1$
: PRINT HEX(0C0E);"HOOK IN TEST"
: PRINT I1$
1560 I1$=I1$(1)
: GOSUB 1570
: GOTO 1680
1570 PRINT "RECEIVED DATA PATTERN IS--";
1580 A=POS(STR(I1$,1,LEN(I1$))>7F)
: IF A=0 THEN 1650
1590 A=POS(STR(I1$,1,LEN(I1$))<80)
: IF A=0 THEN 1670
1600 PRINT "7 DATA BITS +PARITY=";
: REM /..SOME 80 BITS ON
1610 C$=STR(I1$,LEN(I1$),1)
: A=0
: FOR Z=1TO 8
: IF C$<HEX(7F)THEN 1620
: A=A+1
1620 ROTATE(C$,1)
: NEXT Z
: BIN(C$)=A
: AND (C$,01)
1630 IF C$=HEX(01)THEN 1640
: PRINT "EVEN"
: RETURN
1640 PRINT "ODD"
: RETURN
1650 PRINT "8 DATA BITS +NO PARITY"
: RETURN
: REM /.NO 80 BITS ON
1660 RETURN
1670 PRINT "7 DATA BITS +STRAPPED 80 BIT"
: RETURN
1680 I1$=I1$(I)
: PRINT
: PRINT "<<<RECEIVED DATA FOR BLOCK ";I
: PRINT I1$
1690 AND (I1$,7F)
: PRINT
: PRINT "CODES WITH VALUES 00-1F OR 7F"
: A=0
1700 FOR A=1 TO LEN(I1$)
: C$=STR(I1$,A,1)
1710 IF C$<" "THEN 1720
: IF C$<>HEX(7F)THEN 1730
1720 HEXPRINT C$;
: PRINT " ";
1730 NEXT A
: PRINT ">>>"
1735 PRINT "DISPLAY IN HEX"
: HEXPRINT STR(I1$(I),1,LEN(I1$(I)))
1740 IF I1$(I+1)<>" "THEN 1750
: SELECT PRINT 005
: END
1750 IF D=1THEN 1760
: INPUT "KEY EXEC FOR MORE DATA",I
1760 PRINT
: PRINT
: PRINT HEX(03)
: I=I+1
: GOTO 1680
1800 DEFFN'11
: PRINT "DISPLAY IN HEX"
: HEXPRINT STR(I1$(I),1,LEN(I1$(I)))
1810 HEXPRINT STR(I1$,1,LEN(I1$))
: PRINT I1$
: RETURN