image of READY prompt

Wang2200.org

Listing of file='CIOV095' on disk='vmedia/731-0111.wvd.zip'

# Sector 207, program filename = 'CIOV095'
0010 REM CIOV095, 10/19/81, 2200-2200 DISK I/O VIA SEARCH (VP/MVP), COPYRIGHT
     WANG LABS,1981
0100 GOTO 9900
   : ON AGOTO 110,120,130,140,3000,4000,4100
0110 COM Y0,Y$8,Y,Y1,Y3,Y5,Y2,Z3,Z4,Z5,Z6,Z7,Z8,Z9,Y1$(16)8,Y9
0120 COM X0$8,X,X0,X1,X2,X3,X8,Z,Z1,Z2,Z0,Z9$(16),X$8,X5,W0
0130 COM Y$(4)64,Y8,Y6,Y4
0140 COM X$(4)64,X4,X6,X9$(60)4,X8$3,Y8$3
3000 IF A1$(5)<HEX(0080)THEN 3080
   : ON X8GOTO 3350,3510,3540,3060
   : X8=4
   : X$(3)=I$(1)
   : X$(4)=I$(2)
   : ON VAL(A1$(1))GOTO 3100,3040,3100
3040 DATA SAVE BA T#2,(X4,X4)X$()
   : RETURN
3060 X8=5
   : X$(1)=I$(1)
   : X$(2)=I$(2)
   : RETURN
3080 IF A1$(5)=HEX(0000)THEN 100
   : N$=I$(1)
   : PRINT D$(1)
   : PRINT N$
   : RETURN
3100 ON XGOTO 3160,3160
   : DATA SAVE BA T#2,(X4,X4)X$()
3160 LIMITS T#2,X$,X5,X6,A
   : ON XGOTO 3220,3220
   : DATA LOAD BA T#2,(X6,A)X$()
   : A=(X4-X5+1)/256
   : BIN(STR(X$(1),2,1))=A
   : BIN(STR(X$(1),3,1))=(A-INT(A))*256
   : IF X=4THEN 3220
   : STR(X$(1),1,1)=HEX(20)
3220 DATA SAVE BA T#2,(X6,A)X$()
   : ON XGOTO 3240,3260,3240,3260
3240 GOSUB '229(2,X$)
   : STR(Z9$(Z6),2,1)=HEX(80)
   : DATA SAVE BA T#2,(Z3,Z3)Z9$()
3260 PRINT D$(1);TAB(29);"Received "
   : X8=1
   : RETURN
3350 A$,X$=I$(1)
   : IF STR(A$,10,8)="Sectors="THEN 3420
   : IF VAL(X$)<>7THEN 3900
   : X$=STR(A$,19,8)
   : Z1=VAL(STR(A$,9),2)
   : A$=X$&" Sectors="
   : CONVERT Z1TO STR(A$,18,4),(####)
   : IF STR(I$(1),13,1)=HEX(05)THEN STR(A$,23)="D"
   : IF STR(I$(1),13,1)=HEX(06)THEN STR(A$,23)="P"
3420 CONVERT STR(A$,18,4)TO Z1
   : PRINT D$(1);TAB(29);"Receiving=";STR(A$,1,23);TAB(63)
   : X8=2
   : B$=STR(A$,23)
   : X=0
   : IF B$="P"THEN X=1
   : IF B$="D"THEN X=2
   : GOSUB '229(2,X$)
   : IF B$=HEX(00)THEN 3460
   : X$=X0$
   : X3=X3+1
   : CONVERT X3TO STR(X0$,7,2),(##)
3460 PRINT D$(1);"OPEN FILE=";X$
3470 W2=0
   : GOSUB '228(2,X$,Z1)
   : IF W2>0THEN 6190
   : IF B$<>"1"THEN 3480
   : X0=0
   : X$=" "
   : RETURN
3480 X0=1
   : LIMITS T#2,X$,X4,X5,X6
   : ERRORW2=ERR
   : GOSUB 6970
   : GOTO 6190
3490 X5=X4
   : X2=1
   : RETURN
3510 X8=3
   : ON VAL(A1$(1))GOTO 3100,100,3100
   : RETURN
3540 IF X>0THEN 3060
   : X=4
   : IF STR(I$(1),10,1)<>HEX(FD)THEN 3060
   : B$=I$(1)
   : AND (B$,AF)
   : IF B$=HEX(00)THEN X=3
   : GOTO 3060
3900 STOP "Wang 2200-2200 emulator on Sending side must be at least BSC 5.0"
4000 AND (STR(A2$(1),1,1),FE)
   : STR(A2$(2),2)=HEX(80)
   : IF Y=1THEN 4020
   : Y=1
   : MAT COPY Y$()<129,128>TO O$()<1,128>
   : Y6=Y6-1
   : IF Y6<1THEN 4050
   : DATA LOAD BA T#1,(Y4,Y4)Y$()
   : RETURN
4020 MAT COPY Y$()<1,128>TO O$()<1,128>
   : Y=0
   : RETURN
4030 IF Y9=0THEN 4040
   : GOSUB 4450
   : Y0=Y0+Y2
   : IF Y9>0THEN 100
4040 E$=HEX(01)
   : OR (A2$(1),05)
   : Y3=0
   : RETURN
4050 IF STR(W$,6,1)="T"THEN 4120
   : IF Y6<0THEN 4120
   : DATA LOAD BA T#1,(Y5,A)Y$()
   : RETURN
4100 Y3,Y0,Y1=0
   : A2$(1)=HEX(02)
   : F1=1
4110 GOSUB 4220
4120 OR (STR(A2$(1),1,1),01)
   : IF Y1<>0THEN 4130
   : AND (STR(A2$(1),1,1),FE)
   : IF Y3=1THEN 4030
   : GOSUB 4300
   : PRINT HEX(0C);TAB(63);HEX(0D);
   : IF Y1=0THEN 4030
   : Y3=1
4130 Y$=Y1$(Y1)
   : Y=0
   : LIMITS T#1,Y$,Y4,Y5,Y6,Y
   : ERRORW2=ERR
   : GOSUB 6970
   : GOTO 4405
4150 IF Y<1THEN 4404
   : Y8=Y5-Y4+1
   : IF Y6=1THEN Y6=Y8
   : PRINT D$(2);HEX(0C);TAB(63);HEX(0D);
   : IF Y9=0THEN 4175
   : PRINT "From Cat. sector ";Y9-1;TAB(30);
4175 PRINTUSING 4200,Y0+Y1,Y$
   : IF STR(W$,6,1)="D"THEN 4185
   : A$=Y$
   : STR(A$,10)="Sectors="
   : CONVERT Y8TO STR(A$,18,4),(####)
   : IF Y=1THEN STR(A$,23)="P"
   : IF Y=2THEN STR(A$,23)="D"
   : GOTO 4190
4185 BIN(B$)=5
   : IF Y=1THEN BIN(B$)=6
   : A$=HEX(0720202020201602)&BIN(Y8,2)&HEX(0C01)&B$&HEX(0F01000108)&STR(Y$,1,
     8)&HEX(FF)
4190 INIT(20)Y$()
   : Y$(1)=A$
   : Y1=Y1+1
   : IF Y1<>Y2THEN 4195
   : Y1=0
4195 Y=1
   : RETURN
4200 %SENDING FILE ### -- ########
4220 GOSUB 7400
4240 GOSUB '100(Y8$,X9$())
   : IF W1=0THEN 4245
   : PRINT AT(5,0);TAB(63)
   : PRINT AT(5,0);"Reenter --";
   : ON W1GOSUB 4250,4260,4265
   : GOTO 4240
4245 PRINT D$(2);TAB(63)
   : PRINT TAB(63)
   : PRINT TAB(63)
   : PRINT TAB(63)
   : PRINT AT(3,18);"from disk ";Y8$
   : RETURN
4250 PRINT "device address not in table"
   : RETURN
4260 PRINT "device already $OPEN'd"
   : RETURN
4265 PRINT "device is unavailable"
   : RETURN
4280 DEFFN'100(Y8$,X9$())
   : W1=0
   : PRINT D$(2);TAB(63)
   : PRINT D$(2);"ENTER SEND DISK ADDRESS";
   : LINPUT ?-Y8$
   : IF Y8$=" "THEN 4280
   : MAT SEARCHX9$(),=STR(Y8$,1,3)TO W2$STEP 4
   : IF VAL(W2$,2)=0THEN 4290
   : SELECT #1<Y8$>
   : $OPEN 4286,#1
   : $CLOSE#1
   : Z$=" "
   : HEXPACKZ$FROMSTR(Y8$,2,1)
   : Z1$=" "
   : GOSUB '120(Z$,Z1$)
   : IF Z1$=" "THEN RETURN
   : W1=3
   : RETURN
4286 W1=2
   : RETURN
4290 W1=1
   : RETURN
4300 Y1=1
   : INIT(20)Y1$()
   : Y9=0
   : PRINT D$(2);TAB(63);HEX(0D);"ENTER ALL or FILE NAME ";Y1;
   : INPUT Y$
   : IF Y$="ALL"THEN 4410
   : GOTO 4370
4340 PRINT "ALREADY IN LIST ";
   : GOTO 4350
4345 PRINT "SCRATCHED FILE ";
4350 PRINT "REENTER"
4360 Y$=" "
   : PRINT D$(2);TAB(63);HEX(0D);"ENTER FILE NAME ";Y1;
   : INPUT Y$
4370 PRINT TAB(63);HEX(0D);
   : IF Y$=" "THEN 4400
   : Y2=1
4380 IF Y1=Y2THEN 4390
   : IF Y1$(Y2)=Y$THEN 4340
   : Y2=Y2+1
   : GOTO 4380
4390 W2=0
   : GOSUB '229(1,Y$)
   : IF W2>0THEN 4405
   : IF B$=HEX(00)THEN 4350
   : IF B$=HEX(11)THEN 4345
   : Y1$(Y1)=Y$
   : Y1=Y1+1
   : IF Y1<17THEN 4360
4400 Y2=Y1
   : Y1=1
   : IF Y2<>1THEN 100
   : Y1=0
   : E$=HEX(00)
   : RETURN
4404 PRINT AT(5,0,63);"Unable to send file ";Y$
4405 Y1=Y1-1
   : GOTO 4110
4410 W2=0
   : GOSUB '229(1,Y$)
   : IF W2>0THEN 4405
   : IF B$=HEX(00)THEN 4420
   : GOSUB '229(1,"all.files")
   : IF B$>HEX(00)THEN 4370
4420 Y$="N"
   : PRINT D$(2);TAB(63);HEX(0D);"DO YOU WISH TO SEND ALL   Y/N";
   : INPUT Y$
   : IF Y$<>"Y"THEN 4300
4430 Y1=1
   : GOSUB 6420
   : IF Y1>1THEN 4400
4450 IF Y9<Z4THEN 4430
   : Y9=0
   : RETURN
4500 DEFFN'80
   : PRINT D$(3)
   : B$(3)="1"
   : IF X3>99THEN 4620
   : IF B$="1"THEN 4650
   : IF X0=0THEN 4590
   : B$(3)="0"
   : PRINT "Receive file ";X0$;" assigned to disk ";X8$
   : RETURN
4590 PRINT "RECEIVE DISK FILE NOT OPENED"
   : RETURN
4620 PRINT "ENTER NEW FILE NAME FOR RECEIVE DISK"
   : RETURN
4650 PRINT "INSUFFICIENT SPACE ON RECEIVE DISK"
   : RETURN
6000 DEFFN'83
   : PRINT HEX(0D010A0A0A);
   : FOR A=1TO 4
   : PRINT TAB(63)
   : NEXT A
   : PRINT HEX(010A);TAB(63);HEX(0D);"'0=CONTROL      '1=OPEN RECEIVE FILE
           '2=ERASE FILE";HEX(0D);
6035 KEYIN B$,6035,6045
   : GOTO 6035
6045 ON VAL(B$)+1GOTO 100,6190,6355
   : GOTO 6035
   : GOSUB 7200
6090 PRINT HEX(010A);TAB(63);HEX(0D);"'0=CONTROL";HEX(0D0A0A);TAB(63)
   : PRINT HEX(0C0D);
   : IF X0>0THEN 6095
   : X8$=" "
6095 GOSUB 7400
6100 GOSUB '101(X8$,X9$())
   : IF W1=0THEN 6110
   : PRINT AT(5,0);TAB(63)
   : PRINT AT(5,0);"Reenter --";
   : ON W1GOSUB 6120,6130,6135
   : GOTO 6100
6110 PRINT D$(2);TAB(63)
   : PRINT TAB(63)
   : PRINT TAB(63)
   : RETURN
6120 PRINT "device address not in table"
   : RETURN
6130 PRINT "device already $OPEN'd"
   : RETURN
6135 PRINT "device is unavailable"
   : RETURN
6150 DEFFN'101(X8$,X9$())
   : W1=0
   : PRINT D$(2);"ENTER RECEIVE DISK ADDRESS";
   : LINPUT ?-X8$
   : IF X8$=" "THEN 6150
   : MAT SEARCHX9$(),=STR(X8$,1,3)TO W2$STEP 4
   : IF VAL(W2$,2)=0THEN 6170
   : SELECT #2<X8$>
   : $OPEN 6162,#2
   : $CLOSE#2
   : Z$=" "
   : HEXPACKZ$FROMSTR(X8$,2,1)
   : Z1$=" "
   : GOSUB '120(Z$,Z1$)
   : IF Z1$=" "THEN RETURN
   : W1=3
   : RETURN
6162 W1=2
   : RETURN
6170 W1=1
   : RETURN
6185 GOSUB 4650
6190 GOSUB 6090
   : W2=0
   : GOSUB '128(2,10)
   : IF W2>0THEN 6190
   : PRINT HEX(0D010A0A);X6;" Sectors available ";"on disk ";X8$
   : IF B$="1"THEN 6185
   : PRINT TAB(63)
   : PRINT
   : GOSUB 6215
   : PRINT D$(2);TAB(63)
   : PRINT TAB(63)
   : PRINT AT(5,2);"Assuring disk may be written"
   : GOSUB 3470
   : GOSUB 7200
   : X$=X0$
   : X8,X0=1
   : RETURN
6215 PRINT HEX(0C0D);TAB(63);HEX(0D);
   : INPUT "ENTER 1- TO 6-CHARACTER FILE NAME",X$
   : IF LEN(X$)<=6THEN 6250
   : PRINT TAB(63);HEX(0D);"REENTER";
   : GOTO 6215
6250 PRINT "SEARCHING CATALOGUE";TAB(63);
   : W2=0
   : GOSUB '129(2,X$)
   : IF W2>0THEN 6190
   : IF B$=HEX(00)THEN 6290
   : PRINT HEX(0D);TAB(63);HEX(0D);"ROOT ";X$;" ALREADY CATALOGUED";
   : GOTO 6215
6290 X0$=X$
   : STR(X0$,7)="01"
   : X3=1
   : RETURN
6355 ON X0GOTO 6360
   : X0$=" "
   : GOSUB 6090
6360 X$=X0$
   : PRINT HEX(010A);TAB(63);HEX(0D);"'0=CONTROL";HEX(0D0A0A);
   : IF X8$=" "THEN 6395
   : PRINT TAB(63);"ERASE FILE ";X$;
   : IF X$<>" "THEN 6380
   : LINPUT ?-X$
6380 GOSUB 7200
   : IF W2<>0THEN 6190
   : RETURN
6395 X1=1
   : GOSUB 6090
   : X1=0
   : GOTO 6360
6420 DATA LOAD BA T#Z9,(Y9,Y9)Z9$()
   : FOR Z7=1TO 16
   : IF Y9>1THEN 6440
   : IF Z7<>1THEN 6440
   : Z7=2
6440 IF STR(Z9$(Z7),1,1)<>HEX(10)THEN 6480
   : Y1$(Y1)=STR(Z9$(Z7),9,8)
   : Y1=Y1+1
6480 NEXT Z7
   : RETURN
6500 DEFFN'229(Z9,STR(A$,1,8))
   : DATA LOAD BA T#Z9,(0,Z3)Z9$()
   : ERRORW2=ERR
   : GOSUB 6970
   : RETURN
6510 Z4=VAL(STR(Z9$(1),2,1))
   : STR(A$,9,8)=STR(A$,1,8)
   : XOR (STR(A$,10,7),STR(A$,9,8))
   : B$=STR(A$,16,1)
   : STR(A$,18,2)=HEX(0000)
   : ADDC(STR(A$,18,2),B$)
   : ADDC(STR(A$,18,2),B$)
   : ADDC(STR(A$,18,2),B$)
   : ADD(STR(A$,18,1),STR(A$,19,1))
   : Z3=VAL(STR(A$,18,2))
   : Z3=Z3-INT(Z3/Z4)*Z4
   : Z5=Z3
6620 DATA LOAD BA T#Z9,(Z3,Z8)Z9$()
   : Z6=0
   : FOR Z7=1TO 16
   : IF Z3<>0THEN 6680
   : IF Z7<>1THEN 6680
   : Z7=2
6680 B$=STR(Z9$(Z7),1,1)
   : IF B$=HEX(00)THEN 6740
   : IF B$=HEX(10)THEN 6720
   : IF B$<>HEX(11)THEN 6750
6720 IF STR(Z9$(Z7),9,8)<>STR(A$,1,8)THEN 6750
   : Z6=Z7
6740 Z7=16
6750 NEXT Z7
   : IF B$=HEX(00)THEN RETURN
   : IF Z6<>0THEN RETURN
   : B$=HEX(00)
   : Z3=Z3-1
   : IF Z3=Z5THEN RETURN
   : IF Z3>=0THEN 6620
   : Z3=Z4-1
   : GOTO 6620
6844 DEFFN'128(Z9,Z1)
   : DATA LOAD BA T#Z9,(0,Z3)Z9$()
   : ERRORW2=ERR
   : GOSUB 6970
   : RETURN
6845 Z2=VAL(STR(Z9$(),3),2)
   : Z3=VAL(STR(Z9$(),5),2)
   : B$="0"
   : X6=Z3-Z2
   : IF X6>Z1+2THEN 100
   : B$="1"
   : RETURN
6850 DEFFN'228(Z9,X$,Z1)
   : W2=0
   : GOSUB '128(Z9,Z1)
   : IF W2>0THEN RETURN
   : IF B$="1"THEN 100
   : DATA SAVE DC OPEN T#Z9,(Z1),X$
   : ERRORW2=ERR
   : GOSUB 6970
6851 RETURN
6970 Y$=" "
   : PRINT AT(5,0,63)
   : IF W2=95THEN 6980
   : IF W2<>98THEN 6990
   : PRINT "I98 (illegal sector address or platter not mounted)"
   : RETURN
6980 PRINT "I95 (device error - in PROTECT?)"
   : RETURN
6990 PRINT "Disk error = ";W2
   : RETURN
7000 DEFFN'129(Z9,X$)
   : Z=0
   : Z1,Z2=2
   : DATA LOAD BA T#Z9,(Z,Z)Z9$()
   : ERRORW2=ERR
   : GOSUB 6970
   : RETURN
7010 Z4=VAL(STR(Z9$(1),2,1))
7060 IF Z9$(Z1)=HEX(00000000000000000000000000000000)THEN 7100
   : IF STR(Z9$(Z1),9,6)=STR(X$,1,6)THEN 7160
7080 Z1=Z1+1
   : IF Z1<17THEN 7060
7100 Z1=1
   : IF Z=Z4THEN 7140
   : DATA LOAD BA T#Z9,(Z,Z)Z9$()
   : GOTO 7060
7140 B$=HEX(00)
   : RETURN
7160 B$=STR(Z9$(Z1),1,1)
   : IF B$=HEX(21)THEN 7080
   : RETURN
7200 PRINT HEX(0C0A0D);"SEARCHING FOR FILE";HEX(0D);
   : W2=0
   : GOSUB '229(2,X$)
   : IF W2<>0THEN 100
   : IF B$>HEX(00)THEN 7210
   : PRINT TAB(63);HEX(0D);"FILE NOT CATALOGUED"
   : GOTO 7300
7210 PRINT TAB(63);HEX(0D);"ERASING FILE ";X$
   : LIMITS T#Z9,X$,A,B,A
   : STR(Z9$(Z6),1,1)=HEX(21)
   : INIT(00)STR(Z9$(Z6),9,8)
   : DATA SAVE BA T#Z9,(Z3,Z8)Z9$()
   : STR(A$,18,2)=STR(Z9$(Z6),3,2)
   : DATA LOAD BA T#Z9,(0,Z8)Z9$()
   : IF VAL(STR(Z9$(),3),2)<>B+1THEN 7290
   : STR(Z9$(1),3,2)=STR(A$,18,2)
   : DATA SAVE BA T#Z9,(0,Z8)Z9$()
7290 PRINT TAB(63);HEX(0D);"FILE  ";X$;"  ERASED"
7300 X0=0
   : X$=" "
   : RETURN
7310 DEFFN'120(Z$,Z1$)
   : $GIO(731002000301122270A040008600,Z$)
   : ERRORW2=ERR
   : Z1$="unavailable"
   : RETURN
7330 IF STR(Z$,8,1)=HEX(00)THEN RETURN
   : Z1$="unavailable"
   : RETURN
7400 X9$()="310 320 330 340 350 360 370 B10 B20 B30 B40 B50 B60 B70 D10 D11 D1
     2 D13 D14 D15 D20 D21 D22 D23 D24 D25 D30 D31 D32 D33 D34 D35 D50 D51 D52
      D53 D54 D55 D60 D61 D62 D63 D64 D65 D70 D71 D72 D73 D74 D75"
   : RETURN