Listing of file='CIOVDPSS' on disk='vmedia/731-0111.wvd.zip'
# Sector 329, program filename = 'CIOVDPSS'
0010 REM CIOVDPSS, 10/05/81, OPEN DISK/PRT SAVE/SEARCH METHOD (VP/MVP), COPYRI
GHT WANG LABS,1981
0100 GOTO 9900
: ON AGOTO 105,3220,6259,6262,6264
0105 COM Z0,Z1,Z2,Z3,Z4,Z5,Z6,Z7,Z8,Z9,Z9$(16),Z,Z$(60)4,Z3$3
3220 DATA SAVE DC #2,END
: GOSUB '227(2,X$,0)
: X2=X2+1
: IF X2>99THEN 100
: CONVERT X2TO STR(X$,7,2),(##)
: GOSUB '228(2,X$,10)
: GOSUB '80
: X=0
: RETURN
4500 DEFFN'80
: PRINT D$(3)
: B$(3)="1"
: IF X2>99THEN 4620
: IF X0=0THEN 4590
: PRINT AT(5,0);"RECEIVE FILE ";X$;" OPENED";
: GOTO 4840
4590 PRINT AT(7,0);"RECEIVE DISK FILE NOT OPENED"
: RETURN
4620 PRINT AT(4,0);"ENTER NEW FILE NAME FOR RECEIVE DISK"
: RETURN
4840 $GIO#5(0100020112124000,Z$)
: IF STR(Z$,8,1)=HEX(10)THEN 4920
: INIT(20)X9$()
: X9=1E99
: IF X8<>0THEN 4880
: X8=1
4880 PRINT TAB(50)
: B$(3)="0"
: RETURN
4920 PRINT ,"PRINTER NOT READY"
: RETURN
6000 DEFFN'83
: PRINT HEX(0D010A0A0A);
: FOR A=1TO 4
: PRINT TAB(63)
: NEXT A
: PRINT HEX(0D010A);"'0=CONTROL '1=OPEN RCV FILE '2=ERASE FILE '12=PRT FM
T TAPE";HEX(0D);
6035 KEYIN B$,6035,6045
: GOTO 6035
6045 ON VAL(B$)+1GOTO 100,6190,6355
: ON VAL(B$)-11GOTO 6260
: GOTO 6035
6075 GOSUB 7200
6090 PRINT HEX(010A);TAB(63);HEX(0D);"'0=CONTROL";HEX(0D0A0A);TAB(64)
: PRINT HEX(0C0D);
: IF X0>0THEN 6075
: A=0
6095 Z$()="310 320 330 340 350 360 370 B10 B20 B30 B40 B50 B60 B70 D10 D11 D12
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"
6120 GOSUB '200(Z3$,Z$())
: IF X4=0THEN 6130
: PRINT AT(5,0);TAB(63)
: PRINT AT(5,0);"Reenter --";
: ON X4GOSUB 6160,6165,6170
: GOTO 6120
6130 PRINT D$(2);TAB(63)
: PRINT TAB(63)
: PRINT TAB(63)
: RETURN
6150 X4=1
: RETURN
6160 PRINT "device address not in table"
: RETURN
6165 PRINT "device already $OPEN'd"
: RETURN
6170 PRINT "device is unavailable"
: RETURN
6180 DEFFN'200(Z3$,Z$())
6185 X4=0
: PRINT D$(2);TAB(63)
: PRINT D$(2);"ENTER RECEIVE DISK ADDRESS";
: LINPUT ?-Z3$
: IF Z3$=" "THEN 6185
: MAT SEARCHZ$(),=STR(Z3$,1,3)TO X7$STEP 4
: IF VAL(X7$,2)=0THEN 6150
: SELECT #2<Z3$>
: $OPEN 6188,#2
: $CLOSE#2
: Z$=" "
: HEXPACKZ$FROMSTR(Z3$,2,1)
: Z1$=" "
: GOSUB '120(Z$,Z1$)
: IF Z1$<>"unavailable"THEN RETURN
: X4=3
: RETURN
6188 X4=2
: RETURN
6190 GOSUB 6090
: PRINT AT(5,0);TAB(63)
: PRINT TAB(63)
: W2=0
: GOSUB '128(2,10)
: IF W2>0THEN 6190
: PRINT AT(2,0);X6;" Sectors available";" on disk ";Z3$
6215 PRINT D$(2);TAB(63);HEX(0D)
: INPUT "ENTER 1- TO 6-CHARACTER FILE NAME",X$
: PRINT HEX(0C0D);TAB(63);HEX(0D0A);TAB(63);HEX(0D);
: IF X$=" "THEN 6240
: IF LEN(X$)<=6THEN 6250
6240 PRINT "REENTER";HEX(0D0C);
: GOTO 6215
6250 PRINT "SEARCHING CATALOGUE";
: 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.";HEX(0D0C)
;
: GOTO 6215
6259 %REM .'12 Set up printer format control tapes
6260 PRINT HEX(0D010A0A0A);
: FOR A=1TO 5
: PRINT TAB(80)
: NEXT A
: PRINT HEX(010A);TAB(80);HEX(0D)
6262 %REM ....!....1....!....2....!....3....!....4....!....5....!....6
6264 % " A B C D F M":REM A (top
of form) - line 5, B - skip to channel 11, C - skip to channel 22, D - sk
ip to channel 35, F - skip to channel 45 and M (end of page) - vertical l
ine 55.
6266 PRINT " 0= Default printer tape 2= User format tape 2"
: PRINT " 1= User format tape 1 3= User format tape 3"
6268 PRINT
: PRINT "See lines 6272, 6274, and 6276 for user tape formats."
: PRINT "Refer to user manual for instructions."
: PRINT "Key 0, 1, 2, or 3 for printer format tape."
: LINPUT ?B$
: ON VAL(B$)-47GOSUB 6270,6272,6274,6276,6270
: X9=POS(STR(X9$(),1)="M")
: RETURN
6270 STR(X9$(),1)=" "
: RETURN
6272 STR(X9$(),1)=" A B C D E F M"
: RETURN
6274 STR(X9$(),1)=" A B C D E F M"
: RETURN
6276 STR(X9$(),1)=" A B C D E F M"
: RETURN
6290 X2=1
: CONVERT X2TO STR(X$,7,2),(##)
: W2=0
: GOSUB '228(2,X$,10)
: IF W2>0THEN 6190
: IF B$="1"THEN 6350
: X0=1
: GOTO 3160
6350 RETURN
6355 ON X0GOTO 6360
: X$=" "
: GOSUB 6090
6360 PRINT HEX(010A);TAB(63);HEX(0D);"'0=CONTROL";HEX(0D0A0A);
: PRINT HEX(0D);TAB(63);HEX(0D);"ERASE File ";X$;
: IF X$<>" "THEN 6400
: LINPUT ?-X$
6400 GOSUB 7200
: IF W2>0THEN 6190
: 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 6840
: IF Z6<>0THEN 6840
: B$=HEX(00)
: Z3=Z3-1
: IF Z3=Z5THEN 6840
: IF Z3>=0THEN 6620
: Z3=Z4-1
: GOTO 6620
6840 RETURN
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 100
: IF B$="1"THEN 100
: IF X5=0THEN 6880
: IF X5>X6THEN 6880
: X6=X5
6880 DATA SAVE DC OPEN T#Z9,(X6),X$
: ERRORW2=ERR
: GOSUB 6970
6881 RETURN
6910 DEFFN'227(Z9,X$,Z1)
: LIMITS T#Z9,X$,Z2,Z3,Z0
: Z2,Z4=Z2+Z1+Z0-1
: DATA LOAD BA T#Z9,(Z3,Z3)Z9$()
: DATA SAVE BA T#Z9,(Z4,Z3)Z9$()
: GOSUB '229(Z9,X$)
: Z4=Z2
: BIN(STR(Z9$(Z6),5,1))=INT(Z4/256)
6950 BIN(STR(Z9$(Z6),6,1))=Z4-INT(Z4/256)*256
: DATA SAVE BA T#Z9,(Z3,Z3)Z9$()
: DATA LOAD BA T#Z9,(0,Z3)Z9$()
: BIN(STR(Z9$(1),3,1))=INT((Z4+1)/256)
: BIN(STR(Z9$(1),4,1))=Z4+1-INT((Z4+1)/256)*256
: DATA SAVE BA T#Z9,(0,Z3)Z9$()
: RETURN
6970 PRINT D$(3);TAB(63)
: IF W2=95THEN 6980
: IF W2<>98THEN 6990
: PRINT D$(3);"I98 (illegal sector address or platter not mounted)"
: RETURN
6980 PRINT D$(3);"I95 (device error - in PROTECT?)"
: RETURN
6990 PRINT D$(3);"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 ";X$;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
7320 IF STR(Z$,8,1)=HEX(00)THEN RETURN
: Z1$="unavailable"
: RETURN