Listing of file='HASP010B' on disk='vmedia/731-0111.wvd.zip'
# Sector 528, program filename = 'HASP010B'
0010 REM HASP010B 10/16/81
: GOTO 5000
0100 GOTO 9900
: ON AGOTO 1020,1060,1080,1090,1200,1210,5100,5200,9000
1000 $IF ON /001,2000
1020 $GIORCV#6(I1$(),I$())I0$()
: ON VAL(I$(1))GOTO 1040
: GOSUB 1195
1040 A=A
1050 $IF ON /001,2002
1060 ON W(2)GOSUB 1110,1140,1110
1070 $IF ON /001,2003
1080 IF W(3)=0THEN 1090
: $GIO#4(010002011212400040004000,Z$)
: C$=STR(Z$,8,1)
: ON W(3)GOSUB 1380,1450,1500,1380
1090 ON W(5)GOTO 1000,5240
1110 $GIOSND#6(O7$(),O8$())K2$()<,O8$(6)>
: IF STR(O8$(1),2,1)=HEX(03)THEN 2054
: IF O8$(4)=HEX(0008)THEN 100
: GOSUB '86(13,9,"Message Sent")
: W(2)=W(2)-1
: RETURN
1140 $GIOSND#6(O1$(),O$())O0$()<,O$(6)>
: IF STR(O$(1),2,1)=HEX(03)THEN 2054
: IF O$(4)=HEX(0008)THEN 100
: W(2)=W(2)-2
: RETURN
1195 C=VAL(STR(I$(5),2))
1200 ON VAL(I$(1))GOTO 100,1230,1260,100,100,100,100,5235,100
1210 W(5)=2
: ON VAL(STR(I$(1),2))GOTO 5210,5220,5230
: STOP "1220 microcode bug"
1230 IF D>2THEN 1235
: D=3
: PRINT HEX(03);"CONSOLE MESSAGES RECEIVED"
1235 $GIO#5(400D400AA000,A$)I0$()<1,C>
: RETURN
1260 IF C>R9-RTHEN 1310
1270 MAT COPY I$()<9,2>TO R$()<R,2>
: MAT COPY I0$()<1,C>TO R$()<R+2,C>
: R=R+C+2
: RETURN
1310 IF P=1THEN 1340
: A=R-P
: MAT COPY R$()<P,A>TO R$()<1,A>
: R=A+1
: P=1
1340 IF R<R9-132THEN 1260
: IF W(3)>1THEN 1345
: W(3)=2
1345 I1$(6)=HEX(01)
: IF R<R8THEN 1270
: I1$(6)=HEX(02)
: GOTO 1270
1370 ADD(P1$,01)
: IF P1$<HEX(FF)THEN 100
: IF K8<0THEN 100
: GOSUB '86(6,1,"Not Ready")
: W(3)=3
: RETURN
1380 IF C$=HEX(10)THEN 1370
: IF R=PTHEN 100
1390 P1$=P2$
: MAT COPY R$()<P+1,1>TO B$()
: C=VAL(B$(1))
: MAT COPY R$()<P+2,C>TO P$()<1,C>
: P=P+C+2
: B$=P$(1)
: IF B$>HEX(7F)THEN 1550
: IF B$="@"THEN 1680
: $GIO#4(A200,Z$)P$()<2,C-1>
1430 ON VAL(B$)-46GOTO 100,100,1580,1580,1580,1580,1580,1580,1580,1580,1580,15
80,1580,1580,1580,1580,1580,1680,1600,1610,1610,1610,1610,1610,1610,1610,
1610,1610,1610,1610,1610,1610,1610
: STOP "1435 -- ERROR -- IN PRINT CONTROL BYTE"
1450 IF C$=HEX(10)THEN 1370
: IF P<R-500THEN 1390
: IF K8<0THEN 100
: I1$(6)=HEX(00)
: W(3)=1
: RETURN
1500 IF C$=HEX(10)THEN 100
: GOSUB '85(6,1,9)
: W(3)=2
: P1$=P2$
: RETURN
1550 AND (B$,7F)
: GOSUB 1430
: $GIO#4(A200,Z$)P$()<2,C-1>
: RETURN
1570 B$="1"
1580 B=VAL(B$)-48
: IF P8+B>=P9THEN 1600
: $GIO#4(400D,Z$)
: IF B<2THEN 1590
: FOR A=2TO B
: $GIO#4(400A,Z$)
: NEXT A
1590 P8=P8+B
: RETURN
1600 $GIO#4(400D,Z$)
: IF P8>=P9THEN 1605
: $GIO#4(400C,Z$)
1605 P8=1
: RETURN
1610 MAT SEARCHP9$()<P8+1,150-P8>,=B$TO C$()
: B=VAL(STR(C$(1),2))
: IF B=0THEN 1630
: P8=P8+B
: IF P8>=P9THEN 1600
: $GIO#4(400D,Z$)
1620 IF B=1THEN 100
: FOR A=2TO B
: $GIO#4(400A,Z$)
: NEXT A
: RETURN
1630 MAT SEARCHP9$(),=B$TO C$()
: B=VAL(STR(C$(1),2))
: IF B=0THEN 1570
: $GIO#4(400D400C,Z$)
: P8=B
: GOTO 1620
1680 MAT COPY P$()<2,C-1>TO P9$()<2,C-1>
: B$="M"
: MAT SEARCHP9$()<1,99>,=B$TO C$()
: IF C$(1)=HEX(0000)THEN 100
: P9=VAL(STR(C$(1),2))
: RETURN
1910 DEFFN'85(A1,B1,C1)
: INIT(20)A$()
1920 MAT COPY A$()<1,C1>TO D$()<D(A1)+B1+8,C1>
1930 DEFFN'89
: IF D>1THEN 100
: IF W(1)<>1THEN 100
: $GIO#5(A000,Z$)D$()
: RETURN
1970 DEFFN'86(A1,B1,A$(1))
: C1=LEN(A$(1))
: GOTO 1920
1975 DEFFN'87(A1,B1,C1,A$(1))
: GOTO 1920
1980 DEFFN'88(A1,B1,C1)
: MAT COPY D$()<D(A1)+B1+8,C1>TO A$()<1,C1>
: RETURN
2000 ON W(K)GOSUB 2008,2220,2100
: GOTO 1000
2002 ON W(K)GOSUB 2008,2220,2100
: GOTO 1050
2003 ON W(K)GOSUB 2008,2220,2100
: GOTO 1070
2008 KEYIN C$,100,2010
: RETURN
2010 ON VAL(C$)+1GOTO 2030,2040,2050,2060,2070,2080,2090
: RETURN
2030 I1$(10)=HEX(00)
: GOSUB '85(16,1,64)
: D=1
: GOSUB '91
: ON W(2)GOTO 2485
: RETURN
2040 RETURN
2050 IF W(H)>0THEN 2054
: W(H)=-W(H)
: RETURN
2054 ON W(2)GOTO 100
: GOSUB '87(H9,1,12,"ABORT")
: GOSUB '85(H9+1,1,64)
: GOSUB '87(2,23,5,"SEND")
: O1$(4)=HEX(01)
: W(H)=-1
: RETURN
2060 A$="CONSOLE ENTRY"
: K1=1
: GOTO 2500
2070 A$="ENTER SIGNON"
: K1=0
: GOTO 2500
2079 DEFFN'93
2080 IF K9=0THEN 100
: K9=-K9
: A$="EOF"
: ON K9GOTO 2085
: A$=" "
2085 GOSUB '87(H9,1,5,A$)
: RETURN
2090 IF K8=0THEN 100
: K8=-K8
: A$=" "
: W(3)=2
: ON K8GOTO 2095
: A$="Suspended"
: W(3)=4
: IF I1$(6)>HEX(00)THEN 2095
: I1$(6)=HEX(01)
2095 GOSUB '87(6,1,9,A$)
: RETURN
2100 KEYIN C$,100,2120
: RETURN
2120 MAT SEARCHK1$()<1,16>,=C$TO C$()
: IF C$(1)=HEX(0000)THEN 100
: HEXPRINT C$
: K2$(1)=C$
: D=D-1
: W(K1)=K2
: W(K)=0
: RETURN
2220 KEYIN C$,2230,2270
: RETURN
2230 IF C$=HEX(0D)THEN 2400
: IF C$=HEX(08)THEN 2370
: IF C$=HEX(E5)THEN 2250
: K2$(K3)=C$
: $GIO#5(A000,A2$)C$
: IF K3=LTHEN 2238
: K3=K3+1
: IF K3<K5THEN 100
: K5=K3-1
: RETURN
2238 K5=K3
2240 $GIO#5(400DA000,A2$)K2$()<1,L>
2245 INIT(09)A$()
: STR(A$(1),1,1)=HEX(00)
: $GIO#5(400DA000,A2$)A$()<1,K3>
: RETURN
2250 INIT(" ")K2$()
: K3=1
: K5=0
: $GIO#5(400DA000400D,A2$)K2$()
: RETURN
2270 IF C$=HEX(00)THEN 2280
: ON VAL(C$)-5GOTO 2275,2290,2300,2320,2330,2340,2350,2370,2360
: RETURN
2275 K3=L
: GOTO 2245
2280 D=D-1
: W(K)=1
: GOSUB '91
: IF K1<2THEN 100
: W(K1)=-1
: RETURN
2290 K3=1
: $GIO#5(400D,A2$)
: RETURN
2300 INIT(20)B$()
: $TRAN(K2$()<K3,L-K3+1>,B$())00
: K5=K3-1
: GOTO 2240
2320 A=K5-K3
: MAT COPY K2$()<K3+1,A>TO K2$()<K3,A>
: K2$(K5)=" "
: K5=K5-1
: GOTO 2240
2330 A=L-K3
: MAT COPY -K2$()<K3,A>TO -K2$()<K3+1,A>
: K2$(K3)=" "
: K5=K5+1
: IF K5<LTHEN 2240
: K5=L
: GOTO 2240
2340 K3=K3+4
2350 K3=K3+1
: IF K3<LTHEN 2245
: K3=L
: GOTO 2245
2360 K3=K3-4
2370 K3=K3-1
: IF K3>0THEN 2245
: K3=1
: GOTO 2245
2400 I1$(10)=HEX(00)
: GOSUB '92
: ON K1+1GOTO 2450,2420
: D=D-1
: W(K1)=K2
: W(K)=0
: RETURN
2420 A$="Console"
: GOTO 2460
2450 A$="Signon"
2460 D=1
: IF K5=0THEN 2480
: GOSUB '87(13,1,64,A$)
: INIT(00)O8$()
: BIN(STR(O8$(6),2))=80
: O7$(6)=HEX(00)
: IF K1=1THEN 2470
: O7$(6)=HEX(02)
2470 W(K)=1
: W(2)=W(2)+1
: MAT COPY K2$()<1,64>TO A$()
: GOSUB '87(14,1,64,A$(1))
: RETURN
2480 GOSUB '85(13,1,64)
: W(K)=1
: GOSUB '85(14,1,64)
: RETURN
2485 GOSUB '86(13,9,"Aborted")
: W(2)=0
: RETURN
2495 DEFFN'96(K1,K2,K1$)
: RETURN CLEAR
: W(K1)=0
2500 ON W(2)GOTO 100
: I1$(10)=HEX(02)
: W(K)=2
: INIT(" ")K2$()
: K3=1
: K5=0
: D=D+1
: IF D=4THEN 2520
: GOSUB '92
2520 SELECT PRINT 005
: PRINT
: PRINT A$;" '0 ABORT"
: IF K1>1THEN 2570
: A$(1)="....!....1....!....2....!....3....!....4....!....5....!....6...."
: A$(2)="!....7....!....8"
: $GIO#5(A000400D400A,A2$)A$()<1,L>
: GOTO 2580
2570 $GIO#5(A000400D400A,A2$)K1$
2580 INIT(" ")A$()
: $GIO#5(A000400D,A2$)A$()
: RETURN
2910 DEFFN'91
: GOSUB '92
: GOSUB '89
: RETURN
2920 DEFFN'92
: $GIO#5(4003,A2$)
: RETURN
2930 DEFFN'95(K1,K2,K1$(1))
: W(K)=3
: D=D+1
: RETURN
2970 DEFFN'97(B)
: K1$=HEX(101020203030)
: Z$=STR(K1$,A,1)
: K1$=" "
: $GIO(73100101121270A040008600,Z$)
: IF STR(Z$,8,1)=HEX(00)THEN 100
: K1$="Unavailable"
: RETURN
5000 GOSUB '92
5100 GOSUB '89
: W(H)=-1
: R,P,W(1),W(5)=1
: W(2)=0
: IF K9=0THEN 5140
: GOSUB '86(2,49,"'5=EOF")
5140 A=A
5200 $GIOCONNECT#6(4406,A$)
: GOTO 1000
5210 GOSUB '87(16,1,64,"Data Set Ready Not On")
: RETURN
5220 GOSUB '87(16,1,64,"Abort Received")
: RETURN
5230 GOSUB '87(16,1,64,"Line Disconnected")
: RETURN
5235 GOSUB '87(16,1,64,"ILLEGAL MESSAGE TYPE RECEIVED")
: RETURN
5240 IF I$(1)<HEX(0004)THEN 1000
: W(5)=1
: GOSUB '85(16,1,64)
: GOTO 1000
9000 ON ERRORD0$,D1$GOTO 9010
9010 A$="ERROR = AT LINE ="
: STR(A$,9,5)=D0$
: STR(A$,25)=D1$
: GOSUB '87(16,1,64,A$)
9030 DEFFN'0
: D,W(K)=1
: GOSUB '91
: IF K1<2THEN 1000
: W(K1)=-1
: GOTO 1000
9990 DEFFN'31
: $GIO#6(4580,A$)
: RETURN