Listing of file='2229SUB' on disk='vmedia/mvp-diag-2.6.2.wvd.zip'
# Sector 1590, program filename = '2229SUB'
5000 REM % "2229SUB" - part of 2229 utilities package
5005 REM ST 01/21/1983
5010 DIM U8$2
5100 DEFFN'102
: REM % BOARD STATUS
5115 S$=ALL(20)
: R$=ALL(01)
5120 $GIO#4(4402 8701 1800 C340,R$)STR(S$,1,VAL(STR(R$,1,1)))
: RETURN
5250 DEFFN'104
: REM % LOAD TAPE
5260 PRINT HEX(020404000E)
: M$="Loading Tape"
: GOSUB '160
: $GIO#4(4404 8701,R$)
: PRINT HEX(0F)
: GOSUB '222
: REM GET ERROR
: IF E=0THEN RETURN
: IF E<>3THEN 7540
5275 GOSUB '208
: GOTO 5260
5300 DEFFN'105
: REM % UNLOAD TAPE
5305 PRINT HEX(020404000E)
: M$="Unloading tape"
: GOSUB '160
5310 $GIO#4(4405 8701,R$)
: PRINT HEX(0F)
: GOSUB '222
5315 IF E=0THEN RETURN
: IF E<>3THEN 7540
: GOSUB '208
: GOTO 5305
5400 DEFFN'108
: REM % SPACE IBG
5410 $GIO#4(4408 8701,R$)
: GOSUB '222
: RETURN
5500 DEFFN'110
: REM %SPACE FILE MARK
5510 M$="Searching for file mark"
: GOSUB '160
: F3=0
: REM NO FILE MARK
5520 $GIO#4(440A 8701,R$)
: GOSUB '222
5530 IF E=2THEN RETURN
: IF E=7THEN F3=1
: IF F3=1THEN RETURN
: IF E<>3THEN 7540
: GOSUB '208
: GOTO 5510
5600 DEFFN'111
: REM % SPACE REVERSE FILE MARK
: $GIO#4(440B 8701,R$)
: GOSUB '222
: IF E=0OR E=7OR E=2THEN RETURN
: GOTO 7540
5650 DEFFN'112
: REM %READ
5660 $GIO#4 (440C 8701,R$)
: B=0
: GOSUB '222
: IF E=0THEN 5680
: IF E<>7THEN 5665
: F3=1
: REM FM FOUND
: RETURN
5665 IF E=2THEN STOP "OUT OF TAPE"
: IF E=6THEN STOP "DATA ERROR ON READ"
: GOSUB '208
: GOTO 5660
5680 $GIO#4(8703 8704,R$)
: REM GET BYTE COUNT
5685 IF F3=1THEN 5690
: REM JUMP IF PREVIOUS RECORD WAS FM
: $GIO#4(1800 C340 1936 1801 C340,R$)C$; STR(A1$(),1,VAL(STR(R$,3,2),2))
: GOTO 5700
5690 REM PREVIOUS RECORD WAS FILE MARK, SO THIS IS LABEL
: $GIO#4(1800 C340,R$)STR(A1$(),1,VAL(STR(R$,3,2),2))
5700 B=VAL(STR(R$,3,2),2)
: REM # OF BYTES
: IF F3=1THEN 5710
: C=VAL(C$,2)
: C1=C1+1
: REM BLOCK COUNT
5710 F3=0
: RETURN
5750 DEFFN'155
: REM % CHANGE WRITE CURRENT FOR 600 FOOT TAPE
5760 $GIO#4(4432 8701,R$)
: GOSUB '222
: RETURN
5790 DEFFN'213
: REM %WRITE LABEL
: W=1
: B=256
: GOTO 5805
5800 DEFFN'113
: REM %WRITE RECORD
: W=0
5805 STR(R$,3,2)=BIN(B,2)
: IF W=1THEN 5810
: $GIO(1935,R$)
: REM INC BYTE COUNT BY 2 IF NOT LABEL
5810 STR(R$,2,1)=HEX(00)
: $GIO#4(440D 4230 4240 8701,R$)
: GOSUB '222
: IF E=0THEN 5820
: IF E=5THEN GOSUB '220
: REM END WRITE IF NECESSARY
: IF E=2THEN RETURN
: IF E<>3THEN 7540
: GOSUB '208
: GOTO 5810
5820 IF W=1THEN 5840
: C=C+1
: C$=BIN(C,2)
: $GIO(1936,R$)
: REM DEC COUNT
5830 $GIO#4(1300 A000,R$)C$
5840 $GIO#4(1300 A000,R$)STR(A1$(),1,VAL(STR(R$,3,2),2))
5845 IF W=1THEN GOSUB '220
: REM IF LABEL DO ENDWRITE
: RETURN
6000 DEFFN'115
: REM % WRITE FILE MARK
6005 $GIO#4(440F 8701,R$)
: GOSUB '222
: IF E=0 OR E = 2 THEN RETURN
: IF E<>3THEN 7540
6010 GOSUB '208
: GOTO 6005
6400 DEFFN'220
: REM % ENDWRITE
6410 STR(R$,2,1)=HEX(00)
: $GIO#4 (4420 8701 8702,R$)
: GOSUB '222
: RETURN
6500 DEFFN'160
: REM PRINT OUT MESSAGE
: PRINT HEX(06),AT(10,0,320);M$
: RETURN
7000 DEFFN'240
: REM % GET VOLUME PARAMETERS
7005 PRINT HEX(06);AT(4,0,);"Tape Volume Name"
: PRINT AT(5,0);"Date (ddmmyy)"
: PRINT AT(6,0);"Time (hhmmss)"
: PRINT AT(7,0);"Tape Length"
7010 PRINT AT(4,0);"Tape Volume Name";
: PRINT AT(4,22);
: STR(V$(),5,8)=ALL(20)
: LINPUT -STR(V$(),5,8)
: ERRORPRINT HEX(07)
: GOTO 7010
7015 STR(V$(),13,2)="01"
: REM FIRST VOLUME STARTS WITH ASCII 01
7020 PRINT AT(5,0);"Date (ddmmyy)";
: PRINT AT(5,22);
: D1$=" "
: LINPUT -D1$
: ERRORPRINT HEX(07)
: GOTO 7020
7025 STR(V$(),17,6)=D1$
7030 PRINT AT(6,0);"Time (hhmmss)";
: PRINT AT(6,22);
: T1$=" "
: LINPUT -T1$
: ERRORPRINT HEX(07)
: GOTO 7030
7035 STR(V$(),23,6)=T1$
7040 L1$="450"
: PRINT AT(7,0);"Tape Length";
: PRINT AT(7,22);
: LINPUT -L1$
: ERRORPRINT HEX(07)
: GOTO 7040
7045 CONVERT L1$TO L
: ERRORGOTO 7040
7050 IF L=300OR L=450OR L=600THEN 7055
: PRINT HEX(07)
: GOTO 7040
7055 IF L=600THEN GOSUB '155
: STR(V$(),38)=BIN((L/300)*2-1)
: REM TAPE LENGTH (1 = 300, 2 = 450, 3 = 600)
7058 PRINT AT(8,0);"User comments";AT(8,22);
: STR(V$(),202,55)=" "
: LINPUT -STR(V$(),202,55)
7060 STR(V$(),39,8)=STR(V$(),5,8)
: REM PREVIOUS VOLUME NAME IS SAME AS THIS VOLUME NAME
7065 STR(V$(),1,4)="VHDR"
: REM VOLUME HEADER
7070 STR(V$(),15,2)=BIN(16386,2)
: REM MAX BLOCK SIZE
7075 STR(V$(),29,1)=HEX(01)
: REM LABEL FORMAT VERSION ID
7080 REM ACCESS CONTROL WORD EMPTY FOR NOW
7085 STR(V$(),47,1)=BIN(01)
: AND (STR(S$,6,1),01)
: IF STR(S$,6,1)=HEX(01)THEN STR(V$(),47,1)=BIN(02)
: REM # OF TRACKS - STATUS ('102) MUST BE DONE FIRST
7088 STR(V$(),48,1)=HEX(00)
: REM USER DEFINED BYTE
7090 STR(V$(),49,6)="999999"
: RETURN
7100 REM % Initialize File Label
7105 DEFFN'241
7115 STR(F$(),5,2)=BIN(0,2)
: REM TAPE FILE SEQ #
7120 STR(F$(),7,1)=BIN(0)
: REM TAPE FILE SECTION NUMBER
7125 C=0
: GOSUB '243
: REM BC
7130 STR(F$(),16,6)=D1$
: REM DATE
7135 STR(F$(),22,6)=T1$
: REM TIME
7145 STR(F$(),30,1)=HEX(FF)
: REM STANDARD RECORD SIZE
7150 STR(F$(),31,2)=BIN(16386,2)
: REM BLOCK SIZE
7155 STR(F$(),33,2)=BIN(256,2)
: REM RECORD SIZE
7160 STR(F$(),35,1)=HEX(11)
: REM SYSTEM ID
7165 STR(F$(),36,8)=ALL(00)
: REM USER DEFINED BYTES
7180 RETURN
7200 REM % INIT FILE HEADER
7205 DEFFN'245
: STR(F$(),1,4)="FHDR"
7210 IF C2=1THEN ADD(STR(F$(),7,1),01)
: ELSE STR(F$(),7,1)=HEX(01)
7215 C=0
: GOSUB '243
: REM CLEAR BLOCK COUNT
7220 STR(F$(),44,1)=HEX(00)
: REM CONTINUATION FLAG
7223 IF C2=0THEN STR(F$(),8,8)=STR(V$(),5,8)
: REM IF FILE IS NOT CONTINUED THEN START OF FILE IS ON THIS VOLUME
: REM ELSE FIRST TERMINATION OF FILE WILL SET TO PROPER NAME
7225 RETURN
7250 DEFFN'243
: REM % COMPUTE BLOCK COUNT
7255 STR(F$(),28,2)=BIN(C,2)
7260 RETURN
7300 REM % SET UP FILE TRAILER LABEL
7305 DEFFN'242
: STR(F$(),1,4)="FEND"
7310 GOSUB '243
: REM BLOCK COUNT
7315 STR(F$(),44,1)=HEX(00)
: C2=0
: IF S1>G3THEN 7320
: STR(F$(),44,1)=HEX(FF)
: REM SET CONT FLAG IF NECESSARY
: C2=1
: REM SET BASIC CONT FLAG
7320 RETURN
7500 REM % CHECK ERROR RETURN FOR IMMEDIATE MODE COMMANDS
7510 DEFFN'222
: REM % Check error return
: E=VAL(STR(R$,1,1))
: IF E=0THEN RETURN
: RESTORE LINE7520,E
: READ E$
: IF E=2THEN C3=1
: REM SET OUT OF TAPE FLAG
: IF E=8THEN 7600
: RETURN
7520 DATA "ILLEGAL COMMAND","OUT OF TAPE","TAPE NOT READY","WRITE PROTECTED","
RESULTS PENDING","DATA ERROR","FILE MARK FOUND","TAPE FAULT"
7530 REM % Errors
7540 PRINT "Error ";E;" - ";E$
: STOP
7560 DEFFN'152
: REM % WAIT FOR RETURN KEY
7565 PRINT
: PRINT "Press RETURN"
7570 DEFFN'154
: KEYIN K$
7580 KEYIN K$,7580,7580
: RETURN
: REM FLUSH EXTRA KEYSTROKES
7600 REM PROCESS DRIVE/CONTROLLER FAULT
7610 PRINT HEX(06),AT(10,0);"Error 8 - Drive/Controller fault"
: GOSUB '102
: REM TAKE STATUS
: PRINT
7620 PRINTUSING 7700,"Controller PROM rev",STR(S$,1,2)
7625 PRINTUSING 7700,"Software rev",STR(S$,3,2)
7630 PRINTUSING 7700,"Tape drive PROM rev",VAL(STR(S$,5,1))
7635 HEXUNPACKSTR(S$,6,1)TO U8$
: PRINTUSING 7700,"Controller device switch",U8$
7640 HEXUNPACKSTR(S$,7,1)TO U8$
: PRINTUSING 7700,"Tape drive STATUS 1",U8$
7645 HEXUNPACKSTR(S$,8,1)TO U8$
: PRINTUSING 7700,"Tape drive STATUS 2",U8$
7650 PRINTUSING 7700,"Drive/controller fault",VAL(STR(S$,10,1))
: PRINT
: STOP
7700 %######################## ##
8000 DEFFN'225
: REM % FILL UP BUFFER WITH DATA
: REM START WITH SECTOR S1
: REM FILL UNTIL BUFFER IS FULL OR S1 = G3(LAST)
: REM EXIT WITH S1 POINTING TO NEXT SECTOR
8020 $OPEN #2
: P=1
: REM POINTER INTO BUFFER
8025 C(4)=C(3)
: C(3)=C(2)
: C(2)=C(1)
: C(1)=S1
: REM ROTATE SECTOR ARRAY
8030 DATA LOAD BA T#2,(S1,S1)STR(A1$(),P,256)
: ERRORGOTO 8600
8040 P=P+256
: REM UPDATE POINTER
: IF S1>G3THEN 8070
: REM IF NEXT SECTOR > LAST THEN DONE
8060 IF P<16384THEN 8030
: REM GET MORE DATA
8070 $CLOSE#2
: STR(R$,3,2)=BIN(P-1,2)
: REM # OF BYTES
: RETURN
8500 DEFFN'208
: REM % ERROR MESSAGE FOR TAPE UNIT NOT READY
8510 GOSUB '102
: M$="Tape drive is not ready "
: GOSUB '160
: GOSUB '152
: RETURN
8567 DEFFN'151
: PRINT HEX(03);AT(0,40-(LEN(T$)/2));HEX(020402040E);T$;HEX(0F)
: RETURN
8600 $CLOSE#2
: PRINT "DISK ERROR ";ERR
: STOP #
8700 DEFFN'126
: RETURN CLEAR ALL
: GOTO 20
8710 DEFFN'127
: RETURN CLEAR ALL
: $PSTAT=".2229"
: F$=".2229"
: LOAD RUN
8720 DEFFN'153
: PRINT AT(18,0);"Press FN/TAB to restart current utility"
: PRINT "Press Shift FN/TAB to return to menu"
: RETURN