image of READY prompt

Wang2200.org

Listing of file='2229SUB' on disk='vmedia/2229_diagnostics.wvd.zip'

# Sector 161, program filename = '2229SUB'
5000 REM % "2229SUB" - part of 2229 utilities package
5002 REM % COPYRIGHT WANG LABORATORIES, INC., 1986
5005 REM ST 01/24/1986
5100 REM Changes ---> version 2.0
5110 REM ADDED SOFT RESET IN LINE 5250 BEFORE TAPE LOAD
5120 REM ADDED 'LOOK AHEAD READ' (B9 FLAG) TO READ ROUTINES TO SPEED UP RECOVE
     RY (LINES 5660 TO 5710)
5125 REM ADDED LINES TO STATMENT 5685 TO CHECK FOR ILLEGAL LENGTH OF TAPE RECO
     RD - (CHECK HARDWARE ECO LEVEL OF CONTROLLER)
5130 REM LINE 7160 CHANGED SYS ID TO HEX(12)
5135 REM ADDED MESSAGE TO LINE 5665 FOR UNEXPECTED END OF TAPE
5140 REM ADDED LOGIC IN READ ROUTINE '112 FOR HANDLING BAD BLOCKS
5145 REM ADDED DEBUG STATEMENTS
5200 DIM U8$2
5210 DEFFN'102
   : REM % BOARD STATUS
5220 S$=ALL(20)
   : R$=ALL(01)
5230 $GIO#4(4402 8701 1800 C340,R$)STR(S$,1,VAL(STR(R$,1,1)))
   : RETURN
5240 DEFFN'104
   : REM % LOAD TAPE
5250 IF D9<1THEN PRINT HEX(020404000E)
   : PRINT AT(10,0,);"Loading Tape"
   : IF D9=2THEN 5265
   : IF D9=1THEN D9=2
   : REM JUMP ON DEBUG
   : $GIO#4(4430 4404 8701,R$)
   : PRINT HEX(0F)
   : GOSUB '222
   : REM GET ERROR
   : IF E=0THEN RETURN
   : IF E<>3THEN 7540
5260 GOSUB '208
   : GOTO 5250
5265 PRINT "*****";
   : $GIO(75FF)
   : STR(R$,1,1)=HEX(00)
   : E=0
   : RETURN
5270 DEFFN'105
   : REM % UNLOAD TAPE
5280 IF D9<1THEN  PRINT HEX(020404000E)
   : PRINT AT(10,0,);"Unloading tape"
5290 IF D9>0THEN 5310
   : $GIO#4(4405 8701,R$)
   : PRINT HEX(0F)
   : GOSUB '222
5300 IF E=0THEN RETURN
   : IF E<>3THEN 7540
   : GOSUB '208
   : GOTO 5280
5310 PRINT "*****";
   : $GIO(75FF)
   : E=0
   : STR(R$,1,1)=HEX(00)
   : RETURN
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
5625 DEFFN'103
   : REM % START LOOK AHEAD READ
5630 $GIO#4(440C,R$)
   : B9=1
   : RETURN
5650 DEFFN'112
   : REM %READ
5660 IF B9=1THEN 5662
   : $GIO#4 (440C,R$)
   : REM START READ
5662 $GIO#4 (8701,R$)
   : REM GET READ RESULT
   : B9=0
   : B=0
   : GOSUB '222
   : IF E=0THEN 5680
   : IF E<>7THEN 5665
   : F3=1
   : REM FM FOUND
   : RETURN
5665 IF E<>2THEN 5670
   : PRINT AT(10,0,);"Error - unexpected end of tape without Volume trailer la
     bel"
   : STOP #
   : GOTO 10
5670 IF E<>6THEN 5675
   : REM TAPE READ ERROR
   : RETURN
5675 REM FALL THROUGH TO NOT READY
   : GOSUB '208
   : GOTO 5660
5680 $GIO#4(8703 8704,R$)
   : REM GET BYTE COUNT
   : B6=VAL(STR(R$,3,2),2)
   : IF B6<=16386THEN 5685
   : PRINT AT(10,0,);"Drive/Controller error - tape record too large"
   : PRINT "Tape Controller possibly not latest hardware revision"
   : STOP #
   : GOTO 10
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 5815
   : $GIO(1935,R$)
   : REM INC BYTE COUNT BY 2 IF NOT LABEL
5810 IF D9<1THEN 5815
   : REM JUMP IF DEBUG OFF
   : KEYIN K$,5815,5812
   : GOTO 5815
5812 IF K$<>HEX(00)THEN 5815
   : STR(R$,1,2)=HEX(0500)
   : GOTO 5818
5815 STR(R$,2,1)=HEX(00)
   : $GIO#4(440D 4230 4240 8701,R$)
5818 GOSUB '222
   : IF E=0THEN 5820
   : IF E=5THEN GOSUB '220
   : REM END WRITE IF NECESSARY
   : IF W=0AND D9>1THEN 5819
   : IF E=2THEN RETURN
   : IF E<>3THEN 7540
   : GOSUB '208
   : GOTO 5810
5819 STR(R$,1,2)=HEX(0200)
   : E=2
   : C3=1
   :  RETURN
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(12)
   : REM SYSTEM ID = 2200, VERSION 2.X
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
   : GOSUB '153
   : 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